summaryrefslogtreecommitdiff
path: root/app/eudas/5.3/src/eudas.uebersicht.04
blob: be597dabec4908112369e92c089bbce3f25b83b1 (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
PACKET uebersichtsanzeige

(*************************************************************************)
(*                                                                       *)
(*     Anzeige von EUDAS-Dateien als Übersicht                           *)
(*                                                                       *)
(*     Version 04                                                        *)
(*                                                                       *)
(*     Autor: Thomas Berlage                                             *)
(*     Stand: 14.01.88                                                   *)
(*                                                                       *)
(*************************************************************************)

  DEFINES

  uebersicht,
  uebersichtsfenster :


ROW 24 INT VAR zeilensatz;

ROW 24 INT VAR zeilenkombi;

FENSTER VAR fenster;
fenster initialisieren (fenster);

INT VAR
  laenge := 24,
  breite := 79,
  zeilen anf := 1,
  spalten anf := 1,
  freier rest,
  feldversion := -1;

BOOL VAR
  bis zeilenende;

TEXT VAR
  feldnummern;

LET
  niltext = "",
  begin mark = ""15"",
  end mark = ""14"",
  blank = " ",
  piep = ""7"",
  cleol = ""5"";

LET
  t satznr =  #901#
    ""15"Satznr. ",
  t dateiende =  #902#
    "  << DATEIENDE >>",
  uebersicht status =  #903#
"UEBERSICHT:   Rollen: HOP OBEN, HOP UNTEN   Beenden: ESC q   Hilfe: ESC ?";


PROC uebersichtsfenster (FENSTER CONST fe) :

  fenstergroesse (fe, spalten anf, zeilen anf, breite, laenge);
  fenstergroesse setzen (fenster, fe);
  bis zeilenende := spalten anf + breite >= x size

END PROC uebersichtsfenster;

FENSTER PROC uebersichtsfenster :
  fenster
END PROC uebersichtsfenster;

PROC uebersicht (TEXT CONST nummern, PROC hilfe) :

  TEXT VAR eingabezeichen;
  BOOL VAR dummy;
  INT VAR
    angezeigter satz := 1,
    ausgegebene zeilen := 0,
    eingabezustand := 1;

  fensterzugriff (fenster, dummy);
  status anzeigen (uebersicht status);
  feldnummern bestimmen;
  aktueller satz wird erster;
  REP
    kommando annehmen und zeile ausgeben;
    cursor auf zeilenanfang;
    kommando interpretieren
  END REP .

feldnummern bestimmen :
  IF nummern = niltext THEN
    ggf alte auswahl uebernehmen
  ELSE
    feldnummern := nummern;
    feldversion := dateiversion
  END IF .

ggf alte auswahl uebernehmen :
  IF feldversion <> dateiversion THEN
    alle felder anzeigen;
    feldversion := dateiversion
  END IF .

alle felder anzeigen :
  INT VAR i;
  feldnummern := niltext;
  FOR i FROM 1 UPTO anzahl felder REP
    feldnummern CAT code (i)
  END REP .

kommando annehmen und zeile ausgeben :
  WHILE ausgegebene zeilen < laenge REP
    eingabezeichen := getcharety;
    IF eingabezeichen <> "" THEN
      LEAVE kommando annehmen und zeile ausgeben
    END IF;
    eine zeile ausgeben;
    ausgegebene zeilen INCR 1
  END REP;
  aktuellen satz markieren und einnehmen;
  getchar (eingabezeichen) .

eine zeile ausgeben :
  IF ausgegebene zeilen = 0 THEN
    ueberschrift ausgeben
  ELIF ausgegebene zeilen = 1 THEN
    erste zeile ausgeben
  ELSE
    weitere zeile ausgeben
  END IF .

ueberschrift ausgeben :
  cursor (spalten anf, zeilen anf);
  out (t satznr);
  freier rest := breite - length (t satznr) - 1;
  INT VAR feldindex;
  FOR feldindex FROM 1 UPTO length (feldnummern)
  WHILE freier rest > 0 REP
    feldnamen bearbeiten (code (feldnummern SUB feldindex),
      PROC (TEXT CONST, INT CONST, INT CONST) feld bis rest)
  END REP;
  zeilenrest loeschen;
  cursor (spalten anf + breite - 1, zeilen anf);
  out (end mark) .

erste zeile ausgeben :
  auf uebersichtssatz (1);
  satznummer in zeile (1);
  satz als zeile ausgeben .

weitere zeile ausgeben :
  cursor (spalten anf, zeilen anf + ausgegebene zeilen);
  IF dateiende THEN
    zeilensatz (ausgegebene zeilen) := 0;
    freier rest := breite;
    zeilenrest loeschen
  ELSE
    naechsten satz einnehmen;
    satznummer in zeile (ausgegebene zeilen);
    satz als zeile ausgeben
  END IF .

naechsten satz einnehmen :
  weiter (2);
  auf abbruch testen;
  zeilensatz (ausgegebene zeilen) := satznummer;
  zeilenkombi (ausgegebene zeilen) := satzkombination .

auf abbruch testen :
  IF NOT (satz ausgewaehlt OR dateiende) THEN
    LEAVE uebersicht
  END IF .

cursor auf zeilenanfang :
  cursor (spalten anf, zeilen anf + angezeigter satz) .

aktuellen satz markieren und einnehmen :
  WHILE zeilensatz (angezeigter satz) = 0 REP
    angezeigter satz DECR 1
  END REP;
  auf uebersichtssatz (angezeigter satz);
  cursor (spalten anf + 6, zeilen anf + angezeigter satz) .

kommando interpretieren :
  SELECT eingabezustand OF
  CASE 1 : normales kommando interpretieren
  CASE 2 : hop kommando interpretieren
  CASE 3 : esc kommando interpretieren
  END SELECT .

normales kommando interpretieren :
  SELECT pos (""3""10""1""27"+-", eingabezeichen) OF
  CASE 1 : zeile nach oben
  CASE 2 : zeile nach unten
  CASE 3 : eingabezustand := 2
  CASE 4 : eingabezustand := 3
  CASE 5 : markieren
  CASE 6 : demarkieren
  OTHERWISE out (piep)
  END SELECT .

hop kommando interpretieren :
  SELECT pos (""3""10""13"", eingabezeichen) OF
  CASE 1 : seite nach oben
  CASE 2 : seite nach unten
  CASE 3 : hop return
  OTHERWISE out (piep)
  END SELECT;
  eingabezustand := 1 .

esc kommando interpretieren :
  SELECT pos ("19qh?", eingabezeichen) OF
  CASE 1 : esc 1
  CASE 2 : esc 9
  CASE 3, 4 : esc q
  CASE 5 : hilfestellung
  OTHERWISE out (piep)
  END SELECT;
  eingabezustand := 1 .

zeile nach oben :
  IF angezeigter satz > 1 THEN
    angezeigter satz DECR 1;
  ELSE
    nach oben rollen (1);
    ausgegebene zeilen := 1
  END IF .

zeile nach unten :
  IF NOT dateiende THEN
    IF angezeigter satz < laenge - 1 THEN
      angezeigter satz INCR 1
    ELSE
      zeilensatz (1) := zeilensatz (2);
      zeilenkombi (1) := zeilenkombi (2);
      ausgegebene zeilen := 1
    END IF
  END IF .

markieren :
  IF NOT satz markiert THEN
    markierung aendern;
    IF angezeigter satz < ausgegebene zeilen THEN
      satznummer in zeile (angezeigter satz)
    END IF
  END IF .

demarkieren :
  IF satz markiert THEN
    markierung aendern;
    IF angezeigter satz < ausgegebene zeilen THEN
      satznummer in zeile (angezeigter satz)
    END IF
  END IF .

seite nach oben :
  IF angezeigter satz > 1 THEN
    angezeigter satz := 1
  ELSE
    nach oben rollen (laenge - 1);
    ausgegebene zeilen := 1
  END IF .

seite nach unten :
  IF angezeigter satz = laenge - 1 AND NOT dateiende THEN
    weiter (2);
    aktueller satz wird erster;
    ausgegebene zeilen := 1
  ELSE
    angezeigter satz := laenge - 1
  END IF .

hop return :
  IF angezeigter satz <> 1 THEN
    zeilensatz (1) := zeilensatz (angezeigter satz);
    zeilenkombi (1) := zeilenkombi (angezeigter satz);
    angezeigter satz := 1;
    ausgegebene zeilen := 1
  END IF .

esc 1 :
  auf satz (1);
  IF NOT satz ausgewaehlt THEN
    weiter (2)
  END IF;
  aktueller satz wird erster;
  angezeigter satz := 1;
  ausgegebene zeilen := 1 .

esc 9 :
  auf satz (32767);
  aktueller satz wird erster;
  nach oben rollen (laenge - 2);
  ausgegebene zeilen := 1 .

esc q :
  LEAVE uebersicht .

hilfestellung :
  hilfe;
  status anzeigen (uebersicht status);
  ausgegebene zeilen := 0 .

END PROC uebersicht;

PROC nach oben rollen (INT CONST gerollt) :

  INT VAR i;
  auf uebersichtssatz (1);
  FOR i FROM 1 UPTO gerollt
  WHILE satznummer > 1 REP
    zurueck (2)
  END REP;
  aktueller satz wird erster

END PROC nach oben rollen;

PROC auf uebersichtssatz (INT CONST zeile) :

  auf satz (zeilensatz (zeile));
  WHILE satzkombination <> zeilenkombi (zeile) REP
    weiter (1)
  END REP

END PROC auf uebersichtssatz;

PROC aktueller satz wird erster :

  zeilensatz (1) := satznummer;
  zeilenkombi (1) := satzkombination

END PROC aktueller satz wird erster;

BOOL PROC uebereinstimmung (INT CONST zeile) :

  satznummer = zeilensatz (zeile) CAND satzkombination = zeilenkombi (zeile)

END PROC uebereinstimmung;

PROC feld bis rest (TEXT CONST satz, INT CONST von, bis) :

  INT CONST laenge := min (freier rest, bis - von + 1);
  outsubtext (satz, von, von + laenge - 1);
  freier rest DECR laenge;
  IF freier rest >= 2 THEN
    out (", "); freier rest DECR 2
  ELIF freier rest = 1 THEN
    out (","); freier rest := 0
  END IF

END PROC feld bis rest;

PROC satznummer in zeile (INT CONST zeile) :

  cursor (spalten anf, zeilen anf + zeile);
  IF satz markiert THEN
    out (begin mark)
  ELSE
    out (blank)
  END IF;
  outtext (text (satznummer), 1, 5);
  IF satz markiert THEN
    out (end mark)
  ELSE
    out (blank)
  END IF;
  freier rest := breite - 7

END PROC satznummer in zeile;

PROC zeilenrest loeschen :

  IF bis zeilenende THEN
    out (cleol)
  ELSE
    freier rest TIMESOUT blank
  END IF

END PROC zeilenrest loeschen;

PROC satz als zeile ausgeben :

  IF satz ausgewaehlt THEN
    felder ausgeben
  ELIF dateiende THEN
    out (t dateiende);
    freier rest DECR length (t dateiende)
  ELSE
    out ("<< >>");
    freier rest DECR 5
  END IF;
  zeilenrest loeschen .

felder ausgeben :
  INT VAR feldindex;
  FOR feldindex FROM 1 UPTO length (feldnummern)
  WHILE freier rest > 0 REP
    feld bearbeiten (code (feldnummern SUB feldindex),
      PROC (TEXT CONST, INT CONST, INT CONST) feld bis rest)
  END REP .

END PROC satz als zeile ausgeben;

END PACKET uebersichtsanzeige;