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]]