summaryrefslogtreecommitdiff
path: root/dviware/psprint/vms/pswriter.mod
blob: a18ccc2df11d02e8173f6118cf7461b68f3629de (plain)
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
IMPLEMENTATION MODULE PSWriter;

(* Author:         Andrew Trevorrow
   Implementation: University of Hamburg Modula-2 under VAX/VMS version 4
   Date Started:   August, 1986

   Description:
   PostScript output routines used by PSDVI.
   The output file consists of calls to various PostScript procedures
   defined in a header file that must be prepended to the output.

   Some of the PostScript procedures expect integer arguments that represent
   page positions in TeX's coordinate system.  Units are in "dots" (i.e.,
   device pixels, where /RESOLUTION defines the number of dots per inch).
   The origin (0,0) is a dot 1 inch in from both the top and left paper edges.
   Horizontal coordinates increase to the right and vertical coordinates
   increase down the page.  The header file must contain the necessary matrix
   transformations to convert TeX coordinates back into device coordinates.

   Revised:
   November, 1987 (while at The Open University)
 - Output file is now normal text file rather than fixed-length record file.
 - Added SaveVM and RestoreVM routines to support the conserveVM flag
   used by the main module.
 - Added SetPostScriptChar to overcome rounding problems if we try to
   use SetBitmapChar for a PostScript font.

   June--August, 1988 (while at Aston University)
 - Modified SetPostScriptChar to output strings like SetBitmapChar.
 - EndBitmapFont now called EndFont as it is used for both font types.

   September--October, 1989 (while at Aston University, 2nd time)
 - Modified SendBitmapChar and SetPostScriptChar so they can't create
   a string too long for WriteChar's output buffer.
   Adrian Clark can now use his half-tone font with PSPRINT.
*)

FROM FileSystem IMPORT
   File, Create, Open, Done,
   ReadChar, WriteChar,
   Eof, Close;

CONST
   NULL = 0C;
   CR   = 15C;
   DEL  = 177C;

VAR
   PSfile : File;          (* output file *)
   curh, curv : INTEGER;   (* for SetBitmapChar and SetPostScriptChar *)
   stringlen : CARDINAL;   (* ditto; current string length *)
   pendingch : CHAR;       (* ditto; terminates current string *)

(******************************************************************************)

PROCEDURE OpenOutput (name : ARRAY OF CHAR) : BOOLEAN;

BEGIN
(* SYSDEP: create a normal VAX/VMS text file *)
Create(PSfile,name,TRUE,TRUE);
RETURN Done();
END OpenOutput;

(******************************************************************************)

PROCEDURE OutputHeader (name : ARRAY OF CHAR) : BOOLEAN;

VAR f : File;   ch : CHAR;

BEGIN
Open(f,name,FALSE);       (* SYSDEP: read only *)
IF Done() THEN
   LOOP
      ReadChar(f,ch);     (* next char or Eof *)
      IF Eof(f) THEN
         EXIT;
      ELSE
         Put(ch);         (* copy verbatim, including any ctrl chars *)
      END;
   END;
   Close(f);
   RETURN TRUE;
