Version 10 of tclscreen

Updated 2008-08-22 07:10:05 by tonytraductor

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 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) waits the user configured delay, grabs a screenshot, then shows 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).


#!/usr/bin/env wish8.5

# tclscreen copyright tony baldwin - [email protected]

  # 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 - [email protected]

# 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.