[PD-cvs] pd/src desire.tk,1.1.2.313,1.1.2.314

Mathieu Bouchard matju at users.sourceforge.net
Fri Aug 11 06:46:47 CEST 2006


Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5443

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
new code for Duplicate (Ctrl+D)
also, copy+paste work with IEMGUI again


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.313
retrieving revision 1.1.2.314
diff -C2 -d -r1.1.2.313 -r1.1.2.314
*** desire.tk	11 Aug 2006 02:08:21 -0000	1.1.2.313
--- desire.tk	11 Aug 2006 04:46:45 -0000	1.1.2.314
***************
*** 193,213 ****
  
  #-----------------------------------------------------------------------------------#
! # we might also use "man 3tk clipboard" in this specific case.
  
  # uses system clipboard
! class_new Clipboard {Observable Thing}
! def Clipboard init   {{value ""}} {super; $self value= $value}
! def Clipboard value= {value} {clipboard clear; clipboard append $value; $self changed}
! def Clipboard << {value}     {                 clipboard append $value; $self changed}
! def Clipboard value {} {clipboard get}
! set clipboard [Clipboard new]
  
  # uses string buffer (not system clipboard)
! class_new Clipboard2 {Observable Thing}
! def Clipboard2 init   {{value ""}} {super; $self value= $value}
  def Clipboard2 value= {value} {set    @value $value; $self changed}
  def Clipboard2 << {value}     {append @value $value; $self changed}
  def Clipboard2 value {} {return $@value}
  
  #-----------------------------------------------------------------------------------#
  # adapted from matju's MetaRuby (UndoQueue.rb)
--- 193,216 ----
  
  #-----------------------------------------------------------------------------------#
! # abstract class: subclass must def {value value= <<}
! class_new Clipboard {Observable Thing}
! def Clipboard init   {{value ""}} {super; $self value= $value; set @copy_count 0}
! def Clipboard copy_times= {c} {set @copy_count $c}
! def Clipboard copy_times {} {return $@copy_count}
  
  # uses system clipboard
! class_new Clipboard1 {Clipboard}
! def Clipboard1 value= {value} {clipboard clear; clipboard append $value; $self changed}
! def Clipboard1 << {value}     {                 clipboard append $value; $self changed}
! def Clipboard1 value {} {clipboard get}
  
  # uses string buffer (not system clipboard)
! class_new Clipboard2 {Clipboard}
  def Clipboard2 value= {value} {set    @value $value; $self changed}
  def Clipboard2 << {value}     {append @value $value; $self changed}
  def Clipboard2 value {} {return $@value}
  
+ set clipboard [Clipboard1 new]
+ 
  #-----------------------------------------------------------------------------------#
  # adapted from matju's MetaRuby (UndoQueue.rb)
***************
*** 944,952 ****
  
  # normally ninlets/noutlets should be in class "Box", but server-side isn't smart enough
! def View  ninlets= {v}   {set  @ninlets $v}
! def View noutlets= {v}   {set @noutlets $v}
! def View  ninlets {} {return  $@ninlets}
! def View noutlets {} {return $@noutlets}
! def View draw_wires {} {}
  def View init {} {
  	super
--- 947,957 ----
  
  # normally ninlets/noutlets should be in class "Box", but server-side isn't smart enough
! def View  pdclass= {v}    {set @pdclass $v}
! def View  pdclass  {} {return $@pdclass}
! def View  ninlets= {v}    {set  @ninlets $v}
! def View  ninlets  {} {return  $@ninlets}
! def View noutlets= {v}    {set @noutlets $v}
! def View noutlets  {} {return $@noutlets}
! 
  def View init {} {
  	super
***************
*** 971,986 ****
  	
  	
- 	#if {$suffix != "WIRE"} {
  	set find [lsearch $args "-width"]
  	if {$find >= 0} {
! 	set new_width [format %.0f [expr [lindex $args [expr $find+1]] * $_($@canvas:scale)]]
! 	set args [lreplace $args [expr $find + 1] [expr $find + 1] $new_width]
  	}
- 	#}
  	
  	if {$type == "text"} {
! 		set find [lsearch $args "-font"]
! 		set new_size [format %.0f [expr $font(size)*$_($@canvas:scale)]]
! 		set args [lreplace $args [expr $find + 1] [expr $find + 1] [format $font(str2) $new_size]]
  	}
  	
--- 976,993 ----
  	
  	
  	set find [lsearch $args "-width"]
  	if {$find >= 0} {
! 		set new_width [format %.0f [expr [lindex $args [expr $find+1]] * $_($@canvas:scale)]]
! 		set args [lreplace $args [expr $find + 1] [expr $find + 1] $new_width]
  	}
  	
  	if {$type == "text"} {
! 		if {$find >= 0} {
! 			set find [lsearch $args "-font"]
! 			post "View item find: $find"
! 			set new_size [format %.0f [expr $font(size)*$_($@canvas:scale)]]
! 			set s [format $font(str2) $new_size]
! 			set args [lreplace $args [expr $find + 1] [expr $find + 1] $s]
! 		}
  	}
  	
***************
*** 1181,1188 ****
      $self changed ;#$self draw
  }
  
! def Canvas getscroll {args} {}
! 
! def Canvas window {} {return .$self}
  
  #-----------------------------------------------------------------------------------#
--- 1188,1198 ----
      $self changed ;#$self draw
  }
