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) } } } }