[PD-cvs] pd/src u_object.tk,1.1.2.1,1.1.2.2
matju at users.sourceforge.net
matju at users.sourceforge.net
Fri Mar 5 20:00:02 CET 2004
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5696
Modified Files:
Tag: impd_0_37
u_object.tk
Log Message:
this part gets used by the upcoming rewritten Pd widgets
Index: u_object.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/u_object.tk,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -d -r1.1.2.1 -r1.1.2.2
*** u_object.tk 22 Feb 2004 22:15:05 -0000 1.1.2.1
--- u_object.tk 5 Mar 2004 18:59:50 -0000 1.1.2.2
***************
*** 0 ****
--- 1,242 ----
+ ############ colouring
+
+ proc bluify {colour} {
+ scan $colour #%02x%02x%02x r g b
+ set r [expr ($r*0xbb)>>8]
+ set g [expr ($g*0xe4)>>8]
+ return [format #%02x%02x%02x $r $g $b]
+ }
+
+ proc darker {colour} {
+ scan $colour #%02x%02x%02x r g b
+ set r [expr $r*3/4]
+ set g [expr $g*3/4]
+ set b [expr $b*3/4]
+ return [format #%02x%02x%02x $r $g $b]
+ }
+
+ ############ rendering
+
+ # modes:
+ # 0: creation
+ # 1: resize (or move)
+
+ proc wire_draw {canvas tag thick x1 y1 x2 y2} {
+ global look
+ set xys [list $x1 $y1 $x2 $y2]
+ if {[llength [$canvas gettags $tag]] != 0} {
+ eval "$canvas coords $tag $xys"
+ } {
+ eval "$canvas create line $xys -tags $tag -width $thick \
+ -arrow last -fill $look(wirefg) -smooth yes"
+ }
+ }
+
+ proc wire_select {canvas tag flag} {
+ if {$flag} {set colour #0000ff} {set colour #8888cc}
+ $canvas itemconfigure $tag -fill $colour
+ }
+
+ proc wire_erase {canvas tag} {
+ $canvas delete $tag
+ }
+
+ #ifdef MACOSX
+ #set look(extrapix) 2
+ #else
+ set look(extrapix) 1
+ #endif
+
+ set look(iowidth) 7
+ set look(iopos) 1
+
+ proc io_draw {canvas tag x1 y1 x2 y2 ins outs} {
+ global look
+ set width [expr $x2 - $x1]
+ set fx $look(iopos)
+ set fy $look(iopos)
+ set nplus [expr $ins == 1 ? 1 : $ins-1]
+ for {set i 0} {$i<$ins} {incr i} {
+ set onset [expr $x1 + ($width - $look(iowidth)) * $i / $nplus]
+ set points [list [expr $onset+$fx] [expr $y1-$fy] \
+ [expr $onset-$fx+$look(iowidth)] [expr $y1-$fy+$look(extrapix)]]
+ if {[llength [$canvas gettags ${tag}i$i]] != 0} {
+ eval "$canvas coords ${tag}i$i $points"
+ } {
+ eval "$canvas create rectangle $points -tags {${tag}i ${tag}i$i} -outline red"
+ }
+ }
+ set nplus [expr $outs == 1 ? 1 : $outs-1]
+ for {set i 0} {$i<$outs} {incr i} {
+ set onset [expr $x1 + ($width - $look(iowidth)) * $i / $nplus]
+ set points [list [expr $onset+$fx] [expr $y2-1+$fy] \
+ [expr $onset-$fx+$look(iowidth)] [expr $y2+$fy]]
+ if {[llength [$canvas gettags ${tag}o$i]] != 0} {
+ eval "$canvas coords ${tag}o$i $points"
+ } {
+ eval "$canvas create rectangle $points -tags {${tag}o ${tag}o$i} -outline red"
+ }
+ }
+ }
+
+ proc io_erase {canvas tag} {
+ $canvas delete ${tag}i
+ $canvas delete ${tag}o
+ }
+
+ proc objectbox_draw {canvas tag x1 y1 x2 y2 ins outs} {
+ global look
+ 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]]
+ set xyd [list [expr $x1+4] [expr $y1+4] [expr $x2+4] [expr $y2+4]]
+ if {[llength [$canvas gettags $tag]] != 0} {
+ eval "$canvas coords ${tag} $xya"
+ eval "$canvas coords ${tag}+ $xyb"
+ eval "$canvas coords ${tag}++ $xyc"
+ } {
+ eval "$canvas create rectangle $xya -tag ${tag} -fill ${look(objectbg)}"
+ eval "$canvas create line $xyb -tag ${tag}+ -fill ${look(objectframe1)}"
+ eval "$canvas create line $xyc -tag ${tag}++ -fill ${look(objectframe2)}"
+ }
+ io_draw $canvas $tag $x1 $y1 $x2 $y2 $ins $outs
+ }
+
+ proc objectbox_select {canvas tag flag} {
+ global look
+ if {$flag} {set colour $look(objectframe4)} {set colour $look(objectframe3)}
+ $canvas itemconfigure $tag -outline $colour
+ }
+
+ proc objectbox_erase {canvas tag} {
+ $canvas delete $tag $tag+ $tag++
+ io_erase $canvas $tag
+ }
+
+ proc brokenbox_draw {canvas tag x1 y1 x2 y2 ins outs} {
+ objectbox_draw $canvas $tag $x1 $y1 $x2 $y2 $ins $outs
+ $canvas itemconfigure ${tag}.l -fill #ffcccc
+ }
+
+ proc brokenbox_select {canvas tag flag} {objectbox_select $canvas $tag $flag}
+ proc brokenbox_erase {canvas tag} {objectbox_erase $canvas $tag}
+
+ proc message_draw {canvas tag x1 y1 x2 y2 ins outs} {
+ global look
+ set points [list $x1 $y1 [expr $x2+4] $y1 $x2 [expr $y1+4] $x2 [expr $y2-4] \
+ [expr $x2+4] $y2 $x1 $y2 $x2 $y2 $x1 $y2]
+ if {[llength [$canvas gettags $tag]] != 0} {
+ eval "$canvas coords ${tag} $points"
+ } {
+ eval "$canvas create polygon $points -tag ${tag} -fill $look(objectbg) -outline $look(objectframe3)"
+ }
+ io_draw $canvas $tag $x1 $y1 $x2 $y2 $ins $outs
+ }
+
+ proc message_select {canvas tag flag} {
+ global look
+ if {$flag} {set colour $look(objectframe4)} {set colour $look(objectframe3)}
+ $canvas itemconfigure $tag -outline $colour
+ }
+
+ proc message_erase {canvas tag} {
+ $canvas delete $tag
+ io_erase $canvas $tag
+ }
+
+ #proc message_click {canvas tag} {}
+ #proc message_tick {canvas tag} {}
+
+ proc atom_draw {canvas tag x1 y1 x2 y2 ins outs} {
+ global look
+ set points [list $x1 $y1 [expr $x2-4] $y1 $x2 [expr $y1+4] $x2 $y2 $x1 $y2]
+ if {[llength [$canvas gettags $tag]] != 0} {
+ eval "$canvas coords ${tag} $points"
+ } {
+ eval "$canvas create polygon $points -tag ${tag} -fill $look(objectbg) -outline $look(objectframe3)"
+ }
+ io_draw $canvas $tag $x1 $y1 $x2 $y2 $ins $outs
+ }
+
+ proc atom_select {canvas tag flag} {
+ if {$flag} {set colour #0000ff} {set colour #000000}
+ $canvas itemconfigure $tag -outline $colour
+ }
+
+ proc atom_erase {canvas tag} {
+ $canvas delete $tag
+ io_erase $canvas $tag
+ }
+
+ proc comment_draw {canvas tag x1 y1 x2 y2 ins outs} {
+ if {[llength [$canvas gettags $tag]] != 0} {}
+ }
+ proc comment_select {canvas tag flag} {}
+ proc comment_erase {canvas tag} {}
+
+ proc bluebox_draw {canvas tag x1 y1 x2 y2 ins outs colour} {
+ 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]]
+ if {[llength [$canvas gettags $tag]] != 0} {
+ eval "$canvas coords ${tag} $xya"
+ eval "$canvas coords ${tag}+ $xyb"
+ eval "$canvas coords ${tag}++ $xyc"
+ } {
+ set color [bluify #ffffff]
+ eval "$canvas create rectangle $xya -tag ${tag} -fill $color"
+ eval "$canvas create line $xyb -tag ${tag}+ -fill #ffffff"
+ eval "$canvas create line $xyc -tag ${tag}++ -fill [darker $color]"
+ }
+ io_draw $canvas $tag $x1 $y1 $x2 $y2 $ins $outs
+ }
+
+ proc bluebox_select {canvas tag flag} {
+ if {$flag} {set colour #0000ff} {set colour #000000}
+ $canvas itemconfigure $tag -outline $colour
+ }
+
+ proc bluebox_erase {canvas tag} {
+ $canvas delete $tag $tag+ $tag++
+ io_erase $canvas $tag
+ }
+
+ proc slider_select {canvas tag flag} {
+ if {$flag} {set colour #0000ff} {set colour #000000}
+ $canvas itemconfigure $tag -outline $colour
+ }
+
+ proc numbox_draw {canvas tag x1 y1 x2 y2 ins outs color1 color2} {
+ atom_draw $canvas $tag $x1 $y1 $x2 $y2 $ins $outs
+ }
+
+ proc numbox_erase {canvas tag} {
+ atom_erase $canvas $tag
+ io_erase $canvas $tag
+ }
+
+ proc radio_draw {canvas tag x1 y1 x2 y2 ins outs orient number colour} {
+ set isnew [expr [llength [$canvas gettags ${tag}BASE]] == 0]
+ bluebox_draw $canvas $tag $x1 $y1 $x2 $y2 $ins $outs $colour
+ if {$orient} {set size [expr $y2-$y1]} {set size [expr $x2-$x1]}
+ set size [expr $size/$number]
+ for {set i 0} {$i<$number} {incr i} {
+ if {$isnew} {
+ $canvas create rectangle \
+ [expr $x1+3] [expr $y1+3] \
+ [expr $x1+$size-3] [expr $y1+$size-3] \
+ -fill #ffffff -outline #000000 -tags "${tag}BUT ${tag}BUT$i"
+ } else {
+ $canvas coords ${tag}BUT$i \
+ [expr $x1+3] [expr $y1+3] \
+ [expr $x1+$size-3] [expr $y1+$size-3]
+ }
+ if {$orient} {set y1 [expr $y1+$size]} {set x1 [expr $x1+$size]}
+ }
+ }
+
+ proc radio_set {canvas tag value} {
+ post_to_gui "radio_set: $value\n"
+ $canvas itemconfigure ${tag}BUT -fill #ffffff
+ $canvas itemconfigure ${tag}BUT$value -fill #000000
+ }
More information about the Pd-cvs
mailing list