0) Set general window & widget parms (win-name, win-position,
win-color-scheme, fonts, widget-geometry-parms, win-size-control,
text-array-for-labels-etc).
1a) Define ALL frames (and sub-frames, if any).
1b) Pack ALL frames and sub-frames.
2) Define all widgets in the frames, frame by frame.
When the widgets for a frame are defined, pack them.
3) Define keyboard and mouse/touchpad/touch-sensitive-screen action
BINDINGS, if needed.
4) Define PROCS, if needed.
5) Additional GUI initialization (typically with one or more of
the procs), if needed.This structure is discussed in more detail on the page A Canonical Structure for Tk Code --- and variations.This structure makes it easy for me to find code sections --- while generating and testing a Tk script, and when looking for code snippets to include in Tk scripts (code re-use).To make the 'miniscale' widget to be used in step (2), I essentially inserted a new step:1c) Define any procs to be used in making widgets.You will find a 'miniscale' proc in that section (area) of the code._________________________________________________________________Like with the 'entry widget' version and the '6-spinboxes' version and the '6-scales' version of this utility, I have put the four main pack parameters --- '-side', '-anchor', '-fill', '-expand' --- on the pack command for the various frames and widgets. So Tcler's can experiment with these parameters if they want to change the behavior of the GUI when window size is changed.Furthermore, you can experiment with different font families, font weights, widget geometry (padding, borderwidth), widget and frame relief (raised, flat, ...). Tailor the GUI to your liking.And if you want to see what will happen if you try letting the color-gradient-canvas be redrawn as any of the 'miniscale' widgets is rapidly changing the numbers in its variable, you can enhance the 'miniscale' proc to take a proc as an argument --- so that a redraw proc can be passed to each call to the 'miniscale' proc (which defines each 'miniscale' widget).Note that there are <ButtonPress-1> bindings within the 'miniscale' proc (for the '+' and '-' buttons) --- and there are <ButtonRelease-1> bindings in the BINDINGS section of this code, for those same buttons. Note the difference:The <ButtonPress-1> bindings increment/decrement the numbers (more or less rapidly). The <ButtonRelease-1> bindings call on the 'DrawGradient' proc.Code for the Tk script 'make_gradient-on-canvas_6miniscales-2radiobuttons.tk' :
#!/usr/bin/wish -f
##
## SCRIPT: make_gradient-on-canvas_6miniscales-2radiobuttons.tk
##
## PURPOSE: This TkGUI script facilitates the creation of
## rectangular color-gradient images that can be used, for example,
## for the background of 'buttons' in GUIs such as 'toolchests'.
##
## A screen/window capture utility (like 'gnome-screenshot' on Linux)
## can be used to capture the image in a PNG file, say.
##
## Then, if necessary, an image editor (like 'mtpaint' on Linux)
## can be used to crop the window capture image to get only the
## rectangular area of the canvas containing the color-gradient
## --- or some sub-rectangle of that area.
##
## Furthermore, utilities (such as the ImageMagick 'convert' command
## on Linux) can be used to 'mirror' or 'flip' a gradient image in
## an image file (PNG or JPEG or GIF). The 'mirror' and 'flip'
## operations can be applied vertically or horizontally --- and
## can be applied multiple times, for various visual effects.
##
## The resulting rectangular color-gradient image can then be used as a
## background in Tk widgets, such as button or canvas or label widgets
## in 'toolchests' or other types of GUIs.
##
##+#####################
## GUI LAYOUT and METHOD:
##
## The GUI contains a rectangular canvas widget into which the
## color gradient is drawn with canvas 'create line' commands,
## where the lines can be either horizontal (in the x direction)
## or vertical (in the y direction).
##
## In addition to the canvas widget (in a bottom frame of the
## GUI window), there other frames of the GUI window:
## - one frame for 2 radiobuttons and an 'Exit' button.
## - 1 frame for 6 'miniscale' widgets.
##
## The 2 radiobuttons are to set the direction of the gradient ---
## in the x direction or the y direction.
##
## The 6 'miniscale' widgets are to set 2 pairs of RGB values --- of
## the form r1 g1 b1 r2 g2 b2 --- for the left-color (or top-color)
## and right-color (bottom-color) of the gradient.
##
## Examples of 2 settings of the radiobuttons and the 6 miniscales:
## x 255 255 0 255 0 0
## y 255 0 255 0 0 255
##
## The first example says draw the lines horizontally starting
## from yellow on the left to red on the right.
##
## The second example says draw the lines vertically starting
## from magenta at the top to blue on the bottom.
##
## The seven parms (x/y r1 g1 b1 r2 g2 b2)
## are passed into a 'DrawGradient' proc that draws the lines
## within the canvas, filling the canvas with colored pixels.
##
## There could be a 'command' parameter/argument for the miniscale widget
## which could be used to call the 'DrawGradient' proc to redraw
## the color-gradient in the canvas as any miniscale (slider) changes.
##
## However, the 'DrawGradient' proc may not be fast enough
## to re-draw all the gradient-lines in a smooth fashion as the
## miniscale values are changed.
##
## We can use a button1-release binding on each miniscale widget
## to trigger a call to the 'DrawGradient' proc. By the time
## the user mouse-releases one miniscale and goes to
## move-and-release another miniscale, the 'DrawGradient' proc
## can complete the re-draw.
##
## Thus we get a 'semi-dynamic' (not quite immediate) GUI-update
## action from the miniscales, rather than a fully 'dynamic'
## (immediate) GUI-update action.
##
## However, the user/programmer can experiment by commenting
## out the 12 button1-release 'bind ' statements, and
## implementing a 'command' parm for the 'miniscale' widget.
## Then the 'DrawGradient' proc could be passed to the 6 miniscale
## definition statements (calls to the 'miniscale' proc) ---
## and the command could be called within the loops of the
## increment and decrement procs of the miniscale widget/proc.
##
## REFERENCE:
## The 'DrawGradient' proc is based on a Tcl-Tk script by GPS and
## Damon Courtney --- published at http://wiki.tcl.tk/6100 -
## 'Drawing Gradients on a Canvas'. (downloaded 2011sep26)
## That script draws gradients on multiple rectangular canvases, packed
## top to bottom. You need to edit that script to change colors or
## gradient direction. No GUI for entry of those indicators is provided.
##+######################################################################
## 'CANONICAL' STRUCTURE OF THIS CODE:
##
## 0) Set general window parms (win-name,win-position,color-scheme,fonts,
## widget-geometry-parms,text-array-for-labels-etc).
## 1a) Define ALL frames (and sub-frames, if any).
## 1b) Pack the frames and sub-frames.
## 2) Define all widgets in the frames, frame-by-frame.
## When the widgets for a frame are defined, pack them.
##
## 3) Define keyboard and mouse/touchpad/touch-sensitive-screen
## 'event' BINDINGS, if needed.
## 4) Define PROCS, if needed.
## 5) Additional GUI INITIALIZATION (typically with one or two procs),
## if needed.
##
## The structure detail for this particular script:
##
## 1a) Define ALL frames:
##
## Top-level : '.fRbuttons' '.fRminiscales' '.fRcanvas'
##
## Sub-frames: none
##
## 1b) Pack ALL frames.
##
## 2) Define all widgets in the frames (and pack them):
##
## - In '.fRbuttons': 1 button widget ('Exit') and
## 2 radiobuttons (for x or y),
##
## - In the '.fRminiscales' frame: 6 miniscale widgets
## (with 2 label widgets for 2 triplets)
##
## - In '.fRcanvas': one 'canvas' widget
##
## 3) Define bindings: 2 x six, for the miniscale widget's '+' and '-' buttons
##
## 4) Define procs:
## - 'DrawGradient' invoked by the bindings on the miniscale widgets
## and on the 2 radiobuttons --- and invoked by
## the additional-GUI-initialization section, next
##
## 5) Additional GUI initialization: Execute 'DrawGradient' once with
## an initial, example set of 7 parms
## --- x/y r1 g1 b1 r2 g2 b2 --- to start
## with a color-gradient in the canvas
## rather than a blank canvas.
##+########################################################################
## DEVELOPED WITH:
## Tcl-Tk 8.5 on Ubuntu 9.10 (2009-october, 'Karmic Koala).
##
## $ wish
## % puts "$tcl_version $tk_version"
## showed 8.5 8.5 on Ubuntu 9.10.
##+#######################################################################
## MAINTENANCE HISTORY:
## Created by: Blaise Montandon 2012aug10
## Changed by: Blaise Montandon 2012sep08 Make some changes to make sure
## that STOPminiscale is set to 1 most
## of the time.
## Changed by: Blaise Montandon 2012nov18 Added braces to 9 'expr' statements.
## Provided more consistent indenting
## of the code. Touched up the comments
## to match the final code. Added a
## text-array for labels,buttons,etc.
## Improved calc of minsize of window.
## Moved canvas to bottom of GUI.
##+#######################################################################
##+#######################################################################
## Set WINDOW TITLES.
##+#######################################################################
wm title . "Draw-Color-Gradient in a Canvas"
wm iconname . "DrawGradient"
##+######################################################################
## Set WINDOW POSITION.
##+######################################################################
wm geometry . +15+30
##+######################################################
## Set the COLOR SCHEME for the window and its widgets ---
## radiobuttons.
##+######################################################
tk_setPalette "#e0e0e0"
set radbuttBKGD "#ffffff"
##+########################################################
## SET FONT-NAMES.
## We use a variable-width font for labels and buttons.
##
## We use a fixed-width font for entry fields, for easy access
## to narrow characters like i, j, l, and the number 1 ---
## in listboxes so that character columns in the list line up,
## and for text in a help window, so that columns will line up.
## However we do not have entry,listbox, or text widgets in
## this GUI --- unless we add a Help button.
##+########################################################
font create fontTEMP_varwidth \
-family {comic sans ms} \
-size -14 \
-weight bold \
-slant roman
font create fontTEMP_SMALL_varwidth \
-family {comic sans ms} \
-size -12 \
-weight bold \
-slant roman
## Some other possible (similar) variable width fonts:
## Arial
## Bitstream Vera Sans
## DejaVu Sans
## Droid Sans
## FreeSans
## Liberation Sans
## Nimbus Sans L
## Trebuchet MS
## Verdana
font create fontTEMP_fixedwidth \
-family {liberation mono} \
-size -14 \
-weight bold \
-slant roman
font create fontTEMP_SMALL_fixedwidth \
-family {liberation mono} \
-size -12 \
-weight bold \
-slant roman
## Some other possible fixed width fonts (esp. on Linux):
## Andale Mono
## Bitstream Vera Sans Mono
## Courier 10 Pitch
## DejaVu Sans Mono
## Droid Sans Mono
## FreeMono
## Nimbus Mono L
## TlwgMono
##+###########################################################
## SET GEOM VARS FOR THE VARIOUS WIDGET DEFINITIONS.
## (e.g. width and height of canvas, and padding for Buttons)
##+###########################################################
## CANVAS parms:
set initCanWidthPx 300
set initCanHeightPx 24
set minCanHeightPx 24
# set BDwidthPx_canvas 2
set BDwidthPx_canvas 0
## BUTTON parms:
set PADXpx_button 0
set PADYpx_button 0
set BDwidthPx_button 2
## LABEL parms:
set PADXpx_label 0
set PADYpx_label 0
set BDwidthPx_label 2
##+######################################################
## Set a MINSIZE of the window (roughly),
## according to the approx max WIDTH of the chars in the
## 'fRbuttons' frame.
##
## --- and according to the approx HEIGHT of the 4 frames
## --- 'fRbuttons', 'fRminiscales', 'fRinfo', 'fRcanvas'.
##+################################################################
## We allow the window to be resizable and we pack the canvas with
## '-fill both' so that the canvas can be enlarged by enlarging the
## window. Just click-release any of the miniscales (or radiobuttons)
## to re-fill the canvas with the user-specified color gradient.
##+################################################################
set minWinWidthPx [font measure fontTEMP_varwidth \
" Exit Gradient direction: x y"]
## Add some to account for right-left-side window border-widths
## (about 2x3=6 pixels) and widget border-widths --- about
## 4 widgets x 4 pixels/widget = 16 pixels.
set minWinWidthPx [expr {22 + $minWinWidthPx}]
## For MIN-HEIGHT, allow:
## 1 char high for 'fRbuttons',
## 2 chars high for 'fRminiscales',
## 3 chars high for 'fRinfo'
## 24 pixels high for 'fRcanvas'.
set minCharHeightPx [font metrics fontTEMP_varwidth -linespace]
## and add 1 for the radiobuttons frame.
set minWinHeightPx [expr { 24 + (6 * $minCharHeightPx)}]
## Add some to account for top-bottom window decoration (about 23 pixels)
## and frame/widget padding/borders (about
## 6 frames/widgets x 4 pixels/frame-widget = 24 pixels).
set minWinHeightPx [expr {47 + $minWinHeightPx}]
## FOR TESTING:
# puts "minWinWidthPx = $minWinWidthPx"
# puts "minWinHeightPx = $minWinHeightPx"
wm minsize . $minWinWidthPx $minWinHeightPx
## If you want to make the window un-resizable,
## you can use the following statement.
# wm resizable . 0 0
##+################################################
## Load a TEXT-ARRAY variable with text for
## labels and other GUI widgets --- to facilitate
## 'internationalization' of this script.
##+################################################
## if { "$VARlocale" == "en"}
set aRtext(buttonEXIT) "Exit"
set aRtext(labelDIR) " Gradient direction:"
set aRtext(labelRGB1) "RGB-left
or top :"
set aRtext(labelRGB2) "RGB-right
or bottom :"
set aRtext(labelINFO) "\
Mouse-button-1 down on the '+' or '-' buttons to change values.
Press the 'Ctrl' key, then button-1, to change 4 times faster.
Press the 'Shift' key, then button-1, for 16 times faster."
## END OF if { "$VARlocale" == "en"}
##+################################################################
## DEFINE *ALL* THE FRAMES:
##
## Top-level : 'fRbuttons' 'fRminiscales' 'fRinfo' 'fRcanvas'
##
## Sub-frames: none
##+################################################################
## FOR TESTING: (of expansion of frames, esp. during window expansion)
# set RELIEF_frame raised
# set BDwidth_frame 2
set RELIEF_frame flat
set BDwidth_frame 0
frame .fRbuttons -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame .fRminiscales -relief raised -borderwidth 2
frame .fRinfo -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame .fRcanvas -relief $RELIEF_frame -borderwidth $BDwidth_frame
##+##############################
## PACK the top-level FRAMES.
##+##############################
pack .fRbuttons \
.fRminiscales \
.fRinfo \
-side top \
-anchor nw \
-fill none \
-expand 0
pack .fRcanvas \
-side top \
-anchor nw \
-fill both \
-expand 1
## OK. All frames are defined and packed.
## Now, before defining the widgets within the frames,
## we make the 'miniscale' proc that is going to be
## used to make the 'miniscale' widgets.
##+#########################
## DEFINE PROC 'miniscale'
## (for use in making a couple 6 color-scale widgets below)
##+##############################################################
## By using font and widget-geometry global variables
## - fontTEMP_SMALL_varwidth
## - PADXpx_button
## - PADYpx_button
## - BDwidthPx_button
## - PADXpx_label
## - PADYpx_label
## - BDwidthPx_label
## for the decorative & geometric elements/parameters of the GUI,
## we keep the arguments of this widget-made-on-the-fly down
## to 8 MAIN ELEMENTS/VARIABLES:
##
## - the parent widget/window --- a (sub)frame widget,
##
## - the name of the variable that is to hold the current scale value,
##
## - the min value of the range of the scale,
## - the max value of the range of the scale,
##
## - an initial value at which to initially set the scale variable value
## --- and show in the 'label' widget of this 'miniscale' widget,
##
## - a 'resolution' of the scale, such as 1 or 5 or 0.1 or 0.25 or 0.002.
## Each click on the '+' or '-' button of the 'miniscale' widget increases
## or decreases the variable associated with this 'miniscale' widget,
## by an amount equal to this resolution value.
##
## - a non-fractional digits specification to allow space for the digits
## to the left of a decimal point --- which can keep the right-most digit
## in the same place, instead of shifting left/right as the magnitude
## of the scale value decreases/increases.
## Example: 3 to allow for values 0 to 255 to stay justified right.
## and 4 to allow values -1.0 to +1.0 in tenths to stay justified.
##
## - a fractional digits specification to make sure arithmetic precision errors
## do not result in numbers like 0.30000000000000004 instead of 0.3.
## Example values: 0 for integers and 1 for tenths.
##
## - a millisecs wait parameter
##+##############################################################
proc miniscale {w scalevar minval maxval initval unit nonfracdigits fracdigits milsecs} {
global fontTEMP_SMALL_varwidth fontTEMP_varwidth \
PADXpx_button PADYpx_button \
BDwidthPx_button BDwidthPx_label
##+###########################################
## DEFINE-and-PACK the widget SUB-FRAMES:
## '.fRup-down' for 2 up and down buttons and
## '.fRlabel' to show the current scale value.
## Pack them side by side.
##+###########################################
frame $w.fRlabelVAL -relief flat -bd 0
frame $w.fRup-down -relief flat -bd 0
pack $w.fRlabelVAL \
$w.fRup-down \
-side left \
-anchor w \
-fill y \
-expand 0
##+####################################################
## Initialize the 'miniscale' variable.
#######################################################
set $scalevar $initval
## FOR TESTING:
# puts "$scalevar : [set $scalevar]"
##+####################################################
## In FRAME '.fRlabel',
## DEFINE-and-PACK a label widget to show the current
## 'miniscale' widget value.
##+####################################################
label $w.fRlabelVAL.labelVAL \
-text "
$initval" \
-font fontTEMP_SMALL_varwidth \
-justify right \
-anchor e \
-width [expr $nonfracdigits + $fracdigits] \
-relief flat \
-fg red \
-bd $BDwidthPx_label
pack $w.fRlabelVAL.labelVAL \
-side top \
-anchor n \
-fill none \
-expand 0
##+####################################################
## In FRAME '.fRup-down',
## DEFINE-and-PACK a top-spacer label and 2 buttons.
##+####################################################
button $w.fRup-down.buttUP \
-text "+" \
-font fontTEMP_SMALL_varwidth \
-width 1 -height 1 \
-pady 0 \
-padx 0 \
-command ""
# -command "increment_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits $milsecs"
button $w.fRup-down.buttDOWN \
-text "-" \
-width 1 -height 1 \
-font fontTEMP_SMALL_varwidth \
-pady 0 \
-padx 0 \
-command ""
# -command "decrement_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits $milsecs"
pack $w.fRup-down.buttUP \
$w.fRup-down.buttDOWN \
-side top \
-anchor n \
-fill none \
-expand 0
##+#####################################################
## SET BINDING on the buttons in this new-widget so that
## <ButtonPress-1> increments/decrements the
## scalevar rapidly as the button continues to
## be pressed.
##+#####################################################
bind $w.fRup-down.buttUP <ButtonPress-1> \
"increment_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits [expr 16 * $milsecs]"
bind $w.fRup-down.buttUP <Control-ButtonPress-1> \
"increment_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits [expr 4 * $milsecs]"
bind $w.fRup-down.buttUP <Shift-ButtonPress-1> \
"increment_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits $milsecs"
bind $w.fRup-down.buttDOWN <ButtonPress-1> \
"decrement_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits [expr 16 * $milsecs]"
bind $w.fRup-down.buttDOWN <Control-ButtonPress-1> \
"decrement_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits [expr 4 * $milsecs]"
bind $w.fRup-down.buttDOWN <Shift-ButtonPress-1> \
"decrement_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits $milsecs"
##+#####################################################
## SET BINDING on the buttons in this new-widget so that
## <ButtonRelease-1> sets the STOPminiscale to 1 (stop)
## --- to help assure the scalevar quits changing
## when the user stops pressing Button1.
##+#####################################################
bind $w.fRup-down.buttUP <ButtonRelease-1> \
"set STOPminiscale 1"
bind $w.fRup-down.buttDOWN <ButtonRelease-1> \
"set STOPminiscale 1"
##+#####################################################
## SET BINDING on the buttons in this new-widget so that
## <Leave> sets the STOPminiscale to 1 (stop)
## --- to help assure the scalevar quits changing
## when the user 'leaves' the button.
##
## Also we use <Leave> as an opportunity to make sure a
## miniscale button is returned to a raised condition when
## the user is through with the button.
##+#####################################################
bind $w.fRup-down.buttUP <Leave> "set STOPminiscale 1 ; \
$w.fRup-down.buttUP config -relief raised"
bind $w.fRup-down.buttDOWN <Leave> "set STOPminiscale 1 ; \
$w.fRup-down.buttDOWN config -relief raised"
## For more safety --- to help assure the scalevar quits
## changing if it continues to increment/decrement ---
## we set STOPminiscale to 1 as we ENTER a miniscale button.
bind $w.fRup-down.buttUP <Enter> "set STOPminiscale 1"
bind $w.fRup-down.buttDOWN <Enter> "set STOPminiscale 1"
################################################################
## Initialize STOPminiscale.
## STOPminiscale is used in the 2 increment & decrement procs below to
## signal the increment/decrement loop when to stop.
## For safety, we set it to 'stop' (1).
## We set it to 0 only when we enter the increment/decrement proc.
###############################################################
global STOPminiscale
set STOPminiscale 1
##+########################################################
## PROC 'increment_miniscale' -
##
## CALLED BY: 'ButtonPress-1' binding on the '+' button.
##+########################################################
proc increment_miniscale {w scalevar minval maxval unit nonfracdigits fracdigits milsecs} {
## This 'upvar' associates the local var 'cur_scale_var' with
## the outer var 'scalevar' that is to contain the scale value.
## It is like an EQUIVALENCE statement in FORTRAN.
upvar #0 $scalevar cur_scale_val
global STOPminiscale
## The only 2 places where STOPminiscale is set to 0 (off) is in
## the increment and decrement miniscale procs.
## In your editor on your code, you can use Find to make
## sure that that is true.
set STOPminiscale 0
while { $STOPminiscale != 1} {
## FOR TESTING:
# puts "cur_scale_val: $cur_scale_val"
set cur_scale_val [expr $cur_scale_val + $unit]
if { $cur_scale_val > $maxval} {
set cur_scale_val $maxval
set STOPminiscale 1
}
set cur_scale_val [format %${nonfracdigits}.${fracdigits}f $cur_scale_val]
$w.fRlabelVAL.labelVAL configure -text "
$cur_scale_val"
## Slow down the change of the scale to human reaction time levels.
after $milsecs
## 'update' is needed to check for a button-release or leave event
## that sets STOPminiscale to 1.
update
## FOR TESTING:
# puts "cur_scale_val: $cur_scale_val"
}
## END OF LOOP while { $STOPminiscale != 1}
## The following are not needed.
# set $scalevar $cur_scale_val
## FOR TESTING:
# puts "$scalevar : [set $scalevar]"
}
## END OF proc 'increment_miniscale'
##+########################################################
## PROC 'decrement_miniscale' -
##
## CALLED BY: 'ButtonPress-1' binding on the '-' button.
##+########################################################
proc decrement_miniscale {w scalevar minval maxval unit nonfracdigits fracdigits milsecs} {
## This 'upvar' associates the local var 'cur_scale_var' with
## the outer var 'scalevar' that is to contain the scale value.
## It is like an EQUIVALENCE statement in FORTRAN.
upvar #0 $scalevar cur_scale_val
global STOPminiscale
## The only 2 places where STOPminiscale is set to 0 (off) is in
## the increment and decrement miniscale procs.
## In your editor on your code, you can use Find to make
## sure that that is true.
set STOPminiscale 0
while { $STOPminiscale != 1} {
## FOR TESTING:
# puts "cur_scale_val: $cur_scale_val"
set cur_scale_val [expr $cur_scale_val - $unit]
if { $cur_scale_val < $minval} {
set cur_scale_val $minval
set STOPminiscale 1
}
set cur_scale_val [format %${nonfracdigits}.${fracdigits}f $cur_scale_val]
$w.fRlabelVAL.labelVAL configure -text "
$cur_scale_val"
## Slow down the change of the scale to human reaction time levels.
after $milsecs
## 'update' is needed to check for a button-release or leave event
## that sets STOPminiscale to 1.
update
## FOR TESTING:
# puts "cur_scale_val: $cur_scale_val"
}
## END OF LOOP while { $STOPminiscale != 1}
## The following are not needed.
# set $scalevar $cur_scale_val
## FOR TESTING:
# puts "$scalevar : [set $scalevar]"
}
## END OF proc 'decrement_miniscale'
}
## END OF 'miniscale' PROC
##+#########################################################
## OK. Now we are ready to define the widgets in the frames.
##+#########################################################
##+################################################################
## IN THE '.fRbuttons' frame -
## DEFINE the 'Exit' button --- and
## 2 radiobuttons (with a label button).
##+################################################################
button .fRbuttons.buttEXIT \
-text "$aRtext(buttonEXIT)" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {exit}
## Define label and 2 radiobuttons:
label .fRbuttons.labDIR \
-text "$aRtext(labelDIR)" \
-font fontTEMP_varwidth \
-justify left \
-anchor w \
-padx $PADXpx_label \
-pady $PADYpx_label \
-relief flat \
-bd $BDwidthPx_label
## Initialize the values of the radiobuttons.
set curDIRECTION "x"
radiobutton .fRbuttons.radbuttX \
-text "x" \
-font fontTEMP_varwidth \
-anchor w \
-variable curDIRECTION \
-value "x" \
-selectcolor "$radbuttBKGD" \
-relief flat \
-bd $BDwidthPx_button
radiobutton .fRbuttons.radbuttY \
-text "y" \
-font fontTEMP_varwidth \
-anchor w \
-variable curDIRECTION \
-value "y" \
-selectcolor "$radbuttBKGD" \
-relief flat \
-bd $BDwidthPx_button
##+##############################################
## Pack ALL the widgets in the 'fRbuttons' frame.
##+##############################################
pack .fRbuttons.buttEXIT \
.fRbuttons.labDIR \
.fRbuttons.radbuttX \
.fRbuttons.radbuttY \
-side left \
-anchor w \
-fill none \
-expand 0
##+#################################################################
## IN THE '.fRminiscales' frame -
## DEFINE A LABEL and 3 'miniscale' WIDGETS, and
## another LABEL and 3 'miniscale' WIDGETS.
##+#################################################################
##
## NOTE: We define a frame here to hold each 'miniscale' widget ---
## instead of in the define-and-pack-all-frames section above.
## We define a frame here rather than above, because these
## frames are actually the widget (at least, the container
## of the widget).
##+#################################################################
label .fRminiscales.labelRGB1 \
-text "$aRtext(labelRGB1)" \
-width 10 \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-relief flat \
-bd $BDwidthPx_label
## DEFINE the 'miniscale' widget for 'curR1'.
frame .fRminiscales.fRminiscaleR1 -relief raised -bd 2
set curR1 255
miniscale .fRminiscales.fRminiscaleR1 curR1 0 255 $curR1 1 3 0 10
## Parms: w scalevar minval maxval initval unit nonfracdigit fracdigit milsecs
## DEFINE the 'miniscale' widget for 'curG1'.
frame .fRminiscales.fRminiscaleG1 -relief raised -bd 2
set curG1 255
miniscale .fRminiscales.fRminiscaleG1 curG1 0 255 $curG1 1 3 0 10
## Parms: w scalevar minval maxval initval unit nonfracdigit fracdigit milsecs
## DEFINE the 'miniscale' widget for 'curB1'.
frame .fRminiscales.fRminiscaleB1 -relief raised -bd 2
set curB1 0
miniscale .fRminiscales.fRminiscaleB1 curB1 0 255 $curB1 1 3 0 10
## Parms: w scalevar minval maxval initval unit nonfracdigit fracdigit milsecs
##+########################################################
## THE 2nd 3 RGB 'miniscale' widgets -- with LABEL:
##+########################################################
label .fRminiscales.labelRGB2 \
-text "$aRtext(labelRGB2)" \
-width 12 \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-relief flat \
-bd $BDwidthPx_label
## DEFINE the 'miniscale' widget for 'curR2'.
frame .fRminiscales.fRminiscaleR2 -relief raised -bd 2
set curR2 255
miniscale .fRminiscales.fRminiscaleR2 curR2 0 255 $curR2 1 3 0 10
## Parms: w scalevar minval maxval initval unit nonfracdigit fracdigit milsecs
## DEFINE the 'miniscale' widget for 'curG2'.
frame .fRminiscales.fRminiscaleG2 -relief raised -bd 2
set curG2 0
miniscale .fRminiscales.fRminiscaleG2 curG2 0 255 $curG2 1 3 0 10
## Parms: w scalevar minval maxval initval unit nonfracdigit fracdigit milsecs
## DEFINE the 'miniscale' widget for 'curB2'.
frame .fRminiscales.fRminiscaleB2 -relief raised -bd 2
set curB2 0
miniscale .fRminiscales.fRminiscaleB2 curB2 0 255 $curB2 1 3 0 10
## Parms: w scalevar minval maxval initval unit nonfracdigit fracdigit milsecs
##+##########################################################
## Pack ALL the widgets in the '.fRminiscales' FRAME ---
## the 2 LABELs & 6 'miniscale' widgets.
##+##########################################################
pack .fRminiscales.labelRGB1 \
.fRminiscales.fRminiscaleR1 \
.fRminiscales.fRminiscaleG1 \
.fRminiscales.fRminiscaleB1 \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRminiscales.labelRGB2 \
.fRminiscales.fRminiscaleR2 \
.fRminiscales.fRminiscaleG2 \
.fRminiscales.fRminiscaleB2 \
-side left \
-anchor w \
-fill none \
-expand 0
##+######################################################
## In the '.fRinfo' FRAME -
## DEFINE-and-PACK a 'label' widget.
##+######################################################
label .fRinfo.labelINFO \
-text "$aRtext(labelINFO)" \
-font fontTEMP_SMALL_varwidth \
-justify left \
-anchor w \
-padx $PADXpx_label \
-pady $PADYpx_label \
-relief flat \
-bd $BDwidthPx_label
pack .fRinfo.labelINFO \
-side top \
-anchor nw \
-fill x \
-expand 0
##+###############################
## In the '.fRcanvas' frame -
## DEFINE-and-PACK CANVAS WIDGET.
##+###############################
## We set highlightthickness & borderwidth of the canvas to
## zero, as suggested on page 558, Chapter 37, 'The Canvas
## Widget', in the 4th edition of the book 'Practical
## Programming in Tcl and Tk'.
##+######################################################
canvas .fRcanvas.can \
-width $initCanWidthPx \
-height $initCanHeightPx \
-relief flat \
-highlightthickness 0 \
-borderwidth 0
pack .fRcanvas.can \
-side top \
-anchor nw \
-fill both \
-expand 1
## OK. All widgets are defined and packed.
## Now define bindings and procs.
##+#######################################################################
## BINDINGS SECTION:
## - one each, for button1-release on each of the 6 miniscales
## - one each, for button1-release on each of the 2 radiobuttons
##+#######################################################################
if {1} {
bind .fRminiscales.fRminiscaleR1.fRup-down.buttUP <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
bind .fRminiscales.fRminiscaleR1.fRup-down.buttDOWN <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
bind .fRminiscales.fRminiscaleG1.fRup-down.buttUP <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
bind .fRminiscales.fRminiscaleG1.fRup-down.buttDOWN <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
bind .fRminiscales.fRminiscaleB1.fRup-down.buttUP <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
bind .fRminiscales.fRminiscaleB1.fRup-down.buttDOWN <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
bind .fRminiscales.fRminiscaleR2.fRup-down.buttUP <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
bind .fRminiscales.fRminiscaleR2.fRup-down.buttDOWN <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
bind .fRminiscales.fRminiscaleG2.fRup-down.buttUP <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
bind .fRminiscales.fRminiscaleG2.fRup-down.buttDOWN <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
bind .fRminiscales.fRminiscaleB2.fRup-down.buttUP <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
bind .fRminiscales.fRminiscaleB2.fRup-down.buttDOWN <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
## button1 release bindings on 2 radiobuttons:
## (To make sure a scale is still not rolling over, even when the user
## definitely does not have MB1 over a miniscale button, set STOPminiscale to 1.)
bind .fRbuttons.radbuttX <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
bind .fRbuttons.radbuttY <ButtonRelease-1> {set STOPminiscale 1 ; DrawGradient \
.fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2}
}
## END OF 'if {1/0}' SECTION
## To easily disable the bindings.
##+######################################################################
## PROCS SECTION:
## - 'DrawGradient' to fill the specified canvas according to the
## 7 parms --- x/y r1 g1 b1 r2 g2 b2
##+######################################################################
##+#####################################################################
## proc DrawGradient -
##
## PURPOSE:
## Draws the gradient on the canvas using canvas 'create line'
## commands. Draws vertical or horizontal lines according to
## the axis-specification: 'x' or 'y'. Interpolates between
## 2 RGB colors.
##
## CALLED BY: bindings on 6 'miniscale' widgets and 2 radiobuttons,
## and in the additional-GUI-initialization section at
## the bottom of this script.
##+####################################################################
proc DrawGradient {win axis r1 g1 b1 r2 g2 b2} {
global ENTRYstring
# $win delete TAGgradient
set width [winfo width $win]
set height [winfo height $win]
switch -- $axis {
"x" { set max $width; set x 1 }
"y" { set max $height; set x 0 }
default {
## We could put the error msg on the end of the user-entry
## in the entry-field.
# set ENTRYstring "$ENTRYstring ERR: Invalid 1st parm. Must be x or y."
# return
return -code error "Invalid 1st parm: $axis. Must be x or y"
}
}
if { $r1 > 255 || $r1 < 0 } {
return -code error "Invalid color value for r1: $r1"
}
if { $g1 > 255 || $g1 < 0 } {
return -code error "Invalid color value for g1: $g1"
}
if { $b1 > 255 || $b1 < 0 } {
return -code error "Invalid color value for b1: $b1"
}
if { $r2 > 255 || $r2 < 0 } {
return -code error "Invalid color value for r2: $r2"
}
if { $g2 > 255 || $g2 < 0 } {
return -code error "Invalid color value for g2: $g2"
}
if { $b2 > 255 || $b2 < 0 } {
return -code error "Invalid color value for b2: $b2"
}
set rRange [expr {$r2 - double($r1)}]
set gRange [expr {$g2 - double($g1)}]
set bRange [expr {$b2 - double($b1)}]
set rRatio [expr {$rRange / $max}]
set gRatio [expr {$gRange / $max}]
set bRatio [expr {$bRange / $max}]
for {set i 0} {$i < $max} {incr i} {
set nR [expr {int( $r1 + ($rRatio * $i) )}]
set nG [expr {int( $g1 + ($gRatio * $i) )}]
set nB [expr {int( $b1 + ($bRatio * $i) )}]
set col [format {%2.2x} $nR]
append col [format {%2.2x} $nG]
append col [format {%2.2x} $nB]
## FOR TESTING:
# puts "col = $col"
if {$x} {
$win create line $i 0 $i $height -tags TAGgradient -fill "#$col"
} else {
$win create line 0 $i $width $i -tags TAGgradient -fill "#$col"
}
}
}
## END OF proc DrawGradient
##+#####################################################
## Additional GUI initialization, if needed (or wanted).
##+#####################################################
update
## 'update' is needed before DrawGradient so that the
## canvas width and height are implemented.
## DrawGradient uses 'winfo' to get those dimensions.
DrawGradient .fRcanvas.can $curDIRECTION \
$curR1 $curG1 $curB1 $curR2 $curG2 $curB2
Like I said at the bottom of the A color-gradient-button-maker GUI page:Make one enhancement to a Tk script and it leads to other enhancements or completely new scripts. It never ends.But, hopefully, this ends (at least for a few months --- or weeks?) my attempts to make a better color-gradient-maker GUI.__________________Thanks to Richard Suchenwirth for his 'spinner' widget demo on the spinbox page. That led me to make a similar 'minilistbox' widget --- and then to making this 'miniscale' widget --- using widgets ('label' and 'button') that have existed since Tcl-Tk 7.x. Hence the 'miniscale' widget should work for people with old versions of the 'wish' interpreter.
uniquename 2012nov19 Update:I am going through some of my old scripts making a few changes based on experiences gained over the past few months. Changes to this script:
- Added braces to 9 'expr' statements. (Should increase the draw speed some. It might be feasible to implement a 'command' option for the 'miniscale' widgets, instead of using the button1-release bindings.)
- Provided more consistent indenting of the code (removed some whitespace from the front of many lines).
- Touched up the comments to match the final code.
- Added a text-array for text in labels,buttons,etc. --- to facilitate 'internationalization' of the GUI.
- Improved calculation of 'minsize' of window.
- Moved canvas from top of GUI to bottom.
