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,@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 }