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 .$(a)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]]
