Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4216
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
added proc super.
removed most def $foo erase
added class view (not to confuse with class vu)
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.51
retrieving revision 1.1.2.52
diff -C2 -d -r1.1.2.51 -r1.1.2.52
*** desire.tk 14 Sep 2005 01:10:36 -0000 1.1.2.51
--- desire.tk 14 Sep 2005 04:39:41 -0000 1.1.2.52
***************
*** 61,65 ****
lookup_method $_($self:_class) $selector candidates
puts "!!! candidates: $candidates"
! set name [lindex $candidates 0]
puts "proc name of $self $selector is $name"
set r [uplevel 1 [concat [list $name $self] [lrange $args 2 end]]]
--- 61,66 ----
lookup_method $_($self:_class) $selector candidates
puts "!!! candidates: $candidates"
! set i 0
! set name [lindex $candidates $i]
puts "proc name of $self $selector is $name"
set r [uplevel 1 [concat [list $name $self] [lrange $args 2 end]]]
***************
*** 68,71 ****
--- 69,81 ----
}
+ proc super {args} {
+ upvar 2 candidates candidates self self
+ set i [expr 1+[uplevel 2 {list $i}]]
+ puts "!!! super #$i"
+ set name [lindex $candidates $i]
+ puts "proc name of $self $selector is $name"
+ set r [uplevel 1 [concat [list $name $self] $args]]
+ }
+
class_new thing
set _(thing:_super) {}
***************
*** 721,725 ****
#-----------------------------------------------------------------------------------#
!
set font(size) 12
set font(width) 0
--- 731,735 ----
#-----------------------------------------------------------------------------------#
! # why didn't you use the font metrics function? --matju
set font(size) 12
set font(width) 0
***************
*** 746,761 ****
set look(wirefg) #888888
set look(wirefg2) #ee0000
- #set look(sliderbg) #bbe4ff
set look(sliderbg) #ccebff
! #set look(sliderbg) #ddf2ff
set look(inletfg) #ff0000
set look(outletfg) #ff0000
!
! # Tearoff is set to true by default:
! set pd_tearoff 1
set current_x 0
set current_y 0
-
set tooltip(mx) -1000
set tooltip(my) -1000
--- 756,769 ----
set look(wirefg) #888888
set look(wirefg2) #ee0000
set look(sliderbg) #ccebff
! #set look(sliderbg) #ffeedd
set look(inletfg) #ff0000
set look(outletfg) #ff0000
! set look(extrapix) [switch $OS {
! osx { set look(extrapix) 2 }
! default { set look(extrapix) 1 }}]
set current_x 0
set current_y 0
set tooltip(mx) -1000
set tooltip(my) -1000
***************
*** 763,767 ****
set tooltip(visible) 0
set tooltip(text) ""
-
set dehighlight {}
set wire_from {}
--- 771,774 ----
***************
*** 778,785 ****
#-----------------------------------------------------------------------------------#
! proc menu_close {name} {pd "$name menuclose 0 ;"}
proc menu_save {name} {canvas_checkgeometry $name; pd "$name menusave ;"}
proc menu_saveas {name} {canvas_checkgeometry $name; pd "$name menusaveas ;"}
! proc menu_print {name} {
set filename [tk_getSaveFile -initialfile pd.ps -defaultextension .ps \
-filetypes { {{postscript} {.ps}} }]
--- 785,792 ----
#-----------------------------------------------------------------------------------#
! proc menu_close {name} {pd "$name menuclose 0 ;"}
proc menu_save {name} {canvas_checkgeometry $name; pd "$name menusave ;"}
proc menu_saveas {name} {canvas_checkgeometry $name; pd "$name menusaveas ;"}
! proc menu_print {name} {
set filename [tk_getSaveFile -initialfile pd.ps -defaultextension .ps \
-filetypes { {{postscript} {.ps}} }]
***************
*** 930,946 ****
global _
regsub "\\.x" $name "" self
- puts "NEW CANVAS $self"
set _($self:_class) canvas
$self init $width $height $geometry $editable
}
class_new canvas
def canvas init {width height geometry editable} {
- set name .$self
- #puts "canvas_new::: $name $width $height $geometry $editable"
global pd_opendir pd_tearoff OS cmdline canvasmenu _
! # my code begins --chun
set _(focus) $name.c
- # my code ends
-
toplevel $name -menu $name.m
wm geometry $name $geometry
--- 937,950 ----
global _
regsub "\\.x" $name "" self
set _($self:_class) canvas
$self init $width $height $geometry $editable
}
+
class_new canvas
def canvas init {width height geometry editable} {
global pd_opendir pd_tearoff OS cmdline canvasmenu _
! set name .$self
! # focus should be set to either always a _ object or always a tk object. else we'll run into trouble. what do we do here? --matju
set _(focus) $name.c
toplevel $name -menu $name.m
wm geometry $name $geometry
***************
*** 966,972 ****
menu $name.popup -tearoff false
populate_menu $name.popup $name {
! {"Properties" {popup_action %W 0} ""}
! {"Open" {popup_action %W 1} ""}
! {"Help" {popup_action %W 2} ""}
}
--- 970,976 ----
menu $name.popup -tearoff false
populate_menu $name.popup $name {
! {"Properties" {popup_properties [canvastosym %W]} ""}
! {"Open" {popup_open [canvastosym %W]} ""}
! {"Help" {popup_help [canvastosym %W]} ""}
}
***************
*** 981,985 ****
bind $c <Alt-Control-Button> {canvas_click %W %x %y %b 6}
bind $c <Alt-Control-Shift-Button> {canvas_click %W %x %y %b 7}
- global OS
switch $OS {
osx {
--- 985,988 ----
***************
*** 992,1004 ****
}
}
! # change mac to right-click, not middle click -atl 2002.09.02
! bind $c <ButtonRelease> {canvas_mouseup %W %x %y %b}
bind $c <Control-Key> {canvas_ctrlkey %W %K 0}
bind $c <Control-Shift-Key> {canvas_ctrlkey %W %K 1}
! bind $c <Alt-Key> {canvas_altkey %W %K %A}
switch $OS {
unix {
! bind $c <Mod1-Key> {canvas_altkey %W %K %A}
! bind $c <Mod4-Key> {canvas_altkey %W %K %A}
}
osx {
--- 995,1006 ----
}
}
! bind $c <ButtonRelease> {canvas_mouseup %W %x %y %b}
bind $c <Control-Key> {canvas_ctrlkey %W %K 0}
bind $c <Control-Shift-Key> {canvas_ctrlkey %W %K 1}
! bind $c <Alt-Key> {canvas_altkey %W %K %A}
switch $OS {
unix {
! bind $c <Mod1-Key> {canvas_altkey %W %K %A}
! bind $c <Mod4-Key> {canvas_altkey %W %K %A}
}
osx {
***************
*** 1017,1032 ****
pdtk_canvas_editval $name $editable
bind $c <Motion> "+statusbar_update $name %x %y"
-
- global OS
switch $OS { unix {
! bind $c <Button-4> "pdtk_canvas_scroll $name.c y -1"
! bind $c <Button-5> "pdtk_canvas_scroll $name.c y +1"
! bind $c <Shift-Button-4> "pdtk_canvas_scroll $name.c x -1"
! bind $c <Shift-Button-5> "pdtk_canvas_scroll $name.c x +1"
} default {
bind $c <MouseWheel> \
! "pdtk_canvas_scroll $name.c y \[expr -abs(%D)/%D\]"
bind $c <Shift-MouseWheel> \
! "pdtk_canvas_scroll $name.c x \[expr -abs(%D)/%D\]"
}}
#catch {image create photo mybackground -file "test2.gif"}
--- 1019,1032 ----
pdtk_canvas_editval $name $editable
bind $c <Motion> "+statusbar_update $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\]"
}}
#catch {image create photo mybackground -file "test2.gif"}
***************
*** 1278,1285 ****
#-----------------------------------------------------------------------------------#
- switch $OS {
- osx { set look(extrapix) 2 }
- default { set look(extrapix) 1 }
- }
#-----------------------------------------------------------------------------------#
--- 1278,1281 ----
***************
*** 1328,1331 ****
--- 1324,1329 ----
#-----------------------------------------------------------------------------------#
# create a new text object
+ class_new text {thing}
+
proc text_new {canvas self x y text font color} {
$canvas create text $x $y \
***************
*** 1335,1339 ****
}
- #-----------------------------------------------------------------------------------#
# change the text
proc pdtk_text_set {canvas myname text} {text_set $canvas $myname $text}
--- 1333,1336 ----
***************
*** 1377,1385 ****
}
- #-----------------------------------------------------------------------------------#
def text key {canvas widget x y key iso shift} {
global font
set @text [$widget get 1.0 1.end]
- # regexp {(\.x[0-9a-fA-F]+\.c)\.([0-9a-fA-F]+)text(.*)} $widget full canvas self
$widget configure -width [expr [llength $@text]+1]
$self update_size
--- 1374,1380 ----
***************
*** 1437,1441 ****
$canvas delete ${self}text
$self erase $canvas
! $self pdate_size
$self draw $canvas
for {set x 0} {$x<$@inlets} {incr x} {
--- 1432,1436 ----
$canvas delete ${self}text
$self erase $canvas
! $self update_size
$self draw $canvas
for {set x 0} {$x<$@inlets} {incr x} {
***************
*** 1770,1782 ****
set mouse(b1down) 1
foreach {type id} [identify_target $canvas $cx $cy $b $f "click"] {}
- #puts "click on => $type:$id"
-
switch $type {
object {
set run [expr !$edit || ($f&2)]
- #pd "$self click-on-object x$id $cx $cy $b $f;"
if {[string length $@focus]} {set gid $@focus}
if {$f&8} {
- #puts "RIGHTCLICK OBJECT"
set rightclick_object $id
} else {
--- 1765,1773 ----
***************
*** 1887,1891 ****
}
if {[llength $@selection] > 0} {
- #puts "dehightlight all!!!!!"
foreach obj $@selection {
$canvas itemconfigure ${obj}BASE -outline $look(objectframe3)
--- 1878,1881 ----
***************
*** 1894,1898 ****
}
if {[llength $@selection_wire] > 0} {
- #puts "dehightlight all wires!!!!!"
foreach wire $@selection_wire {
$canvas itemconfigure $wire -fill $look(wirefg)
--- 1884,1887 ----
***************
*** 1904,1908 ****
set @action rect
$canvas create line $cx $cy $cx $cy $cx $cy $cx $cy $cx $cy -tags selrect
- global OS
switch $OS { osx {} default { $canvas itemconfigure selrect -dash {3 3 3 3}}}
}
--- 1893,1896 ----
***************
*** 2280,2299 ****
#-----------------------------------------------------------------------------------#
def wire draw {canvas thick x1 y1 x2 y2} {
- #puts "wire_draw:: $self $canvas $thick $x1 $y1 $x2 $y2"
-
global look
set xys [list $x1 $y1 $x2 $y2]
set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
- # set step [expr 1/floor(1+$length/4)]
- # for {set i 0} {$i<=1.001} {set i [expr $i+$step]} {
- # set r [expr (rand()-0.5)*$i*(1-$i)*150]
- # set r [expr sin($i/$step)*$i*(1-$i)*100]
- # set q [expr sin(1+$i/$step)*$i*(1-$i)*100]
- # #lappend xys [expr $x1+($x2-$x1)*$i+$r*[expr ($y1-$y2)/$length]]
- # #lappend xys [expr $y1+($y2-$y1)*$i+$q*[expr ($x2-$x1)/$length]]
- # lappend xys [expr $x1+($x2-$x1)*$i+(rand()-0.5)*150*$i*(1-$i)]
- # lappend xys [expr $y1+($y2-$y1)*$i+(rand()-0.5)*150*$i*(1-$i)]
- # }
-
set arrowsize [expr $length<100 ? $length/10 : 10]
if {$arrowsize < 5} {set arrow none} {set arrow last}
--- 2268,2274 ----
***************
*** 2305,2309 ****
def wire draw2 {canvas} {
- #puts "wire_draw2:: $self $canvas"
set bbox1 [$canvas bbox [join [list "$@obj1" o "$@port1"] ""]]
set bbox2 [$canvas bbox [join [list "$@obj2" i "$@port2"] ""]]
--- 2280,2283 ----
***************
*** 2316,2320 ****
def wire select {canvas flag} {
- #puts "wire_select:: $self $canvas $flag"
global look
if {$flag} {set colour #ff8000} {set colour $look(wirefg)}
--- 2290,2293 ----
***************
*** 2323,2333 ****
def wire erase {canvas} {
- #puts "wire_erase:: $self $canvas"
-
$canvas delete $self
}
def wire update {d} {
- #puts "wire_update:: $self $d"
foreach [list @obj1 @port1 @obj2 @port2] \
[lrange $d 0 3] {}
--- 2296,2303 ----
***************
*** 2336,2341 ****
#def wire status {d} {
# puts "wire_update:: $self $d"
! # foreach [list @obj1 @port1 @obj2 @port2] \
! # [lrange $d 0 3] {}
#}
--- 2306,2310 ----
#def wire status {d} {
# puts "wire_update:: $self $d"
! # foreach [list @obj1 @port1 @obj2 @port2] [lrange $d 0 3] {}
#}
***************
*** 2449,2452 ****
--- 2418,2424 ----
############ rendering
+ class_new view {thing}
+ def view erase {canvas} {item_delete $self $canvas}
+
proc item {self canvas suffix type coords args} {
if {![llength [$canvas gettags ${self}${suffix}]]} {
***************
*** 2472,2476 ****
}
! def message draw {canvas xs ys ins outs} {
global look
foreach {x1 y1} [object_xy $self $canvas] {}
--- 2444,2449 ----
}
! class_new messagebox {view}
! def messagebox draw {canvas xs ys ins outs} {
global look
foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 2486,2490 ****
}
! def message bang {canvas flag} {
global look
$canvas itemconfigure ${self}BASE -fill \
--- 2459,2463 ----
}
! def messagebox bang {canvas flag} {
global look
$canvas itemconfigure ${self}BASE -fill \
***************
*** 2492,2504 ****
}
! def message erase {canvas} {
! $canvas delete ${self}BASE
! io_erase $self $canvas
! }
!
! #def message click {canvas} {}
! #def message tick {canvas} {}
!
! def atom draw {canvas xs ys ins outs} {
global look
foreach {x1 y1} [object_xy $self $canvas] {}
--- 2465,2470 ----
}
! class_new atombox {view}
! def atombox draw {canvas xs ys ins outs} {
global look
foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 2517,2525 ****
}
! def atom erase {canvas} {
! $canvas delete ${self}BASE
! io_erase $self $canvas
! }
!
def numbox draw {canvas} {
global look
--- 2483,2487 ----
}
! class_new numbox {view}
def numbox draw {canvas} {
global look
***************
*** 2576,2596 ****
# must shrink number
if {$is_exp} {
! #if(x->x_gui.x_w <= 5) {x->x_buf[0] = (f < 0.0 ? '-' : '+'); x->x_buf[1] = 0;}
! #i = bufsize - 4;
! #for(idecimal=0; idecimal < i; idecimal++) if(x->x_buf[idecimal] == '.') break;
! #if(idecimal > (x->x_gui.x_w - 4)) {
! # x->x_buf[0]=f<0.0?'-':'+';x->x_buf[1] = 0;
! #} {
! # int new_exp_index=x->x_gui.x_w-4, old_exp_index=bufsize-4;
! # for(i=0; i < 4; i++, new_exp_index++, old_exp_index++)
! # x->x_buf[new_exp_index] = x->x_buf[old_exp_index];
! # x->x_buf[x->x_gui.x_w] = 0;
! #}
} {
! #for(idecimal=0; idecimal < bufsize; idecimal++)
! #if(x->x_buf[idecimal] == '.') break;
! #if(idecimal > x->x_gui.x_w) {x->x_buf[0] = (f < 0.0 ? '-' : '+');
! # x->x_buf[1] = 0;
! #} {x->x_buf[x->x_gui.x_w] = 0;}
}
}
--- 2538,2544 ----
# must shrink number
if {$is_exp} {
! #...
} {
! #...
}
}
***************
*** 2598,2607 ****
}
- def numbox erase {canvas} {
- $canvas delete ${self}BASE ${self}NUMBER ${self}BASE4
- io_erase $self $canvas
- label_erase $self $canvas
- }
-
def numbox click {canvas x y b f} {
canvas_focus $canvas $self
--- 2546,2549 ----
***************
*** 2663,2666 ****
--- 2605,2609 ----
}
+ class_new comment {view}
def comment draw {canvas xs ys ins outs} {
if {[llength [$canvas gettags $self]] != 0} {}
***************
*** 2668,2673 ****
}
- def comment erase {canvas} {}
-
def bluebox draw {canvas x1 y1 xs ys ins outs} {
global look
--- 2611,2614 ----
***************
*** 2687,2695 ****
}
! def bluebox erase {canvas} {
! $canvas delete ${self}BASE ${self}BASE2 ${self}BASE3
! io_erase $self $canvas
! }
!
def radio orient {} {
switch $@class {
--- 2628,2632 ----
}
! class_new radio {view}
def radio orient {} {
switch $@class {
***************
*** 2732,2741 ****
}
! def radio erase {canvas} {
! bluebox_erase $self $canvas
! $canvas delete ${self}BUT
! label_erase $self $canvas
! }
!
def radio click {canvas x y b f} {
set x [expr $x-$@x1]
--- 2669,2673 ----
}
! class_new radio {view}
def radio click {canvas x y b f} {
set x [expr $x-$@x1]
***************
*** 2752,2755 ****
--- 2684,2688 ----
}
+ class_new slider {view}
def slider orient {} {
switch $@class {
***************
*** 2818,2827 ****
}
- def slider erase {canvas} {
- bluebox_erase $self $canvas
- label_erase $self $canvas
- $canvas delete ${self}KNOB
- }
-
def slider click {canvas x y b f} {
canvas_focus $canvas $self
--- 2751,2754 ----
***************
*** 2857,2860 ****
--- 2784,2788 ----
}
+ #class_new label_new {view}
def label draw {canvas} {
foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 2876,2880 ****
#-----------------------------------------------------------------------------------#
! class_new bang
def bang init {} {
global offset _
--- 2804,2808 ----
#-----------------------------------------------------------------------------------#
! class_new bang {view}
def bang init {} {
global offset _
***************
*** 2899,2903 ****
}
- #-----------------------------------------------------------------------------------#
def bang draw {canvas} {
foreach {x1 y1} [object_xy $self $canvas] {}
--- 2827,2830 ----
***************
*** 2918,2927 ****
}
- def bang erase {canvas} {
- bluebox_erase $self $canvas
- io_erase $self $canvas
- $canvas delete ${self}BUT ${self}LABEL
- }
-
def bang click {canvas x y b f} {
pd "x$self click $x $y 0 0 0 ;"
--- 2845,2848 ----
***************
*** 2933,2936 ****
--- 2854,2858 ----
}
+ class_new toggle {view}
def toggle draw {canvas} {
foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 2963,2967 ****
}
-
def toggle erase {canvas} {
bluebox_erase $self $canvas
--- 2885,2888 ----
***************
*** 2974,2977 ****
--- 2895,2900 ----
}
+ class new vu {view}
+
set vu_col {
0 17 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16
***************
*** 3051,3060 ****
}
- def vu erase {canvas} {
- bluebox_erase $self $canvas
- label_erase $self $canvas
- $canvas delete ${self}SCALE ${self}RMS ${self}MASK
- }
-
catch {
package require tkdnd
--- 2974,2977 ----
***************
*** 3062,3065 ****
--- 2979,2983 ----
}
+ class_new dropper {view}
def dropper draw {canvas} {
set isnew [expr [llength [$canvas gettags ${self}BASE]] == 0]
***************
*** 3083,3091 ****
def dropper erase {canvas} {
- bluebox_erase $self $canvas
destroy $canvas.${self}DROP
! $canvas delete ${self}window
}
def cnv draw {canvas} {
foreach {x1 y1} [object_xy $self $canvas] {}
--- 3001,3009 ----
def dropper erase {canvas} {
destroy $canvas.${self}DROP
! super $canvas
}
+ class cnv {view}
def cnv draw {canvas} {
foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 3097,3105 ****
}
- def cnv erase {canvas} {
- label_erase $self $canvas
- $canvas delete ${self}BASE ${self}LABEL
- }
-
#####################################################################################
############ console
--- 3015,3018 ----
