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