Gnocl Cookbook‎ > ‎

Progress Wheel





# !/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
    "
}

if 0 {
    # draw grey disc to give appearance of a ring
if $vars(ring) {
    append actions     "
    set_source_rgb {0.5 0.5 0.5}
    arc { $cx $cy $radius2 0 360 }
    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.2

    gnocl::update

}

demo

set myVAR 100


ċ
progress-wheel-widget.tcl
(10k)
William Giddings,
27 Mar 2019, 01:39
Comments