#!/usr/bin/wish -f ## ## SCRIPT: makePolygons_withRoundedCorners_2solidColors.tk ## ## ## PURPOSE: This Tk GUI script facilitates the creation of polygons ## (3 to 10 sided ; i.e. triangle to decagon - also a star) ## as solid-color images with rounded corners at vertices --- ## on a canvas widget. ## ## An image consists of one polygon done in two colors --- ## one color inside the polygon (with round corners) and a ## different color outside the rounded polygon (i.e. the ## canvas background). ## ## METHOD: The GUI contains a rectangular canvas widget on which the ## solid-color polygon with rounded corners is drawn. ## ## The GUI includes a 'scale' widget whose slider-bar can ## be used to change the radius of the corners dynamically. ## That is, the polygon (or star) corners change radius as ## the slider-bar is dragged in either direction. ## ## The GUI also includes the capability to set the 2 colors ## of the image. (Any number of methods could be used to ## set the two colors: two entry fields OR 2 buttons which ## call on an external script to allow the user to set each ## color via a color-selector-GUI. We use the latter.) ## ## (A set of 6 spinboxes or 6 scales could be put on the GUI ## to set the RGB values of the 2 colors --- but those widgets ## take a lot of space on the GUI.) ## ## There is a '-command' parameter tied to the radius-setting 'scale' ## widget. That parameter is used to call a 'ReDraw' proc ## to redraw the solid-colored polygon with round corners --- as ## the slider-bar is used to change the value of a radius variable. ## ## The redraw includes clearing the canvas and redrawing ## polygons on the canvas for each detected change in radius. ## ## Since erasing these items from the canvas and redrawing them ## completes within a very small fraction of a second, it is ## 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 editor ## could also be used to blur the image slightly to 'feather' ## the edges of the polygon. ## ## Several 'use-cases' for the captured-cropped image file: ## ## 1) The colored image could be used, directly, for the background of ## 'buttons'/'drawers'/'icons'/'bullets' in GUIs such as 'toolchests'. ## ## 2) The colored image file could be used with a utility (like the ## ImageMagick 'convert' command) to change the outer (or inner) ## color to TRANSPARENT, making a partially transparent GIF ## (or PNG) file --- for example, with the 'rounded-off' corners ## being part of the transparency. ## Then the semi-transparent, solid-color image file could be used, ## directly, for the background of 'buttons'/'drawers'/etc in GUIs ## such as 'toolchests'. ## ## 3) The semi-transparent, solid-color image file from use-case 2 ## could be used as a MASK on a non-solid-color image file of ## the same size. ## A utility (like the ImageMagick 'convert' or 'composite' command) ## could be used to 'apply' the mask to the NON-solid-color image ## file, making a rounded-corner semi-transparent image file ## (GIF or PNG) from the NON-solid-color image. ## Then the semi-transparent, NON-solid-color image file could be ## used, for 'buttons'/'drawers'/etc in GUI's. ## ## 4) For a family of GUI 'toolchests', the toolchests will generally ## require a different width button/drawer for each toolchest. ## In that case, the semi-transparent, NON-solid-color image file ## from use-case 3 could be STRETCHED-OUT (by any one of several means) ## to make a semi-transparent, NON-solid-color image of the required ## width for each toolchest. ## ##+######################################################################## ## REFERENCE: ## http://wiki.tcl.tk/8590 - 'Rounded Polygons' ## (code downloaded 2012aug14) ## Author: KPV = Keith Vetter 2003 ## ##+######################################################################## ## 'CANONICAL' STRUCTURE OF THIS TK CODE: ## ## 0) Set general window parms (win-name,win-position,win-size-control, ## win-color-scheme, fonts, widget-geometry-parms,etc.). ## ## 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' , '.fRpolyspecs' , '.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 ## 2 buttons (for setting the inside/outside colors), ## and ## 1 checkbutton to ask for an EQUILATERAL n-gon ## and ## 1 checkbutton to ask that a DOTTED 'TRACE' of ## the non-rounded polygon 'corners' be shown ## 'in the background' --- in light-gray fill, ## with a black dotted outline. ## ## - In '.fRpolyspecs': 1 'minilistbox' widget to specify the polygon type, ## which is usually indicated by the number, N, of ## sides (but using 0 to request the star polygon), ## and ## 1 'minilistbox' widget to specify a rotation ## angle to use in drawing the polygon (sets the ## place where the first polygon vertex is drawn) ## and ## 1 radius 'scale' widget, to 'dynamically' change ## the radius of the polygon 'corners' ## ## - In '.fRcan': 1 'canvas' widget ## ## 3) Define bindings: ## - button1-release on either of the 2 checkbuttons (the 'equilateral' ## and 'corner-trace' requests) should cause a redraw ## - change of the N-sides indicator (polygon type) --- i.e. ## button1-release on that 'minilistbox' --- should cause a redraw ## - change of the rotation indicator (polygon orientation) --- i.e. ## button1-release on that 'minilistbox' --- should cause a redraw ## - change of inside or outside color should cause a redraw --- i.e. ## the commands for the 2 color-setting buttons should end with a redraw ## ## 4) Define procs: ## ## - 'ReDraw' - draws the polygon/star on the canvas ## - 'RoundPoly' - handles making the round corners ## - '_RoundPoly2' - helps to make the round corners ## - 'rp' - makes the vertices of an N-sided 'regular' polygon ## - 'MakeStar' - makes the vertices of a 5-pointed star ## ## - 'set_color_inside' shows a color selector GUI and uses the ## user-selected color to redraw (re-fill) the ## polygons on the canvas in the specified color ## ## - 'set_color_outside' 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 'ReDraw' once with ## an initial, example set of parms ## --- Nsides curRADIUS CINhex COUThex ## (poly-type, radius and 2 colors) --- ## to start with a rounded polygon 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 2012aug15 ## Changed by: ...... ......... 2012 ##+####################################################################### ##+####################################################################### ## Set general window parms (title,position,size,color-scheme,fonts,etc.). ##+####################################################################### wm title . "Polygons with Round Corners on a Canvas" wm iconname . "RoundPolys" 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 'inside' and 'outside' colors for the canvas. # set CINr 255 # set CINg 255 # set CINb 255 set CINr 100 set CINg 100 set CINb 240 set CINhex [format "#%02X%02X%02X" $CINr $CINg $CINb] # set COUTr 0 # set COUTg 0 # set COUTb 0 set COUTr 60 set COUTg 60 set COUTb 60 set COUThex [format "#%02X%02X%02X" $COUTr $COUTg $COUTb] ##+######################################################## ## 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 ## 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 ## 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 (and LABEL) geom parameters: set PADXpx_button 0 set PADYpx_button 0 set BDwidthPx_button 2 ## SCALE geom parameters: set BDwidthPx_scale 2 set initScaleLengthPx 200 ##+################################################################### ## Set a MINSIZE of the window. ## ## For width, allow for the minwidth of the '.fRbuttons' frame: ## about 3 buttons (Exit,Color1,Color2), and ## 2 checkboxes, and a label with current polygon-type ## and current rotation angle shown. ## ## For height, allow for a canvas at least 24 pixels high, and ## 2 chars high for the scale widget height in the ## .fRpolyspecs' frame, and ## 2 chars high for the widgets in the '.fRbuttons' frame. ##+################################################################### set minWinWidthPx [font measure fontTEMP_fixedwidth \ "ExitColor1Color2EquilateralRotation Current PolyID Angle"] ## Add some pixels to account for right-left-side window decoration ## (about 8 pixels), about 6x8 pixels for borders/padding for frames ## and 3 buttons and 2 checkboxes and 1 label (6 widgets). set minWinWidthPx [expr 56 + $minWinWidthPx] ## FOR MIN HEIGHT: set CharHeightPx [font metrics fontTEMP_fixedwidth -linespace] set minWinHeightPx [expr $minCanHeightPx + 4 * $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' '.fRpolyspecs' 'fRcan' ## ## Sub-frames: none ##+################################################################ # set BDwidth_frame 0 set BDwidth_frame 2 # set RELIEF_frame raised set RELIEF_frame flat frame .fRbuttons -relief $RELIEF_frame -borderwidth $BDwidth_frame frame .fRpolyspecs -relief raised -borderwidth 2 frame .fRcan -relief $RELIEF_frame -borderwidth $BDwidth_frame ##+############################## ## PACK the top-level FRAMES. ##+############################## pack .fRbuttons \ .fRpolyspecs \ -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 seloptvar mlbProc} { global fontTEMP_SMALL_fixedwidth fontTEMP_SMALL_varwidth \ listboxBKGD listboxWIDTHchars ##+##################################### ## 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 "Nsides: $Nsides" ## 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 ## Let us define those 4 global vars for the 'minlistbox' proc. 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 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 set listboxBKGD "#f0f0f0" set listboxWIDTHchars 15 ##+######################################################### ## OK. Now we are ready to define the widgets in the frames. ##+######################################################### ##+##################################################################### ## In the '.fRbuttons' FRAME --- DEFINE-and-PACK ## - an exit-button, ## and ## - 2 buttons ( to specify 'inside' color and 'outside' color) ## and ## - a CHECKBUTTON (to request an EQUILATERAL polygon) ## and ## - a CHECKBUTTON (to request a 'trace' of the polygon corners/points) ##+##################################################################### button .fRbuttons.buttEXIT \ -text "Exit" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {exit} button .fRbuttons.buttCIN \ -text "\ Inside Color" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {set_color_inside} button .fRbuttons.buttCOUT \ -text "\ Outside Color" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {set_color_outside} set polygonEQUILAT 1 checkbutton .fRbuttons.chkbuttEQUILAT \ -text "Equilateral" \ -font fontTEMP_varwidth \ -variable polygonEQUILAT \ -selectcolor "#cccccc" \ -relief raised set polygonTRACE 0 checkbutton .fRbuttons.chkbuttTRACE \ -text "Show Vertices" \ -font fontTEMP_varwidth \ -variable polygonTRACE \ -selectcolor "#cccccc" \ -relief raised label .fRbuttons.labelPARMS \ -text "" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd $BDwidthPx_button ##+########################################### ## Pack the widgets in the 'fRbuttons' frame. ##+########################################### pack .fRbuttons.buttEXIT \ .fRbuttons.buttCIN \ .fRbuttons.buttCOUT \ .fRbuttons.chkbuttEQUILAT \ .fRbuttons.chkbuttTRACE \ .fRbuttons.labelPARMS \ -side left \ -anchor w \ -fill none \ -expand 0 ##+################################################################## ## In the '.fRpolyspecs' FRAME ---- DEFINE-and-PACK ## - a LABEL widget ## - a 'minilistbox' widget for polygon-type ## - a LABEL widget ## - a 'minlistbox' widget for rotation/angle (polygon orientation) ## - a LABEL widget ## - a SCALE widget, for radius of the rounded corners/points ##+################################################################### label .fRpolyspecs.labelNsides \ -text "\ Polygon type (N sides ; 0 is 5-pointed-star)" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd $BDwidthPx_button ## DEFINE the 'minilistbox' widget for polygon type (Nsides) frame .fRpolyspecs.fRpolysides -relief flat -bd 0 set polynums { 0 3 4 5 6 7 8 9 10 } set Nsides 5 minilistbox .fRpolyspecs.fRpolysides $Nsides $polynums Nsides "ReDraw 0" label .fRpolyspecs.labelNinfo \ -text "\ \ \ \ \ Rotation angle (CC):" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd $BDwidthPx_button ## DEFINE the 'minilistbox' widget for polygon rotation angle (orientation) frame .fRpolyspecs.fRpolyangle -relief flat -bd 0 set polyangles { 0 45 90 135 180 225 270 315 } set theta0deg 0 minilistbox .fRpolyspecs.fRpolyangle $theta0deg $polyangles theta0deg "ReDraw 0" ##+################################ ## DEFINE the radius 'scale' widget ## including a 'label' widget. ##+################################ ## Set the init value for the radius-scale var. set curRADIUSallVerts 25 ## 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 / 4] set scaleMaxUnits [expr $initCanWidthPx / 2] ## Define a label widget to precede the radius-scale, ## followed by the scale: label .fRpolyspecs.labelSCALE1 \ -text "\ \ \ \ \ Radius for all corners:" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd $BDwidthPx_button scale .fRpolyspecs.scale1 \ -orient horizontal \ -digits 0 \ -from 0 -to $scaleMaxUnits \ -length $initScaleLengthPx \ -variable curRADIUSallVerts \ -command "ReDraw" ## PACK the widgets of FRAME .fRpolyspecs --- ## label ; minilistbox-frame ; label ; minilistbox-frame ; label ; scale pack .fRpolyspecs.labelNsides \ .fRpolyspecs.fRpolysides \ .fRpolyspecs.labelNinfo \ .fRpolyspecs.fRpolyangle \ .fRpolyspecs.labelSCALE1 \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRpolyspecs.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.chkbuttEQUILAT "ReDraw 0" bind .fRbuttons.chkbuttTRACE "ReDraw 0" ##+################################################################ ## PROCS SECTION: ## - ReDraw - called in radius-scale '-command' and ## in several bindings ## - RoundPoly - called by ReDraw ## - _RoundPoly2 - called by RoundPoly ## - rp - called by ReDraw ## - MakeStar - called by ReDraw ## ## - set_color_inside - called by inside-color button '-command' ## - set_color_outside - called by outside-color button '-command' ##+################################################################# ##+#################################################################### ## proc ReDraw - called by '-command' on the radius-resetting scale widget ## and when polygon-type is reset ## and when regularity is reset ## and when non-rounded polygon dotted-trace is requested. ##+#################################################################### ## Set the drawing area proportion of the canvas once, ## when the GUI starts up. set drawareaFactor 0.8 proc ReDraw {dummy} { global curRADIUSallVerts Nsides theta0deg \ drawareaFactor polygonEQUILAT polygonTRACE CINhex ## Get the current canvas width and height. set canWidth [winfo width .fRcan.can] set canHeight [winfo height .fRcan.can] ## Set the width and height of the polygon draw area (a rectangle). set W [expr $canWidth * $drawareaFactor] set H [expr $canHeight * $drawareaFactor] ## If a regular polygon is wanted, make the drawing area square. if { $polygonEQUILAT == 1} { if {$W > $H} { set W $H } else { set H $W } } ## Set the upper left point of the drawing area. set x0 [expr ( $canWidth - $W ) / 2 ] set y0 [expr ( $canHeight - $H ) / 2 ] ## Set the lower right of the drawing area. set x1 [expr $x0 + $W] set y1 [expr $y0 + $H] ## Load var 'xy' with the vertices of the polygon. if {$Nsides == 0} { set xm [expr $canWidth / 2 ] set ym [expr $canHeight / 2 ] set rad [expr $W / 4 ] set xy [MakeStar $xm $ym $rad] # set xy [MakeStar 0 0 $W] } else { set xy [rp $x0 $y0 $x1 $y1 $Nsides] } ## Set the radius for each vertex. ## For now, all radii are set the same, but RoundPoly is ## written to allow a different radius for each vertex. set radii {} foreach {x y} $xy { lappend radii $curRADIUSallVerts } ## Clear all polygons off the canvas. .fRcan.can delete poly ## If the user wants the corners indicated, draw the non-rounded polygon ## first, in gray, before the rounded-polygon draw and the dotted-lines draw. if { $polygonTRACE == 1 } { .fRcan.can create poly $xy -fill gray90 -outline black -dash . -tags poly } ## Draw the rounded polygon (filled), in the requested inside-color. RoundPoly .fRcan.can $xy $radii -fill $CINhex -outline $CINhex -tags poly ## If the user wants the dotted-lines of the unrounded polygon border drawn, ## draw the dotted lines last, after the rounded-filled-polygon draw. if { $polygonTRACE == 1 } { .fRcan.can create poly $xy -fill {} -outline black -dash . -tags poly } .fRbuttons.labelPARMS configure -text \ " Current PolyID=$Nsides OrientAngle=$theta0deg (cc)" } ## END OF proc ReDraw ##+################################################################### ## ## proc RoundPoly: called by ReDraw ## ## Draws a polygon with rounded corners in the canvas, based ## on ideas and code from "Drawing rounded rectangles" ## ## Parameters: ## w - Path name of the canvas ## xy - list of coordinates of the vertices of the polygon ## radii - list of radii --- the bend at each vertex ## args - Other args suitable to a 'polygon' item on the canvas ## ## Results: ## - Returns the canvas item number of the rounded polygon. ## - Creates a rounded polygon in the canvas. ## ##+################################################################### proc RoundPoly {w xy radii args} { set lenXY [llength $xy] set lenR [llength $radii] if {$lenXY != 2 * $lenR} { error "wrong number of vertices and radii" } # Walk down vertices keeping previous, current and next foreach {x0 y0} [lrange $xy end-1 end] break foreach {x1 y1} $xy break eval lappend xy [lrange $xy 0 1] set knots {} ;# These are the control points for {set i 0} {$i < $lenXY} {incr i 2} { set radius [lindex $radii [expr {$i/2}]] set r [winfo pixels $w $radius] foreach {x2 y2} [lrange $xy [expr {$i + 2}] [expr {$i + 3}]] break set z [_RoundPoly2 $x0 $y0 $x1 $y1 $x2 $y2 $r] eval lappend knots $z foreach {x0 y0} [list $x1 $y1] break ;# Current becomes previous foreach {x1 y1} [list $x2 $y2] break ;# Next becomes current } set n [eval $w create polygon $knots -smooth 1 $args] return $n } ## END OF proc RoundPoly ##+########################################## ## proc _RoundPoly2 - called by RoundPoly ##+########################################## proc _RoundPoly2 {x0 y0 x1 y1 x2 y2 radius} { set d [expr { 2 * $radius }] set maxr 0.75 set v1x [expr {$x0 - $x1}] set v1y [expr {$y0 - $y1}] set v2x [expr {$x2 - $x1}] set v2y [expr {$y2 - $y1}] set vlen1 [expr {sqrt($v1x*$v1x + $v1y*$v1y)}] set vlen2 [expr {sqrt($v2x*$v2x + $v2y*$v2y)}] if {$d > $maxr * $vlen1} { set d [expr {$maxr * $vlen1}] } if {$d > $maxr * $vlen2} { set d [expr {$maxr * $vlen2}] } lappend xy [expr {$x1 + $d * $v1x/$vlen1}] [expr {$y1 + $d * $v1y/$vlen1}] lappend xy $x1 $y1 lappend xy [expr {$x1 + $d * $v2x/$vlen2}] [expr {$y1 + $d * $v2y/$vlen2}] return $xy } ## END OF proc _RoundPoly2 ##+##################################################################### ## proc rp - called by ReDraw - draws a regular polygon of n sides. ## ## Code from 'Regular polygons' at ## http://wiki.tcl.tk/8398 R. Suchenwirth ##+##################################################################### set pi [expr 4 * atan(1)] proc rp {x0 y0 x1 y1 {n 0}} { global theta0deg pi set theta0rad [expr $pi * ($theta0deg / 180.0) ] ## FOR TESTING: # puts "rp: theta0rad = $theta0rad" ## Apparently RS or KPV set the initial angle, for the location ## of the first vertex, at 6 * 45 degrees = 270 degrees. # set th [expr {atan(1)*6}] ;#top ## set th [expr $theta0rad + (3*$pi/2)] set th [expr (3*$pi/2) - $theta0rad] ## FOR TESTING: # puts "rp: init th = $th" set xm [expr {($x0+$x1)/2.}] set ym [expr {($y0+$y1)/2.}] set rx [expr {$xm-$x0}] set ry [expr {$ym-$y0}] if {$n==0} { set n [expr {round(($rx+$ry)*0.5)}] } set step [expr {atan(1)*8/$n}] set res "" for {set i 0} {$i<$n} {incr i} { lappend res \ [expr {$xm+$rx*cos($th)}] \ [expr {$ym+$ry*sin($th)}] set th [expr {$th+$step}] ## FOR TESTING: # puts "rp: th = $th" } set res } ## END OF proc rp ##+############################################################# ## proc MakeStar - called by ReDraw ## ## Code from 'Sun, moon, and stars' at ## http://wiki.tcl.tk/1247 R. Suchenwirth ##+############################################################# proc MakeStar {x y delta} { set pi [expr {atan(1) * 4}] # Compute distance to inner corner #set x1 [expr {cos(54 * $pi/180)}] ;# Unit vector to inner point set y1 [expr {sin(54 * $pi/180)}] set y2 [expr {$delta * sin(18 * $pi/180)}] ;# Y value to match set delta2 [expr {$y2 / $y1}] # Now get all coordinates of the 5 outer and 5 inner points for {set i 0} {$i < 10} {incr i} { set d [expr {($i % 2) == 0 ? $delta : $delta2}] set theta [expr {(90 + 36 * $i) * $pi / 180}] set x1 [expr {$x + $d * cos($theta)}] set y1 [expr {$y - $d * sin($theta)}] lappend coords $x1 $y1 } return $coords } ## END OF proc MakeStar ##+##################################################################### ## proc 'set_color_inside' ##+##################################################################### ## 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 all the tagged items ## (ovals and rectangles) on the canvas. ## ## Arguments: none ## ## CALLED BY: .fRbuttons.buttCIN button ##+##################################################################### proc set_color_inside {} { global CINr CINg CINb CINhex curRADIUSallVerts curRADIUSevenVerts # global feDIR_tkguis ## FOR TESTING: # puts "CINr: $CINr" # puts "CINg: $CINg" # puts "CINb: $CINb" set TEMPrgb [ exec \ ./sho_colorvals_via_sliders3rgb.tk \ $CINr $CINg $CINb] # $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 CINhex "#$hexRGB" set CINr $r255 set CINg $g255 set CINb $b255 ## Call proc ReDraw to redraw the geometry in the new interior color. ReDraw 0 } ## END OF proc 'set_color_inside' ##+##################################################################### ## proc 'set_color_outside' ##+##################################################################### ## 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.buttCOUT button ##+##################################################################### proc set_color_outside {} { global COUTr COUTg COUTb COUThex # global feDIR_tkguis ## FOR TESTING: # puts "COUTr: $COUTr" # puts "COUTg: $COUTb" # puts "COUTb: $COUTb" set TEMPrgb [ exec \ ./sho_colorvals_via_sliders3rgb.tk \ $COUTr $COUTg $COUTb] # $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 COUThex "#$hexRGB" set COUTr $r255 set COUTg $g255 set COUTb $b255 ## Set the color of the canvas. .fRcan.can config -bg $COUThex } ## END OF proc 'set_color_outside' ##+##################################################### ## Additional GUI initialization, if needed (or wanted). ##+##################################################### ReDraw 0 .fRcan.can config -bg $COUThex