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 + }