#!/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 ## increments/decrements the ## scalevar rapidly as the button continues to ## be pressed. ##+##################################################### bind $w.fRup-down.buttUP \ "increment_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits [expr 16 * $milsecs]" bind $w.fRup-down.buttUP \ "increment_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits [expr 4 * $milsecs]" bind $w.fRup-down.buttUP \ "increment_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits $milsecs" bind $w.fRup-down.buttDOWN \ "decrement_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits [expr 16 * $milsecs]" bind $w.fRup-down.buttDOWN \ "decrement_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits [expr 4 * $milsecs]" bind $w.fRup-down.buttDOWN \ "decrement_miniscale $w $scalevar $minval $maxval $unit $nonfracdigits $fracdigits $milsecs" ##+##################################################### ## SET BINDING on the buttons in this new-widget so that ## sets the STOPminiscale to 1 (stop) ## --- to help assure the scalevar quits changing ## when the user stops pressing Button1. ##+##################################################### bind $w.fRup-down.buttUP \ "set STOPminiscale 1" bind $w.fRup-down.buttDOWN \ "set STOPminiscale 1" ##+##################################################### ## SET BINDING on the buttons in this new-widget so that ## sets the STOPminiscale to 1 (stop) ## --- to help assure the scalevar quits changing ## when the user 'leaves' the button. ## ## Also we use 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 "set STOPminiscale 1 ; \ $w.fRup-down.buttUP config -relief raised" bind $w.fRup-down.buttDOWN "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 "set STOPminiscale 1" bind $w.fRup-down.buttDOWN "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 {set STOPminiscale 1 ; DrawGradient \ .fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2} bind .fRminiscales.fRminiscaleR1.fRup-down.buttDOWN {set STOPminiscale 1 ; DrawGradient \ .fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2} bind .fRminiscales.fRminiscaleG1.fRup-down.buttUP {set STOPminiscale 1 ; DrawGradient \ .fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2} bind .fRminiscales.fRminiscaleG1.fRup-down.buttDOWN {set STOPminiscale 1 ; DrawGradient \ .fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2} bind .fRminiscales.fRminiscaleB1.fRup-down.buttUP {set STOPminiscale 1 ; DrawGradient \ .fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2} bind .fRminiscales.fRminiscaleB1.fRup-down.buttDOWN {set STOPminiscale 1 ; DrawGradient \ .fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2} bind .fRminiscales.fRminiscaleR2.fRup-down.buttUP {set STOPminiscale 1 ; DrawGradient \ .fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2} bind .fRminiscales.fRminiscaleR2.fRup-down.buttDOWN {set STOPminiscale 1 ; DrawGradient \ .fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2} bind .fRminiscales.fRminiscaleG2.fRup-down.buttUP {set STOPminiscale 1 ; DrawGradient \ .fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2} bind .fRminiscales.fRminiscaleG2.fRup-down.buttDOWN {set STOPminiscale 1 ; DrawGradient \ .fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2} bind .fRminiscales.fRminiscaleB2.fRup-down.buttUP {set STOPminiscale 1 ; DrawGradient \ .fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2} bind .fRminiscales.fRminiscaleB2.fRup-down.buttDOWN {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 {set STOPminiscale 1 ; DrawGradient \ .fRcanvas.can $curDIRECTION $curR1 $curG1 $curB1 $curR2 $curG2 $curB2} bind .fRbuttons.radbuttY {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