|
1 " |
|
2 COPYRIGHT (c) 1988-92 by Claus Gittinger |
|
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 |
|
27 COPYRIGHT (c) 1988-92 by Claus Gittinger |
|
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 |
|
34 %W% %E% |
|
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 ! ! |