Version 8 of tclscreen

Updated 2008-08-21 21:58:19 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) 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!)


#!/opt/ActiveTcl-8.5/bin/wish8.5

# tclscreen copyright tony baldwin - [email protected]

# load necessary packages

package require ftp

set ::ftp::VERBOSE 1

global filename global host global path global username global password global url

wm title . "Tickle Screen"

grid ttk::label .hq -text "Enter the remote host:"\ ttk::entry .host -textvariable host

grid ttk::label .pathq -text "Enter the path: "\ ttk::entry .path -textvariable path

grid ttk::label .unam -text "Enter your username: "\ ttk::entry .uname -textvariable username

grid ttk::label .pwrd -text "Enter your password: "\ ttk::entry .pswrd -show * -textvariable password

grid ttk::label .fname -text "Enter the filename for the image: "\ ttk::entry .filename -textvariable filename

grid ttk::button .go -text "take screenshot" -command {shoot}

proc shoot {} { exec import -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

}

grid ttk::button .send -text "upload image" -command {upshot}

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 ttk::button .url.btn.b -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 "You have not chosen a browser for this session.\
        Let's set the browser now." -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.