ELSE
   RETURN FALSE;          (* couldn't open given file *)
END;
END OutputHeader;

(******************************************************************************)

PROCEDURE BeginPage (DVIpage : CARDINAL);

BEGIN
PutCard(DVIpage); PutString(' @bop0'); Put(CR);
END BeginPage;

(******************************************************************************)

PROCEDURE NewBitmapFont (VAR fontid : ARRAY OF CHAR);

BEGIN
Put('/'); PutString(fontid); PutString(' @newfont'); Put(CR);
END NewBitmapFont;

(******************************************************************************)

PROCEDURE OutputPage (DVIpage : CARDINAL);

BEGIN
PutCard(DVIpage); PutString(' @bop1'); Put(CR);
END OutputPage;

(******************************************************************************)

PROCEDURE OutputSpecial (VAR name : specialstring;
                         hpos, vpos : INTEGER) : BOOLEAN;

VAR f : File;   fspec : specialstring;   ch : CHAR;   i : CARDINAL;

BEGIN
(* check name for optional space (indicating additional PostScript text) *)
i := 0;
fspec := '';                (* SYSDEP: fill with NULLs *)
WHILE (i <= HIGH(name)) AND (name[i] <> ' ') DO
   fspec[i] := name[i];     (* extract file spec from name *)
   INC(i);
END;
Open(f,fspec,FALSE);        (* SYSDEP: read only *)
IF Done() THEN
   PutInt(hpos); Put(' '); PutInt(vpos); PutString(' p'); Put(CR);
   PutString('@bsp'); Put(CR);
   IF i <= HIGH(name) THEN
      (* name[i] is first ' '; skip this and copy rest of name to output *)
      INC(i);
      WHILE (i <= HIGH(name)) AND (name[i] <> NULL) DO
         Put(name[i]);
         INC(i);
      END;
      Put(CR);              (* text becomes first line of file *)
   END;
   LOOP
      ReadChar(f,ch);       (* next char or Eof *)
      IF Eof(f) THEN
         EXIT;
      ELSE
         Put(ch);           (* copy verbatim, including any ctrl chars *)
      END;
   END;
   Close(f);
   PutString('@esp'); Put(CR);
   RETURN TRUE;
ELSE
   RETURN FALSE;            (* couldn't open given file *)
END;
END OutputSpecial;

(******************************************************************************)

PROCEDURE SaveVM (VAR fontid : ARRAY OF CHAR);

BEGIN
Put('/'); PutString(fontid); PutString(' @saveVM'); Put(CR);
END SaveVM;

(******************************************************************************)

PROCEDURE BeginPostScriptFont (VAR fontname : ARRAY OF CHAR;
                               scaledsize, mag : INTEGER);

(* Output PostScript code to scale and set a resident PostScript font.
   The fontname will be the name of a TFM file (beginning with /psprefix value).
   This TFM name will need to be converted into a PostScript font name.
   The scaledsize and mag parameters represent the desired size of the font.
*)

BEGIN
(* sp will convert scaled points to dots *)
PutInt(scaledsize);  PutString(' sp ');
PutInt(mag);         PutString(' 1000 div mul ');
PutString(fontname); PutString(' PSfont'); Put(CR);
(* initialize some globals for first SetPostScriptChar in this font *)
curh := MAX(INTEGER);
curv := MAX(INTEGER);
stringlen := 0;
pendingch := '?';
END BeginPostScriptFont;

(******************************************************************************)

PROCEDURE SetPostScriptChar (ch : CHAR; hpos, vpos, pwidth : INTEGER);

(* Similar to SetBitmapChar but we cannot use RELATIVE horizontal positioning
   because the advance widths of characters in a PostScript font are not
   an integral number of dots, and we must avoid accumulated rounding errors.
*)

BEGIN
IF curv = vpos THEN            (* don't update v position *)
   IF curh <> hpos THEN        (* update h position *)
      stringlen := 0;
      Put(')'); Put(pendingch); Put(CR);
      PutInt(hpos); Put('(');
      pendingch := 'H';
   END;
ELSE                           (* update h and v position *)
   IF stringlen > 0 THEN
      stringlen := 0;
      Put(')'); Put(pendingch); Put(CR);
   END;
   PutInt(hpos); Put(' '); PutInt(vpos); Put('(');
   pendingch := 'S';
END;
IF (ch >= ' ') AND (ch < DEL) THEN
   IF (ch = '(') OR (ch = ')') OR (ch = '\') THEN   (* prefix (,),\ with \ *)
      Put('\'); Put(ch);
   ELSE
      Put(ch);
   END;
ELSE
   Put('\');
   (* and put out 3 octal digits representing ch *)
   Put( CHR(ORD('0') + (ORD(ch) DIV 64)) );
   Put( CHR(ORD('0') + ((ORD(ch) DIV 8) MOD 8)) );
   Put( CHR(ORD('0') + (ORD(ch) MOD 8)) );
END;
(* update current page position and string length for next call *)
curh := hpos + pwidth;
curv := vpos;
INC(stringlen);
IF (stringlen MOD 72) = 0 THEN Put('\'); Put(CR) END;
END SetPostScriptChar;

(******************************************************************************)

PROCEDURE BeginBitmapFont (VAR fontid : ARRAY OF CHAR);

BEGIN
PutString(fontid); PutString(' sf'); Put(CR);
(* Initialize some globals for first SetBitmapChar in this font.
   This is not relevant when BeginBitmapFont is used before OutputPage.
*)
curh := MAX(INTEGER);
curv := MAX(INTEGER);
stringlen := 0;
pendingch := '?';
END BeginBitmapFont;

(******************************************************************************)

PROCEDURE SetBitmapChar (ch : CHAR; hpos, vpos, pwidth : INTEGER);

BEGIN
IF curv = vpos THEN            (* don't update v position *)
   IF curh <> hpos THEN        (* update h position (kern or space) *)
      stringlen := 0;
      Put(')'); Put(pendingch); Put(CR);
      PutInt(hpos-curh); Put('(');
      pendingch := 'h';
   END;
ELSE                           (* update h and v position *)
   IF stringlen > 0 THEN
      stringlen := 0;
      Put(')'); Put(pendingch); Put(CR);
   END;
   PutInt(hpos); Put(' '); PutInt(vpos); Put('(');
   pendingch := 's';
END;
IF (ch >= ' ') AND (ch < DEL) THEN
   IF (ch = '(') OR (ch = ')') OR (ch = '\') THEN   (* prefix (,),\ with \ *)
      Put('\'); Put(ch);
   ELSE
      Put(ch);
   END;
ELSE
   Put('\');
   (* and put out 3 octal digits representing ch *)
   Put( CHR(ORD('0') + (ORD(ch) DIV 64)) );
   Put( CHR(ORD('0') + ((ORD(ch) DIV 8) MOD 8)) );
   Put( CHR(ORD('0') + (ORD(ch) MOD 8)) );
END;
(* update current page position and string length for next call *)
curh := hpos + pwidth;
curv := vpos;
INC(stringlen);
IF (stringlen MOD 72) = 0 THEN Put('\'); Put(CR) END;
END SetBitmapChar;

(******************************************************************************)

PROCEDURE EndFont;

(* Terminate the last "h v(..." or "dh(..." for the current font. *)

BEGIN
IF stringlen > 0 THEN
   Put(')'); Put(pendingch); Put(CR);
END;
END EndFont;

(******************************************************************************)

PROCEDURE RestoreVM;

BEGIN
PutString('@restoreVM'); Put(CR);
END RestoreVM;

(******************************************************************************)

PROCEDURE SetRule (wd, ht : CARDINAL; hpos, vpos : INTEGER);

BEGIN
PutCard(wd); Put(' '); PutCard(ht); Put(' ');
PutInt(hpos); Put(' '); PutInt(vpos);
PutString(' r'); Put(CR);
END SetRule;

(******************************************************************************)

PROCEDURE EndPage (DVIpage : CARDINAL);

BEGIN
PutCard(DVIpage); PutString(' @eop'); Put(CR);
END EndPage;

(******************************************************************************)

PROCEDURE CloseOutput;

BEGIN
PutString('@end'); Put(CR);
Close(PSfile);
END CloseOutput;

(******************************************************************************)

PROCEDURE Put (ch : CHAR);

BEGIN
WriteChar(PSfile,ch);
END Put;

(******************************************************************************)

PROCEDURE PutString (s : ARRAY OF CHAR);

VAR i : INTEGER;

BEGIN
(* SYSDEP: LEN assumes end of string is first NULL, or string is full *)
FOR i := 0 TO LEN(s) - 1 DO
   WriteChar(PSfile,s[i]);
END;
END PutString;

(******************************************************************************)

PROCEDURE PutInt (i : INTEGER);

(* We call PutCard after writing any '-' sign. *)

BEGIN
IF i < 0 THEN
   WriteChar(PSfile,'-');
   i := ABS(i);
END;
PutCard(CARDINAL(i));
END PutInt;

(******************************************************************************)

PROCEDURE PutCard (c : CARDINAL);

(* Since the majority of given values will be < 10,000 we avoid
   recursion until c >= 10,000.
*)

BEGIN
IF c < 10 THEN
   WriteChar(PSfile, CHR(ORD('0') + c) );
ELSIF c < 100 THEN
   WriteChar(PSfile, CHR(ORD('0') + (c DIV 10)) );    c := c MOD 10;
   WriteChar(PSfile, CHR(ORD('0') + c) );
ELSIF c < 1000 THEN
   WriteChar(PSfile, CHR(ORD('0') + (c DIV 100)) );   c := c MOD 100;
   WriteChar(PSfile, CHR(ORD('0') + (c DIV 10)) );    c := c MOD 10;
   WriteChar(PSfile, CHR(ORD('0') + c) );
ELSIF c < 10000 THEN
   WriteChar(PSfile, CHR(ORD('0') + (c DIV 1000)) );  c := c MOD 1000;
   WriteChar(PSfile, CHR(ORD('0') + (c DIV 100)) );   c := c MOD 100;
   WriteChar(PSfile, CHR(ORD('0') + (c DIV 10)) );    c := c MOD 10;
   WriteChar(PSfile, CHR(ORD('0') + c) );
ELSE
   PutCard(c DIV 10000);   (* recursive if c >= 10000 *)
   c := c MOD 10000;
   WriteChar(PSfile, CHR(ORD('0') + (c DIV 1000)) );  c := c MOD 1000;
   WriteChar(PSfile, CHR(ORD('0') + (c DIV 100)) );   c := c MOD 100;
   WriteChar(PSfile, CHR(ORD('0') + (c DIV 10)) );    c := c MOD 10;
   WriteChar(PSfile, CHR(ORD('0') + c) );
END;
END PutCard;

(******************************************************************************)

BEGIN
END PSWriter.