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:

WikiDBImage GnoclDrawingArea

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