File: xsnap

package info (click to toggle)
imagemagick 4:5.4.4.5-1woody6
  • links: PTS
  • area: main
  • in suites: woody
  • size: 20,904 kB
  • ctags: 11,673
  • sloc: ansic: 141,668; cpp: 15,076; sh: 7,495; perl: 2,530; makefile: 1,101; tcl: 459
file content (603 lines) | stat: -rw-r--r-- 20,545 bytes parent folder | download | duplicates (11)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
#!/bin/sh
# \
exec wish "$0" "$@"

#
#  XSnap, X-Windows Snapshot.  A GUI for the ImageMagick import command
#
#  Software design, John Cristy (magick@dupont.com), March 1996
#
#  Copyright (C) 2000 ImageMagick Studio, a non-profit organization
#  dedicated to making software imaging solutions freely available.
#
#  Permission is hereby granted, free of charge, to any person obtaining
#  a copy of this software and associated documentation files
#  ("ImageMagick"), to deal in ImageMagick without restriction,
#  including without limitation the rights to use, copy, modify, merge,
#  publish, distribute, sublicense, and/or sell copies of ImageMagick,
#  and to permit persons to whom the ImageMagick is furnished to do so,
#  subject to the following conditions:
#
#  The above copyright notice and this permission notice shall be
#  included in all copies or substantial portions of ImageMagick.
#
#  The software is provided "as is", without warranty of any kind,
#  express or implied, including but not limited to the warranties of
#  merchantability, fitness for a particular purpose and
#  noninfringement.  In no event shall ImageMagick Studio be liable for
#  any claim, damages or other liability, whether in an action of
#  contract, tort or otherwise, arising from, out of or in connection
#  with ImageMagick or the use or other dealings in ImageMagick.
#
#  Except as contained in this notice, the name of the ImageMagick
#  Studio shall not be used in advertising or otherwise to promote the
#  sale, use or other dealings in ImageMagick without prior written
#  authorization from the ImageMagick Studio.
#
#

#
# Create an alert window and display a message to the user.
#
proc Alert {dograb message args} {
  #
  # Initialize alert window.
  #
  catch {destroy .alert}
  toplevel .alert -class alert
  wm title .alert Alert
  wm iconname .alert alert
  wm group .alert .
  wm transient .alert .
  wm geometry .alert \
    +[expr {[winfo width .]+[winfo x .]+100}]+[expr {[winfo y .]+75}]
  #
  # Create alert window frame.
  #
  frame .alert.top -relief raised -border 1
  frame .alert.bottom -relief raised -border 1
  pack append .alert .alert.top {top fill expand} .alert.bottom \
    {top fill expand}
  message .alert.top.message -width 350 -justify left -text $message
  pack append .alert.top .alert.top.message {top expand padx 5 pady 5}
  if {[llength $args] > 0} {
    #
    # Create as many buttons as needed and arrange them from left to right.
    #
    set arg [lindex $args 0]
    frame .alert.bottom.0 -relief sunken -border 1
    pack append .alert.bottom .alert.bottom.0 {left expand padx 10 pady 10}
    button .alert.bottom.0.button -text [lindex $arg 0] \
      -command "[lindex $arg 1]; destroy .alert"
    pack append .alert.bottom.0 .alert.bottom.0.button {expand padx 12 pady 12}
    bind .alert <Return> "[lindex $arg 1]; destroy .alert"
    focus .alert
    set i 1
    foreach arg [lrange $args 1 end] {
      button .alert.bottom.$i -text [lindex $arg 0] \
        -command "[lindex $arg 1]; destroy .alert"
      pack append .alert.bottom .alert.bottom.$i {left expand padx 20}
      set i [expr $i+1]
    }
  }
  bind .alert <Any-Enter> [list focus .alert]
  if {$dograb == "grab"} {
    tkwait visibility .alert
    grab set .alert
  } else {
    focus .alert
  }
}

#
# Proc AppendImageFormat appends the image format type to the filename.
#
proc AppendImageFormat {w} {
  set snap(format) \
    [$w.format.list get [lindex [$w.format.list curselection] 0]]
  set filename [$w.file.entry get]
  set extension [file extension $filename]
  $w.file.entry delete \
    [expr {[string length $filename]-[string length $extension]}] end
  $w.file.entry insert end .
  $w.file.entry insert end $snap(format)
}

