#!/usr/bin/wish -f ## ## SCRIPT: make_NsidedPolygon_2colorGradient_shadedEdges.tk ## ## PURPOSE: This Tk GUI script 'draws' a color-filled N-sided polygon ## --- including shading to an 'edge color'. ## ## The polygon is drawn surrounded by a background color for ## the image area on which the polygon is drawn. ## ## The user can specify these 3 colors --- ## 'fill', 'edge', and 'background' colors. ## ## The user may also specify the number of sides, N, ## of the polygon --- where N may be 3 up to about 20 or more. ## ## (More than 20 sides and the polygon starts to look like a circle. ## We already have a Tk script to draw a 2-color-gradient disk.) ## ## In addition, the user can specify the dimensions, i-max and j-max, ## of the image area (in pixels). ## ## USES OF THE IMAGE: ## ## Examples of use of this polygon-shaped image: ## ## 1) After this 'color shaded polygon' image is made, it could be ## scaled down to be used as a 'bullet' decorative item --- for ## a list of items on a web page or on widgets of a Tk GUI, such as ## on drawers of a 'toolchest'. ## ## 2) At a large size, the 'color shaded polygon' image ## could be used as a background for a logo. ## ## 3) At a medium size, the image could be used as a background ## for an icon (say, to be displayed on a 'desktop'). ## ## GENERAL METHOD OF DRAWING: ('create image' on a Tk canvas widget) ## ## This script makes this color-shaded shape via a Tk image 'structure' ## placed on a Tk canvas widget. ## ## The image is put on the canvas via a Tk canvas 'image create' command ## --- and the image is generated via 'put -to $i $j' ## commands on the image. ## ## The rectangular image-structure covers the entire canvas widget. The ## polygon-shape lies within the canvas (and within the image structure) ## --- with a margin around the polygon. In the margin, i.e. outside the ## polygon-shape on the canvas, a user-selected 'background' color ## is applied. ## ## REFERENCES and CREDITS: (use of a 'metric' within the shape) ## ## This Tk script is based on other Tk scripts that I have written to ## make a color-gradient image with shaded, 3D-looking edges. In each of ## those scripts a 'metric' was devised, by which to do the color gradient. ## ## One example is my Tk script at http://wiki.tcl.tk/37156 ## - 'GUI for Drawing 'Super-formula' shapes, with nice shaded border'. ## ## In that script, I devised a 'color-metric' v at each point x,y. ## Then v and (1-v) could be applied to a user-selected 'fill' color ## and a user-selected 'edge' color for the super-formula shape, to get ## a 'weighted-average' of the two colors, for the color at the pixel x,y. ## ## The equation for the 'super-formula' is: ## ## R(theta) = ( |cos(m*theta/4)/a| ^ n2 + |sin(m*theta/4)/b| ^ n3 ) ^ -1/n1 ## ## where the points on the border of the super-formula shape are given by ## x = R(theta) cos(theta) ## y = R(theta) sin(theta). ## ## I defined a 'color-metric' at any point x,y on the rectangular image ## on the rectangular canvas by ## v = r(x,y) / R(theta) ## where r(x,y) = sqrt(x*x + y*y). ## ## v is 0.0 in the center of the super-formula shape and ## v is 1.0 on the border of the super-formula shape. ## ## The canvas 'create image' (and 'put' commands) technique used in the ## super-formula script is similar to the technique used in two of my ## scripts that make SHADED EDGES around 'super-ellipses' and around ## color-gradient-rectangles. ## ## See ## http://wiki.tcl.tk/37004 - ## GUI for Drawing 'Super-ellipses', with nice shaded edges ## and ## http://wiki.tcl.tk/37143 - ## GUI for Drawing Rectangular 'Buttons' with nice shaded edges ## ## Those 2 scripts also use a 'color metric' v --- and the factors ## v and (1 - v) were used get a weighted average of 2 colors to ## apply that color to a pixel at x,y. ## ##+##################### ## ANOTHER EXAMPLE: ## THE SHADING TECHNIQUE (metric) for the SUPER-ELLIPSE: ## ## For detail on the shading technique applied to super-ellipses, ## see wiki.tcl.tk/37004 - ## GUI for Drawing 'Super-ellipses', with nice shaded edges. ## ## The edge-shading effect for the super-ellipse benefited from the equation ## for a super-ellipse --- more precisely, the equation for its edge: ## |x/a|^n + |y/b|^n = 1 ## ## The interior of the super-ellipse is given by the inequality ## |x/a|^n + |y/b|^n <= 1 ## ## The edge shading (3D effect) was obtained by using a 'metric' on the ## points x,y in the super-ellipse --- a value 'v', between 0 and 1, ## given by: ## v = |x/a|^n + |y/b|^n ## for each point inside the super-ellipse. ## ## The equation for v dictates that the value of v is 1 on the border of ## the super-ellipse and declines to 0 towards the center. ## ## (1.0 - $v) is applied to the user-selected RGB 'fill' color for ## the super-ellipse --- and $v applied to the user-selected RGB ## 'edge' color. The weighted-average of the pair of RGB values ## gives us the color at any x,y point in the super-ellipse. ## ## (Note that v is not a constant. The values of x and y gave us the ## 'v' value to apply to get the 'shaded' color at x,y --- i.e. ## v is a function of x and y.) ## ##+###################################################### ## DERIVATION OF A 'COLOR METRIC' FOR THE N-sided POLYGON: ## ## For the moment, we forget the fact that we are going to scan ## across the horizontal pixel lines of the image-rectangle to ## set the color of each pixel. The x,y locations of those pixels ## are specified as integers. ## ## Instead, we will think of using 'world-coordinates' ('real' numbers, ## not necessarily integers) for the x,y coordinates of the interior ## points of our polygon. ## ## We will think of our polygon as being centered at (0.0,0.0), and ## we are going to want to color the pixels in our polygon such that ## all the pixels on a line parallel to the outer edge of the polygon ## are the same color. That color is a mix of the 'fill' and 'edge' ## RGB colors. ## ## To specify that color-mix, we want to devise a metric, v, that ## is zero at the origin (0.0,0.0) and is 1.0 on the outer edge ## of the polygon. ## ## Given a point (x,y) inside the polygon, we will define our ## metric to be ## v = r(x,y) / R(X,Y) ## ## where r(x,y) = sqrt (x*x + y*y). ## ## To determine R(X,Y), we imagine extending a line from the origin ## (0.0, 0.0) through (x,y) until it intersects the outer edge of ## the polygon --- at a point (X,Y) say. ## ## We set R(x,y) = sqrt (X*X + Y*Y). ## ## This gives us a nice metric, v, with v = 0 at the origin and ## v = 1 on the outer edge of the polygon. ## ## The tough mathematics comes in determining the intersection point ## X,Y. We will do that by using a parametric form of the two ## intersecting lines --- one line being the one through the origin ## and (x,y). The other line being a 'face' of the polygon. ## ## For simplicity, we will say our polygon has vertices 1.0 unit ## from the origin. I.e. the vertices lie on a unit circle. ## ## There are N faces of the polygon --- each subtending an angle ## of (2 * pi / N). We can determine which sector (x,y) is in from ## the angle that the line through (0.0,0.0) and (x,y) makes with a ## horizontal x-axis. Knowing that sector, we know the angles of ## the two end-points of the 'face' of that sector, say Q1 and Q2, ## and we can calculate the coordinates of those two points (which ## happen to lie on our unit circle). ## ## Now our problem boils down to finding the intersection point, ## (X,Y), of two lines --- the line through P1 (the origin) and ## P2 (the x,y point) --- and the line through Q1 and Q2. ## ## We will use a parametric formulation of these two lines, ## with parameters s and t, respectively. And we will use a proc ## that solves 2 linear equations in 2 unknowns, given the ## constants in the equations. ## ## Here is how we do the parameterization. In this derivation, ## P1 can be any point (not necessarily the origin). We are just ## devising a method to find the intersection of any two ## non-parallel lines --- given a pair of points defining each line. ## ## Thinking of P1,P2,Q1,Q2 as being 2-dimensional vectors, the ## vector equations for our two lines are: ## ## P = P1 + s * (P2 - P1) which is P1 at s=0 and P2 at s=1 ## Q = Q1 + t * (Q2 - Q1) which is Q1 at t=0 and Q2 at t=1 ## ## The intersection is where P = Q, in other words, we want to ## solve the vector equation ## ## P1 + s * (P2 - P1) = Q1 + t * (Q2 - Q1) ## ## for s and t. ## ## In terms of x,y coordinates, the vector equality becomes the following ## two 'scalar' equations: ## ## P1x + s * (P2x - P1x) = Q1x + t * (Q2x - Q1x) ## and ## P1y + s * (P2y - P1y) = Q1y + t * (Q2y - Q1y) ## ## This gives us 2 linear equations in unkowns s,t: ## ## s * (P2x - P1x) - t * (Q2x - Q1x) = Q1x - P1x ## and ## s * (P2y - P1y) - t * (Q2y - Q1y) = Q1y - P1y ## ## We can write this in a simpler, matrix-like form --- using ## coefficients 'a' and right-hand-side constants 'c' --- as ## ## a11 * s + a12 * t = c1 ## and ## a21 * s + a22 * t = c2 ## ## We can eliminate t by multiplying the first equation by a22 ## and the second equation by a12. We get ## ## a11 a22 s + a22 a12 t = a22 c1 ## and ## a21 a12 s + a22 a12 t = a12 c2 ## ## Subracting equation 2 from equation 1, we get ## ## (a11 * a22 - a21 * a12) * s = a22 * c1 - a12 * c2 ## ## We can write this in 'Cramer' form as ## ## | c1 a12 | ## | c2 a22 | ## s = ----------- ## | a11 a12 | ## | a21 a22 | ## ## Then we can use s in the P1-P2 line equation to get the ## values X,Y of the intersection point of the two lines ## P1-P2 and Q1-Q2. ## ## Then we calculate R(x,y) = sqrt (X*X + Y*Y). ## ## Which gives us v = r(x,y) / R(X,Y), where r(x,y) = sqrt (x*x + y*y). ## ## Now we have a suitable metric, v. ## ## At a point x,y, we determine the 'shaded color' at the point by ## using a color interpolated between the user-selected 'fill' color ## (color1) of the 'polygon shape' and the user-selected ## 'edge' color (color2). ## ## We calculate the 'shaded color' at x,y by calulating a weighted average ## based on applying the factor (1.0 - v) to color1 --- and applying v ## to color2. That is, shaded-color = (1 - v) * color1 + v * color2. ## ## We actually calculate via formulas like ## shaded-R = (1 - v) * R1 + v * R2 ## shaded-G = (1 - v) * G1 + v * G2 ## shaded-B = (1 - v) * B1 + v * B2 ## ## Thus we will get the edge-shading (the 3D effect) for the ## 'polygon shape'. ## ## Actually, it turns out that 1-v and v gives a rather washed-out (too ## gradual) shading effect. It is better if we raise v to a power M ## and use v^M and (1 - v^M). It turns out that M = 3 gives pretty nice ## shading for the polygon shape, but rather than hard-code the value of M, ## we provide a scale widget on the GUI so that the user can set the ## value of M. ## ## --------- ## ## Returning to the issue of scanning across horizontal lines of pixels ## in the rectangular image: ## ## For a given pixel with integer pixel coordinates (i,j), ## we will convert i and j to 'world coordinates' using a mapping of ## the pixel coordinates to world coordinates. ## ## We determine that mapping by using a mapping based on the ## UpperLeft and LowerRight coordinates in each space --- for example, ## ## Upper left pixel coordinates = 0,0 ## Upper left world coordinates = -1,1 ## ## Lower right pixel coordinates = XmaxPx, YmaxPx (the dimensions of ## the canvas image) ## Lower right world coordinates = 1,-1 ## ## We use 2 procs 'Xpx2Xwc' and 'Ypx2Ywc' to convert a pixel (i,j) ## to a world-coordinate-point (x,y). Then we use the above 'world-coordinate' ## equations to determine the color at pixel (i,j). ## ##+############## ## THE GUI DESIGN: ## ## The GUI made by this Tk script contains a rectangular ## canvas widget on which the color-filled polygon shape ## will be drawn. ## ## The GUI includes 2 'scale' widgets whose slider-bars can ## be used to change the values of XmaxPx and YmaxPx, the ## dimensions of the image area. ## ## There is also a scale for the exponent M to control the extent ## of the shading --- by using the two color weighting factors ## v^M and (1.0 - v^M). ## ## The GUI also includes 3 buttons to call an RGB color selector GUI ## to set the 'fill' , 'edge', and background colors. ## ## A redraw includes clearing the canvas and redrawing the ## polygon shape. ## ## A redraw should be done (a) whenever any of the 3 scales change, ## (b) whenever a color button is used to change a color, and ## (c) whenever the image area is resized. ## ## The polygon-shape will always be redrawn centered in ## the canvas. ## ## PERFORMANCE CONSIDERATIONS: ## Since the redraw has a lot of pixels to color, especially when ## a large image size is requested, a redraw may take several seconds. ## ## So it is probably NOT going to be feasible/pleasing to do redraws ## 'dynamically' with the '-command' option of the 'scale' widgets. ## ## For now, I have defined a button1-release binding on the 3 ## scale widgets to trigger a redraw --- only when the user ## finishes dragging the slider-button of any scale widget. ## ## However, it should be pointed out that if erasing the ## canvas and calculating-colors and putting the colors in the ## polygon shape completes within a small fraction of a second, it ## would be feasible to do the redraws 'dynamically' with each ## sliderbar, via the '-command' option. (But it might heat up ## the CPU doing those operations --- by quite a few degrees.) ## ## USING THE GENERATED IMAGE: ## ## A screen/window capture utility (like 'gnome-screenshot' on ## Linux) can be used to capture the GUI image in a PNG 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-background image file. ## ## 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 or buttons for use in web-pages or GUIs. ## ## The image could also be taken into a scalable vector graphics ## (SVG) editor (like Inkscape on Linux) and the SVG editor used ## to add anti-aliased, scalable text to the image. OR, the shape can ## be used as an underlying pattern to reproduce the shape as a ## scalable shape, by using curve drawing tools of the SVG editor. ## The SVG image could then be saved as a totally scalable image, ## without a raster-image needing to be stored in the SVG file. ## ##+######################################################################## ## '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). ## ## 1a) Define ALL frames (and sub-frames, if any). ## 1b) Pack ALL frames and sub-frames. ## ## 2) Define all widgets in the frames. Pack them. ## ## 3) Define keyboard or mouse/touchpad/touch-sensitive-screen action ## BINDINGS, if needed. ## ## 4) Define PROCS, if needed. ## ## 5) Additional GUI INITIALIZATION (typically with one or two of ## the procs), if needed. ## ## ## Some detail about the code structure of this particular script: ## ## 1a) Define ALL frames: ## ## Top-level : '.fRbuttons' ## '.fRmsg' ## '.fRcontrols' ## '.fRimgsize' ## '.fRcanvas' ## No sub-frames. ## ## 1b) Pack ALL frames. ## ## 2) Define all widgets in the frames (and pack them): ## ## - In '.fRbuttons': ## 3 button widgets ('Exit', 'Help' , 'ReDraw') ## and ## 3 buttons (for setting the 'fill', 'edge', and ## background colors), ## and ## 1 label widget to display the current color ## values (in hex). ## ## - In '.fRmsg': ## 1 label widget to display elapsed execution time, ## as well as a 'calculation in progress' msg or other msgs. ## ## - In '.fRcontrols': ## 1 'label' and 1 'scale' widget for M, where M is an exponent ## used to control the 'extensity' of the edge-shading. ## 1 'label' and 1 'scale' widget for a 'margin-fraction'. ## ## - In '.fRimgsize': ## 1 'label' and 1 'scale' widget each for XmaxPx, YmaxPx ## ## - In '.fRcanvas': 1 'canvas' widget ## ## 3) Define bindings: ## ## - a button1-release on the M-exponent and 'margin-fraction' scale ## widgets causes a redraw ## ## NOTE: The color changes should trigger a redraw, but we do not ## need bindings to do those redraws. ## The redraws can be done in procs that are used to ## set each of the colors. ## ## NOTE2: We do not use bindings on the 2 image size scales to do a redraw. ## The user can use the 'ReDraw' button when they have both ## scales set as desired. ## ## 4) Define procs: ## ## - 'ReDraw' - to clear the canvas and redraw the pixels ## in the image rectangle that contains the ## polygon shape ## --- for the current values of the 3 scale ## parameters and the 3 colors. ## ## - 'advise_user' - called by some bindings and ## by proc ReDraw to show draw-time ## ## - 'setMappingVars_for_px2wc' - called by proc ReDraw ## ## - 'Xpx2wc' - called by proc ReDraw ## - 'Ypx2wc' - called by proc ReDraw ## ## - 'get_Q1Q2_for_xy' - called by proc ReDraw ## ## - 'intersect_line1_line2' - called by proc ReDraw ## ## - 'set_scale_Ymax_equal_Xmax' - called by button1-release on the X-scale ## ## - 'set_polygon_color1' - shows a color selector GUI and uses the ## user-selected color for the 'fill' color ## of the polygon shape on the canvas ## ## - 'set_polygon_color2' - shows a color selector GUI and uses the ## user-selected color for the 'edge' color ## of the polygon shape 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 ## ## - 'update_color_button' - sets background color of any of the 3 ## color buttons ## ## 5) Additional GUI initialization: Execute proc 'ReDraw' once with ## an initial, example set of parms ## --- 3 scale vars, COLOR1hex, COLOR2hex, ## COLORBKGDhex --- ## to start with a polygon shape 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 2015dec14 ## Changed by: Blaise Montandon 2015jan07 Added 2 LIST vars with which ## to build the image as a list-of-lists ## of hexcolors. Improves performance ## by using just one 'put' to the ## 'image structure'. ## Added a scale widget for ## 'margin-fraction'. ## Added scrollbars to the canvas. ##+####################################################################### ##+####################################################################### ## Set general window parms (win-title,win-position). ##+####################################################################### wm title . "Edge-shaded 'polygon' shape, on a single-color canvas" wm iconname . "3D-like Polygon" wm geometry . +15+30 ##+###################################################### ## Set the color scheme for the window and set the ## background color for the 'trough' in some widgets. ##+###################################################### tk_setPalette "#e0e0e0" # set listboxBKGD "#f0f0f0" # set entryBKGD "#f0f0f0" set scaleBKGD "#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 -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) ##+########################################################### ## BUTTON geom parameters: set PADXpx_button 0 set PADYpx_button 0 set BDwidthPx_button 2 ## LABEL geom parameters: set PADXpx_label 0 set PADYpx_label 0 set BDwidthPx_label 2 ## SCALE geom parameters: set BDwidthPx_scale 2 # set initScaleLengthPx 100 set scaleThicknessPx 10 ## CANVAS geom parameters: set initCanWidthPx 300 set initCanHeightPx 200 set minCanHeightPx 24 # set BDwidthPx_canvas 2 set BDwidthPx_canvas 0 ##+################################################################### ## Set a MINSIZE of the window. ## ## For width, allow for the minwidth of the '.fRbuttons' frame: ## about 6 buttons (Exit,Help, ReDraw, Color1,Color2, COLORBKGD). ## We want to at least be able to see the Exit button. ## ## For height, allow ## 2 chars high for the '.fRbuttons' frame, ## 2 chars high for the '.fRimgsize' frame, ## 24 pixels high for the '.fRcanvas' frame. ##+################################################################### ## MIN WIDTH: set minWinWidthPx [font measure fontTEMP_varwidth \ "Exit Help ReDraw"] ## If we wanted to assure that all buttons and the label in '.fRbuttons' ## show, we could use the following. ## ## "Exit Help ReDraw Fill Edge Background DRAW TIME: ...."] ## Add some pixels to account for right-left-side window decoration ## (about 8 pixels), about 3 x 4 pixels/widget for borders/padding for ## 3 widgets --- 3 buttons. set minWinWidthPx [expr {20 + $minWinWidthPx}] ## MIN HEIGHT --- allow ## 2 chars high for 'fRbuttons' ## 1 char high for 'fRmsg' ## 2 chars high for 'fRcontrols' ## 2 chars high for 'fRimgsize' ## 24 pixels high for 'fRcanvas' set CharHeightPx [font metrics fontTEMP_varwidth -linespace] set minWinHeightPx [expr {24 + (7 * $CharHeightPx)}] ## Add about 28 pixels for top-bottom window decoration, ## about 5x4 pixels for each of the 5 stacked frames and their ## widgets (their borders/padding). set minWinHeightPx [expr {$minWinHeightPx + 48}] ## FOR TESTING: # puts "minWinWidthPx = $minWinWidthPx" # puts "minWinHeightPx = $minWinHeightPx" wm minsize . $minWinWidthPx $minWinHeightPx ## 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 a TEXT-ARRAY to hold text for buttons & labels on the GUI. ## NOTE: This can aid INTERNATIONALIZATION. This array can ## be set according to a nation/region parameter. ##+#################################################################### ## if { "$VARlocale" == "en"} ## For widgets in 'fRbuttons' frame: set aRtext(buttonEXIT) "Exit" set aRtext(buttonHELP) "Help" set aRtext(buttonREDRAW) "ReDraw" set aRtext(buttonCOLOR1) "Fill Color" set aRtext(buttonCOLOR2) "Edge Color" set aRtext(buttonCOLORBKGD) "Background Color" set aRtext(label_N) "N sides of the polygon:" ## For widgets in 'fRcontrols' frame: set aRtext(label_M) "Exponent M to control 'extensity' of edge shading:" set aRtext(labelMARGIN) "Margin fraction:" ## For widgets in 'fRimgsize' frame: set aRtext(labelXmaxPx) "Image width (in pixels):" set aRtext(labelYmaxPx) "Image Height (in pixels):" ## END OF if { "$VARlocale" == "en"} ##+################################################################ ## DEFINE *ALL* THE FRAMES: ## ## Top-level : '.fRbuttons' '.fRimgsize' '.fRcanvas' ##+################################################################ ## FOR TESTING change 0 to 1: ## (Example1: To see appearance of frames when borders are drawn.) ## (Example2: To see sizes of frames for various '-fill' options.) ## (Example3: To see how frames expand as window is resized.) if {0} { set RELIEF_frame raised set BDwidthPx_frame 2 } else { set RELIEF_frame flat set BDwidthPx_frame 0 } frame .fRbuttons -relief $RELIEF_frame -borderwidth $BDwidthPx_frame frame .fRmsg -relief raised -borderwidth 2 frame .fRcontrols -relief $RELIEF_frame -borderwidth $BDwidthPx_frame frame .fRimgsize -relief $RELIEF_frame -borderwidth $BDwidthPx_frame # frame .fRcanvas -relief $RELIEF_frame -borderwidth $BDwidthPx_frame frame .fRcanvas -relief raised -borderwidth 2 ##+############################## ## PACK the top-level FRAMES. ##+############################## pack .fRbuttons \ .fRmsg \ .fRcontrols \ .fRimgsize \ -side top \ -anchor nw \ -fill x \ -expand 0 pack .fRcanvas \ -side top \ -anchor nw \ -fill both \ -expand 1 ##+######################################################### ## OK. Now we are ready to define the widgets in the frames. ##+######################################################### ##+##################################################################### ## In the '.fRbuttons' FRAME --- DEFINE-and-PACK ## - an exit-button, a help-button, a redraw-button ## and ## - 2 buttons ( to specify colors) ## and ## - a label widget, to show current color values (in hex) ## and re-draw time (in millisecs). ##+##################################################################### button .fRbuttons.buttEXIT \ -text "$aRtext(buttonEXIT)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {exit} button .fRbuttons.buttHELP \ -text "$aRtext(buttonHELP)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {popup_msgVarWithScroll .topHelp "$HELPtext" +10+10} button .fRbuttons.buttREDRAW \ -text "$aRtext(buttonREDRAW)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {ReDraw 0} button .fRbuttons.buttCOLOR1 \ -text "$aRtext(buttonCOLOR1)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command "set_polygon_color1" button .fRbuttons.buttCOLOR2 \ -text "$aRtext(buttonCOLOR2)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command "set_polygon_color2" button .fRbuttons.buttCOLORBKGD \ -text "$aRtext(buttonCOLORBKGD)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command "set_background_color" ## DEFINE SCALE for N, number of sides of the polygon. label .fRbuttons.label_N \ -text "$aRtext(label_N)" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief ridge \ -bd $BDwidthPx_label ## Set this widget var in the GUI initialization section ## at the bottom of this script. # set M 6 scale .fRbuttons.scale_N \ -from 3 -to 20 \ -resolution 1 \ -bigincrement 1 \ -repeatdelay 1000 \ -length 120 \ -font fontTEMP_SMALL_varwidth \ -variable Nsides \ -showvalue true \ -orient horizontal \ -bd $BDwidthPx_scale \ -width $scaleThicknessPx # -command "ReDraw" ##+########################################### ## Pack the widgets in the 'fRbuttons' frame. ##+########################################### pack .fRbuttons.buttEXIT \ .fRbuttons.buttHELP \ .fRbuttons.buttREDRAW \ .fRbuttons.buttCOLOR1 \ .fRbuttons.buttCOLOR2 \ .fRbuttons.buttCOLORBKGD \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRbuttons.label_N \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRbuttons.scale_N \ -side left \ -anchor w \ -fill x \ -expand 0 ##+################################################################## ## In the '.fRmsg' FRAME ---- DEFINE-and-PACK 1 LABEL widget. ##+################################################################## label .fRmsg.labelINFO \ -text "" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief flat \ -background "#ff9999" \ -bd $BDwidthPx_button pack .fRmsg.labelINFO \ -side left \ -anchor w \ -fill x \ -expand 1 ##+################################################################## ## In the '.fRcontrols' FRAME ---- DEFINE-and-PACK ## 1 LABEL and 1 SCALE widget for M ('extensity') and ## 1 LABEL and 1 SCALE widget for 'margin-fraction'. ##+################################################################## ## DEFINE SCALE for exponent M ('extensity'). label .fRcontrols.label_M \ -text "$aRtext(label_M)" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief ridge \ -bd $BDwidthPx_label ## Set this widget var in the GUI initialization section ## at the bottom of this script. # set M 6 scale .fRcontrols.scale_M \ -from 1 -to 20 \ -resolution 1 \ -bigincrement 1 \ -repeatdelay 1000 \ -length 60 \ -font fontTEMP_SMALL_varwidth \ -variable M \ -showvalue true \ -orient horizontal \ -bd $BDwidthPx_scale \ -width $scaleThicknessPx # -command "ReDraw" pack .fRcontrols.label_M \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRcontrols.scale_M \ -side left \ -anchor w \ -fill x \ -expand 1 ## DEFINE SCALE for exponent 'margin-fraction'. label .fRcontrols.labelMARGIN \ -text "$aRtext(labelMARGIN)" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief ridge \ -bd $BDwidthPx_label ## Set this widget var in the GUI initialization section ## at the bottom of this script. # set marginFRACTION 0.2 scale .fRcontrols.scaleMARGIN \ -from 0.0 -to 0.5 \ -resolution 0.01 \ -bigincrement 0.1 \ -repeatdelay 1000 \ -length 60 \ -font fontTEMP_SMALL_varwidth \ -variable marginFRACTION \ -showvalue true \ -orient horizontal \ -bd $BDwidthPx_scale \ -width $scaleThicknessPx # -command "ReDraw" pack .fRcontrols.labelMARGIN \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRcontrols.scaleMARGIN \ -side left \ -anchor w \ -fill x \ -expand 1 ##+################################################################## ## In the '.fRimgsize' FRAME ---- DEFINE-and-PACK ## 1 LABEL and 1 SCALE widget for Xmax and ## 1 LABEL and 1 SCALE widget for Ymax. ##+################################################################### label .fRimgsize.labelXmaxPx \ -text "$aRtext(labelXmaxPx)" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief ridge \ -bd $BDwidthPx_label ## Set this widget var in the GUI initialization section ## at the bottom of this script. # set XmaxPx 500 scale .fRimgsize.scaleXmaxPx \ -from 10 -to 1000 \ -resolution 1 \ -bigincrement 1 \ -repeatdelay 1000 \ -length 100 \ -font fontTEMP_SMALL_varwidth \ -variable XmaxPx \ -showvalue true \ -orient horizontal \ -bd $BDwidthPx_scale \ -width $scaleThicknessPx # -command "Redraw" pack .fRimgsize.labelXmaxPx \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRimgsize.scaleXmaxPx \ -side left \ -anchor w \ -fill x \ -expand 1 ## DEFINE SCALE for YmaxPx. label .fRimgsize.labelYmaxPx \ -text "$aRtext(labelYmaxPx)" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief ridge \ -bd $BDwidthPx_label ## Set this widget var in the GUI initialization section ## at the bottom of this script. # set YmaxPx 400 scale .fRimgsize.scaleYmaxPx \ -from 10 -to 1000 \ -resolution 1 \ -bigincrement 1 \ -repeatdelay 1000 \ -length 100 \ -font fontTEMP_SMALL_varwidth \ -variable YmaxPx \ -showvalue true \ -orient horizontal \ -bd $BDwidthPx_scale \ -width $scaleThicknessPx # -command "Redraw" pack .fRimgsize.labelYmaxPx \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRimgsize.scaleYmaxPx \ -side left \ -anchor w \ -fill x \ -expand 1 ##+###################################################### ## In the '.fRcanvas' FRAME - ## DEFINE-and-PACK the '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 \ -yscrollcommand ".fRcanvas.scrolly set" \ -xscrollcommand ".fRcanvas.scrollx set" scrollbar .fRcanvas.scrolly \ -orient vertical \ -command ".fRcanvas.can yview" scrollbar .fRcanvas.scrollx \ -orient horizontal \ -command ".fRcanvas.can xview" ##+####################################################### ## PACK the widgets in frame '.fRcanvas'. ## ## NOTE: ## NEED TO PACK THE SCROLLBARS BEFORE THE CANVAS WIDGET. ## OTHERWISE THE CANVAS WIDGET TAKES ALL THE FRAME SPACE. ##+####################################################### pack .fRcanvas.scrolly \ -side right \ -anchor e \ -fill y \ -expand 0 pack .fRcanvas.scrollx \ -side bottom \ -anchor s \ -fill x \ -expand 0 ## !!!NEED TO USE '-expand 0' FOR THE X AND Y SCROLLBARS, so that ## the canvas is allowed to fill the remaining frame-space nicely ## --- without a gap between the canvas and its scrollbars. pack .fRcanvas.can \ -side top \ -anchor nw \ -fill both \ -expand 1 ##+######################################## ## END OF the DEFINITION OF THE GUI WIDGETS ##+######################################## ##+############################### ## BINDINGS SECTION: ##+############################### ##+####################################################### ## Make ymax-scale move to position of xmax-scale, ## to make it easy to ask for a square image. ## ## We do not add a ReDraw as follows. ## bind .fRimgsize.scaleXmaxPx "set_scale_Ymax_equal_Xmax ; Redraw 0" ## ## Instead, we advise user to click ReDraw. ## (The user may want to make other changes before the redraw.) ##+####################################################### bind .fRimgsize.scaleXmaxPx "set_scale_Ymax_equal_Xmax ; \ advise_user \"** Click ReDraw to make resized image. **\" " ##+####################################################### ## Advise user to click 'ReDraw' after changing ymax scale value. ## ## We do not add a ReDraw as follows. ## bind .fRimgsize.scaleYmaxPx "Redraw 0" ## ## Instead, we advise user to click ReDraw. ## (The user may want to make other changes before the redraw.) ##+####################################################### bind .fRimgsize.scaleYmaxPx \ "advise_user \"** Click ReDraw to make resized image. **\" " ##+####################################################### ## Advise user to click 'ReDraw' after changing N-sides. ## ## We do not do a ReDraw as follows. ## bind .fRbuttons.scale_N "ReDraw 0" ## ## Instead, we advise user to click ReDraw. ## (The user may want to make other changes before the redraw.) ##+####################################################### bind .fRbuttons.scale_N \ "advise_user \"** Click ReDraw to make new polygon. **\" " ##+####################################################### ## Advise user to click 'ReDraw' after changing 'extensity'. ## ## We do not do a ReDraw as follows. ## bind .fRcontrols.scale_M "ReDraw 0" ## ## Instead, we advise user to click ReDraw. ## (The user may want to make other changes before the redraw.) ##+####################################################### bind .fRcontrols.scale_M \ "advise_user \"** Click 'ReDraw' to redo the edge shading. **\" " ##+####################################################### ## Advise user to click 'ReDraw' after changing 'margin-fraction'. ## ## We do not do a ReDraw as follows. ## bind .fRcontrols.scaleMARGIN "ReDraw 0" ## ## Instead, we advise user to click ReDraw. ## (The user may want to make other changes before the redraw.) ##+####################################################### bind .fRcontrols.scaleMARGIN \ "advise_user \"** Click 'ReDraw' to redraw with a new margin around the polygon. **\" " ##+###################################################################### ## PROCS SECTION: ## ## - ReDraw - Called by the 'ReDraw' button OR by a ## button1-release binding on the M scale widget ## OR by the set-color procs, ## and in the GUI initialization section at the ## bottom of this script. ## ## Draws the polygon shape on the canvas for ## the current scale parameter values and for the ## current color var values. ## ## - setMappingVars_for_px2wc - called by proc ReDraw ## ## - Xpx2wc - called by proc ReDraw ## - Ypx2wc - called by proc ReDraw ## ## - get_Q1Q2_for_xy - called by proc ReDraw ## ## - intersect_line1_line2 - called by proc ReDraw ## ## - set_scale_Ymax_equal_Xmax - called by button1-release on the X-scale ## ## - set_polygon_color1 - called by color1 (fill) button '-command' ## ## - set_polygon_color2 - called by color2 (edge) button '-command' ## ## - set_background_color - called by background color button '-command' ## ## - update_color_button - called by the 'set_*_color*' procs and once ## in the 'Additional GUI Initialization section. ## ## - popup_msgVarWithScroll - called by Help button ## ##+####################################################################### ##+##################################################################### ## proc ReDraw - ## ## PURPOSE: ## Draws the polygon shape on the canvas. ## ## We 'poke' hex-colors a pixel at a time with calls like: ## imgID put $hexcolor -to $i $j ## ## CALLED BY: By clicking on the 'ReDraw' button --- and by ## bindings (in the BINDINGS section) --- and by set-color procs ## --- and by the GUI initialization section at the bottom of ## this script. ## ## NOTE: The 'val' argument to this proc is to avoid a syntax error if we ever call ## this proc in a scale '-command' --- which passes a scale value as an argument ## to the command. ## This is in case we try using the '-command' option of the scale widgets ## to do the redraws 'dynamically' as a scale widget sliderbar is moved. ## We do not use 'val'. We use the scale variables instead. ##+##################################################################### ## Recall that our 'color-metric', v, is given as follows. ## ## We put 'world coordinates' on the canvas with origin (0.0,0.0) ## at the center of the canvas. ## ## Given a point (x,y) inside the polygon, we define our ## metric to be ## v = r(x,y) / R(X,Y) ## where r(x,y) = sqrt (x*x + y*y). ## ## To determine R(X,Y), we imagine extending a line from the origin ## (0.0, 0.0) through (x,y) until it intersects the outer edge of ## the polygon --- at a point (X,Y) say. ## ## We set R(x,y) = sqrt (X*X + Y*Y). ## ## This gives us a nice metric, v, with v = 0 at the origin and ## v = 1 on the edges of the polygon. ## ## More details are given in comments near the top of this Tk script. ##+##################################################################### proc ReDraw {val} { ## FOR TESTING: (dummy out this proc) # return global XmaxPx YmaxPx Nsides twopi twopiN M marginFRACTION \ Q1x Q1y Q2x Q2y X Y \ COLOR1r COLOR1g COLOR1b COLOR1hex \ COLOR2r COLOR2g COLOR2b COLOR2hex \ COLORBKGDr COLORBKGDg COLORBKGDb COLORBKGDhex ## Set the current time, for determining elapsed ## time for building the 'photo' image. set t0 [clock milliseconds] ## Indicate that drawing calculations are starting. advise_user "** PERFORMING CALCULATIONS **" ## This 'update' makes sure that this label update is displayed. update ## Change the title of the window to show calculations are in process. ## (This shows how we could put a msg in the window title bar, ## instead of in a label in the GUI.) ## # wm title . \ # "** DRAWING CALCULATIONS ARE IN PROGRESS ** Please wait." ## Delete the current image structure. ## We especially need to do this when the canvas has been re-sized, ## so that we can redraw the image according to the new canvas size. catch {image delete imgID} ## Initialize the width & height of the image that we are ## going to create --- from two scale widget variables. set imgWidthPx $XmaxPx set imgHeightPx $YmaxPx ## Do something with the canvas size. Reset it to requested image size?? # set curCanWidthPx $imgWidthPx # set curCanHeightPx $imgHeightPx ## FOR TESTING: # puts "" # puts "imgWidthPx = $imgWidthPx imgHeightPx = $imgHeightPx" ## Make each dimension of the image an even (or odd?) integer (pixels). ## (DO WITHOUT THIS?) (Can change 'if {0}' to 'if {1}' to activate, ## or remove the 'if {0}' stuff.) if {0} { if {$imgWidthPx % 2 == 1} { incr imgWidthPx -1 } if {$imgHeightPx % 2 == 1} { incr imgHeightPx -1 } # if {$imgWidthPx % 2 == 0} { incr imgWidthPx -1 } # if {$imgHeightPx % 2 == 0} { incr imgHeightPx -1 } } ######################################################### ## Make the new image structure. ## (We need to do this after the 'delete imgID' above.) ######################################################### image create photo imgID -width $imgWidthPx -height $imgHeightPx ######################################################## ## Put the new image 'structure' on the canvas. ## (We need to do this after the 'delete imgID' above.) ######################################################## .fRcanvas.can create image 0 0 -anchor nw -image imgID ######################################################## ## Set the 'scrollregion' of the canvas according to the ## size of the image. (A simple 'update' does not work.) ######################################################## .fRcanvas.can configure -scrollregion "0 0 $imgWidthPx $imgHeightPx" ######################################################## ## Make the canvas area as big as we can to accomodate ## a large image. ## (We try some 'wm' commands to get the window to resize ## according to the canvas resize --- even after the ## user has manually resized the top window.) ######################################################## # wm geometry . {} ;# from http://wiki.tcl.tk/10720 ; WORKS! .fRcanvas.can configure -width $imgWidthPx -height $imgHeightPx wm geometry . {} ;# WORKS here too. ################################################################ ## Set the variables for converting pixels to world-coords. ## This is in case the user changed the image dimensions. ################################################################ ## Recall input vars for proc 'setMappingVars_for_px2wc' are: ## xORy,ULwcX,ULwcY,ULpxX,ULpxY,LRwcX,LRwcY,LRpxX,LRpxY ## ## Our polygon will be circumscribed by a unit circle. ## In order to allow some margin: ## ## We map world-coord X-limits -1.2 and 1.2 ## TO pixel-coord X-limits 0 and XmaxPx ## ## AND ## ## We map world-coord Y-limits 1.2 and -1.2 ## TO pixel-coord Y-limits 0 and YmaxPx ## ## where '.2' represents a 'margin-fraction'. ## ## See code in 'setMappingVars_for_px2wc' for details. ######################################################################## set XwcUL [expr {-1.0 - $marginFRACTION}] set YwcUL [expr {1.0 + $marginFRACTION}] set XwcLR [expr {1.0 + $marginFRACTION}] set YwcLR [expr {-1.0 - $marginFRACTION}] setMappingVars_for_px2wc xy $XwcUL $YwcUL 0 0 $XwcLR $YwcLR $XmaxPx $YmaxPx ######################################################################### ## Calculate the angle of each sector of the polygon --- for use ## in angle calculations below. ######################################################################### set twopiN [expr {$twopi / $Nsides}] ######################################################################### ## HERE IS THE 'GUTS': ## In a loop over yPx and xPx, where yPx and xPx are measured from the ## top left of the canvas/image rectangle, we calculate the hex-color ## for each pixel, from x,y where x and y are transformed to ## 'world coordinates' with origin in the center of the canvas. ## ## To determine the hexcolor of a pixel: ## After converting xPx,yPx to world-coordinates x,y: ## 1) We determine the sector of the polygon in which x,y lies. ## 2) We determine the coordinate of Q1,Q2, the end-points of the ## polygon-edge of that sector. ## 3) With P1 and P2 being (0,0) and (x,y), we use P1,Q1,P2,Q2 ## to determine the intersection point (X,Y). ## 4) We calculate the metric v = r(x,y) / R(X,Y) ## where r(x,y) = sqrt (x*x + y*y) ## and R(x,y) = sqrt (X*X + Y*Y). ## ## We use the scalar 'color-shading-metric' 'v' to calculate the ## color of the pixel at (xPx,yPx) using RGB color1 and color2 ## via formulas like ## shaded-R = (1 - v) * R1 + v * R2 ## shaded-G = (1 - v) * G1 + v * G2 ## shaded-B = (1 - v) * B1 + v * B2 ####################################################################### ## Get the half width and height of the image rectangle --- ## which is the same as the pixel-coordinates of the 'origin' ## in the middle of the image area. ## ** For use in 'FOR TESTING' message-sections below. ** set xmidPx [expr {$imgWidthPx / 2}] set ymidPx [expr {$imgHeightPx / 2}] ## Get 2 vars to hold image dimensions minus one. ## ** For use in 'FOR TESTING' message-sections below. ** set imgWidthPx_1 [expr {$imgWidthPx - 1}] set imgHeightPx_1 [expr {$imgHeightPx - 1}] ####################################################### ## Remove var 'allrowsLISTcolors' so that it can be ## re-created by a first 'lappend' command below. ## ## "You can call 'lappend' with the name of an undefined ## variable and the variable will be created." from ## page 66 of Chapter 5 'Tcl Lists' of the book ## 'Practical Programming in Tcl and Tk' (4th edition) ## by Brent Welch, Ken Jones, Jeffrey Hobbs. ####################################################### catch {unset allrowsLISTcolors} ################################################### ## We start 'scanning' at the top row of pixels. ################################################### for {set yPx 0} {$yPx < $imgHeightPx} {incr yPx} { ####################################################### ## Remove var 'onerowLISTcolors' so that it can be ## re-created by a first 'lappend' command below. ## ## "You can call 'lappend' with the name of an undefined ## variable and the variable will be created." from ## page 66 of Chapter 5 'Tcl Lists' of the book ## 'Practical Programming in Tcl and Tk' (4th edition) ## by Brent Welch, Ken Jones, Jeffrey Hobbs. ####################################################### catch {unset onerowLISTcolors} ################################################ ## We 'scan' along each row of pixels. ################################################ for {set xPx 0} {$xPx < $imgWidthPx} {incr xPx} { ## Convert (xPx,yPx) to world-coordinates (x,y). set x [Xpx2wc $xPx] set y [Ypx2wc $yPx] ## FOR TESTING: (show pixel AND world coords.) ## (Change 'if {0}' to 'if {1}' to activate.) if {0} { if {$yPx == 0 || $yPx == $ymidPx || $yPx == $imgHeightPx_1} { if {$xPx == 0 || $xPx == $xmidPx || $xPx == $imgWidthPx_1} { puts "" puts "xPx = $xPx yPx = $yPx x = $x y = $y" } } } ############################################################## ## Cover the exceptional case when the pixel is at the origin, ## i.e. when x=0.0 and y=0.0 in world coordinates. ## In this case, point P1 = P2 and ## proc 'intersect_line1_line2' fails with 's = Inf'. ############################################################## if {$x == 0.0 && $y == 0.0} { ## For this point at the origin, ## add the polygon 'fill' color to the row-list. lappend onerowLISTcolors $COLOR1hex ## Go to the next pixel in the loop. continue } ## END OF if {$x == 0.0 && $y == 0.0} ## Get coords of Q1 and Q2 --- end-points of the 'face' of ## the polygon sector that contains (x,y). These coords ## are in global vars Q1x,Q1y,Q2x,Q2y. ## NOTE: The points Q1 and Q2 should be on the unit circle ## that circumscribes the polygon. ## Turn debug msgs on or off with 1 or 0 as the last argument. set debug0or1 0 ## FOR TESTING: (Change 'if {0}' to 'if {1}' to activate.) if {0} { if {$yPx == 0 || $yPx == $ymidPx || $yPx == $imgHeightPx_1} { if {$xPx == 0 || $xPx == $xmidPx || $xPx == $imgWidthPx_1} { set debug0or1 1 } } } get_Q1Q2_for_xy $x $y $debug0or1 ## Calculate the intersection point (X,Y) of the line through ## (0.0,0.0) and (x,y) and the line through Q1 and Q2. ## NOTE: The point (X,Y) should be hust inside the unit circle ## that circumscribes the polygon. ## Turn debug msgs on or off with 1 or 0 as the last argument. set debug0or1 0 ## FOR TESTING: (Change 'if {0}' to 'if {1}' to activate.) if {0} { if {$yPx == 0 || $yPx == $ymidPx || $yPx == $imgHeightPx_1} { if {$xPx == 0 || $xPx == $xmidPx || $xPx == $imgWidthPx_1} { set debug0or1 1 } } } intersect_line1_line2 0.0 0.0 $x $y $Q1x $Q1y $Q2x $Q2y $debug0or1 ## Calculate the metric value, v. set r [expr {sqrt( ($x * $x) + ($y * $y) )}] set R [expr {sqrt( ($X * $X) + ($Y * $Y) )}] set v [expr {$r / $R}] ## FOR TESTING: (Change 'if {0}' to 'if {1}' to activate.) if {0} { if {$yPx == 0 || $yPx == $ymidPx || $yPx == $imgHeightPx} { if {$xPx == 0 || $xPx == $xmidPx || $xPx == $imgWidthPx} { puts "" puts "r = $r R = $R v = $v" } } } ## According to the value of v, set the pixel color that we will ## put at $xPx, $yPx. ## ## If v > 1.0, the point x,y is outside the 'polygon shape', ## so we set the pixel to the background color. ## ## The shading at the edges may fall off too slowly if we use v. ## We use a power of v --- M, from a scale widget on the GUI. if {$v > 1.0} { lappend onerowLISTcolors $COLORBKGDhex } else { ## We should be inside or on the 'polygon shape'. set vpow [expr {pow($v,$M)}] set oneMinusVpow [expr {1.0 - $vpow}] set Red [expr {int(($vpow * $COLOR2r) + ($oneMinusVpow * $COLOR1r))}] set Grn [expr {int(($vpow * $COLOR2g) + ($oneMinusVpow * $COLOR1g))}] set Blu [expr {int(($vpow * $COLOR2b) + ($oneMinusVpow * $COLOR1b))}] if {$Red > 255} {set Red 255} if {$Grn > 255} {set Grn 255} if {$Blu > 255} {set Blu 255} if {$Red < 0} {set Red 0} if {$Grn < 0} {set Grn 0} if {$Blu < 0} {set Blu 0} set hexcolor [format "#%02X%02X%02X" $Red $Grn $Blu] ## Put the color at $xPx $yPx. lappend onerowLISTcolors $hexcolor } ## END OF if {$v > 1.0} ## NOTE: ## As an alternative to appending a pixel-color to a row-of-image LIST, ## we could use a checkbutton variable on the GUI to signal that the user ## wants to 'put' a pixel before building the color of the next pixel. } ## END OF the x-loop --- for {set xPx 0} {$xPx < $imgWidthPx} {incr xPx} ################################################################## ## Add the completed row-list to the all-rows-list. ################################################################## lappend allrowsLISTcolors $onerowLISTcolors ## NOTE: ## As an alternative to appending a row of colors to an all-of-image LIST, ## we could use a checkbutton variable on the GUI to signal that the user ## wants to 'put' a horizontal line of pixels before building the next row. } ## END OF the y-loop --- for {set yPx 0} {$yPx < $imgHeightPx} {incr yPx} ################################################################## ## Put the list-of-lists of row colors (the complete image) ## into the 'image structure'. ################################################################## imgID put $allrowsLISTcolors -to 0 0 ## Reset the cursor from a 'watch' cursor. # . config -cursor {} ############################################### ## Show the user the draw-time for this redraw. ############################################### advise_user "\ DRAW TIME: [expr {[clock milliseconds] - $t0}] millisecs elapsed" } ## END OF proc 'ReDraw' ##+######################################################################## ## PROC 'setMappingVars_for_px2wc' ##+######################################################################## ## PURPOSE: Sets up 'constants' to be used in converting between x,y ## 'world coordinates' and 'pixel coordinates' on a Tk canvas. ## ## Puts the constants in global variables: ## PXperWC BASEwcX BASEwcY BASEpxX BASEpxY ## ## These variables are for use by 'Xwc2px' and 'Ywc2px' procs ## and 'Xpx2wc' and 'Ypx2wc' procs. ## ## The 'BASE' variables are coordinates of the upper-left point ## of the 'plotting rectangle' --- in world coordinates and ## in pixel coordinates. ## ## METHOD: This proc takes the coordinates of an UpperLeft (UL) ## point and a LowerRight (LR) point --- in both ## 'world coordinates' and 'pixel coordinates' and ## sets some global variables to the used by the ## other drawing procs --- mainly the ratio: ## ## the number-of-pixels-per-world-coordinate-unit, ## in global variable 'PXperWC' ## ## (This will generally include a fractional amount, ## i.e. it is not necessarily an integer.) ## ## INPUTS: ## ## At least eight numbers are input to this proc, as indicated by: ## ## ULwcX ULwcY ULpxX ULpxY LRwcX LRwcY LRpxX LRpxY ## ## Generally, the 'wc' inputs may be floating point numbers, and the ## 'px' inputs will generally be (non-negative) integers. ## ## Example: (for a plot area with x between -1.2 and +1.2 ## and with y between -0.2 and +1.2) ## setMappingVars_for_px2wc xy -1.2 1.2 0 0 1.2 -0.2 $canvasWidthPx $canvasHeightPx ## ## The first argument can be either 'x' or 'y' or 'xy'. This determines whether ## global variable 'PXperWC' is detemined by just the X-numbers, just the Y-numbers, ## or both. In this script, we use 'xy' (both). ## ## An 'adjustYpx' global variable can be used to adjust if the pixels ## on a user's monitor are not square. ## ## OUTPUTS: global variables PXperWC BASEwcX BASEwcY BASEpxX BASEpxY ## ## CALLED BY: by the Redraw' proc. ##+######################################################################## proc setMappingVars_for_px2wc {xORy ULwcX ULwcY ULpxX ULpxY LRwcX LRwcY LRpxX LRpxY} { global PXperWCx PXperWCy BASEwcX BASEwcY BASEpxX BASEpxY adjustYpx ## FOR TESTING: (to dummy out this proc) # return ############################################################ ## Calculate PXperWCx and PXperWCy ## (pixels-per-world-coordinate-unit) --- the ratio ## of pixels-per-world-coordinate in the x and y directions, ## for the given UL and LR values. ############################################################ set PXperWCx [expr {abs(($LRpxX - $ULpxX) / ($LRwcX - $ULwcX))}] set PXperWCy [expr {abs(($LRpxY - $ULpxY) / ($LRwcY - $ULwcY))}] ## FOR TESTING: if {0} { puts "proc 'Redraw':" puts "LRwcY: $LRwcY ULwcY: $ULwcY LRwcX: $LRwcX ULwcX: $ULwcX" puts "PXperWCx: $PXperWCx" puts "LRpxY: $LRpxY ULpxY: $ULpxY LRpxX: $LRpxX ULpxX: $ULpxX" puts "PXperWCy: $PXperWCy" } ############################################################# ## Reset PXperWCx and PXperWCy according to whether input ## variable 'xORy' is 'x' or 'y' or 'min' or 'xy'. ## ## For 'x', we set PXperWCy equal to PCperWcx. ## ## For 'y', we set PXperWCx equal to PCperWcy. ## ## For 'min', we set PXperWCx and PXperWCy to the smaller ## of PXperWCx and PXperWCy. ## ## For 'xy', we will leave PXperWCx and PXperWCy unchanged. ############################################################# if {$xORy == "x"} { set PXperWCy $PXperWCx } elseif {$xORy == "y"} { set PXperWCx $PXperWCy } elseif {$xORy == "min"} { if {$PXperWCx > $PXperWCy} { set PXperWCx $PXperWCy } else { set PXperWCy $PXperWCx } } ## END OF if {$xORy == "x"} ############################################################ ## In case the pixels are not square, provide a factor ## that can be used to adjust in the Y direction. ############################################################ set adjustYpx 1.0 ############################################################ ## Set BASEwcX, BASEwcY, BASEpxX and BASEpxY. ############################################################ set BASEwcX $ULwcX set BASEwcY $ULwcY set BASEpxX $ULpxX set BASEpxY $ULpxY ## FOR TESTING: if {0} { puts "proc 'setMappingVars_for_px2wc':" puts "PXperWCx: $PXperWCx PXperWCy: $PXperWCy" puts "BASEwcX: $BASEwcX BASEwcY: $BASEwcY" puts "BASEpxX: $BASEpxX BASEpxY: $BASEpxY" } } ## END OF PROC 'setMappingVars_for_px2wc' ##+######################################################################## ## PROC 'Xwc2px' ##+######################################################################## ## PURPOSE: Converts an x world-coordinate to pixel units. ## ## CALLED BY: the 'draw' procs ##+######################################################################## proc Xwc2px {x} { global PXperWCx BASEwcX BASEpxX set px [expr {($x - $BASEwcX) * $PXperWCx + $BASEpxX}] return $px } ## END OF PROC 'Xwc2px' ##+######################################################################## ## PROC 'Xpx2wc' ##+######################################################################## ## PURPOSE: Converts an x-pixel unit to an x-world-coordinate value. ## ## CALLED BY: the 'ReDraw' proc ##+######################################################################## proc Xpx2wc {px} { global PXperWCx BASEwcX BASEpxX set x [expr {( ($px - $BASEpxX) / $PXperWCx ) + $BASEwcX }] return $x } ## END OF PROC 'Xpx2wc' ##+######################################################################## ## PROC 'Ywc2px' ##+######################################################################## ## PURPOSE: Converts an y world-coordinate to pixel units. ## ## CALLED BY: the 'draw' procs ##+######################################################################## proc Ywc2px {y} { global PXperWCy BASEwcY BASEpxY adjustYpx set px [expr {($BASEwcY - $y) * $PXperWCy * $adjustYpx + $BASEpxY}] return $px } ## END OF PROC 'Ywc2px' ##+######################################################################## ## PROC 'Ypx2wc' ##+######################################################################## ## PURPOSE: Converts a y-pixel unit to a y-world-coordinate value. ## ## CALLED BY: the 'ReDraw' proc ##+######################################################################## proc Ypx2wc {px} { global PXperWCy BASEwcY BASEpxY adjustYpx set y [expr { $BASEwcY - ( ($px - $BASEpxY) / ( $PXperWCy * $adjustYpx ) ) }] return $y } ## END OF PROC 'Ypx2wc' ##+####################################################################### ## PROC 'get_Q1Q2_for_xy' ##+######################################################################## ## PURPOSE: Given a point with world-coordinates (x,y), ## determine the sector of the polygon in which the point lies ## and return the coordinates of the end-points Q1 and Q2 ## of that 'facet' of the polygon. ## ## In other words, determine the angle that the line from the ## origin (0.0,0.0) to point (x,y) makes with the x-axis. ## Use that angle to determine the sector in which the point lies. ## ## The polygon sectors are bounded by angles ## i * 2pi/N and (i+1) * 2pi/N. ## We determine the value of 'i' which bounds the angle(x,y). ## Then ## Q1x = cos(i * 2pi/N) ## Q1y = sin(i * 2pi/N) ## Q2x = cos((i+1) * 2pi/N) ## Q2y = sin((i+1) * 2pi/N) ## ## CALLED BY: proc ReDraw ##+######################################################################## proc get_Q1Q2_for_xy {x y debug0or1} { global twopiN Nsides twopi ## Output global vars: The coordinates of the intersection. global Q1x Q1y Q2x Q2y ## Get the angle (in radians) determined by point (x,y). ## atan returns an angle between -pi and +pi. ## We convert negative angles to positive by adding 2pi. set ANGxy [expr {atan2($y,$x)}] if {$ANGxy < 0.0} { set ANGxy [expr {$ANGxy + $twopi}] } ## FOR TESTING: if {$debug0or1} { puts "" puts "FROM proc 'get_Q1Q2_for_xy':" puts " x = $x y = $y ANGxy = $ANGxy" } ## We start a loop to determine 'i+1'. for {set i 1} {$i <= $Nsides} {incr i} { set upperANG [expr {$i * $twopiN}] if {$ANGxy < $upperANG} {break} } set Q1x [expr {cos(($i - 1) * $twopiN)}] set Q1y [expr {sin(($i - 1) * $twopiN)}] set Q2x [expr {cos($i * $twopiN)}] set Q2y [expr {sin($i * $twopiN)}] ## FOR TESTING: if {$debug0or1} { puts " Q1x = $Q1x Q1y = $Q1y Q2x = $Q2x Q2y = $Q2y" } } ## END OF PROC 'get_Q1Q2_for_xy' ##+######################################################################## ## PROC 'intersect_line1_line2' ##+######################################################################## ## PURPOSE: Given points P1,P2 defining line1, ## and points Q1,Q2 defining line2, ## return the coordinates (X,Y) for their intersection. ## ## INPUTS: The x and y coordinates of the 4 points P1,P2,Q1,Q2 ---- ## in other words, 8 floating-point numbers. ## ## METHOD: ## ## The intersection is where P = Q, in other words, we want to ## solve the vector equation ## ## P1 + s * (P2 - P1) = Q1 + t * (Q2 - Q1) ## ## for s and t. ## ## In terms of x,y coordinates, the vector equality becomes the following ## two 'scalar' equations: ## ## P1x + s * (P2x - P1x) = Q1x + t * (Q2x - Q1x) ## and ## P1y + s * (P2y - P1y) = Q1y + t * (Q2y - Q1y) ## ## This gives us 2 linear equations in unkowns s,t: ## ## s * (P2x - P1x) - t * (Q2x - Q1x) = Q1x - P1x ## and ## s * (P2y - P1y) - t * (Q2y - Q1y) = Q1y - P1y ## ## We can write this in a simpler, matrix-like form --- using ## coefficients 'a' and right-hand-side constants 'c' --- as ## ## a11 * s + a12 * t = c1 ## and ## a21 * s + a22 * t = c2 ## ## We can eliminate t by multiplying the first equation by a22 ## and the second equation by a12. We get ## ## a11 a22 s + a22 a12 t = a22 c1 ## and ## a21 a12 s + a22 a12 t = a12 c2 ## ## Subracting equation 2 from equation 1, we get ## ## (a11 * a22 - a21 * a12) * s = a22 * c1 - a12 * c2 ## ## We can write this in 'Cramer' form as ## ## | c1 a12 | ## | c2 a22 | ## s = ----------- ## | a11 a12 | ## | a21 a22 | ## ## Then we can use s in the P1-P2 line equation to get the ## values X,Y of the intersection point of the two lines ## P1-P2 and Q1-Q2. ## ## CALLED BY: proc ReDraw ##+######################################################################## proc intersect_line1_line2 {P1x P1y P2x P2y Q1x Q1y Q2x Q2y debug0or1} { ## Output global vars: The coordinates of the intersection. global X Y set a11 [expr { $P2x - $P1x }] set a12 [expr { $Q1x - $Q2x }] set a21 [expr { $P2y - $P1y }] set a22 [expr { $Q1y - $Q2y }] set c1 [expr { $Q1x - $P1x }] set c2 [expr { $Q1y - $P1y }] set num [expr { ($c1 * $a22) - ($c2 * $a12) }] set denom [expr { ($a11 * $a22) - ($a12 * $a21) }] set s [expr { $num / $denom }] ## FOR TESTING: (Change 'if {0}' to 'if {1}' to activate.) if {$debug0or1} { set absdenom [expr {abs($denom)}] if {$absdenom < 0.001} { puts "" puts "FROM proc 'intersect_line1_line2':" puts " P1x = $P1x P1y = $P1y P2x = $P2x P2y = $P2y" puts " Q1x = $Q1x Q1y = $Q1y Q2x = $Q2x Q2y = $Q2y" puts " num = $num denom = $denom s = $s" } } set X [expr { $P1x + ($s * ($P2x - $P1x)) }] set Y [expr { $P1y + ($s * ($P2y - $P1y)) }] ## FOR TESTING: (Change 'if {0}' to 'if {1}' to activate.) if {$debug0or1} { if {$absdenom < 0.001} { puts " X = $X Y = $Y" } } } ## END OF proc 'intersect_line1_line2' ##+########################################################## ## proc set_scale_Ymax_equal_Xmax ## ## PURPOSE: Make YmaxPx equal XmaxPx when the scale for ## XmaxPx is used. ## ## CALLED BY: a button1-release binding on .fRimgsize.scaleXmaxPx. ##+########################################################## proc set_scale_Ymax_equal_Xmax {} { global XmaxPx YmaxPx if {$YmaxPx != $XmaxPx} {set YmaxPx $XmaxPx} } ## END OF proc 'set_scale_Ymax_equal_Xmax' ##+##################################################################### ## proc 'set_polygon_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 a 'fill' color. ## ## Arguments: none ## ## CALLED BY: .fRbuttons.buttCOLOR1 button ##+##################################################################### proc set_polygon_color1 {} { global COLOR1r COLOR1g COLOR1b COLOR1hex ColorSelectorScript ## FOR TESTING: # puts "COLOR1r: $COLOR1r" # puts "COLOR1g: $COLOR1g" # puts "COLOR1b: $COLOR1b" set TEMPrgb [ exec $ColorSelectorScript $COLOR1r $COLOR1g $COLOR1b] ## 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 ## Set background color of the indicated color button. update_color_button color1 ## Redraw the geometry in the new 'fill' color. ## OR advise the user to click 'ReDraw' button. # ReDraw 0 advise_user "** Click 'ReDraw' button to use new color. **" } ## END OF proc 'set_polygon_color1' ##+##################################################################### ## proc 'set_polygon_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 an 'edge' color. ## ## Arguments: none ## ## CALLED BY: .fRbuttons.buttCOLOR2 button ##+##################################################################### proc set_polygon_color2 {} { global COLOR2r COLOR2g COLOR2b COLOR2hex ColorSelectorScript ## FOR TESTING: # puts "COLOR2r: $COLOR2r" # puts "COLOR2g: $COLOR2g" # puts "COLOR2b: $COLOR2b" set TEMPrgb [ exec $ColorSelectorScript $COLOR2r $COLOR2g $COLOR2b] ## 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 ## Set background color of the indicated color button. update_color_button color2 ## Redraw the geometry in the new 'edge' color. ## OR advise the user to click 'ReDraw' button. # ReDraw 0 advise_user "** Click 'ReDraw' button to use new color. **" } ## END OF proc 'set_polygon_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 (lines) lie. ## ## Arguments: none ## ## CALLED BY: .fRbuttons.buttCOLORBKGD button ##+##################################################################### proc set_background_color {} { global COLORBKGDr COLORBKGDg COLORBKGDb COLORBKGDhex ColorSelectorScript ## FOR TESTING: # puts "COLORBKGDr: $COLORBKGDr" # puts "COLORBKGDg: $COLORBKGDb" # puts "COLORBKGDb: $COLORBKGDb" set TEMPrgb [ exec $ColorSelectorScript $COLORBKGDr $COLORBKGDg $COLORBKGDb] ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" if { "$TEMPrgb" == "" } { return } scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB set COLORBKGDhex "#$hexRGB" set COLORBKGDr $r255 set COLORBKGDg $g255 set COLORBKGDb $b255 ## Set background color of the indicated color button. update_color_button bkgd ## Redraw the geometry in the new background color. ## OR advise the user to click 'ReDraw' button. # ReDraw 0 advise_user "** Click 'ReDraw' button to use new color. **" } ## END OF proc 'set_background_color' ##+##################################################################### ## PROC 'update_color_button' ##+##################################################################### ## PURPOSE: ## This procedure is invoked to set the background color of the ## color button, indicated by the 'colorID' string, ## to its currently set 'colorID' color --- and sets ## foreground color, for text on the button, to a suitable black or ## white color, so that the label text is readable. ## ## Arguments: global color vars ## ## CALLED BY: in three 'set_*_color*' procs ## and in the additional-GUI-initialization section at ## the bottom of this script. ##+##################################################################### proc update_color_button {colorID} { global COLOR1r COLOR1g COLOR1b COLOR1hex global COLORBKGDr COLORBKGDg COLORBKGDb COLORBKGDhex global COLOR2r COLOR2g COLOR2b COLOR2hex # set colorBREAK 300 set colorBREAK 350 if {"$colorID" == "color1"} { .fRbuttons.buttCOLOR1 configure -bg $COLOR1hex set sumCOLOR1 [expr {$COLOR1r + $COLOR1g + $COLOR1b}] if {$sumCOLOR1 > $colorBREAK} { .fRbuttons.buttCOLOR1 configure -fg "#000000" } else { .fRbuttons.buttCOLOR1 configure -fg "#ffffff" } } elseif {"$colorID" == "color2"} { .fRbuttons.buttCOLOR2 configure -bg $COLOR2hex set sumCOLOR1 [expr {$COLOR2r + $COLOR2g + $COLOR2b}] if {$sumCOLOR1 > $colorBREAK} { .fRbuttons.buttCOLOR2 configure -fg "#000000" } else { .fRbuttons.buttCOLOR2 configure -fg "#ffffff" } } elseif {"$colorID" == "bkgd"} { .fRbuttons.buttCOLORBKGD configure -bg $COLORBKGDhex set sumCOLOR1 [expr {$COLORBKGDr + $COLORBKGDg + $COLORBKGDb}] if {$sumCOLOR1 > $colorBREAK} { .fRbuttons.buttCOLORBKGD configure -fg "#000000" } else { .fRbuttons.buttCOLORBKGD configure -fg "#ffffff" } } else { ## Seems to be an invalid colorID. return } } ## END OF PROC 'update_color_button' ##+##################################################################### ## PROC 'advise_user' ##+##################################################################### ## PURPOSE: ## ## CALLED BY: in three 'set_*_color*' procs, ## in some 'bind' statements in the BIND section above, ## and in the additional-GUI-initialization section at ## the bottom of this script. ##+##################################################################### proc advise_user {text} { .fRmsg.labelINFO configure -text "$text" } ## END OF PROC 'update_color_button' ##+######################################################################## ## PROC 'popup_msgVarWithScroll' ##+######################################################################## ## PURPOSE: Report help or error conditions to the user. ## ## We do not use focus,grab,tkwait in this proc, ## because we use it to show help when the GUI is idle, ## and we may want the user to be able to keep the Help ## window open while doing some other things with the GUI ## such as putting a filename in the filename entry field ## or clicking on a radiobutton. ## ## For a similar proc with focus-grab-tkwait added, ## see the proc 'popup_msgVarWithScroll_wait' in a ## 3DterrainGeneratorExaminer Tk script. ## ## REFERENCE: page 602 of 'Practical Programming in Tcl and Tk', ## 4th edition, by Welch, Jones, Hobbs. ## ## ARGUMENTS: A toplevel frame name (such as .fRhelp or .fRerrmsg) ## and a variable holding text (many lines, if needed). ## ## CALLED BY: 'help' button ##+######################################################################## ## To have more control over the formatting of the message (esp. ## words per line), we use this 'toplevel-text' method, ## rather than the 'tk_dialog' method -- like on page 574 of the book ## by Hattie Schroeder & Mike Doyel,'Interactive Web Applications ## with Tcl/Tk', Appendix A "ED, the Tcl Code Editor". ##+######################################################################## proc popup_msgVarWithScroll { toplevName VARtext ULloc} { ## global fontTEMP_varwidth #; Not needed. 'wish' makes this global. ## global env # bell # bell ################################################# ## Set VARwidth & VARheight from $VARtext. ################################################# ## To get VARheight, ## split at '\n' (newlines) and count 'lines'. ################################################# set VARlist [ split $VARtext "\n" ] ## For testing: # puts "VARlist: $VARlist" set VARheight [ llength $VARlist ] ## For testing: # puts "VARheight: $VARheight" ################################################# ## To get VARwidth, ## loop through the 'lines' getting length ## of each; save max. ################################################# set VARwidth 0 ############################################# ## LOOK AT EACH LINE IN THE LIST. ############################################# foreach line $VARlist { ############################################# ## Get the length of the line. ############################################# set LINEwidth [ string length $line ] if { $LINEwidth > $VARwidth } { set VARwidth $LINEwidth } } ## END OF foreach line $VARlist ## For testing: # puts "VARwidth: $VARwidth" ############################################################### ## NOTE: VARwidth works for a fixed-width font used for the ## text widget ... BUT the programmer may need to be ## careful that the contents of VARtext are all ## countable characters by the 'string length' command. ############################################################### ##################################### ## SETUP 'TOP LEVEL' HELP WINDOW. ##################################### catch {destroy $toplevName} toplevel $toplevName # wm geometry $toplevName 600x400+100+50 # wm geometry $toplevName +100+50 wm geometry $toplevName $ULloc wm title $toplevName "Note" # wm title $toplevName "Note to $env(USER)" wm iconname $toplevName "Note" ##################################### ## In the frame '$toplevName' - ## DEFINE THE TEXT WIDGET and ## its two scrollbars --- and ## DEFINE an OK BUTTON widget. ##################################### if {$VARheight > 10} { text $toplevName.text \ -wrap none \ -font fontTEMP_varwidth \ -width $VARwidth \ -height $VARheight \ -bg "#f0f0f0" \ -relief raised \ -bd 2 \ -yscrollcommand "$toplevName.scrolly set" \ -xscrollcommand "$toplevName.scrollx set" scrollbar $toplevName.scrolly \ -orient vertical \ -command "$toplevName.text yview" scrollbar $toplevName.scrollx \ -orient horizontal \ -command "$toplevName.text xview" } else { text $toplevName.text \ -wrap none \ -font fontTEMP_varwidth \ -width $VARwidth \ -height $VARheight \ -bg "#f0f0f0" \ -relief raised \ -bd 2 } button $toplevName.butt \ -text "OK" \ -font fontTEMP_varwidth \ -command "destroy $toplevName" ############################################### ## PACK *ALL* the widgets in frame '$toplevName'. ############################################### ## Pack the bottom button BEFORE the ## bottom x-scrollbar widget, pack $toplevName.butt \ -side bottom \ -anchor center \ -fill none \ -expand 0 if {$VARheight > 10} { ## Pack the scrollbars BEFORE the text widget, ## so that the text does not monopolize the space. pack $toplevName.scrolly \ -side right \ -anchor center \ -fill y \ -expand 0 ## DO NOT USE '-expand 1' HERE on the Y-scrollbar. ## THAT ALLOWS Y-SCROLLBAR TO EXPAND AND PUTS ## BLANK SPACE BETWEEN Y-SCROLLBAR & THE TEXT AREA. pack $toplevName.scrollx \ -side bottom \ -anchor center \ -fill x \ -expand 0 ## DO NOT USE '-expand 1' HERE on the X-scrollbar. ## THAT KEEPS THE TEXT AREA FROM EXPANDING. pack $toplevName.text \ -side top \ -anchor center \ -fill both \ -expand 1 } else { pack $toplevName.text \ -side top \ -anchor center \ -fill both \ -expand 1 } ##################################### ## LOAD MSG INTO TEXT WIDGET. ##################################### ## $toplevName.text delete 1.0 end $toplevName.text insert end $VARtext $toplevName.text configure -state disabled } ## END OF PROC 'popup_msgVarWithScroll' ##+######################################################## ## Set the 'HELPtext' var. ##+######################################################## set HELPtext "\ \ \ ** HELP for this Color-Gradient-Polygon maker --- with shaded, 3D-like edges. ** This Tk GUI script facilitates the creation of an edge-shaded, color-gradient N-sided 'polygon' --- with the color gradient going radially from the middle of the polygon to the outer edges. The rectangular (or square) image lies on a rectangular 'canvas' area. The polygon lies within the rectangular image area, with a margin around it. In the margin, outside the polygon on the image-rectangle, a user-selected 'background' color is applied. Rather than simply use a single color within the polygon, and get an unshaded polygon, this GUI allows the user to choose TWO colors ('fill' and 'edge') and the polygon is colored from the 'fill' color in the center of the polygon to the 'edge' color at the outer facets of the polygon. We use a 'pixel-by-pixel coloring' technique in this script in order to facilitate creation of the shading (3D effect) at the edges of the polygon. The 2 user-selected colors, that gradiate across the polygon radially, allow for creating the 3D effect at the edges of the polygon. To get nice blending of the edges with the background color, the user may want to choose the same color for the edge-color and the background-color. **************************** SOME 'scale' WIDGET FEATURES: **************************** Note that you can click in the 'trough' on either side of a slider-button of a 'scale' widget, to change the scale value precisely one 'resolution-unit' per click. Hold down the mouse-button for about a second, on either side of the 'trough', and the scale value changes repeatedly, one 'resolution-unit' at a time. On this GUI, when you change the Image-Width scale widget, the Image-Height scale widget is set to the same value. This is to allow for easy specification of a SQUARE image. If you want a non-square image, change the Image-Height AFTER you have set the Image-Width. ******************** USES OF THE IMAGE: ******************** Examples of use of this polygon-shaped image: 1) After this 'color shaded polygon' image is made and captured in an image file, the image could be scaled down to be used as a 'bullet' decorative item --- for a list of items on a web page or on widgets of a Tk GUI, such as on drawers of a 'toolchest'. 2) At a large size, the 'color shaded polygon' image could be used as a background for a logo. 3) At a medium size, the image could be used as a background for an icon (say, to be displayed on a 'desktop'). ************************* CAPTURING THE IMAGE: ************************* A screen/window capture utility (like 'gnome-screenshot' on Linux) can be used to capture the GUI image in a PNG 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-background' image file. 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 or buttons for use in web-pages or GUIs. ********************* THE SHADING TECHNIQUE (for the 3D effect): ********************* To do the shading of our 2-color-gradient polygon, we establish a scalar 'color-shading-metric' on the polygon. The 'metric' is 0.0 at the middle of the polygon and 1.0 on the outer edges of the polygon. We use that metric to determine the 'mix' of the two colors ('fill' color and 'edge' color) at any pixel in the image. ************************************************* DERIVATION OF A 'COLOR METRIC' FOR THE 'POLYGON': ************************************************* For the moment, we forget the fact that we are going to scan across the horizontal pixel lines of the image-rectangle to set the color of each pixel. The x,y locations of those pixels are specified as integers. Instead, we will think of using 'world-coordinates' ('real', 'floating-point' numbers, not necessarily integers) for the x,y coordinates of the interior points of our polygon. We will think of our polygon as being centered at (0.0,0.0), and we are going to want to color the pixels in our polygon such that all the pixels on a line parallel to one of the outer edges of the polygon are the same color. That color is a mix of the 'fill' and 'edge' RGB colors. To specify that color-mix, we want to devise a metric, v, that is zero at the origin (0.0,0.0) and is 1.0 on the outer edges of the polygon. Given a point (x,y) inside the polygon, we will define our metric to be v = r(x,y) / R(X,Y) where r(x,y) = sqrt (x*x + y*y). To determine R(X,Y), we imagine extending a line from the origin (0.0, 0.0) through (x,y) until it intersects an outer edge of the polygon --- at a point (X,Y) say. We set R(x,y) = sqrt (X*X + Y*Y). This gives us a nice metric, v, with v = 0 at the origin and v = 1 on the outer edge of the polygon. ************************************** DETERMINING THE INTERSECTION POINT X,Y: ************************************** The tough mathematics comes in determining the intersection point X,Y. We will do that by using a parametric form of the two intersecting lines --- one line being the one through the origin and (x,y). The other line being a 'face' of the polygon. For simplicity, we will say our polygon has vertices 1.0 unit from the origin. I.e. the vertices lie on a unit circle. There are N faces of the polygon --- each subtending an angle of (2 * pi / N). We can determine the 'sector of the polygon' in which a point (x,y) lies from the angle that the line through 0,0 and x,y makes with a horizontal x-axis. Knowing that sector, we know the angles made by the two lines from the origin (0,0) to the two end-points of the 'face' of that sector, say Q1 and Q2, and we can calculate the coordinates of those two points (which happen to lie on our unit circle). Now our problem boils down to finding the intersection point, (X,Y), of two lines --- the line through P1 (the origin) and P2 (the x,y point) --- and the line through Q1 and Q2. We will use a parametric formulation of these two lines, with parameters s and t, respectively. And we will use a proc that solves 2 linear equations in 2 unknowns, given the constants in the equations via the coordinates of P1,P2,Q1,Q2. Here is how we do the parameterization. For this argument, P1 can be any point (not necessarily the origin). We are just devising a method to find the intersection of any two non-parallel lines --- given a pair of points defining each line. Thinking of P1,P2,Q1,Q2 as being 2-dimensional vectors, the vector equations for our two lines are: P = P1 + s * (P2 - P1) which is P1 at s=0 and P2 at s=1 Q = Q1 + t * (Q2 - Q1) which is Q1 at t=0 and Q2 at t=1 The intersection is where P = Q, in other words, we want to solve the vector equation P1 + s * (P2 - P1) = Q1 + t * (Q2 - Q1) for s and t. In terms of x,y coordinates, the vector equality becomes the following two 'scalar' equations: P1x + s * (P2x - P1x) = Q1x + t * (Q2x - Q1x) and P1y + s * (P2y - P1y) = Q1y + t * (Q2y - Q1y) This gives us 2 linear equations in unkowns s,t: s * (P2x - P1x) - t * (Q2x - Q1x) = Q1x - P1x and s * (P2y - P1y) - t * (Q2y - Q1y) = Q1y - P1y We can write this in a simpler, matrix-like form --- using coefficients 'a' and right-hand-side constants 'c' --- as a11 * s + a12 * t = c1 and a21 * s + a22 * t = c2 We can eliminate t by multiplying the first equation by a22 and the second equation by a12. We get a11 a22 s + a22 a12 t = a22 c1 and a21 a12 s + a22 a12 t = a12 c2 Subracting equation 2 from equation 1, we get (a11 * a22 - a21 * a12) * s = a22 * c1 - a12 * c2 We can write this in 'Cramer' form as | c1 a12 | | c2 a22 | s = ----------- | a11 a12 | | a21 a22 | Then we can use s in the P1-P2 line equation to get the values X,Y of the intersection point of the two lines P1-P2 and Q1-Q2. Then we get R(x,y) = sqrt (X*X + Y*Y). Which gives us v = r(x,y) / R(X,Y), where r(x,y) = sqrt (x*x + y*y). Now we have a method to compute the suitable metric, v. ******************************************************** USING THE 'COLOR METRIC' TO COLOR A PIXEL in (or out of) the polygon: ******************************************************** As we scan across the pixels of the rectangular image area, we can convert integer pixel coordinates (i,j) to 'real-number' 'world coordinates' (x,y) --- with (x,y) = (0.0,0.0) being somewhere in the middle of the rectangular image area. At a point (x,y) inside the polygon, the metric v is less than or equal to 1.0. At a point (x,y) outside the polygon the metric v is greater than 1.0. For those external points, we simply set the color to the user-selected background color. We determine the 'shaded color' at a point inside the polygon by using a color interpolated between (1) the user-selected 'fill' color (color1) for the 'polygon shape' and (2) the user-selected 'edge' color (color2). We calculate the 'shaded color' at (x,y) by calculating a weighted average based on applying the factor (1.0 - v) to color1 (the 'fill' color) --- and applying v to color2 (the 'edge' color). That is: shaded-color = (1 - v) * color1 + v * color2. We actually calculate via formulas like shaded-R = (1 - v) * R1 + v * R2 shaded-G = (1 - v) * G1 + v * G2 shaded-B = (1 - v) * B1 + v * B2 Thus we will get the edge-shading (the 3D effect) for the 'polygon shape'. --- Actually, it turns out that v and 1-v gives a rather washed-out (too gradual) shading effect. It is better if we raise v to a power M and use v^M and (1 - v^M). It turns out that M = 6 to M = 12 gives pretty nice shading for the polygon shape, but rather than hard-code the value of M, we provide a scale widget on the GUI so that the user can set the value of M --- between 1 and 20, say. Thus the transition from the 'fill' color to the 'edge' (or 'background') color can be made 'sharp' or 'fuzzy'. We will refer to the exponent M, a variable that makes the edge-color transition sharp or fuzzy, as an 'extensity' variable --- an 'extent-and-intensity' determining variable. " ##+##################################################### ##+##################################################### ## ADDITIONAL GUI INITIALIZATION, if needed (or wanted). ##+##################################################### ##+##################################################### ##+##################################################### ## Set the full-name of the RGB color-selector Tk script ## that is used in several procs above. ##+##################################################### ## FOR TESTING: # puts "argv0: $argv0" set DIRthisScript "[file dirname $argv0]" ## For ease of testing in a Linux/Unix terminal and located at the ## directory containing this Tk script. Set the full directory name. if {"$DIRthisScript" == "."} { set DIRthisScript "[pwd]" } set DIRupOne "[file dirname "$DIRthisScript"]" set DIRupTwo "[file dirname "$DIRupOne"]" set ColorSelectorScript "$DIRupTwo/SELECTORtools/tkRGBselector/sho_colorvals_via_sliders3rgb.tk" ## Alternatively: Put the RGB color-selector Tk script in the ## same directory as this Tk script and uncomment the following. # set ColorSelectorScript "$DIRthisScript/sho_colorvals_via_sliders3rgb.tk" ##+######################################### ## Initialize the polygon shape 'fill' color. ## ## (Change 'if {1}' to 'if {0}' to try an ## alternative 'fill' color.) ##+######################################### if {1} { ## Magenta: set COLOR1r 255 set COLOR1g 0 set COLOR1b 255 } else { ## White: set COLOR1r 255 set COLOR1g 255 set COLOR1b 255 } set COLOR1hex [format "#%02X%02X%02X" $COLOR1r $COLOR1g $COLOR1b] update_color_button "color1" ##+######################################### ## Initialize the polygon shape 'edge' color ## to gradiate to, from the 'fill' color. ## ## (Change 'if {1}' to 'if {0}' to try an ## alternative 'edge' color.) ##+######################################### if {1} { ## Black: set COLOR2r 0 set COLOR2g 0 set COLOR2b 0 } else { ## Yellow: set COLOR2r 255 set COLOR2g 255 set COLOR2b 0 } set COLOR2hex [format "#%02X%02X%02X" $COLOR2r $COLOR2g $COLOR2b] update_color_button "color2" ##+############################################## ## Initialize the background color for the canvas. ## (Change 'if {1}' to 'if {0}' to try an ## alternative background color.) ##+############################################## if {1} { ## Medium Gray: set COLORBKGDr 150 set COLORBKGDg 150 set COLORBKGDb 150 } else { ## Black: set COLORBKGDr 0 set COLORBKGDg 0 set COLORBKGDb 0 } set COLORBKGDhex \ [format "#%02X%02X%02X" $COLORBKGDr $COLORBKGDg $COLORBKGDb] update_color_button "bkgd" ##+################################################# ## Set constants to use for angle conversions --- ## degrees to radians. ##+################################################ set pi [expr {4.0 * atan(1.0)}] set twopi [expr {2.0 * $pi}] # set radsPERdeg [expr {$pi/180.0}] ##+##################################################### ## Set initial scale widget variables --- for ## Nsides, M, and marginFRACTION. ##+##################################################### set Nsides 6 set M 6 set marginFRACTION 0.2 ##+################################################# ## Set initial image size. ##+################################################ if {1} { ## Draw goes much faster with small image size --- ## less than 1 second for a 200x200 image on a ## moderately powerful CPU. set XmaxPx 200 set YmaxPx 200 } else { ## A 400x400 image may take about 3 seconds. set XmaxPx 400 set YmaxPx 400 } ##+##################################################### ## Initialize the canvas with 'ReDraw'. ##+##################################################### ReDraw 0 ## Alternative, if we do not do an initial redraw: # advise_user "** Click 'ReDraw' button to start. **"