[PD-cvs] pd/src desire.tk,1.1.2.49,1.1.2.50
Mathieu Bouchard
matju at users.sourceforge.net
Wed Sep 14 02:29:29 CEST 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16365
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
added method lookup with backtracking.
changed more _($self:...) to @...
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.49
retrieving revision 1.1.2.50
diff -C2 -d -r1.1.2.49 -r1.1.2.50
*** desire.tk 13 Sep 2005 21:58:20 -0000 1.1.2.49
--- desire.tk 14 Sep 2005 00:29:27 -0000 1.1.2.50
***************
*** 13,26 ****
# (thanks for taking time looking at this code)
#-----------------------------------------------------------------------------------#
! # This section is matju's object system (the base class is called base because
! # there's already something else called class)
set nextid 0
! proc class_new {name} {
! proc ${name}_new {args} "
global nextid _
set self \[format %08x \$nextid\]
incr nextid
! set _(\$self:_class) $name
eval [concat [list \$self init] \$args]
"
--- 13,35 ----
# (thanks for taking time looking at this code)
#-----------------------------------------------------------------------------------#
!
! #-----------------------------------------------------------------------------------#
! # OBJECT ORIENTED PROGRAMMING IN TCL (by Mathieu Bouchard)
! # (please distinguish between what this is and what dataflow is)
! # note, the toplevel class is called "thing".
set nextid 0
! set _(class:_class) class
! set _(class:_super) {thing}
!
! proc class_new {self {super {thing}}} {
! global _
! set _($self:_class) class
! set _($self:_super) $super
! proc ${self}_new {args} "
global nextid _
set self \[format %08x \$nextid\]
incr nextid
! set _(\$self:_class) $self
eval [concat [list \$self init] \$args]
"
***************
*** 32,35 ****
--- 41,52 ----
}
+ proc lookup_method {class selector listvar} {
+ global _
+ upvar $listvar lv
+ set name ${class}_$selector
+ if {[info procs $name} {lappend lv $name}
+ foreach super $_($class:_super) {lookup_method $super $selector lv}
+ }
+
rename unknown _original_unknown
proc unknown {args} {
***************
*** 41,45 ****
return [uplevel 1 [linsert $args 0 _original_unknown]]
}
! set name $_($self:_class)_$selector
puts "proc name of $self $selector is $name"
set r [uplevel 1 [concat [list $name $self] [lrange $args 2 end]]]
--- 58,65 ----
return [uplevel 1 [linsert $args 0 _original_unknown]]
}
! set candidates {}
! lookup_method $_($self:_class) $selector candidates
! puts "!!! candidates: $candidates"
! set name [lindex $candidates 0]
puts "proc name of $self $selector is $name"
set r [uplevel 1 [concat [list $name $self] [lrange $args 2 end]]]
***************
*** 48,51 ****
--- 68,76 ----
}
+ class_new thing
+ set _(thing:_super) {}
+
+ #-----------------------------------------------------------------------------------#
+
# carmen's canvas
source pd_base.tk
***************
*** 984,990 ****
}
}
! bind $c <Key> {canvas_key %W %x %y %K %A 0}
! bind $c <Shift-Key> {canvas_key %W %x %y %K %A 1}
! bind $c <KeyRelease> {canvas_keyup %W %x %y %K %A 0}
bind $c <Motion> {canvas_motion %W %x %y 0 %s}
bind $c <Alt-Motion> {canvas_motion %W %x %y 4 %s}
--- 1009,1015 ----
}
}
! bind $c <Key> {canvas_key [canvastosym %W] %x %y %K %A 0}
! bind $c <Shift-Key> {canvas_key [canvastosym %W] %x %y %K %A 1}
! bind $c <KeyRelease> {canvas_keyup [canvastosym %W] %x %y %K %A 0}
bind $c <Motion> {canvas_motion %W %x %y 0 %s}
bind $c <Alt-Motion> {canvas_motion %W %x %y 4 %s}
***************
*** 1011,1027 ****
global _
set self [canvastosym $name.c]
! set _($self:action) none
! set _($self:selection) {}
! set _($self:selection_wire) {}
! set _($self:focus) ""
! set _($self:current_x) 30
! set _($self:current_y) 30
! #set _($self:editable) $editable
!
#if {$editable == 1} {
# puts "editable == 1"
! # set _($self:mode) "edit"
#} else {
! # set _($self:mode) "run"
#}
--- 1036,1051 ----
global _
set self [canvastosym $name.c]
! set @action none
! set @selection {}
! set @selection_wire {}
! set @focus ""
! set @current_x 30
! set @current_y 30
! #set @editable $editable
#if {$editable == 1} {
# puts "editable == 1"
! # set @mode "edit"
#} else {
! # set @mode "run"
#}
***************
*** 1200,1204 ****
proc canvas_of {self} {
global _
! return $_($self:canvas)
}
--- 1224,1228 ----
proc canvas_of {self} {
global _
! return $@canvas
}
***************
*** 1327,1337 ****
#-----------------------------------------------------------------------------------#
def text create {canvas font_size text} {
- #puts "text_create:: $self $canvas $font_size"
global look font
! set name_len [string length $text]
! set xs [expr ($font(width) * ($name_len+1) + $font(padx))]
! set ys [expr $font(height) + $font(pady)]
! set @xs $xs
! set @ys $ys
objectbox_draw $self $canvas
set t $canvas.${self}text
--- 1351,1357 ----
#-----------------------------------------------------------------------------------#
def text create {canvas font_size text} {
global look font
! set @name_len [string length $text]
! object_update_size $self
objectbox_draw $self $canvas
set t $canvas.${self}text
***************
*** 1374,1387 ****
class_new objectbox
def objectbox init {} {
! global offset
#set canvas [canvastosym $_(focus)]
set canvas $_(focus)
set @class ""
$self add $canvas
}
- #-----------------------------------------------------------------------------------#
def objectbox add {canvas} {
- #puts "object_add:: $self $canvas"
global font look
set canvas_id [canvastosym $canvas]
--- 1394,1412 ----
class_new objectbox
def objectbox init {} {
! set @isnew 1
#set canvas [canvastosym $_(focus)]
set canvas $_(focus)
set @class ""
$self add $canvas
+ set @name_len 0
+ }
+
+ def objectbox update_size {} {
+ global font
+ set @xs [expr $font(padx)+$font(width)*($@name_len+$@isnew)]
+ set @ys [expr $font(pady)+$font(height)]
}
def objectbox add {canvas} {
global font look
set canvas_id [canvastosym $canvas]
***************
*** 1391,1395 ****
set object [lindex $_($canvas_id:selection) 0]
#puts "___ complete $object first ____"
! object_complete $object $canvas
}
}
--- 1416,1420 ----
set object [lindex $_($canvas_id:selection) 0]
#puts "___ complete $object first ____"
! objectbox_complete $object $canvas
}
}
***************
*** 1399,1420 ****
set _($canvas_id:selection) {}
}
- set @isnew 1
set canvas_id [canvastosym $canvas]
- #puts "canvas_id ==> $canvas_id"
set _($canvas_id:obj_in_edit) 1
! #set _($canvas_id:obj_in_edit) $self
! set _($canvas_id:selection) {}
set _($canvas_id:selection) [linsert $_($canvas_id:selection) 0 $self]
! #puts "self:selection: [lindex $_($canvas_id:selection) 0]"
! #puts "set $self:isnew -> $@isnew"
! set @xs [expr $font(width) + $font(padx)]
! set @ys [expr $font(height) + $font(pady)]
!
objectbox_draw $self $canvas
text_create $self $canvas $font(size) ""
}
! #-----------------------------------------------------------------------------------#
! def object complete {canvas} {
global font
set @isselected 0
--- 1424,1437 ----
set _($canvas_id:selection) {}
}
set canvas_id [canvastosym $canvas]
set _($canvas_id:obj_in_edit) 1
! set _($canvas_id:selection) {}
set _($canvas_id:selection) [linsert $_($canvas_id:selection) 0 $self]
! $self update_size
objectbox_draw $self $canvas
text_create $self $canvas $font(size) ""
}
! def objectbox complete {canvas} {
global font
set @isselected 0
***************
*** 1425,1430 ****
$canvas delete ${self}text
objectbox_erase $self $canvas
! set @sx [expr ($@name_len*$font(width)) + $font(padx)]
! set @sy [expr $font(height) + $font(pady)]
objectbox_draw $self $canvas
for {set x 0} {$x<$@inlets} {incr x} {
--- 1442,1446 ----
$canvas delete ${self}text
objectbox_erase $self $canvas
! objectbox_update_size $self
objectbox_draw $self $canvas
for {set x 0} {$x<$@inlets} {incr x} {
***************
*** 1432,1436 ****
#puts "wires at inlet $x to select --> $_($self:0:$x)"
#wire_update $_()
- #wire_update:: l80f8ea8 81168ae 1 81168af 0 0
foreach wire_id $_($self:0:$x) {
wire_update $wire_id $_($wire_id)
--- 1448,1451 ----
***************
*** 1457,1461 ****
#-----------------------------------------------------------------------------------#
! def object edit {canvas} {
global font
set canvas_id [canvastosym $canvas]
--- 1472,1476 ----
#-----------------------------------------------------------------------------------#
! def objectbox edit {canvas} {
global font
set canvas_id [canvastosym $canvas]
***************
*** 1492,1513 ****
proc canvas_motion {canvas x y mods state} {
#puts "canvas_motion::: $canvas $x $y $mods $state"
! canvas_motion2 $canvas $x $y $mods $state
! #statusbar_update [canvastosym $canvas] $x $y
}
#-----------------------------------------------------------------------------------#
! proc canvas_motion2 {canvas x y mods state} {
! #puts "canvas_motion2::: $x $y $mods $state"
!
global current_x current_y old_x old_y select_area mouse font
global tooltip _ dehighlight look wire_from wire_to
! set self [canvastosym $canvas]
! set cx [$canvas canvasx $x]
! set cy [$canvas canvasy $y]
!
! set _($self:current_x) $cx
! set _($self:current_y) $cy
! set edit 0; switch $_($self:mode) { edit { set edit 1 } }
if {$tooltip(visible)} {
#puts "cx=$cx cy=$cy tooltip=($tooltip(mx),$tooltip(my),$tooltip(canvas),$tooltip(visible)"
--- 1507,1524 ----
proc canvas_motion {canvas x y mods state} {
#puts "canvas_motion::: $canvas $x $y $mods $state"
! canvas_motion2 [canvastosym $canvas] $x $y $mods $state
! statusbar_update [canvastosym $canvas] $x $y
}
#-----------------------------------------------------------------------------------#
! def canvas motion2 {x y mods state} {
global current_x current_y old_x old_y select_area mouse font
global tooltip _ dehighlight look wire_from wire_to
! #puts "canvas_motion2::: $x $y $mods $state"
! set canvas $self.c
! set cx [$canvas canvasx $x]; set @current_x $cx
! set cy [$canvas canvasy $y]; set @current_y $cy
! set edit 0; switch $@mode { edit { set edit 1 } }
if {$tooltip(visible)} {
#puts "cx=$cx cy=$cy tooltip=($tooltip(mx),$tooltip(my),$tooltip(canvas),$tooltip(visible)"
***************
*** 1531,1540 ****
$canvas coords lnew $l
}
! switch $_($self:action) {
move {
#pd "$self displace-selection [expr $cx-$old_x] [expr $cy-$old_y] ;\n"
# my move object code begins --chun
#puts "move objects by :: [expr $cx-$old_x] [expr $cy-$old_y]"
! foreach obj $_($self:selection) {
#puts "___ move object $obj ___"
set _($obj:cx) [expr $_($obj:cx) + $cx-$old_x]
--- 1542,1551 ----
$canvas coords lnew $l
}
! switch $@action {
move {
#pd "$self displace-selection [expr $cx-$old_x] [expr $cy-$old_y] ;\n"
# my move object code begins --chun
#puts "move objects by :: [expr $cx-$old_x] [expr $cy-$old_y]"
! foreach obj $@selection {
#puts "___ move object $obj ___"
set _($obj:cx) [expr $_($obj:cx) + $cx-$old_x]
***************
*** 1549,1553 ****
set text_pos [list [expr $_($obj:cx)+1] [expr $_($obj:cy)+1]]
set text_pos2 [list [expr $_($obj:cx)+2] [expr $_($obj:cy)+2]]
! if {$_($self:obj_in_edit)} {$canvas coords ${obj}text $text_pos}
$canvas coords ${obj}TEXT $text_pos2
}
--- 1560,1564 ----
set text_pos [list [expr $_($obj:cx)+1] [expr $_($obj:cy)+1]]
set text_pos2 [list [expr $_($obj:cx)+2] [expr $_($obj:cy)+2]]
! if {$@obj_in_edit} {$canvas coords ${obj}text $text_pos}
$canvas coords ${obj}TEXT $text_pos2
}
***************
*** 1558,1563 ****
}
#----handles the wire update----
! #set _($self:inlets) $ins
! #set _($self:outlets) $outs
for {set x 0} {$x<$_($obj:inlets)} {incr x} {
#if {[info exists]}
--- 1569,1574 ----
}
#----handles the wire update----
! #set @inlets $ins
! #set @outlets $outs
for {set x 0} {$x<$_($obj:inlets)} {incr x} {
#if {[info exists]}
***************
*** 1596,1601 ****
}
set run [expr !$edit]
! if {[string length $_($self:focus)]} {
! set id $_($self:focus)
if {$run} {
event $id motionevent $canvas $cx $cy $mods} {
--- 1607,1612 ----
}
set run [expr !$edit]
! if {[string length $@focus]} {
! set id $@focus
if {$run} {
event $id motionevent $canvas $cx $cy $mods} {
***************
*** 1655,1659 ****
}
}
! #puts "search clicked object: [lsearch $_($self:selection) $id]"
#puts "b1_down? $mouse(b1down)"
#puts "arghhhhhhhh"
--- 1666,1670 ----
}
}
! #puts "search clicked object: [lsearch $@selection $id]"
#puts "b1_down? $mouse(b1down)"
#puts "arghhhhhhhh"
***************
*** 1829,1833 ****
set old_obj [lindex $@selection 0]
if {$@select_by == "click"} {
! object_complete $old_obj $canvas
}
set @obj_in_edit 0
--- 1840,1844 ----
set old_obj [lindex $@selection 0]
if {$@select_by == "click"} {
! objectbox_complete $old_obj $canvas
}
set @obj_in_edit 0
***************
*** 1877,1881 ****
if {[info exists @obj_in_edit]} {
if {$@obj_in_edit > 0} {
! object_complete [lindex $@selection 0] $canvas
set @obj_in_edit 0
}
--- 1888,1892 ----
if {[info exists @obj_in_edit]} {
if {$@obj_in_edit > 0} {
! objectbox_complete [lindex $@selection 0] $canvas
set @obj_in_edit 0
}
***************
*** 2088,2109 ****
if {[llength $@selection]==1} {
#puts "___only one obj selected by click!!!"
-
#pd "$self gobj-activate x$@selection;"
#puts "____ selected by ->$@select_by ____"
-
if {$@select_by == "click"} {
-
switch $_($@selection:class) {
!
! objectbox {
! if {$@obj_in_edit == 0} {
! set @obj_in_edit 1
! object_edit [lindex $@selection 0] $canvas
! }
! }
!
}
}
! #object_edit $@edit_object $canvas
}
set edit 0; switch $@mode { edit { set edit 1 } }
--- 2099,2115 ----
if {[llength $@selection]==1} {
#puts "___only one obj selected by click!!!"
#pd "$self gobj-activate x$@selection;"
#puts "____ selected by ->$@select_by ____"
if {$@select_by == "click"} {
switch $_($@selection:class) {
! objectbox {
! if {$@obj_in_edit == 0} {
! set @obj_in_edit 1
! objectbox_edit [lindex $@selection 0] $canvas
! }
! }
}
}
! #objectbox_edit $@edit_object $canvas
}
set edit 0; switch $@mode { edit { set edit 1 } }
***************
*** 2190,2200 ****
#-----------------------------------------------------------------------------------#
! proc canvas_key {canvas x y key iso shift} {
# .controls.switches.meterbutton configure -text $key
#puts "canvas_key::: $canvas $x $y $key $iso $shift"
-
- global OS
- global _
- set self [canvastosym $canvas]
#hide_canvas_tooltip $canvas
switch $OS {
--- 2196,2204 ----
#-----------------------------------------------------------------------------------#
! def canvas key {x y key iso shift} {
! global OS
! set canvas $self.c
# .controls.switches.meterbutton configure -text $key
#puts "canvas_key::: $canvas $x $y $key $iso $shift"
#hide_canvas_tooltip $canvas
switch $OS {
***************
*** 2241,2245 ****
#-----------------------------------------------------------------------------------#
! proc canvas_keyup {canvas x y key iso shift} {
#puts "canvas_keyup::: $canvas $x $y $key $iso $shift"
--- 2245,2250 ----
#-----------------------------------------------------------------------------------#
! def canvas keyup {x y key iso shift} {
! set canvas $self.c
#puts "canvas_keyup::: $canvas $x $y $key $iso $shift"
More information about the Pd-cvs
mailing list