#
# Proc Options creates the options window.
#
proc Options {} {
  #
  # Initialize snap window.
  #
  catch {destroy .options}
  toplevel .options -class Options
  wm title .options "Set Image Options"
  wm group .options .
  wm transient .options .
  wm geometry .options \
    +[expr {[winfo width .]+[winfo x .]+25}]+[winfo y .]
  #
  # Create options window frame.
  #
  frame .options.input_title
    label .options.input_title.label -text "Input"
    pack .options.input_title.label
  pack .options.input_title
  frame .options.input -relief sunken -borderwidth 2
    frame .options.input.checks
      checkbutton .options.input.checks.border -text "Borders" -width 11 \
        -anchor w -variable snap(border)
      checkbutton .options.input.checks.frame -text "Frame" -width 11 \
        -anchor w -variable snap(frame)
      checkbutton .options.input.checks.screen -text "Screen" -width 11 \
        -anchor w -variable snap(screen)
      checkbutton .options.input.checks.descend -text "Descend" -anchor w \
        -variable snap(descend)
      pack .options.input.checks.border .options.input.checks.frame \
        .options.input.checks.screen .options.input.checks.descend -side left
    pack .options.input.checks
    frame .options.input.delay
      label .options.input.delay.label -text "Delay:" -width 9 -anchor w
      scale .options.input.delay.scale -orient horizontal -length 11c \
        -from 0 -to 120 -tickinterval 15 -variable snap(delay)
      pack .options.input.delay.label .options.input.delay.scale -side left
    pack .options.input.delay
    frame .options.input.id
      label .options.input.id.window -text "Window:" -width 9 -anchor w
      entry .options.input.id.window_entry -width 18 -relief sunken \
        -textvariable snap(window)
      label .options.input.id.display -text "Display:"
      entry .options.input.id.display_entry -width 18 -relief sunken \
        -textvariable snap(display)
      pack .options.input.id.window .options.input.id.window_entry \
        .options.input.id.display .options.input.id.display_entry -side left
      pack .options.input.checks .options.input.delay .options.input.id \
        -padx 1m -anchor w
    pack .options.input.id -pady 1m
  pack .options.input -expand 1 -fill both
  frame .options.processing_title
    label .options.processing_title.label -text "Image Processing"
    pack .options.processing_title.label
  pack .options.processing_title
  frame .options.processing -relief sunken -borderwidth 2
    frame .options.processing.checks
      checkbutton .options.processing.checks.dither -text "Dither" -width 11 \
        -anchor w -variable snap(dither)
      checkbutton .options.processing.checks.negate -text "Negate" -width 11 \
        -anchor w -variable snap(negate)
      checkbutton .options.processing.checks.monochrome -text "Monochrome" \
        -width 11 -anchor w -variable snap(monochrome)
      checkbutton .options.processing.checks.trim -text "Trim" -anchor w \
        -variable snap(trim)
      pack .options.processing.checks.dither .options.processing.checks.negate \
        .options.processing.checks.monochrome .options.processing.checks.trim \
        -side left
    pack .options.processing.checks
    frame .options.processing.colors
      label .options.processing.colors.label -text "Colors:" -width 9 -anchor w
      scale .options.processing.colors.scale -orient horizontal -length 11c \
        -from 0 -to 256 -tickinterval 32 -variable snap(colors)
      pack .options.processing.colors.label .options.processing.colors.scale \
        -side left
    pack .options.processing.colors
    frame .options.processing.rotate
      label .options.processing.rotate.label -text "Rotate:" -width 9 -anchor w
      scale .options.processing.rotate.scale -orient horizontal -length 11c \
        -from 0 -to 360 -tickinterval 45 -variable snap(degrees)
      pack .options.processing.rotate.label .options.processing.rotate.scale \
        -side left
    pack .options.processing.rotate
    pack .options.processing.checks .options.processing.colors \
      .options.processing.rotate -padx 1m -anchor w
  pack .options.processing -expand 1 -fill both
  frame .options.output_title
    label .options.output_title.label -text "Output"
    pack .options.output_title.label
  pack .options.output_title
  frame .options.output -relief sunken -borderwidth 2
    frame .options.output.checks
      checkbutton .options.output.checks.compress -text "Compress" -width 11 \
        -anchor w -variable snap(compress)
      checkbutton .options.output.checks.interlace -text "Interlace" -width 11 \
        -anchor w -variable snap(interlace)
      checkbutton .options.output.checks.verbose -text "Verbose" -anchor w \
        -variable snap(verbose)
      pack .options.output.checks.compress .options.output.checks.interlace \
        .options.output.checks.verbose -side left
    pack .options.output.checks
    frame .options.output.scene
      label .options.output.scene.label -text "Scene:" -width 9 -anchor w
      scale .options.output.scene.scale -orient horizontal -length 11c \
        -from 0 -to 40 -tickinterval 5 -variable snap(scene)
      pack .options.output.scene.label .options.output.scene.scale -side left
    pack .options.output.scene
    frame .options.output.comment
      label .options.output.comment.label -text "Comment:" -width 9 -anchor w
      entry .options.output.comment.entry -width 45 -relief sunken \
        -textvariable snap(comment)
      pack .options.output.comment.label .options.output.comment.entry \
        -side left
    pack .options.output.comment
    frame .options.output.label
      label .options.output.label.label -text "Label:" -width 9 -anchor w
      entry .options.output.label.entry -width 45 -relief sunken \
        -textvariable snap(label)
      pack .options.output.label.label .options.output.label.entry -side left
    pack .options.output.label
    frame .options.output.id
      label .options.output.id.page -text "Page:" -width 9 -anchor w
      entry .options.output.id.page_entry -width 18 -relief sunken \
        -textvariable snap(page)
      label .options.output.id.density -text "Density:"
      entry .options.output.id.density_entry -width 18 -relief sunken \
        -textvariable snap(density)
      pack .options.output.id.page .options.output.id.page_entry \
        .options.output.id.density .options.output.id.density_entry -side left
      pack .options.output.checks .options.output.scene \
        .options.output.comment .options.output.label .options.output.id \
        -padx 1m -anchor w
    pack .options.output.id -pady 1m
  pack .options.output -expand 1 -fill both
  button .options.button -text Ok -command {destroy .options}
  pack .options.button
  bind .options <Return> {destroy .options}
  #
  # Map options window.
  #
  pack .options.input_title .options.input .options.processing_title \
    .options.processing .options.output_title .options.output .options.button \
    -side top -padx 2m -pady 1m
}

