From: <ro...@us...> - 2014-12-05 14:59:21
|
Revision: 2222 http://sourceforge.net/p/nsclspectcl/code/2222 Author: ron-fox Date: 2014-12-05 14:59:12 +0000 (Fri, 05 Dec 2014) Log Message: ----------- EvbUI - provides event builder user interface widget for SpecTcl controls. Added Paths: ----------- branches/LLNLMadcChainSpecTcl-mtdcdev/eventbuildergui.tcl Added: branches/LLNLMadcChainSpecTcl-mtdcdev/eventbuildergui.tcl =================================================================== --- branches/LLNLMadcChainSpecTcl-mtdcdev/eventbuildergui.tcl (rev 0) +++ branches/LLNLMadcChainSpecTcl-mtdcdev/eventbuildergui.tcl 2014-12-05 14:59:12 UTC (rev 2222) @@ -0,0 +1,137 @@ +# +#****************************************************************************** +# +# Via Vetraia, 11 - 55049 - Viareggio ITALY +# +390594388398 - www.caen.it +# +#***************************************************************************//** +# + +## +# @file eventbuilderui.tcl +# @brief Graphical user interface for the event builder. +# @author Ron Fox (rfo...@gm...) + +package require Tk +package require snit + +## +# @class EvbUI +# +# Provides all of the user interface elements required to control +# how the event builder works. At present, this means being able to +# control the event builder build window (evb.buildWindow). +# This is managed via a ttk::spinbox. We want the spin box to have a mininum +# value of 0 and be unbounded at the upper end. This is accomplished by +# registering for the <<Increment>> and <<Decrement>> Events and managing +# the spinbox value ourself. +# +snit::widgetadaptor EvbUI { + component spinbox + + option -value -default 0 -configuremethod _set + option -command -default [list] + + delegate option -increment to spinbox + + ## + # constructor + # - Make the hull a ttk::frame + # - grid the spinbox into that grid. + # - Establish event handlers for the <<Increment>> <<Decrement>> events. + # - Run the configuration. + # + constructor args { + installhull using ttk::frame + + install spinbox using ttk::spinbox $win.spinner \ + -validate key -validatecommand [mymethod _validate %P] \ + -from 0 -to 0; # -from/-to set so built in won't inc/dec. + grid $spinbox -sticky ewn + + bind $spinbox <<Increment>> [mymethod _inc] + bind $spinbox <<Decrement>> [mymethod _dec] + + $spinbox set 0 + + $self configurelist $args + } + + ## + # _set + # Configure method for -value, sets the spinbox value text. + # @note the spin box value must be an integer. + # + # @param optname - name of the option being configured + # @param optval - new value. + # + method _set {optname optval} { + if {![string is integer -strict $optval] && ($optval >= 0)} { + error "-value must be an integer >= 0 was $optval" + } + $spinbox set $optval + set options($optname) $optval + $self _dispatch + } + ## + # _inc + # Called in response to the increment event. Increment the value of the + # entry. + # + method _inc {} { + set value [$spinbox get] + incr value + if {$value > [$spinbox cget -to]} { + $spinbox configure -to $value + } + $spinbox set $value + $self _dispatch + } + ## + # _dec + # Called in response to the decrement event. Decrement the value of + # the entry unless it would become less than zero. + # + method _dec {} { + set value [$spinbox get] + incr value -1 + if {$value >= 0} { + $spinbox set $value + $self _dispatch + } else { + bell + } + } + ## + # _validate + # Validation after a keystroke in the entry part of the spinbox. + # Serves the dual function of ensuring the result is an integer >=- + # and scheduling a dispatch of the -command option if so. + # + # @param proposed - new proposed value for the entry. + # @return boolean true if validates false otherwise. + # + method _validate {proposed} { + if {[string is integer -strict $proposed] && ($proposed >= 0)} { + after 10 [mymethod _dispatch]; # After in case event propagation is needed. + return true + + } else { + bell + return false + } + } + ## + # _dispatch + # Dispatches the -command script if it is defined. + # Users can substitute %V to get the value of the spinbox at the time of + # the dispatch. + # + method _dispatch {} { + set script $options(-command) + if {$script ne ""} { + set script [string map [list %V [$spinbox get]] $script] + uplevel #0 $script + } + } +} \ No newline at end of file This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |