[PD-cvs] pd/src desire.tk,1.1.2.53,1.1.2.54
Mathieu Bouchard
matju at users.sourceforge.net
Wed Sep 14 09:53:15 CEST 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6971
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
stuff and such
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.53
retrieving revision 1.1.2.54
diff -C2 -d -r1.1.2.53 -r1.1.2.54
*** desire.tk 14 Sep 2005 06:04:42 -0000 1.1.2.53
--- desire.tk 14 Sep 2005 07:53:11 -0000 1.1.2.54
***************
*** 256,261 ****
proc pdtk_pd_meters {indb outdb inclip outclip} {
- #puts "pdtk_pd_meters::: $indb $outdb $inclip $outclip"
-
.controls.in.1.mtr coords m 0 0 $indb 0
.controls.out.1.mtr coords m 0 0 $outdb 0
--- 256,259 ----
***************
*** 418,433 ****
proc enquote {x} {
- puts "enquote::: $x"
set foo [string map {"," "" ";" "" "\"" ""} $x]
return [string map {" " "\\ " "{" "" "}" ""} $foo]
}
! proc pdtk_watchdog {} {
! puts "pdtk_watchdog:::"
! pd "pd ping ;"; after 2000 {pdtk_watchdog}
! }
proc pdtk_check {x message} {
- puts "pdtk_check::: $x $message"
set answer [tk_messageBox -message $x -type yesno -icon question]
switch -- $answer {yes {pd $message}}
--- 416,426 ----
proc enquote {x} {
set foo [string map {"," "" ";" "" "\"" ""} $x]
return [string map {" " "\\ " "{" "" "}" ""} $foo]
}
! proc pdtk_watchdog {} {pd "pd ping ;"; after 2000 {pdtk_watchdog}}
proc pdtk_check {x message} {
set answer [tk_messageBox -message $x -type yesno -icon question]
switch -- $answer {yes {pd $message}}
***************
*** 463,467 ****
proc menu_new {} {
- #puts "menu_new:::"
global untitled_number untitled_directory offset_canvas _
pd "pd filename Untitled-$untitled_number $untitled_directory ;"
--- 456,459 ----
***************
*** 473,477 ****
# set canvas_id .x$canvas_id
# set offset_canvas [expr $offset_canvas + 1]
- # puts "new canvas id -> $canvas_id"
# canvas_new $canvas_id 300 300 +[expr $offset_canvas*50]+[expr $offset_canvas*50] 1
set untitled_number [expr $untitled_number + 1]
--- 465,468 ----
***************
*** 480,485 ****
proc menu_open {} {
- #puts "menu_open:::"
-
global pd_opendir
set filename [tk_getOpenFile -defaultextension .pd \
--- 471,474 ----
***************
*** 490,495 ****
proc open_file {filename} {
- #puts "open_file $filename"
-
global pd_opendir offset_canvas_file offset_wire_file offset_obj_file _ font
global wire_from wire_to
--- 479,482 ----
***************
*** 862,869 ****
}
! proc menu_audio {flag} {
! puts "menu_audio::: $flag"
! pd "pd dsp $flag ;"
! }
#-----------------------------------------------------------------------------------#
--- 849,853 ----
}
! proc menu_audio {flag} {pd "pd dsp $flag ;"}
#-----------------------------------------------------------------------------------#
***************
*** 884,888 ****
# check or uncheck the "edit" menu item
proc pdtk_canvas_editval {name value} {
- #puts "pdtk_canvas_editval::: $name $value"
global look _
set self [canvastosym $name.c]
--- 868,871 ----
***************
*** 894,900 ****
}
! proc pdtk_canvas_getscroll {args} {
! puts "pdtk_canvas_getscroll: $args"
! }
#-----------------------------------------------------------------------------------#
--- 877,881 ----
}
! proc pdtk_canvas_getscroll {args} {}
#-----------------------------------------------------------------------------------#
***************
*** 940,944 ****
wm protocol $name WM_DELETE_WINDOW "menu_close $name"
! canvas_new_binds $name
focus $name.c
pdtk_canvas_editval $name $editable
--- 921,925 ----
wm protocol $name WM_DELETE_WINDOW "menu_close $name"
! canvas_new_binds $self
focus $name.c
pdtk_canvas_editval $name $editable
***************
*** 955,963 ****
#-----------------------------------------------------------------------------------#
! proc canvas_new_binds {name} {
global OS
! set c $name.c
bind $c <Button> {canvas_click %W %x %y %b 0}
bind $c <Shift-Button> {canvas_click %W %x %y %b 1}
bind $c <Control-Shift-Button> {canvas_click %W %x %y %b 3}
bind $c <Alt-Button> {canvas_click %W %x %y %b 4}
--- 936,945 ----
#-----------------------------------------------------------------------------------#
! def canvas new_binds {} {
global OS
! set c .x$self.c
bind $c <Button> {canvas_click %W %x %y %b 0}
bind $c <Shift-Button> {canvas_click %W %x %y %b 1}
+ bind $c <Control-Button> {canvas_click %W %x %y %b 2}
bind $c <Control-Shift-Button> {canvas_click %W %x %y %b 3}
bind $c <Alt-Button> {canvas_click %W %x %y %b 4}
***************
*** 972,976 ****
default {
bind $c <Button-3> {canvas_click %W %x %y %b 8}
- bind $c <Control-Button> {canvas_click %W %x %y %b 2}
}
}
--- 954,957 ----
***************
*** 996,1010 ****
# bind $c <Map> {canvas_map %W}
# bind $c <Unmap> {canvas_unmap %W}
! bind $c <Motion> "+statusbar_update [c2self $name] %x %y"
switch $OS { unix {
! bind $c <Button-4> "canvas_scroll $name.c y -1"
! bind $c <Button-5> "canvas_scroll $name.c y +1"
! bind $c <Shift-Button-4> "canvas_scroll $name.c x -1"
! bind $c <Shift-Button-5> "canvas_scroll $name.c x +1"
} default {
! bind $c <MouseWheel> \
! "canvas_scroll $name.c y \[expr -abs(%D)/%D\]"
! bind $c <Shift-MouseWheel> \
! "canvas_scroll $name.c x \[expr -abs(%D)/%D\]"
}}
}
--- 977,989 ----
# bind $c <Map> {canvas_map %W}
# bind $c <Unmap> {canvas_unmap %W}
! bind $c <Motion> "+statusbar_update $self %x %y"
switch $OS { unix {
! bind $c <Button-4> "canvas_scroll $c y -1"
! bind $c <Button-5> "canvas_scroll $c y +1"
! bind $c <Shift-Button-4> "canvas_scroll $c x -1"
! bind $c <Shift-Button-5> "canvas_scroll $c x +1"
} default {
! bind $c <MouseWheel> "canvas_scroll $c y \[expr -abs(%D)/%D\]"
! bind $c <Shift-MouseWheel> "canvas_scroll $c x \[expr -abs(%D)/%D\]"
}}
}
***************
*** 1057,1082 ****
}
! #-----------------------------------------------------------------------------------#
! proc menu_editmode {name} {
! #puts "menu_editmode::: $name"
! pd "$name editmode 0 ;"
! }
! #-----------------------------------------------------------------------------------#
# correct edit menu, enabling or disabling undo/redo
# LATER also cut/copy/paste
proc menu_fixeditmenu {name} {
! #puts "menu_fixeeditmenu::: $name"
!
! #global pd_undoaction pd_redoaction pd_undocanvas
! #if {$name == $pd_undocanvas && $pd_undoaction != "no"} {
! #$name.m.edit entryconfigure "Undo*" -state normal -label "Undo $pd_undoaction"
! #} else {
! #$name.m.edit entryconfigure "Undo*" -state disabled -label "Undo"
! #}
! #if {$name == $pd_undocanvas && $pd_redoaction != "no"} {
! #$name.m.edit entryconfigure "Redo*" -state normal -label "Redo $pd_redoaction"
! #} else {
! #$name.m.edit entryconfigure "Redo*" -state disabled
! #}
}
--- 1036,1057 ----
}
! proc menu_editmode {name} {pd "$name editmode 0 ;"}
!
# correct edit menu, enabling or disabling undo/redo
# LATER also cut/copy/paste
proc menu_fixeditmenu {name} {
! return
! global pd_undoaction pd_redoaction pd_undocanvas
! set e $name.m.edit
! if {$name == $pd_undocanvas && $pd_undoaction != "no"} {
! $e entryconfigure "Undo*" -state normal -label "Undo $pd_undoaction"
! } else {
! $e entryconfigure "Undo*" -state disabled -label "Undo"
! }
! if {$name == $pd_undocanvas && $pd_redoaction != "no"} {
! $e entryconfigure "Redo*" -state normal -label "Redo $pd_redoaction"
! } else {
! $e entryconfigure "Redo*" -state disabled
! }
}
***************
*** 1085,1095 ****
# message from Pd to update the currently available undo/redo action
proc pdtk_undomenu {name undoaction redoaction} {
! #puts "pdtk_undomenu::: $name $undoaction $redoaction"
!
! #global pd_undoaction pd_redoaction pd_undocanvas
! #set pd_undocanvas $name
! #set pd_undoaction $undoaction
! #set pd_redoaction $redoaction
! #if {$name != "nobody"} {menu_fixeditmenu $name}
}
--- 1060,1069 ----
# message from Pd to update the currently available undo/redo action
proc pdtk_undomenu {name undoaction redoaction} {
! return
! global pd_undoaction pd_redoaction pd_undocanvas
! set pd_undocanvas $name
! set pd_undoaction $undoaction
! set pd_redoaction $redoaction
! if {$name != "nobody"} {menu_fixeditmenu $name}
}
***************
*** 1100,1104 ****
}
! def canvas ctrlkey2 {key shift} {
global accels
set top .x$self
--- 1074,1078 ----
}
! def* canvas ctrlkey2 {key shift} {
global accels
set top .x$self
***************
*** 1171,1184 ****
}
! 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
foreach {x1 y1} [object_xy $self $canvas] {}
- #set x1 50; set y1 50
set x2 [expr $x1+$xs]
set y2 [expr $y1+$ys]
--- 1145,1156 ----
}
! def* objectbox draw {canvas} {
! $self update_size
! set xs $@xs
! set ys $@ys
! set ins $@inlets
! set outs $@outlets
global look
foreach {x1 y1} [object_xy $self $canvas] {}
set x2 [expr $x1+$xs]
set y2 [expr $y1+$ys]
***************
*** 1191,1195 ****
item $self $canvas BASE2 line $xyb -fill $look(objectframe2)
item $self $canvas BASE3 line $xyc -fill $look(objectframe3)
! io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
#set @clickeditevent objectbox_clickedit
#set @clickevent objectbox_click
--- 1163,1167 ----
item $self $canvas BASE2 line $xyb -fill $look(objectframe2)
item $self $canvas BASE3 line $xyc -fill $look(objectframe3)
! io_draw $self $canvas
#set @clickeditevent objectbox_clickedit
#set @clickevent objectbox_click
***************
*** 1207,1254 ****
#make objects turn blue.
! proc canvas_isselected {canvas member} {
! #puts "canvas_isselected::: $canvas $member"
! global _
! set self [canvastosym $canvas]
! set i [lsearch $_($self:selection) $member]
! #puts "canvas_issellected ::: -> $i [expr $i>=0]"
return [expr $i>=0]
}
#-----------------------------------------------------------------------------------#
! def io draw {canvas x1 y1 xs ys ins outs} {
! global look _
set x2 [expr $x1+$xs]
set y2 [expr $y1+$ys]
! set fx $look(iopos)
! set fy $look(iopos)
! set @inlets $ins
! set @outlets $outs
! set nplus [expr $ins == 1 ? 1 : $ins-1]
! for {set i 0} {$i<$ins} {incr i} {
! set onset [expr $x1 + ($xs - $look(iowidth)) * $i / $nplus]
! set points [list [expr $onset+$fx] [expr $y1-$fy] \
! [expr $onset-$fx+$look(iowidth)] [expr $y1-$fy+$look(extrapix)]]
! # will update this code when proc item deals with mult.tags
! if {[llength [$canvas gettags ${self}i$i]] != 0} {
! $canvas coords ${self}i$i $points
! } {
! $canvas create rectangle $points -tags "${self}i ${self}i$i $self" -outline $look(inletfg)
! }
! }
! set nplus [expr $outs == 1 ? 1 : $outs-1]
! for {set i 0} {$i<$outs} {incr i} {
! set onset [expr $x1 + ($xs - $look(iowidth)) * $i / $nplus]
! set points [list [expr $onset+$fx] [expr $y2-1+$fy] \
! [expr $onset-$fx+$look(iowidth)] [expr $y2+$fy]]
# will update this code when proc item deals with mult.tags
! if {[llength [$canvas gettags ${self}o$i]] != 0} {
! $canvas coords ${self}o$i $points
} {
! $canvas create rectangle $points -tags "${self}o ${self}o$i $self" -outline $look(outletfg)
}
}
}
def io erase {canvas} {$canvas delete ${self}i ${self}o}
--- 1179,1218 ----
#make objects turn blue.
! def canvas isselected {member} {
! set i [lsearch $@selection $member]
return [expr $i>=0]
}
#-----------------------------------------------------------------------------------#
! def io draw/2 {canvas which n y} {
! global look
! set nplus [expr $n==1 ? 1 : $n-1]
! foreach {x1 y1} [object_xy $self $canvas] {}
! set xs $@xs
! set ys $@ys
set x2 [expr $x1+$xs]
set y2 [expr $y1+$ys]
! for {set i 0} {$i<$n} {incr i} {
! set onset [expr $x1 + ($@xs-$look(iowidth)) * $i / $nplus]
! set points [list [expr $onset+$fx] $y [expr $onset-$fx+$look(iowidth)] [expr $y]]
! set points [list [expr $onset+$fx] $y [expr $onset-$fx+$look(iowidth)] [expr $y]]
# will update this code when proc item deals with mult.tags
! if {[llength [$canvas gettags ${self}$which$i]] != 0} {
! $canvas coords ${self}$which$i $points
} {
! $canvas create rectangle $points -tags "$self$which $self$which$i $self" \
! -outline [switch $which { i {list $look(inletfg)} o {list $look(outletfg)}}]
}
}
}
+ def io draw {canvas} {
+ global look
+ set fy $look(iopos)
+ foreach {x1 y1} [object_xy $self $canvas] {}
+ io_draw/2 $self $canvas i $@inlets [expr $y1-$fy+$look(extrapix)]
+ io_draw/2 $self $canvas o $@outlets [expr $y1+$fy]
+ }
+
def io erase {canvas} {$canvas delete ${self}i ${self}o}
***************
*** 1293,1297 ****
$t configure -pady 0
$t insert 1.0 $text
! #bind $t <Motion> {canvas_motion %W %x %y 0 %s}
focus $t
#puts "class name -> [winfo children ${canvas}]"
--- 1257,1261 ----
$t configure -pady 0
$t insert 1.0 $text
! #bind $t <Motion> {canvas_motion %W %x %y 0 %s}
focus $t
#puts "class name -> [winfo children ${canvas}]"
***************
*** 1299,1308 ****
}
! def text key {canvas widget x y key iso shift} {
global font
set @text [$widget get 1.0 1.end]
$self update_size
$self draw $canvas
! $widget configure -width [expr [llength $@text]+1]
}
--- 1263,1274 ----
}
! def* text key {canvas widget x y key iso shift} {
global font
set @text [$widget get 1.0 1.end]
+ set n [expr [string length $@text]+1]
+ puts "@text=$@text n=$n"
$self update_size
$self draw $canvas
! $widget configure -width $n
}
***************
*** 1311,1314 ****
--- 1277,1282 ----
def objectbox init {} {
set @isnew 1
+ set @inlets 0
+ set @outlets 0
#set canvas [canvastosym $_(focus)]
set canvas $_(focus)
***************
*** 1318,1322 ****
}
! def objectbox update_size {} {
global font
set @xs [expr $font(padx)+$font(width)*([llength $@text]+$@isnew)]
--- 1286,1290 ----
}
! def* objectbox update_size {} {
global font
set @xs [expr $font(padx)+$font(width)*([llength $@text]+$@isnew)]
***************
*** 1472,1477 ****
}
#----handles the wire update----
- #set @inlets $ins
- #set @outlets $outs
for {set x 0} {$x<$_($obj:inlets)} {incr x} {
#if {[info exists]}
--- 1440,1443 ----
***************
*** 2207,2214 ****
}
! #def wire status {d} {
! # puts "wire_update:: $self $d"
! # foreach [list @obj1 @port1 @obj2 @port2] [lrange $d 0 3] {}
! #}
#-----------------------------------------------------------------------------------#
--- 2173,2179 ----
}
! def wire status {d} {
! foreach [list @obj1 @port1 @obj2 @port2] [lrange $d 0 3] {}
! }
#-----------------------------------------------------------------------------------#
***************
*** 2351,2355 ****
class_new messagebox {view}
! def messagebox draw {canvas xs ys ins outs} {
global look
foreach {x1 y1} [object_xy $self $canvas] {}
--- 2316,2320 ----
class_new messagebox {view}
! def messagebox draw {canvas} {
global look
foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 2360,2364 ****
#shadow_draw $self $canvas $points
item $self $canvas BASE polygon $points -fill $look(objectbg) -outline $look(objectframe3)
! io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
if {[canvas_isselected $canvas $self]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
$canvas itemconfigure ${self}BASE -outline $frcol
--- 2325,2329 ----
#shadow_draw $self $canvas $points
item $self $canvas BASE polygon $points -fill $look(objectbg) -outline $look(objectframe3)
! io_draw $self $canvas
if {[canvas_isselected $canvas $self]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
$canvas itemconfigure ${self}BASE -outline $frcol
***************
*** 2372,2376 ****
class_new atombox {view}
! def atombox draw {canvas xs ys ins outs} {
global look
foreach {x1 y1} [object_xy $self $canvas] {}
--- 2337,2341 ----
class_new atombox {view}
! def atombox draw {canvas} {
global look
foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 2384,2388 ****
}
item $self $canvas BASE polygon $points -tag -fill $look(objectbg) -outline $look(objectframe3)
! io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
if {[canvas_isselected $canvas $self]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
$canvas itemconfigure ${self}BASE -outline $frcol
--- 2349,2353 ----
}
item $self $canvas BASE polygon $points -tag -fill $look(objectbg) -outline $look(objectframe3)
! io_draw $self $canvas
if {[canvas_isselected $canvas $self]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
$canvas itemconfigure ${self}BASE -outline $frcol
***************
*** 2419,2423 ****
$canvas create line $x3 $y1 $x3 $y2 -tags ${self}CURS -fill red
}
! io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
label_draw $self $canvas
set @clickevent numbox_click
--- 2384,2388 ----
$canvas create line $x3 $y1 $x3 $y2 -tags ${self}CURS -fill red
}
! io_draw $self $canvas
label_draw $self $canvas
set @clickevent numbox_click
***************
*** 2529,2533 ****
item $self $canvas BASE2 line $xyb -fill #ffffff
item $self $canvas BASE3 line $xyc -fill [darker $color]
! io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
if {[canvas_isselected $canvas $self]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
$canvas itemconfigure ${self}BASE -outline $frcol
--- 2494,2498 ----
item $self $canvas BASE2 line $xyb -fill #ffffff
item $self $canvas BASE3 line $xyc -fill [darker $color]
! io_draw $self $canvas
if {[canvas_isselected $canvas $self]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
$canvas itemconfigure ${self}BASE -outline $frcol
***************
*** 2554,2558 ****
set ins [expr [string compare $@rcv empty]==0]
set outs [expr [string compare $@snd empty]==0]
! bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
if {$orient} {set size $ys} {set size $xs}
set size [expr $size/$n]
--- 2519,2523 ----
set ins [expr [string compare $@rcv empty]==0]
set outs [expr [string compare $@snd empty]==0]
! bluebox_draw $self $canvas
if {$orient} {set size $ys} {set size $xs}
set size [expr $size/$n]
***************
*** 2609,2613 ****
set outs [expr [string compare $@snd empty]==0]
switch $@class {hsl {set orient 0} vsl {set orient 1}}
! bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
if {![info exists @clicking]} {set @clicking 0}
set color [bluify #ffffff]
--- 2574,2578 ----
set outs [expr [string compare $@snd empty]==0]
switch $@class {hsl {set orient 0} vsl {set orient 1}}
! bluebox_draw $self $canvas
if {![info exists @clicking]} {set @clicking 0}
set color [bluify #ffffff]
***************
*** 2742,2747 ****
set outs [expr [string compare $@snd empty]==0]
set colour [parse_color $@bcol]
! bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
! io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
item $self $canvas BUT oval \
[expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2] \
--- 2707,2712 ----
set outs [expr [string compare $@snd empty]==0]
set colour [parse_color $@bcol]
! bluebox_draw $self $canvas
! io_draw $self $canvas
item $self $canvas BUT oval \
[expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2] \
***************
*** 2770,2775 ****
set outs [expr [string compare $@snd empty]==0]
set colour [parse_color $@bcol]
! bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
! io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
set w 1
if {$xs >= 30} {set w 2}
--- 2735,2740 ----
set outs [expr [string compare $@snd empty]==0]
set colour [parse_color $@bcol]
! bluebox_draw $self $canvas
! io_draw $self $canvas
set w 1
if {$xs >= 30} {set w 2}
More information about the Pd-cvs
mailing list