gnocl::drawingArea
WJG (13/03/18) The gnocl::drawingArea is an unusual widget. Unusual in the sense that it doesn’t really do much on its own. As a binding to the GtkDrawingArea object, the gnocl::drawingArea widget offers all the event trapping and cairo drawing operations necessary to build custom widgets without faffing around with any C coding.
Here’s an example:
This object creates a simple progress wheel which can either be a hollow circle or a solid disk. It offers some advantages over a rectangular progressbar such as embedding it snugly into a toolbar or statusbar.
Here’s the script.
# !/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
package require Gnocl
package provide progressWheel
#---------------
# increment any number, including doubles
# https://wiki.tcl-lang.org/1476
#---------------
#
proc gnocl::+= { varName step {precision 0} } {
upvar 1 $varName var
set var [format "%.${precision}f" [expr {$var+$step}]]
} ;# RS
#---------------
# limit value to range
#---------------
#
proc gnocl::clamp {varName {min 0.0} {max 1.0} } {
upvar 1 $varName var
if { $var >= $max } {
return $max
} elseif { $var <= $min } {
return $min
}
}
#---------------
# begin widget construction
#---------------
#
namespace eval gnocl::progressWheel {}
#---------------
# lists of valid widget options, commands and components
#---------------
#
set gnocl::progressWheel::opts { -data -name -alias -tooltip }
set gnocl::progressWheel::cmds { configure cget class opts cmds delete }
append gnocl::progressWheel::opts { -myEvent -ring -step -swap }
append gnocl::progressWheel::cmds { set draw_ step }
#set gnocl::progressWheel::val 0.0
#---------------
# Redraw proc for whenever the widget is exposed.
#---------------
#
proc gnocl::progressWheel::redraw { w } {
array set vars $::gnocl::progressWheel::vars([$w parent]_)
set x 0
set y 0
set height 100
set width 100
set padding 5
lassign [$w geometry] x y width height
set angle [format "%.2f" [expr -90 + (360.0*$vars(val)) ]]
set diameter $height
if { $height > $width } { set diameter $width }
set radius [expr $diameter/2 - $padding]
set radius2 [expr $radius/2]]
set cx [expr $width/2]
set cy [expr $height/2]
if { $vars(swap) } {
set clr(1) "1 0 0"
set clr(2) "1 1 1"
} else {
set clr(1) "1 1 1"
set clr(2) "1 0 0"
}
if $vars(ring) {
# draw circle on grey background
set lw1 [expr $radius / 2]
set lw2 [expr $lw1 * 0.5]
set radius [expr $radius - $lw1/2 ]
set actions "
set_source_rgb {0.5 0.5 0.5}
rectangle {0 0 $width $height}
fill
set_line_cap round
set_line_width $lw1
set_source_rgb {$clr(1)}
arc { $cx $cy $radius 0 360 }
stroke
set_line_width $lw2
set_source_rgb {$clr(2)}
arc { $cx $cy $radius -90 $angle }
stroke
"
} else {
# draw disc on grey background
set actions "
set_source_rgb {0.5 0.5 0.5}
rectangle {0 0 $width $height}
fill
set_source_rgb {$clr(1)}
arc { $cx $cy $radius 0 360 }
fill
move_to {$cx $cy}
set_source_rgb {$clr(2)}
arc { $cx $cy $radius -90 $angle }
fill
"
}
$w configure -actions $actions
}
#---------------
#
#---------------
#
proc gnocl::progressWheel::setVal { wid val } {
foreach { w id } $gnocl::progressWheel::components($wid) { set $w $id }
if { $val < 0.0 || $val > 1.0 } { puts ERROR! ; exit }
set gnocl::progressWheel::vars($wid) [lreplace $gnocl::progressWheel::vars($wid) 1 1 $val]
gnocl::progressWheel::redraw $da
$da configure -tooltip $val
$da draw
return $val
}
#---------------
#
#---------------
#
proc gnocl::progressWheel::swap { wid } {
foreach {a b} $gnocl::progressWheel::vars($wid) { set $a $b }
set swap [gnocl::toggle swap]
set gnocl::progressWheel::vars($wid) [lreplace $gnocl::progressWheel::vars($wid) 5 5 $swap]
}
#---------------
# Increment wheel display by one step.
#---------------
#
proc gnocl::progressWheel::step { wid } {
foreach { w id } $gnocl::progressWheel::components($wid) { set $w $id }
foreach { a b } $gnocl::progressWheel::vars($wid) { set $a $b }
set val [expr $val + $step ]
set val [format "%.3f" $val]
if {$val > 1.0} {
set val $step
set swap [gnocl::toggle $swap]
}
set gnocl::progressWheel::vars($wid) [lreplace $gnocl::progressWheel::vars($wid) 1 1 $val]
set gnocl::progressWheel::vars($wid) [lreplace $gnocl::progressWheel::vars($wid) 5 5 $swap]
gnocl::progressWheel::redraw $da
$da configure -tooltip $val
$da draw
return $val
}
#---------------
# implement widget commands
#---------------
#
proc gnocl::progressWheel::cmd { wid cmd args } {
gnocl::progressWheel::check $cmd
# get list of members
foreach { w id } $gnocl::progressWheel::components($wid) { set $w $id }
# apply the commands
switch -- $cmd {
swap { gnocl::progressWheel::swap $wid }
step { return [gnocl::progressWheel::step $wid] }
set { gnocl::progressWheel::setVal $wid $args }
opts -
cmds { return [ lsort [ set gnocl::progressWheel::$cmd ] ] }
class { return "progressWheel" }
configure -
delete -
cget { {*}"gnocl::progressWheel::$cmd $wid $args" }
default { # shouldn't need to get here, but... }
}
}
#---------------
# retrieve current component values
#---------------
#
proc gnocl::progressWheel::cget { wid args } {
gnocl::progressWheel::check $args
# get list of members
foreach { w id } $gnocl::progressWheel::components($wid) { set $w $id }
# obtain current settings
foreach { a b } $args {
# apply according to each component
switch -- $a {
-onClicked -
-text { return [ $but_1 cget $a ] }
-data { return [ $wid cget $a ] }
-name { return $::gnocl::progressWheel::names($wid) }
default { # shouldn't need to get here, but... }
}
}
}
#---------------
# check options and commands for valid values
#---------------
#
proc gnocl::progressWheel::check { opts } {
# test for a valid options
if { [string first - $opts ] >= 0 } {
foreach { opt val } $opts {
if { [string first $opt $gnocl::progressWheel::opts] == -1 } {
append errmsg [string repeat - 17]\n
append errmsg "ERROR! Invalid gnocl::gnocl::progressWheel option \"$opt\".\n"
append errmsg "Should be one of: [lsort $gnocl::progressWheel::opts]\n"
append errmsg [string repeat - 17]\n
error $errmsg
}
}
return
}
# test for valid command
foreach { cmd } $opts {
if { [string first $cmd $gnocl::progressWheel::cmds] == -1 } {
append errmsg [string repeat - 17]\n
append errmsg "ERROR! Invalid gnocl::gnocl::progressWheel command \"$cmd\".\n"
append errmsg "Should be one of: [lsort $gnocl::progressWheel::cmds]\n"
append errmsg [string repeat - 17]\n
error $errmsg
}
}
}
#---------------
# configure widget components
#---------------
#
proc gnocl::progressWheel::configure { wid args } {
gnocl::progressWheel::check $args
# recover list of widget components
foreach {w id} $::gnocl::progressWheel::components($wid) {set $w $id}
array set vars $::gnocl::progressWheel::vars($wid)
# apply new options
foreach {a b} $args {
# apply according to each component
switch -- $a {
-alias {
interp alias {} $b {} $wid
}
-name {
#interp alias {} $b {} $wid
$da configure -name $b
}
-ring {
set gnocl::progressWheel::vars($wid) [lreplace $gnocl::progressWheel::vars($wid) 7 7 $b]
gnocl::progressWheel::redraw $da
$da draw
}
-data {
$wid configure $a $b
}
-swap {
}
default { # shouldn't need to get here, but... }
}
}
}
#---------------
# delete widget and clean up
#---------------
#
proc gnocl::progressWheel::delete { wid } {
$wid delete
array unset gnocl::progressWheel::names $wid
array unset gnocl::progressWheel::components $wid
}
#---------------
# create and assemble widget components
#---------------
#
proc gnocl::progressWheel::construct {} {
set diameter 100
set radius [expr $diameter-4/2]
set cx $radius
set cy $radius
# set some defaults
set val 0.000
set step 0.050
# create components
set da [gnocl::drawingArea -name DA -actions fill ]
# create object container
set vbox [gnocl::vBox -borderWidth 0]
# assemble components
$vbox add $da -fill {1 1} -expand 1
# add to listing
set ::gnocl::progressWheel::components(${vbox}_) [list da $da]
# set some widget specific variables
set ::gnocl::progressWheel::vars(${vbox}_) [list val $val step $step swap 0 ring 0]
$da configure -tooltip $val
$da configure -onExpose { gnocl::progressWheel::redraw %w }
return $vbox
}
#---------------
# the widget command itself
#---------------
#
proc gnocl::progressWheel { args } {
set wid [gnocl::progressWheel::construct]
# overload the box to add commands
rename $wid ${wid}_
# configure
{*}"gnocl::progressWheel::configure ${wid}_ $args"
# widget command
proc $wid { cmd args } {
set wid [lindex [::info level 0] 0]
{*}"gnocl::progressWheel::cmd ${wid}_ $cmd $args"
}
return $wid
}
#===============
# DEMO
#===============
proc demo {} {
set wid(1) [gnocl::progressWheel \
-name PW \
-data "HO HI HO!" \
-name campers]
set wid(2) [gnocl::button \
-text incr \
-data $wid(1) \
-onClicked {
puts [%d step] } ]
set wid(3) [gnocl::button \
-text reset \
-data $wid(1) \
-onClicked { puts [%d set 0.000] } ]
set wid(4) [gnocl::toggleButton \
-data $wid(1) \
-text ring/circle \
-onToggled { %d configure -ring %v } ]
gnocl::vBox -name vbox
vbox add $wid(1) -fill {1 1} -expand 1
vbox add $wid(2)
vbox add $wid(3)
vbox add $wid(4)
gnocl::window -child [vbox] -setSize 0.250
gnocl::update
}
demo
set myVAR 100