'''[WJG]''' (13/03/18) The '''gnocl::drawingArea''' is an unusual widget. Unusual on 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: [WikiDBImage GnoclDrawingArea] This object offers 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 # http://wiki.tcl.tk/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 ======