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