Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24962
Modified Files: Tag: devel_0_39 desire.tk Log Message: cleanup
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.326 retrieving revision 1.1.2.327 diff -C2 -d -r1.1.2.326 -r1.1.2.327 *** desire.tk 13 Aug 2006 08:42:24 -0000 1.1.2.326 --- desire.tk 13 Aug 2006 19:09:04 -0000 1.1.2.327 *************** *** 1880,1884 **** mset {ox1 oy1 ox2 oy2} [lrange [$c coords lnew] end-3 end] mset {x1 y1} [lrange [$c coords lnew] 0 1] - #puts "ox1=$ox1 oy1=$oy1 x=$x y=$y" set l [$c coords lnew] #if {[llength $l]<4 || [distance [list $ox1 $oy1] [list $x $y]] < 30} { --- 1880,1883 ---- *************** *** 1944,1966 **** #-----------------------------------------------------------------------------------# def Canvas identify_target {x y b f label} { set c .$self.c ! set stack [lreverse [$c find overlapping \ ! [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]]] foreach tag $stack { set tags [$c gettags $tag] if {[regexp {^x([a-f0-9]{6,8})} $tags id]} { - global _ if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown} - #post "(.....) $id is a [$class] object" return [list "object" $id] } } foreach tag $stack { ! set tags [$c gettags $tag] ! if {[regexp {^([0-9a-f]{6,8})} $tags id]} { ! return [list "wire" $id] ! } } - #post "(.....) nothing in particular" return [list "nothing"] } --- 1943,1960 ---- #-----------------------------------------------------------------------------------# def Canvas identify_target {x y b f label} { + global _ set c .$self.c ! set stack [lreverse [$c find overlapping [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]]] foreach tag $stack { set tags [$c gettags $tag] if {[regexp {^x([a-f0-9]{6,8})} $tags id]} { if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown} return [list "object" $id] } } foreach tag $stack { ! set tags [$c gettags $tag] ! if {[regexp {^([0-9a-f]{6,8})} $tags id]} {return [list "wire" $id]} } return [list "nothing"] } *************** *** 2093,2096 **** --- 2087,2091 ---- $self copy $self paste + $clipboard _delete set clipboard $backup } *************** *** 2122,2126 **** menu $p -tearoff false if {$id == ""} { ! $self populate_menu $p {popup_properties popup_help} } { $id populate_menu $p {popup_properties popup_open popup_help} --- 2117,2121 ---- menu $p -tearoff false if {$id == ""} { ! $self populate_menu $p {popup_properties popup_help} } { $id populate_menu $p {popup_properties popup_open popup_help} *************** *** 2129,2133 **** }
! # this method is too long def* Canvas clickedit {x y b f} { set c .[$self canvas].c --- 2124,2128 ---- }
! #!@#$ this method is too long def* Canvas clickedit {x y b f} { set c .[$self canvas].c *************** *** 2610,2625 **** if {[llength $@selection] > 0} {$self delete_selection} if {[llength $@selection_wire] > 0} { - puts "delete this $self :: $@selection_wire" foreach x $@selection_wire { ! set find [lsearch $@wires_pair $x] ! if { $find != -1} { ! pd .$self disconnect [lindex $@wires_pair [expr $find - 1]] ! # remove the selected wire from the @wire_pair... ! set @wires_pair [lreplace $@wires_pair $find $find] ! set @wires_pair [lreplace $@wires_pair [expr $find - 1] [expr $find - 1]] } $x delete } - set $@selection_wire {} } --- 2605,2616 ---- if {[llength $@selection] > 0} {$self delete_selection} if {[llength $@selection_wire] > 0} { foreach x $@selection_wire { ! set find [lsearch $@wires_pair $x] ! if {$find != -1} { ! pd .$self disconnect [lindex $@wires_pair [expr $find - 1]] ! set @wires_pair [lreplace $@wires_pair [expr $find - 1] [expr $find - 1]] } $x delete } set $@selection_wire {} } *************** *** 2637,2649 **** if {$_($@selection:_class) == "ObjectBox"} {$@selection edit; $self dehilite_io} } else { - puts "connect this :::: $@keynav_iosel" set from_obj [lindex $@keynav_iosel 0] ! set to_obj [lindex $@keynav_iosel 1] ! set from [lsearch $@children [lindex $@keynav_iosel 0]] ! set to [lsearch $@children [lindex $@keynav_iosel 1]] ! puts "from::: $from to:::$to" ! pd .$self connect [list $from [lindex $_($from_obj:ioselect) 0] $to [lindex $_($to_obj:ioselect) 0]] $self dehilite_io - } } --- 2628,2639 ---- 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 } } *************** *** 2707,2714 **** super $dx $dy #$self draw_wires - #foreach wire $@wires { - # set _($wire:select_by) $_($@canvas:select_by) - #$wire draw - #} }
--- 2697,2700 ---- *************** *** 2722,2731 **** if {$in_selection && [llength $_($@canvas:selection)]>1} { foreach obj $_($@canvas:selection) {mset {x y} [$obj xy];$obj set_orig_xy $x $y} - puts "begin to move _______ $_($@canvas:selection)" set _($@canvas:action) move } { $@canvas deselect_all set _($@canvas:selection) $self - #set _($@canvas:action) move set _($@canvas:action) edit } --- 2708,2715 ---- *************** *** 2741,2752 **** for {set n 0} {$n<$ports} {incr n} { ! set tag $self$type$n ! set area [.$@canvas.c bbox $self$type$n] ! set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ] ! set dist [expr abs($x - $center)] ! if {$dist < [expr ([look iowidth]/2)+5] && $dist > 0} {set port $n} } ! ! if {$ports==0 | $port==-1} return #set port [expr int(($x-$x1)*$ports/$xs)] --- 2725,2735 ---- for {set n 0} {$n<$ports} {incr n} { ! set tag $self$type$n ! set area [.$@canvas.c bbox $self$type$n] ! set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ] ! set dist [expr abs($x - $center)] ! if {$dist < [expr ([look iowidth]/2)+5] && $dist > 0} {set port $n} } ! if {$ports==0 | $port==-1} return #set port [expr int(($x-$x1)*$ports/$xs)] *************** *** 2771,2779 **** set @port2 $inlet set @canvas $canvas - #set _($@obj1:wires) $self - #set _($@obj2:wires) $self # associate wires to its connected objects lappend _($@obj1:wires) $self - puts "_($@obj1:wires) is $_($@obj1:wires)" lappend _($@obj2:wires) $self # select_by is a hack to get wires remain hilited if selected by serect.... --- 2754,2759 ---- *************** *** 2787,2792 ****
def Wire draw {} { - #set thick 2 - #puts "------- from:$@obj1 outlet:$@port1 to:$@obj2 inlet:$@port2" set bbox1 [.$@canvas.c bbox [join [list "$@obj1" o "$@port1"] ""]] set bbox2 [.$@canvas.c bbox [join [list "$@obj2" i "$@port2"] ""]] --- 2767,2770 ---- *************** *** 2795,2806 **** 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]]] - #wire_draw $self 1 $x1 $y1 $x2 $y2 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? set arrowsize [expr $length<100 ? $length/10 : 10] if {$arrowsize < 5} {set arrow none} {set arrow last} set arrowshape [list $arrowsize [expr $arrowsize*4/5] [expr $arrowsize/3]] - # need this, maybe... #if {$@select_by == "selrect"} {set wire_color [look wirefg2]} {set wire_color [look wirefg]} if {[$self selected?]} {set wire_color [look wirefg2]} {set wire_color [look wirefg]} --- 2773,2782 ---- 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? set arrowsize [expr $length<100 ? $length/10 : 10] if {$arrowsize < 5} {set arrow none} {set arrow last} set arrowshape [list $arrowsize [expr $arrowsize*4/5] [expr $arrowsize/3]] #if {$@select_by == "selrect"} {set wire_color [look wirefg2]} {set wire_color [look wirefg]} if {[$self selected?]} {set wire_color [look wirefg2]} {set wire_color [look wirefg]} *************** *** 2808,2831 **** $self item WIRE line $xys -width [look wirethick] -smooth yes \ -arrow $arrow -arrowshape $arrowshape -fill $wire_color - - #puts ".......tags: [.$@canvas.c gettags $self]" - #if {[llength [.$@canvas.c gettags $self]] != 0} { - #$canvas coords $self $xys - #$canvas itemconfigure -arrow $arrow -arrowshape $arrowshape - #} { - #$canvas create line $xys -tags $self -width $thick \ - # -arrow $arrow -arrowshape $arrowshape -fill [look wirefg] - # $self item WIRE line $xys -width $thick -smooth yes \ - # -arrow $arrow -arrowshape $arrowshape -fill [look wirefg] - #} }
- #def* Wire selected?= {flag} { - # if {$flag} {set colour [look wirefg2]} {set colour [look wirefg]} - # .$@canvas.c itemconfigure ${self}WIRE -fill $colour - #} - #!@#$ what's this? doesn't match the name of instance variables. def Wire update {source outlet target inlet kind} { set @source $source set @outlet $outlet --- 2784,2792 ---- $self item WIRE line $xys -width [look wirethick] -smooth yes \ -arrow $arrow -arrowshape $arrowshape -fill $wire_color }
#!@#$ what's this? doesn't match the name of instance variables. def Wire update {source outlet target inlet kind} { + error "proof that this method is used somewhere..." set @source $source set @outlet $outlet *************** *** 3170,3179 **** set class $_($@of:class) if {![info exists fields($class)]} {set class obj} - puts "this is a $_($@of:class) class" set orig {} set props ".$@of reload" set props2 {} foreach var [lrange $fields($class) 5 end] { - #puts "$var --from-- $_($@of:$var) --to-- $@$var" lappend orig $_($@of:$var) lappend props2 $@$var ;# does $@$ really work or not? if not, fix objective.tcl ... --- 3131,3138 ---- *************** *** 3185,3198 **** default {set val $@$var} } ! if {[regexp -nocase {^([a-z])col$} $var]} { ! set val [unparse_color $val] ! puts "color ---- > $val" ! } switch -- $val { {} {set val "empty"}} set props "$props $val" } - puts "orig props:: $orig" - puts "inter props:: $props2" - puts "real props:: $props" pd $props } --- 3144,3151 ---- default {set val $@$var} } ! if {[regexp -nocase {^([a-z])col$} $var]} {set val [unparse_color $val]} switch -- $val { {} {set val "empty"}} set props "$props $val" } pd $props } *************** *** 3205,3236 **** wm title .$self "[$class] [say popup_properties]" if {![info exists fields($class)]} {set class obj} - puts "this is a $_($of:class) class" - puts "it has [llength $fields($class)] properties" - #clone values foreach var $fields($class) { - puts "$var ---------- $_($of:$var)" switch $var { ! is_log {if {$_($of:$var)} {set val "linear"} else { set val "logarithmic"}} ! isa {if {$_($of:$var)} {set val "yes"} else { set val "no"}} ! steady {if {$_($of:$var)} {set val "jump"} else { set val "steady"}} ! fstyle {if {$_($of:$var)} {set val "yes"} else { set val "no"}} default {set val $_($of:$var)} } - #set val $_($of:$var) switch -- $val { empty {set val ""}} if {[regexp -nocase {^([a-z])col$} $var]} {set val [parse_color $val]} set @$var $val } - - - #set @loadbang [expr $@isa & 1] - #set @scale [expr ($@isa>>20) & 1] set @class $_($of:class) - # the longest label is... foreach prop $fields($class) { ! set label [say $prop] ! if {[string length $label] > $@max_label} {set @max_label [string length $label]} } - foreach prop [lrange $fields($class) 5 end] { switch $prop { --- 3158,3178 ---- wm title .$self "[$class] [say popup_properties]" if {![info exists fields($class)]} {set class obj} foreach var $fields($class) { switch $var { ! is_log {if {$_($of:$var)} {set val "linear"} else {set val "logarithmic"}} ! isa {if {$_($of:$var)} {set val "yes" } else {set val "no"}} ! steady {if {$_($of:$var)} {set val "jump" } else {set val "steady"}} ! fstyle {if {$_($of:$var)} {set val "yes" } else {set val "no"}} default {set val $_($of:$var)} } switch -- $val { empty {set val ""}} if {[regexp -nocase {^([a-z])col$} $var]} {set val [parse_color $val]} set @$var $val } set @class $_($of:class) foreach prop $fields($class) { ! set label [say $prop] ! if {[string length $label] > $@max_label} {set @max_label [string length $label]} } foreach prop [lrange $fields($class) 5 end] { switch $prop { *************** *** 3271,3277 **** properties_dialog $self .$self $d } - - - #puts "$self = IEMPropertiesDialog $of" }
--- 3213,3216 ---- *************** *** 3283,3287 **** foreach var {xscale yscale graphme} {set @$var $_($of:$var)} wm title .$self "[say canvas] [say popup_properties]" - #wm protocol $id WM_DELETE_WINDOW "canvas_cancel $id" set props { xscale "X units/px: " entry {-width 10} --- 3222,3225 ---- *************** *** 3291,3295 **** pack [checkbutton .$self.graphme -text "graph on parent" \ -variable @graphme -anchor w] -side top - #bind .$self.xscale.entry <KeyPress-Return> "canvas_ok $id" #bind .$self.yscale.entry <KeyPress-Return> "canvas_ok $id" .$self.xscale.entry select from 0 --- 3229,3232 ----