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
|
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
# $Id: prntview.tcl,v 2.14 2005/01/02 00:45:07 jfontain Exp $
class printViewer {
set ::env(DISPLAY) [winfo screen .] ;# to make sure gs outputs to screen
set (pixelsPerInch) [winfo pixels . 1i]
set (pixelsPerMillimeter) [expr {$(pixelsPerInch) / 25.4}]
set (margin) 10
set (offset) 3
set (pageHeight) 130 ;# initial values in millimeters
set (pageWidth) 100
proc printViewer {this parentPath args} composite {[new frame $parentPath -background gray] $args} {
set path $widget::($this,path)
set ($this,shadow) [frame $path.shadow -background black]
set ($this,sheet) [frame $path.sheet -container 1 -background white]
scan [winfo id $($this,sheet)] 0x%x ($this,id)
set ($this,height) [expr {round($(pageHeight) * $(pixelsPerMillimeter))}] ;# in pixels
set ($this,width) [expr {round($(pageWidth) * $(pixelsPerMillimeter))}]
composite::complete $this
}
proc ~printViewer {this} {
terminateProcess $this
if {$composite::($this,-deletefile)} {
file delete $composite::($this,-file)
}
}
proc options {this} {
return [list\
[list -deletefile 0 0]\
[list -file {} {}]\
[list -pageheight $(pageHeight)]\
[list -pagewidth $(pageWidth)]\
[list -zoom 1 1]\
]
}
proc set-deletefile {this value} {} ;# delete source postscript file when done
proc set-file {this value} {}
proc set-pageheight {this value} { ;# in millimeters
set ($this,height) [expr {round($value * $(pixelsPerMillimeter))}] ;# in pixels
displaySheet $this
}
proc set-pagewidth {this value} {
set ($this,width) [expr {round($value * $(pixelsPerMillimeter))}]
displaySheet $this
}
proc set-zoom {this value} {}
proc terminateProcess {this} { ;# eventually terminate existing viewer process
catch {puts $($this,channel) quit}
catch {close $($this,channel)}
}
proc displaySheet {this} {
set ratio $composite::($this,-zoom)
set width [expr {round($($this,width) * $ratio)}]
set height [expr {round($($this,height) * $ratio)}]
place $($this,sheet) -x $(margin) -y $(margin) -width $width -height $height
place $($this,shadow) -x [expr {$(margin) + $(offset)}] -y [expr {$(margin) + $(offset)}] -width $width -height $height
$widget::($this,path) configure\
-width [expr {$width + (2 * $(margin)) + $(offset)}] -height [expr {$height + (2 * $(margin)) + $(offset)}]
}
proc refresh {this} { ;# public procedure
if {[string length $composite::($this,-file)] == 0} return
terminateProcess $this
displaySheet $this
set ratio $composite::($this,-zoom)
set width [expr {round($($this,width) * $ratio)}]
set height [expr {round($($this,height) * $ratio)}]
set pixelsPerInch [expr {round($(pixelsPerInch) * $ratio)}]
# use open instead of exec so that application is not hung while previewing
set ($this,channel) [open\
"|gs -q -sDEVICE=x11 -dWindowID=$($this,id) -g${width}x$height -r$pixelsPerInch -dBATCH -dNOPROMPT\
$composite::($this,-file)"\
w\
]
fconfigure $($this,channel) -blocking 0 ;# required to prevent hang state
}
}
|
