[PD-cvs] pd/src desire.tk,1.1.2.104,1.1.2.105
Mathieu Bouchard
matju at users.sourceforge.net
Sat Nov 5 14:47:13 CET 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18044
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
uh, whatever
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.104
retrieving revision 1.1.2.105
diff -C2 -d -r1.1.2.104 -r1.1.2.105
*** desire.tk 4 Nov 2005 02:15:30 -0000 1.1.2.104
--- desire.tk 5 Nov 2005 13:47:11 -0000 1.1.2.105
***************
*** 103,106 ****
--- 103,188 ----
#-----------------------------------------------------------------------------------#
+ # adapted from matju's MetaRuby (UndoQueue.rb)
+
+ class_new history
+
+ def history init {} {
+ set @undo {}
+ set @redo {}
+ }
+
+ # overload this if you want to control how many levels
+ # of undo may be kept.
+ # keep in mind that undo information is kept hierarchically.
+ def history add {message} {
+ @undo << message
+ @redo.clear
+ }
+
+ # runs the restore procedure for the last item in the root undo_queue.
+ def history undo {} {
+ begin {
+ set backup $@undo
+ set @undo $@redo
+ set @redo {}
+ perform backup.pop
+ } ensure {
+ set @redo $@undo
+ set @undo $backup
+ }
+ }
+
+ def history redo {} {
+ set backup $@redo
+ set @redo {}
+ perform backup.pop
+ set @redo $backup
+ }
+
+ # this traverses a tree and runs all the restore operations.
+ #!@#$ could I use #flatten! now ?
+ def history perform {mess} {
+ $self atomically {
+ if Array===mess {
+ mess.reverse_each{|x| perform x }
+ } {
+ mess.call
+ }
+ }
+ }
+
+ def history atomically {&proc} {
+ set ubackup @undo; set @undo {}
+ set rbackup @redo; set @redo {}
+ begin {
+ proc.call
+ } ensure {
+ lappend backup_undo $@undo_queue
+ set @undo_queue $ubackup
+ set @redo_queue $rbackup
+ }
+ }
+
+ class_new UndoFeature
+ # attr_accessor :undo_queue
+ # def initialize {args} { @undo = UndoQueue.new; super }
+ # this version of #modify atomicizes undo information;
+ # which means that all operations occurring during the #modify block
+ # will be undone by a single call to #undo.
+ # def modify(&proc); @undo_queue.atomically { super(&proc) }; end
+ # def undo; @undo_queue.undo; end
+ # def redo; @undo_queue.redo; end
+ #end
+
+ #class UndoableArray < AutoArray
+ # include UndoFeature
+ ## def initialize(n=0,v=nil); super; end
+ # def put(i,v) @undo_queue.add Message.new(self,:put,i,get(i)); super end
+ # def put_seq(i,n,v) @undo_queue.add Message.new(self,:put_seq,i,v.length,get_seq(i,n)); super end
+ #end
+
+ set history [history_new]
+
+ #-----------------------------------------------------------------------------------#
# this is the beginning of the more application-dependent part.
***************
*** 299,304 ****
set cmd [gets $sock]
if {[eof $sock]} {
- #tk_messageBox -message "my sock puppet disappeared (ah, the great mysteries of the washingmachine). Well, that's all, folks!" -type ok
- #exit 42
tk_messageBox -message "server gone boom" -type ok
set sock {}
--- 381,384 ----
***************
*** 514,518 ****
set font(pady) 3
set font(padx) 5
- set mouse(b1down) 0
#-----------------------------------------------------------------------------------#
set look(iowidth) 7
--- 594,597 ----
***************
*** 536,541 ****
default {list 1}}]
- set dehighlight {}
-
#-----------------------------------------------------------------------------------#
set pd_apilist "{ALSA 1}"
--- 615,618 ----
***************
*** 579,583 ****
def* view motionedit {args} {}
def view selected? {} {return $@selected?}
! def view selected?= {x} {set @selected? $x}
def* view select {state} {
--- 656,660 ----
def* view motionedit {args} {}
def view selected? {} {return $@selected?}
! def view selected?= {x} {set @selected? $x; $self changed}
def* view select {state} {
***************
*** 793,796 ****
--- 870,874 ----
set @children {}
set @obj_in_edit {}
+ set @dehighlight {}
global manager
post %s "canvas init: subscribing to $manager"
***************
*** 936,968 ****
# correct edit menu, enabling or disabling undo/redo
# LATER also cut/copy/paste
! proc menu_fixeditmenu {name} {
! return
! global pd_undoaction pd_redoaction pd_undocanvas
! set e $name.m.edit
! if {$name == $pd_undocanvas && $pd_undoaction != "no"} {
! $e entryconfigure "Undo*" -state normal -label "Undo $pd_undoaction"
} else {
! $e entryconfigure "Undo*" -state disabled -label "Undo"
}
! if {$name == $pd_undocanvas && $pd_redoaction != "no"} {
! $e entryconfigure "Redo*" -state normal -label "Redo $pd_redoaction"
} else {
! $e entryconfigure "Redo*" -state disabled
}
}
#-----------------------------------------------------------------------------------#
-
- # message from Pd to update the currently available undo/redo action
- proc pdtk_undomenu {name undoaction redoaction} {
- return
- global pd_undoaction pd_redoaction pd_undocanvas
- set pd_undocanvas $name
- set pd_undoaction $undoaction
- set pd_redoaction $redoaction
- if {$name != "nobody"} {menu_fixeditmenu $name}
- }
-
- #-----------------------------------------------------------------------------------#
def* canvas ctrlkey {key shift} {
global accels focus
--- 1014,1032 ----
# correct edit menu, enabling or disabling undo/redo
# LATER also cut/copy/paste
! def canvas fix_edit_menu {} {
! set e .x$self.m.edit
! if {$name==$@undocanvas && $@undoaction!="no"} {
! $e entryconfigure "Undo*" -state normal -label "Undo $@undoaction"
} else {
! $e entryconfigure "Undo*" -state disabled -label "Can't Undo"
}
! if {$name==$@undocanvas && $@redoaction!="no"} {
! $e entryconfigure "Redo*" -state normal -label "Redo $@redoaction"
} else {
! $e entryconfigure "Redo*" -state disabled -label "Can't Redo"
}
}
#-----------------------------------------------------------------------------------#
def* canvas ctrlkey {key shift} {
global accels focus
***************
*** 1203,1207 ****
set t $c.${self}text
set @text [$t get 1.0 1.end]
! $c delete ${self}text ${self}BASE ${self}BASE2 ${self}BASE3
after 1 "destroy $t"
set l {}
--- 1267,1271 ----
set t $c.${self}text
set @text [$t get 1.0 1.end]
! $self erase
after 1 "destroy $t"
set l {}
***************
*** 1212,1221 ****
def objectbox complete2 {} {
- global fonttext_setto
- # why?
- set @selected? 0
- $self erase
- $self update_size
- $self draw
for {set x 0} {$x<$@ninlets} {incr x} {
if {[info exists _($self:i:$x)]} {
--- 1276,1279 ----
***************
*** 1228,1233 ****
}
}
- mset cx cy [$self xy]
- text_new $self [expr $cx+2] [expr $cy+2] $obj_name $font(size) #000000
}
--- 1286,1289 ----
***************
*** 1236,1243 ****
}
- def objectbox clickedit {args} {
- puts "$self is being clicked in edit mode"
- }
-
def objectbox unclick {args} {
puts "$self is being unclicked in run mode"
--- 1292,1295 ----
***************
*** 1247,1250 ****
--- 1299,1303 ----
puts "$self is being unclicked in [lindex $args 0] edit mode"
$self edit
+ #objectbox_edit
}
***************
*** 1290,1298 ****
set dead [lwithout $@children $children]; post %s "DEAD: $dead"
foreach x $born {$x subscribe $self; $x changed; $x canvas= $self}
! foreach x $dead {$x unsubscribe $self}
set @children $children
$self changed
}
def* canvas add {obj} {
set i [lsearch $@children $obj]
--- 1343,1353 ----
set dead [lwithout $@children $children]; post %s "DEAD: $dead"
foreach x $born {$x subscribe $self; $x changed; $x canvas= $self}
! foreach x $dead {$x unsubscribe $self; $x erase}
set @children $children
$self changed
}
+ def canvas children_index {child} {lindex $@children $child}
+
def* canvas add {obj} {
set i [lsearch $@children $obj]
***************
*** 1324,1331 ****
def view move {dx dy} {
! mset x y [$self xy]
set @x1 [expr $@x1+$dx]
set @y1 [expr $@y1+$dy]
! mset u v [$self xy]
.x$@canvas.c move $self [expr $u-$x] [expr $v-$y]
}
--- 1379,1386 ----
def view move {dx dy} {
! mset {x y} [$self xy]
set @x1 [expr $@x1+$dx]
set @y1 [expr $@y1+$dy]
! mset {u v} [$self xy]
.x$@canvas.c move $self [expr $u-$x] [expr $v-$y]
}
***************
*** 1336,1340 ****
mset {cx cy} [$self xy]
set c .x$@canvas.c
! set ports 0; catch {set ports $@ninlets}
if {$ports==0} return
set port [expr int(($x-$cx)*$ports/$@xs)]
--- 1391,1395 ----
mset {cx cy} [$self xy]
set c .x$@canvas.c
! set ports 0; catch {switch $type {i {set ports $@ninlets} o {set ports $@noutlets}}}
if {$ports==0} return
set port [expr int(($x-$cx)*$ports/$@xs)]
***************
*** 1350,1355 ****
def canvas motion {x y mods state} {
! global mouse font
! global tooltip dehighlight look
set c .x$self.c
set x [$c canvasx $x]
--- 1405,1410 ----
def canvas motion {x y mods state} {
! global font
! global tooltip look
set c .x$self.c
set x [$c canvasx $x]
***************
*** 1360,1365 ****
}
}
! eval $dehighlight
! set dehighlight {}
# backup values
set ox $@current_x; set @current_x $x
--- 1415,1420 ----
}
}
! eval $@dehighlight
! set @dehighlight {}
# backup values
set ox $@current_x; set @current_x $x
***************
*** 1377,1381 ****
switch $@action {
move {
! foreach obj $@selection {$obj move $self [expr $x-$ox] [expr $y-$oy]}
return
}
--- 1432,1436 ----
switch $@action {
move {
! foreach obj $@selection {$obj move [expr $x-$ox] [expr $y-$oy]}
return
}
***************
*** 1396,1405 ****
object {
if {$@editmode} {set event motionedit} {set event motion}
! $id $event $self $x $y $mods
if {$@editmode && [llength [$id bbox]]} {
mset {x1 y1 x2 y2} [$id bbox]
if {abs($y1+3-$y)<=3} {
set port [$id hilite_io i $x $y]
! set dehighlight "$c delete ${id}i${port}b; set wire_to {}"
set wire_to [list $id $port]
return
--- 1451,1460 ----
object {
if {$@editmode} {set event motionedit} {set event motion}
! $id $event $x $y $mods
if {$@editmode && [llength [$id bbox]]} {
mset {x1 y1 x2 y2} [$id bbox]
if {abs($y1+3-$y)<=3} {
set port [$id hilite_io i $x $y]
! set @dehighlight "$c delete ${id}i${port}b; set wire_to {}"
set wire_to [list $id $port]
return
***************
*** 1407,1411 ****
if {abs($y2-3-$y)<=3} {
set port [$id hilite_io o $x $y]
! set dehighlight "$c delete ${id}o${port}b"
return
}
--- 1462,1466 ----
if {abs($y2-3-$y)<=3} {
set port [$id hilite_io o $x $y]
! set @dehighlight "$c delete ${id}o${port}b"
return
}
***************
*** 1492,1553 ****
#-----------------------------------------------------------------------------------#
! # this proc is too long, should be cut in several parts --matju
! # agree, but could i do this a bit later? --chun
!
! def* canvas click_on_object {x y b f id} {
! global look
! set c .x$self.c
! set run [expr $@editmode || ($f&2)]
! if {[string length $@focus]} {set gid $@focus}
! if {$f&8} {
! set @rclick_object $id
! } else {
! if {$run} {set event click} {set event clickedit}
! $id $event $self $x $y $b $f
! }
! if {!($f&8) && $@editmode && [llength [$id bbox]]} {
! #$self start_wire
! mset {x1 y1 x2 y2} [$id bbox]
! if {abs($y2-3-$y)<=3} {
! set outs 0
! catch {set outs $_($id:noutlets)}
! if {$outs} {
! set out [expr int(($x-$x1)*$outs/($x2-$x1))]
! mset {ox1 oy1 ox2 oy2} [$c bbox ${id}o${out}]
! $c create line $x $y $x $y -dash {4 4 4 4} -tags lnew
! set @wire_from [list $id $out]
! return
! }
! }
! set already [expr [lsearch $@selection $id]>=0]
! #if selection only contains one object and has already been selected,
! #allow it to turn into edit mode.
! if {[llength $@selection]==1 && $already} {set @select_by "click"}
! if {($f&1) && !$already} {
! pd $self select-object x$id
! } elseif {!$already} {
! # may need to call canvas_select_object here to work out
! # the shift+click selection
! if {[llength $@selection] == 1} {
! #puts "____complete [lindex $@selection 0] first!____"
! set @old_obj [lindex $@selection 0]
! if {$@select_by == "click"} {$old_obj unedit}
! set @obj_in_edit {}
! }
! if {[llength $@selection] > 0} {
! foreach obj $@selection {
! $c itemconfigure ${obj}BASE -outline $look(objectframe3)
! }
! #set @selection {}
! }
! set @selection {}
! set @selection [linsert $@selection 0 $id]
! foreach obj $@selection {
! $c itemconfigure ${obj}BASE -outline $look(objectframe4)
! }
! set @select_by "click"
! }
! set @action move
! }
}
--- 1547,1551 ----
#-----------------------------------------------------------------------------------#
! def* objectbox clickedit {x y b f id} {
}
***************
*** 1563,1598 ****
}
def* canvas clickedit {x y b f} {
! if {[llength $@obj_in_edit]} {
! #puts "and some object is in edit -> $@obj_in_edit in $self"
! #[lindex $@selection 0] unedit
! $@obj_in_edit unedit
! set @obj_in_edit {}
}
- # if {[llength $@selection] > 0} {
- # foreach obj $@selection {$c itemconfigure ${obj}BASE -outline $look(objectframe3)}
- # set @selection {}
- # }
- # if {[llength $@selection_wire] > 0} {
- # foreach wire $@selection_wire {$c itemconfigure $wire -fill $look(wirefg)}
- # set @selection_wire {}
- # }
- focus .x$self.c
- set @action rect
- .x$self.c create line $x $y $x $y $x $y $x $y $x $y -tags {selrect1 selrect} -fill black -dash {3 3 3 3} -dashoffset 3
}
def* canvas click {x y b f} {
! global mouse look focus
set c .x$self.c
set x [$c canvasx $x]
set y [$c canvasy $y]
set @select_area [list $x $y $x $y]
! set mouse(b1down) 1
mset {type id} [$self identify_target $x $y $b $f "click"]
switch $type {
! # object {$self click_on_object $x $y $b $f $id}
! # wire {$self click_on_wire $x $y $b $f $id}
! default {if {$@editmode} {$self clickedit $x $y $b $f}}
}
}
--- 1561,1634 ----
}
+ def canvas select_all {} {
+ foreach o $@children {$o selected?= 0}
+ set @selection $@children
+ }
+
+ def canvas deselect_all {} {
+ foreach o $@selection {$o selected?= 0}
+ set @selection {}
+ }
+
def* canvas clickedit {x y b f} {
! set c .x[$self canvas].c
! mset {type id} [$self identify_target $x $y $b $f "click"]
! if {$f&8} {post "right click!"; return}
! if {![llength $id]} {
! $self deselect_all
! set @action rect
! $c create line $x $y $x $y $x $y $x $y $x $y \
! -tags {selrect1 selrect} -fill black -dash {3 3 3 3} -dashoffset 3
! return
! }
! if {[llength $@obj_in_edit]} {$@obj_in_edit unedit; set @obj_in_edit {}}
! set in_selection [expr [lsearch $@selection $id]>=0]
! if {[llength $@selection]==1 && $in_selection} {set @select_by click; $x edit; return}
! if {[llength $@selection]} {
! foreach o $@selection {$o selected?= 0}
! set @selection {}
! }
! mset {x1 y1 x2 y2} [$id bbox]
! set outs 0; catch {set outs $id noutlets}
! if {abs($y2-3-$y)<=3 && $outs} {
! set out [expr int(($x-$x1)*$outs/($x2-$x1))]
! $c create line $x $y $x $y -dash {4 4 4 4} -tags lnew
! set @clickon [list outlet $self $out]
! set @action wire
! return
! }
! switch $type {
! object {$id clickedit $x $y $b $f $id}
! wire {$id clickedit $x $y $b $f $id}
! default {error BORK}
! }
! if {($f&1) && !$already} {post "add to selection?"; return}
! if {!$in_selection} {
! if {[llength $@selection] == 1} {
! set @old_obj [lindex $@selection 0]
! if {$@select_by == "click"} {$old_obj unedit}
! set @obj_in_edit {}
! }
! set @selection {}
! set @selection [linsert $@selection 0 $id]
! set @select_by click
! set @action move
}
}
def* canvas click {x y b f} {
! global look focus
set c .x$self.c
+ focus $c
set x [$c canvasx $x]
set y [$c canvasy $y]
set @select_area [list $x $y $x $y]
! if {$@editmode && !($f&2)} {$self clickedit $x $y $b $f}
mset {type id} [$self identify_target $x $y $b $f "click"]
+ if {![llength $id]} return
switch $type {
! object {$id click $x $y $b $f}
! wire {$id click $x $y $b $f}
! default {error BORK}
}
}
More information about the Pd-cvs
mailing list