[tonytraductor] : This screenshot is the result of a days hacking, in response to a little challenge. [http://www.linguasos.org/bsoft/nyannya.jpg] My nephew wrote this [http://staticfree.info/~samuel/nieuw/code/%|% this nifty little script %|%] little nifty script in perl that grabs a screen shot, and loads it to his webserver. Not much to it, really, but, cool, anyway, since the kid's all of 16 (but a genius). So, I looked at his script, and said, hmmm...I could do that in tcl/tk, wrap it in a gui, and give it more features. Mine (which you can see in my text editor in the screenshot) grabs a screenshot, then show the user a preview in a tcl/tk window, then allows the user to upload it to the server, then, allows the user to open the url to which it has been uploaded in a browser, just to check. The guys on #tcl at freenode were very helpful, however, so, I can't take all the credit. My nephew's script uses scp to copy the file over to the remote server, and I was able to use that here, to make an image and copy it to another machine on my network, but, my server doesn't allow ssh access, so, I had to figure out how to do it with ftp. Now, I've only used ftp with a gui client like gftp before. I could have called on lftp, or something, but, I wanted to learn to do it the tcl way, and I did (with help). But, hey: SUCCESS! WIN WIN That'll show the little upstart! (of whom I am quite proud) (bah...perl...Tcl/tk can do anything perl can, and with more grace...ha!) ------------------------------------------- #!/usr/bin/env wish8.5 # tclscreen copyright tony baldwin - tonytraductor@linguasos.org # load necessary packages package require ftp package require Img # package require ftp::geturl set ::ftp::VERBOSE 1 global filename global host global path global username global password global url global dlay wm title . "Tickle Screen" frame .notes grid [ttk::label .notes.lab -text " Enter your values for your web server or remote host\n your username and password, then click \'shoot\'.\n TclScreen will wait according to the delay you enter in seconds,\nand take a screenshot.\n You can minimize this window within that delay, etc.\n TclScreen will then show you a preview of the image.\n Then, click \'upload\' to load the image to your server.\n TclScreen will then nofity you of the url to view the image.\n You can copy the url, or just click the browser button\n to call a browser to open that url."] pack .notes -in . -fill x frame .fields grid [ttk::label .fields.hq -text "Enter the remote host:"]\ [ttk::entry .fields.host -textvariable host] grid [ttk::label .fields.pathq -text "Enter the path: "]\ [ttk::entry .fields.path -textvariable path] grid [ttk::label .fields.unam -text "Enter your username: "]\ [ttk::entry .fields.uname -textvariable username] grid [ttk::label .fields.pwrd -text "Enter your password: "]\ [ttk::entry .pswrd -show * -textvariable password] grid [ttk::label .fields.fname -text "Enter the filename for the image: "]\ [ttk::entry .fields.filename -textvariable filename] grid [ttk::label .fields.secs -text "Enter delay in seconds: "]\ [ttk::entry .fields.scnds -textvariable dlay] pack .fields -in . -fill x frame .btns grid [ttk::button .btns.go -text "shoot" -command {shoot}]\ [ttk::button .btns.send -text "upload" -command {upshot}]\ [ttk::button .btns.out -text "QUIT" -command {exit}] pack .btns -in . -fill x proc shoot {} { exec import -pause $::dlay -resize 800X600 -window root $::env(HOME)/$::filename # exec fbgrab $::filename" image create photo screenshot -file $::env(HOME)/$::filename toplevel .img # canvas .img.shot -width 800 -height 600 # .img.shot create image 200 200 -image screenshot tk::label .img.shot -image screenshot pack .img.shot -in .img } proc upshot {} { set handle [::ftp::Open $::host $::username $::password] ::ftp::Cd $handle $::path ::ftp::Put $handle $::env(HOME)/$::filename $::filename ::ftp::Close $handle toplevel .url # text .url.ad # .url.ad insert end "Your image is at www.$::host/$::path/$::filename" # frame .url.btn grid [ttk::label .url.lbl -text "Your image is at www.$::host/$::path/$::filename"]\ [ttk::button .url.btn -text "open in browser" -command {browse}] # pack .url.ad -in .url # pack .url.btn -in .url # pack .url.btn.b -in .url.btn } proc browse {} { set filetypes " " tk_messageBox -message "Choose a browser." -type ok -title "Set browser" set brow [tk_getOpenFile -filetypes $filetypes] exec $brow www.$::host/$::path/$::filename & } # This program was written by tony baldwin - tonytraductor@linguasos.org # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ----------------------------------- !!!!!! |[Category Example]| !!!!!! ----------------------------------