[PD-cvs] pd/src desire.tk,1.1.2.289,1.1.2.290
Mathieu Bouchard
matju at users.sourceforge.net
Mon Aug 7 09:42:43 CEST 2006
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27890
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
rewrote upload_object
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.289
retrieving revision 1.1.2.290
diff -C2 -d -r1.1.2.289 -r1.1.2.290
*** desire.tk 6 Aug 2006 21:19:16 -0000 1.1.2.289
--- desire.tk 7 Aug 2006 07:42:40 -0000 1.1.2.290
***************
*** 172,176 ****
lappend @q $origin
}
! post "Manager notice: queue length is now %d" [llength $@q]
}
--- 172,176 ----
lappend @q $origin
}
! #post "Manager notice: queue length is now %d" [llength $@q]
}
***************
*** 370,374 ****
}
}
! set cmdline(server) \"$cmdline(server)\"
switch -regexp -- $cmdline(lang) {
en|english|C {source locale/english.tcl}
--- 370,374 ----
}
}
! #set cmdline(server) \"$cmdline(server)\"
switch -regexp -- $cmdline(lang) {
en|english|C {source locale/english.tcl}
***************
*** 378,381 ****
--- 378,382 ----
es|espanol {source locale/espanol.tcl}
pt|portugues {source locale/portugues.tcl}
+ it|italiano {source locale/italiano.tcl}
nb|norsk|bokmal {source locale/bokmal.tcl}
default {error huh??? unknown lang (locale)}
***************
*** 555,558 ****
--- 556,562 ----
set sock_lobby {}
+ proc VTred {} {return "\x1b\[0;1;31m"}
+ proc VTgrey {} {return "\x1b\[0m"}
+
proc poll_sock {} {
global sock sock_lobby
***************
*** 573,577 ****
regsub -all " invoked from within\n" $errorInfo "" errorInfo
regsub -all "\n \\(" $errorInfo " (" errorInfo
! puts "Exception: errorCode=$errorCode; errorInfo=$errorInfo"
}
set sock_lobby {}
--- 577,581 ----
regsub -all " invoked from within\n" $errorInfo "" errorInfo
regsub -all "\n \\(" $errorInfo " (" errorInfo
! puts "[VTred]Exception:[VTgrey] errorCode=$errorCode; errorInfo=$errorInfo"
}
set sock_lobby {}
***************
*** 626,630 ****
set gdb [open "| gdb 2&>1" w+]
fconfigure $gdb -blocking 0 -buffering none
! puts $gdb "file $cmdline(server)"
puts $gdb "run -guiport $server_port"
flush $gdb
--- 630,634 ----
set gdb [open "| gdb 2&>1" w+]
fconfigure $gdb -blocking 0 -buffering none
! puts $gdb "file \"$cmdline(server)\"" ;# bad quoting, sorry
puts $gdb "run -guiport $server_port"
flush $gdb
***************
*** 1107,1111 ****
}
-
#-----------------------------------------------------------------------------------#
--- 1111,1114 ----
***************
*** 1113,1142 ****
def Canvas undo {} {$@history undo}
def Canvas redo {} {$@history redo}
! #{width 400} {height 300} {geometry +0+0} {editable 1}
! def* Canvas init {args} {
! super
global pd_opendir pd_tearoff OS cmdline canvas history manager
! set name .$self
! set c .$self.c
! toplevel $name -menu $name.m
! # turn buttonbar on/off
! if {[look buttonbar]} {pack [[ButtonBar new $self] widget] -side top -fill x -expand no}
! set @statusbar [StatusBar new $self]
! # turn statusbar on/off
! if {[look statusbar]} {pack [$@statusbar widget] -side bottom -fill x}
! pack [scrollbar $name.xscroll -command "$c xview" -orient horizontal] -side bottom -fill x
! pack [scrollbar $name.yscroll -command "$c yview" ] -side right -fill y
! pack [canvas $c -width $@w -height $@h -background white \
! -yscrollcommand "$name.yscroll set" \
! -xscrollcommand "$name.xscroll set" \
! -scrollregion [list 0 0 $@w $@h]] -side left -expand 1 -fill both
! wm minsize $name 1 1
! wm geometry $name +$@x+$@y
! #wtf?????
! $self editmode= $@editable
! $self new_menubar $@editable
! wm protocol $name WM_DELETE_WINDOW "$self close"
$self new_binds
- focus $c
set @action none
set @selection {}
--- 1116,1137 ----
def Canvas undo {} {$@history undo}
def Canvas redo {} {$@history redo}
!
! def* Canvas init {x1 y1 xs ys args} {
global pd_opendir pd_tearoff OS cmdline canvas history manager
! super
! # those four are not to be confused with other @variables of the same name.
! set @canvasx1 $x1
! set @canvasy1 $y1
! set @canvasxs $xs
! set @canvasys $ys
! switch [llength $args] {
! 1 {set @subpatch 0; mset {@fontsize} $args; set @name ""; set @mapped 1}
! 2 {set @subpatch 1; mset {@name @mapped} $args; set @fontsize "what?"}
! default {error "wrong number of arguments (expecting 5 or 6)"}
! }
! $self init_window
! $self editmode= 0
! $self new_menubar
$self new_binds
set @action none
set @selection {}
***************
*** 1164,1172 ****
$self canvas= $self
#not sure if init should be calling pd, but it fixes the editmode bug for now -chun
! pd $name editmode $@editmode
set @coords 0
set @jump 0
set @keynav_current 0
! set @keynav_next 0
}
--- 1159,1192 ----
$self canvas= $self
#not sure if init should be calling pd, but it fixes the editmode bug for now -chun
! pd .$self editmode $@editmode
set @coords 0
set @jump 0
set @keynav_current 0
! set @keynav_next 0
! }
!
! def Canvas reinit {x1 y1 xs ys args} {
! #ignore for now
! }
!
! def Canvas init_window {} {
! set win .$self
! set c .$self.c
! toplevel $win -menu $win.m
! # turn buttonbar on/off
! if {[look buttonbar]} {pack [[ButtonBar new $self] widget] -side top -fill x -expand no}
! set @statusbar [StatusBar new $self]
! # turn statusbar on/off
! if {[look statusbar]} {pack [$@statusbar widget] -side bottom -fill x}
! pack [scrollbar $win.xscroll -command "$c xview" -orient horizontal] -side bottom -fill x
! pack [scrollbar $win.yscroll -command "$c yview" ] -side right -fill y
! pack [canvas $c -width $@canvasxs -height $@canvasys -background white \
! -yscrollcommand "$win.yscroll set" \
! -xscrollcommand "$win.xscroll set" \
! -scrollregion [list 0 0 $@canvasxs $@canvasys]] -side left -expand 1 -fill both
! wm minsize $win 1 1
! wm geometry $win +$@canvasx1+$@canvasy1
! wm protocol $win WM_DELETE_WINDOW "$self close"
! focus $c
}
***************
*** 1273,1277 ****
def Canvas Array {} {$self editmode= 1; pd .x$self menuarray}
! def Canvas new_menubar {editable} {
set name .$self
global pd_opendir pd_tearoff OS cmdline key accels
--- 1293,1297 ----
def Canvas Array {} {$self editmode= 1; pd .x$self menuarray}
! def Canvas new_menubar {} {
set name .$self
global pd_opendir pd_tearoff OS cmdline key accels
***************
*** 1394,1397 ****
--- 1414,1420 ----
class_new TextBox {Box}
+ def TextBox text= {text} {set @text $text; $self update_size}
+ def TextBox text {} {return $text}
+
def* TextBox draw {} {
# TEXT = the text label
***************
*** 1748,1751 ****
--- 1771,1776 ----
}
+ def* View position= {xy1} {mset [list @x1 @y1] $xy1}
+
def View move {dx dy} {
mset {x y} [$self xy]
***************
*** 1953,1956 ****
--- 1978,1983 ----
$item selected?= 0
mset {x1 y1} [$item xy]
+ set x1 [expr $x1+15]
+ set y1 [expr $y1+15]
puts "dup class :::: $_($item:_class) :::: $_($item:class)"
***************
*** 1963,1970 ****
# not quite pretty, will rewrite when something better comes up
switch $_($item:_class) {
! FloatAtom {pd .$self floatatom [expr $x1 + 15] [expr $y1 +15] $_($item:text)}
! SymbolAtom {pd .$self symbolatom [expr $x1 + 15] [expr $y1 +15]}
! MessageBox {pd .$self msg [expr $x1 + 15] [expr $y1 +15] $_($item:text)}
! default {pd .$self obj [expr $x1 + 15] [expr $y1 +15] $name}
}
--- 1990,1997 ----
# not quite pretty, will rewrite when something better comes up
switch $_($item:_class) {
! FloatAtom {pd .$self floatatom $x1 $y1 $_($item:text)}
! SymbolAtom {pd .$self symbolatom $x1 $y1}
! MessageBox {pd .$self msg $x1 $y1 $item:text)}
! default {pd .$self obj $x1 $y1 $name}
}
***************
*** 2823,2828 ****
set fields(hdl) $fields(hradio)
set fields(vdl) $fields(hradio)
- #set fields(canvas) {name width height geometry editable}
- set fields(canvas) {foo bar x y w h editable}
set fields(msg) {foo bar x1 y1}
set fields(coords) {foo bar xfrom yfrom xto yto w h gop x1 y1}
--- 2850,2853 ----
***************
*** 2830,2851 ****
# @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(hradio) {Radio}
! set classinfo(vu) {Vu}
! set classinfo(dropper) {Dropper}
! set classinfo(vsl) $classinfo(hsl)
! set classinfo(vradio) $classinfo(hradio)
! set classinfo(hdl) $classinfo(hradio)
! set classinfo(vdl) $classinfo(hradio)
! set classinfo(canvas) {Canvas}
! set classinfo(cnv) {Cnv}
! set classinfo(comment) {Comment}
! set classinfo(floatatom) {FloatAtom}
! set classinfo(symbolatom) {SymbolAtom}
#
# a hack to get around the file loading process
--- 2855,2876 ----
# @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(hradio) Radio
! set classinfo(vu) Vu
! set classinfo(dropper) Dropper
! set classinfo(vsl) Slider
! set classinfo(vradio) Slider
! set classinfo(hdl) Radio
! set classinfo(vdl) Radio
! set classinfo(canvas) Canvas
! set classinfo(cnv) Cnv
! set classinfo(comment) Comment
! set classinfo(floatatom) FloatAtom
! set classinfo(symbolatom) SymbolAtom
#
# a hack to get around the file loading process
***************
*** 2853,3016 ****
set canvas(current) ""
! proc update_object {x e ninlets noutlets} {
! global _ fields classinfo canvas clipboard
! set findV [string first "#V" $e]
! set v ""
! set d ""
! if {$findV >= 0} {
! set d [string range $e 0 [expr $findV - 2]]
! set v [string range $e $findV end-1]
! set _($x:V) $v
} else {
! set d [string trimright $e "\n"]
! set d [string trimright $e ";"]
}
set i 1
! set class [lindex $d $i]
switch -- $class {
! canvas {set class $class; set canvas(current) $x}
! #canvas {set class $class}
! obj {set i 4; set class [lindex $d 4]}
}
!
! if {![info exists _($x:_class)]} {
! # new object
! if {[info exists classinfo($class)]} {
! set _($x:_class) [lindex $classinfo($class) 0]
! } {
! post BLEH
! set dlength [llength $d]
! if {$dlength == 4} {
! set _($x:isnew) 1
! set _($x:text) {}
! } else {
! set _($x:isnew) 0
! set _($x:text) [lrange $d 4 end]
! puts "_($x:text) : $_($x:text)"
! }
! set _($x:_class) ObjectBox
! }
! # duped here because some objs needs this properties before init
! if {![info exists fields($class)]} {set class obj}
! set i 0
! foreach f $fields($class) {
! set _($x:$f) [lindex $d $i]
! #puts "------> set $x:$f to [lindex $d $i] <------"
! incr i
! }
!
! if {$class == "msg"} {
! set _($x:text) [join [lrange $d 4 end]]
! set _($x:class) "msg"
! }
! if {$class == "floatatom"} {
! set _($x:text) [lindex $d 4]
! set _($x:class) "floatatom"
! }
! if {$class == "comment"} {
! set _($x:text) [join [lrange $d 4 end]]
! set _($x:class) "comment"
! }
! $x init
!
! if {$_($canvas(current):duplicating)} {
! #puts "duplicating stuff............ $x"
! $x selected?= 1
! lappend _($canvas(current):selection) $x
!
!
! set test [lsearch $_($canvas(current):children) $x]
if {$test <0} {
! #puts "$_($x:_class)"
! puts "oops..... $x is not in children!!!!!!!!!!!!!!!!!!!"
! $x subscribe $canvas(current)
! $x canvas= $canvas(current)
! $x ninlets= $ninlets
! $x noutlets= $noutlets
! lappend _($canvas(current):children) $x
! }
!
! if {[llength $_($canvas(current):selection)] == [llength $canvas(dup_orig)]} {
! #puts "############ dude, all done ##################"
! $canvas(current) duplicate_wire
}
}
!
! if {[info exists clipboard(copying)]} {
if {$clipboard(copying)} {
! puts "copying stuff................ $x"
! $x selected?= 1
! lappend _($canvas(current):selection) $x
! lappend clipboard(copied_obj) $x
if {[llength $clipboard(objs)] == [llength $clipboard(copied_obj)]} {
! $canvas(current) paste_wires
}
}
- }
- }
- switch -- _($x:_class) {
- ObjectBox {
- set _($x:text) [lrange $d $i end]
- set _($x:valid) 0
- $x update_size
- }
}
!
! if {![info exists fields($class)]} {set class obj}
! if {$class == "comment"} {set class comment}
!
! set i 0
! foreach f $fields($class) {
! set _($x:$f) [lindex $d $i]
! #puts "==== setting $x:$f to [lindex $d $i] ===="
! incr i
! }
! if {$class == "msg"} {set _($x:text) [join [lrange $d 4 end]]}
! if {[info exists canvas(msg_isnew)]} {
! #puts "_______ spanking new message ________"
! set _($x:isnew) 1
! $x selected?= 1
! unset canvas(msg_isnew)
! }
!
! #hack to get the file loading working, not sure if its a good solution
! #-------------------------------------------------------------
! set unborn_child [lsearch $_($canvas(current):unborn) $x]
if {$unborn_child > -1} {
! puts "subscribing unborn child:: $x"
! $x subscribe $canvas(current)
! $x canvas= $canvas(current)
! #calling the ninlets because when its called by the server, its too late...
! #so the $ninlets and $noutlets are added to the sys_vgui call in pd_upload...
! $x ninlets= $ninlets
! $x noutlets= $noutlets
! $x draw
! if {$unborn_child == [expr [llength $_($canvas(current):unborn)] - 1]} {
# when it reachs the last unborn child, its time to draw the wires
# the end of duplication
! puts "###### number of unborn child [llength $_($canvas(current):unborn)] ######"
! puts "###### they are :: $_($canvas(current):unborn) ######"
! puts "###### but we are now at :: $x ######"
! set _($canvas(current):unborn) ""
!
!
! if {[info exists _($canvas(current):unborn_wire)]} {
! puts "time to draw wires ----- $_($canvas(current):unborn_wire)"
! $canvas(current) wires= $_($canvas(current):unborn_wire)
! #set _($canvas(current):unborn_wire) ""
! unset _($canvas(current):unborn_wire)
}
-
}
}
- #-------------------------------------------------------------
- # maybe this $x changed should be changed, so that when loading a file, changed won't
- # call the drawing method twice...
- $x changed
-
-
}
--- 2878,3009 ----
set canvas(current) ""
! # remember, _($foo:$bar) notation should die
! # because objects ought to be autonomous.
! proc update_object {self e ninlets noutlets} {
! global _ fields classinfo canvas
! set isnew [expr ![info exists _($self:_class)]]
! foreach mess [split $e ";"] {
! switch -- [lindex $mess 0] {
! "#N" {
! post "#N: $mess"
! set class canvas
! if {$isnew} {
! eval [concat [list Canvas new_as $self] [lrange $mess 2 end]]
} else {
! eval [concat [list $self reinit] [lrange $mess 2 end]]
}
+ set canvas(current) $self
+ }
+ "#X" {
+ post "#X: $mess"
set i 1
! if {[lindex $mess 1] == "obj"} {set i 4}
! set class [lindex $mess $i]
! if {[info exists classinfo($class)]} {
! set _class [lindex $classinfo($class) 0]
! } {
! set class obj
! set _class ObjectBox
! set _($self:isnew) [expr [llength $mess] == 4]
! set _($self:valid) 0
! }
! if {$isnew} {$_class new_as $self}
! $self position= [lrange $mess 2 3]
! $self ninlets= $ninlets
! $self noutlets= $noutlets
switch -- $class {
! obj {$self text= [join [lrange $mess 4 end]]}
! msg {$self text= [join [lrange $mess 4 end]]}
! floatatom {$self text= [lindex $d 4]}
! symbolatom {$self text= [lindex $d 4]}
! text {$self text= [join [lrange $mess 4 end]]}
! default {$self text= [join [lrange $mess 4 end]];
! set i 0; foreach f $fields($class) {set _($self:$f) [lindex $d $i]; incr i}}
}
! if {$isnew} {update_object_2 $self $mess}
! if {[info exists canvas(msg_isnew)]} {
! set _($self:isnew) 1
! $self selected?= 1
! unset canvas(msg_isnew)
! }
! }
! "#V" {
! post "#V: $mess"
! }
! default {if {$mess != ""} {error "what you say? ($mess)"}}
! }
! }
! update_object_3 $self $mess
! #-------------------------------------------------------------
! # maybe this $self changed should be changed, so that when loading a file, changed won't
! # call the drawing method twice... -- chun
! # excuse me. why would it be called twice? -- matju
! $self changed
! }
! # 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)
! proc update_object_3 {self e} {
! global canvas _
! set c $canvas(current)
! set unborn_child [lsearch $_($c:unborn) $self]
if {$unborn_child > -1} {
! puts "subscribing unborn child:: $self"
! $self subscribe $c
! $self canvas= $c
! #calling the ninlets because when its called by the server, its too late...
! #so the $ninlets and $noutlets are added to the sys_vgui call in pd_upload...
! #$self ninlets= $ninlets
! #$self noutlets= $noutlets
! $self draw
! if {$unborn_child == [expr [llength $_($c:unborn)] - 1]} {
# when it reachs the last unborn child, its time to draw the wires
# the end of duplication
! puts "### at $self, [llength $_($c:unborn)] unborn children: $_($c:unborn)"
! set _($c:unborn) ""
! if {[info exists _($c:unborn_wire)]} {
! puts "time to draw wires ----- $_($c:unborn_wire)"
! $c wires= $_($c:unborn_wire)
! #set _($c:unborn_wire) ""
! unset _($c:unborn_wire)
}
}
}
}
More information about the Pd-cvs
mailing list