---- [http://web.tiscali.it/marcomaggi/images/canvas_equaliser.png] (Image link broken Sept 25, 2011) ---- ====== # canvas_equaliser.tcl -- # # Part of: Useless Analog Widgets # Contents: canvas equaliser test script # Date: Fri Dec 24, 2004 # # Abstract # # # # Copyright (c) 2004 Marco Maggi # # The author hereby grant permission to use, copy, modify, distribute, # and license this software and its documentation for any purpose, # provided that existing copyright notices are retained in all copies # and that this notice is included verbatim in any distributions. No # written agreement, license, or royalty fee is required for any of the # authorized uses. Modifications to this software may be copyrighted by # their authors and need not follow the licensing terms described here, # provided that the new terms are clearly indicated on the first page of # each file where they apply. # # IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTORS BE LIABLE TO ANY PARTY # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY # DERIVATIVES THEREOF, EVEN IF THE AUTHOR HAVE BEEN ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # # THE AUTHOR AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND # NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, # AND THE AUTHOR AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE # MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. # # #page ## ------------------------------------------------------------ ## Setup. ## ------------------------------------------------------------ package require Tcl 8.4 package require Tk 8.4 #page ## ------------------------------------------------------------ ## TK options. ## ------------------------------------------------------------ # led numbers and pad options must be tailored to the screen resolution # the values below work for 1024x768 option add *borderWidth 1 option add *Equaliser.relief sunken option add *Equaliser.borderWidth 1 option add *Equaliser.highlightTickness 0 option add *Equaliser.canvas.borderWidth 0 option add *Equaliser.canvas.highlightTickness 0 option add *Equaliser.canvas.relief flat option add *Equaliser.canvas.background black option add *Equaliser.label level option add *Equaliser.label_font {-family helvetica -size 10} option add *Equaliser.channel_number 10 option add *Equaliser.led_number 15 option add *Equaliser.epadx 6 option add *Equaliser.epady 6 option add *Equaliser.ipadx 6 option add *Equaliser.ipady 6 option add *Equaliser.box_display yes option add *Equaliser.box_color gold option add *Equaliser.orient vertical option add *Equaliser.led_width 8 option add *Equaliser.led_height 2 option add *Equaliser.channel_spacing 3 option add *Equaliser.led_spacing 2 option add *Equaliser.led_red_mark 0.8 option add *Equaliser.led_green_off_color darkgreen option add *Equaliser.led_green_on_color green option add *Equaliser.led_red_off_color darkred option add *Equaliser.led_red_on_color red option add *b.led_height 1 option add *b.channel_number 20 option add *b.label {} option add *b.led_red_mark 1.0 option add *b.led_green_off_color goldenrod4 option add *b.led_green_on_color gold option add *b.epadx 3 option add *b.epady 3 option add *b.ipadx 3 option add *b.ipady 3 option add *d.led_height 1 option add *d.channel_number 20 option add *d.led_number 30 option add *d.label {} option add *d.led_red_mark 1.0 option add *d.led_green_off_color darkslategray option add *d.led_green_on_color lightgray option add *d.epadx 3 option add *d.epady 3 option add *d.ipadx 3 option add *d.ipady 3 option add *d.box_color lightgray option add *c.orient horizontal option add *e.label channels option add *e.led_number 40 option add *e.led_height 2 option add *e.channel_number 2 option add *e.orient horizontal #page ## ------------------------------------------------------------ ## Main. ## ------------------------------------------------------------ proc main {} { global exit_trigger wm title . "Testing canvas equaliser" wm geometry . +200+100 grid [frame .f] -sticky news equaliser .f.a equaliser .f.b equaliser .f.c equaliser .f.d grid .f.a .f.b -sticky news -padx 5 -pady 5 grid .f.c .f.d -sticky news -padx 5 equaliser .e grid .e grid [button .quit -text Exit -command main_exit] focus .quit bind .quit main_exit bind . main_exit interp alias {} main_exit {} set exit_trigger 1 vwait exit_trigger exit } proc equaliser { widget } { uwp_equaliser_build $widget schedule [list signals $widget [option get $widget channel_number {}]] } proc schedule { script } { after 250 [list schedule $script] uplevel \#0 $script } proc signals { widget number } { for {set i 0} {$i < $number} {incr i} { lappend signal [expr {rand()}] } uwp_equaliser_update $widget $signal } #page proc uwp_op_array { widget varName } { uplevel [subst -nocommands { array set $varName {} trace add variable $varName read { uwp_op_get $widget } trace add variable $varName write { uwp_op_set $widget } }] } proc uwp_op_get { widget name1 name2 op } { upvar $name1 options set options($name2) [option get $widget $name2 {}] } proc uwp_op_set { widget name1 name2 op } { upvar $name1 options option add *[string trimleft $widget .].$name2 $options($name2) } #page proc uwp_equaliser_build { widget } { uwp_op_array $widget options frame $widget -class Equaliser canvas [set c $widget.canvas] grid $c -sticky news -padx 0 -pady 0 uwp_p_equaliser_draw_$options(orient) $widget return $widget } #page proc uwp_p_equaliser_draw_vertical { widget } { uwp_op_array $widget options set c $widget.canvas foreach var { epadx epady ipadx ipady channel_number led_number channel_spacing led_spacing led_width led_height } { set $var $options($var) } set width [expr {2*$epadx+2*$ipadx+ $led_width*$channel_number+ $channel_spacing*($channel_number-1)}] set height [expr {2*$epadx+2*$ipadx+ $led_height*$led_number+ $led_spacing*($led_number-1)}] $c configure -width $width -height $height if { $options(box_display) } { $c create rectangle $epadx $epady \ [expr {$width-$epadx}] [expr {$height-$epady}] \ -outline $options(box_color) -tag Box } if { [string length $options(label)] } { set x1 [expr {$epadx+$ipadx+1}] set y1 $epady $c create text $x1 $y1 \ -anchor w -text $options(label) -fill $options(box_color) \ -font $options(label_font) -tag Label foreach {x1 y1 x2 y2} [$c bbox Label] {} $c create polygon $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 \ -fill [option get $c background {}] -tag LabelBack $c raise LabelBack Box $c raise Label LabelBack } set baseX [expr {$epadx+$ipadx}] set baseY [expr {$height-$epady-$ipady}] for {set channel 0} {$channel < $channel_number} {incr channel} { for {set led 0} {$led < $led_number} {incr led} { set x1 [expr {$baseX+$channel*($channel_spacing+$led_width)}] set y1 [expr {$baseY-$led*($led_spacing+$led_height)}] set x2 [expr {$x1+$led_width}] set y2 [expr {$y1-$led_height}] $c create polygon $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 \ -tags $channel:$led } } uwp_equaliser_update $widget } #page proc uwp_p_equaliser_draw_horizontal { widget } { uwp_op_array $widget options set c $widget.canvas foreach var { epadx epady ipadx ipady channel_number led_number channel_spacing led_spacing led_width led_height } { set $var $options($var) } set height [expr {2*$epadx+2*$ipadx+ $led_width*$channel_number+ $channel_spacing*($channel_number-1)}] set width [expr {2*$epadx+2*$ipadx+ $led_height*$led_number+ $led_spacing*($led_number-1)}] $c configure -width $width -height $height if { $options(box_display) } { $c create rectangle $epadx $epady \ [expr {$width-$epadx}] [expr {$height-$epady}] \ -outline $options(box_color) -tag Box } if { [string length $options(label)] } { set x1 [expr {$epadx+$ipadx+1}] set y1 $epady $c create text $x1 $y1 \ -anchor w -text $options(label) -fill $options(box_color) \ -font $options(label_font) -tag Label foreach {x1 y1 x2 y2} [$c bbox Label] {} $c create polygon $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 \ -fill [option get $c background {}] -tag LabelBack $c raise LabelBack Box $c raise Label LabelBack } set baseX [expr {$epadx+$ipadx}] set baseY [expr {$epady+$ipady}] for {set channel 0} {$channel < $channel_number} {incr channel} { for {set led 0} {$led < $led_number} {incr led} { set x1 [expr {$baseX+$led*($led_spacing+$led_height)}] set x2 [expr {$x1+$led_height}] set y1 [expr {$baseY+$channel*($channel_spacing+$led_width)}] set y2 [expr {$y1+$led_width}] $c create polygon $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 \ -tags $channel:$led } } uwp_equaliser_update $widget } #page proc uwp_equaliser_update { widget {levels {}} } { upvar \#0 uwp_data data uwp_op_array $widget options foreach var { led_number channel_number led_red_mark } { set $var $options($var) } for {set channel 0} {$channel < $channel_number} {incr channel} { set level [if {[llength $levels]} {lindex $levels $channel} {expr 0}] for {set led 0} {$led < $led_number} {incr led} { if { int(double($led_number)*$level) > $led } { set color on } else { set color off } if { double($led)/double($led_number) < $led_red_mark } { set color led_green_${color}_color } else { set color led_red_${color}_color } $widget.canvas itemconfigure $channel:$led -fill $options($color) } } } #page ## ------------------------------------------------------------ ## Let's go. ## ------------------------------------------------------------ main ### end of file # Local Variables: # mode: tcl # End: ====== <> Graphics | Widget | Broken Links