0
|
1 |
"
|
4
|
2 |
COPYRIGHT (c) 1988 by Claus Gittinger
|
71
|
3 |
All Rights Reserved
|
0
|
4 |
|
|
5 |
This software is furnished under a license and may be used
|
|
6 |
only in accordance with the terms of that license and with the
|
|
7 |
inclusion of the above copyright notice. This software may not
|
|
8 |
be provided or otherwise made available to, or used by, any
|
|
9 |
other person. No title to or ownership of the software is
|
|
10 |
hereby transferred.
|
|
11 |
"
|
|
12 |
|
|
13 |
PrinterStream subclass:#PostscriptPrinterStream
|
126
|
14 |
instanceVariableNames:'xPos yPos lineBuffer colNr lineNr fFamily fStyle'
|
|
15 |
classVariableNames:'Prolog Trailer PageProlog PageTrailer FontHeight FontWidth LeftX
|
170
|
16 |
TopY LinesPerPage Italic Bold Normal Courier Times Helvetica'
|
126
|
17 |
poolDictionaries:''
|
|
18 |
category:'Streams-External'
|
0
|
19 |
!
|
|
20 |
|
6
|
21 |
!PostscriptPrinterStream class methodsFor:'documentation'!
|
|
22 |
|
31
|
23 |
copyright
|
|
24 |
"
|
|
25 |
COPYRIGHT (c) 1988 by Claus Gittinger
|
71
|
26 |
All Rights Reserved
|
31
|
27 |
|
|
28 |
This software is furnished under a license and may be used
|
|
29 |
only in accordance with the terms of that license and with the
|
|
30 |
inclusion of the above copyright notice. This software may not
|
|
31 |
be provided or otherwise made available to, or used by, any
|
|
32 |
other person. No title to or ownership of the software is
|
|
33 |
hereby transferred.
|
|
34 |
"
|
|
35 |
!
|
|
36 |
|
6
|
37 |
documentation
|
|
38 |
"
|
28
|
39 |
This class provides simple text output to postscript printers;
|
31
|
40 |
to use it, evaluate
|
|
41 |
Smalltalk at:#Printer put:PostscriptPrinterStream
|
28
|
42 |
(usually in -rc file).
|
0
|
43 |
|
28
|
44 |
It does not support graphics and other fancy features of Postscript, but
|
|
45 |
provides a compatible interface to line-printing (see other subclasses of
|
|
46 |
PrinterStream).
|
6
|
47 |
"
|
126
|
48 |
!
|
|
49 |
|
|
50 |
version
|
170
|
51 |
^ '$Header: /cvs/stx/stx/libbasic2/PostscriptPrinterStream.st,v 1.15 1996-01-27 18:33:23 cg Exp $'
|
6
|
52 |
! !
|
0
|
53 |
|
|
54 |
!PostscriptPrinterStream class methodsFor:'initialization'!
|
|
55 |
|
|
56 |
fontNames
|
|
57 |
^ #('/Helvetica-Oblique'
|
71
|
58 |
'/Helvetica-Bold'
|
|
59 |
'/Helvetica'
|
|
60 |
'/Times-Italic'
|
|
61 |
'/Times-Bold'
|
|
62 |
'/Times'
|
|
63 |
'/Courier-Oblique'
|
|
64 |
'/Courier-Bold'
|
|
65 |
'/Courier' )
|
0
|
66 |
!
|
|
67 |
|
|
68 |
initialize
|
|
69 |
|tmpString t fontNr|
|
|
70 |
|
170
|
71 |
Normal isNil ifTrue:[
|
|
72 |
Normal := 0.
|
|
73 |
Bold := 1.
|
|
74 |
Italic := 2.
|
0
|
75 |
|
170
|
76 |
Courier := 0.
|
|
77 |
Times := 3.
|
|
78 |
Helvetica := 6.
|
0
|
79 |
|
170
|
80 |
LinesPerPage := 66.
|
|
81 |
FontHeight := 200.
|
|
82 |
FontWidth := 120.
|
|
83 |
LeftX := 900.
|
|
84 |
TopY := 14900.
|
|
85 |
|
|
86 |
tmpString :=
|
0
|
87 |
'%!!PS-Adobe-1.0
|
|
88 |
%%Creator: Smalltalk
|
|
89 |
%%DocumentFonts: Courier-Oblique Courier-Bold Courier Times-Italic Times-Bold Times
|
|
90 |
save/SmalltalkJob exch def
|
|
91 |
/StartSmalltalkDoc{$smalltalk begin}def
|
|
92 |
/$smalltalk 50 dict def $smalltalk begin
|
|
93 |
/EndSmalltalkDoc{end}def
|
|
94 |
/S/show load def
|
|
95 |
/X{exch 0 rmoveto S}def
|
|
96 |
/Y{exch 0 exch rmoveto S}def
|
|
97 |
/B{3 1 roll moveto S}def
|
|
98 |
/F{$fd exch get setfont}def
|
|
99 |
/StartPage{/svpg save def .05 dup scale}def
|
|
100 |
/EndPage{svpg restore showpage}def
|
|
101 |
/DoPreFeed{/statusdict where{pop
|
|
102 |
statusdict/prefeed known{statusdict exch/prefeed exch put 0}if}if pop}def
|
|
103 |
/Landscape{90 rotate 0 -15840 translate}def
|
|
104 |
/SetUpFonts
|
|
105 |
{dup/$fd exch array def{findfont exch scalefont $fd 3 1 roll put}repeat}def
|
|
106 |
/InitGaudy{/TwoColumn exch def /BarLength exch def
|
|
107 |
/ftD /Times-Bold findfont 12 UP scalefont def
|
|
108 |
/ftF /Times-Roman findfont 14 UP scalefont def
|
|
109 |
/ftP /Helvetica-Bold findfont 30 UP scalefont def}def
|
|
110 |
/U{1440 mul}def
|
|
111 |
/UP{U 72 div}def
|
|
112 |
/LB{/pts exch UP def /charcolor exch def /boxcolor exch def /font exch def
|
|
113 |
/label exch def /dy exch def /dx exch def /lly exch def /llx exch def
|
|
114 |
gsave boxcolor setgray
|
|
115 |
llx lly moveto dx 0 rlineto 0 dy rlineto dx neg 0 rlineto closepath fill
|
|
116 |
/lines label length def
|
|
117 |
/yp lly dy add dy lines pts mul sub 2 div sub pts .85 mul sub def
|
|
118 |
font setfont charcolor setgray
|
|
119 |
label {dup stringwidth pop 2 div llx dx 2 div add exch sub yp moveto show
|
|
120 |
/yp yp pts sub def}forall grestore}def
|
|
121 |
/Gaudy{/Page exch def /Date exch def /File exch def /Comment exch def
|
|
122 |
.25 U 10.2 U BarLength .1 sub U .25 U [File] ftF .97 0 14 LB
|
|
123 |
.25 U 10.45 U BarLength .1 sub U .25 U [Comment] ftF 1 0 14 LB
|
|
124 |
.25 U 10.2 U 1 U .5 U Date ftD .7 0 12 LB
|
|
125 |
BarLength .75 sub U 10.2 U 1 U .5 U [Page] ftP .7 1 30 LB
|
|
126 |
TwoColumn{BarLength 2 div .19 add U 10.2 U moveto 0 -10 U rlineto stroke}if
|
|
127 |
}def
|
|
128 |
end
|
|
129 |
StartSmalltalkDoc % end fixed prolog
|
|
130 |
'.
|
170
|
131 |
fontNr := 8.
|
|
132 |
t := ''.
|
|
133 |
self fontNames do:[:aName |
|
|
134 |
t := t , (fontNr printString) , ' '
|
|
135 |
, (FontHeight printString) , ' '
|
|
136 |
, aName , (Character nl) asString.
|
|
137 |
fontNr := fontNr - 1
|
|
138 |
].
|
|
139 |
tmpString := tmpString , t.
|
|
140 |
tmpString := tmpString , '9 SetUpFonts
|
0
|
141 |
'.
|
170
|
142 |
Prolog := tmpString.
|
0
|
143 |
|
170
|
144 |
PageProlog :=
|
0
|
145 |
'StartPage
|
|
146 |
'.
|
|
147 |
|
170
|
148 |
PageTrailer :=
|
0
|
149 |
'EndPage
|
|
150 |
'.
|
|
151 |
|
170
|
152 |
Trailer :=
|
0
|
153 |
'EndSmalltalkDoc
|
|
154 |
SmalltalkJob restore
|
|
155 |
'
|
170
|
156 |
]
|
0
|
157 |
! !
|
|
158 |
|
126
|
159 |
!PostscriptPrinterStream methodsFor:'access writing'!
|
0
|
160 |
|
126
|
161 |
bold
|
|
162 |
self flushLine.
|
|
163 |
fStyle := Bold.
|
|
164 |
self setFont
|
0
|
165 |
!
|
|
166 |
|
126
|
167 |
courier
|
0
|
168 |
self flushLine.
|
126
|
169 |
fFamily := Courier.
|
|
170 |
self setFont
|
0
|
171 |
!
|
|
172 |
|
|
173 |
cr
|
6
|
174 |
"send line termination"
|
|
175 |
|
0
|
176 |
self flushLine.
|
28
|
177 |
xPos := LeftX.
|
0
|
178 |
colNr := 0.
|
28
|
179 |
yPos := yPos - FontHeight.
|
0
|
180 |
lineNr := lineNr + 1.
|
28
|
181 |
lineNr > LinesPerPage ifTrue:[
|
71
|
182 |
self nextPage
|
0
|
183 |
]
|
|
184 |
!
|
|
185 |
|
126
|
186 |
helvetica
|
|
187 |
self flushLine.
|
|
188 |
fFamily := Helvetica.
|
|
189 |
self setFont
|
|
190 |
!
|
|
191 |
|
|
192 |
italic
|
|
193 |
self flushLine.
|
|
194 |
fStyle := Italic.
|
|
195 |
self setFont
|
|
196 |
!
|
|
197 |
|
0
|
198 |
nextPut:aCharacter
|
|
199 |
(aCharacter == Character cr) ifTrue:[
|
71
|
200 |
^ self cr
|
0
|
201 |
].
|
|
202 |
(aCharacter == $( ) ifTrue:[
|
71
|
203 |
lineBuffer := lineBuffer , '\(' .
|
|
204 |
^ self
|
0
|
205 |
].
|
|
206 |
(aCharacter == $) ) ifTrue:[
|
71
|
207 |
lineBuffer := lineBuffer , '\)' .
|
|
208 |
^ self
|
0
|
209 |
].
|
|
210 |
(aCharacter == $\ ) ifTrue:[
|
71
|
211 |
lineBuffer := lineBuffer , '\\' .
|
|
212 |
^ self
|
0
|
213 |
].
|
|
214 |
(aCharacter == Character tab ) ifTrue:[
|
71
|
215 |
self flushLine.
|
|
216 |
colNr := ((colNr + 8) // 8) * 8.
|
|
217 |
xPos := LeftX + (colNr * FontWidth).
|
|
218 |
^ self
|
0
|
219 |
].
|
|
220 |
lineBuffer := lineBuffer copyWith:aCharacter
|
|
221 |
!
|
|
222 |
|
126
|
223 |
normal
|
0
|
224 |
self flushLine.
|
126
|
225 |
fStyle := Normal.
|
0
|
226 |
self setFont
|
|
227 |
!
|
|
228 |
|
|
229 |
times
|
|
230 |
self flushLine.
|
|
231 |
fFamily := Times.
|
|
232 |
self setFont
|
126
|
233 |
! !
|
|
234 |
|
|
235 |
!PostscriptPrinterStream methodsFor:'open/close'!
|
|
236 |
|
|
237 |
endPrint
|
|
238 |
self endPage.
|
|
239 |
super nextPutAll:Trailer.
|
|
240 |
super endPrint
|
0
|
241 |
!
|
|
242 |
|
126
|
243 |
startPrint
|
|
244 |
Prolog isNil ifTrue:[
|
|
245 |
self class initialize
|
|
246 |
].
|
|
247 |
fFamily := Courier.
|
|
248 |
fStyle := Normal.
|
|
249 |
super writingTo:PrintCommand.
|
|
250 |
super nextPutAllUntranslated:Prolog.
|
|
251 |
self startPage
|
|
252 |
! !
|
|
253 |
|
|
254 |
!PostscriptPrinterStream methodsFor:'private'!
|
|
255 |
|
|
256 |
endPage
|
0
|
257 |
self flushLine.
|
126
|
258 |
super nextPutAllUntranslated:PageTrailer
|
0
|
259 |
!
|
|
260 |
|
126
|
261 |
flushLine
|
|
262 |
(lineBuffer size > 0) ifTrue:[
|
|
263 |
super nextPutAllUntranslated:(xPos printString ).
|
|
264 |
super nextPutAllUntranslated:' '.
|
|
265 |
super nextPutAllUntranslated:(yPos printString).
|
|
266 |
super nextPutAllUntranslated:'('.
|
|
267 |
super nextPutAllUntranslated:lineBuffer.
|
|
268 |
super nextPutAllUntranslated:')B'.
|
|
269 |
super nextPutUntranslated:(Character cr).
|
|
270 |
xPos := xPos + (FontWidth * lineBuffer size).
|
|
271 |
colNr := colNr + lineBuffer size
|
|
272 |
].
|
|
273 |
lineBuffer := ''
|
|
274 |
!
|
|
275 |
|
|
276 |
nextPage
|
|
277 |
self endPage.
|
|
278 |
self startPage
|
0
|
279 |
!
|
|
280 |
|
126
|
281 |
setFont
|
|
282 |
|fontNumber|
|
|
283 |
fontNumber := fFamily + fStyle.
|
|
284 |
super nextPutAllUntranslated:fontNumber printString.
|
|
285 |
super nextPutAllUntranslated:' F'.
|
|
286 |
super nextPutUntranslated:(Character cr)
|
0
|
287 |
!
|
|
288 |
|
126
|
289 |
startPage
|
|
290 |
super nextPutAllUntranslated:PageProlog.
|
|
291 |
self setFont.
|
|
292 |
yPos := TopY.
|
|
293 |
xPos := LeftX.
|
|
294 |
lineBuffer := ''.
|
|
295 |
lineNr := 1.
|
|
296 |
colNr := 0
|
0
|
297 |
! !
|
126
|
298 |
|
|
299 |
PostscriptPrinterStream initialize!
|