[PD-cvs] pd/src desire.tk,1.1.2.137,1.1.2.138
Mathieu Bouchard
matju at users.sourceforge.net
Mon Dec 5 06:24:37 CET 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19691
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
fixed draw for [hradio] [vradio].
@xs, at ys replaced by a custom def of bbox.
renamed def bluebox makebox to def bluebox draw, to take advantage of super.
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.137
retrieving revision 1.1.2.138
diff -C2 -d -r1.1.2.137 -r1.1.2.138
*** desire.tk 4 Dec 2005 16:58:16 -0000 1.1.2.137
--- desire.tk 5 Dec 2005 05:24:35 -0000 1.1.2.138
***************
*** 708,713 ****
--- 708,721 ----
class_new view {observable thing}
+ # normally ninlets/noutlets should be in class "box", but server-side isn't smart enough
+ def view ninlets= {v} {set @ninlets $v}
+ def view noutlets= {v} {set @noutlets $v}
+ def view ninlets {} {return $@ninlets}
+ def view noutlets {} {return $@noutlets}
+
def view init {} {
set @selected? 0
+ set @ninlets 1
+ set @noutlets 0
super
}
***************
*** 730,733 ****
--- 738,743 ----
default {.$@canvas.c delete $self$suffix}}}
+ def* view draw {} {}
+
def* view delete {} {$self erase; $self _delete; io_erase $self}
def* view erase {} {$self item_delete}
***************
*** 970,980 ****
}
- def* canvas ninlets= {n} {}
- def* canvas noutlets= {n} {}
def canvas focus {} {return $@focus}
def canvas focus= {o} {set @focus $o}
-
-
#-----------------------------------------------------------------------------------#
--- 980,986 ----
***************
*** 1214,1222 ****
class_new textbox {box}
- def textbox ninlets= {v} {set @ninlets $v}
- def textbox noutlets= {v} {set @noutlets $v}
- def textbox ninlets {} {return $@ninlets}
- def textbox noutlets {} {return $@noutlets}
-
def* textbox draw {} {
# TEXT = the text label
--- 1220,1223 ----
***************
*** 1492,1497 ****
rect {
set coords [$c coords selrect]
! set x1 [lindex $coords 0]; set x2 $x
! set y1 [lindex $coords 1]; set y2 $y
$c coords selrect $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x1 $y1
}
--- 1493,1497 ----
rect {
set coords [$c coords selrect]
! mset {x1 y1} $coords; set x2 $x; set y2 $y
$c coords selrect $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x1 $y1
}
***************
*** 1500,1505 ****
set @action move
mset {ox oy} $@click_at
! }
! }
}
# if {[string length $@focus]} {
--- 1500,1505 ----
set @action move
mset {ox oy} $@click_at
! }
! }
}
# if {[string length $@focus]} {
***************
*** 1850,1860 ****
class_new box {view}
- def box ninlets= {v} {set @ninlets $v}
- def box noutlets= {v} {set @noutlets $v}
- def box ninlets {} {return $@ninlets}
- def box noutlets {} {return $@noutlets}
-
-
-
def* box init {args} {
super
--- 1850,1853 ----
***************
*** 1925,1936 ****
def box hilite_io {type x y} {
global look
! mset {cx cy} [$self xy]
set c .$@canvas.c
! set ports 0; catch {switch $type {i {set ports $@ninlets} o {set ports $@noutlets}}}
if {$ports==0} return
! set port [expr int(($x-$cx)*$ports/$@xs)]
if {$port >= $ports} {set port [expr $ports-1]}
! set p ${self}${type}${port}
! #if {![llength $@wire_from]} {}
set outline [switch $type {i {concat $look(outletfg)} o {concat $look(inletfg)}}]
$c create rectangle [l+ [$c coords $p] {-4 -4 +4 +4}] -outline $outline -width 1 -tags ${p}b
--- 1918,1929 ----
def box hilite_io {type x y} {
global look
! mset {x1 y1 x2 y2} [$self bbox]
! set xs [expr $x2-$x1]
set c .$@canvas.c
! switch $type {i {set ports $@ninlets} o {set ports $@noutlets}}
if {$ports==0} return
! set port [expr int(($x-$x1)*$ports/$xs)]
if {$port >= $ports} {set port [expr $ports-1]}
! set p $self$type$port
set outline [switch $type {i {concat $look(outletfg)} o {concat $look(inletfg)}}]
$c create rectangle [l+ [$c coords $p] {-4 -4 +4 +4}] -outline $outline -width 1 -tags ${p}b
***************
*** 2230,2241 ****
}
! class_new bluebox {box}
! #class_new bluebox {labeled view}
! def* bluebox makebox {x1 y1 xs ys ins outs} {
global look
! set x2 [expr $x1+$xs]
! set y2 [expr $y1+$ys]
! set xya [list $x1 $y1 $x2 $y2]
set xyb [list [expr $x2-1] [expr $y1+1] [expr $x1+1] [expr $y1+1] [expr $x1+1] [expr $y2-1]]
set xyc [list [expr $x2-1] [expr $y1+1] [expr $x2-1] [expr $y2-1] [expr $x1+1] [expr $y2-1]]
--- 2223,2233 ----
}
! class_new bluebox {labeled box}
! def* bluebox draw {} {
global look
! super
! set xya [$self bbox]
! mset {x1 y1 x2 y2} $xya
set xyb [list [expr $x2-1] [expr $y1+1] [expr $x1+1] [expr $y1+1] [expr $x1+1] [expr $y2-1]]
set xyc [list [expr $x2-1] [expr $y1+1] [expr $x2-1] [expr $y2-1] [expr $x1+1] [expr $y2-1]]
***************
*** 2253,2257 ****
}
! class_new numbox {bluebox}
def* numbox init {args} {
eval [concat [list super] $args]
--- 2245,2249 ----
}
! class_new numbox {labeled box}
def* numbox init {args} {
eval [concat [list super] $args]
***************
*** 2369,2373 ****
}
! class_new radio {view}
def radio orient {} {
switch $@class {
--- 2361,2365 ----
}
! class_new radio {bluebox}
def radio orient {} {
switch $@class {
***************
*** 2379,2402 ****
}
! def radio draw {} {
! set orient [radio_orient $self]
mset {x1 y1} [$self xy]
! set n $@n
! set xs [expr $@w*($orient?1:$n)]
! set ys [expr $@w*($orient?$n:1)]
! set x2 [expr $x1+$xs]
! set y2 [expr $y1+$ys]
set ins [expr [string compare $@rcv empty]==0]
set outs [expr [string compare $@snd empty]==0]
super
! if {$orient} {set size $ys} {set size $xs}
! set size [expr $size/$n]
! for {set i 0} {$i<$n} {incr i} {
#fixme: item doesn't support multiple tags yet
$self item "BUT$i BUT" rectangle \
! [expr $x1+3] [expr $y1+3] \
! [expr $x1+$size-3] [expr $y1+$size-3] \
-fill #ffffff -outline #000000
! if {$orient} {set y1 [expr $y1+$size]} {set x1 [expr $x1+$size]}
}
$self set $@on
--- 2371,2394 ----
}
! def radio bbox {} {
! set orient [$self orient]
mset {x1 y1} [$self xy]
! set x2 [expr $x1+$@w*($orient?1:$@n)]
! set y2 [expr $y1+$@w*($orient?$@n:1)]
! list $x1 $y1 $x2 $y2
! }
!
! def* radio draw {} {
! set orient [$self orient]
! mset {x1 y1 x2 y2} [$self bbox]
set ins [expr [string compare $@rcv empty]==0]
set outs [expr [string compare $@snd empty]==0]
super
! for {set i 0} {$i<$@n} {incr i} {
#fixme: item doesn't support multiple tags yet
$self item "BUT$i BUT" rectangle \
! [list [expr $x1+3] [expr $y1+3] [expr $x1+$@w-3] [expr $y1+$@w-3]] \
-fill #ffffff -outline #000000
! if {$orient} {set y1 [expr $y1+$@w]} {set x1 [expr $x1+$@w]}
}
$self set $@on
***************
*** 2404,2412 ****
def radio set {value} {
! $@canvas itemconfigure ${self}BUT -fill #ffffff
! $@canvas itemconfigure ${self}BUT$value -fill #000000
}
- class_new radio {view}
def radio click {x y b f} {
mset {x1 y1} [$self xy]
--- 2396,2403 ----
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]
***************
*** 2437,2443 ****
}
def slider draw {} {
global look
! mset {x1 y1} [$self xy]
set xs $@w
set ys $@h
--- 2428,2439 ----
}
+ 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]
set xs $@w
set ys $@h
***************
*** 2448,2452 ****
set outs [expr [string compare $@snd empty]==0]
super
- $self makebox $x1 $y1 $@w $@h $@ninlets $@noutlets
set color [bluify #ffffff]
$self item KNOB rectangle [list $x1 $y1 $x1 $y1] \
--- 2444,2447 ----
***************
*** 2539,2562 ****
#-----------------------------------------------------------------------------------#
class_new bang {bluebox}
! def* bang init {args} {
puts "!!!!!! args:$args"
super
set @w 15
- set @xs $@w
- set @ys $@w
}
! #def bang ninlets= {v} {set @ninlets $v}
! #def bang noutlets= {v} {set @noutlets $v}
! #def bang ninlets {} {return $@ninlets}
! #def bang noutlets {} {return $@noutlets}
!
! def* bang draw {} {
mset {x1 y1} [$self xy]
set colour [parse_color $@bcol]
- #super
- set xs $@w; set x2 [expr $x1+$xs]
- set ys $@w; set y2 [expr $y1+$ys]
- $self makebox $x1 $y1 $@w $@w $@ninlets $@noutlets
$self item BUT oval \
[list [expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2]] \
--- 2534,2552 ----
#-----------------------------------------------------------------------------------#
class_new bang {bluebox}
! def bang init {args} {
puts "!!!!!! args:$args"
super
set @w 15
}
! def bang bbox {} {
mset {x1 y1} [$self xy]
+ list $x1 $y1 [expr $x1+$@w] [expr $y1+$@w]
+ }
+
+ def bang draw {} {
+ super
+ mset {x1 y1 x2 y2} [$self bbox]
set colour [parse_color $@bcol]
$self item BUT oval \
[list [expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2]] \
***************
*** 2573,2601 ****
class_new toggle {bluebox}
! def* toggle init {args} {
puts "!!!!!! args:$args"
super
set @on 0
set @w 15
- set @xs $@w
- set @ys $@w
}
! def* toggle draw {} {
mset {x1 y1} [$self xy]
! set xs $@w
! set ys $@w
! set x2 [expr $x1+$xs]
! set y2 [expr $y1+$ys]
set colour [parse_color $@bcol]
! #super
! set w 1
! if {$xs >= 30} {set w 2}
! if {$xs >= 60} {set w 3}
set fill [bluify $colour]
! set x3 [expr $x1+$w+2]
! set y3 [expr $y1+$w+2]
! set x4 [expr $x2-$w-2]
! set y4 [expr $y2-$w-2]
if {$@on} {
set fill [parse_color $@fcol]
--- 2563,2586 ----
class_new toggle {bluebox}
! def toggle init {args} {
puts "!!!!!! args:$args"
super
set @on 0
set @w 15
}
! def toggle bbox {} {
mset {x1 y1} [$self xy]
! list $x1 $y1 [expr $x1+$@w] [expr $y1+$@w]
! }
!
! def toggle draw {} {
! super
! mset {x1 y1 x2 y2} [$self bbox]
set colour [parse_color $@bcol]
! set t [expr int(($@w+29)/30)]
set fill [bluify $colour]
! set x3 [expr $x1+$t+2]; set y3 [expr $y1+$t+2]
! set x4 [expr $x2-$t-2]; set y4 [expr $y2-$t-2]
if {$@on} {
set fill [parse_color $@fcol]
***************
*** 2603,2609 ****
set fill [bluify [parse_color $@bcol]]
}
! $self makebox $x1 $y1 $@w $@w $@ninlets $@noutlets
! $self item X1 line [list $x3 $y3 [expr $x4+1] [expr $y4+1]] -width $w -fill $fill
! $self item X2 line [list $x3 $y4 [expr $x4+1] [expr $y3-1]] -width $w -fill $fill
}
--- 2588,2593 ----
set fill [bluify [parse_color $@bcol]]
}
! $self item X1 line [list $x3 $y3 [expr $x4+1] [expr $y4+1]] -width $t -fill $fill
! $self item X2 line [list $x3 $y4 [expr $x4+1] [expr $y3-1]] -width $t -fill $fill
}
More information about the Pd-cvs
mailing list