SCREENSHOT OF THE GUIOn the basis of those goals, I ended up with the GUI seen in the following image.
(A '#' in column 1 of the line makes the line a comment line
--- for example, to allow for indicating comics for which
retrieval has not been implemented, and reminding the user
to keep looking for a method to retrieve those comics.)Step 2:Date fields (year,month,day) provide the user a way to select a specific comic to retrieve --- if a web site supports retrieval by date.
(If some sites offer a different way, from year-month-day,
of identifying individual comics, this code could
activate a different widget --- or widgets --- by which
to specify a comic --- according to the site selected
by the user.
In that case, 'comic selection widgets' on the GUI may have
to be activated/deactivated according to the site selected.)The '<' and '>' buttons on either side of the Day entry field facilitate quickly scanning through cartoons of a given site, by successive days.You can skip to a different year or month by simply entering a new number in the Year or Month entry fields.Step 3:After each date is set, click on the 'Retrieve' button to display the corresponding comic.The 'Retrieve' button causes a series of Tcl 'http' commands to be issued, commands such as - http::config
- http::geturl
- http::data
- http::cleanupto get the comic file (GIF) data and display it in the canvas.---Error/Warning Popups:Occasionally, at a comic archive site, there may not be a comic for a specified date. In that case, you may see an error message popup in a window. Simply dismiss the window and try another date.Also, if your network connection is not active, you will get a popup that reminds you that you need to establish your internet connection.The codeBelow, I provide the Tk script code for this 'get-comics' utility.I follow my usual 'canonical' structure for Tk code for this Tk script:
0) Set general window & widget parms (win-name, win-position,
win-color-scheme, fonts-for-widgets, widget-geometry-parms,
text-array-for-labels-etc, win-size-control).
1a) Define ALL frames (and sub-frames, if any).
1b) Pack ALL frames and sub-frames.
2) Define & pack all widgets in the frames, frame by frame.
Within each frame, define ALL the widgets.
Then pack the widgets.
3) Define keyboard and mouse/touchpad/touch-sensitive-screen action
BINDINGS, if needed.
4) Define PROCS, if needed.
5) Additional GUI initialization (typically with one or more of
the procs), if needed.This Tk coding structure is discussed in more detail on the page A Canonical Structure for Tk Code --- and variations.This structure makes it easy for me to find code sections --- while generating and testing a Tk script, and when looking for code snippets to include in other scripts (code re-use).I call your attention to step-zero. One thing that I started doing in 2013 is use of a text-array for text in labels, buttons, and other widgets in the GUI. This can make it easier for people to internationalize my scripts. I will be using a text-array like this in most of my scripts in the future.In this script, motivated by the many instances of popup messages in the code, I included message text in the text-array.Experimenting with the GUIAs in all my scripts that use the 'pack' geometry manager (which is all of my 100-plus scripts, so far), I provide the four main pack parameters --- '-side', '-anchor', '-fill', '-expand' --- on all of the 'pack' commands for the frames and widgets.That helps me when I am initially testing the behavior of a GUI (the various widgets within it) as I resize the main window.I think that I have used a pretty nice choice of the 'pack' parameters. The label and button and year-month-day entry widgets stay fixed in size and relative-location if the window is re-sized --- while the site entry widget expands/contracts horizontally whenever the window is re-sized horizontally.Also, the WIDTH of the 'listbox' stays FIXED, while the 'canvas' can expand horizontally (as well as vertically) --- allowing more room for the canvas (that is, large comics) if the user expands the window.You can experiment with the '-side', '-anchor', '-fill', and '-expand' parameters on the 'pack' commands for the various frames and widgets --- to get the widget behavior that you want.___Additional experimentation: You might want to change the fonts used for the various GUI widgets. For example, you could change '-weight' from 'bold' to 'normal' --- or '-slant' from 'roman' to 'italic'. Or change font families.In fact, you may NEED to change the font families, because the families I used may not be available on your computer --- and the default font that the 'wish' interpreter chooses may not be very pleasing.I use variables to set geometry parameters of widgets --- parameters such as border-widths and padding. And I have included the '-relief' parameter on the definitions of frames and widgets. Feel free to experiment with those 'appearance' parameters as well.If you find the gray 'palette' of the GUI is not to your liking, you can change the value of the RGB parameter supplied to the 'tk_setPalette' command near the top of the code.
Some features in the codeThat said, here's the code --- with plenty of comments to describe what most of the code-sections are doing.You can look at the top of the PROCS section of the code to see a list of the procs used in this script, along with brief descriptions of how they are called and what they do.The main procs are
'get_site_selectedInListbox' - called via a button1-release binding on
the listbox widget.
'Retrieve' - called by the 'Retrieve' button.The following procs are called by the 'Retrieve' proc, depending on which site(/comic-strip) was selected from the listbox widget.
'get_babyblues_comic'
'get_bizzaro_comic'
'get_dilbert_comic'
'get_doonesbury_comic'
'get_rhymeswithorange_comic'
'get_speedbump_comic'
'get_zits_comic'And there are the following 'utility' procs.
'show_image_forPicURL' - called by the 'get_*_comic' procs.
(To avoid repeating code that is common
to all the procs --- after the URL of the
image file has been determined.)
'save_image_toLocalFile' - called via the 'SaveAsGIF' button.
'date_increment' - called via the '>' button
'date_decrement' - called via the '<' button
'popup_msgVarWithScroll' - called via the 'Help' button --- and
used for warning/error messages.---The 'http' package routineshttp::config http::geturl http::data http::cleanupare used in the 'get_*_comic' procs and the 'show_image_forPicURL' proc.
It is my hope that the copious comments in the code will help Tcl-Tk coding 'newbies' get started in making GUI's like this.Without the comments, potential young Tcler's might be tempted to return to their iPhones and iPads and iPods --- to watch videos of Daniel Tosh providing people who have posted videos on the internet the opportunity for 'web redemption'.
Code for Tk script 'get_comics.tk' :
#!/usr/bin/wish -f
##
## SCRIPT: get_comics.tk
##
## PURPOSE: This Tk script offers a GUI on which the user can
## - choose a comics site (such as dilbert.com OR
## gocomics.com/doonesbury/)
## and
## - use buttons and other widgets on the GUI to retrieve
## one comic at a time from the site.
##
## A particular comic at a site is selected by a date (or some other
## type of 'index'), where the date (or other index) is user-selected
## via widgets on the GUI.
##
## A Tk 'canvas' widget on the GUI is used to display the comic
## --- if it is a GIF (or PNG) file.
##
## (If the site stores the comics in another format, such as
## JPEG-JFIF, this code could run an 'external' utility such as
## ImageMagick 'convert' to convert the retrieved file
## to a GIF file --- and display that file.)
##
## A 'SaveAsGIF' button on the GUI offers the user the option to
## save the comic as a file on the user's local computer storage.
##
## (This code automatically puts the file in the /tmp directory,
## from which the user can transfer the file to another directory.
## The temporary directory location can be changed by changing
## the setting of the 'DIRtemp' variable in this code.)
##
##+###################
## METHOD OF OPERATION:
##
## A 'listbox' on the GUI offers a list of comic sites from
## which to choose.
##
## Date fields (year,month,day) provide the user a way to
## select a specific comic to retrieve --- if a web site
## supports retrieval by date.
##
## (If some sites offer a different way of identifying
## the cartoons, this code may activate a different
## widget --- or widgets --- by which to specify a comic
## --- depending on the site selected by the user.)
##
## A 'Retrieve' button causes a series of Tcl 'http' commands
## to be issued, commands such as
## - http::config
## - http::geturl
## - http::data
## - http::cleanup
##
## These commands are issued in a 'get_*_comic' proc. For
## each web site, there is a 'get_*_comic' proc tailored
## to the requirements of getting the available comics
## from the user-selected web site.
##
## A 'package require http' statement is used to determine
## whether the Tcl 'http' package is available.
##
##+##############
## THE GUI LAYOUT:
##
## -------------------------------------------------------------------------------
## GetComics - from some comics archive web sites
## [window title]
## -------------------------------------------------------------------------------
## {Exit} {Help} Comic site: _____________________ [This is a disabled entry widget.]
## Year: ____ Month: __ Day: __ {Retrieve} {SaveAsFile} Image size:
## _____________________________ _____________________________________________________
## | Baby Blues @ babyblues.comA | A
## | Bizarro @ bizarrocomics.co| | |
## | Dilbert @ dilbert.com # Di| | |
## | Doonsebury @ gocomics.com/| | |
## | Rhymes With Orange @ rhyme| | Canvas area in which |
## | Speed Bump @ gocomics.com/| | to display a |
## | Zits @ zitscomics.com # Zi| | retrieved comic. |
## | | | |
## | | | |
## | | | |
## | V | V
## <---------------------------> <--------------------------------------------------->
##
## In the 'text-sketch' of the GUI:
##
## - Square brackets indicate a comment (not to be shown on the GUI).
## - Braces indicate a Tk 'button' widget.
## - A colon with text to the left indicates a Tk 'label' widget.
## - Underscores indicate a Tk 'entry' widget.
## - Capital-O indicates a Tk 'radiobutton' widget (if any).
## - Capital-X indicates a Tk 'checkbutton' widget (if any).
## - A line (hyphens) with an 'arrow-head' at each end indicates a Tk 'scale' widget.
##
## - A combination of vertical-bar characters and underscore characters, that
## outline a rectangular shape, are used to indicate either a 'listbox' or
## a 'canvas' widget. 'Arrow-heads' at the right of the box shape indicate
## vertical scroll-bars there. 'Arrow-heads' at the bottom of the box shape
## indicate horizontal scroll-bars there.
##
## The scroll-bar 'arrow-heads' are drawn as follows:
##
## - an UP arrow-head is drawn with capital-A.
## - a DOWN arrow-head is drawn with capital-V.
## - a LEFT arrow-head is drawn with a less-than sign.
## - a RIGHT arrow-head is drawn with a greater-than sign.
##
## The left/right arrow-heads are joined by hyphens, rather than underscores.
##
##
## The year,month,day entry fields could be initialized with today's date
## --- or changed to a date suited to the user-selected web site.
##
## This GUI will contain about:
##
## 4 'button' widgets
## 5 'label' widgets (or more)
## 4 'entry' widgets
## 1 'listbox' widget (with scrollbars)
## 1 'canvas' widget (with scrollbars)
## 0 'scale' widgets
## 0 'radiobutton' widgets
## 0 'checkbutton' widgets
## 0 'text' widgets
##
##+######################################################################
## 'CANONICAL' STRUCTURE OF THIS CODE:
##
## 0) Set general window parms (win-name, win-position, win-color-scheme,
## fonts, widget-geometry-parms, text-array-for-labels-etc,
## win-size-control).
## 1a) Define ALL frames (and sub-frames, if any).
## 1b) Pack ALL the frames and sub-frames.
## 2) Define all widgets in the frames, frame by frame.
## When all widgets are defined for a frame, pack them.
##
## 3) Define keyboard 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),
## if needed.
##
## The code-structure detail for this particular script:
##
## 1a) Define ALL frames:
##
## Top-level : '.fRbuttons' '.fRoptions' '.fRbottom'
##
## Sub-frames: '.fRbottom.fRsites' and '.fRbottom.fRdisplay'
##
## 1b) Pack ALL frames.
##
## 2) Define all widgets in the frames (and pack them):
##
## - In '.fRbuttons' frame:
## 2 button widgets ('Exit','Help') and
## a label-and-entry widget pair (to display the currently
## selected comics site)
##
## - In '.fRoptions' frame:
## 3 label-and-entry widget pairs (for year, month, day) and
## 2 button widgets ('Retrieve' and 'SaveAsGIF')
##
## - In '.fRbottom.fRsites' frame:
## 1 listbox widget, with x-y scrollbars
##
## - In '.fRbottom.fRdisplay' frame:
## 1 canvas widget, with x-y scrollbars
##
## (The widgets in the '.fRoptions' frame could be
## packed/activated depending on the web site chosen
## by the user.)
##
## 3) Define BINDINGS:
## - a button1-release binding on the listbox
## (See the BINDINGS section to see if
## any other bindings were eventually defined.)
##
## 4) Define PROCS:
##
## 'get_site_selectedInListbox' - called via a button1-release binding on
## the listbox widget.
##
## 'Retrieve' - called by the 'Retrieve' button.
##
## The procs like the following are called by the 'Retrieve' proc, depending on
## which site(/comic-strip) was selected from the listbox widget.
##
## 'get_dilbert_comic'
## 'get_doonesbury_comic'
## 'get_rhymeswithorange_comic'
## 'get_speedbump_comic'
## 'get_zits_comic'
##
## Of course, other comic sites could be added to the listbox,
## along with adding a corresponding 'get' proc.
##
## NOTE: These procs will need to be changed as the sites change
## the way they store their comics.
##
## 'save_image_toLocalFile' - called via the 'SaveAsGIF' button.
##
## 'popup_msgVarWithScroll' - for a Help button --- and for warning/error
## messages.
##
## See the (top of the) PROCS section of the code for a more detailed list
## and description of the procs.
##
## 5) Additional GUI initialization:
##
## The 'DIRtemp' variable is set here. Change this 'set'
## statement to change where the image files will be created
## when the 'SaveAsGIF' button is used.
##
##+########################################################################
## 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 on Ubuntu 9.10.
##+#######################################################################
## MAINTENANCE HISTORY:
## Created by: Blaise Montandon 2014feb06 Started coding based on a 2013
## Tcl-Tk script by 's_m' at
## http://wiki.tcl.tk/8899.
## Got the GUI up, with dummied
## out procs.
## Changed by: Blaise Montandon 2014mar07 Added scrollbars to canvas.
## Started developing and testing
## the procs.
## Added '>' and '<' buttons.
## Changed by: Blaise Montandon 2014mar08 Added 'popupMSG' text items to
## the $aRtext array, for use in
## the 'get_*_comic' procs.
## Added var 'fileMIDNAME' for use
## in the proc for 'SaveAsGIF'.
## Changed by: Blaise Montandon 2014mar26 1) ADDED some comic strips -- Agnes,
## BabyBlues, Bizarro -- by
## adding some 'get_*_comic' procs
## and adding lines to the listbox.
## 2) PUT date-range checks in all the
## get-comic procs, and added date-range
## info on the lines in the listbox.
## 3) ADDED code to the 'show_image_forPicURL'
## proc to convert a nonGIF file (such as
## JPEG or PNG) to a GIF file before
## loading the image data into a Tk
## 'photo' image and displaying the
## image on the canvas.
## 4) ADDED proc 'popmsg_forFailedGetURL'
## to use at 'http::geturl' statements
## in the 'get_*_comic' procs.
## 5) ADDED 'http::ncode' 404 checks in
## the 'get_*_comic' procs.
## 6) CHANGED '>' and '<' buttons to
## '+' and '-' buttons.
##+#######################################################################
##+#######################################################################
## Set window parms --- WIN-TITLE and WIN-POSITION.
##+#######################################################################
wm title . "GetComics - from some comics archive web sites"
wm iconname . "tkGetComics"
wm geometry . +15+30
##+#########################################################
## Set the COLOR SCHEME (palette) for the window ---
## and some colors for its widgets --- such as scale widgets.
##+#########################################################
## gray
set R255pal 210
set G255pal 210
set B255pal 210
## sandy brown
# set R255pal 244
# set G255pal 164
# set B255pal 96
set hexCOLORpal [format "#%02X%02X%02X" $R255pal $G255pal $B255pal]
tk_setPalette "$hexCOLORpal"
set BKGD_listbox "#f0f0f0"
set BKGD_entry "#f0f0f0"
# set BKGD_radbutt "#f0f0f0"
##+########################################################
## SET 'FONT-NAMES'.
##
## We use a VARIABLE-WIDTH FONT for LABEL and BUTTON widgets
## --- and the numeric values shown by SCALE widgets.
##
## We generally use a FIXED-WIDTH FONT for the text in
## ENTRY and LISTBOX widgets.
##
## We MAY use a FIXED-WIDTH FONT for help text in a TEXT
## widget (so that any columns in the text stay lined up).
##+########################################################
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
## 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 and borderwidths for Buttons and Labels)
##+###########################################################
## For LABEL widgets:
set PADYpx_label 0
set PADXpx_label 0
# set BDwidthPx_label 0
set BDwidthPx_label 2
## For BUTTON widgets:
set PADXpx_button 0
set PADYpx_button 0
set BDwidthPx_button 2
## For the LISTBOX widget:
set initListboxWidthChars 25
set initListboxHeightChars 11
set BDwidthPx_listbox 2
## For ENTRY widgets:
set BDwidthPx_entry 2
## For TEXT widgets:
set BDwidthPx_text 2
## CANVAS widget geom settings:
set initCanWidthPx 300
set initCanHeightPx 100
# set BDwidthPx_canvas 2
set BDwidthPx_canvas 0
##+####################################################################
## Set a TEXT-ARRAY to hold text for buttons & labels on the GUI.
## NOTE: This can aid INTERNATIONALIZATION. This array can
## be set according to a nation/region/language parameter.
##+####################################################################
## if { "$VARlocale" == "en"}
## For 'fRbuttons' frame:
set aRtext(buttonEXIT) "Exit"
set aRtext(buttonHELP) "Help"
## We use leading spaces to provide left-padding,
## separating the SITE label from the HELP button.
set aRtext(labelSITE) " Comic Site:"
## For 'fRoptions' frame:
## We use leading spaces to provide left-padding,
## separating the YEAR label from the left side of the window.
set aRtext(labelYEAR) " Comic Year:"
set aRtext(labelMONTH) "Month:"
set aRtext(labelDAY) "Day:"
# set aRtext(buttDATEINCR) ">"
set aRtext(buttDATEINCR) "+"
# set aRtext(buttDATEDECR) "<"
set aRtext(buttDATEDECR) "-"
set aRtext(buttRETRIEVE) "Retrieve"
set aRtext(buttSAVE) "SaveAsGIF"
## For popup-msg in the 'show_image_forPicURL' proc:
set aRtext(popupMSGhttpData1) \
"The 'http::data' did not return GIF data. First 1000 chars are:"
set aRtext(popupMSGhttpData2) \
"*** NOT PUTTING A NEW PICTURE ON THE CANVAS! ***"
set aRtext(MSGconvert) \
"The ImageMagick 'convert' command failed on trying to make a GIF file from file"
## For popup-msgs in the 'get_*_comic' procs:
set aRtext(popupMSGhttpGeturl1) \
"The 'http::geturl' command failed on URL"
set aRtext(popupMSGhttpGeturl2) \
"*** IS YOUR NETWORK CONNECTION UP?? ***"
## For popup-msg in the 'save_image_toLocalFile' proc:
set aRtext(popupMSGsavedGIF1) \
"The GIF file was saved with filename:"
## For popup-msg in the 'save_image_toLocalFile' proc:
set aRtext(popupMSGhttpREQUIRE) \
"The 'http' package is not available."
## For popup-err-msgs:
set aRtext(popupMSGerrMsg) \
"Error message: "
## END OF if { "$VARlocale" == "en"}
##+########################################################
## Set a MINSIZE of the window (roughly) -- according to the
## approx max WIDTH of the buttons in the 'fRbuttons' frame
## --- and according to the approx HEIGHT of the 4 frames.
##+########################################################
set minWinWidthPx [font measure fontTEMP_varwidth \
" $aRtext(buttonEXIT) $aRtext(buttonHELP) $aRtext(labelSITE) \
___________________________________________"]
## Add some pixels to account for right-left-side window decoration
## (about 8 pixels), about 4 widgets x 4 pixels/widget for borders/padding.
set minWinWidthPx [expr {24 + $minWinWidthPx}]
## MIN HEIGHT --- allow at least
## 1 char high for the 'fRbuttons' frame
## 1 char high for the 'fRoptions' frame
## 7 chars high for the listbox in the 'fRbottom' frame
set charHeightPx [font metrics fontTEMP_varwidth -linespace]
set minWinHeightPx [expr {9 * $charHeightPx}]
## Add some pixels to account for top-bottom window decoration
## (about 28 pixels) and frame/widget padding vertically
## (about 4 pixels/frame x 3 frames).
set minWinHeightPx [expr {40 + $minWinHeightPx}]
## FOR TESTING:
# puts "minWinWidthPx = $minWinWidthPx"
# puts "minWinHeightPx = $minWinHeightPx"
wm minsize . $minWinWidthPx $minWinHeightPx
## We allow the window to be resizable and we pack the canvas
## (and listbox?) with '-fill both' so that the canvas (and listbox?)
## 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' '.fRoptions' '.fRbottom'
##
## Sub-frames: '.fRbottom.fRsites' and '.fRbottom.fRdisplay'
##+################################################################
## FOR TESTING of expansion of frames (esp. during window expansion):
# set RELIEF_frame raised
# set BDwidth_frame 2
set RELIEF_frame flat
set BDwidth_frame 0
frame .fRbuttons -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame .fRoptions -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame .fRbottom -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame .fRbottom.fRsites -relief $RELIEF_frame -borderwidth $BDwidth_frame
# frame .fRbottom.fRdisplay -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame .fRbottom.fRdisplay -relief raised -borderwidth 2
## Before packing these frames, we offer some options to turn
## off (or on) the minimization of parent windows.
# pack propagate . 0
# pack propagate .fRbottom 0
# pack propagate .fRbottom.fRdisplay 0
##+########################################
## PACK the top-level FRAMES, top to bottom.
## Allow the '.fRbottom' frame to expand.
##+########################################
pack .fRbuttons \
-side top \
-anchor nw \
-fill x \
-expand 0
pack .fRoptions \
-side top \
-anchor nw \
-fill none \
-expand 0
pack .fRbottom \
-side top \
-anchor nw \
-fill both \
-expand 1
##+####################################
## PACK the SUB-FRAMES, in '.fRbottom'
## --- left to right.
##+####################################
pack .fRbottom.fRsites \
-side left \
-anchor nw \
-fill y \
-expand 0
pack .fRbottom.fRdisplay \
-side left \
-anchor nw \
-fill both \
-expand 1
## NOTE: We want to make sure the canvas has
## plenty of room, esp. if the user expands the
## window horizontally.
##
## Hence we want the canvas to expand horizontally,
## but not the listbox. So we use '-fill y' for the
## pack parameter of the listbox, rather than '-fill both'.
## OK. ALL frames are defined and packed.
##
## READY TO DEFINE WIDGETS.
##+################################################################
##+################################################################
## START DEFINING & PACKING WIDGETS WITHIN THEIR FRAMES,
## frame-by-frame. When all widgets for a frame are defined,
## pack them in the frame.
##+################################################################
##+################################################################
##+################################################################
## IN THE '.fRbuttons' frame -
## DEFINE some BUTTONS (Exit,Help) and a LABEL-and-ENTRY
## widget pair.
##+################################################################
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"}
label .fRbuttons.labelSITE \
-text "$aRtext(labelSITE)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label
entry .fRbuttons.entrySITE \
-textvariable ENTRYsite \
-font fontTEMP_fixedwidth \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
# -width 20 \
.fRbuttons.entrySITE configure -state disabled
## Pack ALL the widgets in frame 'fRbuttons'.
pack .fRbuttons.buttEXIT \
.fRbuttons.buttHELP \
.fRbuttons.labelSITE \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRbuttons.entrySITE \
-side left \
-anchor w \
-fill x \
-expand 1
##+################################################################
## IN THE '.fRoptions' frame -
## DEFINE some LABEL-and-ENTRY widget pairs (for year,month,day)
## and some BUTTONS (Retrieve, SaveAsGIF).
##+################################################################
## YEAR:
label .fRoptions.labelYEAR \
-text "$aRtext(labelYEAR)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label
## Variable VARyear is initialized in the 'Additional GUI Initialization'
## section at the bottom of this script.
entry .fRoptions.entryYEAR \
-textvariable VARyear \
-font fontTEMP_fixedwidth \
-width 4 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## MONTH:
label .fRoptions.labelMONTH \
-text "$aRtext(labelMONTH)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label
## Variable VARmonth is initialized in the 'Additional GUI Initialization'
## section at the bottom of this script.
entry .fRoptions.entryMONTH \
-textvariable VARmonth \
-font fontTEMP_fixedwidth \
-width 2 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## DAY:
label .fRoptions.labelDAY \
-text "$aRtext(labelDAY)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label
## Variable VARday is initialized in the 'Additional GUI Initialization'
## section at the bottom of this script.
entry .fRoptions.entryDAY \
-textvariable VARday \
-font fontTEMP_fixedwidth \
-width 2 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## '+' and '-' (or '>' and '<') BUTTONS:
button .fRoptions.buttDATEINCR \
-text "$aRtext(buttDATEINCR)" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {date_increment}
button .fRoptions.buttDATEDECR \
-text "$aRtext(buttDATEDECR)" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {date_decrement}
## RETRIEVE & SAVE BUTTONS:
button .fRoptions.buttRETRIEVE \
-text "$aRtext(buttRETRIEVE)" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {Retrieve}
button .fRoptions.buttSAVE \
-text "$aRtext(buttSAVE)" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {save_image_toLocalFile}
## IMAGE SIZE label:
label .fRoptions.labelIMGSIZE \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label
## Pack ALL the widgets in frame 'fRoptions'.
pack .fRoptions.labelYEAR \
.fRoptions.entryYEAR \
.fRoptions.labelMONTH \
.fRoptions.entryMONTH \
.fRoptions.labelDAY \
.fRoptions.buttDATEDECR \
.fRoptions.entryDAY \
-side left \
-anchor w \
-fill none \
-expand 0
## Pack the day increment button with some right-padding
## --- to separate from the RETRIEVE & SAVE buttons.
pack .fRoptions.buttDATEINCR \
-side left \
-anchor w \
-fill none \
-expand 0 \
-padx {0 40}
pack .fRoptions.buttRETRIEVE \
.fRoptions.buttSAVE \
.fRoptions.labelIMGSIZE \
-side left \
-anchor w \
-fill none \
-expand 0
##+######################################################
## In FRAME '.fRbottom.fRsites' -
## DEFINE-and-PACK a LISTBOX widget,
## with scrollbars --- for a list of web sites.
##+######################################################
listbox .fRbottom.fRsites.listbox \
-width $initListboxWidthChars \
-height $initListboxHeightChars \
-font fontTEMP_fixedwidth \
-relief raised \
-borderwidth $BDwidthPx_listbox \
-state normal \
-yscrollcommand ".fRbottom.fRsites.scrbary set" \
-xscrollcommand ".fRbottom.fRsites.scrbarx set"
scrollbar .fRbottom.fRsites.scrbary \
-orient vertical \
-command ".fRbottom.fRsites.listbox yview"
scrollbar .fRbottom.fRsites.scrbarx \
-orient horizontal \
-command ".fRbottom.fRsites.listbox xview"
##+####################################################################
## NOTE:
## We INSERT LISTBOX LINES down in the PROCS section --- just above
## the 'Retrieve' proc that uses parts of the listbox lines to
## determine which 'get_*_comic' proc to call.
##+####################################
## Pack the listbox and its scrollbars.
##+####################################
pack .fRbottom.fRsites.scrbary \
-side right \
-anchor e \
-fill y \
-expand 0
pack .fRbottom.fRsites.scrbarx \
-side bottom \
-anchor s \
-fill x \
-expand 0
## We need to pack the listbox AFTER
## the scrollbars, to get the scrollbars
## positioned properly --- BEFORE
## the listbox FILLS the pack area.
pack .fRbottom.fRsites.listbox \
-side top \
-anchor nw \
-fill both \
-expand 1
##+######################################################
## In FRAME '.fRbottom.fRdisplay' -
## DEFINE-and-PACK a CANVAS WIDGET, on which to display
## images of comic files.
##
## We 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'.
##
## We provide x-y scrollbars on the canvas in case some
## of the comics are so large (horizontally or vertically)
## that they exceed the size of the monitor screen.
##+#######################################################
canvas .fRbottom.fRdisplay.can \
-width 300 \
-height 100 \
-relief flat \
-borderwidth 0 \
-highlightthickness 0 \
-yscrollcommand ".fRbottom.fRdisplay.scrolly set" \
-xscrollcommand ".fRbottom.fRdisplay.scrollx set"
## FOR TESTING:
# -relief raised \
# -borderwidth 2 \
## OTHERWISE:
# -relief flat \
# -borderwidth 0 \
## NOT NEEDED?
# -width $initCanWidthPx \
# -height $initCanHeightPx \
scrollbar .fRbottom.fRdisplay.scrolly \
-orient vertical \
-command ".fRbottom.fRdisplay.can yview"
scrollbar .fRbottom.fRdisplay.scrollx \
-orient horizontal \
-command ".fRbottom.fRdisplay.can xview"
##+#######################################################
## PACK the widgets in frame '.fRbottom.fRdisplay'.
##
## NOTE:
## NEED TO PACK THE SCROLLBARS BEFORE THE CANVAS WIDGET.
## OTHERWISE THE CANVAS WIDGET TAKES ALL THE FRAME SPACE.
##+#######################################################
pack .fRbottom.fRdisplay.scrolly \
-side right \
-anchor e \
-fill y \
-expand 0
pack .fRbottom.fRdisplay.scrollx \
-side bottom \
-anchor s \
-fill x \
-expand 0
## !!!NEED TO USE '-expand 0' FOR THE X AND Y SCROLLBARS, so that
## the canvas is allowed to fill the remaining frame-space nicely
## --- without a gap between the canvas and its scrollbars.
pack .fRbottom.fRdisplay.can \
-side left \
-anchor nw \
-fill both \
-expand 1
## Alternatives for packing the canvas:
# -side top \
# -anchor center \
##
# -side left \
# -anchor nw \
## Either one seems to work OK.
##+#####################################################################
## END OF THE DEFINE-and-PACK SECTIONS TO SETUP THE GUI.
## ALL FRAMES and WIDGETS are DEFINED-and-PACKED.
##
## We are now ready to define BINDINGS and PROCS, and do some
## additional initialization of the GUI.
##+#####################################################################
##+#######################################################################
## DEFINE BINDINGS SECTION, including:
## - button1-release on the listbox
##+#######################################################################
bind .fRbottom.fRsites.listbox <ButtonRelease-1> {get_site_selectedInListbox}
##+######################################################################
## DEFINE PROCS SECTION.
##
## Procs here include:
##
## 'get_site_selectedInListbox' - called via a button1-release binding on
## the listbox widget.
## Strips a site-ID out of the selected line
## and puts the site-ID into a (disabled)
## entry widget on the GUI, via the
## ENTRYsite variable --- to unequivocally
## show the currently selected site.
##
## 'Retrieve' - called by the 'Retrieve' button.
## To execute one of the following 'get_*_comic'
## procs, chosen according to the site-ID
## in the ENTRYsite variable.
##
## 'show_image_forPicURL' - called by the following 'get_*_comic' procs.
## For a given fully-qualified URL for a picture
## file (GIF or whatever), this proc loads the
## picture data into a Tk 'photo' image structure
## and places the image structure on the canvas.
##
## 'popmsg_forFailedGetURL' - called by the following 'get_*_comic' procs.
##
## 'get_month_name' - called by some 'get_*_comic' procs, like
## 'get_rhymeswithorange_comic'.
##
## Procs like the following are called by the 'Retrieve' proc, depending on
## which comic-strip-site (URL) was selected from the listbox widget.
##
## 'get_agnes_comic'
## 'get_babyblues-1996-2002_comic'
## 'get_bizarro-files_comic'
## 'get_dilbert_comic'
## 'get_doonesbury_comic'
## 'get_rhymeswithorange_comic'
## 'get_speedbump_comic'
## 'get_zits_comic'
##
## Of course, other comic sites could be added to the listbox,
## along with adding a corresponding 'get_*_comic' proc.
##
## These 'get' procs are used to find the appropriate picture file
## URL in order to fetch the image data from the site and load it
## into a Tk 'photo' image structure and put that photo-image
## on the Tk 'canvas' widget. Each site may require a unique
## way to determine the URL of the picture file, hence a separate
## 'get' proc for each web site.
##
## 'save_image_toLocalFile' - called via the 'SaveAsGIF' button.
## Writes the image data from the
## Tk 'photo' image structure to
## a file on the user's local storage.
##
## 'date_increment' - called via the '+' (or '>') button
## 'date_decrement' - called via the '-' (or '<') button
##
## 'popup_msgVarWithScroll' - called via the 'Help' button --- and
## used for warning/error messages.
##
## 'popup_msgVarWithScroll_wait' - for showing error messages, and not
## allowing further actions with the GUI.
## (NOT USED, yet)
##+########################################################################
##+#########################################################################
## PROC 'get_site_selectedInListbox'
##+#########################################################################
## PURPOSE: Puts a 'site-ID' from a selected line of the sites listbox
## into the entry widget text variable 'ENTRYsite'.
##
## CALLED BY: button1-release on the sites listbox
##
## See the listbox insert statements above (where the listbox widget was
## defined) for the web-site strings that were loaded in the listbox.
##+#########################################################################
proc get_site_selectedInListbox {} {
global ENTRYsite
## FOR TESTING: (to dummy out this proc)
# return
#################################################
## Get the (vertical) index of the line selected.
#################################################
set sel_index [ .fRbottom.fRsites.listbox curselection ]
#######################################################
## Put the first part of the line (before a # sign)
## into the ENTRYsite variable --- if the line does not
## start with a # sign in column 1 (a comment line).
#######################################################
if { $sel_index != "" } {
################################################
## Get the user-selected line from the listbox.
################################################
set SITEline [ .fRbottom.fRsites.listbox get $sel_index ]
###############################################################
## Bail out if the user selected a comment line in the listbox.
###############################################################
set FIRSTchar [string index "$SITEline" 0]
if { "$FIRSTchar" == "#" } {return}
##################################################################
## Get the website from the listbox line.
## The website is between the '@' and '#' characters.
## See the 'insert' code lines that insert lines into the listbox.
## Before '@' is a name of the comic and after '#' are comments.
##################################################################
## Split off the comment on the end of the listbox line.
set tempLIST [split $SITEline #]
set tempSTRING [lindex $tempLIST 0]
## tempSTRING holds the string before '#'. Split that string at '@'.
set tempLIST [split $tempSTRING @]
## Get the 2nd part of the list, the stuff after '@'.
set ENTRYsite [lindex $tempLIST 1]
set ENTRYsite [string trim $ENTRYsite]
} else {return}
## FOR TESTING:
# puts "proc 'get_site_selectedInListbox' > ENTRYsite: $ENTRYsite"
}
## END OF PROC 'get_site_selectedInListbox'
##+############################################################################
## INSERT WEB-SITE LISTBOX ENTRIES that hold web-site 'location indicators'
## --- each followed by a separator character (#) --- and
## preceded by the '@' character. Example:
##
## "Dilbert (1989+) @ dilbert.com/strips/ # Dilbert comics go back to about 1989"
##
## In front of '@' is a name of the comic.
## Between '@' and '#' is a web site URL.
## After '#' are comments.
##
## By adding a '#' at the 1st character of a line, we signal
## that retrieval of that comic is not implemented yet --- but it
## is being considered for addition at some future date.
##+############################################################################
## Make sure the listbox is empty.
.fRbottom.fRsites.listbox delete 0 end
## New WEB-SITES are to be added/activated here:
## AGNES:
.fRbottom.fRsites.listbox insert end \
"Agnes (2002+) @ www.gocomics.com/agnes/ # Agnes comics (2002-2014+) at www.gocomics.com/agnes/ \
go back to about 2002aug11."
## May attempt (someday) to retrieve about a year and a half more Agnes strips (2001-2002aug).
# .fRbottom.fRsites.listbox insert end \
# "Agnes (2001-2002) @ www.gocomics.com/Agnes/ # Agnes comics (2001-mid2002) at www.gocomics.com/Agnes/ are \
# available via directories of the form /2001-2-1/ to about /2002-8-1/."
## BABY BLUES:
# .fRbottom.fRsites.listbox insert end \
# "## For Baby Blues comics, a suitable archive site and retrieval method has not been found yet."
.fRbottom.fRsites.listbox insert end \
"BabyBlues (1996-2002) @ www.babyblues.com/images/ # BabyBlues comics (1996-2002) are in '.gif' files \
from about /images/1996/96mmdd.gif \
to about /images/2002/02mmdd.gif . \
Sunday comics end in 's.gif' instead of '.gif'."
## May attempt (someday) to retrieve the 2003-2014 BabyBlues strips.
# .fRbottom.fRsites.listbox insert end \
# "# BabyBlues comics from 2003 to 2014+ are stored at safr.kingfeatures.com/... BUT \
# not available yet via this utility."
.fRbottom.fRsites.listbox insert end \
"# BabyBlues comics from 2003 to 2014+ are not available yet via this utility."
## BIZARRO:
# .fRbottom.fRsites.listbox insert end \
# "## For Bizarro comics, a suitable archive site and retrieval method has not been found yet."
.fRbottom.fRsites.listbox insert end \
"Bizarro (2011+) @ bizarrocomics.com/files/ # Bizarro comics (in JPEG files) are in \
bizarrocomics.com/files/ from about 2013 thru 2014 and in bizarrocomics.com/files/upload/ \
from about 2011 thru 2012."
## May (someday) retrieve the Bizarro comics in '/files/uploads/' in a separate proc,
## if the combination of '/files/' and '/files/uploads/' above does no work out.
# .fRbottom.fRsites.listbox insert end \
# "Bizarro @ bizarrocomics.com/files/uploads/ # Bizarro (2011-2012) JPEG! comics at \
# bizarrocomics.com/files/uploads/ go from about \
# /2011/09/bz-panel-09-21-11.jpg to about \
# /2012/12/bz-panel-12-24-12.jpg"
## May attempt (someday) to retrieve (more) Bizarro comics from another site.
# .fRbottom.fRsites.listbox insert end \
# "Bizarro @ comicskingdom.com # Bizarro comics at comicskingdom.com go back to about ???"
## DILBERT:
.fRbottom.fRsites.listbox insert end \
"Dilbert (1989+) @ dilbert.com/strips/ # Dilbert comics go back to about 1989"
## DOONESBURY:
.fRbottom.fRsites.listbox insert end \
"Doonesbury (2004-2014) @ gocomics.com/doonesbury/ # Doonesbury comics at this site go \
from about 2004 to 2014. Doonesbury stopped creating new comics around 2014 March."
## RHYMES WITH ORANGE:
.fRbottom.fRsites.listbox insert end \
"Rhymes With Orange (1996+) @ rhymeswithorange.com # Rhymes With Orange comics at this site \
go back to 1996apr24."
## SPEED BUMP:
.fRbottom.fRsites.listbox insert end \
"Speed Bump (1999+) @ gocomics.com/speedbump/ # Speed Bump comics at this site go back to \
about 1999."
## ZITS:
.fRbottom.fRsites.listbox insert end \
"Zits (2005+) @ zitscomics.com # Zits comics at this site go back to about 2005jan01."
##+###############################################################
## Get the number of web-sites loaded into the listbox. We may use
## this variable to show users how many are in the listbox, some
## of which may be out of sight.
##+###############################################################
set numSites [.fRbottom.fRsites.listbox index end]
##+###############################################################
## Set the initial string in the site-entry field to be
## one of the above 'site strings'.
# set ENTRYsite ""
set ENTRYsite "dilbert.com/strips/"
##+#########################################################################
## PROC 'Retrieve'
##+#########################################################################
## PURPOSE: For a selected web-site 'location' in variable 'ENTRYsite',
## THIS PROC executes one of the 'get_*_comic' procs ---
## to retrieve
## a specified comic from the selected site (for a given 'index'
## such as VARyear, VARmonth, VARday) and display the comic
## on the Tk 'canvas' widget.
##
## THE VARIABLE 'ENTRYsite':
##
## The web-site 'location' in variable 'ENTRYsite' is the string between
## '@' and '#' in the listbox lines.
##
## We use the string between '@' and '#' (example: 'dilbert.com/strips/')
## rather than the user-friendly, brief string before '@'
## (example: 'Dilbert (1989+)') --- because:
##
## 1) we may eventually provide multiple archive sources for a given comic
## --- for example, we may offer 'Dilbert1' and 'Dilbert2', from
## two or more different server addresses (see Doonesbury example below),
## and
## 2) the 'site-string' is a little more 'telling' about the source
## (and usually does not contain space characters)
## and
## 3) in some cases, we may wish to use the contents of $ENTRYsite
## within the 'get_*_comic' proc that is called.
##
## POSSIBILITY OF MULTIPLE SITES:
##
## Note that Doonesbury comics may be retrievable from multiple sites:
## - gocomics.com/doonesbury/
## - doonesbury.slate.com/strip/archive/
## - comicstriptarchive.com/Doonesbury/
## There are many other sites, but they usually have only selected comics
## rather than a day-by-day collection covering years.
##
## THE VARIABLE 'fileMIDNAME':
##
## The variable fileMIDNAME, in each 'if' clause below, is used in naming
## output files from the 'SaveAsGIF' option that saves the currently
## displayed image to local storage.
##
## UPDATING THIS PROC:
##
## More 'if' lines can be added here, with appropriate 'get_*_comic' procs
## added below and with appropriate lines inserted in the listbox above.
##
## CALLED BY: the 'Retrieve' button
##+#########################################################################
proc Retrieve {} {
global ENTRYsite VARyear VARmonth VARday fileMIDNAME
## FOR TESTING: (to dummy out this proc)
# return
## AGNES:
if {"$ENTRYsite" == "www.gocomics.com/agnes/"} {
set fileMIDNAME "agnes"
get_agnes_comic $VARyear $VARmonth $VARday
}
## The listbox line 'www.gocomics.com/Agnes/' is temporarily
## commented out above. So this never finds a match.
if {"$ENTRYsite" == "www.gocomics.com/Agnes/"} {
set fileMIDNAME "Agnes"
get_Agnes-2001-2002_comic $VARyear $VARmonth $VARday
}
## BABY BLUES:
if {"$ENTRYsite" == "www.babyblues.com/images/"} {
set fileMIDNAME "BabyBlues"
get_babyblues-1996-2002_comic $VARyear $VARmonth $VARday
}
## BIZARRO:
if {"$ENTRYsite" == "bizarrocomics.com/files/"} {
set fileMIDNAME "Bizarro"
get_bizarro-files_comic $VARyear $VARmonth $VARday
}
## DILBERT:
if {"$ENTRYsite" == "dilbert.com/strips/"} {
set fileMIDNAME "Dilbert"
get_dilbert_comic $VARyear $VARmonth $VARday
}
## DOONESBURY:
if {"$ENTRYsite" == "gocomics.com/doonesbury/"} {
set fileMIDNAME "Doonesbury"
get_doonesbury_comic $VARyear $VARmonth $VARday
}
## RHYMES WITH ORANGE:
if {"$ENTRYsite" == "rhymeswithorange.com"} {
set fileMIDNAME "RhymesWithOrange"
get_rhymeswithorange_comic $VARyear $VARmonth $VARday
}
## SPEED BUMP:
if {"$ENTRYsite" == "gocomics.com/speedbump/"} {
set fileMIDNAME "SpeedBump"
get_speedbump_comic $VARyear $VARmonth $VARday
}
## ZITS:
if {"$ENTRYsite" == "zitscomics.com"} {
set fileMIDNAME "Zits"
get_zits_comic $VARyear $VARmonth $VARday
}
}
## END OF proc 'Retrieve'
##+#############################################################################
## PROC 'show_image_forPicURL'
##+#############################################################################
## PURPOSE: For a given fully-qualified URL for a picture file (GIF or whatever)
## at a (comics archive) web-site, this proc loads the picture data into
## a Tk 'photo' image structure and places the image structure
## on the canvas widget of this GUI.
##
## CALLED BY: each of the following 'get_*_comic' procs
##+#############################################################################
proc show_image_forPicURL {fileType picURL} {
## For Input:
global aRtext DIRtemp
## For Output:
## Make the picture data put in the Tk 'photo' image 'structure'
## by this proc available to the writeGIF proc.
global imageID
# global picDATA
############################################################
## Get the image data of the specified day's comic strip ---
## via a 'http:geturl' command and a 'http:data' command.
############################################################
set TEMPurlID [http::geturl "$picURL"]
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'show_image_forPicURL' did 'http::geturl' on"
puts "picURL: $picURL"
puts "and got TEMPurlID: $TEMPurlID"
}
set picDATA [http::data $TEMPurlID]
## FOR TESTING: (WARNING: This can be many screen-fulls of 'binary characters'.)
if {0} {
puts ""
puts "PROC 'show_image_forPicURL' did 'http::getdata' on URL-ID $TEMPurlID"
puts "and got the following data."
puts "picDATA: $picDATA"
}
## We don't need TEMPurlID any more.
http::cleanup $TEMPurlID
###############################################################
## If fileType is NOT 'GIF' (say JPEG or PNG),
## 1) write this picDATA to a temp file,
## 2) use ImageMagick 'convert' to make a temp GIF file,
## and
## 3) use 'image create photo' to load the GIF file into
## the 'imageID' Tk in-memory image 'structure' ---
## which will be placed on the canvas.
###############################################################
if {"$fileType" != "GIF"} {
########################################################
## Write $picDATA to a temp '.img' file.
########################################################
set tempIMGfile "$DIRtemp/comic.img"
## exec rm "$tempIMGfile"
set fileID [open "$tempIMGfile" w]
fconfigure $fileID -translation binary -encoding binary
puts -nonewline $fileID "$picDATA"
close $fileID
########################################################
## Use ImageMagick 'convert' to make a temp '.gif' file.
########################################################
set tempGIFfile "$DIRtemp/comic.gif"
## exec rm "$tempGIFfile"
# exec convert "$tempIMGfile" -colors 256 "$tempGIFfile"
set RETcode [catch {exec convert "$tempIMGfile" -colors 256 "$tempGIFfile"} CatchMsg]
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'show_image_forPicURL' - message from 'convert' command:"
puts ""
puts "CatchMsg: $CatchMsg"
}
##############################################
## Check for error from the 'convert' command.
##############################################
if {$RETcode != 0} {
set ERRmsg "$aRtext(MSGconvert)
$tempIMGfile
RETcode: $RETcode
CatchMsg: $CatchMsg
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
#########################################################
## Use 'image create photo' to load the GIF file into the
## 'imageID' Tk in-memory image 'structure'.
#########################################################
set imageID [image create photo -file "$tempGIFfile"]
}
## END OF if {"$fileType" != "GIF"}
if {"$fileType" == "GIF"} {
#################################################
## Check for GIF file data, to make sure we can
## use the 'image create photo' command below.
#################################################
set First3 [string range "$picDATA" 0 2]
set First1000 [string range "$picDATA" 0 999]
if {"$First3" != "GIF"} {
set ERRmsg "$aRtext(popupMSGhttpData1)
$First1000
$aRtext(popupMSGhttpData2)
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
## END OF if {"$First3" != "GIF"}
###############################################################
## Create the Tk 'photo' image 'structure' from the GIF data.
###############################################################
## We might want to change this to a technique that keeps
## reusing the same image ID. Example:
## image create photo imageID1 -data "$picDATA"
###############################################################
set imageID [image create photo -data "$picDATA"]
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'show_image_forPicURL' did 'image create photo' with data in"
puts "the 'picDATA' variable and returned imageID: $imageID"
}
}
## END OF if {"$fileType" == "GIF"}
#################################################
## Put the image on the Tk 'canvas' widget ---
## via its 'handle' --- after clearing the canvas.
#################################################
.fRbottom.fRdisplay.can delete all
set IMGwidthPx [image width $imageID]
set IMGheightPx [image height $imageID]
# set halfIMGwidthPx [expr {$IMGwidthPx/2}]
# set halfIMGheightPx [expr {$IMGheightPx/2}]
.fRbottom.fRdisplay.can create image 0 0 -anchor nw -image $imageID
## Alternatives:
# .fRbottom.fRdisplay.can create image $IMGwidthPx $IMGheightPx \
# -anchor se -image $imageID
##
# .fRbottom.fRdisplay.can create image $halfIMGwidthPx $halfIMGheightPx \
# -anchor center -image $imageID
##############################################################
## Resize the canvas to show as much of the image as possible.
##############################################################
# . configure -height $IMGheightPx
# update
# .fRbottom configure -height $IMGheightPx
# update
# .fRbottom.fRdisplay configure -width $IMGwidthPx -height $IMGheightPx
# update
.fRbottom.fRdisplay.can configure -width $IMGwidthPx -height $IMGheightPx
# update
.fRbottom.fRdisplay.can configure -scrollregion "0 0 $IMGwidthPx $IMGheightPx"
# update
#################################################################################
## DARN. 'No one' and 'no combination' of these configure width/height statements
## seem to resize the canvas, if the user has 'manually' changed the window size
## before these are executed. Solution? Tk-wish seems to lose track of canvas size
## after the user 'manually' resizes the window. Do we need to store canvas size
## after a <Configure> event and use that somehow?
## In any case, it appears that we DO need to configure '-width', '-height', and
## '-scrollregion' here.
#################################################################################
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'show_image_forPicURL' TRIED TO reconfigure the canvas according to"
puts "IMGwidthPx: $IMGwidthPx IMGheightPx: $IMGheightPx"
puts "canvas reqwidth : [winfo reqwidth .fRbottom.fRdisplay.can]"
puts "canvas reqheight: [winfo reqheight .fRbottom.fRdisplay.can]"
puts "canvas width : [winfo width .fRbottom.fRdisplay.can]"
puts "canvas height: [winfo height .fRbottom.fRdisplay.can]"
puts "canvas frame width : [winfo width .fRbottom.fRdisplay]"
puts "canvas frame height: [winfo height .fRbottom.fRdisplay]"
}
#################################################
## Display the image size in a label on the GUI.
#################################################
.fRoptions.labelIMGSIZE configure -text \
"Image size: ${IMGwidthPx}x$IMGheightPx"
}
##END OF proc 'show_image_forPicURL'
##+#############################################################################
## PROC 'popmsg_forFailedGetURL'
##+#############################################################################
## PURPOSE: To be used when an 'http::geturl' command fails.
## Pops up a message that indicates either the tested URL(s)
## were not found OR that the network connection may be the issue.
##
## CALLED BY: 'get_*_comic' procs
proc popmsg_forFailedGetURL { URLs {caughtMsg ""} {retCode ""} } {
global aRtext
## Trim 'caughtMsg'.
set caughtMsg [string trim "$caughtMsg"]
## Build the msg.
set ERRmsg "$aRtext(popupMSGhttpGeturl1)
$URLs
$aRtext(popupMSGhttpGeturl2)
Return code: $retCode
$aRtext(popupMSGerrMsg) $caughtMsg"
## Popup the msg.
popup_msgVarWithScroll .topErr "$ERRmsg"
}
## END OF PROC 'popmsg_forFailedGetURL'
##+#############################################################################
## PROC 'get_month_name'
##+#############################################################################
## PURPOSE: For a given month number, return its name.
## Example: for '03', return 'march'.
##
## We provide another parameter to allow for returning names
## like 'March' or 'Mar' or 'mar'.
##
## CALLED BY: some of the following 'get_*_comic' procs ---
## for example, 'get_rhymeswithorange_comic'
##+#############################################################################
proc get_month_name {NUMmonth} {
## Replace this by if-else-if construct (someday).
if {"$NUMmonth" == "01"} {set NAMEmonth "january"}
if {"$NUMmonth" == "02"} {set NAMEmonth "february"}
if {"$NUMmonth" == "03"} {set NAMEmonth "march"}
if {"$NUMmonth" == "04"} {set NAMEmonth "april"}
if {"$NUMmonth" == "05"} {set NAMEmonth "may"}
if {"$NUMmonth" == "06"} {set NAMEmonth "june"}
if {"$NUMmonth" == "07"} {set NAMEmonth "july"}
if {"$NUMmonth" == "08"} {set NAMEmonth "august"}
if {"$NUMmonth" == "09"} {set NAMEmonth "september"}
if {"$NUMmonth" == "10"} {set NAMEmonth "october"}
if {"$NUMmonth" == "11"} {set NAMEmonth "november"}
if {"$NUMmonth" == "12"} {set NAMEmonth "december"}
return $NAMEmonth
}
##END OF proc 'get_month_name'
## START OF THE 'get_*_comic' PROCS:
##
## OUTLINE OF BASIC-METHOD USED BY THESE PROCS:
##
## The Tcl 'http' package commands are used to retrieve
## a specific comic from the web site and display it
## in the canvas widget.
##
## A series of Tcl 'http' commands are issued ---
## commands such as
## - http::config
## - http::geturl
## - http::data
## - http::cleanup
##+#########################################################################
## PROC 'get_agnes_comic'
##+#########################################################################
## PURPOSE: For a comic 'index' specification (VARyear,VARmonth,VARday),
## retrieve the indicated comic from the 'www.gocomics.com/agnes/'
## web site location --- and display it on the Tk 'canvas' widget.
##
## FETCH TECHNIQUE:
## Agnes comics (2002-2014+) at www.gocomics.com/Agnes/ are accessed
## via web pages in directories like /2014/02/12/ --- and go back to
## about /2002/08/11/.
##
## For date yyyy-mm-dd, we should be able to do something like
## build 'directory URL'
## http://www.gocomics.com/agnes/${yyyy}/${mm}/${dd}/
##
## Then get the HTML page returned on using that directory-URL
## and scan the text of the page for strings
## class="feature_item"
## and
## src=" (and an ending double-quote)
## to get the URL of the (GIF) image file. Example:
##
## http://assets.amuniversal.com/9d89c4e089bf013107e5005056a9545d
##
## Then pass that image-file-URL to the 'show_image_forPicURL' proc.
##
## DATE LIMITS:
##
## Cartoons fetchable like this (via directories /${yyyy}/${mm}/${dd}/)
## go from the current date (in 2014) back to about 2002 August.
##
## We put a check in this proc to see if the date (yyyy mm dd)
## passed to this proc is before 2002 08 01.
##
## CALLED BY: proc 'Retrieve'
##+#########################################################################
## ANOTHER POSSIBLE SOURCE OF RECENT 'AGNES' COMICS: (if gocomics.com fades)
## http://www.creators.com/comics/agnes/archive.html
##
## Possible extraction procedure:
## 1)
## Given a date yyyy-mm-dd, look for mm/dd/yyyy in the
## page http://www.creators.com/comics/agnes/archive.html
## and extract the string after the string
## mm/dd/yyyy <a href="
## and up to the ending string
## ">.
##
## 2)
## Then in that page (example: http://www.creators.com/comics/agnes/117548.html),
## look for the string between
## <td class="zoom middle zoom_bg" width="220"> <a href="
## and
## ">.
## Example: /comics/15/117548_image.jpg
##
## 3)
## Convert that JPEG file to GIF and display it on the Tk canvas.
proc get_agnes_comic {yyyy mm dd} {
## FOR TESTING: (to dummy out this proc)
# return
## For Input:
global aRtext
## For Output:
global VARyear VARmonth VARday
#################################################
## Set the directory-URL that we will use.
#################################################
set TEMPurlDIR "http://www.gocomics.com/agnes/${yyyy}/${mm}/${dd}/"
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_agnes_comic' used date"
puts "yyyy: $yyyy mm: $mm dd: $dd"
puts "set 'web-location'"
puts "TEMPurlDIR: $TEMPurlDIR"
}
########################################################################
## Check for too old a date (older than 2002 aug 01).
########################################################################
# scan $dd %d D
scan $mm %d M
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_agnes_comic' did 'scan' to remove a leading zero:"
# puts "dd: $dd D : $D"
puts "mm: $mm M : $M"
}
if {$yyyy < 2002 || ($yyyy == 2002 && $M < 8)} {
set VARyear 2002
set VARmonth 09
set VARday 01
set ERRmsg "\
The date you used ($yyyy $mm $dd) is PROBABLY TOO OLD (older than 2002 aug 11).
The web page that this 'get_agnes_comic' procedure tries to use ---
$TEMPurlDIR
--- probably does not exist.
Try a more recent date --- like $VARyear $VARmonth $VARday.
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
## END OF date-too-old-check
###########################################################################
## Read from the site www.gocomics.com/Agnes/ page --- URL in TEMPurlDIR ---
## and get the HTML text that contains a link to that day's comic image file.
##
## (This may need to be changed if the image storage-and-access procedure
## changes.)
###########################################################################
## To help catch cases where the user has not established a
## network connection yet, we use a catch' statement like:
##
## if {[catch {$command} CatchMsg] != 0} {..show an err msg.. ; return}
###########################################################################
http::config -useragent "Mozilla/1.0" -accept "image/gif,image/jpeg,text/*"
set RETcode [catch { set TEMPurlID [http::geturl "$TEMPurlDIR"] } CatchMsg]
if {$RETcode != 0} {
popmsg_forFailedGetURL "$TEMPurlDIR" "$CatchMsg" $RETcode
return
}
if {[http::ncode $TEMPurlID] == 404} {
popmsg_forFailedGetURL "$TEMPurlDIR" "" 404
return
}
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_agnes_comic' did 'http:geturl' and got URL-ID"
puts "TEMPurlID: $TEMPurlID"
}
#################################################
## Get the text of the HTML file.
#################################################
set HTMLtext [http::data $TEMPurlID]
## FOR TESTING: (WARNING: This can be many screen-fulls of text lines.)
if {0} {
puts ""
puts "PROC 'get_agnes_comic' did 'http:geturl' and got URL-ID"
puts "TEMPurlID: $TEMPurlID"
puts "and did 'http:data' on this URL-ID to get HTML text:
puts "HTMLtext: $HTMLtext"
}
########################################################
## We don't need TEMPurlID any more. Cleanup on aisle 4.
########################################################
http::cleanup $TEMPurlID
#############################################################################
## Use 'regexp' to get the URL of the yyyy-mm-dd image file
## from the HTML text.
## Reference: pages 158-162 of the 4th edition of
## 'Practical Programming in Tcl & Tk'.
## Syntax:
## regexp ?flags? pattern string ?match sub1 sub2 ...?
##
## We scan the HTMLtext of the page for strings:
## class="feature_item"
## and
## src=" (and an ending double-quote)
## to get the URL of the (GIF) image file.
##
## (This technique may need to be changed if the site image storage-and-access
## method changes.)
############################################################################
regexp -nocase {class="feature_item".*?src="([^"]+)"} "$HTMLtext" to picURL
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_agnes_comic' did 'regexp' to get 'picURL' from the HTML text."
puts "picURL: $picURL"
}
##########################################################
## Get the image data of the specified day's comic strip
## and display it on the 'canvas' widget.
##########################################################
if {[info exists picURL] != 0} {
show_image_forPicURL GIF "$picURL"
} else {
set ERRmsg "The URL of a picture file was not found for a web page at
$TEMPurlDIR
IT MAY BE THAT DATE ${yyyy}-${mm}-$dd IS INVALID (the page may not exist).
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
}
## END OF PROC 'get_agnes_comic'
##+#########################################################################
## PROC 'get_Agnes-2001-2002_comic'
## (NOT SUCCESSFUL YET. RETURNS THE COMIC-OF-THE-DAY.)
##+#########################################################################
## PURPOSE: For a comic 'index' specification (VARyear,VARmonth,VARday),
## retrieve the indicated comic from the 'www.gocomics.com/Agnes/'
## web site location --- and display it on the Tk 'canvas' widget.
##
## FETCH TECHNIQUE:
## Agnes comics (2001-mid2002) at www.gocomics.com/Agnes/ are in
## directories of the form /2001-2-1/ to about /2002-8-1/.
##
## For date yyyy-mm-dd (in that 2001-2002 range), we should be able
## to do something like
## scan $dd %d D
## scan $mm %d M
## and build URL
## http://www.gocomics.com/Agnes/${yyyy}-${M}-${D}/
##
## Then get and scan the text of that page for strings
## class="feature_item"
## and
## src=" (ended by double-quotes)
## to get the URL of the GIF image file. Example:
##
## http://assets.amuniversal.com/9d89c4e089bf013107e5005056a9545d
##
## Then pass that URL to the 'show_image_forPicURL' proc.
##
## DATE LIMITS:
##
## Cartoons fetchable like this (via directories /${yyyy}-${M}-${D}/)
## are in the range from about 2001 January to about 2002 August.
##
## We put a check in this proc to see if the date (yyyy mm dd)
## passed to this proc is in that range.
##
## CALLED BY: proc 'Retrieve'
##+#########################################################################
proc get_Agnes-2001-2002_comic {yyyy mm dd} {
## FOR TESTING: (to dummy out this proc)
# return
## For Input:
global aRtext
## For Output:
global VARyear VARmonth VARday
#################################################
## Set the directory-URL that we will use.
#################################################
scan $dd "%d" D
scan $mm "%d" M
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_Agnes-2001-2002_comic' used 'scan' to remove leading zeros."
puts "dd: $dd D : $D"
puts "mm: $mm M : $M"
}
set TEMPurlDIR "http://www.gocomics.com/agnes/${yyyy}-${M}-${D}/"
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_Agnes-2001-2002_comic' used date"
puts "yyyy: $yyyy mm: $mm dd: $dd"
puts "to make 'web-location'"
puts "TEMPurlDIR: $TEMPurlDIR"
}
########################################################################
## Check for an out-of-range date (outside 2001jan01 to 2002jul31).
########################################################################
if {$yyyy < 2001 || $yyyy > 2002 || ($yyyy == 2002 && $M > 7)} {
set VARyear 2002
set VARmonth 07
set VARday 01
set ERRmsg "\
The date you used ($yyyy $mm $dd) is PROBABLY OUT OF RANGE FOR THIS SITE-and-PROCEDURE.
The web directory that this 'get_Agnes-2001-2002_comic' procedure tries to find ---
$TEMPurlDIR
--- probably does not exist. (The date is outside 2001jan01 to 2002jul31.)
Try a date in that range --- like $VARyear $VARmonth $VARday.
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
## END OF date-out-of-range-check
########################################################################
## Read from the site www.gocomics.com/agnes/ page --- in TEMPurlDIR ---
## and get the HTML text that contains a link to that day's comic image file.
##
## (This may need to be changed if the image storage-and-access procedure
## changes.)
########################################################################
## To help catch cases where the user has not established a
## network connection yet, we use a catch' statement like:
##
## if {[catch {$command} CatchMsg] != 0} {..show an err msg.. ; return}
########################################################################
http::config -useragent "Mozilla/1.0" -accept "image/gif,image/jpeg,text/*"
set RETcode [catch { set TEMPurlID [http::geturl "$TEMPurlDIR"] } CatchMsg]
if {$RETcode != 0} {
popmsg_forFailedGetURL "$TEMPurlDIR" "$CatchMsg" $RETcode
return
}
if {[http::ncode $TEMPurlID] == 404} {
popmsg_forFailedGetURL "$TEMPurlDIR" "" 404
return
}
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_Agnes-2001-2002_comic' did 'http:geturl' on URL-DIR"
puts "$TEMPurlDIR"
puts "and got URL
puts "TEMPurlID: $TEMPurlID"
}
#################################################
## Get the text of the HTML file.
#################################################
set HTMLtext [http::data $TEMPurlID]
## FOR TESTING: (WARNING: This can be many screen-fulls of text lines.)
if {0} {
puts ""
puts "PROC 'get_Agnes-2001-2002_comic' did 'http:data' on URL-ID $TEMPurlID"
puts "to get HTML text."
puts "HTMLtext: $HTMLtext"
}
## We don't need TEMPurlID any more.
http::cleanup $TEMPurlID
#############################################################################
## Use 'regexp' to get the URL of the yyyy-mm-dd image file
## from the HTML text.
## Reference: pages 158-162 of the 4th edition of
## 'Practical Programming in Tcl & Tk'.
## Syntax:
## regexp ?flags? pattern string ?match sub1 sub2 ...?
##
## We scan the HTMLtext of the page for strings:
## class="feature_item"
## and
## src=" (and an ending double-quote)
## to get the URL of the (GIF) image file.
##
## (This technique may need to be changed if the site image storage-and-access
## method changes.)
############################################################################
regexp -nocase {class="feature_item".*?src="([^"]+)"} "$HTMLtext" to picURL
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_Agnes-2001-2002_comic' used 'regexp' on HTML text"
puts "to get the image-file URL."
puts "picURL: $picURL"
}
##########################################################
## Get the image data of the specified day's comic strip
## and display it on the 'canvas' widget.
##########################################################
if {[info exists picURL] != 0} {
show_image_forPicURL GIF "$picURL"
} else {
set ERRmsg "The URL of a picture file was not found for a web page at
$TEMPurlDIR
IT MAY BE THAT DATE ${yyyy}-${mm}-$dd IS INVALID (the page may not exist).
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
}
## END OF PROC 'get_Agnes-2001-2002_comic'
##+#########################################################################
## PROC 'get_babyblues-1996-2002_comic'
##+#########################################################################
## PURPOSE: For a comic 'index' specification (VARyear,VARmonth,VARday),
## retrieve the indicated comic via the 'www.babyblues.com/images/yyyy/'
## web site location --- and displays it on the Tk 'canvas' widget.
##
## NOTE: The images retrieved by this method are probably reduced
## size images made from images that were about twice as large.
##
## FETCH TECHNIQUE:
## BabyBlues comics (1996-2002) at www.babyblues.com/images/ can be
## accessed 'directly' via '.gif' files with URL names like
## www.babyblues.com/images/1996/960312.gif
## www.babyblues.com/images/1999/990704s.gif
## www.babyblues.com/images/2002/021029.gif
## where the 's.gif' suffix indicates a Sunday (color) comic.
##
## For date yyyy-mm-dd, we can
## set YY [string range $yyyy 2 3]
## and then do something like build two URL's:
## www.babyblues.com/images/${yyyy}/${YY}${mm}${dd}.gif
## and
## www.babyblues.com/images/${yyyy}/${YY}${mm}${dd}s.gif
##
## We use 'http' commands to determine which one of these exists,
## and pass an existing name to proc 'show_image_forPicURL'.
##
## Note that 7 years are available via this technique:
## 1996, 1997, 1998, 1999, 2000, 2001, 2002.
##
## From 2003 and beyond, BabyBlues cartoons are at safr.kingfeatures.com/...
## but the fetch from there (or elsewhere) is left for a different
## proc (someday?).
##
## DATE LIMITS:
##
## Cartoons fetchable like this (via directories babyblues.com/images/${yyyy}/)
## are in the date range 1996 thru 2002.
##
## We put a check in this proc to see if the date (yyyy mm dd)
## passed to this proc is in that range.
##
## CALLED BY: proc 'Retrieve'
## ALTERNATIVE SOURCE DIRECTORIES: ('IMAGES' instead of 'images')
##
## Various .gif files are in http://www.babyblues.com/IMAGES/
## including DIRECTORIES
## http://www.babyblues.com/IMAGES/1996/
## thru
## http://www.babyblues.com/IMAGES/2002/
##
## Found the 'images' and 'IMAGES' directories by doing a Google search
## on keywords 'filetype:gif babyblues'
proc get_babyblues-1996-2002_comic {yyyy mm dd} {
## FOR TESTING: (to dummy out this proc)
# return
## For Input:
global aRtext
## For Output:
global VARyear VARmonth VARday
#####################################################################
## Set the 'directory-URL' that we will use to find the '.gif' file.
#####################################################################
# scan $dd %d D
# scan $mm %d M
set TEMPurlDIR "http://www.babyblues.com/images/${yyyy}"
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_babyblues-1996-2002_comic' set 'web-location':"
puts "yyyy: $yyyy mm: $mm dd: $dd"
puts "TEMPurlDIR: $TEMPurlDIR"
}
########################################################################
## Check for an out-of-range date (outside 1996 thru 2002).
########################################################################
if {$yyyy < 1996 || $yyyy > 2002 } {
set VARyear 2001
set VARmonth 12
set VARday 01
set ERRmsg "\
The date you used ($yyyy $mm $dd) is PROBABLY OUT OF RANGE FOR THIS SITE-and-PROCEDURE.
The web directory that this 'get_babyblues-1996-2002_comic' procedure tries to find ---
$TEMPurlDIR
--- probably does not exist. (The date is outside 1996 to 2002.)
Try a date in that range --- like $VARyear $VARmonth $VARday.
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
## END OF date-out-of-range-check
##################################################
## Set the 2 GIF-filenames to look for.
##################################################
set YY [string range "$yyyy" 2 3]
set URLgif1 "$TEMPurlDIR/${YY}${mm}${dd}.gif"
set URLgif2 "$TEMPurlDIR/${YY}${mm}${dd}s.gif"
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_babyblues-1996-2002_comic' GIF-file URL-names:"
puts "URLgif1: $URLgif1"
puts "URLgif2: $URLgif2"
}
########################################################################
## Try an 'http::geturl' command on 'URLgif1' (and 'URLgif2') ---
## and check 'http::ncode' to see if either '.gif' file exists.
########################################################################
## We use this double-check rather than adding code to determine if
## yyyy-mm-dd is a Sunday and then use 's.gif' instead of '.gif'. This
## could handle cases when the Sunday/color comic may be 'mis-named'.
########################################################################
## To help catch cases where the user has not established a
## network connection yet, we use a catch' statement like:
##
## if {[catch {$command} CatchMsg] != 0} {..show an err msg.. ; return}
########################################################################
http::config -useragent "Mozilla/1.0" -accept "image/gif,image/jpeg,text/*"
set picURL ""
set RETcode1 [catch { set TEMPurlID1 [http::geturl "$URLgif1"] } CatchMsg]
if {$RETcode1 != 0} {
popmsg_forFailedGetURL "$URLgif1" "$CatchMsg" $RETcode1
return
}
if {[http::ncode $TEMPurlID1] != 404} {
set picURL "$URLgif1"
} else {
set RETcode2 [catch { set TEMPurlID2 [http::geturl "$URLgif2"] } CatchMsg]
if {$RETcode2 != 0} {
popmsg_forFailedGetURL "$URLgif2" "$CatchMsg" $RETcode2
return
}
if {[http::ncode $TEMPurlID2] != 404} {
set picURL "$URLgif2"
}
}
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_babyblues-1996-2002_comic' did 'http::geturl' on URLgif1."
# puts "RETcode1: $RETcode1"
# puts "CatchMsg: $CatchMsg"
puts "TEMPurlID1: $TEMPurlID1"
puts "http::code $TEMPurlID1 gives [http::code $TEMPurlID1]"
puts "http::ncode $TEMPurlID1 gives [http::ncode $TEMPurlID1]"
puts "http::error $TEMPurlID1 gives [http::error $TEMPurlID1]"
puts "http::size $TEMPurlID1 gives [http::size $TEMPurlID1]"
# puts "http::status $TEMPurlID1 gives [http::status $TEMPurlID1]"
# puts "http::data $TEMPurlID1 gives [http::data $TEMPurlID1]"
}
########################################################################
## We don't need TEMPurlID1 and TEMPurlID2 any more. Cleanup on aisle 4.
########################################################################
http::cleanup $TEMPurlID1
if {[info exists TEMPurlID2]} {http::cleanup $TEMPurlID2}
#########################################################
## If picURL was not set to URLgif1 or URLgif2, bail out.
#########################################################
if {"$picURL" == ""} {
## It looks like neither URLgif1 nor URLgif2 exist.
## Pop a message to the user that the network connection may be an issue.
# set CatchMsg [string trim "$CatchMsg"]
set CatchMsg ""
set ERRmsg "$aRtext(popupMSGhttpGeturl1)
$URLgif1
and
$URLgif2
$aRtext(popupMSGhttpGeturl2)
$aRtext(popupMSGerrMsg) $CatchMsg"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_babyblues-1996-2002_comic' determined via 'http::geturl'"
puts "on the 2 GIF file URL's"
puts "$URLgif1"
puts "and"
puts "$URLgif2"
puts "which of the 2 GIF files to use for 'picURL' ---"
puts "to pass the 'show_image_forPicURL GIF' proc:"
puts "picURL: $picURL"
}
##########################################################
## If we get here, it appears the the picURL is valid.
## Provide it to the 'show_image_forPicURL' proc ---
## with an indicator that it is a GIF file.
##########################################################
show_image_forPicURL GIF "$picURL"
}
## END OF PROC 'get_babyblues-1996-2002_comic'
##+#########################################################################
## PROC 'get_babyblues-archive_comic' (to try to get 2003-2014)
## NOTE: NOT TOTALLY IMPLEMENTED YET. SEE ERROR-NOTE AT BOTTOM OF THIS PROC.
##+#########################################################################
## PURPOSE: For a comic 'index' specification (VARyear,VARmonth,VARday),
## retrieve the indicated comic from 'babyblues.com/archive'
## and display it on the Tk 'canvas' widget.
##
## FETCH TECHNIQUE:
## Baby Blues comics (2002? to 2014-plus) at 'babyblues.com/archive'
## are referenced via links on web pages whose URL is of the form:
##
## http://www.babyblues.com/archive/index.php?formname=getstrip&GoToDay=01/02/2013
##
## For a given date yyyy-mm-dd, we should be able
## to build URL
## http://www.babyblues.com/archive/index.php?formname=getstrip&GoToDay=${mm}/${dd}/$yyyy
##
## Then get HTMLtext returned via that directory-URL
## and scan the text of the page for strings
## class="comic archive-
## and
## src=" (and an ending double-quote)
## to get the URL of the GIF image file.
##
## Typical value thus found for the URL of the GIF image file:
## http://safr.kingfeatures.com/idn/babyblues/zone/js/index.php?cn=72&zn=132&fn=22&fd=Tuesday, March 5, 2013&wt=2&fs=0&null=0
##
## Then pass that image-file-URL to the 'show_image_forPicURL' proc.
##
##
## CALLED BY: proc 'Retrieve'
##+#########################################################################
proc get_babyblues-archive_comic {yyyy mm dd} {
## FOR TESTING: (to dummy out this proc)
# return
## For Input:
global aRtext
##############################################################
## Set the URL that we will use to find a URL link to a comic
## for the specified date --- yyyy mm dd.
##############################################################
set tempURL "http://www.babyblues.com/archive/index.php?formname=getstrip&GoToDay=${mm}/${dd}/$yyyy"
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_babyblues-archive_comic' using the date"
puts "yyyy: $yyyy mm: $mm dd: $dd"
puts "built the URL for the page whose HTML we want to search for an image-file URL."
puts "tempURL: $tempURL"
}
################################################
## A TOO-OLD DATE-CHECK could go here.
################################################
if {$yyyy < 2003 } {
set VARyear 2003
set VARmonth 02
set VARday 05
set ERRmsg "\
The date you used ($yyyy $mm $dd) is PROBABLY TOO-OLD for THIS SITE-and-PROCEDURE.
The web page that this 'get_babyblues-archive_comic' procedure tries to find ---
$tempURL
--- probably does not exist. (The date precedes year 2003.)
Try a newer date --- like $VARyear $VARmonth $VARday.
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
## END OF date-too-old-check
###########################################################################
## Read from BabyBlues archive site 'www.babyblues.com/archive/':
## Using the URL
## http://www.babyblues.com/archive/index.php?formname=getstrip&GoToDay=${mm}/${dd}/$yyyy
## get the HTML text that contains a link to that day's comic image file.
##
## (This technique may need to be changed if the HTML text format changes.)
###########################################################################
## To help catch cases where the user has not established a
## network connection yet, we use a catch' statement like:
##
## if {[catch {$command} CatchMsg] != 0} {..show an err msg.. ; return}
###########################################################################
http::config -useragent "Mozilla/1.0" -accept "image/gif,image/jpeg,text/*"
#################################################
## Check for error from the http::geturl command.
#################################################
set RETcode [catch { set TEMPurlID [http::geturl "$tempURL"] } CatchMsg]
if {$RETcode != 0} {
popmsg_forFailedGetURL "$tempURL" "$CatchMsg" $RETcode
return
}
if {[http::ncode $TEMPurlID] == 404} {
popmsg_forFailedGetURL "$tempURL" "" 404
return
}
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_babyblues-archive_comic' did 'http::geturl' on URL"
puts "$tempURL"
puts "and got the URL-ID"
puts "TEMPurlID: $TEMPurlID"
}
#################################################
## Get the text of the HTML file.
#################################################
set HTMLtext [http::data $TEMPurlID]
## FOR TESTING: (WARNING: This can be many screen-fulls of text lines.)
if {0} {
puts ""
puts "PROC 'get_babyblues-archive_comic' did 'http::data' on URL-ID $TEMPurlID"
puts "and got the following HTML text."
puts "HTMLtext: $HTMLtext"
}
########################################################
## We don't need TEMPurlID any more. Cleanup on aisle 4.
########################################################
http::cleanup $TEMPurlID
###############################################################################
## Use 'regexp' to get the URL of the yyyy-mm-dd image file
## from the HTML text.
## Reference: pages 158-162 of the 4th edition of
## 'Practical Programming in Tcl & Tk'.
## Syntax:
## regexp ?flags? pattern string ?match sub1 sub2 ...?
##
## (This technique may need to be changed if the site comic archive changes.)
###############################################################################
regexp -nocase {class="comic archive\-.*?src="([^"]+)"} "$HTMLtext" to picURL
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_babyblues-archive_comic' used 'regexp' on HTML text"
puts "to extract the following image-file URL."
puts "picURL: $picURL"
}
## Typical value of picURL for babyblues.com:
## http://safr.kingfeatures.com/idn/babyblues/zone/js/index.php?cn=72&zn=132&fn=22&fd=Tuesday, March 5, 2013&wt=2&fs=0&null=0
##########################################################
## Get the image data of the specified day's comic strip
## and display it on the 'canvas' widget.
##########################################################
## First, replace whitespace in the URL with %20.
## Reference: http://wiki.tcl.tk/1039 on 'exec'
## --- to avoid getting 'Illegal characters in URL path'
## error from the ' http::geturl "$picURL" ' statement
## in the 'show_image_...' proc.
##########################################################
set picURL [string map {{ } %20} "$picURL"]
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_babyblues-archive_comic' used 'string map' on the image-file URL"
puts "picURL: $picURL"
puts "to replace each space by '%20' --- yielding"
puts "picURL: $picURL"
}
##########################################################
## Provide picURL to the 'show_image_forPicURL' proc ---
## with an indicator that it is a GIF file.
##############################################################
## ERROR:
## I get the error 'Unauthorized Request! Invalid Domain ().'
## (even) when I paste the URL om picURL manually into the
## URL entry field of a web browser (Seamonkey).
##
## That error msg gets loaded into picURL, instead of the
## URL of an image-file. An popup window of proc
## 'show_image_forPicURL' shows the error msg.
##
## Need to look into this further.
##############################################################
show_image_forPicURL GIF "$picURL"
}
## END OF proc 'get_babyblues-archive_comic"
##+####################################################################
## BIZARRO NOTES:
## Unfortunately, the main Bizarro web site provides a URL to
## a JPEG file on a page with a name like:
## http://bizarrocomics.com/2011/07/30/see-um-syrup-wedding/
## which contains an extra qualifier besides yyyy/mm/dd.
##
## I do not have a way (yet) to determine/find that extra qualifier.
##
## However, the typical URL of the JPEG files looks like:
## http://bizarrocomics.com/files/uploads/2011/07/bz-panel-07-29-11.jpg
##
## So the following bizarro procs are based on looking 'directly'
## for files like that --- and converting the JPEG data to GIF data
## for display on the Tk canvas.
##+####################################################################
## SOME OTHER POSSIBLE SITES FOR 'BIZARRO' COMICS:
## http://www.chron.com/entertainment/comics-games/comic/Bizarro/
## http://comicskingdom.com/bizarro/yyyy-mm-dd
##
##+#########################################################################
## PROC 'get_bizarro-files_comic'
##+#########################################################################
## PURPOSE: For a comic 'index' specification (VARyear,VARmonth,VARday),
## retrieve the indicated comic from 'bizarrocomics.com/files/yyyy/'
## --- and display it on the Tk 'canvas' widget.
##
## FETCH TECHNIQUE:
## Bizarro comics (2013jan-plus) at 'bizarrocomics.com/files/' can be
## accessed 'directly' via '.jpg' files with URL names like
## bizarrocomics.com/files/2013/03/bz-panel-03-11-13.jpg
## bizarrocomics.com/files/2013/12/bz-panel-12-07-13.jpg
## bizarrocomics.com/files/2014/03/bz-panel-03-13-14.jpg
##
## For about a year and a half (2012 and last part of 2011),
## the same naming was used, except that the files were
## under '/files/upload/' instead of '/files/'.
## In this proc, we MAY try to allow for accessing comics of
## 2012 and the last part of 2011 --- as well as more recent
## (2013, 2014, ...) comics.
##
## For date yyyy-mm-dd, we can
## set YY [string range $yyyy 2 3]
## and then build the URL:
## bizarrocomics.com/files/${yyyy}/${mm}/bz-panel-${mm}-${dd}-${YY}.jpg
##
## We use 'http::' commands to determine if this image URL exists.
## If so, pass the image-file-URL to proc 'show_image_forPicURL'.
##
## DATE LIMITS:
##
## Cartoons fetchable like this (via directories bizarrocomics.com/files/${yyyy}/)
## are in the date range 2013jan-plus.
##
## We put a check in this proc to see if the date (yyyy mm dd)
## passed to this proc is in that range.
##
## We MAY check if the date is 2012 or last part of 2011, and
## if so, change the imgURL from /file/ to /file/upload/.
##
## CALLED BY: proc 'Retrieve'
proc get_bizarro-files_comic {yyyy mm dd} {
## FOR TESTING: (to dummy out this proc)
# return
## For Input:
global aRtext
## For Output:
global VARyear VARmonth VARday
#####################################################################
## Set the 'imgURL' that we will use to process the '.jpg' file.
#####################################################################
# scan $dd %d D
# scan $mm %d M
set YY [string range $yyyy 2 3]
if {$yyyy < 2013} {
set imgURL "http://bizarrocomics.com/files/upload/${yyyy}/${mm}/bz-panel-${mm}-${dd}-${YY}.jpg"
} else {
set imgURL "http://bizarrocomics.com/files/${yyyy}/${mm}/bz-panel-${mm}-${dd}-${YY}.jpg"
}
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_bizarro-files_comic' for the date"
puts "yyyy: $yyyy mm: $mm dd: $dd"
puts "built the following image-file URL"
puts "imgURL: $imgURL"
}
########################################################################
## Check for a too-old date (before 2011sep).
########################################################################
if {$yyyy < 2011 || ($yyyy == 2011 && $M < 9)} {
set VARyear 2013
set VARmonth 01
set VARday 05
set ERRmsg "\
The date you used ($yyyy $mm $dd) is PROBABLY TOO OLD for THIS SITE-and-PROCEDURE.
The '.jpg' file that this 'get_bizarro-files_comic' procedure tries to find ---
$imgURL
--- probably does not exist. (The date is older than 2011 September.)
Try a more recent date --- like $VARyear $VARmonth $VARday.
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
## END OF date-too-old-check
########################################################################
## Try a 'http::geturl' command on 'imgURL' ---
## and check the return code to see if the '.jpg' file exists.
########################################################################
## To help catch cases where the user has not established a
## network connection yet, we use a catch' statement like:
##
## if {[catch {$command} CatchMsg] != 0} {..show an err msg.. ; return}
########################################################################
http::config -useragent "Mozilla/1.0" -accept "image/gif,image/jpeg,text/*"
set RETcode [catch { set TEMPurlID [http::geturl "$imgURL"] } CatchMsg]
if {$RETcode != 0} {
popmsg_forFailedGetURL "$imgURL" "$CatchMsg" $RETcode
return
}
if {[http::ncode $TEMPurlID] == 404} {
popmsg_forFailedGetURL "$imgURL" "" 404
return
}
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_bizarro-files_comic' used 'http::geturl' on the image-file URL"
puts "imgURL: $imgURL"
puts "and got the URL-ID"
puts "TEMPurlID: $TEMPurlID"
}
##########################################################
## At this point, it would appear that the imgURL is valid.
## Provide it to the 'show_image_forPicURL' proc --- with
## an indicator that it is a JPEG file.
##########################################################
show_image_forPicURL JPEG "$imgURL"
}
## END OF PROC 'get_bizarro-files_comic'
##+#########################################################################
## PROC 'get_dilbert_comic'
##+#########################################################################
## PURPOSE: For a comic 'index' specification (VARyear,VARmonth,VARday),
## retrieve the indicated comic from the 'dilbert.com' web site
## --- and display it on the Tk 'canvas' widget.
##
## FETCH TECHNIQUE:
## Dilbert comics (1989-2014+) at www.dilbert.com are referenced
## via links on web pages whose 'directory-URL' is of the form
##
## http://www.dilbert.com/strips/comic/2014-03-07/
##
## For a given date yyyy-mm-dd, we should be able
## to do something like build 'directory-URL'
## http://www.dilbert.com/strips/comic/${yyyy}-${mm}-${dd}/
##
## Then get and scan the HTML text of the page returned (when
## that URL is used) for strings
## class="STR_Content"
## and
## src=" (and an ending double-quote)
## to get the URL of the GIF image file.
##
## Typical 'relative' value of the URL of the GIF image file:
## dyn/str_strip/000000000/00000000/0000000/200000/10000/4000/200/214290/214290.strip.gif
##
## Then pass that URL --- prefixed by
## http://www.dilbert.com/strips/comic/${yyyy}-${mm}-${dd}/
## --- to the 'show_image_forPicURL' proc.
##
## CALLED BY: proc 'Retrieve'
##+#########################################################################
## CREDITS:
## This dilbert-code was 'inspired by' the Tcl-Tk code for retrieval of a Dilbert
## 'comic-of-the-day' --- at http://wiki.tcl.tk/8899 (created 2005) ---
## the code that was contributed by 's_m' on 2013apr10.
##
## In a test run of that code in early 2014, the values assigned to the
## variables 'um', 'picurl', 'um', 'ext', and 'filename' were:
##
## um = ::http::1
## picurl = /dyn/str_strip/000000000/00000000/0000000/200000/10000/1000/500/211518/211518.strip.gif
## um = ::http::2
## ext = .gif
## filename = dil_img/dilbert20140206.gif
##+#########################################################################
proc get_dilbert_comic {yyyy mm dd} {
## FOR TESTING: (to dummy out this proc)
# return
## For Input:
global aRtext
#################################################
## Set the directory-URL that we will use.
#################################################
set TEMPurlDIR "http://www.dilbert.com/strips/comic/${yyyy}-${mm}-$dd/"
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_dilbert_comic' used date"
puts "yyyy: $yyyy mm: $mm dd: $dd"
puts "to build the 'directory-URL"
puts "TEMPurlDIR: $TEMPurlDIR"
}
########################################################################
## Check for a too-old date (before 1989).
########################################################################
if {$yyyy < 1989} {
set VARyear 1990
set VARmonth 01
set VARday 05
set ERRmsg "\
The date you used ($yyyy $mm $dd) is PROBABLY TOO OLD for THIS SITE-and-PROCEDURE.
The 'directory-URL' that this 'get_dilbert_comic' procedure tries to find ---
$TEMPurlDIR
--- probably does not exist. (The date is older than 1989.)
Try a more recent date --- like $VARyear $VARmonth $VARday.
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
## END OF date-too-old-check
########################################################################
## Read from the site dilbert.com --- a yyyy-mm-dd page ---
## and get the HTML text that contains a link to that day's comic image file.
##
## (This may need to be changed if the site comic archive changes.)
########################################################################
## To help catch cases where the user has not established a
## network connection yet, we use a catch' statement like:
##
## if {[catch {$command} CatchMsg] != 0} {..show an err msg.. ; return}
########################################################################
http::config -useragent "Mozilla/1.0" -accept "image/gif,image/jpeg,text/*"
set RETcode [catch { set TEMPurlID [http::geturl "$TEMPurlDIR"] } CatchMsg]
if {$RETcode != 0} {
popmsg_forFailedGetURL "$TEMPurlDIR" "$CatchMsg" $RETcode
return
}
if {[http::ncode $TEMPurlID] == 404} {
popmsg_forFailedGetURL "$TEMPurlDIR" "" 404
return
}
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_dilbert_comic' used 'http::geturl' on 'directory-URL'"
puts "$TEMPurlDIR"
puts "and got the URL-ID"
puts "TEMPurlID: $TEMPurlID"
}
#################################################
## Get the text of the HTML file.
#################################################
set HTMLtext [http::data $TEMPurlID]
## FOR TESTING: (WARNING: This can be many screen-fulls of text lines.)
if {0} {
puts ""
puts "PROC 'get_dilbert_comic' used 'http::data' on URL-ID $TEMPurlID"
puts "to get the following HTML text."
puts "HTMLtext: $HTMLtext"
}
## We don't need TEMPurlID any more.
http::cleanup $TEMPurlID
#############################################################################
## Use 'regexp' to get the URL of the yyyy-mm-dd image file
## from the HTML text.
## Reference: pages 158-162 of the 4th edition of
## 'Practical Programming in Tcl & Tk'.
## Syntax:
## regexp ?flags? pattern string ?match sub1 sub2 ...?
##
## (This technique may need to be changed if the site comic archive changes.)
############################################################################
regexp -nocase {class="STR_Content".*?src="([^"]+)"} "$HTMLtext" to picURL
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_dilbert_comic' used 'regexp' on HTML text"
puts "to extract the URL of the desired image file."
puts "picURL: $picURL"
}
## Typical 'relative' value in picURL for dilbert.com:
## dyn/str_strip/000000000/00000000/0000000/200000/10000/4000/200/214290/214290.strip.gif
##########################################################
## Pass the picURL to proc 'show_image_forPicURL' --- to
## get the image data of the specified day's comic strip
## and display it on the 'canvas' widget.
##########################################################
if {[info exists picURL] != 0} {
show_image_forPicURL GIF "http://www.dilbert.com$picURL"
} else {
set ERRmsg "The URL of a picture file was not found for a web page at
$TEMPurlDIR
IT MAY BE THAT DATE ${yyyy}-${mm}-$dd IS INVALID (the page may not exist).
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
}
## END OF PROC 'get_dilbert_comic'
##+#########################################################################
## PROC 'get_doonesbury_comic'
##+#########################################################################
## PURPOSE: For a comic 'index' specification (VARyear,VARmonth,VARday),
## retrieve the indicated comic from 'www.gocomics.com/doonesbury/'
## --- and display it on the Tk 'canvas' widget.
##
## FETCH TECHNIQUE:
## Doonesbury comics (2004 to 2014march) at 'www.gocomics.com/doonesbury/'
## are referenced via links on web pages whose 'directory-URL' is of
## the form
## http://www.gocomics.com/doonesbury/2014/03/01/
##
## For a given date yyyy-mm-dd, we should be able
## to do something like build 'directory-URL'
## http://www.gocomics.com/doonesbury/${yyyy}/${mm}/${dd}/
##
## Then get HTMLtext returned via that directory-URL
## and scan the text of the page for strings
## class="feature_item"
## and
## src=" (and an ending double-quote)
## to get the URL of the GIF image file.
##
## Typical value thus found for the URL of the GIF image file:
## http://assets.amuniversal.com/fee42e407aff0131fb33005056a9545d
##
## Then pass that image-file-URL to the 'show_image_forPicURL' proc.
##
## CALLED BY: proc 'Retrieve'
##+#########################################################################
proc get_doonesbury_comic {yyyy mm dd} {
## FOR TESTING: (to dummy out this proc)
# return
## For Input:
global aRtext
#################################################
## Set the directory-URL that we will use.
#################################################
# scan $dd %d D
# scan $mm %d M
set TEMPurlDIR "http://www.gocomics.com/doonesbury/${yyyy}/${mm}/${dd}/"
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_doonesbury_comic' used date"
puts "yyyy: $yyyy mm: $mm dd: $dd"
puts "to build a 'directory-URL'"
puts "TEMPurlDIR: $TEMPurlDIR"
}
########################################################################
## Check for a too-old date (before 2004).
########################################################################
if {$yyyy < 2004} {
set VARyear 2004
set VARmonth 01
set VARday 05
set ERRmsg "\
The date you used ($yyyy $mm $dd) is PROBABLY TOO OLD for THIS SITE-and-PROCEDURE.
The 'directory-URL' that this 'get_doonesbury_comic' procedure tries to find ---
$TEMPurlDIR
--- probably does not exist. (The date is older than 2004.)
Try a more recent date --- like $VARyear $VARmonth $VARday.
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
## END OF date-too-old-check
###########################################################################
## Read from Doonesbury archive site 'www.gocomics.com/doonesbury/':
## Using the 'directory-URL'
## www.gocomics.com/doonesbury/${yyyy}/${mm}/${dd}/
## get the HTML text that contains a link to that day's comic image file.
##
## (This technique may need to be changed if the site comic archive changes.)
###########################################################################
## To help catch cases where the user has not established a
## network connection yet, we use a catch' statement like:
##
## if {[catch {$command} CatchMsg] != 0} {..show an err msg.. ; return}
###########################################################################
http::config -useragent "Mozilla/1.0" -accept "image/gif,image/jpeg,text/*"
#################################################
## Check for error from the http::geturl command.
#################################################
set RETcode [catch { set TEMPurlID [http::geturl "$TEMPurlDIR"] } CatchMsg]
if {$RETcode != 0} {
popmsg_forFailedGetURL "$TEMPurlDIR" "$CatchMsg" $RETcode
return
}
if {[http::ncode $TEMPurlID] == 404} {
popmsg_forFailedGetURL "$TEMPurlDIR" "" 404
return
}
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_doonesbury_comic' used 'http::geturl' on the 'directory-URL'"
puts "$TEMPurlDIR"
puts "to get the URL-ID"
puts "TEMPurlID: $TEMPurlID"
}
#################################################
## Get the text of the HTML file.
#################################################
set HTMLtext [http::data $TEMPurlID]
## FOR TESTING: (WARNING: This can be many screen-fulls of text lines.)
if {0} {
puts ""
puts "PROC 'get_doonesbury_comic' used 'http::data' on the URL-ID $TEMPurlID"
puts "to get the following HTML text."
puts "HTMLtext: $HTMLtext"
}
## We don't need TEMPurlID any more.
http::cleanup $TEMPurlID
###############################################################################
## Use 'regexp' to get the URL of the yyyy-mm-dd image file
## from the HTML text.
## Reference: pages 158-162 of the 4th edition of
## 'Practical Programming in Tcl & Tk'.
## Syntax:
## regexp ?flags? pattern string ?match sub1 sub2 ...?
##
## (This technique may need to be changed if the site comic archive changes.)
###############################################################################
regexp -nocase {class="feature_item".*?src="([^"]+)"} "$HTMLtext" to picURL
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_doonesbury_comic' used 'regexp' on HTML text"
puts "to extact the URL of the desired image-file"
puts "picURL: $picURL"
}
## Typical picURL value for www.gocomics.com/doonesbury/:
## http://assets.amuniversal.com/fee42e407aff0131fb33005056a9545d
##########################################################
## Pass the picURL to proc 'show_image_forPicURL' --- to
## get the image data of the specified day's comic strip
## and display it on the 'canvas' widget.
##########################################################
show_image_forPicURL GIF "$picURL"
}
## END OF proc 'get_doonesbury_comic"
##+#########################################################################
## PROC 'get_rhymeswithorange_comic'
##+#########################################################################
## PURPOSE: For a comic 'index' specification (VARyear,VARmonth,VARday),
## retrieve the indicated comic from 'rhymeswithorange.com/comics/'
## --- and display it on the Tk 'canvas' widget.
##
## FETCH TECHNIQUE:
## Rhymes With Orange comics (1996 to 2014-plus) at
## 'http://rhymeswithorange.com/comics/'
## are referenced via links on web pages whose 'directory-URL' is of
## the form
## http://rhymeswithorange.com/comics/march-5-2014/
##
## For a given date yyyy-mm-dd, we should be able to set
## set NAMEmonth [get_month_name $mm]
## scan $dd %d NUMday
## where 'get_month_name' is a proc in this script,
## to build 'directory-URL'
## rhymeswithorange.com/comics/${NAMEmonth}-${NUMday}-$yyyy/
##
## Then get HTMLtext returned via that directory-URL
## and scan the text of the page for strings
## class="entry-content"
## and
## src=" (and an ending double-quote)
## to get the URL of the GIF image file.
##
## Typical URL of the GIF image file:
## http://safr.kingfeatures.com/idn/etv/zone/xml/content.php?file=aHR0cDovL3NhZnIua2luZ2ZlYXR1cmVzLmNvbS9SaHltZXNXaXRoT3JhbmdlLzIwMTQvMDMvUmh5bWVzX3dpdGhfT3JhbmdlLjIwMTQwMzA1XzkwMC5naWY=
##
## Then pass that image-file-URL to the 'show_image_forPicURL' proc.
##
## CALLED BY: proc 'Retrieve'
##+#########################################################################
proc get_rhymeswithorange_comic {yyyy mm dd} {
## FOR TESTING: (to dummy out this proc)
# return
## For Input:
global aRtext
#################################################
## Set the directory-URL that we will use.
#################################################
set NAMEmonth [get_month_name $mm]
scan $dd %d NUMday
set TEMPurlDIR "http://rhymeswithorange.com/comics/${NAMEmonth}-${NUMday}-$yyyy/"
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_rhymeswithorange_comic' used date"
puts "yyyy: $yyyy mm: $mm dd: $dd"
puts "to build 'directory-URL'"
puts "TEMPurlDIR: $TEMPurlDIR"
}
########################################################################
## Check for a too-old date (before 1996).
########################################################################
if {$yyyy < 1996} {
set VARyear 1996
set VARmonth 01
set VARday 05
set ERRmsg "\
The date you used ($yyyy $mm $dd) is PROBABLY TOO OLD for THIS SITE-and-PROCEDURE.
The 'directory-URL' that this 'get_rhymeswithorange_comic' procedure tries to find ---
$TEMPurlDIR
--- probably does not exist. (The date is older than 1996.)
Try a more recent date --- like $VARyear $VARmonth $VARday.
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
## END OF date-too-old-check
###########################################################################
## Read from the site rhymeswithorange.com --- a month-d-yyyy page ---
## and get the HTML text that contains a link to that day's comic image file.
##
## Example page URL:
## http://rhymeswithorange.com/comics/march-5-2014/
##
## (This technique may need to be changed if the site comic archive changes.)
###########################################################################
## To help catch cases where the user has not established a
## network connection yet, we use a catch' statement like:
##
## if {[catch {$command} CatchMsg] != 0} {..show an err msg.. ; return}
###########################################################################
http::config -useragent "Mozilla/1.0" -accept "image/gif,image/jpeg,text/*"
#################################################
## Check for error from the http::geturl command.
#################################################
set RETcode [catch { set TEMPurlID [http::geturl "$TEMPurlDIR"] } CatchMsg]
if {$RETcode != 0} {
popmsg_forFailedGetURL "$TEMPurlDIR" "$CatchMsg" $RETcode
return
}
if {[http::ncode $TEMPurlID] == 404} {
popmsg_forFailedGetURL "$TEMPurlDIR" "" 404
return
}
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_rhymeswithorange_comic' used 'http::geturl' on 'directory-URL'"
puts "$TEMPurlDIR"
puts "to get URL-ID"
puts "TEMPurlID: $TEMPurlID"
}
#################################################
## Get the text of the HTML file.
#################################################
set HTMLtext [http::data $TEMPurlID]
## FOR TESTING: (WARNING: This can be many screen-fulls of text lines.)
if {0} {
puts ""
puts "PROC 'get_rhymeswithorange_comic' used 'http::data' on URL-ID $TEMPurlID"
puts "to get the following HTML text."
puts "HTMLtext: $HTMLtext"
}
## We don't need TEMPurlID any more.
http::cleanup $TEMPurlID
###############################################################################
## Use 'regexp' to get the URL of the yyyy-mm-dd image file
## from the HTML text.
## Reference: pages 158-162 of the 4th edition of
## 'Practical Programming in Tcl & Tk'.
## Syntax:
## regexp ?flags? pattern string ?match sub1 sub2 ...?
##
## (This technique may need to be changed if the site comic archive changes.)
###############################################################################
regexp -nocase {class="entry-content".*?src="([^"]+)"} "$HTMLtext" to picURL
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_rhymeswithorange_comic' used 'regexp' on HTML text"
puts "to extract the URL of the desired image file"
puts "picURL: $picURL"
}
## Typical picURL value for rhymeswithorange.com:
## http://safr.kingfeatures.com/idn/etv/zone/xml/content.php?file=aHR0cDovL3NhZnIua2luZ2ZlYXR1cmVzLmNvbS9SaHltZXNXaXRoT3JhbmdlLzIwMTQvMDMvUmh5bWVzX3dpdGhfT3JhbmdlLjIwMTQwMzA1XzkwMC5naWY=
##########################################################
## Pass the picURL to proc 'show_image_forPicURL' --- to
## get the image data of the specified day's comic strip
## and display it on the 'canvas' widget.
##########################################################
show_image_forPicURL GIF "$picURL"
}
## END OF proc 'get_rhymeswithorange_comic"
##+#########################################################################
## PROC 'get_speedbump_comic'
##+#########################################################################
## PURPOSE: For a comic 'index' specification (VARyear,VARmonth,VARday),
## retrieve the indicated comic from 'www.gocomics.com/speedbump/'
## --- and display it on the Tk 'canvas' widget.
##
## FETCH TECHNIQUE:
## Speed Bump comics (1999 to 2014-plus) at 'www.gocomics.com/speedbump/'
## are referenced via links on web pages whose 'directory-URL' is of
## the form
## http://www.gocomics.com/speedbump/2014/03/01/
##
## For a given date yyyy-mm-dd, we should be able
## to do something like build 'directory-URL'
## http://www.gocomics.com/speedbump/${yyyy}/${mm}/${dd}/
##
## Then get HTMLtext returned via that directory-URL
## and scan the text of the page for strings
## class="feature_item"
## and
## src=" (and an ending double-quote)
## to get the URL of the GIF image file.
##
## Typical value thus found for URL of the GIF image file:
## http://assets.amuniversal.com/335222d079470131f9e9005056a9545d
##
## Then pass that image-file-URL to the 'show_image_forPicURL' proc.
##
## CALLED BY: proc 'Retrieve'
##+#########################################################################
proc get_speedbump_comic {yyyy mm dd} {
## FOR TESTING: (to dummy out this proc)
# return
## For Input:
global aRtext
#################################################
## Set the directory-URL that we will use.
#################################################
set TEMPurlDIR "http://www.gocomics.com/speedbump/${yyyy}/${mm}/${dd}/"
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_speedbump_comic' used date"
puts "yyyy: $yyyy mm: $mm dd: $dd"
puts "to build 'directory-URL'"
puts "TEMPurlDIR: $TEMPurlDIR"
}
########################################################################
## Check for a too-old date (before 1999).
########################################################################
if {$yyyy < 1999} {
set VARyear 1999
set VARmonth 01
set VARday 05
set ERRmsg "\
The date you used ($yyyy $mm $dd) is PROBABLY TOO OLD for THIS SITE-and-PROCEDURE.
The 'directory-URL' that this 'get_speedbump_comic' procedure tries to find ---
$TEMPurlDIR
--- probably does not exist. (The date is older than 1999.)
Try a more recent date --- like $VARyear $VARmonth $VARday.
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
## END OF date-too-old-check
###########################################################################
## Read from a speedbump archive site 'gocomics.com/speedbump/':
## Using the 'directory-URL'
## www.gocomics.com/speedbump/${yyyy}/${mm}/${dd}/
## and get the HTML text that contains a link to that day's comic image file.
##
## (This technique may need to be changed if the location of the HTML text changes.)
###########################################################################
## To help catch cases where the user has not established a
## network connection yet, we use a catch' statement like:
##
## if {[catch {$command} CatchMsg] != 0} {..show an err msg.. ; return}
###########################################################################
http::config -useragent "Mozilla/1.0" -accept "image/gif,image/jpeg,text/*"
#################################################
## Check for error from the http::geturl command.
#################################################
set RETcode [catch { set TEMPurlID [http::geturl "$TEMPurlDIR"] } CatchMsg]
if {$RETcode != 0} {
popmsg_forFailedGetURL "$TEMPurlDIR" "$CatchMsg" $RETcode
return
}
if {[http::ncode $TEMPurlID] == 404} {
popmsg_forFailedGetURL "$TEMPurlDIR" "" 404
return
}
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_speedbump_comic' used 'http::geturl' on 'directory-URL'"
puts "$TEMPurlDIR"
puts "to get URL-ID"
puts "TEMPurlID: $TEMPurlID"
}
#################################################
## Get the text of the HTML file.
#################################################
set HTMLtext [http::data $TEMPurlID]
## FOR TESTING: (WARNING: This can be many screen-fulls of text lines.)
if {0} {
puts ""
puts "PROC 'get_speedbump_comic' used 'http::data' on URL-ID $TEMPurlID"
puts "to get the following HTML text."
puts "HTMLtext: $HTMLtext"
}
## We don't need TEMPurlID any more.
http::cleanup $TEMPurlID
###############################################################################
## Use 'regexp' to get the URL of the yyyy-mm-dd image file
## from the HTML text.
## Reference: pages 158-162 of the 4th edition of
## 'Practical Programming in Tcl & Tk'.
## Syntax:
## regexp ?flags? pattern string ?match sub1 sub2 ...?
##
## (This technique may need to be changed if the HTML text format changes.)
###############################################################################
regexp -nocase {class="feature_item".*?src="([^"]+)"} "$HTMLtext" to picURL
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_speedbump_comic' used 'regexp' on HTML text"
puts "to extract the URL of the desired image file"
puts "picURL: $picURL"
}
## Typical picURL value for www.gocomics.com/speedbump/:
## http://assets.amuniversal.com/335222d079470131f9e9005056a9545d
##########################################################
## Pass the picURL to proc 'show_image_forPicURL' --- to
## get the image data of the specified day's comic strip
## and display it on the 'canvas' widget.
##########################################################
show_image_forPicURL GIF "$picURL"
}
## END OF proc 'get_speedbump_comic"
##+#########################################################################
## PROC 'get_zits_comic'
##+#########################################################################
## PURPOSE: For a comic 'index' specification (VARyear,VARmonth,VARday),
## retrieve the indicated comic from 'zitscomics.com/comics/'
## --- and display it on the Tk 'canvas' widget.
##
## FETCH TECHNIQUE:
## Zits comics (2005 to 2014-plus) at 'zitscomics.com/comics/'
## are referenced via links on web pages whose 'directory-URL' is of
## the form
## http://zitscomics.com/comics/march-5-2014/
##
## For a given date yyyy-mm-dd, we should be able to set
## set NAMEmonth [get_month_name $mm]
## scan $dd %d NUMday
## where 'get_month_name' is a proc in this script,
## to build 'directory-URL'
## zitscomics.com/comics/${NAMEmonth}-${NUMday}-$yyyy/
##
## Then get HTMLtext returned via that directory-URL
## and scan the text of the page for strings
## class="entry-content"
## and
## src=" (and an ending double-quote)
## to get the URL of the GIF image file.
##
## Typical value found for the URL of the GIF file:
## http://safr.kingfeatures.com/idn/etv/zone/xml/content.php?file=aHR0cDovL3NhZnIua2luZ2ZlYXR1cmVzLmNvbS9aaXRzLzIwMTQvMDMvWml0cy4yMDE0MDMwNV85MDAuZ2lm
##
## Then pass that image-file-URL to the 'show_image_forPicURL' proc.
##
## CALLED BY: proc 'Retrieve'
##+#########################################################################
proc get_zits_comic {yyyy mm dd} {
## FOR TESTING: (to dummy out this proc)
# return
## For Input:
global aRtext
#################################################
## Set the directory-URL that we will use.
#################################################
set NAMEmonth [get_month_name $mm]
scan $dd %d NUMday
set TEMPurlDIR "http://zitscomics.com/comics/${NAMEmonth}-${NUMday}-$yyyy/"
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_zits_comic' used the date"
puts "yyyy: $yyyy mm: $mm dd: $dd"
puts "to build 'directory-URL'"
puts "TEMPurlDIR: $TEMPurlDIR"
}
########################################################################
## Check for a too-old date (before 2005).
########################################################################
if {$yyyy < 2005} {
set VARyear 2005
set VARmonth 01
set VARday 05
set ERRmsg "\
The date you used ($yyyy $mm $dd) is PROBABLY TOO OLD for THIS SITE-and-PROCEDURE.
The 'directory-URL' that this 'get_zits_comic' procedure tries to find ---
$TEMPurlDIR
--- probably does not exist. (The date is older than 2005.)
Try a more recent date --- like $VARyear $VARmonth $VARday.
"
popup_msgVarWithScroll .topErr "$ERRmsg"
return
}
## END OF date-too-old-check
###########################################################################
## Read from Zits archive site 'zitscomics.com/comics/' :
## Using the 'directory-URL'
## http://zitscomics.com/comics/${NAMEmonth}-${NUMday}-$yyyy/"
## get the HTML text that contains a link to that day's comic image file.
##
## (This technique may need to be changed if the HTML text format changes.)
###########################################################################
## To help catch cases where the user has not established a
## network connection yet, we use a catch' statement like:
##
## if {[catch {$command} CatchMsg] != 0} {..show an err msg.. ; return}
###########################################################################
http::config -useragent "Mozilla/1.0" -accept "image/gif,image/jpeg,text/*"
#################################################
## Check for error from the http::geturl command.
#################################################
set RETcode [catch { set TEMPurlID [http::geturl "$TEMPurlDIR"] } CatchMsg]
if {$RETcode != 0} {
popmsg_forFailedGetURL "$TEMPurlDIR" "$CatchMsg" $RETcode
return
}
if {[http::ncode $TEMPurlID] == 404} {
popmsg_forFailedGetURL "$TEMPurlDIR" "" 404
return
}
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_zits_comic' used 'http::geturl' on the 'directory-URL'"
puts "$TEMPurlDIR"
puts "to get URL-ID"
puts "TEMPurlID: $TEMPurlID"
}
#################################################
## Get the text of the HTML file.
#################################################
set HTMLtext [http::data $TEMPurlID]
## FOR TESTING: (WARNING: This can be many screen-fulls of text lines.)
if {0} {
puts ""
puts "PROC 'get_zits_comic' used 'http::data' on URL-ID $TEMPurlID"
puts "to get the following HTML text."
puts "HTMLtext: $HTMLtext"
}
## We don't need TEMPurlID any more.
http::cleanup $TEMPurlID
###############################################################################
## Use 'regexp' to get the URL of the yyyy-mm-dd image file
## from the HTML text.
## Reference: pages 158-162 of the 4th edition of
## 'Practical Programming in Tcl & Tk'.
## Syntax:
## regexp ?flags? pattern string ?match sub1 sub2 ...?
##
## (This technique may need to be changed if the site comic archive changes.)
###############################################################################
regexp -nocase {class="entry-content".*?src="([^"]+)"} "$HTMLtext" to picURL
## FOR TESTING:
if {0} {
puts ""
puts "PROC 'get_zits_comic' used 'regexp' on HTML text"
puts "to extract the URL of the desired image file"
puts "picURL: $picURL"
}
## Typical picURL value for zitscomics.com:
## http://safr.kingfeatures.com/idn/etv/zone/xml/content.php?file=aHR0cDovL3NhZnIua2luZ2ZlYXR1cmVzLmNvbS9aaXRzLzIwMTQvMDMvWml0cy4yMDE0MDMwNV85MDAuZ2lm
##########################################################
## Pass the picURL to proc 'show_image_forPicURL' --- to
## get the image data of the specified day's comic strip
## and display it on the 'canvas' widget.
##########################################################
show_image_forPicURL GIF "$picURL"
}
## END OF proc 'get_zits_comic"
##+#########################################################################
## PROC 'save_image_toLocalFile'
##+#########################################################################
## PURPOSE: Writes an image file to directory DIRtemp using
## image data from the Tk 'photo' image 'structure'
## with the 'handle' --- imageID.
##
## CALLED BY: the 'SaveAsGIF' button
##+#########################################################################
proc save_image_toLocalFile {} {
global DIRtemp imageID VIEWER4images \
ENTRYsite VARyear VARmonth VARday fileMIDNAME aRtext
# global picDATA
## FOR TESTING: (to dummy out this proc)
# return
################################################
## If 'imageID' does not exist, exit gracefully.
################################################
if {![info exists imageID]} {return}
########################################
## Make the filename for the GIF file.
########################################
## FROM http://wiki.tcl.tk/8899 :
# set filename [clock format [clock seconds] -format "dil_img/dilbert%Y%m%d$ext"]
# set comicNUM [clock seconds]
# set TEMPfilename "$DIRtemp/comic_${comicNUM}.gif"
set TEMPfilename "$DIRtemp/comic_${fileMIDNAME}_${VARyear}_${VARmonth}_${VARday}.gif"
## FOR TESTING:
# puts "TEMPfilename: $TEMPfilename"
##########################################################
## WRITE the GIF file.
##########################################################
## The technique used by 's_m' at http://wiki.tcl.tk/8899 :
##
## set fileID [open "$TEMPfilename" w]
## fconfigure $fileID -translation binary -encoding binary
## puts $fileID $picDATA
## close $fileID
##########################################################
## For using '-format' to assure that a GIF file is written,
## see pages 629-631 of the 4th edition of
## 'Practical Programming in Tcl & Tk'.
##########################################################
$imageID write "$TEMPfilename" -format gif
#######################################################
## Tell the user the location and name of the GIF file.
#######################################################
set LOCmsg "$aRtext(popupMSGsavedGIF1)
$TEMPfilename"
popup_msgVarWithScroll .topLoc "$LOCmsg"
#######################################################
## OPTIONAL.
## Confirm that the GIF file was written, by
## showing the file in an 'external' image viewer.
#######################################################
## We use a 'background' run --- per page 107 of the
## 4th edition of 'Practical Programming in Tcl & Tk', where
## there is the following quote on the Tcl 'exec' command and
## 'background' mode:
##
## "A trailing '&' causes the program to run in the background.
## In this case, the process identifier is returned by the 'exec'
## command. Otherwise, the 'exec' command blocks during execution
## of the program, and the standard output of the program is the
## return code of 'exec'."
##
## We use 'eval' to avoid a 'not found' error when we append
## some parms (or a space) to the viewer command.
###############################################################
if {0} {
catch {eval exec $VIEWER4images "$TEMPfilename" &} ViewerPID
## FOR TESTING:
# puts "VARcommand: $VARcommand"
# puts "ViewerPID: $ViewerPID"
}
## END OF if {0/1} section
}
## END OF proc 'save_image_toLocalFile'
##+#########################################################################
## PROC 'date_increment'
##+#########################################################################
## PURPOSE: Increases the date by one day --- by updating the
## VARyear, VARmonth, VARday entry ariables.
##
## CALLED BY: the '>' button
##+#########################################################################
proc date_increment {} {
global VARyear VARmonth VARday
## FOR TESTING: (to dummy out this proc)
# return
## Remove leading zeros (if any) from VARmonth and
## VARday --- to avoid 'invalid octal number' errors
## from '08' and above. Ref: http://wiki.tcl.tk/15158
# set VARmonth [string trimleft $VARmonth 0]
# if { "$VARmonth" == "" } {set VARmonth 0}
# set VARday [string trimleft $VARday 0]
# if { "$VARday" == "" } {set VARday 0}
## Convert text VAR strings to numeric variables.
# set NUMyear [expr {int($VARyear)}]
# set NUMmonth [expr {int($VARmonth)}]
# set NUMday [expr {int($VARday)}]
## Alternatively, use 'scan'. Ref: http://wiki.tcl.tk/948
set NUMyear [ scan $VARyear %d ]
set NUMmonth [ scan $VARmonth %d ]
set NUMday [ scan $VARday %d ]
## Increment num-days.
incr NUMday
## Handle day-overflow for months 9,4,6,11.
if {$NUMmonth == 9 || $NUMmonth == 4 || \
$NUMmonth == 6 || $NUMmonth == 11} {
if {$NUMday > 30} {
set NUMday 1
incr NUMmonth
if {$NUMmonth > 12} {
set NUMmonth 1
incr NUMyear
}
}
## END OF if {$NUMday > 30}
## Reset VARyear VARmonth VARday before 'return'.
set VARyear [format "%04d" $NUMyear]
set VARmonth [format "%02d" $NUMmonth]
set VARday [format "%02d" $NUMday]
return
}
## END OF if $NUMmonth == 9,4,6,11
## Handle day-overflow for the other months, except 2
## --- months 1,3,5,7,8,10,12.
if {$NUMmonth == 1 || $NUMmonth == 3 || $NUMmonth == 5 || \
$NUMmonth == 7 || $NUMmonth == 8 || $NUMmonth == 10 || \
$NUMmonth == 12 } {
if {$NUMday > 31} {
set NUMday 1
incr NUMmonth
if {$NUMmonth > 12} {
set NUMmonth 1
incr NUMyear
}
}
## END OF if {$NUMday > 30}
## Reset VARyear VARmonth VARday before 'return'.
set VARyear [format "%04d" $NUMyear]
set VARmonth [format "%02d" $NUMmonth]
set VARday [format "%02d" $NUMday]
return
}
## END OF if $NUMmonth == 1,3,5,7,8,10,12.
## Handle day-overflow for month 2.
if {[expr {$NUMyear % 4}] == 0} {
## For leap year:
if {$NUMday > 29} {
set NUMday 1
incr NUMmonth
if {$NUMmonth > 12} {
set NUMmonth 1
incr NUMyear
}
}
## END OF if {$NUMday > 29}
} else {
## For non-leap year:
if {$NUMday > 28} {
set NUMday 1
incr NUMmonth
if {$NUMmonth > 12} {
set NUMmonth 1
incr NUMyear
}
}
## END OF if {$NUMday > 28}
}
## END OF if {[expr {$NUMyear % 4}] == 0}
## Reset VARyear VARmonth VARday before 'return'.
set VARyear [format "%04d" $NUMyear]
set VARmonth [format "%02d" $NUMmonth]
set VARday [format "%02d" $NUMday]
}
## END OF proc 'date_increment'
##+#########################################################################
## PROC 'date_decrement'
##+#########################################################################
## PURPOSE: Decreases the date by one day --- by updating the
## VARyear, VARmonth, VARday entry ariables.
##
## CALLED BY: the '<' button
##+#########################################################################
proc date_decrement {} {
global VARyear VARmonth VARday
## FOR TESTING: (to dummy out this proc)
# return
## Remove leading zeros (if any) from VARmonth and
## VARday --- to avoid 'invalid octal number' errors
## from '08' and above. Ref: http://wiki.tcl.tk/15158
# set VARmonth [string trimleft $VARmonth 0]
# if { "$VARmonth" == "" } {set VARmonth "0"}
# set VARday [string trimleft $VARday 0]
# if { "$VARday" == "" } {set VARday "0"}
## Convert text VAR strings to numeric variables.
# set NUMyear [expr {int($VARyear)}]
# set NUMmonth [expr {int($VARmonth)}]
# set NUMday [expr {int($VARday)}]
## Alternatively, use 'scan'. Ref: http://wiki.tcl.tk/948
set NUMyear [ scan $VARyear %d ]
set NUMmonth [ scan $VARmonth %d ]
set NUMday [ scan $VARday %d ]
## DEcrement num-days.
incr NUMday -1
## Handle day-UNDERflow for months 9+1,4+1,6+1,11+1.
if {$NUMmonth == 10 || $NUMmonth == 5 || \
$NUMmonth == 7 || $NUMmonth == 12} {
if {$NUMday < 1} {
set NUMday 30
incr NUMmonth -1
if {$NUMmonth < 1} {
set NUMmonth 12
incr NUMyear -1
}
}
## END OF if {$NUMday < 1}
## Reset VARyear VARmonth VARday before 'return'.
set VARyear [format "%04d" $NUMyear]
set VARmonth [format "%02d" $NUMmonth]
set VARday [format "%02d" $NUMday]
return
}
## END OF if $NUMmonth == 9+1,4+1,6+1,11+1.
## Handle day-UNDERflow for the other months, except 2+1
## --- months 1+1,3+1,5+1,7+1,8+1,10+1,12+1(=1).
if {$NUMmonth == 2 || $NUMmonth == 4 || $NUMmonth == 6 || \
$NUMmonth == 8 || $NUMmonth == 9 || $NUMmonth == 11 || \
$NUMmonth == 1 } {
if {$NUMday < 1} {
set NUMday 31
incr NUMmonth -1
if {$NUMmonth < 1} {
set NUMmonth 12
incr NUMyear -1
}
}
## END OF if {$NUMday < 1}
## Reset VARyear VARmonth VARday before 'return'.
set VARyear [format "%04d" $NUMyear]
set VARmonth [format "%02d" $NUMmonth]
set VARday [format "%02d" $NUMday]
return
}
## END OF if $NUMmonth == 1,3,5,7,8,10,12.
## Handle day-UNDERflow for month 2+1(=3).
if {[expr {$NUMyear % 4}] == 0} {
## For leap year:
if {$NUMday < 1} {
set NUMday 29
incr NUMmonth -1
if {$NUMmonth < 1} {
set NUMmonth 12
incr NUMyear -1
}
}
## END OF if {$NUMday < 1}
} else {
## For non-leap year:
if {$NUMday < 1} {
set NUMday 28
incr NUMmonth -1
if {$NUMmonth < 1} {
set NUMmonth 12
incr NUMyear -1
}
}
## END OF if {$NUMday < 1}
}
## END OF if {[expr {$NUMyear % 4}] == 0}
## Reset VARyear VARmonth VARday before 'return'.
set VARyear [format "%04d" $NUMyear]
set VARmonth [format "%02d" $NUMmonth]
set VARday [format "%02d" $NUMday]
}
## END OF proc 'date_decrement'
##+########################################################################
## 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 } {
## 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 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 || $VARwidth > 80} {
text $toplevName.text \
-wrap none \
-font fontTEMP_fixedwidth \
-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 || $VARwidth > 80} {
## Pack the scrollbars BEFORE the text widget,
## so that the text does not monopolize the space.
pack $toplevName.scrolly \
-side right \
-anchor center \
-fill y \
-expand 0
## DO NOT USE '-expand 1' HERE on the Y-scrollbar.
## THAT ALLOWS Y-SCROLLBAR TO EXPAND AND PUTS
## BLANK SPACE BETWEEN Y-SCROLLBAR & THE TEXT AREA.
pack $toplevName.scrollx \
-side bottom \
-anchor center \
-fill x \
-expand 0
## DO NOT USE '-expand 1' HERE on the X-scrollbar.
## THAT KEEPS THE TEXT AREA FROM EXPANDING.
pack $toplevName.text \
-side top \
-anchor center \
-fill both \
-expand 1
} else {
pack $toplevName.text \
-side top \
-anchor center \
-fill both \
-expand 1
}
#####################################
## LOAD MSG INTO TEXT WIDGET.
#####################################
## $toplevName.text delete 1.0 end
$toplevName.text insert end $VARtext
$toplevName.text configure -state disabled
}
## END OF PROC 'popup_msgVarWithScroll'
##+########################################################################
## PROC 'popup_msgVarWithScroll_wait'
##+########################################################################
## PURPOSE: Report error conditions to the user.
## Sets 'focus' on this toplevel window, does a 'grab',
## and does 'tkwait' so that execution stops until the
## user responds to this window.
##
## ARGUMENTS: A toplevel frame name (such as .fRhelp or .fRerrmsg)
## and a variable holding text (many lines, if needed).
##
## CALLED BY: various procs that need to popup an error message.
##+########################################################################
proc popup_msgVarWithScroll_wait { toplevName VARtext } {
popup_msgVarWithScroll $toplevName $VARtext
focus $toplevName
grab $toplevName
tkwait window $toplevName
}
## END OF PROC 'popup_msgVarWithScroll_wait'
##+###################################################
## Set the HELP text variable for the 'Help' button.
##+###################################################
set HELPtext "\
\ \ \ \ \ ** HELP for this Get-Comics Utility **
This utility offers a GUI with which the user can
- choose a comics archive site (such as dilbert.com or
gocomics.com/doonesbury/)
and
- use a 'Retrieve' button on the GUI to retrieve one comic at
a time from the site.
A particular comic at a site is selected by a date (or some other
type of 'index'), where the date (or other index) is user-selected
via widgets on the GUI.
(Since each site will generally have a different way of
archiving comics on the site, the way to specify a
particular comic will, in general, depend on the storage
and access methods of the site. Fortunately, year-month-day is
a sufficient index to the individual comics for many sites.)
A 'canvas' widget on the GUI is used to display the comic
--- if it is a GIF file.
(If the web-site stores the comics in another file format,
such as JPEG-JFIF, this code will run the utility
ImageMagick 'convert' to convert the retrieved file
to a GIF file --- and display that file.)
There are horizontal and vertical scroll bars on the canvas, to
allow for scrolling the comic if it is bigger (horizontally or
vertically) than the maximum size of the canvas --- which is
determined by the size of the user's computer monitor.
A 'SaveAsGIF' button on the GUI offers the user the option to save
each comic as a file on the user's local computer storage devices.
(The Tcl-Tk code that implements this utility automatically
puts the file in the /tmp directory --- from which the user
can transfer the file to another directory.
The temporary-directory location can be changed by changing the
setting of the 'DIRtemp' variable at the bottom of this code.)
***********************
TYPICAL OPERATION STEPS: (with details)
***********************
---------------------
STEP 1 - Pick a comic:
---------------------
A 'listbox' on the GUI offers a list of comic archive sites
from which to choose.
Click on a line of the listbox to choose a web-site. The
web-site identifier is between the '@' character and the
hash-mark character (#) of each line.
The web-site identifier is a name like 'dilbert.com' or
'gocomics.com/doonesbury/'.
After the '#' character are comments that describe the web-site.
Before the '@' character is a brief name indicating the
comic --- such as 'Dilbert' or 'Baby Blues (1996-2002)'.
A name like 'Agnes (2002+)' indicates the comics are available
from 2002 up to the present.
(A '#' in column 1 of the line makes the entire line a comment
line --- for example, to allow for indicating comics for which
retrieval has not been implemented, and reminding the user
to keep looking for a method to retrieve those comics.)
---------------------
STEP 2 - Pick a date:
---------------------
Date fields (year,month,day) provide the user a way to
select a specific comic to retrieve --- if a web site
supports retrieval by date.
(If some sites offer a different way, from year-month-day,
of identifying individual comics, this code could
activate a different widget --- or widgets --- by which
to specify a comic --- according to the site selected
by the user.
In that case, 'comic selection widgets' on the GUI may have
to be activated/deactivated according to the site selected.)
The '-' and '+' buttons on either side of the Day entry field
facilitate quickly scanning through cartoons of a given site,
by successive days.
You can skip to a different year or month by simply entering
a new number in the Year or Month entry fields.
-------------------
STEP 3 - 'Retrieve':
--------------------
After each date is set, click on the 'Retrieve' button to
display the corresponding comic.
The 'Retrieve' button causes a series of Tcl 'http' commands
to be issued, commands such as
- http::config
- http::geturl
- http::data
- http::cleanup
to get the comic file (GIF) data and display it in the canvas.
Occasionally, at a comic archive site, there may not be
a comic for a specified date. In that case, you may see
an error message popup in a window. Simply dismiss the
window and try another date.
***********************
Tcl PACKAGE REQUIREMENT:
***********************
A 'package require http' statement is used (in the code) to
determine whether the Tcl 'http' package is available. A
popup message window will inform you if you need to install
the Tcl 'http' package.
"
## END of setting var 'HELPtext'.
##+#####################################################
## The Additional-GUI-Initialization SECTION:
##+#####################################################
##+######################################################
## Set a default directory for the saved image files.
##+######################################################
set DIRtemp "/tmp"
##+######################################################
## Set an 'external' image viewer to be used to show
## image files. (May be used in the SaveAsGIF proc.)
##+######################################################
# set VIEWER4images "/usr/bin/ffplay"
# set VIEWER4images "/usr/bin/display"
set VIEWER4images "/usr/bin/eog"
##+###########################################################
## Initialize the year, month, day entry field variables.
##+###########################################################
# set YMDstring [clock format [clock seconds] -format "%Y %b %m"]
set VARyear [clock format [clock seconds] -format "%Y"]
set VARmonth [clock format [clock seconds] -format "%m"]
set VARday [clock format [clock seconds] -format "%d"]
##+###########################################################
## AFTER the initialized GUI is displayed, check that the
## Tcl 'http' package is available.
##+###########################################################
if {[catch {package require http} CatchMsg]} {
set ERRmsg "$aRtext(popupMSGhttpREQUIRE)
$aRtext(popupMSGerrMsg)$CatchMsg"
popup_msgVarWithScroll .topErr "$ERRmsg"
}
INSTALLING THE SCRIPT:For this 'get-comics' utility, a SINGLE Tk script can be put in a sub-directory of the user's home directory, such as $HOME/apps/tkGetComics.Then the user can use their desktop system (such as Gnome or KDE) to set up the Tk script as an icon on the desktop. Then the user can click on the icon to startup the GUI.
SOME POSSIBLE ENHANCEMENTSThis Tk script is the first utility that I have added to the bottom of my 'bio' page at uniquename --- in the 'CNP' (Code using Network Protocols) group.I have many more scripts in various states of development --- in the other categories of 'done and to-do' projects on my 'bio' page.But I may return to this 'get-comics' Tk script to provide some enhancements, such as:More Warning/Error PopupsIn using this utility, I may discover error conditions that I did not encounter in testing. I may add ways to 'trap' the errors and provide some pop-up messages in addition to the ones I already implemented during the testing phase.Additonal ComicsSome additional comics may be added. This involves adding 'listbox' entries and adding a 'get_*_comic' proc for each new comic archive site.JPEG SupportSome sites provide comics in JPEG-JFIF format rather than GIF format. In those cases, I could add some code, using the ImageMagick 'convert' command, to convert the JPEG file to a GIF file ('under the covers') --- and then place the GIF image on the canvas.Accommodate web-site changesThese comic archive sites occasionally change their web pages and the ways that they store and access the comics. Some of the 'get_*_comic' routines may need to be changed in coming months/years to keep up with the web-site changes.
IN CONCLUSIONI want to thank those who authored the 'http' package ('beedub' and others?) that allowed me to avoid having to go a level lower --- into Tcl 'socket' programming.Also many thanks to 's_m' for his 2013-code to get the Dilbert comic-of-the-day.Furthermore, as I have said on several other code-donation pages on this wiki ...There's a lot to like about a utility that is 'free freedom' --- that is, no-cost and open-source so that you can modify/enhance/fix it without having to wait for someone else to do it for you (which may be never).A BIG THANK YOU to Ousterhout for starting Tcl-Tk, and a BIG THANK YOU to the Tcl-Tk developers and maintainers who have kept the simply MAH-velous 'wish' interpreter going.
uniquename 2014mar27 UPDATEI have improved the 'get_comics.tk' script in the following ways:1) ADDED some comic strips -- Agnes, BabyBlues, Bizarro --- by adding some 'get_*_comic' procs and adding lines to the site-selection listbox.2) ADDED date-range checks in all the get-comic procs, and added date-range info on the lines in the site-selection listbox.3) ADDED code to the 'show_image_forPicURL' proc to convert a nonGIF file (such as JPEG or PNG) to a GIF file before loading the image data into a Tk 'photo' image and displaying the image on the canvas.4) ADDED proc 'popmsg_forFailedGetURL' to use at 'http::geturl' statements in the 'get_*_comic' procs.5) ADDED 'http::ncode' 404 checks in the 'get_*_comic' procs.6) CHANGED '>' and '<' buttons to '+' and '-' buttons.7) ADDED an image-size label above the canvas.The following 3 images confirm that the Agnes, BabyBlues, and Bizarro comics are retrievable --- and the images show some of the (almost unnoticeable) changes to the GUI.