#
# Proc Print prints the snapped image to a printer or command.
#
proc Print {} {
  global snap

  . configure -cursor watch
  update
  set command convert
  set command [concat $command $snap(snapshot)]
  set option +compress
  if {$snap(compress)} {
    set option "-compress zip"
  }
  set command [concat $command $option]
  set command [concat $command -density \"$snap(density)\"]
  set command [concat $command -page \"$snap(page)\"]
  set command [concat $command \"ps:|$snap(printer)\"]
  eval exec $command
  . configure -cursor {}
}

#
# Proc PrintImage allows the user to provide a command name to print with.
#
proc PrintImage {} {
  #
  # Initialize print window.
  #
  catch {destroy .print}
  toplevel .print -class Print
  wm title .print Print
  wm group .print .
  wm transient .print .
  wm geometry .print \
    +[expr {[winfo width .]+[winfo x .]+75}]+[expr {[winfo y .]+50}]
  #
  # Create print window frame.
  #
  frame .print.format
    scrollbar .print.format.scroll -command ".print.format.list yview"
    listbox .print.format.list -yscroll ".print.format.scroll set" -setgrid 1 \
      -height 8
    pack .print.format.scroll -side right -fill y
    pack .print.format.list -side top -expand 1 -fill both
    .print.format.list insert 0  \
      Letter Tabloid Ledger Legal Statement Executive A3 A4 A5 B4 B5 Folio \
      Quarto 10x14
    .print.format.list selection set 0
  pack .print.format
  frame .print.file
    entry .print.file.entry -width 18 -relief sunken -textvariable snap(printer)
    pack .print.file.entry -side right -expand 1 -fill both
  pack .print.file
  frame .print.buttons
    button .print.buttons.print -text Print -command Print
    button .print.buttons.cancel -text Cancel -command {destroy .print}
    pack .print.buttons.print .print.buttons.cancel -side left -expand 1 \
      -fill both -padx 2m
  pack .print.buttons
  #
  # Map print window.
  #
  pack .print.format .print.file .print.buttons -padx 2m -pady 2m -expand 1 \
    -fill both
  return
}

#
# Proc Save saves the snapped image to disk.
#
proc Save {} {
  global snap

  if ![file readable $snap(snapshot)] {
    Alert grab "You must snap an image before you can save it!" {"  OK  " {}}
    tkwait window .alert
    return
  }
  . configure -cursor watch
  update
  set command convert
  set command [concat $command $snap(snapshot)]
  set option +compress
  if {$snap(compress)} {
    set option "-compress zip"
  }
  set command [concat $command $option]
  set command [concat $command -density \"$snap(density)\"]
  set command [concat $command -page \"$snap(page)\"]
  set filename $snap(filename)
  if {$snap(format) != {}} {
    set filename "$snap(format):$snap(filename)"
  }
  set command [concat $command $filename]
  eval exec $command
  . configure -cursor {}
}

proc SaveImage {} {
  #
  # Initialize save window.
  #
  catch {destroy .save}
  toplevel .save -class Saves
  wm title .save "Save As..."
  wm group .save .
  wm transient .save .
  wm geometry .save \
    +[expr {[winfo width .]+[winfo x .]+50}]+[expr {[winfo y .]+25}]
  #
  # Create save window frame.
  #
  frame .save.format
    scrollbar .save.format.scroll -command ".save.format.list yview"
    listbox .save.format.list -yscroll ".save.format.scroll set" -setgrid 1 \
      -height 8
    pack .save.format.scroll -side right -fill y
    pack .save.format.list -side top -expand 1 -fill both
    .save.format.list insert 0  \
      ps avs bie bmp cmyk dcx eps epsf epsi fax fits gif gif87 gray g3 hdf \
      histogram jbig jpeg jpg map matte miff mpg mtv pbm pcd pcx pdf pgm pict \
      png ppm pnm ps2 ras rgb rle sgi sun tga tiff uyvy vid viff x xbm xpm \
      xv xwd yuv yuv3
    .save.format.list selection set 0
  pack .save.format
  frame .save.file
    entry .save.file.entry -width 18 -relief sunken -textvariable snap(filename)
    pack .save.file.entry -side right -expand 1 -fill both
  pack .save.file
  frame .save.buttons
    button .save.buttons.save -text Save -command Save
    button .save.buttons.cancel -text Cancel -command {destroy .save}
    pack .save.buttons.save .save.buttons.cancel -side left -expand 1 \
      -fill both -padx 2m
  pack .save.buttons
  #
  # Bind buttons to print window.
  #
  bind .save.format.list <ButtonRelease-1> {
    set snap(format) \
      [.save.format.list get [lindex [.save.format.list curselection] 0]]
  }
  bind .save.format.list <Double-Button-1> {AppendImageFormat .save}
  #
  # Map save window.
  #
  pack .save.format .save.file .save.buttons -padx 2m -pady 2m -expand 1 \
    -fill both
  return
}

#
# Proc ShowImage displays the full-sized snapped image in a top level window.
#
proc ShowImage { title name } {
  catch {destroy .show}
  toplevel .show -visual best
  wm title .show $title
  button .show.image -image $name -command {destroy .show}
  pack .show.image
}

#
# Proc Snap executes the ImageMagick import program to grab the image
# from the X server screen.
#
proc Snap {} {
  global snap

  #
  # Initialize import command.
  #
  set command import
  set command [concat $command -depth 8]
  set option +border
  if {$snap(border)} {
    set option -border
  }
  set command [concat $command $option]
  if {$snap(colors)} {
    set command [concat $command -colors $snap(colors)]
  }
  set command [concat $command -comment \"$snap(comment)\"]
  set option +compress
  if {$snap(compress)} {
    set option "-compress zip"
  }
  set command [concat $command $option]
  if {$snap(delay)} {
    set command [concat $command -delay $snap(delay)]
  }
  set command [concat $command -density \"$snap(density)\"]
  if {$snap(descend)} {
    set command [concat $command -descend]
  }
  set command [concat $command -display \"$snap(display)\"]
  set option +dither
  if {$snap(dither)} {
    set option -dither
  }
  set command [concat $command $option]
  set option +frame
  if {$snap(frame)} {
    set option -frame
  }
  set command [concat $command $option]
  set option +interlace
  if {$snap(interlace)} {
    set option "-interlace plane"
  }
  set command [concat $command $option]
  set command [concat $command -label \"$snap(label)\"]
  set option +monochrome
  if {$snap(monochrome)} {
    set option -monochrome
  }
  set command [concat $command $option]
  set option +negate
  if {$snap(negate)} {
    set option -negate
  }
  set command [concat $command $option]
  set command [concat $command -page \"$snap(page)\"]
  if {$snap(degrees)} {
    set command [concat $command -rotate $snap(degrees)]
  }
  if {$snap(scene)} {
    set command [concat $command -scene $snap(scene)]
  }
  set option +screen
  if {$snap(screen)} {
    set option -screen
  }
  set command [concat $command $option]
  if {$snap(trim)} {
    set command [concat $command -crop 0x0]
  }
  set option +verbose
  if {$snap(verbose)} {
    set option -verbose
  }
  set command [concat $command $option]
  set command [concat $command $snap(snapshot)]
  #
  # Import the image from the X server screen.
  #
  . configure -cursor watch
  update
  wm withdraw .
  eval exec $command
  wm deiconify .
  update
  catch {image delete snapshot}
  image create photo snapshot -file $snap(snapshot)
  #
  # Convert to an image tile.
  #
  exec convert -geometry 320x320> $snap(snapshot) $snap(tile)
  catch {image delete tile}
  image create photo tile -file $snap(tile)
  exec rm -f $snap(tile)
  #
  # Display tile image as a button.
  #
  if [winfo exists .canvas.label] {
    destroy .canvas.label
    destroy .canvas.button
  }
  label .canvas.label -text $snap(filename)
  button .canvas.button -image tile -relief sunken -borderwidth 2 \
    -command { ShowImage $snap(filename) snapshot }
  pack .canvas.label .canvas.button -side top -expand 1 -fill both \
    -padx 1m -pady 1m
  bind . <Return> { ShowImage $snap(filename) snapshot }
  . configure -cursor {}
}

#
# Proc SnapWindow creates the top level window.
#
proc SnapWindow {} {
  #
  # Initialize snap window.
  #
  wm title . "X-Windows Snapshot"
  wm iconname . "xsnap"
  #
  # Create snap window frame.
  #
  frame .toolbar -relief raised -bd 2
    menubutton .toolbar.file -text "File" -menu .toolbar.file.menu -underline 0
    menu .toolbar.file.menu
    .toolbar.file.menu add command -label "Save" -command Save
    .toolbar.file.menu add command -label "Save As ..." -command "SaveImage"
    .toolbar.file.menu add command -label Print -command PrintImage
    .toolbar.file.menu add separator
    .toolbar.file.menu add command -label Quit \
      -command { exec rm -f $snap(snapshot); exit }
    pack .toolbar.file -side left
  pack .toolbar -side top -fill x
  canvas .canvas -width 256 -height 128
  pack .canvas
  frame .buttons
    button .buttons.snap -text Snap -command Snap
    button .buttons.options -text Options -command Options
    pack .buttons.snap .buttons.options -side left -expand 1
  pack .buttons -side bottom -fill x -padx 2m -pady 2m
  #
  # Map snap window.
  #
  pack .toolbar .canvas .buttons
}

#
# Initalize snap options.
#
set snap(border) 0
set snap(colors) 0
set snap(comment) "Imported from %m image: %f"
set snap(compress) 1
set snap(degrees) 0
set snap(delay) 0
set snap(density) 72x72
set snap(descend) 0
set snap(display) :0
if [info exists env(DISPLAY)] {
  set snap(display) $env(DISPLAY)
}
set snap(dither) 1
set snap(filename) magick.ps
set snap(format) {}
set snap(frame) 0
set snap(interlace) 1
set snap(label) "%f   %wx%h"
set snap(monochrome) 0
set snap(negate) 0
set snap(page) Letter
set snap(printer) lp
set snap(scene) 0
set snap(screen) 0
set snap(snapshot) /tmp/snap[pid].pnm
set snap(tile) /tmp/tile[pid].pnm
set snap(trim) 0
set snap(verbose) 0
#
# Create top level snap window.
#
SnapWindow
tkwait window .
exec rm -f $snap(snapshot)