cristy | 3ed852e | 2009-09-05 21:47:34 +0000 | [diff] [blame] | 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 | # |
cristy | 45ef08f | 2012-12-07 13:13:34 +0000 | [diff] [blame] | 10 | # Copyright (C) 1999-2013 ImageMagick Studio LLC, a non-profit organization |
cristy | 3ed852e | 2009-09-05 21:47:34 +0000 | [diff] [blame] | 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) |