# 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 <Return> main_exit
bind . <Escape> 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:
