granicus.if.org Git - imagemagick/blob - scripts/xsnap

   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, John Cristy (magick@dupont.com), March 1996
   9 #
  10 #  Copyright (C) 1999-2012 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)