pd/src desire.tk,1.1.2.104,1.1.2.105 - Pd-cvs

5 Nov 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}
      }
  }