#!/usr/bin/wish -f ## ## SCRIPT: make_gradient_disk_given2colors_onColorBkgnd.tk ## ## ## PURPOSE: This Tk GUI script facilitates the creation of a disk ## made up of a gradient of colored circles --- ## on a canvas widget with a given (background) color. ## ## This Tk script is based on a Tk script at the web page ## called 'Gradient Spheres' at http://wiki.tcl.tk/16283 --- ## by Keith Vetter in 2006 August. To quote Vetter: ## ## "For a game I'm writing, I needed sphere-shaped playing ## pieces. I grabbed some images off the web but I had ## trouble when I made the background transparent --- ## the edges just looked horrible. ## ## So I decided to create my own. It draws a series of ## shrinking circles, each slightly offset from the previous ## and with colors from a gradient. ## ## The result looks (sort of) like a sphere with an offset ## light source." ## ## I too have had problems finding sphere-like images ## which are usable after their solid-color background ## is made transparent --- because the background near ## the edge of the sphere is not really a solid color ## but a blend of the background color and the spherical ## image color(s). ## ## With this Tk script, I have more control over how ## the boundary of the disk and the background is made. ## ## METHOD: The GUI made by this Tk script contains a rectangular ## canvas widget on which the colored circles (that make up ## the disk) are drawn. ## ## The GUI includes a 'scale' widget whose slider-bar can ## be used to change the radius of the sphere-like disk. ## ## The GUI also includes two buttons used to call a color selector ## GUI to set the 2 colors to gradiate from and to, across the ## disk/sphere. ## ## A third button calls the same color selector GUI to set a ## background color --- the color of the canvas. ## ## There is a '-command' parameter tied to the radius-setting 'scale' ## widget. That '-command' parameter is used to call a proc ## to redraw the color-gradient disk. ## ## The redraw includes clearing the canvas and redrawing the series ## of circles that make up the gradient-colored disk, for each ## detected change in radius. ## ## (If the redraw takes more than half-a-second, then we can use ## a button1-release binding on the scale widget to trigger the ## redraw --- only when the user finishes dragging the sliderbar ## of the scale.) ## ## If erasing the colored circles from the canvas and redrawing ## them completes within a very small fraction of a second, it will ## be feasible to do the redraws 'dynamically' with the sliderbar. ## ## USING THE GENERATED IMAGE: ## A screen/window capture utility (like 'gnome-screenshot' ## on Linux) can be used to capture the GUI image in a GIF file, say. ## ## If necessary, an image editor (like 'mtpaint' on Linux) ## can be used to crop the window capture image. The image ## could also be down-sized --- say to make a 'bullet' image ## file or an icon image file. ## ## The editor could also be used to blur the image slightly to ## 'feather' the edges of the polygon. ## ## The colored image file could be used with a utility (like the ## ImageMagick 'convert' command) to change the outer, background ## color to TRANSPARENT, making a partially transparent GIF ## (or PNG) file. Then the semi-transparent image file could be used, ## for 'bullets' in HTML pages or in Tk GUI's --- or for the ## background of icons for use in GUIs. ## ##+######################################################################## ## 'CANONICAL' STRUCTURE OF THIS TK CODE: ## ## 0) Set general window & widget parms (win-name, win-position, ## win-color-scheme, fonts, widget-geometry-parms, win-size-control). ## ## 1) Define ALL frames (and sub-frames). Pack them. ## ## 2) Define all widgets in the frames. Pack them. ## ## 3) Define keyboard or mouse action BINDINGS, if needed. ## ## 4) Define PROCS, if needed. ## ## 5) Additional GUI INITIALIZATION (with procs), if needed. ## ## ## Some detail about the code structure of this particular script: ## ## 1a) Define ALL frames: ## ## Top-level : '.fRbuttons' , '.fRimgspecs' , '.fRcan' ## ## Sub-frames: none ## ## 1b) Pack ALL frames. ## ## 1c) Define a 'minilistbox' proc that is used to make a couple of ## COMPACT LIST-SELECTION WIDGETS for use in step 2 below --- to serve ## in place of the old-fashioned 'tk_optionMenu' widget, and yet ## to avoid using a newer widget like 'spinbox' that is ## not available to users of older 8.x wish interpreters ## or the really-old 7.x interpreters. ## ## 2) Define all widgets in the frames (and pack them): ## ## - In '.fRbuttons': 1 button widget ('Exit'), ## and ## 3 buttons (for setting 2 disk-gradient colors and ## one background color), ## and ## 1 checkbutton to ask for a circle --- rather than ## an elliptical shape that has the aspect ratio of ## the canvas. ## ## - In '.fRimgspecs': 1 'minilistbox' widget to specify the location ## of an apparent light reflection on the 'sphere' ## --- compass points such as ## nw, n, ne, e, se, s, sw, w, or center. ## 1 radius 'scale' widget, to 'dynamically' change ## the radius of the disk/sphere. ## ## - In '.fRcan': 1 'canvas' widget ## ## 3) Define bindings: ## ## - button1-release on the 1 checkbutton (the 'circle' request) ## should cause a redraw ## ## - change of the light-location indicator --- i.e. ## button1-release on that 'minilistbox' --- should cause a redraw ## ## NOTE: The following 3 color changes should trigger a redraw. ## They can probably be done in procs that are used to ## set each of the 3 colors --- but, if the redraw is not ## done at the end of each proc, the redraw could be done ## via a button1-release binding on the 3 color-change buttons. ## ## - change of either of the 2 gradient colors should cause a redraw ## --- i.e. the commands for the 2 gradient-color-setting buttons ## should end with a disk-redraw ## ## - change of the background (canvas) color MAY need to cause a redraw ## --- i.e. the command for the background-color-setting button ## MAY need to end with a disk-redraw ## ## 4) Define procs: ## ## - 'Gradient' - to set the list of colors gradiating from ## color1 to color2 in N steps --- where N ## may be the number of pixels in the radius of ## the disk (or less than that) ## ## - 'GradientSphere' - to do the (re)draw ## ## - 'set_gradient_color1' - shows a color selector GUI and uses the ## user-selected color to redraw the disk on ## the canvas ## ## - 'set_gradient_color2' - shows a color selector GUI and uses the ## user-selected color to redraw the disk on ## the canvas ## ## - 'set_color_background' - shows a color selector GUI and uses the ## user-selected color to reset the color of ## the canvas background ## ## 5) Additional GUI initialization: Execute proc 'GradientSphere' once with ## an initial, example set of parms ## --- curRADIUS COLOR1hex COLOR2hex, ## COLORbkGNDhex --- ## to start with a gradient disk/sphere on ## the canvas rather than a blank canvas. ## ##+######################################################################## ## DEVELOPED WITH: ## Tcl-Tk 8.5 on Ubuntu 9.10 (2009-october release, 'Karmic Koala'). ## ## $ wish ## % puts "$tcl_version $tk_version" ## showed 8.5 8.5 on Ubuntu 9.10 ## after Tcl-Tk 8.4 was replaced by 8.5 --- to get anti-aliased fonts. ##+####################################################################### ## MAINTENANCE HISTORY: ## Created by: Blaise Montandon 2012sep02 ## Changed by: ...... ......... 2012 ##+####################################################################### ##+####################################################################### ## Set general window parms (title,position,size,color-scheme,fonts,etc.). ##+####################################################################### wm title . "Color-Gradient 'Sphere' on a Canvas" wm iconname . "Gradient" wm geometry . +15+30 ## We allow the window to be resizable and we pack the canvas with ## '-fill both -expand 1' so that the canvas can be enlarged by enlarging ## the window. ## If you want to make the window un-resizable, ## you can use the following statement. # wm resizable . 0 0 ##+###################################################### ## Set the color scheme for the window and its widgets --- ## and set the initial color for the polygon interior ## and the canvas background (outside the polygon). ##+###################################################### tk_setPalette "#e0e0e0" ## Initialize the 2 gradient colors and the background color for the canvas. # set COLOR1r 255 # set COLOR1g 255 # set COLOR1b 255 set COLOR1r 255 set COLOR1g 0 set COLOR1b 255 set COLOR1hex [format "#%02X%02X%02X" $COLOR1r $COLOR1g $COLOR1b] # set COLOR2r 255 # set COLOR2g 255 # set COLOR2b 0 set COLOR2r 255 set COLOR2g 255 set COLOR2b 255 set COLOR2hex [format "#%02X%02X%02X" $COLOR2r $COLOR2g $COLOR2b] # set COLORbkGNDr 60 # set COLORbkGNDg 60 # set COLORbkGNDb 60 set COLORbkGNDr 0 set COLORbkGNDg 0 set COLORbkGNDb 0 set COLORbkGNDhex \ [format "#%02X%02X%02X" $COLORbkGNDr $COLORbkGNDg $COLORbkGNDb] set listboxBKGD "#f0f0f0" ##+######################################################## ## Use a VARIABLE-WIDTH FONT for label and button widgets. ## ## Use a FIXED-WIDTH FONT for listboxes (and ## entry fields, if any). ##+######################################################## font create fontTEMP_varwidth \ -family {comic sans ms} \ -size -14 \ -weight bold \ -slant roman font create fontTEMP_SMALL_varwidth \ -family {comic sans ms} \ -size -10 \ -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 -10 \ -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) ##+########################################################### set initCanWidthPx 400 set initCanHeightPx 300 set minCanHeightPx 24 # set BDwidthPx_canvas 2 set BDwidthPx_canvas 0 ## BUTTON geom parameters: set PADXpx_button 0 set PADYpx_button 0 set BDwidthPx_button 2 ## LABEL geom parameters: set BDwidthPx_label 2 ## SCALE geom parameters: set BDwidthPx_scale 2 set initScaleLengthPx 200 ## LISTBOX geom parameters: set listboxWIDTHchars 3 ##+################################################################### ## Set a MINSIZE of the window. ## ## For width, allow for the minwidth of the '.fRbuttons' frame: ## about 3 buttons (Exit,Color1,Color2,ColorBkgnd), and ## 1 checkboxes, and a label with current disk info. ## ## For height, allow for a canvas at least 24 pixels high, and ## 2 chars high for the scale widget height in the ## '.fRimgspecs' frame, and ## 2 chars high for the widgets in the '.fRbuttons' frame. ##+################################################################### set minWinWidthPx [font measure fontTEMP_varwidth \ "Exit Color1 Color2 Background Circular (not elliptical) Current Colors"] ## Add some pixels to account for right-left-side window decoration ## (about 8 pixels), about 6 x 8 pixels/widget for borders/padding for ## 6 widgets --- 4 buttons and 1 checkbox and 1 label. set minWinWidthPx [expr 56 + $minWinWidthPx] ## MIN HEIGHT --- ## for the 3 frames 'fRbuttons' 'fRimgspecs' 'fRcan'. ## Allow ## 1 char high for 'fRbuttons' ## 2 chars high for 'fRimgspecs' ## 2 chars high for 'fRcan' set CharHeightPx [font metrics fontTEMP_varwidth -linespace] set minWinHeightPx [expr $minCanHeightPx + 5 * $CharHeightPx] ## Add about 28 pixels for top-bottom window decoration, ## about 3x8 pixels for each of the 3 stacked frames and their ## widgets (their borders/padding). set minWinHeightPx [expr $minWinHeightPx + 52] ## FOR TESTING: # puts "minWinWidthPx = $minWinWidthPx" # puts "minWinHeightPx = $minWinHeightPx" wm minsize . $minWinWidthPx $minWinHeightPx ##+################################################################ ## DEFINE *ALL* THE FRAMES: ## ## Top-level : 'fRbuttons' '.fRimgspecs' 'fRcan' ## ## Sub-frames: none ##+################################################################ # set BDwidth_frame 2 set BDwidth_frame 0 # set RELIEF_frame raised set RELIEF_frame flat frame .fRbuttons -relief $RELIEF_frame -borderwidth $BDwidth_frame frame .fRimgspecs -relief raised -borderwidth 2 frame .fRcan -relief $RELIEF_frame -borderwidth $BDwidth_frame ##+############################## ## PACK the top-level FRAMES. ##+############################## pack .fRbuttons \ .fRimgspecs \ -side top \ -anchor nw \ -fill x \ -expand 0 pack .fRcan \ -side top \ -anchor nw \ -fill both \ -expand 1 ##+######################### ## DEFINE PROC 'minilistbox' ## (for use in making a couple of widgets below) ##+############################################################## ## By using the global variables ## - fontTEMP_SMALL_fixedwidth ## - fontTEMP_SMALL_varwidth ## - listboxBKGD ## - listboxWIDTHchars ## for the decorative & geometric elements/parameters of the GUI, ## we keep the arguments of this widget-made-on-the-fly down ## to the 5 MAIN ELEMENTS/VARIABLES --- 3 INPUT AND 1 OUTPUT AND 1 CMD: ## ## - the parent widget/window, ## ## - an option/line at which to initially position the list in ## the listbox (with the 'see' command), ## ## - an options list, ## ## - the name of the variable that is to hold the user-selected option, ## i.e. a list-line (the result/output) ## --- retrieved from the listbox with 'curselection' and 'get', ## ## - a command (proc --- and parameters, if any) to be executed at a ## button1-release on this widget's frame. ##+############################################################## proc minilistbox {w opt1 optslist listboxWIDTHchars seloptvar mlbProc} { global fontTEMP_SMALL_fixedwidth fontTEMP_SMALL_varwidth \ listboxBKGD ##+##################################### ## DEFINE-and-PACK the widget SUB-FRAMES: ## '.frup-down' for 2 up and down buttons ## and '.fRopts' for the listbox. ## Pack them side by side. ##+##################################### frame $w.fRup-down -relief flat -bd 2 frame $w.fRopts -relief flat -bd 2 pack $w.fRup-down \ $w.fRopts \ -side left \ -anchor w \ -fill y \ -expand 0 ##+#################################################### ## In FRAME '.fRup-down', ## DEFINE-and-PACK a top-spacer label and 2 buttons. ##+#################################################### ## We comment-out this label definition (and its pack statement) ## to reduce the height of this 'minilistbox' widget. ## See the label definition statement for frame .fRopts, below. # label $w.fRup-down.label \ # -text " " \ # -anchor w \ # -relief flat button $w.fRup-down.buttUP \ -text "Up" \ -font fontTEMP_SMALL_varwidth \ -width 3 -height 1 \ -pady 1 \ -padx 0 \ -command [list $w.fRopts.listbox yview scroll -1 unit] button $w.fRup-down.buttDOWN \ -text "Dwn" \ -width 3 -height 1 \ -font fontTEMP_SMALL_varwidth \ -pady 1 \ -padx 0 \ -command [list $w.fRopts.listbox yview scroll +1 unit] # pack $w.fRup-down.label \ # -side top \ # -anchor n \ # -fill none \ # -expand 0 pack $w.fRup-down.buttUP \ $w.fRup-down.buttDOWN \ -side top \ -anchor n \ -fill none \ -expand 0 ##+#################################################### ## In FRAME '.fRopts', ## DEFINE-and-PACK an info label and a listbox widget. ##+#################################################### ## We comment-out this label definition (and its pack statement) ## to reduce the height of this 'minilistbox' widget. ## The user could supply a label, say to the left of this ## 'minilistbox' widget, using a label-def in their Tk script. # label $w.fRopts.label \ # -text "Up/dwn ; click a line:" \ # -font fontTEMP_SMALL_varwidth \ # -anchor w \ # -relief flat listbox $w.fRopts.listbox \ -font fontTEMP_SMALL_fixedwidth \ -height 3 \ -width $listboxWIDTHchars \ -bg "$listboxBKGD" \ -state normal foreach optline $optslist { $w.fRopts.listbox insert end $optline } # pack $w.fRopts.label \ # -side top \ # -anchor n \ # -fill x \ # -expand 0 pack $w.fRopts.listbox \ -side top \ -anchor n \ -fill x \ -expand 0 ##+################################################### ## POSITION the list at the 'opt1' line, using 'see'. ## And make the opt1 line the default selection. (?) ##+################################################### set INDEXofOPT1 [ lsearch -exact $optslist $opt1 ] if { "$INDEXofOPT1" != "-1" } { set seeINDEX [expr $INDEXofOPT1 - 1 ] if { "$seeINDEX" < "0" } { set seeINDEX "0" } $w.fRopts.listbox see $seeINDEX ## Comment this to de-activate it? $w.fRopts.listbox selection set $INDEXofOPT1 } ## END OF if { "$INDEXofOPT1" != "-1" } ##+######################################################## ## PROC for the following button1-release BINDING: getline ##+######################################################## proc getline {w outvar passedproc} { ## This 'upvar' associates the local var 'selectline' with ## the outer var that is to contain the listbox selection. ## It is like an EQUIVALENCE statement in FORTRAN. upvar #0 $outvar selectline set sel_index [ $w.fRopts.listbox curselection ] ## FOR TESTING: # puts "sel_index: $sel_index" if { $sel_index != "" } { set selectline [ $w.fRopts.listbox get $sel_index ] } else { set selectline "" } eval set $outvar "$selectline" ## FOR TESTING: # puts "selectline: $selectline" ## puts "LIGHTloc: $LIGHTloc" ## puts "theta0deg: $theta0deg" # puts "outvar: [expr \$$outvar]" eval $passedproc } ## END OF proc getline ##+##################################################### ## SET BINDING on the listbox in this new-widget so that ## puts a selected line of the ## listbox in a specified var and executes a ## specified command/proc. ##+##################################################### bind $w.fRopts.listbox "getline $w $seloptvar \"$mlbProc\"" } ## END OF 'minlistbox' PROC ##+######################################################### ## OK. Now we are ready to define the widgets in the frames. ##+######################################################### ##+##################################################################### ## In the '.fRbuttons' FRAME --- DEFINE-and-PACK ## - an exit-button, ## and ## - 3 buttons ( to specify 3 colors) ## and ## - a CHECKBUTTON (to request a CIRCLE, rather than an ellipse) ##+##################################################################### button .fRbuttons.buttEXIT \ -text "Exit" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {exit} button .fRbuttons.buttCOLOR1 \ -text "\ Gradient Color1" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {set_gradient_color1} button .fRbuttons.buttCOLOR2 \ -text "\ Gradient Color2" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {set_gradient_color2} button .fRbuttons.buttCOLORbkGND \ -text "\ Background Color" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {set_background_color} set CIRCULARellipse 1 checkbutton .fRbuttons.chkbuttCIRCLE \ -text "\ Circle (not ellipse)" \ -font fontTEMP_varwidth \ -variable CIRCULARellipse \ -selectcolor "#cccccc" \ -relief raised label .fRbuttons.labelPARMS \ -text "" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd $BDwidthPx_button ##+########################################### ## Pack the widgets in the 'fRbuttons' frame. ##+########################################### pack .fRbuttons.buttEXIT \ .fRbuttons.buttCOLOR1 \ .fRbuttons.buttCOLOR2 \ .fRbuttons.buttCOLORbkGND \ .fRbuttons.chkbuttCIRCLE \ .fRbuttons.labelPARMS \ -side left \ -anchor w \ -fill none \ -expand 0 ##+################################################################## ## In the '.fRimgspecs' FRAME ---- DEFINE-and-PACK ## - a LABEL widget ## - a 'minilistbox' widget for lighting-location on the sphere/disk ## - a LABEL widget ## - a SCALE widget, for radius of the rounded corners/points ##+################################################################### label .fRimgspecs.labelLighting \ -text "\ Light-Reflection Location on the Sphere/disk" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd $BDwidthPx_button ## DEFINE the 'minilistbox' widget for light-reflection location ## on the sphere/disk. frame .fRimgspecs.fRlightloc -relief flat -bd 0 set LIGHTlocs { nw n ne e se s sw w center } set LIGHTloc nw minilistbox .fRimgspecs.fRlightloc $LIGHTloc $LIGHTlocs 6 LIGHTloc "ReDraw 0" ##+################################ ## DEFINE the radius 'scale' widget ## including a 'label' widget. ##+################################ ## Set the init value for the radius-scale var. set curRADIUS 100 ## Set the MAX UNITS for the radius-scale, ## i.e. the upper limit of the range of values, # set scaleMaxUnits 200 set scaleMaxUnits [expr $initCanWidthPx / 2] # set scaleMaxUnits [expr [winfo height .] / 2] # set scaleMaxUnits [expr [winfo height .fRcan.can] / 2] ## Define a label widget to precede the radius-scale, ## followed by the scale: label .fRimgspecs.labelSCALE1 \ -text "\ \ \ \ Radius (in pixels) for the disk/sphere:" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd $BDwidthPx_button scale .fRimgspecs.scale1 \ -orient horizontal \ -digits 0 \ -from 0 -to $scaleMaxUnits \ -length $initScaleLengthPx \ -variable curRADIUS \ -command "ReDraw" ## PACK the widgets of FRAME .fRimgspecs --- ## label ; minilistbox-frame ; label ; minilistbox-frame ; label ; scale pack .fRimgspecs.labelLighting \ .fRimgspecs.fRlightloc \ .fRimgspecs.labelSCALE1 \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRimgspecs.scale1 \ -side left \ -anchor w \ -fill x \ -expand 1 ##+###################################################### ## DEFINE-and-PACK the 'canvas' widget ## in the '.fRcan' FRAME ##+###################################################### canvas .fRcan.can \ -width $initCanWidthPx \ -height $initCanHeightPx \ -relief raised \ -borderwidth $BDwidthPx_canvas pack .fRcan.can \ -side top \ -anchor nw \ -fill both \ -expand 1 ##+######################################## ## END OF the DEFINITION OF THE GUI WIDGETS ##+######################################## ##+############################### ## BINDINGS SECTION: ##+############################### bind . "ReDraw 0" bind .fRbuttons.chkbuttCIRCLE "ReDraw 0" ##+###################################################################### ## PROCS SECTION: ## ## - ReDraw - Called in the radius-scale '-command' and ## in several bindings. ## ## Sets the light x,y coords (in -1 to +1) from ## the LIGHTloc var (compass points). Then ## calls 'GradientSphere' and provides it about ## 9 parameters. ## ## - GradientSphere - called by ReDraw ## ## - Gradient - called by GradientSphere ## ## - set_gradient_color1 - called by color1 button '-command' ## - set_gradient_color2 - called by color2 button '-command' ## - set_background_color - called by background color button '-command' ## ##+####################################################################### ##+##################################################################### ## proc ReDraw - ## ## PURPOSE: ## Sets the light x,y coords (in -1 to +1) from the ## LIGHTloc var (compass points). ## Then calls 'GradientSphere' and provides it about 9 parameters. ## ## CALLED BY: the radius-scale '-command' and in a couple of bindings ## (a button1-release on a checkbutton and a window-reconfig ## binding) and 3 set-color procs. ## ## NOTE: The 'x' argument is to avoid an error when the scale '-command' ## passes a scale value as an argument to the command. ## If we ever wanted to try doing the disk redraws 'dynamically' ## as the scale sliderbar is dragged, we could use 'x' as the ## current radius of the disk. ##+##################################################################### proc ReDraw {x} { global curRADIUS LIGHTloc COLOR1hex COLOR2hex CIRCULARellipse if { $CIRCULARellipse != 1 } { set OFFset 0.25 } else { set OFFset 0.5 } # if { $LIGHTloc == "nw" } { set LIGHTx -$OFFset set LIGHTy -$OFFset # } if { $LIGHTloc == "n" } { set LIGHTx 0.0 set LIGHTy -$OFFset } if { $LIGHTloc == "ne" } { set LIGHTx $OFFset set LIGHTy -$OFFset } if { $LIGHTloc == "e" } { set LIGHTx $OFFset set LIGHTy 0.0 } if { $LIGHTloc == "se" } { set LIGHTx $OFFset set LIGHTy $OFFset } if { $LIGHTloc == "s" } { set LIGHTx 0.0 set LIGHTy $OFFset } if { $LIGHTloc == "sw" } { set LIGHTx -$OFFset set LIGHTy $OFFset } if { $LIGHTloc == "w" } { set LIGHTx -$OFFset set LIGHTy 0.0 } if { $LIGHTloc == "center" } { set LIGHTx 0.0 set LIGHTy 0.0 } .fRcan.can delete gradient GradientSphere .fRcan.can \ [expr [winfo width .fRcan.can] / 2] \ [expr [winfo height .fRcan.can] / 2] \ $curRADIUS $LIGHTx $LIGHTy \ $COLOR1hex $COLOR2hex $curRADIUS .fRbuttons.labelPARMS configure -text "\ Colors: 1-Disk - $COLOR1hex , 2-Lighting - $COLOR2hex" } ## END OF proc 'ReDraw' ##+##################################################################### ## proc GradientSphere {c Ox Oy radius Lx Ly color1 color2 {csteps {}}} ## ## Description of the arguments: ## ## c: canvas to use ## Ox,Oy, radius: center and radius of sphere in pixels) ## Lx,Ly: where light source hits and is a position in a -1,-1 to 1,1 box ## which is mapped onto the bounding box of the sphere ## color1, color2: outer and inner colors for the gradient ## csteps: how many colors to use, defaults to radius ## ##+##################################################################### proc GradientSphere {c Ox Oy radius Lx Ly color1 color2 {csteps {}}} { global CIRCULARellipse if {$csteps eq {}} {set csteps $radius} set clrs [Gradient $csteps $color1 $color2] if { $CIRCULARellipse != 1 } { set canWidthPx [winfo width .fRcan.can] set canHeightPx [winfo height .fRcan.can] set canAspectYX [expr $canHeightPx / double($canWidthPx)] } else { set canAspectYX 1.0 } ## FOR TESTING: # puts "canAspectYX: $canAspectYX" for {set i 0} {$i < $radius} {incr i} { set x [expr {$Ox + $i * $Lx}] ;# Center of shrinking circle set y [expr {$Oy + $i * $Ly}] set x0 [expr {$x - ($radius - $i)}] ;# BBox of shrinking circle set y0 [expr {$y - (($radius - $i) * $canAspectYX)}] set x1 [expr {$x + ($radius - $i)}] set y1 [expr {$y + (($radius - $i) * $canAspectYX)}] set idx [expr {round($csteps * $i / double($radius))}] set clr [lindex $clrs $idx] $c create oval $x0 $y0 $x1 $y1 -tag gradient -fill $clr -outline $clr } } ## END OF proc GradientSphere ##+######################################################################## ## proc Gradient {n clr1 clr2} ##+######################################################################## proc Gradient {n clr1 clr2} { foreach {r1 g1 b1} [winfo rgb . $clr1] {r2 g2 b2} [winfo rgb . $clr2] break set n [expr {$n <= 1 ? 1 : double($n - 1)}] set gradient {} for {set i 0} {$i <= $n} {incr i} { set r [expr {int(($r2 - $r1) * $i / $n + $r1) * 255 / 65535}] set g [expr {int(($g2 - $g1) * $i / $n + $g1) * 255 / 65535}] set b [expr {int(($b2 - $b1) * $i / $n + $b1) * 255 / 65535}] lappend gradient [format "#%.2x%.2x%.2x" $r $g $b] } return $gradient } ## END OF proc Gradient ##+##################################################################### ## proc 'set_gradient_color1' ##+##################################################################### ## PURPOSE: ## ## This procedure is invoked to get an RGB triplet ## via 3 RGB slider bars on the FE Color Selector GUI. ## ## Uses that RGB value to set color1 of the 2 colors for a ## sequence of circles changing from color1 to color2. ## ## Arguments: none ## ## CALLED BY: .fRbuttons.buttCOLOR1 button ##+##################################################################### proc set_gradient_color1 {} { global COLOR1r COLOR1g COLOR1b COLOR1hex curRADIUS curRADIUSevenVerts # global feDIR_tkguis ## FOR TESTING: # puts "COLOR1r: $COLOR1r" # puts "COLOR1g: $COLOR1g" # puts "COLOR1b: $COLOR1b" set TEMPrgb [ exec \ ./sho_colorvals_via_sliders3rgb.tk \ $COLOR1r $COLOR1g $COLOR1b] # $feDIR_tkguis/sho_colorvals_via_sliders3rgb.tk \ ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" if { "$TEMPrgb" == "" } { return } scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB set COLOR1hex "#$hexRGB" set COLOR1r $r255 set COLOR1g $g255 set COLOR1b $b255 ## Call proc GradientSphere to redraw the geometry in the new interior color. ReDraw 0 } ## END OF proc 'set_gradient_color1' ##+##################################################################### ## proc 'set_gradient_color2' ##+##################################################################### ## PURPOSE: ## ## This procedure is invoked to get an RGB triplet ## via 3 RGB slider bars on the FE Color Selector GUI. ## ## Uses that RGB value to set color2 of the 2 colors for a ## sequence of circles changing from color1 to color2. ## ## Arguments: none ## ## CALLED BY: .fRbuttons.buttCOLOR1 button ##+##################################################################### proc set_gradient_color2 {} { global COLOR2r COLOR2g COLOR2b COLOR2hex curRADIUS curRADIUSevenVerts # global feDIR_tkguis ## FOR TESTING: # puts "COLOR2r: $COLOR2r" # puts "COLOR2g: $COLOR2g" # puts "COLOR2b: $COLOR2b" set TEMPrgb [ exec \ ./sho_colorvals_via_sliders3rgb.tk \ $COLOR2r $COLOR2g $COLOR2b] # $feDIR_tkguis/sho_colorvals_via_sliders3rgb.tk \ ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" if { "$TEMPrgb" == "" } { return } scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB set COLOR2hex "#$hexRGB" set COLOR2r $r255 set COLOR2g $g255 set COLOR2b $b255 ## Call proc GradientSphere to redraw the geometry in the new interior color. ReDraw 0 } ## END OF proc 'set_gradient_color2' ##+##################################################################### ## proc 'set_background_color' ##+##################################################################### ## PURPOSE: ## ## This procedure is invoked to get an RGB triplet ## via 3 RGB slider bars on the FE Color Selector GUI. ## ## Uses that RGB value to set the color of the canvas --- ## on which all the tagged items (ovals and rectangles) lie. ## ## Arguments: none ## ## CALLED BY: .fRbuttons.buttCOLORbkGND button ##+##################################################################### proc set_background_color {} { global COLORbkGNDr COLORbkGNDg COLORbkGNDb COLORbkGNDhex # global feDIR_tkguis ## FOR TESTING: # puts "COLORbkGNDr: $COLORbkGNDr" # puts "COLORbkGNDg: $COLORbkGNDb" # puts "COLORbkGNDb: $COLORbkGNDb" set TEMPrgb [ exec \ ./sho_colorvals_via_sliders3rgb.tk \ $COLORbkGNDr $COLORbkGNDg $COLORbkGNDb] # $feDIR_tkguis/sho_colorvals_via_sliders3rgb.tk \ ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" if { "$TEMPrgb" == "" } { return } scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB set COLORbkGNDhex "#$hexRGB" set COLORbkGNDr $r255 set COLORbkGNDg $g255 set COLORbkGNDb $b255 ## Set the color of the canvas. .fRcan.can config -bg $COLORbkGNDhex } ## END OF proc 'set_background_color' ##+##################################################### ## Additional GUI initialization, if needed (or wanted). ##+##################################################### ReDraw 0 .fRcan.can config -bg $COLORbkGNDhex