[PD-cvs] pd/src desire.tk,1.1.2.326,1.1.2.327
Mathieu Bouchard
matju at users.sourceforge.net
Sun Aug 13 21:09:07 CEST 2006
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 ----
More information about the Pd-cvs
mailing list