TclScreen

a ticklish screenshot snapper tool by tonybaldwin

tclscreen will snap a screenshot, allowing you to choose a delay and the dimensions and file format of the shot (only jpg or png).
Then it will show you a preview of the shot, and allow you to open it in your favorite editor, if you wish to edit it further.
Then, tclscreen will ftp upload your screenshot to your webserver, show you the final url, and open it in a browser to verify.

It's really quite simple, but, at the same time, very, very handy when posting screenshots to your blog.
Geeks like me enjoy that.

Tclscreen uses imagemagick “import” to take a screenshot, but I can whip out a scrot version in a jiffy if anyone wants.
I should probably write both in and allow the user to choose…
Hmmmm…I'll get on that right away…or shortly…when I get around to it.

tclscreen on freshmeat

download tclscreen

tclscreenshot20100219.jpg

#!/usr/bin/env wish8.5
 
 
# tclscreen - screencap shooter and uploader
# copyright tony baldwin - http://tonybaldwin.me
# released according to the GPL v. 3 
 
  # load necessary packages
  package require ftp
  package require Img
 
 
 set ::ftp::VERBOSE 1
 
bind . <Escape> exit
 
global filename
global host
global path
global username
global password
global url
global dlay
global novar
global hi
global wi
global browz
 
set browz "none"
 
set novar "cows"
 
set allvars [list host path username password browz novar]
 
wm title . "Tickle Screen"
 
frame .notes
 
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]
 
grid [ttk::label .fields.ht -text "Enter image dimensions in px (ie. 800X600): "]\
[ttk::entry .fields.imht -textvariable dims]
 
grid [ttk::button .fields.browz -text "Browser: " -command {setbro}]\
[ttk::entry .fields.brz -textvariable browz]
 
 
 
 
 
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.op -text "load profile" -command "openprofile"]\
[ttk::button .btns.sp -text "save profile" -command {sapo}]\
[ttk::button .btns.help -text "Help" -command {help}]\
[ttk::button .btns.out -text "QUIT" -command {exit}]
 
pack .btns -in . -fill x
 
proc shoot {} {
exec import -pause $::dlay -resize $::dims -window root $::env(HOME)/$::filename
# exec fbgrab $::filename"
image create photo screenshot -file $::env(HOME)/$::filename
 
toplevel .img
 
frame .img.p
tk::label .img.p.shot -image screenshot
frame .img.b
tk::button .img.b.ed -text "Edit in GIMP" -command {edit}
tk::button .img.b.out -text "Close preview" -command {destroy .img}
 
pack .img.p -in .img -side top
pack .img.p.shot -in .img.p -side top
pack .img.b -in .img -side top
pack .img.b.ed -in .img.b -side right
pack .img.b.out -in .img.b -side right
 
 
 
}
 
proc edit {} {
    exec gimp $::env(HOME)/$::filename &
    }
 
 
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.lbl -height 2 -width 80 
.url.lbl insert end "Your image is at http://www.$::host/$::path/$::filename"
tk::button .url.btn -text "open in browser" -command {browse}
tk::button .url.out -text "close" -command {destroy .url}
 
pack .url.lbl -in .url -side top
pack .url.btn -in .url -side bottom
pack .url.out -in .url -side bottom
 
}
 
proc setbro {} {
set filetypes " "
set ::browz [tk_getOpenFile -filetypes $filetypes -initialdir "/usr/bin"]
}
 
proc browse {} {
    if {$::browz eq "none"} {
	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 -initialdir "/usr/bin"]
	exec $brow www.$::host/$::path/$::filename &} else {
	    exec $::browz www.$::host/$::path/$::filename &
	    }
}
 
#######
# save profile/server settings
#######
 
proc sapo {} {
 
    set xanswer [tk_messageBox -message "This will save your server settings, including your password, unless you clear the field first.\n  Choose yes to change the password to 0000 and save, or no to save as is."\
 -title "B'Bye..." -type yesno -icon question]
 	if {$xanswer eq "yes"} {
	set novar "cows"
	set password "0000"
	set header "#!/usr/bin/env wish8.5 "
   set file_types {
     {".profile" {.tprof}}
    }
   set filename [tk_getSaveFile -filetypes $file_types -initialdir ~/.tclup]
   set fileid [open $filename w]
   puts $fileid $header
   foreach var $::allvars {puts $fileid [list set $var [set ::$var]]}
   close $fileid
 
  } else {
 	if {$xanswer eq "no"} {
	set novar "cows"
	set header "#!/usr/bin/env wish8.5 "
   		set file_types {
     		{".profile" {.prof}}
    		}
   set filename [tk_getSaveFile -filetypes $file_types]
   set fileid [open $filename w]
   puts $fileid $header
   foreach var $::allvars {puts $fileid [list set $var [set ::$var]]}
   close $fileid
   }
   }
} 
 
proc openprofile {} {
     set file_types {
     {"profile" {.prof}}
    }
set project [tk_getOpenFile -filetypes $file_types -initialdir ~/.tclscreen]
uplevel #0 [list source $project]
}
 
proc help {} {
toplevel .help
wm title .help "About TclScreen"
text .help.inf -width 120 -height 35
.help.inf insert end "TclScreenUP: A ticklish, quick-n-dirty screenshot snapper and uploader\nwritten by Tony Baldwin <tonytraductor@linguasos.org>\n\nThis software is released under the terms of the Gnu Public License v. 2 or later.\n\nProfile: (this is the information for your remote host)\nhost:  enter the url for your ftp server (ie: the ip address, or, domain, such as myserver.com)\ndirectory: the path to the directory to which you wish to upload files\nusername:  your username for your ftp account\npassword:  the password for your ftp account\n\nButtons:\n\n-Uploads:\nLocal file:  opens a file selection dialog to choose a file on your local file system.\nupload: \ninitiates upload to the server\nBrowser:  choose a browser to preview files once they've been uploaded\n\nLoad profile:  load a saved profile (ie. server info & browser choice)\nSave profile:  save a profile (you can have as many as you like, handy if you use multilpe servers)\n(Progress bar):  uselessly slides back and forth during upload/download...looks cool, no?\nQuit:  closes TclUP\n\nFeel free to e-mail me if you have any questions.\n\nThanks for using TclScreenUP,\nTony Baldwin"
tk::button .help.out -text "Okay" -command {destroy .help}
pack .help.out -in .help -side top
pack .help.inf -in .help -side top
}
 
# This program was written by tony baldwin - http://tonybaldwin.me 
# 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.

tonybaldwin

shortlink to this page: http://tonyb.us/tclscreen


~~DISQUS~~