[PD-cvs] pd/src desire.tk,1.1.2.178,1.1.2.179
Mathieu Bouchard
matju at users.sourceforge.net
Sat Apr 22 08:44:43 CEST 2006
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30306
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
misc varia stuff
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.178
retrieving revision 1.1.2.179
diff -C2 -d -r1.1.2.178 -r1.1.2.179
*** desire.tk 22 Apr 2006 03:41:13 -0000 1.1.2.178
--- desire.tk 22 Apr 2006 06:44:41 -0000 1.1.2.179
***************
*** 17,22 ****
#-----------------------------------------------------------------------------------#
! # some list processing functions
proc min {x y} {if {$x<$y} {return $x} {return $y}}
proc max {x y} {if {$x>$y} {return $x} {return $y}}
--- 17,27 ----
#-----------------------------------------------------------------------------------#
! # some list processing functions and some math too
+ proc clip {x min max} {
+ if {$x<$min} {return $min}
+ if {$x>$max} {return $max}
+ return $x
+ }
proc min {x y} {if {$x<$y} {return $x} {return $y}}
proc max {x y} {if {$x>$y} {return $x} {return $y}}
***************
*** 97,101 ****
post %s "$o: $poolset($o)"
unset poolset($o)
- puts ".....draw $o ....."
$o draw
}
--- 102,105 ----
***************
*** 872,875 ****
--- 876,885 ----
def Canvas quit {} {global main; $main quit}
+ proc wonder {} {tk_messageBox -message "this would be a cool feature, eh?" -type yesno -icon question}
+
+ def Canvas popup_properties {} {wonder}
+ def Canvas popup_open {} {wonder}
+ def Canvas popup_help {} {wonder}
+
def* Canvas eval% {code} {
regsub -all %X $code $@current_x code
***************
*** 969,976 ****
def Canvas editmode {} {return $@editmode}
def Canvas editmode= {mode} {
! global look edit_toggle
set @editmode $mode
#sets the edit_toggle so the edit mode checkbox will follow if key binding is used
- set edit_toggle $@editmode
catch {.$self.bbar.edit configure -image icon_mode_$mode}
.$self.c configure -background [if $@editmode {concat $look(canvasbgedit)} {concat $look(canvasbgrun)}]
--- 979,985 ----
def Canvas editmode {} {return $@editmode}
def Canvas editmode= {mode} {
! global look
set @editmode $mode
#sets the edit_toggle so the edit mode checkbox will follow if key binding is used
catch {.$self.bbar.edit configure -image icon_mode_$mode}
.$self.c configure -background [if $@editmode {concat $look(canvasbgedit)} {concat $look(canvasbgrun)}]
***************
*** 1192,1202 ****
$m.edit add checkbutton -label [say edit_mode] \
! -selectcolor grey0 -command "menu_editmode $name" \
-accelerator [accel_munge "Ctrl+e"] -indicatoron 1 \
! -variable edit_toggle -onvalue 1 -offvalue 0
! #binds the state of the checkbox to global variable edit_toggle
!
! dict append @accels "Ctrl+e" "menu_editmode $name"
!
$m.edit configure -postcommand "$self fix_edit_menu"
$m.window configure -postcommand "menu_fixwindowmenu"
--- 1201,1209 ----
$m.edit add checkbutton -label [say edit_mode] \
! -selectcolor grey0 -command "$self editmode 0" \
-accelerator [accel_munge "Ctrl+e"] -indicatoron 1 \
! -variable @editmode -onvalue 1 -offvalue 0
! #binds the state of the checkbox to global variable editmod
! dict append @accels "Ctrl+e" "$self editmode 0"
$m.edit configure -postcommand "$self fix_edit_menu"
$m.window configure -postcommand "menu_fixwindowmenu"
***************
*** 1211,1219 ****
}
- proc menu_editmode {name} {
- global _ edit_toggle
- pd $name editmode 0
- }
-
def Canvas editmodeswitch {args} {
set @editmode [expr !$@editmode]
--- 1218,1221 ----
***************
*** 1359,1366 ****
global font look
set @textwidth [expr $font(padx)+$font(width)*([string length $@text]+$@edit)]
! set @topwidth [expr ($@ninlets + ($@ninlets - 1)) * $look(iowidth)]
! set @bottomwidth [expr ($@noutlets + ($@noutlets - 1)) * $look(iowidth)]
set @xs [max $look(minobjwidth) [max $@bottomwidth [max $@topwidth $@textwidth]]]
! set @ys [expr $font(pady)+$font(height)]
}
--- 1361,1368 ----
global font look
set @textwidth [expr $font(padx)+$font(width)*([string length $@text]+$@edit)]
! set @topwidth [expr (2* $@ninlets-1) * $look(iowidth)]
! set @bottomwidth [expr (2*$@noutlets-1) * $look(iowidth)]
set @xs [max $look(minobjwidth) [max $@bottomwidth [max $@topwidth $@textwidth]]]
! set @ys [expr $font(pady)+$font(height)]
}
***************
*** 1566,1570 ****
}
! def* View move {dx dy} {
mset {x y} [$self xy]
set @x1 [expr $@x1+$dx]
--- 1568,1572 ----
}
! def View move {dx dy} {
mset {x y} [$self xy]
set @x1 [expr $@x1+$dx]
***************
*** 1769,1774 ****
set c .[$self canvas].c
mset {type id} [$self identify_target $x $y $b $f "click"]
! puts "object_in_edit: $@obj_in_edit id:$id"
! if {$f&8} {post "right click!"; return}
if {[llength $@obj_in_edit]} {$@obj_in_edit unedit; set @obj_in_edit {}}
# if clicked on empty space in edit mode, draw dash sel rect
--- 1771,1778 ----
set c .[$self canvas].c
mset {type id} [$self identify_target $x $y $b $f "click"]
! if {$f&8} {
! tk_popup .$self.popup [winfo pointerx $c] [winfo pointery $c]
! return
! }
if {[llength $@obj_in_edit]} {$@obj_in_edit unedit; set @obj_in_edit {}}
# if clicked on empty space in edit mode, draw dash sel rect
***************
*** 2051,2086 ****
def* Box draw_wires {} {
-
puts "wires:$@wires"
!
! foreach wire $@wires {
! $wire draw
! }
}
def* Box delete_wire {wire} {
! set find [lsearch $@wires $wire]
! if { $find != -1} {
! set @wires [lreplace $@wires $find $find]
! }
}
! def* Box move {dx dy} {
! global _
! super $dx $dy
! #$self draw_wires
! foreach wire $@wires {
! # the select_by is ugly, remove later... $_($@canvas:select_by)
! set _($wire:select_by) $_($@canvas:select_by)
! $wire draw
! }
}
-
def* Box clickedit {x y butt key in_selection selection} {
#handles the shift click
#if {($f&1) && !$already} {post "add to selection?"; return}
if {($key&1) && $selection>0} {
! puts "add $self to selection...."
}
#if clicked obj is part of the $@selection, than....
--- 2055,2082 ----
def* Box draw_wires {} {
puts "wires:$@wires"
! foreach wire $@wires {$wire draw}
}
def* Box delete_wire {wire} {
! set find [lsearch $@wires $wire]
! if {$find != -1} {set @wires [lreplace $@wires $find $find]}
}
! def Box move {dx dy} {
! super $dx $dy
! #$self draw_wires
! foreach wire $@wires {
! # the select_by is ugly, remove later... $_($@canvas:select_by)
! set _($wire:select_by) $_($@canvas:select_by)
! $wire draw
! }
}
def* Box clickedit {x y butt key in_selection selection} {
#handles the shift click
#if {($f&1) && !$already} {post "add to selection?"; return}
if {($key&1) && $selection>0} {
! puts "add $self to selection...."
}
#if clicked obj is part of the $@selection, than....
***************
*** 2267,2275 ****
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)
--- 2263,2271 ----
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)
***************
*** 2277,2281 ****
set classinfo(vdl) $classinfo(hradio)
set classinfo(canvas) {Canvas}
! set classinfo(cnv) {cnv}
proc update_object {x d} {
--- 2273,2277 ----
set classinfo(vdl) $classinfo(hradio)
set classinfo(canvas) {Canvas}
! set classinfo(cnv) {Cnv}
proc update_object {x d} {
***************
*** 2352,2356 ****
incr i
}
- puts "==== x:$x"
$x changed
}
--- 2348,2351 ----
***************
*** 2359,2364 ****
# fix me
! class_new shadow {qwerty}
! def shadow draw {coords} {
global look
set light [darker ${look(objectbg)}]
--- 2354,2359 ----
# fix me
! class_new Shadow {} ;# make a Box class inherit from this
! def Shadow draw {coords} {
global look
set light [darker ${look(objectbg)}]
***************
*** 2436,2441 ****
}
! class_new BlueBox {labeled Box}
! #class_new BlueBox {Box labeled}
def* BlueBox draw {} {
--- 2431,2436 ----
}
! class_new BlueBox {Labeled Box}
! #class_new BlueBox {Box Labeled}
def* BlueBox draw {} {
***************
*** 2459,2464 ****
}
! class_new numbox {labeled Box}
! def* numbox init {args} {
eval [concat [list super] $args]
set @clicking 0
--- 2454,2459 ----
}
! class_new NumBox {Labeled Box}
! def* NumBox init {args} {
eval [concat [list super] $args]
set @clicking 0
***************
*** 2466,2470 ****
}
! def* numbox draw {} {
$self update_size
global look
--- 2461,2465 ----
}
! def* NumBox draw {} {
$self update_size
global look
***************
*** 2485,2489 ****
$self item BASE polygon $points -fill [parse_color $@bcol] -outline $look(objectframe3)
$self item BASE4 polygon $points2 -fill $color4 -outline $look(objectframe3)
! $self item NUMBER text [list $xt $yt] -anchor w -text [numbox_ftoa $self] \
-font [list $font $@fs bold] -fill [parse_color $@fcol]
.$@canvas.c delete ${self}CURS
--- 2480,2484 ----
$self item BASE polygon $points -fill [parse_color $@bcol] -outline $look(objectframe3)
$self item BASE4 polygon $points2 -fill $color4 -outline $look(objectframe3)
! $self item NUMBER text [list $xt $yt] -anchor w -text [$self ftoa] \
-font [list $font $@fs bold] -fill [parse_color $@fcol]
.$@canvas.c delete ${self}CURS
***************
*** 2493,2502 ****
}
io_draw $self
! labeled_draw $self
if {[$self selected?]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
.$@canvas.c itemconfigure ${self}BASE -outline $frcol
}
! def* numbox update_size {} {
global font look
set @textwidth [expr $font(padx)+$font(width)*[string length $@buf]]
--- 2488,2497 ----
}
io_draw $self
! Labeled_draw $self
if {[$self selected?]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
.$@canvas.c itemconfigure ${self}BASE -outline $frcol
}
! def* NumBox update_size {} {
global font look
set @textwidth [expr $font(padx)+$font(width)*[string length $@buf]]
***************
*** 2509,2513 ****
! def numbox ftoa {} {
set f $@val
set is_exp 0
--- 2504,2508 ----
! def NumBox ftoa {} {
set f $@val
set is_exp 0
***************
*** 2530,2534 ****
}
! def numbox click {x y b f} {
$@canvas focus $self
$@canvas itemconfigure ${self}BASE4 -fill #00ff00
--- 2525,2529 ----
}
! def NumBox click {x y b f} {
$@canvas focus $self
$@canvas itemconfigure ${self}BASE4 -fill #00ff00
***************
*** 2539,2543 ****
}
! def numbox motion {x y mod} {
set focused [$self == [$@canvas focus]]
if {!$focused} {return}
--- 2534,2538 ----
}
! def NumBox motion {x y mod} {
set focused [$self == [$@canvas focus]]
if {!$focused} {return}
***************
*** 2549,2555 ****
}
! def numbox unfocus {} {set @buf ""; $self changed}
! def numbox unclick {x y} {
set @clicking 0
if {$@oval!=$@val} {
--- 2544,2550 ----
}
! def NumBox unfocus {} {set @buf ""; $self changed}
! def NumBox unclick {x y} {
set @clicking 0
if {$@oval!=$@val} {
***************
*** 2559,2563 ****
}
! def numbox key {key shift} {
set c -1
catch {set c [format %c $key]}
--- 2554,2558 ----
}
! def NumBox key {key shift} {
set c -1
catch {set c [format %c $key]}
***************
*** 2581,2590 ****
$@canvas unfocus
} else {
! puts "numbox_key $key"
}
}
! class_new radio {BlueBox}
! def radio orient {} {
switch $@pdclass {
hradio {set orient 0} hdl {set orient 0}
--- 2576,2585 ----
$@canvas unfocus
} else {
! puts "NumBox_key $key"
}
}
! class_new Radio {BlueBox}
! def Radio orient {} {
switch $@pdclass {
hradio {set orient 0} hdl {set orient 0}
***************
*** 2595,2599 ****
}
! def radio bbox {} {
set orient [$self orient]
mset {x1 y1} [$self xy]
--- 2590,2594 ----
}
! def Radio bbox {} {
set orient [$self orient]
mset {x1 y1} [$self xy]
***************
*** 2603,2607 ****
}
! def* radio draw {} {
set orient [$self orient]
mset {x1 y1 x2 y2} [$self bbox]
--- 2598,2602 ----
}
! def* Radio draw {} {
set orient [$self orient]
mset {x1 y1 x2 y2} [$self bbox]
***************
*** 2619,2628 ****
}
! def radio set {value} {
.$@canvas.c itemconfigure ${self}BUT -fill #ffffff
.$@canvas.c itemconfigure ${self}BUT$value -fill #000000
}
! def radio click {x y b f} {
mset {x1 y1} [$self xy]
set x [expr $x-$x1]
--- 2614,2623 ----
}
! def Radio set {value} {
.$@canvas.c itemconfigure ${self}BUT -fill #ffffff
.$@canvas.c itemconfigure ${self}BUT$value -fill #000000
}
! def Radio click {x y b f} {
mset {x1 y1} [$self xy]
set x [expr $x-$x1]
***************
*** 2633,2644 ****
}
! proc clamp {x min max} {
! if {$x<$min} {return $min}
! if {$x>$max} {return $max}
! return $x
! }
!
! class_new slider {BlueBox}
! def slider orient {} {
switch $@pdclass {
vsl {set orient 1} default {set orient 0}
--- 2628,2633 ----
}
! class_new Slider {BlueBox}
! def Slider orient {} {
switch $@pdclass {
vsl {set orient 1} default {set orient 0}
***************
*** 2647,2661 ****
}
! def* slider init {args} {
super
set @clicking 0
}
! def slider bbox {} {
mset {x1 y1} [$self xy]
list $x1 $y1 [expr $x1+$@w] [expr $y1+$@h]
}
! def slider draw {} {
global look
mset {x1 y1 x2 y2} [$self bbox]
--- 2636,2650 ----
}
! def Slider init {args} {
super
set @clicking 0
}
! def Slider bbox {} {
mset {x1 y1} [$self xy]
list $x1 $y1 [expr $x1+$@w] [expr $y1+$@h]
}
! def Slider draw {} {
global look
mset {x1 y1 x2 y2} [$self bbox]
***************
*** 2691,2703 ****
# not used
! def slider draw_notches {} {
set orient [$self orient]
if {$orient} {
! set thick [clamp [expr $xs/3] 1 5]
set x3 [expr $x1+$xs-$thick/2-2]
set eighth [expr round($ys/8-1)]
set coords [list $x3 $y1 $x3 [expr $y1+$ys]]
} else {
! set thick [clamp [expr $ys/3] 1 5]
set y3 [expr $y1+$ys-$thick/2-2]
set eighth [expr $xs/8]
--- 2680,2692 ----
# not used
! def Slider draw_notches {} {
set orient [$self orient]
if {$orient} {
! set thick [clip [expr $xs/3] 1 5]
set x3 [expr $x1+$xs-$thick/2-2]
set eighth [expr round($ys/8-1)]
set coords [list $x3 $y1 $x3 [expr $y1+$ys]]
} else {
! set thick [clip [expr $ys/3] 1 5]
set y3 [expr $y1+$ys-$thick/2-2]
set eighth [expr $xs/8]
***************
*** 2707,2711 ****
}
! def slider click {x y b f} {
$@canvas focus $self
set @first [list $x $y]
--- 2696,2700 ----
}
! def Slider click {x y b f} {
$@canvas focus $self
set @first [list $x $y]
***************
*** 2715,2719 ****
}
! def slider unclick {x y} {
set @clicking 0
if {[lindex $@first 1] != $y} {
--- 2704,2708 ----
}
! def Slider unclick {x y} {
set @clicking 0
if {[lindex $@first 1] != $y} {
***************
*** 2723,2727 ****
}
! def slider motion {x y mods} {
set focused [$self == [$@canvas focus]]
if {!$focused} {return}
--- 2712,2716 ----
}
! def Slider motion {x y mods} {
set focused [$self == [$@canvas focus]]
if {!$focused} {return}
***************
*** 2736,2744 ****
}
! def slider unfocus {} {$self draw}
! class_new labeled {}
! def* labeled draw {} {
mset {x1 y1} [$self xy]
set lx [expr $x1+$@ldx]
--- 2725,2733 ----
}
! def Slider unfocus {} {$self draw}
! class_new Labeled {}
! def* Labeled draw {} {
mset {x1 y1} [$self xy]
set lx [expr $x1+$@ldx]
***************
*** 2752,2756 ****
}
! def labeled erase {} {
# $@canvas delete ${self}LABEL
}
--- 2741,2745 ----
}
! def Labeled erase {} {
# $@canvas delete ${self}LABEL
}
***************
*** 2788,2792 ****
def Toggle init {args} {
- puts "!!!!!! args:$args"
super
set @on 0
--- 2777,2780 ----
***************
*** 2828,2832 ****
}
! class_new vu {View}
set vu_col {
--- 2816,2820 ----
}
! class_new Vu {View}
set vu_col {
***************
*** 2835,2839 ****
}
! def vu led_size {} {
set n [expr $@h/40]
if {$n < 2} {set n 2}
--- 2823,2827 ----
}
! def Vu led_size {} {
set n [expr $@h/40]
if {$n < 2} {set n 2}
***************
*** 2841,2845 ****
}
! def vu draw {} {
global vu_col
mset {x1 y1} [$self xy]
--- 2829,2833 ----
}
! def Vu draw {} {
global vu_col
mset {x1 y1} [$self xy]
***************
*** 2883,2887 ****
}
! def vu set {i j} {
global vu_col
mset {x1 y1} [$self xy]
--- 2871,2875 ----
}
! def Vu set {i j} {
global vu_col
mset {x1 y1} [$self xy]
***************
*** 2906,2911 ****
}
! class_new dropper {View}
! def dropper draw {} {
set isnew [expr [llength [$@canvas gettags ${self}BASE]] == 0]
mset {x1 y1} [$self xy]
--- 2894,2899 ----
}
! class_new Dropper {View}
! def Dropper draw {} {
set isnew [expr [llength [$@canvas gettags ${self}BASE]] == 0]
mset {x1 y1} [$self xy]
***************
*** 2927,2934 ****
}
! def dropper erase {} {destroy $@canvas.${self}DROP; super}
! class_new cnv {labeled View}
! def cnv draw {} {
mset {x1 y1} [$self xy]
set xs $@w
--- 2915,2922 ----
}
! def Dropper erase {} {destroy $@canvas.${self}DROP; super}
! class_new Cnv {Labeled View}
! def Cnv draw {} {
mset {x1 y1} [$self xy]
set xs $@w
More information about the Pd-cvs
mailing list