Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7366
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
auto object insert
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.507
retrieving revision 1.1.2.508
diff -C2 -d -r1.1.2.507 -r1.1.2.508
*** desire.tk 14 Oct 2006 14:46:45 -0000 1.1.2.507
--- desire.tk 15 Oct 2006 11:57:51 -0000 1.1.2.508
***************
*** 1605,1608 ****
--- 1605,1635 ----
}
+ def Canvas insert_object {} {
+ if {[llength $@selection_wire] == 1} {
+ puts "insert object for $@selection_wire"
+ #<- .x82aa1d8 obj 243.0 147.0;
+ mset {obj1 outlet obj2 inlet} [$@selection_wire report]
+ puts " $obj1 $outlet ----> $obj2 $inlet"
+ set c [$self widget]
+ set iowidth [$self look iowidth]
+ mset {ox1 oy1 ox2 oy2} [lmap / [$c bbox ${obj1}o${outlet}] [$self zoom]]
+ mset {ix1 iy1 ix2 iy2} [lmap / [$c bbox ${obj2}i${inlet}] [$self zoom]]
+ set x1 [expr $ox1 + ($iowidth / 2)]
+ set y1 [expr ($oy1 + $oy2) / 2]
+ set x2 [expr $ix1 + ($iowidth / 2)]
+ set y2 [expr ($iy1 + $iy2) / 2]
+ set x [expr (abs($x2-$x1) / 2) + $x1]
+ set y [expr (abs($y2-$y1) / 2) + $y1]
+ # $c create oval [list [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]] \
+ # -fill blue -tags "POO"
+ pd .$self "obj" $x $y
+ set @action insert
+ puts " action ::: $@action"
+ } else {
+ return
+ }
+ }
+
+
def Canvas Object {} {$self new_object obj}
def Canvas Message {} {$self new_object msg; global canvas; set canvas(msg_isnew) 1} ;# ???
***************
*** 1802,1806 ****
mset {cx cy} [$self xy]
$self item text window [list [expr $cx+2] [expr $cy+2]] \
! -window $t -anchor nw -tags "${self}text $self"
$t configure -pady 0 -padx 1
$t insert 1.0 $@text
--- 1829,1833 ----
mset {cx cy} [$self xy]
$self item text window [list [expr $cx+2] [expr $cy+2]] \
! -window $t -anchor nw -tags "${self}text $self text"
$t configure -pady 0 -padx 1
$t insert 1.0 $@text
***************
*** 1967,1974 ****
--- 1994,2014 ----
pd .$@canvas text_setto !$self $l
$self changed
+ if {[$@canvas action] == "insert"} {
+ set wire [$@canvas selection_wire]
+ set wire2 [$@canvas get_wire $wire]
+ mset {obj1 outlet obj2 inlet} [$wire report]
+ $@canvas disconnect $wire2
+ set obj1_idx [$@canvas children_idx $obj1]
+ set obj2_idx [$@canvas children_idx $obj2]
+ set obj3_idx [$@canvas children_idx $self]
+ $@canvas connect [list $obj1_idx $outlet $obj3_idx 0]
+ $@canvas connect [list $obj3_idx 0 $obj2_idx $inlet]
+ $@canvas action= none
+ }
}
def TextBox unedit {{accept 1}} {
if {!$@edit} {return}
+ if {!$accept} {$@canvas del [$@canvas children_idx $self]}
set @edit 0
set c [$@canvas widget]
***************
*** 2020,2023 ****
--- 2060,2065 ----
def Canvas children {} {return $@children}
+ def Canvas children_idx {obj} {return [lsearch $@children $obj]}
+
# think of the children!!!
# should be only called from the server
***************
*** 2092,2095 ****
--- 2134,2144 ----
def Canvas wires {} {return $@wires}
+ def Canvas get_wire {wire} {
+ set find [lsearch $@wires_pair $wire]
+ if {$find != -1} {
+ return [lindex $@wires_pair [expr $find -1]]
+ }
+ }
+
def Canvas delete_selection {} {
if {![llength $@selection] && ![llength $@selection_wire]} {return}
***************
*** 2250,2253 ****
--- 2299,2303 ----
}
}
+ insert {}
none {}
default {$@action motion $x $y $f $target}
***************
*** 2354,2357 ****
--- 2404,2408 ----
def Canvas statusbar_draw {x y} {$@statusbar draw $x $y}
def Canvas action {} {return $@action}
+ def Canvas action= {action} {set @action $action}
def Canvas zoom {} {return $@zoom}
***************
*** 2512,2516 ****
$@history add [list $self connect $wire]
}
! def Canvas connect {wire} {
mset {from outlet to inlet} $wire; pd .$self connect $from $outlet $to $inlet
$@history add [list $self disconnect $wire]
--- 2563,2567 ----
$@history add [list $self connect $wire]
}
! def Canvas connect {wire} {
mset {from outlet to inlet} $wire; pd .$self connect $from $outlet $to $inlet
$@history add [list $self disconnect $wire]
***************
*** 2601,2605 ****
}
def FutureWire draw {} {
! $self item WIRE line [xys $@x1 $@y1 $@x2 $@y2] -dash {4 4 4 4} -fill [$self look dash] -smooth yes
}
--- 2652,2656 ----
}
def FutureWire draw {} {
! $self item WIRE line [list $@x1 $@y1 $@x2 $@y2] -dash {4 4 4 4} -fill [$self look dash] -smooth yes
}
***************
*** 2737,2740 ****
--- 2788,2792 ----
move {}
none {}
+ insert {}
default {$@action unclick $x $y $f $target}
}
***************
*** 2748,2779 ****
def Canvas unclick {x y f target} {
! set c [$self widget]
! mset {type id detail} $target
! if {$@editmode} {
! switch $@action {
! edit {set @obj_in_edit $id; $id edit; set @action none; $id changed}
! move {
! foreach obj $@selection {
! if {![[$obj class] <= Box]} {
! puts "Canvas unclick warning: trying to move non-Box explicitly"
! continue
! }
! mset {x1 y1} [$obj xy]
! $obj position= [$obj backupxy]
! $obj moveto $x1 $y1
! }
! set objs $@selection
! set @action none
! }
! none {}
! default {$@action unclick $x $y $f $target}
! }
! } else {
! if {[$self focus] != ""} {[$self focus] unclick $x $y $f $target}
mset {type id detail} $target
! if {$id != ""} {if {[$id class] == "Array"} {$id unclick $x $y $f $target; return}}
! }
! $self adjust_scrollbars
! $self checkgeometry
}
--- 2800,2832 ----
def Canvas unclick {x y f target} {
! set c [$self widget]
mset {type id detail} $target
! if {$@editmode} {
! switch $@action {
! edit {set @obj_in_edit $id; $id edit; set @action none; $id changed}
! move {
! foreach obj $@selection {
! if {![[$obj class] <= Box]} {
! puts "Canvas unclick warning: trying to move non-Box explicitly"
! continue
! }
! mset {x1 y1} [$obj xy]
! $obj position= [$obj backupxy]
! $obj moveto $x1 $y1
! }
! set objs $@selection
! set @action none
! }
! none {}
! insert {}
! default {$@action unclick $x $y $f $target}
! }
! } else {
! if {[$self focus] != ""} {[$self focus] unclick $x $y $f $target}
! mset {type id detail} $target
! if {$id != ""} {if {[$id class] == "Array"} {$id unclick $x $y $f $target; return}}
! }
! $self adjust_scrollbars
! $self checkgeometry
}
***************
*** 3129,3173 ****
def Canvas key {x y key iso shift} {
! $self hide_tooltip
! if {[$self focus] != ""} {
! [$self focus] key $key $shift
! }
! #if {$iso != ""} {scan $iso %c key}
! if {$shift} {set motion 10} {set motion 1}
! switch -regexp -- $key {
! BackSpace|Delete|KP_Delete {$self delete_selection}
! Up {if {[llength $@selection]} {$self selection_move 0 -$motion} else {$self scroll y -$motion}}
! Down {if {[llength $@selection]} {$self selection_move 0 +$motion} else {$self scroll y +$motion}}
! Left {if {[llength $@selection]} {$self selection_move -$motion 0} else {$self scroll x -$motion}}
! Right {if {[llength $@selection]} {$self selection_move +$motion 0} else {$self scroll x +$motion}}
! Tab {$self tab_jump}
! Return {
! if {[llength $@selection] == 1} {
! if {[llength $@keynav_iosel] < 2} {
! if {$_($@selection:_class) == "ObjectBox"} {$@selection edit; $self dehilite_io}
! } else {
! set from_obj [lindex $@keynav_iosel 0]
! set to_obj [lindex $@keynav_iosel 1]
! set from [lsearch $@children [lindex $@keynav_iosel 0]]
! set inlet [lindex $_($from_obj:ioselect) 0]
! set to [lsearch $@children [lindex $@keynav_iosel 1]]
! set outlet [lindex $_($to_obj:ioselect) 0]
! pd .$self connect [list $from $inlet $to $outlet]
! $self dehilite_io
! }
! }
}
! Escape {
! if {[llength $@selection] > 0 | [llength $@selection_wire] > 0} {
! $self deselect_all
! $self dehilite_io
! }
! if {$@keynav} {set @keynav 0}
!
! #this should be better sorted out in canvas tab_jump
! if {$@keynav_tab_sel == "object"} {set @keynav_tab_sel "wire"} else {set @keynav_tab_sel "object"}
}
- default {}
- }
}
--- 3182,3234 ----
def Canvas key {x y key iso shift} {
! $self hide_tooltip
! if {[$self focus] != ""} {
! [$self focus] key $key $shift
}
! #if {$iso != ""} {scan $iso %c key}
! if {$shift} {set motion 10} {set motion 1}
! switch -regexp -- $key {
! BackSpace|Delete|KP_Delete {$self delete_selection}
! Up {if {[llength $@selection]} {$self selection_move 0 -$motion} else {$self scroll y -$motion}}
! Down {if {[llength $@selection]} {$self selection_move 0 +$motion} else {$self scroll y +$motion}}
! Left {if {[llength $@selection]} {$self selection_move -$motion 0} else {$self scroll x -$motion}}
! Right {if {[llength $@selection]} {$self selection_move +$motion 0} else {$self scroll x +$motion}}
! Tab {$self tab_jump}
! Return {
! if {[llength $@selection] == 1} {
! if {[llength $@keynav_iosel] < 2} {
! if {$_($@selection:_class) == "ObjectBox"} {$@selection edit; $self dehilite_io}
! } else {
! set from_obj [lindex $@keynav_iosel 0]
! set to_obj [lindex $@keynav_iosel 1]
! set from [lsearch $@children [lindex $@keynav_iosel 0]]
! set inlet [lindex $_($from_obj:ioselect) 0]
! set to [lsearch $@children [lindex $@keynav_iosel 1]]
! set outlet [lindex $_($to_obj:ioselect) 0]
! pd .$self connect [list $from $inlet $to $outlet]
! $self dehilite_io
! }
! }
! }
! Escape {
! if {[llength $@selection] > 0 | [llength $@selection_wire] > 0} {
! $self deselect_all
! $self dehilite_io
! }
! if {$@keynav} {set @keynav 0}
!
! #this should be better sorted out in canvas tab_jump
! if {$@keynav_tab_sel == "object"} {
! set @keynav_tab_sel "wire"
! } else {
! set @keynav_tab_sel "object"
! }
!
! #if {[llength [[$self widget] gettags text]]} {
! # puts " delete something.........."
! #}
! }
! default {}
}
}
***************
*** 3370,3374 ****
def Wire to {} {return $@obj2}
def Wire inlet {} {return $@port2}
-
def View draw_wires {} {foreach wire $_($@canvas:wires) {$wire changed}}
def Wire move {dx dy} {$self changed}
--- 3431,3434 ----
***************
*** 3429,3433 ****
#mset {x1 y1} [l/2 [l+ [lrange $bbox1 0 1] [lrange $bbox1 2 3]]]
#mset {x2 y2} [l/2 [l+ [lrange $bbox2 0 1] [lrange $bbox2 2 3]]]
! set xys [xys $x1 $y1 $x2 $y2]
set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
# how to customise the arrow size/shape?
--- 3489,3493 ----
#mset {x1 y1} [l/2 [l+ [lrange $bbox1 0 1] [lrange $bbox1 2 3]]]
#mset {x2 y2} [l/2 [l+ [lrange $bbox2 0 1] [lrange $bbox2 2 3]]]
! set xys [list $x1 $y1 $x2 $y2]
set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
# how to customise the arrow size/shape?
