#!/usr/bin/wish -f ## ##+####################################################################### ## NOTE: ## If the 'wish' interpreter is in another directory, like ## /usr/local/bin, you, as root, can make a soft-link from 'wish' there ## to /usr/bin/wish --- with a command like ## ln -s /usr/bin/local/wish /usr/bin/wish ## The form of this command: ## ln -s ##+####################################################################### ## Tk SCRIPT NAME: tkMovingText.tk ## ## WHERE: in $FEDIR_TKGUIS/ImageAnimations = $FEDIR/tkGUIs/ImageAnimations ## or $FEDIR_TKGUIS/TEXTtools = $FEDIR/tkGUIs/TEXTtools ## ## where $FEDIR is the installation directory ## of an FE subsystem --- such as 'tkGooies'. ## The default installation directory ## is FEDIR = $HOME/apps/tkGooies. ## Reference: www.freedomenv.com ##+####################################################################### ## PURPOSE: This TkGUI script provides a GUI for creating 'moving text' ## using FONTS (i.e. text) (and, optionally, a background image) ## placed on a Tk canvas --- with canvas 'create text' and ## 'create image' commands. ## ## The GUI provides a 'text-entry' area in which the user ## can specify LINES OF TEXT for the 'moving text'. ## ## And the GUI provides an 'entry' widget and 'Browse...' button ## so that the user can select ONE OR MORE IMAGES to be placed ## as a background on the canvas (for example, a star field). ## ## This GUI provides the capability for the user to specify ## - various ways the text can move across the canvas ## (bottom-to-top, top-to-bottom, left-to-right, ## right-to-left, and maybe more) ## and ## - speed at which the text moves across the canvas ## (via a 'wait-time' in millisecs). ## ## This GUI calls on a separate FONT-SELECTOR GUI to set the ## FONT FOR THE TEXT-LINE(S) to be placed on the canvas. ## ## The font-selector GUI facilitates the selection of a set of ## Tcl-Tk FONT SPECIFICATION VALUES (6 of them): ## ## - font-family ## - font-size (pixels or points ; negative or positive integers) ## - font-weight: bold or normal ## - font-slant: roman (erect) or italic ## - underscore: off or on ## - overstrike: off or on ## ##+############# ## IMAGE CAPTURE: ## ## To capture any single image of the text on the canvas, ## the user can use a screen/window capture utility ## (such as 'gnome-screenshot' on Linux) to capture the ## image in an image file format, such as PNG. ## ## An image editor (such as 'mtpaint' on Linux) can be used to ## 'crop' the captured image if necessary --- and can be used ## to apply processing options such as 'blur' or 'emboss' or ## whatever. ## ## The resulting image file(s) can be printed with an image ## view-and-print utility (such as 'eog' = 'Eye of Gnome' on ## Linux). ## ##------ ## ## A 'WriteAniGIF' or 'WriteMovie' button may (eventually) be provided ## on the GUI, by which to capture the moving-text in an animated-GIF file. ## ## ##+################# ## THE GUI WIDGETS: ## ## The options available to the user are indicated by ## the following 'sketch' of the GUI: ## ## FRAMEnames ## VVVVVVVVVV ## --------------------------------------------------------------------------------- ## tkMovingText ## [window title] ## --------------------------------------------------------------------------------- ## ## .fRbuttons {Exit} {Help} {Font} {Clear} {Backgd {Text X ShowOptions Animate: O Start O Stop ## Color} Color} ## ## .fRmsg [.... Messages to user are display in a label here .............................] ## ## .fRopts [The .fRopts frame contains subframes and may be initially hidden (not packed). ## The following subframes of .fRopts appear when the Options checkbutton is 'on'.] ## ## .fRopts.fRfile Background Image filename: __________________________________________ {Browse...} ## ## |-----------------------------------------------------------------A ## .fRopts.fRtextarea | [TEXT widget (scrollable) in which | ## ENTER TEXT | to enter text for the animation | ## LINE(S) HERE: | on the canvas.] | ## |<--------------------------------------------------------------->V ## ## Speed control 2 500 Direction [a scrollable LISTBOX of options is put here ## .fRopts.fRcontrols1 (millisecs wait): <-----O---> of movement: --- 'bottom-to-top', 'right-to-left', etc. --- ## there could be ten or more direction options here.] ## ## |-------------------------------------------------------------------------------A ## .fRcanvas | [CANVAS (scollable) on which to animate the text.] | ## | | ## | | ## | | ## | | ## | | ## | | ## | | ## | | ## | | ## | | ## |<------------------------------------------------------------------------------>V ## ## ------------------------------------------------------------------- ## ## In the above sketch of the GUI: ## ## 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. ## (To clarify the label extent, single quotes may be used around the text.) ## ## UNDERSCORES indicate a Tk 'entry' widget. ## CAPITAL-O indicates a Tk 'radiobutton' widget. ## CAPITAL-X indicates a Tk 'checkbutton' widget (if any). ## <----O----> indicates a horizontal Tk 'scale' widget. ## ## A rectangle marked by hyphens (-) and vertical bars (|) ## indicates a Tk 'text' or 'canvas' or 'listbox' widget. ## ##+############## ## GUI components: ## ## From the GUI 'sketch' above, it is seen that the GUI consists of ## about ## ## - 7 button widgets ## - 5 label widgets ## - 2 radiobutton widgets (in one group) ## - 1 checkbutton widget ## - 1 entry widget ## - 1 scale widget (horizontal) ## - 1 listbox widget (with x,y scrollbars) ## - 1 text widget (with x,y scrollbars) ## - 1 canvas widget (with x,y scrollbars) ## ## NOTE: This Tk script contains almost every main type of Tk widget. ## Hence this script can be handy when looking for examples ## of definition and packing statements for Tk widgets. ##+##################################################################### ## CALLED BY: - a drawer in the 'ImageAnimations' subtoolchest ## of the 'IMAGEtools' toolchest ## OR ## - a drawer in the 'TEXTtools' toolchest ## in the 'tkGooies' FE system ## ## OR ## in a shell script or another Tk script. ## ##+######################################################################## ## 'CANONICAL' STRUCTURE OF THIS CODE: ## ## 0) Set general window parms (win-name,win-position,win-color-scheme, ## fonts,widget-geom-parameters,win-size-control,text-array-for-labels-etc). ## 1a) Define ALL frames (and sub-frames). ## 1b) Pack ALL frames and sub-frames. ## 2) Define & pack all widgets in the frames, frame by frame. ## ## 3) Define key and mouse/touchpad/touch-sensitive-screen 'event' ## BINDINGS, if needed. ## 4) Define PROCS, if needed. ## 5) Additional GUI INITIALIZATION (typically with one or two procs ## from section 4), if needed. ## ##+################################# ## Some detail on the code structure of this particular Tk script: ## ## 1a) Define ALL frames: ## ## Top-level : ## '.fRbuttons' - to contain buttons such as 'Exit', 'Help', 'Font', ## 'Clear' --- and 2 color selection buttons --- ## for text color and for canvas (background) color. ## '.fRmsg' - to contain a label for messages to the user. ## '.fRopts.fRfile' - to contain a triplet: label-entry-button widgets. ## '.fRopts.fRtextarea' - to contain a label and a scrollable text widget for text entry. ## '.fRopts.fRcontrols1' - to contain a label and a horizontal scale widget ## and a label and a scrollable listbox widget. ## '.fRcanvas' - to contain a scrollable canvas widget. ## ## Sub-frames: none ## ## 1b) Pack ALL frames. ## ## 2) Define & pack all WIDGETS IN THE FRAMES -- basically going through ## frames & their interiors in top-to-bottom and/or left-to-right order: ## ## 3) Define BINDINGS: ## ## - bind - on the listbox widget - calls proc 'direction_select' ## and various other bindings. ## - See the BINDINGS section for all the bindings. ## ## 4) Define PROCS: ## ## - 'show_hide_options' - To pack (or 'pack forget') the '.fRopts'. ## Called by a button1-release binding on the ## 'ShowOptions' checkbutton. ## ## - 'get_img_filename' - To get the image filename. ## Called by the 'Browse...' button. ## ## - 'add_image' - To put an image on the canvas. ## Called by a button1-release or Return-key binding on the ## image filename entry field. ## ## - 'set_font' - To set a font to use for the text lines on the canvas. ## Called by the 'Font' button. ## ## - 'get_text_lines_width_height' - To set the width and height of the text message ## in characters and pixels. ## Called by the 'animate' proc. ## ## - 'clear' - To remove all objects from the canvas (text & img). ## Called by the 'Clear' button. ## ## - 'direction_select' - To get the direction of text-movement on the canvas. ## Called by a button1-release binding on the ## listbox widget. ## ## - 'animate' - To move the text across the canvas. ## Called by a button1-release binding on the ## 'Start' radiobutton. ## ## - 'set_text_color' - To set the color for creating the text-lines. ## Called by the 'TextColor' button. ## ## - 'set_background_color' - To set the background (canvas) color. ## Called by the 'BkgdColor' button. ## ## - 'update_color_button' - to set the background and foreground colors ## of a color button. ## Called by the 'set_*_color' procs. ## ## - 'advise_user' - To put messages in the '.fRmsg' frame. ## Called in the 'animate' proc and maybe elsewhere. ## ## - 'popup_msg_var_scroll' - To show the text of the HELPtext variable in a ## popup window. ## Called by the 'Help' button. ## ## 5) Additional GUI initialization: ## - set an initial canvas color ## - set a color and font to use for the next text-line placed on canvas ## - initialize the 2 entry areas (for movable-text and background image) ## - put a message in the '.fRmsg' frame to tell the user how ## to proceed. (Set the text etc. and click 'Start' to animate.) ## ##+####################################################################### ## 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 2016apr08 Got animation going. But needed ## to improve text display at the ## top-bottom-sides of the canvas. ## Changed by: Blaise Montandon 2016jul31 Restarted development. ##+####################################################################### ##+####################################################################### ## Set general window parms (titles,position). ##+####################################################################### wm title . "tkMovingText" wm iconname . "MovingText" wm geometry . +15+30 ##+###################################################### ## Set the color scheme for the window and its widgets --- ## such as entry field background color. ##+###################################################### tk_setPalette "#e0e0e0" set chkbuttBKGD "#f0f0f0" set radbuttBKGD "#f0f0f0" set entryBKGD "#ffffff" set textBKGD "#ffffff" set listboxBKGD "#ffffff" ##+######################################################## ## We use a VARIABLE-WIDTH font for text on label and ## button widgets. ## ## We use a FIXED-WIDTH font for text in entry & listbox widgets ## and for the text in a text widget, such as help text. ##+######################################################## font create fontTEMP_varwidth \ -family {comic sans ms} \ -size -14 \ -weight bold \ -slant roman font create fontTEMP_SMALL_varwidth \ -family {comic sans ms} \ -size -10 \ -weight bold \ -slant roman ## Some other possible (similar) variable width fonts: ## Arial ## Bitstream Vera Sans ## DejaVu Sans ## Droid Sans ## FreeSans ## Liberation Sans ## Nimbus Sans L ## Trebuchet MS ## Verdana font create fontTEMP_fixedwidth \ -family {liberation mono} \ -size -14 \ -weight bold \ -slant roman font create fontTEMP_SMALL_fixedwidth \ -family {liberation mono} \ -size -10 \ -weight bold \ -slant roman ## Some other possible fixed width fonts (esp. on Linux): ## Andale Mono ## Bitstream Vera Sans Mono ## Courier 10 Pitch ## DejaVu Sans Mono ## Droid Sans Mono ## FreeMono ## Nimbus Mono L ## TlwgMono ##+########################################################### ## SET GEOM VARS FOR THE VARIOUS WIDGET DEFINITIONS. ## (e.g. padding for Buttons ; border-width of various widgets ; ## relief for radiobuttons ; width and height of canvas) ##+########################################################### ## BUTTON widget geom settings: set PADXpx_button 0 set PADYpx_button 0 set BDwidthPx_button 2 set RELIEF_button "raised" ## LABEL widget geom settings: set PADXpx_label 0 set PADYpx_label 0 set BDwidthPx_label 2 # set RELIEF_label "flat" set RELIEF_label "ridge" ## CHECKBUTTON widget geom settings: set PADXpx_chkbutt 0 set PADYpx_chkbutt 0 set BDwidthPx_chkbutt 2 set RELIEF_chkbutt "ridge" ## RADIOBUTTON widget geom settings: set PADXpx_radbutt 0 set PADYpx_radbutt 0 set BDwidthPx_radbutt 2 set RELIEF_radbutt "ridge" ## ENTRY widget geom settings: set BDwidthPx_entry 2 set initImgfileEntryWidthChars 20 ## TEXT geom parameters: set BDwidthPx_text 2 set RELIEF_text "raised" ## LISTBOX geom settings: set BDwidthPx_listbox 2 set RELIEF_listbox "raised" # set initListboxWidthChars 30 # set initListboxHeightChars 8 ## SCALE geom parameters: set BDwidthPx_scale 2 set scaleLengthPx 200 set scaleThicknessPx 10 set scaleRepeatDelayMillisecs 200 ## CANVAS geom settings: set initCanWidthPx 300 set initCanHeightPx 300 set minCanWidthPx 24 set minCanHeightPx 24 # set BDwidthPx_canvas 2 set BDwidthPx_canvas 0 set RELIEF_canvas "raised" ##+######################################################################## ## 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 '.fRbuttons' frame: set aRtext(buttonEXIT) "Exit" set aRtext(buttonHELP) "Help" set aRtext(buttonFONT) "Font" set aRtext(buttonCLEAR) "Clear" set aRtext(buttonCOLORBKGD) "Backgd Color" set aRtext(buttonCOLORTEXT) "Text Color" set aRtext(chkbuttOPTIONS) " Show Options" set aRtext(labelANIMATE) " Animate:" set aRtext(radbuttSTART) "Start" set aRtext(radbuttSTOP) "Stop" ## For top of '.fRfile' frame: set aRtext(labelFILENAME) "Background-Image filename:" set aRtext(buttonBROWSE) "Browse..." ## For top of '.fRtextarea' frame: set aRtext(labelENTERTEXT) "ENTER TEXT LINE(S) HERE:" ## For top of '.fRcontrols1' frame: set aRtext(labelWAITTIME) "Speed control (millisecs-wait):" set aRtext(labelDIRECTION) "Direction of movement:" ## For some messages to user: set aRtext(OPTSmsg) \ "** Click 'Start' after entering/changing text - and optionally choose ** a font, image-background, colors, and direction of movement. Click 'Show Options' to hide or show the options lines below." set aRtext(STARTmsg) \ "** Click on the 'Start' button to start the animation. **" set aRtext(STARTSTOPmsg) \ "** Started animation. Click 'Stop' to halt the processing (and change options). **" set aRtext(PUTIMGmsg) \ "**** Press the Enter key (or 'right-click' on the filename) \ to put the image on the canvas. ****" set aRtext(CLEARclickSTARTmsg) \ "** Click 'Start' to start the animation. Reload the image, if wanted. **" set aRtext(CLEARclickSTOPmsg) \ "** Click 'Stop' to halt the processing. Reload the image, if wanted. **" ## END OF if { "$VARlocale" == "en" ##+####################################################################### ## Set a MINSIZE of the window (roughly). ## ## For width, allow for the minwidth of the '.fRbuttons' frame: ## about 7 buttons (Exit,Help,Font,Clear,BkgndColor,TextColor), ## and a label with start-and-stop radiobuttons. ## ## For height, allow for ## 2 chars high for the '.fRbuttons' frame ## 3 chars high for the '.fRmsg' frame ## 3 chars high for the '.fRopts.fRtextarea' frame ## 1 char high for the '.fRopts.fRfile' frame ## 2 chars high for the '.fRopts.fRcontrols1' frame ## about 24 pixels high for the '.fRcanvas' frame. ##+####################################################################### set minWinWidthPx [font measure fontTEMP_varwidth \ "Exit Help Font Clear Color Color X Show Options Animate: Start Stop"] ## Add some pixels to account for right-left-side window decoration ## (about 8 pixels), about 9 x 4 pixels/widget for borders/padding for ## 9 widgets. set minWinWidthPx [expr {44 + $minWinWidthPx}] ## MIN HEIGHT --- ## 2 chars high for the '.fRbuttons' frame ## 3 chars high for the '.fRmsg' frame ## 3 chars high for the '.fRopts.fRtextarea' frame ## 1 char high for the '.fRopts.fRfile' frame ## 2 chars high for the '.fRopts.fRcontrols1' frame ## about 24 pixels high for the '.fRcanvas' frame. set charHeightPx [font metrics fontTEMP_fixedwidth -linespace] set minWinHeightPx [expr {24 + (11 * $charHeightPx)}] ## Add about 28 pixels for top-bottom window decoration, ## about 6x4 pixels for each of the 6 stacked frames and their ## widgets (their borders/padding). set minWinHeightPx [expr {$minWinHeightPx + 52}] ## FOR TESTING: # puts "minWinWidthPx = $minWinWidthPx" # puts "minWinHeightPx = $minWinHeightPx" wm minsize . $minWinWidthPx $minWinHeightPx ## We allow the window to be resizable and we pack the canvas with ## '-fill both' so that the canvas can be enlarged by enlarging the ## window. ## 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' '.fRopts' '.fRcanvas' ## ## Sub-frames: '.fRopts.fRfile' '.fRopts.fRtextarea' ## '.fRopts.fRcontrols1' ##+################################################################ ## 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 } ## TOP FRAMES: frame .fRbuttons -relief $RELIEF_frame -bd $BDwidthPx_frame # frame .fRmsg -relief $RELIEF_frame -bd $BDwidthPx_frame frame .fRmsg -relief raised -bd 2 frame .fRopts -relief $RELIEF_frame -bd $BDwidthPx_frame frame .fRcanvas -relief raised -bd 2 ## SUB-FRAMES: frame .fRopts.fRfile -relief $RELIEF_frame -bd $BDwidthPx_frame frame .fRopts.fRtextarea -relief $RELIEF_frame -bd $BDwidthPx_frame frame .fRopts.fRcontrols1 -relief $RELIEF_frame -bd $BDwidthPx_frame # frame .fRopts.fRcontrols1 -relief raised -bd 2 ##+############################################ ## PACK the TOP FRAMES (and subframes). ## NOTE: We can experiment with the order ## in which the frames & subframes are stacked. ##+############################################ pack .fRbuttons \ -side top \ -anchor nw \ -fill none \ -expand 0 pack .fRmsg \ -side top \ -anchor nw \ -fill x \ -expand 1 ## WE DO NOT PACK the '.fRopts' frame here. ## We pack (and 'pack forget') when the 'Options' ## checkbutton is set on (or off) --- by a call ## to the proc 'show_hide_options'. ## ## NOTE: We did however DEFINE the '.fRopts' frame, ## above --- so that the following subframes of the ## '.fRopts' frame can be defined below. # pack .fRopts \ # -side top \ # -anchor nw \ # -fill x \ # -expand 1 pack .fRcanvas \ -side top \ -anchor nw \ -fill both \ -expand 1 ## Pack the SUB-frames. pack .fRopts.fRtextarea \ -side top \ -anchor nw \ -fill x \ -expand 1 pack .fRopts.fRfile \ -side top \ -anchor nw \ -fill x \ -expand 1 pack .fRopts.fRcontrols1 \ -side top \ -anchor nw \ -fill x \ -expand 1 ##+######################################### ## OK, frames are defined. ## Now start defining-and-packing widgets. ##+######################################### ##+######################################### ## In FRAME '.fRbuttons' - ## DEFINE about 7 'BUTTON' WIDGETS and a LABEL ## widget and 2 RADIOBUTTON widgets. ## Then PACK them. ##+######################################### button .fRbuttons.buttEXIT \ -text "$aRtext(buttonEXIT)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief $RELIEF_button \ -bd $BDwidthPx_button \ -command {exit} button .fRbuttons.buttHELP \ -text "$aRtext(buttonHELP)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief $RELIEF_button \ -bd $BDwidthPx_button \ -command {popup_msg_var_scroll "$HELPtext"} button .fRbuttons.buttFONT \ -text "$aRtext(buttonFONT)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief $RELIEF_button \ -bd $BDwidthPx_button \ -command {set_font} button .fRbuttons.buttCLEAR \ -text "$aRtext(buttonCLEAR)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief $RELIEF_button \ -bd $BDwidthPx_button \ -command {clear} button .fRbuttons.buttCOLORBKGD \ -text "$aRtext(buttonCOLORBKGD)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief $RELIEF_button \ -bd $BDwidthPx_button \ -command "set_background_color" button .fRbuttons.buttCOLORTEXT \ -text "$aRtext(buttonCOLORTEXT)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief $RELIEF_button \ -bd $BDwidthPx_button \ -command "set_text_color" ## The checkbutton var 'VARshowOpts0or1' will be set in the ## GUI-init section at the bottom of this script. ## # set VARshowOpts0or1 0 checkbutton .fRbuttons.chkbuttOPTIONS \ -text "$aRtext(chkbuttOPTIONS)" \ -font fontTEMP_varwidth \ -variable VARshowOpts0or1 \ -padx $PADXpx_chkbutt \ -pady $PADYpx_chkbutt \ -relief $RELIEF_chkbutt \ -bd $BDwidthPx_chkbutt \ -selectcolor "$chkbuttBKGD" label .fRbuttons.labelANIMATE \ -text "$aRtext(labelANIMATE)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief $RELIEF_label \ -bd $BDwidthPx_label set VARstartORstop "stop" radiobutton .fRbuttons.radbuttSTART \ -text "$aRtext(radbuttSTART)" \ -font fontTEMP_varwidth \ -anchor w \ -variable VARstartORstop \ -value "start" \ -selectcolor "$radbuttBKGD" \ -relief $RELIEF_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRbuttons.radbuttSTOP \ -text "$aRtext(radbuttSTOP)" \ -font fontTEMP_varwidth \ -anchor w \ -variable VARstartORstop \ -value "stop" \ -selectcolor "$radbuttBKGD" \ -relief $RELIEF_radbutt \ -bd $BDwidthPx_radbutt ## Pack ALL the widgets in frame 'fRbuttons'. pack .fRbuttons.buttEXIT \ .fRbuttons.buttHELP \ .fRbuttons.buttFONT \ .fRbuttons.buttCLEAR \ .fRbuttons.buttCOLORBKGD \ .fRbuttons.buttCOLORTEXT \ .fRbuttons.chkbuttOPTIONS \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRbuttons.labelANIMATE \ .fRbuttons.radbuttSTART \ .fRbuttons.radbuttSTOP \ -side left \ -anchor w \ -fill x \ -expand 0 ##+######################################### ## In FRAME '.fRmsg' - ## DEFINE a LABEL widget. Then PACK it. ##+######################################### label .fRmsg.labelMSG \ -text "" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief $RELIEF_label \ -bd $BDwidthPx_label ## Pack ALL the widgets in frame 'fRmsg'. pack .fRmsg.labelMSG \ -side left \ -anchor w \ -fill x \ -expand 1 ##+######################################## ## In FRAME '.fRopts.fRfile' - ## DEFINE 3 widgets - LABEL, ENTRY, BUTTON. ## Then PACK them. ##+######################################## label .fRopts.fRfile.labelFILE \ -text "$aRtext(labelFILENAME)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief $RELIEF_label \ -bd $BDwidthPx_label ## We initialize this widget var (and others) ## in the GUI initialization section at the ## bottom of this script. ## # set ENTRYfilename "" entry .fRopts.fRfile.entFILENAME \ -textvariable ENTRYfilename \ -bg $entryBKGD \ -font fontTEMP_fixedwidth \ -width $initImgfileEntryWidthChars \ -relief sunken \ -bd $BDwidthPx_entry button .fRopts.fRfile.buttBROWSE \ -text "$aRtext(buttonBROWSE)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief $RELIEF_button \ -bd $BDwidthPx_button \ -command {get_img_filename} ## Pack ALL the widgets in frame '.fRopts.fRfile'. pack .fRopts.fRfile.labelFILE \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRopts.fRfile.entFILENAME \ -side left \ -anchor w \ -fill x \ -expand 1 pack .fRopts.fRfile.buttBROWSE \ -side left \ -anchor w \ -fill none \ -expand 0 ##+################################################### ## In FRAME '.fRopts.fRtextarea' - ## DEFINE 1 LABEL and 1 TEXT widget (with scrollbars). ## Then PACK them. ##+################################################### label .fRopts.fRtextarea.labelENTERTEXT \ -text "$aRtext(labelENTERTEXT)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief $RELIEF_label \ -bd $BDwidthPx_label text .fRopts.fRtextarea.textLINES \ -height 2 \ -width 18 \ -wrap none \ -font fontTEMPT_fixedwidth \ -relief $RELIEF_text \ -borderwidth $BDwidthPx_text \ -yscrollcommand ".fRopts.fRtextarea.scrbary set" \ -xscrollcommand ".fRopts.fRtextarea.scrbarx set" scrollbar .fRopts.fRtextarea.scrbary \ -orient vertical -command ".fRopts.fRtextarea.textLINES yview" scrollbar .fRopts.fRtextarea.scrbarx \ -orient horizontal -command ".fRopts.fRtextarea.textLINES xview" ## Pack ALL the widgets in frame '.fRopts.fRtextarea'. pack .fRopts.fRtextarea.labelENTERTEXT \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRopts.fRtextarea.scrbary \ -side right \ -anchor center \ -fill y \ -expand 0 pack .fRopts.fRtextarea.scrbarx \ -side bottom \ -anchor center \ -fill x \ -expand 0 pack .fRopts.fRtextarea.textLINES \ -side top \ -anchor n \ -fill both \ -expand 1 ##+################################################### ## In FRAME '.fRopts.fRcontrols1' - ## DEFINE a LABEL and a SCALE widget ## and a LABEL and a LISTBOX widget (with scrollbars) ## Then PACK them. ##+################################################### label .fRopts.fRcontrols1.labelWAITTIME \ -text "$aRtext(labelWAITTIME)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief $RELIEF_label \ -bd $BDwidthPx_label ## Set this widget var in the GUI initialization section ## at the bottom of this script. # set VARwaittime 100 scale .fRopts.fRcontrols1.scaleWAITTIME \ -from 0 -to 1000 \ -resolution 1 \ -bigincrement 10 \ -repeatdelay $scaleRepeatDelayMillisecs \ -length $scaleLengthPx \ -font fontTEMP_varwidth \ -variable VARwaittime \ -showvalue true \ -orient horizontal \ -bd $BDwidthPx_scale \ -width $scaleThicknessPx label .fRopts.fRcontrols1.labelDIRECTION \ -text "$aRtext(labelDIRECTION)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief $RELIEF_label \ -bd $BDwidthPx_label listbox .fRopts.fRcontrols1.listbox \ -width 20 \ -height 2 \ -font fontTEMP_fixedwidth \ -relief $RELIEF_listbox \ -borderwidth $BDwidthPx_listbox \ -state normal \ -yscrollcommand ".fRopts.fRcontrols1.scrbary set" \ -xscrollcommand ".fRopts.fRcontrols1.scrbarx set" \ scrollbar .fRopts.fRcontrols1.scrbary \ -orient vertical -command ".fRopts.fRcontrols1.listbox yview" scrollbar .fRopts.fRcontrols1.scrbarx \ -orient horizontal -command ".fRopts.fRcontrols1.listbox xview" ## Pack ALL the widgets in frame '.fRopts.fRcontrols1'. pack .fRopts.fRcontrols1.labelWAITTIME \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRopts.fRcontrols1.scaleWAITTIME \ -side left \ -anchor w \ -fill x \ -expand 0 pack .fRopts.fRcontrols1.labelDIRECTION \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRopts.fRcontrols1.scrbary \ -side right \ -anchor e \ -fill y \ -expand 0 pack .fRopts.fRcontrols1.scrbarx \ -side bottom \ -anchor sw \ -fill x \ -expand 0 pack .fRopts.fRcontrols1.listbox \ -side left \ -anchor nw \ -fill both \ -expand 1 ##+################################################### ## In FRAME '.fRcanvas' - ## DEFINE a CANVAS widget with x,y scrollbar widgets. ## Then PACK them. ##+################################################### ## We set '-highlightthickness' and '-borderwidth' to ## zero, to avoid covering some of the viewable area ## of the canvas, as suggested on page 558 of the 4th ## edition of 'Practical Programming with Tcl and Tk'. ##+################################################### canvas .fRcanvas.can \ -width $initCanWidthPx \ -height $initCanHeightPx \ -relief $RELIEF_canvas \ -highlightthickness 0 \ -borderwidth 0 \ -yscrollcommand ".fRcanvas.scrolly set" \ -xscrollcommand ".fRcanvas.scrollx set" scrollbar .fRcanvas.scrolly \ -orient vertical \ -command ".fRcanvas.can yview" scrollbar .fRcanvas.scrollx \ -orient horizontal \ -command ".fRcanvas.can xview" ## Pack ALL the '.fRcanvas' widgets (scrollbars and canvas). ## NOTE: ## GOOD TO PACK THE SCROLLBARS BEFORE THE CANVAS WIDGET. ## THE CANVAS WIDGET MAY TRY TO TAKE ALL THE FRAME SPACE. pack .fRcanvas.scrolly \ -side right \ -anchor e \ -fill y \ -expand 0 ## DO NOT USE '-expand 1' FOR Y-SCROLLBAR. IT ALLOWS Y-SCROLLBAR ## TO X-EXPAND. IT PUTS BLANK SPACE BETWEEN Y-SCROLLBAR & CANVAS. pack .fRcanvas.scrollx \ -side bottom \ -anchor s \ -fill x \ -expand 0 ## DO NOT USE '-expand 1' FOR X-SCROLLBAR. IT ALLOWS X-SCROLLBAR ## TO Y-EXPAND. IT KEEPS THE CANVAS FROM Y-EXPANDING. pack .fRcanvas.can \ -side top \ -anchor nw \ -fill both \ -expand 1 ##+################################################## ## END OF DEFINITION of the GUI widgets. ##+################################################## ## Start of BINDINGS, PROCS, Added-GUI-INIT sections. ##+################################################## ##+####################################################################### ##+####################################################################### ## BINDINGS SECTION: ## - a button1-release binding on the 'ShowOptions' checkbutton. ## - a button1-release binding on the 'Start' radiobutton. ## - a button1-release and Return-key bindings on the IMAGE-FILENAME entry field. ## - a button1-release binding on the MOVEMENT-DIRECTION listbox. ##+####################################################################### ## For the 'ShowOptions' checkbutton: bind .fRbuttons.chkbuttOPTIONS {show_hide_options} ## For the 'Start' radiobutton: bind .fRbuttons.radbuttSTART { animate } ## For filename-entry-field: bind .fRopts.fRfile.entFILENAME { add_image } bind .fRopts.fRfile.entFILENAME { add_image } ## For text-lines text area widget: ## ## COMMENTED. Instead, we use a 'get' in the 'animate' proc ## in case the user does not use the Return-key or utton1-release ## after entering text in the text widget. # bind .fRopts.fRtextarea.textLINES { set TEXTlines [.fRopts.fRtextarea.textLINES get 1.0 end] } # bind .fRopts.fRtextarea.textLINES { set TEXTlines [.fRopts.fRtextarea.textLINES get 1.0 end] } ## For direction-listbox select: bind .fRopts.fRcontrols1.listbox { direction_select } ##+############################################################################# ##+############################################################################# ## DEFINE PROCS SECTION: ## ## - 'show_hide_options' - To pack (or 'pack forget') the '.fRopts'. ## Called by a button1-release binding on the ## 'ShowOptions' checkbutton. ## ## - 'get_img_filename' - To get the image filename. ## Called by the Browse button. ## ## - 'add_image' - To add an image and update counts. ## Called by a button1-release binding on the ## image filename entry field. ## ## - 'set_font' - To set a font to use for the text lines on the canvas. ## Called by the 'Font' button. ## ## - 'get_text_lines_width_height' - To set the width and height of the text message ## in characters and pixels. ## Called by the 'animate' proc. ## ## - 'clear' - To remove all objects from the canvas (text & img). ## Called by the 'Clear' button. ## ## - 'direction_select' - To get the type of text-movement on the canvas. ## Called by a button1-release binding on the ## listbox widget. ## ## - 'animate' - To move the text across the canvas. ## Called by a button1-release binding on the ## 'Start' radiobutton. ## ## - 'set_text_color' - To set the color for creating the text-lines. ## Called by the 'TextColor' button. ## ## - 'set_background_color' - To set the background (canvas) color. ## Called by the 'BkgdColor' button. ## ## - 'update_color_button' - To set the background and foreground colors ## of a color button. ## Called by the 'set_*_color' procs. ## ## - 'advise_user' - To put messages in the '.fRmsg' frame. ## Called in the 'animate' proc and maybe elsewhere. ## ## - 'popup_msg_var_scroll' - To show the text of the HELPtext variable in a ## popup window. ## Called by the 'Help' button. ## ##+############################################################################ ##+######################################################################### ## PROC 'show_hide_options' ##+######################################################################### ## PURPOSE: To show or hide the '.fRopts' frame. ## ## CALLED BY: a button1-release binding on the 'ShowOptions' checkbutton. ##+######################################################################### proc show_hide_options {} { global VARshowOpts0or1 if {$VARshowOpts0or1 == 1} { pack forget .fRcanvas pack .fRopts \ -side top \ -anchor nw \ -fill x \ -expand 0 pack .fRcanvas \ -side top \ -anchor nw \ -fill both \ -expand 1 } if {$VARshowOpts0or1 == 0} { pack forget .fRopts } } ## END OF PROC 'show_hide_options' ##+######################################################################### ## PROC 'get_img_filename' ##+######################################################################### ## PURPOSE: To get the name of an image file (GIF/PNG) and put the ## filename into global var 'ENTRYfilename'. ## ## CALLED BY: the '-command' option of the 'Browse ...' button. ##+######################################################################### proc get_img_filename {} { global ENTRYfilename env curDIR imgID aRtext ## Provide the user a way to select an image file. set fName [tk_getOpenFile -parent . \ -title "Select GIF/PNG file to load" \ -initialdir "$curDIR" ] ## FOR TESTING: # puts "fName : $fName" ## Load the ENTRYfilename and curDIR variables. if {[file exists $fName]} { set ENTRYfilename "$fName" set curDIR [ file dirname "$ENTRYfilename" ] .fRopts.fRfile.entFILENAME xview end } ## END OF if {[file exists $fName]} advise_user "$aRtext(PUTIMGmsg)" } ## END OF PROC 'get_img_filename' ##+################################################################## ## PROC 'add_image' ##+################################################################## ## PURPOSE: Puts an image on the canvas (in the upper left corner) ## based on the image filename currently in the ## image-filename-entry-field. ## ## CALLED BY: two bindings on the image-filename-entry-field --- ## one binding for Return-key and one for button1-release. ##+################################################################## proc add_image {} { global ENTRYfilename imgID aRtext ## Remove a previously created image, if any, from memory. catch { image delete imgID } ## Create a new in-memory image from the current filename. set imgID [image create photo -file "$ENTRYfilename"] ## Reset the canvas size to VARimgsize (formerly the image size). set imgWidthPx [image width $imgID] set imgHeightPx [image height $imgID] .fRcanvas.can configure -width $imgWidthPx -height $imgHeightPx ## Put the image on the canvas --- anchoring the top-left ## corner of the image to the top-left corner of the canvas. .fRcanvas.can create image 0 0 -anchor nw -image $imgID -tag TAGimg advise_user "$aRtext(STARTmsg)" } ## END OF PROC 'add_image' ##+##################################################################### ## PROC 'set_font' ##+##################################################################### ## PURPOSE: This procedure is invoked to get a font to ## use for the next text-line that is created on the canvas. ## ## The FE Font Selector GUI is used to return the ## 6-components of a font specification. ## ## ARGUMENTS: none ## ## OUTPUT: in global var 'curFONTspecs' ## (and in font-name 'fontTEMP_text'?) ## ## CALLED BY: .fRbuttons.buttFONT button ##+##################################################################### ## Initialize the global curFONTspecs var. ## We do this in the GUI-init section at the bottom of this script. ## # set curFONTspecs [ font actual fontTEMP_varwidth ] proc set_font {} { global curFONTspecs FontSelectorScript fontSELECTED ## FOR TESTING: # puts "set_font > curFONTspecs: $curFONTspecs" ## Start up a version of the FE font selector GUI with ## the current font specs passed as the default. Put the ## font specs that the user chooses in 'newFONTspecs'. set newFONTspecs [ exec $FontSelectorScript $curFONTspecs ] if { "$newFONTspecs" == ""} { return } ## FOR TESTING: # puts "newFONTspecs: $newFONTspecs" if { "$newFONTspecs" == "" } { return } ## Save the chosen font specs for the next default. set curFONTspecs "$newFONTspecs" ## Create a Tk fontname from the specs. font delete fontSELECTED eval font create fontSELECTED $newFONTspecs } ## END OF PROC 'set_font' ##+##################################################################### ## PROC 'get_text_lines_width_height' ##+##################################################################### ## PURPOSE: For the text-lines in the TEXTlines global variable, ## 1) max-height --- in characters and pixels ## 2) mas-width --- in characters and pixels. ## ## CALLED BY: the 'animate' proc ##+##################################################################### proc get_text_lines_width_height {} { ## INPUT: global fontSELECTED ## OUTPUT: global TEXTlines TEXTwidthChars TEXTheightChars TEXTwidthPx TEXTheightPx ######################################################### ## Fetch the text lines from the text widget. ## Removed the last nul line with {end -1c} as seen on ## page http://wiki.tcl.tk/10720 'weeEdit' by D. McClamrock. ######################################################### # set TEXTlines [.fRopts.fRtextarea.textLINES get 1.0 end] set TEXTlines [.fRopts.fRtextarea.textLINES get 1.0 {end -1c}] ################################################# ## To get TEXTheightChars, ## split at '\n' (newlines) and count 'lines'. ################################################# set TEMPlist [ split $TEXTlines "\n" ] ## FOR TESTING: # puts "TEMPlist: $TEMPlist" set TEXTheightChars [ llength $TEMPlist ] ## FOR TESTING: # puts "TEXTheightChars: $TEXTheightChars" ###################################################### ## To get TEXTheightPx, get height of 1 char in pixels, ## then multiply by number of lines. ###################################################### set curCharHeightPx [font metrics fontSELECTED -linespace] set TEXTheightPx [expr {$TEXTheightChars * $curCharHeightPx}] ################################################# ## To get TEXTwidthChars, ## loop through the 'lines' getting length ## of each; save max. ################################################# set TEXTwidthChars 0 ############################################# ## LOOK AT EACH LINE IN THE LIST. ############################################# foreach line $TEMPlist { ############################################# ## Get the length of the line. ############################################# set tempLINEwidth [ string length [string trim $line] ] if { $tempLINEwidth > $TEXTwidthChars } { set TEXTwidthChars $tempLINEwidth set TEXTwidthPx [font measure fontSELECTED "$line"] } } ## END OF foreach line $TEMPlist ## FOR TESTING: # puts "TEXTwidthChars: $TEXTwidthChars" ################################################################### ## ALTERNATIVE (cruder) WAY TO GET THE max-text-width-pixels: ## ## To get TEXTwidthPx, get (average) width of 1 char in pixels, ## then multiply by number of chars in the line with the most chars. ################################################################### # set curCharWidthPx [font measure fontSELECTED "w"] # set TEXTwidthPx [expr {$TEXTwidthChars * $curCharWidthPx}] ## FOR TESTING: if {0} { puts "" puts "proc 'get_text_lines_width_height':" puts "TEXTlines:" puts "$TEXTlines" puts "TEMPlist:" puts "$TEMPlist" puts "TEXTwidthChars: $TEXTwidthChars" puts "TEXTwidthPx: $TEXTwidthPx" puts "TEXTheightChars: $TEXTheightChars" puts "TEXTheightPx: $TEXTheightPx" puts "" } } ## END OF proc 'get_text_lines_width_height' ##+##################################################################### ## PROC 'clear' ##+##################################################################### ## PURPOSE: Removes all objects (text-lines and background image) ## from the canvas. ## ## ARGUMENTS: none ## ## CALLED BY: a 'Clear' button. ##+##################################################################### proc clear {} { global VARstartORstop aRtext .fRcanvas.can delete all if {"$VARstartORstop" == "stop"} { advise_user "$aRtext(CLEARclickSTARTmsg)" } else { advise_user "$aRtext(CLEARclickSTOPmsg)" } } ## END OF proc 'clear' ##+##################################################################### ## PROC 'direction_select' ##+##################################################################### ## PURPOSE: To get the type of text-movement on the canvas --- ## bottom-to-top, right-to-left, or whatever. ## ## CALLED BY: a button1-release binding on the listbox widget. ##+##################################################################### proc direction_select {} { ## FOR TESTING: (to dummy out this proc) # return global SELdirection set sel_index [ .fRopts.fRcontrols1.listbox curselection ] # puts "sel_index: $sel_index" if { "$sel_index" != "" } { set SELdirection [ .fRopts.fRcontrols1.listbox get $sel_index ] } ## FOR TESTING: # puts "direction_select: SELdirection = $SELdirection" return } ## END OF proc 'direction_select' ##+##################################################################### ## PROC 'animate' ##+##################################################################### ## PURPOSE: Moves the text across the canvas, in a direction selected ## by the listbox of the GUI. ## ## Stops the animation according to the value of the ## VARstartORstop variable which can be set to "stop" ## by the STOP radiobutton. ## ## CALLED BY: a 'Start' button. ##+##################################################################### proc animate {} { ## FOR TESTING: (to dummy out this proc) # return global VARstartORstop VARshowOpts0or1 XmaxPx YmaxPx SELdirection TEXTlines \ TEXTwidthChars TEXTheightChars TEXTwidthPx TEXTheightPx \ VARwaittime curFONTspecs fontSELECTED imgID aRtext \ COLORBKGDr COLORBKGDg COLORBKGDb COLORBKGDhex \ COLORTEXTr COLORTEXTg COLORTEXTb COLORTEXThex ## Set the current time, for determining and displaying ## elapsed time. NOT USED, yet. # set t0 [clock milliseconds] ## Display a starting-animation message to the user. advise_user "$aRtext(STARTSTOPmsg)" ######################################################### ## Put the text-lines from the text widget into variable ## TEXTlines. ## Set four size variables for the (max) text size --- ## in characters and pixels. ######################################################### get_text_lines_width_height ####################################################### ## Hide the options. This removes many distractions ## from the canvas animation. ####################################################### set VARshowOpts0or1 0 show_hide_options ####################################################### ## If an image was loaded to the canvas, let the image ## determine the size of the (scrollable) canvas area. ####################################################### if {[info exists imgID]} { ######################################################## ## Set the 'scrollregion' of the canvas according to the ## VARimgsizePx variable (formerly to the size of the image). ## (A simple 'update' does not work.) ######################################################## set imgWidthPx [image width $imgID] set imgHeightPx [image height $imgID] .fRcanvas.can configure -scrollregion "0 0 $imgWidthPx $imgHeightPx" .fRcanvas.can configure -width $imgWidthPx -height $imgHeightPx ## FOR TESTING: if {0} { puts "" puts "'animate' proc -- after setting canvas-size to image-size:" puts "imgWidthPx: $imgWidthPx" puts "imgHeightPx: $imgHeightPx" puts "" } } ## END OF if {[info exists imgID]} ############################################################# ## We use a 'wm geometry . {}' command to get the window (and ## the canvas widget) to resize appropriately --- 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 . {} ## This update is needed to get the proper canvas ## width and height below. update ######################################################### ## Get the current canvas width and height. ######################################################### set curCanWidthPx [winfo width .fRcanvas.can] set curCanHeightPx [winfo height .fRcanvas.can] ## This does not give the scrollregion size. It gives the ## screensize --- 1024x600 on a netbook. # set curCanWidthPx [winfo screenwidth .fRcanvas.can] # set curCanHeightPx [winfo screenheight .fRcanvas.can] #################################################################### ## Initialize the text-location variables Xpx,Ypx, and ## ANCHORside to start the text on an edge of the canvas/image area. ## ANCHORside tells which side of the text attaches to point Xpx,Ypx. #################################################################### set halfCanWidthPx [expr {int($curCanWidthPx / 2)}] set halfCanHeightPx [expr {int($curCanHeightPx / 2)}] ## FOR TESTING: if {0} { puts "" puts "'animate' proc -- after current canvas-size query:" puts "curCanWidthPx: $curCanWidthPx" puts "curCanHeightPx: $curCanHeightPx" puts "halfCanWidthPx: $halfCanWidthPx" puts "halfCanHeightPx: $halfCanHeightPx" puts "" } if {"$SELdirection" == "bottom-to-top"} { ## Start top-of-text (north-side) at the bottom of the canvas. set Xpx $halfCanWidthPx set Ypx $curCanHeightPx set ANCHORside n } elseif {"$SELdirection" == "top-to-bottom"} { ## Start bottom-of-text (south-side) at the top of the canvas. set Xpx $halfCanWidthPx set Ypx 0 set ANCHORside s } elseif {"$SELdirection" == "right-to-left"} { ## Start left-of-text (west-side) at the right of the canvas. set Xpx $curCanWidthPx set Ypx $halfCanHeightPx set ANCHORside w } elseif {"$SELdirection" == "left-to-right"} { ## Start right-of-text (east-side) at the left of the canvas. set Xpx 0 set Ypx $halfCanHeightPx set ANCHORside e } ######################################################### ## 'while' LOOP to move the text, until STOP is signalled. ######################################################### while {true} { ####################################################### ## Remove the text line(s) from the canvas. ####################################################### .fRcanvas.can delete TAGtext ####################################################### ## Increment the pixel location of the text. ####################################################### if {"$SELdirection" == "bottom-to-top"} { set Ypx [expr {$Ypx - 1}] ## In this case, Ypx is the location of top-of-text. ## When bottom of text goes past the top of the canvas, ## reset Ypx back to the bottom of the canvas. ## This happens when Ypx < -TEXTheightPx ## or when Ypx + TEXTheightPx < 0. if {[expr {$Ypx + $TEXTheightPx}] < 0} { set Ypx $curCanHeightPx } # if {[expr {$Ypx + $TEXTheightPx}] < 0} { set Ypx [expr {$curCanHeightPx + $TEXTheightPx}] } } elseif {"$SELdirection" == "top-to-bottom"} { set Ypx [expr {$Ypx + 1}] ## In this case, Ypx is the location of bottom-of-text. ## When top of text goes below the bottom of the canvas, ## reset Ypx back to the top of the canvas. ## This happens when Ypx > curCanHeightPx + TEXTheightPx ## or when Ypx - (curCanHeightPx + TEXTheightPx) > 0. if {[expr {$Ypx - ($curCanHeightPx + $TEXTheightPx)}] > 0} { set Ypx 0 } # if {[expr {$Ypx - ($curCanHeightPx + $TEXTheightPx)}] > $TEXTheightPx} { set Ypx 0 } } elseif {"$SELdirection" == "right-to-left"} { set Xpx [expr {$Xpx - 1}] ## In this case, Xpx is the location of left-of-text. ## When right of text goes past the left of the canvas, ## reset Xpx back to the right of the canvas. ## This happens when Xpx < -TEXTwidthPx ## or when Xpx + TEXTwidthPx < 0. if {[expr {$Xpx + $TEXTwidthPx}] < 0} { set Xpx $curCanWidthPx } } elseif {"$SELdirection" == "left-to-right"} { set Xpx [expr {$Xpx + 1}] ## In this case, Xpx is the location of right-of-text. ## When left of text goes past the right of the canvas, ## reset Xpx back to the left of the canvas. ## This happens when Xpx - TEXTwidthPx > curCanWidthPx ## or when Xpx - (TEXTwidthPx + curCanWidthPx) > 0. if {[expr { $Xpx - ($TEXTwidthPx + $curCanWidthPx)}] > 0} { set Xpx 0 } } ## FOR TESTING: if {0} { puts "" puts "animate:" puts "Xpx: $Xpx Ypx: $Ypx" puts "ANCHORside: $ANCHORside" puts "tempLINEWIDTHpx: $tempLINEWIDTHpx" puts "COLORTEXThex: $COLORTEXThex" puts "" } ####################################################### ## Put the text line(s) in a new position on the canvas. ####################################################### # .fRcanvas.can create text $Xpx $Ypx -anchor $ANCHORside \ # -fill $COLORTEXThex -font "$curFONTspecs" \ # -text "$TEXTlines" -tag TAGtext .fRcanvas.can create text $Xpx $Ypx -anchor $ANCHORside \ -fill $COLORTEXThex -font fontSELECTED \ -text "$TEXTlines" -tag TAGtext ############################################################### ## Update the window to cause the text-line(s) to be displayed. ############################################################### update ####################################################### ## Check if the user has asked to STOP the animation. ## If so, break out of the while loop. ####################################################### if {"$VARstartORstop" == "stop"} { advise_user "$aRtext(OPTSmsg)" set VARshowOpts0or1 1 show_hide_options break } ####################################################### ## Pause the amount indicated by the scale widget. ####################################################### after $VARwaittime } ## END of the 'while' loop that moves the text line(s) } ## END OF proc 'animate' ##+##################################################################### ## PROC 'set_background_color' ##+##################################################################### ## PURPOSE: This procedure is invoked to get an RGB triplet ## via 3 RGB slider bars on the FE Color Selector GUI. ## ## Uses that RGB value to set the color of the canvas --- ## on which all the objects (text-lines & images) lie. ## ## INPUT and ## OUTPUT: in global vars COLORBKGDr COLORBKGDg COLORBKGDb COLORBKGDhex ## ## 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 the color of the canvas. .fRcanvas.can config -bg $COLORBKGDhex ## Update the colors of the background-color button. update_color_button "bkgd" } ## END OF PROC 'set_background_color' ##+##################################################################### ## PROC 'set_text_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 a 'fill' color for the ## next text-line created on the canvas. ## ## ARGUMENTS: none ## ## OUTPUT: in global vars COLORTEXTr COLORTEXTg COLORTEXTb COLORTEXThex ## ## CALLED BY: .fRbuttons.buttCOLORTEXT button ##+##################################################################### proc set_text_color {} { global COLORTEXTr COLORTEXTg COLORTEXTb COLORTEXThex ColorSelectorScript ## FOR TESTING: # puts "COLORTEXTr: $COLORTEXTr" # puts "COLORTEXTg: $COLORTEXTg" # puts "COLORTEXTb: $COLORTEXTb" set TEMPrgb [ exec $ColorSelectorScript $COLORTEXTr $COLORTEXTg $COLORTEXTb] ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" if { "$TEMPrgb" == "" } { return } scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB set COLORTEXThex "#$hexRGB" set COLORTEXTr $r255 set COLORTEXTg $g255 set COLORTEXTb $b255 ## Update the colors of the text-color button. update_color_button "text" } ## END OF PROC 'set_text_color' ##+##################################################################### ## PROC 'update_color_button' ##+##################################################################### ## PURPOSE: ## This procedure is invoked to set the background color of the ## color button, indicated by the 'colorID' string, ## to its currently set 'colorID' color --- and sets ## foreground color, for text on the button, to a suitable black or ## white color, so that the label text is readable. ## ## Arguments: global color vars ## ## CALLED BY: in three 'set_*_color*' procs ## and in the additional-GUI-initialization section at ## the bottom of this script. ##+##################################################################### proc update_color_button {colorID} { global COLORBKGDr COLORBKGDg COLORBKGDb COLORBKGDhex global COLORTEXTr COLORTEXTg COLORTEXTb COLORTEXThex # set colorBREAK 300 set colorBREAK 350 if {"$colorID" == "bkgd"} { .fRbuttons.buttCOLORBKGD configure -bg $COLORBKGDhex set sumCOLOR [expr {$COLORBKGDr + $COLORBKGDg + $COLORBKGDb}] if {$sumCOLOR > $colorBREAK} { .fRbuttons.buttCOLORBKGD configure -fg "#000000" } else { .fRbuttons.buttCOLORBKGD configure -fg "#ffffff" } } elseif {"$colorID" == "text"} { .fRbuttons.buttCOLORTEXT configure -bg $COLORTEXThex set sumCOLOR [expr {$COLORTEXTr + $COLORTEXTg + $COLORTEXTb}] if {$sumCOLOR > $colorBREAK} { .fRbuttons.buttCOLORTEXT configure -fg "#000000" } else { .fRbuttons.buttCOLORTEXT configure -fg "#ffffff" } } else { ## Seems to be an invalid colorID. return } } ## END OF PROC 'update_color_button' ##+##################################################################### ## PROC 'advise_user' ##+##################################################################### ## PURPOSE: Puts a message for the user on a message line of the GUI. ## ## CALLED BY: in the 'Additional GUI Initialization' section at the ## bottom of this script. Also in some procs like the ## 'animate' proc. ##+##################################################################### proc advise_user {text} { .fRmsg.labelMSG configure -text "$text" } ## END OF proc 'advise_user' ##+######################################################################## ## PROC 'popup_msg_var_scroll' ##+######################################################################## ## PURPOSE: Report help or error conditions to the user. ## 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_msg_var_scroll { VARtext } { ## 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 .topmsg} toplevel .topmsg # wm geometry .topmsg 600x400+100+50 wm geometry .topmsg +100+50 wm title .topmsg "Note" # wm title .topmsg "Note to $env(USER)" wm iconname .topmsg "Note" ##################################### ## DEFINE & PACK TEXT WIDGET. ##################################### text .topmsg.text \ -wrap none \ -font fontTEMP_varwidth \ -width $VARwidth \ -height $VARheight \ -bg "#f0f0f0" \ -relief raised \ -bd 2 \ -yscrollcommand ".topmsg.scrolly set" \ -xscrollcommand ".topmsg.scrollx set" scrollbar .topmsg.scrolly \ -orient vertical \ -command ".topmsg.text yview" scrollbar .topmsg.scrollx \ -orient horizontal \ -command ".topmsg.text xview" ## Pack the scrollbars BEFORE the text widget, ## so that the text does not monopolize the space. pack .topmsg.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 .topmsg.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 .topmsg.text \ -side top \ -anchor center \ -fill both \ -expand 1 ##################################### ## DEFINE & PACK OK BUTTON WIDGET. ##################################### button .topmsg.butt \ -text "OK" \ -command "destroy .topmsg" pack .topmsg.butt \ -side bottom \ -anchor center \ -fill none \ -expand 0 ##################################### ## LOAD MSG INTO TEXT WIDGET. ##################################### ## .topmsg.text delete 1.0 end .topmsg.text insert end $VARtext .topmsg.text configure -state disabled } ## END OF PROC 'popup_msg_var_scroll' ##+######################## ## END of PROC definitions. ##+######################## set HELPtext "\ \ \ \ \ \ ** HELP for the 'tkMovingText' utility ** This Tk GUI script provides a GUI for creating 'moving text' using a user-selected FONT for the text-lines placed on a an image area --- a rectangular Tk 'canvas' widget. ********************** TYPICAL USE OF THE GUI: ********************** Here are typical steps to consider in using this GUI: 1) SET THE TEXT: Check the text in a scrollable 'text-entry' area on the GUI. Change the text to what you want. Although only 2 lines are showing, you can keep entering more lines by pressing the Enter/Return key at the end of each line. The text area will scroll down so that you can keep entering lines of text. 2) SET THE BACKGROUND: The GUI provides a Background-Image Filename 'entry' widget and a 'Browse...' button so that the user can, optionally, select an IMAGE FILENAME --- to place an image as a background on the canvas. The file can be a GIF for a Tcl-Tk 8.5 (or older) 'wish' interpreter. The file can be a PNG or GIF for Tcl-Tk 8.6 or after. To load the image onto the background of the image area, after you select (or enter) a filename, press the Enter/Return key (or 'right-click' the mouse) in the entry field. If you do not want to use a background image, there is a 'Background Color' button which can be used to set a background color of the canvas. Similarly, you can change the color of the text by using the 'Text Color' button. A click on either Color button brings up an RGB color-selector GUI by which to set a different color. 3) SET THE TEXT-MOVEMENT DIRECTION: A small listbox below the filename entry field provides the capability for the user to specify a direction of text movement --- bottom-to-top, top-to-bottom, right-to-left, left-to-right. The listbox shows 2 of these options, but you can scroll down the listbox to show the other direction options. 4) SET THE SPEED: A scale widget below the filename entry field provides the capability of the user to control the speed at which the text moves across the canvas. This is actually a WAIT-TIME (in millisecs) between text moves --- one pixel at a time. 5) SET THE FONT: The 'Font' button on the GUI can be used to choose a font for the text. 6) START ANIMATION: After the options above are set as desired, the user can click on the 'Start' radiobutton to start the animation. Click on 'Stop' to stop the animation. ************** FONT SELECTION: ************** This GUI calls on a separate FONT-SELECTOR GUI to set the FONT FOR THE TEXT-LINES to be placed on the canvas. The font-selector GUI facilitates the selection of a set of Tcl-Tk FONT SPECIFICATION VALUES (6 of them): - font-family - font-size (pixels or points ; negative or positive integers, resp.) - font-weight: bold or normal - font-slant: roman (erect) or italic - underscore: off or on - overstrike: off or on ************** OTHER CONTROLS: ************** After an animation is stopped, you can click on the 'Clear' button to clear the text-line(s) and background image from the canvas. Then you can 'right-click' on the filename in the entry field, to (re)load the image from the image file to the canvas --- if you want to do another animation with the background image. --- Some options can be changed while the animation is in progress. For example, the 'Font' or 'BackgroundColor' or 'TextColor' button can be used to change the font or a color. The animation is paused as the font-selector or color-selector GUI is used to change the font or color. The animation proceeds when the selector window is closed. During an animation, the 'Show Options' checkbutton can be used to show the options. The speed-control 'scale' widget can be used to speed-up or slow-down the text movement. You can click on either side of the slider-button to advance the slider one millisec per click. For example, slide it all the way to the left, to zero. Then click on the right of the slider-button to increase the wait-time one millisec per click. **************** CAPTURING IMAGES: **************** To capture any single image of the text on the canvas, the user can use a screen/window capture utility (such as 'gnome-screenshot' on Linux) to capture the image in an image file format, such as PNG. An image editor (such as 'mtpaint' on Linux) can be used to 'crop' the captured image if necessary --- and can be used to apply processing options such as 'gamma' or 'brightness' correction or whatever. --- A 'WriteAniGIF' or 'WriteMovie' button may, eventually, be provided on the GUI, by which to capture the moving-text images in an animated-GIF file or a movie file. " ##+###################################################### ##+###################################################### ## Additional GUI INITIALIZATION: ## (for APPLICATION-SPECIFIC initialization; i.e. for ## app or widget VARIABLES --- NOT widget PARAMETERS ## like button padding or '-relief' settings.) ##+###################################################### ##+###################################################### ##+##################################################### ## Set the full-name of the RGB COLOR-selector Tk script ## that may be used in procs above. ##+##################################################### ## FOR TESTING: # puts "argv0: $argv0" set DIRthisScript "[file dirname $argv0]" set DIRupOne "[file dirname "$DIRthisScript"]" set DIRupTwo "[file dirname "$DIRupOne"]" set ColorSelectorScript "$DIRupTwo/Selectors/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" ##+##################################################### ## Set the full-name of the FONT-selector Tk script ## that may be used in procs above. ##+##################################################### set FontSelectorScript "$DIRupTwo/Selectors/tkFONTselector/select_tkFont_standAlone.tk" ## Alternatively: Put the FONT-selector Tk script in the ## same directory as this Tk script and uncomment the following. set FontSelectorScript "$DIRthisScript/select_tkFont_standAlone.tk" ##+##################################################### ## Initialize some entry fields that are shown ## on the GUI and set via the GUI. ##+##################################################### set ENTRYfilename "" .fRopts.fRtextarea.textLINES delete 1.0 end .fRopts.fRtextarea.textLINES insert end "This is a test." ##+##################################################### ## Set an initial directory for the 'Browse...' feature. ## And keep track of last-used directory in $curDIR. ##+##################################################### # set curDIR "$env(HOME)" ## FOR TESTING: set curDIR "pwd" ##+############################################################### ## Initialize the color variables --- for text and background. ## ## (To avoid overpowering the user's eyes with a white background, ## we start with background=black and text=white.) ##+############################################################### # set COLORBKGDr 60 # set COLORBKGDg 60 # set COLORBKGDb 60 set COLORBKGDr 0 set COLORBKGDg 0 set COLORBKGDb 0 set COLORBKGDhex \ [format "#%02X%02X%02X" $COLORBKGDr $COLORBKGDg $COLORBKGDb] update_color_button "bkgd" set COLORTEXTr 255 set COLORTEXTg 255 set COLORTEXTb 255 # set COLORTEXTr 255 # set COLORTEXTg 255 # set COLORTEXTb 0 set COLORTEXThex [format "#%02X%02X%02X" $COLORTEXTr $COLORTEXTg $COLORTEXTb] update_color_button "text" ##+########################################### ## Set the background color of the canvas. ##+########################################### .fRcanvas.can configure -bg $COLORBKGDhex ##+########################################################## ## Initialize var 'curFONTspecs', used by the 'set_font' proc. ## 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] ## Create a Tk fontname from the specs. if {0} { font create fontSELECTED \ -family {Liberation Mono} \ -size -34 \ -weight bold \ -slant roman \ -underline 0 \ -overstrike 0 } else { eval font create fontSELECTED $curFONTspecs } ##+########################################################## ## Set a cursor for the canvas. ## ## Some crosshair-type cursors: ## crosshair,plus,tcross,cross,cross_reverse,diamond_cross, ## Some empty-center-type cursors: ## circle,heart,star,icon,target,box_spiral,dotbox,draped_box,rtl_logo ## Some 'specialty' cursors: ## spraycan,watch,dot,fleur,exchange,hand2,man,pencil,pirate,sizing,xterm ##+########################################################## .fRcanvas.can configure -cursor crosshair ##+########################################################## ## Initialize the 'ShowOptions' checkbutton. ## To hide the options frames, use {1} in place of {0}. ##+########################################################## if {0} { ## Hide the options. set VARshowOpts0or1 0 } else { ## Show the options. set VARshowOpts0or1 1 } show_hide_options ##+########################################################## ## Initialize the 'VARwaittime' scale variable. ##+########################################################## # set VARwaittime 0 set VARwaittime 20 ##+################################################### ## LOAD the directions listbox. ##+################################################### .fRopts.fRcontrols1.listbox delete 0 end .fRopts.fRcontrols1.listbox insert end "bottom-to-top" .fRopts.fRcontrols1.listbox insert end "top-to-bottom" .fRopts.fRcontrols1.listbox insert end "right-to-left" .fRopts.fRcontrols1.listbox insert end "left-to-right" ##+########################################################## ## Initialize the SELdirection variable. ##+########################################################## set SELdirection "bottom-to-top" .fRopts.fRcontrols1.listbox selection set 0 ##+########################################################## ## Set some background colors for message line, ## text entry area, and movement-direction-listbox. ##+########################################################## .fRmsg.labelMSG configure -bg "#ff9966" .fRopts.fRtextarea.textLINES configure -bg "#9966ff" .fRopts.fRcontrols1.listbox configure -bg "#99ff99" .fRopts.fRcontrols1.listbox configure -selectbackground "#f0f0f0" ##+########################################################## ## Advise user on what to do initially. ##+########################################################## advise_user "$aRtext(OPTSmsg)"