Home | History | Annotate | Download | only in scripts
      1 #!/bin/sh
      2 # \
      3 exec wish "$0" "$@"
      4 
      5 #
      6 #  XSnap, X-Windows Snapshot.  A GUI for the ImageMagick import command
      7 #
      8 #  Software design, Cristy (magick (at] dupont.com), March 1996
      9 #
     10 #  Copyright (C) 1999-2016 ImageMagick Studio LLC, a non-profit organization
     11 #  dedicated to making software imaging solutions freely available.
     12 #
     13 #  This software and documentation is provided "as is," and the copyright
     14 #  holders and contributing author(s) make no representations or warranties,
     15 #  express or implied, including but not limited to, warranties of
     16 #  merchantability or fitness for any particular purpose or that the use of
     17 #  the software or documentation will not infringe any third party patents,
     18 #  copyrights, trademarks or other rights.
     19 #
     20 #  The copyright holders and contributing author(s) will not be held liable
     21 #  for any direct, indirect, special or consequential damages arising out of
     22 #  any use of the software or documentation, even if advised of the
     23 #  possibility of such damage.
     24 #
     25 #  Permission is hereby granted to use, copy, modify, and distribute this
     26 #  source code, or portions hereof, documentation and executables, for any
     27 #  purpose, without fee, subject to the following restrictions:
     28 #
     29 #    1. The origin of this source code must not be misrepresented.
     30 #    2. Altered versions must be plainly marked as such and must not be
     31 #       misrepresented as being the original source.
     32 #    3. This Copyright notice may not be removed or altered from any source
     33 #       or altered source distribution.
     34 #
     35 #  The copyright holders and contributing author(s) specifically permit,
     36 #  without fee, and encourage the use of this source code as a component for
     37 #  supporting image processing in commercial products.  If you use this
     38 #  source code in a product, acknowledgment is not required but would be
     39 #
     40 #
     41 
     42 #
     43 # Create an alert window and display a message to the user.
     44 #
     45 proc Alert {dograb message args} {
     46   #
     47   # Initialize alert window.
     48   #
     49   catch {destroy .alert}
     50   toplevel .alert -class alert
     51   wm title .alert Alert
     52   wm iconname .alert alert
     53   wm group .alert .
     54   wm transient .alert .
     55   wm geometry .alert \
     56     +[expr {[winfo width .]+[winfo x .]+100}]+[expr {[winfo y .]+75}]
     57   #
     58   # Create alert window frame.
     59   #
     60   frame .alert.top -relief raised -border 1
     61   frame .alert.bottom -relief raised -border 1
     62   pack append .alert .alert.top {top fill expand} .alert.bottom \
     63     {top fill expand}
     64   message .alert.top.message -width 350 -justify left -text $message
     65   pack append .alert.top .alert.top.message {top expand padx 5 pady 5}
     66   if {[llength $args] > 0} {
     67     #
     68     # Create as many buttons as needed and arrange them from left to right.
     69     #
     70     set arg [lindex $args 0]
     71     frame .alert.bottom.0 -relief sunken -border 1
     72     pack append .alert.bottom .alert.bottom.0 {left expand padx 10 pady 10}
     73     button .alert.bottom.0.button -text [lindex $arg 0] \
     74       -command "[lindex $arg 1]; destroy .alert"
     75     pack append .alert.bottom.0 .alert.bottom.0.button {expand padx 12 pady 12}
     76     bind .alert <Return> "[lindex $arg 1]; destroy .alert"
     77     focus .alert
     78     set i 1
     79     foreach arg [lrange $args 1 end] {
     80       button .alert.bottom.$i -text [lindex $arg 0] \
     81         -command "[lindex $arg 1]; destroy .alert"
     82       pack append .alert.bottom .alert.bottom.$i {left expand padx 20}
     83       set i [expr $i+1]
     84     }
     85   }
     86   bind .alert <Any-Enter> [list focus .alert]
     87   if {$dograb == "grab"} {
     88     tkwait visibility .alert
     89     grab set .alert
     90   } else {
     91     focus .alert
     92   }
     93 }
     94 
     95 #
     96 # Proc AppendImageFormat appends the image format type to the filename.
     97 #
     98 proc AppendImageFormat {w} {
     99   set snap(format) \
    100     [$w.format.list get [lindex [$w.format.list curselection] 0]]
    101   set filename [$w.file.entry get]
    102   set extension [file extension $filename]
    103   $w.file.entry delete \
    104     [expr {[string length $filename]-[string length $extension]}] end
    105   $w.file.entry insert end .
    106   $w.file.entry insert end $snap(format)
    107 }
    108 
    109 #
    110 # Proc Options creates the options window.
    111 #
    112 proc Options {} {
    113   #
    114   # Initialize snap window.
    115   #
    116   catch {destroy .options}
    117   toplevel .options -class Options
    118   wm title .options "Set Image Options"
    119   wm group .options .
    120   wm transient .options .
    121   wm geometry .options \
    122     +[expr {[winfo width .]+[winfo x .]+25}]+[winfo y .]
    123   #
    124   # Create options window frame.
    125   #
    126   frame .options.input_title
    127     label .options.input_title.label -text "Input"
    128     pack .options.input_title.label
    129   pack .options.input_title
    130   frame .options.input -relief sunken -borderwidth 2
    131     frame .options.input.checks
    132       checkbutton .options.input.checks.border -text "Borders" -width 11 \
    133         -anchor w -variable snap(border)
    134       checkbutton .options.input.checks.frame -text "Frame" -width 11 \
    135         -anchor w -variable snap(frame)
    136       checkbutton .options.input.checks.screen -text "Screen" -width 11 \
    137         -anchor w -variable snap(screen)
    138       checkbutton .options.input.checks.descend -text "Descend" -anchor w \
    139         -variable snap(descend)
    140       pack .options.input.checks.border .options.input.checks.frame \
    141         .options.input.checks.screen .options.input.checks.descend -side left
    142     pack .options.input.checks
    143     frame .options.input.delay
    144       label .options.input.delay.label -text "Delay:" -width 9 -anchor w
    145       scale .options.input.delay.scale -orient horizontal -length 11c \
    146         -from 0 -to 120 -tickinterval 15 -variable snap(delay)
    147       pack .options.input.delay.label .options.input.delay.scale -side left
    148     pack .options.input.delay
    149     frame .options.input.id
    150       label .options.input.id.window -text "Window:" -width 9 -anchor w
    151       entry .options.input.id.window_entry -width 18 -relief sunken \
    152         -textvariable snap(window)
    153       label .options.input.id.display -text "Display:"
    154       entry .options.input.id.display_entry -width 18 -relief sunken \
    155         -textvariable snap(display)
    156       pack .options.input.id.window .options.input.id.window_entry \
    157         .options.input.id.display .options.input.id.display_entry -side left
    158       pack .options.input.checks .options.input.delay .options.input.id \
    159         -padx 1m -anchor w
    160     pack .options.input.id -pady 1m
    161   pack .options.input -expand 1 -fill both
    162   frame .options.processing_title
    163     label .options.processing_title.label -text "Image Processing"
    164     pack .options.processing_title.label
    165   pack .options.processing_title
    166   frame .options.processing -relief sunken -borderwidth 2
    167     frame .options.processing.checks
    168       checkbutton .options.processing.checks.dither -text "Dither" -width 11 \
    169         -anchor w -variable snap(dither)
    170       checkbutton .options.processing.checks.negate -text "Negate" -width 11 \
    171         -anchor w -variable snap(negate)
    172       checkbutton .options.processing.checks.monochrome -text "Monochrome" \
    173         -width 11 -anchor w -variable snap(monochrome)
    174       checkbutton .options.processing.checks.trim -text "Trim" -anchor w \
    175         -variable snap(trim)
    176       pack .options.processing.checks.dither .options.processing.checks.negate \
    177         .options.processing.checks.monochrome .options.processing.checks.trim \
    178         -side left
    179     pack .options.processing.checks
    180     frame .options.processing.colors
    181       label .options.processing.colors.label -text "Colors:" -width 9 -anchor w
    182       scale .options.processing.colors.scale -orient horizontal -length 11c \
    183         -from 0 -to 256 -tickinterval 32 -variable snap(colors)
    184       pack .options.processing.colors.label .options.processing.colors.scale \
    185         -side left
    186     pack .options.processing.colors
    187     frame .options.processing.rotate
    188       label .options.processing.rotate.label -text "Rotate:" -width 9 -anchor w
    189       scale .options.processing.rotate.scale -orient horizontal -length 11c \
    190         -from 0 -to 360 -tickinterval 45 -variable snap(degrees)
    191       pack .options.processing.rotate.label .options.processing.rotate.scale \
    192         -side left
    193     pack .options.processing.rotate
    194     pack .options.processing.checks .options.processing.colors \
    195       .options.processing.rotate -padx 1m -anchor w
    196   pack .options.processing -expand 1 -fill both
    197   frame .options.output_title
    198     label .options.output_title.label -text "Output"
    199     pack .options.output_title.label
    200   pack .options.output_title
    201   frame .options.output -relief sunken -borderwidth 2
    202     frame .options.output.checks
    203       checkbutton .options.output.checks.compress -text "Compress" -width 11 \
    204         -anchor w -variable snap(compress)
    205       checkbutton .options.output.checks.interlace -text "Interlace" -width 11 \
    206         -anchor w -variable snap(interlace)
    207       checkbutton .options.output.checks.verbose -text "Verbose" -anchor w \
    208         -variable snap(verbose)
    209       pack .options.output.checks.compress .options.output.checks.interlace \
    210         .options.output.checks.verbose -side left
    211     pack .options.output.checks
    212     frame .options.output.scene
    213       label .options.output.scene.label -text "Scene:" -width 9 -anchor w
    214       scale .options.output.scene.scale -orient horizontal -length 11c \
    215         -from 0 -to 40 -tickinterval 5 -variable snap(scene)
    216       pack .options.output.scene.label .options.output.scene.scale -side left
    217     pack .options.output.scene
    218     frame .options.output.comment
    219       label .options.output.comment.label -text "Comment:" -width 9 -anchor w
    220       entry .options.output.comment.entry -width 45 -relief sunken \
    221         -textvariable snap(comment)
    222       pack .options.output.comment.label .options.output.comment.entry \
    223         -side left
    224     pack .options.output.comment
    225     frame .options.output.label
    226       label .options.output.label.label -text "Label:" -width 9 -anchor w
    227       entry .options.output.label.entry -width 45 -relief sunken \
    228         -textvariable snap(label)
    229       pack .options.output.label.label .options.output.label.entry -side left
    230     pack .options.output.label
    231     frame .options.output.id
    232       label .options.output.id.page -text "Page:" -width 9 -anchor w
    233       entry .options.output.id.page_entry -width 18 -relief sunken \
    234         -textvariable snap(page)
    235       label .options.output.id.density -text "Density:"
    236       entry .options.output.id.density_entry -width 18 -relief sunken \
    237         -textvariable snap(density)
    238       pack .options.output.id.page .options.output.id.page_entry \
    239         .options.output.id.density .options.output.id.density_entry -side left
    240       pack .options.output.checks .options.output.scene \
    241         .options.output.comment .options.output.label .options.output.id \
    242         -padx 1m -anchor w
    243     pack .options.output.id -pady 1m
    244   pack .options.output -expand 1 -fill both
    245   button .options.button -text Ok -command {destroy .options}
    246   pack .options.button
    247   bind .options <Return> {destroy .options}
    248   #
    249   # Map options window.
    250   #
    251   pack .options.input_title .options.input .options.processing_title \
    252     .options.processing .options.output_title .options.output .options.button \
    253     -side top -padx 2m -pady 1m
    254 }
    255 
    256 #
    257 # Proc Print prints the snapped image to a printer or command.
    258 #
    259 proc Print {} {
    260   global snap
    261 
    262   . configure -cursor watch
    263   update
    264   set command convert
    265   set command [concat $command $snap(snapshot)]
    266   set option +compress
    267   if {$snap(compress)} {
    268     set option "-compress zip"
    269   }
    270   set command [concat $command $option]
    271   set command [concat $command -density \"$snap(density)\"]
    272   set command [concat $command -page \"$snap(page)\"]
    273   set command [concat $command \"ps:|$snap(printer)\"]
    274   eval exec $command
    275   . configure -cursor {}
    276 }
    277 
    278 #
    279 # Proc PrintImage allows the user to provide a command name to print with.
    280 #
    281 proc PrintImage {} {
    282   #
    283   # Initialize print window.
    284   #
    285   catch {destroy .print}
    286   toplevel .print -class Print
    287   wm title .print Print
    288   wm group .print .
    289   wm transient .print .
    290   wm geometry .print \
    291     +[expr {[winfo width .]+[winfo x .]+75}]+[expr {[winfo y .]+50}]
    292   #
    293   # Create print window frame.
    294   #
    295   frame .print.format
    296     scrollbar .print.format.scroll -command ".print.format.list yview"
    297     listbox .print.format.list -yscroll ".print.format.scroll set" -setgrid 1 \
    298       -height 8
    299     pack .print.format.scroll -side right -fill y
    300     pack .print.format.list -side top -expand 1 -fill both
    301     .print.format.list insert 0  \
    302       Letter Tabloid Ledger Legal Statement Executive A3 A4 A5 B4 B5 Folio \
    303       Quarto 10x14
    304     .print.format.list selection set 0
    305   pack .print.format
    306   frame .print.file
    307     entry .print.file.entry -width 18 -relief sunken -textvariable snap(printer)
    308     pack .print.file.entry -side right -expand 1 -fill both
    309   pack .print.file
    310   frame .print.buttons
    311     button .print.buttons.print -text Print -command Print
    312     button .print.buttons.cancel -text Cancel -command {destroy .print}
    313     pack .print.buttons.print .print.buttons.cancel -side left -expand 1 \
    314       -fill both -padx 2m
    315   pack .print.buttons
    316   #
    317   # Map print window.
    318   #
    319   pack .print.format .print.file .print.buttons -padx 2m -pady 2m -expand 1 \
    320     -fill both
    321   return
    322 }
    323 
    324 #
    325 # Proc Save saves the snapped image to disk.
    326 #
    327 proc Save {} {
    328   global snap
    329 
    330   if ![file readable $snap(snapshot)] {
    331     Alert grab "You must snap an image before you can save it!" {"  OK  " {}}
    332     tkwait window .alert
    333     return
    334   }
    335   . configure -cursor watch
    336   update
    337   set command convert
    338   set command [concat $command $snap(snapshot)]
    339   set option +compress
    340   if {$snap(compress)} {
    341     set option "-compress zip"
    342   }
    343   set command [concat $command $option]
    344   set command [concat $command -density \"$snap(density)\"]
    345   set command [concat $command -page \"$snap(page)\"]
    346   set filename $snap(filename)
    347   if {$snap(format) != {}} {
    348     set filename "$snap(format):$snap(filename)"
    349   }
    350   set command [concat $command $filename]
    351   eval exec $command
    352   . configure -cursor {}
    353 }
    354 
    355 proc SaveImage {} {
    356   #
    357   # Initialize save window.
    358   #
    359   catch {destroy .save}
    360   toplevel .save -class Saves
    361   wm title .save "Save As..."
    362   wm group .save .
    363   wm transient .save .
    364   wm geometry .save \
    365     +[expr {[winfo width .]+[winfo x .]+50}]+[expr {[winfo y .]+25}]
    366   #
    367   # Create save window frame.
    368   #
    369   frame .save.format
    370     scrollbar .save.format.scroll -command ".save.format.list yview"
    371     listbox .save.format.list -yscroll ".save.format.scroll set" -setgrid 1 \
    372       -height 8
    373     pack .save.format.scroll -side right -fill y
    374     pack .save.format.list -side top -expand 1 -fill both
    375     .save.format.list insert 0  \
    376       ps avs bie bmp cmyk dcx eps epsf epsi fax fits gif gif87 gray g3 hdf \
    377       histogram jbig jpeg jpg map matte miff mpg mtv pbm pcd pcx pdf pgm pict \
    378       png ppm pnm ps2 ras rgb rle sgi sun tga tiff uyvy vid viff x xbm xpm \
    379       xv xwd yuv yuv3
    380     .save.format.list selection set 0
    381   pack .save.format
    382   frame .save.file
    383     entry .save.file.entry -width 18 -relief sunken -textvariable snap(filename)
    384     pack .save.file.entry -side right -expand 1 -fill both
    385   pack .save.file
    386   frame .save.buttons
    387     button .save.buttons.save -text Save -command Save
    388     button .save.buttons.cancel -text Cancel -command {destroy .save}
    389     pack .save.buttons.save .save.buttons.cancel -side left -expand 1 \
    390       -fill both -padx 2m
    391   pack .save.buttons
    392   #
    393   # Bind buttons to print window.
    394   #
    395   bind .save.format.list <ButtonRelease-1> {
    396     set snap(format) \
    397       [.save.format.list get [lindex [.save.format.list curselection] 0]]
    398   }
    399   bind .save.format.list <Double-Button-1> {AppendImageFormat .save}
    400   #
    401   # Map save window.
    402   #
    403   pack .save.format .save.file .save.buttons -padx 2m -pady 2m -expand 1 \
    404     -fill both
    405   return
    406 }
    407 
    408 #
    409 # Proc ShowImage displays the full-sized snapped image in a top level window.
    410 #
    411 proc ShowImage { title name } {
    412   catch {destroy .show}
    413   toplevel .show -visual best
    414   wm title .show $title
    415   button .show.image -image $name -command {destroy .show}
    416   pack .show.image
    417 }
    418 
    419 #
    420 # Proc Snap executes the ImageMagick import program to grab the image
    421 # from the X server screen.
    422 #
    423 proc Snap {} {
    424   global snap
    425 
    426   #
    427   # Initialize import command.
    428   #
    429   set command import
    430   set command [concat $command -depth 8]
    431   set option +border
    432   if {$snap(border)} {
    433     set option -border
    434   }
    435   set command [concat $command $option]
    436   if {$snap(colors)} {
    437     set command [concat $command -colors $snap(colors)]
    438   }
    439   set command [concat $command -comment \"$snap(comment)\"]
    440   set option +compress
    441   if {$snap(compress)} {
    442     set option "-compress zip"
    443   }
    444   set command [concat $command $option]
    445   if {$snap(delay)} {
    446     set command [concat $command -delay $snap(delay)]
    447   }
    448   set command [concat $command -density \"$snap(density)\"]
    449   if {$snap(descend)} {
    450     set command [concat $command -descend]
    451   }
    452   set command [concat $command -display \"$snap(display)\"]
    453   set option +dither
    454   if {$snap(dither)} {
    455     set option -dither
    456   }
    457   set command [concat $command $option]
    458   set option +frame
    459   if {$snap(frame)} {
    460     set option -frame
    461   }
    462   set command [concat $command $option]
    463   set option +interlace
    464   if {$snap(interlace)} {
    465     set option "-interlace plane"
    466   }
    467   set command [concat $command $option]
    468   set command [concat $command -label \"$snap(label)\"]
    469   set option +monochrome
    470   if {$snap(monochrome)} {
    471     set option -monochrome
    472   }
    473   set command [concat $command $option]
    474   set option +negate
    475   if {$snap(negate)} {
    476     set option -negate
    477   }
    478   set command [concat $command $option]
    479   set command [concat $command -page \"$snap(page)\"]
    480   if {$snap(degrees)} {
    481     set command [concat $command -rotate $snap(degrees)]
    482   }
    483   if {$snap(scene)} {
    484     set command [concat $command -scene $snap(scene)]
    485   }
    486   set option +screen
    487   if {$snap(screen)} {
    488     set option -screen
    489   }
    490   set command [concat $command $option]
    491   if {$snap(trim)} {
    492     set command [concat $command -crop 0x0]
    493   }
    494   set option +verbose
    495   if {$snap(verbose)} {
    496     set option -verbose
    497   }
    498   set command [concat $command $option]
    499   set command [concat $command $snap(snapshot)]
    500   #
    501   # Import the image from the X server screen.
    502   #
    503   . configure -cursor watch
    504   update
    505   wm withdraw .
    506   eval exec $command
    507   wm deiconify .
    508   update
    509   catch {image delete snapshot}
    510   image create photo snapshot -file $snap(snapshot)
    511   #
    512   # Convert to an image tile.
    513   #
    514   exec convert -geometry 320x320> $snap(snapshot) -depth 8 $snap(tile)
    515   catch {image delete tile}
    516   image create photo tile -file $snap(tile)
    517   exec rm -f $snap(tile)
    518   #
    519   # Display tile image as a button.
    520   #
    521   if [winfo exists .canvas.label] {
    522     destroy .canvas.label
    523     destroy .canvas.button
    524   }
    525   label .canvas.label -text $snap(filename)
    526   button .canvas.button -image tile -relief sunken -borderwidth 2 \
    527     -command { ShowImage $snap(filename) snapshot }
    528   pack .canvas.label .canvas.button -side top -expand 1 -fill both \
    529     -padx 1m -pady 1m
    530   bind . <Return> { ShowImage $snap(filename) snapshot }
    531   . configure -cursor {}
    532 }
    533 
    534 #
    535 # Proc SnapWindow creates the top level window.
    536 #
    537 proc SnapWindow {} {
    538   #
    539   # Initialize snap window.
    540   #
    541   wm title . "X-Windows Snapshot"
    542   wm iconname . "xsnap"
    543   #
    544   # Create snap window frame.
    545   #
    546   frame .toolbar -relief raised -bd 2
    547     menubutton .toolbar.file -text "File" -menu .toolbar.file.menu -underline 0
    548     menu .toolbar.file.menu
    549     .toolbar.file.menu add command -label "Save" -command Save
    550     .toolbar.file.menu add command -label "Save As ..." -command "SaveImage"
    551     .toolbar.file.menu add command -label Print -command PrintImage
    552     .toolbar.file.menu add separator
    553     .toolbar.file.menu add command -label Quit \
    554       -command { exec rm -f $snap(snapshot); exit }
    555     pack .toolbar.file -side left
    556   pack .toolbar -side top -fill x
    557   canvas .canvas -width 256 -height 128
    558   pack .canvas
    559   frame .buttons
    560     button .buttons.snap -text Snap -command Snap
    561     button .buttons.options -text Options -command Options
    562     pack .buttons.snap .buttons.options -side left -expand 1
    563   pack .buttons -side bottom -fill x -padx 2m -pady 2m
    564   #
    565   # Map snap window.
    566   #
    567   pack .toolbar .canvas .buttons
    568 }
    569 
    570 #
    571 # Initalize snap options.
    572 #
    573 set snap(border) 0
    574 set snap(colors) 0
    575 set snap(comment) "Imported from %m image: %f"
    576 set snap(compress) 1
    577 set snap(degrees) 0
    578 set snap(delay) 0
    579 set snap(density) 72x72
    580 set snap(descend) 0
    581 set snap(display) :0
    582 if [info exists env(DISPLAY)] {
    583   set snap(display) $env(DISPLAY)
    584 }
    585 set snap(dither) 1
    586 set snap(filename) magick.ps
    587 set snap(format) {}
    588 set snap(frame) 0
    589 set snap(interlace) 1
    590 set snap(label) "%f   %wx%h"
    591 set snap(monochrome) 0
    592 set snap(negate) 0
    593 set snap(page) Letter
    594 set snap(printer) lp
    595 set snap(scene) 0
    596 set snap(screen) 0
    597 set snap(snapshot) /tmp/snap[pid].ppm
    598 set snap(tile) /tmp/tile[pid].ppm
    599 set snap(trim) 0
    600 set snap(verbose) 0
    601 #
    602 # Create top level snap window.
    603 #
    604 SnapWindow
    605 tkwait window .
    606 exec rm -f $snap(snapshot)
    607