+ def Canvas editmodeswitch {args} {
+     set @editmode [expr !$@editmode]
+     pd .$self editmode $@editmode
+ }
  
! def Canvas getscroll {args} {} ;# what's this for, again?
! def Canvas window {} {return .$self} ;# this method is called "widget" elsewhere...
  
  #-----------------------------------------------------------------------------------#
***************
*** 1329,1337 ****
      $self bind <Control-Shift-Key> ctrlkey %K 1
      $self bind <Alt-Key>           altkey  %K %A 0
!     $self bind <Alt-Shift-Key>           altkey  %K %A 1
      switch $OS {
        unix {
! 	$self bind <Mod1-Key>      altkey %K %A 0
! 	$self bind <Mod4-Key>      altkey %K %A
        }
        osx {
--- 1339,1349 ----
      $self bind <Control-Shift-Key> ctrlkey %K 1
      $self bind <Alt-Key>           altkey  %K %A 0
!     $self bind <Alt-Shift-Key>     altkey  %K %A 1
      switch $OS {
        unix {
! 	$self bind <Mod1-Key>       altkey %K %A 0
! 	$self bind <Mod1-Shift-Key> altkey %K %A 1
! 	$self bind <Mod4-Key>       altkey %K %A 0
! 	$self bind <Mod4-Shift-Key> altkey %K %A 1
        }
        osx {
***************
*** 1346,1355 ****
      $self bind <Motion>     motion %x %y 0 %s
      $self bind <Alt-Motion> motion %x %y 4 %s
! 
! # other (future use)
! #   $self bind <Map>        map
! #   $self bind <Unmap>      unmap
  }
  
  def Canvas scroll {axis diff} {.$self.c [list $axis]view scroll $diff units}
  def Canvas reload {} {pd ".$self map 0; .$self map 1"}
--- 1358,1368 ----
      $self bind <Motion>     motion %x %y 0 %s
      $self bind <Alt-Motion> motion %x %y 4 %s
!     $self bind <Map>        map
!     $self bind <Unmap>      unmap
  }
  
+ def* Canvas   map {} {}
+ def* Canvas unmap {} {}
+ 
  def Canvas scroll {axis diff} {.$self.c [list $axis]view scroll $diff units}
  def Canvas reload {} {pd ".$self map 0; .$self map 1"}
***************
*** 1429,1437 ****
  }
  
- def Canvas editmodeswitch {args} {
-     set @editmode [expr !$@editmode]
-     pd .$self editmode $@editmode
- }
- 
  # corrects edit menu, enabling or disabling undo/redo
  # LATER also cut/copy/paste
--- 1442,1445 ----
***************
*** 1484,1488 ****
  #-----------------------------------------------------------------------------------#
  # wtf is this supposed to be, again?
! class_new io {ganymeda}
  
  def io draw/2 {which n y} {
--- 1492,1496 ----
  #-----------------------------------------------------------------------------------#
  # wtf is this supposed to be, again?
! class_new io {ganymeda} ;# kill me
  
  def io draw/2 {which n y} {
***************
*** 1530,1534 ****
  def TextBox text {} {return $text}
  
! def* TextBox draw {} {
      $self update_size
      # TEXT = the text label
--- 1538,1542 ----
  def TextBox text {} {return $text}
  
! def TextBox draw {} {
      $self update_size
      # TEXT = the text label
***************
*** 1662,1666 ****
  class_new ObjectBox {TextBox}
  
! def* ObjectBox init {args} {
  	super
  	set @valid 0
--- 1670,1674 ----
  class_new ObjectBox {TextBox}
  
! def ObjectBox init {args} {
  	super
  	set @valid 0
***************
*** 1697,1701 ****
  }
  
! def* ObjectBox draw {} {
  	super
          io_draw $self
--- 1705,1709 ----
  }
  
! def ObjectBox draw {} {
  	super
          io_draw $self
***************
*** 1797,1801 ****
  		lappend @wires_pair $new_wire
  		lappend wires $new_wire
! 		} else {puts "$obj1 or $obj2 not been born yet....."; set @unborn_wire [lappend @unborn_wire $x]}
  	   } else {
  	    # wire already exist
--- 1805,1811 ----
  		lappend @wires_pair $new_wire
  		lappend wires $new_wire
! 	   } else {
! 		puts "$obj1 or $obj2 not born yet"
! 		set @unborn_wire [lappend @unborn_wire $x]}
  	   } else {
  	    # wire already exist
***************
*** 2051,2054 ****
--- 2061,2065 ----
  
  def StatusBar draw {x y} {
+     if {$x == "??"} {post "StatusBar WTF?"; return}
      set c .$@canvas.c
      set f [$self widget]
***************
*** 2111,2116 ****
  	#$clipboard value= [$self deconstruct]
  	$clipboard value= ""
! 	#$clipboard canvas= $self
! 	#$clipboard copy_times= 0
  	array unset obj_index_sel $self:*
  	foreach child $@selection {
--- 2122,2126 ----
  	#$clipboard value= [$self deconstruct]
  	$clipboard value= ""
! 	$clipboard copy_times= 0
  	array unset obj_index_sel $self:*
  	foreach child $@selection {
***************
*** 2783,2787 ****
  def* Box connect_out {} {}
  def* Box connect_in {} {}
! def Box draw {} {$self draw_box}
  def Box draw_box {} {}
  def* Box edit {} {}
--- 2793,2801 ----
  def* Box connect_out {} {}
  def* Box connect_in {} {}
! def Box draw {} {
! 	#set text "[$@canvas index $self]: "
! 	#$self item ID text [$self xy] -fill [look objectfg] -anchor ne -text $text
! 	$self draw_box
! }
  def Box draw_box {} {}
  def* Box edit {} {}
***************
*** 3026,3049 ****
  set fields(symbolatom) {foo bar x1 y1 w min max pos lab snd rcv}
  
! #             @pdclass {@_class}
! set classinfo(obj)     ObjectBox
! set classinfo(msg)     MessageBox
! set classinfo(tgl)     Toggle
! set classinfo(bng)     Bang
! set classinfo(nbx)     NumBox
! set classinfo(hsl)     Slider
! set classinfo(vsl)     Slider
! set classinfo(vu)      Vu
! set classinfo(dropper) Dropper
! set classinfo(hradio)  Radio
! set classinfo(vradio)  Radio
! set classinfo(hdl)     Radio
! set classinfo(vdl)     Radio
! set classinfo(canvas)  Canvas
! set classinfo(cnv)     Cnv
! #set classinfo(comment)       Comment
! set classinfo(text)          Comment
! set classinfo(floatatom)   FloatAtom
! set classinfo(symbolatom) SymbolAtom
  #
  # a hack to get around the file loading process
--- 3040,3069 ----
  set fields(symbolatom) {foo bar x1 y1 w min max pos lab snd rcv}
  
! proc classinfo {pdclass _class} {
! 	global classinfo classinfo2
! 	set classinfo($pdclass) $_class
! 	set classinfo2($_class) $pdclass
! }
! 
! classinfo obj        ObjectBox
! classinfo msg        MessageBox
! classinfo floatatom  FloatAtom
! classinfo symbolatom SymbolAtom
! classinfo text       Comment
! 
! classinfo bng      Bang
! classinfo tgl      Toggle
! classinfo nbx      NumBox
! classinfo hsl      Slider
! classinfo vsl      Slider
! classinfo vu       Vu
! classinfo dropper  Dropper
! classinfo hradio   Radio
! classinfo vradio   Radio
! classinfo hdl      Radio
! classinfo vdl      Radio
! classinfo canvas   Canvas
! classinfo cnv      Cnv
! 
  #
  # a hack to get around the file loading process
***************
*** 3086,3091 ****
  	if {$isnew} {$_class new_as $self}
  	$self position= [lrange $mess 2 3]
! 	$self canvas= $canvas(current)
! 	$self ninlets= $ninlets
  	$self noutlets= $noutlets
  	switch -- $class {
--- 3106,3112 ----
  	if {$isnew} {$_class new_as $self}
  	$self position= [lrange $mess 2 3]
! 	$self   canvas= $canvas(current)
! 	$self  pdclass= $class
! 	$self  ninlets= $ninlets
  	$self noutlets= $noutlets
  	switch -- $class {
***************
*** 3098,3102 ****
  			set _($self:$f) [lindex $mess $i]; incr i}}
  	}
- 	if {$isnew} {update_object_2 $self $mess}
  	if {[info exists canvas(msg_isnew)]} {
  		set _($self:isnew) 1
--- 3119,3122 ----
***************
*** 3119,3158 ****
  }
  
- # proc for handling object duplication.
- # shouldn't be needed (please replace this by something more solid)
- # instead it should get some help from the server to keep track of the objects
- proc update_object_2 {self e} {
- 	global canvas clipboard _
- 	set c $canvas(current)
- 	if {$_($c:duplicating)} {
- 		$self selected?= 1
- 		lappend _($c:selection) $self
- 		set test [lsearch $_($c:children) $self]
- 		if {$test <0} {
- 			puts "oops..... $self is not in children!!!!!!!!!!!!!!!!!!!"
- 			$self subscribe $c
- 			$self canvas= $c
- 			#$self ninlets= $ninlets
- 			#$self noutlets= $noutlets
- 			lappend _($c:children) $self
- 		}
- 		
- 		if {[llength $_($c:selection)] == [llength $canvas(dup_orig)]} {
- 			$c duplicate_wire
- 		}
- 	}
- 	if {[info exists clipboard(copying)]} {
- 		if {$clipboard(copying)} {
- 		puts "copying stuff................ $self"
- 		$self selected?= 1
- 		lappend _($c:selection) $self
- 		lappend clipboard(copied_obj) $self
- 			if {[llength $clipboard(objs)] == [llength $clipboard(copied_obj)]} {
- 				$c paste_wires
- 			}
- 		}
- 	}
- }
- 
  # proc for treating race conditions
  # shouldn't be needed (please replace this by something more solid)
--- 3139,3142 ----
***************
*** 3257,3268 ****
  
  def* AtomBox draw {} {
- 	global font
  	super
- 
  	mset {x1 y1} [$self xy]
- 	set xs [expr 4+10*$@w]
- 	set ys $font(height)
  	if {[$self selected?]} {set fcol red} else {set fcol [look objectfg]}
! 	if {[string length $@val] <= $@w} { 
  		set string $@text
  	} else {
--- 3241,3248 ----
  
  def* AtomBox draw {} {
  	super
  	mset {x1 y1} [$self xy]
  	if {[$self selected?]} {set fcol red} else {set fcol [look objectfg]}
! 	if {[string length $@val] <= $@w} {
  		set string $@text
  	} else {
***************
*** 3274,3281 ****
  class_new Comment {TextBox}
  
- def* Comment init {} {
- 	super
- }
- 
  def Comment draw_box {} {
  	super
--- 3254,3257 ----
***************
*** 3295,3299 ****
  #class_new BlueBox {Box Labeled}
  
! def* BlueBox draw_box {} {
  	super
  	set xya [$self bbox]
--- 3271,3275 ----
  #class_new BlueBox {Box Labeled}
  
! def BlueBox draw_box {} {
  	super
  	set xya [$self bbox]
***************
*** 4744,4750 ****
  		after 500 $self test_focus
  		puts "focus is:   [focus] || viewable: [winfo viewable .$self]"
- 		
- 		}
  	}
  
  def* ClassBrowser tab {textbox} {
--- 4720,4725 ----
  		after 500 $self test_focus
  		puts "focus is:   [focus] || viewable: [winfo viewable .$self]"
  	}
+ }
  
  def* ClassBrowser tab {textbox} {
***************
*** 5545,5549 ****
    key select_all
    key {reload redraw}
!   key editmodeswitch 
   subsection general
    key Pdwindow 
--- 5520,5524 ----
    key select_all
    key {reload redraw}
!   key editmodeswitch
   subsection general
    key Pdwindow 
***************
*** 5881,5888 ****
  }
  
- def  ObjectBox deconstruct {} {concat [list #X obj  $@x1 $@y1] $@text}
  def MessageBox deconstruct {} {concat [list #X msg  $@x1 $@y1] $@text}
  def Comment    deconstruct {} {concat [list #X text $@x1 $@y1] $@text}
  
  def* View deconstruct_to {stream args} {
  	$stream << [eval [concat [list $self deconstruct] $args]]
--- 5856,5875 ----
  }
  
  def MessageBox deconstruct {} {concat [list #X msg  $@x1 $@y1] $@text}
  def Comment    deconstruct {} {concat [list #X text $@x1 $@y1] $@text}
  
+ def Box deconstruct {} {
+ 	global fields
+ 	if {[array names fields $@pdclass] == ""} {
+ 		return [concat [list #X obj  $@x1 $@y1] $@text]
+ 	} {
+ 		set r {}
+ 		foreach field $fields($@pdclass) {lappend r $_($self:$field)}
+ 		puts "Box deconstruct: fields=$fields($@pdclass)"
+ 		puts "Box deconstruct: r=$r"
+ 		return $r
+ 	}
+ }
+ 
  def* View deconstruct_to {stream args} {
  	$stream << [eval [concat [list $self deconstruct] $args]]





More information about the Pd-cvs mailing list