2003 implementation edit
Just for fun: Get your daily Dilbert comic and display it. If you provide a directory name as argument, it'll be saved to dirname/dilbertyyyymmdd.gif where yyyymmdd is todays date.Code
package require Tk package require http package require base64 set um [http::geturl http://www.dilbert.com/] set b [split [http::data $um] "\n"] #set ln [lsearch -inline -glob $b "*ALT=?Today's Dilbert Comic*"] set ln [lsearch -inline -glob $b "*ALT=?Today's Comic*"] regexp {^.*IMG SRC=\"([^"]+)\".*$} $ln --> picurl http::cleanup $um set um [http::geturl http://www.unitedmedia.com$picurl
Discussion
Michael Jacobson: Also see Comic Server for some code to get a bunch of comic strips from uComics. Or you can check out (on windows only ~ sorry) in a TclKit application that servers the comics and display them in a embededd MSIE frame using optcl. Get the application here ... https://web.archive.org/web/20070614053050/http://mywebpages.comcast.net/jakeforce/COMon!ics.kit (96kb). (I use this code in NewzPoint)02. Aug. 2005: The Text for the Daily Dilbert comic changed. Replace the lsearch line with the following (This has already been done; the if 0 { wrapper was added to make the version grabbed by wish-reaper operate correctly):
if 0 {
set ln [lsearch -inline -glob $b "*ALT=?Today's Comic*"]
}RLH 20050802: I get the error: if 0 {
"Can't read "picurl": no such variable while executing "http::geturl http://www.unitedmedia.com$picurl"
}RS Have you applied the fix above? It worked for me after I did it.RLH I had read the post wrong and thought it was fixed above. Works now and I have commented out the old line above and added the one that works.escargo 3 Aug 2005 - Touched up the previous included text to make compatible with wish-reaper.CJL 11 July 2006 - The presence (and validity) of the optional directory name argument determined whether a file was written, but didn't affect where it was written. Fixed.2008 implementation edit
Stu 2008-10-25 The Dilbert site has changed.Here's the above functionality (minus the image saving) in two lines:Stu 2008-10-26 Updated to work on Sunday; now a one-liner.Stu 2008-10-29 Shows Loading message, centers, Double-1 to exit, improved regexp.
foreach p {Tk http base64} { package require $p }; pack [label .l -text Loading]; tk::PlaceWindow .; .l configure -image [image create photo dilbert -data [base64::encode [http::data [set tok [http::geturl [lindex [regexp -inline {http://dilbert.com/dyn/str_strip/(0+/){4}\d{5}/\d{4}/\d{3}/\d{5}/\d{5}.strip(.sunday)?.gif} [http::data [set tok [http::geturl http://www.dilbert.com/]]][http::cleanup $tok]] 0]]]][http::cleanup $tok]]]; bind . <Double-1> exit; tk::PlaceWindow .Discussion
2013 implementation (last updated 2017) edit
Download with wiki-reaper: wiki-reaper -x 8899 4 > dilbert.tclCode
s_m - my current version:#
# Show and save today's Dilbert comic strip
#
package require Tk
package require http
label .l -text Loading...
pack .l
http::config -useragent "Mozilla/1.0" -accept "image/gif,image/jpeg,text/*"
# Read dilbert.com home page and find link to today's comic
set um [http::geturl http://dilbert.com/]
regexp -nocase {comic-item-container [^>]+ data-image="([^"]+)"} [http::data $um] to picurl
http::cleanup $um
# Get today's comic strip and display the image
set um [http::geturl $picurl]
set pic [http::data $um]
http::cleanup $um
image create photo dilbert -data $pic
.l configure -image dilbert
# Save the image
if {![file isdirectory dil_img]} {
file mkdir dil_img
}
set ext [file extension $picurl]
set filename [clock format [clock seconds] -format "dil_img/dilbert%Y%m%d$ext"]
set fd [open $filename w]
fconfigure $fd -translation binary -encoding binary
puts $fd $pic
close $fd
# close after 40s
after 40000 exit
