[PD-cvs] pd/src desire.tk,1.1.2.35,1.1.2.36
Mathieu Bouchard
matju at users.sourceforge.net
Sat Sep 10 10:26:48 CEST 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22347
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
whatever
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.35
retrieving revision 1.1.2.36
diff -C2 -d -r1.1.2.35 -r1.1.2.36
*** desire.tk 6 Sep 2005 11:37:52 -0000 1.1.2.35
--- desire.tk 10 Sep 2005 08:26:46 -0000 1.1.2.36
***************
*** 13,17 ****
# (thanks for taking time looking at this code)
#-----------------------------------------------------------------------------------#
! # This section is matju's object system
proc class_new {name body} {
--- 13,18 ----
# (thanks for taking time looking at this code)
#-----------------------------------------------------------------------------------#
! # This section is matju's object system (the base class is called base because
! # there's already something else called class)
proc class_new {name body} {
***************
*** 24,27 ****
--- 25,41 ----
}
+ rename unknown _original_unknown
+ proc unknown {args} {
+ global _
+ if {[catch {
+ set name $_($self:_class)_$selector
+ set self [lindex $args 0]
+ set selector [lindex $args 1]
+ uplevel 1 [linsert [concat [list $self] [lrange $args 2 end] 0 $selector]]
+ }]} {
+ uplevel 1 [linsert $args 0 _original_unknown]
+ }
+ }
+
#some questions to matju --chun
#
***************
*** 162,179 ****
for {set i 0} {$i < $argc} {incr i} {
! global cmdline
set o [lindex $argv $i]
switch -regexp -- $o {
! -console {
! incr i
! set cmdline(console) [lindex $argv $i]
! }
! -gdb {set cmdline(gdb) 1}
! -nogdb {set cmdline(gdb) 0}
! -* {puts "ERROR: command line argument: unknown $o"}
! default {
! incr i
! lappend files_to_open [lindex $argv $i]
! }
}
}
--- 176,187 ----
for {set i 0} {$i < $argc} {incr i} {
! global cmdline files_to_open
set o [lindex $argv $i]
switch -regexp -- $o {
! ^-console\$ {incr i; set cmdline(console) [lindex $argv $i]}
! ^-gdb\$ {set cmdline(gdb) 1}
! ^-nogdb\$ {set cmdline(gdb) 0}
! ^- {puts "ERROR: command line argument: unknown $o"}
! default {lappend files_to_open [lindex $argv $i]}
}
}
***************
*** 315,322 ****
poll_sock
global files_to_open
foreach f $files_to_open {
! set ff [file split $f]
set ffl [llength $ff]
! pd "pd open [lindex $ff [expr $ffl-1]] [file join [lrange $ff 0 [expr $ffl-2]]] ;"
}
} {
--- 323,335 ----
poll_sock
global files_to_open
+ post "files_to_open='$files_to_open'"
foreach f $files_to_open {
! set ff [file split [file normalize $f]]
set ffl [llength $ff]
! set file [lindex $ff [expr $ffl-1]]
! set dir [join [lrange $ff 0 [expr $ffl-2]] [file separator]]
! post "f='$f' ff='$ff' ffl='$ffl'"
! post "pd open $file $dir ;"
! pd "pd open $file $dir ;"
}
} {
***************
*** 513,517 ****
objectbox_draw $object_id $canvas.c \
[expr ($_($object_id:name_len)*$font(width)) + $font(padx)] \
! [expr $font(height) + $font(pady)] 1 3
pdtk_text_new \
--- 526,530 ----
objectbox_draw $object_id $canvas.c \
[expr ($_($object_id:name_len)*$font(width)) + $font(padx)] \
! [expr $font(height) + $font(pady)]
pdtk_text_new \
***************
*** 632,658 ****
#-----------------------------------------------------------------------------------#
proc populate_menu {menu context list} {
- #puts "__populate_menu::: $menu $context $list"
-
global accels
foreach e $list {
! switch -- [llength $e] {
! 0 {
! $menu add separator
! }
! 3 {
! set cmd [lindex $e 1]
! set accel [accel_munge [lindex $e 2]]
! if {$accel != ""} {set accels([string tolower $accel]) $cmd}
! regsub -all %W $cmd $context cmd
! $menu add command -label [lindex $e 0] -command $cmd \
! -accelerator $accel
! }
! 4 {
! set cmd [lindex $e 1]
! set accel [accel_munge [lindex $e 2]]
! if {$accel != ""} {set accels([string tolower $accel]) $cmd}
! regsub -all %W $cmd $context cmd
! $menu add checkbutton -label [lindex $e 0] -command $cmd \
! -accelerator $accel -indicatoron ???
}
}
--- 645,661 ----
#-----------------------------------------------------------------------------------#
proc populate_menu {menu context list} {
global accels
foreach e $list {
! if {[llength $e]==0} {$menu add separator} {
! set cmd [lindex $e 1]
! set accel [accel_munge [lindex $e 2]]
! regsub -all %W $cmd $context cmd
! if {$accel != ""} {set accels([string tolower $accel]) $cmd}
! if {[llength $e]==3} {
! $menu add command -label [lindex $e 0] -command $cmd \
! -accelerator $accel
! } { # 4
! $menu add checkbutton -label [lindex $e 0] -command $cmd \
! -accelerator $accel -indicatoron ???
}
}
***************
*** 693,697 ****
#-----------------------------------------------------------------------------------#
set look(iowidth) 7
! set look(iopos) 1
set look(objectfg) #000000
set look(objectbg) #ffffff
--- 696,700 ----
#-----------------------------------------------------------------------------------#
set look(iowidth) 7
! set look(iopos) 0
set look(objectfg) #000000
set look(objectbg) #ffffff
***************
*** 735,738 ****
--- 738,751 ----
}
#-----------------------------------------------------------------------------------#
+
+ proc menu_close {name} {pd "$name menuclose 0 ;"}
+ proc menu_save {name} {pdtk_canvas_checkgeometry $name; pd "$name menusave ;"}
+ proc menu_saveas {name} {pdtk_canvas_checkgeometry $name; pd "$name menusaveas ;"}
+ proc menu_print {name} {
+ set filename [tk_getSaveFile -initialfile pd.ps -defaultextension .ps \
+ -filetypes { {{postscript} {.ps}} }]
+ if {$filename != ""} {$name.c postscript -file $filename}
+ }
+
proc menu_addstd {mbar} {
puts "menu_addstd::: $mbar"
***************
*** 771,777 ****
{}
{Close {foo menu_close} "Ctrl+w"}
! {Save {foo menu_save} "Ctrl+s"}
! {"Save as..." {foo menu_saveas} "Ctrl+S"}
! {Print {foo menu_print} "Ctrl+p"}
{}
{Quit {foo menu_quit} "Ctrl+q"}
--- 784,790 ----
{}
{Close {foo menu_close} "Ctrl+w"}
! {Save {menu_save} "Ctrl+s"}
! {"Save as..." {menu_saveas} "Ctrl+S"}
! {Print {menu_print} "Ctrl+p"}
{}
{Quit {foo menu_quit} "Ctrl+q"}
***************
*** 1081,1089 ****
# for quit/save/undo
! #switch -- $key {
! # q {if {$shift} {menu_really_quit} else {menu_quit}; return}
! # s {if {$shift} {menu_saveas $topname} {menu_save $topname}; return}
! # z {if {$shift} {menu_redo $topname} else {menu_undo $topname}; return}
! #}
global accels
--- 1094,1102 ----
# for quit/save/undo
! switch -- $key {
! #q {if {$shift} {menu_really_quit} else {menu_quit}; return}
! s {if {$shift} {menu_saveas $topname} {menu_save $topname}; return}
! #z {if {$shift} {menu_redo $topname} else {menu_undo $topname}; return}
! }
global accels
***************
*** 1107,1110 ****
--- 1120,1124 ----
}
}
+
#-----------------------------------------------------------------------------------#
proc pdtk_canvas_altkey {name key iso} {
***************
*** 1122,1130 ****
}
}
- #-----------------------------------------------------------------------------------#
-
- proc foo {args} {
- puts " $args not there yet...."
- }
#-----------------------------------------------------------------------------------#
--- 1136,1139 ----
***************
*** 1141,1145 ****
#-----------------------------------------------------------------------------------#
def object xy {canvas} {
- puts "object_xy"
set canvas_id [canvastosym $canvas]
if {[info exists @cx]} {
--- 1150,1153 ----
***************
*** 1150,1172 ****
#don't delete these two lines
! set @cx $_($canvas_id:current_x)
! set @cy $_($canvas_id:current_y)
!
! #set @cx 40
! #set @cy 40
!
return [list $@cx $@cy]
}
}
! #-----------------------------------------------------------------------------------#
! def brokenbox draw {canvas xs ys ins outs} {
! puts "brokenbox_draw:: $self $canvas $xs $ys $ins $outs"
! objectbox_draw $self $canvas $xs $ys $ins $outs
! $canvas itemconfigure ${self}BASE -outline blue -width 3
}
! #-----------------------------------------------------------------------------------#
! def objectbox draw {canvas xs ys ins outs} {
! puts "objectbox_draw ::: $self $canvas $xs $ys $ins $outs"
global look
--- 1158,1183 ----
#don't delete these two lines
! set @cx 40; catch {set @cx $_($canvas_id:current_x)}
! set @cy 40; catch {set @cy $_($canvas_id:current_y)}
return [list $@cx $@cy]
}
}
!
! proc canvas_of {self} {
! global _
! return $_($self:canvas)
}
! def brokenbox draw {canvas} {
! puts "brokenbox_draw:: $self $canvas"
! $canvas itemconfigure ${self}BASE -width 1 -dash {8 8 8 8}
! }
!
! def objectbox draw {canvas} {
! set xs 42; catch {set xs $@xs}
! set ys 42; catch {set ys $@ys}
! set ins 2; catch {set ins $@nins}
! set outs 2; catch {set outs $@nouts}
! puts "objectbox_draw ::: $self $canvas"
global look
***************
*** 1304,1311 ****
set sx [expr ($font(width) * ($name_len+1) + $font(padx))]
set sy [expr $font(height) + $font(pady)]
if {[expr $@isnew == 1]} {
! brokenbox_draw $self $canvas $sx $sy 0 0
} {
! objectbox_draw $self $canvas $sx $sy 1 3
}
--- 1315,1324 ----
set sx [expr ($font(width) * ($name_len+1) + $font(padx))]
set sy [expr $font(height) + $font(pady)]
+ set @sx sx
+ set @sy sy
if {[expr $@isnew == 1]} {
! brokenbox_draw $self $canvas
} {
! objectbox_draw $self $canvas
}
***************
*** 1553,1591 ****
set _($obj:cx) [expr $_($obj:cx) + $cx-$old_x]
set _($obj:cy) [expr $_($obj:cy) + $cy-$old_y]
-
puts "**** class==> $_($obj:class) *****"
-
switch $_($obj:class) {
!
!
! textobj {
!
! puts "move textobj"
!
! objectbox_draw $obj $canvas \
! [expr ($_($obj:name_len)*$font(width)) + $font(padx)] \
! [expr $font(height) + $font(pady)] 1 3
!
! set text_pos [list [expr $_($obj:cx)+1] [expr $_($obj:cy)+1]]
! set text_pos2 [list [expr $_($obj:cx)+2] [expr $_($obj:cy)+2]]
!
! if {$_($self:obj_in_edit)} {$canvas coords ${obj}text $text_pos}
! $canvas coords ${obj}TEXT $text_pos2
!
!
! }
!
! bang {
!
! puts "move bang"
! bang_draw $obj $canvas
!
! }
!
!
}
-
-
-
#----handles the wire update----
#set _($self:inlets) $ins
--- 1566,1586 ----
set _($obj:cx) [expr $_($obj:cx) + $cx-$old_x]
set _($obj:cy) [expr $_($obj:cy) + $cy-$old_y]
puts "**** class==> $_($obj:class) *****"
switch $_($obj:class) {
! textobj {
! puts "move textobj"
! set $_($obj:sx) [expr ($_($obj:name_len)*$font(width)) + $font(padx)]
! set $_($obj:sy) [expr $font(height) + $font(pady)]
! objectbox_draw $obj $canvas
! set text_pos [list [expr $_($obj:cx)+1] [expr $_($obj:cy)+1]]
! set text_pos2 [list [expr $_($obj:cx)+2] [expr $_($obj:cy)+2]]
! if {$_($self:obj_in_edit)} {$canvas coords ${obj}text $text_pos}
! $canvas coords ${obj}TEXT $text_pos2
! }
! bang {
! puts "move bang"
! bang_draw $obj $canvas
! }
}
#----handles the wire update----
#set _($self:inlets) $ins
***************
*** 2463,2467 ****
#set fields(msg)
! set classinfo(obj) {Object object}
set classinfo(tgl) {Toggle toggle}
set classinfo(bng) {Bang bang}
--- 2458,2462 ----
#set fields(msg)
! set classinfo(obj) {Object objectbox}
set classinfo(tgl) {Toggle toggle}
set classinfo(bng) {Bang bang}
***************
*** 2479,2483 ****
proc call {sel self args} {
global _ classinfo
! set class [lindex $classinfo($_($self:class)) 1]
eval [linsert $args 0 ${class}_$sel $self]
}
--- 2474,2479 ----
proc call {sel self args} {
global _ classinfo
! set class objectbox
! catch {set class [lindex $classinfo($_($self:class)) 1]}
eval [linsert $args 0 ${class}_$sel $self]
}
More information about the Pd-cvs
mailing list