root / ImageMagick / branches / ImageMagick-6.3.5 / scripts / xsnap

Revision 7647, 20.2 kB (checked in by cristy, 15 months ago)
Line 
1#!/bin/sh
2# \
3exec 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-2005 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#
45proc 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#
98proc 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#
112proc 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#
259proc 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#
281proc 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#
327proc 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
355proc 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#
411proc 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#
423proc 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) $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#
537proc 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#
573set snap(border) 0
574set snap(colors) 0
575set snap(comment) "Imported from %m image: %f"
576set snap(compress) 1
577set snap(degrees) 0
578set snap(delay) 0
579set snap(density) 72x72
580set snap(descend) 0
581set snap(display) :0
582if [info exists env(DISPLAY)] {
583  set snap(display) $env(DISPLAY)
584}
585set snap(dither) 1
586set snap(filename) magick.ps
587set snap(format) {}
588set snap(frame) 0
589set snap(interlace) 1
590set snap(label) "%f   %wx%h"
591set snap(monochrome) 0
592set snap(negate) 0
593set snap(page) Letter
594set snap(printer) lp
595set snap(scene) 0
596set snap(screen) 0
597set snap(snapshot) /tmp/snap[pid].ppm
598set snap(tile) /tmp/tile[pid].ppm
599set snap(trim) 0
600set snap(verbose) 0
601#
602# Create top level snap window.
603#
604SnapWindow
605tkwait window .
606exec rm -f $snap(snapshot)
Note: See TracBrowser for help on using the browser.