| #!/bin/sh |
| # \ |
| exec wish "$0" "$@" |
| |
| # |
| # XSnap, X-Windows Snapshot. A GUI for the ImageMagick import command |
| # |
| # Software design, John Cristy (magick@dupont.com), March 1996 |
| # |
| # Copyright (C) 1999-2010 ImageMagick Studio LLC, a non-profit organization |
| # dedicated to making software imaging solutions freely available. |
| # |
| # This software and documentation is provided "as is," and the copyright |
| # holders and contributing author(s) make no representations or warranties, |
| # express or implied, including but not limited to, warranties of |
| # merchantability or fitness for any particular purpose or that the use of |
| # the software or documentation will not infringe any third party patents, |
| # copyrights, trademarks or other rights. |
| # |
| # The copyright holders and contributing author(s) will not be held liable |
| # for any direct, indirect, special or consequential damages arising out of |
| # any use of the software or documentation, even if advised of the |
| # possibility of such damage. |
| # |
| # Permission is hereby granted to use, copy, modify, and distribute this |
| # source code, or portions hereof, documentation and executables, for any |
| # purpose, without fee, subject to the following restrictions: |
| # |
| # 1. The origin of this source code must not be misrepresented. |
| # 2. Altered versions must be plainly marked as such and must not be |
| # misrepresented as being the original source. |
| # 3. This Copyright notice may not be removed or altered from any source |
| # or altered source distribution. |
| # |
| # The copyright holders and contributing author(s) specifically permit, |
| # without fee, and encourage the use of this source code as a component for |
| # supporting image processing in commercial products. If you use this |
| # source code in a product, acknowledgment is not required but would be |
| # |
| # |
| |
| # |
| # Create an alert window and display a message to the user. |
| # |
| proc Alert {dograb message args} { |
| # |
| # Initialize alert window. |
| # |
| catch {destroy .alert} |
| toplevel .alert -class alert |
| wm title .alert Alert |
| wm iconname .alert alert |
| wm group .alert . |
| wm transient .alert . |
| wm geometry .alert \ |
| +[expr {[winfo width .]+[winfo x .]+100}]+[expr {[winfo y .]+75}] |
| # |
| # Create alert window frame. |
| # |
| frame .alert.top -relief raised -border 1 |
| frame .alert.bottom -relief raised -border 1 |
| pack append .alert .alert.top {top fill expand} .alert.bottom \ |
| {top fill expand} |
| message .alert.top.message -width 350 -justify left -text $message |
| pack append .alert.top .alert.top.message {top expand padx 5 pady 5} |
| if {[llength $args] > 0} { |
| # |
| # Create as many buttons as needed and arrange them from left to right. |
| # |
| set arg [lindex $args 0] |
| frame .alert.bottom.0 -relief sunken -border 1 |
| pack append .alert.bottom .alert.bottom.0 {left expand padx 10 pady 10} |
| button .alert.bottom.0.button -text [lindex $arg 0] \ |
| -command "[lindex $arg 1]; destroy .alert" |
| pack append .alert.bottom.0 .alert.bottom.0.button {expand padx 12 pady 12} |
| bind .alert <Return> "[lindex $arg 1]; destroy .alert" |
| focus .alert |
| set i 1 |
| foreach arg [lrange $args 1 end] { |
| button .alert.bottom.$i -text [lindex $arg 0] \ |
| -command "[lindex $arg 1]; destroy .alert" |
| pack append .alert.bottom .alert.bottom.$i {left expand padx 20} |
| set i [expr $i+1] |
| } |
| } |
| bind .alert <Any-Enter> [list focus .alert] |
| if {$dograb == "grab"} { |
| tkwait visibility .alert |
| grab set .alert |
| } else { |
| focus .alert |
| } |
| } |
| |
| # |
| # Proc AppendImageFormat appends the image format type to the filename. |
| # |
| proc AppendImageFormat {w} { |
| set snap(format) \ |
| [$w.format.list get [lindex [$w.format.list curselection] 0]] |
| set filename [$w.file.entry get] |
| set extension [file extension $filename] |
| $w.file.entry delete \ |
| [expr {[string length $filename]-[string length $extension]}] end |
| $w.file.entry insert end . |
| $w.file.entry insert end $snap(format) |
| } |
| |
| # |
| # Proc Options creates the options window. |
| # |
| proc Options {} { |
| # |
| # Initialize snap window. |
| # |
| catch {destroy .options} |
| toplevel .options -class Options |
| wm title .options "Set Image Options" |
| wm group .options . |
| wm transient .options . |
| wm geometry .options \ |
| +[expr {[winfo width .]+[winfo x .]+25}]+[winfo y .] |
| # |
| # Create options window frame. |
| # |
| frame .options.input_title |
| label .options.input_title.label -text "Input" |
| pack .options.input_title.label |
| pack .options.input_title |
| frame .options.input -relief sunken -borderwidth 2 |
| frame .options.input.checks |
| checkbutton .options.input.checks.border -text "Borders" -width 11 \ |
| -anchor w -variable snap(border) |
| checkbutton .options.input.checks.frame -text "Frame" -width 11 \ |
| -anchor w -variable snap(frame) |
| checkbutton .options.input.checks.screen -text "Screen" -width 11 \ |
| -anchor w -variable snap(screen) |
| checkbutton .options.input.checks.descend -text "Descend" -anchor w \ |
| -variable snap(descend) |
| pack .options.input.checks.border .options.input.checks.frame \ |
| .options.input.checks.screen .options.input.checks.descend -side left |
| pack .options.input.checks |
| frame .options.input.delay |
| label .options.input.delay.label -text "Delay:" -width 9 -anchor w |
| scale .options.input.delay.scale -orient horizontal -length 11c \ |
| -from 0 -to 120 -tickinterval 15 -variable snap(delay) |
| pack .options.input.delay.label .options.input.delay.scale -side left |
| pack .options.input.delay |
| frame .options.input.id |
| label .options.input.id.window -text "Window:" -width 9 -anchor w |
| entry .options.input.id.window_entry -width 18 -relief sunken \ |
| -textvariable snap(window) |
| label .options.input.id.display -text "Display:" |
| entry .options.input.id.display_entry -width 18 -relief sunken \ |
| -textvariable snap(display) |
| pack .options.input.id.window .options.input.id.window_entry \ |
| .options.input.id.display .options.input.id.display_entry -side left |
| pack .options.input.checks .options.input.delay .options.input.id \ |
| -padx 1m -anchor w |
| pack .options.input.id -pady 1m |
| pack .options.input -expand 1 -fill both |
| frame .options.processing_title |
| label .options.processing_title.label -text "Image Processing" |
| pack .options.processing_title.label |
| pack .options.processing_title |
| frame .options.processing -relief sunken -borderwidth 2 |
| frame .options.processing.checks |
| checkbutton .options.processing.checks.dither -text "Dither" -width 11 \ |
| -anchor w -variable snap(dither) |
| checkbutton .options.processing.checks.negate -text "Negate" -width 11 \ |
| -anchor w -variable snap(negate) |
| checkbutton .options.processing.checks.monochrome -text "Monochrome" \ |
| -width 11 -anchor w -variable snap(monochrome) |
| checkbutton .options.processing.checks.trim -text "Trim" -anchor w \ |
| -variable snap(trim) |
| pack .options.processing.checks.dither .options.processing.checks.negate \ |
| .options.processing.checks.monochrome .options.processing.checks.trim \ |
| -side left |
| pack .options.processing.checks |
| frame .options.processing.colors |
| label .options.processing.colors.label -text "Colors:" -width 9 -anchor w |
| scale .options.processing.colors.scale -orient horizontal -length 11c \ |
| -from 0 -to 256 -tickinterval 32 -variable snap(colors) |
| pack .options.processing.colors.label .options.processing.colors.scale \ |
| -side left |
| pack .options.processing.colors |
| frame .options.processing.rotate |
| label .options.processing.rotate.label -text "Rotate:" -width 9 -anchor w |
| scale .options.processing.rotate.scale -orient horizontal -length 11c \ |
| -from 0 -to 360 -tickinterval 45 -variable snap(degrees) |
| pack .options.processing.rotate.label .options.processing.rotate.scale \ |
| -side left |
| pack .options.processing.rotate |
| pack .options.processing.checks .options.processing.colors \ |
| .options.processing.rotate -padx 1m -anchor w |
| pack .options.processing -expand 1 -fill both |
| frame .options.output_title |
| label .options.output_title.label -text "Output" |
| pack .options.output_title.label |
| pack .options.output_title |
| frame .options.output -relief sunken -borderwidth 2 |
| frame .options.output.checks |
| checkbutton .options.output.checks.compress -text "Compress" -width 11 \ |
| -anchor w -variable snap(compress) |
| checkbutton .options.output.checks.interlace -text "Interlace" -width 11 \ |
| -anchor w -variable snap(interlace) |
| checkbutton .options.output.checks.verbose -text "Verbose" -anchor w \ |
| -variable snap(verbose) |
| pack .options.output.checks.compress .options.output.checks.interlace \ |
| .options.output.checks.verbose -side left |
| pack .options.output.checks |
| frame .options.output.scene |
| label .options.output.scene.label -text "Scene:" -width 9 -anchor w |
| scale .options.output.scene.scale -orient horizontal -length 11c \ |
| -from 0 -to 40 -tickinterval 5 -variable snap(scene) |
| pack .options.output.scene.label .options.output.scene.scale -side left |
| pack .options.output.scene |
| frame .options.output.comment |
| label .options.output.comment.label -text "Comment:" -width 9 -anchor w |
| entry .options.output.comment.entry -width 45 -relief sunken \ |
| -textvariable snap(comment) |
| pack .options.output.comment.label .options.output.comment.entry \ |
| -side left |
| pack .options.output.comment |
| frame .options.output.label |
| label .options.output.label.label -text "Label:" -width 9 -anchor w |
| entry .options.output.label.entry -width 45 -relief sunken \ |
| -textvariable snap(label) |
| pack .options.output.label.label .options.output.label.entry -side left |
| pack .options.output.label |
| frame .options.output.id |
| label .options.output.id.page -text "Page:" -width 9 -anchor w |
| entry .options.output.id.page_entry -width 18 -relief sunken \ |
| -textvariable snap(page) |
| label .options.output.id.density -text "Density:" |
| entry .options.output.id.density_entry -width 18 -relief sunken \ |
| -textvariable snap(density) |
| pack .options.output.id.page .options.output.id.page_entry \ |
| .options.output.id.density .options.output.id.density_entry -side left |
| pack .options.output.checks .options.output.scene \ |
| .options.output.comment .options.output.label .options.output.id \ |
| -padx 1m -anchor w |
| pack .options.output.id -pady 1m |
| pack .options.output -expand 1 -fill both |
| button .options.button -text Ok -command {destroy .options} |
| pack .options.button |
| bind .options <Return> {destroy .options} |
| # |
| # Map options window. |
| # |
| pack .options.input_title .options.input .options.processing_title \ |
| .options.processing .options.output_title .options.output .options.button \ |
| -side top -padx 2m -pady 1m |
| } |
| |
| # |
| # Proc Print prints the snapped image to a printer or command. |
| # |
| proc Print {} { |
| global snap |
| |
| . configure -cursor watch |
| update |
| set command convert |
| set command [concat $command $snap(snapshot)] |
| set option +compress |
| if {$snap(compress)} { |
| set option "-compress zip" |
| } |
| set command [concat $command $option] |
| set command [concat $command -density \"$snap(density)\"] |
| set command [concat $command -page \"$snap(page)\"] |
| set command [concat $command \"ps:|$snap(printer)\"] |
| eval exec $command |
| . configure -cursor {} |
| } |
| |
| # |
| # Proc PrintImage allows the user to provide a command name to print with. |
| # |
| proc PrintImage {} { |
| # |
| # Initialize print window. |
| # |
| catch {destroy .print} |
| toplevel .print -class Print |
| wm title .print Print |
| wm group .print . |
| wm transient .print . |
| wm geometry .print \ |
| +[expr {[winfo width .]+[winfo x .]+75}]+[expr {[winfo y .]+50}] |
| # |
| # Create print window frame. |
| # |
| frame .print.format |
| scrollbar .print.format.scroll -command ".print.format.list yview" |
| listbox .print.format.list -yscroll ".print.format.scroll set" -setgrid 1 \ |
| -height 8 |
| pack .print.format.scroll -side right -fill y |
| pack .print.format.list -side top -expand 1 -fill both |
| .print.format.list insert 0 \ |
| Letter Tabloid Ledger Legal Statement Executive A3 A4 A5 B4 B5 Folio \ |
| Quarto 10x14 |
| .print.format.list selection set 0 |
| pack .print.format |
| frame .print.file |
| entry .print.file.entry -width 18 -relief sunken -textvariable snap(printer) |
| pack .print.file.entry -side right -expand 1 -fill both |
| pack .print.file |
| frame .print.buttons |
| button .print.buttons.print -text Print -command Print |
| button .print.buttons.cancel -text Cancel -command {destroy .print} |
| pack .print.buttons.print .print.buttons.cancel -side left -expand 1 \ |
| -fill both -padx 2m |
| pack .print.buttons |
| # |
| # Map print window. |
| # |
| pack .print.format .print.file .print.buttons -padx 2m -pady 2m -expand 1 \ |
| -fill both |
| return |
| } |
| |
| # |
| # Proc Save saves the snapped image to disk. |
| # |
| proc Save {} { |
| global snap |
| |
| if ![file readable $snap(snapshot)] { |
| Alert grab "You must snap an image before you can save it!" {" OK " {}} |
| tkwait window .alert |
| return |
| } |
| . configure -cursor watch |
| update |
| set command convert |
| set command [concat $command $snap(snapshot)] |
| set option +compress |
| if {$snap(compress)} { |
| set option "-compress zip" |
| } |
| set command [concat $command $option] |
| set command [concat $command -density \"$snap(density)\"] |
| set command [concat $command -page \"$snap(page)\"] |
| set filename $snap(filename) |
| if {$snap(format) != {}} { |
| set filename "$snap(format):$snap(filename)" |
| } |
| set command [concat $command $filename] |
| eval exec $command |
| . configure -cursor {} |
| } |
| |
| proc SaveImage {} { |
| # |
| # Initialize save window. |
| # |
| catch {destroy .save} |
| toplevel .save -class Saves |
| wm title .save "Save As..." |
| wm group .save . |
| wm transient .save . |
| wm geometry .save \ |
| +[expr {[winfo width .]+[winfo x .]+50}]+[expr {[winfo y .]+25}] |
| # |
| # Create save window frame. |
| # |
| frame .save.format |
| scrollbar .save.format.scroll -command ".save.format.list yview" |
| listbox .save.format.list -yscroll ".save.format.scroll set" -setgrid 1 \ |
| -height 8 |
| pack .save.format.scroll -side right -fill y |
| pack .save.format.list -side top -expand 1 -fill both |
| .save.format.list insert 0 \ |
| ps avs bie bmp cmyk dcx eps epsf epsi fax fits gif gif87 gray g3 hdf \ |
| histogram jbig jpeg jpg map matte miff mpg mtv pbm pcd pcx pdf pgm pict \ |
| png ppm pnm ps2 ras rgb rle sgi sun tga tiff uyvy vid viff x xbm xpm \ |
| xv xwd yuv yuv3 |
| .save.format.list selection set 0 |
| pack .save.format |
| frame .save.file |
| entry .save.file.entry -width 18 -relief sunken -textvariable snap(filename) |
| pack .save.file.entry -side right -expand 1 -fill both |
| pack .save.file |
| frame .save.buttons |
| button .save.buttons.save -text Save -command Save |
| button .save.buttons.cancel -text Cancel -command {destroy .save} |
| pack .save.buttons.save .save.buttons.cancel -side left -expand 1 \ |
| -fill both -padx 2m |
| pack .save.buttons |
| # |
| # Bind buttons to print window. |
| # |
| bind .save.format.list <ButtonRelease-1> { |
| set snap(format) \ |
| [.save.format.list get [lindex [.save.format.list curselection] 0]] |
| } |
| bind .save.format.list <Double-Button-1> {AppendImageFormat .save} |
| # |
| # Map save window. |
| # |
| pack .save.format .save.file .save.buttons -padx 2m -pady 2m -expand 1 \ |
| -fill both |
| return |
| } |
| |
| # |
| # Proc ShowImage displays the full-sized snapped image in a top level window. |
| # |
| proc ShowImage { title name } { |
| catch {destroy .show} |
| toplevel .show -visual best |
| wm title .show $title |
| button .show.image -image $name -command {destroy .show} |
| pack .show.image |
| } |
| |
| # |
| # Proc Snap executes the ImageMagick import program to grab the image |
| # from the X server screen. |
| # |
| proc Snap {} { |
| global snap |
| |
| # |
| # Initialize import command. |
| # |
| set command import |
| set command [concat $command -depth 8] |
| set option +border |
| if {$snap(border)} { |
| set option -border |
| } |
| set command [concat $command $option] |
| if {$snap(colors)} { |
| set command [concat $command -colors $snap(colors)] |
| } |
| set command [concat $command -comment \"$snap(comment)\"] |
| set option +compress |
| if {$snap(compress)} { |
| set option "-compress zip" |
| } |
| set command [concat $command $option] |
| if {$snap(delay)} { |
| set command [concat $command -delay $snap(delay)] |
| } |
| set command [concat $command -density \"$snap(density)\"] |
| if {$snap(descend)} { |
| set command [concat $command -descend] |
| } |
| set command [concat $command -display \"$snap(display)\"] |
| set option +dither |
| if {$snap(dither)} { |
| set option -dither |
| } |
| set command [concat $command $option] |
| set option +frame |
| if {$snap(frame)} { |
| set option -frame |
| } |
| set command [concat $command $option] |
| set option +interlace |
| if {$snap(interlace)} { |
| set option "-interlace plane" |
| } |
| set command [concat $command $option] |
| set command [concat $command -label \"$snap(label)\"] |
| set option +monochrome |
| if {$snap(monochrome)} { |
| set option -monochrome |
| } |
| set command [concat $command $option] |
| set option +negate |
| if {$snap(negate)} { |
| set option -negate |
| } |
| set command [concat $command $option] |
| set command [concat $command -page \"$snap(page)\"] |
| if {$snap(degrees)} { |
| set command [concat $command -rotate $snap(degrees)] |
| } |
| if {$snap(scene)} { |
| set command [concat $command -scene $snap(scene)] |
| } |
| set option +screen |
| if {$snap(screen)} { |
| set option -screen |
| } |
| set command [concat $command $option] |
| if {$snap(trim)} { |
| set command [concat $command -crop 0x0] |
| } |
| set option +verbose |
| if {$snap(verbose)} { |
| set option -verbose |
| } |
| set command [concat $command $option] |
| set command [concat $command $snap(snapshot)] |
| # |
| # Import the image from the X server screen. |
| # |
| . configure -cursor watch |
| update |
| wm withdraw . |
| eval exec $command |
| wm deiconify . |
| update |
| catch {image delete snapshot} |
| image create photo snapshot -file $snap(snapshot) |
| # |
| # Convert to an image tile. |
| # |
| exec convert -geometry 320x320> $snap(snapshot) -depth 8 $snap(tile) |
| catch {image delete tile} |
| image create photo tile -file $snap(tile) |
| exec rm -f $snap(tile) |
| # |
| # Display tile image as a button. |
| # |
| if [winfo exists .canvas.label] { |
| destroy .canvas.label |
| destroy .canvas.button |
| } |
| label .canvas.label -text $snap(filename) |
| button .canvas.button -image tile -relief sunken -borderwidth 2 \ |
| -command { ShowImage $snap(filename) snapshot } |
| pack .canvas.label .canvas.button -side top -expand 1 -fill both \ |
| -padx 1m -pady 1m |
| bind . <Return> { ShowImage $snap(filename) snapshot } |
| . configure -cursor {} |
| } |
| |
| # |
| # Proc SnapWindow creates the top level window. |
| # |
| proc SnapWindow {} { |
| # |
| # Initialize snap window. |
| # |
| wm title . "X-Windows Snapshot" |
| wm iconname . "xsnap" |
| # |
| # Create snap window frame. |
| # |
| frame .toolbar -relief raised -bd 2 |
| menubutton .toolbar.file -text "File" -menu .toolbar.file.menu -underline 0 |
| menu .toolbar.file.menu |
| .toolbar.file.menu add command -label "Save" -command Save |
| .toolbar.file.menu add command -label "Save As ..." -command "SaveImage" |
| .toolbar.file.menu add command -label Print -command PrintImage |
| .toolbar.file.menu add separator |
| .toolbar.file.menu add command -label Quit \ |
| -command { exec rm -f $snap(snapshot); exit } |
| pack .toolbar.file -side left |
| pack .toolbar -side top -fill x |
| canvas .canvas -width 256 -height 128 |
| pack .canvas |
| frame .buttons |
| button .buttons.snap -text Snap -command Snap |
| button .buttons.options -text Options -command Options |
| pack .buttons.snap .buttons.options -side left -expand 1 |
| pack .buttons -side bottom -fill x -padx 2m -pady 2m |
| # |
| # Map snap window. |
| # |
| pack .toolbar .canvas .buttons |
| } |
| |
| # |
| # Initalize snap options. |
| # |
| set snap(border) 0 |
| set snap(colors) 0 |
| set snap(comment) "Imported from %m image: %f" |
| set snap(compress) 1 |
| set snap(degrees) 0 |
| set snap(delay) 0 |
| set snap(density) 72x72 |
| set snap(descend) 0 |
| set snap(display) :0 |
| if [info exists env(DISPLAY)] { |
| set snap(display) $env(DISPLAY) |
| } |
| set snap(dither) 1 |
| set snap(filename) magick.ps |
| set snap(format) {} |
| set snap(frame) 0 |
| set snap(interlace) 1 |
| set snap(label) "%f %wx%h" |
| set snap(monochrome) 0 |
| set snap(negate) 0 |
| set snap(page) Letter |
| set snap(printer) lp |
| set snap(scene) 0 |
| set snap(screen) 0 |
| set snap(snapshot) /tmp/snap[pid].ppm |
| set snap(tile) /tmp/tile[pid].ppm |
| set snap(trim) 0 |
| set snap(verbose) 0 |
| # |
| # Create top level snap window. |
| # |
| SnapWindow |
| tkwait window . |
| exec rm -f $snap(snapshot) |