#!/usr/bin/wish -f ##+######################################################################## ## ## SCRIPT: tkVarignonsTheorem.tk ## ## PURPOSE: This Tk script is meant to demonstrate Varignon's Theorem: ## ## For an arbitrary quadrilateral, if you determine the 4 mid-points ## of the 4 sides and connect the points so that they form a ## quadrilateral inside the original quadrilateral, the interior ## quadrilateral is always a PARALLELOGRAM. ## ## This script is meant to 'dynamically' demonstrate this fact ## by allowing the user to 'drag' any point of the original ## quadrilateral to form a new quadrilateral. ## ## When the user finishes the 'drag' (releases the mouse-button): ## 1) the moved point is deleted and redrawn in its new position, ## 2) the 2 affected sides (line-segments) of the original, ## outer quadrilateral are deleted and redrawn, ## 3) the 2 new mid-points of those 2 line-segments are calculated, ## 4) the 2 'old' mid-points are deleted and redrawn, ## 5) the 2 'old' sides of the inner quadrilateral are deleted ## and redrawn --- yielding a new parallelogram. ## ## These operations may be done in a different order. For example, ## some deletions may be grouped together, and some re-draws may be ## grouped together. ## ## We may 'tag' the 4 points of the outer quadrilateral with ## names like A,B,C,D. ## And we may 'tag' the 4 (mid)points of the inner quadrilateral ## with names like AB,BC,CD,DA. ## ## GUI FEATURES: ## This GUI uses a Tk 'canvas' widget to show the two quadrilaterals. ## ## The line segments of the 2 quadrilaterals are drawn with eight ## 'create line' commands on the canvas. ## The 8 points are indicated by use of 'create oval' commands. ## ## We use a rectangular drawing area (the Tk 'canvas' widget), and ## we allow the user to control the size (in pixels) of that ## drawing area by the user resizing the entire GUI window --- which ## results in the canvas being automatically resized by the ## Tk 'pack' geometry manager. ## ## The delete-and-redraw operations are automatically triggered ## when the user releases the mouse button after moving one of ## the 4 points of the 'outer' quadrilateral. (The 4 vertices ## of the 'outer' quadrilateral are the only objects on the ## canvas that are moveable.) ## ## Three 'Color' buttons on the GUI allow the user to specify ## - background color of the Tk canvas widget ## - color of the eight line segments ## - color of the eight points ## ## A 'ShowState' button on the GUI may be used to report on ## the state of the current image, such as: ## - coordinates of the eight points ## - lengths of the eight line-segments. ## ## (The opposite sides of the 'inner' quadrilateral should ## have the same length --- thus indicating that the ## inner-quadrilateral is indeed a parallelogram.) ## ## A 'Help' button on the GUI describes how the GUI operates ## and describes the geometry involved in Varignon's Theorem. ## ##+######################### ## PLANNED LAYOUT OF THE GUI: ## ## FrameNames ## VVVVVVVVVV ## ----------------------------------------------------------------------------- ## tkVarignonsTheorem ## [window title] ## ----------------------------------------------------------------------------- ## ## .fRbuttons {Exit} {Help} {ShowState} {Backgd {Line {Point ## Color} Color} Color} ## ## .fRmsg [ .......... Message line --- for advice to the user .................. ] ## ## .fRcanvas ----------------------------------------------------------------------------- ## | | ## | | ## | | ## | [Canvas for displaying the two quadrilaterals | ## | in a rectangular image area. No scrollbars.] | ## | | ## | | ## | | ## | | ## ----------------------------------------------------------------------------- ## ## SKETCH CONVENTIONS for this GUI sketch: ## ## SQUARE-BRACKETS indicate a comment (not to be placed on the GUI). ## BRACES indicate a Tk 'button' widget. ## ## A COLON indicates that the text before the colon is on a 'label' widget. ## UNDERSCORES indicate a Tk 'entry' widget (if any). ## CAPITAL-X indicates a Tk 'checkbutton' widget (if any). ## CAPITAL-O indicates a Tk 'radiobutton' widget (if any). ## <---O---> indicates a horizontal Tk 'scale' widget (if any). ## ## A combination of VERTICAL-BAR CHARACTERS AND HYPHEN CHARACTERS, ## that outline a RECTANGULAR SHAPE, are used to indicate either a ## Tk 'canvas' widget or a Tk 'listbox' widget or a Tk 'text' widget. ## ## SCROLL-BAR 'ARROW-HEADS' (for a 'canvas', 'listbox', or 'text' Tk widget) ## are drawn as follows: ## ## UP ARROW-HEAD is drawn with a CAPITAL-A. ## DOWN ARROW-HEAD is drawn with a CAPITAL-V. ## LEFT ARROW-HEAD is drawn with a LESS-THAN sign. ## RIGHT ARROW-HEAD is drawn with a GREATER-THAN sign. ## ## UP-and-DOWN ARROW-HEADS at the right/left of the box shape indicate ## a VERTICAL SCROLL-BAR there. ## ## LEFT-and-RIGHT ARROW-HEADS at the bottom/top of the box shape indicate ## a HORIZONTAL SCROLL-BAR there. ## ## The arrow-heads on a horizontal scrollbar are joined by hyphens, rather than ## underscores. ## ## A LINE (HYPHENS or VERTICAL-BARS) WITH AN 'ARROW-HEAD' AT EACH END indicates ## a Tk 'scale' widget --- horizontal or vertical, respectively. ## ##+################## ## GUI WIDGET SUMMARY: ## ## This GUI will contain about: ## ## 6 'button' widgets ## 1 'label' widget ## 1 'canvas' widget (with no x-y scrollbars) ## ## 0 'entry' widgets ## 0 'checkbutton' widgets ## 0 'radiobutton' widgets ## 0 'scale' widgets ## 0 'listbox' widgets ## 0 'text' widgets ## ##+################################## ## METHOD USED to perform the drawing: ## ## We specify the point coordinates in 'pixel coordinates' ## on the Tk 'canvas' widget --- rather than using 'world coordinates' ## and mapping the 'world coordinates' to 'pixel coordinates' on the ## Tk 'canvas' widget. ## ## At any time we can query the width and height of the 'canvas' ## widget and note that, in pixel coordinates, the box is ## UpperLeft Corner: 0,0 ## LowerRight Corner: ImgWidthPx,ImgHeightPx ## ## In other words, the x-pixel-coordinates vary from zero ## on the left of the canvas and increase to the right ## --- and the y-pixel-coordinates vary from zero ## at the top of the canvas and increase to the bottom. ## ## Lines are drawn on the canvas using 'create line' commands ## that specify the pixel coordinates of 2 points. ## ## Points are drawn on the canvas using 'create oval' commands ## with the center of the oval at pixel coordinates of a point. ## ## Some text items might be put on the canvas, such as labels ## for points, by use of 'create text' commands on the canvas. ## ##+####################### ## CAPTURING THE GUI IMAGE: ## ## A screen/window capture utility (like 'gnome-screenshot' ## on Linux) can be used to capture the GUI image in a PNG ## or GIF file, say. ## ## If necessary, an image editor (like 'mtpaint' on Linux) ## can be used to crop the window capture image. The image ## could also be down-sized --- say to make a smaller image ## suitable for use in a web page or an email. ## ##+####################################################################### ## 'CANONICAL' STRUCTURE OF THIS CODE: ## ## 0) Set general window parms (win-name, win-position, win-color-scheme, ## fonts, widget-geom-parms, win-size-control, text-array-for-labels-etc). ## ## 1a) Define ALL frames (and sub-frames, if any). ## 1b) Pack the frames. ## ## 2) Define & pack all widgets in the frames, frame by frame. ## After all the widgets for a frame are defined, pack them in the frame. ## ## 3) Define keyboard or mouse/touchpad/touch-sensitive-screen 'event' ## BINDINGS, if needed. ## ## 4) Define PROCS, if needed. ## ## 5) Additional GUI INITIALIZATION (typically with one or more of ## the procs), if needed. ## ##+################################# ## Some detail of the code structure of this particular script: ## ## 1a) Define ALL frames: ## ## Top-level : ## '.fRbuttons' - to contain 'Exit', 'Help', 'Redraw' and ## several color buttons. ## ## '.fRmsg' - to contain a label widget ## ## '.fRcanvas' - to contain a canvas widget, which will display ## the circle and polygon(s). ## ## 1b) Pack ALL frames. ## ## 2) Define & pack all widgets in the frames -- basically going through ## frames & their interiors in left-to-right, or top-to-bottom order. ## ## 3) Define BINDINGS: such as button1-release on the 'canvas' widget ## (See the BINDINGS section below, for details.) ## ## 4) Define PROCS: such as a 'Redraw' proc for the button1-release ## on the 'canvas' widget ## (See the PROCS section below, for details.) ## ## 5) Additional GUI Initialization: ## - call 'initDdraw' to put the initial drawing of 2 quadrilaterals ## on the canvas, for a given initial setting of coordinates of ## points A,B,C,D. ## ##+####################################################################### ## DEVELOPED WITH: Tcl-Tk 8.5 on Ubuntu 9.10 (2009-october, 'Karmic Koala') ## ## $ wish ## % puts "$tcl_version $tk_version" ## ## showed ## 8.5 8.5 ## but this script should work in most previous 8.x versions, and probably ## even in some 7.x versions (if font handling is made 'old-style'). ##+####################################################################### ## MAINTENANCE HISTORY: ## Started by: Blaise Montandon 2016aug16 Started coding based on tkGooie ## scripts ## 'tkCircleCircumferenceByPolygons.tk' ## and ## 'tkImageGridWarp_withFixedEdge.tk' ## Changed by: Blaise Montandon 2016aug19 Finalized code for release. ##+######################################################################## ##+###################################################### ## Set WINDOW TITLE and POSITION. ##+###################################################### wm title . "tkVarignonsTheorem - Quadrilateral Midpoints Yield a Parallelogram" wm iconname . "VarignonQuads" wm geometry . +8+30 ##+###################################################### ## Set the COLOR SCHEME for the window and its widgets --- ## such as listbox and entry field background color. ##+###################################################### tk_setPalette "#f0f0f0" # set scaleBKGD "#f0f0f0" # set chkbuttBKGD "#c0c0c0" # set radbuttBKGD "#c0c0c0" # set entryBKGD "#ffffff" # set listboxBKGD "#ffffff" ##+######################################################## ## DEFINE (temporary) FONT NAMES. ## ## We use a VARIABLE-WIDTH font for text on LABEL and ## BUTTON widgets. ## ## We use a FIXED-WIDTH font for LISTBOX lists, ## for Help-text in a TEXT widget, and for ## the text in 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) ##+########################################################### ## LABEL widget geom settings: set PADXpx_label 0 set PADYpx_label 0 set BDwidthPx_label 2 set RELIEF_label_lo "flat" ## BUTTON widget geom settings: set PADXpx_button 0 set PADYpx_button 0 set BDwidthPx_button 2 ## We generally default to relief "raised" for all 'button' widgets. ## BUT, in case you want to experiment: set RELIEF_button "raised" ## COMMENTED WIDGET GEOM PARMS - NOT USED, yet: if {0} { ## ENTRY widget geom settings: set BDwidthPx_entry 2 ## CHECKBUTTON geom parameters: set PADXpx_chkbutt 0 set PADYpx_chkbutt 0 set BDwidthPx_chkbutt 1 set RELIEF_chkbutt_hi "raised" ## SCALE widget geom parameters: # set BDwidthPx_scale 2 # set scaleThicknessPx 10 } ## END OF COMMENTED WIDGET GEOM PARMS. ## CANVAS widget geom settings: set initCanWidthPx 350 set initCanHeightPx 350 # set BDwidthPx_canvas 2 set BDwidthPx_canvas 0 set RELIEF_canvas "flat" ##+############################################################## ## 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 the '.fRbuttons' frame: set aRtext(buttonEXIT) "Exit" set aRtext(buttonHELP) "Help" set aRtext(buttonSTATE) "ShowState" set aRtext(buttonCOLORbkgd) "Backgrnd Color" set aRtext(buttonCOLORline) "Line Color" set aRtext(buttonCOLORpoint) "Point Color" ## For the '.fRmsg' frame: set aRtext(labelINIT) \ "** Highlight and drag any point of the 4 points of the OUTER quadrilateral. The figure will be redrawn. See 'Help'. **" set aRtext(labelDRAG) "** Highlight and drag point A, B, C, or D. **" ## END OF if { "$VARlocale" == "en"} ##+###################################################################### ## Set a MIN-SIZE of the window (roughly). ## ## For WIDTH, allow for the min-width of the '.fRbuttons' frame. ## ## For HEIGHT, allow for the stacked frames: ## 2 chars high for the '.fRbuttons' frame, ## 1 char high for the '.fRmsg' frame, ## at least 50 pixels high for the '.fRcanvas' frame. ##+##################################################################### ## FOR WIDTH: set minWidthPx [font measure fontTEMP_varwidth \ " $aRtext(buttonEXIT) $aRtext(buttonHELP) $aRtext(buttonSTATE) \ Color Color Color "] ## We add some pixels to account for right-left-size of ## window-manager decoration (~8 pixels) and some pixels for ## frame/widget borders (6 widgets x 4 pixels/widget = 24 pixels). set minWinWidthPx [expr {32 + $minWidthPx}] ## For HEIGHT --- for ## 2 chars high for the '.fRbuttons' frame, ## 1 char high for the '.fRmsg' frame, ## 50 pixels high for the '.fRcanvas' frame. set charHeightPx [font metrics fontTEMP_varwidth -linespace] set minWinHeightPx [expr {3 * $charHeightPx}] ## Add about 50 pixels for height of the canvas ## AND add about 20 pixels for top-bottom window decoration -- ## and some pixels for top-and-bottom of frame/widget borders ## (3 widgets x 4 pixels/widget = 12 pixels). set minWinHeightPx [expr {82 + $minWinHeightPx}] ## FOR TESTING: # puts "minWinWidthPx = $minWinWidthPx" # puts "minWinHeightPx = $minWinHeightPx" wm minsize . $minWinWidthPx $minWinHeightPx ## If you want to make the window un-resizable, ## you can use the following statement. # wm resizable . 0 0 ##+################################################################ ## DEFINE *ALL* THE FRAMES: ## ## Top-level : '.fRbuttons' '.fRmsg' '.fRcanvas' ## ## Sub-frames: none ##+################################################################ ## 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 -bd $BDwidthPx_frame # frame .fRmsg -relief $RELIEF_frame -bd $BDwidthPx_frame frame .fRmsg -relief raised -bd 2 # frame .fRcanvas -relief $RELIEF_frame -bd $BDwidthPx_frame frame .fRcanvas -relief raised -bd 2 ##+############################## ## PACK the FRAMES. ##+############################## pack .fRbuttons \ -side top \ -anchor nw \ -fill x \ -expand 0 pack .fRmsg \ -side top \ -anchor nw \ -fill x \ -expand 0 pack .fRcanvas \ -side top \ -anchor n \ -fill both \ -expand 1 ##+########################################################## ## The FRAMES ARE PACKED. START PACKING WIDGETS IN THE FRAMES. ##+########################################################## ##+########################################################## ## In FRAME '.fRbuttons' - ## DEFINE six 'BUTTON' WIDGETS --- Exit, Help, ShowState --- ## and 3 color buttons. ## Then PACK them. ##+########################################################## 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" +150+50} button .fRbuttons.buttSTATE \ -text "$aRtext(buttonSTATE)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {show_state} button .fRbuttons.buttCOLORbkgd \ -text "$aRtext(buttonCOLORbkgd)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command "set_background_color" button .fRbuttons.buttCOLORline \ -text "$aRtext(buttonCOLORline)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command "set_line_color" button .fRbuttons.buttCOLORpoint \ -text "$aRtext(buttonCOLORpoint)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command "set_point_color" ## Pack the widgets in frame '.fRbuttons'. pack .fRbuttons.buttEXIT \ .fRbuttons.buttHELP \ .fRbuttons.buttSTATE \ .fRbuttons.buttCOLORbkgd \ .fRbuttons.buttCOLORline \ .fRbuttons.buttCOLORpoint \ -side left \ -anchor w \ -fill none \ -expand 0 ##+######################################################## ## In FRAME '.fRmsg' - ## DEFINE one LABEL widget. Then PACK it. ##+####################################################### label .fRmsg.labelMSG \ -text "" \ -font fontTEMP_varwidth \ -width 100 \ -justify left \ -anchor w \ -relief flat \ -padx $PADXpx_label \ -pady $PADYpx_label \ -bg "#ff9999" \ -bd $BDwidthPx_label ## Pack the widgets in frame '.fRmsg'. pack .fRmsg.labelMSG \ -side top \ -anchor nw \ -fill both \ -expand 1 ##+######################################################## ## In FRAME '.fRcanvas' - ## DEFINE a CANVAS WIDGET (no scrollbars). Then PACK it. ## ## 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 ## COMMENT OUT SCROLLBAR DEFINITIONS. if {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" } ## END OF COMMENTED SCROLLBARS. ##+####################################################### ## 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. ##+####################################################### ## COMMENTED PACKING OF THE SCROLLBARS. if {0} { 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. } ## END OF COMMENTED PACKING OF SCROLLBARS. pack .fRcanvas.can \ -side top \ -anchor n \ -fill both \ -expand 1 ##+################################################## ## END OF DEFINITION of the GUI widgets. ##+################################################## ## Start of BINDINGS, PROCS, Added-GUI-INIT sections. ##+################################################## ##+################################################################## ##+################################################################## ## BINDINGS SECTION: ##+################################################################## ##+########################################################################### ## BINDINGS for 4 'OUTER' POINT OBJECTS on the canvas widget: ## ## Note that (except for button1-motion on the canvas) we are NOT putting ## bindings on the entire canvas. We use '.fRcanvas.can bind TAGpointOuter' ## to avoid move-operations being performed on objects on the canvas ## other than the 4 points of the 'outer' quadrilateral. ## ## In other words, we do not want these bindings to allow the user to move ## - the 4 mid-points that define the 'inner' quadrilateral ## - the lines of the 'outer' and 'inner' quadrilateral ## - any text objects put on the canvas. ## ## See the 'plot.tcl' demo that comes with Tcl-Tk. ## Example location: /usr/share/doc/tk8.5/examples/plot.tcl ##+########################################################################### .fRcanvas.can bind TAGpointOuter {pointSelect %x %y} bind .fRcanvas.can {pointMove %x %y} .fRcanvas.can bind TAGpointOuter {pointMoveEnd %x %y} ##+####################################################################### ## Let us give a hint when a point is a 'subject' for button1-press action. ##+####################################################################### .fRcanvas.can bind TAGpointOuter \ {.fRcanvas.can itemconfig current -fill "#ffffff"} .fRcanvas.can bind TAGpointOuter \ {.fRcanvas.can itemconfig current -fill $COLORPOINThex} ##+################################################################## ##+################################################################## ## PROCS SECTION: ## ## 'initDraw' - This proc is called in the 'Additional GUI ## Initialization' section at the bottom of this ## script to put an initial drawing of the original ## 'outer' quadrilateral --- and the 'inner', ## 'mid-points' quadrilateral --- on the canvas. ## ## The following 3 procs handle moving an 'outer' quadrilateral point ## --- any of the 4 points called A,B,C,D. ## ## 'pointSelect' - called by a button1-press binding on an 'outer'-point-tag of the canvas. ## 'pointMove' - called by a button1-motion binding on the canvas. ## 'pointMoveEnd' - called by a button1-release binding on an 'outer'-point-tag of the canvas. ## ## 'redraw4movedA' - called by proc 'pointMoveEnd', to delete and redraw the points, ## lines, and text affected by moving 'outer' point A. ## 'redraw4movedB' - called by proc 'pointMoveEnd', to delete and redraw the points, ## lines, and text affected by moving 'outer' point B. ## 'redraw4movedC' - called by proc 'pointMoveEnd', to delete and redraw the points, ## lines, and text affected by moving 'outer' point C. ## 'redraw4movedD' - called by proc 'pointMoveEnd', to delete and redraw the points, ## lines, and text affected by moving 'outer' point D. ## ## 'show_state' - reports on the state of the current image: ## - the coordinates of the 8 points ## - the lengths of the 8 lines ## Called by the 'ShowState' button. ## ## Other utility procs: ## ## 'set_background_color' - Sets the color for the canvas (background). ## Called by the 'BackgroundColor' button. ## ## 'set_line_color' - Sets the color for the circle on the canvas. ## Called by the 'LineColor' button. ## ## 'set_point_color' - Sets the color for the inscribed polygon. ## Called by the 'PointColor' button. ## ## 'update_button_colors' - Sets the color of the 4 color buttons. ## Called by the 'set_*_color' procs. ## ## 'advise_user' - Used by various procs to put a message for ## the user on a message line of the GUI. ## ## 'popup_msgVarWithScroll' - called by 'Help' button to show HELPtext var. ## ##+################################################################# ##+######################################################################## ## PROC 'initDraw' ##+######################################################################## ## PURPOSE: Draws the initial 'outer' and 'inner' quadrilaterals, given ## coordinates of the 4 'outer' quadrilateral points - A,B,C,D. ## ## CALLED BY: the 'Additional GUI Initialization' section at the ## bottom of this Tk script. ##+######################################################################## proc initDraw {} { ## FOR TESTING: (to dummy out this proc) # return ## INPUT globals: global lineWidthPx dashPatternOuter dashPatternInner \ COLORLINEhex COLORPOINThex curFONTspecs \ pointRADIUSpx pointOUTLINEWIDTHpx pointOUTLINECOLORhex ## OUTPUT globals: global AxPx AyPx BxPx ByPx CxPx CyPx DxPx DyPx \ midABxPx midAByPx midBCxPx midBCyPx midCDxPx midCDyPx midDAxPx midDAyPx # global PrevImgWidthPx PrevImgHeightPx ######################################################## ## 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.) ## ## Reference: wiki.tcl.tk/10720 and wiki.tcl.tk/44 ## and page 237 of Ousterhout's book 'Tcl and the Tk Toolkit': ## "If you would like to restore a window to its natural ## size, you can invoke 'wm geometry' with an empty ## geometry string." ######################################################## # wm geometry . {} ################################################################## ## Use 'update' to make sure the 'pack' geometry manager has ## set the width and height of the canvas widget. ################################################################## update ################################################################ ## Get the current width & height of the image area that we ## are going to use --- the dimensions of the canvas widget. ################################################################ set CurImgWidthPx [winfo width .fRcanvas.can] set CurImgHeightPx [winfo height .fRcanvas.can] ## FOR TESTING: if {0} { puts "" puts "proc 'initDraw':" puts "CurImgWidthPx: $CurImgWidthPx CurImgHeightPx: $CurImgHeightPx" } ################################################################ ## Store the current width & height in 'Prev' variables --- for ## use in other draw procs to check if the mapping between ## world-coordinates and pixel-coordinates needs to be changed. ################################################################ set PrevImgWidthPx $CurImgWidthPx set PrevImgHeightPx $CurImgHeightPx ############################################################ ## Set the 'scrollregion' of the canvas according to the ## requested canvas size. (A simple 'update' does not work.) ## COMMENTED. ## We will use this if we put scrollbars on the canvas. ############################################################ # .fRcanvas.can configure -scrollregion "0 0 $CurImgWidthPx $CurImgHeightPx" ##+################################################## ## Set the initial coordinates of the 4 vertices --- ## A,B,C,D --- of the original, 'outer' quadrilateral. ## ## Keep the x and y coordinates between 0.0 and 1.0. ##+################################################## set AxPx [expr {0.2 * $CurImgWidthPx}] set AyPx [expr {0.8 * $CurImgHeightPx}] set BxPx [expr {0.2 * $CurImgWidthPx}] set ByPx [expr {0.2 * $CurImgHeightPx}] set CxPx [expr {0.85 * $CurImgWidthPx}] set CyPx [expr {0.15 * $CurImgHeightPx}] set DxPx [expr {0.5 * $CurImgWidthPx}] set DyPx [expr {0.84 * $CurImgHeightPx}] ############################################### ## Draw the line from A to B. ############################################### .fRcanvas.can create line \ $AxPx $AyPx $BxPx $ByPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineAB} ############################################### ## Draw the line from B to C. ############################################### .fRcanvas.can create line \ $BxPx $ByPx $CxPx $CyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineBC} ############################################### ## Draw the line from C to D. ############################################### .fRcanvas.can create line \ $CxPx $CyPx $DxPx $DyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineCD} ############################################### ## Draw the line from D to A. ############################################### .fRcanvas.can create line \ $DxPx $DyPx $AxPx $AyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineDA} ############################################### ## Calculate the 4 mid-points. ############################################### set midABxPx [expr {($AxPx + $BxPx)/2.0}] set midAByPx [expr {($AyPx + $ByPx)/2.0}] set midBCxPx [expr {($CxPx + $BxPx)/2.0}] set midBCyPx [expr {($CyPx + $ByPx)/2.0}] set midCDxPx [expr {($CxPx + $DxPx)/2.0}] set midCDyPx [expr {($CyPx + $DyPx)/2.0}] set midDAxPx [expr {($AxPx + $DxPx)/2.0}] set midDAyPx [expr {($AyPx + $DyPx)/2.0}] ############################################### ## Draw the line from midAB to midBC. ############################################### .fRcanvas.can create line \ $midABxPx $midAByPx $midBCxPx $midBCyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidAB2MidBC} ############################################### ## Draw the line from midBC to midCD. ############################################### .fRcanvas.can create line \ $midBCxPx $midBCyPx $midCDxPx $midCDyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidBC2MidCD} ############################################### ## Draw the line from midCD to midDA. ############################################### .fRcanvas.can create line \ $midCDxPx $midCDyPx $midDAxPx $midDAyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidCD2MidDA} ############################################### ## Draw the line from midDA to midAB. ############################################### .fRcanvas.can create line \ $midDAxPx $midDAyPx $midABxPx $midAByPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidDA2MidAB} #################################################### ## Draw circles representing the 4 vertices (points) ## of the 'outer' quadrilateral --- A,B,C,D. #################################################### set ulXpx [expr {$AxPx - $pointRADIUSpx}] set ulYpx [expr {$AyPx - $pointRADIUSpx}] set lrXpx [expr {$AxPx + $pointRADIUSpx}] set lrYpx [expr {$AyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointOuter TAGpointA} set ulXpx [expr {$BxPx - $pointRADIUSpx}] set ulYpx [expr {$ByPx - $pointRADIUSpx}] set lrXpx [expr {$BxPx + $pointRADIUSpx}] set lrYpx [expr {$ByPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointOuter TAGpointB} set ulXpx [expr {$CxPx - $pointRADIUSpx}] set ulYpx [expr {$CyPx - $pointRADIUSpx}] set lrXpx [expr {$CxPx + $pointRADIUSpx}] set lrYpx [expr {$CyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointOuter TAGpointC} set ulXpx [expr {$DxPx - $pointRADIUSpx}] set ulYpx [expr {$DyPx - $pointRADIUSpx}] set lrXpx [expr {$DxPx + $pointRADIUSpx}] set lrYpx [expr {$DyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointOuter TAGpointD} ######################################################## ## Draw circles representing the 4 vertices (points) of ## the 'inner' quadrilateral --- midAB,midBC,midCD,midDA. ######################################################## set ulXpx [expr {$midABxPx - $pointRADIUSpx}] set ulYpx [expr {$midAByPx - $pointRADIUSpx}] set lrXpx [expr {$midABxPx + $pointRADIUSpx}] set lrYpx [expr {$midAByPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidAB} set ulXpx [expr {$midBCxPx - $pointRADIUSpx}] set ulYpx [expr {$midBCyPx - $pointRADIUSpx}] set lrXpx [expr {$midBCxPx + $pointRADIUSpx}] set lrYpx [expr {$midBCyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidBC} set ulXpx [expr {$midCDxPx - $pointRADIUSpx}] set ulYpx [expr {$midCDyPx - $pointRADIUSpx}] set lrXpx [expr {$midCDxPx + $pointRADIUSpx}] set lrYpx [expr {$midCDyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidCD} set ulXpx [expr {$midDAxPx - $pointRADIUSpx}] set ulYpx [expr {$midDAyPx - $pointRADIUSpx}] set lrXpx [expr {$midDAxPx + $pointRADIUSpx}] set lrYpx [expr {$midDAyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidDA} #################################################### ## Draw a text character near the 4 vertices (points) ## of the 'outer' quadrilateral --- A,B,C,D. #################################################### .fRcanvas.can create text $AxPx [expr {$AyPx + (1.5 * $pointRADIUSpx)}] \ -anchor ne \ -fill $COLORPOINThex -font "$curFONTspecs" \ -text "A" -tags {TAGtext TAGtextA} .fRcanvas.can create text $BxPx [expr {$ByPx - (1.5 * $pointRADIUSpx)}] \ -anchor se \ -fill $COLORPOINThex -font "$curFONTspecs" \ -text "B" -tags {TAGtext TAGtextB} .fRcanvas.can create text $CxPx [expr {$CyPx - (1.5 * $pointRADIUSpx)}] \ -anchor sw \ -fill $COLORPOINThex -font "$curFONTspecs" \ -text "C" -tags {TAGtext TAGtextC} .fRcanvas.can create text $DxPx [expr {$DyPx + (1.5 * $pointRADIUSpx)}] \ -anchor nw \ -fill $COLORPOINThex -font "$curFONTspecs" \ -text "D" -tags {TAGtext TAGtextD} } ## END OF PROC 'initDraw' ##+######################################################### ## PROC: 'pointSelect' ##+######################################################### ## PURPOSE: Determines an object-ID to move. ## Gets the ID of the 'current' selected object ## on the canvas, at the button-press location. ## ## Sets the current x,y in vars prevXpx and prevYpx ## --- for use in the 'pointMove' proc. ## ## CALLED BY: a button1-PRESS binding on the canvas, namely ## .fRcanvas.can bind TAGpointOuter ... ##+######################################################## proc pointSelect {Xpx Ypx} { ## FOR TESTING: (to dummy out this proc) # return ## OUTPUT globals: global moveID prevXpx prevYpx ################################################################## ## Map from view coordinates to canvas coordinates, per ## page 559 of 4th edition of 'Practical Programming in Tcl & Tk'. ## ## (This may only be needed if we put scrollbars on the canvas.) ################################################################## # set Xpx [.fRcanvas.can canvasx $Xpx] # set Ypx [.fRcanvas.can canvasy $Ypx] ######################################################################## ## Tag the 'current' canvas (point) object with tag 'TAGselected'. ######################################################################## ## Reference: plot.tcl of the Tcl-Tk demos. See BINDINGS section above. ######################################################################## .fRcanvas.can dtag TAGselected .fRcanvas.can addtag TAGselected withtag current .fRcanvas.can raise TAGselected ####################################################################### ## Get the ID of the 'current' (selected) item. ####################################################################### set moveID [.fRcanvas.can find withtag TAGselected] ## FOR TESTING: if {0} { puts "" puts "PROC 'pointSelect' selected canvas object:" puts " moveID = $moveID" } ############################################## ## Put a status message in the status frame. ## ## COMMENTED. This causes the canvas to resize ## --- narrower. ############################################## # advise_user "Point ID $moveID selected." # update #################################################################### ## Hold these coordinates for use in the other 2 'pointMove' procs ## --- 'pointMove' and 'pointMoveEnd'. #################################################################### set prevXpx $Xpx set prevYpx $Ypx ############################################################## ## We COULD delete the 2 lines attached to this point now, ## and the 2 affected mid-points, and the line connecting those ## mid-points. ## Then we could re-draw them in proc 'pointMoveEnd'. ## OR ## We could delete the lines-and-points AND redraw them ## in proc 'pointMoveEnd'. ## ## We will do both the delete and the redraw in proc 'pointMoveEnd'. ## ## If that is too confusing to the user, we could do the delete here. ## ## What would probably be least confusing to the user is to ## 'rubber band' the 4 lines in the 'pointMove' proc. But that ## is extra processing (and code). We avoid that for now. ################################################################## ## FOR TESTING: if {0} { puts "" puts "PROC 'pointSelect' detected" puts "moveID: $moveID" puts "pixel coordinates Xpx: $Xpx Ypx: $Ypx" set TAGS_for_moveID [.fRcanvas.can gettags $moveID] puts "TAGS_for_moveID: $TAGS_for_moveID" } } ## END OF PROC 'pointSelect' ##+############################################################# ## proc 'pointMove' ##+############################################################# ## PURPOSE: Moves a selected point, whose ID is in var 'moveID', ## according to the current x,y pixel coordinates. ## ## CALLED BY: bind .fRcanvas.can ##+######################################################### proc pointMove {Xpx Ypx} { ## FOR TESTING: (to dummy out this proc) # return ## INPUT globals: global moveID ## INPUT AND OUTPUT globals: global prevXpx prevYpx #################################################### ## If a point is not currently selected, exit. #################################################### if {![info exists moveID]} {return} if {"$moveID" == ""} {return} ################################################################## ## Map from view coordinates to canvas coordinates, per ## page 559 of 4th edition of 'Practical Programming in Tcl & Tk'. ## ## (This may only be needed if we put scrollbars on the canvas.) ################################################################## # set Xpx [.fRcanvas.can canvasx $Xpx] # set Ypx [.fRcanvas.can canvasy $Ypx] ######################################################## ## Reset the location of object $moveID on the canvas, ## by the 'delta' from the previous location. ######################################################## .fRcanvas.can move $moveID [expr {$Xpx - $prevXpx}] [expr {$Ypx - $prevYpx}] ######################################################################## ## Alternatively: Move the item with tag 'TAGselected'. ######################################################################## ## Reference: plot.tcl of the Tcl-Tk demos. See BINDINGS section above. ######################################################################## # .fRcanvas.can move TAGselected [expr {$Xpx - $prevXpx}] [expr {$Ypx - $prevYpx}] ############################################################# ## Save the new position for use in these 'pointMove' procs. ############################################################# set prevXpx $Xpx set prevYpx $Ypx ## FOR TESTING: if {0} { puts "" puts "PROC 'pointMove' > Moved object $moveID to $Xpx $Ypx" set TAGS_for_moveID [.fRcanvas.can gettags $moveID] puts "TAGS_for_moveID: $TAGS_for_moveID" } } ## END OF PROC 'pointMove' ##+############################################################## ## PROC: 'pointMoveEnd' ##+############################################################## ## PURPOSE: Get the new x,y pixel coordinates of the moving point, ## whose canvas ID is in var 'moveID'. ## ## Redraw the outer and inner quadrilateral configuration, ## according to whether point A,B,C, or D, is being moved. ## ## CALLED BY: a button1-release binding on the canvas, namely ## fRcanvas.can bind TAGpointOuter ... ##+############################################################## proc pointMoveEnd {Xpx Ypx} { ## FOR TESTING: (to dummy out this proc) # return ## INPUT globals: global moveID prevXpx prevYpx aRtext #################################################### ## If a point is not currently selected, exit. #################################################### if {![info exists moveID]} {return} if {"$moveID" == ""} {return} ################################################################## ## Map from view coordinates to canvas coordinates, per ## page 559 of 4th edition of 'Practical Programming in Tcl & Tk'. ## ## (This may only be needed if we put scrollbars on the canvas.) ################################################################## # set Xpx [.fRcanvas.can canvasx $Xpx] # set Ypx [.fRcanvas.can canvasy $Ypx] ############################################################# ## Reset the location of the point $moveID on the canvas, ## according to the 'delta' from the previous positon. ############################################################# .fRcanvas.can move $moveID [expr {$Xpx - $prevXpx}] [expr {$Ypx - $prevYpx}] ####################################################### ## Determine which of points A,B,C,D is being moved. ####################################################### set TAGS_for_moveID [.fRcanvas.can gettags $moveID] set moveLETTER "" if {[lsearch -exact $TAGS_for_moveID TAGpointA] != -1} { set moveLETTER "A" } elseif {[lsearch -exact $TAGS_for_moveID TAGpointB] != -1} { set moveLETTER "B" } elseif {[lsearch -exact $TAGS_for_moveID TAGpointC] != -1} { set moveLETTER "C" } elseif {[lsearch -exact $TAGS_for_moveID TAGpointD] != -1} { set moveLETTER "D" } ## FOR TESTING: if {0} { puts "" puts "PROC 'pointMoveEnd' > Moved object $moveID to $Xpx $Ypx" puts "moveLETTER: $moveLETTER" } ############################################## ## Put a message in the message frame. ############################################## advise_user "Point $moveLETTER was moved to $Xpx,$Ypx pixel coordinates. $aRtext(labelDRAG)" update ############################################## ## For the indicated point (A,B,C, or D), ## perform the appropriate redraw processing. ############################################## if {"$moveLETTER" == "A"} { redraw4movedA $Xpx $Ypx } elseif {"$moveLETTER" == "B"} { redraw4movedB $Xpx $Ypx } elseif {"$moveLETTER" == "C"} { redraw4movedC $Xpx $Ypx } elseif {"$moveLETTER" == "D"} { redraw4movedD $Xpx $Ypx } ################################################################ ## We are done with this move. ## Let us blank out var 'moveID' to make sure we do not move ## this point anymore until a new select (button-press) event. ################################################################ set moveID "" ############################################################# ## Remove the tag 'TAGselected'. ######################################################################## ## Reference: plot.tcl of the Tcl-Tk demos. See BINDINGS section above. ######################################################################## .fRcanvas.can dtag TAGselected } ## END OF PROC 'pointMoveEnd' ##+############################################################# ## PROC 'redraw4movedA' ##+############################################################# ## PURPOSE: When point A of the 'outer' quadrilateral is moved, ## this proc is called to delete and redraw ## - a point and 2 lines of the 'outer' quadrilateral ## - 2 mid-points and 3 sides of the 'inner' quadrilateral ## that involve one or both of those points. ## ## CALLED BY: proc 'pointMoveEnd' ##+############################################################# proc redraw4movedA {Xpx Ypx} { ## FOR TESTING: (dummy out this routine) # return ## INPUT globals: global DxPx DyPx BxPx ByPx \ midCDxPx midCDyPx midBCxPx midBCyPx \ lineWidthPx dashPatternOuter dashPatternInner \ COLORLINEhex COLORPOINThex curFONTspecs \ pointRADIUSpx pointOUTLINEWIDTHpx pointOUTLINECOLORhex ## OUTPUT globals: global AxPx AyPx midDAxPx midDAyPx midABxPx midAByPx ################################################################## ## Delete point A and associated lines and points, namely: ## - the text for point A ## - lines AB and DA ## - midpoints on lines AB and DA ## - the 'inner' quadrilateral line connecting those 2 midpoints ## - the other 2 'inner' quadrilateral lines connected to ## those 2 midpoints. ## In total, delete 9 objects. ################################################################## .fRcanvas.can delete TAGpointA .fRcanvas.can delete TAGtextA .fRcanvas.can delete TAGlineAB .fRcanvas.can delete TAGlineDA .fRcanvas.can delete TAGpointMidAB .fRcanvas.can delete TAGpointMidDA .fRcanvas.can delete TAGlineMidDA2MidAB .fRcanvas.can delete TAGlineMidCD2MidDA .fRcanvas.can delete TAGlineMidAB2MidBC ################################################################ ## Reset the coordinates of point A. ################################################################ set AxPx $Xpx set AyPx $Ypx ################################################################ ## ReDraw lines AB and DA. ################################################################ .fRcanvas.can create line \ $AxPx $AyPx $BxPx $ByPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineAB} .fRcanvas.can create line \ $DxPx $DyPx $AxPx $AyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineDA} ################################################################ ## Recalculate the midpoints on lines AB and DA. ################################################################ set midABxPx [expr {($AxPx + $BxPx)/2.0}] set midAByPx [expr {($AyPx + $ByPx)/2.0}] set midDAxPx [expr {($AxPx + $DxPx)/2.0}] set midDAyPx [expr {($AyPx + $DyPx)/2.0}] ######################################################### ## Redraw the side of the 'inner' quadrilateral that ## connects the 2 midpoints of lines DA and AB. ######################################################### .fRcanvas.can create line \ $midDAxPx $midDAyPx $midABxPx $midAByPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidDA2MidAB} ######################################################### ## Redraw the side of the 'inner' quadrilateral that ## connects the 2 midpoints of lines AB and BC. ######################################################### .fRcanvas.can create line \ $midABxPx $midAByPx $midBCxPx $midBCyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidAB2MidBC} ######################################################### ## Redraw the side of the 'inner' quadrilateral that ## connects the 2 midpoints of lines CD and DA. ######################################################### .fRcanvas.can create line \ $midCDxPx $midCDyPx $midDAxPx $midDAyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidCD2MidDA} ################################################################ ## ReDraw the midpoints on lines AB and DA. ################################################################ set ulXpx [expr {$midABxPx - $pointRADIUSpx}] set ulYpx [expr {$midAByPx - $pointRADIUSpx}] set lrXpx [expr {$midABxPx + $pointRADIUSpx}] set lrYpx [expr {$midAByPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidAB} set ulXpx [expr {$midDAxPx - $pointRADIUSpx}] set ulYpx [expr {$midDAyPx - $pointRADIUSpx}] set lrXpx [expr {$midDAxPx + $pointRADIUSpx}] set lrYpx [expr {$midDAyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidDA} ################################################################ ## ReDraw the point A. ################################################################ set ulXpx [expr {$AxPx - $pointRADIUSpx}] set ulYpx [expr {$AyPx - $pointRADIUSpx}] set lrXpx [expr {$AxPx + $pointRADIUSpx}] set lrYpx [expr {$AyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointOuter TAGpointA} ################################################################ ## Raise points D and B --- so that they cover ends of lines. ## Also raise the 4 mid-points. ################################################################ .fRcanvas.can raise TAGpointD .fRcanvas.can raise TAGpointB .fRcanvas.can raise TAGpointMidAB .fRcanvas.can raise TAGpointMidBC .fRcanvas.can raise TAGpointMidCD .fRcanvas.can raise TAGpointMidDA #################################################### ## Redraw a text character near vertex A. #################################################### .fRcanvas.can create text $AxPx [expr {$AyPx + (1.5 * $pointRADIUSpx)}] \ -anchor ne \ -fill $COLORPOINThex -font "$curFONTspecs" \ -text "A" -tags {TAGtext TAGtextA} } ## END OF PROC 'redraw4movedA' ##+############################################################# ## PROC 'redraw4movedB' ##+############################################################# ## PURPOSE: When point B of the 'outer' quadrilateral is moved, ## this proc is called to delete and redraw ## - a point and 2 lines of the 'outer' quadrilateral ## - 2 mid-points and 3 sides of the 'inner' quadrilateral ## that involve one or both of those points. ## ## CALLED BY: proc 'pointMoveEnd' ##+############################################################# proc redraw4movedB {Xpx Ypx} { ## FOR TESTING: (dummy out this routine) # return ## INPUT globals: global AxPx AyPx CxPx CyPx \ midDAxPx midDAyPx midCDxPx midCDyPx \ lineWidthPx dashPatternOuter dashPatternInner \ COLORLINEhex COLORPOINThex curFONTspecs \ pointRADIUSpx pointOUTLINEWIDTHpx pointOUTLINECOLORhex ## OUTPUT globals: global BxPx ByPx midABxPx midAByPx midBCxPx midBCyPx ################################################################## ## Delete point B and associated lines and points, namely: ## - the text for point B ## - lines AB and BC ## - midpoints on lines AB and BC ## - the 'inner' quadrilateral line connecting those 2 midpoints ## - the other 2 'inner' quadrilateral lines connected to ## those 2 midpoints. ## In total, delete 9 objects. ################################################################## .fRcanvas.can delete TAGpointB .fRcanvas.can delete TAGtextB .fRcanvas.can delete TAGlineAB .fRcanvas.can delete TAGlineBC .fRcanvas.can delete TAGpointMidAB .fRcanvas.can delete TAGpointMidBC .fRcanvas.can delete TAGlineMidAB2MidBC .fRcanvas.can delete TAGlineMidDA2MidAB .fRcanvas.can delete TAGlineMidBC2MidCD ################################################################ ## Reset the coordinates of point B. ################################################################ set BxPx $Xpx set ByPx $Ypx ################################################################ ## ReDraw lines AB and BC. ################################################################ .fRcanvas.can create line \ $AxPx $AyPx $BxPx $ByPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineAB} .fRcanvas.can create line \ $BxPx $ByPx $CxPx $CyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineBC} ################################################################ ## Recalculate the midpoints on lines AB and BC. ################################################################ set midABxPx [expr {($AxPx + $BxPx)/2.0}] set midAByPx [expr {($AyPx + $ByPx)/2.0}] set midBCxPx [expr {($BxPx + $CxPx)/2.0}] set midBCyPx [expr {($ByPx + $CyPx)/2.0}] ######################################################### ## Redraw the side of the 'inner' quadrilateral that ## connects the 2 midpoints of lines AB and BC. ######################################################### .fRcanvas.can create line \ $midABxPx $midAByPx $midBCxPx $midBCyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidAB2MidBC} ######################################################### ## Redraw the side of the 'inner' quadrilateral that ## connects the 2 midpoints of lines DA and AB. ######################################################### .fRcanvas.can create line \ $midDAxPx $midDAyPx $midABxPx $midAByPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidDA2MidAB} ######################################################### ## Redraw the side of the 'inner' quadrilateral that ## connects the 2 midpoints of lines BC and CD. ######################################################### .fRcanvas.can create line \ $midBCxPx $midBCyPx $midCDxPx $midCDyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidBC2MidCD} ################################################################ ## ReDraw the midpoints on lines AB and BC. ################################################################ set ulXpx [expr {$midABxPx - $pointRADIUSpx}] set ulYpx [expr {$midAByPx - $pointRADIUSpx}] set lrXpx [expr {$midABxPx + $pointRADIUSpx}] set lrYpx [expr {$midAByPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidAB} set ulXpx [expr {$midBCxPx - $pointRADIUSpx}] set ulYpx [expr {$midBCyPx - $pointRADIUSpx}] set lrXpx [expr {$midBCxPx + $pointRADIUSpx}] set lrYpx [expr {$midBCyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidBC} ################################################################ ## ReDraw the point B. ################################################################ set ulXpx [expr {$BxPx - $pointRADIUSpx}] set ulYpx [expr {$ByPx - $pointRADIUSpx}] set lrXpx [expr {$BxPx + $pointRADIUSpx}] set lrYpx [expr {$ByPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointOuter TAGpointB} ################################################################ ## Raise points A and C --- so that they cover ends of lines. ## Also raise the 4 mid-points. ################################################################ .fRcanvas.can raise TAGpointA .fRcanvas.can raise TAGpointC .fRcanvas.can raise TAGpointMidAB .fRcanvas.can raise TAGpointMidBC .fRcanvas.can raise TAGpointMidCD .fRcanvas.can raise TAGpointMidDA #################################################### ## Redraw a text character near vertex B. #################################################### .fRcanvas.can create text $BxPx [expr {$ByPx - (1.5 * $pointRADIUSpx)}] \ -anchor se \ -fill $COLORPOINThex -font "$curFONTspecs" \ -text "B" -tags {TAGtext TAGtextB} } ## END OF PROC 'redraw4movedB' ##+############################################################# ## PROC 'redraw4movedC' ##+############################################################# ## PURPOSE: When point C of the 'outer' quadrilateral is moved, ## this proc is called to delete and redraw ## - a point and 2 lines of the 'outer' quadrilateral ## - 2 mid-points and 3 sides of the 'inner' quadrilateral ## that involve one or both of those points. ## ## CALLED BY: proc 'pointMoveEnd' ##+############################################################# proc redraw4movedC {Xpx Ypx} { ## FOR TESTING: (dummy out this routine) # return ## INPUT globals: global BxPx ByPx DxPx DyPx \ midABxPx midAByPx midDAxPx midDAyPx \ lineWidthPx dashPatternOuter dashPatternInner \ COLORLINEhex COLORPOINThex curFONTspecs \ pointRADIUSpx pointOUTLINEWIDTHpx pointOUTLINECOLORhex ## OUTPUT globals: global CxPx CyPx midBCxPx midBCyPx midCDxPx midCDyPx ################################################################## ## Delete point C and associated lines and points, namely: ## - the text for point C ## - lines BC and CD ## - midpoints on lines BC and CD ## - the 'inner' quadrilateral line connecting those 2 midpoints ## - the other 2 'inner' quadrilateral lines connected to ## those 2 midpoints. ## In total, delete 9 objects. ################################################################## .fRcanvas.can delete TAGpointC .fRcanvas.can delete TAGtextC .fRcanvas.can delete TAGlineBC .fRcanvas.can delete TAGlineCD .fRcanvas.can delete TAGpointMidBC .fRcanvas.can delete TAGpointMidCD .fRcanvas.can delete TAGlineMidBC2MidCD .fRcanvas.can delete TAGlineMidAB2MidBC .fRcanvas.can delete TAGlineMidCD2MidDA ################################################################ ## Reset the coordinates of point C. ################################################################ set CxPx $Xpx set CyPx $Ypx ################################################################ ## ReDraw lines BC and CD. ################################################################ .fRcanvas.can create line \ $BxPx $ByPx $CxPx $CyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineBC} .fRcanvas.can create line \ $CxPx $CyPx $DxPx $DyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineCD} ################################################################ ## Recalculate the midpoints on lines BC and CD. ################################################################ set midBCxPx [expr {($BxPx + $CxPx)/2.0}] set midBCyPx [expr {($ByPx + $CyPx)/2.0}] set midCDxPx [expr {($CxPx + $DxPx)/2.0}] set midCDyPx [expr {($CyPx + $DyPx)/2.0}] ######################################################### ## Redraw the side of the 'inner' quadrilateral that ## connects the 2 midpoints of lines BC and CD. ######################################################### .fRcanvas.can create line \ $midBCxPx $midBCyPx $midCDxPx $midCDyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidBC2MidCD} ######################################################### ## Redraw the side of the 'inner' quadrilateral that ## connects the 2 midpoints of lines AB and BC. ######################################################### .fRcanvas.can create line \ $midABxPx $midAByPx $midBCxPx $midBCyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidAB2MidBC} ######################################################### ## Redraw the side of the 'inner' quadrilateral that ## connects the 2 midpoints of lines CD and DA. ######################################################### .fRcanvas.can create line \ $midCDxPx $midCDyPx $midDAxPx $midDAyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidCD2MidDA} ################################################################ ## ReDraw the midpoints on lines BC and CD. ################################################################ set ulXpx [expr {$midBCxPx - $pointRADIUSpx}] set ulYpx [expr {$midBCyPx - $pointRADIUSpx}] set lrXpx [expr {$midBCxPx + $pointRADIUSpx}] set lrYpx [expr {$midBCyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidBC} set ulXpx [expr {$midCDxPx - $pointRADIUSpx}] set ulYpx [expr {$midCDyPx - $pointRADIUSpx}] set lrXpx [expr {$midCDxPx + $pointRADIUSpx}] set lrYpx [expr {$midCDyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidCD} ################################################################ ## ReDraw the point C. ################################################################ set ulXpx [expr {$CxPx - $pointRADIUSpx}] set ulYpx [expr {$CyPx - $pointRADIUSpx}] set lrXpx [expr {$CxPx + $pointRADIUSpx}] set lrYpx [expr {$CyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointOuter TAGpointC} ################################################################ ## Raise points B and D --- so that they cover ends of lines. ## Also raise the 4 mid-points. ################################################################ .fRcanvas.can raise TAGpointB .fRcanvas.can raise TAGpointD .fRcanvas.can raise TAGpointMidAB .fRcanvas.can raise TAGpointMidBC .fRcanvas.can raise TAGpointMidCD .fRcanvas.can raise TAGpointMidDA #################################################### ## Redraw a text character near vertex C. #################################################### .fRcanvas.can create text $CxPx [expr {$CyPx - (1.5 * $pointRADIUSpx)}] \ -anchor sw \ -fill $COLORPOINThex -font "$curFONTspecs" \ -text "C" -tags {TAGtext TAGtextC} } ## END OF PROC 'redraw4movedC' ##+############################################################# ## PROC 'redraw4movedD' ##+############################################################# ## PURPOSE: When point D of the 'outer' quadrilateral is moved, ## this proc is called to delete and redraw ## - a point and 2 lines of the 'outer' quadrilateral ## - 2 mid-points and 3 sides of the 'inner' quadrilateral ## that involve one or both of those points. ## ## CALLED BY: proc 'pointMoveEnd' ##+############################################################# proc redraw4movedD {Xpx Ypx} { ## FOR TESTING: (dummy out this routine) # return ## INPUT globals: global CxPx CyPx AxPx AyPx \ midBCxPx midBCyPx midABxPx midAByPx \ lineWidthPx dashPatternOuter dashPatternInner \ COLORLINEhex COLORPOINThex curFONTspecs \ pointRADIUSpx pointOUTLINEWIDTHpx pointOUTLINECOLORhex ## OUTPUT globals: global DxPx DyPx midCDxPx midCDyPx midDAxPx midDAyPx ################################################################## ## Delete point D and associated lines and points, namely: ## - the text for point D ## - lines CD and DA ## - midpoints on lines CD and DA ## - the 'inner' quadrilateral line connecting those 2 midpoints ## - the other 2 'inner' quadrilateral lines connected to ## those 2 midpoints. ## In total, delete 9 objects. ################################################################## .fRcanvas.can delete TAGpointD .fRcanvas.can delete TAGtextD .fRcanvas.can delete TAGlineCD .fRcanvas.can delete TAGlineDA .fRcanvas.can delete TAGpointMidCD .fRcanvas.can delete TAGpointMidDA .fRcanvas.can delete TAGlineMidCD2MidDA .fRcanvas.can delete TAGlineMidBC2MidCD .fRcanvas.can delete TAGlineMidDA2MidAB ################################################################ ## Reset the coordinates of point D. ################################################################ set DxPx $Xpx set DyPx $Ypx ################################################################ ## ReDraw lines CD and DA. ################################################################ .fRcanvas.can create line \ $CxPx $CyPx $DxPx $DyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineCD} .fRcanvas.can create line \ $DxPx $DyPx $AxPx $AyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineDA} ################################################################ ## Recalculate the midpoints on lines CD and DA. ################################################################ set midCDxPx [expr {($CxPx + $DxPx)/2.0}] set midCDyPx [expr {($CyPx + $DyPx)/2.0}] set midDAxPx [expr {($DxPx + $AxPx)/2.0}] set midDAyPx [expr {($DyPx + $AyPx)/2.0}] ######################################################### ## Redraw the line connecting the 2 midpoints on lines ## CD and DA. ######################################################### .fRcanvas.can create line \ $midCDxPx $midCDyPx $midDAxPx $midDAyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidCD2MidDA} ######################################################### ## Redraw the side of the 'inner' quadrilateral that ## connects the 2 midpoints of lines BC and CD. ######################################################### .fRcanvas.can create line \ $midBCxPx $midBCyPx $midCDxPx $midCDyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidBC2MidCD} ######################################################### ## Redraw the side of the 'inner' quadrilateral that ## connects the 2 midpoints of lines DA and AB. ######################################################### .fRcanvas.can create line \ $midDAxPx $midDAyPx $midABxPx $midAByPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidDA2MidAB} ################################################################ ## ReDraw the midpoints on lines CD and DA. ################################################################ set ulXpx [expr {$midCDxPx - $pointRADIUSpx}] set ulYpx [expr {$midCDyPx - $pointRADIUSpx}] set lrXpx [expr {$midCDxPx + $pointRADIUSpx}] set lrYpx [expr {$midCDyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidCD} set ulXpx [expr {$midDAxPx - $pointRADIUSpx}] set ulYpx [expr {$midDAyPx - $pointRADIUSpx}] set lrXpx [expr {$midDAxPx + $pointRADIUSpx}] set lrYpx [expr {$midDAyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidDA} ################################################################ ## ReDraw the point D. ################################################################ set ulXpx [expr {$DxPx - $pointRADIUSpx}] set ulYpx [expr {$DyPx - $pointRADIUSpx}] set lrXpx [expr {$DxPx + $pointRADIUSpx}] set lrYpx [expr {$DyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointOuter TAGpointD} ################################################################ ## Raise points C and A --- so that they cover ends of lines. ## Also raise the 4 mid-points. ################################################################ .fRcanvas.can raise TAGpointC .fRcanvas.can raise TAGpointA .fRcanvas.can raise TAGpointMidAB .fRcanvas.can raise TAGpointMidBC .fRcanvas.can raise TAGpointMidCD .fRcanvas.can raise TAGpointMidDA #################################################### ## Redraw a text character near vertex D. #################################################### .fRcanvas.can create text $DxPx [expr {$DyPx + (1.5 * $pointRADIUSpx)}] \ -anchor nw \ -fill $COLORPOINThex -font "$curFONTspecs" \ -text "D" -tags {TAGtext TAGtextD} } ## END OF PROC 'redraw4movedD' ##+##################################################################### ## PROC 'show_state' ##+##################################################################### ## PURPOSE: To report on the state of the current ## configuration of 'outer' and 'inner' quadrilaterals: ## ## - the coordinates of their vertex points ## - the lengths of their line segments (sides) ## ## CALLED BY: the 'ShowState' button ##+##################################################################### proc show_state {} { ## FOR TESTING: (dummy out this routine) # return global AxPx AyPx BxPx ByPx CxPx CyPx DxPx DyPx \ midABxPx midAByPx midBCxPx midBCyPx midCDxPx midCDyPx midDAxPx midDAyPx ################################################################### ## Calculate the lengths of the sides of the 'outer' quadrilateral. ################################################################### set lenAB [expr {hypot($BxPx - $AxPx,$ByPx - $AyPx)}] set lenBC [expr {hypot($CxPx - $BxPx,$CyPx - $ByPx)}] set lenCD [expr {hypot($DxPx - $CxPx,$DyPx - $CyPx)}] set lenDA [expr {hypot($AxPx - $DxPx,$AyPx - $DyPx)}] ################################################################### ## Calculate the lengths of the sides of the 'inner' quadrilateral. ################################################################### set lenMidAB2MidBC [expr {hypot($midBCxPx - $midABxPx,$midBCyPx - $midAByPx)}] set lenMidBC2MidCD [expr {hypot($midCDxPx - $midBCxPx,$midCDyPx - $midBCyPx)}] set lenMidCD2MidDA [expr {hypot($midDAxPx - $midCDxPx,$midDAyPx - $midCDyPx)}] set lenMidDA2MidAB [expr {hypot($midABxPx - $midDAxPx,$midAByPx - $midDAyPx)}] ############################################ ## Create the heading for the state listing. ############################################ set VARlist \ "tkVarignonsTheorem - Quadrilateral Midpoints Yield a Parallelogram STATE OF THE CURRENT CONFIGURATION OF AN 'OUTER' QUADRILATERAL AND AN 'INNER', 'MID-POINTS' QUADRILATERAL: Current Coordinates of points A,B,C,D of the 'outer' quadrilateral: Ax,Ay: [format "%-10.4f" $AxPx] , [format "%-10.4f" $AyPx] Bx,By: [format "%-10.4f" $BxPx] , [format "%-10.4f" $ByPx] Cx,Cy: [format "%-10.4f" $CxPx] , [format "%-10.4f" $CyPx] Dx,Dy: [format "%-10.4f" $DxPx] , [format "%-10.4f" $DyPx] Current Coordinates of the MID-POINTS that are the vertices of the inner-quadrilateral: midABx,midABy: [format "%-10.4f" $midABxPx] , [format "%-10.4f" $midAByPx] midBCx,midBCy: [format "%-10.4f" $midBCxPx] , [format "%-10.4f" $midBCyPx] midCDx,midCDy: [format "%-10.4f" $midCDxPx] , [format "%-10.4f" $midCDyPx] midDAx,midDAy: [format "%-10.4f" $midDAxPx] , [format "%-10.4f" $midDAyPx] Lengths of the sides of the 'outer' quadrilateral: Length of side AB: [format "%-10.4f" $lenAB] Length of side BC: [format "%-10.4f" $lenBC] Length of side CD: [format "%-10.4f" $lenCD] Length of side DA: [format "%-10.4f" $lenDA] Lengths of the sides of the 'inner' quadrilateral (the PARALLELOGRAM): Length of side midAB-to-midBC: [format "%-10.4f" $lenMidAB2MidBC] Length of side midBC-to-midCD: [format "%-10.4f" $lenMidBC2MidCD] Length of side midCD-to-midDA: [format "%-10.4f" $lenMidCD2MidDA] Length of side midDA-to-midAB: [format "%-10.4f" $lenMidDA2MidAB] NOTE: The opposite sides of the 'inner' quadrilateral have the same length. This confirms that the 'inner', 'mid-points' quadrilateral is a parallelogram. " ############################## ## Show the list. ############################## popup_msgVarWithScroll .topList "$VARlist" +20+30 } ## END OF proc 'show_state' ##+##################################################################### ## 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 (background) color of the canvas --- ## on which all the geometry is to be drawn. ## ## 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 color of background-color button. update_button_colors ## Set the color of the canvas. .fRcanvas.can config -bg $COLORBKGDhex } ## END OF PROC 'set_background_color' #+##################################################################### ## PROC 'set_line_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 circle to be ## drawn on the canvas. ## ## Arguments: none (global variables are used) ## ## CALLED BY: .fRbuttons.buttCOLORline button ##+##################################################################### proc set_line_color {} { global COLORLINEr COLORLINEg COLORLINEb COLORLINEhex ColorSelectorScript ## FOR TESTING: # puts "COLORLINEr: $COLORLINEr" # puts "COLORLINEg: $COLORLINEb" # puts "COLORLINEb: $COLORLINEb" set TEMPrgb [ exec $ColorSelectorScript $COLORLINEr $COLORLINEg $COLORLINEb] ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" if { "$TEMPrgb" == "" } { return } scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB set COLORLINEhex "#$hexRGB" set COLORLINEr $r255 set COLORLINEg $g255 set COLORLINEb $b255 ## Set color of the draw-color button. update_button_colors ## Redraw the lines. redraw_lines } ## END OF PROC 'set_line_color' ##+##################################################################### ## PROC 'redraw_lines' ##+##################################################################### ## PURPOSE: Redraw the 8 lines --- using a new line color. ## ## CALLED BY: the 'set_line_color' proc ##+##################################################################### proc redraw_lines {} { ## FOR TESTING: (dummy out this routine) # return global lineWidthPx dashPatternOuter dashPatternInner COLORLINEhex \ AxPx AyPx BxPx ByPx CxPx CyPx DxPx DyPx \ midABxPx midAByPx midBCxPx midBCyPx midCDxPx midCDyPx midDAxPx midDAyPx ############################################### ## Delete lines AB,BC,CD,DA. ############################################### .fRcanvas.can delete TAGlineAB .fRcanvas.can delete TAGlineBC .fRcanvas.can delete TAGlineCD .fRcanvas.can delete TAGlineDA ############################################### ## Draw the line from A to B. ############################################### .fRcanvas.can create line \ $AxPx $AyPx $BxPx $ByPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineAB} ############################################### ## Draw the line from B to C. ############################################### .fRcanvas.can create line \ $BxPx $ByPx $CxPx $CyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineBC} ############################################### ## Draw the line from C to D. ############################################### .fRcanvas.can create line \ $CxPx $CyPx $DxPx $DyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineCD} ############################################### ## Draw the line from D to A. ############################################### .fRcanvas.can create line \ $DxPx $DyPx $AxPx $AyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternOuter -tags {TAGlinesOuter TAGlineDA} ############################################### ## Delete the 'mid-point' lines. ############################################### .fRcanvas.can delete TAGlineMidAB2MidBC .fRcanvas.can delete TAGlineMidBC2MidCD .fRcanvas.can delete TAGlineMidCD2MidDA .fRcanvas.can delete TAGlineMidDA2MidAB ############################################### ## Draw the line from midAB to midBC. ############################################### .fRcanvas.can create line \ $midABxPx $midAByPx $midBCxPx $midBCyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidAB2MidBC} ############################################### ## Draw the line from midBC to midCD. ############################################### .fRcanvas.can create line \ $midBCxPx $midBCyPx $midCDxPx $midCDyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidBC2MidCD} ############################################### ## Draw the line from midCD to midDA. ############################################### .fRcanvas.can create line \ $midCDxPx $midCDyPx $midDAxPx $midDAyPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidCD2MidDA} ############################################### ## Draw the line from midDA to midAB. ############################################### .fRcanvas.can create line \ $midDAxPx $midDAyPx $midABxPx $midAByPx \ -fill $COLORLINEhex -width $lineWidthPx \ -dash $dashPatternInner -tags {TAGlinesInner TAGlineMidDA2MidAB} #################################################### ## Raise the point objects above the line objects. #################################################### .fRcanvas.can raise TAGpointA .fRcanvas.can raise TAGpointB .fRcanvas.can raise TAGpointC .fRcanvas.can raise TAGpointD .fRcanvas.can raise TAGpointMidAB .fRcanvas.can raise TAGpointMidBC .fRcanvas.can raise TAGpointMidCD .fRcanvas.can raise TAGpointMidDA } ## END OF proc 'redraw_lines' #+##################################################################### ## PROC 'set_point_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 inscribed polygon ## drawn on the canvas. ## ## Arguments: none (global variables are used) ## ## CALLED BY: .fRbuttons.buttCOLORpoint button ##+##################################################################### proc set_point_color {} { global COLORPOINTr COLORPOINTg COLORPOINTb COLORPOINThex ColorSelectorScript ## FOR TESTING: # puts "COLORPOINTr: $COLORPOINTr" # puts "COLORPOINTg: $COLORPOINTb" # puts "COLORPOINTb: $COLORPOINTb" set TEMPrgb [ exec $ColorSelectorScript $COLORPOINTr $COLORPOINTg $COLORPOINTb] ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" if { "$TEMPrgb" == "" } { return } scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB set COLORPOINThex "#$hexRGB" set COLORPOINTr $r255 set COLORPOINTg $g255 set COLORPOINTb $b255 ## Set color of the draw-color button. update_button_colors ## Redraw the points. redraw_points } ## END OF PROC 'set_point_color' ##+##################################################################### ## PROC 'redraw_points' ##+##################################################################### ## PURPOSE: Redraw the 8 points --- using a new point color. ## ## CALLED BY: the 'set_point_color' proc ##+##################################################################### proc redraw_points {} { ## FOR TESTING: (dummy out this routine) # return global COLORPOINThex pointRADIUSpx pointOUTLINEWIDTHpx \ pointOUTLINECOLORhex curFONTspecs \ AxPx AyPx BxPx ByPx CxPx CyPx DxPx DyPx \ midABxPx midAByPx midBCxPx midBCyPx midCDxPx midCDyPx midDAxPx midDAyPx #################################################### ## Delete the 4 points A,B,C,D. #################################################### .fRcanvas.can delete TAGpointA .fRcanvas.can delete TAGpointB .fRcanvas.can delete TAGpointC .fRcanvas.can delete TAGpointD #################################################### ## Draw circles representing the 4 vertices (points) ## of the 'outer' quadrilateral --- A,B,C,D. #################################################### set ulXpx [expr {$AxPx - $pointRADIUSpx}] set ulYpx [expr {$AyPx - $pointRADIUSpx}] set lrXpx [expr {$AxPx + $pointRADIUSpx}] set lrYpx [expr {$AyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointOuter TAGpointA} set ulXpx [expr {$BxPx - $pointRADIUSpx}] set ulYpx [expr {$ByPx - $pointRADIUSpx}] set lrXpx [expr {$BxPx + $pointRADIUSpx}] set lrYpx [expr {$ByPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointOuter TAGpointB} set ulXpx [expr {$CxPx - $pointRADIUSpx}] set ulYpx [expr {$CyPx - $pointRADIUSpx}] set lrXpx [expr {$CxPx + $pointRADIUSpx}] set lrYpx [expr {$CyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointOuter TAGpointC} set ulXpx [expr {$DxPx - $pointRADIUSpx}] set ulYpx [expr {$DyPx - $pointRADIUSpx}] set lrXpx [expr {$DxPx + $pointRADIUSpx}] set lrYpx [expr {$DyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointOuter TAGpointD} #################################################### ## Delete the 4 mid-points. #################################################### .fRcanvas.can delete TAGpointMidAB .fRcanvas.can delete TAGpointMidBC .fRcanvas.can delete TAGpointMidCD .fRcanvas.can delete TAGpointMidDA ######################################################## ## Draw circles representing the 4 vertices (points) of ## the 'inner' quadrilateral --- midAB,midBC,midCD,midDA. ######################################################## set ulXpx [expr {$midABxPx - $pointRADIUSpx}] set ulYpx [expr {$midAByPx - $pointRADIUSpx}] set lrXpx [expr {$midABxPx + $pointRADIUSpx}] set lrYpx [expr {$midAByPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidAB} set ulXpx [expr {$midBCxPx - $pointRADIUSpx}] set ulYpx [expr {$midBCyPx - $pointRADIUSpx}] set lrXpx [expr {$midBCxPx + $pointRADIUSpx}] set lrYpx [expr {$midBCyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidBC} set ulXpx [expr {$midCDxPx - $pointRADIUSpx}] set ulYpx [expr {$midCDyPx - $pointRADIUSpx}] set lrXpx [expr {$midCDxPx + $pointRADIUSpx}] set lrYpx [expr {$midCDyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidCD} set ulXpx [expr {$midDAxPx - $pointRADIUSpx}] set ulYpx [expr {$midDAyPx - $pointRADIUSpx}] set lrXpx [expr {$midDAxPx + $pointRADIUSpx}] set lrYpx [expr {$midDAyPx + $pointRADIUSpx}] .fRcanvas.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $COLORPOINThex -tags {TAGpointInner TAGpointMidDA} #################################################### ## Delete the 4 text labels -- for points A,B,C,D. #################################################### .fRcanvas.can delete TAGtextA .fRcanvas.can delete TAGtextB .fRcanvas.can delete TAGtextC .fRcanvas.can delete TAGtextD #################################################### ## Draw a text character near the 4 vertices (points) ## of the 'outer' quadrilateral --- A,B,C,D. #################################################### .fRcanvas.can create text $AxPx $AyPx -anchor ne \ -fill $COLORPOINThex -font "$curFONTspecs" \ -text "A" -tags {TAGtext TAGtextA} .fRcanvas.can create text $BxPx $ByPx -anchor se \ -fill $COLORPOINThex -font "$curFONTspecs" \ -text "B" -tags {TAGtext TAGtextB} .fRcanvas.can create text $CxPx $CyPx -anchor sw \ -fill $COLORPOINThex -font "$curFONTspecs" \ -text "C" -tags {TAGtext TAGtextC} .fRcanvas.can create text $DxPx $DyPx -anchor nw \ -fill $COLORPOINThex -font "$curFONTspecs" \ -text "D" -tags {TAGtext TAGtextD} } ## END OF proc 'redraw_points' ##+##################################################################### ## PROC 'update_button_colors' ##+##################################################################### ## PURPOSE: ## This procedure is invoked to set the background color of each of ## 3 color buttons to its current color --- and sets foreground color, ## for text on the 3 buttons, to a suitable(?) black or white color, ## so that the label text is readable. ## ## (We might need to weight the RGB colors differently when summing ## them, to get a better choice of black or white for the wide ## range of colors that are possible on these color buttons.) ## ## Arguments: global color vars ## ## CALLED BY: 3 colors procs: ## 'set_background_color' 'set_line_color' ## 'set_point_color' ## and ## in the additional-GUI-initialization section at ## the bottom of this script to initialize the color of ## the buttons. ##+##################################################################### proc update_button_colors {} { global COLORBKGDr COLORBKGDg COLORBKGDb COLORBKGDhex \ COLORLINEr COLORLINEg COLORLINEb COLORLINEhex \ COLORPOINTr COLORPOINTg COLORPOINTb COLORPOINThex # set colorBREAK 300 set colorBREAK 375 .fRbuttons.buttCOLORbkgd configure -bg $COLORBKGDhex set sumCOLOR [expr {$COLORBKGDr + $COLORBKGDg + $COLORBKGDb}] if {$sumCOLOR > $colorBREAK} { .fRbuttons.buttCOLORbkgd configure -fg "#000000" } else { .fRbuttons.buttCOLORbkgd configure -fg "#f0f0f0" } .fRbuttons.buttCOLORline configure -bg $COLORLINEhex set sumCOLOR [expr {$COLORLINEr + $COLORLINEg + $COLORLINEb}] if {$sumCOLOR > $colorBREAK} { .fRbuttons.buttCOLORline configure -fg "#000000" } else { .fRbuttons.buttCOLORline configure -fg "#f0f0f0" } .fRbuttons.buttCOLORpoint configure -bg $COLORPOINThex set sumCOLOR [expr {$COLORPOINTr + $COLORPOINTg + $COLORPOINTb}] if {$sumCOLOR > $colorBREAK} { .fRbuttons.buttCOLORpoint configure -fg "#000000" } else { .fRbuttons.buttCOLORpoint configure -fg "#f0f0f0" } } ## END OF PROC 'update_button_colors' ##+##################################################################### ## PROC 'advise_user' ##+##################################################################### ## PURPOSE: Puts a message to the user on the GUI. ## ## CALLED BY: in the additional-GUI-initialization section at ## the bottom of this script ## and in some procs. ##+##################################################################### proc advise_user {text} { .fRmsg.labelMSG configure -text "$text" ## Make sure the text is displayed on the GUI. update ## Alternatively, we could put the message in the title-bar ## of the GUI window. (But it is easy for the user to ## fail to see the message there. Besides, we have more ## options in displaying the message by putting it on a ## Tk widget in the GUI.) ## # wm title . "$text" } ## END OF PROC 'advise_user' ##+######################################################################## ## 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 } ################################################ ## Set some 'event' bindings to allow for ## easy scrolling through huge listings. ## is a press of the Page-Down key. ## is a press of the Page-Up key. ## is a press of the Home key ## to go to the top of the listing. ## is a press of the End key ## to go to the bottom of the listing. ## is a press of the Up-arrow key. ## is a press of the Down-arrow key. ################################################ bind $toplevName "$toplevName.text yview scroll +1 page" bind $toplevName "$toplevName.text yview scroll -1 page" bind $toplevName "$toplevName.text see 1.0" bind $toplevName "$toplevName.text see end" bind $toplevName "$toplevName.text yview scroll -1 unit" bind $toplevName "$toplevName.text yview scroll +1 unit" ##################################### ## 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' ##+######################## ## END of PROC definitions. ##+######################## ##+######################## ## Set the 'HELPtext' var. ##+######################## set HELPtext "\ \ \ ** HELP for this 'tkVarignonsTheorem' App ** This Tk script is meant to demonstrate Varignon's Theorem: For an arbitrary quadrilateral, if you determine the 4 mid-points of the 4 sides and connect the points so that they form a quadrilateral inside the original quadrilateral, the interior quadrilateral is always a PARALLELOGRAM. This is true even when a point is dragged so that the original quadrilateral becomes 'concave' instead of 'convex'. This script is meant to 'dynamically' demonstrate this fact by allowing the user to 'drag' any point of the original quadrilateral to form a new quadrilateral. When the user finishes the 'drag' (releases the mouse-button): 1) the moved point is deleted and redrawn in its new position, 2) the 2 affected sides (line-segments) of the original, outer quadrilateral are deleted and redrawn, 3) the 2 new mid-points of those 2 line-segments are calculated, 4) the 2 'old' mid-points are deleted and redrawn, 5) the 3 'old' sides of the inner quadrilateral are deleted and redrawn --- yielding a new parallelogram, These operations are not necessarily performed in this order. For example, some deletions may be grouped together, and some re-draws may be grouped together. We 'tag' the 4 points of the outer quadrilateral with the names A,B,C,D. ************ GUI FEATURES: ************ This GUI uses a Tk 'canvas' widget to show the two quadrilaterals. The line segments (sides) of the 2 quadrilaterals are drawn with eight 'create line' commands on the canvas. The 8 vertex points are indicated by use of 'create oval' commands. We use a rectangular drawing area (the Tk 'canvas' widget), and we allow the user to control the size (in pixels) of that drawing area by the user resizing the entire GUI window --- which results in the canvas being automatically resized by the Tk 'pack' geometry manager. The delete-and-redraw operations are automatically triggered when the user releases the mouse button after moving one of the 4 points of the 'outer' quadrilateral. Three 'Color' buttons on the GUI allow the user to specify - background color of the Tk canvas widget - color of the eight line segments - color of the eight points A 'ShowState' button on the GUI may be used to report on the state of the current image, such as: - coordinates of the eight points - the 4 vertices of the 'outer' quadrilateral and the 4 mid-points of its sides - lengths of the eight line-segments --- the 4 sides of the 'outer' quadrilateral and the 4 sides of the 'inner' quadrilateral. A 'Help' button on the GUI show this help text. ******************************** CAPTURING THE GUI 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 smaller image suitable for use in a web page or an email. " ##+################################################################ ##+################################################################ ## ADDITIONAL GUI INITIALIZATION SECTION: Mainly to ## - Draw an initial circle and polygon(s) on the canvas. ##+################################################################ ##+################################################################ ##+##################################################### ## 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 3 drawing colors --- for background, ## line-segments, and points. ##+############################################################ set COLORBKGDr 90 set COLORBKGDg 90 set COLORBKGDb 255 set COLORBKGDhex [format "#%02X%02X%02X" $COLORBKGDr $COLORBKGDg $COLORBKGDb] set COLORLINEr 255 set COLORLINEg 255 set COLORLINEb 255 set COLORLINEhex [format "#%02X%02X%02X" $COLORLINEr $COLORLINEg $COLORLINEb] set COLORPOINTr 255 set COLORPOINTg 0 set COLORPOINTb 0 set COLORPOINThex [format "#%02X%02X%02X" $COLORPOINTr $COLORPOINTg $COLORPOINTb] ##+################################### ## Set the color of the color buttons. ##+################################### update_button_colors ##+############################################################ ## We need following command because the 'initDraw' proc ## (called below) does not (re)set the background/canvas color. ## Only the background-color button-proc sets the canvas color. ##+############################################################ .fRcanvas.can config -bg $COLORBKGDhex ##+################################################ ## Set a width for line-segments. ##+################################################ # set lineWidthPx 1 set lineWidthPx 2 ##+################################################# ## Set a constants to use in 'format' statements ## used to display the coordinate values and line ## lengths. ##+################################################ # set decimalDIGITS 6 set decimalDIGITS 8 ##+################################################### ## Set dash-patterns for the lines (sides) of the ## outer and inner quadrilaterals. ##+################################################### set dashPatternOuter {} set dashPatternInner {3 3} ##+################################################### ## Set a radius (in pixels) for the circles that ## represent the 8 vertices of the 2 quadrilaterals. ##+################################################### set pointRADIUSpx 5 ##+################################################### ## Set a color for the outline of the circles that ## represent the 8 vertices of the 2 quadrilaterals. ##+################################################### set pointOUTLINECOLORhex "#ffffff" ##+###################################################### ## Set a width (in pixels) for the outline of the circles ## that represent the 8 vertices of the 2 quadrilaterals. ##+###################################################### set pointOUTLINEWIDTHpx 1 ##+##################################################### ## Initialize var 'curFONTspecs', used to specify the ## font for the text drawn on the canvas widget. ## See the font-section near the top of the code ## for some other font family names, such as ## { new century schoolbook } ##+##################################################### set curFONTspecs [list -family {Liberation Mono} -size -34 \ -weight bold -slant roman -underline 0 -overstrike 0] ##+###################################################### ## Display an initial 'how-to' message to the user. ## ## This should be performed before the call to 'initDraw', ## because this determines the width of the window --- ## and thus the width of the expandable canvas. ## This helps center the initial figure in the canvas area. ##+###################################################### advise_user "$aRtext(labelINIT)" ##+################################################# ## Draw the initial configuration of an 'outer' ## quadrilateral and an 'inner' quadrilateral. ##+################################################# initDraw