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
|
PACKET eudas std listen
(*************************************************************************)
(* *)
(* Drucken von Standardlisten ohne Druckmuster *)
(* *)
(* Version 01 *)
(* *)
(* Autor: Thomas Berlage *)
(* Stand: 06.02.89 *)
(* *)
(*************************************************************************)
DEFINES
drucke standardlisten,
std listenbreite,
std listenlaenge,
std listenfont :
LET
listendruckmuster = "******* Listendruckmuster *******";
FILE VAR f;
TEXT VAR puffer, feldname;
TEXT VAR std font := "";
INT VAR
std breite := 70,
std laenge := 60;
PROC std listenbreite (INT CONST breite) :
std breite := breite
END PROC std listenbreite;
INT PROC std listenbreite :
std breite
END PROC std listenbreite;
PROC std listenlaenge (INT CONST laenge) :
std laenge := laenge
END PROC std listenlaenge;
INT PROC std listenlaenge :
std laenge
END PROC std listenlaenge;
PROC std listenfont (TEXT CONST font) :
std font := font
END PROC std listenfont;
TEXT PROC std listenfont :
std font
END PROC std listenfont;
PROC drucke standardlisten (INT CONST listenform, TEXT CONST feldliste) :
forget (listendruckmuster, quiet);
f := sequential file (output, listendruckmuster);
maxlinelength (f, std breite);
IF kommaliste THEN
generiere komma druckmuster (feldliste)
ELSE
generiere spalten druckmuster (feldliste)
END IF;
TEXT CONST last := std;
drucke (listendruckmuster);
forget (listendruckmuster, quiet);
last param (last) .
kommaliste :
listenform = 2 .
END PROC drucke standardlisten;
ROW 100 INT VAR feld max;
INT VAR
zeilen pro satz,
zeilenlaenge,
feldlaenge,
druckfelder,
ges max;
PROC generiere listenkopf :
IF std font <> "" THEN
putline (f, "#type(" + textdarstellung (std font) + ")#")
END IF;
putline (f, "% GRUPPE 1 seitennummer");
putline (f, "% VOR");
put (f, date); put (f, time of day); put (f, "Uhr:");
put (f, eudas dateiname (1));
write (f, (std breite - length (eudas dateiname (1)) - 25) * " ");
putline (f, "&&-S");
line (f)
END PROC generiere listenkopf;
PROC generiere seitenvorschub :
putline (f, "% NACH");
putline (f, "#page#");
putline (f, "% ABK");
putline (f, "&? : lfd nr .");
putline (f, "&-S : seitennummer .");
putline (f, "seitennummer :");
putline (f, " text (int (lfd nr) DIV saetze pro seite + 1) .");
write (f, "saetze pro seite : ");
put (f, (std laenge - 2) DIV zeilen pro satz - 1);
putline (f, ".")
END PROC generiere seitenvorschub;
PROC generiere komma druckmuster (TEXT CONST feldliste) :
generiere listenkopf;
generiere feldueberschriften;
generiere wiederholungsteil;
generiere seitenvorschub .
generiere feldueberschriften :
write (f, "Nr. ");
FOR i FROM 1 UPTO length (feldliste) REP
feldnamen lesen (code (feldliste SUB i), feldname);
IF i < length (feldliste) THEN
write (f, feldname + ", ")
ELSE
write (f, feldname)
END IF
END REP;
line (f);
putline (f, maxlinelength (f) * "-");
zeilen pro satz := 1 .
generiere wiederholungsteil :
putline (f, "% WDH");
INT CONST max alt := maxlinelength (f);
INT VAR i;
maxlinelength (f, 10000);
write (f, "&&? ");
FOR i FROM 1 UPTO length (feldliste) REP
ein feldname als muster
END REP;
line (f);
maxlinelength (f, max alt) .
ein feldname als muster :
write (f, "%<");
feldnamen lesen (code (feldliste SUB i), feldname);
write (f, feldname);
write (f, ">");
IF i < length (feldliste) THEN write (f, ", ") END IF .
END PROC generiere komma druckmuster;
PROC maxima suchen (TEXT CONST feldliste) :
INT VAR i;
maxima initialisieren;
auf satz (1);
INT VAR modus;
IF markierte saetze > 0 THEN
modus := 3;
IF NOT satz markiert THEN weiter (3) END IF
ELSE
modus := 2;
IF NOT satz ausgewaehlt THEN weiter (2) END IF
END IF;
WHILE NOT dateiende REP
einen satz testen;
weiter (modus)
END REP .
maxima initialisieren :
druckfelder := length (feldliste);
FOR i FROM 1 UPTO druckfelder REP
feld max (i) := 2
END REP;
ges max := 0 .
einen satz testen :
INT VAR gesamt := 0;
FOR i FROM 1 UPTO druckfelder REP
feld bearbeiten (code (feldliste SUB i),
PROC (TEXT CONST, INT CONST, INT CONST) fl);
IF feldlaenge > feld max (i) THEN feld max (i) := feldlaenge END IF;
gesamt INCR feldlaenge
END REP;
IF gesamt > ges max THEN ges max := gesamt END IF .
END PROC maxima suchen;
PROC fl (TEXT CONST satz, INT CONST von, bis) :
feldlaenge := bis - von + 1
END PROC fl;
PROC generiere spalten druckmuster (TEXT CONST feldliste) :
maxima suchen (feldliste);
generiere listenkopf;
generiere feldueberschriften;
generiere wiederholungsteil;
generiere abkuerzungen;
generiere seitenvorschub .
generiere feldueberschriften :
TEXT VAR abk felder := "";
INT VAR i;
zeilenlaenge := 4;
zeilen pro satz := 1;
write (f, "Nr. ");
FOR i FROM 1 UPTO length (feldliste) REP
feldnamen lesen (code (feldliste SUB i), feldname);
IF length (feldname) + 2 >= feld max (i) THEN
abkuerzung einfuehren
END IF;
zeilenlaenge INCR feld max (i) + 1;
IF zeilenlaenge > std breite THEN
line (f); zeilenlaenge := feld max (i) + 1; zeilen pro satz INCR 1
END IF;
write (f, text (feldname, feld max (i) + 1))
END REP;
line (f);
putline (f, maxlinelength (f) * "-") .
abkuerzung einfuehren :
abk felder CAT (feldliste SUB i) .
generiere wiederholungsteil :
putline (f, "% WDH");
write (f, "&&? ");
FOR i FROM 1 UPTO length (feldliste) REP
ein feldmuster erzeugen
END REP;
line (f) .
ein feldmuster erzeugen :
INT CONST abk pos := pos (abk felder, feldliste SUB i);
puffer := "&";
IF abk pos > 0 THEN
puffer CAT text (code (abk pos + 64), feld max (i))
ELSE
feldnamen lesen (code (feldliste SUB i), feldname);
puffer CAT text ("<" + feldname + ">", feld max (i))
END IF;
write (f, puffer) .
generiere abkuerzungen :
IF abk felder <> "" THEN
putline (f, "% ABK");
FOR i FROM 1 UPTO length (abk felder) REP
eine abkuerzung generieren
END REP
END IF .
eine abkuerzung generieren :
write (f, "&");
write (f, code (i + 64));
write (f, " : ");
write (f, "f (");
feldnamen lesen (code (abk felder SUB i), feldname);
write (f, textdarstellung (feldname));
putline (f, ") .") .
END PROC generiere spalten druckmuster;
END PACKET eudas std listen;
|
