summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLars-Dominik Braun <lars@6xq.net>2016-10-09 11:28:19 +0200
committerLars-Dominik Braun <lars@6xq.net>2016-10-09 11:28:19 +0200
commitafd4c3c448381f6eb706090911a15c162fdaf8af (patch)
tree90955166d185de4acd210c3880dc78640ecd31fa
parent724cc003460ec67eda269911da85c9f9e40aa6cf (diff)
downloadeumel-src-afd4c3c448381f6eb706090911a15c162fdaf8af.tar.gz
eumel-src-afd4c3c448381f6eb706090911a15c162fdaf8af.tar.bz2
eumel-src-afd4c3c448381f6eb706090911a15c162fdaf8af.zip
Decompress source files
EUMEL’s TEXT dataspaces wastes a lot of storage space. Some files were therefore “compressed” by storing them as a single line, reducing overhead significantly.
-rw-r--r--dialog/ls-DIALOG 1558
-rw-r--r--dialog/ls-DIALOG 2871
-rw-r--r--dialog/ls-DIALOG 3414
-rw-r--r--dialog/ls-DIALOG 4762
-rw-r--r--dialog/ls-DIALOG 51480
-rw-r--r--dialog/ls-DIALOG 61238
-rw-r--r--dialog/ls-DIALOG 7464
-rw-r--r--dialog/ls-DIALOG MENUKARTEN MANAGER44
-rw-r--r--dialog/ls-DIALOG MM-gen27
-rw-r--r--dialog/ls-DIALOG decompress9
-rw-r--r--dialog/ls-DIALOG-gen108
-rw-r--r--hamster/ls-Herbert und Robbi 11018
-rw-r--r--hamster/ls-Herbert und Robbi 2120
-rw-r--r--hamster/ls-Herbert und Robbi 3963
-rw-r--r--hamster/ls-Herbert und Robbi-gen125
-rw-r--r--menugenerator/ls-Menu-Generator 1373
-rw-r--r--menugenerator/ls-Menu-Generator 2720
-rw-r--r--menugenerator/ls-Menu-Generator-gen92
-rw-r--r--mp-bap/ls-MP BAP 11415
-rw-r--r--mp-bap/ls-MP BAP 21472
-rw-r--r--mp-bap/ls-MP BAP-gen80
-rw-r--r--prozess/ls-Prozess 1 für AKTRONIC-Adapter564
-rw-r--r--prozess/ls-Prozess 1 für MUFI als Endgerät557
-rw-r--r--prozess/ls-Prozess 1 für MUFI im Terminalkanal511
-rw-r--r--prozess/ls-Prozess 2227
-rw-r--r--prozess/ls-Prozess 39
-rw-r--r--prozess/ls-Prozess 4606
-rw-r--r--prozess/ls-Prozess 5863
-rw-r--r--warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter190
-rw-r--r--warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät197
-rw-r--r--warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal89
-rw-r--r--warenhaus/ls-Warenhaus 0: ohne Kartenleser26
-rw-r--r--warenhaus/ls-Warenhaus 1222
-rw-r--r--warenhaus/ls-Warenhaus 21319
-rw-r--r--warenhaus/ls-Warenhaus 31018
-rw-r--r--warenhaus/ls-Warenhaus 4419
-rw-r--r--warenhaus/ls-Warenhaus 51352
-rw-r--r--warenhaus/ls-Warenhaus-gen74
38 files changed, 19327 insertions, 1269 deletions
diff --git a/dialog/ls-DIALOG 1 b/dialog/ls-DIALOG 1
index 974bcda..b4a2408 100644
--- a/dialog/ls-DIALOG 1
+++ b/dialog/ls-DIALOG 1
@@ -22,39 +22,527 @@
*)
PACKET ls dialog 1 DEFINES
- ecke oben links, balken oben,{} ecke oben rechts, balken rechts,{} ecke unten links, balken links,{} ecke unten rechts, balken unten,{} waagerecht, senkrecht, kreuz,{} cursor on, cursor off,{} clear buffer, clear buffer and count,{} center, invers, page, page up,{} out frame, out menuframe, erase frame,{} std graphic char, ft20 graphic char,{} ibm graphic char, AREA, :=, fill,{} areax, areay, areaxsize, areaysize,{} cursor, get cursor, out, out invers,{}
- out with beam, out invers with beam,{} erase, erase invers, erase with beam:{}TYPE AREA = STRUCT (INT x, y, xsize, ysize);{}LET blank = " ",{} mark ein = ""15"",{} mark aus = ""14"",{} cleol = ""5"";{}TEXT CONST fehlermeldung :: "Unzulässige Größen!";{}TEXT VAR eol := "+", eor := "+", eul := "+", eur := "+",{} bo := "+", br := "+", bl := "+", bu := "+",{} waa := "-", sen := "|", kr := "+",{} cursor sichtbar := "", cursor unsichtbar := "";{}
-TEXT PROC ecke oben links : eol END PROC ecke oben links ;{}TEXT PROC ecke oben rechts: eor END PROC ecke oben rechts ;{}TEXT PROC ecke unten links : eul END PROC ecke unten links ;{}TEXT PROC ecke unten rechts: eur END PROC ecke unten rechts ;{}TEXT PROC balken oben : bo END PROC balken oben ;{}TEXT PROC balken links : bl END PROC balken links ;{}TEXT PROC balken rechts : br END PROC balken rechts ;{}TEXT PROC balken unten : bu END PROC balken unten ;{}
-TEXT PROC waagerecht : waa END PROC waagerecht ;{}TEXT PROC senkrecht : sen END PROC senkrecht ;{}TEXT PROC kreuz : kr END PROC kreuz ;{}PROC ecke oben links (TEXT CONST t): eol := t END PROC ecke oben links ;{}PROC ecke oben rechts (TEXT CONST t): eor := t END PROC ecke oben rechts ;{}PROC ecke unten links (TEXT CONST t): eul := t END PROC ecke unten links ;{}PROC ecke unten rechts (TEXT CONST t): eur := t END PROC ecke unten rechts ;{}
-PROC balken oben (TEXT CONST t): bo := t END PROC balken oben ;{}PROC balken links (TEXT CONST t): bl := t END PROC balken links ;{}PROC balken rechts (TEXT CONST t): br := t END PROC balken rechts ;{}PROC balken unten (TEXT CONST t): bu := t END PROC balken unten ;{}PROC waagerecht (TEXT CONST t): waa := t END PROC waagerecht ;{}PROC senkrecht (TEXT CONST t): sen := t END PROC senkrecht ;{}PROC kreuz (TEXT CONST t): kr := t END PROC kreuz ;{}
-PROC std graphic char:{} ecke oben links ("+"); ecke oben rechts ("+");{} ecke unten links ("+"); ecke unten rechts ("+");{} balken oben ("+"); balken rechts ("+");{} balken links ("+"); balken unten ("+");{} waagerecht ("-"); senkrecht ("|");{} kreuz ("+");{} cursor sichtbar := ""; cursor unsichtbar := ""{}END PROC std graphic char;{}PROC ft20 graphic char:{} ecke oben links (""27"R�"27"S"); ecke oben rechts (""27"RD"27"S");{} ecke unten links (""27"RH"27"S"); ecke unten rechts (""27"RL"27"S");{}
- balken oben (""27"RP"27"S"); balken rechts (""27"RT"27"S");{} balken links (""27"RX"27"S"); balken unten (""27"R\"27"S");{} waagerecht (""27"R`"27"S"); senkrecht (""27"Rd"27"S");{} kreuz (""27"Rh"27"S");{} cursor sichtbar := ""27"-1" ; cursor unsichtbar := ""27"-0" ;{} ft20 statuszeilen aus{}END PROC ft20 graphic char;{}PROC ft 20 statuszeilen aus: out (""27".A") END PROC ft 20 statuszeilen aus;{}PROC ft 20 statuszeilen an : out (""27".�") END PROC ft 20 statuszeilen an ;{}
-PROC ibm graphic char:{} ecke oben links (""201""); ecke oben rechts (""187"");{} ecke unten links (""200""); ecke unten rechts (""188"");{} balken oben (""203""); balken rechts (""185"");{} balken links (""204""); balken unten (""202"");{} waagerecht (""205""); senkrecht (""186"");{} kreuz (""206"");{} cursor sichtbar := "" ; cursor unsichtbar := ""{}END PROC ibm graphic char;{}PROC cursor on : out (cursor sichtbar ) END PROC cursor on ;{}
-PROC cursor off : out (cursor unsichtbar) END PROC cursor off;{}PROC cursor on (TEXT CONST t): cursor sichtbar := t END PROC cursor on ;{}PROC cursor off (TEXT CONST t): cursor unsichtbar := t END PROC cursor off;{}PROC clear buffer:{} REP UNTIL incharety = "" PER{}END PROC clear buffer;{}INT PROC clear buffer and count (TEXT CONST zeichen):{} INT VAR zaehler :: 0;{} TEXT VAR zeichenkette :: "", ch;{} IF zeichen = "" THEN clear buffer; LEAVE clear buffer and count WITH 0 FI;{}
- ermittle die zeichenkette;{} untersuche auf vorhandene zeichen;{} zaehler.{} ermittle die zeichenkette:{} REP{} ch := incharety (1);{} zeichenkette CAT ch{} UNTIL ch = "" PER.{} untersuche auf vorhandene zeichen:{} INT VAR i;{} FOR i FROM 1 UPTO length (zeichenkette) REP{} IF pos (subtext (zeichenkette, i), zeichen) = 1{} THEN zaehler INCR 1{} FI{} PER.{}END PROC clear buffer and count;{}TEXT PROC center (INT CONST xsize, TEXT CONST t):{} TEXT VAR zeile :: compress (t);{}
- zeile := ((xsize - length (zeile)) DIV 2) * blank + zeile;{} zeile CAT (xsize - length (zeile)) * blank;{} zeile{}END PROC center;{}TEXT PROC center (TEXT CONST t):{} center (79, t){}END PROC center;{}TEXT PROC invers (TEXT CONST t):{} TEXT VAR neu :: mark ein; neu CAT t; neu CAT " "; neu CAT mark aus;{} neu{}END PROC invers;{}PROC page (INT CONST x, y, xsize, ysize):{} INT VAR zeiger;{} IF x + xsize = 80{} THEN in einem streich{} ELSE putze vorsichtig{} FI;{} cursor (x, y).{}
- in einem streich:{} FOR zeiger FROM y UPTO y + ysize - 1 REP{} cursor (x, zeiger); out (cleol){} PER.{} putze vorsichtig:{} FOR zeiger FROM y UPTO y + ysize - 1 REP{} cursor (x, zeiger); xsize TIMESOUT blank{} PER.{}END PROC page;{}PROC page (AREA CONST a):{} page (a.x, a.y, a.xsize, a.ysize){}END PROC page;{}PROC page up (INT CONST x, y, xsize, ysize):{} INT VAR zeiger;{} IF x + xsize = 80{} THEN in einem streich{} ELSE putze vorsichtig{}
- FI.{} in einem streich:{} FOR zeiger FROM y + ysize - 1 DOWNTO y REP{} cursor (x, zeiger); out (cleol){} PER.{} putze vorsichtig:{} FOR zeiger FROM y + ysize - 1 DOWNTO y REP{} cursor (x, zeiger); xsize TIMESOUT blank{} PER.{}END PROC page up;{}PROC page up (AREA CONST a):{} page up (a.x, a.y, a.xsize, a.ysize){}END PROC page up;{}PROC out frame (INT CONST x, y, xsize, ysize):{} INT VAR zeiger;{} IF x < 1 COR y < 1 COR xsize < 8 COR ysize < 3 COR{} x + xsize > 80 COR y + ysize > 25{}
- THEN LEAVE out frame{} FI;{} male oben;{} male seiten;{} male unten.{} male oben:{} cursor (x, y);{} out (ecke oben links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke oben rechts).{} male seiten:{} FOR zeiger FROM 1 UPTO ysize - 2 REP{} cursor (x, y + zeiger); out (senkrecht);{} cursor (x + xsize - 1, y + zeiger); out (senkrecht){} PER.{} male unten:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{}
- out (ecke unten rechts){}END PROC out frame;{}PROC out frame (AREA CONST a):{} IF a.x - 1 < 1 OR a.y - 1 < 1{} OR a.xsize + 2 > 79 OR a.ysize + 2 > 24{} OR a.x + a.xsize + 1 > 80{} OR a.y + a.ysize + 1 > 25{} THEN LEAVE out frame{} FI;{} out frame (a.x - 1, a.y - 1, a.xsize + 2, a.ysize + 2){}END PROC out frame;{}PROC out menuframe (INT CONST x, y, xsize, ysize):{} INT VAR i;{} untersuche angaben;{} schreibe rahmen.{} untersuche angaben:{} IF x < 0 COR y < 0 COR x + xsize > 81 COR y + ysize > 26{}
- THEN LEAVE out menuframe{} FI.{} schreibe rahmen:{} IF x = 0 COR y = 0 COR xsize = 81 COR ysize = 26{} THEN zeichne reduzierten rahmen{} ELSE zeichne vollen rahmen{} FI.{} zeichne reduzierten rahmen:{} zeichne oberlinie;{} zeichne unterlinie.{} zeichne oberlinie:{} cursor (1, 2);{} 79 TIMESOUT waagerecht.{} zeichne unterlinie:{} cursor (1, 23);{} 79 TIMESOUT waagerecht.{} zeichne vollen rahmen:{} schreibe kopf; schreibe rumpf; schreibe fuss;{}
- schreibe kopfleiste; schreibe fussleiste.{} schreibe kopf:{} cursor (x, y);{} out (ecke oben links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke oben rechts).{} schreibe rumpf:{} FOR i FROM y + 1 UPTO y + ysize - 2 REP{} cursor (x, i); out (senkrecht);{} cursor (x + xsize - 1, i); out (senkrecht){} PER.{} schreibe fuss:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{}
- schreibe kopfleiste:{} cursor (x, y + 2 ); schreibe balkenlinie.{} schreibe fussleiste:{} cursor (x, y + ysize - 3); schreibe balkenlinie.{} schreibe balkenlinie:{} out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts).{}END PROC out menuframe;{}PROC out menuframe (AREA CONST a):{} out menuframe (a.x - 1, a.y - 1, a.xsize + 2, a.ysize + 2){}END PROC out menuframe;{}PROC erase frame (INT CONST x, y, xsize, ysize):{} INT VAR zeiger;{} loesche oben; loesche seiten; loesche unten.{}
- loesche oben:{} cursor (x, y); xsize TIMESOUT blank.{} loesche seiten:{} FOR zeiger FROM 1 UPTO ysize - 2 REP{} cursor (x, y + zeiger); out (blank);{} cursor (x + xsize - 1, y + zeiger); out (blank){} PER.{} loesche unten:{} cursor (x, y + ysize - 1); xsize TIMESOUT blank.{}END PROC erase frame;{}OP := (AREA VAR ziel, AREA CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}PROC fill (AREA VAR ziel, INT CONST a, b, c, d):{} IF a < 1 COR b < 1 COR a > 79 COR b > 24 COR c < 8 COR d < 3{}
- COR c > 79 COR d > 24 COR a + c > 80 COR b + d > 25{} THEN errorstop (fehlermeldung){} FI;{} ziel.x := a; ziel.y := b; ziel.xsize := c; ziel.ysize := d{}END PROC fill;{}INT PROC areax (AREA CONST a): a.x END PROC areax;{}INT PROC areay (AREA CONST a): a.y END PROC areay;{}INT PROC areaxsize (AREA CONST a): a.xsize END PROC areaxsize;{}INT PROC areaysize (AREA CONST a): a.ysize END PROC areaysize;{}PROC out (TEXT CONST t, INT CONST breite):{} outtext (t, 1, breite){}
-END PROC out;{}PROC erase (INT CONST breite):{} breite TIMESOUT blank{}END PROC erase;{}PROC cursor (AREA CONST a, INT CONST spa, zei):{} cursor (a.x + spa - 1, a.y + zei - 1){}END PROC cursor;{}PROC get cursor (AREA CONST a, INT VAR spalte, zeile):{} INT VAR x, y;{} get cursor (x, y);{} spalte := x - a.x + 1; zeile := y - a.y + 1{}END PROC get cursor;{}PROC out (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{} ueberpruefe cursorangaben; positioniere cursor;{} IF text ist zu lang{} THEN verkuerzte ausgabe{}
- ELSE out (t){} FI.{} ueberpruefe cursorangaben:{} IF spa > xsize COR zei > a.ysize COR spa < 1 COR zei < 1{} THEN LEAVE out{} FI.{} positioniere cursor:{} cursor (a.x + spa - 1, a.y + zei - 1).{} text ist zu lang:{} length (t) > a.xsize - spa + 1.{} verkuerzte ausgabe:{} outsubtext (t, 1, a.xsize - spa + 1){}END PROC out;{}PROC out (AREA CONST a, INT CONST spa, zei, TEXT CONST t, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} IF laenge ist zu gross{}
- THEN verkuerzte ausgabe{} ELSE outtext (t, 1, laenge){} FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize COR zei > a.ysize COR spa < 1 COR zei < 1{} THEN LEAVE out{} FI.{} positioniere cursor:{} cursor (a.x + spa - 1, a.y + zei - 1).{} laenge ist zu gross:{} laenge > a.xsize - spa + 1.{} verkuerzte ausgabe:{} outtext (t, 1, a.xsize - spa + 1){}END PROC out;{}PROC erase (AREA CONST a, INT CONST spa, zei, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{}
- IF laenge ist zu gross{} THEN verkuerzte ausgabe{} ELSE erase (laenge){} FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize COR zei > a.ysize COR spa < 1 COR zei < 1{} THEN LEAVE erase{} FI.{} positioniere cursor:{} cursor (a.x + spa - 1, a.y + zei - 1).{} laenge ist zu gross:{} laenge > a.xsize - spa + 1.{} verkuerzte ausgabe:{} erase (a.xsize - spa + 1){}END PROC erase;{}PROC out invers (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{} ueberpruefe cursorangaben; positioniere cursor;{}
- IF text ist zu lang{} THEN verkuerzte ausgabe{} ELSE out (mark ein); out (t); out (blank); out (mark aus){} FI.{} ueberpruefe cursorangaben:{} IF spa > (xsize - 4) COR zei > ysize COR spa < 2 COR zei < 1{} THEN LEAVE out invers{} FI.{} positioniere cursor:{} cursor (a.x + spa - 2, a.y + zei - 1).{} text ist zu lang:{} length (t) > a.xsize - spa - 1.{} verkuerzte ausgabe:{} out (mark ein); outsubtext (t, 1, a.xsize - spa - 1);{} out (blank); out (mark aus){}END PROC out invers;{}
-PROC out invers (AREA CONST a, INT CONST spa, zei,{} TEXT CONST t, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} IF laenge ist zu gross{} THEN verkuerzte ausgabe{} ELSE out (mark ein); outtext (t, 1, laenge); out (blank); out (mark aus){} FI.{} ueberpruefe cursorangaben:{} IF spa > (a.xsize - 4) COR zei > a.ysize COR spa < 2 COR zei < 1{} THEN LEAVE out invers{} FI.{} positioniere cursor:{} cursor (a.x + spa - 2, a.y + zei - 1).{}
- laenge ist zu gross:{} laenge > a.xsize - spa - 1.{} verkuerzte ausgabe:{} out (mark ein); outsubtext (t, 1, a.xsize - spa - 1);{} out (blank); out (mark aus){}END PROC out invers;{}PROC erase invers (AREA CONST a, INT CONST spa, zei, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} IF laenge ist zu gross{} THEN verkuerzte ausgabe{} ELSE erase (laenge + 3){} FI.{} ueberpruefe cursorangaben:{} IF spa > (a.xsize - 4) COR zei > a.ysize COR spa < 2 COR zei < 1{}
- THEN LEAVE erase invers{} FI.{} positioniere cursor:{} cursor (a.x + spa - 2, a.y + zei - 1).{} laenge ist zu gross:{} laenge > a.xsize - spa - 1.{} verkuerzte ausgabe:{} erase ( a.xsize - spa + 2).{}END PROC erase invers;{}PROC out with beam (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{} ueberpruefe cursorangaben; positioniere cursor;{} IF text ist zu lang{} THEN verkuerzte ausgabe{} ELSE out (senkrecht); out (blank); out (blank);{} out (t);{} out (blank); out (blank); out (senkrecht){}
- FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{} THEN LEAVE out with beam{} FI.{} positioniere cursor:{} cursor (a.x + spa - 4, a.y + zei - 1).{} text ist zu lang:{} length (t) > a.xsize - spa - 2.{} verkuerzte ausgabe:{} out (senkrecht); out (blank); out (blank);{} outsubtext (t, 1, a.xsize - spa - 2);{} out (blank); out (blank); out (senkrecht){}END PROC out with beam;{}PROC out with beam (AREA CONST a, INT CONST spa, zei,{}
- TEXT CONST t, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} IF laenge ist zu gross{} THEN verkuerzte ausgabe{} ELSE out (senkrecht); out (blank); out (blank);{} outtext (t, 1,laenge);{} out (blank); out (blank); out (senkrecht){} FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{} THEN LEAVE out with beam{} FI.{} positioniere cursor:{} cursor (a.x + spa - 4, a.y + zei - 1).{}
- laenge ist zu gross:{} laenge > a.xsize - spa - 2.{} verkuerzte ausgabe:{} out (senkrecht); out (blank); out (blank);{} outsubtext (t, 1, a.xsize - spa - 2);{} out (blank); out (blank); out (senkrecht){}END PROC out with beam;{}PROC erase with beam (AREA CONST a, INT CONST spa, zei, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} IF laenge ist zu gross{} THEN verkuerzte ausgabe{} ELSE erase (laenge + 6){} FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{}
- THEN LEAVE erase with beam{} FI.{} positioniere cursor:{} cursor (a.x + spa - 4, a.y + zei - 1).{} laenge ist zu gross:{} laenge > a.xsize - spa - 2.{} verkuerzte ausgabe:{} erase (a.xsize - spa + 4).{}END PROC erase with beam;{}PROC out invers with beam (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{} ueberpruefe cursorangaben; positioniere cursor;{} IF text ist zu lang{} THEN verkuerzte ausgabe{} ELSE out (senkrecht); out (blank); out (mark ein);{} out (t);{}
- out (blank); out (mark aus); out (senkrecht){} FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{} THEN LEAVE out invers with beam{} FI.{} positioniere cursor:{} cursor (a.x + spa - 4, a.y + zei - 1).{} text ist zu lang:{} length (t) > a.xsize - spa - 2.{} verkuerzte ausgabe:{} out (senkrecht); out (blank); out (mark ein);{} outsubtext (t, 1, a.xsize - spa - 2);{} out (blank); out (mark aus); out (senkrecht){}
-END PROC out invers with beam;{}PROC out invers with beam (AREA CONST a, INT CONST spa, zei,{} TEXT CONST t, INT CONST laenge):{} ueberpruefe cursorangaben; positioniere cursor;{} IF laenge ist zu gross{} THEN verkuerzte ausgabe{} ELSE out (senkrecht); out (blank); out (mark ein);{} outtext (t, 1, laenge);{} out (blank); out (mark aus); out (senkrecht){} FI.{} ueberpruefe cursorangaben:{} IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{}
- THEN LEAVE out invers with beam{} FI.{} positioniere cursor:{} cursor (a.x + spa - 4, a.y + zei - 1).{} laenge ist zu gross:{} laenge > a.xsize - spa - 2.{} verkuerzte ausgabe:{} out (senkrecht); out (blank); out (mark ein);{} outsubtext (t, 1, a.xsize - spa - 2);{} out (blank); out (mark aus); out (senkrecht){}END PROC out invers with beam;{}END PACKET ls dialog 1;{}
+ ecke oben links, balken oben,
+ ecke oben rechts, balken rechts,
+ ecke unten links, balken links,
+ ecke unten rechts, balken unten,
+ waagerecht, senkrecht, kreuz,
+ cursor on, cursor off,
+ clear buffer, clear buffer and count,
+ center, invers, page, page up,
+ out frame, out menuframe, erase frame,
+ std graphic char, ft20 graphic char,
+ ibm graphic char, AREA, :=, fill,
+ areax, areay, areaxsize, areaysize,
+ cursor, get cursor, out, out invers,
+
+ out with beam, out invers with beam,
+ erase, erase invers, erase with beam:
+TYPE AREA = STRUCT (INT x, y, xsize, ysize);
+LET blank = " ",
+ mark ein = ""15"",
+ mark aus = ""14"",
+ cleol = ""5"";
+TEXT CONST fehlermeldung :: "Unzulässige Größen!";
+TEXT VAR eol := "+", eor := "+", eul := "+", eur := "+",
+ bo := "+", br := "+", bl := "+", bu := "+",
+ waa := "-", sen := "|", kr := "+",
+ cursor sichtbar := "", cursor unsichtbar := "";
+
+TEXT PROC ecke oben links : eol END PROC ecke oben links ;
+TEXT PROC ecke oben rechts: eor END PROC ecke oben rechts ;
+TEXT PROC ecke unten links : eul END PROC ecke unten links ;
+TEXT PROC ecke unten rechts: eur END PROC ecke unten rechts ;
+TEXT PROC balken oben : bo END PROC balken oben ;
+TEXT PROC balken links : bl END PROC balken links ;
+TEXT PROC balken rechts : br END PROC balken rechts ;
+TEXT PROC balken unten : bu END PROC balken unten ;
+
+TEXT PROC waagerecht : waa END PROC waagerecht ;
+TEXT PROC senkrecht : sen END PROC senkrecht ;
+TEXT PROC kreuz : kr END PROC kreuz ;
+PROC ecke oben links (TEXT CONST t): eol := t END PROC ecke oben links ;
+PROC ecke oben rechts (TEXT CONST t): eor := t END PROC ecke oben rechts ;
+PROC ecke unten links (TEXT CONST t): eul := t END PROC ecke unten links ;
+PROC ecke unten rechts (TEXT CONST t): eur := t END PROC ecke unten rechts ;
+
+PROC balken oben (TEXT CONST t): bo := t END PROC balken oben ;
+PROC balken links (TEXT CONST t): bl := t END PROC balken links ;
+PROC balken rechts (TEXT CONST t): br := t END PROC balken rechts ;
+PROC balken unten (TEXT CONST t): bu := t END PROC balken unten ;
+PROC waagerecht (TEXT CONST t): waa := t END PROC waagerecht ;
+PROC senkrecht (TEXT CONST t): sen := t END PROC senkrecht ;
+PROC kreuz (TEXT CONST t): kr := t END PROC kreuz ;
+
+PROC std graphic char:
+ ecke oben links ("+"); ecke oben rechts ("+");
+ ecke unten links ("+"); ecke unten rechts ("+");
+ balken oben ("+"); balken rechts ("+");
+ balken links ("+"); balken unten ("+");
+ waagerecht ("-"); senkrecht ("|");
+ kreuz ("+");
+ cursor sichtbar := ""; cursor unsichtbar := ""
+END PROC std graphic char;
+PROC ft20 graphic char:
+ ecke oben links (""27"R�"27"S"); ecke oben rechts (""27"RD"27"S");
+ ecke unten links (""27"RH"27"S"); ecke unten rechts (""27"RL"27"S");
+
+ balken oben (""27"RP"27"S"); balken rechts (""27"RT"27"S");
+ balken links (""27"RX"27"S"); balken unten (""27"R\"27"S");
+ waagerecht (""27"R`"27"S"); senkrecht (""27"Rd"27"S");
+ kreuz (""27"Rh"27"S");
+ cursor sichtbar := ""27"-1" ; cursor unsichtbar := ""27"-0" ;
+ ft20 statuszeilen aus
+END PROC ft20 graphic char;
+PROC ft 20 statuszeilen aus: out (""27".A") END PROC ft 20 statuszeilen aus;
+PROC ft 20 statuszeilen an : out (""27".�") END PROC ft 20 statuszeilen an ;
+
+PROC ibm graphic char:
+ ecke oben links (""201""); ecke oben rechts (""187"");
+ ecke unten links (""200""); ecke unten rechts (""188"");
+ balken oben (""203""); balken rechts (""185"");
+ balken links (""204""); balken unten (""202"");
+ waagerecht (""205""); senkrecht (""186"");
+ kreuz (""206"");
+ cursor sichtbar := "" ; cursor unsichtbar := ""
+END PROC ibm graphic char;
+PROC cursor on : out (cursor sichtbar ) END PROC cursor on ;
+
+PROC cursor off : out (cursor unsichtbar) END PROC cursor off;
+PROC cursor on (TEXT CONST t): cursor sichtbar := t END PROC cursor on ;
+PROC cursor off (TEXT CONST t): cursor unsichtbar := t END PROC cursor off;
+PROC clear buffer:
+ REP UNTIL incharety = "" PER
+END PROC clear buffer;
+INT PROC clear buffer and count (TEXT CONST zeichen):
+ INT VAR zaehler :: 0;
+ TEXT VAR zeichenkette :: "", ch;
+ IF zeichen = "" THEN clear buffer; LEAVE clear buffer and count WITH 0 FI;
+
+ ermittle die zeichenkette;
+ untersuche auf vorhandene zeichen;
+ zaehler.
+ ermittle die zeichenkette:
+ REP
+ ch := incharety (1);
+ zeichenkette CAT ch
+ UNTIL ch = "" PER.
+ untersuche auf vorhandene zeichen:
+ INT VAR i;
+ FOR i FROM 1 UPTO length (zeichenkette) REP
+ IF pos (subtext (zeichenkette, i), zeichen) = 1
+ THEN zaehler INCR 1
+ FI
+ PER.
+END PROC clear buffer and count;
+TEXT PROC center (INT CONST xsize, TEXT CONST t):
+ TEXT VAR zeile :: compress (t);
+
+ zeile := ((xsize - length (zeile)) DIV 2) * blank + zeile;
+ zeile CAT (xsize - length (zeile)) * blank;
+ zeile
+END PROC center;
+TEXT PROC center (TEXT CONST t):
+ center (79, t)
+END PROC center;
+TEXT PROC invers (TEXT CONST t):
+ TEXT VAR neu :: mark ein; neu CAT t; neu CAT " "; neu CAT mark aus;
+ neu
+END PROC invers;
+PROC page (INT CONST x, y, xsize, ysize):
+ INT VAR zeiger;
+ IF x + xsize = 80
+ THEN in einem streich
+ ELSE putze vorsichtig
+ FI;
+ cursor (x, y).
+
+ in einem streich:
+ FOR zeiger FROM y UPTO y + ysize - 1 REP
+ cursor (x, zeiger); out (cleol)
+ PER.
+ putze vorsichtig:
+ FOR zeiger FROM y UPTO y + ysize - 1 REP
+ cursor (x, zeiger); xsize TIMESOUT blank
+ PER.
+END PROC page;
+PROC page (AREA CONST a):
+ page (a.x, a.y, a.xsize, a.ysize)
+END PROC page;
+PROC page up (INT CONST x, y, xsize, ysize):
+ INT VAR zeiger;
+ IF x + xsize = 80
+ THEN in einem streich
+ ELSE putze vorsichtig
+
+ FI.
+ in einem streich:
+ FOR zeiger FROM y + ysize - 1 DOWNTO y REP
+ cursor (x, zeiger); out (cleol)
+ PER.
+ putze vorsichtig:
+ FOR zeiger FROM y + ysize - 1 DOWNTO y REP
+ cursor (x, zeiger); xsize TIMESOUT blank
+ PER.
+END PROC page up;
+PROC page up (AREA CONST a):
+ page up (a.x, a.y, a.xsize, a.ysize)
+END PROC page up;
+PROC out frame (INT CONST x, y, xsize, ysize):
+ INT VAR zeiger;
+ IF x < 1 COR y < 1 COR xsize < 8 COR ysize < 3 COR
+ x + xsize > 80 COR y + ysize > 25
+
+ THEN LEAVE out frame
+ FI;
+ male oben;
+ male seiten;
+ male unten.
+ male oben:
+ cursor (x, y);
+ out (ecke oben links);
+ (xsize - 2) TIMESOUT waagerecht;
+ out (ecke oben rechts).
+ male seiten:
+ FOR zeiger FROM 1 UPTO ysize - 2 REP
+ cursor (x, y + zeiger); out (senkrecht);
+ cursor (x + xsize - 1, y + zeiger); out (senkrecht)
+ PER.
+ male unten:
+ cursor (x, y + ysize - 1);
+ out (ecke unten links);
+ (xsize - 2) TIMESOUT waagerecht;
+
+ out (ecke unten rechts)
+END PROC out frame;
+PROC out frame (AREA CONST a):
+ IF a.x - 1 < 1 OR a.y - 1 < 1
+ OR a.xsize + 2 > 79 OR a.ysize + 2 > 24
+ OR a.x + a.xsize + 1 > 80
+ OR a.y + a.ysize + 1 > 25
+ THEN LEAVE out frame
+ FI;
+ out frame (a.x - 1, a.y - 1, a.xsize + 2, a.ysize + 2)
+END PROC out frame;
+PROC out menuframe (INT CONST x, y, xsize, ysize):
+ INT VAR i;
+ untersuche angaben;
+ schreibe rahmen.
+ untersuche angaben:
+ IF x < 0 COR y < 0 COR x + xsize > 81 COR y + ysize > 26
+
+ THEN LEAVE out menuframe
+ FI.
+ schreibe rahmen:
+ IF x = 0 COR y = 0 COR xsize = 81 COR ysize = 26
+ THEN zeichne reduzierten rahmen
+ ELSE zeichne vollen rahmen
+ FI.
+ zeichne reduzierten rahmen:
+ zeichne oberlinie;
+ zeichne unterlinie.
+ zeichne oberlinie:
+ cursor (1, 2);
+ 79 TIMESOUT waagerecht.
+ zeichne unterlinie:
+ cursor (1, 23);
+ 79 TIMESOUT waagerecht.
+ zeichne vollen rahmen:
+ schreibe kopf; schreibe rumpf; schreibe fuss;
+
+ schreibe kopfleiste; schreibe fussleiste.
+ schreibe kopf:
+ cursor (x, y);
+ out (ecke oben links);
+ (xsize - 2) TIMESOUT waagerecht;
+ out (ecke oben rechts).
+ schreibe rumpf:
+ FOR i FROM y + 1 UPTO y + ysize - 2 REP
+ cursor (x, i); out (senkrecht);
+ cursor (x + xsize - 1, i); out (senkrecht)
+ PER.
+ schreibe fuss:
+ cursor (x, y + ysize - 1);
+ out (ecke unten links);
+ (xsize - 2) TIMESOUT waagerecht;
+ out (ecke unten rechts).
+
+ schreibe kopfleiste:
+ cursor (x, y + 2 ); schreibe balkenlinie.
+ schreibe fussleiste:
+ cursor (x, y + ysize - 3); schreibe balkenlinie.
+ schreibe balkenlinie:
+ out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts).
+END PROC out menuframe;
+PROC out menuframe (AREA CONST a):
+ out menuframe (a.x - 1, a.y - 1, a.xsize + 2, a.ysize + 2)
+END PROC out menuframe;
+PROC erase frame (INT CONST x, y, xsize, ysize):
+ INT VAR zeiger;
+ loesche oben; loesche seiten; loesche unten.
+
+ loesche oben:
+ cursor (x, y); xsize TIMESOUT blank.
+ loesche seiten:
+ FOR zeiger FROM 1 UPTO ysize - 2 REP
+ cursor (x, y + zeiger); out (blank);
+ cursor (x + xsize - 1, y + zeiger); out (blank)
+ PER.
+ loesche unten:
+ cursor (x, y + ysize - 1); xsize TIMESOUT blank.
+END PROC erase frame;
+OP := (AREA VAR ziel, AREA CONST quelle):
+ CONCR (ziel) := CONCR (quelle)
+END OP :=;
+PROC fill (AREA VAR ziel, INT CONST a, b, c, d):
+ IF a < 1 COR b < 1 COR a > 79 COR b > 24 COR c < 8 COR d < 3
+
+ COR c > 79 COR d > 24 COR a + c > 80 COR b + d > 25
+ THEN errorstop (fehlermeldung)
+ FI;
+ ziel.x := a; ziel.y := b; ziel.xsize := c; ziel.ysize := d
+END PROC fill;
+INT PROC areax (AREA CONST a): a.x END PROC areax;
+INT PROC areay (AREA CONST a): a.y END PROC areay;
+INT PROC areaxsize (AREA CONST a): a.xsize END PROC areaxsize;
+INT PROC areaysize (AREA CONST a): a.ysize END PROC areaysize;
+PROC out (TEXT CONST t, INT CONST breite):
+ outtext (t, 1, breite)
+
+END PROC out;
+PROC erase (INT CONST breite):
+ breite TIMESOUT blank
+END PROC erase;
+PROC cursor (AREA CONST a, INT CONST spa, zei):
+ cursor (a.x + spa - 1, a.y + zei - 1)
+END PROC cursor;
+PROC get cursor (AREA CONST a, INT VAR spalte, zeile):
+ INT VAR x, y;
+ get cursor (x, y);
+ spalte := x - a.x + 1; zeile := y - a.y + 1
+END PROC get cursor;
+PROC out (AREA CONST a, INT CONST spa, zei, TEXT CONST t):
+ ueberpruefe cursorangaben; positioniere cursor;
+ IF text ist zu lang
+ THEN verkuerzte ausgabe
+
+ ELSE out (t)
+ FI.
+ ueberpruefe cursorangaben:
+ IF spa > xsize COR zei > a.ysize COR spa < 1 COR zei < 1
+ THEN LEAVE out
+ FI.
+ positioniere cursor:
+ cursor (a.x + spa - 1, a.y + zei - 1).
+ text ist zu lang:
+ length (t) > a.xsize - spa + 1.
+ verkuerzte ausgabe:
+ outsubtext (t, 1, a.xsize - spa + 1)
+END PROC out;
+PROC out (AREA CONST a, INT CONST spa, zei, TEXT CONST t, INT CONST laenge):
+ ueberpruefe cursorangaben; positioniere cursor;
+ IF laenge ist zu gross
+
+ THEN verkuerzte ausgabe
+ ELSE outtext (t, 1, laenge)
+ FI.
+ ueberpruefe cursorangaben:
+ IF spa > a.xsize COR zei > a.ysize COR spa < 1 COR zei < 1
+ THEN LEAVE out
+ FI.
+ positioniere cursor:
+ cursor (a.x + spa - 1, a.y + zei - 1).
+ laenge ist zu gross:
+ laenge > a.xsize - spa + 1.
+ verkuerzte ausgabe:
+ outtext (t, 1, a.xsize - spa + 1)
+END PROC out;
+PROC erase (AREA CONST a, INT CONST spa, zei, INT CONST laenge):
+ ueberpruefe cursorangaben; positioniere cursor;
+
+ IF laenge ist zu gross
+ THEN verkuerzte ausgabe
+ ELSE erase (laenge)
+ FI.
+ ueberpruefe cursorangaben:
+ IF spa > a.xsize COR zei > a.ysize COR spa < 1 COR zei < 1
+ THEN LEAVE erase
+ FI.
+ positioniere cursor:
+ cursor (a.x + spa - 1, a.y + zei - 1).
+ laenge ist zu gross:
+ laenge > a.xsize - spa + 1.
+ verkuerzte ausgabe:
+ erase (a.xsize - spa + 1)
+END PROC erase;
+PROC out invers (AREA CONST a, INT CONST spa, zei, TEXT CONST t):
+ ueberpruefe cursorangaben; positioniere cursor;
+
+ IF text ist zu lang
+ THEN verkuerzte ausgabe
+ ELSE out (mark ein); out (t); out (blank); out (mark aus)
+ FI.
+ ueberpruefe cursorangaben:
+ IF spa > (xsize - 4) COR zei > ysize COR spa < 2 COR zei < 1
+ THEN LEAVE out invers
+ FI.
+ positioniere cursor:
+ cursor (a.x + spa - 2, a.y + zei - 1).
+ text ist zu lang:
+ length (t) > a.xsize - spa - 1.
+ verkuerzte ausgabe:
+ out (mark ein); outsubtext (t, 1, a.xsize - spa - 1);
+ out (blank); out (mark aus)
+END PROC out invers;
+
+PROC out invers (AREA CONST a, INT CONST spa, zei,
+ TEXT CONST t, INT CONST laenge):
+ ueberpruefe cursorangaben; positioniere cursor;
+ IF laenge ist zu gross
+ THEN verkuerzte ausgabe
+ ELSE out (mark ein); outtext (t, 1, laenge); out (blank); out (mark aus)
+ FI.
+ ueberpruefe cursorangaben:
+ IF spa > (a.xsize - 4) COR zei > a.ysize COR spa < 2 COR zei < 1
+ THEN LEAVE out invers
+ FI.
+ positioniere cursor:
+ cursor (a.x + spa - 2, a.y + zei - 1).
+
+ laenge ist zu gross:
+ laenge > a.xsize - spa - 1.
+ verkuerzte ausgabe:
+ out (mark ein); outsubtext (t, 1, a.xsize - spa - 1);
+ out (blank); out (mark aus)
+END PROC out invers;
+PROC erase invers (AREA CONST a, INT CONST spa, zei, INT CONST laenge):
+ ueberpruefe cursorangaben; positioniere cursor;
+ IF laenge ist zu gross
+ THEN verkuerzte ausgabe
+ ELSE erase (laenge + 3)
+ FI.
+ ueberpruefe cursorangaben:
+ IF spa > (a.xsize - 4) COR zei > a.ysize COR spa < 2 COR zei < 1
+
+ THEN LEAVE erase invers
+ FI.
+ positioniere cursor:
+ cursor (a.x + spa - 2, a.y + zei - 1).
+ laenge ist zu gross:
+ laenge > a.xsize - spa - 1.
+ verkuerzte ausgabe:
+ erase ( a.xsize - spa + 2).
+END PROC erase invers;
+PROC out with beam (AREA CONST a, INT CONST spa, zei, TEXT CONST t):
+ ueberpruefe cursorangaben; positioniere cursor;
+ IF text ist zu lang
+ THEN verkuerzte ausgabe
+ ELSE out (senkrecht); out (blank); out (blank);
+ out (t);
+ out (blank); out (blank); out (senkrecht)
+
+ FI.
+ ueberpruefe cursorangaben:
+ IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1
+ THEN LEAVE out with beam
+ FI.
+ positioniere cursor:
+ cursor (a.x + spa - 4, a.y + zei - 1).
+ text ist zu lang:
+ length (t) > a.xsize - spa - 2.
+ verkuerzte ausgabe:
+ out (senkrecht); out (blank); out (blank);
+ outsubtext (t, 1, a.xsize - spa - 2);
+ out (blank); out (blank); out (senkrecht)
+END PROC out with beam;
+PROC out with beam (AREA CONST a, INT CONST spa, zei,
+
+ TEXT CONST t, INT CONST laenge):
+ ueberpruefe cursorangaben; positioniere cursor;
+ IF laenge ist zu gross
+ THEN verkuerzte ausgabe
+ ELSE out (senkrecht); out (blank); out (blank);
+ outtext (t, 1,laenge);
+ out (blank); out (blank); out (senkrecht)
+ FI.
+ ueberpruefe cursorangaben:
+ IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1
+ THEN LEAVE out with beam
+ FI.
+ positioniere cursor:
+ cursor (a.x + spa - 4, a.y + zei - 1).
+
+ laenge ist zu gross:
+ laenge > a.xsize - spa - 2.
+ verkuerzte ausgabe:
+ out (senkrecht); out (blank); out (blank);
+ outsubtext (t, 1, a.xsize - spa - 2);
+ out (blank); out (blank); out (senkrecht)
+END PROC out with beam;
+PROC erase with beam (AREA CONST a, INT CONST spa, zei, INT CONST laenge):
+ ueberpruefe cursorangaben; positioniere cursor;
+ IF laenge ist zu gross
+ THEN verkuerzte ausgabe
+ ELSE erase (laenge + 6)
+ FI.
+ ueberpruefe cursorangaben:
+ IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1
+
+ THEN LEAVE erase with beam
+ FI.
+ positioniere cursor:
+ cursor (a.x + spa - 4, a.y + zei - 1).
+ laenge ist zu gross:
+ laenge > a.xsize - spa - 2.
+ verkuerzte ausgabe:
+ erase (a.xsize - spa + 4).
+END PROC erase with beam;
+PROC out invers with beam (AREA CONST a, INT CONST spa, zei, TEXT CONST t):
+ ueberpruefe cursorangaben; positioniere cursor;
+ IF text ist zu lang
+ THEN verkuerzte ausgabe
+ ELSE out (senkrecht); out (blank); out (mark ein);
+ out (t);
+
+ out (blank); out (mark aus); out (senkrecht)
+ FI.
+ ueberpruefe cursorangaben:
+ IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1
+ THEN LEAVE out invers with beam
+ FI.
+ positioniere cursor:
+ cursor (a.x + spa - 4, a.y + zei - 1).
+ text ist zu lang:
+ length (t) > a.xsize - spa - 2.
+ verkuerzte ausgabe:
+ out (senkrecht); out (blank); out (mark ein);
+ outsubtext (t, 1, a.xsize - spa - 2);
+ out (blank); out (mark aus); out (senkrecht)
+
+END PROC out invers with beam;
+PROC out invers with beam (AREA CONST a, INT CONST spa, zei,
+ TEXT CONST t, INT CONST laenge):
+ ueberpruefe cursorangaben; positioniere cursor;
+ IF laenge ist zu gross
+ THEN verkuerzte ausgabe
+ ELSE out (senkrecht); out (blank); out (mark ein);
+ outtext (t, 1, laenge);
+ out (blank); out (mark aus); out (senkrecht)
+ FI.
+ ueberpruefe cursorangaben:
+ IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1
+
+ THEN LEAVE out invers with beam
+ FI.
+ positioniere cursor:
+ cursor (a.x + spa - 4, a.y + zei - 1).
+ laenge ist zu gross:
+ laenge > a.xsize - spa - 2.
+ verkuerzte ausgabe:
+ out (senkrecht); out (blank); out (mark ein);
+ outsubtext (t, 1, a.xsize - spa - 2);
+ out (blank); out (mark aus); out (senkrecht)
+END PROC out invers with beam;
+END PACKET ls dialog 1;
+
diff --git a/dialog/ls-DIALOG 2 b/dialog/ls-DIALOG 2
index 1750162..7fb5d36 100644
--- a/dialog/ls-DIALOG 2
+++ b/dialog/ls-DIALOG 2
@@ -22,56 +22,823 @@
*)
PACKET ls dialog 2 DEFINES
- some,{} one,{} infix namen,{} ohne praefix,{} not empty:{}LET maxentries = 200;{}LET zeichenstring = ""1""27""3""10""13""12"xo?",{} oben unten return rubout kreuz kringel = ""3""10""13""12"xo",{} q eins neun h = "q19h";{}LET zurueck = ""8"",{} piep = ""7"";{}LET hop = 1,{} esc = 2,{} oben = 3,{} unten = 4,{} return = 5,{} rubout = 6,{}
- kreuz = 7,{} kringel = 8,{} frage = 9;{}LET punkt = ".",{} gleich = "=",{} blank = " ";{}INT VAR x,{} y,{} xsize,{} ysize,{} maxeintraege,{} anzahl,{} erste auswahlzeile,{} virtueller cursor,{} reeller cursor;{}TEXT VAR kennzeile 1,{} kennzeile 2,{} registrierkette :: "";{}BOOL VAR abbruch,{} auswahlende;{}BOUND ROW max entries TEXT VAR eintrag;{}ROW 2 TEXT CONST fehlermeldung :: ROW 2 TEXT : ({}
- "Unzulässige Cursorwerte bei der Auswahl",{} "Fenster für Auswahl zu klein (x < 56 / y < 15)");{}ROW 24 TEXT CONST hinweis :: ROW 24 TEXT : ({} " Bitte warten... Ich sortiere und räume auf!",{} " Info: <?> Fertig: <ESC><q> Abbrechen: <ESC><h>",{} " Zum Weitermachen bitte irgendeine Taste tippen!",{} "Weitere Dateien!",{} "INFORMATIONEN: Auswahl mehrerer Dateien",{} "INFORMATIONEN: Auswahl einer Datei",{} " "15"Positionierungen: "14"",{} " hoch : zum vorausgehenden Namen",{}
- " runter : zum folgenden Namen",{} " HOP hoch : auf den ersten Namen der Seite", (***********){} " HOP runter : auf den letzten Namen der Seite", (* bitte *){} " ESC 1 : auf den ersten Namen der Liste", (* diese *){} " ESC 9 : auf den letzten Namen der Liste", (* Länge *){} " "15"Auswahl treffen: "14"", (* nicht *){} " RETURN / x : diesen Namen ankreuzen ", (* über- *){}
- " RUBOUT / o : Kreuz vor dem Namen loeschen", (* schrei-*){} " HOP RETURN / HOP x : alle folgende Namen ankreuzen", (* ten! *){} " HOP RUBOUT / HOP o : alle folgende Kreuze loeschen", (***********){} " "15"Auswahl verlassen: "14"",{} " ESC q : Auswahl verlassen",{} " ESC h : Auswahl abbrechen",{} " Auswahl m e h r e r e r Dateien durch Ankreuzen",{} " Auswahl e i n e r Datei durch Ankreuzen",{} " Bitte warten... Ich breche die Auswahl ab!"{}
- );{}THESAURUS PROC auswahl (THESAURUS CONST t,{} BOOL CONST mehrere moeglich,{} TEXT CONST t1, t2):{} werte initialisieren;{} namen besorgen;{} bildschirm aufbauen;{} auswaehlen lassen;{} abgang vorbereiten.{} werte initialisieren:{} THESAURUS VAR ausgabe :: empty thesaurus;{} DATASPACE VAR ds := nilspace;{} eintrag := ds;{} kennzeile 1 := t1;{} kennzeile 2 := t2;{} abbruch := FALSE;{}
- erste auswahlzeile := y + 7;{} anzahl := 0;{} maxeintraege := ysize - 11;{} virtueller cursor := 1;{} reeller cursor := 1.{} namen besorgen:{} fische die namen aus dem thesaurus;{} IF kein eintrag vorhanden{} THEN LEAVE auswahl WITH ausgabe{} FI.{} bildschirm aufbauen:{} schreibe kopfzeile;{} gib hinweis aus (kennzeile 1, kennzeile 2);{} gib erklaerungszeile aus (mehrere moeglich);{} baue bildschirm auf (1);{} footnote (x, y, xsize, ysize, hinweis [2]);{}
- schreibe fusszeile;{} reellen cursor setzen .{} schreibe kopfzeile:{} cursor (x, y);{} out(ecke oben links);{} (xsize - 2) TIMESOUT waagerecht;{} out(ecke oben rechts).{} schreibe fusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{} auswaehlen lassen:{} kreuze an (mehrere moeglich).{} abgang vorbereiten:{} IF abbruch{} THEN change footnote (x, y, xsize, ysize, hinweis [24]){}
- ELSE change footnote (x, y, xsize, ysize, hinweis [ 1]){} FI;{} cursor (x + 1, y + ysize - 1);{} ausgabe erzeugen;{} forget (ds);{} ausgabe.{} fische die namen aus dem thesaurus:{} INT VAR zeiger;{} FOR zeiger FROM 1 UPTO highest entry (t) REP{} IF name (t, zeiger) <> ""{} THEN anzahl INCR 1;{} eintrag [anzahl] := name (t, zeiger){} FI{} PER.{} kein eintrag vorhanden:{} anzahl = 0.{} ausgabe erzeugen:{} TEXT VAR nummer;{} WHILE registrierkette <> "" REP{}
- nummer := subtext (registrierkette, 1, 3);{} registrierkette := subtext (registrierkette, 5);{} insert (ausgabe, eintrag [ int (nummer)]){} PER.{}END PROC auswahl;{}PROC reellen cursor setzen:{} cursor (x + 1, erste auswahlzeile + reeller cursor - 1);{} out (marke (virtueller cursor, TRUE) + (8 * zurueck)){}END PROC reellen cursor setzen;{}PROC baue bildschirm auf (INT CONST anfang):{} gib kopfzeile aus;{} gib namenstabelle aus;{} gib fusszeile aus;{} loesche ggf restbereich.{}
- gib kopfzeile aus:{} cursor (x, erste auswahlzeile - 1); out (senkrecht);{} IF reeller cursor = virtueller cursor{} THEN (xsize - 2) TIMESOUT punkt{} ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt;{} out (invers (hinweis [4])){} FI;{} out (senkrecht);{} line.{} gib namenstabelle aus:{} INT VAR zeiger, zaehler :: -1;{} FOR zeiger FROM anfang UPTO grenze REP{} zaehler INCR 1;{} cursor (x, erste auswahlzeile + zaehler);{} out (senkrecht); out (marke (zeiger, FALSE));{}
- outtext (subtext (eintrag [zeiger], 1, xsize - 10), 1, xsize - 10);{} out (senkrecht);{} PER.{} gib fusszeile aus:{} cursor (x, erste auswahlzeile + zaehler + 1);{} out (senkrecht);{} IF NOT ((virtueller cursor + maxeintraege - reeller cursor) < anzahl){} THEN (xsize - 2) TIMESOUT punkt{} ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt;{} out (invers (hinweis [4])){} FI;{} out (senkrecht).{} loesche ggf restbereich:{} IF zaehler + 1 < maxeintraege{}
- THEN loesche bildschirmrest{} FI.{} loesche bildschirmrest:{} FOR zeiger FROM restanfang UPTO restende REP{} cursor (x, zeiger); out (senkrecht);{} (xsize - 2) TIMESOUT blank;{} out (senkrecht){} PER.{} restanfang:{} erste auswahlzeile + zaehler + 2.{} restende:{} erste auswahlzeile + maxeintraege.{} grenze:{} min (anzahl, anfang + max eintraege - 1).{}END PROC baue bildschirm auf;{}TEXT PROC marke (INT CONST zeiger, BOOL CONST mit cursor):{}
- INT VAR platz := nr (zeiger);{} IF platz = 0{} THEN leer{} ELSE mit zahl{} FI.{} mit zahl:{} IF mit cursor{} THEN "==>" + (3 - length (text (platz))) * blank + text (platz) + "x "{} ELSE " " + (3 - length (text (platz))) * blank + text (platz) + "x "{} FI.{} leer:{} IF mit cursor{} THEN "==> o "{} ELSE " o "{} FI.{}END PROC marke;{}INT PROC nr (INT CONST zeiger):{} IF pos (registrierkette, textstring (zeiger)) = 0{} THEN 0{} ELSE (pos (registrierkette, textstring (zeiger)) DIV 4) + 1{}
- FI{}END PROC nr;{}TEXT PROC textstring (INT CONST nr):{} text (nr, 3) + "!"{}END PROC textstring;{}PROC info (BOOL CONST mehrere):{} notiere hinweisueberschrift;{} notiere positionierhinweise;{} IF noch platz vorhanden{} THEN notiere auswahlmoeglichkeiten auf alter seite{} ELSE wechsle auf naechste seite;{} notiere hinweisueberschrift;{} notiere auswahlmoeglichtkeiten auf neuer seite{} FI;{} stelle alten bildschirmzustand wieder her.{} notiere hinweisueberschrift:{}
- cursor (x + 1, y + 1);{} IF mehrere{} THEN out (center(xsize - 2, invers (hinweis [5]))){} ELSE out (center(xsize - 2, invers (hinweis [6]))){} FI;{} cursor (x + 1, y + 2); out ("", xsize - 2).{} notiere positionierhinweise:{} cursor (x + 1, y + 3); out (hinweis [ 7], xsize - 2);{} cursor (x + 1, y + 4); out (hinweis [ 8], xsize - 2);{} cursor (x + 1, y + 5); out (hinweis [ 9], xsize - 2);{} cursor (x + 1, y + 6); out (hinweis [10], xsize - 2);{} cursor (x + 1, y + 7); out (hinweis [11], xsize - 2);{}
- cursor (x + 1, y + 8); out (hinweis [12], xsize - 2);{} cursor (x + 1, y + 9); out (hinweis [13], xsize - 2).{} notiere auswahlmoeglichkeiten auf alter seite:{} cursor (x + 1, y + 10); out ("", xsize - 2);{} cursor (x + 1, y + 11); out (hinweis [14], xsize - 2);{} cursor (x + 1, y + 12); out (hinweis [15], xsize - 2);{} IF mehrere{} THEN gib alle auswahlmoeglichkeiten auf der alten seite an{} ELSE gib eine auswahlmoeglichkeit auf der alten seite an{} FI;{}
- notiere verlassmoeglichkeiten auf der alten seite;{} loesche die restlichen zeilen;{} change footnote (x, y, xsize, ysize, hinweis [3]);{} cursor in ruhestellung;{} clear buffer.{} gib alle auswahlmoeglichkeiten auf der alten seite an:{} cursor (x + 1, y + 13); out (hinweis [16], xsize - 2);{} cursor (x + 1, y + 14); out (hinweis [17], xsize - 2);{} cursor (x + 1, y + 15); out (hinweis [18], xsize - 2).{} gib eine auswahlmoeglichkeit auf der alten seite an:{} cursor (x + 1, y + 13); out ("", xsize - 2);{}
- cursor (x + 1, y + 14); out ("", xsize - 2);{} cursor (x + 1, y + 15); out ("", xsize - 2).{} notiere verlassmoeglichkeiten auf der alten seite:{} cursor (x + 1, y + 16); out ("", xsize - 2);{} cursor (x + 1, y + 17); out (hinweis [19], xsize - 2);{} cursor (x + 1, y + 18); out (hinweis [20], xsize - 2);{} cursor (x + 1, y + 19); out (hinweis [21], xsize - 2).{} loesche die restlichen zeilen:{} IF ysize = 24{} THEN cursor (x + 1, y + 20); out ("", xsize - 2){} FI.{}
- wechsle auf naechste seite:{} loesche seitenrest;{} change footnote (x, y, xsize, ysize, hinweis [3]);{} cursor in ruhestellung;{} clear buffer;{} pause.{} loesche seitenrest:{} INT VAR zaehler;{} FOR zaehler FROM 10 UPTO ysize - 4 REP{} cursor (x + 1, y + zaehler); out ("", xsize - 2){} PER.{} notiere auswahlmoeglichtkeiten auf neuer seite:{} cursor (x + 1, y + 3); out (hinweis [14], xsize - 2);{} cursor (x + 1, y + 4); out (hinweis [15], xsize - 2);{} IF mehrere{}
- THEN gib alle auswahlmoeglichkeiten auf der neuen seite an{} ELSE gib eine auswahlmoeglichkeit auf der neuen seite an{} FI;{} notiere verlassmoeglichkeiten auf der neuen seite.{} gib alle auswahlmoeglichkeiten auf der neuen seite an:{} cursor (x + 1, y + 5); out (hinweis [16], xsize - 2);{} cursor (x + 1, y + 6); out (hinweis [17], xsize - 2);{} cursor (x + 1, y + 7); out (hinweis [18], xsize - 2).{} gib eine auswahlmoeglichkeit auf der neuen seite an:{} cursor (x + 1, y + 5); out ("", xsize - 2);{}
- cursor (x + 1, y + 6); out ("", xsize - 2);{} cursor (x + 1, y + 7); out ("", xsize - 2).{} notiere verlassmoeglichkeiten auf der neuen seite:{} cursor (x + 1, y + 8); out ("", xsize - 2);{} cursor (x + 1, y + 9); out (hinweis [19], xsize - 2);{} cursor (x + 1, y + 10); out (hinweis [20], xsize - 2);{} cursor (x + 1, y + 11); out (hinweis [21], xsize - 2);{} cursor in ruhestellung.{} cursor in ruhestellung:{} cursor (x + 1, y + ysize - 2).{} stelle alten bildschirmzustand wieder her:{}
- clear buffer;{} pause;{} gib hinweis aus (kennzeile 1, kennzeile 2);{} gib erklaerungszeile aus (mehrere);{} virtueller cursor := 1;{} reeller cursor := 1;{} baue bildschirm auf (1);{} change footnote (x, y, xsize, ysize, hinweis [2]);{} reellen cursor setzen.{} noch platz vorhanden:{} (ysize - 4) > 18.{}END PROC info;{}PROC kreuze an (BOOL CONST mehrere):{} auswahlende := FALSE;{} REP{} zeichen lesen; zeichen interpretieren{} UNTIL auswahlende PER.{} zeichen lesen:{}
- TEXT VAR zeichen;{} getchar (zeichen).{} zeichen interpretieren:{} SELECT pos (zeichenstring, zeichen) OF{} CASE hop : hop kommando verarbeiten (mehrere){} CASE esc : esc kommando verarbeiten{} CASE oben : nach oben{} CASE unten : nach unten{} CASE kreuz : ankreuzen; evtl aufhoeren{} CASE return : ankreuzen weiter; evtl aufhoeren{} CASE rubout : auskreuzen weiter{} CASE kringel : auskreuzen{} CASE frage : info (mehrere){}
- OTHERWISE out (piep){} END SELECT.{} evtl aufhoeren:{} IF NOT mehrere{} THEN LEAVE kreuze an{} FI.{}END PROC kreuze an;{}PROC hop kommando verarbeiten (BOOL CONST mehrere):{} zweites zeichen lesen;{} zeichen interpretieren.{} zweites zeichen lesen:{} TEXT VAR zweites zeichen;{} getchar(zweites zeichen).{} zeichen interpretieren:{} SELECT pos (oben unten return rubout kreuz kringel, zweites zeichen) OF{} CASE 1 : hop nach oben{} CASE 2 : hop nach unten{}
- CASE 3, 5 : IF mehrere THEN alle darunter ankreuzen FI{} CASE 4, 6 : IF mehrere THEN alle darunter loeschen FI{} OTHERWISE out (piep){} END SELECT.{} alle darunter ankreuzen:{} INT VAR i;{} FOR i FROM virtueller cursor UPTO anzahl REP{} IF nr (i) = 0{} THEN ankreuzen{} FI{} PER;{} bild aktualisieren ;{} reellen cursor setzen .{} ankreuzen:{} registrierkette CAT textstring (i).{} alle darunter loeschen:{} INT VAR j, position;{} FOR j FROM virtueller cursor UPTO anzahl REP{}
- position := nr (j);{} IF position > 0{} THEN rausschmeissen;{} FI{} PER;{} bild aktualisieren;{} reellen cursor setzen.{} rausschmeissen:{} registrierkette := subtext (registrierkette, 1, (4 * position) - 4) +{} subtext (registrierkette, (4 * position) + 1).{} hop nach oben:{} IF ganz oben{} THEN out (piep){} ELIF oben auf der seite{} THEN raufblaettern{} ELSE top of page{} FI.{} ganz oben:{} virtueller cursor = 1.{}
- oben auf der seite:{} reeller cursor = 1.{} raufblaettern:{} virtueller cursor DECR max eintraege;{} virtueller cursor := max (virtueller cursor, 1);{} baue bildschirm auf (virtueller cursor);{} reellen cursor setzen.{} top of page:{} loesche marke;{} virtueller cursor DECR (reeller cursor - 1);{} reeller cursor := 1;{} reellen cursor setzen.{} hop nach unten:{} IF ganz unten{} THEN out (piep){} ELIF unten auf der seite{} THEN runterblaettern{}
- ELSE bottom of page{} FI.{} ganz unten:{} virtueller cursor = anzahl.{} unten auf der seite:{} reeller cursor > max eintraege - 1.{} runterblaettern:{} INT VAR alter virtueller cursor :: virtueller cursor;{} virtueller cursor INCR max eintraege;{} virtueller cursor := min (virtueller cursor, anzahl);{} reeller cursor := virtueller cursor - alter virtueller cursor;{} baue bildschirm auf (alter virtueller cursor + 1);{} reellen cursor setzen.{} bottom of page:{}
- loesche marke;{} alter virtueller cursor := virtueller cursor;{} virtueller cursor INCR (max eintraege - reeller cursor);{} virtueller cursor := min (anzahl, virtueller cursor);{} reeller cursor INCR (virtueller cursor - alter virtueller cursor);{} reellen cursor setzen.{}END PROC hop kommando verarbeiten;{}PROC esc kommando verarbeiten:{} TEXT VAR zweites zeichen;{} getchar (zweites zeichen);{} SELECT pos (q eins neun h, zweites zeichen) OF{} CASE 1 : auswahlende := TRUE{}
- CASE 2 : zeige anfang{} CASE 3 : zeige ende{} CASE 4 : abbruch := TRUE;{} auswahlende := TRUE;{} registrierkette := ""{} OTHERWISE out (piep){} END SELECT.{} zeige anfang:{} IF virtueller cursor = 1{} THEN out (piep){} ELIF virtueller cursor = reeller cursor{} THEN loesche marke;{} virtueller cursor := 1;{} reeller cursor := 1;{} reellen cursor setzen{} ELSE virtueller cursor := 1;{}
- reeller cursor := 1;{} baue bildschirm auf (1);{} reellen cursor setzen{} FI.{} zeige ende:{} IF virtueller cursor = anzahl{} THEN out (piep){} ELIF ende auf bildschirm{} THEN loesche marke;{} reeller cursor INCR (anzahl - virtueller cursor);{} virtueller cursor := anzahl;{} reellen cursor setzen{} ELSE virtueller cursor := anzahl;{} reeller cursor := max eintraege;{}
- baue bildschirm auf (anzahl - (max eintraege - 1));{} reellen cursor setzen{} FI.{} ende auf bildschirm:{} (reeller cursor + anzahl - virtueller cursor) < max eintraege + 1.{}END PROC esc kommando verarbeiten;{}PROC ankreuzen:{} INT VAR platz :: nr (virtueller cursor);{} IF platz <> 0{} THEN out (piep);{} LEAVE ankreuzen{} FI;{} registrierkette CAT textstring (virtueller cursor);{} reellen cursor setzen{}END PROC ankreuzen;{}PROC ankreuzen weiter:{}
- INT VAR platz :: nr (virtueller cursor);{} IF platz <> 0{} THEN out (piep);{} LEAVE ankreuzen weiter{} FI;{} registrierkette CAT textstring (virtueller cursor);{} IF virtueller cursor < anzahl{} THEN nach unten{} FI;{} IF virtueller cursor = anzahl{} THEN reellen cursor setzen{} FI{}END PROC ankreuzen weiter;{}PROC auskreuzen weiter:{} INT VAR position :: nr (virtueller cursor);{} IF position = 0{} THEN out (piep);{} LEAVE auskreuzen weiter{} FI;{} rausschmeissen;{}
- IF virtueller cursor < anzahl{} THEN nach unten{} ELSE loesche marke{} FI;{} bild aktualisieren;{} reellen cursor setzen.{} rausschmeissen:{} registrierkette := subtext (registrierkette, 1, 4 * position - 4) +{} subtext (registrierkette, 4 * position + 1).{}END PROC auskreuzen weiter;{}PROC auskreuzen:{} INT VAR position :: nr (virtueller cursor);{} IF position = 0{} THEN out (piep);{} LEAVE auskreuzen{} FI;{} rausschmeissen;{} loesche marke;{}
- bild aktualisieren;{} reellen cursor setzen.{} rausschmeissen:{} registrierkette := subtext (registrierkette, 1, 4 * position - 4) +{} subtext (registrierkette, 4 * position + 1).{}END PROC auskreuzen;{}PROC bild aktualisieren:{} INT VAR ob, un, i, zaehler :: -1;{} ob := virtueller cursor - reeller cursor + 1;{} un := min (ob + max eintraege - 1, anzahl);{} FOR i FROM ob UPTO un REP{} zaehler INCR 1;{} cursor (x + 1, erste auswahlzeile + zaehler);{} out (marke (i,FALSE)) PER{}
-END PROC bild aktualisieren;{}PROC nach oben:{} IF noch nicht oben (*virtuell*){} THEN gehe nach oben{} ELSE out (piep){} FI.{} noch nicht oben:{} virtueller cursor > 1.{} gehe nach oben:{} IF reeller cursor = 1 THEN scroll down ELSE cursor up FI.{} scroll down:{} virtueller cursor DECR 1;{} baue bildschirm auf (virtueller cursor);{} reellen cursor setzen.{} cursor up:{} loesche marke;{} virtueller cursor DECR 1;{} reeller cursor DECR 1;{} reellen cursor setzen{}
-END PROC nach oben;{}PROC nach unten:{} IF noch nicht unten (*virtuell*){} THEN gehe nach unten{} ELSE out (piep){} FI.{} noch nicht unten:{} virtueller cursor < anzahl.{} gehe nach unten:{} IF reeller cursor > max eintraege - 1 THEN scroll up ELSE cursor down FI.{} scroll up:{} virtueller cursor INCR 1;{} baue bildschirm auf (virtueller cursor - (max eintraege - 1));{} reellen cursor setzen.{} cursor down:{} loesche marke;{} virtueller cursor INCR 1;{} reeller cursor INCR 1;{}
- reellen cursor setzen{}END PROC nach unten;{}PROC loesche marke:{} out (marke (virtueller cursor, FALSE)){}END PROC loesche marke;{}PROC footnote (INT CONST x, y, xsize, ysize, TEXT CONST text):{} cursor (x, y + ysize - 3);{} out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts);{} change footnote (x, y, xsize, ysize, text){}END PROC footnote;{}PROC change footnote (INT CONST x, y, xsize, ysize, TEXT CONST text):{} cursor (x, y + ysize - 2);{} out (senkrecht); outtext (text, 1, xsize - 2); out (senkrecht){}
-END PROC change footnote;{}PROC gib hinweis aus (TEXT CONST t1, t2):{} cursor (x, y + 1); out (senkrecht);{} out (center (xsize - 2, invers (t1)));{} out (senkrecht);{} cursor (x, y + 2); out (senkrecht);{} out ("", xsize - 2);{} out (senkrecht);{} cursor (x, y + 3); out (senkrecht);{} out (center (xsize - 2, t2));{} out (senkrecht){}END PROC gib hinweis aus;{}PROC gib erklaerungszeile aus (BOOL CONST mehrere):{}
- cursor (x, y + 4); out (senkrecht);{} out ((xsize - 2) * gleich);{} out (senkrecht);{} cursor (x, y + 5); out (senkrecht);{} IF mehrere{} THEN out (erklaerungszeile mehrere){} ELSE out (erklaerungszeile eine){} FI;{} out (senkrecht).{} erklaerungszeile mehrere:{} invers (text 1 + (rest1 * blank)).{} erklaerungszeile eine:{} invers (text 2 + (rest2 * blank)).{}
- text1:{} hinweis [22].{} text2:{} hinweis [23].{} rest1: (***************************){} xsize - length (text1) - 5. (* durch 'invers' wird ein *){} (* Blank angehängt und zu- *){} rest2: (* sätzlich noch durch *){} xsize - length (text2) - 5. (* 'relativcenter' - außer-*){}END PROC gib erklaerungszeile aus; (* dem nimmt die Markierung*){} (* selbst eine Position ein*){}
- (***************************){}THESAURUS PROC infix namen (THESAURUS CONST t, TEXT CONST infix):{} THESAURUS VAR tt :: empty thesaurus;{} INT VAR i;{} FOR i FROM 1 UPTO highest entry (t) REP{} TEXT VAR eintrag :: name (t,i);{} IF eintrag enthaelt infix{} THEN insert (tt, eintrag){} FI{} PER;{} tt.{} eintrag enthaelt infix:{} pos (eintrag, infix) <> 0{}END PROC infix namen;{}THESAURUS PROC infix namen (THESAURUS CONST t, INT CONST dateityp):{}
- THESAURUS VAR tt :: empty thesaurus;{} INT VAR i;{} FOR i FROM 1 UPTO highest entry (t) REP{} TEXT VAR eintrag :: name (t,i);{} IF eintrag enthaelt infix{} THEN insert (tt, eintrag){} FI{} PER;{} tt.{} eintrag enthaelt infix:{} type (old (eintrag)) = dateityp.{}END PROC infix namen;{}THESAURUS PROC infix namen (THESAURUS CONST t,{} TEXT CONST infix 1, INT CONST dateityp):{} THESAURUS VAR tt :: empty thesaurus;{} INT VAR i;{} FOR i FROM 1 UPTO highest entry (t) REP{}
- TEXT VAR eintrag :: name (t,i);{} IF eintrag enthaelt infix{} THEN insert (tt, eintrag){} FI{} PER;{} tt.{} eintrag enthaelt infix:{} (pos (eintrag, infix 1) <> 0) AND (type (old (eintrag)) = dateityp).{}END PROC infix namen;{}THESAURUS PROC infix namen (THESAURUS CONST t,{} TEXT CONST infix 1, infix 2):{} THESAURUS VAR tt :: empty thesaurus;{} INT VAR i;{} FOR i FROM 1 UPTO highest entry (t) REP{} TEXT VAR eintrag :: name (t,i);{} IF eintrag enthaelt infix{}
- THEN insert (tt, eintrag){} FI{} PER;{} tt.{} eintrag enthaelt infix:{} (pos (eintrag, infix 1) <> 0) OR (pos (eintrag, infix 2) <> 0){}END PROC infix namen;{}THESAURUS PROC infix namen (TEXT CONST infix):{} infix namen (ALL myself, infix){}END PROC infix namen;{}THESAURUS PROC infix namen (TEXT CONST infix 1, infix 2):{} infix namen (ALL myself, infix 1, infix 2){}END PROC infix namen;{}THESAURUS PROC ohne praefix (THESAURUS CONST thesaurus, TEXT CONST praefix):{} THESAURUS VAR t :: empty thesaurus;{}
- INT VAR zaehler;{} FOR zaehler FROM 1 UPTO highest entry (thesaurus) REP{} IF name (thesaurus, zaehler) <> ""{} AND pos (name (thesaurus, zaehler), praefix) = 1{} THEN insert (t, subtext (name (thesaurus, zaehler),{} length (praefix) + 1)){} FI;{} PER;{} t{}END PROC ohne praefix;{}BOOL PROC not empty (THESAURUS CONST t):{} INT VAR i;{} FOR i FROM 1 UPTO highest entry (t) REP{} IF name (t, i) <> ""{} THEN LEAVE not empty WITH TRUE{}
- FI{} PER;{} FALSE{}END PROC not empty;{}PROC untersuche bildschirmmasszahlen (TEXT CONST t1, t2):{} IF unzulaessige cursorwerte{} THEN errorstop (fehlermeldung [1]){} ELIF fenster ist zu klein{} THEN errorstop (fehlermeldung [2]){} FI.{} unzulaessige cursorwerte:{} (x + xsize) > 80 COR (y + ysize) > 25 COR x < 1 COR y < 1{} COR xsize > 79 COR ysize > 24.{} fenster ist zu klein:{} (xsize) < 56 COR (ysize) < 15{} COR length (t1) > (xsize - 5) COR length (t2) > (xsize - 5).{}
-END PROC untersuche bildschirmmasszahlen;{}TEXT PROC ggf gekuerzter text (TEXT CONST text):{} IF length (text) > (xsize - 5){} THEN subtext (text, 1, xsize - 7) + ".."{} ELSE text{} FI{}END PROC ggf gekuerzter text;{}THESAURUS PROC some (INT CONST spa, zei, breite, hoehe,{} THESAURUS CONST t,{} TEXT CONST t1, t2):{} TEXT VAR text 1, text 2;{} x := spa;{} y := zei;{} xsize := breite;{} ysize := hoehe;{} text 1 := ggf gekuerzter text (t1);{}
- text 2 := ggf gekuerzter text (t2);{} untersuche bildschirmmasszahlen (text 1, text 2);{} auswahl (t, TRUE, text 1, text 2){}END PROC some;{}THESAURUS PROC some (INT CONST spa, zei,{} THESAURUS CONST t,{} TEXT CONST t1, t2):{} some (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2){}END PROC some;{}THESAURUS PROC some (THESAURUS CONST t,{} TEXT CONST t1, t2):{} some (1, 1, 79, 24, t, t1, t2){}END PROC some;{}TEXT PROC one (INT CONST spa, zei, breite, hoehe,{}
- THESAURUS CONST t,{} TEXT CONST t1, t2):{} TEXT VAR text 1, text 2;{} x := spa;{} y := zei;{} xsize := breite;{} ysize := hoehe;{} text 1 := ggf gekuerzter text (t1);{} text 2 := ggf gekuerzter text (t2);{} untersuche bildschirmmasszahlen (text 1, text 2);{} name (auswahl (t, FALSE, text 1, text 2), 1){}END PROC one;{}TEXT PROC one (INT CONST spa, zei,{} THESAURUS CONST t,{} TEXT CONST t1, t2):{} one (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2){}
-END PROC one;{}TEXT PROC one (THESAURUS CONST t, TEXT CONST t1, t2):{} one (1, 1, 79, 24, t, t1, t2){}END PROC one;{}END PACKET ls dialog 2;{}
+ some,
+ one,
+ infix namen,
+ ohne praefix,
+ not empty:
+LET maxentries = 200;
+LET zeichenstring = ""1""27""3""10""13""12"xo?",
+ oben unten return rubout kreuz kringel = ""3""10""13""12"xo",
+ q eins neun h = "q19h";
+LET zurueck = ""8"",
+ piep = ""7"";
+LET hop = 1,
+ esc = 2,
+ oben = 3,
+ unten = 4,
+ return = 5,
+ rubout = 6,
+
+ kreuz = 7,
+ kringel = 8,
+ frage = 9;
+LET punkt = ".",
+ gleich = "=",
+ blank = " ";
+INT VAR x,
+ y,
+ xsize,
+ ysize,
+ maxeintraege,
+ anzahl,
+ erste auswahlzeile,
+ virtueller cursor,
+ reeller cursor;
+TEXT VAR kennzeile 1,
+ kennzeile 2,
+ registrierkette :: "";
+BOOL VAR abbruch,
+ auswahlende;
+BOUND ROW max entries TEXT VAR eintrag;
+ROW 2 TEXT CONST fehlermeldung :: ROW 2 TEXT : (
+
+ "Unzulässige Cursorwerte bei der Auswahl",
+ "Fenster für Auswahl zu klein (x < 56 / y < 15)");
+ROW 24 TEXT CONST hinweis :: ROW 24 TEXT : (
+ " Bitte warten... Ich sortiere und räume auf!",
+ " Info: <?> Fertig: <ESC><q> Abbrechen: <ESC><h>",
+ " Zum Weitermachen bitte irgendeine Taste tippen!",
+ "Weitere Dateien!",
+ "INFORMATIONEN: Auswahl mehrerer Dateien",
+ "INFORMATIONEN: Auswahl einer Datei",
+ " "15"Positionierungen: "14"",
+ " hoch : zum vorausgehenden Namen",
+
+ " runter : zum folgenden Namen",
+ " HOP hoch : auf den ersten Namen der Seite", (***********)
+ " HOP runter : auf den letzten Namen der Seite", (* bitte *)
+ " ESC 1 : auf den ersten Namen der Liste", (* diese *)
+ " ESC 9 : auf den letzten Namen der Liste", (* Länge *)
+ " "15"Auswahl treffen: "14"", (* nicht *)
+ " RETURN / x : diesen Namen ankreuzen ", (* über- *)
+
+ " RUBOUT / o : Kreuz vor dem Namen loeschen", (* schrei-*)
+ " HOP RETURN / HOP x : alle folgende Namen ankreuzen", (* ten! *)
+ " HOP RUBOUT / HOP o : alle folgende Kreuze loeschen", (***********)
+ " "15"Auswahl verlassen: "14"",
+ " ESC q : Auswahl verlassen",
+ " ESC h : Auswahl abbrechen",
+ " Auswahl m e h r e r e r Dateien durch Ankreuzen",
+ " Auswahl e i n e r Datei durch Ankreuzen",
+ " Bitte warten... Ich breche die Auswahl ab!"
+
+ );
+THESAURUS PROC auswahl (THESAURUS CONST t,
+ BOOL CONST mehrere moeglich,
+ TEXT CONST t1, t2):
+ werte initialisieren;
+ namen besorgen;
+ bildschirm aufbauen;
+ auswaehlen lassen;
+ abgang vorbereiten.
+ werte initialisieren:
+ THESAURUS VAR ausgabe :: empty thesaurus;
+ DATASPACE VAR ds := nilspace;
+ eintrag := ds;
+ kennzeile 1 := t1;
+ kennzeile 2 := t2;
+ abbruch := FALSE;
+
+ erste auswahlzeile := y + 7;
+ anzahl := 0;
+ maxeintraege := ysize - 11;
+ virtueller cursor := 1;
+ reeller cursor := 1.
+ namen besorgen:
+ fische die namen aus dem thesaurus;
+ IF kein eintrag vorhanden
+ THEN LEAVE auswahl WITH ausgabe
+ FI.
+ bildschirm aufbauen:
+ schreibe kopfzeile;
+ gib hinweis aus (kennzeile 1, kennzeile 2);
+ gib erklaerungszeile aus (mehrere moeglich);
+ baue bildschirm auf (1);
+ footnote (x, y, xsize, ysize, hinweis [2]);
+
+ schreibe fusszeile;
+ reellen cursor setzen .
+ schreibe kopfzeile:
+ cursor (x, y);
+ out(ecke oben links);
+ (xsize - 2) TIMESOUT waagerecht;
+ out(ecke oben rechts).
+ schreibe fusszeile:
+ cursor (x, y + ysize - 1);
+ out (ecke unten links);
+ (xsize - 2) TIMESOUT waagerecht;
+ out (ecke unten rechts).
+ auswaehlen lassen:
+ kreuze an (mehrere moeglich).
+ abgang vorbereiten:
+ IF abbruch
+ THEN change footnote (x, y, xsize, ysize, hinweis [24])
+
+ ELSE change footnote (x, y, xsize, ysize, hinweis [ 1])
+ FI;
+ cursor (x + 1, y + ysize - 1);
+ ausgabe erzeugen;
+ forget (ds);
+ ausgabe.
+ fische die namen aus dem thesaurus:
+ INT VAR zeiger;
+ FOR zeiger FROM 1 UPTO highest entry (t) REP
+ IF name (t, zeiger) <> ""
+ THEN anzahl INCR 1;
+ eintrag [anzahl] := name (t, zeiger)
+ FI
+ PER.
+ kein eintrag vorhanden:
+ anzahl = 0.
+ ausgabe erzeugen:
+ TEXT VAR nummer;
+ WHILE registrierkette <> "" REP
+
+ nummer := subtext (registrierkette, 1, 3);
+ registrierkette := subtext (registrierkette, 5);
+ insert (ausgabe, eintrag [ int (nummer)])
+ PER.
+END PROC auswahl;
+PROC reellen cursor setzen:
+ cursor (x + 1, erste auswahlzeile + reeller cursor - 1);
+ out (marke (virtueller cursor, TRUE) + (8 * zurueck))
+END PROC reellen cursor setzen;
+PROC baue bildschirm auf (INT CONST anfang):
+ gib kopfzeile aus;
+ gib namenstabelle aus;
+ gib fusszeile aus;
+ loesche ggf restbereich.
+
+ gib kopfzeile aus:
+ cursor (x, erste auswahlzeile - 1); out (senkrecht);
+ IF reeller cursor = virtueller cursor
+ THEN (xsize - 2) TIMESOUT punkt
+ ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt;
+ out (invers (hinweis [4]))
+ FI;
+ out (senkrecht);
+ line.
+ gib namenstabelle aus:
+ INT VAR zeiger, zaehler :: -1;
+ FOR zeiger FROM anfang UPTO grenze REP
+ zaehler INCR 1;
+ cursor (x, erste auswahlzeile + zaehler);
+ out (senkrecht); out (marke (zeiger, FALSE));
+
+ outtext (subtext (eintrag [zeiger], 1, xsize - 10), 1, xsize - 10);
+ out (senkrecht);
+ PER.
+ gib fusszeile aus:
+ cursor (x, erste auswahlzeile + zaehler + 1);
+ out (senkrecht);
+ IF NOT ((virtueller cursor + maxeintraege - reeller cursor) < anzahl)
+ THEN (xsize - 2) TIMESOUT punkt
+ ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt;
+ out (invers (hinweis [4]))
+ FI;
+ out (senkrecht).
+ loesche ggf restbereich:
+ IF zaehler + 1 < maxeintraege
+
+ THEN loesche bildschirmrest
+ FI.
+ loesche bildschirmrest:
+ FOR zeiger FROM restanfang UPTO restende REP
+ cursor (x, zeiger); out (senkrecht);
+ (xsize - 2) TIMESOUT blank;
+ out (senkrecht)
+ PER.
+ restanfang:
+ erste auswahlzeile + zaehler + 2.
+ restende:
+ erste auswahlzeile + maxeintraege.
+ grenze:
+ min (anzahl, anfang + max eintraege - 1).
+END PROC baue bildschirm auf;
+TEXT PROC marke (INT CONST zeiger, BOOL CONST mit cursor):
+
+ INT VAR platz := nr (zeiger);
+ IF platz = 0
+ THEN leer
+ ELSE mit zahl
+ FI.
+ mit zahl:
+ IF mit cursor
+ THEN "==>" + (3 - length (text (platz))) * blank + text (platz) + "x "
+ ELSE " " + (3 - length (text (platz))) * blank + text (platz) + "x "
+ FI.
+ leer:
+ IF mit cursor
+ THEN "==> o "
+ ELSE " o "
+ FI.
+END PROC marke;
+INT PROC nr (INT CONST zeiger):
+ IF pos (registrierkette, textstring (zeiger)) = 0
+ THEN 0
+ ELSE (pos (registrierkette, textstring (zeiger)) DIV 4) + 1
+
+ FI
+END PROC nr;
+TEXT PROC textstring (INT CONST nr):
+ text (nr, 3) + "!"
+END PROC textstring;
+PROC info (BOOL CONST mehrere):
+ notiere hinweisueberschrift;
+ notiere positionierhinweise;
+ IF noch platz vorhanden
+ THEN notiere auswahlmoeglichkeiten auf alter seite
+ ELSE wechsle auf naechste seite;
+ notiere hinweisueberschrift;
+ notiere auswahlmoeglichtkeiten auf neuer seite
+ FI;
+ stelle alten bildschirmzustand wieder her.
+ notiere hinweisueberschrift:
+
+ cursor (x + 1, y + 1);
+ IF mehrere
+ THEN out (center(xsize - 2, invers (hinweis [5])))
+ ELSE out (center(xsize - 2, invers (hinweis [6])))
+ FI;
+ cursor (x + 1, y + 2); out ("", xsize - 2).
+ notiere positionierhinweise:
+ cursor (x + 1, y + 3); out (hinweis [ 7], xsize - 2);
+ cursor (x + 1, y + 4); out (hinweis [ 8], xsize - 2);
+ cursor (x + 1, y + 5); out (hinweis [ 9], xsize - 2);
+ cursor (x + 1, y + 6); out (hinweis [10], xsize - 2);
+ cursor (x + 1, y + 7); out (hinweis [11], xsize - 2);
+
+ cursor (x + 1, y + 8); out (hinweis [12], xsize - 2);
+ cursor (x + 1, y + 9); out (hinweis [13], xsize - 2).
+ notiere auswahlmoeglichkeiten auf alter seite:
+ cursor (x + 1, y + 10); out ("", xsize - 2);
+ cursor (x + 1, y + 11); out (hinweis [14], xsize - 2);
+ cursor (x + 1, y + 12); out (hinweis [15], xsize - 2);
+ IF mehrere
+ THEN gib alle auswahlmoeglichkeiten auf der alten seite an
+ ELSE gib eine auswahlmoeglichkeit auf der alten seite an
+ FI;
+
+ notiere verlassmoeglichkeiten auf der alten seite;
+ loesche die restlichen zeilen;
+ change footnote (x, y, xsize, ysize, hinweis [3]);
+ cursor in ruhestellung;
+ clear buffer.
+ gib alle auswahlmoeglichkeiten auf der alten seite an:
+ cursor (x + 1, y + 13); out (hinweis [16], xsize - 2);
+ cursor (x + 1, y + 14); out (hinweis [17], xsize - 2);
+ cursor (x + 1, y + 15); out (hinweis [18], xsize - 2).
+ gib eine auswahlmoeglichkeit auf der alten seite an:
+ cursor (x + 1, y + 13); out ("", xsize - 2);
+
+ cursor (x + 1, y + 14); out ("", xsize - 2);
+ cursor (x + 1, y + 15); out ("", xsize - 2).
+ notiere verlassmoeglichkeiten auf der alten seite:
+ cursor (x + 1, y + 16); out ("", xsize - 2);
+ cursor (x + 1, y + 17); out (hinweis [19], xsize - 2);
+ cursor (x + 1, y + 18); out (hinweis [20], xsize - 2);
+ cursor (x + 1, y + 19); out (hinweis [21], xsize - 2).
+ loesche die restlichen zeilen:
+ IF ysize = 24
+ THEN cursor (x + 1, y + 20); out ("", xsize - 2)
+ FI.
+
+ wechsle auf naechste seite:
+ loesche seitenrest;
+ change footnote (x, y, xsize, ysize, hinweis [3]);
+ cursor in ruhestellung;
+ clear buffer;
+ pause.
+ loesche seitenrest:
+ INT VAR zaehler;
+ FOR zaehler FROM 10 UPTO ysize - 4 REP
+ cursor (x + 1, y + zaehler); out ("", xsize - 2)
+ PER.
+ notiere auswahlmoeglichtkeiten auf neuer seite:
+ cursor (x + 1, y + 3); out (hinweis [14], xsize - 2);
+ cursor (x + 1, y + 4); out (hinweis [15], xsize - 2);
+ IF mehrere
+
+ THEN gib alle auswahlmoeglichkeiten auf der neuen seite an
+ ELSE gib eine auswahlmoeglichkeit auf der neuen seite an
+ FI;
+ notiere verlassmoeglichkeiten auf der neuen seite.
+ gib alle auswahlmoeglichkeiten auf der neuen seite an:
+ cursor (x + 1, y + 5); out (hinweis [16], xsize - 2);
+ cursor (x + 1, y + 6); out (hinweis [17], xsize - 2);
+ cursor (x + 1, y + 7); out (hinweis [18], xsize - 2).
+ gib eine auswahlmoeglichkeit auf der neuen seite an:
+ cursor (x + 1, y + 5); out ("", xsize - 2);
+
+ cursor (x + 1, y + 6); out ("", xsize - 2);
+ cursor (x + 1, y + 7); out ("", xsize - 2).
+ notiere verlassmoeglichkeiten auf der neuen seite:
+ cursor (x + 1, y + 8); out ("", xsize - 2);
+ cursor (x + 1, y + 9); out (hinweis [19], xsize - 2);
+ cursor (x + 1, y + 10); out (hinweis [20], xsize - 2);
+ cursor (x + 1, y + 11); out (hinweis [21], xsize - 2);
+ cursor in ruhestellung.
+ cursor in ruhestellung:
+ cursor (x + 1, y + ysize - 2).
+ stelle alten bildschirmzustand wieder her:
+
+ clear buffer;
+ pause;
+ gib hinweis aus (kennzeile 1, kennzeile 2);
+ gib erklaerungszeile aus (mehrere);
+ virtueller cursor := 1;
+ reeller cursor := 1;
+ baue bildschirm auf (1);
+ change footnote (x, y, xsize, ysize, hinweis [2]);
+ reellen cursor setzen.
+ noch platz vorhanden:
+ (ysize - 4) > 18.
+END PROC info;
+PROC kreuze an (BOOL CONST mehrere):
+ auswahlende := FALSE;
+ REP
+ zeichen lesen; zeichen interpretieren
+ UNTIL auswahlende PER.
+ zeichen lesen:
+
+ TEXT VAR zeichen;
+ getchar (zeichen).
+ zeichen interpretieren:
+ SELECT pos (zeichenstring, zeichen) OF
+ CASE hop : hop kommando verarbeiten (mehrere)
+ CASE esc : esc kommando verarbeiten
+ CASE oben : nach oben
+ CASE unten : nach unten
+ CASE kreuz : ankreuzen; evtl aufhoeren
+ CASE return : ankreuzen weiter; evtl aufhoeren
+ CASE rubout : auskreuzen weiter
+ CASE kringel : auskreuzen
+ CASE frage : info (mehrere)
+
+ OTHERWISE out (piep)
+ END SELECT.
+ evtl aufhoeren:
+ IF NOT mehrere
+ THEN LEAVE kreuze an
+ FI.
+END PROC kreuze an;
+PROC hop kommando verarbeiten (BOOL CONST mehrere):
+ zweites zeichen lesen;
+ zeichen interpretieren.
+ zweites zeichen lesen:
+ TEXT VAR zweites zeichen;
+ getchar(zweites zeichen).
+ zeichen interpretieren:
+ SELECT pos (oben unten return rubout kreuz kringel, zweites zeichen) OF
+ CASE 1 : hop nach oben
+ CASE 2 : hop nach unten
+
+ CASE 3, 5 : IF mehrere THEN alle darunter ankreuzen FI
+ CASE 4, 6 : IF mehrere THEN alle darunter loeschen FI
+ OTHERWISE out (piep)
+ END SELECT.
+ alle darunter ankreuzen:
+ INT VAR i;
+ FOR i FROM virtueller cursor UPTO anzahl REP
+ IF nr (i) = 0
+ THEN ankreuzen
+ FI
+ PER;
+ bild aktualisieren ;
+ reellen cursor setzen .
+ ankreuzen:
+ registrierkette CAT textstring (i).
+ alle darunter loeschen:
+ INT VAR j, position;
+ FOR j FROM virtueller cursor UPTO anzahl REP
+
+ position := nr (j);
+ IF position > 0
+ THEN rausschmeissen;
+ FI
+ PER;
+ bild aktualisieren;
+ reellen cursor setzen.
+ rausschmeissen:
+ registrierkette := subtext (registrierkette, 1, (4 * position) - 4) +
+ subtext (registrierkette, (4 * position) + 1).
+ hop nach oben:
+ IF ganz oben
+ THEN out (piep)
+ ELIF oben auf der seite
+ THEN raufblaettern
+ ELSE top of page
+ FI.
+ ganz oben:
+ virtueller cursor = 1.
+
+ oben auf der seite:
+ reeller cursor = 1.
+ raufblaettern:
+ virtueller cursor DECR max eintraege;
+ virtueller cursor := max (virtueller cursor, 1);
+ baue bildschirm auf (virtueller cursor);
+ reellen cursor setzen.
+ top of page:
+ loesche marke;
+ virtueller cursor DECR (reeller cursor - 1);
+ reeller cursor := 1;
+ reellen cursor setzen.
+ hop nach unten:
+ IF ganz unten
+ THEN out (piep)
+ ELIF unten auf der seite
+ THEN runterblaettern
+
+ ELSE bottom of page
+ FI.
+ ganz unten:
+ virtueller cursor = anzahl.
+ unten auf der seite:
+ reeller cursor > max eintraege - 1.
+ runterblaettern:
+ INT VAR alter virtueller cursor :: virtueller cursor;
+ virtueller cursor INCR max eintraege;
+ virtueller cursor := min (virtueller cursor, anzahl);
+ reeller cursor := virtueller cursor - alter virtueller cursor;
+ baue bildschirm auf (alter virtueller cursor + 1);
+ reellen cursor setzen.
+ bottom of page:
+
+ loesche marke;
+ alter virtueller cursor := virtueller cursor;
+ virtueller cursor INCR (max eintraege - reeller cursor);
+ virtueller cursor := min (anzahl, virtueller cursor);
+ reeller cursor INCR (virtueller cursor - alter virtueller cursor);
+ reellen cursor setzen.
+END PROC hop kommando verarbeiten;
+PROC esc kommando verarbeiten:
+ TEXT VAR zweites zeichen;
+ getchar (zweites zeichen);
+ SELECT pos (q eins neun h, zweites zeichen) OF
+ CASE 1 : auswahlende := TRUE
+
+ CASE 2 : zeige anfang
+ CASE 3 : zeige ende
+ CASE 4 : abbruch := TRUE;
+ auswahlende := TRUE;
+ registrierkette := ""
+ OTHERWISE out (piep)
+ END SELECT.
+ zeige anfang:
+ IF virtueller cursor = 1
+ THEN out (piep)
+ ELIF virtueller cursor = reeller cursor
+ THEN loesche marke;
+ virtueller cursor := 1;
+ reeller cursor := 1;
+ reellen cursor setzen
+ ELSE virtueller cursor := 1;
+
+ reeller cursor := 1;
+ baue bildschirm auf (1);
+ reellen cursor setzen
+ FI.
+ zeige ende:
+ IF virtueller cursor = anzahl
+ THEN out (piep)
+ ELIF ende auf bildschirm
+ THEN loesche marke;
+ reeller cursor INCR (anzahl - virtueller cursor);
+ virtueller cursor := anzahl;
+ reellen cursor setzen
+ ELSE virtueller cursor := anzahl;
+ reeller cursor := max eintraege;
+
+ baue bildschirm auf (anzahl - (max eintraege - 1));
+ reellen cursor setzen
+ FI.
+ ende auf bildschirm:
+ (reeller cursor + anzahl - virtueller cursor) < max eintraege + 1.
+END PROC esc kommando verarbeiten;
+PROC ankreuzen:
+ INT VAR platz :: nr (virtueller cursor);
+ IF platz <> 0
+ THEN out (piep);
+ LEAVE ankreuzen
+ FI;
+ registrierkette CAT textstring (virtueller cursor);
+ reellen cursor setzen
+END PROC ankreuzen;
+PROC ankreuzen weiter:
+
+ INT VAR platz :: nr (virtueller cursor);
+ IF platz <> 0
+ THEN out (piep);
+ LEAVE ankreuzen weiter
+ FI;
+ registrierkette CAT textstring (virtueller cursor);
+ IF virtueller cursor < anzahl
+ THEN nach unten
+ FI;
+ IF virtueller cursor = anzahl
+ THEN reellen cursor setzen
+ FI
+END PROC ankreuzen weiter;
+PROC auskreuzen weiter:
+ INT VAR position :: nr (virtueller cursor);
+ IF position = 0
+ THEN out (piep);
+ LEAVE auskreuzen weiter
+ FI;
+ rausschmeissen;
+
+ IF virtueller cursor < anzahl
+ THEN nach unten
+ ELSE loesche marke
+ FI;
+ bild aktualisieren;
+ reellen cursor setzen.
+ rausschmeissen:
+ registrierkette := subtext (registrierkette, 1, 4 * position - 4) +
+ subtext (registrierkette, 4 * position + 1).
+END PROC auskreuzen weiter;
+PROC auskreuzen:
+ INT VAR position :: nr (virtueller cursor);
+ IF position = 0
+ THEN out (piep);
+ LEAVE auskreuzen
+ FI;
+ rausschmeissen;
+ loesche marke;
+
+ bild aktualisieren;
+ reellen cursor setzen.
+ rausschmeissen:
+ registrierkette := subtext (registrierkette, 1, 4 * position - 4) +
+ subtext (registrierkette, 4 * position + 1).
+END PROC auskreuzen;
+PROC bild aktualisieren:
+ INT VAR ob, un, i, zaehler :: -1;
+ ob := virtueller cursor - reeller cursor + 1;
+ un := min (ob + max eintraege - 1, anzahl);
+ FOR i FROM ob UPTO un REP
+ zaehler INCR 1;
+ cursor (x + 1, erste auswahlzeile + zaehler);
+ out (marke (i,FALSE)) PER
+
+END PROC bild aktualisieren;
+PROC nach oben:
+ IF noch nicht oben (*virtuell*)
+ THEN gehe nach oben
+ ELSE out (piep)
+ FI.
+ noch nicht oben:
+ virtueller cursor > 1.
+ gehe nach oben:
+ IF reeller cursor = 1 THEN scroll down ELSE cursor up FI.
+ scroll down:
+ virtueller cursor DECR 1;
+ baue bildschirm auf (virtueller cursor);
+ reellen cursor setzen.
+ cursor up:
+ loesche marke;
+ virtueller cursor DECR 1;
+ reeller cursor DECR 1;
+ reellen cursor setzen
+
+END PROC nach oben;
+PROC nach unten:
+ IF noch nicht unten (*virtuell*)
+ THEN gehe nach unten
+ ELSE out (piep)
+ FI.
+ noch nicht unten:
+ virtueller cursor < anzahl.
+ gehe nach unten:
+ IF reeller cursor > max eintraege - 1 THEN scroll up ELSE cursor down FI.
+ scroll up:
+ virtueller cursor INCR 1;
+ baue bildschirm auf (virtueller cursor - (max eintraege - 1));
+ reellen cursor setzen.
+ cursor down:
+ loesche marke;
+ virtueller cursor INCR 1;
+ reeller cursor INCR 1;
+
+ reellen cursor setzen
+END PROC nach unten;
+PROC loesche marke:
+ out (marke (virtueller cursor, FALSE))
+END PROC loesche marke;
+PROC footnote (INT CONST x, y, xsize, ysize, TEXT CONST text):
+ cursor (x, y + ysize - 3);
+ out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts);
+ change footnote (x, y, xsize, ysize, text)
+END PROC footnote;
+PROC change footnote (INT CONST x, y, xsize, ysize, TEXT CONST text):
+ cursor (x, y + ysize - 2);
+ out (senkrecht); outtext (text, 1, xsize - 2); out (senkrecht)
+
+END PROC change footnote;
+PROC gib hinweis aus (TEXT CONST t1, t2):
+ cursor (x, y + 1); out (senkrecht);
+ out (center (xsize - 2, invers (t1)));
+ out (senkrecht);
+ cursor (x, y + 2); out (senkrecht);
+ out ("", xsize - 2);
+ out (senkrecht);
+ cursor (x, y + 3); out (senkrecht);
+ out (center (xsize - 2, t2));
+ out (senkrecht)
+END PROC gib hinweis aus;
+PROC gib erklaerungszeile aus (BOOL CONST mehrere):
+
+ cursor (x, y + 4); out (senkrecht);
+ out ((xsize - 2) * gleich);
+ out (senkrecht);
+ cursor (x, y + 5); out (senkrecht);
+ IF mehrere
+ THEN out (erklaerungszeile mehrere)
+ ELSE out (erklaerungszeile eine)
+ FI;
+ out (senkrecht).
+ erklaerungszeile mehrere:
+ invers (text 1 + (rest1 * blank)).
+ erklaerungszeile eine:
+ invers (text 2 + (rest2 * blank)).
+
+ text1:
+ hinweis [22].
+ text2:
+ hinweis [23].
+ rest1: (***************************)
+ xsize - length (text1) - 5. (* durch 'invers' wird ein *)
+ (* Blank angehängt und zu- *)
+ rest2: (* sätzlich noch durch *)
+ xsize - length (text2) - 5. (* 'relativcenter' - außer-*)
+END PROC gib erklaerungszeile aus; (* dem nimmt die Markierung*)
+ (* selbst eine Position ein*)
+
+ (***************************)
+THESAURUS PROC infix namen (THESAURUS CONST t, TEXT CONST infix):
+ THESAURUS VAR tt :: empty thesaurus;
+ INT VAR i;
+ FOR i FROM 1 UPTO highest entry (t) REP
+ TEXT VAR eintrag :: name (t,i);
+ IF eintrag enthaelt infix
+ THEN insert (tt, eintrag)
+ FI
+ PER;
+ tt.
+ eintrag enthaelt infix:
+ pos (eintrag, infix) <> 0
+END PROC infix namen;
+THESAURUS PROC infix namen (THESAURUS CONST t, INT CONST dateityp):
+
+ THESAURUS VAR tt :: empty thesaurus;
+ INT VAR i;
+ FOR i FROM 1 UPTO highest entry (t) REP
+ TEXT VAR eintrag :: name (t,i);
+ IF eintrag enthaelt infix
+ THEN insert (tt, eintrag)
+ FI
+ PER;
+ tt.
+ eintrag enthaelt infix:
+ type (old (eintrag)) = dateityp.
+END PROC infix namen;
+THESAURUS PROC infix namen (THESAURUS CONST t,
+ TEXT CONST infix 1, INT CONST dateityp):
+ THESAURUS VAR tt :: empty thesaurus;
+ INT VAR i;
+ FOR i FROM 1 UPTO highest entry (t) REP
+
+ TEXT VAR eintrag :: name (t,i);
+ IF eintrag enthaelt infix
+ THEN insert (tt, eintrag)
+ FI
+ PER;
+ tt.
+ eintrag enthaelt infix:
+ (pos (eintrag, infix 1) <> 0) AND (type (old (eintrag)) = dateityp).
+END PROC infix namen;
+THESAURUS PROC infix namen (THESAURUS CONST t,
+ TEXT CONST infix 1, infix 2):
+ THESAURUS VAR tt :: empty thesaurus;
+ INT VAR i;
+ FOR i FROM 1 UPTO highest entry (t) REP
+ TEXT VAR eintrag :: name (t,i);
+ IF eintrag enthaelt infix
+
+ THEN insert (tt, eintrag)
+ FI
+ PER;
+ tt.
+ eintrag enthaelt infix:
+ (pos (eintrag, infix 1) <> 0) OR (pos (eintrag, infix 2) <> 0)
+END PROC infix namen;
+THESAURUS PROC infix namen (TEXT CONST infix):
+ infix namen (ALL myself, infix)
+END PROC infix namen;
+THESAURUS PROC infix namen (TEXT CONST infix 1, infix 2):
+ infix namen (ALL myself, infix 1, infix 2)
+END PROC infix namen;
+THESAURUS PROC ohne praefix (THESAURUS CONST thesaurus, TEXT CONST praefix):
+ THESAURUS VAR t :: empty thesaurus;
+
+ INT VAR zaehler;
+ FOR zaehler FROM 1 UPTO highest entry (thesaurus) REP
+ IF name (thesaurus, zaehler) <> ""
+ AND pos (name (thesaurus, zaehler), praefix) = 1
+ THEN insert (t, subtext (name (thesaurus, zaehler),
+ length (praefix) + 1))
+ FI;
+ PER;
+ t
+END PROC ohne praefix;
+BOOL PROC not empty (THESAURUS CONST t):
+ INT VAR i;
+ FOR i FROM 1 UPTO highest entry (t) REP
+ IF name (t, i) <> ""
+ THEN LEAVE not empty WITH TRUE
+
+ FI
+ PER;
+ FALSE
+END PROC not empty;
+PROC untersuche bildschirmmasszahlen (TEXT CONST t1, t2):
+ IF unzulaessige cursorwerte
+ THEN errorstop (fehlermeldung [1])
+ ELIF fenster ist zu klein
+ THEN errorstop (fehlermeldung [2])
+ FI.
+ unzulaessige cursorwerte:
+ (x + xsize) > 80 COR (y + ysize) > 25 COR x < 1 COR y < 1
+ COR xsize > 79 COR ysize > 24.
+ fenster ist zu klein:
+ (xsize) < 56 COR (ysize) < 15
+ COR length (t1) > (xsize - 5) COR length (t2) > (xsize - 5).
+
+END PROC untersuche bildschirmmasszahlen;
+TEXT PROC ggf gekuerzter text (TEXT CONST text):
+ IF length (text) > (xsize - 5)
+ THEN subtext (text, 1, xsize - 7) + ".."
+ ELSE text
+ FI
+END PROC ggf gekuerzter text;
+THESAURUS PROC some (INT CONST spa, zei, breite, hoehe,
+ THESAURUS CONST t,
+ TEXT CONST t1, t2):
+ TEXT VAR text 1, text 2;
+ x := spa;
+ y := zei;
+ xsize := breite;
+ ysize := hoehe;
+ text 1 := ggf gekuerzter text (t1);
+
+ text 2 := ggf gekuerzter text (t2);
+ untersuche bildschirmmasszahlen (text 1, text 2);
+ auswahl (t, TRUE, text 1, text 2)
+END PROC some;
+THESAURUS PROC some (INT CONST spa, zei,
+ THESAURUS CONST t,
+ TEXT CONST t1, t2):
+ some (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2)
+END PROC some;
+THESAURUS PROC some (THESAURUS CONST t,
+ TEXT CONST t1, t2):
+ some (1, 1, 79, 24, t, t1, t2)
+END PROC some;
+TEXT PROC one (INT CONST spa, zei, breite, hoehe,
+
+ THESAURUS CONST t,
+ TEXT CONST t1, t2):
+ TEXT VAR text 1, text 2;
+ x := spa;
+ y := zei;
+ xsize := breite;
+ ysize := hoehe;
+ text 1 := ggf gekuerzter text (t1);
+ text 2 := ggf gekuerzter text (t2);
+ untersuche bildschirmmasszahlen (text 1, text 2);
+ name (auswahl (t, FALSE, text 1, text 2), 1)
+END PROC one;
+TEXT PROC one (INT CONST spa, zei,
+ THESAURUS CONST t,
+ TEXT CONST t1, t2):
+ one (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2)
+
+END PROC one;
+TEXT PROC one (THESAURUS CONST t, TEXT CONST t1, t2):
+ one (1, 1, 79, 24, t, t1, t2)
+END PROC one;
+END PACKET ls dialog 2;
+
diff --git a/dialog/ls-DIALOG 3 b/dialog/ls-DIALOG 3
index dce6507..2460820 100644
--- a/dialog/ls-DIALOG 3
+++ b/dialog/ls-DIALOG 3
@@ -22,27 +22,395 @@
*)
-PACKET ls dialog 3 DEFINES{} WINDOW, :=, window,{} show, page, erase,{} line, remaining lines,{} cursor, get cursor,{} out frame, out menuframe,{} out, put, putline, editget,{} get, getline, yes, no,{} edit, center, stop,{} area, areax, areay,{} areaxsize, areaysize:{}LET piep = ""7"",{} cr = ""13"";{}LET janeinkette = "jJyYnN",{} blank = " ",{} niltext = "";{}TYPE WINDOW = STRUCT (AREA fenster,{}
- INT cspalte, czeile, belegbare zeilen,{} BOOL fensterende erreicht);{}ROW 3 TEXT CONST aussage :: ROW 3 TEXT : ({} " 'Window' ungültig!",{} " (j/n) ?",{} " Zum Weitermachen bitte irgendeine Taste tippen!"{} );{}TEXT VAR number word, exit char;{}OP := (WINDOW VAR links, WINDOW CONST rechts):{} CONCR (links) := CONCR (rechts){}END OP :=;{}WINDOW PROC window (INT CONST x, y, xsize, ysize):{} WINDOW VAR w;{} fill (w.fenster, x, y, xsize, ysize);{} IF fenster ungueltig (w){}
- THEN errorstop (aussage [1]){} FI;{} initialize (w);{} w{}END PROC window;{}PROC initialize (WINDOW VAR w):{} w.czeile := 1;{} w.cspalte := 1;{} w.fensterende erreicht := FALSE;{} w.belegbare zeilen := areaysize (w.fenster){}END PROC initialize;{}BOOL PROC fenster ungueltig (WINDOW CONST w):{} IF areax (w.fenster) < 1 COR areax (w.fenster) > 79{} COR areay (w.fenster) < 1 COR areay (w.fenster) > 24{} COR areaxsize (w.fenster) < 6 COR areaysize (w.fenster) < 3{}
- COR areax (w.fenster) + areaxsize (w.fenster) > 80{} COR areay (w.fenster) + areaysize (w.fenster) > 25{} THEN TRUE{} ELSE FALSE{} FI.{}END PROC fenster ungueltig;{}PROC show (WINDOW VAR w):{} zeige rahmen;{} fenster putzen.{} zeige rahmen:{} out frame (w.fenster).{} fenster putzen:{} page (w).{}END PROC show;{}PROC page (WINDOW VAR w):{} initialize (w);{} page (w, FALSE){}END PROC page;{}PROC page (WINDOW CONST w, BOOL CONST mit rahmen ):{} IF areax (w) = 1 AND areay (w) = 1 AND{}
- areaxsize (w) = 79 AND areaysize (w) = 24{} THEN page;{} ELSE loesche bereich{} FI.{} loesche bereich:{} IF mit rahmen{} THEN page (areax (w) - 1, areay (w) - 1,{} areaxsize (w) + 2, areaysize (w) + 2){} ELSE page (area (w)){} FI{}END PROC page;{}PROC erase (WINDOW VAR w):{} page (w, TRUE){}END PROC erase;{}PROC line (WINDOW VAR w):{} w.cspalte := 1;{} IF w.czeile < w.belegbare zeilen{} THEN w.czeile INCR 1;{} ELSE w.czeile := 1;{}
- w.fensterende erreicht := TRUE{} FI;{} cursor (w, w.cspalte, w.czeile){}END PROC line;{}PROC line (WINDOW VAR w, INT CONST anzahl):{} INT VAR i; FOR i FROM 1 UPTO anzahl REP line (w) PER{}END PROC line;{}INT PROC remaining lines (WINDOW CONST w):{} INT VAR spalte, zeile;{} get cursor (w, spalte, zeile);{} IF spalte = 0 OR zeile = 0{} THEN 0{} ELSE w.belegbare zeilen - w.czeile{} FI{}END PROC remaining lines;{}PROC cursor (WINDOW VAR w, INT CONST spalte, zeile):{} IF spalte < 1 OR zeile < 1 OR spalte > areaxsize (w) OR zeile > areaysize (w){}
- THEN page (w);{} ELSE w.cspalte := spalte; w.czeile := zeile;{} FI;{} cursor (w.fenster, w.cspalte, w.czeile){}END PROC cursor;{}PROC get cursor (WINDOW CONST w, INT VAR spalte, zeile):{} IF (w.cspalte < 1) OR (w.cspalte > areaxsize (w.fenster)){} OR{} (w.czeile < 1) OR (w.czeile > areaysize (w.fenster)){} THEN spalte := 0; zeile := 0{} ELSE spalte := w.cspalte; zeile := w.czeile{} FI{}END PROC get cursor;{}PROC out (WINDOW VAR w, TEXT CONST text):{}
- INT VAR restlaenge;{} IF (w.cspalte >= 1) AND (w.cspalte <= areaxsize (w.fenster)){} AND{} (w.czeile >= 1) AND (w.czeile <= w.belegbare zeilen){} THEN putze ggf fenster;{} cursor (w.fenster, w.cspalte, w.czeile);{} outtext (text, 1, textende);{} setze fenstercursor neu;{} setze ausgabe ggf in naechster zeile fort{} FI.{} putze ggf fenster:{} IF w.fensterende erreicht{} THEN page (w);{} w.fensterende erreicht := FALSE{}
- FI.{} textende:{} restlaenge := areaxsize (w.fenster) - w.cspalte + 1;{} min (length (text), restlaenge).{} setze fenstercursor neu:{} IF length (text) >= restlaenge{} THEN w.cspalte := 1;{} w.czeile INCR 1;{} schlage ggf neue seite auf{} ELSE w.cspalte INCR length (text){} FI.{} schlage ggf neue seite auf:{} IF w.czeile > w.belegbare zeilen{} THEN page (w);{} w.czeile := 1{} FI.{} setze ausgabe ggf in naechster zeile fort:{}
- IF length (text) > restlaenge{} THEN out (w, subtext (text, restlaenge + 1)){} FI.{}END PROC out;{}PROC out frame (WINDOW VAR w):{} out frame (area (w)){}END PROC out frame;{}PROC out menuframe (WINDOW VAR w):{} out menu frame (area (w)){}END PROC out menuframe;{}PROC put (WINDOW VAR w, TEXT CONST word):{} out (w, word); out (w, blank){}END PROC put;{}PROC put (WINDOW VAR w, INT CONST number):{} put (w, text (number)){}END PROC put;{}PROC put (WINDOW VAR w, REAL VAR number):{} put (w, text (number)){}
-END PROC put;{}PROC putline (WINDOW VAR w, TEXT CONST textline):{} out (w, textline); line (w){}END PROC putline;{}PROC editget (WINDOW VAR w, TEXT VAR ausgabe,{} INT CONST max laenge, scroll,{} TEXT CONST sep, res, TEXT VAR exit char):{} INT VAR spalte, zeile;{} ggf zur naechsten zeile;{} get cursor (spalte, zeile); cursor on; cursor (spalte, zeile);{} editget (ausgabe, max laenge, min (scroll, restlaenge),{} sep, res, exitchar);{} get cursor (spalte, zeile); cursor off; cursor (spalte, zeile).{}
- ggf zur naechsten zeile:{} IF restlaenge < 5 THEN line (w) FI.{} restlaenge:{} areaxsize (w.fenster) - w.cspalte - 1.{}END PROC editget;{}PROC editget (WINDOW VAR w, TEXT VAR ausgabe):{} TEXT VAR dummy;{} editget (w, ausgabe, 79, 79, "", "", dummy){}END PROC editget;{}PROC get (WINDOW VAR w, TEXT VAR word):{} INT VAR spa, zei;{} ggf zur naechsten zeile;{} get cursor (spa, zei); cursor on; cursor (spa, zei);{} REP{} word := "";{} editget (word, maxtextlength, restlaenge, " ", "", exit char);{}
- out (w, subtext (word, 1, restlaenge));{} IF compress (word) <> ""{} THEN echoe exit char (w){} FI{} UNTIL word <> niltext AND word <> blank PER;{} get cursor (spa, zei); cursor off; cursor (spa, zei);{} delete leading blanks.{} ggf zur naechsten zeile:{} IF restlaenge < 5 THEN line (w) FI.{} restlaenge:{} areaxsize (w.fenster) - w.cspalte - 1.{} delete leading blanks:{} WHILE (word SUB 1) = blank REP word := subtext (word, 2) PER.{}END PROC get;{}PROC get (WINDOW VAR w, TEXT VAR word, TEXT CONST separator):{}
- INT VAR spa, zei;{} ggf zur naechsten zeile;{} get cursor (spa, zei); cursor on; cursor (spa, zei);{} REP{} word := "";{} editget (word, maxtextlength, restlaenge, separator, "", exit char);{} out (w, subtext (word, 1, restlaenge));{} echoe exit char (w);{} UNTIL word <> niltext AND word <> blank PER;{} get cursor (spa, zei); cursor off; cursor (spa, zei).{} ggf zur naechsten zeile:{} IF restlaenge < 5 THEN line (w) FI.{} restlaenge:{} areaxsize (w.fenster) - w.cspalte - 1.{}
-END PROC get;{}PROC get (WINDOW VAR w, TEXT VAR word, INT CONST length):{} INT VAR spa, zei;{} ggf zur naechsten zeile;{} get cursor (spa, zei); cursor on; cursor (spa, zei);{} REP{} word := "";{} editget (word, maxtextlength, laenge, "", "", exit char);{} out (w, subtext (word, 1, laenge));{} echoe exit char (w){} UNTIL word <> niltext AND word <> blank PER;{} get cursor (spa, zei); cursor off; cursor (spa, zei).{} ggf zur naechsten zeile:{} IF restlaenge < 5 THEN line (w) FI.{}
- restlaenge:{} areaxsize (w.fenster) - w.cspalte - 1.{} laenge:{} min (length, restlaenge).{}END PROC get;{}PROC get (WINDOW VAR w, INT VAR number):{} get (w, number word);{} number := int (number word){}END PROC get;{}PROC get (WINDOW VAR w, REAL VAR number):{} get (w, number word);{} number := real (number word){}END PROC get;{}PROC getline (WINDOW VAR w, TEXT VAR textline):{} INT VAR spa, zei;{} ggf zur naechsten zeile;{} get cursor (spa, zei); cursor on; cursor (spa, zei);{} REP{}
- textline := "";{} editget (textline, maxtextlength, restlaenge, "", "", exit char);{} out (w, subtext (word, 1, restlaenge));{} echoe exit char (w);{} UNTIL textline <> niltext AND textline <> blank PER;{} get cursor (spa, zei); cursor off; cursor (spa, zei).{} ggf zur naechsten zeile:{} IF restlaenge < 5 THEN line (w) FI.{} restlaenge:{} areaxsize (w.fenster) - w.cspalte - 1.{}END PROC getline;{}PROC echoe exit char (WINDOW VAR fenster):{} IF exit char = cr{} THEN line (fenster){}
- ELSE out (fenster, exit char){} FI{}END PROC echoe exit char;{}TEXT PROC center (WINDOW CONST w, TEXT CONST text):{} IF length (text) >= areaxsize (w.fenster){} THEN subtext (text, 1, areaxsize (w.fenster)){} ELSE center (areaxsize (w.fenster), text){} FI{}END PROC center;{}BOOL PROC yes (WINDOW VAR w, TEXT CONST frage):{} TEXT VAR zeichen, interne frage :: frage;{} interne frage CAT aussage [2];{} wechsel ggf auf neue seite;{} out (w, interne frage);{} hole eingabezeichen;{}
- werte zeichen aus.{} wechsel ggf auf neue seite:{} IF remaining lines (w) < 1{} THEN page (w){} FI.{} hole eingabezeichen:{} cursor on; clear buffer;{} REP{} inchar (zeichen);{} piepse ggf{} UNTIL pos (janeinkette, zeichen) > 0 PER;{} out (w, blank + zeichen);{} cursor off; line (w).{} piepse ggf:{} IF pos (janeinkette, zeichen) = 0 THEN out (piep) FI.{} werte zeichen aus:{} IF pos (janeinkette, zeichen) < 5{} THEN TRUE{} ELSE FALSE{} FI.{}
-END PROC yes;{}PROC edit (WINDOW VAR w, FILE VAR f):{} out frame (w.fenster);{} loesche rechte spalten (w);{} cursor on;{} edit (f, areax (w.fenster), areay (w.fenster),{} areaxsize (w.fenster) - 1, areaysize (w.fenster));{} cursor off{}END PROC edit;{}PROC edit (WINDOW VAR w, TEXT CONST dateiname):{} FILE VAR f :: sequential file (modify, dateiname);{} to line (f, 1);{} edit (w, f){}END PROC edit;{}PROC show (WINDOW VAR w, FILE VAR f):{} out frame (w.fenster);{} loesche rechte spalten (w);{}
- open editor (groesster editor + 1, f, FALSE,{} areax (w.fenster), areay (w.fenster),{} areaxsize (w.fenster) - 1, areaysize (w.fenster));{} cursor on;{} edit (groesster editor, "eqvw19dpgn"9"",{} PROC (TEXT CONST) std kommando interpreter);{} cursor off{}END PROC show;{}PROC show (WINDOW VAR w, TEXT CONST dateiname):{} FILE VAR f :: sequential file (modify, dateiname);{} to line (f, 1);{} show (w, f){}END PROC show;{}PROC loesche rechte spalten (WINDOW VAR w):{}
- INT VAR i;{} FOR i FROM 1 UPTO areaysize (w.fenster) REP{} cursor (w, areaxsize (w.fenster) - 2, i); out (3 * blank){} PER{}END PROC loesche rechte spalten;{}BOOL PROC no (WINDOW VAR w, TEXT CONST frage):{} NOT yes (w, frage){}END PROC no;{}PROC stop (WINDOW VAR w):{} stop (w, 2){}END PROC stop;{}PROC stop (WINDOW VAR w, INT CONST zeilenzahl):{} INT VAR i; FOR i FROM 1 UPTO zeilenzahl REP line (w) PER;{} out (w, aussage [3]);{} pause{}END PROC stop;{}AREA PROC area (WINDOW CONST w):{}
- w.fenster{}END PROC area;{}INT PROC areax (WINDOW CONST w):{} areax (w.fenster){}END PROC areax;{}INT PROC areay (WINDOW CONST w):{} areay (w.fenster){}END PROC areay;{}INT PROC areaxsize (WINDOW CONST w):{} areaxsize (w.fenster){}END PROC areaxsize;{}INT PROC areaysize (WINDOW CONST w):{} areaysize (w.fenster){}END PROC areaysize;{}END PACKET ls dialog 3;{}
+PACKET ls dialog 3 DEFINES
+ WINDOW, :=, window,
+ show, page, erase,
+ line, remaining lines,
+ cursor, get cursor,
+ out frame, out menuframe,
+ out, put, putline, editget,
+ get, getline, yes, no,
+ edit, center, stop,
+ area, areax, areay,
+ areaxsize, areaysize:
+LET piep = ""7"",
+ cr = ""13"";
+LET janeinkette = "jJyYnN",
+ blank = " ",
+ niltext = "";
+TYPE WINDOW = STRUCT (AREA fenster,
+
+ INT cspalte, czeile, belegbare zeilen,
+ BOOL fensterende erreicht);
+ROW 3 TEXT CONST aussage :: ROW 3 TEXT : (
+ " 'Window' ungültig!",
+ " (j/n) ?",
+ " Zum Weitermachen bitte irgendeine Taste tippen!"
+ );
+TEXT VAR number word, exit char;
+OP := (WINDOW VAR links, WINDOW CONST rechts):
+ CONCR (links) := CONCR (rechts)
+END OP :=;
+WINDOW PROC window (INT CONST x, y, xsize, ysize):
+ WINDOW VAR w;
+ fill (w.fenster, x, y, xsize, ysize);
+ IF fenster ungueltig (w)
+
+ THEN errorstop (aussage [1])
+ FI;
+ initialize (w);
+ w
+END PROC window;
+PROC initialize (WINDOW VAR w):
+ w.czeile := 1;
+ w.cspalte := 1;
+ w.fensterende erreicht := FALSE;
+ w.belegbare zeilen := areaysize (w.fenster)
+END PROC initialize;
+BOOL PROC fenster ungueltig (WINDOW CONST w):
+ IF areax (w.fenster) < 1 COR areax (w.fenster) > 79
+ COR areay (w.fenster) < 1 COR areay (w.fenster) > 24
+ COR areaxsize (w.fenster) < 6 COR areaysize (w.fenster) < 3
+
+ COR areax (w.fenster) + areaxsize (w.fenster) > 80
+ COR areay (w.fenster) + areaysize (w.fenster) > 25
+ THEN TRUE
+ ELSE FALSE
+ FI.
+END PROC fenster ungueltig;
+PROC show (WINDOW VAR w):
+ zeige rahmen;
+ fenster putzen.
+ zeige rahmen:
+ out frame (w.fenster).
+ fenster putzen:
+ page (w).
+END PROC show;
+PROC page (WINDOW VAR w):
+ initialize (w);
+ page (w, FALSE)
+END PROC page;
+PROC page (WINDOW CONST w, BOOL CONST mit rahmen ):
+ IF areax (w) = 1 AND areay (w) = 1 AND
+
+ areaxsize (w) = 79 AND areaysize (w) = 24
+ THEN page;
+ ELSE loesche bereich
+ FI.
+ loesche bereich:
+ IF mit rahmen
+ THEN page (areax (w) - 1, areay (w) - 1,
+ areaxsize (w) + 2, areaysize (w) + 2)
+ ELSE page (area (w))
+ FI
+END PROC page;
+PROC erase (WINDOW VAR w):
+ page (w, TRUE)
+END PROC erase;
+PROC line (WINDOW VAR w):
+ w.cspalte := 1;
+ IF w.czeile < w.belegbare zeilen
+ THEN w.czeile INCR 1;
+ ELSE w.czeile := 1;
+
+ w.fensterende erreicht := TRUE
+ FI;
+ cursor (w, w.cspalte, w.czeile)
+END PROC line;
+PROC line (WINDOW VAR w, INT CONST anzahl):
+ INT VAR i; FOR i FROM 1 UPTO anzahl REP line (w) PER
+END PROC line;
+INT PROC remaining lines (WINDOW CONST w):
+ INT VAR spalte, zeile;
+ get cursor (w, spalte, zeile);
+ IF spalte = 0 OR zeile = 0
+ THEN 0
+ ELSE w.belegbare zeilen - w.czeile
+ FI
+END PROC remaining lines;
+PROC cursor (WINDOW VAR w, INT CONST spalte, zeile):
+ IF spalte < 1 OR zeile < 1 OR spalte > areaxsize (w) OR zeile > areaysize (w)
+
+ THEN page (w);
+ ELSE w.cspalte := spalte; w.czeile := zeile;
+ FI;
+ cursor (w.fenster, w.cspalte, w.czeile)
+END PROC cursor;
+PROC get cursor (WINDOW CONST w, INT VAR spalte, zeile):
+ IF (w.cspalte < 1) OR (w.cspalte > areaxsize (w.fenster))
+ OR
+ (w.czeile < 1) OR (w.czeile > areaysize (w.fenster))
+ THEN spalte := 0; zeile := 0
+ ELSE spalte := w.cspalte; zeile := w.czeile
+ FI
+END PROC get cursor;
+PROC out (WINDOW VAR w, TEXT CONST text):
+
+ INT VAR restlaenge;
+ IF (w.cspalte >= 1) AND (w.cspalte <= areaxsize (w.fenster))
+ AND
+ (w.czeile >= 1) AND (w.czeile <= w.belegbare zeilen)
+ THEN putze ggf fenster;
+ cursor (w.fenster, w.cspalte, w.czeile);
+ outtext (text, 1, textende);
+ setze fenstercursor neu;
+ setze ausgabe ggf in naechster zeile fort
+ FI.
+ putze ggf fenster:
+ IF w.fensterende erreicht
+ THEN page (w);
+ w.fensterende erreicht := FALSE
+
+ FI.
+ textende:
+ restlaenge := areaxsize (w.fenster) - w.cspalte + 1;
+ min (length (text), restlaenge).
+ setze fenstercursor neu:
+ IF length (text) >= restlaenge
+ THEN w.cspalte := 1;
+ w.czeile INCR 1;
+ schlage ggf neue seite auf
+ ELSE w.cspalte INCR length (text)
+ FI.
+ schlage ggf neue seite auf:
+ IF w.czeile > w.belegbare zeilen
+ THEN page (w);
+ w.czeile := 1
+ FI.
+ setze ausgabe ggf in naechster zeile fort:
+
+ IF length (text) > restlaenge
+ THEN out (w, subtext (text, restlaenge + 1))
+ FI.
+END PROC out;
+PROC out frame (WINDOW VAR w):
+ out frame (area (w))
+END PROC out frame;
+PROC out menuframe (WINDOW VAR w):
+ out menu frame (area (w))
+END PROC out menuframe;
+PROC put (WINDOW VAR w, TEXT CONST word):
+ out (w, word); out (w, blank)
+END PROC put;
+PROC put (WINDOW VAR w, INT CONST number):
+ put (w, text (number))
+END PROC put;
+PROC put (WINDOW VAR w, REAL VAR number):
+ put (w, text (number))
+
+END PROC put;
+PROC putline (WINDOW VAR w, TEXT CONST textline):
+ out (w, textline); line (w)
+END PROC putline;
+PROC editget (WINDOW VAR w, TEXT VAR ausgabe,
+ INT CONST max laenge, scroll,
+ TEXT CONST sep, res, TEXT VAR exit char):
+ INT VAR spalte, zeile;
+ ggf zur naechsten zeile;
+ get cursor (spalte, zeile); cursor on; cursor (spalte, zeile);
+ editget (ausgabe, max laenge, min (scroll, restlaenge),
+ sep, res, exitchar);
+ get cursor (spalte, zeile); cursor off; cursor (spalte, zeile).
+
+ ggf zur naechsten zeile:
+ IF restlaenge < 5 THEN line (w) FI.
+ restlaenge:
+ areaxsize (w.fenster) - w.cspalte - 1.
+END PROC editget;
+PROC editget (WINDOW VAR w, TEXT VAR ausgabe):
+ TEXT VAR dummy;
+ editget (w, ausgabe, 79, 79, "", "", dummy)
+END PROC editget;
+PROC get (WINDOW VAR w, TEXT VAR word):
+ INT VAR spa, zei;
+ ggf zur naechsten zeile;
+ get cursor (spa, zei); cursor on; cursor (spa, zei);
+ REP
+ word := "";
+ editget (word, maxtextlength, restlaenge, " ", "", exit char);
+
+ out (w, subtext (word, 1, restlaenge));
+ IF compress (word) <> ""
+ THEN echoe exit char (w)
+ FI
+ UNTIL word <> niltext AND word <> blank PER;
+ get cursor (spa, zei); cursor off; cursor (spa, zei);
+ delete leading blanks.
+ ggf zur naechsten zeile:
+ IF restlaenge < 5 THEN line (w) FI.
+ restlaenge:
+ areaxsize (w.fenster) - w.cspalte - 1.
+ delete leading blanks:
+ WHILE (word SUB 1) = blank REP word := subtext (word, 2) PER.
+END PROC get;
+PROC get (WINDOW VAR w, TEXT VAR word, TEXT CONST separator):
+
+ INT VAR spa, zei;
+ ggf zur naechsten zeile;
+ get cursor (spa, zei); cursor on; cursor (spa, zei);
+ REP
+ word := "";
+ editget (word, maxtextlength, restlaenge, separator, "", exit char);
+ out (w, subtext (word, 1, restlaenge));
+ echoe exit char (w);
+ UNTIL word <> niltext AND word <> blank PER;
+ get cursor (spa, zei); cursor off; cursor (spa, zei).
+ ggf zur naechsten zeile:
+ IF restlaenge < 5 THEN line (w) FI.
+ restlaenge:
+ areaxsize (w.fenster) - w.cspalte - 1.
+
+END PROC get;
+PROC get (WINDOW VAR w, TEXT VAR word, INT CONST length):
+ INT VAR spa, zei;
+ ggf zur naechsten zeile;
+ get cursor (spa, zei); cursor on; cursor (spa, zei);
+ REP
+ word := "";
+ editget (word, maxtextlength, laenge, "", "", exit char);
+ out (w, subtext (word, 1, laenge));
+ echoe exit char (w)
+ UNTIL word <> niltext AND word <> blank PER;
+ get cursor (spa, zei); cursor off; cursor (spa, zei).
+ ggf zur naechsten zeile:
+ IF restlaenge < 5 THEN line (w) FI.
+
+ restlaenge:
+ areaxsize (w.fenster) - w.cspalte - 1.
+ laenge:
+ min (length, restlaenge).
+END PROC get;
+PROC get (WINDOW VAR w, INT VAR number):
+ get (w, number word);
+ number := int (number word)
+END PROC get;
+PROC get (WINDOW VAR w, REAL VAR number):
+ get (w, number word);
+ number := real (number word)
+END PROC get;
+PROC getline (WINDOW VAR w, TEXT VAR textline):
+ INT VAR spa, zei;
+ ggf zur naechsten zeile;
+ get cursor (spa, zei); cursor on; cursor (spa, zei);
+ REP
+
+ textline := "";
+ editget (textline, maxtextlength, restlaenge, "", "", exit char);
+ out (w, subtext (word, 1, restlaenge));
+ echoe exit char (w);
+ UNTIL textline <> niltext AND textline <> blank PER;
+ get cursor (spa, zei); cursor off; cursor (spa, zei).
+ ggf zur naechsten zeile:
+ IF restlaenge < 5 THEN line (w) FI.
+ restlaenge:
+ areaxsize (w.fenster) - w.cspalte - 1.
+END PROC getline;
+PROC echoe exit char (WINDOW VAR fenster):
+ IF exit char = cr
+ THEN line (fenster)
+
+ ELSE out (fenster, exit char)
+ FI
+END PROC echoe exit char;
+TEXT PROC center (WINDOW CONST w, TEXT CONST text):
+ IF length (text) >= areaxsize (w.fenster)
+ THEN subtext (text, 1, areaxsize (w.fenster))
+ ELSE center (areaxsize (w.fenster), text)
+ FI
+END PROC center;
+BOOL PROC yes (WINDOW VAR w, TEXT CONST frage):
+ TEXT VAR zeichen, interne frage :: frage;
+ interne frage CAT aussage [2];
+ wechsel ggf auf neue seite;
+ out (w, interne frage);
+ hole eingabezeichen;
+
+ werte zeichen aus.
+ wechsel ggf auf neue seite:
+ IF remaining lines (w) < 1
+ THEN page (w)
+ FI.
+ hole eingabezeichen:
+ cursor on; clear buffer;
+ REP
+ inchar (zeichen);
+ piepse ggf
+ UNTIL pos (janeinkette, zeichen) > 0 PER;
+ out (w, blank + zeichen);
+ cursor off; line (w).
+ piepse ggf:
+ IF pos (janeinkette, zeichen) = 0 THEN out (piep) FI.
+ werte zeichen aus:
+ IF pos (janeinkette, zeichen) < 5
+ THEN TRUE
+ ELSE FALSE
+ FI.
+
+END PROC yes;
+PROC edit (WINDOW VAR w, FILE VAR f):
+ out frame (w.fenster);
+ loesche rechte spalten (w);
+ cursor on;
+ edit (f, areax (w.fenster), areay (w.fenster),
+ areaxsize (w.fenster) - 1, areaysize (w.fenster));
+ cursor off
+END PROC edit;
+PROC edit (WINDOW VAR w, TEXT CONST dateiname):
+ FILE VAR f :: sequential file (modify, dateiname);
+ to line (f, 1);
+ edit (w, f)
+END PROC edit;
+PROC show (WINDOW VAR w, FILE VAR f):
+ out frame (w.fenster);
+ loesche rechte spalten (w);
+
+ open editor (groesster editor + 1, f, FALSE,
+ areax (w.fenster), areay (w.fenster),
+ areaxsize (w.fenster) - 1, areaysize (w.fenster));
+ cursor on;
+ edit (groesster editor, "eqvw19dpgn"9"",
+ PROC (TEXT CONST) std kommando interpreter);
+ cursor off
+END PROC show;
+PROC show (WINDOW VAR w, TEXT CONST dateiname):
+ FILE VAR f :: sequential file (modify, dateiname);
+ to line (f, 1);
+ show (w, f)
+END PROC show;
+PROC loesche rechte spalten (WINDOW VAR w):
+
+ INT VAR i;
+ FOR i FROM 1 UPTO areaysize (w.fenster) REP
+ cursor (w, areaxsize (w.fenster) - 2, i); out (3 * blank)
+ PER
+END PROC loesche rechte spalten;
+BOOL PROC no (WINDOW VAR w, TEXT CONST frage):
+ NOT yes (w, frage)
+END PROC no;
+PROC stop (WINDOW VAR w):
+ stop (w, 2)
+END PROC stop;
+PROC stop (WINDOW VAR w, INT CONST zeilenzahl):
+ INT VAR i; FOR i FROM 1 UPTO zeilenzahl REP line (w) PER;
+ out (w, aussage [3]);
+ pause
+END PROC stop;
+AREA PROC area (WINDOW CONST w):
+
+ w.fenster
+END PROC area;
+INT PROC areax (WINDOW CONST w):
+ areax (w.fenster)
+END PROC areax;
+INT PROC areay (WINDOW CONST w):
+ areay (w.fenster)
+END PROC areay;
+INT PROC areaxsize (WINDOW CONST w):
+ areaxsize (w.fenster)
+END PROC areaxsize;
+INT PROC areaysize (WINDOW CONST w):
+ areaysize (w.fenster)
+END PROC areaysize;
+END PACKET ls dialog 3;
+
diff --git a/dialog/ls-DIALOG 4 b/dialog/ls-DIALOG 4
index 7c9d9c4..e1d38c4 100644
--- a/dialog/ls-DIALOG 4
+++ b/dialog/ls-DIALOG 4
@@ -22,50 +22,720 @@
*)
-PACKET ls dialog 4 DEFINES{} boxinfo,{} boxnotice,{} boxalternative,{} boxyes,{} boxno,{} boxanswer,{} boxone,{} boxanswerone,{} boxsome,{} boxanswersome,{} out footnote,{} erase footnote:{}LET mark ein = ""15"",{} mark aus = ""14"",{} delimiter = ""13"",{} piep = ""7"",{} rechts links esc return = ""2""8""27""13"",{}
- rechts links null return = ""2""8""0""13"" ,{} blank = " ",{} niltext = "",{} janeintasten = "jJyYnN";{}ROW 8 TEXT CONST aussage :: ROW 8 TEXT : ({}" Zum Weitermachen bitte irgendeine Taste tippen!",{}" Ändern: <Pfeile> Bestätigen: <RETURN> Abbruch: <ESC> <h>",{}" Ändern: <Pfeile> Bestätigen: <RETURN> Ja: <j> Nein: <n>",{}" Ändern: <Pfeile> Bestätigen: <RETURN>",{}" Fertig: <RETURN> Zeigen: <ESC><z> Abbruch: <ESC><h>",{}
-" Fertig: <RETURN> Abbruch: <ESC><h>",{}"Ja"13"Nein",{}" Eingabe: "{});{}PROC boxinfo (WINDOW VAR w, TEXT CONST t,{} INT CONST position, timelimit,{} INT VAR x, y, xsize, ysize):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} schreibe box (w, t, position, timelimit, x, y, xsize, ysize);{} cursor (w, spa, zei);{}END PROC boxinfo;{}PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position,{} timelimit, BOOL CONST trennlinie weg):{} INT VAR x, y, xsize, ysize, spa, zei;{}
- get cursor (w, spa, zei);{} schreibe box (w, t, position, timelimit, x, y, xsize, ysize);{} page up (x, y, xsize, ysize);{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI;{} cursor (w, spa, zei){}END PROC boxinfo;{}PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position, timelimit):{} boxinfo (w, t, position, timelimit, TRUE){}END PROC boxinfo;{}PROC boxinfo (WINDOW VAR w, TEXT CONST t):{} boxinfo (w, t, 5, maxint, TRUE){}END PROC boxinfo;{}
-PROC boxnotice (WINDOW VAR w, TEXT CONST t, INT CONST position,{} INT VAR x, y, xsize, ysize):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} schreibe notiz (w, t, position, x, y, xsize, ysize);{} cursor (w, spa, zei){}END PROC boxnotice;{}INT PROC boxalternative (WINDOW VAR w, TEXT CONST t,{} auswahlliste, zusatztasten,{} INT CONST position, BOOL CONST mit abbruch,{} INT VAR x, y, xsize, ysize):{}
- INT VAR ergebnis, spa, zei;{} get cursor (w, spa, zei);{} schreibe alternativen (w, t, auswahlliste, zusatztasten, position,{} mit abbruch, x, y, xsize, ysize, ergebnis);{} cursor (w, spa, zei);{} ergebnis{}END PROC boxalternative;{}INT PROC boxalternative (WINDOW VAR w, TEXT CONST t, auswahlliste,{} zusatztasten, INT CONST position,{} BOOL CONST mit abbruch, trennlinie weg):{} INT VAR x, y, xsize, ysize, ergebnis, spa, zei;{}
- get cursor (w, spa, zei);{} ergebnis := boxalternative (w, t, auswahlliste, zusatztasten, position,{} mit abbruch, x, y, xsize, ysize);{} page up (x, y, xsize, ysize);{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI;{} cursor (w, spa, zei);{} ergebnis{}END PROC boxalternative;{}INT PROC boxalternative (WINDOW VAR w, TEXT CONST t,{} auswahlliste, zusatztasten,{} INT CONST position, BOOL CONST mit abbruch):{}
- boxalternative (w, t, auswahlliste, zusatztasten,{} position, mit abbruch, TRUE){}END PROC boxalternative;{}BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position,{} INT VAR x, y, xsize, ysize):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} BOOL CONST wert :: ja (w, t, position, x, y, xsize, ysize);{} cursor (w, spa, zei);{} wert{}END PROC boxyes;{}BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t,{} INT CONST position, BOOL CONST trennlinie weg):{}
- INT VAR x, y, xsize, ysize, spa, zei;{} get cursor (w, spa, zei);{} BOOL VAR wert :: ja (w, t, position, x, y, xsize, ysize);{} page up (x, y, xsize, ysize);{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE);{} FI;{} cursor (w, spa, zei);{} wert{}END PROC boxyes;{}BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position):{} boxyes (w, t, position, TRUE){}END PROC boxyes;{}BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position,{}
- INT VAR x, y, xsize, ysize):{} NOT boxyes (w, t, position, x, y, xsize, ysize){}END PROC boxno;{}BOOL PROC boxno (WINDOW VAR w, TEXT CONST t,{} INT CONST position, BOOL CONST trennlinie weg):{} NOT boxyes (w, t, position, trennlinie weg){}END PROC boxno;{}BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position):{} boxno (w, t, position){}END PROC boxno;{}TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,{} INT CONST position, INT VAR x, y, xsize, ysize):{}
- INT VAR spa, zei;{} TEXT VAR wert;{} get cursor (w, spa, zei);{} wert := hole antwort (w, t, vorgabe, position, FALSE, x, y, xsize, ysize);{} cursor (spa, zei);{} wert{}END PROC boxanswer;{}TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,{} INT CONST position, BOOL CONST trennlinie weg):{} INT VAR x, y, xsize, ysize, spa, zei;{} get cursor (w, spa, zei);{} TEXT VAR wert := hole antwort (w, t, vorgabe, position, FALSE,{} x, y, xsize, ysize);{}
- page up (x, y, xsize, ysize);{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI;{} cursor (w, spa, zei);{} wert{}END PROC boxanswer;{}TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,{} INT CONST position):{} boxanswer (w, t, vorgabe, position, TRUE){}END PROC boxanswer;{}TEXT PROC boxone (WINDOW VAR w, THESAURUS CONST thesaurus,{} TEXT CONST text1, text2, BOOL CONST mit reinigung):{}
- INT VAR spa, zei;{} get cursor (w, spa, zei);{} TEXT VAR wert :: one (areax (w) + 2, areay (w) + 2,{} areaxsize (w) - 4, areaysize (w) - 2,{} thesaurus, text1, text2);{} IF mit reinigung{} THEN page up (areax (w) + 2, areay (w) + 2,{} areaxsize (w) - 4, areaysize (w) - 2);{} erase footnote (w){} FI;{} cursor (w, spa, zei);{} wert{}END PROC boxone;{}TEXT PROC boxanswerone (WINDOW VAR w, TEXT CONST text, vorgabe,{}
- THESAURUS CONST thesaurus, TEXT CONST t1, t2,{} BOOL CONST mit reinigung, trennlinie weg):{} INT VAR x,y, xsize, ysize, spa, zei;{} get cursor (w, spa, zei);{} TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE,{} x, y, xsize, ysize);{} IF wert = ""27"z"{} THEN lasse auswaehlen{} ELSE uebernimm den wert{} FI;{} cursor (w, spa, zei);{} wert.{} lasse auswaehlen:{} IF mit reinigung{} THEN wert := boxone (w, thesaurus, t1, t2, TRUE ){}
- ELSE wert := boxone (w, thesaurus, t1, t2, FALSE){} FI.{} uebernimm den wert:{} IF mit reinigung{} THEN page up (x, y, xsize, ysize);{} entferne ggf die trennlinie{} FI.{} entferne ggf die trennlinie:{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI.{}END PROC boxanswer one;{}TEXT PROC boxanswerone (WINDOW VAR w, TEXT CONST text, vorgabe,{} THESAURUS CONST thesaurus, TEXT CONST t1, t2,{}
- BOOL CONST mit reinigung):{} boxanswerone (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE){}END PROC boxanswer one;{}THESAURUS PROC boxsome (WINDOW VAR w, THESAURUS CONST thesaurus,{} TEXT CONST text1, text2,{} BOOL CONST mit reinigung):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} THESAURUS VAR wert :: some (areax (w) + 2, areay (w) + 2,{} areaxsize (w) - 4, areaysize (w) - 2,{}
- thesaurus, text1, text2);{} IF mit reinigung{} THEN page up (areax (w) + 2, areay (w) + 2,{} areaxsize (w) - 4, areaysize (w) - 2);{} erase footnote (w){} FI;{} cursor (w, spa, zei);{} wert{}END PROC boxsome;{}THESAURUS PROC boxanswersome (WINDOW VAR w, TEXT CONST text, vorgabe,{} THESAURUS CONST thesaurus,{} TEXT CONST t1, t2,{} BOOL CONST mit reinigung, trennlinie weg):{}
- THESAURUS VAR ergebnis :: empty thesaurus;{} INT VAR x, y, xsize, ysize, spa, zei;{} get cursor (w, spa, zei);{} TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE,{} x, y, xsize, ysize);{} IF wert = ""27"z"{} THEN lasse auswaehlen{} ELSE uebernimm den wert{} FI;{} cursor (w, spa, zei);{} ergebnis.{} lasse auswaehlen:{} IF mit reinigung{} THEN ergebnis := boxsome (w, thesaurus, t1, t2, TRUE ){} ELSE ergebnis := boxsome (w, thesaurus, t1, t2, FALSE){}
- FI.{} uebernimm den wert:{} IF wert <> niltext{} THEN insert (ergebnis, wert){} FI;{} IF mit reinigung{} THEN page up (x, y, xsize, ysize);{} entferne ggf die trennlinie{} FI.{} entferne ggf die trennlinie:{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI.{}END PROC boxanswer some;{}THESAURUS PROC boxanswersome (WINDOW VAR w, TEXT CONST text, vorgabe,{} THESAURUS CONST thesaurus,{}
- TEXT CONST t1, t2,{} BOOL CONST mit reinigung):{} boxanswersome (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE){}END PROC boxanswersome;{}PROC out footnote (WINDOW VAR w, BOOL CONST mit trennlinie, TEXT CONST text):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} IF mit trennlinie{} THEN cursor (w, 1, areaysize (w) - 1);{} areaxsize (w) TIMESOUT waagerecht{} FI;{} cursor (w, 1, areaysize (w));{} outtext (text, 1, areaxsize (w));{}
- cursor (w, spa, zei){}END PROC out footnote;{}PROC out footnote (WINDOW VAR w, TEXT CONST t):{} out footnote (w, TRUE, t){}END PROC out footnote;{}PROC erase footnote (WINDOW VAR w, BOOL CONST auch trennlinie):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} IF auch trennlinie{} THEN cursor (w, 1, areaysize (w) - 1);{} outtext ("", 1, areaxsize (w)){} FI;{} cursor (w, 1, areaysize (w));{} outtext ("", 1, areaxsize (w));{} cursor (w, spa, zei){}END PROC erase footnote;{}PROC erase footnote (WINDOW VAR w):{}
- erase footnote (w, TRUE){}END PROC erase footnote;{}PROC schreibe boxtext (WINDOW VAR w, TEXT CONST t,{} INT CONST position, zusatzlaenge,{} mindestbreite, mindesthoehe,{} INT VAR x, y, xsize, ysize):{} ermittle boxbreite und boxhoehe;{} ermittle rahmenwerte;{} schreibe boxkopf;{} schreibe boxrumpf.{} ermittle boxbreite und boxhoehe:{} TEXT VAR intern :: t + delimiter;{} entferne fuehrende delimiter;{} INT VAR anfang :: 1,{}
- ende :: pos (intern, delimiter, anfang) - 1;{} xsize := 0;{} ysize := 0;{} WHILE ende > 0 REP{} ysize INCR 1;{} lege ggf boxbreite fest;{} bestimme neue positionen{} PER.{} entferne fuehrende delimiter:{} WHILE (intern SUB 1) = delimiter REP{} intern := subtext (intern, 2){} PER.{} lege ggf boxbreite fest:{} IF length (subtext (intern, anfang, ende)) > xsize{} THEN xsize := length (subtext (intern, anfang, ende)){} FI.{} bestimme neue positionen:{}
- anfang := ende + 2;{} ende := pos (intern, delimiter, anfang) - 1.{} ermittle rahmenwerte:{} schlage notwendige groessen auf;{} kill ueberlaengen;{} lege bildschirmpositionen fest.{} schlage notwendige groessen auf:{} IF xsize < mindestbreite{} THEN xsize := mindestbreite{} FI;{} IF ysize < mindesthoehe{} THEN ysize := mindesthoehe{} FI;{} ysize INCR zusatzlaenge;{} ysize INCR 2; (* Für den Rahmen *){} xsize INCR 2. (* Für den Rahmen *){} kill ueberlaengen:{}
- IF ysize > (areaysize (w) - 4){} THEN ysize := areaysize (w) - 4{} FI;{} IF xsize > (areaxsize (w) - 4){} THEN xsize := areaxsize (w) - 4{} FI.{} lege bildschirmpositionen fest:{} SELECT position OF{} CASE 1: plazierung links oben{} CASE 2: plazierung rechts oben{} CASE 3: plazierung links unten{} CASE 4: plazierung rechts unten{} OTHERWISE plazierung im zentrum{} END SELECT.{} plazierung links oben:{} x := areax (w) + 2;{} y := areay (w) + 2.{}
- plazierung rechts oben:{} x := areax (w) + areaxsize (w) - xsize - 2;{} y := areay (w) + 2.{} plazierung links unten:{} x := areax (w) + 2;{} y := areay (w) + areaysize (w) - ysize - 2.{} plazierung rechts unten:{} x := areax (w) + areaxsize (w) - xsize - 2;{} y := areay (w) + areaysize (w) - ysize - 2.{} plazierung im zentrum:{} x := areax (w) + ((areaxsize (w) - (xsize + 2)) DIV 2) + 1;{} y := areay (w) + ((areaysize (w) - ysize) DIV 2).{} schreibe boxkopf:{}
- cursor (x, y);{} out (ecke oben links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke oben rechts).{} schreibe boxrumpf:{} INT VAR i;{} intern := t + delimiter;{} entferne fuehrende delimiter;{} anfang := 1;{} ende := pos (intern, delimiter, anfang) - 1;{} FOR i FROM y + 1 UPTO y + ysize - zusatzlaenge - 2 REP{} cursor (x, i);{} out (senkrecht);{} outtext (subtext (intern, anfang, ende), 1, xsize - 2);{} out (senkrecht);{} anfang := ende + 2;{}
- ende := pos (intern, delimiter, anfang) - 1{} PER{}END PROC schreibe boxtext;{}PROC schreibe boxfuss (WINDOW VAR w,{} INT CONST x, y, xsize, ysize, limit):{} schreibe abschlusszeile;{} out footnote (w, aussage [1]);{} cursor in position und warten.{} schreibe abschlusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{} cursor in position und warten:{} cursor parken (w);{}
- clear buffer;{} pause (limit){}END PROC schreibe boxfuss;{}PROC cursor parken (WINDOW VAR w):{} cursor (w, 1, 2){}END PROC cursor parken;{}PROC schreibe box (WINDOW VAR w, TEXT CONST t,{} INT CONST position, timelimit,{} INT VAR x, y, xsize, ysize):{} schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize);{} schreibe boxfuss (w, x, y, xsize, ysize, timelimit){}END PROC schreibe box;{}PROC schreibe notizfuss (WINDOW VAR w, INT CONST x, y, xsize, ysize):{}
- schreibe abschlusszeile;{} cursor parken (w).{} schreibe abschlusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{}END PROC schreibe notizfuss;{}PROC schreibe notiz (WINDOW VAR w, TEXT CONST t, INT CONST position,{} INT VAR x, y, xsize, ysize):{} schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize);{} schreibe notizfuss (w, x, y, xsize, ysize){}END PROC schreibe notiz;{}PROC schreibe alternativen (WINDOW VAR w, TEXT CONST t, altzeile, sonst,{}
- INT CONST position, BOOL CONST mit abbruch,{} INT VAR x, y, xsize, ysize, ergebnis):{} ROW 10 STRUCT (TEXT alternat, INT anfang, laenge) VAR altliste;{} normiere alternativen;{} untersuche alternativen;{} schreibe boxtext (w, textintern, position, 2, altbreite,{} 0, x, y, xsize, ysize);{} schreibe alternativenfuss;{} lasse auswaehlen;{} liefere ergebnis.{} textintern:{} IF sonst = janeintasten{} THEN TEXT VAR zwischen;{}
- zwischen := t;{} kuerze um folgende blanks;{} zwischen + "? "{} ELSE t{} FI.{} kuerze um folgende blanks:{} WHILE (zwischen SUB (length (zwischen))) = blank REP{} zwischen := subtext (zwischen , 1, length (zwischen) - 1){} PER.{} normiere alternativen:{} TEXT VAR altintern :: altzeile;{} altintern CAT delimiter.{} untersuche alternativen:{} INT VAR altanzahl :: 1, altbreite, first :: - 2, anfang :: 1,{} ende :: pos (altintern, delimiter, anfang) - 1;{}
- WHILE ende > 0 AND altanzahl <= 10 REP{} trage alternative ein;{} trage alternativenanfang ein;{} trage alternativenlaenge ein;{} setze neue positionen fest{} PER;{} ermittle gesamtalternativenbreite.{} trage alternative ein:{} altliste [altanzahl].alternat :={} compress (subtext (altintern, anfang, ende)).{} trage alternativenanfang ein:{} first INCR 3;{} altliste [altanzahl].anfang := first.{} trage alternativenlaenge ein:{}
- altliste [altanzahl].laenge := length (altliste [altanzahl].alternat);{} first INCR altliste [altanzahl].laenge.{} setze neue positionen fest:{} anfang := ende + 2;{} ende := pos (altintern, delimiter, anfang) - 1;{} altanzahl INCR 1.{} ermittle gesamtalternativenbreite:{} altanzahl DECR 1;{} altbreite := altliste [altanzahl].anfang;{} altbreite INCR (altliste [altanzahl].laenge + 3);{} IF altbreite > areaxsize (w) - 6{} THEN LEAVE schreibe alternativen{}
- FI.{} schreibe alternativenfuss:{} schreibe leerzeile;{} schreibe antwortmoeglichkeiten;{} schreibe abschlusszeile;{} IF mit abbruch{} THEN out footnote (w, aussage [2]){} ELSE beruecksichtige ja nein hinweis{} FI.{} schreibe leerzeile:{} cursor (x, y + ysize - 3);{} out (senkrecht);{} (xsize - 2) TIMESOUT blank;{} out (senkrecht).{} schreibe antwortmoeglichkeiten:{} cursor (x, y + ysize - 2);{} out (senkrecht);{} einrueckbreite TIMESOUT blank;{}
- out (antwortleiste);{} rest TIMESOUT blank;{} out (senkrecht).{} einrueckbreite:{} (xsize - 2 - length (antwortleiste)) DIV 2.{} antwortleiste:{} INT VAR zeiger; TEXT VAR ausgabe :: "";{} FOR zeiger FROM 1 UPTO altanzahl REP{} ausgabe CAT altliste [zeiger].alternat;{} ausgabe CAT " "{} PER;{} compress (ausgabe).{} rest:{} xsize - 2 - einrueckbreite - length (antwortleiste).{} schreibe abschlusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{}
- (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{} beruecksichtige ja nein hinweis:{} IF sonst = janeintasten{} THEN out footnote (w, aussage [3]){} ELSE out footnote (w, aussage [4]){} FI.{} lasse auswaehlen:{} INT VAR altzeiger :: 1;{} stelle erste alternative invers dar;{} REP{} hole eingabe;{} werte eingabe aus und reagiere{} UNTIL alternative gefunden PER.{} stelle erste alternative invers dar:{} cursor (x + einrueckbreite, y + ysize - 2);{}
- out (mark ein);{} out (altliste [altzeiger].alternat); out (blank);{} out (mark aus);{} cursor (x + einrueckbreite, y + ysize - 2).{} hole eingabe:{} TEXT VAR moegliche, eingabe;{} IF mit abbruch{} THEN moegliche := rechts links esc return + sonst{} ELSE moegliche := rechts links null return + sonst{} FI;{} clear buffer;{} REP{} inchar (eingabe);{} piepse bei unzulaessiger eingabe{} UNTIL pos (moegliche, eingabe) > 0 PER.{} piepse bei unzulaessiger eingabe:{}
- IF pos (moegliche, eingabe) = 0 THEN out (piep) FI.{} werte eingabe aus und reagiere:{} SELECT pos (moegliche, eingabe) OF{} CASE 1: zur naechsten alternative{} CASE 2: zur vorausgehenden alternative{} CASE 3: esc kommando verarbeiten{} END SELECT.{} zur naechsten alternative:{} loesche aktuelle alternative;{} ermittle rechte alternative;{} stelle neue alternative invers dar.{} zur vorausgehenden alternative:{} loesche aktuelle alternative;{} ermittle linke alternative;{}
- stelle neue alternative invers dar.{} loesche aktuelle alternative:{} cursor (alternativenanfang - 1, y + ysize - 2);{} out (blank);{} out (altliste [altzeiger].alternat);{} out (2 * blank).{} alternativenanfang:{} x + einrueckbreite + altliste [altzeiger].anfang.{} ermittle rechte alternative:{} IF altzeiger = altanzahl{} THEN altzeiger := 1{} ELSE altzeiger INCR 1{} FI.{} ermittle linke alternative:{} IF altzeiger = 1{} THEN altzeiger := altanzahl{}
- ELSE altzeiger DECR 1{} FI.{} stelle neue alternative invers dar:{} cursor (alternativenanfang - 1, y + ysize - 2);{} out (mark ein);{} out (altliste [altzeiger].alternat); out (blank);{} out (mark aus);{} cursor (alternativenanfang - 1, y + ysize - 2).{} esc kommando verarbeiten:{} inchar (eingabe);{} IF eingabe = "h"{} THEN ergebnis := 0;{} LEAVE schreibe alternativen{} ELSE out (piep); eingabe := ""{} FI.{} alternative gefunden:{} pos (moegliche, eingabe) > 3.{}
- liefere ergebnis:{} IF pos (moegliche, eingabe) = 4{} THEN ergebnis := altzeiger{} ELSE ergebnis := 100 + pos (sonst, eingabe){} FI.{}END PROC schreibe alternativen;{}BOOL PROC ja (WINDOW VAR w, TEXT CONST t, INT CONST position,{} INT VAR x, y, xsize, ysize):{} INT VAR ergebnis;{} schreibe alternativen (w, t, aussage [7], janeintasten, position,{} FALSE, x, y, xsize, ysize, ergebnis);{} SELECT ergebnis OF{} CASE 2, 105, 106: FALSE{} OTHERWISE TRUE{}
- END SELECT.{}END PROC ja;{}TEXT PROC hole antwort (WINDOW VAR w, TEXT CONST t, vorgabe,{} INT CONST position, BOOL CONST mit auswahl,{} INT VAR x, y, xsize, ysize):{} TEXT VAR eingabe :: compress (vorgabe);{} schreibe boxtext (w, t, position, 2, length (aussage [8]) + 12, 2,{} x, y, xsize, ysize);{} schreibe antwortfuss;{} clear buffer;{} REP{} IF eingabe = "break"{} THEN eingabe := ""{} FI;{} lasse eintragen{}
- UNTIL eingabe <> "break" PER;{} liefere ergebnis.{} schreibe antwortfuss:{} schreibe leerzeile;{} schreibe eingabezeile;{} schreibe abschlusszeile;{} IF mit auswahl{} THEN out footnote (w, aussage [5]){} ELSE out footnote (w, aussage [6]){} FI.{} schreibe leerzeile:{} cursor (x, y + ysize - 3);{} out (senkrecht);{} (xsize - 2) TIMESOUT blank;{} out (senkrecht).{} schreibe eingabezeile:{} cursor (x, y + ysize - 2);{} out (senkrecht);{} out (aussage [8]);{}
- (xsize - 2 - length (aussage [8])) TIMESOUT blank;{} out (senkrecht).{} schreibe abschlusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{} lasse eintragen:{} TEXT VAR exit :: "";{} cursor on;{} cursor (x + length (aussage [8]) + 1, y + ysize - 2);{} IF mit auswahl{} THEN editget (eingabe, maxtextlength, textlaenge, "", "hz", exit){} ELSE editget (eingabe, maxtextlength, textlaenge, "", "h", exit){}
- FI;{} cursor off;{} IF exit = ""27"h"{} THEN eingabe := ""{} ELIF mit auswahl AND (exit = ""27"z"){} THEN eingabe := ""27"z"{} ELSE eingabe := compress (eingabe){} FI.{} textlaenge:{} xsize - 2 - length (aussage [8]).{} liefere ergebnis:{} eingabe.{}END PROC hole antwort;{}END PACKET ls dialog 4;{}
+PACKET ls dialog 4 DEFINES
+ boxinfo,
+ boxnotice,
+ boxalternative,
+ boxyes,
+ boxno,
+ boxanswer,
+ boxone,
+ boxanswerone,
+ boxsome,
+ boxanswersome,
+ out footnote,
+ erase footnote:
+LET mark ein = ""15"",
+ mark aus = ""14"",
+ delimiter = ""13"",
+ piep = ""7"",
+ rechts links esc return = ""2""8""27""13"",
+
+ rechts links null return = ""2""8""0""13"" ,
+ blank = " ",
+ niltext = "",
+ janeintasten = "jJyYnN";
+ROW 8 TEXT CONST aussage :: ROW 8 TEXT : (
+" Zum Weitermachen bitte irgendeine Taste tippen!",
+" Ändern: <Pfeile> Bestätigen: <RETURN> Abbruch: <ESC> <h>",
+" Ändern: <Pfeile> Bestätigen: <RETURN> Ja: <j> Nein: <n>",
+" Ändern: <Pfeile> Bestätigen: <RETURN>",
+" Fertig: <RETURN> Zeigen: <ESC><z> Abbruch: <ESC><h>",
+
+" Fertig: <RETURN> Abbruch: <ESC><h>",
+"Ja"13"Nein",
+" Eingabe: "
+);
+PROC boxinfo (WINDOW VAR w, TEXT CONST t,
+ INT CONST position, timelimit,
+ INT VAR x, y, xsize, ysize):
+ INT VAR spa, zei;
+ get cursor (w, spa, zei);
+ schreibe box (w, t, position, timelimit, x, y, xsize, ysize);
+ cursor (w, spa, zei);
+END PROC boxinfo;
+PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position,
+ timelimit, BOOL CONST trennlinie weg):
+ INT VAR x, y, xsize, ysize, spa, zei;
+
+ get cursor (w, spa, zei);
+ schreibe box (w, t, position, timelimit, x, y, xsize, ysize);
+ page up (x, y, xsize, ysize);
+ IF trennlinie weg
+ THEN erase footnote (w, TRUE)
+ ELSE erase footnote (w, FALSE)
+ FI;
+ cursor (w, spa, zei)
+END PROC boxinfo;
+PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position, timelimit):
+ boxinfo (w, t, position, timelimit, TRUE)
+END PROC boxinfo;
+PROC boxinfo (WINDOW VAR w, TEXT CONST t):
+ boxinfo (w, t, 5, maxint, TRUE)
+END PROC boxinfo;
+
+PROC boxnotice (WINDOW VAR w, TEXT CONST t, INT CONST position,
+ INT VAR x, y, xsize, ysize):
+ INT VAR spa, zei;
+ get cursor (w, spa, zei);
+ schreibe notiz (w, t, position, x, y, xsize, ysize);
+ cursor (w, spa, zei)
+END PROC boxnotice;
+INT PROC boxalternative (WINDOW VAR w, TEXT CONST t,
+ auswahlliste, zusatztasten,
+ INT CONST position, BOOL CONST mit abbruch,
+ INT VAR x, y, xsize, ysize):
+
+ INT VAR ergebnis, spa, zei;
+ get cursor (w, spa, zei);
+ schreibe alternativen (w, t, auswahlliste, zusatztasten, position,
+ mit abbruch, x, y, xsize, ysize, ergebnis);
+ cursor (w, spa, zei);
+ ergebnis
+END PROC boxalternative;
+INT PROC boxalternative (WINDOW VAR w, TEXT CONST t, auswahlliste,
+ zusatztasten, INT CONST position,
+ BOOL CONST mit abbruch, trennlinie weg):
+ INT VAR x, y, xsize, ysize, ergebnis, spa, zei;
+
+ get cursor (w, spa, zei);
+ ergebnis := boxalternative (w, t, auswahlliste, zusatztasten, position,
+ mit abbruch, x, y, xsize, ysize);
+ page up (x, y, xsize, ysize);
+ IF trennlinie weg
+ THEN erase footnote (w, TRUE)
+ ELSE erase footnote (w, FALSE)
+ FI;
+ cursor (w, spa, zei);
+ ergebnis
+END PROC boxalternative;
+INT PROC boxalternative (WINDOW VAR w, TEXT CONST t,
+ auswahlliste, zusatztasten,
+ INT CONST position, BOOL CONST mit abbruch):
+
+ boxalternative (w, t, auswahlliste, zusatztasten,
+ position, mit abbruch, TRUE)
+END PROC boxalternative;
+BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position,
+ INT VAR x, y, xsize, ysize):
+ INT VAR spa, zei;
+ get cursor (w, spa, zei);
+ BOOL CONST wert :: ja (w, t, position, x, y, xsize, ysize);
+ cursor (w, spa, zei);
+ wert
+END PROC boxyes;
+BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t,
+ INT CONST position, BOOL CONST trennlinie weg):
+
+ INT VAR x, y, xsize, ysize, spa, zei;
+ get cursor (w, spa, zei);
+ BOOL VAR wert :: ja (w, t, position, x, y, xsize, ysize);
+ page up (x, y, xsize, ysize);
+ IF trennlinie weg
+ THEN erase footnote (w, TRUE)
+ ELSE erase footnote (w, FALSE);
+ FI;
+ cursor (w, spa, zei);
+ wert
+END PROC boxyes;
+BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position):
+ boxyes (w, t, position, TRUE)
+END PROC boxyes;
+BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position,
+
+ INT VAR x, y, xsize, ysize):
+ NOT boxyes (w, t, position, x, y, xsize, ysize)
+END PROC boxno;
+BOOL PROC boxno (WINDOW VAR w, TEXT CONST t,
+ INT CONST position, BOOL CONST trennlinie weg):
+ NOT boxyes (w, t, position, trennlinie weg)
+END PROC boxno;
+BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position):
+ boxno (w, t, position)
+END PROC boxno;
+TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,
+ INT CONST position, INT VAR x, y, xsize, ysize):
+
+ INT VAR spa, zei;
+ TEXT VAR wert;
+ get cursor (w, spa, zei);
+ wert := hole antwort (w, t, vorgabe, position, FALSE, x, y, xsize, ysize);
+ cursor (spa, zei);
+ wert
+END PROC boxanswer;
+TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,
+ INT CONST position, BOOL CONST trennlinie weg):
+ INT VAR x, y, xsize, ysize, spa, zei;
+ get cursor (w, spa, zei);
+ TEXT VAR wert := hole antwort (w, t, vorgabe, position, FALSE,
+ x, y, xsize, ysize);
+
+ page up (x, y, xsize, ysize);
+ IF trennlinie weg
+ THEN erase footnote (w, TRUE)
+ ELSE erase footnote (w, FALSE)
+ FI;
+ cursor (w, spa, zei);
+ wert
+END PROC boxanswer;
+TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,
+ INT CONST position):
+ boxanswer (w, t, vorgabe, position, TRUE)
+END PROC boxanswer;
+TEXT PROC boxone (WINDOW VAR w, THESAURUS CONST thesaurus,
+ TEXT CONST text1, text2, BOOL CONST mit reinigung):
+
+ INT VAR spa, zei;
+ get cursor (w, spa, zei);
+ TEXT VAR wert :: one (areax (w) + 2, areay (w) + 2,
+ areaxsize (w) - 4, areaysize (w) - 2,
+ thesaurus, text1, text2);
+ IF mit reinigung
+ THEN page up (areax (w) + 2, areay (w) + 2,
+ areaxsize (w) - 4, areaysize (w) - 2);
+ erase footnote (w)
+ FI;
+ cursor (w, spa, zei);
+ wert
+END PROC boxone;
+TEXT PROC boxanswerone (WINDOW VAR w, TEXT CONST text, vorgabe,
+
+ THESAURUS CONST thesaurus, TEXT CONST t1, t2,
+ BOOL CONST mit reinigung, trennlinie weg):
+ INT VAR x,y, xsize, ysize, spa, zei;
+ get cursor (w, spa, zei);
+ TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE,
+ x, y, xsize, ysize);
+ IF wert = ""27"z"
+ THEN lasse auswaehlen
+ ELSE uebernimm den wert
+ FI;
+ cursor (w, spa, zei);
+ wert.
+ lasse auswaehlen:
+ IF mit reinigung
+ THEN wert := boxone (w, thesaurus, t1, t2, TRUE )
+
+ ELSE wert := boxone (w, thesaurus, t1, t2, FALSE)
+ FI.
+ uebernimm den wert:
+ IF mit reinigung
+ THEN page up (x, y, xsize, ysize);
+ entferne ggf die trennlinie
+ FI.
+ entferne ggf die trennlinie:
+ IF trennlinie weg
+ THEN erase footnote (w, TRUE)
+ ELSE erase footnote (w, FALSE)
+ FI.
+END PROC boxanswer one;
+TEXT PROC boxanswerone (WINDOW VAR w, TEXT CONST text, vorgabe,
+ THESAURUS CONST thesaurus, TEXT CONST t1, t2,
+
+ BOOL CONST mit reinigung):
+ boxanswerone (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE)
+END PROC boxanswer one;
+THESAURUS PROC boxsome (WINDOW VAR w, THESAURUS CONST thesaurus,
+ TEXT CONST text1, text2,
+ BOOL CONST mit reinigung):
+ INT VAR spa, zei;
+ get cursor (w, spa, zei);
+ THESAURUS VAR wert :: some (areax (w) + 2, areay (w) + 2,
+ areaxsize (w) - 4, areaysize (w) - 2,
+
+ thesaurus, text1, text2);
+ IF mit reinigung
+ THEN page up (areax (w) + 2, areay (w) + 2,
+ areaxsize (w) - 4, areaysize (w) - 2);
+ erase footnote (w)
+ FI;
+ cursor (w, spa, zei);
+ wert
+END PROC boxsome;
+THESAURUS PROC boxanswersome (WINDOW VAR w, TEXT CONST text, vorgabe,
+ THESAURUS CONST thesaurus,
+ TEXT CONST t1, t2,
+ BOOL CONST mit reinigung, trennlinie weg):
+
+ THESAURUS VAR ergebnis :: empty thesaurus;
+ INT VAR x, y, xsize, ysize, spa, zei;
+ get cursor (w, spa, zei);
+ TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE,
+ x, y, xsize, ysize);
+ IF wert = ""27"z"
+ THEN lasse auswaehlen
+ ELSE uebernimm den wert
+ FI;
+ cursor (w, spa, zei);
+ ergebnis.
+ lasse auswaehlen:
+ IF mit reinigung
+ THEN ergebnis := boxsome (w, thesaurus, t1, t2, TRUE )
+ ELSE ergebnis := boxsome (w, thesaurus, t1, t2, FALSE)
+
+ FI.
+ uebernimm den wert:
+ IF wert <> niltext
+ THEN insert (ergebnis, wert)
+ FI;
+ IF mit reinigung
+ THEN page up (x, y, xsize, ysize);
+ entferne ggf die trennlinie
+ FI.
+ entferne ggf die trennlinie:
+ IF trennlinie weg
+ THEN erase footnote (w, TRUE)
+ ELSE erase footnote (w, FALSE)
+ FI.
+END PROC boxanswer some;
+THESAURUS PROC boxanswersome (WINDOW VAR w, TEXT CONST text, vorgabe,
+ THESAURUS CONST thesaurus,
+
+ TEXT CONST t1, t2,
+ BOOL CONST mit reinigung):
+ boxanswersome (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE)
+END PROC boxanswersome;
+PROC out footnote (WINDOW VAR w, BOOL CONST mit trennlinie, TEXT CONST text):
+ INT VAR spa, zei;
+ get cursor (w, spa, zei);
+ IF mit trennlinie
+ THEN cursor (w, 1, areaysize (w) - 1);
+ areaxsize (w) TIMESOUT waagerecht
+ FI;
+ cursor (w, 1, areaysize (w));
+ outtext (text, 1, areaxsize (w));
+
+ cursor (w, spa, zei)
+END PROC out footnote;
+PROC out footnote (WINDOW VAR w, TEXT CONST t):
+ out footnote (w, TRUE, t)
+END PROC out footnote;
+PROC erase footnote (WINDOW VAR w, BOOL CONST auch trennlinie):
+ INT VAR spa, zei;
+ get cursor (w, spa, zei);
+ IF auch trennlinie
+ THEN cursor (w, 1, areaysize (w) - 1);
+ outtext ("", 1, areaxsize (w))
+ FI;
+ cursor (w, 1, areaysize (w));
+ outtext ("", 1, areaxsize (w));
+ cursor (w, spa, zei)
+END PROC erase footnote;
+PROC erase footnote (WINDOW VAR w):
+
+ erase footnote (w, TRUE)
+END PROC erase footnote;
+PROC schreibe boxtext (WINDOW VAR w, TEXT CONST t,
+ INT CONST position, zusatzlaenge,
+ mindestbreite, mindesthoehe,
+ INT VAR x, y, xsize, ysize):
+ ermittle boxbreite und boxhoehe;
+ ermittle rahmenwerte;
+ schreibe boxkopf;
+ schreibe boxrumpf.
+ ermittle boxbreite und boxhoehe:
+ TEXT VAR intern :: t + delimiter;
+ entferne fuehrende delimiter;
+ INT VAR anfang :: 1,
+
+ ende :: pos (intern, delimiter, anfang) - 1;
+ xsize := 0;
+ ysize := 0;
+ WHILE ende > 0 REP
+ ysize INCR 1;
+ lege ggf boxbreite fest;
+ bestimme neue positionen
+ PER.
+ entferne fuehrende delimiter:
+ WHILE (intern SUB 1) = delimiter REP
+ intern := subtext (intern, 2)
+ PER.
+ lege ggf boxbreite fest:
+ IF length (subtext (intern, anfang, ende)) > xsize
+ THEN xsize := length (subtext (intern, anfang, ende))
+ FI.
+ bestimme neue positionen:
+
+ anfang := ende + 2;
+ ende := pos (intern, delimiter, anfang) - 1.
+ ermittle rahmenwerte:
+ schlage notwendige groessen auf;
+ kill ueberlaengen;
+ lege bildschirmpositionen fest.
+ schlage notwendige groessen auf:
+ IF xsize < mindestbreite
+ THEN xsize := mindestbreite
+ FI;
+ IF ysize < mindesthoehe
+ THEN ysize := mindesthoehe
+ FI;
+ ysize INCR zusatzlaenge;
+ ysize INCR 2; (* Für den Rahmen *)
+ xsize INCR 2. (* Für den Rahmen *)
+ kill ueberlaengen:
+
+ IF ysize > (areaysize (w) - 4)
+ THEN ysize := areaysize (w) - 4
+ FI;
+ IF xsize > (areaxsize (w) - 4)
+ THEN xsize := areaxsize (w) - 4
+ FI.
+ lege bildschirmpositionen fest:
+ SELECT position OF
+ CASE 1: plazierung links oben
+ CASE 2: plazierung rechts oben
+ CASE 3: plazierung links unten
+ CASE 4: plazierung rechts unten
+ OTHERWISE plazierung im zentrum
+ END SELECT.
+ plazierung links oben:
+ x := areax (w) + 2;
+ y := areay (w) + 2.
+
+ plazierung rechts oben:
+ x := areax (w) + areaxsize (w) - xsize - 2;
+ y := areay (w) + 2.
+ plazierung links unten:
+ x := areax (w) + 2;
+ y := areay (w) + areaysize (w) - ysize - 2.
+ plazierung rechts unten:
+ x := areax (w) + areaxsize (w) - xsize - 2;
+ y := areay (w) + areaysize (w) - ysize - 2.
+ plazierung im zentrum:
+ x := areax (w) + ((areaxsize (w) - (xsize + 2)) DIV 2) + 1;
+ y := areay (w) + ((areaysize (w) - ysize) DIV 2).
+ schreibe boxkopf:
+
+ cursor (x, y);
+ out (ecke oben links);
+ (xsize - 2) TIMESOUT waagerecht;
+ out (ecke oben rechts).
+ schreibe boxrumpf:
+ INT VAR i;
+ intern := t + delimiter;
+ entferne fuehrende delimiter;
+ anfang := 1;
+ ende := pos (intern, delimiter, anfang) - 1;
+ FOR i FROM y + 1 UPTO y + ysize - zusatzlaenge - 2 REP
+ cursor (x, i);
+ out (senkrecht);
+ outtext (subtext (intern, anfang, ende), 1, xsize - 2);
+ out (senkrecht);
+ anfang := ende + 2;
+
+ ende := pos (intern, delimiter, anfang) - 1
+ PER
+END PROC schreibe boxtext;
+PROC schreibe boxfuss (WINDOW VAR w,
+ INT CONST x, y, xsize, ysize, limit):
+ schreibe abschlusszeile;
+ out footnote (w, aussage [1]);
+ cursor in position und warten.
+ schreibe abschlusszeile:
+ cursor (x, y + ysize - 1);
+ out (ecke unten links);
+ (xsize - 2) TIMESOUT waagerecht;
+ out (ecke unten rechts).
+ cursor in position und warten:
+ cursor parken (w);
+
+ clear buffer;
+ pause (limit)
+END PROC schreibe boxfuss;
+PROC cursor parken (WINDOW VAR w):
+ cursor (w, 1, 2)
+END PROC cursor parken;
+PROC schreibe box (WINDOW VAR w, TEXT CONST t,
+ INT CONST position, timelimit,
+ INT VAR x, y, xsize, ysize):
+ schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize);
+ schreibe boxfuss (w, x, y, xsize, ysize, timelimit)
+END PROC schreibe box;
+PROC schreibe notizfuss (WINDOW VAR w, INT CONST x, y, xsize, ysize):
+
+ schreibe abschlusszeile;
+ cursor parken (w).
+ schreibe abschlusszeile:
+ cursor (x, y + ysize - 1);
+ out (ecke unten links);
+ (xsize - 2) TIMESOUT waagerecht;
+ out (ecke unten rechts).
+END PROC schreibe notizfuss;
+PROC schreibe notiz (WINDOW VAR w, TEXT CONST t, INT CONST position,
+ INT VAR x, y, xsize, ysize):
+ schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize);
+ schreibe notizfuss (w, x, y, xsize, ysize)
+END PROC schreibe notiz;
+PROC schreibe alternativen (WINDOW VAR w, TEXT CONST t, altzeile, sonst,
+
+ INT CONST position, BOOL CONST mit abbruch,
+ INT VAR x, y, xsize, ysize, ergebnis):
+ ROW 10 STRUCT (TEXT alternat, INT anfang, laenge) VAR altliste;
+ normiere alternativen;
+ untersuche alternativen;
+ schreibe boxtext (w, textintern, position, 2, altbreite,
+ 0, x, y, xsize, ysize);
+ schreibe alternativenfuss;
+ lasse auswaehlen;
+ liefere ergebnis.
+ textintern:
+ IF sonst = janeintasten
+ THEN TEXT VAR zwischen;
+
+ zwischen := t;
+ kuerze um folgende blanks;
+ zwischen + "? "
+ ELSE t
+ FI.
+ kuerze um folgende blanks:
+ WHILE (zwischen SUB (length (zwischen))) = blank REP
+ zwischen := subtext (zwischen , 1, length (zwischen) - 1)
+ PER.
+ normiere alternativen:
+ TEXT VAR altintern :: altzeile;
+ altintern CAT delimiter.
+ untersuche alternativen:
+ INT VAR altanzahl :: 1, altbreite, first :: - 2, anfang :: 1,
+ ende :: pos (altintern, delimiter, anfang) - 1;
+
+ WHILE ende > 0 AND altanzahl <= 10 REP
+ trage alternative ein;
+ trage alternativenanfang ein;
+ trage alternativenlaenge ein;
+ setze neue positionen fest
+ PER;
+ ermittle gesamtalternativenbreite.
+ trage alternative ein:
+ altliste [altanzahl].alternat :=
+ compress (subtext (altintern, anfang, ende)).
+ trage alternativenanfang ein:
+ first INCR 3;
+ altliste [altanzahl].anfang := first.
+ trage alternativenlaenge ein:
+
+ altliste [altanzahl].laenge := length (altliste [altanzahl].alternat);
+ first INCR altliste [altanzahl].laenge.
+ setze neue positionen fest:
+ anfang := ende + 2;
+ ende := pos (altintern, delimiter, anfang) - 1;
+ altanzahl INCR 1.
+ ermittle gesamtalternativenbreite:
+ altanzahl DECR 1;
+ altbreite := altliste [altanzahl].anfang;
+ altbreite INCR (altliste [altanzahl].laenge + 3);
+ IF altbreite > areaxsize (w) - 6
+ THEN LEAVE schreibe alternativen
+
+ FI.
+ schreibe alternativenfuss:
+ schreibe leerzeile;
+ schreibe antwortmoeglichkeiten;
+ schreibe abschlusszeile;
+ IF mit abbruch
+ THEN out footnote (w, aussage [2])
+ ELSE beruecksichtige ja nein hinweis
+ FI.
+ schreibe leerzeile:
+ cursor (x, y + ysize - 3);
+ out (senkrecht);
+ (xsize - 2) TIMESOUT blank;
+ out (senkrecht).
+ schreibe antwortmoeglichkeiten:
+ cursor (x, y + ysize - 2);
+ out (senkrecht);
+ einrueckbreite TIMESOUT blank;
+
+ out (antwortleiste);
+ rest TIMESOUT blank;
+ out (senkrecht).
+ einrueckbreite:
+ (xsize - 2 - length (antwortleiste)) DIV 2.
+ antwortleiste:
+ INT VAR zeiger; TEXT VAR ausgabe :: "";
+ FOR zeiger FROM 1 UPTO altanzahl REP
+ ausgabe CAT altliste [zeiger].alternat;
+ ausgabe CAT " "
+ PER;
+ compress (ausgabe).
+ rest:
+ xsize - 2 - einrueckbreite - length (antwortleiste).
+ schreibe abschlusszeile:
+ cursor (x, y + ysize - 1);
+ out (ecke unten links);
+
+ (xsize - 2) TIMESOUT waagerecht;
+ out (ecke unten rechts).
+ beruecksichtige ja nein hinweis:
+ IF sonst = janeintasten
+ THEN out footnote (w, aussage [3])
+ ELSE out footnote (w, aussage [4])
+ FI.
+ lasse auswaehlen:
+ INT VAR altzeiger :: 1;
+ stelle erste alternative invers dar;
+ REP
+ hole eingabe;
+ werte eingabe aus und reagiere
+ UNTIL alternative gefunden PER.
+ stelle erste alternative invers dar:
+ cursor (x + einrueckbreite, y + ysize - 2);
+
+ out (mark ein);
+ out (altliste [altzeiger].alternat); out (blank);
+ out (mark aus);
+ cursor (x + einrueckbreite, y + ysize - 2).
+ hole eingabe:
+ TEXT VAR moegliche, eingabe;
+ IF mit abbruch
+ THEN moegliche := rechts links esc return + sonst
+ ELSE moegliche := rechts links null return + sonst
+ FI;
+ clear buffer;
+ REP
+ inchar (eingabe);
+ piepse bei unzulaessiger eingabe
+ UNTIL pos (moegliche, eingabe) > 0 PER.
+ piepse bei unzulaessiger eingabe:
+
+ IF pos (moegliche, eingabe) = 0 THEN out (piep) FI.
+ werte eingabe aus und reagiere:
+ SELECT pos (moegliche, eingabe) OF
+ CASE 1: zur naechsten alternative
+ CASE 2: zur vorausgehenden alternative
+ CASE 3: esc kommando verarbeiten
+ END SELECT.
+ zur naechsten alternative:
+ loesche aktuelle alternative;
+ ermittle rechte alternative;
+ stelle neue alternative invers dar.
+ zur vorausgehenden alternative:
+ loesche aktuelle alternative;
+ ermittle linke alternative;
+
+ stelle neue alternative invers dar.
+ loesche aktuelle alternative:
+ cursor (alternativenanfang - 1, y + ysize - 2);
+ out (blank);
+ out (altliste [altzeiger].alternat);
+ out (2 * blank).
+ alternativenanfang:
+ x + einrueckbreite + altliste [altzeiger].anfang.
+ ermittle rechte alternative:
+ IF altzeiger = altanzahl
+ THEN altzeiger := 1
+ ELSE altzeiger INCR 1
+ FI.
+ ermittle linke alternative:
+ IF altzeiger = 1
+ THEN altzeiger := altanzahl
+
+ ELSE altzeiger DECR 1
+ FI.
+ stelle neue alternative invers dar:
+ cursor (alternativenanfang - 1, y + ysize - 2);
+ out (mark ein);
+ out (altliste [altzeiger].alternat); out (blank);
+ out (mark aus);
+ cursor (alternativenanfang - 1, y + ysize - 2).
+ esc kommando verarbeiten:
+ inchar (eingabe);
+ IF eingabe = "h"
+ THEN ergebnis := 0;
+ LEAVE schreibe alternativen
+ ELSE out (piep); eingabe := ""
+ FI.
+ alternative gefunden:
+ pos (moegliche, eingabe) > 3.
+
+ liefere ergebnis:
+ IF pos (moegliche, eingabe) = 4
+ THEN ergebnis := altzeiger
+ ELSE ergebnis := 100 + pos (sonst, eingabe)
+ FI.
+END PROC schreibe alternativen;
+BOOL PROC ja (WINDOW VAR w, TEXT CONST t, INT CONST position,
+ INT VAR x, y, xsize, ysize):
+ INT VAR ergebnis;
+ schreibe alternativen (w, t, aussage [7], janeintasten, position,
+ FALSE, x, y, xsize, ysize, ergebnis);
+ SELECT ergebnis OF
+ CASE 2, 105, 106: FALSE
+ OTHERWISE TRUE
+
+ END SELECT.
+END PROC ja;
+TEXT PROC hole antwort (WINDOW VAR w, TEXT CONST t, vorgabe,
+ INT CONST position, BOOL CONST mit auswahl,
+ INT VAR x, y, xsize, ysize):
+ TEXT VAR eingabe :: compress (vorgabe);
+ schreibe boxtext (w, t, position, 2, length (aussage [8]) + 12, 2,
+ x, y, xsize, ysize);
+ schreibe antwortfuss;
+ clear buffer;
+ REP
+ IF eingabe = "break"
+ THEN eingabe := ""
+ FI;
+ lasse eintragen
+
+ UNTIL eingabe <> "break" PER;
+ liefere ergebnis.
+ schreibe antwortfuss:
+ schreibe leerzeile;
+ schreibe eingabezeile;
+ schreibe abschlusszeile;
+ IF mit auswahl
+ THEN out footnote (w, aussage [5])
+ ELSE out footnote (w, aussage [6])
+ FI.
+ schreibe leerzeile:
+ cursor (x, y + ysize - 3);
+ out (senkrecht);
+ (xsize - 2) TIMESOUT blank;
+ out (senkrecht).
+ schreibe eingabezeile:
+ cursor (x, y + ysize - 2);
+ out (senkrecht);
+ out (aussage [8]);
+
+ (xsize - 2 - length (aussage [8])) TIMESOUT blank;
+ out (senkrecht).
+ schreibe abschlusszeile:
+ cursor (x, y + ysize - 1);
+ out (ecke unten links);
+ (xsize - 2) TIMESOUT waagerecht;
+ out (ecke unten rechts).
+ lasse eintragen:
+ TEXT VAR exit :: "";
+ cursor on;
+ cursor (x + length (aussage [8]) + 1, y + ysize - 2);
+ IF mit auswahl
+ THEN editget (eingabe, maxtextlength, textlaenge, "", "hz", exit)
+ ELSE editget (eingabe, maxtextlength, textlaenge, "", "h", exit)
+
+ FI;
+ cursor off;
+ IF exit = ""27"h"
+ THEN eingabe := ""
+ ELIF mit auswahl AND (exit = ""27"z")
+ THEN eingabe := ""27"z"
+ ELSE eingabe := compress (eingabe)
+ FI.
+ textlaenge:
+ xsize - 2 - length (aussage [8]).
+ liefere ergebnis:
+ eingabe.
+END PROC hole antwort;
+END PACKET ls dialog 4;
+
diff --git a/dialog/ls-DIALOG 5 b/dialog/ls-DIALOG 5
index 1772b99..9902098 100644
--- a/dialog/ls-DIALOG 5
+++ b/dialog/ls-DIALOG 5
@@ -22,97 +22,1391 @@
*)
-PACKET ls dialog 5 DEFINES{} menufootnote, old menufootnote,{} menuinfo,menualternative,{} menuyes, menuno, menuone,{} menusome,menuanswer,{} menuanswerone, menuanswersome,{} install menu, handle menu,{} refresh submenu, deactivate,{} regenerate menuscreen, activate,{} write menunotice, erase menunotice,{} menubasistext, anwendungstext,{} show menuwindow, menuwindowpage,{} menuwindowout, menuwindowget,{} menuwindoweditget, menuwindowedit,{}
- menuwindowshow, menuwindowline,{} menuwindowyes, menuwindowno,{} menuwindowcursor, get menuwindowcursor,{} remaining menuwindowlines,{} menuwindowcenter, menuwindowstop,{} editorinformationen,stdinfoedit,{} menukartenname, current menuwindow,{} reset dialog, only intern, ausstieg,{} direktstart:{}LET systemkuerzel = "ls-DIALOG",{} menutafeltaskname = "ls-MENUKARTEN",{} menutafeltype = 1954,{} menutafelpraefix = "ls-MENUKARTE:",{}
- stdmenukartenname = "ls-MENUKARTE:Archiv",{} versionsnummer = "1.1",{} copyright1 = " (C) 1987/88 Eva Latta-Weber",{} copyright2 = " (C) 1988 ERGOS GmbH";{}LET maxmenus = 6,{} maxmenutexte = 300,{} maxinfotexte = 2000,{} maxhauptmenupunkte = 10,{} maxuntermenupunkte = 15,{} erste untermenuzeile = 3;{}LET blank = " ",{} piep = ""7"",{}
- cleol = ""5"",{} cleop = ""4"",{} trennzeilensymbol = "###",{} bleibt leer symbol = "***",{} hauptmenuluecke = " ";{}LET auswahlstring1 = ""8""2""10""3""13""27"?";{}TYPE MENUPUNKT = STRUCT (TEXT punktkuerzel,{} punktname,{} procname,{} boxtext,{} BOOL aktiv,{} angewaehlt),{}
- EINZELMENU = STRUCT (INT belegt,{} TEXT ueberschrift,{} INT anfangsposition,{} maxlaenge,{} ROW maxuntermenupunkte MENUPUNKT menupunkt,{} INT aktueller untermenupunkt,{} TEXT startprozedurname,{} leaveprozedurname),{} MENU = STRUCT (TEXT menuname,{} INT anzahl hauptmenupunkte,{}
- ROW maxhauptmenupunkte EINZELMENU einzelmenu,{} TEXT menueingangsprozedur,{} menuausgangsprozedur,{} menuinfo,{} lizenznummer,{} versionsnummer,{} INT hauptmenuzeiger,{} untermenuanfang,{} untermenuzeiger),{} INFOTEXT = STRUCT (INT anzahl infotexte,{}
- ROW maxinfotexte TEXT stelle),{} MENUTEXT = STRUCT (INT anzahl menutexte,{} ROW maxmenutexte TEXT platz),{} MENULEISTE = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,{} ROW maxmenus MENU menu,{} MENUTEXT menutext,{} INFOTEXT infotext);{}BOUND MENULEISTE VAR menuleiste;{}DATASPACE VAR ds;{}WINDOW VAR menuwindow, schreibfenster, editorinfofenster;{}
-INITFLAG VAR in this task :: FALSE;{}INT VAR anzahl offener menus :: 0;{}INT VAR menunotizx, menunotizxsize,{} menunotizy, menunotizysize,{} menunotizposition;{}TEXT VAR angekoppelte menutafel :: "",{} permanent footnote :: "",{} menunotiztext;{}BOOL VAR menunotiz ist gesetzt :: FALSE,{} nur interne verwendung :: FALSE,{} mit ausstieg :: FALSE;{}REAL VAR zeitpunkt :: clock (1);{}
-ROW 13 TEXT CONST fehlermeldung :: ROW 13 TEXT : ({}"Die Task '" + menutafeltaskname + "' existiert nicht!",{}"Die Menukarte '",{}"' existiert nicht in der Task '" + menutafeltaskname + "'!",{}"' hat falschen Typ/Bezeichnung (keine 'MENUKARTE')!",{}"Das Menu '",{}"' ist nicht in der angekoppelten Menukarte!",{}"Zu viele geoeffnete Menus ( > 2 )!",{}"Kein Menu geoeffnet!",{}"Menu enthaelt keine Menupunkte!",{}"Menupunkt ist nicht im Menu enthalten!",{}"Kein Text vorhanden!",{}"Zugriff unmöglich!",{}
-"Einschränkung unzulässig!"{});{}ROW 1 TEXT CONST vergleichstext :: ROW 1 TEXT : ({}"gibt es nicht"{});{}ROW 3 TEXT CONST hinweis :: ROW 3 TEXT : ({}"Info:<ESC><?>/<?> Wahl:<Pfeile> Ausführen:<RETURN> Verlassen:<ESC><q>",{}" Zum Weitermachen bitte irgendeine Taste tippen!",{}"Bitte warten ... Ich räume auf!"{});{}ROW 3 TEXT CONST infotext :: ROW 3 TEXT : ({}" Für diesen Menupunkt ist (noch) keine "13""13" Funktion eingetragen!",{}" Möchten Sie dieses Menu tatsächlich verlassen",{}" Leider ist zu diesem Menupunkt "13""13" kein Info - Text eingetragen!"{}
- );{}PROC install menu (TEXT CONST menutafelname):{} installmenu (menutafelname, TRUE){}END PROC install menu;{}PROC install menu (TEXT CONST menutafelname, BOOL CONST mit kennung):{} TEXT VAR letzter parameter;{} IF mit kennung{} THEN zeige menukennung{} FI;{} initialisiere menu ggf;{} IF menutafel noch nicht angekoppelt{} THEN letzter parameter := std;{} hole menutafel;{} kopple menutafel an;{} last param (letzter parameter){} FI.{} initialisiere menu ggf:{}
- IF NOT initialized (in this task){} THEN angekoppelte menutafel := "";{} anzahl offener menus := 0;{} menunotiz ist gesetzt := FALSE;{} nur interne verwendung := FALSE{} FI.{} menutafel noch nicht angekoppelt:{} menutafelname <> angekoppelte menutafel.{} hole menutafel:{} IF NOT exists task (menutafeltaskname){} THEN bereinige situation; cursor on;{} errorstop (fehlermeldung [1]){} FI;{} disable stop;{} fetch (menutafelname, /menutafeltaskname);{}
- IF is error AND pos (errormessage, vergleichstext [1]) > 0{} THEN clear error; enable stop;{} bereinige situation; cursor on;{} errorstop (fehlermeldung [2] + menutafelname +{} fehlermeldung [3]){} ELIF is error{} THEN clear error; enable stop;{} bereinige situation; cursor on;{} errorstop (errormessage){} ELSE enable stop{} FI.{} kopple menutafel an:{} IF type (old (menutafelname)) = menutafeltype{}
- AND pos (menutafelname,menutafelpraefix) = 1{} THEN forget (ds);{} ds := old (menutafelname);{} menuleiste := ds;{} angekoppelte menutafel := menutafelname;{} forget (menutafelname, quiet){} ELSE bereinige situation; cursor on;{} errorstop ("'" + menutafelname + fehlermeldung [4]){} FI.{}END PROC install menu;{}PROC only intern (BOOL CONST wert):{} nur interne verwendung := wert{}END PROC only intern;{}
-PROC ausstieg (BOOL CONST wert):{} mit ausstieg := wert{}END PROC ausstieg;{}TEXT PROC menukartenname:{} IF NOT initialized (in this task){} THEN angekoppelte menutafel := "";{} anzahl offener menus := 0;{} menunotiz ist gesetzt := FALSE;{} FI;{} angekoppelte menutafel{}END PROC menukartenname;{}PROC handle menu (TEXT CONST menuname):{} nur interne verwendung := FALSE;{} mit ausstieg := TRUE;{} handle menu (menuname, ""){}END PROC handle menu;{}
-PROC handle menu (TEXT CONST menuname, ausstiegsproc):{} cursor off;{} IF nur interne verwendung{} THEN oeffne menu (menuname){} ELSE biete menu an{} FI;{} lasse menupunkte auswaehlen;{} IF nur interne verwendung{} THEN do (ausstiegsproc);{} anzahl offener menus DECR 1;{} IF anzahl offener menus < 1 THEN erase menunotice FI;{} menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{} menuwindow := window (1,1,79, 24);{} nur interne verwendung := FALSE;{}
- mit ausstieg := TRUE;{} cursor on{} ELSE schliesse menu;{} leere ggf den bildschirm{} FI.{} biete menu an:{} REAL VAR zwischenzeit :: clock (1) - zeitpunkt;{} IF zwischenzeit < 2.0{} THEN pause (20 - int (10.0 * zwischenzeit)){} FI;{} oeffne menu (menuname).{} leere ggf den bildschirm:{} IF anzahl offener menus < 1{} THEN erase menunotice;{} page; cursor on{} FI.{} lasse menupunkte auswaehlen:{} TEXT VAR kuerzelkette :: "";{}
- starte aktuelle untermenuoperationen;{} REP{} cursor in warteposition;{} ermittle aktuelle kuerzelkette;{} nimm zeichen auf;{} interpretiere zeichen;{} UNTIL menu verlassen gewuenscht PER.{} nimm zeichen auf:{} TEXT CONST erlaubte zeichen ::auswahlstring1 + kuerzelkette;{} TEXT VAR eingabezeichen;{} INT VAR zeichenposition;{} REP{} inchar (eingabezeichen);{} zeichenposition := pos (erlaubte zeichen, eingabezeichen);{} piepse ggf{} UNTIL zeichenposition > 0 PER.{}
- piepse ggf:{} IF zeichenposition = 0 THEN out (piep) FI.{} menu verlassen gewuenscht:{} zeichenposition = 6 AND (zweites zeichen = "q").{} interpretiere zeichen:{} SELECT zeichenposition OF{} CASE 1: gehe einen hauptmenupunkt nach links{} CASE 2: gehe einen hauptmenupunkt nach rechts{} CASE 3: gehe einen untermenupunkt nach unten{} CASE 4: gehe einen untermenupunkt nach oben{} CASE 5: fuehre aktuellen menupunkt aus{} CASE 6: hole esc sequenz{} CASE 7: zeige erklaerungstext im menu an{}
- OTHERWISE werte kuerzeleingabe aus{} END SELECT.{} gehe einen hauptmenupunkt nach links:{} INT VAR anzahl schritte :: 1;{} beende aktuelle untermenuoperationen;{} loesche aktuelles untermenu auf bildschirm;{} loesche alte hauptmenumarkierung;{} anzahl schritte INCR clear buffer and count (""8"");{} ermittle linke menuposition;{} stelle aktuellen hauptmenupunkt invers dar;{} starte aktuelle untermenuoperationen;{} schreibe aktuelles untermenu auf bildschirm.{} gehe einen hauptmenupunkt nach rechts:{}
- anzahl schritte := 1;{} beende aktuelle untermenuoperationen;{} loesche aktuelles untermenu auf bildschirm;{} loesche alte hauptmenumarkierung;{} anzahl schritte INCR clear buffer and count (""2"");{} ermittle rechte menuposition;{} stelle aktuellen hauptmenupunkt invers dar;{} starte aktuelle untermenuoperationen;{} schreibe aktuelles untermenu auf bildschirm.{} loesche alte hauptmenumarkierung:{} erase invers (area (menuwindow), startpos, 1, ueberschriftlaenge);{}
- out (area (menuwindow), startpos, 1, ueberschrifttext).{} startpos:{} aktuelles untermenu.anfangsposition.{} ueberschriftlaenge:{} length (ueberschrifttext).{} ueberschrifttext:{} aktuelles untermenu.ueberschrift.{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} ermittle linke menuposition:{} INT VAR positionszaehler;{} FOR positionszaehler FROM 1 UPTO anzahl schritte REP{}
- drehe die menuposition um einen wert runter{} PER.{} ermittle rechte menuposition:{} FOR positionszaehler FROM 1 UPTO anzahl schritte REP{} drehe die menuposition um einen wert hoch{} PER.{} drehe die menuposition um einen wert runter:{} IF aktuelles menu.hauptmenuzeiger > 1{} THEN aktuelles menu.hauptmenuzeiger DECR 1{} ELSE aktuelles menu.hauptmenuzeiger{} := aktuelles menu.anzahl hauptmenupunkte{} FI.{} drehe die menuposition um einen wert hoch:{}
- IF aktuelles menu.hauptmenuzeiger{} < aktuelles menu.anzahl hauptmenupunkte{} THEN aktuelles menu.hauptmenuzeiger INCR 1{} ELSE aktuelles menu.hauptmenuzeiger := 1{} FI.{} gehe einen untermenupunkt nach unten:{} INT VAR naechster aktiver := folgender aktiver untermenupunkt;{} nimm ummarkierung vor.{} gehe einen untermenupunkt nach oben:{} naechster aktiver := vorausgehender aktiver untermenupunkt;{} nimm ummarkierung vor.{} nimm ummarkierung vor:{} IF ueberhaupt aktive menupunkte vorhanden{}
- THEN demarkiere aktuellen untermenupunkt;{} gehe zum folgenden untermenupunkt;{} markiere aktuellen untermenupunkt{} FI.{} ueberhaupt aktive menupunkte vorhanden:{} (aktuelles untermenu.belegt > 0) CAND (naechster aktiver > 0).{} gehe zum folgenden untermenupunkt:{} aktuelles menu.untermenuzeiger := naechster aktiver.{} stelle aktuellen hauptmenupunkt invers dar:{} out invers (area (menuwindow), startpos, 1, ueberschrifttext).{} fuehre aktuellen menupunkt aus:{}
- IF nur interne verwendung AND mit ausstieg{} THEN kennzeichne als angetickt;{} disable stop;{} do (ausstiegsproc);{} do (menuanweisung);{} aktueller menupunkt.angewaehlt := FALSE;{} IF is error THEN put error; clear error FI;{} enable stop;{} anzahl offener menus DECR 1;{} menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{} menuwindow := window (1,1,79, 24);{} nur interne verwendung := FALSE;{}
- cursor on;{} LEAVE handle menu{} ELSE kennzeichne als angetickt;{} fuehre operation aus (menuanweisung);{} nimm kennzeichnung zurueck{} FI.{} kennzeichne als angetickt:{} aktueller menupunkt.angewaehlt := TRUE;{} markiere aktuellen untermenupunkt.{} nimm kennzeichnung zurueck:{} aktueller menupunkt.angewaehlt := FALSE;{} markiere aktuellen untermenupunkt.{} menuanweisung:{} compress (aktueller menupunkt.procname).{} aktueller menupunkt:{}
- aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].{} hole esc sequenz:{} TEXT VAR zweites zeichen;{} inchar (zweites zeichen);{} SELECT pos ("q?$", zweites zeichen) OF{} CASE 1: erfrage abbruch{} CASE 2: zeige menubedienhinweise{} CASE 3: gib info aus{} OTHERWISE out (piep){} END SELECT.{} erfrage abbruch:{} IF menuno (infotext [2], 5){} THEN zweites zeichen := "n" (* gleichgültig, nur nicht 'q' *){} FI.{} zeige menubedienhinweise:{}
- INT VAR gewaehlt;{} REP{} gewaehlt := menualternative ( alttext, altwahl, altzusatz, 5, FALSE);{} erfuelle den wunsch{} UNTIL ausstieg aus bedienhinweisen gewuenscht PER.{} alttext:{} menuleiste.menutext.platz [1].{} altwahl:{} menuleiste.menutext.platz [2].{} altzusatz:{} menuleiste.menutext.platz [3].{} erfuelle den wunsch:{} SELECT gewaehlt OF{} CASE 1,101,106: menuinfo (menuleiste.menutext.platz [4], 5, maxint){} CASE 2,102,107: menuinfo (menuleiste.menutext.platz [5], 5, maxint){}
- CASE 3,103,108: menuinfo (menuleiste.menutext.platz [6], 5, maxint){} CASE 4,104,109: menuinfo (menuleiste.menutext.platz [7], 5, maxint){} END SELECT.{} ausstieg aus bedienhinweisen gewuenscht:{} gewaehlt = 5 OR gewaehlt = 105 OR gewaehlt = 110.{} gib info aus:{} menuinfo (menuleiste.menutext.platz [20]).{} zeige erklaerungstext im menu an:{} IF compress (erklaerungstext) = ""{} THEN menuinfo (infotext [3]){} ELSE menuinfo (erklaerungstext){} FI.{} erklaerungstext:{}
- aktueller menupunkt.boxtext.{} werte kuerzeleingabe aus:{} naechster aktiver := pos (kuerzelkette, eingabezeichen);{} nimm ummarkierung vor;{} fuehre aktuellen menupunkt aus.{} starte aktuelle untermenuoperationen:{} ermittle aktuelle kuerzelkette;{} IF startoperation <> ""{} THEN fuehre operation aus (startoperation){} FI.{} startoperation:{} compress (aktuelles untermenu.startprozedurname).{} ermittle aktuelle kuerzelkette:{} kuerzelkette := "";{} INT VAR kuerzelzeiger;{}
- FOR kuerzelzeiger FROM 1 UPTO aktuelles untermenu.belegt REP{} IF compress (aktuelles punktkuerzel) = ""{} THEN kuerzelkette CAT ""0"" { beliebiger Code der Länge 1 }{} ELSE haenge ggf kuerzel an{} FI{} PER.{} aktuelles punktkuerzel:{} aktuelles untermenu.menupunkt [kuerzelzeiger].punktkuerzel.{} haenge ggf kuerzel an:{} IF betrachteter punkt ist aktiv{} THEN kuerzelkette CAT aktuelles punktkuerzel{} ELSE kuerzelkette CAT ""0""{} FI.{} betrachteter punkt ist aktiv:{}
- aktuelles untermenu.menupunkt [kuerzelzeiger].aktiv.{} beende aktuelle untermenuoperationen:{} kuerzelkette := "".{}END PROC handle menu;{}PROC oeffne menu (TEXT CONST menuname):{} cursor off;{} suche eingestelltes menu;{} IF menu existiert nicht{} THEN cursor on;{} page;{} errorstop (fehlermeldung [5] + menuname + fehlermeldung [6]){} FI;{} anzahl offener menus INCR 1;{} ggf neue seite aufschlagen;{} ueberpruefe anzahl offener menus;{} lege ggf aktuelles menu auf eis;{}
- initialisiere den menubildschirm;{} IF NOT nur interne verwendung{} THEN aktuelles menu.hauptmenuzeiger := 1;{} aktuelles menu.untermenuzeiger := 0;{} aktuelles menu.untermenuanfang := 0;{} FI;{} show menu;{} fuehre ggf menueingangsprozedur aus;{} zeige ggf menukenndaten an.{} suche eingestelltes menu:{} INT VAR i, suchzeiger;{} BOOL VAR gefunden :: FALSE;{} FOR i FROM 1 UPTO menuleiste.belegt REP{} IF menuleiste.menu [i].menuname = menuname{}
- THEN gefunden := TRUE;{} suchzeiger := i;{} FI{} UNTIL menuleiste.menu [i].menuname = menuname PER.{} menu existiert nicht:{} NOT gefunden.{} ueberpruefe anzahl offener menus:{} IF anzahl offener menus > 2{} THEN anzahl offener menus := 0; cursor on;{} errorstop (fehlermeldung [7]){} FI.{} lege ggf aktuelles menu auf eis:{} IF anzahl offener menus = 2{} THEN menuleiste.zeigerhintergrund := menuleiste.zeigeraktuell{} FI;{} menuleiste.zeigeraktuell := suchzeiger.{}
- initialisiere den menubildschirm:{} IF anzahl offener menus = 2{} THEN menuwindow := window (6, 4, 73, 20){} ELSE menuwindow := window (1, 1, 79, 24);{} FI.{} fuehre ggf menueingangsprozedur aus:{} IF aktuelles menu.menueingangsprozedur <> ""{} THEN fuehre operation aus (aktuelles menu.menueingangsprozedur){} FI.{} ggf neue seite aufschlagen:{} IF anzahl offener menus = 1 THEN page FI.{} zeige ggf menukenndaten an:{} IF anzahl offener menus = 1 AND aktuelles menu.menuinfo <> bleibt leer symbol{}
- THEN write menunotice (vollstaendiger infotext, 4);{} pause (100);{} erase menunotice{} FI.{} vollstaendiger infotext:{} aktuelles menu.menuinfo +{} aktuelles menu.lizenznummer +{} aktuelles menu.versionsnummer.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{}END PROC oeffne menu;{}PROC show menu:{} ueberpruefe menudaten;{} stelle hauptmenuleiste zusammen;{} zeige hauptmenu an;{} stelle aktuellen hauptmenupunkt invers dar;{} schreibe aktuelles untermenu auf bildschirm;{}
- zeige informationszeile an.{} ueberpruefe menudaten:{} IF anzahl offener menus = 0{} THEN errorstop (fehlermeldung [8]){} ELIF aktuelles menu.anzahl hauptmenupunkte < 1{} THEN errorstop (fehlermeldung [9]){} FI.{} stelle hauptmenuleiste zusammen:{} TEXT VAR hauptmenuzeile :: "";{} INT VAR zeiger;{} hauptmenuzeile CAT aktuelles menu.menuname;{} hauptmenuzeile CAT ":";{} FOR zeiger FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP{} haenge hauptmenupunkt an{}
- PER.{} haenge hauptmenupunkt an:{} hauptmenuzeile CAT hauptmenuluecke;{} hauptmenuzeile CAT hauptmenupunktname.{} hauptmenupunktname:{} aktuelles menu.einzelmenu [zeiger].ueberschrift.{} zeige hauptmenu an:{} page (menuwindow, TRUE);{} out menuframe (area (menuwindow));{} cursor (menuwindow, 1, 1);{} out (menuwindow, hauptmenuzeile).{} stelle aktuellen hauptmenupunkt invers dar:{} cursor (menuwindow, startposition, 1);{} out (menuwindow, invers (ueberschrifttext)).{}
- startposition:{} aktuelles untermenu.anfangsposition - 1.{} ueberschrifttext:{} aktuelles untermenu.ueberschrift.{} zeige informationszeile an:{} write permanent footnote (hinweis [1]).{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC show menu;{}PROC schreibe aktuelles untermenu auf bildschirm:{} ermittle linke obere ecke des untermenukastens;{} wirf untermenu aus;{}
- show menunotice;{} cursor in warteposition.{} ermittle linke obere ecke des untermenukastens:{} aktuelles menu.untermenuanfang := menumitte - halbe menubreite;{} achte auf randextrema.{} menumitte:{} startposition + (length (ueberschrifttext) DIV 2) - 1.{} startposition:{} aktuelles untermenu.anfangsposition.{} ueberschrifttext:{} aktuelles untermenu.ueberschrift.{} halbe menubreite:{} aktuelles untermenu.maxlaenge DIV 2.{} achte auf randextrema:{} gleiche ggf linken rand aus;{}
- gleiche ggf rechten rand aus.{} gleiche ggf linken rand aus:{} IF aktuelles menu.untermenuanfang < 4{} THEN aktuelles menu.untermenuanfang := 4{} FI.{} gleiche ggf rechten rand aus:{} IF (aktuelles menu.untermenuanfang + aktuelles untermenu.maxlaenge) >{} (areaxsize (menuwindow) - 3){} THEN aktuelles menu.untermenuanfang{} := areaxsize (menuwindow) - aktuelles untermenu.maxlaenge - 3{} FI.{} wirf untermenu aus:{} IF aktuelles menu.untermenuzeiger = 0{}
- THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt{} FI;{} wirf untermenukopfzeile aus;{} wirf untermenurumpf aus;{} wirf untermenufusszeile aus;{} markiere aktuellen untermenupunkt.{} wirf untermenukopfzeile aus:{} cursor (menuwindow, spalte, anfangszeile);{} out (balken oben); striche; out (balken oben).{} wirf untermenufusszeile aus:{} cursor (menuwindow, spalte, endezeile);{} out (ecke unten links); striche; out (ecke unten rechts).{} spalte:{}
- aktuelles menu.untermenuanfang - 3.{} anfangszeile:{} erste untermenuzeile - 1.{} endezeile:{} erste untermenuzeile + aktuelles untermenu.belegt.{} striche:{} (aktuelles untermenu.maxlaenge + 5) TIMESOUT waagerecht.{} wirf untermenurumpf aus:{} INT VAR laufvar;{} INT CONST aktuelle punktlaenge :: aktuelles untermenu.maxlaenge + 1;{} FOR laufvar FROM 1 UPTO aktuelles untermenu.belegt REP{} wirf eine einzelne menuzeile aus{} PER.{} wirf eine einzelne menuzeile aus:{}
- out with beam (area (menuwindow), menuspalte, menuzeile,{} aktueller punktname, laenge).{} menuspalte:{} aktuelles menu.untermenuanfang.{} menuzeile:{} erste untermenuzeile + laufvar - 1.{} aktueller punktname:{} untermenubezeichnung (laufvar).{} laenge:{} aktuelle punktlaenge.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC schreibe aktuelles untermenu auf bildschirm;{}
-PROC loesche aktuelles untermenu auf bildschirm:{} beende aktuelle untermenuoperationen;{} loesche untermenu auf bildschirm;{} schreibe balken wieder hin;{} aktuelles menu.untermenuzeiger := 1.{} beende aktuelle untermenuoperationen:{} IF leaveoperation <> ""{} THEN fuehre operation aus (leaveoperation){} FI.{} leaveoperation:{} compress (aktuelles untermenu.leaveprozedurname).{} loesche untermenu auf bildschirm:{} INT VAR laufvar;{} FOR laufvar FROM aktuelles untermenu.belegt + 1 DOWNTO 1 REP{}
- loesche eine einzelne menuzeile{} PER.{} loesche eine einzelne menuzeile:{} erase with beam (area (menuwindow), menuspalte, menuzeile, laenge).{} menuspalte:{} aktuelles menu.untermenuanfang.{} menuzeile:{} erste untermenuzeile + laufvar - 1.{} laenge:{} aktuelles untermenu.maxlaenge + 1.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{} schreibe balken wieder hin:{}
- cursor (menuwindow, spalte, anfangszeile);{} (aktuelles untermenu.maxlaenge + 7) TIMESOUT waagerecht.{} spalte:{} aktuelles menu.untermenuanfang - 3.{} anfangszeile:{} erste untermenuzeile - 1.{}END PROC loesche aktuelles untermenu auf bildschirm;{}PROC markiere aktuellen untermenupunkt:{} IF aktuelles menu.untermenuzeiger <> 0{} THEN laufe ggf zum naechsten aktiven menupunkt;{} out invers with beam (area (menuwindow), menuspalte, menuzeile,{} aktueller punktname, laenge){}
- FI.{} laufe ggf zum naechsten aktiven menupunkt:{} IF NOT aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].aktiv{} THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt{} FI.{} menuspalte:{} aktuelles menu.untermenuanfang.{} menuzeile:{} erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.{} aktueller punktname:{} untermenubezeichnung (aktuelles menu.untermenuzeiger).{} laenge:{} aktuelles untermenu.maxlaenge + 1.{} aktuelles menu:{}
- menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC markiere aktuellen untermenupunkt;{}PROC demarkiere aktuellen untermenupunkt:{} IF aktuelles menu.untermenuzeiger <> 0{} THEN erase invers (area (menuwindow), menuspalte, menuzeile, laenge);{} out (area (menuwindow), menuspalte, menuzeile,{} aktueller punktname, laenge){} FI.{} menuspalte:{} aktuelles menu.untermenuanfang.{}
- menuzeile:{} erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.{} aktueller punktname:{} untermenubezeichnung (aktuelles menu.untermenuzeiger).{} laenge:{} aktuelles untermenu.maxlaenge + 1.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC demarkiere aktuellen untermenupunkt;{}INT PROC folgender aktiver untermenupunkt:{} INT VAR anzahl aktiver menupunkte :: 0;{}
- untersuche anzahl aktiver menupunkte;{} IF kein aktiver menupunkt vorhanden{} THEN 0{} ELIF nur ein aktiver menupunkt vorhanden{} THEN liefere einzigen aktiven menupunkt{} ELSE liefere naechsten aktiven menupunkt{} FI.{} untersuche anzahl aktiver menupunkte:{} INT VAR zaehler, position;{} FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP{} IF aktuelles untermenu.menupunkt [zaehler].aktiv{} THEN anzahl aktiver menupunkte INCR 1;{} position := zaehler{}
- FI{} UNTIL anzahl aktiver menupunkte > 1 PER.{} kein aktiver menupunkt vorhanden:{} anzahl aktiver menupunkte = 0.{} nur ein aktiver menupunkt vorhanden:{} anzahl aktiver menupunkte = 1.{} liefere einzigen aktiven menupunkt:{} position.{} liefere naechsten aktiven menupunkt:{} INT VAR interner zeiger;{} stelle internen zeiger auf den naechsten menupunkt;{} WHILE NOT punkt ist aktiv REP{} untersuche naechsten menupunkt{} PER;{} ergebnis.{} stelle internen zeiger auf den naechsten menupunkt:{}
- IF aktuelles menu.untermenuzeiger = letzter untermenupunkt{} THEN interner zeiger := 1{} ELSE interner zeiger := aktuelles menu.untermenuzeiger + 1{} FI.{} letzter untermenupunkt:{} aktuelles untermenu.belegt.{} punkt ist aktiv:{} aktuelles untermenu.menupunkt [interner zeiger].aktiv.{} untersuche naechsten menupunkt:{} IF interner zeiger = letzter untermenupunkt{} THEN interner zeiger := 1{} ELSE interner zeiger INCR 1{} FI.{}
- ergebnis:{} interner zeiger.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC folgender aktiver untermenupunkt;{}INT PROC vorausgehender aktiver untermenupunkt:{} INT VAR anzahl aktiver menupunkte :: 0;{} untersuche anzahl aktiver menupunkte;{} IF kein aktiver menupunkt vorhanden{} THEN 0{} ELIF nur ein aktiver menupunkt vorhanden{} THEN liefere einzigen aktiven menupunkt{}
- ELSE liefere vorausgehenden aktiven menupunkt{} FI.{} untersuche anzahl aktiver menupunkte:{} INT VAR zaehler, position;{} FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP{} IF aktuelles untermenu.menupunkt [zaehler].aktiv{} THEN anzahl aktiver menupunkte INCR 1;{} position := zaehler{} FI{} UNTIL anzahl aktiver menupunkte > 1 PER.{} kein aktiver menupunkt vorhanden:{} anzahl aktiver menupunkte = 0.{} nur ein aktiver menupunkt vorhanden:{} anzahl aktiver menupunkte = 1.{}
- liefere einzigen aktiven menupunkt:{} position.{} liefere vorausgehenden aktiven menupunkt:{} INT VAR interner zeiger;{} stelle internen zeiger auf vorausgehenden menupunkt;{} WHILE NOT punkt ist aktiv REP{} untersuche vorausgehenden menupunkt{} PER;{} ergebnis.{} stelle internen zeiger auf vorausgehenden menupunkt:{} IF aktuelles menu.untermenuzeiger <= 1{} THEN interner zeiger := letzter untermenupunkt{} ELSE interner zeiger := aktuelles menu.untermenuzeiger - 1{}
- FI.{} letzter untermenupunkt:{} aktuelles untermenu.belegt.{} punkt ist aktiv:{} aktuelles untermenu.menupunkt [interner zeiger].aktiv.{} untersuche vorausgehenden menupunkt:{} IF interner zeiger = 1{} THEN interner zeiger := letzter untermenupunkt{} ELSE interner zeiger DECR 1{} FI.{} ergebnis:{} interner zeiger.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}
-END PROC vorausgehender aktiver untermenupunkt;{}PROC cursor in warteposition:{} cursor (areax (menuwindow), areay (menuwindow) + 1){}END PROC cursor in warteposition;{}TEXT PROC untermenubezeichnung (INT CONST position):{} TEXT VAR bezeichnung :: "";{} bezeichnung CAT kennzeichnung;{} bezeichnung CAT punktkennung;{} bezeichnung.{} kennzeichnung:{} IF aktueller menupunkt.aktiv{} AND aktueller menupunkt.angewaehlt{} THEN "*"{} ELIF aktueller menupunkt.aktiv{}
- AND aktueller menupunkt.punktkuerzel <> ""{} THEN aktueller menupunkt.punktkuerzel{} ELIF aktueller menupunkt.aktiv{} AND aktueller menupunkt.punktkuerzel = ""{} THEN blank{} ELSE "-"{} FI.{} punktkennung:{} IF menupunkt ist trennzeile{} THEN strichellinie{} ELSE aktueller menupunkt.punktname{} FI.{} menupunkt ist trennzeile:{} aktueller menupunkt.punktname = (blank + trennzeilensymbol).{} strichellinie:{}
- (aktuelles untermenu.maxlaenge + 1) * "-".{} aktueller menupunkt:{} aktuelles untermenu.menupunkt [position].{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC untermenubezeichnung;{}PROC fuehre operation aus (TEXT CONST operation):{} disable stop;{} IF operation = ""{} THEN menuinfo (infotext [1]);{} LEAVE fuehre operation aus{} FI;{} do (operation);{}
- IF is error{} THEN menuinfo (errormessage, 5);{} clear error{} FI;{} old menufootnote;{} enable stop;{} cursor off{}END PROC fuehre operation aus;{}PROC veraendere aktivierung (TEXT CONST unterpunkt, BOOL CONST eintrag):{} INT VAR unterpunktposition :: 0, zeiger;{} suche unterpunkt;{} aendere aktivierung.{} suche unterpunkt:{} FOR zeiger FROM 1 UPTO untermenuende REP{} IF untermenupunkt = blank + compress (unterpunkt){} THEN unterpunktposition := zeiger;{} LEAVE suche unterpunkt{}
- FI{} PER;{} LEAVE veraendere aktivierung.{} untermenuende:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.{} untermenupunkt:{} aktuelles untermenu.menupunkt [zeiger].punktname.{} aendere aktivierung:{} aktuelles untermenu.menupunkt [unterpunktposition].aktiv := eintrag.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC veraendere aktivierung;{}
-PROC veraendere aktivierung (INT CONST punktnummer, BOOL CONST eintrag):{} IF punktnummer >= 1 AND punktnummer <= untermenuende{} THEN aktuelles untermenu.menupunkt [punktnummer].aktiv := eintrag{} FI.{} untermenuende:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC veraendere aktivierung;{}PROC veraendere anwahl (TEXT CONST unterpunkt, BOOL CONST eintrag):{}
- INT VAR unterpunktposition :: 0, zeiger;{} suche unterpunkt;{} aendere anwahl.{} suche unterpunkt:{} FOR zeiger FROM 1 UPTO untermenuende REP{} IF untermenupunkt = blank + compress (unterpunkt){} THEN unterpunktposition := zeiger;{} LEAVE suche unterpunkt{} FI{} PER;{} enable stop;{} errorstop (fehlermeldung [10]).{} untermenuende:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.{} untermenupunkt:{} aktuelles untermenu.menupunkt [zeiger].punktname.{}
- aendere anwahl:{} aktuelles untermenu.menupunkt [unterpunktposition].angewaehlt := eintrag.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC veraendere anwahl;{}PROC activate (TEXT CONST unterpunkt):{} enable stop;{} veraendere aktivierung (unterpunkt, TRUE){}END PROC activate;{}PROC activate (INT CONST punktnummer):{} enable stop;{} veraendere aktivierung (punktnummer, TRUE){}
-END PROC activate;{}PROC deactivate (TEXT CONST unterpunkt):{} enable stop;{} veraendere aktivierung (unterpunkt, FALSE){}END PROC deactivate;{}PROC deactivate (INT CONST punktnummer):{} enable stop;{} veraendere aktivierung (punktnummer, FALSE){}END PROC deactivate;{}PROC select (TEXT CONST unterpunkt):{} enable stop;{} veraendere anwahl (unterpunkt, TRUE){}END PROC select;{}PROC deselect (TEXT CONST unterpunkt):{} enable stop;{} veraendere anwahl (unterpunkt, FALSE){}END PROC deselect;{}
-PROC schliesse menu:{} IF aktuelles menu.menuausgangsprozedur <> ""{} THEN menufootnote (hinweis [3]);{} fuehre operation aus (aktuelles menu.menuausgangsprozedur){} FI;{} anzahl offener menus DECR 1;{} IF anzahl offener menus = 1{} THEN aktiviere das auf eis gelegte menu{} FI.{} aktiviere das auf eis gelegte menu:{} menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{} menuwindow := window (1, 1, 79, 24);{} show menu.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{}
-END PROC schliesse menu;{}PROC refresh submenu:{} schreibe aktuelles untermenu auf bildschirm;{} show menunotice;{}END PROC refresh submenu;{}PROC regenerate menuscreen:{} IF anzahl offener menus = 0{} THEN errorstop (fehlermeldung [8]){} ELIF anzahl offener menus = 1{} THEN page;{} show menu;{} show menunotice{} ELSE zeige erstes menu an;{} zeige zweites menu an;{} show menunotice{} FI.{} zeige erstes menu an:{} INT VAR menuzeiger :: menuleiste.zeigeraktuell;{}
- menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{} menuwindow := window (1, 1, 79, 24);{} anzahl offener menus := 1;{} show menu.{} zeige zweites menu an:{} menuleiste.zeigeraktuell := menuzeiger;{} menuwindow := window (6, 4, 73, 20);{} anzahl offener menus := 2;{} show menu.{}END PROC regenerate menuscreen;{}PROC menuinfo (TEXT CONST t, INT CONST position, timelimit):{} boxinfo (menuwindow, t, position, timelimit, FALSE);{} schreibe aktuelles untermenu auf bildschirm;{}
- old menufootnote{}END PROC menuinfo;{}PROC menuinfo (TEXT CONST t, INT CONST position):{} menuinfo (t, position, maxint){}END PROC menuinfo;{}PROC menuinfo (TEXT CONST t):{} menuinfo (t, 5, maxint){}END PROC menuinfo;{}INT PROC menualternative (TEXT CONST t, auswahlliste, zusatztasten,{} INT CONST position, BOOL CONST mit abbruch):{} INT VAR ergebnis := boxalternative (menuwindow, t, auswahlliste,{} zusatztasten, position, mit abbruch, FALSE);{}
- schreibe aktuelles untermenu auf bildschirm;{} old menufootnote;{} ergebnis{}END PROC menualternative;{}BOOL PROC menuyes (TEXT CONST frage, INT CONST position):{} BOOL VAR wert := boxyes (menuwindow, frage, position, FALSE);{} schreibe aktuelles untermenu auf bildschirm;{} old menufootnote;{} wert{}END PROC menuyes;{}BOOL PROC menuno (TEXT CONST frage, INT CONST position):{} NOT menuyes (frage, position){}END PROC menuno;{}TEXT PROC menuone (THESAURUS CONST thes, TEXT CONST t1, t2,{} BOOL CONST mit reinigung):{}
- TEXT CONST wert :: boxone (menuwindow, thes, t1, t2, mit reinigung);{} IF mit reinigung{} THEN schreibe aktuelles untermenu auf bildschirm;{} old menufootnote{} FI;{} wert{}END PROC menuone;{}THESAURUS PROC menusome (THESAURUS CONST thes, TEXT CONST t1, t2,{} BOOL CONST mit reinigung):{} THESAURUS CONST thesaurus :: boxsome (menuwindow, thes, t1, t2,{} mit reinigung);{} IF mit reinigung{} THEN schreibe aktuelles untermenu auf bildschirm;{}
- old menufootnote{} FI;{} thesaurus{}END PROC menusome;{}TEXT PROC menuanswer (TEXT CONST t, vorgabe, INT CONST position):{} TEXT VAR wert :: boxanswer (menuwindow, t, vorgabe, position, FALSE);{} schreibe aktuelles untermenu auf bildschirm;{} old menufootnote;{} wert{}END PROC menuanswer;{}TEXT PROC menuanswerone (TEXT CONST t, vorgabe, THESAURUS CONST thes,{} TEXT CONST t1, t2, BOOL CONST mit reinigung):{} TEXT VAR wert :: boxanswerone (menuwindow, t, vorgabe, thes, t1, t2,{}
- mit reinigung, FALSE){} IF mit reinigung{} THEN schreibe aktuelles untermenu auf bildschirm;{} old menufootnote{} FI;{} wert{}END PROC menuanswer one;{}THESAURUS PROC menuanswersome (TEXT CONST t, vorgabe, THESAURUS CONST thes,{} TEXT CONST t1, t2, BOOL CONST mit reinigung):{} THESAURUS VAR wert :: boxanswersome (menuwindow, t, vorgabe,{} thes, t1, t2, mit reinigung, FALSE){}
- IF mit reinigung{} THEN schreibe aktuelles untermenu auf bildschirm;{} old menufootnote{} FI;{} wert{}END PROC menuanswersome;{}PROC menufootnote (TEXT CONST t):{} cursor (menuwindow, 1, areaysize (menuwindow) - 1);{} areaxsize (menuwindow) TIMESOUT waagerecht;{} cursor (menuwindow, 1, areaysize (menuwindow));{} outtext (t, 1, areaxsize (menuwindow)){}END PROC menufootnote;{}PROC old menufootnote:{} menufootnote (permanent footnote){}END PROC old menufootnote;{}TEXT PROC menubasistext (INT CONST nummer):{}
- IF nummer <= 20{} THEN fehlermeldung [12]{} ELIF nummer > menuleiste.menutext.anzahl menutexte{} THEN fehlermeldung [11]{} ELSE menuleiste.menutext.platz [nummer]{} FI{}END PROC menubasistext;{}TEXT PROC anwendungstext (INT CONST nummer):{} IF nummer > menuleiste.infotext.anzahl infotexte{} THEN fehlermeldung [11]{} ELSE menuleiste.infotext.stelle [nummer]{} FI{}END PROC anwendungstext;{}PROC zeige menukennung:{} IF anzahl offener menus = 0{} THEN zeige angaben und emblem;{}
- FI.{} zeige angaben und emblem:{} ROW 5 WINDOW VAR w;{} w [ 1] := window (40, 3, 30, 9);{} w [ 2] := window (36, 5, 30, 9);{} w [ 3] := window (30, 7, 30, 9);{} w [ 4] := window (22, 9, 30, 9);{} w [ 5] := window (12, 11, 30, 9);{} page;{} show (w [1]); out (w [1], center (w [1], invers (systemkuerzel)));{} show (w [2]); out (w [2], " Version " + versionsnummer);{} show (w [3]); out (w [3], copyright1);{} show (w [4]); out (w [4], copyright2);{} show (w [5]);{}
- cursor (w [5], 1, 2);out (w [5], " lll sssssssss ");{} cursor (w [5], 1, 3);out (w [5], " lll sss sss ");{} cursor (w [5], 1, 4);out (w [5], " lll sss ");{} cursor (w [5], 1, 5);out (w [5], " lll sssssssss ");{} cursor (w [5], 1, 6);out (w [5], " lll sss ");{} cursor (w [5], 1, 7);out (w [5], " lll latta soft sss ");{} cursor (w [5], 1, 8);out (w [5], " lllllllll sssssssss ");{} cursor (79, 24);{}
- zeitpunkt := clock (1);{}END PROC zeige menukennung;{}PROC reset dialog:{} angekoppelte menutafel := "";{} anzahl offener menus := 0{}END PROC reset dialog;{}PROC write permanent footnote (TEXT CONST t):{} permanent footnote := t;{} cursor (menuwindow, 1, areaysize (menuwindow));{} outtext (t, 1, areaxsize (menuwindow)){}END PROC write permanent footnote;{}PROC write menunotice (TEXT CONST t, INT CONST position):{} erase menunotice;{} boxnotice (menuwindow, t, position, menunotizx, menunotizy,{}
- menunotizxsize, menunotizysize);{} menunotiztext := t;{} menunotizposition := position;{} menunotiz ist gesetzt := TRUE{}END PROC write menunotice;{}PROC show menunotice:{} IF menunotiz ist gesetzt{} THEN boxnotice (menuwindow, menunotiztext, menunotizposition,{} menunotizx, menunotizy, menunotizxsize, menunotizysize);{} FI{}END PROC show menunotice;{}PROC erase menunotice:{} INT VAR spa, zei;{} get cursor (spa, zei);{}
- IF menunotiz ist gesetzt{} THEN page up (menunotizx, menunotizy, menunotizxsize, menunotizysize);{} menunotiz ist gesetzt := FALSE;{} cursor (spa, zei){} FI{}END PROC erase menunotice;{}PROC initialize menuwindow:{} schreibfenster := window (areax (menuwindow) + 1,{} areay (menuwindow) + 3,{} areaxsize (menuwindow) - 2,{} areaysize (menuwindow) - 4){}END PROC initialize menuwindow;{}
-PROC show menuwindow:{} initialize menuwindow;{} show (schreibfenster);{}END PROC show menuwindow;{}PROC menuwindow page:{} initialize menuwindow;{} page (schreibfenster){}END PROC menuwindow page;{}PROC menuwindowout (TEXT CONST text):{} out (schreibfenster, text){}END PROC menuwindow out;{}PROC menuwindowget (TEXT VAR text):{} get (schreibfenster, text){}END PROC menuwindowget;{}PROC menuwindoweditget (TEXT VAR text):{} editget (schreibfenster, text){}END PROC menuwindoweditget;{}PROC menuwindowedit (TEXT CONST dateiname):{}
- initialize menuwindow;{} edit (schreibfenster, dateiname){}END PROC menuwindowedit;{}PROC menuwindowedit (FILE VAR f):{} initialize menuwindow;{} edit (schreibfenster, f){}END PROC menuwindowedit;{}PROC menuwindowshow (TEXT CONST dateiname):{} initialize menuwindow;{} show (schreibfenster, dateiname){}END PROC menuwindowshow;{}PROC menuwindowshow (FILE VAR f):{} initialize menuwindow;{} show (schreibfenster, f){}END PROC menuwindowshow;{}BOOL PROC menuwindowyes (TEXT CONST frage):{} yes (schreibfenster, frage){}
-END PROC menuwindowyes;{}BOOL PROC menuwindowno (TEXT CONST frage):{} no (schreibfenster, frage){}END PROC menuwindowno;{}PROC menuwindowline:{} menuwindowline (1){}END PROC menuwindowline;{}PROC menuwindowline (INT CONST anzahl):{} line (schreibfenster, anzahl){}END PROC menuwindowline;{}PROC menuwindowcursor (INT CONST spa, zei):{} cursor (schreibfenster, spa, zei){}END PROC menuwindowcursor;{}PROC get menuwindowcursor (INT VAR spa, zei):{} get cursor (schreibfenster, spa, zei){}END PROC get menuwindowcursor;{}
-INT PROC remaining menuwindowlines:{} remaining lines (schreibfenster){}END PROC remaining menuwindowlines;{}TEXT PROC menuwindowcenter (TEXT CONST t):{} center (schreibfenster, t){}END PROC menuwindowcenter;{}PROC menuwindowstop:{} menuwindowstop (2){}END PROC menuwindowstop;{}PROC menuwindowstop (INT CONST anzahl):{} stop (schreibfenster, anzahl){}END PROC menuwindowstop;{}WINDOW PROC current menuwindow:{} initialize menuwindow;{} schreibfenster{}END PROC current menuwindow;{}PROC stdinfoedit (FILE VAR f, INT CONST oberste zeile):{}
- IF oberste zeile < 1 OR oberste zeile > 3{} THEN errorstop (fehlermeldung [13]);{} FI;{} garantiere menukarte;{} cursor (1, oberste zeile); out (cleop);{} cursor (1, 23); out(79 * waagerecht);{} cursor (1, 24); outtext (menubasistext (141), 1, 79);{} editorinfofenster := window (1, oberste zeile + 1, 79, 24 - oberste zeile);{} kommando auf taste legen ("?", "editorinformationen");{} command dialogue (FALSE);{} cursor on; edit (f, 1, oberste zeile, 79, 23 - oberste zeile);{} command dialogue (TRUE);{}
- kommando auf taste legen ("?", "").{} garantiere menukarte:{} TEXT VAR name := compress (menukartenname);{} IF name = ""{} THEN install menu (stdmenukartenname, FALSE){} FI.{}END PROC stdinfoedit;{}PROC stdinfoedit (FILE VAR f):{} stdinfoedit (f, 1){}END PROC stdinfoedit;{}PROC stdinfoedit (TEXT CONST dateiname, INT CONST oberste zeile):{} FILE VAR f :: sequential file (modify, dateiname);{} stdinfoedit (f, oberste zeile);{}END PROC stdinfoedit;{}PROC stdinfoedit (TEXT CONST dateiname):{}
- stdinfoedit (dateiname, 1){}END PROC stdinfoedit;{}PROC editorinformationen:{} BOOL VAR ende gewuenscht :: FALSE; INT VAR z;{} FOR z FROM startwert UPTO 22 REP{} cursor (1, z); out (cleol);{} PER;{} REP{} INT VAR erg := boxalternative (editorinfofenster,{} menubasistext (149),{} menubasistext (150),{} menubasistext (151),{} 5, FALSE, FALSE);{} erfuelle den wunsch{}
- UNTIL ende gewuenscht PER;{} cursor (2, 23); 77 TIMESOUT waagerecht;{} cursor (1, 24); outtext (menubasistext (141), 1, 79).{} startwert:{} areay (editorinfofenster) + 1.{} erfuelle den wunsch:{} SELECT erg OF{} CASE 1, 101, 109: boxinfo (editorinfofenster, menubasistext (142), 5, maxint, FALSE){} CASE 2, 102, 110: boxinfo (editorinfofenster, menubasistext (143), 5, maxint, FALSE){} CASE 3, 103, 111: boxinfo (editorinfofenster, menubasistext (144), 5, maxint, FALSE){} CASE 4, 104, 112: boxinfo (editorinfofenster, menubasistext (145), 5, maxint, FALSE){}
- CASE 5, 105, 113: boxinfo (editorinfofenster, menubasistext (146), 5, maxint, FALSE){} CASE 6, 106, 114: boxinfo (editorinfofenster, menubasistext (147), 5, maxint, FALSE){} CASE 7, 107, 115: boxinfo (editorinfofenster, menubasistext (148), 5, maxint, FALSE){} CASE 8, 108, 116: ende gewuenscht := TRUE{} OTHERWISE (*tue nichts*){} END SELECT{}END PROC editorinformationen;{}PROC bereinige situation:{} page;{} forget (ds);{} reset dialog{}END PROC bereinige situation;{}
-PROC direktstart (TEXT CONST procname, BOOL CONST autoloeschen):{} TEXT VAR datname := "Selbststartergenerierungsdatei", letzter := std;{} kopple archivmenukarte an;{} schreibe programm;{} insertiere programm;{} abkoppeln.{} kopple archivmenukarte an:{} install menu (stdmenukartenname, FALSE).{} schreibe programm:{} forget (datname, quiet);{} FILE VAR f :: sequential file (output, datname);{} putline (f, menubasistext (191));{} putline (f, "do (""reset dialog; erase menunotice; " + procname + """);");{}
- putline (f, menubasistext (192));{} IF autoloeschen{} THEN putline (f, menubasistext (193)){} ELSE putline (f, menubasistext (194)){} FI;{} putline (f, menubasistext (195));{} putline (f, menubasistext (196)).{} insertiere programm:{} TEXT VAR t := "insert (""" + datname + """)"; do (t).{} abkoppeln:{} forget (datname, quiet); last param (letzter);{} reset dialog;{} global manager.{}END PROC direktstart;{}END PACKET ls dialog 5;{}
+PACKET ls dialog 5 DEFINES
+ menufootnote, old menufootnote,
+ menuinfo,menualternative,
+ menuyes, menuno, menuone,
+ menusome,menuanswer,
+ menuanswerone, menuanswersome,
+ install menu, handle menu,
+ refresh submenu, deactivate,
+ regenerate menuscreen, activate,
+ write menunotice, erase menunotice,
+ menubasistext, anwendungstext,
+ show menuwindow, menuwindowpage,
+ menuwindowout, menuwindowget,
+ menuwindoweditget, menuwindowedit,
+
+ menuwindowshow, menuwindowline,
+ menuwindowyes, menuwindowno,
+ menuwindowcursor, get menuwindowcursor,
+ remaining menuwindowlines,
+ menuwindowcenter, menuwindowstop,
+ editorinformationen,stdinfoedit,
+ menukartenname, current menuwindow,
+ reset dialog, only intern, ausstieg,
+ direktstart:
+LET systemkuerzel = "ls-DIALOG",
+ menutafeltaskname = "ls-MENUKARTEN",
+ menutafeltype = 1954,
+ menutafelpraefix = "ls-MENUKARTE:",
+
+ stdmenukartenname = "ls-MENUKARTE:Archiv",
+ versionsnummer = "1.1",
+ copyright1 = " (C) 1987/88 Eva Latta-Weber",
+ copyright2 = " (C) 1988 ERGOS GmbH";
+LET maxmenus = 6,
+ maxmenutexte = 300,
+ maxinfotexte = 2000,
+ maxhauptmenupunkte = 10,
+ maxuntermenupunkte = 15,
+ erste untermenuzeile = 3;
+LET blank = " ",
+ piep = ""7"",
+
+ cleol = ""5"",
+ cleop = ""4"",
+ trennzeilensymbol = "###",
+ bleibt leer symbol = "***",
+ hauptmenuluecke = " ";
+LET auswahlstring1 = ""8""2""10""3""13""27"?";
+TYPE MENUPUNKT = STRUCT (TEXT punktkuerzel,
+ punktname,
+ procname,
+ boxtext,
+ BOOL aktiv,
+ angewaehlt),
+
+ EINZELMENU = STRUCT (INT belegt,
+ TEXT ueberschrift,
+ INT anfangsposition,
+ maxlaenge,
+ ROW maxuntermenupunkte MENUPUNKT menupunkt,
+ INT aktueller untermenupunkt,
+ TEXT startprozedurname,
+ leaveprozedurname),
+ MENU = STRUCT (TEXT menuname,
+ INT anzahl hauptmenupunkte,
+
+ ROW maxhauptmenupunkte EINZELMENU einzelmenu,
+ TEXT menueingangsprozedur,
+ menuausgangsprozedur,
+ menuinfo,
+ lizenznummer,
+ versionsnummer,
+ INT hauptmenuzeiger,
+ untermenuanfang,
+ untermenuzeiger),
+ INFOTEXT = STRUCT (INT anzahl infotexte,
+
+ ROW maxinfotexte TEXT stelle),
+ MENUTEXT = STRUCT (INT anzahl menutexte,
+ ROW maxmenutexte TEXT platz),
+ MENULEISTE = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,
+ ROW maxmenus MENU menu,
+ MENUTEXT menutext,
+ INFOTEXT infotext);
+BOUND MENULEISTE VAR menuleiste;
+DATASPACE VAR ds;
+WINDOW VAR menuwindow, schreibfenster, editorinfofenster;
+
+INITFLAG VAR in this task :: FALSE;
+INT VAR anzahl offener menus :: 0;
+INT VAR menunotizx, menunotizxsize,
+ menunotizy, menunotizysize,
+ menunotizposition;
+TEXT VAR angekoppelte menutafel :: "",
+ permanent footnote :: "",
+ menunotiztext;
+BOOL VAR menunotiz ist gesetzt :: FALSE,
+ nur interne verwendung :: FALSE,
+ mit ausstieg :: FALSE;
+REAL VAR zeitpunkt :: clock (1);
+
+ROW 13 TEXT CONST fehlermeldung :: ROW 13 TEXT : (
+"Die Task '" + menutafeltaskname + "' existiert nicht!",
+"Die Menukarte '",
+"' existiert nicht in der Task '" + menutafeltaskname + "'!",
+"' hat falschen Typ/Bezeichnung (keine 'MENUKARTE')!",
+"Das Menu '",
+"' ist nicht in der angekoppelten Menukarte!",
+"Zu viele geoeffnete Menus ( > 2 )!",
+"Kein Menu geoeffnet!",
+"Menu enthaelt keine Menupunkte!",
+"Menupunkt ist nicht im Menu enthalten!",
+"Kein Text vorhanden!",
+"Zugriff unmöglich!",
+
+"Einschränkung unzulässig!"
+);
+ROW 1 TEXT CONST vergleichstext :: ROW 1 TEXT : (
+"gibt es nicht"
+);
+ROW 3 TEXT CONST hinweis :: ROW 3 TEXT : (
+"Info:<ESC><?>/<?> Wahl:<Pfeile> Ausführen:<RETURN> Verlassen:<ESC><q>",
+" Zum Weitermachen bitte irgendeine Taste tippen!",
+"Bitte warten ... Ich räume auf!"
+);
+ROW 3 TEXT CONST infotext :: ROW 3 TEXT : (
+" Für diesen Menupunkt ist (noch) keine "13""13" Funktion eingetragen!",
+" Möchten Sie dieses Menu tatsächlich verlassen",
+" Leider ist zu diesem Menupunkt "13""13" kein Info - Text eingetragen!"
+
+ );
+PROC install menu (TEXT CONST menutafelname):
+ installmenu (menutafelname, TRUE)
+END PROC install menu;
+PROC install menu (TEXT CONST menutafelname, BOOL CONST mit kennung):
+ TEXT VAR letzter parameter;
+ IF mit kennung
+ THEN zeige menukennung
+ FI;
+ initialisiere menu ggf;
+ IF menutafel noch nicht angekoppelt
+ THEN letzter parameter := std;
+ hole menutafel;
+ kopple menutafel an;
+ last param (letzter parameter)
+ FI.
+ initialisiere menu ggf:
+
+ IF NOT initialized (in this task)
+ THEN angekoppelte menutafel := "";
+ anzahl offener menus := 0;
+ menunotiz ist gesetzt := FALSE;
+ nur interne verwendung := FALSE
+ FI.
+ menutafel noch nicht angekoppelt:
+ menutafelname <> angekoppelte menutafel.
+ hole menutafel:
+ IF NOT exists task (menutafeltaskname)
+ THEN bereinige situation; cursor on;
+ errorstop (fehlermeldung [1])
+ FI;
+ disable stop;
+ fetch (menutafelname, /menutafeltaskname);
+
+ IF is error AND pos (errormessage, vergleichstext [1]) > 0
+ THEN clear error; enable stop;
+ bereinige situation; cursor on;
+ errorstop (fehlermeldung [2] + menutafelname +
+ fehlermeldung [3])
+ ELIF is error
+ THEN clear error; enable stop;
+ bereinige situation; cursor on;
+ errorstop (errormessage)
+ ELSE enable stop
+ FI.
+ kopple menutafel an:
+ IF type (old (menutafelname)) = menutafeltype
+
+ AND pos (menutafelname,menutafelpraefix) = 1
+ THEN forget (ds);
+ ds := old (menutafelname);
+ menuleiste := ds;
+ angekoppelte menutafel := menutafelname;
+ forget (menutafelname, quiet)
+ ELSE bereinige situation; cursor on;
+ errorstop ("'" + menutafelname + fehlermeldung [4])
+ FI.
+END PROC install menu;
+PROC only intern (BOOL CONST wert):
+ nur interne verwendung := wert
+END PROC only intern;
+
+PROC ausstieg (BOOL CONST wert):
+ mit ausstieg := wert
+END PROC ausstieg;
+TEXT PROC menukartenname:
+ IF NOT initialized (in this task)
+ THEN angekoppelte menutafel := "";
+ anzahl offener menus := 0;
+ menunotiz ist gesetzt := FALSE;
+ FI;
+ angekoppelte menutafel
+END PROC menukartenname;
+PROC handle menu (TEXT CONST menuname):
+ nur interne verwendung := FALSE;
+ mit ausstieg := TRUE;
+ handle menu (menuname, "")
+END PROC handle menu;
+
+PROC handle menu (TEXT CONST menuname, ausstiegsproc):
+ cursor off;
+ IF nur interne verwendung
+ THEN oeffne menu (menuname)
+ ELSE biete menu an
+ FI;
+ lasse menupunkte auswaehlen;
+ IF nur interne verwendung
+ THEN do (ausstiegsproc);
+ anzahl offener menus DECR 1;
+ IF anzahl offener menus < 1 THEN erase menunotice FI;
+ menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;
+ menuwindow := window (1,1,79, 24);
+ nur interne verwendung := FALSE;
+
+ mit ausstieg := TRUE;
+ cursor on
+ ELSE schliesse menu;
+ leere ggf den bildschirm
+ FI.
+ biete menu an:
+ REAL VAR zwischenzeit :: clock (1) - zeitpunkt;
+ IF zwischenzeit < 2.0
+ THEN pause (20 - int (10.0 * zwischenzeit))
+ FI;
+ oeffne menu (menuname).
+ leere ggf den bildschirm:
+ IF anzahl offener menus < 1
+ THEN erase menunotice;
+ page; cursor on
+ FI.
+ lasse menupunkte auswaehlen:
+ TEXT VAR kuerzelkette :: "";
+
+ starte aktuelle untermenuoperationen;
+ REP
+ cursor in warteposition;
+ ermittle aktuelle kuerzelkette;
+ nimm zeichen auf;
+ interpretiere zeichen;
+ UNTIL menu verlassen gewuenscht PER.
+ nimm zeichen auf:
+ TEXT CONST erlaubte zeichen ::auswahlstring1 + kuerzelkette;
+ TEXT VAR eingabezeichen;
+ INT VAR zeichenposition;
+ REP
+ inchar (eingabezeichen);
+ zeichenposition := pos (erlaubte zeichen, eingabezeichen);
+ piepse ggf
+ UNTIL zeichenposition > 0 PER.
+
+ piepse ggf:
+ IF zeichenposition = 0 THEN out (piep) FI.
+ menu verlassen gewuenscht:
+ zeichenposition = 6 AND (zweites zeichen = "q").
+ interpretiere zeichen:
+ SELECT zeichenposition OF
+ CASE 1: gehe einen hauptmenupunkt nach links
+ CASE 2: gehe einen hauptmenupunkt nach rechts
+ CASE 3: gehe einen untermenupunkt nach unten
+ CASE 4: gehe einen untermenupunkt nach oben
+ CASE 5: fuehre aktuellen menupunkt aus
+ CASE 6: hole esc sequenz
+ CASE 7: zeige erklaerungstext im menu an
+
+ OTHERWISE werte kuerzeleingabe aus
+ END SELECT.
+ gehe einen hauptmenupunkt nach links:
+ INT VAR anzahl schritte :: 1;
+ beende aktuelle untermenuoperationen;
+ loesche aktuelles untermenu auf bildschirm;
+ loesche alte hauptmenumarkierung;
+ anzahl schritte INCR clear buffer and count (""8"");
+ ermittle linke menuposition;
+ stelle aktuellen hauptmenupunkt invers dar;
+ starte aktuelle untermenuoperationen;
+ schreibe aktuelles untermenu auf bildschirm.
+ gehe einen hauptmenupunkt nach rechts:
+
+ anzahl schritte := 1;
+ beende aktuelle untermenuoperationen;
+ loesche aktuelles untermenu auf bildschirm;
+ loesche alte hauptmenumarkierung;
+ anzahl schritte INCR clear buffer and count (""2"");
+ ermittle rechte menuposition;
+ stelle aktuellen hauptmenupunkt invers dar;
+ starte aktuelle untermenuoperationen;
+ schreibe aktuelles untermenu auf bildschirm.
+ loesche alte hauptmenumarkierung:
+ erase invers (area (menuwindow), startpos, 1, ueberschriftlaenge);
+
+ out (area (menuwindow), startpos, 1, ueberschrifttext).
+ startpos:
+ aktuelles untermenu.anfangsposition.
+ ueberschriftlaenge:
+ length (ueberschrifttext).
+ ueberschrifttext:
+ aktuelles untermenu.ueberschrift.
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ ermittle linke menuposition:
+ INT VAR positionszaehler;
+ FOR positionszaehler FROM 1 UPTO anzahl schritte REP
+
+ drehe die menuposition um einen wert runter
+ PER.
+ ermittle rechte menuposition:
+ FOR positionszaehler FROM 1 UPTO anzahl schritte REP
+ drehe die menuposition um einen wert hoch
+ PER.
+ drehe die menuposition um einen wert runter:
+ IF aktuelles menu.hauptmenuzeiger > 1
+ THEN aktuelles menu.hauptmenuzeiger DECR 1
+ ELSE aktuelles menu.hauptmenuzeiger
+ := aktuelles menu.anzahl hauptmenupunkte
+ FI.
+ drehe die menuposition um einen wert hoch:
+
+ IF aktuelles menu.hauptmenuzeiger
+ < aktuelles menu.anzahl hauptmenupunkte
+ THEN aktuelles menu.hauptmenuzeiger INCR 1
+ ELSE aktuelles menu.hauptmenuzeiger := 1
+ FI.
+ gehe einen untermenupunkt nach unten:
+ INT VAR naechster aktiver := folgender aktiver untermenupunkt;
+ nimm ummarkierung vor.
+ gehe einen untermenupunkt nach oben:
+ naechster aktiver := vorausgehender aktiver untermenupunkt;
+ nimm ummarkierung vor.
+ nimm ummarkierung vor:
+ IF ueberhaupt aktive menupunkte vorhanden
+
+ THEN demarkiere aktuellen untermenupunkt;
+ gehe zum folgenden untermenupunkt;
+ markiere aktuellen untermenupunkt
+ FI.
+ ueberhaupt aktive menupunkte vorhanden:
+ (aktuelles untermenu.belegt > 0) CAND (naechster aktiver > 0).
+ gehe zum folgenden untermenupunkt:
+ aktuelles menu.untermenuzeiger := naechster aktiver.
+ stelle aktuellen hauptmenupunkt invers dar:
+ out invers (area (menuwindow), startpos, 1, ueberschrifttext).
+ fuehre aktuellen menupunkt aus:
+
+ IF nur interne verwendung AND mit ausstieg
+ THEN kennzeichne als angetickt;
+ disable stop;
+ do (ausstiegsproc);
+ do (menuanweisung);
+ aktueller menupunkt.angewaehlt := FALSE;
+ IF is error THEN put error; clear error FI;
+ enable stop;
+ anzahl offener menus DECR 1;
+ menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;
+ menuwindow := window (1,1,79, 24);
+ nur interne verwendung := FALSE;
+
+ cursor on;
+ LEAVE handle menu
+ ELSE kennzeichne als angetickt;
+ fuehre operation aus (menuanweisung);
+ nimm kennzeichnung zurueck
+ FI.
+ kennzeichne als angetickt:
+ aktueller menupunkt.angewaehlt := TRUE;
+ markiere aktuellen untermenupunkt.
+ nimm kennzeichnung zurueck:
+ aktueller menupunkt.angewaehlt := FALSE;
+ markiere aktuellen untermenupunkt.
+ menuanweisung:
+ compress (aktueller menupunkt.procname).
+ aktueller menupunkt:
+
+ aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].
+ hole esc sequenz:
+ TEXT VAR zweites zeichen;
+ inchar (zweites zeichen);
+ SELECT pos ("q?$", zweites zeichen) OF
+ CASE 1: erfrage abbruch
+ CASE 2: zeige menubedienhinweise
+ CASE 3: gib info aus
+ OTHERWISE out (piep)
+ END SELECT.
+ erfrage abbruch:
+ IF menuno (infotext [2], 5)
+ THEN zweites zeichen := "n" (* gleichgültig, nur nicht 'q' *)
+ FI.
+ zeige menubedienhinweise:
+
+ INT VAR gewaehlt;
+ REP
+ gewaehlt := menualternative ( alttext, altwahl, altzusatz, 5, FALSE);
+ erfuelle den wunsch
+ UNTIL ausstieg aus bedienhinweisen gewuenscht PER.
+ alttext:
+ menuleiste.menutext.platz [1].
+ altwahl:
+ menuleiste.menutext.platz [2].
+ altzusatz:
+ menuleiste.menutext.platz [3].
+ erfuelle den wunsch:
+ SELECT gewaehlt OF
+ CASE 1,101,106: menuinfo (menuleiste.menutext.platz [4], 5, maxint)
+ CASE 2,102,107: menuinfo (menuleiste.menutext.platz [5], 5, maxint)
+
+ CASE 3,103,108: menuinfo (menuleiste.menutext.platz [6], 5, maxint)
+ CASE 4,104,109: menuinfo (menuleiste.menutext.platz [7], 5, maxint)
+ END SELECT.
+ ausstieg aus bedienhinweisen gewuenscht:
+ gewaehlt = 5 OR gewaehlt = 105 OR gewaehlt = 110.
+ gib info aus:
+ menuinfo (menuleiste.menutext.platz [20]).
+ zeige erklaerungstext im menu an:
+ IF compress (erklaerungstext) = ""
+ THEN menuinfo (infotext [3])
+ ELSE menuinfo (erklaerungstext)
+ FI.
+ erklaerungstext:
+
+ aktueller menupunkt.boxtext.
+ werte kuerzeleingabe aus:
+ naechster aktiver := pos (kuerzelkette, eingabezeichen);
+ nimm ummarkierung vor;
+ fuehre aktuellen menupunkt aus.
+ starte aktuelle untermenuoperationen:
+ ermittle aktuelle kuerzelkette;
+ IF startoperation <> ""
+ THEN fuehre operation aus (startoperation)
+ FI.
+ startoperation:
+ compress (aktuelles untermenu.startprozedurname).
+ ermittle aktuelle kuerzelkette:
+ kuerzelkette := "";
+ INT VAR kuerzelzeiger;
+
+ FOR kuerzelzeiger FROM 1 UPTO aktuelles untermenu.belegt REP
+ IF compress (aktuelles punktkuerzel) = ""
+ THEN kuerzelkette CAT ""0"" { beliebiger Code der Länge 1 }
+ ELSE haenge ggf kuerzel an
+ FI
+ PER.
+ aktuelles punktkuerzel:
+ aktuelles untermenu.menupunkt [kuerzelzeiger].punktkuerzel.
+ haenge ggf kuerzel an:
+ IF betrachteter punkt ist aktiv
+ THEN kuerzelkette CAT aktuelles punktkuerzel
+ ELSE kuerzelkette CAT ""0""
+ FI.
+ betrachteter punkt ist aktiv:
+
+ aktuelles untermenu.menupunkt [kuerzelzeiger].aktiv.
+ beende aktuelle untermenuoperationen:
+ kuerzelkette := "".
+END PROC handle menu;
+PROC oeffne menu (TEXT CONST menuname):
+ cursor off;
+ suche eingestelltes menu;
+ IF menu existiert nicht
+ THEN cursor on;
+ page;
+ errorstop (fehlermeldung [5] + menuname + fehlermeldung [6])
+ FI;
+ anzahl offener menus INCR 1;
+ ggf neue seite aufschlagen;
+ ueberpruefe anzahl offener menus;
+ lege ggf aktuelles menu auf eis;
+
+ initialisiere den menubildschirm;
+ IF NOT nur interne verwendung
+ THEN aktuelles menu.hauptmenuzeiger := 1;
+ aktuelles menu.untermenuzeiger := 0;
+ aktuelles menu.untermenuanfang := 0;
+ FI;
+ show menu;
+ fuehre ggf menueingangsprozedur aus;
+ zeige ggf menukenndaten an.
+ suche eingestelltes menu:
+ INT VAR i, suchzeiger;
+ BOOL VAR gefunden :: FALSE;
+ FOR i FROM 1 UPTO menuleiste.belegt REP
+ IF menuleiste.menu [i].menuname = menuname
+
+ THEN gefunden := TRUE;
+ suchzeiger := i;
+ FI
+ UNTIL menuleiste.menu [i].menuname = menuname PER.
+ menu existiert nicht:
+ NOT gefunden.
+ ueberpruefe anzahl offener menus:
+ IF anzahl offener menus > 2
+ THEN anzahl offener menus := 0; cursor on;
+ errorstop (fehlermeldung [7])
+ FI.
+ lege ggf aktuelles menu auf eis:
+ IF anzahl offener menus = 2
+ THEN menuleiste.zeigerhintergrund := menuleiste.zeigeraktuell
+ FI;
+ menuleiste.zeigeraktuell := suchzeiger.
+
+ initialisiere den menubildschirm:
+ IF anzahl offener menus = 2
+ THEN menuwindow := window (6, 4, 73, 20)
+ ELSE menuwindow := window (1, 1, 79, 24);
+ FI.
+ fuehre ggf menueingangsprozedur aus:
+ IF aktuelles menu.menueingangsprozedur <> ""
+ THEN fuehre operation aus (aktuelles menu.menueingangsprozedur)
+ FI.
+ ggf neue seite aufschlagen:
+ IF anzahl offener menus = 1 THEN page FI.
+ zeige ggf menukenndaten an:
+ IF anzahl offener menus = 1 AND aktuelles menu.menuinfo <> bleibt leer symbol
+
+ THEN write menunotice (vollstaendiger infotext, 4);
+ pause (100);
+ erase menunotice
+ FI.
+ vollstaendiger infotext:
+ aktuelles menu.menuinfo +
+ aktuelles menu.lizenznummer +
+ aktuelles menu.versionsnummer.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+END PROC oeffne menu;
+PROC show menu:
+ ueberpruefe menudaten;
+ stelle hauptmenuleiste zusammen;
+ zeige hauptmenu an;
+ stelle aktuellen hauptmenupunkt invers dar;
+ schreibe aktuelles untermenu auf bildschirm;
+
+ zeige informationszeile an.
+ ueberpruefe menudaten:
+ IF anzahl offener menus = 0
+ THEN errorstop (fehlermeldung [8])
+ ELIF aktuelles menu.anzahl hauptmenupunkte < 1
+ THEN errorstop (fehlermeldung [9])
+ FI.
+ stelle hauptmenuleiste zusammen:
+ TEXT VAR hauptmenuzeile :: "";
+ INT VAR zeiger;
+ hauptmenuzeile CAT aktuelles menu.menuname;
+ hauptmenuzeile CAT ":";
+ FOR zeiger FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP
+ haenge hauptmenupunkt an
+
+ PER.
+ haenge hauptmenupunkt an:
+ hauptmenuzeile CAT hauptmenuluecke;
+ hauptmenuzeile CAT hauptmenupunktname.
+ hauptmenupunktname:
+ aktuelles menu.einzelmenu [zeiger].ueberschrift.
+ zeige hauptmenu an:
+ page (menuwindow, TRUE);
+ out menuframe (area (menuwindow));
+ cursor (menuwindow, 1, 1);
+ out (menuwindow, hauptmenuzeile).
+ stelle aktuellen hauptmenupunkt invers dar:
+ cursor (menuwindow, startposition, 1);
+ out (menuwindow, invers (ueberschrifttext)).
+
+ startposition:
+ aktuelles untermenu.anfangsposition - 1.
+ ueberschrifttext:
+ aktuelles untermenu.ueberschrift.
+ zeige informationszeile an:
+ write permanent footnote (hinweis [1]).
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC show menu;
+PROC schreibe aktuelles untermenu auf bildschirm:
+ ermittle linke obere ecke des untermenukastens;
+ wirf untermenu aus;
+
+ show menunotice;
+ cursor in warteposition.
+ ermittle linke obere ecke des untermenukastens:
+ aktuelles menu.untermenuanfang := menumitte - halbe menubreite;
+ achte auf randextrema.
+ menumitte:
+ startposition + (length (ueberschrifttext) DIV 2) - 1.
+ startposition:
+ aktuelles untermenu.anfangsposition.
+ ueberschrifttext:
+ aktuelles untermenu.ueberschrift.
+ halbe menubreite:
+ aktuelles untermenu.maxlaenge DIV 2.
+ achte auf randextrema:
+ gleiche ggf linken rand aus;
+
+ gleiche ggf rechten rand aus.
+ gleiche ggf linken rand aus:
+ IF aktuelles menu.untermenuanfang < 4
+ THEN aktuelles menu.untermenuanfang := 4
+ FI.
+ gleiche ggf rechten rand aus:
+ IF (aktuelles menu.untermenuanfang + aktuelles untermenu.maxlaenge) >
+ (areaxsize (menuwindow) - 3)
+ THEN aktuelles menu.untermenuanfang
+ := areaxsize (menuwindow) - aktuelles untermenu.maxlaenge - 3
+ FI.
+ wirf untermenu aus:
+ IF aktuelles menu.untermenuzeiger = 0
+
+ THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt
+ FI;
+ wirf untermenukopfzeile aus;
+ wirf untermenurumpf aus;
+ wirf untermenufusszeile aus;
+ markiere aktuellen untermenupunkt.
+ wirf untermenukopfzeile aus:
+ cursor (menuwindow, spalte, anfangszeile);
+ out (balken oben); striche; out (balken oben).
+ wirf untermenufusszeile aus:
+ cursor (menuwindow, spalte, endezeile);
+ out (ecke unten links); striche; out (ecke unten rechts).
+ spalte:
+
+ aktuelles menu.untermenuanfang - 3.
+ anfangszeile:
+ erste untermenuzeile - 1.
+ endezeile:
+ erste untermenuzeile + aktuelles untermenu.belegt.
+ striche:
+ (aktuelles untermenu.maxlaenge + 5) TIMESOUT waagerecht.
+ wirf untermenurumpf aus:
+ INT VAR laufvar;
+ INT CONST aktuelle punktlaenge :: aktuelles untermenu.maxlaenge + 1;
+ FOR laufvar FROM 1 UPTO aktuelles untermenu.belegt REP
+ wirf eine einzelne menuzeile aus
+ PER.
+ wirf eine einzelne menuzeile aus:
+
+ out with beam (area (menuwindow), menuspalte, menuzeile,
+ aktueller punktname, laenge).
+ menuspalte:
+ aktuelles menu.untermenuanfang.
+ menuzeile:
+ erste untermenuzeile + laufvar - 1.
+ aktueller punktname:
+ untermenubezeichnung (laufvar).
+ laenge:
+ aktuelle punktlaenge.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC schreibe aktuelles untermenu auf bildschirm;
+
+PROC loesche aktuelles untermenu auf bildschirm:
+ beende aktuelle untermenuoperationen;
+ loesche untermenu auf bildschirm;
+ schreibe balken wieder hin;
+ aktuelles menu.untermenuzeiger := 1.
+ beende aktuelle untermenuoperationen:
+ IF leaveoperation <> ""
+ THEN fuehre operation aus (leaveoperation)
+ FI.
+ leaveoperation:
+ compress (aktuelles untermenu.leaveprozedurname).
+ loesche untermenu auf bildschirm:
+ INT VAR laufvar;
+ FOR laufvar FROM aktuelles untermenu.belegt + 1 DOWNTO 1 REP
+
+ loesche eine einzelne menuzeile
+ PER.
+ loesche eine einzelne menuzeile:
+ erase with beam (area (menuwindow), menuspalte, menuzeile, laenge).
+ menuspalte:
+ aktuelles menu.untermenuanfang.
+ menuzeile:
+ erste untermenuzeile + laufvar - 1.
+ laenge:
+ aktuelles untermenu.maxlaenge + 1.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+ schreibe balken wieder hin:
+
+ cursor (menuwindow, spalte, anfangszeile);
+ (aktuelles untermenu.maxlaenge + 7) TIMESOUT waagerecht.
+ spalte:
+ aktuelles menu.untermenuanfang - 3.
+ anfangszeile:
+ erste untermenuzeile - 1.
+END PROC loesche aktuelles untermenu auf bildschirm;
+PROC markiere aktuellen untermenupunkt:
+ IF aktuelles menu.untermenuzeiger <> 0
+ THEN laufe ggf zum naechsten aktiven menupunkt;
+ out invers with beam (area (menuwindow), menuspalte, menuzeile,
+ aktueller punktname, laenge)
+
+ FI.
+ laufe ggf zum naechsten aktiven menupunkt:
+ IF NOT aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].aktiv
+ THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt
+ FI.
+ menuspalte:
+ aktuelles menu.untermenuanfang.
+ menuzeile:
+ erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.
+ aktueller punktname:
+ untermenubezeichnung (aktuelles menu.untermenuzeiger).
+ laenge:
+ aktuelles untermenu.maxlaenge + 1.
+ aktuelles menu:
+
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC markiere aktuellen untermenupunkt;
+PROC demarkiere aktuellen untermenupunkt:
+ IF aktuelles menu.untermenuzeiger <> 0
+ THEN erase invers (area (menuwindow), menuspalte, menuzeile, laenge);
+ out (area (menuwindow), menuspalte, menuzeile,
+ aktueller punktname, laenge)
+ FI.
+ menuspalte:
+ aktuelles menu.untermenuanfang.
+
+ menuzeile:
+ erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.
+ aktueller punktname:
+ untermenubezeichnung (aktuelles menu.untermenuzeiger).
+ laenge:
+ aktuelles untermenu.maxlaenge + 1.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC demarkiere aktuellen untermenupunkt;
+INT PROC folgender aktiver untermenupunkt:
+ INT VAR anzahl aktiver menupunkte :: 0;
+
+ untersuche anzahl aktiver menupunkte;
+ IF kein aktiver menupunkt vorhanden
+ THEN 0
+ ELIF nur ein aktiver menupunkt vorhanden
+ THEN liefere einzigen aktiven menupunkt
+ ELSE liefere naechsten aktiven menupunkt
+ FI.
+ untersuche anzahl aktiver menupunkte:
+ INT VAR zaehler, position;
+ FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP
+ IF aktuelles untermenu.menupunkt [zaehler].aktiv
+ THEN anzahl aktiver menupunkte INCR 1;
+ position := zaehler
+
+ FI
+ UNTIL anzahl aktiver menupunkte > 1 PER.
+ kein aktiver menupunkt vorhanden:
+ anzahl aktiver menupunkte = 0.
+ nur ein aktiver menupunkt vorhanden:
+ anzahl aktiver menupunkte = 1.
+ liefere einzigen aktiven menupunkt:
+ position.
+ liefere naechsten aktiven menupunkt:
+ INT VAR interner zeiger;
+ stelle internen zeiger auf den naechsten menupunkt;
+ WHILE NOT punkt ist aktiv REP
+ untersuche naechsten menupunkt
+ PER;
+ ergebnis.
+ stelle internen zeiger auf den naechsten menupunkt:
+
+ IF aktuelles menu.untermenuzeiger = letzter untermenupunkt
+ THEN interner zeiger := 1
+ ELSE interner zeiger := aktuelles menu.untermenuzeiger + 1
+ FI.
+ letzter untermenupunkt:
+ aktuelles untermenu.belegt.
+ punkt ist aktiv:
+ aktuelles untermenu.menupunkt [interner zeiger].aktiv.
+ untersuche naechsten menupunkt:
+ IF interner zeiger = letzter untermenupunkt
+ THEN interner zeiger := 1
+ ELSE interner zeiger INCR 1
+ FI.
+
+ ergebnis:
+ interner zeiger.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC folgender aktiver untermenupunkt;
+INT PROC vorausgehender aktiver untermenupunkt:
+ INT VAR anzahl aktiver menupunkte :: 0;
+ untersuche anzahl aktiver menupunkte;
+ IF kein aktiver menupunkt vorhanden
+ THEN 0
+ ELIF nur ein aktiver menupunkt vorhanden
+ THEN liefere einzigen aktiven menupunkt
+
+ ELSE liefere vorausgehenden aktiven menupunkt
+ FI.
+ untersuche anzahl aktiver menupunkte:
+ INT VAR zaehler, position;
+ FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP
+ IF aktuelles untermenu.menupunkt [zaehler].aktiv
+ THEN anzahl aktiver menupunkte INCR 1;
+ position := zaehler
+ FI
+ UNTIL anzahl aktiver menupunkte > 1 PER.
+ kein aktiver menupunkt vorhanden:
+ anzahl aktiver menupunkte = 0.
+ nur ein aktiver menupunkt vorhanden:
+ anzahl aktiver menupunkte = 1.
+
+ liefere einzigen aktiven menupunkt:
+ position.
+ liefere vorausgehenden aktiven menupunkt:
+ INT VAR interner zeiger;
+ stelle internen zeiger auf vorausgehenden menupunkt;
+ WHILE NOT punkt ist aktiv REP
+ untersuche vorausgehenden menupunkt
+ PER;
+ ergebnis.
+ stelle internen zeiger auf vorausgehenden menupunkt:
+ IF aktuelles menu.untermenuzeiger <= 1
+ THEN interner zeiger := letzter untermenupunkt
+ ELSE interner zeiger := aktuelles menu.untermenuzeiger - 1
+
+ FI.
+ letzter untermenupunkt:
+ aktuelles untermenu.belegt.
+ punkt ist aktiv:
+ aktuelles untermenu.menupunkt [interner zeiger].aktiv.
+ untersuche vorausgehenden menupunkt:
+ IF interner zeiger = 1
+ THEN interner zeiger := letzter untermenupunkt
+ ELSE interner zeiger DECR 1
+ FI.
+ ergebnis:
+ interner zeiger.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+
+END PROC vorausgehender aktiver untermenupunkt;
+PROC cursor in warteposition:
+ cursor (areax (menuwindow), areay (menuwindow) + 1)
+END PROC cursor in warteposition;
+TEXT PROC untermenubezeichnung (INT CONST position):
+ TEXT VAR bezeichnung :: "";
+ bezeichnung CAT kennzeichnung;
+ bezeichnung CAT punktkennung;
+ bezeichnung.
+ kennzeichnung:
+ IF aktueller menupunkt.aktiv
+ AND aktueller menupunkt.angewaehlt
+ THEN "*"
+ ELIF aktueller menupunkt.aktiv
+
+ AND aktueller menupunkt.punktkuerzel <> ""
+ THEN aktueller menupunkt.punktkuerzel
+ ELIF aktueller menupunkt.aktiv
+ AND aktueller menupunkt.punktkuerzel = ""
+ THEN blank
+ ELSE "-"
+ FI.
+ punktkennung:
+ IF menupunkt ist trennzeile
+ THEN strichellinie
+ ELSE aktueller menupunkt.punktname
+ FI.
+ menupunkt ist trennzeile:
+ aktueller menupunkt.punktname = (blank + trennzeilensymbol).
+ strichellinie:
+
+ (aktuelles untermenu.maxlaenge + 1) * "-".
+ aktueller menupunkt:
+ aktuelles untermenu.menupunkt [position].
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC untermenubezeichnung;
+PROC fuehre operation aus (TEXT CONST operation):
+ disable stop;
+ IF operation = ""
+ THEN menuinfo (infotext [1]);
+ LEAVE fuehre operation aus
+ FI;
+ do (operation);
+
+ IF is error
+ THEN menuinfo (errormessage, 5);
+ clear error
+ FI;
+ old menufootnote;
+ enable stop;
+ cursor off
+END PROC fuehre operation aus;
+PROC veraendere aktivierung (TEXT CONST unterpunkt, BOOL CONST eintrag):
+ INT VAR unterpunktposition :: 0, zeiger;
+ suche unterpunkt;
+ aendere aktivierung.
+ suche unterpunkt:
+ FOR zeiger FROM 1 UPTO untermenuende REP
+ IF untermenupunkt = blank + compress (unterpunkt)
+ THEN unterpunktposition := zeiger;
+ LEAVE suche unterpunkt
+
+ FI
+ PER;
+ LEAVE veraendere aktivierung.
+ untermenuende:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.
+ untermenupunkt:
+ aktuelles untermenu.menupunkt [zeiger].punktname.
+ aendere aktivierung:
+ aktuelles untermenu.menupunkt [unterpunktposition].aktiv := eintrag.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC veraendere aktivierung;
+
+PROC veraendere aktivierung (INT CONST punktnummer, BOOL CONST eintrag):
+ IF punktnummer >= 1 AND punktnummer <= untermenuende
+ THEN aktuelles untermenu.menupunkt [punktnummer].aktiv := eintrag
+ FI.
+ untermenuende:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC veraendere aktivierung;
+PROC veraendere anwahl (TEXT CONST unterpunkt, BOOL CONST eintrag):
+
+ INT VAR unterpunktposition :: 0, zeiger;
+ suche unterpunkt;
+ aendere anwahl.
+ suche unterpunkt:
+ FOR zeiger FROM 1 UPTO untermenuende REP
+ IF untermenupunkt = blank + compress (unterpunkt)
+ THEN unterpunktposition := zeiger;
+ LEAVE suche unterpunkt
+ FI
+ PER;
+ enable stop;
+ errorstop (fehlermeldung [10]).
+ untermenuende:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.
+ untermenupunkt:
+ aktuelles untermenu.menupunkt [zeiger].punktname.
+
+ aendere anwahl:
+ aktuelles untermenu.menupunkt [unterpunktposition].angewaehlt := eintrag.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC veraendere anwahl;
+PROC activate (TEXT CONST unterpunkt):
+ enable stop;
+ veraendere aktivierung (unterpunkt, TRUE)
+END PROC activate;
+PROC activate (INT CONST punktnummer):
+ enable stop;
+ veraendere aktivierung (punktnummer, TRUE)
+
+END PROC activate;
+PROC deactivate (TEXT CONST unterpunkt):
+ enable stop;
+ veraendere aktivierung (unterpunkt, FALSE)
+END PROC deactivate;
+PROC deactivate (INT CONST punktnummer):
+ enable stop;
+ veraendere aktivierung (punktnummer, FALSE)
+END PROC deactivate;
+PROC select (TEXT CONST unterpunkt):
+ enable stop;
+ veraendere anwahl (unterpunkt, TRUE)
+END PROC select;
+PROC deselect (TEXT CONST unterpunkt):
+ enable stop;
+ veraendere anwahl (unterpunkt, FALSE)
+END PROC deselect;
+
+PROC schliesse menu:
+ IF aktuelles menu.menuausgangsprozedur <> ""
+ THEN menufootnote (hinweis [3]);
+ fuehre operation aus (aktuelles menu.menuausgangsprozedur)
+ FI;
+ anzahl offener menus DECR 1;
+ IF anzahl offener menus = 1
+ THEN aktiviere das auf eis gelegte menu
+ FI.
+ aktiviere das auf eis gelegte menu:
+ menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;
+ menuwindow := window (1, 1, 79, 24);
+ show menu.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+
+END PROC schliesse menu;
+PROC refresh submenu:
+ schreibe aktuelles untermenu auf bildschirm;
+ show menunotice;
+END PROC refresh submenu;
+PROC regenerate menuscreen:
+ IF anzahl offener menus = 0
+ THEN errorstop (fehlermeldung [8])
+ ELIF anzahl offener menus = 1
+ THEN page;
+ show menu;
+ show menunotice
+ ELSE zeige erstes menu an;
+ zeige zweites menu an;
+ show menunotice
+ FI.
+ zeige erstes menu an:
+ INT VAR menuzeiger :: menuleiste.zeigeraktuell;
+
+ menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;
+ menuwindow := window (1, 1, 79, 24);
+ anzahl offener menus := 1;
+ show menu.
+ zeige zweites menu an:
+ menuleiste.zeigeraktuell := menuzeiger;
+ menuwindow := window (6, 4, 73, 20);
+ anzahl offener menus := 2;
+ show menu.
+END PROC regenerate menuscreen;
+PROC menuinfo (TEXT CONST t, INT CONST position, timelimit):
+ boxinfo (menuwindow, t, position, timelimit, FALSE);
+ schreibe aktuelles untermenu auf bildschirm;
+
+ old menufootnote
+END PROC menuinfo;
+PROC menuinfo (TEXT CONST t, INT CONST position):
+ menuinfo (t, position, maxint)
+END PROC menuinfo;
+PROC menuinfo (TEXT CONST t):
+ menuinfo (t, 5, maxint)
+END PROC menuinfo;
+INT PROC menualternative (TEXT CONST t, auswahlliste, zusatztasten,
+ INT CONST position, BOOL CONST mit abbruch):
+ INT VAR ergebnis := boxalternative (menuwindow, t, auswahlliste,
+ zusatztasten, position, mit abbruch, FALSE);
+
+ schreibe aktuelles untermenu auf bildschirm;
+ old menufootnote;
+ ergebnis
+END PROC menualternative;
+BOOL PROC menuyes (TEXT CONST frage, INT CONST position):
+ BOOL VAR wert := boxyes (menuwindow, frage, position, FALSE);
+ schreibe aktuelles untermenu auf bildschirm;
+ old menufootnote;
+ wert
+END PROC menuyes;
+BOOL PROC menuno (TEXT CONST frage, INT CONST position):
+ NOT menuyes (frage, position)
+END PROC menuno;
+TEXT PROC menuone (THESAURUS CONST thes, TEXT CONST t1, t2,
+ BOOL CONST mit reinigung):
+
+ TEXT CONST wert :: boxone (menuwindow, thes, t1, t2, mit reinigung);
+ IF mit reinigung
+ THEN schreibe aktuelles untermenu auf bildschirm;
+ old menufootnote
+ FI;
+ wert
+END PROC menuone;
+THESAURUS PROC menusome (THESAURUS CONST thes, TEXT CONST t1, t2,
+ BOOL CONST mit reinigung):
+ THESAURUS CONST thesaurus :: boxsome (menuwindow, thes, t1, t2,
+ mit reinigung);
+ IF mit reinigung
+ THEN schreibe aktuelles untermenu auf bildschirm;
+
+ old menufootnote
+ FI;
+ thesaurus
+END PROC menusome;
+TEXT PROC menuanswer (TEXT CONST t, vorgabe, INT CONST position):
+ TEXT VAR wert :: boxanswer (menuwindow, t, vorgabe, position, FALSE);
+ schreibe aktuelles untermenu auf bildschirm;
+ old menufootnote;
+ wert
+END PROC menuanswer;
+TEXT PROC menuanswerone (TEXT CONST t, vorgabe, THESAURUS CONST thes,
+ TEXT CONST t1, t2, BOOL CONST mit reinigung):
+ TEXT VAR wert :: boxanswerone (menuwindow, t, vorgabe, thes, t1, t2,
+
+ mit reinigung, FALSE)
+ IF mit reinigung
+ THEN schreibe aktuelles untermenu auf bildschirm;
+ old menufootnote
+ FI;
+ wert
+END PROC menuanswer one;
+THESAURUS PROC menuanswersome (TEXT CONST t, vorgabe, THESAURUS CONST thes,
+ TEXT CONST t1, t2, BOOL CONST mit reinigung):
+ THESAURUS VAR wert :: boxanswersome (menuwindow, t, vorgabe,
+ thes, t1, t2, mit reinigung, FALSE)
+
+ IF mit reinigung
+ THEN schreibe aktuelles untermenu auf bildschirm;
+ old menufootnote
+ FI;
+ wert
+END PROC menuanswersome;
+PROC menufootnote (TEXT CONST t):
+ cursor (menuwindow, 1, areaysize (menuwindow) - 1);
+ areaxsize (menuwindow) TIMESOUT waagerecht;
+ cursor (menuwindow, 1, areaysize (menuwindow));
+ outtext (t, 1, areaxsize (menuwindow))
+END PROC menufootnote;
+PROC old menufootnote:
+ menufootnote (permanent footnote)
+END PROC old menufootnote;
+TEXT PROC menubasistext (INT CONST nummer):
+
+ IF nummer <= 20
+ THEN fehlermeldung [12]
+ ELIF nummer > menuleiste.menutext.anzahl menutexte
+ THEN fehlermeldung [11]
+ ELSE menuleiste.menutext.platz [nummer]
+ FI
+END PROC menubasistext;
+TEXT PROC anwendungstext (INT CONST nummer):
+ IF nummer > menuleiste.infotext.anzahl infotexte
+ THEN fehlermeldung [11]
+ ELSE menuleiste.infotext.stelle [nummer]
+ FI
+END PROC anwendungstext;
+PROC zeige menukennung:
+ IF anzahl offener menus = 0
+ THEN zeige angaben und emblem;
+
+ FI.
+ zeige angaben und emblem:
+ ROW 5 WINDOW VAR w;
+ w [ 1] := window (40, 3, 30, 9);
+ w [ 2] := window (36, 5, 30, 9);
+ w [ 3] := window (30, 7, 30, 9);
+ w [ 4] := window (22, 9, 30, 9);
+ w [ 5] := window (12, 11, 30, 9);
+ page;
+ show (w [1]); out (w [1], center (w [1], invers (systemkuerzel)));
+ show (w [2]); out (w [2], " Version " + versionsnummer);
+ show (w [3]); out (w [3], copyright1);
+ show (w [4]); out (w [4], copyright2);
+ show (w [5]);
+
+ cursor (w [5], 1, 2);out (w [5], " lll sssssssss ");
+ cursor (w [5], 1, 3);out (w [5], " lll sss sss ");
+ cursor (w [5], 1, 4);out (w [5], " lll sss ");
+ cursor (w [5], 1, 5);out (w [5], " lll sssssssss ");
+ cursor (w [5], 1, 6);out (w [5], " lll sss ");
+ cursor (w [5], 1, 7);out (w [5], " lll latta soft sss ");
+ cursor (w [5], 1, 8);out (w [5], " lllllllll sssssssss ");
+ cursor (79, 24);
+
+ zeitpunkt := clock (1);
+END PROC zeige menukennung;
+PROC reset dialog:
+ angekoppelte menutafel := "";
+ anzahl offener menus := 0
+END PROC reset dialog;
+PROC write permanent footnote (TEXT CONST t):
+ permanent footnote := t;
+ cursor (menuwindow, 1, areaysize (menuwindow));
+ outtext (t, 1, areaxsize (menuwindow))
+END PROC write permanent footnote;
+PROC write menunotice (TEXT CONST t, INT CONST position):
+ erase menunotice;
+ boxnotice (menuwindow, t, position, menunotizx, menunotizy,
+
+ menunotizxsize, menunotizysize);
+ menunotiztext := t;
+ menunotizposition := position;
+ menunotiz ist gesetzt := TRUE
+END PROC write menunotice;
+PROC show menunotice:
+ IF menunotiz ist gesetzt
+ THEN boxnotice (menuwindow, menunotiztext, menunotizposition,
+ menunotizx, menunotizy, menunotizxsize, menunotizysize);
+ FI
+END PROC show menunotice;
+PROC erase menunotice:
+ INT VAR spa, zei;
+ get cursor (spa, zei);
+
+ IF menunotiz ist gesetzt
+ THEN page up (menunotizx, menunotizy, menunotizxsize, menunotizysize);
+ menunotiz ist gesetzt := FALSE;
+ cursor (spa, zei)
+ FI
+END PROC erase menunotice;
+PROC initialize menuwindow:
+ schreibfenster := window (areax (menuwindow) + 1,
+ areay (menuwindow) + 3,
+ areaxsize (menuwindow) - 2,
+ areaysize (menuwindow) - 4)
+END PROC initialize menuwindow;
+
+PROC show menuwindow:
+ initialize menuwindow;
+ show (schreibfenster);
+END PROC show menuwindow;
+PROC menuwindow page:
+ initialize menuwindow;
+ page (schreibfenster)
+END PROC menuwindow page;
+PROC menuwindowout (TEXT CONST text):
+ out (schreibfenster, text)
+END PROC menuwindow out;
+PROC menuwindowget (TEXT VAR text):
+ get (schreibfenster, text)
+END PROC menuwindowget;
+PROC menuwindoweditget (TEXT VAR text):
+ editget (schreibfenster, text)
+END PROC menuwindoweditget;
+PROC menuwindowedit (TEXT CONST dateiname):
+
+ initialize menuwindow;
+ edit (schreibfenster, dateiname)
+END PROC menuwindowedit;
+PROC menuwindowedit (FILE VAR f):
+ initialize menuwindow;
+ edit (schreibfenster, f)
+END PROC menuwindowedit;
+PROC menuwindowshow (TEXT CONST dateiname):
+ initialize menuwindow;
+ show (schreibfenster, dateiname)
+END PROC menuwindowshow;
+PROC menuwindowshow (FILE VAR f):
+ initialize menuwindow;
+ show (schreibfenster, f)
+END PROC menuwindowshow;
+BOOL PROC menuwindowyes (TEXT CONST frage):
+ yes (schreibfenster, frage)
+
+END PROC menuwindowyes;
+BOOL PROC menuwindowno (TEXT CONST frage):
+ no (schreibfenster, frage)
+END PROC menuwindowno;
+PROC menuwindowline:
+ menuwindowline (1)
+END PROC menuwindowline;
+PROC menuwindowline (INT CONST anzahl):
+ line (schreibfenster, anzahl)
+END PROC menuwindowline;
+PROC menuwindowcursor (INT CONST spa, zei):
+ cursor (schreibfenster, spa, zei)
+END PROC menuwindowcursor;
+PROC get menuwindowcursor (INT VAR spa, zei):
+ get cursor (schreibfenster, spa, zei)
+END PROC get menuwindowcursor;
+
+INT PROC remaining menuwindowlines:
+ remaining lines (schreibfenster)
+END PROC remaining menuwindowlines;
+TEXT PROC menuwindowcenter (TEXT CONST t):
+ center (schreibfenster, t)
+END PROC menuwindowcenter;
+PROC menuwindowstop:
+ menuwindowstop (2)
+END PROC menuwindowstop;
+PROC menuwindowstop (INT CONST anzahl):
+ stop (schreibfenster, anzahl)
+END PROC menuwindowstop;
+WINDOW PROC current menuwindow:
+ initialize menuwindow;
+ schreibfenster
+END PROC current menuwindow;
+PROC stdinfoedit (FILE VAR f, INT CONST oberste zeile):
+
+ IF oberste zeile < 1 OR oberste zeile > 3
+ THEN errorstop (fehlermeldung [13]);
+ FI;
+ garantiere menukarte;
+ cursor (1, oberste zeile); out (cleop);
+ cursor (1, 23); out(79 * waagerecht);
+ cursor (1, 24); outtext (menubasistext (141), 1, 79);
+ editorinfofenster := window (1, oberste zeile + 1, 79, 24 - oberste zeile);
+ kommando auf taste legen ("?", "editorinformationen");
+ command dialogue (FALSE);
+ cursor on; edit (f, 1, oberste zeile, 79, 23 - oberste zeile);
+ command dialogue (TRUE);
+
+ kommando auf taste legen ("?", "").
+ garantiere menukarte:
+ TEXT VAR name := compress (menukartenname);
+ IF name = ""
+ THEN install menu (stdmenukartenname, FALSE)
+ FI.
+END PROC stdinfoedit;
+PROC stdinfoedit (FILE VAR f):
+ stdinfoedit (f, 1)
+END PROC stdinfoedit;
+PROC stdinfoedit (TEXT CONST dateiname, INT CONST oberste zeile):
+ FILE VAR f :: sequential file (modify, dateiname);
+ stdinfoedit (f, oberste zeile);
+END PROC stdinfoedit;
+PROC stdinfoedit (TEXT CONST dateiname):
+
+ stdinfoedit (dateiname, 1)
+END PROC stdinfoedit;
+PROC editorinformationen:
+ BOOL VAR ende gewuenscht :: FALSE; INT VAR z;
+ FOR z FROM startwert UPTO 22 REP
+ cursor (1, z); out (cleol);
+ PER;
+ REP
+ INT VAR erg := boxalternative (editorinfofenster,
+ menubasistext (149),
+ menubasistext (150),
+ menubasistext (151),
+ 5, FALSE, FALSE);
+ erfuelle den wunsch
+
+ UNTIL ende gewuenscht PER;
+ cursor (2, 23); 77 TIMESOUT waagerecht;
+ cursor (1, 24); outtext (menubasistext (141), 1, 79).
+ startwert:
+ areay (editorinfofenster) + 1.
+ erfuelle den wunsch:
+ SELECT erg OF
+ CASE 1, 101, 109: boxinfo (editorinfofenster, menubasistext (142), 5, maxint, FALSE)
+ CASE 2, 102, 110: boxinfo (editorinfofenster, menubasistext (143), 5, maxint, FALSE)
+ CASE 3, 103, 111: boxinfo (editorinfofenster, menubasistext (144), 5, maxint, FALSE)
+ CASE 4, 104, 112: boxinfo (editorinfofenster, menubasistext (145), 5, maxint, FALSE)
+
+ CASE 5, 105, 113: boxinfo (editorinfofenster, menubasistext (146), 5, maxint, FALSE)
+ CASE 6, 106, 114: boxinfo (editorinfofenster, menubasistext (147), 5, maxint, FALSE)
+ CASE 7, 107, 115: boxinfo (editorinfofenster, menubasistext (148), 5, maxint, FALSE)
+ CASE 8, 108, 116: ende gewuenscht := TRUE
+ OTHERWISE (*tue nichts*)
+ END SELECT
+END PROC editorinformationen;
+PROC bereinige situation:
+ page;
+ forget (ds);
+ reset dialog
+END PROC bereinige situation;
+
+PROC direktstart (TEXT CONST procname, BOOL CONST autoloeschen):
+ TEXT VAR datname := "Selbststartergenerierungsdatei", letzter := std;
+ kopple archivmenukarte an;
+ schreibe programm;
+ insertiere programm;
+ abkoppeln.
+ kopple archivmenukarte an:
+ install menu (stdmenukartenname, FALSE).
+ schreibe programm:
+ forget (datname, quiet);
+ FILE VAR f :: sequential file (output, datname);
+ putline (f, menubasistext (191));
+ putline (f, "do (""reset dialog; erase menunotice; " + procname + """);");
+
+ putline (f, menubasistext (192));
+ IF autoloeschen
+ THEN putline (f, menubasistext (193))
+ ELSE putline (f, menubasistext (194))
+ FI;
+ putline (f, menubasistext (195));
+ putline (f, menubasistext (196)).
+ insertiere programm:
+ TEXT VAR t := "insert (""" + datname + """)"; do (t).
+ abkoppeln:
+ forget (datname, quiet); last param (letzter);
+ reset dialog;
+ global manager.
+END PROC direktstart;
+END PACKET ls dialog 5;
+
diff --git a/dialog/ls-DIALOG 6 b/dialog/ls-DIALOG 6
index b27eae2..7d28f7f 100644
--- a/dialog/ls-DIALOG 6
+++ b/dialog/ls-DIALOG 6
@@ -22,81 +22,1165 @@
*)
-PACKET ls dialog 6 DEFINES{} menu archiv notizort setzen,{} menu archiv grundeinstellung,{} menu archiv zieltask einstellen,{} menu archiv zieltask aendern,{} menu archiv reservieren,{} menu archiv neue diskette,{} menu archiv schreiben,{} menu archiv checken,{} menu archiv schreibcheck,{} menu archiv holen,{} menu archiv loeschen,{} menu archiv verzeichnis,{} menu archiv verzeichnis drucken,{} menu archiv initialisieren,{}
- menu archiv reservierung aufgeben,{} archiv:{}LET menukartenname = "ls-MENUKARTE:Archiv";{}LET ack = 0,{} schreiben = 1,{} checken = 2,{} schreibcheck = 3,{} holen = 4,{} loeschen = 5,{} list code = 15,{} reserve code = 19;{}BOOL VAR zieltask ist archivmanager :: TRUE,{} archiv gehoert mir :: FALSE,{} fehlerfall :: FALSE,{} kontakt mit zieltask erfolgt :: FALSE;{}
-TEXT VAR zieltaskname :: "ARCHIVE",{} aktueller archivname :: "";{}INT VAR stationsnummer :: station (myself),{} letzte funktion :: 11,{} notizort :: 3;{}PROC archiv:{} install menu (menukartenname, FALSE);{} handle menu ("ARCHIV"){}END PROC archiv;{}PROC melde zieltaskerror (TEXT CONST meldung):{} IF meldung = menubasistext (47){} THEN menuinfo (menubasistext (123)){} ELIF meldung = menubasistext (46){}
- THEN menuinfo (menubasistext (124)){} ELIF pos (meldung, "inkonsistent") > 0{} THEN menuinfo (menubasistext (125)){} ELIF pos (meldung, "Lesen unmoeglich") > 0{} COR pos (meldung, "Schreiben unmoeglich") > 0{} THEN menuinfo (menubasistext (126)){} ELIF pos (meldung, "Archiv heisst") > 0 AND pos (meldung, "?????") > 0{} THEN menuinfo (menubasistext (127)){} ELIF pos (meldung, "Archiv heisst") > 0{} THEN menuinfo (menubasistext (128)){} ELIF pos (meldung, "Schreibfehler") > 0 CAND pos (meldung, "Archiv") > 0{}
- THEN menuinfo (menubasistext (129)){} ELIF pos (meldung, "Lesefehler") > 0{} THEN menuinfo (menubasistext (130)){} ELIF pos (meldung, "Kommando") > 0 AND pos (meldung, "unbekannt") > 0{} THEN menuinfo (menubasistext (131)){} ELIF pos (meldung, "falscher Auftrag fuer Task") > 0{} THEN menuinfo (menubasistext (132)){} ELIF meldung = menubasistext (41){} THEN menuinfo (menubasistext (133)){} ELIF meldung = menubasistext (42){} THEN menuinfo (menubasistext (134)){}
- ELIF pos (meldung, "Collector") > 0 AND pos(meldung, "fehlt") > 0{} THEN menuinfo (menubasistext (135)){} ELIF pos (meldung, "kein Zugriffsrecht auf Task") > 0{} THEN menuinfo (menubasistext (132)){} ELIF pos (meldung, "nicht initialisiert") > 0{} THEN menuinfo (menubasistext (136)){} ELIF pos (meldung, "ungueltiger Format-Code") > 0{} THEN menuinfo (menubasistext (137)){} ELSE menuinfo (invers (meldung)){} FI{}END PROC melde zieltaskerror;{}PROC menu archiv notizort setzen (INT CONST wert):{}
- SELECT wert OF{} CASE 1,2,3,4,5 : notizort := wert{} OTHERWISE notizort := 3{} END SELECT{}END PROC menu archiv notizort setzen;{}PROC menu archiv grundeinstellung (INT CONST ort):{} menu archiv zieltask aendern ("ARCHIVE", station (myself), TRUE);{} menu archiv notizort setzen (ort);{} zieltask anzeigen{}END PROC menu archiv grundeinstellung;{}PROC menu archiv zieltask einstellen:{} TEXT VAR taskname :: "";{} INT VAR stationsnr, auswahl;{} BOOL VAR ist amanager;{} erfrage daten;{}
- kontrolliere daten;{} menu archiv zieltask aendern (taskname, stationsnr, ist amanager);{} refresh submenu;{} zieltask anzeigen.{} erfrage daten:{} auswahl := menualternative (menubasistext (51), menubasistext (52),{} menubasistext (53), 5, TRUE);{} SELECT auswahl OF{} CASE 1, 101 : menu archiv zieltask aendern{} ("ARCHIVE", station (myself), TRUE );{} ausstieg{} CASE 2, 102 : menu archiv zieltask aendern{}
- (name (father), station (myself), FALSE);{} ausstieg{} CASE 3, 103 : menu archiv zieltask aendern{} ("PUBLIC", station (myself), FALSE);{} ausstieg{} CASE 4, 104 : handeinstellung{} OTHERWISE ausstieg{} END SELECT.{} ausstieg:{} refresh submenu;{} zieltask anzeigen;{} LEAVE menu archiv zieltask einstellen.{} handeinstellung:{} taskname := menuanswer (menubasistext (81), zieltaskname, 5);{}
- stationsnr := int (menuanswer (menubasistext (82),{} text (station (myself)), 5));{} ist amanager := menuyes (menubasistext (83), 5).{} kontrolliere daten:{} IF compress (taskname) = ""{} OR compress (taskname) = "-"{} OR taskname = name (myself){} THEN menuinfo (menubasistext (64));{} LEAVE menu archiv zieltask einstellen{} FI.{}END PROC menu archiv zieltask einstellen;{}PROC menu archiv zieltask aendern (TEXT CONST taskname,{}
- INT CONST stationsnr,{} BOOL CONST ist archivmanager):{} menufootnote (menubasistext (21) + menubasistext (23));{} gib ggf archiv frei;{} IF ist archivmanager{} THEN archivmanager einstellen{} ELSE sonstige task einstellen{} FI;{} aktiviere gueltige archivmenupunkte.{} gib ggf archiv frei:{} IF archiv gehoert mir{} THEN archivreservierung aufgeben{} FI.{} archivmanager einstellen:{} zieltask ist archivmanager := TRUE;{}
- zieltaskname := taskname;{} stationsnummer := stationsnr;{} kontakt mit zieltask erfolgt := FALSE;{} aktueller archivname := "";{} archiv gehoert mir := FALSE;{} letzte funktion := 11.{} sonstige task einstellen:{} zieltask ist archivmanager := FALSE;{} zieltaskname := taskname;{} stationsnummer := stationsnr;{} aktueller archivname := "";{} archiv gehoert mir := FALSE;{}
- letzte funktion := 6.{}END PROC menu archiv zieltask aendern;{}PROC menu archiv reservieren:{} TEXT VAR archivname :: "", meldung :: "";{} kontrolliere einstellung;{} menufootnote (menubasistext (21) + menubasistext (24));{} versuche archiv zu reservieren (meldung);{} werte meldung aus;{} archiv anmelden (archivname, meldung, TRUE);{} IF archivname = ""{} THEN behandle archivfehler{} ELSE aktueller archivname := archivname{} FI;{} aktiviere gueltige archivmenupunkte;{}
- refresh submenu;{} zieltask anzeigen.{} kontrolliere einstellung:{} IF NOT zieltask ist archivmanager{} THEN aktiviere gueltige archivmenupunkte;{} refresh submenu;{} LEAVE menu archiv reservieren{} ELIF NOT kontakt mit zieltask erfolgt{} THEN versuche kontakt herzustellen{} FI.{} versuche kontakt herzustellen:{} TEXT VAR fehler :: "";{} IF NOT task ist kommunikativ (fehler){} THEN melde zieltaskerror (fehler);{} melde rigoros ab;{}
- LEAVE menu archiv reservieren{} ELSE kontakt mit zieltask erfolgt := TRUE{} FI.{} werte meldung aus:{} IF meldung <> ""{} THEN melde zieltaskerror (meldung);{} melde rigoros ab;{} LEAVE menu archiv reservieren{} FI.{} behandle archivfehler:{} melde zieltaskerror (meldung);{} archivreservierung aufgeben;{} melde rigoros ab{}END PROC menu archiv reservieren;{}PROC melde rigoros ab:{} aktueller archivname := "";{} archiv gehoert mir := FALSE;{}
- kontakt mit zieltask erfolgt := FALSE{}END PROC melde rigoros ab;{}PROC versuche archiv zu reservieren (TEXT VAR fehler):{} IF NOT kontakt mit zieltask erfolgt{} THEN fehler := menubasistext (44);{} archiv gehoert mir := FALSE;{} LEAVE versuche archiv zu reservieren{} FI;{} disable stop;{} IF eigene station{} THEN reserve ("beknackter archivename",/zieltaskname ){} ELSE reserve ("beknackter archivename", stationsnummer/zieltaskname){} FI;{} IF is error{} THEN fehler := errormessage;{}
- melde rigoros ab;{} clear error{} ELSE archiv gehoert mir := TRUE;{} fehler := "";{} FI;{} enable stop{}END PROC versuche archiv zu reservieren;{}PROC archiv anmelden (TEXT VAR archivname, fehler, BOOL CONST mit anfrage):{} ueberpruefe archivbesitz;{} fuehre archivanmeldung aus.{} ueberpruefe archivbesitz:{} IF NOT archiv gehoert mir OR NOT kontakt mit zieltask erfolgt{} THEN fehler := menubasistext (45);{} melde rigoros ab;{} LEAVE archiv anmelden{}
- FI.{} fuehre archivanmeldung aus:{} IF mit anfrage{} THEN frage nach eingelegter diskette und melde an{} ELSE melde archiv unter richtigem namen an{} FI.{} frage nach eingelegter diskette und melde an:{} IF menuyes (menubasistext (84), 5){} THEN menufootnote (menubasistext (21) + menubasistext (25));{} melde archiv unter richtigem namen an{} ELSE fehler := menubasistext (46);{} aktueller archivname := "";{} LEAVE archiv anmelden{}
- FI.{} melde archiv unter richtigem namen an:{} disable stop;{} IF eigene station{} THEN reserve ("beknackter archivename",/zieltaskname);{} list (/zieltaskname);{} ELSE reserve ("beknackter archivename", stationsnummer/zieltaskname);{} list (stationsnummer/zieltaskname){} FI;{} IF is error{} THEN fehler := errormessage;{} behandle die fehlermeldung{} ELSE archivname := "beknackter archivename";{} fehler := "";{} enable stop{}
- FI.{} behandle die fehlermeldung:{} IF subtext (fehler, 1, 14) = menubasistext (61){} CAND subtext (fehler, 16, 20) <> menubasistext (62){} THEN clear error; enable stop;{} archivname := subtext (fehler, 16, length (fehler) - 1);{} melde archiv nun wirklich richtig an;{} fehler := "";{} enable stop{} ELIF subtext (fehler, 1, 14) = menubasistext (61){} CAND subtext (fehler, 16, 20) = menubasistext (62){} THEN clear error; enable stop;{}
- archivname := "";{} fehler := menubasistext (62){} ELSE clear error; enable stop;{} archivname := ""{} FI.{} melde archiv nun wirklich richtig an:{} IF eigene station{} THEN reserve (archivname,/zieltaskname);{} ELSE reserve (archivname, stationsnummer/zieltaskname){} FI.{}END PROC archiv anmelden;{}PROC menu archiv neue diskette:{} ueberpruefe reservierung;{} melde neue diskette an.{} ueberpruefe reservierung:{} IF NOT (archiv gehoert mir AND kontakt mit zieltask erfolgt){}
- THEN melde zieltaskerror (menubasistext (47));{} LEAVE menu archiv neue diskette{} FI.{} melde neue diskette an:{} TEXT VAR archivname :: "", meldung :: "";{} menufootnote (menubasistext (21) + menubasistext (26));{} archiv anmelden (archivname, meldung, FALSE);{} IF archivname = ""{} THEN behandle archivfehler{} ELSE aktueller archivname := archivname{} FI;{} zieltask anzeigen.{} behandle archivfehler:{} melde zieltaskerror (meldung);{} aktueller archivname := "".{}
-END PROC menu archiv neue diskette;{}PROC menu archiv schreiben:{} dateioperation mit zieltask (schreiben);{} regenerate menuscreen{}END PROC menu archiv schreiben;{}PROC menu archiv checken:{} dateioperation mit zieltask (checken);{} regenerate menuscreen{}END PROC menu archiv checken;{}PROC menu archiv schreibcheck:{} dateioperation mit zieltask (schreibcheck);{} regenerate menuscreen{}END PROC menu archiv schreibcheck;{}PROC menu archiv holen:{} dateioperation mit zieltask (holen);{} regenerate menuscreen{}
-END PROC menu archiv holen;{}PROC menu archiv loeschen:{} dateioperation mit zieltask (loeschen);{} regenerate menuscreen{}END PROC menu archiv loeschen;{}PROC dateioperation mit zieltask (INT CONST wahl):{} ueberpruefe kommunikationsbasis und sinnhaftigkeit;{} lasse dateien auswaehlen;{} operiere mit ausgewaehlten dateien.{} ueberpruefe kommunikationsbasis und sinnhaftigkeit:{} IF unzulaessiger zieltaskname{} THEN LEAVE dateioperation mit zieltask{} ELIF zieltaskname = name (myself){}
- THEN melde zieltaskerror (menubasistext (48));{} LEAVE dateioperation mit zieltask{} ELIF zieltask ist archivmanager AND NOT archiv gehoert mir{} THEN melde zieltaskerror (menubasistext (47));{} LEAVE dateioperation mit zieltask{} ELIF NOT zieltask ist archivmanager{} AND (wahl = checken OR wahl = schreibcheck){} THEN gib hinweis auf unmoeglich;{} LEAVE dateioperation mit zieltask{} ELIF NOT zieltask ist archivmanager{}
- THEN stelle kontakt mit zieltask her{} ELIF wahl < schreiben OR wahl > loeschen{} THEN LEAVE dateioperation mit zieltask{} FI.{} stelle kontakt mit zieltask her:{} TEXT VAR fehler :: "";{} IF task ist kommunikativ (fehler){} THEN kontakt mit zieltask erfolgt := TRUE{} ELSE melde zieltaskerror (fehler);{} LEAVE dateioperation mit zieltask{} FI.{} gib hinweis auf unmoeglich:{} menuinfo (menubasistext (121) + taskname + menubasistext (122)).{}
- taskname:{} IF eigene station{} THEN zieltaskname{} ELSE text (stationsnummer) + "/" + zieltaskname{} FI.{} lasse dateien auswaehlen:{} THESAURUS VAR angekreuzte;{} disable stop;{} IF wahl = schreiben OR wahl = schreibcheck{} THEN angekreuzte := menusome (ALL myself, operationshinweis,{} ankreuzhinweis, FALSE){} ELSE angekreuzte := menusome (zieltaskthesaurus, operationshinweis,{} ankreuzhinweis, FALSE){}
- FI;{} fehlerbehandlung.{} zieltaskthesaurus:{} IF eigene station{} THEN ALL /zieltaskname{} ELSE ALL (stationsnummer/zieltaskname){} FI.{} ankreuzhinweis:{} menubasistext (91) + operationskennzeichnung (wahl) + menubasistext (92).{} operationshinweis:{} operationsbezeichnung (wahl) + zieltaskhinweis.{} operiere mit ausgewaehlten dateien:{} bereite bildschirm vor;{} steige ggf bei leerem thesaurus aus;{} IF wahl = schreiben OR wahl = schreibcheck{} THEN zuerst loeschen{}
- FI;{} IF wahl = schreibcheck{} THEN fehlerfall := FALSE;{} dateioperation ausfuehren (angekreuzte, schreiben, FALSE);{} IF NOT fehlerfall{} THEN dateioperation ausfuehren (angekreuzte, checken, TRUE){} FI{} ELSE dateioperation ausfuehren (angekreuzte, wahl, TRUE){} FI.{} bereite bildschirm vor:{} show menuwindow.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (angekreuzte){} THEN menuwindowline (2);{} menuwindowout (menubasistext (94));{}
- menuwindowstop;{} LEAVE dateioperation mit zieltask{} FI.{} zuerst loeschen:{} menuwindowout (menuwindowcenter (menubasistext (21) + menubasistext (31)));{} menuwindowline;{} IF not empty (angekreuzte){} THEN disable stop;{} THESAURUS CONST zu loeschende ::{} angekreuzte / zieltaskthesaurus;{} fehlerbehandlung;{} biete ggf dateien zum loeschen an{} ELSE menuwindowpage{} FI.{} biete ggf dateien zum loeschen an:{}
- IF not empty (zu loeschende){} THEN menuwindowout (menuwindowcenter (invers (menubasistext (108))));{} menuwindowline;{} menuwindowout (menuwindowcenter (menubasistext (109)));{} menuwindowline (2);{} dateien rausschmeissen{} ELSE menuwindowpage{} FI.{} dateien rausschmeissen:{} command dialogue (FALSE);{} biete dateien einzeln zum loeschen an;{} menuwindowpage;{} command dialogue (TRUE).{} biete dateien einzeln zum loeschen an:{}
- INT VAR z, index;{} FOR z FROM 1 UPTO highest entry (zu loeschende) REP{} disable stop;{} IF name (zu loeschende, z) <> ""{} THEN stelle frage und fuehre aus{} FI;{} fehlerbehandlung{} PER.{} stelle frage und fuehre aus:{} IF menuwindowyes ("'" + name (zu loeschende, z) + "' "{} + menubasistext (111)){} THEN erase (name (zu loeschende, z), task (zieltaskname)){} ELSE menuwindowout (menubasistext (110));{} menuwindowline;{}
- delete (angekreuzte, name (zu loeschende, z), index);{} pause (20){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} melde zieltaskerror (errormessage);{} clear error; enable stop;{} LEAVE dateioperation mit zieltask{} FI.{}END PROC dateioperation mit zieltask;{}PROC dateioperation ausfuehren (THESAURUS CONST angekreuzte,{} INT CONST wahl,{} BOOL CONST mit schlussbemerkung):{}
- INT VAR spalte :: 1, zeile :: 3, k, anzahl :: 0;{} menuwindowout (menuwindowcenter (invers (operationsbezeichnung (wahl){} + zieltaskhinweis)));{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} IF mit schlussbemerkung{} THEN schreibe schlussbemerkung{} ELSE menuwindowpage{} FI.{} fuehre einzelne operationen aus:{} FOR k FROM 1 UPTO highest entry (angekreuzte) REP{} IF name (angekreuzte, k) <> ""{}
- THEN disable stop;{} bildschirmausgabe;{} operation ausfuehren;{} anzahl INCR 1;{} fehlerbehandlung{} FI{} PER.{} bildschirmausgabe:{} spalte := 1;{} IF remaining menuwindowlines < 2{} THEN menuwindowpage; zeile := 1{} ELSE zeile INCR 1{} FI;{} menuwindowcursor (spalte, zeile);{} ergaenzter dateiname.{} ergaenzter dateiname:{} INT VAR windowcolumn, windowrow;{} SELECT wahl OF{} CASE schreiben : menuwindowout (menubasistext (105) + dateiname){}
- CASE checken : get menuwindowcursor (windowcolumn, windowrow);{} menuwindowout (dateiname + menubasistext (106));{} menuwindowcursor (windowcolumn, windowrow);{} CASE holen : menuwindowout (menubasistext (107) + dateiname){} END SELECT.{} dateiname:{} " """ + name (angekreuzte, k) + """ ".{} operation ausfuehren:{} IF eigene station{} THEN fuehre eigenstationoperation aus{} ELSE fuehre fremdstationoperation aus{} FI.{}
- fuehre eigenstationoperation aus:{} SELECT wahl OF{} CASE schreiben : save (name (angekreuzte, k), /zieltaskname){} CASE checken : check (name (angekreuzte, k), /zieltaskname);{} bestaetige{} CASE holen : ueberschreiben erfragen eigene station{} CASE loeschen : loeschen erfragen eigene station{} END SELECT.{} ueberschreiben erfragen eigene station:{} IF exists (name (angekreuzte, k)){} THEN menuwindowline;{} IF menuwindowyes (dateiname + menubasistext (112)){}
- THEN zeile INCR 2;{} menuwindowline;{} forget (name (angekreuzte, k), quiet);{} fetch (name (angekreuzte, k), /zieltaskname){} FI{} ELSE fetch (name (angekreuzte, k), /zieltaskname){} FI.{} loeschen erfragen eigene station:{} IF menuwindowyes (dateiname + menubasistext (111)){} THEN erase (name (angekreuzte, k), /zieltaskname){} FI.{} fuehre fremdstationoperation aus:{} SELECT wahl OF{} CASE schreiben : save (name (angekreuzte, k), ziel){}
- CASE checken : check (name (angekreuzte, k), ziel); bestaetige{} CASE holen : ueberschreiben erfragen fremde station{} CASE loeschen : loeschen erfragen fremde station{} END SELECT.{} ueberschreiben erfragen fremde station:{} IF exists (name (angekreuzte, k)){} THEN menuwindowline;{} IF menuwindowyes (dateiname + menubasistext (112)){} THEN zeile INCR 2;{} menuwindowline;{} forget (name (angekreuzte, k), quiet);{}
- fetch (name (angekreuzte, k), ziel){} FI{} ELSE fetch (name (angekreuzte, k), ziel){} FI.{} loeschen erfragen fremde station:{} IF menuwindowyes (dateiname + menubasistext (111)){} THEN erase (name (angekreuzte, k), ziel){} FI.{} ziel:{} stationsnummer/zieltaskname.{} bestaetige:{} IF NOT is error{} THEN menuwindowout (dateiname + menubasistext (114)){} FI.{} schreibe schlussbemerkung:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{}
- ELSE menuwindowline (2){} FI;{} IF anzahl > 0{} THEN menuwindowout (menubasistext (93) +{} operationskennzeichnung (wahl)){} ELSE menuwindowout (menubasistext (94)){} FI;{} menuwindowstop.{} fehlerbehandlung:{} IF is error{} THEN fehlerfall := TRUE;{} regenerate menuscreen;{} melde zieltaskerror (errormessage);{} clear error; enable stop;{} LEAVE dateioperation ausfuehren{} FI.{}END PROC dateioperation ausfuehren;{}
-TEXT PROC operationsbezeichnung (INT CONST nr):{} SELECT nr OF{} CASE schreiben : menubasistext (95){} CASE checken : menubasistext (97){} CASE schreibcheck : menubasistext (99){} CASE holen : menubasistext (101){} CASE loeschen : menubasistext (103){} OTHERWISE ""{} END SELECT{}END PROC operationsbezeichnung;{}TEXT PROC operationskennzeichnung (INT CONST nr):{} SELECT nr OF{} CASE schreiben : menubasistext (96){} CASE checken : menubasistext (98){}
- CASE schreibcheck : menubasistext (100){} CASE holen : menubasistext (102){} CASE loeschen : menubasistext (104){} OTHERWISE ""{} END SELECT{}END PROC operationskennzeichnung;{}BOOL PROC not empty (THESAURUS CONST t):{} INT VAR i;{} FOR i FROM 1 UPTO highest entry (t) REP{} IF name (t, i) <> ""{} THEN LEAVE not empty WITH TRUE{} FI{} PER;{} FALSE{}END PROC not empty;{}TEXT PROC zieltaskhinweis:{} IF zieltaskname = "ARCHIVE"{} THEN "(" + menubasistext (78) + ")"{}
- ELIF zieltaskname = name (father){} THEN "(" + menubasistext (79) + ")"{} ELSE menubasistext (80) + zieltaskname + ")"{} FI{}END PROC zieltaskhinweis;{}PROC menu archiv verzeichnis:{} forget("Interne Dateiliste bei Archivoperation", quiet);{} ueberpruefe kommunikationsbasis;{} liste dateien der zieltask auf;{} regenerate menuscreen.{} ueberpruefe kommunikationsbasis:{} IF unzulaessiger zieltaskname{} THEN LEAVE menu archiv verzeichnis{} ELIF zieltaskname = name (myself){}
- THEN LEAVE ueberpruefe kommunikationsbasis{} ELIF zieltask ist archivmanager AND NOT archiv gehoert mir{} THEN melde zieltaskerror (menubasistext (47));{} LEAVE menu archiv verzeichnis{} ELIF NOT zieltask ist archivmanager{} THEN stelle kontakt mit zieltask her{} FI.{} stelle kontakt mit zieltask her:{} TEXT VAR fehler :: "";{} IF task ist kommunikativ (fehler){} THEN kontakt mit zieltask erfolgt := TRUE{} ELSE melde zieltaskerror (fehler);{}
- LEAVE menu archiv verzeichnis{} FI.{} liste dateien der zieltask auf:{} erstelle liste;{} gib liste aus;{} forget ("Interne Dateiliste bei Archivoperation", quiet).{} erstelle liste:{} menufootnote (menubasistext (21) + menubasistext (28));{} FILE VAR f :: sequential file (output, "Interne Dateiliste bei Archivoperation");{} disable stop;{} IF eigene station{} THEN list (f, /zieltaskname){} ELSE list (f, stationsnummer/zieltaskname){} FI;{} IF is error{}
- THEN melde zieltaskerror (errormessage);{} forget ("Interne Dateiliste bei Archivoperation", quiet);{} clear error; enable stop;{} LEAVE menu archiv verzeichnis{} FI;{} enable stop.{} gib liste aus:{} modify (f);{} IF NOT (zieltaskname = name (myself)){} THEN to line (f, 1);{} insert record (f);{} notiere kopfzeile;{} headline (f, menubasistext (43));{} ELSE entferne eigenen namen aus der liste{} FI;{}
- to line (f, 1);{} cursor on; menuwindowshow (f); cursor off.{} notiere kopfzeile:{} IF zieltask ist archivmanager{} THEN write record (f, headline (f));{} ELSE write record (f, zieltaskbezeichnung){} FI.{} entferne eigenen namen aus der liste:{} TEXT VAR zeile :: ""; INT VAR i;{} FOR i FROM lines (f) DOWNTO 1 REP{} to line (f, i);{} read record (f, zeile);{} IF pos (zeile, "Interne Dateiliste bei Archivoperation") > 0{} THEN delete record (f);{}
- LEAVE entferne eigenen namen aus der liste{} FI{} PER{}END PROC menu archiv verzeichnis;{}PROC menu archiv verzeichnis drucken:{} forget ("Interne Dateiliste bei Archivoperation", quiet);{} ueberpruefe kommunikationsbasis;{} erstelle listing;{} drucke listing aus.{} ueberpruefe kommunikationsbasis:{} IF unzulaessiger zieltaskname{} THEN LEAVE menu archiv verzeichnis drucken{} ELIF zieltaskname = name (myself){} THEN LEAVE ueberpruefe kommunikationsbasis{}
- ELIF zieltask ist archivmanager AND NOT archiv gehoert mir{} THEN melde zieltaskerror (menubasistext (47));{} LEAVE menu archiv verzeichnis drucken{} ELIF NOT zieltask ist archivmanager{} THEN stelle kontakt mit zieltask her{} FI.{} stelle kontakt mit zieltask her:{} TEXT VAR fehler :: "";{} IF task ist kommunikativ (fehler){} THEN kontakt mit zieltask erfolgt := TRUE{} ELSE melde zieltaskerror (fehler);{} LEAVE menu archiv verzeichnis drucken{}
- FI.{} erstelle listing:{} LET dummy name pos = 18;{} FILE VAR listfile; INT VAR i; TEXT VAR record :: "";{} TEXT CONST head :: 70 * "=", end :: 70 * "-";{} IF menuno (menubasistext (90), 5){} THEN LEAVE menu archiv verzeichnis drucken{} FI;{} menufootnote (menubasistext (21) + menubasistext (29));{} disable stop;{} listfile := sequential file (output, "Interne Dateiliste bei Archivoperation");{} IF eigene station{} THEN list (listfile, /zieltaskname){} ELSE list (listfile, stationsnummer/zieltaskname){}
- FI;{} IF is error{} THEN melde zieltaskerror (errormessage);{} forget ("Interne Dateiliste bei Archivoperation", quiet);{} clear error; enable stop;{} LEAVE menu archiv verzeichnis drucken{} FI;{} enable stop.{} drucke listing aus:{} schreibe dateikopf;{} loesche dummy names;{} schreibe fuss;{} drucke und loesche listing.{} schreibe dateikopf:{} modify (listfile);{} to line (listfile, 1);{} FOR i FROM 1 UPTO 6 REP insert record (listfile) PER;{}
- to line (listfile, 1);{} write record (listfile, "#type (""elanlist"")#"); down (listfile);{} write record (listfile, "#start (2.5,0.0)##limit (20,5)#"{} + "#pagelength (26.0)#"); down (listfile);{} write record (listfile, head); down (listfile);{} schreibe erkennungszeile; down (listfile);{} write record (listfile, " Listing vom " + date + ", "{} + time of day + " Uhr"); down (listfile);{} write record (listfile, head).{}
- schreibe erkennungszeile:{} IF zieltask ist archivmanager{} THEN write record (listfile, "Archiv: " + headline (listfile)){} ELSE write record (listfile, "Task : " + taskbezeichnung){} FI.{} taskbezeichnung:{} IF eigene station{} THEN zieltaskname{} ELSE text (stationsnummer) + "/" + zieltaskname{} FI.{} loesche dummy names:{} to line (listfile, 8);{} WHILE NOT eof (listfile) REP{} read record (listfile, record);{} IF (record SUB dummy name pos) = "-"{}
- OR pos (record, "Interne Dateiliste bei Archivoperation") > 0{} THEN delete record (listfile){} ELSE down (listfile){} FI{} PER.{} schreibe fuss:{} output (listfile);{} putline (listfile, end).{} drucke und loesche listing:{} menufootnote (menubasistext (21) + menubasistext (30));{} disable stop;{} print ("Interne Dateiliste bei Archivoperation");{} IF is error{} THEN melde zieltaskerror (errormessage);{} clear error; enable stop;{}
- forget ("Interne Dateiliste bei Archivoperation", quiet);{} LEAVE menu archiv verzeichnis drucken{} FI;{} enable stop;{} forget ("Interne Dateiliste bei Archivoperation", quiet){}END PROC menu archiv verzeichnis drucken;{}TEXT PROC zieltaskbezeichnung:{} IF eigene station{} THEN menubasistext (77) + taskbezeichnung{} ELSE menubasistext (76) + text (stationsnummer) + " " +{} menubasistext (77) + zieltaskname{} FI.{} taskbezeichnung:{} IF zieltaskname = "ARCHIVE"{}
- THEN menubasistext (78){} ELIF zieltaskname = name (father){} THEN menubasistext (79) + " (" + zieltaskname + ")"{} ELSE zieltaskname{} FI{}END PROC zieltaskbezeichnung;{}BOOL PROC unzulaessiger zieltaskname:{} IF compress (zieltaskname) = "" OR compress (zieltaskname) = "-"{} THEN TRUE{} ELSE FALSE{} FI{}END PROC unzulaessiger zieltaskname;{}PROC menu archiv initialisieren:{} TEXT VAR archivname :: "", meldung :: "";{} klaere zieltaskart;{} formatiere ggf;{}
- initialisiere ggf.{} klaere zieltaskart:{} IF NOT zieltask ist archivmanager{} THEN menuinfo (menubasistext (121) + zieltaskname +{} menubasistext (122));{} LEAVE menu archiv initialisieren{} FI.{} formatiere ggf:{} IF menuyes (menubasistext (85), 5){} THEN nimm archiv in beschlag;{} fuehre formatierung aus{} FI.{} nimm archiv in beschlag:{} stelle archivbesitz sicher;{} IF aktueller archivname <> ""{} THEN archivname := aktueller archivname{}
- ELSE archivname := menubasistext (75){} FI;{} IF eigene station{} THEN reserve (archivname,/zieltaskname){} ELSE reserve (archivname, stationsnummer/zieltaskname){} FI;{} aktueller archivname := archivname;{} archiv gehoert mir := TRUE;{} zieltask anzeigen.{} stelle archivbesitz sicher:{} IF NOT archiv gehoert mir OR NOT kontakt mit zieltask erfolgt{} THEN versuche kommunikation;{} versuche archiv zu reservieren (meldung);{} werte meldung aus{}
- FI.{} versuche kommunikation:{} TEXT VAR fehler :: "";{} IF NOT task ist kommunikativ (fehler){} THEN melde zieltaskerror (fehler);{} melde rigoros ab;{} LEAVE menu archiv initialisieren{} ELSE kontakt mit zieltask erfolgt := TRUE{} FI.{} werte meldung aus:{} IF meldung <> ""{} THEN melde zieltaskerror (meldung);{} aktueller archivname := "";{} zieltask anzeigen;{} LEAVE menu archiv initialisieren{} FI.{}
- fuehre formatierung aus:{} INT VAR auswahl :: menualternative (menubasistext (54),{} menubasistext (55),{} menubasistext (56), 5, TRUE);{} IF auswahl = 0{} THEN LEAVE fuehre formatierung aus{} FI;{} IF auswahl > 100{} THEN auswahl DECR 100{} FI;{} command dialogue (FALSE);{} disable stop;{} menufootnote (menubasistext (21) + menubasistext (27));{} IF eigene station{} THEN formatiere auf eigener station{}
- ELSE formatiere auf fremder station{} FI;{} IF is error{} THEN melde zieltaskerror (errormessage);{} clear error; enable stop;{} command dialogue (TRUE);{} LEAVE formatiere ggf{} ELSE enable stop;{} command dialogue (TRUE);{} aktiviere gueltige archivmenupunkte;{} refresh submenu;{} zieltask anzeigen{} FI.{} formatiere auf eigener station:{} IF auswahl < 5{} THEN format (auswahl, /zieltaskname){}
- ELSE format (/zieltaskname){} FI.{} formatiere auf fremder station:{} IF auswahl < 5{} THEN format (auswahl, stationsnummer/zieltaskname){} ELSE format (stationsnummer/zieltaskname){} FI.{} initialisiere ggf:{} stelle archivbesitz sicher;{} archiv anmelden (archivname, meldung, FALSE);{} IF archivname <> ""{} THEN aktueller archivname := archivname;{} archiv gehoert mir := TRUE;{} aktiviere gueltige archivmenupunkte;{} refresh submenu;{}
- zieltask anzeigen;{} frage nach ueberschreiben{} ELIF meldung = menubasistext (63) OR meldung = menubasistext (62){} THEN frage nach initialisieren{} ELSE melde zieltaskerror (meldung);{} aktueller archivname := "";{} zieltask anzeigen;{} LEAVE menu archiv initialisieren{} FI.{} frage nach ueberschreiben:{} IF menuyes (menubasistext (86) + archivname + menubasistext (87), 5){} THEN erfrage neuen namen und initialisiere{}
- ELSE LEAVE menu archiv initialisieren{} FI.{} frage nach initialisieren:{} IF menuyes (menubasistext (88), 5){} THEN erfrage neuen namen und initialisiere{} ELSE LEAVE menu archiv initialisieren{} FI.{} erfrage neuen namen und initialisiere:{} TEXT VAR neuer name := compress(menuanswer (menubasistext (89),{} aktueller archivname, 5));{} IF neuer name <> ""{} THEN archivname := neuer name{} ELIF neuer name = "" AND archivname = ""{}
- THEN archivname := menubasistext (75){} FI;{} command dialogue (FALSE);{} disable stop;{} IF eigene station{} THEN reserve (archivname, /zieltaskname);{} clear (/zieltaskname){} ELSE reserve (archivname, stationsnummer/zieltaskname);{} clear (stationsnummer/zieltaskname){} FI;{} IF is error{} THEN melde zieltaskerror (errormessage);{} clear error; enable stop;{} command dialogue (TRUE);{} melde rigoros ab;{}
- archivreservierung aufgeben;{} aktiviere gueltige archivmenupunkte;{} refresh submenu;{} zieltask anzeigen;{} LEAVE menu archiv initialisieren{} ELSE enable stop; command dialogue (TRUE);{} aktueller archivname := archivname;{} archiv gehoert mir := TRUE;{} aktiviere gueltige archivmenupunkte;{} refresh submenu;{} zieltask anzeigen{} FI{}END PROC menu archiv initialisieren;{}PROC archive (TEXT CONST archive name,task, INT CONST station):{}
- call (reserve code, archive name, station/task){}END PROC archive;{}PROC menu archiv reservierung aufgeben:{} IF archiv gehoert mir{} THEN menufootnote (menubasistext (21) + menubasistext (22));{} archivreservierung aufgeben;{} FI;{} erase menunotice;{} old menufootnote{}END PROC menu archiv reservierung aufgeben;{}PROC archivreservierung aufgeben:{} command dialogue (FALSE);{} disable stop;{} IF eigene station{} THEN release (/zieltaskname){} ELSE release (stationsnummer/zieltaskname);{}
- FI;{} IF is error{} THEN clear error{} FI;{} enable stop;{} command dialogue (TRUE);{} archiv gehoert mir := FALSE;{} aktueller archivname := ""{}END PROC archivreservierung aufgeben;{}BOOL PROC eigene station:{} IF stationsnummer = 0 OR stationsnummer = station (myself){} THEN TRUE{} ELSE FALSE{} FI{}END PROC eigene station;{}PROC aktiviere gueltige archivmenupunkte:{} IF zieltask ist archivmanager AND NOT archiv gehoert mir{} THEN aktiviere nur grundfunktionen{}
- ELSE aktiviere alle momentan gueltigen punkte{} FI.{} aktiviere alle momentan gueltigen punkte:{} IF letzte funktion = 11{} THEN activate (1); activate (2);{} activate (4); activate (5); activate (6); activate (7); activate (8);{} activate (10); activate (11);{} activate (13); activate (14);{} ELIF letzte funktion = 6{} THEN deactivate (1); deactivate (2);{} activate (4); deactivate (5); deactivate (6); activate (7); activate (8);{}
- activate (10); activate (11);{} deactivate (13); activate (14);{} FI.{} aktiviere nur grundfunktionen:{} activate (1); deactivate (2);{} deactivate (4); deactivate (5); deactivate (6); deactivate (7); deactivate (8);{} deactivate (10); deactivate (11);{} activate (13); activate (14).{}END PROC aktiviere gueltige archivmenupunkte;{}PROC zieltask anzeigen:{} IF zieltask ist archivmanager{} THEN schreibe taskname und archivname{} ELSE schreibe taskname{}
- FI.{} schreibe taskname:{} write menunotice (menubasistext (59) + ""13"" + name der task, notizort).{} schreibe taskname und archivname:{} write menunotice (menubasistext (59) + ""13"" + name der task +{} ""13"" + menubasistext (60) + ""13"" + archivname,{} notizort).{} name der task:{} IF zieltaskname = "ARCHIVE" AND eigene station{} THEN " " + menubasistext (71){} ELIF zieltaskname = "PUBLIC" AND eigene station{} THEN " " + menubasistext (72){}
- ELIF zieltaskname = name (father){} THEN " " + menubasistext (73){} ELSE " " + ggf gekuerzter zieltaskname{} FI.{} ggf gekuerzter zieltaskname:{} TEXT VAR interner name;{} IF eigene station{} THEN interner name := zieltaskname;{} ELSE interner name := text (stationsnummer) + "/" + zieltaskname{} FI;{} IF length (interner name) < 20{} THEN ""15"" + interner name + " "14""{} ELSE ""15"" + subtext (interner name, 1 , 18) + ".." + " "14""{} FI.{}
- archivname:{} IF NOT archiv gehoert mir OR aktueller archivname = ""{} THEN " " + menubasistext (74){} ELSE " "15"" + ggf gekuerzter archivname + " "14""{} FI.{} ggf gekuerzter archivname:{} IF eigene station AND length (aktueller archivname) > 20{} THEN subtext (aktueller archivname, 1, 18) + ".."{} ELIF NOT eigene station AND length (aktueller archivname) > 17{} THEN subtext (aktueller archivname, 1, 15) + ".."{} ELSE aktueller archivname{} FI.{}
-END PROC zieltask anzeigen;{}BOOL PROC task ist kommunikativ (TEXT VAR fehler):{} INT VAR antwort;{} DATASPACE VAR dummy space := nilspace;{} IF zieltask ist archivmanager{} THEN schicke reservierungscode{} ELSE schicke listcode{} FI.{} schicke reservierungscode:{} disable stop;{} IF eigene station{} THEN pingpong (/zieltaskname, reserve code, dummy space, antwort);{} ELSE pingpong (stationsnummer/zieltaskname, reserve code,{} dummy space, antwort){}
- FI;{} werte antwort aus.{} schicke listcode:{} disable stop;{} IF eigene station{} THEN pingpong (/zieltaskname, list code, dummy space, antwort);{} ELSE pingpong (stationsnummer/zieltaskname, list code,{} dummy space, antwort){} FI;{} werte antwort aus.{} werte antwort aus:{} IF is error{} THEN clear error{} FI;{} BOUND TEXT VAR inhalt := dummy space;{} enable stop;{} IF antwort = 0 THEN fehler := ""{} ELIF antwort = -1 THEN fehler := menubasistext (41){}
- ELIF antwort = -2 THEN fehler := menubasistext (42){} ELSE fehler := inhalt{} FI;{} forget (dummy space);{} IF antwort = ack{} THEN kontakt mit zieltask erfolgt := TRUE; TRUE{} ELSE kontakt mit zieltask erfolgt := FALSE; FALSE{} FI{}END PROC task ist kommunikativ;{}END PACKET ls dialog 6;{}
+PACKET ls dialog 6 DEFINES
+ menu archiv notizort setzen,
+ menu archiv grundeinstellung,
+ menu archiv zieltask einstellen,
+ menu archiv zieltask aendern,
+ menu archiv reservieren,
+ menu archiv neue diskette,
+ menu archiv schreiben,
+ menu archiv checken,
+ menu archiv schreibcheck,
+ menu archiv holen,
+ menu archiv loeschen,
+ menu archiv verzeichnis,
+ menu archiv verzeichnis drucken,
+ menu archiv initialisieren,
+
+ menu archiv reservierung aufgeben,
+ archiv:
+LET menukartenname = "ls-MENUKARTE:Archiv";
+LET ack = 0,
+ schreiben = 1,
+ checken = 2,
+ schreibcheck = 3,
+ holen = 4,
+ loeschen = 5,
+ list code = 15,
+ reserve code = 19;
+BOOL VAR zieltask ist archivmanager :: TRUE,
+ archiv gehoert mir :: FALSE,
+ fehlerfall :: FALSE,
+ kontakt mit zieltask erfolgt :: FALSE;
+
+TEXT VAR zieltaskname :: "ARCHIVE",
+ aktueller archivname :: "";
+INT VAR stationsnummer :: station (myself),
+ letzte funktion :: 11,
+ notizort :: 3;
+PROC archiv:
+ install menu (menukartenname, FALSE);
+ handle menu ("ARCHIV")
+END PROC archiv;
+PROC melde zieltaskerror (TEXT CONST meldung):
+ IF meldung = menubasistext (47)
+ THEN menuinfo (menubasistext (123))
+ ELIF meldung = menubasistext (46)
+
+ THEN menuinfo (menubasistext (124))
+ ELIF pos (meldung, "inkonsistent") > 0
+ THEN menuinfo (menubasistext (125))
+ ELIF pos (meldung, "Lesen unmoeglich") > 0
+ COR pos (meldung, "Schreiben unmoeglich") > 0
+ THEN menuinfo (menubasistext (126))
+ ELIF pos (meldung, "Archiv heisst") > 0 AND pos (meldung, "?????") > 0
+ THEN menuinfo (menubasistext (127))
+ ELIF pos (meldung, "Archiv heisst") > 0
+ THEN menuinfo (menubasistext (128))
+ ELIF pos (meldung, "Schreibfehler") > 0 CAND pos (meldung, "Archiv") > 0
+
+ THEN menuinfo (menubasistext (129))
+ ELIF pos (meldung, "Lesefehler") > 0
+ THEN menuinfo (menubasistext (130))
+ ELIF pos (meldung, "Kommando") > 0 AND pos (meldung, "unbekannt") > 0
+ THEN menuinfo (menubasistext (131))
+ ELIF pos (meldung, "falscher Auftrag fuer Task") > 0
+ THEN menuinfo (menubasistext (132))
+ ELIF meldung = menubasistext (41)
+ THEN menuinfo (menubasistext (133))
+ ELIF meldung = menubasistext (42)
+ THEN menuinfo (menubasistext (134))
+
+ ELIF pos (meldung, "Collector") > 0 AND pos(meldung, "fehlt") > 0
+ THEN menuinfo (menubasistext (135))
+ ELIF pos (meldung, "kein Zugriffsrecht auf Task") > 0
+ THEN menuinfo (menubasistext (132))
+ ELIF pos (meldung, "nicht initialisiert") > 0
+ THEN menuinfo (menubasistext (136))
+ ELIF pos (meldung, "ungueltiger Format-Code") > 0
+ THEN menuinfo (menubasistext (137))
+ ELSE menuinfo (invers (meldung))
+ FI
+END PROC melde zieltaskerror;
+PROC menu archiv notizort setzen (INT CONST wert):
+
+ SELECT wert OF
+ CASE 1,2,3,4,5 : notizort := wert
+ OTHERWISE notizort := 3
+ END SELECT
+END PROC menu archiv notizort setzen;
+PROC menu archiv grundeinstellung (INT CONST ort):
+ menu archiv zieltask aendern ("ARCHIVE", station (myself), TRUE);
+ menu archiv notizort setzen (ort);
+ zieltask anzeigen
+END PROC menu archiv grundeinstellung;
+PROC menu archiv zieltask einstellen:
+ TEXT VAR taskname :: "";
+ INT VAR stationsnr, auswahl;
+ BOOL VAR ist amanager;
+ erfrage daten;
+
+ kontrolliere daten;
+ menu archiv zieltask aendern (taskname, stationsnr, ist amanager);
+ refresh submenu;
+ zieltask anzeigen.
+ erfrage daten:
+ auswahl := menualternative (menubasistext (51), menubasistext (52),
+ menubasistext (53), 5, TRUE);
+ SELECT auswahl OF
+ CASE 1, 101 : menu archiv zieltask aendern
+ ("ARCHIVE", station (myself), TRUE );
+ ausstieg
+ CASE 2, 102 : menu archiv zieltask aendern
+
+ (name (father), station (myself), FALSE);
+ ausstieg
+ CASE 3, 103 : menu archiv zieltask aendern
+ ("PUBLIC", station (myself), FALSE);
+ ausstieg
+ CASE 4, 104 : handeinstellung
+ OTHERWISE ausstieg
+ END SELECT.
+ ausstieg:
+ refresh submenu;
+ zieltask anzeigen;
+ LEAVE menu archiv zieltask einstellen.
+ handeinstellung:
+ taskname := menuanswer (menubasistext (81), zieltaskname, 5);
+
+ stationsnr := int (menuanswer (menubasistext (82),
+ text (station (myself)), 5));
+ ist amanager := menuyes (menubasistext (83), 5).
+ kontrolliere daten:
+ IF compress (taskname) = ""
+ OR compress (taskname) = "-"
+ OR taskname = name (myself)
+ THEN menuinfo (menubasistext (64));
+ LEAVE menu archiv zieltask einstellen
+ FI.
+END PROC menu archiv zieltask einstellen;
+PROC menu archiv zieltask aendern (TEXT CONST taskname,
+
+ INT CONST stationsnr,
+ BOOL CONST ist archivmanager):
+ menufootnote (menubasistext (21) + menubasistext (23));
+ gib ggf archiv frei;
+ IF ist archivmanager
+ THEN archivmanager einstellen
+ ELSE sonstige task einstellen
+ FI;
+ aktiviere gueltige archivmenupunkte.
+ gib ggf archiv frei:
+ IF archiv gehoert mir
+ THEN archivreservierung aufgeben
+ FI.
+ archivmanager einstellen:
+ zieltask ist archivmanager := TRUE;
+
+ zieltaskname := taskname;
+ stationsnummer := stationsnr;
+ kontakt mit zieltask erfolgt := FALSE;
+ aktueller archivname := "";
+ archiv gehoert mir := FALSE;
+ letzte funktion := 11.
+ sonstige task einstellen:
+ zieltask ist archivmanager := FALSE;
+ zieltaskname := taskname;
+ stationsnummer := stationsnr;
+ aktueller archivname := "";
+ archiv gehoert mir := FALSE;
+
+ letzte funktion := 6.
+END PROC menu archiv zieltask aendern;
+PROC menu archiv reservieren:
+ TEXT VAR archivname :: "", meldung :: "";
+ kontrolliere einstellung;
+ menufootnote (menubasistext (21) + menubasistext (24));
+ versuche archiv zu reservieren (meldung);
+ werte meldung aus;
+ archiv anmelden (archivname, meldung, TRUE);
+ IF archivname = ""
+ THEN behandle archivfehler
+ ELSE aktueller archivname := archivname
+ FI;
+ aktiviere gueltige archivmenupunkte;
+
+ refresh submenu;
+ zieltask anzeigen.
+ kontrolliere einstellung:
+ IF NOT zieltask ist archivmanager
+ THEN aktiviere gueltige archivmenupunkte;
+ refresh submenu;
+ LEAVE menu archiv reservieren
+ ELIF NOT kontakt mit zieltask erfolgt
+ THEN versuche kontakt herzustellen
+ FI.
+ versuche kontakt herzustellen:
+ TEXT VAR fehler :: "";
+ IF NOT task ist kommunikativ (fehler)
+ THEN melde zieltaskerror (fehler);
+ melde rigoros ab;
+
+ LEAVE menu archiv reservieren
+ ELSE kontakt mit zieltask erfolgt := TRUE
+ FI.
+ werte meldung aus:
+ IF meldung <> ""
+ THEN melde zieltaskerror (meldung);
+ melde rigoros ab;
+ LEAVE menu archiv reservieren
+ FI.
+ behandle archivfehler:
+ melde zieltaskerror (meldung);
+ archivreservierung aufgeben;
+ melde rigoros ab
+END PROC menu archiv reservieren;
+PROC melde rigoros ab:
+ aktueller archivname := "";
+ archiv gehoert mir := FALSE;
+
+ kontakt mit zieltask erfolgt := FALSE
+END PROC melde rigoros ab;
+PROC versuche archiv zu reservieren (TEXT VAR fehler):
+ IF NOT kontakt mit zieltask erfolgt
+ THEN fehler := menubasistext (44);
+ archiv gehoert mir := FALSE;
+ LEAVE versuche archiv zu reservieren
+ FI;
+ disable stop;
+ IF eigene station
+ THEN reserve ("beknackter archivename",/zieltaskname )
+ ELSE reserve ("beknackter archivename", stationsnummer/zieltaskname)
+ FI;
+ IF is error
+ THEN fehler := errormessage;
+
+ melde rigoros ab;
+ clear error
+ ELSE archiv gehoert mir := TRUE;
+ fehler := "";
+ FI;
+ enable stop
+END PROC versuche archiv zu reservieren;
+PROC archiv anmelden (TEXT VAR archivname, fehler, BOOL CONST mit anfrage):
+ ueberpruefe archivbesitz;
+ fuehre archivanmeldung aus.
+ ueberpruefe archivbesitz:
+ IF NOT archiv gehoert mir OR NOT kontakt mit zieltask erfolgt
+ THEN fehler := menubasistext (45);
+ melde rigoros ab;
+ LEAVE archiv anmelden
+
+ FI.
+ fuehre archivanmeldung aus:
+ IF mit anfrage
+ THEN frage nach eingelegter diskette und melde an
+ ELSE melde archiv unter richtigem namen an
+ FI.
+ frage nach eingelegter diskette und melde an:
+ IF menuyes (menubasistext (84), 5)
+ THEN menufootnote (menubasistext (21) + menubasistext (25));
+ melde archiv unter richtigem namen an
+ ELSE fehler := menubasistext (46);
+ aktueller archivname := "";
+ LEAVE archiv anmelden
+
+ FI.
+ melde archiv unter richtigem namen an:
+ disable stop;
+ IF eigene station
+ THEN reserve ("beknackter archivename",/zieltaskname);
+ list (/zieltaskname);
+ ELSE reserve ("beknackter archivename", stationsnummer/zieltaskname);
+ list (stationsnummer/zieltaskname)
+ FI;
+ IF is error
+ THEN fehler := errormessage;
+ behandle die fehlermeldung
+ ELSE archivname := "beknackter archivename";
+ fehler := "";
+ enable stop
+
+ FI.
+ behandle die fehlermeldung:
+ IF subtext (fehler, 1, 14) = menubasistext (61)
+ CAND subtext (fehler, 16, 20) <> menubasistext (62)
+ THEN clear error; enable stop;
+ archivname := subtext (fehler, 16, length (fehler) - 1);
+ melde archiv nun wirklich richtig an;
+ fehler := "";
+ enable stop
+ ELIF subtext (fehler, 1, 14) = menubasistext (61)
+ CAND subtext (fehler, 16, 20) = menubasistext (62)
+ THEN clear error; enable stop;
+
+ archivname := "";
+ fehler := menubasistext (62)
+ ELSE clear error; enable stop;
+ archivname := ""
+ FI.
+ melde archiv nun wirklich richtig an:
+ IF eigene station
+ THEN reserve (archivname,/zieltaskname);
+ ELSE reserve (archivname, stationsnummer/zieltaskname)
+ FI.
+END PROC archiv anmelden;
+PROC menu archiv neue diskette:
+ ueberpruefe reservierung;
+ melde neue diskette an.
+ ueberpruefe reservierung:
+ IF NOT (archiv gehoert mir AND kontakt mit zieltask erfolgt)
+
+ THEN melde zieltaskerror (menubasistext (47));
+ LEAVE menu archiv neue diskette
+ FI.
+ melde neue diskette an:
+ TEXT VAR archivname :: "", meldung :: "";
+ menufootnote (menubasistext (21) + menubasistext (26));
+ archiv anmelden (archivname, meldung, FALSE);
+ IF archivname = ""
+ THEN behandle archivfehler
+ ELSE aktueller archivname := archivname
+ FI;
+ zieltask anzeigen.
+ behandle archivfehler:
+ melde zieltaskerror (meldung);
+ aktueller archivname := "".
+
+END PROC menu archiv neue diskette;
+PROC menu archiv schreiben:
+ dateioperation mit zieltask (schreiben);
+ regenerate menuscreen
+END PROC menu archiv schreiben;
+PROC menu archiv checken:
+ dateioperation mit zieltask (checken);
+ regenerate menuscreen
+END PROC menu archiv checken;
+PROC menu archiv schreibcheck:
+ dateioperation mit zieltask (schreibcheck);
+ regenerate menuscreen
+END PROC menu archiv schreibcheck;
+PROC menu archiv holen:
+ dateioperation mit zieltask (holen);
+ regenerate menuscreen
+
+END PROC menu archiv holen;
+PROC menu archiv loeschen:
+ dateioperation mit zieltask (loeschen);
+ regenerate menuscreen
+END PROC menu archiv loeschen;
+PROC dateioperation mit zieltask (INT CONST wahl):
+ ueberpruefe kommunikationsbasis und sinnhaftigkeit;
+ lasse dateien auswaehlen;
+ operiere mit ausgewaehlten dateien.
+ ueberpruefe kommunikationsbasis und sinnhaftigkeit:
+ IF unzulaessiger zieltaskname
+ THEN LEAVE dateioperation mit zieltask
+ ELIF zieltaskname = name (myself)
+
+ THEN melde zieltaskerror (menubasistext (48));
+ LEAVE dateioperation mit zieltask
+ ELIF zieltask ist archivmanager AND NOT archiv gehoert mir
+ THEN melde zieltaskerror (menubasistext (47));
+ LEAVE dateioperation mit zieltask
+ ELIF NOT zieltask ist archivmanager
+ AND (wahl = checken OR wahl = schreibcheck)
+ THEN gib hinweis auf unmoeglich;
+ LEAVE dateioperation mit zieltask
+ ELIF NOT zieltask ist archivmanager
+
+ THEN stelle kontakt mit zieltask her
+ ELIF wahl < schreiben OR wahl > loeschen
+ THEN LEAVE dateioperation mit zieltask
+ FI.
+ stelle kontakt mit zieltask her:
+ TEXT VAR fehler :: "";
+ IF task ist kommunikativ (fehler)
+ THEN kontakt mit zieltask erfolgt := TRUE
+ ELSE melde zieltaskerror (fehler);
+ LEAVE dateioperation mit zieltask
+ FI.
+ gib hinweis auf unmoeglich:
+ menuinfo (menubasistext (121) + taskname + menubasistext (122)).
+
+ taskname:
+ IF eigene station
+ THEN zieltaskname
+ ELSE text (stationsnummer) + "/" + zieltaskname
+ FI.
+ lasse dateien auswaehlen:
+ THESAURUS VAR angekreuzte;
+ disable stop;
+ IF wahl = schreiben OR wahl = schreibcheck
+ THEN angekreuzte := menusome (ALL myself, operationshinweis,
+ ankreuzhinweis, FALSE)
+ ELSE angekreuzte := menusome (zieltaskthesaurus, operationshinweis,
+ ankreuzhinweis, FALSE)
+
+ FI;
+ fehlerbehandlung.
+ zieltaskthesaurus:
+ IF eigene station
+ THEN ALL /zieltaskname
+ ELSE ALL (stationsnummer/zieltaskname)
+ FI.
+ ankreuzhinweis:
+ menubasistext (91) + operationskennzeichnung (wahl) + menubasistext (92).
+ operationshinweis:
+ operationsbezeichnung (wahl) + zieltaskhinweis.
+ operiere mit ausgewaehlten dateien:
+ bereite bildschirm vor;
+ steige ggf bei leerem thesaurus aus;
+ IF wahl = schreiben OR wahl = schreibcheck
+ THEN zuerst loeschen
+
+ FI;
+ IF wahl = schreibcheck
+ THEN fehlerfall := FALSE;
+ dateioperation ausfuehren (angekreuzte, schreiben, FALSE);
+ IF NOT fehlerfall
+ THEN dateioperation ausfuehren (angekreuzte, checken, TRUE)
+ FI
+ ELSE dateioperation ausfuehren (angekreuzte, wahl, TRUE)
+ FI.
+ bereite bildschirm vor:
+ show menuwindow.
+ steige ggf bei leerem thesaurus aus:
+ IF NOT not empty (angekreuzte)
+ THEN menuwindowline (2);
+ menuwindowout (menubasistext (94));
+
+ menuwindowstop;
+ LEAVE dateioperation mit zieltask
+ FI.
+ zuerst loeschen:
+ menuwindowout (menuwindowcenter (menubasistext (21) + menubasistext (31)));
+ menuwindowline;
+ IF not empty (angekreuzte)
+ THEN disable stop;
+ THESAURUS CONST zu loeschende ::
+ angekreuzte / zieltaskthesaurus;
+ fehlerbehandlung;
+ biete ggf dateien zum loeschen an
+ ELSE menuwindowpage
+ FI.
+ biete ggf dateien zum loeschen an:
+
+ IF not empty (zu loeschende)
+ THEN menuwindowout (menuwindowcenter (invers (menubasistext (108))));
+ menuwindowline;
+ menuwindowout (menuwindowcenter (menubasistext (109)));
+ menuwindowline (2);
+ dateien rausschmeissen
+ ELSE menuwindowpage
+ FI.
+ dateien rausschmeissen:
+ command dialogue (FALSE);
+ biete dateien einzeln zum loeschen an;
+ menuwindowpage;
+ command dialogue (TRUE).
+ biete dateien einzeln zum loeschen an:
+
+ INT VAR z, index;
+ FOR z FROM 1 UPTO highest entry (zu loeschende) REP
+ disable stop;
+ IF name (zu loeschende, z) <> ""
+ THEN stelle frage und fuehre aus
+ FI;
+ fehlerbehandlung
+ PER.
+ stelle frage und fuehre aus:
+ IF menuwindowyes ("'" + name (zu loeschende, z) + "' "
+ + menubasistext (111))
+ THEN erase (name (zu loeschende, z), task (zieltaskname))
+ ELSE menuwindowout (menubasistext (110));
+ menuwindowline;
+
+ delete (angekreuzte, name (zu loeschende, z), index);
+ pause (20)
+ FI.
+ fehlerbehandlung:
+ IF is error
+ THEN regenerate menuscreen;
+ melde zieltaskerror (errormessage);
+ clear error; enable stop;
+ LEAVE dateioperation mit zieltask
+ FI.
+END PROC dateioperation mit zieltask;
+PROC dateioperation ausfuehren (THESAURUS CONST angekreuzte,
+ INT CONST wahl,
+ BOOL CONST mit schlussbemerkung):
+
+ INT VAR spalte :: 1, zeile :: 3, k, anzahl :: 0;
+ menuwindowout (menuwindowcenter (invers (operationsbezeichnung (wahl)
+ + zieltaskhinweis)));
+ command dialogue (FALSE);
+ fuehre einzelne operationen aus;
+ command dialogue (TRUE);
+ IF mit schlussbemerkung
+ THEN schreibe schlussbemerkung
+ ELSE menuwindowpage
+ FI.
+ fuehre einzelne operationen aus:
+ FOR k FROM 1 UPTO highest entry (angekreuzte) REP
+ IF name (angekreuzte, k) <> ""
+
+ THEN disable stop;
+ bildschirmausgabe;
+ operation ausfuehren;
+ anzahl INCR 1;
+ fehlerbehandlung
+ FI
+ PER.
+ bildschirmausgabe:
+ spalte := 1;
+ IF remaining menuwindowlines < 2
+ THEN menuwindowpage; zeile := 1
+ ELSE zeile INCR 1
+ FI;
+ menuwindowcursor (spalte, zeile);
+ ergaenzter dateiname.
+ ergaenzter dateiname:
+ INT VAR windowcolumn, windowrow;
+ SELECT wahl OF
+ CASE schreiben : menuwindowout (menubasistext (105) + dateiname)
+
+ CASE checken : get menuwindowcursor (windowcolumn, windowrow);
+ menuwindowout (dateiname + menubasistext (106));
+ menuwindowcursor (windowcolumn, windowrow);
+ CASE holen : menuwindowout (menubasistext (107) + dateiname)
+ END SELECT.
+ dateiname:
+ " """ + name (angekreuzte, k) + """ ".
+ operation ausfuehren:
+ IF eigene station
+ THEN fuehre eigenstationoperation aus
+ ELSE fuehre fremdstationoperation aus
+ FI.
+
+ fuehre eigenstationoperation aus:
+ SELECT wahl OF
+ CASE schreiben : save (name (angekreuzte, k), /zieltaskname)
+ CASE checken : check (name (angekreuzte, k), /zieltaskname);
+ bestaetige
+ CASE holen : ueberschreiben erfragen eigene station
+ CASE loeschen : loeschen erfragen eigene station
+ END SELECT.
+ ueberschreiben erfragen eigene station:
+ IF exists (name (angekreuzte, k))
+ THEN menuwindowline;
+ IF menuwindowyes (dateiname + menubasistext (112))
+
+ THEN zeile INCR 2;
+ menuwindowline;
+ forget (name (angekreuzte, k), quiet);
+ fetch (name (angekreuzte, k), /zieltaskname)
+ FI
+ ELSE fetch (name (angekreuzte, k), /zieltaskname)
+ FI.
+ loeschen erfragen eigene station:
+ IF menuwindowyes (dateiname + menubasistext (111))
+ THEN erase (name (angekreuzte, k), /zieltaskname)
+ FI.
+ fuehre fremdstationoperation aus:
+ SELECT wahl OF
+ CASE schreiben : save (name (angekreuzte, k), ziel)
+
+ CASE checken : check (name (angekreuzte, k), ziel); bestaetige
+ CASE holen : ueberschreiben erfragen fremde station
+ CASE loeschen : loeschen erfragen fremde station
+ END SELECT.
+ ueberschreiben erfragen fremde station:
+ IF exists (name (angekreuzte, k))
+ THEN menuwindowline;
+ IF menuwindowyes (dateiname + menubasistext (112))
+ THEN zeile INCR 2;
+ menuwindowline;
+ forget (name (angekreuzte, k), quiet);
+
+ fetch (name (angekreuzte, k), ziel)
+ FI
+ ELSE fetch (name (angekreuzte, k), ziel)
+ FI.
+ loeschen erfragen fremde station:
+ IF menuwindowyes (dateiname + menubasistext (111))
+ THEN erase (name (angekreuzte, k), ziel)
+ FI.
+ ziel:
+ stationsnummer/zieltaskname.
+ bestaetige:
+ IF NOT is error
+ THEN menuwindowout (dateiname + menubasistext (114))
+ FI.
+ schreibe schlussbemerkung:
+ IF remaining menuwindowlines < 7
+ THEN menuwindowpage; menuwindowline
+
+ ELSE menuwindowline (2)
+ FI;
+ IF anzahl > 0
+ THEN menuwindowout (menubasistext (93) +
+ operationskennzeichnung (wahl))
+ ELSE menuwindowout (menubasistext (94))
+ FI;
+ menuwindowstop.
+ fehlerbehandlung:
+ IF is error
+ THEN fehlerfall := TRUE;
+ regenerate menuscreen;
+ melde zieltaskerror (errormessage);
+ clear error; enable stop;
+ LEAVE dateioperation ausfuehren
+ FI.
+END PROC dateioperation ausfuehren;
+
+TEXT PROC operationsbezeichnung (INT CONST nr):
+ SELECT nr OF
+ CASE schreiben : menubasistext (95)
+ CASE checken : menubasistext (97)
+ CASE schreibcheck : menubasistext (99)
+ CASE holen : menubasistext (101)
+ CASE loeschen : menubasistext (103)
+ OTHERWISE ""
+ END SELECT
+END PROC operationsbezeichnung;
+TEXT PROC operationskennzeichnung (INT CONST nr):
+ SELECT nr OF
+ CASE schreiben : menubasistext (96)
+ CASE checken : menubasistext (98)
+
+ CASE schreibcheck : menubasistext (100)
+ CASE holen : menubasistext (102)
+ CASE loeschen : menubasistext (104)
+ OTHERWISE ""
+ END SELECT
+END PROC operationskennzeichnung;
+BOOL PROC not empty (THESAURUS CONST t):
+ INT VAR i;
+ FOR i FROM 1 UPTO highest entry (t) REP
+ IF name (t, i) <> ""
+ THEN LEAVE not empty WITH TRUE
+ FI
+ PER;
+ FALSE
+END PROC not empty;
+TEXT PROC zieltaskhinweis:
+ IF zieltaskname = "ARCHIVE"
+ THEN "(" + menubasistext (78) + ")"
+
+ ELIF zieltaskname = name (father)
+ THEN "(" + menubasistext (79) + ")"
+ ELSE menubasistext (80) + zieltaskname + ")"
+ FI
+END PROC zieltaskhinweis;
+PROC menu archiv verzeichnis:
+ forget("Interne Dateiliste bei Archivoperation", quiet);
+ ueberpruefe kommunikationsbasis;
+ liste dateien der zieltask auf;
+ regenerate menuscreen.
+ ueberpruefe kommunikationsbasis:
+ IF unzulaessiger zieltaskname
+ THEN LEAVE menu archiv verzeichnis
+ ELIF zieltaskname = name (myself)
+
+ THEN LEAVE ueberpruefe kommunikationsbasis
+ ELIF zieltask ist archivmanager AND NOT archiv gehoert mir
+ THEN melde zieltaskerror (menubasistext (47));
+ LEAVE menu archiv verzeichnis
+ ELIF NOT zieltask ist archivmanager
+ THEN stelle kontakt mit zieltask her
+ FI.
+ stelle kontakt mit zieltask her:
+ TEXT VAR fehler :: "";
+ IF task ist kommunikativ (fehler)
+ THEN kontakt mit zieltask erfolgt := TRUE
+ ELSE melde zieltaskerror (fehler);
+
+ LEAVE menu archiv verzeichnis
+ FI.
+ liste dateien der zieltask auf:
+ erstelle liste;
+ gib liste aus;
+ forget ("Interne Dateiliste bei Archivoperation", quiet).
+ erstelle liste:
+ menufootnote (menubasistext (21) + menubasistext (28));
+ FILE VAR f :: sequential file (output, "Interne Dateiliste bei Archivoperation");
+ disable stop;
+ IF eigene station
+ THEN list (f, /zieltaskname)
+ ELSE list (f, stationsnummer/zieltaskname)
+ FI;
+ IF is error
+
+ THEN melde zieltaskerror (errormessage);
+ forget ("Interne Dateiliste bei Archivoperation", quiet);
+ clear error; enable stop;
+ LEAVE menu archiv verzeichnis
+ FI;
+ enable stop.
+ gib liste aus:
+ modify (f);
+ IF NOT (zieltaskname = name (myself))
+ THEN to line (f, 1);
+ insert record (f);
+ notiere kopfzeile;
+ headline (f, menubasistext (43));
+ ELSE entferne eigenen namen aus der liste
+ FI;
+
+ to line (f, 1);
+ cursor on; menuwindowshow (f); cursor off.
+ notiere kopfzeile:
+ IF zieltask ist archivmanager
+ THEN write record (f, headline (f));
+ ELSE write record (f, zieltaskbezeichnung)
+ FI.
+ entferne eigenen namen aus der liste:
+ TEXT VAR zeile :: ""; INT VAR i;
+ FOR i FROM lines (f) DOWNTO 1 REP
+ to line (f, i);
+ read record (f, zeile);
+ IF pos (zeile, "Interne Dateiliste bei Archivoperation") > 0
+ THEN delete record (f);
+
+ LEAVE entferne eigenen namen aus der liste
+ FI
+ PER
+END PROC menu archiv verzeichnis;
+PROC menu archiv verzeichnis drucken:
+ forget ("Interne Dateiliste bei Archivoperation", quiet);
+ ueberpruefe kommunikationsbasis;
+ erstelle listing;
+ drucke listing aus.
+ ueberpruefe kommunikationsbasis:
+ IF unzulaessiger zieltaskname
+ THEN LEAVE menu archiv verzeichnis drucken
+ ELIF zieltaskname = name (myself)
+ THEN LEAVE ueberpruefe kommunikationsbasis
+
+ ELIF zieltask ist archivmanager AND NOT archiv gehoert mir
+ THEN melde zieltaskerror (menubasistext (47));
+ LEAVE menu archiv verzeichnis drucken
+ ELIF NOT zieltask ist archivmanager
+ THEN stelle kontakt mit zieltask her
+ FI.
+ stelle kontakt mit zieltask her:
+ TEXT VAR fehler :: "";
+ IF task ist kommunikativ (fehler)
+ THEN kontakt mit zieltask erfolgt := TRUE
+ ELSE melde zieltaskerror (fehler);
+ LEAVE menu archiv verzeichnis drucken
+
+ FI.
+ erstelle listing:
+ LET dummy name pos = 18;
+ FILE VAR listfile; INT VAR i; TEXT VAR record :: "";
+ TEXT CONST head :: 70 * "=", end :: 70 * "-";
+ IF menuno (menubasistext (90), 5)
+ THEN LEAVE menu archiv verzeichnis drucken
+ FI;
+ menufootnote (menubasistext (21) + menubasistext (29));
+ disable stop;
+ listfile := sequential file (output, "Interne Dateiliste bei Archivoperation");
+ IF eigene station
+ THEN list (listfile, /zieltaskname)
+ ELSE list (listfile, stationsnummer/zieltaskname)
+
+ FI;
+ IF is error
+ THEN melde zieltaskerror (errormessage);
+ forget ("Interne Dateiliste bei Archivoperation", quiet);
+ clear error; enable stop;
+ LEAVE menu archiv verzeichnis drucken
+ FI;
+ enable stop.
+ drucke listing aus:
+ schreibe dateikopf;
+ loesche dummy names;
+ schreibe fuss;
+ drucke und loesche listing.
+ schreibe dateikopf:
+ modify (listfile);
+ to line (listfile, 1);
+ FOR i FROM 1 UPTO 6 REP insert record (listfile) PER;
+
+ to line (listfile, 1);
+ write record (listfile, "#type (""elanlist"")#"); down (listfile);
+ write record (listfile, "#start (2.5,0.0)##limit (20,5)#"
+ + "#pagelength (26.0)#"); down (listfile);
+ write record (listfile, head); down (listfile);
+ schreibe erkennungszeile; down (listfile);
+ write record (listfile, " Listing vom " + date + ", "
+ + time of day + " Uhr"); down (listfile);
+ write record (listfile, head).
+
+ schreibe erkennungszeile:
+ IF zieltask ist archivmanager
+ THEN write record (listfile, "Archiv: " + headline (listfile))
+ ELSE write record (listfile, "Task : " + taskbezeichnung)
+ FI.
+ taskbezeichnung:
+ IF eigene station
+ THEN zieltaskname
+ ELSE text (stationsnummer) + "/" + zieltaskname
+ FI.
+ loesche dummy names:
+ to line (listfile, 8);
+ WHILE NOT eof (listfile) REP
+ read record (listfile, record);
+ IF (record SUB dummy name pos) = "-"
+
+ OR pos (record, "Interne Dateiliste bei Archivoperation") > 0
+ THEN delete record (listfile)
+ ELSE down (listfile)
+ FI
+ PER.
+ schreibe fuss:
+ output (listfile);
+ putline (listfile, end).
+ drucke und loesche listing:
+ menufootnote (menubasistext (21) + menubasistext (30));
+ disable stop;
+ print ("Interne Dateiliste bei Archivoperation");
+ IF is error
+ THEN melde zieltaskerror (errormessage);
+ clear error; enable stop;
+
+ forget ("Interne Dateiliste bei Archivoperation", quiet);
+ LEAVE menu archiv verzeichnis drucken
+ FI;
+ enable stop;
+ forget ("Interne Dateiliste bei Archivoperation", quiet)
+END PROC menu archiv verzeichnis drucken;
+TEXT PROC zieltaskbezeichnung:
+ IF eigene station
+ THEN menubasistext (77) + taskbezeichnung
+ ELSE menubasistext (76) + text (stationsnummer) + " " +
+ menubasistext (77) + zieltaskname
+ FI.
+ taskbezeichnung:
+ IF zieltaskname = "ARCHIVE"
+
+ THEN menubasistext (78)
+ ELIF zieltaskname = name (father)
+ THEN menubasistext (79) + " (" + zieltaskname + ")"
+ ELSE zieltaskname
+ FI
+END PROC zieltaskbezeichnung;
+BOOL PROC unzulaessiger zieltaskname:
+ IF compress (zieltaskname) = "" OR compress (zieltaskname) = "-"
+ THEN TRUE
+ ELSE FALSE
+ FI
+END PROC unzulaessiger zieltaskname;
+PROC menu archiv initialisieren:
+ TEXT VAR archivname :: "", meldung :: "";
+ klaere zieltaskart;
+ formatiere ggf;
+
+ initialisiere ggf.
+ klaere zieltaskart:
+ IF NOT zieltask ist archivmanager
+ THEN menuinfo (menubasistext (121) + zieltaskname +
+ menubasistext (122));
+ LEAVE menu archiv initialisieren
+ FI.
+ formatiere ggf:
+ IF menuyes (menubasistext (85), 5)
+ THEN nimm archiv in beschlag;
+ fuehre formatierung aus
+ FI.
+ nimm archiv in beschlag:
+ stelle archivbesitz sicher;
+ IF aktueller archivname <> ""
+ THEN archivname := aktueller archivname
+
+ ELSE archivname := menubasistext (75)
+ FI;
+ IF eigene station
+ THEN reserve (archivname,/zieltaskname)
+ ELSE reserve (archivname, stationsnummer/zieltaskname)
+ FI;
+ aktueller archivname := archivname;
+ archiv gehoert mir := TRUE;
+ zieltask anzeigen.
+ stelle archivbesitz sicher:
+ IF NOT archiv gehoert mir OR NOT kontakt mit zieltask erfolgt
+ THEN versuche kommunikation;
+ versuche archiv zu reservieren (meldung);
+ werte meldung aus
+
+ FI.
+ versuche kommunikation:
+ TEXT VAR fehler :: "";
+ IF NOT task ist kommunikativ (fehler)
+ THEN melde zieltaskerror (fehler);
+ melde rigoros ab;
+ LEAVE menu archiv initialisieren
+ ELSE kontakt mit zieltask erfolgt := TRUE
+ FI.
+ werte meldung aus:
+ IF meldung <> ""
+ THEN melde zieltaskerror (meldung);
+ aktueller archivname := "";
+ zieltask anzeigen;
+ LEAVE menu archiv initialisieren
+ FI.
+
+ fuehre formatierung aus:
+ INT VAR auswahl :: menualternative (menubasistext (54),
+ menubasistext (55),
+ menubasistext (56), 5, TRUE);
+ IF auswahl = 0
+ THEN LEAVE fuehre formatierung aus
+ FI;
+ IF auswahl > 100
+ THEN auswahl DECR 100
+ FI;
+ command dialogue (FALSE);
+ disable stop;
+ menufootnote (menubasistext (21) + menubasistext (27));
+ IF eigene station
+ THEN formatiere auf eigener station
+
+ ELSE formatiere auf fremder station
+ FI;
+ IF is error
+ THEN melde zieltaskerror (errormessage);
+ clear error; enable stop;
+ command dialogue (TRUE);
+ LEAVE formatiere ggf
+ ELSE enable stop;
+ command dialogue (TRUE);
+ aktiviere gueltige archivmenupunkte;
+ refresh submenu;
+ zieltask anzeigen
+ FI.
+ formatiere auf eigener station:
+ IF auswahl < 5
+ THEN format (auswahl, /zieltaskname)
+
+ ELSE format (/zieltaskname)
+ FI.
+ formatiere auf fremder station:
+ IF auswahl < 5
+ THEN format (auswahl, stationsnummer/zieltaskname)
+ ELSE format (stationsnummer/zieltaskname)
+ FI.
+ initialisiere ggf:
+ stelle archivbesitz sicher;
+ archiv anmelden (archivname, meldung, FALSE);
+ IF archivname <> ""
+ THEN aktueller archivname := archivname;
+ archiv gehoert mir := TRUE;
+ aktiviere gueltige archivmenupunkte;
+ refresh submenu;
+
+ zieltask anzeigen;
+ frage nach ueberschreiben
+ ELIF meldung = menubasistext (63) OR meldung = menubasistext (62)
+ THEN frage nach initialisieren
+ ELSE melde zieltaskerror (meldung);
+ aktueller archivname := "";
+ zieltask anzeigen;
+ LEAVE menu archiv initialisieren
+ FI.
+ frage nach ueberschreiben:
+ IF menuyes (menubasistext (86) + archivname + menubasistext (87), 5)
+ THEN erfrage neuen namen und initialisiere
+
+ ELSE LEAVE menu archiv initialisieren
+ FI.
+ frage nach initialisieren:
+ IF menuyes (menubasistext (88), 5)
+ THEN erfrage neuen namen und initialisiere
+ ELSE LEAVE menu archiv initialisieren
+ FI.
+ erfrage neuen namen und initialisiere:
+ TEXT VAR neuer name := compress(menuanswer (menubasistext (89),
+ aktueller archivname, 5));
+ IF neuer name <> ""
+ THEN archivname := neuer name
+ ELIF neuer name = "" AND archivname = ""
+
+ THEN archivname := menubasistext (75)
+ FI;
+ command dialogue (FALSE);
+ disable stop;
+ IF eigene station
+ THEN reserve (archivname, /zieltaskname);
+ clear (/zieltaskname)
+ ELSE reserve (archivname, stationsnummer/zieltaskname);
+ clear (stationsnummer/zieltaskname)
+ FI;
+ IF is error
+ THEN melde zieltaskerror (errormessage);
+ clear error; enable stop;
+ command dialogue (TRUE);
+ melde rigoros ab;
+
+ archivreservierung aufgeben;
+ aktiviere gueltige archivmenupunkte;
+ refresh submenu;
+ zieltask anzeigen;
+ LEAVE menu archiv initialisieren
+ ELSE enable stop; command dialogue (TRUE);
+ aktueller archivname := archivname;
+ archiv gehoert mir := TRUE;
+ aktiviere gueltige archivmenupunkte;
+ refresh submenu;
+ zieltask anzeigen
+ FI
+END PROC menu archiv initialisieren;
+PROC archive (TEXT CONST archive name,task, INT CONST station):
+
+ call (reserve code, archive name, station/task)
+END PROC archive;
+PROC menu archiv reservierung aufgeben:
+ IF archiv gehoert mir
+ THEN menufootnote (menubasistext (21) + menubasistext (22));
+ archivreservierung aufgeben;
+ FI;
+ erase menunotice;
+ old menufootnote
+END PROC menu archiv reservierung aufgeben;
+PROC archivreservierung aufgeben:
+ command dialogue (FALSE);
+ disable stop;
+ IF eigene station
+ THEN release (/zieltaskname)
+ ELSE release (stationsnummer/zieltaskname);
+
+ FI;
+ IF is error
+ THEN clear error
+ FI;
+ enable stop;
+ command dialogue (TRUE);
+ archiv gehoert mir := FALSE;
+ aktueller archivname := ""
+END PROC archivreservierung aufgeben;
+BOOL PROC eigene station:
+ IF stationsnummer = 0 OR stationsnummer = station (myself)
+ THEN TRUE
+ ELSE FALSE
+ FI
+END PROC eigene station;
+PROC aktiviere gueltige archivmenupunkte:
+ IF zieltask ist archivmanager AND NOT archiv gehoert mir
+ THEN aktiviere nur grundfunktionen
+
+ ELSE aktiviere alle momentan gueltigen punkte
+ FI.
+ aktiviere alle momentan gueltigen punkte:
+ IF letzte funktion = 11
+ THEN activate (1); activate (2);
+ activate (4); activate (5); activate (6); activate (7); activate (8);
+ activate (10); activate (11);
+ activate (13); activate (14);
+ ELIF letzte funktion = 6
+ THEN deactivate (1); deactivate (2);
+ activate (4); deactivate (5); deactivate (6); activate (7); activate (8);
+
+ activate (10); activate (11);
+ deactivate (13); activate (14);
+ FI.
+ aktiviere nur grundfunktionen:
+ activate (1); deactivate (2);
+ deactivate (4); deactivate (5); deactivate (6); deactivate (7); deactivate (8);
+ deactivate (10); deactivate (11);
+ activate (13); activate (14).
+END PROC aktiviere gueltige archivmenupunkte;
+PROC zieltask anzeigen:
+ IF zieltask ist archivmanager
+ THEN schreibe taskname und archivname
+ ELSE schreibe taskname
+
+ FI.
+ schreibe taskname:
+ write menunotice (menubasistext (59) + ""13"" + name der task, notizort).
+ schreibe taskname und archivname:
+ write menunotice (menubasistext (59) + ""13"" + name der task +
+ ""13"" + menubasistext (60) + ""13"" + archivname,
+ notizort).
+ name der task:
+ IF zieltaskname = "ARCHIVE" AND eigene station
+ THEN " " + menubasistext (71)
+ ELIF zieltaskname = "PUBLIC" AND eigene station
+ THEN " " + menubasistext (72)
+
+ ELIF zieltaskname = name (father)
+ THEN " " + menubasistext (73)
+ ELSE " " + ggf gekuerzter zieltaskname
+ FI.
+ ggf gekuerzter zieltaskname:
+ TEXT VAR interner name;
+ IF eigene station
+ THEN interner name := zieltaskname;
+ ELSE interner name := text (stationsnummer) + "/" + zieltaskname
+ FI;
+ IF length (interner name) < 20
+ THEN ""15"" + interner name + " "14""
+ ELSE ""15"" + subtext (interner name, 1 , 18) + ".." + " "14""
+ FI.
+
+ archivname:
+ IF NOT archiv gehoert mir OR aktueller archivname = ""
+ THEN " " + menubasistext (74)
+ ELSE " "15"" + ggf gekuerzter archivname + " "14""
+ FI.
+ ggf gekuerzter archivname:
+ IF eigene station AND length (aktueller archivname) > 20
+ THEN subtext (aktueller archivname, 1, 18) + ".."
+ ELIF NOT eigene station AND length (aktueller archivname) > 17
+ THEN subtext (aktueller archivname, 1, 15) + ".."
+ ELSE aktueller archivname
+ FI.
+
+END PROC zieltask anzeigen;
+BOOL PROC task ist kommunikativ (TEXT VAR fehler):
+ INT VAR antwort;
+ DATASPACE VAR dummy space := nilspace;
+ IF zieltask ist archivmanager
+ THEN schicke reservierungscode
+ ELSE schicke listcode
+ FI.
+ schicke reservierungscode:
+ disable stop;
+ IF eigene station
+ THEN pingpong (/zieltaskname, reserve code, dummy space, antwort);
+ ELSE pingpong (stationsnummer/zieltaskname, reserve code,
+ dummy space, antwort)
+
+ FI;
+ werte antwort aus.
+ schicke listcode:
+ disable stop;
+ IF eigene station
+ THEN pingpong (/zieltaskname, list code, dummy space, antwort);
+ ELSE pingpong (stationsnummer/zieltaskname, list code,
+ dummy space, antwort)
+ FI;
+ werte antwort aus.
+ werte antwort aus:
+ IF is error
+ THEN clear error
+ FI;
+ BOUND TEXT VAR inhalt := dummy space;
+ enable stop;
+ IF antwort = 0 THEN fehler := ""
+ ELIF antwort = -1 THEN fehler := menubasistext (41)
+
+ ELIF antwort = -2 THEN fehler := menubasistext (42)
+ ELSE fehler := inhalt
+ FI;
+ forget (dummy space);
+ IF antwort = ack
+ THEN kontakt mit zieltask erfolgt := TRUE; TRUE
+ ELSE kontakt mit zieltask erfolgt := FALSE; FALSE
+ FI
+END PROC task ist kommunikativ;
+END PACKET ls dialog 6;
+
diff --git a/dialog/ls-DIALOG 7 b/dialog/ls-DIALOG 7
index 467f531..bc43410 100644
--- a/dialog/ls-DIALOG 7
+++ b/dialog/ls-DIALOG 7
@@ -22,33 +22,439 @@
*)
-PACKET ls dialog 7 DEFINES{} menu dateien verzeichnis,{} menu dateien loeschen,{} menu dateien drucken,{} menu dateien kopieren,{} menu dateien umbenennen,{} menu dateien speicherplatz,{} menu dateien aufraeumen:{}LET filetype = 1003,{} maxlaenge = 60,{} breite = 40,{} niltext = "";{}TEXT CONST dateibez :: "Dateiliste bei internen Operationen";{}PROC menu dateien verzeichnis:{} forget (dateibez, quiet);{} liste dateien auf;{}
- regenerate menuscreen.{} liste dateien auf:{} erstelle liste;{} gib liste aus;{} forget (dateibez, quiet).{} erstelle liste:{} menufootnote (menubasistext (21) + menubasistext (28));{} FILE VAR f :: sequential file (output, dateibez);{} list (f); modify (f);{} headline (f, menubasistext (43));{} to line (f, 1); insert record (f);{} write record (f, menubasistext (161));{} entferne eigenen namen aus der liste.{} entferne eigenen namen aus der liste:{} TEXT VAR zeile :: ""; INT VAR i;{}
- FOR i FROM lines (f) DOWNTO 1 REP{} to line (f, i); read record (f, zeile);{} IF pos (zeile, dateibez) > 0{} THEN delete record (f);{} LEAVE entferne eigenen namen aus der liste{} FI{} PER.{} gib liste aus:{} to line (f, 1); cursor on; menuwindowshow (f); cursor off{}END PROC menu dateien verzeichnis;{}PROC menu dateien loeschen:{} lasse dateien auswaehlen;{} loesche ausgewaehlte dateien;{} regenerate menuscreen.{} lasse dateien auswaehlen:{} IF NOT not empty (ALL myself){}
- THEN noch keine datei;{} LEAVE menu dateien loeschen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} THESAURUS VAR angekreuzte :={} menuanswersome ( center (breite, invers (menubasistext(162))) +{} menubasistext (163), "", ALL myself,{} menubasistext (162), menubasistext (91) +{} menubasistext (104) + menubasistext (92), FALSE).{} loesche ausgewaehlte dateien:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{}
- menuwindowout (menuwindowcenter (invers (menubasistext (162))));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operation aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (menubasistext (93) + menubasistext (104));{} menuwindowstop.{} fuehre einzelne operation aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (angekreuzte) REP{} IF name (angekreuzte, k) = niltext{} THEN LEAVE fuehre einzelne operation aus{}
- ELIF NOT exists (name (angekreuzte, k)){} THEN menuwindowout (" """ + name (angekreuzte, k) + """");{} menuwindowline;{} menuwindowout (menubasistext (188)); menuwindowline;{} LEAVE fuehre einzelne operation aus{} ELSE disable stop;{} IF menuwindowyes (" """ + name (angekreuzte, k) + """ "{} + menubasistext (111)){} THEN forget (name (angekreuzte, k), quiet){} FI;{}
- fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (angekreuzte){} THEN menuwindowline (2);{} menuwindowout (menubasistext (94));{} menuwindowstop;{} regenerate menuscreen;{} LEAVE menu dateien loeschen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{}
- THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE menu dateien loeschen{} FI{}END PROC menu dateien loeschen;{}PROC menu dateien drucken:{} lasse programme auswaehlen;{} drucke programme;{} regenerate menuscreen.{} lasse programme auswaehlen:{} IF NOT not empty (ALL myself){} THEN noch keine datei;{} LEAVE menu dateien drucken{} ELSE biete auswahl an{} FI.{} biete auswahl an:{}
- THESAURUS VAR angekreuzte :={} menuanswersome ( center (breite, invers (menubasistext(164))) +{} menubasistext (163), "", ALL myself,{} menubasistext (164), menubasistext (91) +{} menubasistext (165) + menubasistext (92), FALSE).{} drucke programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (menubasistext (164))));{} menuwindowline (2);{} command dialogue (FALSE);{}
- fuehre einzelne operation aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (menubasistext (93) + menubasistext (165));{} menuwindowstop.{} fuehre einzelne operation aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (angekreuzte) REP{} IF name (angekreuzte, k) = niltext{} THEN LEAVE fuehre einzelne operation aus{} ELIF NOT exists (name (angekreuzte, k)){} THEN menuwindowout (" """ + name (angekreuzte, k) + """");{}
- menuwindowline;{} menuwindowout (menubasistext (188)); menuwindowline;{} LEAVE fuehre einzelne operation aus{} ELSE disable stop;{} menuwindowout ( " """ + name (angekreuzte, k) + """ "{} + menubasistext (166));{} menuwindowline;{} print (name (angekreuzte, k));{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (angekreuzte){}
- THEN menuwindowline (2);{} menuwindowout (menubasistext (94));{} menuwindowstop;{} regenerate menuscreen;{} LEAVE menu dateien drucken{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{}
- LEAVE menu dateien drucken{} FI.{}END PROC menu dateien drucken;{}PROC menu dateien kopieren:{} ermittle alten dateinamen;{} erfrage neuen dateinamen;{} kopiere ggf die datei.{} ermittle alten dateinamen:{} IF NOT not empty (ALL myself){} THEN noch keine datei;{} LEAVE menu dateien kopieren{} ELSE hole den namen{} FI.{} hole den namen:{} TEXT VAR alter name :={} menuanswerone ( center (breite, invers (menubasistext(167))) +{} menubasistext (163), "", ALL myself,{}
- menubasistext (167), menubasistext (168) +{} menubasistext (169) + menubasistext (170), TRUE);{} IF alter name = niltext{} THEN LEAVE menu dateien kopieren{} ELIF NOT exists (alter name){} THEN menuinfo (menubasistext (188));{} LEAVE menu dateien kopieren{} FI.{} erfrage neuen dateinamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + menubasistext (171) + bisheriger name{}
- + menubasistext (172).{} ueberschrift:{} center (maxlaenge, invers (menubasistext (167))) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} kopiere ggf die datei:{} IF neuer name = niltext{} THEN menuinfo (invers (menubasistext (173)));{} LEAVE menu dateien kopieren{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE menu dateien kopieren{} ELSE copy (alter name, neuer name){}
- FI.{} mache vorwurf:{} menuinfo (menubasistext (174)).{}END PROC menu dateien kopieren;{}PROC menu dateien umbenennen:{} ermittle alten dateinamen;{} erfrage neuen dateinamen;{} benenne ggf die datei um.{} ermittle alten dateinamen:{} IF NOT not empty (ALL myself){} THEN noch keine datei;{} LEAVE menu dateien umbenennen{} ELSE hole den namen{} FI.{} hole den namen:{} TEXT VAR alter name :={} menuanswerone ( center (breite, invers (menubasistext(175))) +{}
- menubasistext (163), "", ALL myself,{} menubasistext (175), menubasistext (168) +{} menubasistext (176) + menubasistext (170), TRUE);{} IF alter name = niltext{} THEN LEAVE menu dateien umbenennen{} ELIF NOT exists (alter name){} THEN menuinfo (menubasistext (188));{} LEAVE menu dateien umbenennen{} FI.{} erfrage neuen dateinamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{}
- ueberschrift + menubasistext (171) + bisheriger name{} + menubasistext (177).{} ueberschrift:{} center (maxlaenge, invers (menubasistext (175))) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} benenne ggf die datei um:{} IF neuer name = niltext{} THEN menuinfo (invers (menubasistext (173)));{} LEAVE menu dateien umbenennen{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE menu dateien umbenennen{}
- ELSE rename (alter name, neuer name){} FI.{} mache vorwurf:{} menuinfo (menubasistext (174)).{}END PROC menu dateien umbenennen;{}PROC menu dateien speicherplatz:{} lasse dateinamen auswaehlen;{} ermittle den speicherplatz;{} regenerate menuscreen.{} lasse dateinamen auswaehlen:{} IF NOT not empty (ALL myself){} THEN noch keine datei;{} LEAVE menu dateien speicherplatz{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} THESAURUS VAR angekreuzte :={}
- menuanswersome ( center (breite, invers (menubasistext(178))) +{} menubasistext (163), "", ALL myself,{} menubasistext (178), menubasistext (179), FALSE).{} ermittle den speicherplatz:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (menubasistext (178))));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operation aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{}
- menuwindowout (menubasistext (180));{} menuwindowstop.{} fuehre einzelne operation aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (angekreuzte) REP{} IF name (angekreuzte, k) = niltext{} THEN LEAVE fuehre einzelne operation aus{} ELIF NOT exists (name (angekreuzte, k)){} THEN menuwindowout (" """ + name (angekreuzte, k) + """");{} menuwindowline;{} menuwindowout (menubasistext (188)); menuwindowline;{} LEAVE fuehre einzelne operation aus{}
- ELSE disable stop;{} menuwindowout ( " """ + name (angekreuzte, k) + """ "{} + menubasistext (181){} + speicherplatz (name (angekreuzte, k)));{} menuwindowline;{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (angekreuzte){} THEN menuwindowline (2);{} menuwindowout (menubasistext (94));{} menuwindowstop;{} regenerate menuscreen;{}
- LEAVE menu dateien speicherplatz{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE menu dateien speicherplatz{} FI.{}END PROC menu dateien speicherplatz;{}TEXT PROC speicherplatz (TEXT CONST dateiname):{}
- DATASPACE VAR ds :: old (dateiname);{} INT CONST platz :: storage (ds);{} forget (ds);{} " " + text (platz) + menubasistext (182){}END PROC speicherplatz;{}PROC menu dateien aufraeumen:{} lasse dateinamen auswaehlen;{} raeume die dateien auf;{} regenerate menuscreen.{} lasse dateinamen auswaehlen:{} IF NOT not empty (ALL myself){} THEN noch keine datei;{} LEAVE menu dateien aufraeumen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} THESAURUS VAR angekreuzte :={}
- menuanswersome ( center (breite, invers (menubasistext(183))) +{} menubasistext (163), "", ALL myself,{} menubasistext (183), menubasistext (91) +{} menubasistext (184) + menubasistext (92), FALSE).{} raeume die dateien auf:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (menubasistext (183))));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operation aus;{}
- command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (menubasistext (93) + menubasistext (184));{} menuwindowstop.{} fuehre einzelne operation aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (angekreuzte) REP{} IF name (angekreuzte, k) = niltext{} THEN LEAVE fuehre einzelne operation aus{} ELIF NOT exists (name (angekreuzte, k)){} THEN menuwindowout (" """ + name (angekreuzte, k) + """");{} menuwindowline;{} menuwindowout (menubasistext (188)); menuwindowline;{}
- LEAVE fuehre einzelne operation aus{} ELIF dateityp ist ok{} THEN disable stop;{} menuwindowline;{} menuwindowout ( " """ + name (angekreuzte, k) + """ "{} + menubasistext (185) );{} menuwindowline; menuwindowout (" ");{} reorganize (name (angekreuzte, k));{} fehlerbehandlung{} ELSE menuwindowout ( " """ + name (angekreuzte, k) + """ "{} + menubasistext (186)){}
- FI{} PER.{} dateityp ist ok:{} type (old (name (angekreuzte, k))) = filetype.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (angekreuzte){} THEN menuwindowline (2);{} menuwindowout (menubasistext (94));{} menuwindowstop;{} regenerate menuscreen;{} LEAVE menu dateien aufraeumen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){}
- FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE menu dateien aufraeumen{} FI.{}END PROC menu dateien aufraeumen;{}PROC noch keine datei:{} menuinfo (menubasistext ( 187)){}END PROC noch keine datei;{}END PACKET ls dialog 7;{}
+PACKET ls dialog 7 DEFINES
+ menu dateien verzeichnis,
+ menu dateien loeschen,
+ menu dateien drucken,
+ menu dateien kopieren,
+ menu dateien umbenennen,
+ menu dateien speicherplatz,
+ menu dateien aufraeumen:
+LET filetype = 1003,
+ maxlaenge = 60,
+ breite = 40,
+ niltext = "";
+TEXT CONST dateibez :: "Dateiliste bei internen Operationen";
+PROC menu dateien verzeichnis:
+ forget (dateibez, quiet);
+ liste dateien auf;
+
+ regenerate menuscreen.
+ liste dateien auf:
+ erstelle liste;
+ gib liste aus;
+ forget (dateibez, quiet).
+ erstelle liste:
+ menufootnote (menubasistext (21) + menubasistext (28));
+ FILE VAR f :: sequential file (output, dateibez);
+ list (f); modify (f);
+ headline (f, menubasistext (43));
+ to line (f, 1); insert record (f);
+ write record (f, menubasistext (161));
+ entferne eigenen namen aus der liste.
+ entferne eigenen namen aus der liste:
+ TEXT VAR zeile :: ""; INT VAR i;
+
+ FOR i FROM lines (f) DOWNTO 1 REP
+ to line (f, i); read record (f, zeile);
+ IF pos (zeile, dateibez) > 0
+ THEN delete record (f);
+ LEAVE entferne eigenen namen aus der liste
+ FI
+ PER.
+ gib liste aus:
+ to line (f, 1); cursor on; menuwindowshow (f); cursor off
+END PROC menu dateien verzeichnis;
+PROC menu dateien loeschen:
+ lasse dateien auswaehlen;
+ loesche ausgewaehlte dateien;
+ regenerate menuscreen.
+ lasse dateien auswaehlen:
+ IF NOT not empty (ALL myself)
+
+ THEN noch keine datei;
+ LEAVE menu dateien loeschen
+ ELSE biete auswahl an
+ FI.
+ biete auswahl an:
+ THESAURUS VAR angekreuzte :=
+ menuanswersome ( center (breite, invers (menubasistext(162))) +
+ menubasistext (163), "", ALL myself,
+ menubasistext (162), menubasistext (91) +
+ menubasistext (104) + menubasistext (92), FALSE).
+ loesche ausgewaehlte dateien:
+ show menuwindow;
+ steige ggf bei leerem thesaurus aus;
+
+ menuwindowout (menuwindowcenter (invers (menubasistext (162))));
+ menuwindowline (2);
+ command dialogue (FALSE);
+ fuehre einzelne operation aus;
+ command dialogue (TRUE);
+ schlage ggf neue seite auf;
+ menuwindowout (menubasistext (93) + menubasistext (104));
+ menuwindowstop.
+ fuehre einzelne operation aus:
+ INT VAR k;
+ FOR k FROM 1 UPTO highest entry (angekreuzte) REP
+ IF name (angekreuzte, k) = niltext
+ THEN LEAVE fuehre einzelne operation aus
+
+ ELIF NOT exists (name (angekreuzte, k))
+ THEN menuwindowout (" """ + name (angekreuzte, k) + """");
+ menuwindowline;
+ menuwindowout (menubasistext (188)); menuwindowline;
+ LEAVE fuehre einzelne operation aus
+ ELSE disable stop;
+ IF menuwindowyes (" """ + name (angekreuzte, k) + """ "
+ + menubasistext (111))
+ THEN forget (name (angekreuzte, k), quiet)
+ FI;
+
+ fehlerbehandlung
+ FI
+ PER.
+ steige ggf bei leerem thesaurus aus:
+ IF NOT not empty (angekreuzte)
+ THEN menuwindowline (2);
+ menuwindowout (menubasistext (94));
+ menuwindowstop;
+ regenerate menuscreen;
+ LEAVE menu dateien loeschen
+ FI.
+ schlage ggf neue seite auf:
+ IF remaining menuwindowlines < 7
+ THEN menuwindowpage; menuwindowline
+ ELSE menuwindowline (2)
+ FI.
+ fehlerbehandlung:
+ IF is error
+
+ THEN regenerate menuscreen;
+ menuinfo (invers (errormessage));
+ clear error; enable stop;
+ LEAVE menu dateien loeschen
+ FI
+END PROC menu dateien loeschen;
+PROC menu dateien drucken:
+ lasse programme auswaehlen;
+ drucke programme;
+ regenerate menuscreen.
+ lasse programme auswaehlen:
+ IF NOT not empty (ALL myself)
+ THEN noch keine datei;
+ LEAVE menu dateien drucken
+ ELSE biete auswahl an
+ FI.
+ biete auswahl an:
+
+ THESAURUS VAR angekreuzte :=
+ menuanswersome ( center (breite, invers (menubasistext(164))) +
+ menubasistext (163), "", ALL myself,
+ menubasistext (164), menubasistext (91) +
+ menubasistext (165) + menubasistext (92), FALSE).
+ drucke programme:
+ show menuwindow;
+ steige ggf bei leerem thesaurus aus;
+ menuwindowout (menuwindowcenter (invers (menubasistext (164))));
+ menuwindowline (2);
+ command dialogue (FALSE);
+
+ fuehre einzelne operation aus;
+ command dialogue (TRUE);
+ schlage ggf neue seite auf;
+ menuwindowout (menubasistext (93) + menubasistext (165));
+ menuwindowstop.
+ fuehre einzelne operation aus:
+ INT VAR k;
+ FOR k FROM 1 UPTO highest entry (angekreuzte) REP
+ IF name (angekreuzte, k) = niltext
+ THEN LEAVE fuehre einzelne operation aus
+ ELIF NOT exists (name (angekreuzte, k))
+ THEN menuwindowout (" """ + name (angekreuzte, k) + """");
+
+ menuwindowline;
+ menuwindowout (menubasistext (188)); menuwindowline;
+ LEAVE fuehre einzelne operation aus
+ ELSE disable stop;
+ menuwindowout ( " """ + name (angekreuzte, k) + """ "
+ + menubasistext (166));
+ menuwindowline;
+ print (name (angekreuzte, k));
+ fehlerbehandlung
+ FI
+ PER.
+ steige ggf bei leerem thesaurus aus:
+ IF NOT not empty (angekreuzte)
+
+ THEN menuwindowline (2);
+ menuwindowout (menubasistext (94));
+ menuwindowstop;
+ regenerate menuscreen;
+ LEAVE menu dateien drucken
+ FI.
+ schlage ggf neue seite auf:
+ IF remaining menuwindowlines < 7
+ THEN menuwindowpage; menuwindowline
+ ELSE menuwindowline (2)
+ FI.
+ fehlerbehandlung:
+ IF is error
+ THEN regenerate menuscreen;
+ menuinfo (invers (errormessage));
+ clear error; enable stop;
+
+ LEAVE menu dateien drucken
+ FI.
+END PROC menu dateien drucken;
+PROC menu dateien kopieren:
+ ermittle alten dateinamen;
+ erfrage neuen dateinamen;
+ kopiere ggf die datei.
+ ermittle alten dateinamen:
+ IF NOT not empty (ALL myself)
+ THEN noch keine datei;
+ LEAVE menu dateien kopieren
+ ELSE hole den namen
+ FI.
+ hole den namen:
+ TEXT VAR alter name :=
+ menuanswerone ( center (breite, invers (menubasistext(167))) +
+ menubasistext (163), "", ALL myself,
+
+ menubasistext (167), menubasistext (168) +
+ menubasistext (169) + menubasistext (170), TRUE);
+ IF alter name = niltext
+ THEN LEAVE menu dateien kopieren
+ ELIF NOT exists (alter name)
+ THEN menuinfo (menubasistext (188));
+ LEAVE menu dateien kopieren
+ FI.
+ erfrage neuen dateinamen:
+ TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
+ ausgabe:
+ ueberschrift + menubasistext (171) + bisheriger name
+
+ + menubasistext (172).
+ ueberschrift:
+ center (maxlaenge, invers (menubasistext (167))) + ""13""13"".
+ bisheriger name:
+ ""13""13" " + invers (alter name) + ""13""13"".
+ kopiere ggf die datei:
+ IF neuer name = niltext
+ THEN menuinfo (invers (menubasistext (173)));
+ LEAVE menu dateien kopieren
+ ELIF exists (neuer name)
+ THEN mache vorwurf;
+ LEAVE menu dateien kopieren
+ ELSE copy (alter name, neuer name)
+
+ FI.
+ mache vorwurf:
+ menuinfo (menubasistext (174)).
+END PROC menu dateien kopieren;
+PROC menu dateien umbenennen:
+ ermittle alten dateinamen;
+ erfrage neuen dateinamen;
+ benenne ggf die datei um.
+ ermittle alten dateinamen:
+ IF NOT not empty (ALL myself)
+ THEN noch keine datei;
+ LEAVE menu dateien umbenennen
+ ELSE hole den namen
+ FI.
+ hole den namen:
+ TEXT VAR alter name :=
+ menuanswerone ( center (breite, invers (menubasistext(175))) +
+
+ menubasistext (163), "", ALL myself,
+ menubasistext (175), menubasistext (168) +
+ menubasistext (176) + menubasistext (170), TRUE);
+ IF alter name = niltext
+ THEN LEAVE menu dateien umbenennen
+ ELIF NOT exists (alter name)
+ THEN menuinfo (menubasistext (188));
+ LEAVE menu dateien umbenennen
+ FI.
+ erfrage neuen dateinamen:
+ TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
+ ausgabe:
+
+ ueberschrift + menubasistext (171) + bisheriger name
+ + menubasistext (177).
+ ueberschrift:
+ center (maxlaenge, invers (menubasistext (175))) + ""13""13"".
+ bisheriger name:
+ ""13""13" " + invers (alter name) + ""13""13"".
+ benenne ggf die datei um:
+ IF neuer name = niltext
+ THEN menuinfo (invers (menubasistext (173)));
+ LEAVE menu dateien umbenennen
+ ELIF exists (neuer name)
+ THEN mache vorwurf;
+ LEAVE menu dateien umbenennen
+
+ ELSE rename (alter name, neuer name)
+ FI.
+ mache vorwurf:
+ menuinfo (menubasistext (174)).
+END PROC menu dateien umbenennen;
+PROC menu dateien speicherplatz:
+ lasse dateinamen auswaehlen;
+ ermittle den speicherplatz;
+ regenerate menuscreen.
+ lasse dateinamen auswaehlen:
+ IF NOT not empty (ALL myself)
+ THEN noch keine datei;
+ LEAVE menu dateien speicherplatz
+ ELSE biete auswahl an
+ FI.
+ biete auswahl an:
+ THESAURUS VAR angekreuzte :=
+
+ menuanswersome ( center (breite, invers (menubasistext(178))) +
+ menubasistext (163), "", ALL myself,
+ menubasistext (178), menubasistext (179), FALSE).
+ ermittle den speicherplatz:
+ show menuwindow;
+ steige ggf bei leerem thesaurus aus;
+ menuwindowout (menuwindowcenter (invers (menubasistext (178))));
+ menuwindowline (2);
+ command dialogue (FALSE);
+ fuehre einzelne operation aus;
+ command dialogue (TRUE);
+ schlage ggf neue seite auf;
+
+ menuwindowout (menubasistext (180));
+ menuwindowstop.
+ fuehre einzelne operation aus:
+ INT VAR k;
+ FOR k FROM 1 UPTO highest entry (angekreuzte) REP
+ IF name (angekreuzte, k) = niltext
+ THEN LEAVE fuehre einzelne operation aus
+ ELIF NOT exists (name (angekreuzte, k))
+ THEN menuwindowout (" """ + name (angekreuzte, k) + """");
+ menuwindowline;
+ menuwindowout (menubasistext (188)); menuwindowline;
+ LEAVE fuehre einzelne operation aus
+
+ ELSE disable stop;
+ menuwindowout ( " """ + name (angekreuzte, k) + """ "
+ + menubasistext (181)
+ + speicherplatz (name (angekreuzte, k)));
+ menuwindowline;
+ fehlerbehandlung
+ FI
+ PER.
+ steige ggf bei leerem thesaurus aus:
+ IF NOT not empty (angekreuzte)
+ THEN menuwindowline (2);
+ menuwindowout (menubasistext (94));
+ menuwindowstop;
+ regenerate menuscreen;
+
+ LEAVE menu dateien speicherplatz
+ FI.
+ schlage ggf neue seite auf:
+ IF remaining menuwindowlines < 7
+ THEN menuwindowpage; menuwindowline
+ ELSE menuwindowline (2)
+ FI.
+ fehlerbehandlung:
+ IF is error
+ THEN regenerate menuscreen;
+ menuinfo (invers (errormessage));
+ clear error; enable stop;
+ LEAVE menu dateien speicherplatz
+ FI.
+END PROC menu dateien speicherplatz;
+TEXT PROC speicherplatz (TEXT CONST dateiname):
+
+ DATASPACE VAR ds :: old (dateiname);
+ INT CONST platz :: storage (ds);
+ forget (ds);
+ " " + text (platz) + menubasistext (182)
+END PROC speicherplatz;
+PROC menu dateien aufraeumen:
+ lasse dateinamen auswaehlen;
+ raeume die dateien auf;
+ regenerate menuscreen.
+ lasse dateinamen auswaehlen:
+ IF NOT not empty (ALL myself)
+ THEN noch keine datei;
+ LEAVE menu dateien aufraeumen
+ ELSE biete auswahl an
+ FI.
+ biete auswahl an:
+ THESAURUS VAR angekreuzte :=
+
+ menuanswersome ( center (breite, invers (menubasistext(183))) +
+ menubasistext (163), "", ALL myself,
+ menubasistext (183), menubasistext (91) +
+ menubasistext (184) + menubasistext (92), FALSE).
+ raeume die dateien auf:
+ show menuwindow;
+ steige ggf bei leerem thesaurus aus;
+ menuwindowout (menuwindowcenter (invers (menubasistext (183))));
+ menuwindowline (2);
+ command dialogue (FALSE);
+ fuehre einzelne operation aus;
+
+ command dialogue (TRUE);
+ schlage ggf neue seite auf;
+ menuwindowout (menubasistext (93) + menubasistext (184));
+ menuwindowstop.
+ fuehre einzelne operation aus:
+ INT VAR k;
+ FOR k FROM 1 UPTO highest entry (angekreuzte) REP
+ IF name (angekreuzte, k) = niltext
+ THEN LEAVE fuehre einzelne operation aus
+ ELIF NOT exists (name (angekreuzte, k))
+ THEN menuwindowout (" """ + name (angekreuzte, k) + """");
+ menuwindowline;
+ menuwindowout (menubasistext (188)); menuwindowline;
+
+ LEAVE fuehre einzelne operation aus
+ ELIF dateityp ist ok
+ THEN disable stop;
+ menuwindowline;
+ menuwindowout ( " """ + name (angekreuzte, k) + """ "
+ + menubasistext (185) );
+ menuwindowline; menuwindowout (" ");
+ reorganize (name (angekreuzte, k));
+ fehlerbehandlung
+ ELSE menuwindowout ( " """ + name (angekreuzte, k) + """ "
+ + menubasistext (186))
+
+ FI
+ PER.
+ dateityp ist ok:
+ type (old (name (angekreuzte, k))) = filetype.
+ steige ggf bei leerem thesaurus aus:
+ IF NOT not empty (angekreuzte)
+ THEN menuwindowline (2);
+ menuwindowout (menubasistext (94));
+ menuwindowstop;
+ regenerate menuscreen;
+ LEAVE menu dateien aufraeumen
+ FI.
+ schlage ggf neue seite auf:
+ IF remaining menuwindowlines < 7
+ THEN menuwindowpage; menuwindowline
+ ELSE menuwindowline (2)
+
+ FI.
+ fehlerbehandlung:
+ IF is error
+ THEN regenerate menuscreen;
+ menuinfo (invers (errormessage));
+ clear error; enable stop;
+ LEAVE menu dateien aufraeumen
+ FI.
+END PROC menu dateien aufraeumen;
+PROC noch keine datei:
+ menuinfo (menubasistext ( 187))
+END PROC noch keine datei;
+END PACKET ls dialog 7;
+
diff --git a/dialog/ls-DIALOG MENUKARTEN MANAGER b/dialog/ls-DIALOG MENUKARTEN MANAGER
index 67799ea..a6fcb1f 100644
--- a/dialog/ls-DIALOG MENUKARTEN MANAGER
+++ b/dialog/ls-DIALOG MENUKARTEN MANAGER
@@ -22,7 +22,45 @@
*)
-PACKET ls dialog manager DEFINES{} ls dialog manager:{}LET fetch code = 11,{} save code = 12,{} exists code = 13,{} list code = 15,{} continue code = 100;{}LET mm taskname = "ls-MENUKARTEN",{} gibt es schon = "Die Task 'ls-MENUKARTEN' existiert schon!",{} verweis = "Unzulässiger Zugriff auf die Task 'ls-MENUKARTEN'!";{}PROC ls dialog manager:{} stelle richtigen tasknamen ein;{} global manager{} (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) ls dialog manager){}
-END PROC ls dialog manager;{}PROC stelle richtigen tasknamen ein:{} IF name (myself) <> mm taskname{} THEN nimm umbenennung vor{} FI.{} nimm umbenennung vor:{} IF NOT exists task (mm taskname){} THEN rename myself (mm taskname){} ELSE errorstop (gibt es schon){} FI.{}END PROC stelle richtigen tasknamen ein;{}PROC ls dialog manager (DATASPACE VAR ds, INT CONST order, phase,{} TASK CONST order task):{} IF order task = supervisor{} OR order = fetch code{}
- OR order = save code{} OR order = exists code{} OR order = list code{} OR order = continue code{} THEN free manager (ds, order, phase, order task){} ELSE errorstop (verweis){} FI{}END PROC ls dialog manager;{}END PACKET ls dialog manager;{}
+PACKET ls dialog manager DEFINES
+ ls dialog manager:
+LET fetch code = 11,
+ save code = 12,
+ exists code = 13,
+ list code = 15,
+ continue code = 100;
+LET mm taskname = "ls-MENUKARTEN",
+ gibt es schon = "Die Task 'ls-MENUKARTEN' existiert schon!",
+ verweis = "Unzulässiger Zugriff auf die Task 'ls-MENUKARTEN'!";
+PROC ls dialog manager:
+ stelle richtigen tasknamen ein;
+ global manager
+ (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) ls dialog manager)
+
+END PROC ls dialog manager;
+PROC stelle richtigen tasknamen ein:
+ IF name (myself) <> mm taskname
+ THEN nimm umbenennung vor
+ FI.
+ nimm umbenennung vor:
+ IF NOT exists task (mm taskname)
+ THEN rename myself (mm taskname)
+ ELSE errorstop (gibt es schon)
+ FI.
+END PROC stelle richtigen tasknamen ein;
+PROC ls dialog manager (DATASPACE VAR ds, INT CONST order, phase,
+ TASK CONST order task):
+ IF order task = supervisor
+ OR order = fetch code
+
+ OR order = save code
+ OR order = exists code
+ OR order = list code
+ OR order = continue code
+ THEN free manager (ds, order, phase, order task)
+ ELSE errorstop (verweis)
+ FI
+END PROC ls dialog manager;
+END PACKET ls dialog manager;
+
diff --git a/dialog/ls-DIALOG MM-gen b/dialog/ls-DIALOG MM-gen
index ef05853..213a826 100644
--- a/dialog/ls-DIALOG MM-gen
+++ b/dialog/ls-DIALOG MM-gen
@@ -22,6 +22,29 @@
*)
-LET dateiname = "ls-DIALOG MENUKARTEN MANAGER",{} archivname = "gs-dialog";{}gib bildschirmhinweis;{}hole generatordatei vom archiv;{}insertiere die datei;{}do ("ls dialog manager").{}gib bildschirmhinweis:{} page;{} putline (" "15"ls-DIALOG MENUKARTEN MANAGER - Generierung "14"").{}hole generatordatei vom archiv:{} IF NOT exists (dateiname){} THEN cursor (1, 5); out (""4"");{} putline ("Bitte warten... Ich hole eine Datei von der Diskette!");{} archive (archivname);{}
- fetch (dateiname, archive);{} release (archive){} FI.{}insertiere die datei:{} cursor (1, 5); out (""4"");{} putline ("Bitte warten... Ich insertiere!");{} check off; insert (dateiname); check on;{} forget ("ls-DIALOG MM/gen", quiet);{} forget (dateiname, quiet).{}
+LET dateiname = "ls-DIALOG MENUKARTEN MANAGER",
+ archivname = "gs-dialog";
+gib bildschirmhinweis;
+hole generatordatei vom archiv;
+insertiere die datei;
+do ("ls dialog manager").
+gib bildschirmhinweis:
+ page;
+ putline (" "15"ls-DIALOG MENUKARTEN MANAGER - Generierung "14"").
+hole generatordatei vom archiv:
+ IF NOT exists (dateiname)
+ THEN cursor (1, 5); out (""4"");
+ putline ("Bitte warten... Ich hole eine Datei von der Diskette!");
+ archive (archivname);
+
+ fetch (dateiname, archive);
+ release (archive)
+ FI.
+insertiere die datei:
+ cursor (1, 5); out (""4"");
+ putline ("Bitte warten... Ich insertiere!");
+ check off; insert (dateiname); check on;
+ forget ("ls-DIALOG MM/gen", quiet);
+ forget (dateiname, quiet).
+
diff --git a/dialog/ls-DIALOG decompress b/dialog/ls-DIALOG decompress
index 96d9340..fdda0d6 100644
--- a/dialog/ls-DIALOG decompress
+++ b/dialog/ls-DIALOG decompress
@@ -69,7 +69,8 @@ PROC komprimiere (TEXT CONST dateiname):
haenge zeilentrenner an:
IF zwischenzeile <> ""
- THEN zwischenzeile CAT "{}"
+ THEN zwischenzeile CAT "
+"
FI.
haenge zwischenzeile an ausgabezeile:
@@ -138,13 +139,15 @@ PROC dekomprimiere (TEXT CONST dateiname):
PER.
nimm das erste stueck und schreibe es weg:
- ausgabezeile := subtext (eingabezeile, 1, pos (eingabezeile, "{}") - 1);
+ ausgabezeile := subtext (eingabezeile, 1, pos (eingabezeile, "
+") - 1);
putline (aus, ausgabezeile);
zaehler INCR 1;
cout (zaehler).
entferne den zeilentrenner:
- eingabezeile := subtext (eingabezeile, pos (eingabezeile, "{}") + 2).
+ eingabezeile := subtext (eingabezeile, pos (eingabezeile, "
+") + 2).
END PROC dekomprimiere;
END PACKET ls dialog decompress;
diff --git a/dialog/ls-DIALOG-gen b/dialog/ls-DIALOG-gen
index e085616..b5c7867 100644
--- a/dialog/ls-DIALOG-gen
+++ b/dialog/ls-DIALOG-gen
@@ -22,12 +22,108 @@
*)
-LET mm taskname = "ls-MENUKARTEN",{} datei 1 = "ls-DIALOG 1",{} datei 2 = "ls-DIALOG 2",{} datei 3 = "ls-DIALOG 3",{} datei 4 = "ls-DIALOG 4",{} datei 5 = "ls-DIALOG 5",{} datei 6 = "ls-DIALOG 6",{} datei 7 = "ls-DIALOG 7",{} menukarte = "ls-MENUKARTE:Archiv";{}PROC stelle existenz des mm sicher:{} cursor (1, 5); out (""4"");{} IF NOT exists (task (mm taskname)){} THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!");{} FI{}
-END PROC stelle existenz des mm sicher;{}PROC vom archiv (TEXT CONST datei):{} cursor (1,5); out (""4"");{} out (" """); out (datei); putline (""" wird geholt.");{} fetch (datei, archive){}END PROC vom archiv;{}PROC hole (TEXT CONST datei):{} IF NOT exists (datei) THEN vom archiv (datei) FI{}END PROC hole;{}PROC in (TEXT CONST datei):{} hole (datei);{} cursor (1, 5); out (""4"");{} out (" """); out (datei); out (""" wird übersetzt: ");{} insert (datei);{} forget (datei, quiet);{}END PROC in;{}
-PROC schicke (TEXT CONST datei):{} cursor (1, 5); out (""4"");{} out (" """); out(datei);{} out (""" wird zum MENUKARTEN-MANAGER geschickt!");{} command dialogue (FALSE);{} save (datei, task (mm taskname));{} command dialogue (TRUE);{} forget (datei, quiet){}END PROC schicke;{}INT VAR size, used;{}BOOL VAR einzeln;{}storage (size, used);{}einzeln := size - used < 500;{}forget ("ls-DIALOG/gen", quiet);{}wirf kopfzeile aus;{}stelle existenz des mm sicher;{}hole die dateien;{}insertiere die dateien;{}
-mache global manager aus der task.{}wirf kopfzeile aus:{} page;{} putline (" "15"ls-DIALOG - Automatische Generierung "14"").{}hole die dateien:{} IF NOT exists (datei 1) COR NOT exists (datei 2){} COR NOT exists (datei 3) COR NOT exists (datei 4){} COR NOT exists (datei 5) COR NOT exists (datei 6){} COR NOT exists (datei 7) COR NOT exists (menukarte){} THEN hole dateien vom archiv{} FI.{}hole dateien vom archiv:{} cursor (1,3);{} IF yes ("Ist das Archiv angemeldet und die 'ls-DIALOG' - Diskette eingelegt"){}
- THEN lese ein{} ELSE line (2);{} errorstop ("Ohne die Diskette kann ich das System nicht generieren!"){} FI.{}lese ein:{} cursor (1, 3); out (""4"");{} out (" "15"Bitte die Diskette eingelegt lassen! "14"");{} IF NOT einzeln{} THEN hole (datei 1);{} hole (datei 2);{} hole (datei 3);{} hole (datei 4);{} hole (datei 5);{} hole (datei 6);{} hole (datei 7);{} hole (menukarte);{} cursor (1, 3); out(""4"");{}
- out (" "15"Die Diskette wird nicht mehr benötigt! "14"");{} release (archive){} FI.{}insertiere die dateien:{} check off;{} in (datei 1);{} in (datei 2);{} in (datei 3);{} in (datei 4);{} in (datei 5);{} in (datei 6);{} in (datei 7);{} schicke (menukarte);{} IF einzeln THEN release (archive) FI;{} check on.{}mache global manager aus der task:{} global manager.{}
+LET mm taskname = "ls-MENUKARTEN",
+ datei 1 = "ls-DIALOG 1",
+ datei 2 = "ls-DIALOG 2",
+ datei 3 = "ls-DIALOG 3",
+ datei 4 = "ls-DIALOG 4",
+ datei 5 = "ls-DIALOG 5",
+ datei 6 = "ls-DIALOG 6",
+ datei 7 = "ls-DIALOG 7",
+ menukarte = "ls-MENUKARTE:Archiv";
+PROC stelle existenz des mm sicher:
+ cursor (1, 5); out (""4"");
+ IF NOT exists (task (mm taskname))
+ THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!");
+ FI
+
+END PROC stelle existenz des mm sicher;
+PROC vom archiv (TEXT CONST datei):
+ cursor (1,5); out (""4"");
+ out (" """); out (datei); putline (""" wird geholt.");
+ fetch (datei, archive)
+END PROC vom archiv;
+PROC hole (TEXT CONST datei):
+ IF NOT exists (datei) THEN vom archiv (datei) FI
+END PROC hole;
+PROC in (TEXT CONST datei):
+ hole (datei);
+ cursor (1, 5); out (""4"");
+ out (" """); out (datei); out (""" wird übersetzt: ");
+ insert (datei);
+ forget (datei, quiet);
+END PROC in;
+
+PROC schicke (TEXT CONST datei):
+ cursor (1, 5); out (""4"");
+ out (" """); out(datei);
+ out (""" wird zum MENUKARTEN-MANAGER geschickt!");
+ command dialogue (FALSE);
+ save (datei, task (mm taskname));
+ command dialogue (TRUE);
+ forget (datei, quiet)
+END PROC schicke;
+INT VAR size, used;
+BOOL VAR einzeln;
+storage (size, used);
+einzeln := size - used < 500;
+forget ("ls-DIALOG/gen", quiet);
+wirf kopfzeile aus;
+stelle existenz des mm sicher;
+hole die dateien;
+insertiere die dateien;
+
+mache global manager aus der task.
+wirf kopfzeile aus:
+ page;
+ putline (" "15"ls-DIALOG - Automatische Generierung "14"").
+hole die dateien:
+ IF NOT exists (datei 1) COR NOT exists (datei 2)
+ COR NOT exists (datei 3) COR NOT exists (datei 4)
+ COR NOT exists (datei 5) COR NOT exists (datei 6)
+ COR NOT exists (datei 7) COR NOT exists (menukarte)
+ THEN hole dateien vom archiv
+ FI.
+hole dateien vom archiv:
+ cursor (1,3);
+ IF yes ("Ist das Archiv angemeldet und die 'ls-DIALOG' - Diskette eingelegt")
+
+ THEN lese ein
+ ELSE line (2);
+ errorstop ("Ohne die Diskette kann ich das System nicht generieren!")
+ FI.
+lese ein:
+ cursor (1, 3); out (""4"");
+ out (" "15"Bitte die Diskette eingelegt lassen! "14"");
+ IF NOT einzeln
+ THEN hole (datei 1);
+ hole (datei 2);
+ hole (datei 3);
+ hole (datei 4);
+ hole (datei 5);
+ hole (datei 6);
+ hole (datei 7);
+ hole (menukarte);
+ cursor (1, 3); out(""4"");
+
+ out (" "15"Die Diskette wird nicht mehr benötigt! "14"");
+ release (archive)
+ FI.
+insertiere die dateien:
+ check off;
+ in (datei 1);
+ in (datei 2);
+ in (datei 3);
+ in (datei 4);
+ in (datei 5);
+ in (datei 6);
+ in (datei 7);
+ schicke (menukarte);
+ IF einzeln THEN release (archive) FI;
+ check on.
+mache global manager aus der task:
+ global manager.
+
diff --git a/hamster/ls-Herbert und Robbi 1 b/hamster/ls-Herbert und Robbi 1
index ed19e98..9b3ff72 100644
--- a/hamster/ls-Herbert und Robbi 1
+++ b/hamster/ls-Herbert und Robbi 1
@@ -22,63 +22,963 @@
*)
-PACKET ls herbert und robbi 1 DEFINES{} sei ein hamster, ist hamster,{} sei ein roboter, ist roboter,{} landschaft, arbeitsfeld,{} vor, links um, nimm, gib,{} korn da, werkstueck da,{} backen leer, behaelter leer,{} vorn frei, lauf,{} hamsterinter, roboterinter,{} geschwindigkeit, taste,{} befehlssatz erweitern,{} befehlssatz ist erweitert,{} drucke landschaft,{} hamster druckerstart einstellen,{} hamster drucker xstart,{}
- hamster drucker ystart,{} hamster landschaftsschrifttyp einstellen,{} hamster landschaftsschrifttyp,{} druckereinstellung fuer flaechenausdruck,{} landschaftsauskunftstext,{} testauskunftstext 1, testauskunftstext 2,{} befehlsauskunftstext, laufauskunftstext,{} kommandomodus, hamstermodus,{} zeige landschaft, lege landschaft ab:{}TYPE LOCATION = STRUCT (INT x, y);{}LET menukarte = "ls-MENUKARTE:Herbert und Robbi",{} richtung = ""3""8""10""2"",{}
- erscheinungsform = "A<V>",{} praefix = "Flaeche:",{} flaechentype = 1007,{} neutral = 0,{} erzeuge = 1,{} hamsterlauf = 2,{} interaktiv = 3,{} kommandostufe = 99,{} west = ""8"",{} ost = ""2"",{} cleol = ""5"",{} piep = ""7"",{}
- mark ein = ""15"",{} mark aus = ""14"",{} escape = ""27"",{} blank = " ",{} niltext = "",{} hindernis = "#",{} korn = "o",{} hinderniskachel = "##",{} blankkachel = " .",{} kornkachel = " o",{} protokollname = "PROTOKOLL";{}LET max x = 40,{}
- max y = 23;{}LET FLAECHE = ROW max x ROW max y INT;{}LET LANDSCHAFT = STRUCT (INT xpos, ypos, blickrichtung,{} anzahl koerner, FLAECHE flaeche);{}LET HAMSTER = STRUCT (LOCATION stelle, INT koerner, form);{}BOUND LANDSCHAFT VAR aktuelle landschaft;{}FLAECHE VAR land;{}HAMSTER VAR hamster;{}FILE VAR protokoll;{}INT CONST besetzt :: -1,{} frei :: 0;{}
-TEXT CONST kornsymbole ::{} "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";{}INT CONST maxkornzahl :: LENGTH kornsymbole;{}BOOL VAR hamster eingestellt :: TRUE,{} befehlssatz erweitert :: FALSE;{}TEXT VAR eingabezeichen :: niltext,{} archivlandschaftsname :: niltext,{} hinderniszeichen :: "\#\#",{} schrifttyp :: niltext;{}INT VAR verzoegerungsfaktor :: 5,{}
- modus :: kommandostufe,{} a, b, c, d;{}REAL VAR xstart :: 0.0,{} ystart :: 0.0;{}WINDOW VAR fenster :: window (1, 1, 79, 24);{}INITFLAG VAR in this task :: FALSE;{}OP := (LOCATION VAR l, LOCATION CONST r):{} l.x := r.x; l.y := r.y{}END OP :=;{}PROC initialize hamstersystem:{} IF NOT initialized (in this task){} THEN install menu (menukarte);{} FI{}END PROC initialize hamstersystem;{}
-PROC sei ein hamster:{} hamster eingestellt := TRUE{}END PROC sei ein hamster;{}BOOL PROC ist hamster:{} hamster eingestellt{}END PROC ist hamster;{}PROC sei ein roboter:{} hamster eingestellt := FALSE{}END PROC sei ein roboter;{}BOOL PROC ist roboter:{} NOT hamster eingestellt{}END PROC ist roboter;{}PROC hole landschaft (TEXT CONST name):{} aktuelle landschaft := old (praefix + name);{} land := aktuelle landschaft.flaeche;{} hamster.form := aktuelle landschaft.blickrichtung;{}
- hamster.stelle.x := aktuelle landschaft.xpos;{} hamster.stelle.y := aktuelle landschaft.ypos;{} hamster.koerner := aktuelle landschaft.anzahl koerner{}END PROC hole landschaft;{}PROC lege landschaft ab (TEXT CONST name):{} IF exists (praefix + name){} THEN forget (praefix + name, quiet){} FI;{} aktuelle landschaft := new (praefix + name);{} aktuelle landschaft.flaeche := land;{} aktuelle landschaft.blickrichtung := hamster.form;{} aktuelle landschaft.xpos := hamster.stelle.x;{}
- aktuelle landschaft.ypos := hamster.stelle.y;{} aktuelle landschaft.anzahl koerner := hamster.koerner;{} type( old(praefix + name), flaechentype){}END PROC lege landschaft ab;{}PROC hamstermodus:{} modus := neutral{}END PROC hamstermodus;{}PROC kommandomodus:{} modus := kommandostufe{}END PROC kommandomodus;{}PROC erzeugemodus:{} modus := erzeuge{}END PROC erzeugemodus;{}PROC intermodus:{} modus := interaktiv{}END PROC intermodus;{}PROC laufmodus:{} modus := hamsterlauf{}
-END PROC laufmodus;{}BOOL PROC vorn frei:{} kontrolliere modus;{} LOCATION VAR hier :: hamster.stelle;{} SELECT hamster.form OF{} CASE 1: IF hamster.stelle.y < 2 THEN protestiere FI;{} hier.y DECR 1{} CASE 2: IF hamster.stelle.x < 2 THEN protestiere FI;{} hier.x DECR 1{} CASE 3: IF hamster.stelle.y >= max y THEN protestiere FI;{} hier.y INCR 1{} CASE 4: IF hamster.stelle.x >= max x THEN protestiere FI;{} hier.x INCR 1{} OTHERWISE modus := kommandostufe;{}
- IF ist hamster{} THEN errorstop(nachricht( 7)){} ELSE errorstop(nachricht(14)){} FI{} END SELECT;{} IF modus = erzeuge{} THEN TRUE{} ELSE land[hier.x] [hier.y] <> besetzt{} FI{}END PROC vorn frei;{}BOOL PROC korn da:{} kontrolliere modus;{} kornzahl > 0{}END PROC korn da;{}INT PROC kornzahl:{} land [hamster.stelle.x] [hamster.stelle.y]{}END PROC kornzahl;{}BOOL PROC werkstueck da:{} korn da{}END PROC werkstueck da;{}BOOL PROC backen leer:{}
- kontrolliere modus;{} hamster.koerner <= 0 AND (modus = hamsterlauf OR modus = interaktiv){}END PROC backen leer;{}BOOL PROC behaelter leer:{} backen leer{}END PROC behaelter leer;{}PROC protestiere:{} IF modus = erzeuge{} THEN out(piep); eins zurueck{} ELSE verzoegere 10 mal; zeige("X"); verzoegere 10 mal;{} kommandomodus;{} IF ist hamster{} THEN errorstop(nachricht( 6)){} ELSE errorstop(nachricht(13)){} FI;{} FI.{} eins zurueck:{}
- SELECT hamster.form OF{} CASE 1: hamster.stelle.y INCR 1{} CASE 2: hamster.stelle.x INCR 1{} CASE 3: hamster.stelle.y DECR 1{} CASE 4: hamster.stelle.x DECR 1{} OTHERWISE kommandomodus;{} IF ist hamster{} THEN errorstop(nachricht( 7)){} ELSE errorstop(nachricht(14)){} FI;{} END SELECT.{} verzoegere 10 mal:{} INT VAR j;{} FOR j FROM 1 UPTO 10 REP{} verzoegere{} PER{}END PROC protestiere;{}
-PROC verzoegere:{} IF modus <> hamsterlauf{} THEN LEAVE verzoegere{} FI;{} eingabezeichen := incharety (verzoegerungsfaktor);{} IF eingabezeichen = escape{} THEN kommandomodus;{} IF ist hamster{} THEN errorstop(nachricht( 4)){} ELSE errorstop(nachricht(11)){} FI{} ELIF eingabezeichen = "-" THEN verlangsame{} ELIF eingabezeichen = "+" THEN beschleunige{} ELIF eingabezeichen = "?" THEN boxinfo (fenster, laufauskunftstext,{} 5, maxint, a, b, c, d);{}
- cursor on; zeige landschaft{} ELIF pos ("0123456789", eingabezeichen) > 0{} THEN geschwindigkeit (int (eingabezeichen)){} FI.{} verlangsame:{} IF verzoegerungsfaktor > 31 THEN (* lass es dabei *){} ELIF verzoegerungsfaktor < 1{} THEN verzoegerungsfaktor INCR 1{} ELSE verzoegerungsfaktor INCR verzoegerungsfaktor{} FI.{} beschleunige:{} IF verzoegerungsfaktor < 1{} THEN verzoegerungsfaktor := -1{} ELSE verzoegerungsfaktor := verzoegerungsfaktor DIV 2{}
- FI{}END PROC verzoegere;{}PROC geschwindigkeit (INT CONST faktor):{} SELECT faktor OF{} CASE 0 : verzoegerungsfaktor := 20000;{} CASE 1 : verzoegerungsfaktor := 50;{} CASE 2 : verzoegerungsfaktor := 20;{} CASE 3 : verzoegerungsfaktor := 10;{} CASE 4 : verzoegerungsfaktor := 8;{} CASE 5 : verzoegerungsfaktor := 5;{} CASE 6 : verzoegerungsfaktor := 2;{} CASE 7 : verzoegerungsfaktor := 1;{} CASE 8 : verzoegerungsfaktor := 0;{} CASE 9 : verzoegerungsfaktor := -1;{}
- OTHERWISE (*belasse es dabei*){} END SELECT{}END PROC geschwindigkeit;{}PROC vor:{} kontrolliere modus;{} IF vorn frei{} THEN zeige(kachel);{} bilde neue hamsterkoordinaten;{} zeige(erscheinungsform SUB hamster.form);{} verzoegere{} ELSE modus := kommandostufe;{} zeige("X");{} IF ist hamster{} THEN errorstop(nachricht(1)){} ELSE errorstop(nachricht(8)){} FI{} FI.{} kachel:{} INT CONST z :: land [hamster.stelle.x] [hamster.stelle.y];{}
- IF z = besetzt THEN hinderniskachel{} ELIF z = frei THEN blankkachel{} ELSE kornkachel{} FI.{} bilde neue hamsterkoordinaten:{} SELECT hamster.form OF{} CASE 1 :hamster.stelle.y DECR 1{} CASE 2 :hamster.stelle.x DECR 1{} CASE 3 :hamster.stelle.y INCR 1{} CASE 4 :hamster.stelle.x INCR 1{} OTHERWISE modus:=kommandostufe;{} IF ist hamster{} THEN errorstop(nachricht( 7)){} ELSE errorstop(nachricht(14)){}
- FI{} END SELECT.{}END PROC vor;{}PROC nimm:{} kontrolliere modus;{} IF korn da{} THEN variiere kornzahl (-1);{} IF kornzahl < 1 THEN zeige (ost + blank) FI{} ELSE modus := kommandostufe;{} zeige("X");{} IF ist hamster{} THEN errorstop(nachricht(2)){} ELSE errorstop(nachricht(9)){} FI{} FI;{} verzoegere{}END PROC nimm;{}PROC gib:{} kontrolliere modus;{} IF backen leer{} THEN modus := kommandostufe;{} zeige ("X");{}
- IF ist hamster{} THEN errorstop(nachricht( 3)){} ELSE errorstop(nachricht(10)){} FI{} ELSE variiere kornzahl (+1);{} zeige(ost + korn){} FI;{} verzoegere{}END PROC gib;{}PROC links um:{} kontrolliere modus;{} hamster.form := hamster.form MOD 4 + 1;{} (* da hamster.form der Werte 1,2,3,4 faehig ist und linksdreht *){} zeige (subjekt);{} verzoegere.{} subjekt:{} erscheinungsform SUB hamster.form.{}END PROC links um;{}PROC variiere kornzahl (INT CONST delta):{}
- IF delta * delta <> 1{} THEN LEAVE variiere kornzahl{} FI; (* als delta kommen nur +1 und -1 vor *){} INT VAR k;{} IF kornzahl = -1 AND delta = 1{} THEN k := 1{} ELSE k := kornzahl + delta{} FI;{} IF k <= 0{} THEN land [hamster.stelle.x] [hamster.stelle.y] := frei{} ELSE land [hamster.stelle.x] [hamster.stelle.y] := min (k,maxkornzahl){} FI;{} IF modus = hamsterlauf OR modus = interaktiv{} THEN hamster.koerner DECR delta{} FI{}END PROC variiere kornzahl;{}PROC kontrolliere modus:{}
- initialize hamstersystem;{} SELECT modus OF{} CASE neutral : erzeugemodus;{} landschaft;{} laufmodus{} CASE erzeuge,{} interaktiv,{} hamsterlauf: (* nichts *){} OTHERWISE kommandomodus;{} line;{} IF ist hamster{} THEN sage(anwendungstext (21));pause(20);{} errorstop(nachricht( 5)){} ELSE sage(anwendungstext (22));pause(20);{}
- errorstop(nachricht(12)){} FI{} END SELECT{}END PROC kontrolliere modus;{}PROC zeige (TEXT CONST was):{} cursor (2 * hamster.stelle.x - 1, hamster.stelle.y);{} IF hamster.stelle.x >= max x AND hamster.stelle.y > max y{} THEN out ((was SUB 1)); out(west){} ELSE out(was); (LENGTH was) TIMESOUT west{} FI.{}END PROC zeige;{}PROC sage (TEXT CONST aussage):{} cursor(1,24); out(aussage + cleol){}END PROC sage;{}TEXT PROC nachricht (INT CONST nummer):{}
- inv (text (anwendungstext (nummer), 65)) + piep{}END PROC nachricht;{}TEXT PROC inv (TEXT CONST text):{} TEXT VAR aus :: mark ein + text + blank + mark aus;{} aus{}END PROC inv;{}PROC zeige landschaft:{} initialize hamstersystem;{} INT VAR y;{} FOR y FROM 1 UPTO max y REP{} setze zeile zusammen;{} cursor (1,y); out (zeile){} PER;{} cursor(1,24); out(cleol);{} IF modus = interaktiv{} THEN gib befehlszeile aus{} FI;{} zeige hamster; cursor on.{} setze zeile zusammen:{} TEXT VAR zeile :: niltext;{}
- INT VAR x;{} FOR x FROM 1 UPTO max x REP{} zeile CAT kachel{} PER.{} kachel:{} INT CONST z :: land [x] [y];{} IF z = besetzt THEN hinderniskachel{} ELIF z = frei THEN blankkachel{} ELSE kornkachel{} FI.{} gib befehlszeile aus:{} cursor(1,1); write(cleol); write (anwendungstext (62)){}END PROC zeige landschaft;{}PROC zeige hamster:{} zeige (erscheinungsform SUB hamster.form){}END PROC zeige hamster;{}PROC landschaft (TEXT CONST kandidat):{}
- initialize hamstersystem;{} archivlandschaftsname := kandidat;{} IF exists (praefix + kandidat){} CAND type (old (praefix + kandidat)) = flaechentype{} THEN behandle existierende landschaft{} ELIF exists (praefix + kandidat){} THEN forget (praefix + kandidat, quiet);{} behandle neue landschaft{} ELSE behandle neue landschaft{} FI.{} behandle existierende landschaft:{} hole landschaft (kandidat);{} SELECT modus OF{} CASE hamsterlauf,{} interaktiv,{}
- neutral : zeige landschaft;{} laufmodus{} CASE erzeuge : modifiziere eventuell{} CASE kommandostufe : modifiziere landschaft{} OTHERWISE errorstop (anwendungstext (15)){} END SELECT.{} behandle neue landschaft:{} SELECT modus OF{} CASE hamsterlauf,{} interaktiv,{} neutral,{} erzeuge : erschaffe landschaft;{} modifiziere landschaft;{} zeige landschaft;{}
- laufmodus{} CASE kommandostufe : erschaffe landschaft;{} modifiziere landschaft;{} OTHERWISE errorstop (anwendungstext (15)){} END SELECT.{} modifiziere eventuell:{} IF ist hamster{} THEN IF boxyes (fenster, anwendungstext (41), 5, a, b, c, d){} THEN cursor on; modifiziere landschaft{} FI{} ELSE IF boxyes (fenster, anwendungstext (42), 5, a, b, c, d){} THEN cursor on; modifiziere landschaft{}
- FI{} FI;{} zeige landschaft.{} erschaffe landschaft:{} INT VAR j;{} FOR j FROM 1 UPTO max y REP{} INT VAR k;{} FOR k FROM 1 UPTO max x REP{} land [k] [j] := frei{} PER{} PER;{} hamster.form := 4;{} hamster.stelle.x := 20;{} hamster.stelle.y := 12;{} hamster.koerner := 0.{}END PROC landschaft;{}PROC landschaft:{} initialize hamstersystem;{} IF ist hamster{} THEN landschaft (erfragter landschaftsname (anwendungstext (36))){}
- ELSE landschaft (erfragter landschaftsname (anwendungstext (37))){} FI{}END PROC landschaft;{}TEXT PROC erfragter landschaftsname (TEXT CONST satz):{} TEXT VAR landschaftsname :: archivlandschaftsname;{} REP{} page; line (3); out (satz + cleol); line (2);{} editget (landschaftsname);{} landschaftsname := compress (landschaftsname);{} IF landschaftsname = niltext{} THEN line (2); out (anwendungstext (18) + piep);{} line (2); out (anwendungstext (38)); pause{} FI{}
- UNTIL landschaftsname <> niltext PER;{} landschaftsname{}END PROC erfragter landschaftsname;{}PROC arbeitsfeld (TEXT CONST kandidat):{} landschaft (kandidat){}END PROC arbeitsfeld;{}PROC arbeitsfeld:{} landschaft{}END PROC arbeitsfeld;{}PROC modifiziere landschaft:{} INT CONST modalibi :: modus;{} erzeugemodus;{} zeige landschaft;{} informiere;{} zeige hamster;{} nimm ein eingabezeichen;{} WHILE nicht endewunsch REP{} erfuelle fortschreibungswunsch;{} nimm ein eingabezeichen{} PER;{}
- erfrage koernerzahl;{} lege landschaft ab (archivlandschaftsname);{} modus := modalibi.{} nimm ein eingabezeichen:{} inchar (eingabezeichen).{} nicht endewunsch:{} pos ("hH", eingabezeichen) = 0.{} erfuelle fortschreibungswunsch:{} INT CONST r :: pos (richtung, eingabezeichen){} IF r > 0{} THEN IF hamster.form = r{} THEN vor{} ELSE hamster.form := r;{} zeige hamster{} FI{} ELIF eingabezeichen = "?" THEN boxinfo (fenster, landschaftsauskunftstext,{}
- 5, maxint, a, b, c, d);{} cursor on; zeige landschaft; informiere{} ELIF eingabezeichen = "k" THEN kopiere landschaft;{} zeige landschaft; informiere{} ELIF eingabezeichen = "g" THEN gib{} ELIF eingabezeichen = "n" THEN IF korn da THEN nimm ELSE out (piep) FI{} ELIF eingabezeichen = "z" THEN zeige (text (kornzahl, 2)){} ELIF eingabezeichen = hindernis{} THEN land [hamster.stelle.x] [hamster.stelle.y] := besetzt; vor{}
- ELIF eingabezeichen = blank{} THEN land [hamster.stelle.x] [hamster.stelle.y] := frei; vor{} ELSE out (piep){} FI.{} kopiere landschaft:{} TEXT VAR kopie;{} IF NOT not empty (alle landschaften){} THEN IF ist hamster{} THEN boxinfo (fenster, anwendungstext (196), 5, maxint){} ELSE boxinfo (fenster, anwendungstext (197), 5, maxint){} FI{} ELSE lasse original auswaehlen{} FI.{} lasse original auswaehlen:{}
- IF ist hamster{} THEN kopie := boxone (fenster, alle landschaften,{} anwendungstext (23), anwendungstext (24),{} FALSE){} ELSE kopie := boxone (fenster, alle landschaften,{} anwendungstext (25), anwendungstext (26),{} FALSE){} FI;{} cursor on; hole landschaft (kopie).{} alle landschaften:{} ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).{}
- erfrage koernerzahl:{} TEXT VAR eingabe; BOOL VAR ist ok; INT VAR zahl;{} cursor (1,23); 79 TIMESOUT waagerecht;{} REP{} ist ok := TRUE;{} IF ist hamster{} THEN eingabe := boxanswer (fenster, anwendungstext (43),{} text (hamster.koerner),{} 5, a, b, c, d){} ELSE eingabe := boxanswer (fenster, anwendungstext (44),{} text (hamster.koerner),{}
- 5, a, b, c, d){} FI;{} disable stop;{} IF eingabe = "" THEN eingabe := "0" FI;{} zahl := int (eingabe);{} IF zahl < 0 OR zahl > maxint THEN ist ok := FALSE FI;{} IF is error THEN ist ok := FALSE; clear error FI;{} enable stop;{} UNTIL last conversion ok AND ist ok PER;{} cursor on;{} hamster.koerner := zahl.{} informiere:{} cursor (1,1);{} IF ist hamster{} THEN out (anwendungstext (27)){}
- ELSE out (anwendungstext (28)){} FI{}END PROC modifiziere landschaft;{}PROC lauf (TEXT CONST dateiname):{} initialize hamstersystem;{} IF NOT exists (dateiname){} THEN errorstop (anwendungstext (16) + dateiname + anwendungstext (17)){} FI;{} hamstermodus;{} disable stop;{} run (dateiname);{} kommandomodus;{} cursor (1, 24);{} IF is error{} THEN IF length (errormessage) > 1{} THEN sage (errormessage); pause;{} FI{} ELSE sage (anwendungstext (29)); pause; konserviere landschaft{}
- FI;{} clear error;{} enable stop{}END PROC lauf;{}PROC lauf:{} lauf (last param){}END PROC lauf;{}PROC konserviere landschaft:{} TEXT VAR neuer landschaftsname;{} IF ist hamster{} THEN stelle landschaftsfrage{} ELSE stelle arbeitsfeldfrage{} FI; cursor on.{} stelle landschaftsfrage:{} IF boxyes (fenster, anwendungstext (45), 5){} THEN bewahre landschaft auf{} FI.{} stelle arbeitsfeldfrage:{} IF boxyes (fenster, anwendungstext (46), 5){} THEN bewahre landschaft auf{}
- FI.{} bewahre landschaft auf:{} neuer landschaftsname := archivlandschaftsname + ".x";{} lege landschaft ab (neuer landschaftsname);{} gib hinweis auf neuen namen.{} gib hinweis auf neuen namen:{} IF ist hamster{} THEN boxinfo (fenster, anwendungstext (30){} + inv (neuer landschaftsname), 5, maxint, a, b, c, d){} ELSE boxinfo (fenster, anwendungstext (31){} + inv (neuer landschaftsname), 5, maxint, a, b, c, d){} FI{}END PROC konserviere landschaft;{}
-PROC hamsterinter (TEXT CONST landschaftsname):{} initialize hamstersystem;{} sei ein hamster;{} steuere interaktiv (landschaftsname);{} cursor on{}END PROC hamsterinter;{}PROC hamsterinter:{} initialize hamstersystem;{} hamsterinter (erfragter landschaftsname (anwendungstext (39))){}END PROC hamsterinter;{}PROC roboterinter (TEXT CONST landschaftsname):{} initialize hamstersystem;{} sei ein roboter;{} steuere interaktiv (landschaftsname);{} cursor on{}END PROC roboterinter;{}PROC roboterinter:{}
- initialize hamstersystem;{} roboterinter (erfragter landschaftsname (anwendungstext (40))){}END PROC roboterinter;{}PROC steuere interaktiv (TEXT CONST landschaftsname):{} forget (protokollname, quiet);{} protokoll := sequential file (output, protokollname);{} intermodus;{} landschaft (landschaftsname);{} TEXT VAR befehl :: niltext, letzter befehl :: niltext;{} REP{} arbeiten{} PER.{} arbeiten:{} intermodus;{} hole befehl;{} fuehre befehl aus.{} hole befehl:{} TEXT VAR befehlszeichen;{}
- TEXT CONST befehlskette :: "vlngpeVLNGPE";{} INT VAR befehlsposition;{} zeige (hamsterform);{} cursor (1,24);{} IF ist hamster{} THEN out (cleol + anwendungstext (32) + letzter befehl){} ELSE out (cleol + anwendungstext (33) + letzter befehl){} FI;{} cursor(24,24);{} inchar (befehlszeichen);{} befehlsposition := pos(befehlskette,befehlszeichen);{} IF befehlsposition = 0{} THEN out(piep);{} LEAVE arbeiten{} FI;{} SELECT befehlsposition OF{}
- CASE 1, 7: befehl := "vor";{} out("vor");{} letzter befehl := "vor"{} CASE 2, 8: befehl := "links um";{} out("links um");{} letzter befehl := "links um"{} CASE 3, 9: befehl := "nimm";{} out("nimm");{} letzter befehl := "nimm"{} CASE 4,10: befehl := "gib";{} out("gib");{} letzter befehl := "gib"{}
- CASE 5,11: out("protokoll");{} letzter befehl := "protokoll";{} FILE VAR p :: sequential file (modify,protokollname);{} headline(p, protokollname + " (Verlassen: <ESC><q>)");{} cursor on; show(p); cursor off;{} zeige landschaft; befehl := "";{} output(protokoll);{} LEAVE arbeiten{} CASE 6,12: out("ende"); kommandomodus; befehl := "";{} LEAVE steuere interaktiv{}
- END SELECT.{} hamsterform:{} erscheinungsform SUB hamster.form.{} fuehre befehl aus:{} BOOL VAR korrekt;{} disable stop;{} do (befehl);{} cursor (1,24);{} korrekt := NOT is error;{} IF is error{} THEN IF errormessage > ""{} THEN out (inv (text (errormessage, 65)) + piep);{} pause(30);{} FI;{} clear error{} FI;{} IF korrekt AND befehl <> ""{} THEN protokolliere (befehl){} FI;{} enable stop;{}
-END PROC steuere interaktiv;{}PROC protokolliere (TEXT CONST befehl):{} putline (protokoll, befehl + ";"){}END PROC protokolliere;{}PROC drucke landschaft (TEXT CONST landschaftsname):{} initialize hamstersystem;{} ROW max y TEXT VAR drucklandschaft;{} BOUND LANDSCHAFT VAR al;{} INT VAR i, hamsterx, hamstery;{} TEXT VAR hamsterzeichen;{} landschaftsdatei holen;{} drucklandschaft erzeugen;{} hamster in drucklandschaft einsetzen;{} druckdatei erzeugen;{} disable stop;{} TEXT VAR datname := std;{}
- do ("print (""druckdatei"")");{} IF is error{} THEN menuinfo (inv (errormessage));{} clear error;{} FI;{} last param (datname);{} enable stop;{} druckdatei loeschen;{} cursor on.{} landschaftsdatei holen:{} IF exists (praefix + landschaftsname) AND{} (type (old (praefix + landschaftsname)) = flaechentype){} THEN hole landschaft;{} ELSE LEAVE drucke landschaft{} FI.{} hole landschaft:{} al := old (praefix + landschaftsname);{} hamsterx := al.xpos;{}
- hamstery := al.ypos;{} hamsterzeichen := erscheinungsform SUB al.blickrichtung.{} drucklandschaft erzeugen:{} TEXT VAR zeile; INT VAR x;{} FOR i FROM 1 UPTO max y REP{} zeile := "";{} FOR x FROM 1 UPTO maxx REP{} zeile erzeugen{} PER;{} drucklandschaft[i] := zeile{} PER.{} zeile erzeugen:{} INT CONST zeichen :: al.flaeche [x] [i];{} IF zeichen = besetzt THEN zeile CAT hinderniszeichen{} ELIF zeichen = frei THEN zeile CAT " ."{}
- ELSE zeile CAT " o"{} FI.{} hamster in drucklandschaft einsetzen:{} change (drucklandschaft [hamstery], hamsterx*2-1, hamsterx*2-1,{} hamsterzeichen).{} druckdatei erzeugen:{} FILE VAR p::sequential file(output, "druckdatei");{} INT VAR blankzahl;{} line(p);{} putline(p,"#type (""" + schrifttyp + """)#");{} putline(p,"#start(" + text(xstart) + "," + text(ystart) + ")#");{} putline(p,"#limit(20.8)#");{} blankzahl := ( 80 - (8 + length (landschaftsname))) DIV 2;{}
- putline(p, blankzahl * " " + praefix + landschaftsname + " ");{} putline(p, "  ");{} FOR i FROM 1 UPTO maxy REP{} putline(p, drucklandschaft[i] + " "){} PER.{} druckdatei loeschen:{} forget("druckdatei", quiet){}END PROC drucke landschaft;{}PROC drucke landschaft:{} initialize hamstersystem;{} IF ist hamster{} THEN drucke landschaft (erfragter landschaftsname (anwendungstext (36))){} ELSE drucke landschaft (erfragter landschaftsname (anwendungstext (37))){} FI;{} cursor on{}
-END PROC drucke landschaft;{}PROC druckereinstellung fuer flaechenausdruck:{} initialize hamstersystem;{} page;{} IF ist hamster{} THEN putline (center (invers (anwendungstext (71)))){} ELSE putline (center (invers (anwendungstext (72)))){} FI;{} line (3);{} put (anwendungstext (73));{} editget (schrifttyp);{} line (2);{} schrifttyp := compress (schrifttyp);{} putline (anwendungstext (74));{} putline (anwendungstext (75)); line (2);{} putline (anwendungstext (76) + text (xstart) + "," + text (ystart) +{}
- anwendungstext (77)); line;{} put (anwendungstext (78)); get (xstart); line;{} put (anwendungstext (79)); get (ystart); line (2);{} IF yes (anwendungstext (80) + hinderniszeichen + anwendungstext (81)){} THEN line;{} put (anwendungstext (82)); inchar (hinderniszeichen); line (2);{} hinderniszeichen CAT hinderniszeichen;{} IF hinderniszeichen = "##"{} THEN hinderniszeichen := "\#\#"{} FI{} FI;{} line;{} put (anwendungstext (83)){}END PROC druckereinstellung fuer flaechenausdruck;{}
-PROC hamster druckerstart einstellen (REAL CONST xpos, ypos):{} xstart := xpos; ystart := ypos{}END PROC hamster druckerstart einstellen;{}REAL PROC hamster drucker xstart:{} xstart{}END PROC hamster drucker xstart;{}REAL PROC hamster drucker ystart:{} ystart{}END PROC hamster drucker ystart;{}PROC hamster landschaftsschrifttyp einstellen (TEXT CONST typ):{} schrifttyp := typ{}END PROC hamster landschaftsschrifttyp einstellen;{}TEXT PROC hamster landschaftsschrifttyp:{} schrifttyp{}END PROC hamster landschaftsschrifttyp;{}
-PROC drucke arbeitsfeld (TEXT CONST arbeitsfeldname):{} drucke landschaft (arbeitsfeldname){}END PROC drucke arbeitsfeld;{}PROC drucke arbeitsfeld:{} drucke landschaft{}END PROC drucke arbeitsfeld;{}TEXT PROC taste:{} eingabezeichen{}END PROC taste;{}TEXT PROC landschaftsauskunftstext:{} initialize hamstersystem;{} IF ist hamster{} THEN anwendungstext (52){} ELSE anwendungstext (53){} FI{}END PROC landschaftsauskunftstext;{}TEXT PROC laufauskunftstext:{} initialize hamstersystem;{}
- anwendungstext (51){}END PROC laufauskunftstext;{}TEXT PROC befehlsauskunftstext:{} initialize hamstersystem;{} IF ist hamster{} THEN anwendungstext (54){} ELSE anwendungstext (55){} FI{}END PROC befehlsauskunftstext;{}TEXT PROC testauskunftstext 1:{} initialize hamstersystem;{} IF befehlssatz erweitert{} THEN langer testauskunftstext{} ELSE kurzer testauskunftstext{} FI.{} kurzer testauskunftstext:{} IF ist hamster{} THEN anwendungstext (56){} ELSE anwendungstext (57){}
- FI.{} langer testauskunftstext:{} IF ist hamster{} THEN anwendungstext (58){} ELSE anwendungstext (60){} FI.{}END PROC testauskunftstext 1;{}TEXT PROC testauskunftstext 2:{} initialize hamstersystem;{} IF befehlssatz erweitert{} THEN eintragung{} ELSE niltext{} FI.{} eintragung:{} IF ist hamster{} THEN anwendungstext (59){} ELSE anwendungstext (61){} FI{}END PROC testauskunftstext 2;{}PROC befehlssatz erweitern (BOOL CONST status):{} befehlssatz erweitert := status{}
-END PROC befehlssatz erweitern;{}BOOL PROC befehlssatz ist erweitert:{} befehlssatz erweitert{}END PROC befehlssatz ist erweitert;{}END PACKET ls herbert und robbi 1;{}
+PACKET ls herbert und robbi 1 DEFINES
+ sei ein hamster, ist hamster,
+ sei ein roboter, ist roboter,
+ landschaft, arbeitsfeld,
+ vor, links um, nimm, gib,
+ korn da, werkstueck da,
+ backen leer, behaelter leer,
+ vorn frei, lauf,
+ hamsterinter, roboterinter,
+ geschwindigkeit, taste,
+ befehlssatz erweitern,
+ befehlssatz ist erweitert,
+ drucke landschaft,
+ hamster druckerstart einstellen,
+ hamster drucker xstart,
+
+ hamster drucker ystart,
+ hamster landschaftsschrifttyp einstellen,
+ hamster landschaftsschrifttyp,
+ druckereinstellung fuer flaechenausdruck,
+ landschaftsauskunftstext,
+ testauskunftstext 1, testauskunftstext 2,
+ befehlsauskunftstext, laufauskunftstext,
+ kommandomodus, hamstermodus,
+ zeige landschaft, lege landschaft ab:
+TYPE LOCATION = STRUCT (INT x, y);
+LET menukarte = "ls-MENUKARTE:Herbert und Robbi",
+ richtung = ""3""8""10""2"",
+
+ erscheinungsform = "A<V>",
+ praefix = "Flaeche:",
+ flaechentype = 1007,
+ neutral = 0,
+ erzeuge = 1,
+ hamsterlauf = 2,
+ interaktiv = 3,
+ kommandostufe = 99,
+ west = ""8"",
+ ost = ""2"",
+ cleol = ""5"",
+ piep = ""7"",
+
+ mark ein = ""15"",
+ mark aus = ""14"",
+ escape = ""27"",
+ blank = " ",
+ niltext = "",
+ hindernis = "#",
+ korn = "o",
+ hinderniskachel = "##",
+ blankkachel = " .",
+ kornkachel = " o",
+ protokollname = "PROTOKOLL";
+LET max x = 40,
+
+ max y = 23;
+LET FLAECHE = ROW max x ROW max y INT;
+LET LANDSCHAFT = STRUCT (INT xpos, ypos, blickrichtung,
+ anzahl koerner, FLAECHE flaeche);
+LET HAMSTER = STRUCT (LOCATION stelle, INT koerner, form);
+BOUND LANDSCHAFT VAR aktuelle landschaft;
+FLAECHE VAR land;
+HAMSTER VAR hamster;
+FILE VAR protokoll;
+INT CONST besetzt :: -1,
+ frei :: 0;
+
+TEXT CONST kornsymbole ::
+ "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
+INT CONST maxkornzahl :: LENGTH kornsymbole;
+BOOL VAR hamster eingestellt :: TRUE,
+ befehlssatz erweitert :: FALSE;
+TEXT VAR eingabezeichen :: niltext,
+ archivlandschaftsname :: niltext,
+ hinderniszeichen :: "\#\#",
+ schrifttyp :: niltext;
+INT VAR verzoegerungsfaktor :: 5,
+
+ modus :: kommandostufe,
+ a, b, c, d;
+REAL VAR xstart :: 0.0,
+ ystart :: 0.0;
+WINDOW VAR fenster :: window (1, 1, 79, 24);
+INITFLAG VAR in this task :: FALSE;
+OP := (LOCATION VAR l, LOCATION CONST r):
+ l.x := r.x; l.y := r.y
+END OP :=;
+PROC initialize hamstersystem:
+ IF NOT initialized (in this task)
+ THEN install menu (menukarte);
+ FI
+END PROC initialize hamstersystem;
+
+PROC sei ein hamster:
+ hamster eingestellt := TRUE
+END PROC sei ein hamster;
+BOOL PROC ist hamster:
+ hamster eingestellt
+END PROC ist hamster;
+PROC sei ein roboter:
+ hamster eingestellt := FALSE
+END PROC sei ein roboter;
+BOOL PROC ist roboter:
+ NOT hamster eingestellt
+END PROC ist roboter;
+PROC hole landschaft (TEXT CONST name):
+ aktuelle landschaft := old (praefix + name);
+ land := aktuelle landschaft.flaeche;
+ hamster.form := aktuelle landschaft.blickrichtung;
+
+ hamster.stelle.x := aktuelle landschaft.xpos;
+ hamster.stelle.y := aktuelle landschaft.ypos;
+ hamster.koerner := aktuelle landschaft.anzahl koerner
+END PROC hole landschaft;
+PROC lege landschaft ab (TEXT CONST name):
+ IF exists (praefix + name)
+ THEN forget (praefix + name, quiet)
+ FI;
+ aktuelle landschaft := new (praefix + name);
+ aktuelle landschaft.flaeche := land;
+ aktuelle landschaft.blickrichtung := hamster.form;
+ aktuelle landschaft.xpos := hamster.stelle.x;
+
+ aktuelle landschaft.ypos := hamster.stelle.y;
+ aktuelle landschaft.anzahl koerner := hamster.koerner;
+ type( old(praefix + name), flaechentype)
+END PROC lege landschaft ab;
+PROC hamstermodus:
+ modus := neutral
+END PROC hamstermodus;
+PROC kommandomodus:
+ modus := kommandostufe
+END PROC kommandomodus;
+PROC erzeugemodus:
+ modus := erzeuge
+END PROC erzeugemodus;
+PROC intermodus:
+ modus := interaktiv
+END PROC intermodus;
+PROC laufmodus:
+ modus := hamsterlauf
+
+END PROC laufmodus;
+BOOL PROC vorn frei:
+ kontrolliere modus;
+ LOCATION VAR hier :: hamster.stelle;
+ SELECT hamster.form OF
+ CASE 1: IF hamster.stelle.y < 2 THEN protestiere FI;
+ hier.y DECR 1
+ CASE 2: IF hamster.stelle.x < 2 THEN protestiere FI;
+ hier.x DECR 1
+ CASE 3: IF hamster.stelle.y >= max y THEN protestiere FI;
+ hier.y INCR 1
+ CASE 4: IF hamster.stelle.x >= max x THEN protestiere FI;
+ hier.x INCR 1
+ OTHERWISE modus := kommandostufe;
+
+ IF ist hamster
+ THEN errorstop(nachricht( 7))
+ ELSE errorstop(nachricht(14))
+ FI
+ END SELECT;
+ IF modus = erzeuge
+ THEN TRUE
+ ELSE land[hier.x] [hier.y] <> besetzt
+ FI
+END PROC vorn frei;
+BOOL PROC korn da:
+ kontrolliere modus;
+ kornzahl > 0
+END PROC korn da;
+INT PROC kornzahl:
+ land [hamster.stelle.x] [hamster.stelle.y]
+END PROC kornzahl;
+BOOL PROC werkstueck da:
+ korn da
+END PROC werkstueck da;
+BOOL PROC backen leer:
+
+ kontrolliere modus;
+ hamster.koerner <= 0 AND (modus = hamsterlauf OR modus = interaktiv)
+END PROC backen leer;
+BOOL PROC behaelter leer:
+ backen leer
+END PROC behaelter leer;
+PROC protestiere:
+ IF modus = erzeuge
+ THEN out(piep); eins zurueck
+ ELSE verzoegere 10 mal; zeige("X"); verzoegere 10 mal;
+ kommandomodus;
+ IF ist hamster
+ THEN errorstop(nachricht( 6))
+ ELSE errorstop(nachricht(13))
+ FI;
+ FI.
+ eins zurueck:
+
+ SELECT hamster.form OF
+ CASE 1: hamster.stelle.y INCR 1
+ CASE 2: hamster.stelle.x INCR 1
+ CASE 3: hamster.stelle.y DECR 1
+ CASE 4: hamster.stelle.x DECR 1
+ OTHERWISE kommandomodus;
+ IF ist hamster
+ THEN errorstop(nachricht( 7))
+ ELSE errorstop(nachricht(14))
+ FI;
+ END SELECT.
+ verzoegere 10 mal:
+ INT VAR j;
+ FOR j FROM 1 UPTO 10 REP
+ verzoegere
+ PER
+END PROC protestiere;
+
+PROC verzoegere:
+ IF modus <> hamsterlauf
+ THEN LEAVE verzoegere
+ FI;
+ eingabezeichen := incharety (verzoegerungsfaktor);
+ IF eingabezeichen = escape
+ THEN kommandomodus;
+ IF ist hamster
+ THEN errorstop(nachricht( 4))
+ ELSE errorstop(nachricht(11))
+ FI
+ ELIF eingabezeichen = "-" THEN verlangsame
+ ELIF eingabezeichen = "+" THEN beschleunige
+ ELIF eingabezeichen = "?" THEN boxinfo (fenster, laufauskunftstext,
+ 5, maxint, a, b, c, d);
+
+ cursor on; zeige landschaft
+ ELIF pos ("0123456789", eingabezeichen) > 0
+ THEN geschwindigkeit (int (eingabezeichen))
+ FI.
+ verlangsame:
+ IF verzoegerungsfaktor > 31 THEN (* lass es dabei *)
+ ELIF verzoegerungsfaktor < 1
+ THEN verzoegerungsfaktor INCR 1
+ ELSE verzoegerungsfaktor INCR verzoegerungsfaktor
+ FI.
+ beschleunige:
+ IF verzoegerungsfaktor < 1
+ THEN verzoegerungsfaktor := -1
+ ELSE verzoegerungsfaktor := verzoegerungsfaktor DIV 2
+
+ FI
+END PROC verzoegere;
+PROC geschwindigkeit (INT CONST faktor):
+ SELECT faktor OF
+ CASE 0 : verzoegerungsfaktor := 20000;
+ CASE 1 : verzoegerungsfaktor := 50;
+ CASE 2 : verzoegerungsfaktor := 20;
+ CASE 3 : verzoegerungsfaktor := 10;
+ CASE 4 : verzoegerungsfaktor := 8;
+ CASE 5 : verzoegerungsfaktor := 5;
+ CASE 6 : verzoegerungsfaktor := 2;
+ CASE 7 : verzoegerungsfaktor := 1;
+ CASE 8 : verzoegerungsfaktor := 0;
+ CASE 9 : verzoegerungsfaktor := -1;
+
+ OTHERWISE (*belasse es dabei*)
+ END SELECT
+END PROC geschwindigkeit;
+PROC vor:
+ kontrolliere modus;
+ IF vorn frei
+ THEN zeige(kachel);
+ bilde neue hamsterkoordinaten;
+ zeige(erscheinungsform SUB hamster.form);
+ verzoegere
+ ELSE modus := kommandostufe;
+ zeige("X");
+ IF ist hamster
+ THEN errorstop(nachricht(1))
+ ELSE errorstop(nachricht(8))
+ FI
+ FI.
+ kachel:
+ INT CONST z :: land [hamster.stelle.x] [hamster.stelle.y];
+
+ IF z = besetzt THEN hinderniskachel
+ ELIF z = frei THEN blankkachel
+ ELSE kornkachel
+ FI.
+ bilde neue hamsterkoordinaten:
+ SELECT hamster.form OF
+ CASE 1 :hamster.stelle.y DECR 1
+ CASE 2 :hamster.stelle.x DECR 1
+ CASE 3 :hamster.stelle.y INCR 1
+ CASE 4 :hamster.stelle.x INCR 1
+ OTHERWISE modus:=kommandostufe;
+ IF ist hamster
+ THEN errorstop(nachricht( 7))
+ ELSE errorstop(nachricht(14))
+
+ FI
+ END SELECT.
+END PROC vor;
+PROC nimm:
+ kontrolliere modus;
+ IF korn da
+ THEN variiere kornzahl (-1);
+ IF kornzahl < 1 THEN zeige (ost + blank) FI
+ ELSE modus := kommandostufe;
+ zeige("X");
+ IF ist hamster
+ THEN errorstop(nachricht(2))
+ ELSE errorstop(nachricht(9))
+ FI
+ FI;
+ verzoegere
+END PROC nimm;
+PROC gib:
+ kontrolliere modus;
+ IF backen leer
+ THEN modus := kommandostufe;
+ zeige ("X");
+
+ IF ist hamster
+ THEN errorstop(nachricht( 3))
+ ELSE errorstop(nachricht(10))
+ FI
+ ELSE variiere kornzahl (+1);
+ zeige(ost + korn)
+ FI;
+ verzoegere
+END PROC gib;
+PROC links um:
+ kontrolliere modus;
+ hamster.form := hamster.form MOD 4 + 1;
+ (* da hamster.form der Werte 1,2,3,4 faehig ist und linksdreht *)
+ zeige (subjekt);
+ verzoegere.
+ subjekt:
+ erscheinungsform SUB hamster.form.
+END PROC links um;
+PROC variiere kornzahl (INT CONST delta):
+
+ IF delta * delta <> 1
+ THEN LEAVE variiere kornzahl
+ FI; (* als delta kommen nur +1 und -1 vor *)
+ INT VAR k;
+ IF kornzahl = -1 AND delta = 1
+ THEN k := 1
+ ELSE k := kornzahl + delta
+ FI;
+ IF k <= 0
+ THEN land [hamster.stelle.x] [hamster.stelle.y] := frei
+ ELSE land [hamster.stelle.x] [hamster.stelle.y] := min (k,maxkornzahl)
+ FI;
+ IF modus = hamsterlauf OR modus = interaktiv
+ THEN hamster.koerner DECR delta
+ FI
+END PROC variiere kornzahl;
+PROC kontrolliere modus:
+
+ initialize hamstersystem;
+ SELECT modus OF
+ CASE neutral : erzeugemodus;
+ landschaft;
+ laufmodus
+ CASE erzeuge,
+ interaktiv,
+ hamsterlauf: (* nichts *)
+ OTHERWISE kommandomodus;
+ line;
+ IF ist hamster
+ THEN sage(anwendungstext (21));pause(20);
+ errorstop(nachricht( 5))
+ ELSE sage(anwendungstext (22));pause(20);
+
+ errorstop(nachricht(12))
+ FI
+ END SELECT
+END PROC kontrolliere modus;
+PROC zeige (TEXT CONST was):
+ cursor (2 * hamster.stelle.x - 1, hamster.stelle.y);
+ IF hamster.stelle.x >= max x AND hamster.stelle.y > max y
+ THEN out ((was SUB 1)); out(west)
+ ELSE out(was); (LENGTH was) TIMESOUT west
+ FI.
+END PROC zeige;
+PROC sage (TEXT CONST aussage):
+ cursor(1,24); out(aussage + cleol)
+END PROC sage;
+TEXT PROC nachricht (INT CONST nummer):
+
+ inv (text (anwendungstext (nummer), 65)) + piep
+END PROC nachricht;
+TEXT PROC inv (TEXT CONST text):
+ TEXT VAR aus :: mark ein + text + blank + mark aus;
+ aus
+END PROC inv;
+PROC zeige landschaft:
+ initialize hamstersystem;
+ INT VAR y;
+ FOR y FROM 1 UPTO max y REP
+ setze zeile zusammen;
+ cursor (1,y); out (zeile)
+ PER;
+ cursor(1,24); out(cleol);
+ IF modus = interaktiv
+ THEN gib befehlszeile aus
+ FI;
+ zeige hamster; cursor on.
+ setze zeile zusammen:
+ TEXT VAR zeile :: niltext;
+
+ INT VAR x;
+ FOR x FROM 1 UPTO max x REP
+ zeile CAT kachel
+ PER.
+ kachel:
+ INT CONST z :: land [x] [y];
+ IF z = besetzt THEN hinderniskachel
+ ELIF z = frei THEN blankkachel
+ ELSE kornkachel
+ FI.
+ gib befehlszeile aus:
+ cursor(1,1); write(cleol); write (anwendungstext (62))
+END PROC zeige landschaft;
+PROC zeige hamster:
+ zeige (erscheinungsform SUB hamster.form)
+END PROC zeige hamster;
+PROC landschaft (TEXT CONST kandidat):
+
+ initialize hamstersystem;
+ archivlandschaftsname := kandidat;
+ IF exists (praefix + kandidat)
+ CAND type (old (praefix + kandidat)) = flaechentype
+ THEN behandle existierende landschaft
+ ELIF exists (praefix + kandidat)
+ THEN forget (praefix + kandidat, quiet);
+ behandle neue landschaft
+ ELSE behandle neue landschaft
+ FI.
+ behandle existierende landschaft:
+ hole landschaft (kandidat);
+ SELECT modus OF
+ CASE hamsterlauf,
+ interaktiv,
+
+ neutral : zeige landschaft;
+ laufmodus
+ CASE erzeuge : modifiziere eventuell
+ CASE kommandostufe : modifiziere landschaft
+ OTHERWISE errorstop (anwendungstext (15))
+ END SELECT.
+ behandle neue landschaft:
+ SELECT modus OF
+ CASE hamsterlauf,
+ interaktiv,
+ neutral,
+ erzeuge : erschaffe landschaft;
+ modifiziere landschaft;
+ zeige landschaft;
+
+ laufmodus
+ CASE kommandostufe : erschaffe landschaft;
+ modifiziere landschaft;
+ OTHERWISE errorstop (anwendungstext (15))
+ END SELECT.
+ modifiziere eventuell:
+ IF ist hamster
+ THEN IF boxyes (fenster, anwendungstext (41), 5, a, b, c, d)
+ THEN cursor on; modifiziere landschaft
+ FI
+ ELSE IF boxyes (fenster, anwendungstext (42), 5, a, b, c, d)
+ THEN cursor on; modifiziere landschaft
+
+ FI
+ FI;
+ zeige landschaft.
+ erschaffe landschaft:
+ INT VAR j;
+ FOR j FROM 1 UPTO max y REP
+ INT VAR k;
+ FOR k FROM 1 UPTO max x REP
+ land [k] [j] := frei
+ PER
+ PER;
+ hamster.form := 4;
+ hamster.stelle.x := 20;
+ hamster.stelle.y := 12;
+ hamster.koerner := 0.
+END PROC landschaft;
+PROC landschaft:
+ initialize hamstersystem;
+ IF ist hamster
+ THEN landschaft (erfragter landschaftsname (anwendungstext (36)))
+
+ ELSE landschaft (erfragter landschaftsname (anwendungstext (37)))
+ FI
+END PROC landschaft;
+TEXT PROC erfragter landschaftsname (TEXT CONST satz):
+ TEXT VAR landschaftsname :: archivlandschaftsname;
+ REP
+ page; line (3); out (satz + cleol); line (2);
+ editget (landschaftsname);
+ landschaftsname := compress (landschaftsname);
+ IF landschaftsname = niltext
+ THEN line (2); out (anwendungstext (18) + piep);
+ line (2); out (anwendungstext (38)); pause
+ FI
+
+ UNTIL landschaftsname <> niltext PER;
+ landschaftsname
+END PROC erfragter landschaftsname;
+PROC arbeitsfeld (TEXT CONST kandidat):
+ landschaft (kandidat)
+END PROC arbeitsfeld;
+PROC arbeitsfeld:
+ landschaft
+END PROC arbeitsfeld;
+PROC modifiziere landschaft:
+ INT CONST modalibi :: modus;
+ erzeugemodus;
+ zeige landschaft;
+ informiere;
+ zeige hamster;
+ nimm ein eingabezeichen;
+ WHILE nicht endewunsch REP
+ erfuelle fortschreibungswunsch;
+ nimm ein eingabezeichen
+ PER;
+
+ erfrage koernerzahl;
+ lege landschaft ab (archivlandschaftsname);
+ modus := modalibi.
+ nimm ein eingabezeichen:
+ inchar (eingabezeichen).
+ nicht endewunsch:
+ pos ("hH", eingabezeichen) = 0.
+ erfuelle fortschreibungswunsch:
+ INT CONST r :: pos (richtung, eingabezeichen)
+ IF r > 0
+ THEN IF hamster.form = r
+ THEN vor
+ ELSE hamster.form := r;
+ zeige hamster
+ FI
+ ELIF eingabezeichen = "?" THEN boxinfo (fenster, landschaftsauskunftstext,
+
+ 5, maxint, a, b, c, d);
+ cursor on; zeige landschaft; informiere
+ ELIF eingabezeichen = "k" THEN kopiere landschaft;
+ zeige landschaft; informiere
+ ELIF eingabezeichen = "g" THEN gib
+ ELIF eingabezeichen = "n" THEN IF korn da THEN nimm ELSE out (piep) FI
+ ELIF eingabezeichen = "z" THEN zeige (text (kornzahl, 2))
+ ELIF eingabezeichen = hindernis
+ THEN land [hamster.stelle.x] [hamster.stelle.y] := besetzt; vor
+
+ ELIF eingabezeichen = blank
+ THEN land [hamster.stelle.x] [hamster.stelle.y] := frei; vor
+ ELSE out (piep)
+ FI.
+ kopiere landschaft:
+ TEXT VAR kopie;
+ IF NOT not empty (alle landschaften)
+ THEN IF ist hamster
+ THEN boxinfo (fenster, anwendungstext (196), 5, maxint)
+ ELSE boxinfo (fenster, anwendungstext (197), 5, maxint)
+ FI
+ ELSE lasse original auswaehlen
+ FI.
+ lasse original auswaehlen:
+
+ IF ist hamster
+ THEN kopie := boxone (fenster, alle landschaften,
+ anwendungstext (23), anwendungstext (24),
+ FALSE)
+ ELSE kopie := boxone (fenster, alle landschaften,
+ anwendungstext (25), anwendungstext (26),
+ FALSE)
+ FI;
+ cursor on; hole landschaft (kopie).
+ alle landschaften:
+ ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).
+
+ erfrage koernerzahl:
+ TEXT VAR eingabe; BOOL VAR ist ok; INT VAR zahl;
+ cursor (1,23); 79 TIMESOUT waagerecht;
+ REP
+ ist ok := TRUE;
+ IF ist hamster
+ THEN eingabe := boxanswer (fenster, anwendungstext (43),
+ text (hamster.koerner),
+ 5, a, b, c, d)
+ ELSE eingabe := boxanswer (fenster, anwendungstext (44),
+ text (hamster.koerner),
+
+ 5, a, b, c, d)
+ FI;
+ disable stop;
+ IF eingabe = "" THEN eingabe := "0" FI;
+ zahl := int (eingabe);
+ IF zahl < 0 OR zahl > maxint THEN ist ok := FALSE FI;
+ IF is error THEN ist ok := FALSE; clear error FI;
+ enable stop;
+ UNTIL last conversion ok AND ist ok PER;
+ cursor on;
+ hamster.koerner := zahl.
+ informiere:
+ cursor (1,1);
+ IF ist hamster
+ THEN out (anwendungstext (27))
+
+ ELSE out (anwendungstext (28))
+ FI
+END PROC modifiziere landschaft;
+PROC lauf (TEXT CONST dateiname):
+ initialize hamstersystem;
+ IF NOT exists (dateiname)
+ THEN errorstop (anwendungstext (16) + dateiname + anwendungstext (17))
+ FI;
+ hamstermodus;
+ disable stop;
+ run (dateiname);
+ kommandomodus;
+ cursor (1, 24);
+ IF is error
+ THEN IF length (errormessage) > 1
+ THEN sage (errormessage); pause;
+ FI
+ ELSE sage (anwendungstext (29)); pause; konserviere landschaft
+
+ FI;
+ clear error;
+ enable stop
+END PROC lauf;
+PROC lauf:
+ lauf (last param)
+END PROC lauf;
+PROC konserviere landschaft:
+ TEXT VAR neuer landschaftsname;
+ IF ist hamster
+ THEN stelle landschaftsfrage
+ ELSE stelle arbeitsfeldfrage
+ FI; cursor on.
+ stelle landschaftsfrage:
+ IF boxyes (fenster, anwendungstext (45), 5)
+ THEN bewahre landschaft auf
+ FI.
+ stelle arbeitsfeldfrage:
+ IF boxyes (fenster, anwendungstext (46), 5)
+ THEN bewahre landschaft auf
+
+ FI.
+ bewahre landschaft auf:
+ neuer landschaftsname := archivlandschaftsname + ".x";
+ lege landschaft ab (neuer landschaftsname);
+ gib hinweis auf neuen namen.
+ gib hinweis auf neuen namen:
+ IF ist hamster
+ THEN boxinfo (fenster, anwendungstext (30)
+ + inv (neuer landschaftsname), 5, maxint, a, b, c, d)
+ ELSE boxinfo (fenster, anwendungstext (31)
+ + inv (neuer landschaftsname), 5, maxint, a, b, c, d)
+ FI
+END PROC konserviere landschaft;
+
+PROC hamsterinter (TEXT CONST landschaftsname):
+ initialize hamstersystem;
+ sei ein hamster;
+ steuere interaktiv (landschaftsname);
+ cursor on
+END PROC hamsterinter;
+PROC hamsterinter:
+ initialize hamstersystem;
+ hamsterinter (erfragter landschaftsname (anwendungstext (39)))
+END PROC hamsterinter;
+PROC roboterinter (TEXT CONST landschaftsname):
+ initialize hamstersystem;
+ sei ein roboter;
+ steuere interaktiv (landschaftsname);
+ cursor on
+END PROC roboterinter;
+PROC roboterinter:
+
+ initialize hamstersystem;
+ roboterinter (erfragter landschaftsname (anwendungstext (40)))
+END PROC roboterinter;
+PROC steuere interaktiv (TEXT CONST landschaftsname):
+ forget (protokollname, quiet);
+ protokoll := sequential file (output, protokollname);
+ intermodus;
+ landschaft (landschaftsname);
+ TEXT VAR befehl :: niltext, letzter befehl :: niltext;
+ REP
+ arbeiten
+ PER.
+ arbeiten:
+ intermodus;
+ hole befehl;
+ fuehre befehl aus.
+ hole befehl:
+ TEXT VAR befehlszeichen;
+
+ TEXT CONST befehlskette :: "vlngpeVLNGPE";
+ INT VAR befehlsposition;
+ zeige (hamsterform);
+ cursor (1,24);
+ IF ist hamster
+ THEN out (cleol + anwendungstext (32) + letzter befehl)
+ ELSE out (cleol + anwendungstext (33) + letzter befehl)
+ FI;
+ cursor(24,24);
+ inchar (befehlszeichen);
+ befehlsposition := pos(befehlskette,befehlszeichen);
+ IF befehlsposition = 0
+ THEN out(piep);
+ LEAVE arbeiten
+ FI;
+ SELECT befehlsposition OF
+
+ CASE 1, 7: befehl := "vor";
+ out("vor");
+ letzter befehl := "vor"
+ CASE 2, 8: befehl := "links um";
+ out("links um");
+ letzter befehl := "links um"
+ CASE 3, 9: befehl := "nimm";
+ out("nimm");
+ letzter befehl := "nimm"
+ CASE 4,10: befehl := "gib";
+ out("gib");
+ letzter befehl := "gib"
+
+ CASE 5,11: out("protokoll");
+ letzter befehl := "protokoll";
+ FILE VAR p :: sequential file (modify,protokollname);
+ headline(p, protokollname + " (Verlassen: <ESC><q>)");
+ cursor on; show(p); cursor off;
+ zeige landschaft; befehl := "";
+ output(protokoll);
+ LEAVE arbeiten
+ CASE 6,12: out("ende"); kommandomodus; befehl := "";
+ LEAVE steuere interaktiv
+
+ END SELECT.
+ hamsterform:
+ erscheinungsform SUB hamster.form.
+ fuehre befehl aus:
+ BOOL VAR korrekt;
+ disable stop;
+ do (befehl);
+ cursor (1,24);
+ korrekt := NOT is error;
+ IF is error
+ THEN IF errormessage > ""
+ THEN out (inv (text (errormessage, 65)) + piep);
+ pause(30);
+ FI;
+ clear error
+ FI;
+ IF korrekt AND befehl <> ""
+ THEN protokolliere (befehl)
+ FI;
+ enable stop;
+
+END PROC steuere interaktiv;
+PROC protokolliere (TEXT CONST befehl):
+ putline (protokoll, befehl + ";")
+END PROC protokolliere;
+PROC drucke landschaft (TEXT CONST landschaftsname):
+ initialize hamstersystem;
+ ROW max y TEXT VAR drucklandschaft;
+ BOUND LANDSCHAFT VAR al;
+ INT VAR i, hamsterx, hamstery;
+ TEXT VAR hamsterzeichen;
+ landschaftsdatei holen;
+ drucklandschaft erzeugen;
+ hamster in drucklandschaft einsetzen;
+ druckdatei erzeugen;
+ disable stop;
+ TEXT VAR datname := std;
+
+ do ("print (""druckdatei"")");
+ IF is error
+ THEN menuinfo (inv (errormessage));
+ clear error;
+ FI;
+ last param (datname);
+ enable stop;
+ druckdatei loeschen;
+ cursor on.
+ landschaftsdatei holen:
+ IF exists (praefix + landschaftsname) AND
+ (type (old (praefix + landschaftsname)) = flaechentype)
+ THEN hole landschaft;
+ ELSE LEAVE drucke landschaft
+ FI.
+ hole landschaft:
+ al := old (praefix + landschaftsname);
+ hamsterx := al.xpos;
+
+ hamstery := al.ypos;
+ hamsterzeichen := erscheinungsform SUB al.blickrichtung.
+ drucklandschaft erzeugen:
+ TEXT VAR zeile; INT VAR x;
+ FOR i FROM 1 UPTO max y REP
+ zeile := "";
+ FOR x FROM 1 UPTO maxx REP
+ zeile erzeugen
+ PER;
+ drucklandschaft[i] := zeile
+ PER.
+ zeile erzeugen:
+ INT CONST zeichen :: al.flaeche [x] [i];
+ IF zeichen = besetzt THEN zeile CAT hinderniszeichen
+ ELIF zeichen = frei THEN zeile CAT " ."
+
+ ELSE zeile CAT " o"
+ FI.
+ hamster in drucklandschaft einsetzen:
+ change (drucklandschaft [hamstery], hamsterx*2-1, hamsterx*2-1,
+ hamsterzeichen).
+ druckdatei erzeugen:
+ FILE VAR p::sequential file(output, "druckdatei");
+ INT VAR blankzahl;
+ line(p);
+ putline(p,"#type (""" + schrifttyp + """)#");
+ putline(p,"#start(" + text(xstart) + "," + text(ystart) + ")#");
+ putline(p,"#limit(20.8)#");
+ blankzahl := ( 80 - (8 + length (landschaftsname))) DIV 2;
+
+ putline(p, blankzahl * " " + praefix + landschaftsname + " ");
+ putline(p, "  ");
+ FOR i FROM 1 UPTO maxy REP
+ putline(p, drucklandschaft[i] + " ")
+ PER.
+ druckdatei loeschen:
+ forget("druckdatei", quiet)
+END PROC drucke landschaft;
+PROC drucke landschaft:
+ initialize hamstersystem;
+ IF ist hamster
+ THEN drucke landschaft (erfragter landschaftsname (anwendungstext (36)))
+ ELSE drucke landschaft (erfragter landschaftsname (anwendungstext (37)))
+ FI;
+ cursor on
+
+END PROC drucke landschaft;
+PROC druckereinstellung fuer flaechenausdruck:
+ initialize hamstersystem;
+ page;
+ IF ist hamster
+ THEN putline (center (invers (anwendungstext (71))))
+ ELSE putline (center (invers (anwendungstext (72))))
+ FI;
+ line (3);
+ put (anwendungstext (73));
+ editget (schrifttyp);
+ line (2);
+ schrifttyp := compress (schrifttyp);
+ putline (anwendungstext (74));
+ putline (anwendungstext (75)); line (2);
+ putline (anwendungstext (76) + text (xstart) + "," + text (ystart) +
+
+ anwendungstext (77)); line;
+ put (anwendungstext (78)); get (xstart); line;
+ put (anwendungstext (79)); get (ystart); line (2);
+ IF yes (anwendungstext (80) + hinderniszeichen + anwendungstext (81))
+ THEN line;
+ put (anwendungstext (82)); inchar (hinderniszeichen); line (2);
+ hinderniszeichen CAT hinderniszeichen;
+ IF hinderniszeichen = "##"
+ THEN hinderniszeichen := "\#\#"
+ FI
+ FI;
+ line;
+ put (anwendungstext (83))
+END PROC druckereinstellung fuer flaechenausdruck;
+
+PROC hamster druckerstart einstellen (REAL CONST xpos, ypos):
+ xstart := xpos; ystart := ypos
+END PROC hamster druckerstart einstellen;
+REAL PROC hamster drucker xstart:
+ xstart
+END PROC hamster drucker xstart;
+REAL PROC hamster drucker ystart:
+ ystart
+END PROC hamster drucker ystart;
+PROC hamster landschaftsschrifttyp einstellen (TEXT CONST typ):
+ schrifttyp := typ
+END PROC hamster landschaftsschrifttyp einstellen;
+TEXT PROC hamster landschaftsschrifttyp:
+ schrifttyp
+END PROC hamster landschaftsschrifttyp;
+
+PROC drucke arbeitsfeld (TEXT CONST arbeitsfeldname):
+ drucke landschaft (arbeitsfeldname)
+END PROC drucke arbeitsfeld;
+PROC drucke arbeitsfeld:
+ drucke landschaft
+END PROC drucke arbeitsfeld;
+TEXT PROC taste:
+ eingabezeichen
+END PROC taste;
+TEXT PROC landschaftsauskunftstext:
+ initialize hamstersystem;
+ IF ist hamster
+ THEN anwendungstext (52)
+ ELSE anwendungstext (53)
+ FI
+END PROC landschaftsauskunftstext;
+TEXT PROC laufauskunftstext:
+ initialize hamstersystem;
+
+ anwendungstext (51)
+END PROC laufauskunftstext;
+TEXT PROC befehlsauskunftstext:
+ initialize hamstersystem;
+ IF ist hamster
+ THEN anwendungstext (54)
+ ELSE anwendungstext (55)
+ FI
+END PROC befehlsauskunftstext;
+TEXT PROC testauskunftstext 1:
+ initialize hamstersystem;
+ IF befehlssatz erweitert
+ THEN langer testauskunftstext
+ ELSE kurzer testauskunftstext
+ FI.
+ kurzer testauskunftstext:
+ IF ist hamster
+ THEN anwendungstext (56)
+ ELSE anwendungstext (57)
+
+ FI.
+ langer testauskunftstext:
+ IF ist hamster
+ THEN anwendungstext (58)
+ ELSE anwendungstext (60)
+ FI.
+END PROC testauskunftstext 1;
+TEXT PROC testauskunftstext 2:
+ initialize hamstersystem;
+ IF befehlssatz erweitert
+ THEN eintragung
+ ELSE niltext
+ FI.
+ eintragung:
+ IF ist hamster
+ THEN anwendungstext (59)
+ ELSE anwendungstext (61)
+ FI
+END PROC testauskunftstext 2;
+PROC befehlssatz erweitern (BOOL CONST status):
+ befehlssatz erweitert := status
+
+END PROC befehlssatz erweitern;
+BOOL PROC befehlssatz ist erweitert:
+ befehlssatz erweitert
+END PROC befehlssatz ist erweitert;
+END PACKET ls herbert und robbi 1;
+
diff --git a/hamster/ls-Herbert und Robbi 2 b/hamster/ls-Herbert und Robbi 2
index 7394932..a8ce067 100644
--- a/hamster/ls-Herbert und Robbi 2
+++ b/hamster/ls-Herbert und Robbi 2
@@ -22,10 +22,118 @@
*)
-PACKET ls herbert und robbi 2 DEFINES{} rechts frei,{} links frei,{} hinten frei,{} korn vorn, werkstueck vorn,{} korn links, werkstueck links,{} korn rechts, werkstueck rechts,{} korn hinten, werkstueck hinten:{}BOOL PROC rechts frei:{} rechts um;{} IF vorn frei{} THEN links um; TRUE{} ELSE links um; FALSE{} FI{}END PROC rechts frei;{}BOOL PROC links frei:{} links um;{} IF vorn frei{} THEN rechts um; TRUE{} ELSE rechts um; FALSE{}
- FI{}END PROC links frei;{}BOOL PROC hinten frei:{} kehrt;{} IF vorn frei{} THEN kehrt; TRUE{} ELSE kehrt; FALSE{} FI{}END PROC hinten frei;{}BOOL PROC korn vorn:{} IF vorn frei{} THEN untersuche feld vor dir{} ELSE FALSE{} FI.{} untersuche feld vor dir:{} vor;{} IF korn da{} THEN mache vorwaertsgehen rueckgaengig; TRUE{} ELSE mache vorwaertsgehen rueckgaengig; FALSE{} FI.{} mache vorwaertsgehen rueckgaengig:{} kehrt; vor; kehrt{}END PROC korn vorn;{}
-BOOL PROC korn links:{} links um;{} IF vorn frei{} THEN untersuche feld links{} ELSE rechts um; FALSE{} FI.{} untersuche feld links:{} vor;{} IF korn da{} THEN mache linkswende rueckgaengig; TRUE{} ELSE mache linkswende rueckgaengig; FALSE{} FI.{} mache linkswende rueckgaengig:{} kehrt; vor; links um{}END PROC korn links;{}BOOL PROC korn rechts:{} rechts um;{} IF vorn frei{} THEN untersuche feld rechts{} ELSE links um; FALSE{} FI.{} untersuche feld rechts:{}
- vor;{} IF korn da{} THEN mache rechtswende rueckgaengig; TRUE{} ELSE mache rechtswende rueckgaengig; FALSE{} FI.{} mache rechtswende rueckgaengig:{} kehrt; vor; rechts um{}END PROC korn rechts;{}BOOL PROC korn hinten:{} kehrt;{} IF vorn frei{} THEN untersuche feld hinter dir{} ELSE kehrt; FALSE{} FI.{} untersuche feld hinter dir:{} vor;{} IF korn da{} THEN mache kehrtwende rueckgaengig; TRUE{} ELSE mache kehrtwende rueckgaengig; FALSE{} FI.{}
- mache kehrtwende rueckgaengig:{} kehrt; vor{}END PROC korn hinten;{}PROC kehrt:{} links um; links um{}END PROC kehrt;{}PROC rechts um:{} links um; links um; links um{}END PROC rechts um;{}BOOL PROC werkstueck vorn:{} korn vorn{}END PROC werkstueck vorn;{}BOOL PROC werkstueck links:{} korn links{}END PROC werkstueck links;{}BOOL PROC werkstueck rechts:{} korn rechts{}END PROC werkstueck rechts;{}BOOL PROC werkstueck hinten:{} korn hinten{}END PROC werkstueck hinten;{}END PACKET ls herbert und robbi 2;{}
-befehlssatz erweitern (TRUE){}
+PACKET ls herbert und robbi 2 DEFINES
+ rechts frei,
+ links frei,
+ hinten frei,
+ korn vorn, werkstueck vorn,
+ korn links, werkstueck links,
+ korn rechts, werkstueck rechts,
+ korn hinten, werkstueck hinten:
+BOOL PROC rechts frei:
+ rechts um;
+ IF vorn frei
+ THEN links um; TRUE
+ ELSE links um; FALSE
+ FI
+END PROC rechts frei;
+BOOL PROC links frei:
+ links um;
+ IF vorn frei
+ THEN rechts um; TRUE
+ ELSE rechts um; FALSE
+
+ FI
+END PROC links frei;
+BOOL PROC hinten frei:
+ kehrt;
+ IF vorn frei
+ THEN kehrt; TRUE
+ ELSE kehrt; FALSE
+ FI
+END PROC hinten frei;
+BOOL PROC korn vorn:
+ IF vorn frei
+ THEN untersuche feld vor dir
+ ELSE FALSE
+ FI.
+ untersuche feld vor dir:
+ vor;
+ IF korn da
+ THEN mache vorwaertsgehen rueckgaengig; TRUE
+ ELSE mache vorwaertsgehen rueckgaengig; FALSE
+ FI.
+ mache vorwaertsgehen rueckgaengig:
+ kehrt; vor; kehrt
+END PROC korn vorn;
+
+BOOL PROC korn links:
+ links um;
+ IF vorn frei
+ THEN untersuche feld links
+ ELSE rechts um; FALSE
+ FI.
+ untersuche feld links:
+ vor;
+ IF korn da
+ THEN mache linkswende rueckgaengig; TRUE
+ ELSE mache linkswende rueckgaengig; FALSE
+ FI.
+ mache linkswende rueckgaengig:
+ kehrt; vor; links um
+END PROC korn links;
+BOOL PROC korn rechts:
+ rechts um;
+ IF vorn frei
+ THEN untersuche feld rechts
+ ELSE links um; FALSE
+ FI.
+ untersuche feld rechts:
+
+ vor;
+ IF korn da
+ THEN mache rechtswende rueckgaengig; TRUE
+ ELSE mache rechtswende rueckgaengig; FALSE
+ FI.
+ mache rechtswende rueckgaengig:
+ kehrt; vor; rechts um
+END PROC korn rechts;
+BOOL PROC korn hinten:
+ kehrt;
+ IF vorn frei
+ THEN untersuche feld hinter dir
+ ELSE kehrt; FALSE
+ FI.
+ untersuche feld hinter dir:
+ vor;
+ IF korn da
+ THEN mache kehrtwende rueckgaengig; TRUE
+ ELSE mache kehrtwende rueckgaengig; FALSE
+ FI.
+
+ mache kehrtwende rueckgaengig:
+ kehrt; vor
+END PROC korn hinten;
+PROC kehrt:
+ links um; links um
+END PROC kehrt;
+PROC rechts um:
+ links um; links um; links um
+END PROC rechts um;
+BOOL PROC werkstueck vorn:
+ korn vorn
+END PROC werkstueck vorn;
+BOOL PROC werkstueck links:
+ korn links
+END PROC werkstueck links;
+BOOL PROC werkstueck rechts:
+ korn rechts
+END PROC werkstueck rechts;
+BOOL PROC werkstueck hinten:
+ korn hinten
+END PROC werkstueck hinten;
+END PACKET ls herbert und robbi 2;
+
+befehlssatz erweitern (TRUE)
+
diff --git a/hamster/ls-Herbert und Robbi 3 b/hamster/ls-Herbert und Robbi 3
index e5db408..7a1da20 100644
--- a/hamster/ls-Herbert und Robbi 3
+++ b/hamster/ls-Herbert und Robbi 3
@@ -22,63 +22,908 @@
*)
-PACKET ls herbert und robbi 3 DEFINES{} hamsterbefehlsauskunft,{} hamsterlaufauskunft,{} hamsterlandschaftsauskunft,{} hamsterlandschaft verzeichnis,{} hamsterlandschaft neu erstellen,{} hamsterlandschaft ansehen,{} hamsterlandschaft drucken,{} hamsterlandschaft kopieren,{} hamsterlandschaft umbenennen,{} hamsterlandschaft loeschen,{} hamsterprogramm verzeichnis,{} hamsterprogramm neu erstellen,{} hamsterprogramm ansehen,{} hamsterprogramm kopieren,{} hamsterprogramm umbenennen,{}
- hamsterprogramm loeschen,{} hamsterprogramm drucken,{} hamster laufen lassen,{} hamsterinteraktiv laufen lassen,{} hamster, roboter:{}LET menukarte = "ls-MENUKARTE:Herbert und Robbi",{} praefix = "Flaeche:",{} flaechentype = 1007,{} niltext = "",{} maxlaenge = 60,{} maxnamenslaenge = 50;{}TEXT VAR flaechenname :: "",{} programmname :: "";{}INITFLAG VAR in this task :: FALSE;{}PROC initialize hamster:{}
- IF NOT initialized (in this task){} THEN flaechenname := "";{} programmname := ""{} FI{}END PROC initialize hamster;{}PROC hamster:{} sei ein hamster;{} initialize hamster;{} install menu (menukarte);{} handle menu ("HAMSTER"){}END PROC hamster;{}PROC roboter:{} sei ein roboter;{} initialize hamster;{} install menu (menukarte);{} handle menu ("ROBOTER");{}END PROC roboter;{}PROC hamsterlaufauskunft:{} menuinfo (laufauskunftstext){}END PROC hamsterlaufauskunft;{}PROC hamsterlandschaftsauskunft:{}
- menuinfo (landschaftsauskunftstext){}END PROC hamsterlandschaftsauskunft;{}PROC hamsterbefehlsauskunft:{} menuinfo (befehlsauskunftstext);{} menuinfo (testauskunftstext 1);{} IF testauskunftstext 2 <> ""{} THEN menuinfo (testauskunftstext 2){} FI{}END PROC hamsterbefehlsauskunft;{}PROC hamsterlandschaft verzeichnis:{} THESAURUS VAR landschaften ::{} ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{} forget ("Interne Thesaurusdateiliste", quiet);{} FILE VAR f :: sequential file (output, "Interne Thesaurusdateiliste");{}
- f FILLBY landschaften;{} headline (f, anwendungstext (204)); modify (f);{} to line (f, 1); insert record (f); write record (f, kenntext);{} to line (f, 2); insert record (f);{} to line (f, 1); menuwindowshow (f);{} forget ("Interne Thesaurusdateiliste", quiet);{} regenerate menuscreen.{} kenntext:{} IF ist hamster THEN anwendungstext (121) ELSE anwendungstext (151) FI.{}END PROC hamsterlandschaft verzeichnis;{}PROC hamsterprogramm verzeichnis:{} THESAURUS VAR programme :: ALL myself - infix namen (ALL myself, praefix, flaechentype);{}
- forget ("Interne Thesaurusdateiliste", quiet);{} FILE VAR f :: sequential file (output, "Interne Thesaurusdateiliste");{} f FILLBY programme;{} headline (f, anwendungstext (204)); modify (f);{} to line (f, 1); insert record (f); write record (f, anwendungstext (181));{} to line (f, 2); insert record (f);{} to line (f, 1); menuwindowshow (f);{} forget ("Interne Thesaurusdateiliste", quiet);{} regenerate menuscreen{}END PROC hamsterprogramm verzeichnis;{}PROC hamsterlandschaft neu erstellen:{}
- hole flaechenname;{} kontrolliere den flaechennamen;{} kommandomodus;{} landschaft (flaechenname);{} regenerate menuscreen.{} hole flaechenname:{} IF ist hamster{} THEN flaechenname := menuanswer (anwendungstext (101) +{} anwendungstext (102), "", 5){} ELSE flaechenname := menuanswer (anwendungstext (131) +{} anwendungstext (132), "", 5){} FI.{} kontrolliere den flaechennamen:{} IF flaechenname = niltext{}
- THEN LEAVE hamsterlandschaft neu erstellen{} ELIF length (flaechenname) > maxnamenslaenge{} THEN meckere zu langen namen an;{} flaechenname := niltext;{} LEAVE hamsterlandschaft neu erstellen{} ELIF exists (praefix + flaechenname){} THEN meckere existierende flaeche an;{} LEAVE hamsterlandschaft neu erstellen{} FI{}END PROC hamsterlandschaft neu erstellen;{}PROC hamsterprogramm neu erstellen:{} hole programmname;{} kontrolliere den programmnamen;{}
- command dialogue (FALSE);{} cursor on;{} stdinfoedit (programmname);{} cursor off;{} command dialogue (TRUE);{} regenerate menuscreen.{} hole programmname:{} programmname := menuanswer (anwendungstext (161) +{} anwendungstext (162), "", 5).{} kontrolliere den programmnamen:{} IF programmname = niltext{} THEN LEAVE hamsterprogramm neu erstellen{} ELIF length (programmname) > maxnamenslaenge{} THEN meckere zu langen namen an;{} programmname := niltext;{}
- LEAVE hamsterprogramm neu erstellen{} ELIF exists (programmname){} THEN meckere existierendes programm an;{} LEAVE hamsterprogramm neu erstellen{} FI{}END PROC hamsterprogramm neu erstellen;{}PROC hamsterlandschaft ansehen:{} IF flaechenname <> niltext CAND exists (praefix + flaechenname){} THEN frage nach dieser flaeche{} ELSE lasse flaeche auswaehlen{} FI;{} kommandomodus;{} landschaft (flaechenname);{} regenerate menuscreen.{} frage nach dieser flaeche:{}
- IF menuno (ueberschrift + text 1 + name + text 2, 5){} THEN lasse flaeche auswaehlen{} FI.{} ueberschrift:{} IF ist hamster{} THEN center (maxlaenge, invers (anwendungstext (105))) + ""13""13""{} ELSE center (maxlaenge, invers (anwendungstext (135))) + ""13""13""{} FI.{} text 1:{} IF ist hamster THEN anwendungstext (103) ELSE anwendungstext (133) FI.{} name:{} ""13""13" " + invers (flaechenname) + ""13""13"".{} text 2:{} IF ist hamster THEN anwendungstext (104) ELSE anwendungstext (134) FI.{}
- lasse flaeche auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{} IF NOT not empty (verfuegbare){} THEN noch keine flaeche;{} LEAVE hamsterlandschaft ansehen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} IF ist hamster{} THEN flaechenname := menuone (verfuegbare, anwendungstext (105),{} anwendungstext (106), FALSE){} ELSE flaechenname := menuone (verfuegbare, anwendungstext (135),{}
- anwendungstext (136), FALSE){} FI;{} IF flaechenname = niltext{} THEN regenerate menuscreen;{} LEAVE hamsterlandschaft ansehen{} FI.{}END PROC hamsterlandschaft ansehen;{}PROC hamsterprogramm ansehen:{} IF programmname <> niltext CAND exists (programmname){} THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI;{} cursor on;{} stdinfoedit (programmname);{} cursor off;{} regenerate menuscreen.{} frage nach diesem programm:{}
- IF menuno (ueberschrift + anwendungstext (163) + name{} + anwendungstext (164), 5){} THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} center (maxlaenge, invers (anwendungstext (165))) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{}
- LEAVE hamsterprogramm ansehen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, anwendungstext (165),{} anwendungstext (166), FALSE);{} IF programmname = niltext{} THEN regenerate menuscreen;{} LEAVE hamsterprogramm ansehen{} FI.{}END PROC hamsterprogramm ansehen;{}PROC hamsterlandschaft drucken:{} lasse flaechen auswaehlen;{} drucke flaechen;{} regenerate menuscreen.{} lasse flaechen auswaehlen:{}
- THESAURUS VAR verfuegbare;{} verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{} IF NOT not empty (verfuegbare){} THEN noch keine flaeche;{} LEAVE hamsterlandschaft drucken{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} IF ist hamster{} THEN verfuegbare := menusome (verfuegbare, anwendungstext (107),{} anwendungstext (108), FALSE){} ELSE verfuegbare := menusome (verfuegbare, anwendungstext (137),{}
- anwendungstext (138), FALSE){} FI.{} drucke flaechen:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (bezeichnung)));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (schlussbemerkung);{} menuwindowstop.{} bezeichnung:{} IF ist hamster THEN anwendungstext (107) ELSE anwendungstext (137) FI.{}
- schlussbemerkung:{} IF ist hamster THEN anwendungstext (110) ELSE anwendungstext (140) FI.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} menuwindowout ( " """ + name (verfuegbare, k) + """ "{} + anwendungstext (201));{} menuwindowline;{} drucke landschaft (name (verfuegbare, k));{} fehlerbehandlung{}
- FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} IF ist hamster{} THEN menuwindowout (anwendungstext (109)){} ELSE menuwindowout (anwendungstext (139)){} FI;{} menuwindowstop;{} regenerate menuscreen;{} LEAVE hamsterlandschaft drucken{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{}
- ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE hamsterlandschaft drucken{} FI.{}END PROC hamsterlandschaft drucken;{}PROC hamsterprogramm drucken:{} lasse programme auswaehlen;{} drucke programme;{} regenerate menuscreen.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);{}
- IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE hamsterprogramm drucken{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, anwendungstext (167),{} anwendungstext (168), FALSE).{} drucke programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (anwendungstext (167))));{} menuwindowline (2);{} command dialogue (FALSE);{}
- fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (anwendungstext (170));{} menuwindowstop.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} menuwindowout ( " """ + name (verfuegbare, k) + """ "{} + anwendungstext (201));{} menuwindowline;{}
- print (name (verfuegbare, k));{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (anwendungstext (169));{} menuwindowstop;{} regenerate menuscreen;{} LEAVE hamsterprogramm drucken{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){}
- FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE hamsterprogramm drucken{} FI.{}END PROC hamsterprogramm drucken;{}PROC hamsterlandschaft kopieren:{} ermittle alten flaechennamen;{} erfrage neuen flaechennamen;{} kopiere ggf die flaeche.{} ermittle alten flaechennamen:{} IF NOT not empty (bestand){} THEN noch keine flaeche;{} LEAVE hamsterlandschaft kopieren{}
- ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, text1, text2, TRUE);{} IF alter name = niltext{} THEN LEAVE hamsterlandschaft kopieren{} FI.{} bestand:{} ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).{} text1:{} IF ist hamster THEN anwendungstext (111) ELSE anwendungstext (141) FI.{} text2:{} IF ist hamster THEN anwendungstext (112) ELSE anwendungstext (142) FI.{} erfrage neuen flaechennamen:{}
- TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + hinweis auf alt + bisheriger name + aufforderung.{} ueberschrift:{} IF ist hamster{} THEN center (maxlaenge, invers (anwendungstext (111))) + ""13""13""{} ELSE center (maxlaenge, invers (anwendungstext (141))) + ""13""13""{} FI.{} hinweis auf alt:{} IF ist hamster THEN anwendungstext (113) ELSE anwendungstext (143) FI.{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{}
- aufforderung:{} anwendungstext (202).{} kopiere ggf die flaeche:{} IF neuer name = niltext{} THEN menuinfo (invers (anwendungstext (192)));{} LEAVE hamsterlandschaft kopieren{} ELIF exists (praefix + neuer name){} THEN mache vorwurf;{} LEAVE hamsterlandschaft kopieren{} ELSE copy (praefix + alter name, praefix + neuer name){} FI.{} mache vorwurf:{} IF ist hamster{} THEN menuinfo (anwendungstext (193)){} ELSE menuinfo (anwendungstext (194)){}
- FI.{}END PROC hamsterlandschaft kopieren;{}PROC hamsterprogramm kopieren:{} ermittle alten programmnamen;{} erfrage neuen programmnamen;{} kopiere ggf das programm.{} ermittle alten programmnamen:{} IF NOT not empty (bestand){} THEN noch kein programm;{} LEAVE hamsterprogramm kopieren{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, anwendungstext (171),{} anwendungstext (172), TRUE);{}
- IF alter name = niltext{} THEN LEAVE hamsterprogramm kopieren{} FI.{} bestand:{} ALL myself - infix namen (ALL myself, praefix, flaechentype).{} erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + anwendungstext (173) + bisheriger name{} + anwendungstext (202).{} ueberschrift:{} center (maxlaenge, invers (anwendungstext (171))) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{}
- kopiere ggf das programm:{} IF neuer name = niltext{} THEN menuinfo (invers (anwendungstext (192)));{} LEAVE hamsterprogramm kopieren{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE hamsterprogramm kopieren{} ELSE copy (alter name, neuer name){} FI.{} mache vorwurf:{} menuinfo (anwendungstext (195)).{}END PROC hamsterprogramm kopieren;{}PROC hamsterlandschaft umbenennen:{} ermittle alten flaechennamen;{} erfrage neuen flaechennamen;{}
- benenne ggf die flaeche um.{} ermittle alten flaechennamen:{} IF NOT not empty (bestand){} THEN noch keine flaeche;{} LEAVE hamsterlandschaft umbenennen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, text1, text2, TRUE);{} IF alter name = niltext{} THEN LEAVE hamsterlandschaft umbenennen{} FI.{} bestand:{} ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).{} text1:{} IF ist hamster THEN anwendungstext (114) ELSE anwendungstext (144) FI.{}
- text2:{} IF ist hamster THEN anwendungstext (115) ELSE anwendungstext (145) FI.{} erfrage neuen flaechennamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + hinweis auf alt + bisheriger name + aufforderung.{} ueberschrift:{} IF ist hamster{} THEN center (maxlaenge, invers (anwendungstext (114))) + ""13""13""{} ELSE center (maxlaenge, invers (anwendungstext (144))) + ""13""13""{} FI.{} hinweis auf alt:{} IF ist hamster THEN anwendungstext (116) ELSE anwendungstext (146) FI.{}
- bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} aufforderung:{} IF ist hamster THEN anwendungstext (117) ELSE anwendungstext (147) FI.{} benenne ggf die flaeche um:{} IF neuer name = niltext{} THEN menuinfo (invers (anwendungstext (192)));{} LEAVE hamsterlandschaft umbenennen{} ELIF exists (praefix + neuer name){} THEN mache vorwurf;{} LEAVE hamsterlandschaft umbenennen{} ELSE rename (praefix + alter name, praefix + neuer name);{}
- flaechenname := neuer name{} FI.{} mache vorwurf:{} IF ist hamster{} THEN menuinfo (anwendungstext (193)){} ELSE menuinfo (anwendungstext (194)){} FI.{}END PROC hamsterlandschaft umbenennen;{}PROC hamsterprogramm umbenennen:{} ermittle alten programmnamen;{} erfrage neuen programmnamen;{} benenne ggf das programm um.{} ermittle alten programmnamen:{} IF NOT not empty (bestand){} THEN noch kein programm;{} LEAVE hamsterprogramm umbenennen{} ELSE biete auswahl an{}
- FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, anwendungstext (174),{} anwendungstext (175), TRUE);{} IF alter name = niltext{} THEN LEAVE hamsterprogramm umbenennen{} FI.{} bestand:{} ALL myself - infix namen (ALL myself, praefix, flaechentype).{} erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + anwendungstext (176) + bisheriger name{} + anwendungstext (177).{}
- ueberschrift:{} center (maxlaenge, invers (anwendungstext (174))) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} benenne ggf das programm um:{} IF neuer name = niltext{} THEN menuinfo (invers (anwendungstext (192)));{} LEAVE hamsterprogramm umbenennen{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE hamsterprogramm umbenennen{} ELSE rename (alter name, neuer name);{} programmname := neuer name{}
- FI.{} mache vorwurf:{} menuinfo (anwendungstext (195)).{}END PROC hamsterprogramm umbenennen;{}PROC hamsterlandschaft loeschen:{} lasse flaechen auswaehlen;{} loesche flaechen;{} regenerate menuscreen.{} lasse flaechen auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{} IF NOT not empty (verfuegbare){} THEN noch keine flaeche;{} LEAVE hamsterlandschaft loeschen{} ELSE biete auswahl an{}
- FI.{} biete auswahl an:{} IF ist hamster{} THEN verfuegbare := menusome (verfuegbare, anwendungstext (118),{} anwendungstext (119), FALSE){} ELSE verfuegbare := menusome (verfuegbare, anwendungstext (148),{} anwendungstext (149), FALSE){} FI.{} loesche flaechen:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (bezeichnung)));{} menuwindowline (2);{}
- command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (schlussbemerkung);{} menuwindowstop.{} bezeichnung:{} IF ist hamster THEN anwendungstext (118) ELSE anwendungstext (148) FI.{} schlussbemerkung:{} IF ist hamster THEN anwendungstext (120) ELSE anwendungstext (150) FI.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{}
- THEN disable stop;{} IF menuwindowyes (" """ + name (verfuegbare, k) + """ "{} + anwendungstext (203)){} THEN forget (praefix + name (verfuegbare, k), quiet){} FI;{} fehlerbehandlung{} FI{} PER;{} flaechenname := "".{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} IF ist hamster{} THEN menuwindowout (anwendungstext (109)){}
- ELSE menuwindowout (anwendungstext (139)){} FI;{} menuwindowstop;{} regenerate menuscreen;{} LEAVE hamsterlandschaft loeschen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{}
- LEAVE hamsterlandschaft loeschen{} FI.{}END PROC hamsterlandschaft loeschen;{}PROC hamsterprogramm loeschen:{} lasse programme auswaehlen;{} loesche programme;{} regenerate menuscreen.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE hamsterprogramm loeschen{} ELSE biete auswahl an{} FI.{}
- biete auswahl an:{} verfuegbare := menusome (verfuegbare, anwendungstext (178),{} anwendungstext (179), FALSE).{} loesche programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (anwendungstext (178))));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (anwendungstext (180));{}
- menuwindowstop.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} IF menuwindowyes (" """ + name (verfuegbare, k) + """ "{} + anwendungstext (203)){} THEN forget (name (verfuegbare, k), quiet){} FI;{} fehlerbehandlung{} FI{} PER;{} programmname := "".{} steige ggf bei leerem thesaurus aus:{}
- IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (anwendungstext (169));{} menuwindowstop;{} regenerate menuscreen;{} LEAVE hamsterprogramm loeschen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{}
- clear error; enable stop;{} LEAVE hamsterprogramm loeschen{} FI.{}END PROC hamsterprogramm loeschen;{}PROC hamsterinteraktiv laufen lassen:{} frage nach neuer flaeche;{} cursor on;{} IF ist hamster{} THEN hamsterinter (flaechenname){} ELSE roboterinter (flaechenname){} FI;{} programmname := "PROTOKOLL";{} cursor off;{} regenerate menuscreen.{} frage nach neuer flaeche:{} IF menuyes (ueberschrift + fragetext, 5){} THEN lasse flaeche auswaehlen{} ELSE weise auf landschaftsgestaltung hin;{}
- LEAVE hamsterinteraktiv laufen lassen{} FI.{} ueberschrift:{} IF ist hamster{} THEN center (laenge, invers (anwendungstext (122))) + ""13""13""{} ELSE center (laenge, invers (anwendungstext (152))) + ""13""13""{} FI.{} fragetext:{} IF ist hamster{} THEN center (laenge, anwendungstext (123)){} ELSE center (laenge, anwendungstext (153)){} FI.{} laenge:{} IF ist hamster{} THEN max (length (anwendungstext (122)),{} length (anwendungstext (123))) + 5{}
- ELSE max (length (anwendungstext (152)),{} length (anwendungstext (153))) + 5{} FI.{} lasse flaeche auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{} IF ist hamster{} THEN flaechenname := menuone (verfuegbare, anwendungstext (122),{} anwendungstext (106), FALSE){} ELSE flaechenname := menuone (verfuegbare, anwendungstext (152),{} anwendungstext (136), FALSE){}
- FI;{} IF flaechenname = niltext{} THEN weise auf landschaftsgestaltung hin;{} regenerate menuscreen;{} LEAVE hamsterinteraktiv laufen lassen{} FI.{} weise auf landschaftsgestaltung hin:{} WINDOW VAR mfenster := current menuwindow;{} IF ist hamster{} THEN boxinfo (mfenster, anwendungstext (124), 5, maxint){} ELSE boxinfo (mfenster, anwendungstext (154), 5, maxint){} FI.{}END PROC hamsterinteraktiv laufen lassen;{}PROC hamster laufen lassen:{}
- programmname ermitteln;{} BOOL VAR namen eingesetzt :: FALSE;{} untersuche programmdatei auf flaechennamen;{} page;{} geschwindigkeit (5);{} cursor on;{} lauf (programmname);{} cursor off;{} IF namen eingesetzt{} THEN entferne flaechennamen aus programmdatei{} FI;{} regenerate menuscreen.{} programmname ermitteln:{} IF programmname <> niltext CAND exists (programmname){} THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI.{} frage nach diesem programm:{}
- IF menuno (ueberschrift + anwendungstext (163) + name + anwendungstext (164), 5){} THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} IF ist hamster{} THEN center (maxlaenge, invers (anwendungstext (125))) + ""13""13""{} ELSE center (maxlaenge, invers (anwendungstext (155))) + ""13""13""{} FI.{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);{}
- IF ist hamster{} THEN programmname := menuone (verfuegbare, anwendungstext (125),{} anwendungstext (166), TRUE){} ELSE programmname := menuone (verfuegbare, anwendungstext (155),{} anwendungstext (166), TRUE){} FI;{} IF programmname = niltext{} THEN LEAVE hamster laufen lassen{} FI.{} untersuche programmdatei auf flaechennamen:{} FILE VAR a :: sequential file (modify, programmname);{} TEXT VAR zeile;{}
- to line (a, 1);{} REP{} read record (a, zeile);{} zeile := compress (zeile);{} IF NOT eof (a) THEN down (a) FI{} UNTIL zeile <> "" OR eof (a) PER;{} IF pos (zeile, "landschaft") = 0 AND pos (zeile, "arbeitsfeld") = 0{} THEN ermittle flaechennamen;{} setze flaechennamen in datei ein{} FI.{} ermittle flaechennamen:{} IF flaechenname <> ""{} THEN frage nach altem flaechennamen{} ELSE lasse flaeche auswaehlen{} FI.{} frage nach altem flaechennamen:{}
- IF ist hamster{} THEN frage nach alter landschaft{} ELSE frage nach altem arbeitsfeld{} FI.{} frage nach alter landschaft:{} IF menuno (ueberschrift + anwendungstext (103){} + fname + anwendungstext (104), 5){} THEN lasse flaeche auswaehlen{} FI.{} frage nach altem arbeitsfeld:{} IF menuno (ueberschrift + anwendungstext (133){} + fname + anwendungstext (134), 5){} THEN lasse flaeche auswaehlen{} FI.{} fname:{} ""13""13" " + invers (flaechenname) + ""13""13"".{}
- lasse flaeche auswaehlen:{} verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{} IF ist hamster{} THEN flaechenname := menuone (verfuegbare, anwendungstext (125),{} anwendungstext (106), FALSE){} ELSE flaechenname := menuone (verfuegbare, anwendungstext (155),{} anwendungstext (136), FALSE){} FI;{} IF flaechenname = niltext{} THEN regenerate menuscreen;{} landschaftsfehler anzeigen;{}
- LEAVE hamster laufen lassen{} FI.{} landschaftsfehler anzeigen:{} IF ist hamster{} THEN menuinfo (anwendungstext (124)){} ELSE menuinfo (anwendungstext (154)){} FI.{} setze flaechennamen in datei ein:{} to line (a, 1);{} zeile := "landschaft (""" + flaechenname + """);";{} insert record (a);{} write record (a, zeile);{} namen eingesetzt := TRUE.{} entferne flaechennamen aus programmdatei:{} FILE VAR b :: sequential file (modify, programmname);{}
- to line (b, 1);{} REP{} read record (b, zeile);{} IF pos (zeile, "landschaft") = 0 AND pos (zeile, "arbeitsfeld") = 0{} THEN IF NOT eof (b) THEN down (b) FI{} FI{} UNTIL zeile <> "" OR eof (b) PER;{} IF pos (zeile, "landschaft") > 0 OR pos (zeile, "arbeitsfeld") > 0{} THEN delete record (b){} FI{}END PROC hamster laufen lassen;{}PROC meckere zu langen namen an:{} menuinfo (anwendungstext (191)){}END PROC meckere zu langen namen an;{}PROC meckere existierende flaeche an:{}
- IF ist hamster{} THEN menuinfo (anwendungstext (193)){} ELSE menuinfo (anwendungstext (194)){} FI{}END PROC meckere existierende flaeche an;{}PROC meckere existierendes programm an:{} menuinfo (anwendungstext (195)){}END PROC meckere existierendes programm an;{}PROC noch keine flaeche:{} IF ist hamster{} THEN menuinfo (anwendungstext (196)){} ELSE menuinfo (anwendungstext (197)){} FI{}END PROC noch keine flaeche;{}PROC noch kein programm:{} menuinfo (anwendungstext (198)){}
-END PROC noch kein programm;{}END PACKET ls herbert und robbi 3;{}
+PACKET ls herbert und robbi 3 DEFINES
+ hamsterbefehlsauskunft,
+ hamsterlaufauskunft,
+ hamsterlandschaftsauskunft,
+ hamsterlandschaft verzeichnis,
+ hamsterlandschaft neu erstellen,
+ hamsterlandschaft ansehen,
+ hamsterlandschaft drucken,
+ hamsterlandschaft kopieren,
+ hamsterlandschaft umbenennen,
+ hamsterlandschaft loeschen,
+ hamsterprogramm verzeichnis,
+ hamsterprogramm neu erstellen,
+ hamsterprogramm ansehen,
+ hamsterprogramm kopieren,
+ hamsterprogramm umbenennen,
+
+ hamsterprogramm loeschen,
+ hamsterprogramm drucken,
+ hamster laufen lassen,
+ hamsterinteraktiv laufen lassen,
+ hamster, roboter:
+LET menukarte = "ls-MENUKARTE:Herbert und Robbi",
+ praefix = "Flaeche:",
+ flaechentype = 1007,
+ niltext = "",
+ maxlaenge = 60,
+ maxnamenslaenge = 50;
+TEXT VAR flaechenname :: "",
+ programmname :: "";
+INITFLAG VAR in this task :: FALSE;
+PROC initialize hamster:
+
+ IF NOT initialized (in this task)
+ THEN flaechenname := "";
+ programmname := ""
+ FI
+END PROC initialize hamster;
+PROC hamster:
+ sei ein hamster;
+ initialize hamster;
+ install menu (menukarte);
+ handle menu ("HAMSTER")
+END PROC hamster;
+PROC roboter:
+ sei ein roboter;
+ initialize hamster;
+ install menu (menukarte);
+ handle menu ("ROBOTER");
+END PROC roboter;
+PROC hamsterlaufauskunft:
+ menuinfo (laufauskunftstext)
+END PROC hamsterlaufauskunft;
+PROC hamsterlandschaftsauskunft:
+
+ menuinfo (landschaftsauskunftstext)
+END PROC hamsterlandschaftsauskunft;
+PROC hamsterbefehlsauskunft:
+ menuinfo (befehlsauskunftstext);
+ menuinfo (testauskunftstext 1);
+ IF testauskunftstext 2 <> ""
+ THEN menuinfo (testauskunftstext 2)
+ FI
+END PROC hamsterbefehlsauskunft;
+PROC hamsterlandschaft verzeichnis:
+ THESAURUS VAR landschaften ::
+ ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);
+ forget ("Interne Thesaurusdateiliste", quiet);
+ FILE VAR f :: sequential file (output, "Interne Thesaurusdateiliste");
+
+ f FILLBY landschaften;
+ headline (f, anwendungstext (204)); modify (f);
+ to line (f, 1); insert record (f); write record (f, kenntext);
+ to line (f, 2); insert record (f);
+ to line (f, 1); menuwindowshow (f);
+ forget ("Interne Thesaurusdateiliste", quiet);
+ regenerate menuscreen.
+ kenntext:
+ IF ist hamster THEN anwendungstext (121) ELSE anwendungstext (151) FI.
+END PROC hamsterlandschaft verzeichnis;
+PROC hamsterprogramm verzeichnis:
+ THESAURUS VAR programme :: ALL myself - infix namen (ALL myself, praefix, flaechentype);
+
+ forget ("Interne Thesaurusdateiliste", quiet);
+ FILE VAR f :: sequential file (output, "Interne Thesaurusdateiliste");
+ f FILLBY programme;
+ headline (f, anwendungstext (204)); modify (f);
+ to line (f, 1); insert record (f); write record (f, anwendungstext (181));
+ to line (f, 2); insert record (f);
+ to line (f, 1); menuwindowshow (f);
+ forget ("Interne Thesaurusdateiliste", quiet);
+ regenerate menuscreen
+END PROC hamsterprogramm verzeichnis;
+PROC hamsterlandschaft neu erstellen:
+
+ hole flaechenname;
+ kontrolliere den flaechennamen;
+ kommandomodus;
+ landschaft (flaechenname);
+ regenerate menuscreen.
+ hole flaechenname:
+ IF ist hamster
+ THEN flaechenname := menuanswer (anwendungstext (101) +
+ anwendungstext (102), "", 5)
+ ELSE flaechenname := menuanswer (anwendungstext (131) +
+ anwendungstext (132), "", 5)
+ FI.
+ kontrolliere den flaechennamen:
+ IF flaechenname = niltext
+
+ THEN LEAVE hamsterlandschaft neu erstellen
+ ELIF length (flaechenname) > maxnamenslaenge
+ THEN meckere zu langen namen an;
+ flaechenname := niltext;
+ LEAVE hamsterlandschaft neu erstellen
+ ELIF exists (praefix + flaechenname)
+ THEN meckere existierende flaeche an;
+ LEAVE hamsterlandschaft neu erstellen
+ FI
+END PROC hamsterlandschaft neu erstellen;
+PROC hamsterprogramm neu erstellen:
+ hole programmname;
+ kontrolliere den programmnamen;
+
+ command dialogue (FALSE);
+ cursor on;
+ stdinfoedit (programmname);
+ cursor off;
+ command dialogue (TRUE);
+ regenerate menuscreen.
+ hole programmname:
+ programmname := menuanswer (anwendungstext (161) +
+ anwendungstext (162), "", 5).
+ kontrolliere den programmnamen:
+ IF programmname = niltext
+ THEN LEAVE hamsterprogramm neu erstellen
+ ELIF length (programmname) > maxnamenslaenge
+ THEN meckere zu langen namen an;
+ programmname := niltext;
+
+ LEAVE hamsterprogramm neu erstellen
+ ELIF exists (programmname)
+ THEN meckere existierendes programm an;
+ LEAVE hamsterprogramm neu erstellen
+ FI
+END PROC hamsterprogramm neu erstellen;
+PROC hamsterlandschaft ansehen:
+ IF flaechenname <> niltext CAND exists (praefix + flaechenname)
+ THEN frage nach dieser flaeche
+ ELSE lasse flaeche auswaehlen
+ FI;
+ kommandomodus;
+ landschaft (flaechenname);
+ regenerate menuscreen.
+ frage nach dieser flaeche:
+
+ IF menuno (ueberschrift + text 1 + name + text 2, 5)
+ THEN lasse flaeche auswaehlen
+ FI.
+ ueberschrift:
+ IF ist hamster
+ THEN center (maxlaenge, invers (anwendungstext (105))) + ""13""13""
+ ELSE center (maxlaenge, invers (anwendungstext (135))) + ""13""13""
+ FI.
+ text 1:
+ IF ist hamster THEN anwendungstext (103) ELSE anwendungstext (133) FI.
+ name:
+ ""13""13" " + invers (flaechenname) + ""13""13"".
+ text 2:
+ IF ist hamster THEN anwendungstext (104) ELSE anwendungstext (134) FI.
+
+ lasse flaeche auswaehlen:
+ THESAURUS VAR verfuegbare;
+ verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);
+ IF NOT not empty (verfuegbare)
+ THEN noch keine flaeche;
+ LEAVE hamsterlandschaft ansehen
+ ELSE biete auswahl an
+ FI.
+ biete auswahl an:
+ IF ist hamster
+ THEN flaechenname := menuone (verfuegbare, anwendungstext (105),
+ anwendungstext (106), FALSE)
+ ELSE flaechenname := menuone (verfuegbare, anwendungstext (135),
+
+ anwendungstext (136), FALSE)
+ FI;
+ IF flaechenname = niltext
+ THEN regenerate menuscreen;
+ LEAVE hamsterlandschaft ansehen
+ FI.
+END PROC hamsterlandschaft ansehen;
+PROC hamsterprogramm ansehen:
+ IF programmname <> niltext CAND exists (programmname)
+ THEN frage nach diesem programm
+ ELSE lasse programm auswaehlen
+ FI;
+ cursor on;
+ stdinfoedit (programmname);
+ cursor off;
+ regenerate menuscreen.
+ frage nach diesem programm:
+
+ IF menuno (ueberschrift + anwendungstext (163) + name
+ + anwendungstext (164), 5)
+ THEN lasse programm auswaehlen
+ FI.
+ ueberschrift:
+ center (maxlaenge, invers (anwendungstext (165))) + ""13""13"".
+ name:
+ ""13""13" " + invers (programmname) + ""13""13"".
+ lasse programm auswaehlen:
+ THESAURUS VAR verfuegbare;
+ verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);
+ IF NOT not empty (verfuegbare)
+ THEN noch kein programm;
+
+ LEAVE hamsterprogramm ansehen
+ ELSE biete auswahl an
+ FI.
+ biete auswahl an:
+ programmname := menuone (verfuegbare, anwendungstext (165),
+ anwendungstext (166), FALSE);
+ IF programmname = niltext
+ THEN regenerate menuscreen;
+ LEAVE hamsterprogramm ansehen
+ FI.
+END PROC hamsterprogramm ansehen;
+PROC hamsterlandschaft drucken:
+ lasse flaechen auswaehlen;
+ drucke flaechen;
+ regenerate menuscreen.
+ lasse flaechen auswaehlen:
+
+ THESAURUS VAR verfuegbare;
+ verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);
+ IF NOT not empty (verfuegbare)
+ THEN noch keine flaeche;
+ LEAVE hamsterlandschaft drucken
+ ELSE biete auswahl an
+ FI.
+ biete auswahl an:
+ IF ist hamster
+ THEN verfuegbare := menusome (verfuegbare, anwendungstext (107),
+ anwendungstext (108), FALSE)
+ ELSE verfuegbare := menusome (verfuegbare, anwendungstext (137),
+
+ anwendungstext (138), FALSE)
+ FI.
+ drucke flaechen:
+ show menuwindow;
+ steige ggf bei leerem thesaurus aus;
+ menuwindowout (menuwindowcenter (invers (bezeichnung)));
+ menuwindowline (2);
+ command dialogue (FALSE);
+ fuehre einzelne operationen aus;
+ command dialogue (TRUE);
+ schlage ggf neue seite auf;
+ menuwindowout (schlussbemerkung);
+ menuwindowstop.
+ bezeichnung:
+ IF ist hamster THEN anwendungstext (107) ELSE anwendungstext (137) FI.
+
+ schlussbemerkung:
+ IF ist hamster THEN anwendungstext (110) ELSE anwendungstext (140) FI.
+ fuehre einzelne operationen aus:
+ INT VAR k;
+ FOR k FROM 1 UPTO highest entry (verfuegbare) REP
+ IF name (verfuegbare, k) <> ""
+ THEN disable stop;
+ menuwindowout ( " """ + name (verfuegbare, k) + """ "
+ + anwendungstext (201));
+ menuwindowline;
+ drucke landschaft (name (verfuegbare, k));
+ fehlerbehandlung
+
+ FI
+ PER.
+ steige ggf bei leerem thesaurus aus:
+ IF NOT not empty (verfuegbare)
+ THEN menuwindowline (2);
+ IF ist hamster
+ THEN menuwindowout (anwendungstext (109))
+ ELSE menuwindowout (anwendungstext (139))
+ FI;
+ menuwindowstop;
+ regenerate menuscreen;
+ LEAVE hamsterlandschaft drucken
+ FI.
+ schlage ggf neue seite auf:
+ IF remaining menuwindowlines < 7
+ THEN menuwindowpage; menuwindowline
+
+ ELSE menuwindowline (2)
+ FI.
+ fehlerbehandlung:
+ IF is error
+ THEN regenerate menuscreen;
+ menuinfo (invers (errormessage));
+ clear error; enable stop;
+ LEAVE hamsterlandschaft drucken
+ FI.
+END PROC hamsterlandschaft drucken;
+PROC hamsterprogramm drucken:
+ lasse programme auswaehlen;
+ drucke programme;
+ regenerate menuscreen.
+ lasse programme auswaehlen:
+ THESAURUS VAR verfuegbare;
+ verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);
+
+ IF NOT not empty (verfuegbare)
+ THEN noch kein programm;
+ LEAVE hamsterprogramm drucken
+ ELSE biete auswahl an
+ FI.
+ biete auswahl an:
+ verfuegbare := menusome (verfuegbare, anwendungstext (167),
+ anwendungstext (168), FALSE).
+ drucke programme:
+ show menuwindow;
+ steige ggf bei leerem thesaurus aus;
+ menuwindowout (menuwindowcenter (invers (anwendungstext (167))));
+ menuwindowline (2);
+ command dialogue (FALSE);
+
+ fuehre einzelne operationen aus;
+ command dialogue (TRUE);
+ schlage ggf neue seite auf;
+ menuwindowout (anwendungstext (170));
+ menuwindowstop.
+ fuehre einzelne operationen aus:
+ INT VAR k;
+ FOR k FROM 1 UPTO highest entry (verfuegbare) REP
+ IF name (verfuegbare, k) <> ""
+ THEN disable stop;
+ menuwindowout ( " """ + name (verfuegbare, k) + """ "
+ + anwendungstext (201));
+ menuwindowline;
+
+ print (name (verfuegbare, k));
+ fehlerbehandlung
+ FI
+ PER.
+ steige ggf bei leerem thesaurus aus:
+ IF NOT not empty (verfuegbare)
+ THEN menuwindowline (2);
+ menuwindowout (anwendungstext (169));
+ menuwindowstop;
+ regenerate menuscreen;
+ LEAVE hamsterprogramm drucken
+ FI.
+ schlage ggf neue seite auf:
+ IF remaining menuwindowlines < 7
+ THEN menuwindowpage; menuwindowline
+ ELSE menuwindowline (2)
+
+ FI.
+ fehlerbehandlung:
+ IF is error
+ THEN regenerate menuscreen;
+ menuinfo (invers (errormessage));
+ clear error; enable stop;
+ LEAVE hamsterprogramm drucken
+ FI.
+END PROC hamsterprogramm drucken;
+PROC hamsterlandschaft kopieren:
+ ermittle alten flaechennamen;
+ erfrage neuen flaechennamen;
+ kopiere ggf die flaeche.
+ ermittle alten flaechennamen:
+ IF NOT not empty (bestand)
+ THEN noch keine flaeche;
+ LEAVE hamsterlandschaft kopieren
+
+ ELSE biete auswahl an
+ FI.
+ biete auswahl an:
+ TEXT VAR alter name := menuone ( bestand, text1, text2, TRUE);
+ IF alter name = niltext
+ THEN LEAVE hamsterlandschaft kopieren
+ FI.
+ bestand:
+ ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).
+ text1:
+ IF ist hamster THEN anwendungstext (111) ELSE anwendungstext (141) FI.
+ text2:
+ IF ist hamster THEN anwendungstext (112) ELSE anwendungstext (142) FI.
+ erfrage neuen flaechennamen:
+
+ TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
+ ausgabe:
+ ueberschrift + hinweis auf alt + bisheriger name + aufforderung.
+ ueberschrift:
+ IF ist hamster
+ THEN center (maxlaenge, invers (anwendungstext (111))) + ""13""13""
+ ELSE center (maxlaenge, invers (anwendungstext (141))) + ""13""13""
+ FI.
+ hinweis auf alt:
+ IF ist hamster THEN anwendungstext (113) ELSE anwendungstext (143) FI.
+ bisheriger name:
+ ""13""13" " + invers (alter name) + ""13""13"".
+
+ aufforderung:
+ anwendungstext (202).
+ kopiere ggf die flaeche:
+ IF neuer name = niltext
+ THEN menuinfo (invers (anwendungstext (192)));
+ LEAVE hamsterlandschaft kopieren
+ ELIF exists (praefix + neuer name)
+ THEN mache vorwurf;
+ LEAVE hamsterlandschaft kopieren
+ ELSE copy (praefix + alter name, praefix + neuer name)
+ FI.
+ mache vorwurf:
+ IF ist hamster
+ THEN menuinfo (anwendungstext (193))
+ ELSE menuinfo (anwendungstext (194))
+
+ FI.
+END PROC hamsterlandschaft kopieren;
+PROC hamsterprogramm kopieren:
+ ermittle alten programmnamen;
+ erfrage neuen programmnamen;
+ kopiere ggf das programm.
+ ermittle alten programmnamen:
+ IF NOT not empty (bestand)
+ THEN noch kein programm;
+ LEAVE hamsterprogramm kopieren
+ ELSE biete auswahl an
+ FI.
+ biete auswahl an:
+ TEXT VAR alter name := menuone ( bestand, anwendungstext (171),
+ anwendungstext (172), TRUE);
+
+ IF alter name = niltext
+ THEN LEAVE hamsterprogramm kopieren
+ FI.
+ bestand:
+ ALL myself - infix namen (ALL myself, praefix, flaechentype).
+ erfrage neuen programmnamen:
+ TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
+ ausgabe:
+ ueberschrift + anwendungstext (173) + bisheriger name
+ + anwendungstext (202).
+ ueberschrift:
+ center (maxlaenge, invers (anwendungstext (171))) + ""13""13"".
+ bisheriger name:
+ ""13""13" " + invers (alter name) + ""13""13"".
+
+ kopiere ggf das programm:
+ IF neuer name = niltext
+ THEN menuinfo (invers (anwendungstext (192)));
+ LEAVE hamsterprogramm kopieren
+ ELIF exists (neuer name)
+ THEN mache vorwurf;
+ LEAVE hamsterprogramm kopieren
+ ELSE copy (alter name, neuer name)
+ FI.
+ mache vorwurf:
+ menuinfo (anwendungstext (195)).
+END PROC hamsterprogramm kopieren;
+PROC hamsterlandschaft umbenennen:
+ ermittle alten flaechennamen;
+ erfrage neuen flaechennamen;
+
+ benenne ggf die flaeche um.
+ ermittle alten flaechennamen:
+ IF NOT not empty (bestand)
+ THEN noch keine flaeche;
+ LEAVE hamsterlandschaft umbenennen
+ ELSE biete auswahl an
+ FI.
+ biete auswahl an:
+ TEXT VAR alter name := menuone ( bestand, text1, text2, TRUE);
+ IF alter name = niltext
+ THEN LEAVE hamsterlandschaft umbenennen
+ FI.
+ bestand:
+ ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).
+ text1:
+ IF ist hamster THEN anwendungstext (114) ELSE anwendungstext (144) FI.
+
+ text2:
+ IF ist hamster THEN anwendungstext (115) ELSE anwendungstext (145) FI.
+ erfrage neuen flaechennamen:
+ TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
+ ausgabe:
+ ueberschrift + hinweis auf alt + bisheriger name + aufforderung.
+ ueberschrift:
+ IF ist hamster
+ THEN center (maxlaenge, invers (anwendungstext (114))) + ""13""13""
+ ELSE center (maxlaenge, invers (anwendungstext (144))) + ""13""13""
+ FI.
+ hinweis auf alt:
+ IF ist hamster THEN anwendungstext (116) ELSE anwendungstext (146) FI.
+
+ bisheriger name:
+ ""13""13" " + invers (alter name) + ""13""13"".
+ aufforderung:
+ IF ist hamster THEN anwendungstext (117) ELSE anwendungstext (147) FI.
+ benenne ggf die flaeche um:
+ IF neuer name = niltext
+ THEN menuinfo (invers (anwendungstext (192)));
+ LEAVE hamsterlandschaft umbenennen
+ ELIF exists (praefix + neuer name)
+ THEN mache vorwurf;
+ LEAVE hamsterlandschaft umbenennen
+ ELSE rename (praefix + alter name, praefix + neuer name);
+
+ flaechenname := neuer name
+ FI.
+ mache vorwurf:
+ IF ist hamster
+ THEN menuinfo (anwendungstext (193))
+ ELSE menuinfo (anwendungstext (194))
+ FI.
+END PROC hamsterlandschaft umbenennen;
+PROC hamsterprogramm umbenennen:
+ ermittle alten programmnamen;
+ erfrage neuen programmnamen;
+ benenne ggf das programm um.
+ ermittle alten programmnamen:
+ IF NOT not empty (bestand)
+ THEN noch kein programm;
+ LEAVE hamsterprogramm umbenennen
+ ELSE biete auswahl an
+
+ FI.
+ biete auswahl an:
+ TEXT VAR alter name := menuone ( bestand, anwendungstext (174),
+ anwendungstext (175), TRUE);
+ IF alter name = niltext
+ THEN LEAVE hamsterprogramm umbenennen
+ FI.
+ bestand:
+ ALL myself - infix namen (ALL myself, praefix, flaechentype).
+ erfrage neuen programmnamen:
+ TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
+ ausgabe:
+ ueberschrift + anwendungstext (176) + bisheriger name
+ + anwendungstext (177).
+
+ ueberschrift:
+ center (maxlaenge, invers (anwendungstext (174))) + ""13""13"".
+ bisheriger name:
+ ""13""13" " + invers (alter name) + ""13""13"".
+ benenne ggf das programm um:
+ IF neuer name = niltext
+ THEN menuinfo (invers (anwendungstext (192)));
+ LEAVE hamsterprogramm umbenennen
+ ELIF exists (neuer name)
+ THEN mache vorwurf;
+ LEAVE hamsterprogramm umbenennen
+ ELSE rename (alter name, neuer name);
+ programmname := neuer name
+
+ FI.
+ mache vorwurf:
+ menuinfo (anwendungstext (195)).
+END PROC hamsterprogramm umbenennen;
+PROC hamsterlandschaft loeschen:
+ lasse flaechen auswaehlen;
+ loesche flaechen;
+ regenerate menuscreen.
+ lasse flaechen auswaehlen:
+ THESAURUS VAR verfuegbare;
+ verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);
+ IF NOT not empty (verfuegbare)
+ THEN noch keine flaeche;
+ LEAVE hamsterlandschaft loeschen
+ ELSE biete auswahl an
+
+ FI.
+ biete auswahl an:
+ IF ist hamster
+ THEN verfuegbare := menusome (verfuegbare, anwendungstext (118),
+ anwendungstext (119), FALSE)
+ ELSE verfuegbare := menusome (verfuegbare, anwendungstext (148),
+ anwendungstext (149), FALSE)
+ FI.
+ loesche flaechen:
+ show menuwindow;
+ steige ggf bei leerem thesaurus aus;
+ menuwindowout (menuwindowcenter (invers (bezeichnung)));
+ menuwindowline (2);
+
+ command dialogue (FALSE);
+ fuehre einzelne operationen aus;
+ command dialogue (TRUE);
+ schlage ggf neue seite auf;
+ menuwindowout (schlussbemerkung);
+ menuwindowstop.
+ bezeichnung:
+ IF ist hamster THEN anwendungstext (118) ELSE anwendungstext (148) FI.
+ schlussbemerkung:
+ IF ist hamster THEN anwendungstext (120) ELSE anwendungstext (150) FI.
+ fuehre einzelne operationen aus:
+ INT VAR k;
+ FOR k FROM 1 UPTO highest entry (verfuegbare) REP
+ IF name (verfuegbare, k) <> ""
+
+ THEN disable stop;
+ IF menuwindowyes (" """ + name (verfuegbare, k) + """ "
+ + anwendungstext (203))
+ THEN forget (praefix + name (verfuegbare, k), quiet)
+ FI;
+ fehlerbehandlung
+ FI
+ PER;
+ flaechenname := "".
+ steige ggf bei leerem thesaurus aus:
+ IF NOT not empty (verfuegbare)
+ THEN menuwindowline (2);
+ IF ist hamster
+ THEN menuwindowout (anwendungstext (109))
+
+ ELSE menuwindowout (anwendungstext (139))
+ FI;
+ menuwindowstop;
+ regenerate menuscreen;
+ LEAVE hamsterlandschaft loeschen
+ FI.
+ schlage ggf neue seite auf:
+ IF remaining menuwindowlines < 7
+ THEN menuwindowpage; menuwindowline
+ ELSE menuwindowline (2)
+ FI.
+ fehlerbehandlung:
+ IF is error
+ THEN regenerate menuscreen;
+ menuinfo (invers (errormessage));
+ clear error; enable stop;
+
+ LEAVE hamsterlandschaft loeschen
+ FI.
+END PROC hamsterlandschaft loeschen;
+PROC hamsterprogramm loeschen:
+ lasse programme auswaehlen;
+ loesche programme;
+ regenerate menuscreen.
+ lasse programme auswaehlen:
+ THESAURUS VAR verfuegbare;
+ verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);
+ IF NOT not empty (verfuegbare)
+ THEN noch kein programm;
+ LEAVE hamsterprogramm loeschen
+ ELSE biete auswahl an
+ FI.
+
+ biete auswahl an:
+ verfuegbare := menusome (verfuegbare, anwendungstext (178),
+ anwendungstext (179), FALSE).
+ loesche programme:
+ show menuwindow;
+ steige ggf bei leerem thesaurus aus;
+ menuwindowout (menuwindowcenter (invers (anwendungstext (178))));
+ menuwindowline (2);
+ command dialogue (FALSE);
+ fuehre einzelne operationen aus;
+ command dialogue (TRUE);
+ schlage ggf neue seite auf;
+ menuwindowout (anwendungstext (180));
+
+ menuwindowstop.
+ fuehre einzelne operationen aus:
+ INT VAR k;
+ FOR k FROM 1 UPTO highest entry (verfuegbare) REP
+ IF name (verfuegbare, k) <> ""
+ THEN disable stop;
+ IF menuwindowyes (" """ + name (verfuegbare, k) + """ "
+ + anwendungstext (203))
+ THEN forget (name (verfuegbare, k), quiet)
+ FI;
+ fehlerbehandlung
+ FI
+ PER;
+ programmname := "".
+ steige ggf bei leerem thesaurus aus:
+
+ IF NOT not empty (verfuegbare)
+ THEN menuwindowline (2);
+ menuwindowout (anwendungstext (169));
+ menuwindowstop;
+ regenerate menuscreen;
+ LEAVE hamsterprogramm loeschen
+ FI.
+ schlage ggf neue seite auf:
+ IF remaining menuwindowlines < 7
+ THEN menuwindowpage; menuwindowline
+ ELSE menuwindowline (2)
+ FI.
+ fehlerbehandlung:
+ IF is error
+ THEN regenerate menuscreen;
+ menuinfo (invers (errormessage));
+
+ clear error; enable stop;
+ LEAVE hamsterprogramm loeschen
+ FI.
+END PROC hamsterprogramm loeschen;
+PROC hamsterinteraktiv laufen lassen:
+ frage nach neuer flaeche;
+ cursor on;
+ IF ist hamster
+ THEN hamsterinter (flaechenname)
+ ELSE roboterinter (flaechenname)
+ FI;
+ programmname := "PROTOKOLL";
+ cursor off;
+ regenerate menuscreen.
+ frage nach neuer flaeche:
+ IF menuyes (ueberschrift + fragetext, 5)
+ THEN lasse flaeche auswaehlen
+ ELSE weise auf landschaftsgestaltung hin;
+
+ LEAVE hamsterinteraktiv laufen lassen
+ FI.
+ ueberschrift:
+ IF ist hamster
+ THEN center (laenge, invers (anwendungstext (122))) + ""13""13""
+ ELSE center (laenge, invers (anwendungstext (152))) + ""13""13""
+ FI.
+ fragetext:
+ IF ist hamster
+ THEN center (laenge, anwendungstext (123))
+ ELSE center (laenge, anwendungstext (153))
+ FI.
+ laenge:
+ IF ist hamster
+ THEN max (length (anwendungstext (122)),
+ length (anwendungstext (123))) + 5
+
+ ELSE max (length (anwendungstext (152)),
+ length (anwendungstext (153))) + 5
+ FI.
+ lasse flaeche auswaehlen:
+ THESAURUS VAR verfuegbare;
+ verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);
+ IF ist hamster
+ THEN flaechenname := menuone (verfuegbare, anwendungstext (122),
+ anwendungstext (106), FALSE)
+ ELSE flaechenname := menuone (verfuegbare, anwendungstext (152),
+ anwendungstext (136), FALSE)
+
+ FI;
+ IF flaechenname = niltext
+ THEN weise auf landschaftsgestaltung hin;
+ regenerate menuscreen;
+ LEAVE hamsterinteraktiv laufen lassen
+ FI.
+ weise auf landschaftsgestaltung hin:
+ WINDOW VAR mfenster := current menuwindow;
+ IF ist hamster
+ THEN boxinfo (mfenster, anwendungstext (124), 5, maxint)
+ ELSE boxinfo (mfenster, anwendungstext (154), 5, maxint)
+ FI.
+END PROC hamsterinteraktiv laufen lassen;
+PROC hamster laufen lassen:
+
+ programmname ermitteln;
+ BOOL VAR namen eingesetzt :: FALSE;
+ untersuche programmdatei auf flaechennamen;
+ page;
+ geschwindigkeit (5);
+ cursor on;
+ lauf (programmname);
+ cursor off;
+ IF namen eingesetzt
+ THEN entferne flaechennamen aus programmdatei
+ FI;
+ regenerate menuscreen.
+ programmname ermitteln:
+ IF programmname <> niltext CAND exists (programmname)
+ THEN frage nach diesem programm
+ ELSE lasse programm auswaehlen
+ FI.
+ frage nach diesem programm:
+
+ IF menuno (ueberschrift + anwendungstext (163) + name + anwendungstext (164), 5)
+ THEN lasse programm auswaehlen
+ FI.
+ ueberschrift:
+ IF ist hamster
+ THEN center (maxlaenge, invers (anwendungstext (125))) + ""13""13""
+ ELSE center (maxlaenge, invers (anwendungstext (155))) + ""13""13""
+ FI.
+ name:
+ ""13""13" " + invers (programmname) + ""13""13"".
+ lasse programm auswaehlen:
+ THESAURUS VAR verfuegbare;
+ verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);
+
+ IF ist hamster
+ THEN programmname := menuone (verfuegbare, anwendungstext (125),
+ anwendungstext (166), TRUE)
+ ELSE programmname := menuone (verfuegbare, anwendungstext (155),
+ anwendungstext (166), TRUE)
+ FI;
+ IF programmname = niltext
+ THEN LEAVE hamster laufen lassen
+ FI.
+ untersuche programmdatei auf flaechennamen:
+ FILE VAR a :: sequential file (modify, programmname);
+ TEXT VAR zeile;
+
+ to line (a, 1);
+ REP
+ read record (a, zeile);
+ zeile := compress (zeile);
+ IF NOT eof (a) THEN down (a) FI
+ UNTIL zeile <> "" OR eof (a) PER;
+ IF pos (zeile, "landschaft") = 0 AND pos (zeile, "arbeitsfeld") = 0
+ THEN ermittle flaechennamen;
+ setze flaechennamen in datei ein
+ FI.
+ ermittle flaechennamen:
+ IF flaechenname <> ""
+ THEN frage nach altem flaechennamen
+ ELSE lasse flaeche auswaehlen
+ FI.
+ frage nach altem flaechennamen:
+
+ IF ist hamster
+ THEN frage nach alter landschaft
+ ELSE frage nach altem arbeitsfeld
+ FI.
+ frage nach alter landschaft:
+ IF menuno (ueberschrift + anwendungstext (103)
+ + fname + anwendungstext (104), 5)
+ THEN lasse flaeche auswaehlen
+ FI.
+ frage nach altem arbeitsfeld:
+ IF menuno (ueberschrift + anwendungstext (133)
+ + fname + anwendungstext (134), 5)
+ THEN lasse flaeche auswaehlen
+ FI.
+ fname:
+ ""13""13" " + invers (flaechenname) + ""13""13"".
+
+ lasse flaeche auswaehlen:
+ verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);
+ IF ist hamster
+ THEN flaechenname := menuone (verfuegbare, anwendungstext (125),
+ anwendungstext (106), FALSE)
+ ELSE flaechenname := menuone (verfuegbare, anwendungstext (155),
+ anwendungstext (136), FALSE)
+ FI;
+ IF flaechenname = niltext
+ THEN regenerate menuscreen;
+ landschaftsfehler anzeigen;
+
+ LEAVE hamster laufen lassen
+ FI.
+ landschaftsfehler anzeigen:
+ IF ist hamster
+ THEN menuinfo (anwendungstext (124))
+ ELSE menuinfo (anwendungstext (154))
+ FI.
+ setze flaechennamen in datei ein:
+ to line (a, 1);
+ zeile := "landschaft (""" + flaechenname + """);";
+ insert record (a);
+ write record (a, zeile);
+ namen eingesetzt := TRUE.
+ entferne flaechennamen aus programmdatei:
+ FILE VAR b :: sequential file (modify, programmname);
+
+ to line (b, 1);
+ REP
+ read record (b, zeile);
+ IF pos (zeile, "landschaft") = 0 AND pos (zeile, "arbeitsfeld") = 0
+ THEN IF NOT eof (b) THEN down (b) FI
+ FI
+ UNTIL zeile <> "" OR eof (b) PER;
+ IF pos (zeile, "landschaft") > 0 OR pos (zeile, "arbeitsfeld") > 0
+ THEN delete record (b)
+ FI
+END PROC hamster laufen lassen;
+PROC meckere zu langen namen an:
+ menuinfo (anwendungstext (191))
+END PROC meckere zu langen namen an;
+PROC meckere existierende flaeche an:
+
+ IF ist hamster
+ THEN menuinfo (anwendungstext (193))
+ ELSE menuinfo (anwendungstext (194))
+ FI
+END PROC meckere existierende flaeche an;
+PROC meckere existierendes programm an:
+ menuinfo (anwendungstext (195))
+END PROC meckere existierendes programm an;
+PROC noch keine flaeche:
+ IF ist hamster
+ THEN menuinfo (anwendungstext (196))
+ ELSE menuinfo (anwendungstext (197))
+ FI
+END PROC noch keine flaeche;
+PROC noch kein programm:
+ menuinfo (anwendungstext (198))
+
+END PROC noch kein programm;
+END PACKET ls herbert und robbi 3;
+
diff --git a/hamster/ls-Herbert und Robbi-gen b/hamster/ls-Herbert und Robbi-gen
index ae21ddb..6104fe3 100644
--- a/hamster/ls-Herbert und Robbi-gen
+++ b/hamster/ls-Herbert und Robbi-gen
@@ -22,12 +22,121 @@
*)
-LET mm taskname = "ls-MENUKARTEN",{} datei1 = "ls-Herbert und Robbi 1",{} datei2 = "ls-Herbert und Robbi 2",{} datei3 = "ls-Herbert und Robbi 3",{} menukarte = "ls-MENUKARTE:Herbert und Robbi";{}PROC stelle existenz des mm sicher:{} cursor (1, 5); out (""4"");{} IF NOT exists (task (mm taskname)){} THEN errorstop ("Unbedingt erst den 'MENUKARTEN MANAGER' generieren!");{} FI{}END PROC stelle existenz des mm sicher;{}PROC vom archiv (TEXT CONST datei):{} cursor (1,5); out (""4"");{}
- out (" """); out (datei); putline (""" wird geholt.");{} fetch (datei, archive){}END PROC vom archiv;{}PROC hole (TEXT CONST datei):{} IF NOT exists (datei) THEN vom archiv (datei) FI{}END PROC hole;{}PROC in (TEXT CONST datei):{} hole (datei);{} cursor (1, 5); out (""4"");{} out (" """); out (datei); out (""" wird übersetzt: ");{} insert (datei);{} forget (datei, quiet);{}END PROC in;{}PROC schicke (TEXT CONST datei):{} cursor (1, 5); out (""4"");{} out (" """); out(datei);{} out (""" wird zum MENUKARTEN-MANAGER geschickt!");{}
- command dialogue (FALSE);{} save (datei, task (mm taskname));{} command dialogue (TRUE);{} forget (datei, quiet){}END PROC schicke;{}INT VAR size, used;{}BOOL VAR einzeln, mit erweiterung :: FALSE;{}storage (size, used);{}einzeln := size - used < 500;{}forget ("ls-Herbert und Robbi/gen", quiet);{}wirf kopfzeile aus;{}stelle existenz des mm sicher;{}hole die dateien;{}insertiere die dateien;{}mache global manager aus der task.{}wirf kopfzeile aus:{} page;{} putline (" "15"ls-Herbert und Robbi - Automatische Generierung "14"");{}
- line (2);{} putline (" Bitte beantworten Sie noch die folgende Frage:");{} line;{} put(" Sollen neben den 'Standardtests' auch die folgenden 'Tests':");{} line (2);{} putline(" Für den Hamster: Für den Roboter:");{} putline(" links frei links frei");{} putline(" rechts frei rechts frei");{} putline(" hinten frei hinten frei");{} putline(" korn vorn werkstueck vorn");{}
- putline(" korn links werkstueck links");{} putline(" korn rechts werkstueck rechts");{} putline(" korn hinten werkstueck hinten");{} line;{} IF yes(" zur Verfügung gestellt werden"){} THEN mit erweiterung := TRUE{} FI.{}hole die dateien:{} IF NOT exists (datei 1){} COR NOT exists (datei 3){} COR NOT exists (menukarte){} THEN hole dateien vom archiv; LEAVE hole die dateien{}
- FI;{} IF mit erweiterung AND NOT exists (datei 2){} THEN hole dateien vom archiv{} FI.{}hole dateien vom archiv:{} cursor (1,3); out (""4"");{} IF yes ("Ist das Archiv angemeldet und die Diskette eingelegt"){} THEN lese ein{} ELSE line (2);{} errorstop ("Ohne die Diskette kann ich das System nicht generieren!"){} FI.{}lese ein:{} cursor (1, 3); out (""4"");{} out (" "15"Bitte die Diskette eingelegt lassen! "14"");{} IF NOT einzeln{} THEN hole (datei 1);{}
- hole (datei 3);{} hole (menukarte);{} IF mit erweiterung{} THEN hole (datei 2){} FI;{} cursor (1, 3); out(""4"");{} out (" "15"Die Diskette wird nicht mehr benötigt! "14"");{} release (archive){} FI.{}insertiere die dateien:{} check off;{} cursor (1, 3); out(""4"");{} out (" "15"Die Diskette wird nicht mehr benötigt! "14"");{} in (datei 1);{} IF mit erweiterung{} THEN in (datei 2){}
- FI;{} in (datei 3);{} schicke (menukarte);{} IF einzeln THEN release (archive) FI;{} check on.{}mache global manager aus der task:{} global manager.{}
+LET mm taskname = "ls-MENUKARTEN",
+ datei1 = "ls-Herbert und Robbi 1",
+ datei2 = "ls-Herbert und Robbi 2",
+ datei3 = "ls-Herbert und Robbi 3",
+ menukarte = "ls-MENUKARTE:Herbert und Robbi";
+PROC stelle existenz des mm sicher:
+ cursor (1, 5); out (""4"");
+ IF NOT exists (task (mm taskname))
+ THEN errorstop ("Unbedingt erst den 'MENUKARTEN MANAGER' generieren!");
+ FI
+END PROC stelle existenz des mm sicher;
+PROC vom archiv (TEXT CONST datei):
+ cursor (1,5); out (""4"");
+
+ out (" """); out (datei); putline (""" wird geholt.");
+ fetch (datei, archive)
+END PROC vom archiv;
+PROC hole (TEXT CONST datei):
+ IF NOT exists (datei) THEN vom archiv (datei) FI
+END PROC hole;
+PROC in (TEXT CONST datei):
+ hole (datei);
+ cursor (1, 5); out (""4"");
+ out (" """); out (datei); out (""" wird übersetzt: ");
+ insert (datei);
+ forget (datei, quiet);
+END PROC in;
+PROC schicke (TEXT CONST datei):
+ cursor (1, 5); out (""4"");
+ out (" """); out(datei);
+ out (""" wird zum MENUKARTEN-MANAGER geschickt!");
+
+ command dialogue (FALSE);
+ save (datei, task (mm taskname));
+ command dialogue (TRUE);
+ forget (datei, quiet)
+END PROC schicke;
+INT VAR size, used;
+BOOL VAR einzeln, mit erweiterung :: FALSE;
+storage (size, used);
+einzeln := size - used < 500;
+forget ("ls-Herbert und Robbi/gen", quiet);
+wirf kopfzeile aus;
+stelle existenz des mm sicher;
+hole die dateien;
+insertiere die dateien;
+mache global manager aus der task.
+wirf kopfzeile aus:
+ page;
+ putline (" "15"ls-Herbert und Robbi - Automatische Generierung "14"");
+
+ line (2);
+ putline (" Bitte beantworten Sie noch die folgende Frage:");
+ line;
+ put(" Sollen neben den 'Standardtests' auch die folgenden 'Tests':");
+ line (2);
+ putline(" Für den Hamster: Für den Roboter:");
+ putline(" links frei links frei");
+ putline(" rechts frei rechts frei");
+ putline(" hinten frei hinten frei");
+ putline(" korn vorn werkstueck vorn");
+
+ putline(" korn links werkstueck links");
+ putline(" korn rechts werkstueck rechts");
+ putline(" korn hinten werkstueck hinten");
+ line;
+ IF yes(" zur Verfügung gestellt werden")
+ THEN mit erweiterung := TRUE
+ FI.
+hole die dateien:
+ IF NOT exists (datei 1)
+ COR NOT exists (datei 3)
+ COR NOT exists (menukarte)
+ THEN hole dateien vom archiv; LEAVE hole die dateien
+
+ FI;
+ IF mit erweiterung AND NOT exists (datei 2)
+ THEN hole dateien vom archiv
+ FI.
+hole dateien vom archiv:
+ cursor (1,3); out (""4"");
+ IF yes ("Ist das Archiv angemeldet und die Diskette eingelegt")
+ THEN lese ein
+ ELSE line (2);
+ errorstop ("Ohne die Diskette kann ich das System nicht generieren!")
+ FI.
+lese ein:
+ cursor (1, 3); out (""4"");
+ out (" "15"Bitte die Diskette eingelegt lassen! "14"");
+ IF NOT einzeln
+ THEN hole (datei 1);
+
+ hole (datei 3);
+ hole (menukarte);
+ IF mit erweiterung
+ THEN hole (datei 2)
+ FI;
+ cursor (1, 3); out(""4"");
+ out (" "15"Die Diskette wird nicht mehr benötigt! "14"");
+ release (archive)
+ FI.
+insertiere die dateien:
+ check off;
+ cursor (1, 3); out(""4"");
+ out (" "15"Die Diskette wird nicht mehr benötigt! "14"");
+ in (datei 1);
+ IF mit erweiterung
+ THEN in (datei 2)
+
+ FI;
+ in (datei 3);
+ schicke (menukarte);
+ IF einzeln THEN release (archive) FI;
+ check on.
+mache global manager aus der task:
+ global manager.
+
diff --git a/menugenerator/ls-Menu-Generator 1 b/menugenerator/ls-Menu-Generator 1
index b9dfd73..4dea777 100644
--- a/menugenerator/ls-Menu-Generator 1
+++ b/menugenerator/ls-Menu-Generator 1
@@ -22,26 +22,355 @@
*)
-PACKET ls menu generator 1 DEFINES{} textprozedur,{} textzeile:{}LET maxzeilenzahl = 14,{} maxzeichenzahl = 65,{} zentrierkennung = "%",{} beginmarkkennung = "$",{} endmarkkennung = "&",{} unblockkennung = "�",{} blank = " ",{} dateikennung = ".a";{}LET dateieintrag = "#type (""10"")##limit (16.5)#",{} stdfonttabelle = "fonttab.ls-Menu-Generator";{}ROW 3 TEXT CONST fehlermeldung :: ROW 3 TEXT : ({}"existiert nicht!",{}
-""15"Text ist zu lang - bitte kürzen! "14"",{}""15"Zeilenformatierung mit <ESC> abgebrochen! "14""{});{}ROW 6 TEXT CONST hinweis :: ROW 6 TEXT : ({}"Bitte warten ...",{}"Zulässige Zeilenzahl: ",{}"Tatsächliche Zeilenzahl: ",{}"Textlänge ist in Ordnung!",{}"Textprozedur ist erstellt!",{}"Textzeile ist erstellt!"{});{}PROC textprozedur (TEXT CONST dateiname, prozedurname):{} BOOL VAR mit fehler;{} formatiere (dateiname, mit fehler);{} IF mit fehler{} THEN errorstop (fehlermeldung [3]){} FI;{}
- bereite den text auf (dateiname);{} erzeuge textprozedur (dateiname, prozedurname);{} out (""7""); out (hinweis [5]);{} last param (dateiname + dateikennung){}END PROC textprozedur;{}PROC textzeile (TEXT CONST dateiname):{} BOOL VAR mit fehler;{} formatiere (dateiname, mit fehler);{} IF mit fehler{} THEN errorstop (fehlermeldung [3]){} FI;{} bereite den text auf (dateiname);{} erzeuge textzeile (dateiname);{} out (""7""); out (hinweis [6]);{} last param (dateiname + dateikennung){}
-END PROC textzeile;{}PROC gib wartehinweis:{} page;{} out (hinweis [1]){}END PROC gib wartehinweis;{}PROC formatiere (TEXT CONST dateiname, BOOL VAR mit fehler):{} TEXT VAR fonttabelle, zeileninhalt;{} kontrolliere existenz;{} stelle fonttabelle ein;{} schreibe font in die datei;{} zeilenformatierung;{} entferne ggf font aus der datei;{} stelle fonttabelle zurueck;{} streiche restleerzeilen weg;{} untersuche ggf datei auf korrektheit.{} kontrolliere existenz:{} IF NOT exists (dateiname){}
- THEN page; errorstop ("'" + dateiname + "' " + fehlermeldung [1]){} FI.{} stelle fonttabelle ein:{} gib wartehinweis;{} fonttabelle := fonttable;{} fonttable (stdfonttabelle).{} schreibe font in die datei:{} FILE VAR datei :: sequential file (modify, dateiname);{} to line (datei, 1);{} insert record (datei);{} write record (datei, dateieintrag + blank).{} zeilenformatierung:{} disable stop;{} lineform (dateiname);{} IF is error{} THEN clear error;{}
- mit fehler := TRUE{} ELSE mit fehler := FALSE{} FI;{} enable stop.{} entferne ggf font aus der datei:{} to line (datei, 1);{} read record (datei, zeileninhalt);{} IF pos (zeileninhalt, dateieintrag) > 0{} THEN delete record (datei){} FI.{} stelle fonttabelle zurueck:{} fonttable (fonttabelle).{} streiche restleerzeilen weg:{} REP{} streiche ggf letzte zeile{} UNTIL zeile ist nicht leer PER.{} streiche ggf letzte zeile:{} to line (datei, lines (datei));{}
- read record (datei, zeileninhalt);{} IF compress (zeileninhalt) = ""{} THEN delete record (datei){} FI.{} zeile ist nicht leer:{} compress (zeileninhalt) <> "".{} untersuche ggf datei auf korrektheit:{} IF NOT mit fehler{} THEN untersuche zeilenzahl{} FI.{} untersuche zeilenzahl:{} IF lines (datei) > maxzeilenzahl{} THEN page;{} out (hinweis [2] + text (maxzeilenzahl)); line;{} out (hinweis [3] + text (lines (datei))); line (2);{} errorstop (fehlermeldung [2]){}
- ELSE page;{} out (hinweis [4]){} FI.{}END PROC formatiere;{}PROC bereite den text auf (TEXT CONST dateiname):{} INT VAR zaehler;{} TEXT VAR zeileninhalt;{} FILE VAR f :: sequential file (modify, dateiname);{} gib wartehinweis;{} vernichte ggf aufbereitete datei;{} richte datei neu ein;{} uebertrage die zeilen.{} vernichte ggf aufbereitete datei:{} IF exists (dateiname + dateikennung){} THEN forget (dateiname + dateikennung, quiet){} FI.{} richte datei neu ein:{}
- FILE VAR aus :: sequential file (output, dateiname + dateikennung).{} uebertrage die zeilen:{} FOR zaehler FROM 1 UPTO lines (f) REP{} bereite eine zeile auf{} PER.{} bereite eine zeile auf:{} to line (f, zaehler);{} read record (f, zeileninhalt);{} ersetze alle gaensefuesschen;{} haenge ggf absatzmarke an;{} behandle zeile;{} putline (aus, zeileninhalt).{} ersetze alle gaensefuesschen:{} change all (zeileninhalt, """", "'").{} haenge ggf absatzmarke an:{} IF (zeileninhalt SUB (length (zeileninhalt))) = blank{}
- THEN IF (zeileninhalt SUB 1) <> zentrierkennung{} THEN zeileninhalt CAT unblockkennung{} FI{} FI.{} behandle zeile:{} IF zeile soll zentriert werden{} THEN zentriere zeile{} ELIF zeile ist leerzeile{} THEN kennzeichne leerzeile{} ELSE blocke zeile auf stdlaenge{} FI.{} zeile soll zentriert werden:{} (zeileninhalt SUB 1) = zentrierkennung.{} zeile ist leerzeile:{} compress (zeileninhalt) = "".{} zentriere zeile:{} zeileninhalt := subtext (zeileninhalt, 2);{}
- zeileninhalt := anfangsblanks + zeileninhalt;{} zeilenabschluss.{} anfangsblanks:{} ((maxzeichenzahl - length (zeileninhalt)) DIV 2) * blank.{} zeilenabschluss:{} ersetze markierungszeichen;{} setze 13.{} ersetze markierungszeichen:{} change all (zeileninhalt, beginmarkkennung, """15""");{} change all (zeileninhalt, endmarkkennung, """14""").{} setze 13:{} zeileninhalt CAT " ""13""".{} kennzeichne leerzeile:{} zeileninhalt := """13""".{} blocke zeile auf stdlaenge:{}
- IF zeile darf nicht geblockt werden{} THEN ersetze endezeichen{} ELSE fuehre blockung aus{} FI.{} zeile darf nicht geblockt werden:{} (zeileninhalt SUB length (zeileninhalt)) = unblockkennung.{} ersetze endezeichen:{} zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 1);{} ersetze markierungszeichen;{} setze 13.{} fuehre blockung aus:{} ROW maxzeichenzahl INT VAR leerzeichen;{} INT VAR gezaehlte blanks, zu verteilende blanks;{} ordne anfangswerte zu;{}
- verteile blanks gleichmaessig;{} verteile blanks zufaellig;{} baue zeile zusammen;{} ersetze markierungszeichen;{} setze 13.{} ordne anfangswerte zu:{} bestimme blankanzahl in der zeile;{} bestimme zu verteilende blanks;{} initialisiere die reihung.{} bestimme blankanzahl in der zeile:{} gezaehlte blanks := 0;{} INT VAR zeiger;{} FOR zeiger FROM 1 UPTO length (zeileninhalt) REP{} IF (zeileninhalt SUB zeiger) = blank{} THEN gezaehlte blanks INCR 1{}
- FI{} PER.{} bestimme zu verteilende blanks:{} zu verteilende blanks := maxzeichenzahl - length (zeileninhalt).{} initialisiere die reihung:{} FOR zeiger FROM 1 UPTO gezaehlte blanks REP{} leerzeichen [zeiger] := 1{} PER.{} verteile blanks gleichmaessig:{} WHILE (zu verteilende blanks DIV gezaehlte blanks) > 0 REP{} schlag je ein blank auf;{} zu verteilende blanks DECR gezaehlte blanks{} PER.{} schlag je ein blank auf:{} FOR zeiger FROM 1 UPTO gezaehlte blanks REP{}
- leerzeichen [zeiger] INCR 1{} PER.{} verteile blanks zufaellig:{} FOR zeiger FROM 1 UPTO zu verteilende blanks REP{} leerzeichen [random (1, gezaehlte blanks)] INCR 1{} PER.{} baue zeile zusammen:{} TEXT VAR zwischen := zeileninhalt;{} INT VAR aktuelles blank := 0;{} zeileninhalt := "";{} FOR zeiger FROM 1 UPTO length (zwischen) REP{} TEXT VAR aktuelles zeichen :: (zwischen SUB zeiger);{} IF aktuelles zeichen = blank{} THEN aktuelles blank INCR 1;{}
- zeileninhalt CAT (leerzeichen [aktuelles blank] * blank){} ELSE zeileninhalt CAT aktuelles zeichen{} FI{} PER{}END PROC bereite den text auf;{}PROC erzeuge textprozedur (TEXT CONST dateiname, prozedurname):{} mache aus den zeilen einzeltexte;{} entferne ueberfluessige restzeilen;{} erstelle eine textprozedur.{} mache aus den zeilen einzeltexte:{} INT VAR zeiger;{} FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);{} FOR zeiger FROM 1 UPTO lines (ausdatei) REP{}
- bearbeite eine zeile{} PER.{} bearbeite eine zeile:{} TEXT VAR zeileninhalt;{} to line (ausdatei, zeiger);{} read record (ausdatei, zeileninhalt);{} zeileninhalt := """ " + zeileninhalt + """ +";{} change all (zeileninhalt, "­", "-");{} write record (ausdatei, zeileninhalt).{} entferne ueberfluessige restzeilen:{} REP{} entferne ggf eine zeile{} UNTIL zeileninhalt <> """ ""13"""" +" PER;{} entferne return aus letzter zeile.{} entferne ggf eine zeile:{}
- IF compress (zeileninhalt) = """ ""13"""" +"{} THEN delete record (ausdatei){} FI.{} entferne return aus letzter zeile:{} to line (ausdatei, lines (ausdatei));{} read record (ausdatei, zeileninhalt);{} zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 6);{} write record (ausdatei, zeileninhalt).{} erstelle eine textprozedur:{} schreibe procanfang;{} schreibe procende.{} schreibe procanfang:{} to line (ausdatei, 1);{} insert record (ausdatei);{}
- write record (ausdatei, "TEXT PROC " + prozedurname + ":").{} schreibe procende:{} to line (ausdatei, lines (ausdatei) + 1);{} insert record (ausdatei);{} write record (ausdatei, "END PROC " + prozedurname + ";").{}END PROC erzeuge textprozedur;{}PROC erzeuge textzeile (TEXT CONST dateiname):{} entferne ueberfluessige restzeilen;{} entferne return aus letzter zeile;{} erstelle eine textzeile.{} entferne ueberfluessige restzeilen:{} TEXT VAR zeileninhalt;{} INT VAR zeiger;{}
- FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);{} REP{} entferne ggf eine zeile{} UNTIL compress (zeileninhalt) <> """13""" PER.{} entferne ggf eine zeile:{} to line (ausdatei, lines (ausdatei));{} read record (ausdatei, zeileninhalt);{} IF compress (zeileninhalt) = """13"""{} THEN delete record (ausdatei){} FI.{} entferne return aus letzter zeile:{} to line (ausdatei, lines (ausdatei));{} read record (ausdatei, zeileninhalt);{} change all (zeileninhalt, """13""", "");{}
- write record (ausdatei, zeileninhalt).{} erstelle eine textzeile:{} haenge die zeilen aneinander;{} fasse zeile in gaensefuesschen;{} schreibe einzelzeile in ausgabedatei.{} haenge die zeilen aneinander:{} TEXT VAR zeile :: "";{} FOR zeiger FROM 1 UPTO lines (ausdatei) REP{} to line (ausdatei, zeiger);{} read record (ausdatei, zeileninhalt);{} zeile CAT (" " + zeileninhalt){} PER.{} fasse zeile in gaensefuesschen:{} zeile := """" + zeile + """";{} change all (zeile, "­","-").{}
- schreibe einzelzeile in ausgabedatei:{} forget (dateiname + dateikennung, quiet);{} FILE VAR fertig :: sequential file (modify, dateiname + dateikennung);{} to line (fertig, 1);{} insert record (fertig);{} write record (fertig, zeile){}END PROC erzeuge textzeile;{}END PACKET ls menu generator 1;{}
+PACKET ls menu generator 1 DEFINES
+ textprozedur,
+ textzeile:
+LET maxzeilenzahl = 14,
+ maxzeichenzahl = 65,
+ zentrierkennung = "%",
+ beginmarkkennung = "$",
+ endmarkkennung = "&",
+ unblockkennung = "�",
+ blank = " ",
+ dateikennung = ".a";
+LET dateieintrag = "#type (""10"")##limit (16.5)#",
+ stdfonttabelle = "fonttab.ls-Menu-Generator";
+ROW 3 TEXT CONST fehlermeldung :: ROW 3 TEXT : (
+"existiert nicht!",
+
+""15"Text ist zu lang - bitte kürzen! "14"",
+""15"Zeilenformatierung mit <ESC> abgebrochen! "14""
+);
+ROW 6 TEXT CONST hinweis :: ROW 6 TEXT : (
+"Bitte warten ...",
+"Zulässige Zeilenzahl: ",
+"Tatsächliche Zeilenzahl: ",
+"Textlänge ist in Ordnung!",
+"Textprozedur ist erstellt!",
+"Textzeile ist erstellt!"
+);
+PROC textprozedur (TEXT CONST dateiname, prozedurname):
+ BOOL VAR mit fehler;
+ formatiere (dateiname, mit fehler);
+ IF mit fehler
+ THEN errorstop (fehlermeldung [3])
+ FI;
+
+ bereite den text auf (dateiname);
+ erzeuge textprozedur (dateiname, prozedurname);
+ out (""7""); out (hinweis [5]);
+ last param (dateiname + dateikennung)
+END PROC textprozedur;
+PROC textzeile (TEXT CONST dateiname):
+ BOOL VAR mit fehler;
+ formatiere (dateiname, mit fehler);
+ IF mit fehler
+ THEN errorstop (fehlermeldung [3])
+ FI;
+ bereite den text auf (dateiname);
+ erzeuge textzeile (dateiname);
+ out (""7""); out (hinweis [6]);
+ last param (dateiname + dateikennung)
+
+END PROC textzeile;
+PROC gib wartehinweis:
+ page;
+ out (hinweis [1])
+END PROC gib wartehinweis;
+PROC formatiere (TEXT CONST dateiname, BOOL VAR mit fehler):
+ TEXT VAR fonttabelle, zeileninhalt;
+ kontrolliere existenz;
+ stelle fonttabelle ein;
+ schreibe font in die datei;
+ zeilenformatierung;
+ entferne ggf font aus der datei;
+ stelle fonttabelle zurueck;
+ streiche restleerzeilen weg;
+ untersuche ggf datei auf korrektheit.
+ kontrolliere existenz:
+ IF NOT exists (dateiname)
+
+ THEN page; errorstop ("'" + dateiname + "' " + fehlermeldung [1])
+ FI.
+ stelle fonttabelle ein:
+ gib wartehinweis;
+ fonttabelle := fonttable;
+ fonttable (stdfonttabelle).
+ schreibe font in die datei:
+ FILE VAR datei :: sequential file (modify, dateiname);
+ to line (datei, 1);
+ insert record (datei);
+ write record (datei, dateieintrag + blank).
+ zeilenformatierung:
+ disable stop;
+ lineform (dateiname);
+ IF is error
+ THEN clear error;
+
+ mit fehler := TRUE
+ ELSE mit fehler := FALSE
+ FI;
+ enable stop.
+ entferne ggf font aus der datei:
+ to line (datei, 1);
+ read record (datei, zeileninhalt);
+ IF pos (zeileninhalt, dateieintrag) > 0
+ THEN delete record (datei)
+ FI.
+ stelle fonttabelle zurueck:
+ fonttable (fonttabelle).
+ streiche restleerzeilen weg:
+ REP
+ streiche ggf letzte zeile
+ UNTIL zeile ist nicht leer PER.
+ streiche ggf letzte zeile:
+ to line (datei, lines (datei));
+
+ read record (datei, zeileninhalt);
+ IF compress (zeileninhalt) = ""
+ THEN delete record (datei)
+ FI.
+ zeile ist nicht leer:
+ compress (zeileninhalt) <> "".
+ untersuche ggf datei auf korrektheit:
+ IF NOT mit fehler
+ THEN untersuche zeilenzahl
+ FI.
+ untersuche zeilenzahl:
+ IF lines (datei) > maxzeilenzahl
+ THEN page;
+ out (hinweis [2] + text (maxzeilenzahl)); line;
+ out (hinweis [3] + text (lines (datei))); line (2);
+ errorstop (fehlermeldung [2])
+
+ ELSE page;
+ out (hinweis [4])
+ FI.
+END PROC formatiere;
+PROC bereite den text auf (TEXT CONST dateiname):
+ INT VAR zaehler;
+ TEXT VAR zeileninhalt;
+ FILE VAR f :: sequential file (modify, dateiname);
+ gib wartehinweis;
+ vernichte ggf aufbereitete datei;
+ richte datei neu ein;
+ uebertrage die zeilen.
+ vernichte ggf aufbereitete datei:
+ IF exists (dateiname + dateikennung)
+ THEN forget (dateiname + dateikennung, quiet)
+ FI.
+ richte datei neu ein:
+
+ FILE VAR aus :: sequential file (output, dateiname + dateikennung).
+ uebertrage die zeilen:
+ FOR zaehler FROM 1 UPTO lines (f) REP
+ bereite eine zeile auf
+ PER.
+ bereite eine zeile auf:
+ to line (f, zaehler);
+ read record (f, zeileninhalt);
+ ersetze alle gaensefuesschen;
+ haenge ggf absatzmarke an;
+ behandle zeile;
+ putline (aus, zeileninhalt).
+ ersetze alle gaensefuesschen:
+ change all (zeileninhalt, """", "'").
+ haenge ggf absatzmarke an:
+ IF (zeileninhalt SUB (length (zeileninhalt))) = blank
+
+ THEN IF (zeileninhalt SUB 1) <> zentrierkennung
+ THEN zeileninhalt CAT unblockkennung
+ FI
+ FI.
+ behandle zeile:
+ IF zeile soll zentriert werden
+ THEN zentriere zeile
+ ELIF zeile ist leerzeile
+ THEN kennzeichne leerzeile
+ ELSE blocke zeile auf stdlaenge
+ FI.
+ zeile soll zentriert werden:
+ (zeileninhalt SUB 1) = zentrierkennung.
+ zeile ist leerzeile:
+ compress (zeileninhalt) = "".
+ zentriere zeile:
+ zeileninhalt := subtext (zeileninhalt, 2);
+
+ zeileninhalt := anfangsblanks + zeileninhalt;
+ zeilenabschluss.
+ anfangsblanks:
+ ((maxzeichenzahl - length (zeileninhalt)) DIV 2) * blank.
+ zeilenabschluss:
+ ersetze markierungszeichen;
+ setze 13.
+ ersetze markierungszeichen:
+ change all (zeileninhalt, beginmarkkennung, """15""");
+ change all (zeileninhalt, endmarkkennung, """14""").
+ setze 13:
+ zeileninhalt CAT " ""13""".
+ kennzeichne leerzeile:
+ zeileninhalt := """13""".
+ blocke zeile auf stdlaenge:
+
+ IF zeile darf nicht geblockt werden
+ THEN ersetze endezeichen
+ ELSE fuehre blockung aus
+ FI.
+ zeile darf nicht geblockt werden:
+ (zeileninhalt SUB length (zeileninhalt)) = unblockkennung.
+ ersetze endezeichen:
+ zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 1);
+ ersetze markierungszeichen;
+ setze 13.
+ fuehre blockung aus:
+ ROW maxzeichenzahl INT VAR leerzeichen;
+ INT VAR gezaehlte blanks, zu verteilende blanks;
+ ordne anfangswerte zu;
+
+ verteile blanks gleichmaessig;
+ verteile blanks zufaellig;
+ baue zeile zusammen;
+ ersetze markierungszeichen;
+ setze 13.
+ ordne anfangswerte zu:
+ bestimme blankanzahl in der zeile;
+ bestimme zu verteilende blanks;
+ initialisiere die reihung.
+ bestimme blankanzahl in der zeile:
+ gezaehlte blanks := 0;
+ INT VAR zeiger;
+ FOR zeiger FROM 1 UPTO length (zeileninhalt) REP
+ IF (zeileninhalt SUB zeiger) = blank
+ THEN gezaehlte blanks INCR 1
+
+ FI
+ PER.
+ bestimme zu verteilende blanks:
+ zu verteilende blanks := maxzeichenzahl - length (zeileninhalt).
+ initialisiere die reihung:
+ FOR zeiger FROM 1 UPTO gezaehlte blanks REP
+ leerzeichen [zeiger] := 1
+ PER.
+ verteile blanks gleichmaessig:
+ WHILE (zu verteilende blanks DIV gezaehlte blanks) > 0 REP
+ schlag je ein blank auf;
+ zu verteilende blanks DECR gezaehlte blanks
+ PER.
+ schlag je ein blank auf:
+ FOR zeiger FROM 1 UPTO gezaehlte blanks REP
+
+ leerzeichen [zeiger] INCR 1
+ PER.
+ verteile blanks zufaellig:
+ FOR zeiger FROM 1 UPTO zu verteilende blanks REP
+ leerzeichen [random (1, gezaehlte blanks)] INCR 1
+ PER.
+ baue zeile zusammen:
+ TEXT VAR zwischen := zeileninhalt;
+ INT VAR aktuelles blank := 0;
+ zeileninhalt := "";
+ FOR zeiger FROM 1 UPTO length (zwischen) REP
+ TEXT VAR aktuelles zeichen :: (zwischen SUB zeiger);
+ IF aktuelles zeichen = blank
+ THEN aktuelles blank INCR 1;
+
+ zeileninhalt CAT (leerzeichen [aktuelles blank] * blank)
+ ELSE zeileninhalt CAT aktuelles zeichen
+ FI
+ PER
+END PROC bereite den text auf;
+PROC erzeuge textprozedur (TEXT CONST dateiname, prozedurname):
+ mache aus den zeilen einzeltexte;
+ entferne ueberfluessige restzeilen;
+ erstelle eine textprozedur.
+ mache aus den zeilen einzeltexte:
+ INT VAR zeiger;
+ FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);
+ FOR zeiger FROM 1 UPTO lines (ausdatei) REP
+
+ bearbeite eine zeile
+ PER.
+ bearbeite eine zeile:
+ TEXT VAR zeileninhalt;
+ to line (ausdatei, zeiger);
+ read record (ausdatei, zeileninhalt);
+ zeileninhalt := """ " + zeileninhalt + """ +";
+ change all (zeileninhalt, "­", "-");
+ write record (ausdatei, zeileninhalt).
+ entferne ueberfluessige restzeilen:
+ REP
+ entferne ggf eine zeile
+ UNTIL zeileninhalt <> """ ""13"""" +" PER;
+ entferne return aus letzter zeile.
+ entferne ggf eine zeile:
+
+ IF compress (zeileninhalt) = """ ""13"""" +"
+ THEN delete record (ausdatei)
+ FI.
+ entferne return aus letzter zeile:
+ to line (ausdatei, lines (ausdatei));
+ read record (ausdatei, zeileninhalt);
+ zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 6);
+ write record (ausdatei, zeileninhalt).
+ erstelle eine textprozedur:
+ schreibe procanfang;
+ schreibe procende.
+ schreibe procanfang:
+ to line (ausdatei, 1);
+ insert record (ausdatei);
+
+ write record (ausdatei, "TEXT PROC " + prozedurname + ":").
+ schreibe procende:
+ to line (ausdatei, lines (ausdatei) + 1);
+ insert record (ausdatei);
+ write record (ausdatei, "END PROC " + prozedurname + ";").
+END PROC erzeuge textprozedur;
+PROC erzeuge textzeile (TEXT CONST dateiname):
+ entferne ueberfluessige restzeilen;
+ entferne return aus letzter zeile;
+ erstelle eine textzeile.
+ entferne ueberfluessige restzeilen:
+ TEXT VAR zeileninhalt;
+ INT VAR zeiger;
+
+ FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);
+ REP
+ entferne ggf eine zeile
+ UNTIL compress (zeileninhalt) <> """13""" PER.
+ entferne ggf eine zeile:
+ to line (ausdatei, lines (ausdatei));
+ read record (ausdatei, zeileninhalt);
+ IF compress (zeileninhalt) = """13"""
+ THEN delete record (ausdatei)
+ FI.
+ entferne return aus letzter zeile:
+ to line (ausdatei, lines (ausdatei));
+ read record (ausdatei, zeileninhalt);
+ change all (zeileninhalt, """13""", "");
+
+ write record (ausdatei, zeileninhalt).
+ erstelle eine textzeile:
+ haenge die zeilen aneinander;
+ fasse zeile in gaensefuesschen;
+ schreibe einzelzeile in ausgabedatei.
+ haenge die zeilen aneinander:
+ TEXT VAR zeile :: "";
+ FOR zeiger FROM 1 UPTO lines (ausdatei) REP
+ to line (ausdatei, zeiger);
+ read record (ausdatei, zeileninhalt);
+ zeile CAT (" " + zeileninhalt)
+ PER.
+ fasse zeile in gaensefuesschen:
+ zeile := """" + zeile + """";
+ change all (zeile, "­","-").
+
+ schreibe einzelzeile in ausgabedatei:
+ forget (dateiname + dateikennung, quiet);
+ FILE VAR fertig :: sequential file (modify, dateiname + dateikennung);
+ to line (fertig, 1);
+ insert record (fertig);
+ write record (fertig, zeile)
+END PROC erzeuge textzeile;
+END PACKET ls menu generator 1;
+
diff --git a/menugenerator/ls-Menu-Generator 2 b/menugenerator/ls-Menu-Generator 2
index 608f680..e38fc7e 100644
--- a/menugenerator/ls-Menu-Generator 2
+++ b/menugenerator/ls-Menu-Generator 2
@@ -22,51 +22,677 @@
*)
-PACKET ls menu generator 2 DEFINES{} oeffne menukarte,{} oeffne menu,{} oberbegriff,{} menufunktion,{} trennlinie,{} schliesse menu,{} schliesse menukarte,{} testinstallation:{}LET menutafeltype = 1954,{} kennung = "ls - Menu - Generator",{} mm taskname = "ls-MENUKARTEN",{} menutafelpraefix = "ls-MENUKARTE:",{} menu grundtext = "ls-MENUBASISTEXTE",{} zwischenablagename = "MENU-ZWISCHENABLAGEDATEI INTERN";{}
-LET maxmenus = 6,{} maxmenutexte = 300,{} maxinfotexte = 2000,{} maxhauptmenupunkte = 10,{} maxuntermenupunkte = 15,{} maxmenubreite = 71; (* Breite der Hauptmenüzeile - 2 *){}LET blank = " ",{} cleop = ""4"",{} piep = ""7"",{} trennzeilensymbol = "###",{} bleibt leer symbol = "***",{} hauptmenuluecke = " ";{}LET dummyname = "Dummy für Anwendertexte",{}
- install finished = "Installation abgeschlossen!",{} card finished = "Menukartengenerierung abgeschlossen!",{} filetype = 1003;{}TYPE MENUPUNKT = STRUCT (TEXT punktkuerzel,{} punktname,{} procname,{} boxtext,{} BOOL aktiv,{} angewaehlt),{} EINZELMENU = STRUCT (INT belegt,{} TEXT ueberschrift,{}
- INT anfangsposition,{} maxlaenge,{} ROW maxuntermenupunkte MENUPUNKT menupunkt,{} INT aktueller untermenupunkt,{} TEXT startprozedurname,{} leaveprozedurname),{} MENU = STRUCT (TEXT menuname,{} INT anzahl hauptmenupunkte,{} ROW maxhauptmenupunkte EINZELMENU einzelmenu,{}
- TEXT menueingangsprozedur,{} menuausgangsprozedur,{} menuinfo,{} lizenznummer,{} versionsnummer,{} INT hauptmenuzeiger,{} untermenuanfang,{} untermenuzeiger),{} INFOTEXT = STRUCT (INT anzahl infotexte,{} ROW maxinfotexte TEXT stelle),{}
- MENUTEXT = STRUCT (INT anzahl menutexte,{} ROW maxmenutexte TEXT platz),{} MENULEISTE = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,{} ROW maxmenus MENU menu,{} MENUTEXT menutext,{} INFOTEXT infotext);{}ROW 14 TEXT CONST aussage :: ROW 14 TEXT : ({}"ACHTUNG - Eine Menukarte mit diesem Namen existiert bereits - ACHTUNG",{}"Kann die bereits existierende Menukarte gelöscht werden",{}
-"Dann kann keine neue Menukarte mit diesem Namen erstellt werden!",{}"Zum Weitermachen bitte irgendeine Taste tippen!",{}"Sollen auch Anwendungstexte in die Menukarte aufgenommen werden",{}"Auswahl der Datei, in der die Anwendungstexte stehen.",{}"Bitte die gewünschte Datei ankreuzen!",{}"Durchgang 1 von 2 Durchgängen - in Arbeit ist Zeile: ",{}"Durchgang 2 von 2 Durchgängen - in Arbeit ist Zeile: ",{}"",{}"Einlesen von Texten aus Datei : ",{}"Bearbeitet wird Menu : ",{}"Eingetragen wird Oberbegriff : ",{}
-"Eingetragen wird Menufunktion : "{});{}ROW 22 TEXT CONST fehlermeldung :: ROW 22 TEXT : ({}"Ohne die Datei '",{}"' "13""10""10" ist die Menuerstellung "15"unmöglich "14"!!",{}"Hier muß unbedingt eine Datei angekreuzt werden!",{}"Ausgewählte Datei hat falschen Typ (<> 1003) )",{}"Zu viele Anwendungstexte in der Datei ",{}"Anführungszeichen fehlt am Anfang oder Ende der Zeile ",{}"Anführungszeichen fehlt irgendwo in Zeile ",{}"Die angegebene Datei existiert nicht!",{}"Menukarte noch nicht geöffnet ('oeffne menukarte' fehlt)! ",{}
-"Vorausgehendes Menu nicht geschlossen! ",{}"Zu viele Menus in der Menukarte (> " + text (maxmenus) + ")!",{}"Menuname ist mehrfach vorhanden!",{}"Menu noch nicht geoeffnet ('oeffne menu' fehlt)!",{}"Zu viele Oberbegriffe in einem Menu (> " + text (maxhauptmenupunkte) + ")!",{}"Die Kopfzeile ist zu lang (> " + text (maxmenubreite) + ")!",{}"Menupunkt-Kürzel ist länger als ein Zeichen!",{}"Menupunkt-Kürzel kommt mehrfach vor (nicht eindeutig)!",{}"Menupunkt-Bezeichnung ist zu lang!",{}"Zu viele (> " + text (maxuntermenupunkte) + ") Menupunkte in einem Pull-Down-Menu!",{}
-"Menukarte '",{}"' gibt es nicht in dieser Task!",{}"' hat falsche(n) Typ/Bezeichnung"{});{}TEXT VAR menuinfotextdateiname,{} aktueller menudateiname;{}BOOL VAR menuleiste ist bereit :: FALSE,{} menu ist geoeffnet :: FALSE;{}BOUND MENULEISTE VAR menuleiste;{}BOUND MENUTEXT VAR basistexte;{}BOUND MENU VAR aktuelles menu;{}DATASPACE VAR ds;{}OP := (MENUTEXT VAR ziel, MENUTEXT VAR quelle):{} INT VAR z;{} ziel.anzahl menutexte := quelle.anzahl menutexte;{} FOR z FROM 1 UPTO quelle.anzahl menutexte REP{}
- ziel.platz [z] := quelle.platz [z]{} PER{}END OP :=;{}OP := (MENU VAR ziel, MENU CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (EINZELMENU VAR ziel, EINZELMENU CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (MENUPUNKT VAR ziel, MENUPUNKT CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}PROC oeffne menukarte (TEXT CONST menukartenname):{} gib bildschirmhinweis aus;{} ueberpruefe voraussetzungen;{} erfrage den namen der datei mit den anwendertexten;{}
- erstelle neue menuleiste.{} gib bildschirmhinweis aus:{} page; out (center (invers (kennung))).{} ueberpruefe voraussetzungen:{} ueberpruefe ob basistexte vorhanden sind;{} ueberpruefe ob menukarte schon vorhanden ist.{} ueberpruefe ob basistexte vorhanden sind:{} IF NOT exists (menu grundtext){} THEN gib hinweis und brich ab{} FI.{} gib hinweis und brich ab:{} disable stop;{} fetch (menu grundtext, /mm taskname);{} IF is error{} THEN clear error;{} enable stop;{}
- cursor (1, 4); out (cleop);{} errorstop (fehlermeldung [1] + menu grundtext + fehlermeldung [2]){} ELSE clear error;{} enable stop{} FI.{} ueberpruefe ob menukarte schon vorhanden ist:{} IF exists (menukarte){} THEN gib hinweis auf vorhandene menukarte;{} frage ob die alte karte geloescht werden darf{} FI.{} menukarte:{} menutafelpraefix + menukartenname.{} gib hinweis auf vorhandene menukarte:{} cursor (1, 4); out (cleop);{}
- cursor (1, 4); out (center (menukarte));{} cursor (1, 6); out (center (invers (aussage [1]))).{} frage ob die alte karte geloescht werden darf:{} cursor (2, 9);{} IF yes (aussage [2]){} THEN forget (menukarte, quiet){} ELSE weiterarbeit ist unmoeglich{} FI.{} weiterarbeit ist unmoeglich:{} cursor (1, 12); out (center (invers (aussage [3])));{} cursor (2, 15); out (aussage [4]);{} cursor (2, 16); pause; page;{} errorstop ("").{} erfrage den namen der datei mit den anwendertexten:{}
- cursor (1, 4); out (cleop);{} IF yes (aussage [5]){} THEN biete dateiauswahl an{} ELSE erzeuge dateidummy{} FI.{} biete dateiauswahl an:{} menuinfotextdateiname := one (2, 6, 77, 19, ALL myself,{} aussage [6], aussage [7]);{} ueberpruefe den dateinamen;{} ueberpruefe den dateityp.{} ueberpruefe den dateinamen:{} IF compress (menuinfotextdateiname) = ""{} THEN page; errorstop (fehlermeldung [3]){} FI.{} ueberpruefe den dateityp:{}
- IF datei hat falschen typ{} THEN page; errorstop (fehlermeldung [4]){} FI.{} datei hat falschen typ:{} ds := old (menuinfotextdateiname);{} IF type (ds) <> filetype{} THEN forget (ds); TRUE{} ELSE forget (ds); FALSE{} FI.{} erzeuge dateidummy:{} forget (dummyname, quiet);{} FILE VAR datei :: sequential file (modify, dummyname);{} to line (datei, 1);{} menuinfotextdateiname := dummyname.{} erstelle neue menuleiste:{} INT VAR zeiger;{} TEXT VAR zeileninhalt;{}
- initialisiere werte;{} aktueller menudateiname := menukarte;{} menuleiste := new (aktueller menudateiname);{} type (old (aktueller menudateiname), menutafeltype);{} menuleiste.belegt := 0;{} menuleiste ist bereit := TRUE;{} trage menubasistexte ein;{} trage anwendungstexte ein.{} initialisiere werte:{} menuleiste ist bereit := FALSE;{} menu ist geoeffnet := FALSE.{} trage menubasistexte ein:{} basistexte := old (menu grundtext);{}
- menuleiste.menutext := basistexte.{} trage anwendungstexte ein:{} konvertiere (menuinfotextdateiname, zwischenablagename,{} menuleiste.infotext.anzahl infotexte);{} ueberpruefe anwendungstextanzahl;{} trage anwendungstexte in die menuleiste.{} ueberpruefe anwendungstextanzahl:{} IF menuleiste.infotext.anzahl infotexte > maxinfotexte{} THEN forget (zwischenablagename, quiet);{} forget (aktueller menudateiname, quiet);{} errorstop (fehlermeldung [5] + "'" + menuinfotextdateiname + "'"){}
- FI.{} trage anwendungstexte in die menuleiste:{} gib hinweis auf anwendungstexteintrag;{} FILE VAR ein :: sequential file (input, zwischenablagename);{} FOR zeiger FROM 1 UPTO menuleiste.infotext.anzahl infotexte REP{} getline (ein, zeileninhalt);{} menuleiste.infotext.stelle [zeiger] := zeileninhalt;{} cout (zeiger){} PER;{} forget (zwischenablagename, quiet);{} forget (dummyname , quiet).{} gib hinweis auf anwendungstexteintrag:{} cursor (1, 7); out (aussage [9]).{}
-END PROC oeffne menukarte;{}PROC konvertiere (TEXT CONST eingabedatei, ausgabedatei,{} INT VAR anzahl konvertierter saetze):{} loesche ausgabedatei;{} untersuche eingabedatei;{} konvertiere saetze.{} loesche ausgabedatei:{} IF exists (ausgabedatei){} THEN forget (ausgabedatei, quiet){} FI.{} untersuche eingabedatei:{} IF NOT exists (eingabedatei){} THEN errorstop (fehlermeldung [8]){} FI.{} konvertiere saetze:{} gib hinweis;{} konvertiere satzweise.{}
- gib hinweis:{} cursor (1, 4); out (cleop);{} cursor (1, 4); out (aussage [11] + "'" + eingabedatei + "'");{} cursor (1, 6); out (aussage [ 8]);{} anzahl konvertierter saetze := 0.{} konvertiere satzweise:{} TEXT VAR zeileninhalt :: "";{} FILE VAR eingabe :: sequential file (input, eingabedatei);{} WHILE NOT eof (eingabe) REP{} behandle eine dateizeile{} PER;{} optimiere ausgabedatei.{} behandle eine dateizeile:{} getline (eingabe, zeileninhalt);{} anzahl konvertierter saetze INCR 1;{}
- cout (anzahl konvertierter saetze);{} untersuche zeile;{} wandle die zeile um;{} FILE VAR aus :: sequential file (output, ausgabedatei);{} write (aus, textausgabe).{} untersuche zeile:{} zeileninhalt := compress (zeileninhalt);{} IF zeileninhalt = ""{} THEN zeileninhalt := """"""{} FI;{} IF (zeileninhalt SUB 1) <> """"{} OR (zeileninhalt SUB length (zeileninhalt)) <> """"{} THEN bereite abgang vor;{} errorstop (fehlermeldung [6] + text (anzahl konvertierter saetze)){}
- FI.{} wandle die zeile um:{} TEXT VAR textausgabe :: "", codekette;{} zeileninhalt := subtext (zeileninhalt, 2, length (zeileninhalt) - 1);{} WHILE gaensefuesschenposition > 0 REP{} textausgabe CAT subtext (zeileninhalt, 1, gaensefuesschenposition - 1);{} zeileninhalt := subtext (zeileninhalt, gaensefuesschenposition);{} codekette := subtext (zeileninhalt, 1, pos (zeileninhalt, """", 2));{} IF codekette = """7"""{} THEN textausgabe CAT ""7""{}
- ELIF codekette = """5"""{} THEN textausgabe CAT ""5""{} ELIF codekette = """4"""{} THEN textausgabe CAT ""4""{} ELIF codekette = """10"""{} THEN textausgabe CAT ""10""{} ELIF codekette = """13"""{} THEN textausgabe CAT ""13""{} ELIF codekette = """14"""{} THEN textausgabe CAT ""14""{} ELIF codekette = """15"""{} THEN textausgabe CAT ""15""{} ELIF codekette = """"""{} THEN textausgabe CAT """"{}
- ELSE errorstop (fehlermeldung [7] +{} text (anzahl konvertierter saetze)){} FI;{} zeileninhalt := subtext (zeileninhalt, 1 + length (codekette)){} PER;{} textausgabe CAT zeileninhalt.{} gaensefuesschenposition:{} pos (zeileninhalt, """").{} bereite abgang vor:{} forget (ausgabedatei, quiet);{} line (2).{} optimiere ausgabedatei:{} FILE VAR ausgabe :: sequential file (modify, ausgabedatei);{} WHILE lines (ausgabe) > 0 CAND letzter satz ist leer REP{}
- to line (ausgabe, lines (ausgabe));{} delete record (ausgabe);{} anzahl konvertierter saetze DECR 1;{} cout (anzahl konvertierter saetze ){} PER.{} letzter satz ist leer:{} TEXT VAR satz;{} to line (ausgabe,lines (ausgabe));{} read record (ausgabe, satz);{} IF compress (satz) = "" OR compress (satz) = ""13""{} THEN TRUE{} ELSE FALSE{} FI.{}END PROC konvertiere;{}PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc,{} itext, ltext, vtext):{}
- gib hinweis auf geoeffnetes menu;{} ueberpruefe auf ungereimtheiten;{} nimm eintragungen in datenraum vor.{} gib hinweis auf geoeffnetes menu:{} cursor (1, 4); out (cleop);{} out (aussage [12]); out (invers (name));{} cursor (1, 6).{} ueberpruefe auf ungereimtheiten:{} pruefe auf bereits geoeffnete menuliste;{} pruefe auf noch geoeffnetes menu;{} pruefe auf noch freie menuplaetze;{} pruefe auf schon vorhandenen menunamen.{} pruefe auf bereits geoeffnete menuliste:{} IF NOT menuleiste ist bereit{}
- THEN bereinige eintragungen (9){} FI.{} pruefe auf noch geoeffnetes menu:{} IF menu ist geoeffnet{} THEN bereinige eintragungen (10){} FI.{} pruefe auf noch freie menuplaetze:{} IF menuleiste.belegt = maxmenus{} THEN bereinige eintragungen (11){} FI.{} pruefe auf schon vorhandenen menunamen:{} IF menuname schon vorhanden{} THEN bereinige eintragungen (12){} FI.{} menuname schon vorhanden:{} INT VAR i;{} FOR i FROM 1 UPTO menuleiste.belegt REP{}
- untersuche einzelnen menunamen{} PER;{} FALSE.{} untersuche einzelnen menunamen:{} IF menuleiste.menu [i].menuname = compress (name){} THEN LEAVE menuname schon vorhanden WITH TRUE{} FI.{} nimm eintragungen in datenraum vor:{} forget (ds);{} ds := nilspace;{} aktuelles menu := ds;{} init (aktuelles menu);{} aktuelles menu.menuname := compress (name);{} aktuelles menu.menueingangsprozedur := compress (einstiegsproc);{}
- aktuelles menu.menuausgangsprozedur := compress (ausstiegsproc);{} IF itext <> ""{} THEN aktuelles menu.menuinfo := itext;{} aktuelles menu.lizenznummer := ltext;{} aktuelles menu.versionsnummer := vtext{} ELSE aktuelles menu.menuinfo := bleibt leer symbol;{} aktuelles menu.lizenznummer := "";{} aktuelles menu.versionsnummer := ""{} FI;{} menu ist geoeffnet := TRUE.{}END PROC oeffne menu;{}
-PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc):{} oeffne menu (name, einstiegsproc, ausstiegsproc, "", "", ""){}END PROC oeffne menu;{}PROC oeffne menu (TEXT CONST name):{} oeffne menu (name, "", "", "", "", ""){}END PROC oeffne menu;{}PROC bereinige eintragungen (INT CONST nummer):{} forget (ds);{} forget (aktueller menudateiname, quiet);{} menuleiste ist bereit := FALSE;{} menu ist geoeffnet := FALSE;{} errorstop (fehlermeldung [nummer]){}END PROC bereinige eintragungen;{}
-PROC init (MENU VAR m):{} m.menuname := "";{} m.hauptmenuzeiger := 1;{} m.untermenuanfang := 0;{} m.untermenuzeiger := 0;{} m.menueingangsprozedur := "";{} m.menuausgangsprozedur := "";{} m.menuinfo := "";{} m.versionsnummer := "";{} m.anzahl hauptmenupunkte := 0;{} belege hauptmenupunkte.{} belege hauptmenupunkte:{} INT VAR i;{} FOR i FROM 1 UPTO maxhauptmenupunkte REP{}
- aktuelles einzelmenu.belegt := 0;{} aktuelles einzelmenu.ueberschrift := "";{} aktuelles einzelmenu.anfangsposition := 0;{} aktuelles einzelmenu.maxlaenge := 0;{} aktuelles einzelmenu.aktueller untermenupunkt := 1;{} aktuelles einzelmenu.startprozedurname := "";{} aktuelles einzelmenu.leaveprozedurname := "";{} belege untermenuepunkte{} PER.{} belege untermenuepunkte:{}
- INT VAR j;{} FOR j FROM 1 UPTO maxuntermenupunkte REP{} aktueller menupunkt.punktkuerzel := "";{} aktueller menupunkt.punktname := "";{} aktueller menupunkt.procname := "";{} aktueller menupunkt.boxtext := "";{} aktueller menupunkt.aktiv := TRUE;{} aktueller menupunkt.angewaehlt := FALSE{} PER.{} aktuelles einzelmenu: m.einzelmenu [i].{} aktueller menupunkt: aktuelles einzelmenu.menupunkt [j].{}END PROC init;{}PROC oberbegriff (TEXT CONST punktname, startprocname, leaveprocname):{}
- gib hinweis auf oberbegriff;{} untersuche ob menu geoeffnet und bereit ist;{} untersuche oberbegriffe;{} trage neuen oberbegriff ein;{} notiere die anfangsposition;{} notiere start und leaveprozedur;{} erhoehe die anzahl der oberbegriffe.{} gib hinweis auf oberbegriff:{} cursor (1, 6); out (cleop);{} cursor (1, 6); out (aussage [13]); out (invers (punktname)); line.{} untersuche ob menu geoeffnet und bereit ist:{} IF NOT menuleiste ist bereit{} THEN bereinige eintragungen ( 9){}
- FI;{} IF NOT menu ist geoeffnet{} THEN bereinige eintragungen (13){} FI.{} untersuche oberbegriffe:{} IF zu viele oberbegriffe{} THEN bereinige eintragungen (14){} FI;{} IF gesamtlaenge > maxmenubreite{} THEN bereinige eintragungen (15){} FI.{} zu viele oberbegriffe:{} aktuelles menu.anzahl hauptmenupunkte = maxhauptmenupunkte.{} gesamtlaenge:{} gesamtlaenge ohne letzten punkt + length (compress (punktname)).{} gesamtlaenge ohne letzten punkt:{} length (hauptmenuzeile).{}
- hauptmenuzeile:{} INT VAR zaehler;{} TEXT VAR zeile :: "";{} schreibe menunamen;{} schreibe oberbegriffe;{} zeile.{} schreibe menunamen:{} IF aktuelles menu. menuname <> ""{} THEN zeile CAT aktuelles menu.menuname;{} zeile CAT ":"{} FI.{} schreibe oberbegriffe:{} FOR zaehler FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP{} zeile CAT hauptmenuluecke;{} zeile CAT aktuelles menu. einzelmenu [zaehler].ueberschrift{} PER;{} zeile CAT hauptmenuluecke.{}
- trage neuen oberbegriff ein:{} neuer menupunkt.ueberschrift := compress (punktname).{} notiere die anfangsposition:{} neuer menupunkt.anfangsposition := gesamtlaenge ohne letzten punkt + 1.{} notiere start und leaveprozedur:{} neuer menupunkt.startprozedurname := compress (startprocname);{} neuer menupunkt.leaveprozedurname := compress (leaveprocname).{} neuer menupunkt:{} aktuelles menu.einzelmenu [aktuelles menu.anzahl hauptmenupunkte + 1].{} erhoehe die anzahl der oberbegriffe:{}
- aktuelles menu.anzahl hauptmenupunkte INCR 1.{}END PROC oberbegriff;{}PROC oberbegriff (TEXT CONST punktname):{} oberbegriff (punktname, "", ""){}END PROC oberbegriff;{}PROC menufunktionseintrag (TEXT CONST kuerzel,{} punktbezeichnung,{} prozedurname,{} infotext,{} BOOL CONST ist aktiv):{} gib hinweis auf menufunktionseintrag;{} trage menupunkt ein;{} organisiere menu neu.{}
- gib hinweis auf menufunktionseintrag:{} line;{} out (aussage [14]);{} out ("'" + kuerzelzeichen + "' - " + punktname).{} kuerzelzeichen:{} IF kuerzel = "" THEN " " ELSE kuerzel FI.{} punktname:{} IF punktbezeichnung = trennzeilensymbol{} THEN "----------"{} ELSE punktbezeichnung{} FI.{} trage menupunkt ein:{} ueberpruefe das kuerzel;{} ueberpruefe die punktbreite;{} ueberpruefe die eintragsnummer;{} aktuelles menu.einzelmenu [stelle].belegt INCR 1;{}
- aktueller menupunkt.punktkuerzel := compress (kuerzel);{} aktueller menupunkt.punktname := normierter menupunkt;{} aktueller menupunkt.procname := compress (prozedurname);{} aktueller menupunkt.boxtext := infotext;{} aktueller menupunkt.aktiv := ist aktiv;{} aktueller menupunkt.angewaehlt := FALSE.{} aktueller menupunkt:{} aktuelles untermenu.menupunkt [aktuelles untermenu.belegt].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [stelle].{}
- stelle:{} aktuelles menu.anzahl hauptmenupunkte.{} normierter menupunkt:{} blank + compress (punktbezeichnung).{} ueberpruefe das kuerzel:{} TEXT VAR kurz :: compress (kuerzel);{} IF kuerzel ist zu lang{} THEN bereinige eintragungen (16){} ELIF kuerzel ist schon vorhanden{} THEN bereinige eintragungen (17){} FI.{} kuerzel ist zu lang:{} length (kurz) > 1.{} kuerzel ist schon vorhanden:{} (length (kurz) = 1) AND (pos (vorhandene kuerzel, kurz) > 0).{}
- vorhandene kuerzel:{} TEXT VAR liste :: "";{} INT VAR zeiger;{} FOR zeiger FROM 1 UPTO aktuelles untermenu.belegt REP{} liste CAT aktuelles untermenu.menupunkt [zeiger].punktkuerzel{} PER;{} liste.{} ueberpruefe die punktbreite:{} IF length (compress (punktbezeichnung)) > maxmenubreite - 10{} THEN bereinige eintragungen (18){} FI.{} ueberpruefe die eintragsnummer:{} IF aktuelles untermenu.belegt = maxuntermenupunkte{} THEN bereinige eintragungen (19){}
- FI.{} organisiere menu neu:{} IF neue punktlaenge > aktuelles untermenu.maxlaenge{} THEN aktuelles untermenu.maxlaenge := neue punktlaenge{} FI.{} neue punktlaenge:{} length (aktueller menupunkt.punktname).{}END PROC menufunktionseintrag;{}PROC menufunktion (TEXT CONST kuerzel, punktbezeichnung,{} prozedurname, infotext):{} menufunktionseintrag (kuerzel, punktbezeichnung, prozedurname, infotext,{} TRUE){}END PROC menufunktion;{}
-PROC trennlinie:{} menufunktionseintrag ("", trennzeilensymbol, "", "", FALSE){}END PROC trennlinie;{}PROC schliesse menu:{} menuleiste. belegt INCR 1;{} menuleiste.menu [menuleiste.belegt] := aktuelles menu;{} menu ist geoeffnet := FALSE{}END PROC schliesse menu;{}PROC schliesse menukarte:{} forget (ds);{} page; out (piep); put (card finished){}END PROC schliesse menukarte;{}PROC testinstallation (TEXT CONST kartenname):{} ueberpruefe menukarte;{} nimm installation vor.{}
- ueberpruefe menukarte:{} IF NOT exists (kartenname){} THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [21]){} ELIF (pos (kartenname, menutafelpraefix) <> 1){} OR (type (old (kartenname)) <> menutafeltype){} THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [22]){} FI.{} nimm installation vor:{} TEXT CONST neuer kartenname{} :: kartenname + " von Task '" + name (myself) + "'";{} command dialogue (FALSE);{}
- rename (kartenname, neuer kartenname);{} save (neuer kartenname,task (mmtaskname));{} forget (neuer kartenname, quiet);{} reset dialog;{} install menu (neuer kartenname, FALSE);{} fetch (neuer kartenname, task (mmtaskname));{} rename (neuer kartenname, kartenname);{} command dialogue (TRUE);{} page; out (piep); put (install finished){}END PROC testinstallation;{}END PACKET ls menu generator 2;{}
+PACKET ls menu generator 2 DEFINES
+ oeffne menukarte,
+ oeffne menu,
+ oberbegriff,
+ menufunktion,
+ trennlinie,
+ schliesse menu,
+ schliesse menukarte,
+ testinstallation:
+LET menutafeltype = 1954,
+ kennung = "ls - Menu - Generator",
+ mm taskname = "ls-MENUKARTEN",
+ menutafelpraefix = "ls-MENUKARTE:",
+ menu grundtext = "ls-MENUBASISTEXTE",
+ zwischenablagename = "MENU-ZWISCHENABLAGEDATEI INTERN";
+
+LET maxmenus = 6,
+ maxmenutexte = 300,
+ maxinfotexte = 2000,
+ maxhauptmenupunkte = 10,
+ maxuntermenupunkte = 15,
+ maxmenubreite = 71; (* Breite der Hauptmenüzeile - 2 *)
+LET blank = " ",
+ cleop = ""4"",
+ piep = ""7"",
+ trennzeilensymbol = "###",
+ bleibt leer symbol = "***",
+ hauptmenuluecke = " ";
+LET dummyname = "Dummy für Anwendertexte",
+
+ install finished = "Installation abgeschlossen!",
+ card finished = "Menukartengenerierung abgeschlossen!",
+ filetype = 1003;
+TYPE MENUPUNKT = STRUCT (TEXT punktkuerzel,
+ punktname,
+ procname,
+ boxtext,
+ BOOL aktiv,
+ angewaehlt),
+ EINZELMENU = STRUCT (INT belegt,
+ TEXT ueberschrift,
+
+ INT anfangsposition,
+ maxlaenge,
+ ROW maxuntermenupunkte MENUPUNKT menupunkt,
+ INT aktueller untermenupunkt,
+ TEXT startprozedurname,
+ leaveprozedurname),
+ MENU = STRUCT (TEXT menuname,
+ INT anzahl hauptmenupunkte,
+ ROW maxhauptmenupunkte EINZELMENU einzelmenu,
+
+ TEXT menueingangsprozedur,
+ menuausgangsprozedur,
+ menuinfo,
+ lizenznummer,
+ versionsnummer,
+ INT hauptmenuzeiger,
+ untermenuanfang,
+ untermenuzeiger),
+ INFOTEXT = STRUCT (INT anzahl infotexte,
+ ROW maxinfotexte TEXT stelle),
+
+ MENUTEXT = STRUCT (INT anzahl menutexte,
+ ROW maxmenutexte TEXT platz),
+ MENULEISTE = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,
+ ROW maxmenus MENU menu,
+ MENUTEXT menutext,
+ INFOTEXT infotext);
+ROW 14 TEXT CONST aussage :: ROW 14 TEXT : (
+"ACHTUNG - Eine Menukarte mit diesem Namen existiert bereits - ACHTUNG",
+"Kann die bereits existierende Menukarte gelöscht werden",
+
+"Dann kann keine neue Menukarte mit diesem Namen erstellt werden!",
+"Zum Weitermachen bitte irgendeine Taste tippen!",
+"Sollen auch Anwendungstexte in die Menukarte aufgenommen werden",
+"Auswahl der Datei, in der die Anwendungstexte stehen.",
+"Bitte die gewünschte Datei ankreuzen!",
+"Durchgang 1 von 2 Durchgängen - in Arbeit ist Zeile: ",
+"Durchgang 2 von 2 Durchgängen - in Arbeit ist Zeile: ",
+"",
+"Einlesen von Texten aus Datei : ",
+"Bearbeitet wird Menu : ",
+"Eingetragen wird Oberbegriff : ",
+
+"Eingetragen wird Menufunktion : "
+);
+ROW 22 TEXT CONST fehlermeldung :: ROW 22 TEXT : (
+"Ohne die Datei '",
+"' "13""10""10" ist die Menuerstellung "15"unmöglich "14"!!",
+"Hier muß unbedingt eine Datei angekreuzt werden!",
+"Ausgewählte Datei hat falschen Typ (<> 1003) )",
+"Zu viele Anwendungstexte in der Datei ",
+"Anführungszeichen fehlt am Anfang oder Ende der Zeile ",
+"Anführungszeichen fehlt irgendwo in Zeile ",
+"Die angegebene Datei existiert nicht!",
+"Menukarte noch nicht geöffnet ('oeffne menukarte' fehlt)! ",
+
+"Vorausgehendes Menu nicht geschlossen! ",
+"Zu viele Menus in der Menukarte (> " + text (maxmenus) + ")!",
+"Menuname ist mehrfach vorhanden!",
+"Menu noch nicht geoeffnet ('oeffne menu' fehlt)!",
+"Zu viele Oberbegriffe in einem Menu (> " + text (maxhauptmenupunkte) + ")!",
+"Die Kopfzeile ist zu lang (> " + text (maxmenubreite) + ")!",
+"Menupunkt-Kürzel ist länger als ein Zeichen!",
+"Menupunkt-Kürzel kommt mehrfach vor (nicht eindeutig)!",
+"Menupunkt-Bezeichnung ist zu lang!",
+"Zu viele (> " + text (maxuntermenupunkte) + ") Menupunkte in einem Pull-Down-Menu!",
+
+"Menukarte '",
+"' gibt es nicht in dieser Task!",
+"' hat falsche(n) Typ/Bezeichnung"
+);
+TEXT VAR menuinfotextdateiname,
+ aktueller menudateiname;
+BOOL VAR menuleiste ist bereit :: FALSE,
+ menu ist geoeffnet :: FALSE;
+BOUND MENULEISTE VAR menuleiste;
+BOUND MENUTEXT VAR basistexte;
+BOUND MENU VAR aktuelles menu;
+DATASPACE VAR ds;
+OP := (MENUTEXT VAR ziel, MENUTEXT VAR quelle):
+ INT VAR z;
+ ziel.anzahl menutexte := quelle.anzahl menutexte;
+ FOR z FROM 1 UPTO quelle.anzahl menutexte REP
+
+ ziel.platz [z] := quelle.platz [z]
+ PER
+END OP :=;
+OP := (MENU VAR ziel, MENU CONST quelle):
+ CONCR (ziel) := CONCR (quelle)
+END OP :=;
+OP := (EINZELMENU VAR ziel, EINZELMENU CONST quelle):
+ CONCR (ziel) := CONCR (quelle)
+END OP :=;
+OP := (MENUPUNKT VAR ziel, MENUPUNKT CONST quelle):
+ CONCR (ziel) := CONCR (quelle)
+END OP :=;
+PROC oeffne menukarte (TEXT CONST menukartenname):
+ gib bildschirmhinweis aus;
+ ueberpruefe voraussetzungen;
+ erfrage den namen der datei mit den anwendertexten;
+
+ erstelle neue menuleiste.
+ gib bildschirmhinweis aus:
+ page; out (center (invers (kennung))).
+ ueberpruefe voraussetzungen:
+ ueberpruefe ob basistexte vorhanden sind;
+ ueberpruefe ob menukarte schon vorhanden ist.
+ ueberpruefe ob basistexte vorhanden sind:
+ IF NOT exists (menu grundtext)
+ THEN gib hinweis und brich ab
+ FI.
+ gib hinweis und brich ab:
+ disable stop;
+ fetch (menu grundtext, /mm taskname);
+ IF is error
+ THEN clear error;
+ enable stop;
+
+ cursor (1, 4); out (cleop);
+ errorstop (fehlermeldung [1] + menu grundtext + fehlermeldung [2])
+ ELSE clear error;
+ enable stop
+ FI.
+ ueberpruefe ob menukarte schon vorhanden ist:
+ IF exists (menukarte)
+ THEN gib hinweis auf vorhandene menukarte;
+ frage ob die alte karte geloescht werden darf
+ FI.
+ menukarte:
+ menutafelpraefix + menukartenname.
+ gib hinweis auf vorhandene menukarte:
+ cursor (1, 4); out (cleop);
+
+ cursor (1, 4); out (center (menukarte));
+ cursor (1, 6); out (center (invers (aussage [1]))).
+ frage ob die alte karte geloescht werden darf:
+ cursor (2, 9);
+ IF yes (aussage [2])
+ THEN forget (menukarte, quiet)
+ ELSE weiterarbeit ist unmoeglich
+ FI.
+ weiterarbeit ist unmoeglich:
+ cursor (1, 12); out (center (invers (aussage [3])));
+ cursor (2, 15); out (aussage [4]);
+ cursor (2, 16); pause; page;
+ errorstop ("").
+ erfrage den namen der datei mit den anwendertexten:
+
+ cursor (1, 4); out (cleop);
+ IF yes (aussage [5])
+ THEN biete dateiauswahl an
+ ELSE erzeuge dateidummy
+ FI.
+ biete dateiauswahl an:
+ menuinfotextdateiname := one (2, 6, 77, 19, ALL myself,
+ aussage [6], aussage [7]);
+ ueberpruefe den dateinamen;
+ ueberpruefe den dateityp.
+ ueberpruefe den dateinamen:
+ IF compress (menuinfotextdateiname) = ""
+ THEN page; errorstop (fehlermeldung [3])
+ FI.
+ ueberpruefe den dateityp:
+
+ IF datei hat falschen typ
+ THEN page; errorstop (fehlermeldung [4])
+ FI.
+ datei hat falschen typ:
+ ds := old (menuinfotextdateiname);
+ IF type (ds) <> filetype
+ THEN forget (ds); TRUE
+ ELSE forget (ds); FALSE
+ FI.
+ erzeuge dateidummy:
+ forget (dummyname, quiet);
+ FILE VAR datei :: sequential file (modify, dummyname);
+ to line (datei, 1);
+ menuinfotextdateiname := dummyname.
+ erstelle neue menuleiste:
+ INT VAR zeiger;
+ TEXT VAR zeileninhalt;
+
+ initialisiere werte;
+ aktueller menudateiname := menukarte;
+ menuleiste := new (aktueller menudateiname);
+ type (old (aktueller menudateiname), menutafeltype);
+ menuleiste.belegt := 0;
+ menuleiste ist bereit := TRUE;
+ trage menubasistexte ein;
+ trage anwendungstexte ein.
+ initialisiere werte:
+ menuleiste ist bereit := FALSE;
+ menu ist geoeffnet := FALSE.
+ trage menubasistexte ein:
+ basistexte := old (menu grundtext);
+
+ menuleiste.menutext := basistexte.
+ trage anwendungstexte ein:
+ konvertiere (menuinfotextdateiname, zwischenablagename,
+ menuleiste.infotext.anzahl infotexte);
+ ueberpruefe anwendungstextanzahl;
+ trage anwendungstexte in die menuleiste.
+ ueberpruefe anwendungstextanzahl:
+ IF menuleiste.infotext.anzahl infotexte > maxinfotexte
+ THEN forget (zwischenablagename, quiet);
+ forget (aktueller menudateiname, quiet);
+ errorstop (fehlermeldung [5] + "'" + menuinfotextdateiname + "'")
+
+ FI.
+ trage anwendungstexte in die menuleiste:
+ gib hinweis auf anwendungstexteintrag;
+ FILE VAR ein :: sequential file (input, zwischenablagename);
+ FOR zeiger FROM 1 UPTO menuleiste.infotext.anzahl infotexte REP
+ getline (ein, zeileninhalt);
+ menuleiste.infotext.stelle [zeiger] := zeileninhalt;
+ cout (zeiger)
+ PER;
+ forget (zwischenablagename, quiet);
+ forget (dummyname , quiet).
+ gib hinweis auf anwendungstexteintrag:
+ cursor (1, 7); out (aussage [9]).
+
+END PROC oeffne menukarte;
+PROC konvertiere (TEXT CONST eingabedatei, ausgabedatei,
+ INT VAR anzahl konvertierter saetze):
+ loesche ausgabedatei;
+ untersuche eingabedatei;
+ konvertiere saetze.
+ loesche ausgabedatei:
+ IF exists (ausgabedatei)
+ THEN forget (ausgabedatei, quiet)
+ FI.
+ untersuche eingabedatei:
+ IF NOT exists (eingabedatei)
+ THEN errorstop (fehlermeldung [8])
+ FI.
+ konvertiere saetze:
+ gib hinweis;
+ konvertiere satzweise.
+
+ gib hinweis:
+ cursor (1, 4); out (cleop);
+ cursor (1, 4); out (aussage [11] + "'" + eingabedatei + "'");
+ cursor (1, 6); out (aussage [ 8]);
+ anzahl konvertierter saetze := 0.
+ konvertiere satzweise:
+ TEXT VAR zeileninhalt :: "";
+ FILE VAR eingabe :: sequential file (input, eingabedatei);
+ WHILE NOT eof (eingabe) REP
+ behandle eine dateizeile
+ PER;
+ optimiere ausgabedatei.
+ behandle eine dateizeile:
+ getline (eingabe, zeileninhalt);
+ anzahl konvertierter saetze INCR 1;
+
+ cout (anzahl konvertierter saetze);
+ untersuche zeile;
+ wandle die zeile um;
+ FILE VAR aus :: sequential file (output, ausgabedatei);
+ write (aus, textausgabe).
+ untersuche zeile:
+ zeileninhalt := compress (zeileninhalt);
+ IF zeileninhalt = ""
+ THEN zeileninhalt := """"""
+ FI;
+ IF (zeileninhalt SUB 1) <> """"
+ OR (zeileninhalt SUB length (zeileninhalt)) <> """"
+ THEN bereite abgang vor;
+ errorstop (fehlermeldung [6] + text (anzahl konvertierter saetze))
+
+ FI.
+ wandle die zeile um:
+ TEXT VAR textausgabe :: "", codekette;
+ zeileninhalt := subtext (zeileninhalt, 2, length (zeileninhalt) - 1);
+ WHILE gaensefuesschenposition > 0 REP
+ textausgabe CAT subtext (zeileninhalt, 1, gaensefuesschenposition - 1);
+ zeileninhalt := subtext (zeileninhalt, gaensefuesschenposition);
+ codekette := subtext (zeileninhalt, 1, pos (zeileninhalt, """", 2));
+ IF codekette = """7"""
+ THEN textausgabe CAT ""7""
+
+ ELIF codekette = """5"""
+ THEN textausgabe CAT ""5""
+ ELIF codekette = """4"""
+ THEN textausgabe CAT ""4""
+ ELIF codekette = """10"""
+ THEN textausgabe CAT ""10""
+ ELIF codekette = """13"""
+ THEN textausgabe CAT ""13""
+ ELIF codekette = """14"""
+ THEN textausgabe CAT ""14""
+ ELIF codekette = """15"""
+ THEN textausgabe CAT ""15""
+ ELIF codekette = """"""
+ THEN textausgabe CAT """"
+
+ ELSE errorstop (fehlermeldung [7] +
+ text (anzahl konvertierter saetze))
+ FI;
+ zeileninhalt := subtext (zeileninhalt, 1 + length (codekette))
+ PER;
+ textausgabe CAT zeileninhalt.
+ gaensefuesschenposition:
+ pos (zeileninhalt, """").
+ bereite abgang vor:
+ forget (ausgabedatei, quiet);
+ line (2).
+ optimiere ausgabedatei:
+ FILE VAR ausgabe :: sequential file (modify, ausgabedatei);
+ WHILE lines (ausgabe) > 0 CAND letzter satz ist leer REP
+
+ to line (ausgabe, lines (ausgabe));
+ delete record (ausgabe);
+ anzahl konvertierter saetze DECR 1;
+ cout (anzahl konvertierter saetze )
+ PER.
+ letzter satz ist leer:
+ TEXT VAR satz;
+ to line (ausgabe,lines (ausgabe));
+ read record (ausgabe, satz);
+ IF compress (satz) = "" OR compress (satz) = ""13""
+ THEN TRUE
+ ELSE FALSE
+ FI.
+END PROC konvertiere;
+PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc,
+ itext, ltext, vtext):
+
+ gib hinweis auf geoeffnetes menu;
+ ueberpruefe auf ungereimtheiten;
+ nimm eintragungen in datenraum vor.
+ gib hinweis auf geoeffnetes menu:
+ cursor (1, 4); out (cleop);
+ out (aussage [12]); out (invers (name));
+ cursor (1, 6).
+ ueberpruefe auf ungereimtheiten:
+ pruefe auf bereits geoeffnete menuliste;
+ pruefe auf noch geoeffnetes menu;
+ pruefe auf noch freie menuplaetze;
+ pruefe auf schon vorhandenen menunamen.
+ pruefe auf bereits geoeffnete menuliste:
+ IF NOT menuleiste ist bereit
+
+ THEN bereinige eintragungen (9)
+ FI.
+ pruefe auf noch geoeffnetes menu:
+ IF menu ist geoeffnet
+ THEN bereinige eintragungen (10)
+ FI.
+ pruefe auf noch freie menuplaetze:
+ IF menuleiste.belegt = maxmenus
+ THEN bereinige eintragungen (11)
+ FI.
+ pruefe auf schon vorhandenen menunamen:
+ IF menuname schon vorhanden
+ THEN bereinige eintragungen (12)
+ FI.
+ menuname schon vorhanden:
+ INT VAR i;
+ FOR i FROM 1 UPTO menuleiste.belegt REP
+
+ untersuche einzelnen menunamen
+ PER;
+ FALSE.
+ untersuche einzelnen menunamen:
+ IF menuleiste.menu [i].menuname = compress (name)
+ THEN LEAVE menuname schon vorhanden WITH TRUE
+ FI.
+ nimm eintragungen in datenraum vor:
+ forget (ds);
+ ds := nilspace;
+ aktuelles menu := ds;
+ init (aktuelles menu);
+ aktuelles menu.menuname := compress (name);
+ aktuelles menu.menueingangsprozedur := compress (einstiegsproc);
+
+ aktuelles menu.menuausgangsprozedur := compress (ausstiegsproc);
+ IF itext <> ""
+ THEN aktuelles menu.menuinfo := itext;
+ aktuelles menu.lizenznummer := ltext;
+ aktuelles menu.versionsnummer := vtext
+ ELSE aktuelles menu.menuinfo := bleibt leer symbol;
+ aktuelles menu.lizenznummer := "";
+ aktuelles menu.versionsnummer := ""
+ FI;
+ menu ist geoeffnet := TRUE.
+END PROC oeffne menu;
+
+PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc):
+ oeffne menu (name, einstiegsproc, ausstiegsproc, "", "", "")
+END PROC oeffne menu;
+PROC oeffne menu (TEXT CONST name):
+ oeffne menu (name, "", "", "", "", "")
+END PROC oeffne menu;
+PROC bereinige eintragungen (INT CONST nummer):
+ forget (ds);
+ forget (aktueller menudateiname, quiet);
+ menuleiste ist bereit := FALSE;
+ menu ist geoeffnet := FALSE;
+ errorstop (fehlermeldung [nummer])
+END PROC bereinige eintragungen;
+
+PROC init (MENU VAR m):
+ m.menuname := "";
+ m.hauptmenuzeiger := 1;
+ m.untermenuanfang := 0;
+ m.untermenuzeiger := 0;
+ m.menueingangsprozedur := "";
+ m.menuausgangsprozedur := "";
+ m.menuinfo := "";
+ m.versionsnummer := "";
+ m.anzahl hauptmenupunkte := 0;
+ belege hauptmenupunkte.
+ belege hauptmenupunkte:
+ INT VAR i;
+ FOR i FROM 1 UPTO maxhauptmenupunkte REP
+
+ aktuelles einzelmenu.belegt := 0;
+ aktuelles einzelmenu.ueberschrift := "";
+ aktuelles einzelmenu.anfangsposition := 0;
+ aktuelles einzelmenu.maxlaenge := 0;
+ aktuelles einzelmenu.aktueller untermenupunkt := 1;
+ aktuelles einzelmenu.startprozedurname := "";
+ aktuelles einzelmenu.leaveprozedurname := "";
+ belege untermenuepunkte
+ PER.
+ belege untermenuepunkte:
+
+ INT VAR j;
+ FOR j FROM 1 UPTO maxuntermenupunkte REP
+ aktueller menupunkt.punktkuerzel := "";
+ aktueller menupunkt.punktname := "";
+ aktueller menupunkt.procname := "";
+ aktueller menupunkt.boxtext := "";
+ aktueller menupunkt.aktiv := TRUE;
+ aktueller menupunkt.angewaehlt := FALSE
+ PER.
+ aktuelles einzelmenu: m.einzelmenu [i].
+ aktueller menupunkt: aktuelles einzelmenu.menupunkt [j].
+END PROC init;
+PROC oberbegriff (TEXT CONST punktname, startprocname, leaveprocname):
+
+ gib hinweis auf oberbegriff;
+ untersuche ob menu geoeffnet und bereit ist;
+ untersuche oberbegriffe;
+ trage neuen oberbegriff ein;
+ notiere die anfangsposition;
+ notiere start und leaveprozedur;
+ erhoehe die anzahl der oberbegriffe.
+ gib hinweis auf oberbegriff:
+ cursor (1, 6); out (cleop);
+ cursor (1, 6); out (aussage [13]); out (invers (punktname)); line.
+ untersuche ob menu geoeffnet und bereit ist:
+ IF NOT menuleiste ist bereit
+ THEN bereinige eintragungen ( 9)
+
+ FI;
+ IF NOT menu ist geoeffnet
+ THEN bereinige eintragungen (13)
+ FI.
+ untersuche oberbegriffe:
+ IF zu viele oberbegriffe
+ THEN bereinige eintragungen (14)
+ FI;
+ IF gesamtlaenge > maxmenubreite
+ THEN bereinige eintragungen (15)
+ FI.
+ zu viele oberbegriffe:
+ aktuelles menu.anzahl hauptmenupunkte = maxhauptmenupunkte.
+ gesamtlaenge:
+ gesamtlaenge ohne letzten punkt + length (compress (punktname)).
+ gesamtlaenge ohne letzten punkt:
+ length (hauptmenuzeile).
+
+ hauptmenuzeile:
+ INT VAR zaehler;
+ TEXT VAR zeile :: "";
+ schreibe menunamen;
+ schreibe oberbegriffe;
+ zeile.
+ schreibe menunamen:
+ IF aktuelles menu. menuname <> ""
+ THEN zeile CAT aktuelles menu.menuname;
+ zeile CAT ":"
+ FI.
+ schreibe oberbegriffe:
+ FOR zaehler FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP
+ zeile CAT hauptmenuluecke;
+ zeile CAT aktuelles menu. einzelmenu [zaehler].ueberschrift
+ PER;
+ zeile CAT hauptmenuluecke.
+
+ trage neuen oberbegriff ein:
+ neuer menupunkt.ueberschrift := compress (punktname).
+ notiere die anfangsposition:
+ neuer menupunkt.anfangsposition := gesamtlaenge ohne letzten punkt + 1.
+ notiere start und leaveprozedur:
+ neuer menupunkt.startprozedurname := compress (startprocname);
+ neuer menupunkt.leaveprozedurname := compress (leaveprocname).
+ neuer menupunkt:
+ aktuelles menu.einzelmenu [aktuelles menu.anzahl hauptmenupunkte + 1].
+ erhoehe die anzahl der oberbegriffe:
+
+ aktuelles menu.anzahl hauptmenupunkte INCR 1.
+END PROC oberbegriff;
+PROC oberbegriff (TEXT CONST punktname):
+ oberbegriff (punktname, "", "")
+END PROC oberbegriff;
+PROC menufunktionseintrag (TEXT CONST kuerzel,
+ punktbezeichnung,
+ prozedurname,
+ infotext,
+ BOOL CONST ist aktiv):
+ gib hinweis auf menufunktionseintrag;
+ trage menupunkt ein;
+ organisiere menu neu.
+
+ gib hinweis auf menufunktionseintrag:
+ line;
+ out (aussage [14]);
+ out ("'" + kuerzelzeichen + "' - " + punktname).
+ kuerzelzeichen:
+ IF kuerzel = "" THEN " " ELSE kuerzel FI.
+ punktname:
+ IF punktbezeichnung = trennzeilensymbol
+ THEN "----------"
+ ELSE punktbezeichnung
+ FI.
+ trage menupunkt ein:
+ ueberpruefe das kuerzel;
+ ueberpruefe die punktbreite;
+ ueberpruefe die eintragsnummer;
+ aktuelles menu.einzelmenu [stelle].belegt INCR 1;
+
+ aktueller menupunkt.punktkuerzel := compress (kuerzel);
+ aktueller menupunkt.punktname := normierter menupunkt;
+ aktueller menupunkt.procname := compress (prozedurname);
+ aktueller menupunkt.boxtext := infotext;
+ aktueller menupunkt.aktiv := ist aktiv;
+ aktueller menupunkt.angewaehlt := FALSE.
+ aktueller menupunkt:
+ aktuelles untermenu.menupunkt [aktuelles untermenu.belegt].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [stelle].
+
+ stelle:
+ aktuelles menu.anzahl hauptmenupunkte.
+ normierter menupunkt:
+ blank + compress (punktbezeichnung).
+ ueberpruefe das kuerzel:
+ TEXT VAR kurz :: compress (kuerzel);
+ IF kuerzel ist zu lang
+ THEN bereinige eintragungen (16)
+ ELIF kuerzel ist schon vorhanden
+ THEN bereinige eintragungen (17)
+ FI.
+ kuerzel ist zu lang:
+ length (kurz) > 1.
+ kuerzel ist schon vorhanden:
+ (length (kurz) = 1) AND (pos (vorhandene kuerzel, kurz) > 0).
+
+ vorhandene kuerzel:
+ TEXT VAR liste :: "";
+ INT VAR zeiger;
+ FOR zeiger FROM 1 UPTO aktuelles untermenu.belegt REP
+ liste CAT aktuelles untermenu.menupunkt [zeiger].punktkuerzel
+ PER;
+ liste.
+ ueberpruefe die punktbreite:
+ IF length (compress (punktbezeichnung)) > maxmenubreite - 10
+ THEN bereinige eintragungen (18)
+ FI.
+ ueberpruefe die eintragsnummer:
+ IF aktuelles untermenu.belegt = maxuntermenupunkte
+ THEN bereinige eintragungen (19)
+
+ FI.
+ organisiere menu neu:
+ IF neue punktlaenge > aktuelles untermenu.maxlaenge
+ THEN aktuelles untermenu.maxlaenge := neue punktlaenge
+ FI.
+ neue punktlaenge:
+ length (aktueller menupunkt.punktname).
+END PROC menufunktionseintrag;
+PROC menufunktion (TEXT CONST kuerzel, punktbezeichnung,
+ prozedurname, infotext):
+ menufunktionseintrag (kuerzel, punktbezeichnung, prozedurname, infotext,
+ TRUE)
+END PROC menufunktion;
+
+PROC trennlinie:
+ menufunktionseintrag ("", trennzeilensymbol, "", "", FALSE)
+END PROC trennlinie;
+PROC schliesse menu:
+ menuleiste. belegt INCR 1;
+ menuleiste.menu [menuleiste.belegt] := aktuelles menu;
+ menu ist geoeffnet := FALSE
+END PROC schliesse menu;
+PROC schliesse menukarte:
+ forget (ds);
+ page; out (piep); put (card finished)
+END PROC schliesse menukarte;
+PROC testinstallation (TEXT CONST kartenname):
+ ueberpruefe menukarte;
+ nimm installation vor.
+
+ ueberpruefe menukarte:
+ IF NOT exists (kartenname)
+ THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [21])
+ ELIF (pos (kartenname, menutafelpraefix) <> 1)
+ OR (type (old (kartenname)) <> menutafeltype)
+ THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [22])
+ FI.
+ nimm installation vor:
+ TEXT CONST neuer kartenname
+ :: kartenname + " von Task '" + name (myself) + "'";
+ command dialogue (FALSE);
+
+ rename (kartenname, neuer kartenname);
+ save (neuer kartenname,task (mmtaskname));
+ forget (neuer kartenname, quiet);
+ reset dialog;
+ install menu (neuer kartenname, FALSE);
+ fetch (neuer kartenname, task (mmtaskname));
+ rename (neuer kartenname, kartenname);
+ command dialogue (TRUE);
+ page; out (piep); put (install finished)
+END PROC testinstallation;
+END PACKET ls menu generator 2;
+
diff --git a/menugenerator/ls-Menu-Generator-gen b/menugenerator/ls-Menu-Generator-gen
index 9a4c3fc..ca26366 100644
--- a/menugenerator/ls-Menu-Generator-gen
+++ b/menugenerator/ls-Menu-Generator-gen
@@ -22,9 +22,91 @@
*)
-LET mm taskname = "ls-MENUKARTEN",{} datei 1 = "Generatordatei: Archivmenu",{} datei 2 = "ls-MENUBASISTEXTE",{} datei 3 = "ls-Menu-Generator 1",{} datei 4 = "ls-Menu-Generator 2";{}PROC stelle existenz des mm sicher:{} cursor (1, 5); out (""4"");{} IF NOT exists (task (mm taskname)){} THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!");{} FI{}END PROC stelle existenz des mm sicher;{}PROC vom archiv (TEXT CONST datei):{} cursor (1,5); out (""4"");{}
- out (" """); out (datei); putline (""" wird geholt.");{} fetch (datei, archive){}END PROC vom archiv;{}PROC hole (TEXT CONST datei):{} IF NOT exists (datei) THEN vom archiv (datei) FI{}END PROC hole;{}PROC in (TEXT CONST datei):{} hole (datei);{} cursor (1, 5); out (""4"");{} out (" """); out (datei); out (""" wird übersetzt: ");{} insert (datei);{} forget (datei, quiet);{}END PROC in;{}PROC schicke (TEXT CONST datei):{} cursor (1, 5); out (""4"");{} out (" """); out(datei);{} out (""" wird zum MENUKARTEN-MANAGER geschickt!");{}
- command dialogue (FALSE);{} save (datei, task (mm taskname));{} command dialogue (TRUE);{} forget (datei, quiet){}END PROC schicke;{}INT VAR size, used;{}BOOL VAR einzeln;{}storage (size, used);{}einzeln := size - used < 500;{}forget ("ls-Menu-Generator/gen", quiet);{}wirf kopfzeile aus;{}stelle existenz des mm sicher;{}hole die dateien;{}insertiere die dateien;{}mache global manager aus der task.{}wirf kopfzeile aus:{} page;{} putline (" "15"ls-Menu-Generator - Automatische Generierung "14"").{}
-hole die dateien:{} IF NOT exists (datei 1) COR NOT exists (datei 2){} COR NOT exists (datei 3) COR NOT exists (datei 4){} THEN hole dateien vom archiv{} FI.{}hole dateien vom archiv:{} cursor (1,3);{} say ("Ist das Archiv angemeldet und die "); line;{} IF yes ("'ls-Menu-Generator'-Diskette eingelegt"){} THEN lese ein{} ELSE line (2);{} errorstop ("Ohne die Diskette kann ich das System nicht generieren!"){} FI.{}lese ein:{} cursor (1, 3); out (""4"");{} out (" "15"Bitte die Diskette eingelegt lassen! "14"");{}
- IF NOT einzeln{} THEN hole (datei 1);{} hole (datei 2);{} hole (datei 3);{} hole (datei 4);{} cursor (1, 3); out(""4"");{} out (" "15"Die Diskette wird nicht mehr benötigt! "14"");{} release (archive){} FI.{}insertiere die dateien:{} check off;{} schicke (datei 2);{} in (datei 3);{} in (datei 4);{} IF einzeln THEN release (archive) FI;{} check on.{}mache global manager aus der task:{} global manager.{}
+LET mm taskname = "ls-MENUKARTEN",
+ datei 1 = "Generatordatei: Archivmenu",
+ datei 2 = "ls-MENUBASISTEXTE",
+ datei 3 = "ls-Menu-Generator 1",
+ datei 4 = "ls-Menu-Generator 2";
+PROC stelle existenz des mm sicher:
+ cursor (1, 5); out (""4"");
+ IF NOT exists (task (mm taskname))
+ THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!");
+ FI
+END PROC stelle existenz des mm sicher;
+PROC vom archiv (TEXT CONST datei):
+ cursor (1,5); out (""4"");
+
+ out (" """); out (datei); putline (""" wird geholt.");
+ fetch (datei, archive)
+END PROC vom archiv;
+PROC hole (TEXT CONST datei):
+ IF NOT exists (datei) THEN vom archiv (datei) FI
+END PROC hole;
+PROC in (TEXT CONST datei):
+ hole (datei);
+ cursor (1, 5); out (""4"");
+ out (" """); out (datei); out (""" wird übersetzt: ");
+ insert (datei);
+ forget (datei, quiet);
+END PROC in;
+PROC schicke (TEXT CONST datei):
+ cursor (1, 5); out (""4"");
+ out (" """); out(datei);
+ out (""" wird zum MENUKARTEN-MANAGER geschickt!");
+
+ command dialogue (FALSE);
+ save (datei, task (mm taskname));
+ command dialogue (TRUE);
+ forget (datei, quiet)
+END PROC schicke;
+INT VAR size, used;
+BOOL VAR einzeln;
+storage (size, used);
+einzeln := size - used < 500;
+forget ("ls-Menu-Generator/gen", quiet);
+wirf kopfzeile aus;
+stelle existenz des mm sicher;
+hole die dateien;
+insertiere die dateien;
+mache global manager aus der task.
+wirf kopfzeile aus:
+ page;
+ putline (" "15"ls-Menu-Generator - Automatische Generierung "14"").
+
+hole die dateien:
+ IF NOT exists (datei 1) COR NOT exists (datei 2)
+ COR NOT exists (datei 3) COR NOT exists (datei 4)
+ THEN hole dateien vom archiv
+ FI.
+hole dateien vom archiv:
+ cursor (1,3);
+ say ("Ist das Archiv angemeldet und die "); line;
+ IF yes ("'ls-Menu-Generator'-Diskette eingelegt")
+ THEN lese ein
+ ELSE line (2);
+ errorstop ("Ohne die Diskette kann ich das System nicht generieren!")
+ FI.
+lese ein:
+ cursor (1, 3); out (""4"");
+ out (" "15"Bitte die Diskette eingelegt lassen! "14"");
+
+ IF NOT einzeln
+ THEN hole (datei 1);
+ hole (datei 2);
+ hole (datei 3);
+ hole (datei 4);
+ cursor (1, 3); out(""4"");
+ out (" "15"Die Diskette wird nicht mehr benötigt! "14"");
+ release (archive)
+ FI.
+insertiere die dateien:
+ check off;
+ schicke (datei 2);
+ in (datei 3);
+ in (datei 4);
+ IF einzeln THEN release (archive) FI;
+ check on.
+mache global manager aus der task:
+ global manager.
+
diff --git a/mp-bap/ls-MP BAP 1 b/mp-bap/ls-MP BAP 1
index be7e3d2..9fa1a4b 100644
--- a/mp-bap/ls-MP BAP 1
+++ b/mp-bap/ls-MP BAP 1
@@ -22,98 +22,1325 @@ PACKET ls mp bap 1 DEFINES (*******************************)
mp bap pausendauer,
mp bap wertungsschluessel:
-LET maxspalten = 70,{} maxzeilen = 14,{} kleinster wert = 1,{} oben unten return = ""3""10""13"",{} punkt = "+",{} punkt und zurueck = "+"8"",{} piep = ""7"",{} blank = " ";{}INT VAR aktuelle werkstueckbreite,{} aktuelle werkstueckhoehe,{} kleinster aktueller zeichencode,{} groesster aktueller zeichencode,{} aktuelle anzahl der arbeitsphasen,{}
- aktuelle arbeitsphasendauer in minuten,{} aktuelle pausendauer in minuten;{}TEXT VAR aktuelles fehlerzeichen,{} nach rechts,{} nach links,{} nach oben,{} nach unten,{} ausbesserung,{} naechstes;{}BOOL VAR inversdarstellung;{}ROW 11 REAL VAR bewertung;{}WINDOW VAR w1, w2, w3, w4;{}PROC stdvoreinstellung der parameter:{} aktuelle werkstueckbreite := 15;{} aktuelle werkstueckhoehe := 12;{} kleinster aktueller zeichencode := 65;{}
- groesster aktueller zeichencode := 90;{} aktuelle anzahl der arbeitsphasen := 3;{} aktuelle arbeitsphasendauer in minuten := 10;{} aktuelle pausendauer in minuten := 2;{} aktuelles fehlerzeichen := "F";{} nach rechts := ""2"";{} nach links := ""8"";{} nach oben := ""3"";{} nach unten := ""10"";{} ausbesserung := ""1"";{}
- naechstes := ""27"";{} inversdarstellung := FALSE;{} bewertung := ROW 11 REAL : (0.0, 0.1, 0.2, 0.3, 0.4, 0.5,{} 0.6, 0.7, 0.8, 0.9, 1.0){}END PROC stdvoreinstellung der parameter;{}PROC werkstueckdefinition (INT VAR breite, hoehe, kleinster, groesster,{} TEXT VAR fzeichen, BOOL VAR invers):{} breite := aktuelle werkstueckbreite;{} hoehe := aktuelle werkstueckhoehe;{}
- kleinster := kleinster aktueller zeichencode;{} groesster := groesster aktueller zeichencode;{} fzeichen := aktuelles fehlerzeichen;{} invers := inversdarstellung{}END PROC werkstueckdefinition;{}PROC tastendefinition (TEXT VAR rechts, links, hoch, runter, aus, nach):{} rechts := nach rechts;{} links := nach links;{} hoch := nach oben;{} runter := nach unten;{} aus := ausbesserung;{} nach := naechstes{}END PROC tastendefinition;{}
-PROC phasendefinition (INT VAR aphasenzahl, aphasendauer, pausendauer):{} aphasenzahl := aktuelle anzahl der arbeitsphasen;{} aphasendauer := aktuelle arbeitsphasendauer in minuten;{} pausendauer := aktuelle pausendauer in minuten{}END PROC phasendefinition;{}PROC bewertungsschluessel (ROW 11 REAL VAR schluessel):{} INT VAR zeiger;{} FOR zeiger FROM 1 UPTO 11 REP{} schluessel [zeiger] := bewertung [zeiger]{} PER{}END PROC bewertungsschluessel;{}PROC mp bap einstellung anzeigen:{} aktuellen parameterzustand anzeigen;{}
- regenerate menuscreen{}END PROC mp bap einstellung anzeigen;{}PROC mp bap standardwerte:{} standardwerte einstellen;{} regenerate menuscreen{}END PROC mp bap standardwerte;{}PROC mp bap breite des werkstuecks:{} breite des werkstuecks einstellen;{} regenerate menuscreen{}END PROC mp bap breite des werkstuecks;{}PROC mp bap hoehe des werkstuecks:{} hoehe des werkstuecks einstellen;{} regenerate menuscreen{}END PROC mp bap hoehe des werkstuecks;{}PROC mp bap invers normal:{} werkstueckdarstellung einstellen;{}
- regenerate menuscreen{}END PROC mp bap invers normal;{}PROC mp bap zeichensatz:{} zeichensatz einstellen;{} regenerate menuscreen{}END PROC mp bap zeichensatz;{}PROC mp bap fehlerzeichen:{} fehlerzeichen veraendern;{} regenerate menuscreen{}END PROC mp bap fehlerzeichen;{}PROC mp bap tastenbelegung:{} tastaturbelegung einstellen;{} regenerate menuscreen{}END PROC mp bap tastenbelegung;{}PROC mp bap anzahl arbeitsphasen:{} anzahl der arbeitsphasen festlegen;{} regenerate menuscreen{}END PROC mp bap anzahl arbeitsphasen;{}
-PROC mp bap dauer einer arbeitsphase:{} dauer einer arbeitsphase festlegen;{} regenerate menuscreen{}END PROC mp bap dauer einer arbeitsphase;{}PROC mp bap pausendauer:{} pausendauer festlegen;{} regenerate menuscreen{}END PROC mp bap pausendauer;{}PROC mp bap wertungsschluessel:{} wertungsschluessel veraendern;{} regenerate menuscreen{}END PROC mp bap wertungsschluessel;{}PROC aktuellen parameterzustand anzeigen:{} zeige die fenster;{} fuelle die fenster mit inhalt;{} gib hinweis aus.{}
- zeige die fenster:{} w1 := window ( 2, 2, 37, 20);{} w2 := window (41, 2, 38, 20);{} w3 := window ( 1, 1, 79, 24);{} page; show (w1); show (w2).{} fuelle die fenster mit inhalt:{} zeige inhalt fenster 1;{} zeige inhalt fenster 2.{} zeige inhalt fenster 1:{} zeige eingestellte parameter an (w1).{} zeige inhalt fenster 2:{} gib bewertungsschluessel aus (w2).{} gib hinweis aus:{} out footnote (w3, anwendungstext (2)); pause.{}END PROC aktuellen parameterzustand anzeigen;{}
-PROC zeige eingestellte parameter an (WINDOW VAR w):{} zeige ueberschrift;{} zeige werkstueckdefinition;{} zeige tastenbelegung;{} zeige simulationszeiten.{} zeige ueberschrift:{} cursor (w, 1, 1); out (w, center (w, invers (anwendungstext ( 1)))).{} zeige werkstueckdefinition:{} cursor (w, 2, 3); out (w, anwendungstext ( 6));{} out (w, text (aktuelle werkstueckbreite, 3));{} out (w, anwendungstext (28));{} cursor (w, 2, 4); out (w, anwendungstext ( 7));{}
- out (w, text (aktuelle werkstueckhoehe, 3));{} out (w, anwendungstext (28));{} cursor (w, 2, 5); out (w, anwendungstext ( 8));{} IF inversdarstellung{} THEN out (w, anwendungstext (29)){} ELSE out (w, anwendungstext (30)){} FI;{} cursor (w, 2, 6); out (w, anwendungstext ( 9));{} out (w, zeichensatz);{} cursor (w, 2, 7); out (w, anwendungstext (10));{}
- out (blank + aktuelles fehlerzeichen).{} zeige tastenbelegung:{} cursor (w, 2, 9); out (w, anwendungstext (11));{} out (w, tastenbezeichnung (nach rechts));{} cursor (w, 2, 10); out (w, anwendungstext (12));{} out (w, tastenbezeichnung (nach links));{} cursor (w, 2, 11); out (w, anwendungstext (13));{} out (w, tastenbezeichnung (nach oben));{} cursor (w, 2, 12); out (w, anwendungstext (14));{} out (w, tastenbezeichnung (nach unten));{}
- cursor (w, 2, 13); out (w, anwendungstext (15));{} out (w, tastenbezeichnung (ausbesserung));{} cursor (w, 2, 14); out (w, anwendungstext (16));{} out (w, tastenbezeichnung (naechstes)).{} zeige simulationszeiten:{} cursor (w, 2, 16); out (w, anwendungstext (17));{} out (w, text (aktuelle anzahl der arbeitsphasen, 4));{} cursor (w, 2, 17); out (w, anwendungstext (18));{} out (w, text (aktuelle arbeitsphasendauer in minuten, 4));{}
- out (w, anwendungstext (51));{} cursor (w, 2, 18); out (w, anwendungstext (19));{} out (w, text (aktuelle pausendauer in minuten, 4));{} out (w, anwendungstext (51));{} cursor (w, 2, 20); out (w, anwendungstext ( 5));{} out (w, gesamtdauerangabe).{} zeichensatz:{} blank + code (kleinster aktueller zeichencode) + "..." +{} code (groesster aktueller zeichencode) + " (" +{} text (groesster aktueller zeichencode{}
- - kleinster aktueller zeichencode + 1, 2) +{} anwendungstext (28) + ")".{} gesamtdauerangabe:{} text ( arbeitsdauer + pausendauer, 4) + anwendungstext (51).{} arbeitsdauer:{} aktuelle anzahl der arbeitsphasen{} * aktuelle arbeitsphasendauer in minuten.{} pausendauer:{} (aktuelle anzahl der arbeitsphasen - 1){} * aktuelle pausendauer in minuten.{}END PROC zeige eingestellte parameter an;{}PROC gib bewertungsschluessel aus (WINDOW VAR w):{} zeichne koordinatenkreuz;{}
- trage messwerte ein.{} zeichne koordinatenkreuz:{} cursor (w, 1, 1); out (w, center (w, invers (anwendungstext ( 4))));{} cursor (w, 2, 3); out (w, anwendungstext (20));{} cursor (w, 2, 4); out (w, anwendungstext (21));{} cursor (w, 2, 6); out (w, anwendungstext (23));{} cursor (w, 2, 7); out (w, anwendungstext (22));{} cursor (w, 2, 8); out (w, anwendungstext (22));{} cursor (w, 2, 9); out (w, anwendungstext (22));{} cursor (w, 2, 10); out (w, anwendungstext (22));{}
- cursor (w, 2, 11); out (w, anwendungstext (24));{} cursor (w, 2, 12); out (w, anwendungstext (22));{} cursor (w, 2, 13); out (w, anwendungstext (22));{} cursor (w, 2, 14); out (w, anwendungstext (22));{} cursor (w, 2, 15); out (w, anwendungstext (22));{} cursor (w, 2, 16); out (w, anwendungstext (25));{} cursor (w, 2, 17); out (w, anwendungstext (26));{} cursor (w, 2, 19); out (w, anwendungstext (27)).{} trage messwerte ein:{} INT CONST abszisse :: 16, ordinate :: 2;{}
- INT VAR nr;{} FOR nr FROM 1 UPTO 11 REP{} zeichne einen punkt{} PER.{} zeichne einen punkt:{} cursor (w, ordinate + 3 * nr, abszisse - nachkommastelle); out (punkt).{} nachkommastelle:{} int(bewertung [nr] * 10.0).{}END PROC gib bewertungsschluessel aus;{}PROC standardwerte einstellen:{} zeige fenster;{} zeige eingestellte parameter an (w1);{} gib information aus;{} hole bestaetigung ein.{} zeige fenster:{} w1 := window ( 2, 2, 37, 20);{} w2 := window (41, 10, 37, 12);{}
- w3 := window (41, 2, 37, 6);{} page; show (w1); show (w2); show (w3).{} gib information aus:{} cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));{} cursor (w2, 2, 3); out (w2, anwendungstext (67));{} cursor (w2, 2, 4); out (w2, anwendungstext (68));{} cursor (w2, 2, 7); out (w2, anwendungstext (69));{} cursor (w2, 2, 9); out (w2, anwendungstext (70));{} cursor (w2, 2,10); out (w2, anwendungstext (71));{} cursor (w2, 2,11); out (w2, anwendungstext (72));{}
- cursor (w2, 2,12); out (w2, anwendungstext (73)).{} hole bestaetigung ein:{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (66))));{} cursor (w3, 2, 3);{} IF yes (w3, anwendungstext (66)){} THEN stdvoreinstellung der parameter;{} gib positive rueckmeldung{} FI.{} gib positive rueckmeldung:{} page (w1);{} zeige eingestellte parameter an (w1);{} cleop (w3, 2, 3); out (anwendungstext (221));{} cursor (w3, 2, 5); out (anwendungstext ( 3));{}
- pause.{}END PROC standardwerte einstellen;{}PROC breite des werkstuecks einstellen:{} zeige die fenster;{} hinweise an den benutzer ausgeben;{} werkstueck zeigen (w3);{} erfrage veraenderung;{} REP{} neuen wert vom bildschirm holen{} UNTIL benutzer ist einverstanden PER.{} zeige die fenster:{} w1 := window ( 2, 2, 26, 6);{} w2 := window (30, 2, 48, 6);{} w3 := window (2, 9, 77, 16);{} page; show (w1); show (w2).{} hinweise an den benutzer ausgeben:{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{}
- cursor (w1, 2, 3); out (w1, anwendungstext (53));{} out (w1, text (kleinster wert, 3));{} cursor (w1, 2, 4); out (w1, anwendungstext (54));{} out (w1, text (maxspalten, 3));{} cursor (w1, 2, 6); out (w1, anwendungstext (55));{} out (w1, text (aktuelle werkstueckbreite, 3)).{} erfrage veraenderung:{} cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (57))));{} cursor (w2, 2, 3);{} IF no (anwendungstext (216)){}
- THEN LEAVE breite des werkstuecks einstellen{} FI.{} neuen wert vom bildschirm holen:{} cleop (w2, 2, 3); out (w2, anwendungstext (58));{} cursor (w2, 2, 4); out (w2, anwendungstext (59));{} cursor (w2, 2, 6); out (w2, anwendungstext (60));{} aktuelle werkstueckbreite := ermittelter wert (1, maxspalten,{} aktuelle werkstueckbreite).{} benutzer ist einverstanden :{} gib aktuelle infos aus;{} hole bestaetigung.{} gib aktuelle infos aus:{}
- hinweise an den benutzer ausgeben;{} werkstueck zeigen (w3);{} cleop (w2, 1, 3).{} hole bestaetigung:{} cursor (w2, 2, 3);{} IF yes (w2, anwendungstext (62)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC breite des werkstuecks einstellen;{}PROC hoehe des werkstuecks einstellen:{} fenster zeigen;{} hinweise an den benutzer ausgeben;{} werkstueck zeigen (w3);{} erfrage veraenderung;{} REP{} neuen wert vom bildschirm holen{} UNTIL benutzer ist einverstanden PER.{}
- fenster zeigen:{} w1 := window ( 2, 2, 26, 6);{} w2 := window (30, 2, 48, 6);{} w3 := window (2, 9, 77, 16);{} page; show (w1); show (w2).{} hinweise an den benutzer ausgeben:{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{} cursor (w1, 2, 3); out (w1, anwendungstext (53));{} out (w1, text (kleinster wert, 3));{} cursor (w1, 2, 4); out (w1, anwendungstext (54));{} out (w1, text (maxzeilen, 3));{} cursor (w1, 2, 6); out (w1, anwendungstext (55));{}
- out (w1, text (aktuelle werkstueckhoehe, 3)).{} erfrage veraenderung:{} cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (63))));{} cursor (w2, 2, 3);{} IF no (anwendungstext (217)){} THEN LEAVE hoehe des werkstuecks einstellen{} FI.{} neuen wert vom bildschirm holen:{} cleop (w2, 2, 3); out (w2, anwendungstext (58));{} cursor (w2, 2, 4); out (w2, anwendungstext (59));{} cursor (w2, 2, 6); out (w2, anwendungstext (64));{} aktuelle werkstueckhoehe := ermittelter wert (1, maxzeilen,{}
- aktuelle werkstueckhoehe).{} benutzer ist einverstanden :{} gib aktuelle infos aus;{} hole bestaetigung.{} gib aktuelle infos aus:{} hinweise an den benutzer ausgeben;{} werkstueck zeigen (w3);{} cleop (w2, 1, 3).{} hole bestaetigung:{} cursor (w2, 2, 3);{} IF yes (w2, anwendungstext (65)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC hoehe des werkstuecks einstellen;{}PROC werkstueckdarstellung einstellen:{} fenster zeigen;{}
- hinweise an den benutzer ausgeben;{} werkstueck zeigen (w3);{} REP{} bestaetigung einholen;{} hinweise an den benutzer ausgeben;{} werkstueck zeigen (w3){} UNTIL benutzer ist einverstanden PER.{} fenster zeigen:{} w1 := window ( 2, 2, 28, 6);{} w2 := window (32, 2, 46, 6);{} w3 := window ( 2, 9, 77, 16);{} page; show (w1); show (w2).{} hinweise an den benutzer ausgeben:{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{} cursor (w1, 2, 3); out (w1, anwendungstext (74));{}
- out (w1, anwendungstext (76));{} cursor (w1, 2, 4); out (w1, anwendungstext (74));{} out (w1, anwendungstext (77));{} cursor (w1, 2, 6); out (w1, anwendungstext (75));{} IF inversdarstellung{} THEN out (w1, anwendungstext (77)){} ELSE out (w1, anwendungstext (76)){} FI.{} bestaetigung einholen:{} page (w2);{} cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (89))));{}
- cursor (w2, 2, 3);{} IF yes (w2, anwendungstext (78)){} THEN veraendere darstellungsart{} ELSE LEAVE werkstueckdarstellung einstellen{} FI.{} veraendere darstellungsart:{} IF inversdarstellung{} THEN inversdarstellung := FALSE{} ELSE inversdarstellung := TRUE{} FI.{} benutzer ist einverstanden:{} cleop (w2, 1, 3);{} cursor (w2, 2, 3);{} IF yes (w2, anwendungstext (99)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC werkstueckdarstellung einstellen;{}
-PROC zeichensatz einstellen:{} zeige fenster;{} gib eingestellten zeichensatz an;{} gib bedienhinweise aus;{} erfrage neueinstellung;{} REP{} erfrage das neue fehlerzeichen;{} ermittle das kleinste zeichen;{} ermittle das groesste zeichen;{} page (w1);{} gib eingestellten zeichensatz an{} UNTIL benutzer ist einverstanden PER.{} zeige fenster:{} w1 := window ( 2, 2, 28, 22);{} w2 := window (32, 10, 46, 14);{} w3 := window (32, 2, 46, 6);{} page; show (w1); show (w2); show (w3).{}
- gib eingestellten zeichensatz an:{} cursor (w1, 1, 1);{} out (w1, center (w1, invers (anwendungstext (79))));{} gib zeichenkette aus (w1, kleinster aktueller zeichencode,{} groesster aktueller zeichencode,{} code (aktuelles fehlerzeichen)).{} gib bedienhinweise aus:{} cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));{} cursor (w2, 2, 3); out (w2, anwendungstext (80));{} cursor (w2, 2, 4); out (w2, anwendungstext (81));{}
- cursor (w2, 2, 5); out (w2, anwendungstext (82));{} cursor (w2, 2, 6); out (w2, anwendungstext (83));{} cursor (w2, 2, 8); out (w2, anwendungstext (84));{} cursor (w2, 2, 9); out (w2, anwendungstext (85));{} cursor (w2, 2,10); out (w2, anwendungstext (86));{} cursor (w2, 2,12); out (w2, anwendungstext (87));{} cursor (w2, 2,13); out (w2, anwendungstext (88)).{} erfrage neueinstellung:{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (90))));{} cursor (w3, 2, 3);{}
- IF no (w3, anwendungstext (91)){} THEN LEAVE zeichensatz einstellen{} FI.{} erfrage das neue fehlerzeichen:{} gib vollstaendigen zeichensatz aus;{} gib fehlerzeicheninformationen aus;{} REP{} lasse fehlerzeichen eingeben{} UNTIL fehlerzeichen ist ok PER.{} gib vollstaendigen zeichensatz aus:{} page (w1); page (w2); page (w3);{} cursor (w1, 1, 1);{} out (w1, center (w1, invers (anwendungstext (92))));{} gib zeichenkette aus (w1, 33, 126, 0).{} gib fehlerzeicheninformationen aus:{}
- cursor (w2, 1, 1);{} out (w2, center (w2, invers (anwendungstext (52))));{} cursor (w2, 2, 3); out (w2, anwendungstext (95));{} cursor (w2, 2, 4); out (w2, anwendungstext (96));{} cursor (w2, 2, 6); out (w2, anwendungstext (97)).{} lasse fehlerzeichen eingeben:{} cursor (w3, 1, 1);{} out (w3, center (w3, invers (anwendungstext (100))));{} cursor (w3, 2, 3);{} out (w3, anwendungstext (101));{} cursor on; inchar (aktuelles fehlerzeichen); cursor off;{} IF fehlerzeichen ist ok{}
- THEN out (w3, aktuelles fehlerzeichen);{} markiere das fehlerzeichen im ersten fenster;{} ELSE lege beschwerde ein{} FI.{} fehlerzeichen ist ok:{} code (aktuelles fehlerzeichen) >= 33{} AND code (aktuelles fehlerzeichen) <= 126.{} markiere das fehlerzeichen im ersten fenster:{} positioniere cursor in zeichenkette (w1, 33, code (aktuelles fehlerzeichen));{} out (w1, invers (aktuelles fehlerzeichen)).{} lege beschwerde ein:{} piepse;{} cursor (w2, 2, 8); out (w2, anwendungstext (102));{}
- cursor (w2, 2,10); out (w2, anwendungstext (103));{} cursor (w2, 2,11); out (w2, anwendungstext (104));{} cursor (w2, 2,12); out (w2, anwendungstext (105));{} cursor (w2, 2,13); out (w2, anwendungstext (106));{} cursor (w2, 2,14); out (w2, anwendungstext (107)).{} ermittle das kleinste zeichen:{} page (w2); page (w3);{} gib kleinste zeichencode informationen aus;{} lasse den vorbereich festlegen.{} ermittle das groesste zeichen:{} lasse den nachbereich festlegen.{} gib kleinste zeichencode informationen aus:{}
- cursor (w2, 1, 1);{} out (w2, center (w2, invers (anwendungstext (52))));{} cursor (w2, 2, 3); out (w2, anwendungstext (111));{} cursor (w2, 2, 4); out (w2, anwendungstext (112));{} cursor (w2, 2, 5); out (w2, anwendungstext (113));{} cursor (w2, 2, 6); out (w2, anwendungstext (114));{} cursor (w2, 2, 8); out (w2, anwendungstext (115));{} cursor (w2, 2, 9); out (w2, anwendungstext (116));{} cursor (w2, 2,10); out (w2, anwendungstext (117));{} cursor (w2, 2,11); out (w2, anwendungstext (118));{}
- cursor (w2, 2,13); out (w2, anwendungstext (119));{} cursor (w2, 2,14); out (w2, anwendungstext (120)).{} lasse den vorbereich festlegen:{} INT VAR s, z; page (w3); cursor (w3, 1, 1);{} out (w3, center (w3, invers (anwendungstext (121))));{} cursor (w3, 2, 3); out (w3, anwendungstext (122));{} cursor (w3, 2, 4); out (w3, anwendungstext (123));{} cursor (w3, 2, 5); out (w3, anwendungstext (125));{} get cursor (s, z); cursor on;{} kleinster aktueller zeichencode := code (aktuelles fehlerzeichen);{}
- groesster aktueller zeichencode := code (aktuelles fehlerzeichen);{} kleinster aktueller zeichencode := eingabe mit intervallanzeige ( w1, 33,{} code (aktuelles fehlerzeichen),{} kleinster aktueller zeichencode, s, z);{} cursor off.{} lasse den nachbereich festlegen:{} cursor (w3, 1, 1);{} out (w3, center (w3, invers (anwendungstext (121))));{} cursor (w3, 2, 3); out (w3, anwendungstext (122));{} cursor (w3, 2, 4); out (w3, anwendungstext (124));{}
- cursor (w3, 2, 5); out (w3, anwendungstext (125));{} get cursor (s, z); cursor on;{} groesster aktueller zeichencode := eingabe mit intervallanzeige ( w1,{} code (aktuelles fehlerzeichen), 126,{} groesster aktueller zeichencode, s, z);{} cursor off.{} benutzer ist einverstanden:{} page (w3); cursor (w3, 1, 1);{} out (w3, center (w3, invers (anwendungstext (90))));{} cursor (w3, 2, 3);{} IF yes (w3, anwendungstext (126)){}
- THEN TRUE{} ELSE FALSE{} FI.{}END PROC zeichensatz einstellen;{}PROC fehlerzeichen veraendern:{} fenster zeigen;{} gib eingestellten zeichensatz an;{} gib bedienhinweise aus;{} erfrage neueinstellung;{} REP{} lasse fehlerzeichen einstellen{} UNTIL benutzer ist einverstanden PER.{} fenster zeigen:{} w1 := window ( 2, 2, 28, 22);{} w2 := window (32, 10, 46, 14);{} w3 := window (32, 2, 46, 6);{} page; show (w1); show (w2); show (w3).{} gib eingestellten zeichensatz an:{}
- cursor (w1, 1, 1);{} out (w1, center (w1, invers (anwendungstext (79))));{} gib zeichenkette aus (w1, kleinster aktueller zeichencode,{} groesster aktueller zeichencode,{} code (aktuelles fehlerzeichen)).{} gib bedienhinweise aus:{} cursor (w2, 1, 1);{} out (w2, center (w2, invers (anwendungstext (52))));{} cursor (w2, 2, 3); out (w2, anwendungstext (131));{} cursor (w2, 2, 4); out (w2, anwendungstext (132));{} cursor (w2, 2, 5); out (w2, anwendungstext (133));{}
- cursor (w2, 2, 7); out (w2, anwendungstext (134));{} cursor (w2, 2, 8); out (w2, anwendungstext (135));{} cursor (w2, 2, 9); out (w2, anwendungstext (136)).{} erfrage neueinstellung:{} cursor (w3, 1, 1);{} out (w3, center (w3, invers (anwendungstext (130))));{} cursor (w3, 2, 3);{} IF no (w3, anwendungstext (137)){} THEN LEAVE fehlerzeichen veraendern{} FI.{} lasse fehlerzeichen einstellen:{} INT VAR s, z, fehlercode :: code (aktuelles fehlerzeichen);{} page (w3); cursor (w3, 1, 1);{}
- out (w3, center (w3, invers (anwendungstext (138))));{} cursor (w3, 2, 3); out (w3, anwendungstext (139));{} cursor (w3, 2, 4); out (w3, anwendungstext (140));{} cursor (w3, 2, 5); out (w3, anwendungstext (141));{} get cursor (s, z); cursor on;{} fehlercode := eingabe mit elementanzeige (w1,{} kleinster aktueller zeichencode,{} groesster aktueller zeichencode,{} fehlercode, s, z);{}
- cursor off;{} aktuelles fehlerzeichen := code (fehlercode).{} benutzer ist einverstanden:{} page (w3); cursor (w3, 1, 1);{} out (w3, center (w3, invers (anwendungstext (130))));{} cursor (w3, 2, 3);{} IF yes (w3, anwendungstext (142)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC fehlerzeichen veraendern;{}PROC tastaturbelegung einstellen:{} ROW 6 TEXT VAR tastenname, taste;{} fenster zeigen;{} REP{} tastaturneubelegung vornehmen{} UNTIL benutzer ist einverstanden PER.{}
- fenster zeigen:{} w1 := window ( 2, 2, 28, 10);{} w2 := window ( 2, 14, 28, 10);{} w3 := window (32, 10, 46, 14);{} w4 := window (32, 2, 46, 6);{} page; show (w1); show (w2); show (w3); show (w4).{} tastaturneubelegung vornehmen:{} alte tastenbelegung einlesen;{} tastenbelegung anzeigen;{} bedienhinweise ausgeben;{} veraenderung erfragen;{} neue tastenbelegung erfragen;{} hinweis zur bewertung und stand ausgeben.{} alte tastenbelegung einlesen:{} INT VAR z1;{}
- FOR z1 FROM 1 UPTO 6 REP{} tastenname [z1] := anwendungstext (z1 + 10){} PER;{} taste [1] := nach rechts;{} taste [2] := nach links;{} taste [3] := nach oben;{} taste [4] := nach unten;{} taste [5] := ausbesserung;{} taste [6] := naechstes;{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (151)))).{} tastenbelegung anzeigen:{} INT VAR cspa, czei;{} cursor (w1, 2, 3); out (w1, tastenname [1]);{} out (w1, tastenbezeichnung (taste [1]));{}
- get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{} cursor (w1, 2, 4); out (w1, tastenname [2]);{} out (w1, tastenbezeichnung (taste [2]));{} get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{} cursor (w1, 2, 5); out (w1, tastenname [3]);{} out (w1, tastenbezeichnung (taste [3]));{} get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{} cursor (w1, 2, 6); out (w1, tastenname [4]);{}
- out (w1, tastenbezeichnung (taste [4]));{} get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{} cursor (w1, 2, 8); out (w1, tastenname [5]);{} out (w1, tastenbezeichnung (taste [5]));{} get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{} cursor (w1, 2,10); out (w1, tastenname [6]);{} out (w1, tastenbezeichnung (taste [6]));{} get cursor (w1, cspa, czei); cleol (w1, cspa, czei).{}
- bedienhinweise ausgeben:{} cursor (w2, 1, 1); out (center (w2, invers (anwendungstext (152))));{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (52))));{} cursor (w3, 2, 3); out (w3, anwendungstext (153));{} cursor (w3, 2, 4); out (w3, anwendungstext (154));{} cursor (w3, 2, 6); out (w3, anwendungstext (155));{} cursor (w3, 2, 7); out (w3, anwendungstext (156));{} cursor (w3, 2, 8); out (w3, anwendungstext (157));{} cursor (w3, 2, 9); out (w3, anwendungstext (158));{}
- cursor (w3, 2,11); out (w3, anwendungstext (159));{} cursor (w3, 2,12); out (w3, anwendungstext (160));{} cursor (w3, 2,13); out (w3, anwendungstext (161));{} cursor (w3, 2,14); out (w3, anwendungstext (162)).{} veraenderung erfragen:{} cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));{} cursor (w4, 2, 3);{} IF no (w4, anwendungstext (164)){} THEN LEAVE tastaturbelegung einstellen{} FI.{} neue tastenbelegung erfragen:{} INT VAR z2; page (w4);{}
- cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));{} cursor (w4, 2, 3); out (w4, anwendungstext (165));{} FOR z2 FROM 1 UPTO 6 REP{} gib tastenhinweis;{} hole tastatureingabe;{} tastenbelegung anzeigen{} PER.{} gib tastenhinweis:{} cleol (w4, 2, 5); out (w4, tastenname [z2]).{} hole tastatureingabe:{} INT VAR s, z; get cursor (w4, s, z);{} cursor on; inchar (taste [z2]); cursor off;{} cursor (w4, s, z); out (w4, tastenbezeichnung (taste [z2])).{}
- hinweis zur bewertung und stand ausgeben:{} IF neue tastenbelegung ist ok{} THEN akzeptiere{} ELSE akzeptiere nicht{} FI.{} neue tastenbelegung ist ok:{} INT VAR zeiger; TEXT VAR tastenkette :: "";{} FOR zeiger FROM 1 UPTO 6 REP{} IF pos (tastenkette, taste [zeiger]) > 0{} THEN LEAVE neue tastenbelegung ist ok WITH FALSE{} ELSE tastenkette CAT taste [zeiger]{} FI{} PER;{} TRUE.{} akzeptiere:{} cursor (w2, 3, 4);{} out (w2, anwendungstext (166));{}
- cursor (w2, 7, 6);{} out (w2, anwendungstext (167)).{} akzeptiere nicht:{} cursor (w2, 3, 3); out (w2, anwendungstext (168));{} cursor (w2, 3, 4); out (w2, anwendungstext (169));{} cursor (w2, 3, 6); out (w2, anwendungstext (170));{} cursor (w2, 3, 7); out (w2, anwendungstext (171));{} cursor (w2, 3, 9); out (w2, anwendungstext (172));{} cursor (w2, 5,10); out (w2, anwendungstext (173)).{} benutzer ist einverstanden:{} page (w4);{} cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));{}
- IF neue tastenbelegung ist ok{} THEN gib hinweis auf abspeicherung{} ELSE frage nach neueingabe{} FI.{} gib hinweis auf abspeicherung:{} cursor (w4, 3, 3); out (w4, anwendungstext (174));{} neue tastenbelegung festschreiben;{} cursor (w4, 3, 5); out (w4, anwendungstext ( 2));{} cursor on; pause; cursor off;{} TRUE.{} neue tastenbelegung festschreiben:{} nach rechts := taste [1];{} nach links := taste [2];{} nach oben := taste [3];{} nach unten := taste [4];{}
- ausbesserung := taste [5];{} naechstes := taste [6].{} frage nach neueingabe:{} cursor (w4, 2, 3);{} IF yes (w4, anwendungstext (175)){} THEN cleop (w2, 1, 3); FALSE{} ELSE alte tastenbelegung einlesen;{} tastenbelegung anzeigen;{} cleop (w4, 2, 3); out (w4, anwendungstext (176));{} cursor (w4, 3, 5); out (w4, anwendungstext ( 2));{} cursor on; pause; cursor off;{} TRUE{} FI.{}END PROC tastaturbelegung einstellen;{}
-PROC simulationszeiten anzeigen (WINDOW VAR w):{} cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (181))));{} cursor (w, 2, 3); out (w, anwendungstext (17));{} out (w, text (aktuelle anzahl der arbeitsphasen, 4));{} cursor (w, 2, 4); out (w, anwendungstext (18));{} out (w, text (aktuelle arbeitsphasendauer in minuten, 4));{} out (w, anwendungstext (51));{} cursor (w, 2, 5); out (w, anwendungstext (19));{} out (w, text (aktuelle pausendauer in minuten, 4));{}
- out (w, anwendungstext (51));{} cursor (w, 2, 7); out (w, anwendungstext ( 5));{} out (w, gesamtdauerangabe).{} gesamtdauerangabe:{} text ( arbeitsdauer + pausendauer, 4) + anwendungstext (51).{} arbeitsdauer:{} aktuelle anzahl der arbeitsphasen{} * aktuelle arbeitsphasendauer in minuten.{} pausendauer:{} (aktuelle anzahl der arbeitsphasen - 1){} * aktuelle pausendauer in minuten.{}END PROC simulationszeiten anzeigen;{}PROC anzahl der arbeitsphasen festlegen:{}
- INT CONST minwert :: 2, maxwert :: 20;{} zeige fenster;{} hinweise an den benutzer ausgeben;{} simulationszeiten anzeigen (w2);{} erfrage veraenderung;{} REP{} neuen wert vom bildschirm holen{} UNTIL benutzer ist einverstanden PER.{} zeige fenster:{} w1 := window ( 2, 2, 28, 6);{} w2 := window (22, 12, 37, 7);{} w3 := window (32, 2, 47, 6);{} page; show (w1); show (w2); show (w3).{} hinweise an den benutzer ausgeben:{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{}
- cursor (w1, 2, 3); out (w1, anwendungstext (53));{} out (w1, text (minwert, 2));{} cursor (w1, 2, 4); out (w1, anwendungstext (54));{} out (w1, text (maxwert, 2));{} cursor (w1, 2, 6); out (w1, anwendungstext (55));{} out (w1, text (aktuelle anzahl der arbeitsphasen, 2)).{} erfrage veraenderung:{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (182))));{} cursor (w3, 2, 3);{} IF no (anwendungstext (218)){}
- THEN LEAVE anzahl der arbeitsphasen festlegen{} FI.{} neuen wert vom bildschirm holen:{} cleop (w3, 2, 3); out (w3, anwendungstext ( 58));{} cursor (w3, 2, 4); out (w3, anwendungstext ( 59));{} cursor (w3, 2, 6); out (w3, anwendungstext (183));{} aktuelle anzahl der arbeitsphasen := ermittelter wert (minwert, maxwert,{} aktuelle anzahl der arbeitsphasen).{} benutzer ist einverstanden:{} hinweise an den benutzer ausgeben;{} simulationszeiten anzeigen (w2);{}
- cleop (w3, 2, 3);{} IF yes (w3, anwendungstext (184)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC anzahl der arbeitsphasen festlegen;{}PROC dauer einer arbeitsphase festlegen:{} INT CONST minwert :: 1, maxwert :: 60;{} zeige fenster;{} hinweise an den benutzer ausgeben;{} simulationszeiten anzeigen (w2);{} erfrage veraenderung;{} REP{} neuen wert vom bildschirm holen{} UNTIL benutzer ist einverstanden PER.{} zeige fenster:{} w1 := window ( 2, 2, 28, 6);{} w2 := window (22, 12, 37, 7);{}
- w3 := window (32, 2, 47, 6);{} page; show (w1); show (w2); show (w3).{} hinweise an den benutzer ausgeben:{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{} cursor (w1, 2, 3); out (w1, anwendungstext (53));{} out (w1, text (minwert, 2));{} out (w1, anwendungstext (51));{} cursor (w1, 2, 4); out (w1, anwendungstext (54));{} out (w1, text (maxwert, 2));{} out (w1, anwendungstext (51));{}
- cursor (w1, 2, 6); out (w1, anwendungstext (55));{} out (w1, text (aktuelle arbeitsphasendauer in minuten, 2));{} out (w1, anwendungstext (51)).{} erfrage veraenderung:{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (187))));{} cursor (w3, 2, 3);{} IF no (anwendungstext (219)){} THEN LEAVE dauer einer arbeitsphase festlegen{} FI.{} neuen wert vom bildschirm holen:{} INT VAR spa, zei;{} cleop (w3, 2, 3); out (w3, anwendungstext ( 58));{}
- cursor (w3, 2, 3); out (w3, anwendungstext ( 58));{} cursor (w3, 2, 4); out (w3, anwendungstext ( 59));{} cursor (w3, 2, 6); out (w3, anwendungstext (188));{} get cursor (w3, spa, zei);{} cursor (w3, spa + 3, zei); out (w3, anwendungstext (51));{} cursor (w3, spa, zei);{} aktuelle arbeitsphasendauer in minuten{} := ermittelter wert (minwert, maxwert,{} aktuelle arbeitsphasendauer in minuten).{} benutzer ist einverstanden:{}
- hinweise an den benutzer ausgeben;{} simulationszeiten anzeigen (w2);{} cleop (w3, 2, 3);{} IF yes (w3, anwendungstext (189)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC dauer einer arbeitsphase festlegen;{}PROC pausendauer festlegen:{} INT CONST minwert :: 1, maxwert :: 30;{} zeige fenster;{} hinweise an den benutzer ausgeben;{} simulationszeiten anzeigen (w2);{} erfrage veraenderung;{} REP{} neuen wert vom bildschirm holen{} UNTIL benutzer ist einverstanden PER.{}
- zeige fenster:{} w1 := window ( 2, 2, 28, 6);{} w2 := window (22, 12, 37, 7);{} w3 := window (32, 2, 47, 6);{} page; show (w1); show (w2); show (w3).{} hinweise an den benutzer ausgeben:{} cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{} cursor (w1, 2, 3); out (w1, anwendungstext (53));{} out (w1, text (minwert, 2));{} out (w1, anwendungstext (51));{} cursor (w1, 2, 4); out (w1, anwendungstext (54));{}
- out (w1, text (maxwert, 2));{} out (w1, anwendungstext (51));{} cursor (w1, 2, 6); out (w1, anwendungstext (55));{} out (w1, text (aktuelle pausendauer in minuten, 2));{} out (w1, anwendungstext (51)).{} erfrage veraenderung:{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (191))));{} cursor (w3, 2, 3);{} IF no (anwendungstext (220)){} THEN LEAVE pausendauer festlegen{} FI.{}
- neuen wert vom bildschirm holen:{} INT VAR spa, zei;{} cleop (w3, 2, 3); out (w3, anwendungstext ( 58));{} cursor (w3, 2, 4); out (w3, anwendungstext ( 59));{} cursor (w3, 2, 6); out (w3, anwendungstext (192));{} get cursor (w3, spa, zei);{} cursor (w3, spa + 3, zei); out (w3, anwendungstext (51));{} cursor (w3, spa, zei);{} aktuelle pausendauer in minuten{} := ermittelter wert (minwert, maxwert,{} aktuelle pausendauer in minuten).{}
- benutzer ist einverstanden:{} hinweise an den benutzer ausgeben;{} simulationszeiten anzeigen (w2);{} cleop (w3, 2, 3);{} IF yes (w3, anwendungstext (193)){} THEN TRUE{} ELSE FALSE{} FI.{}END PROC pausendauer festlegen;{}PROC wertungsschluessel veraendern:{} INT CONST abszisse :: 16, ordinate :: 2;{} zeige fenster;{} gib bewertungsschluessel aus (w1);{} gib informationen aus;{} stelle frage nach veraenderung;{} REP{} neueinstellung{} UNTIL benutzer ist einverstanden PER.{}
- zeige fenster:{} w1 := window ( 2, 2, 38, 22);{} w2 := window (42, 10, 37, 14);{} w3 := window (42, 2, 37, 6);{} page; show (w1); show (w2); show (w3).{} gib informationen aus:{} cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));{} cursor (w2, 2, 3); out (w2, anwendungstext (195));{} cursor (w2, 2, 4); out (w2, anwendungstext (196));{} cursor (w2, 2, 6); out (w2, anwendungstext (197));{} cursor (w2, 2, 7); out (w2, anwendungstext (198));{} cursor (w2, 2, 8); out (w2, anwendungstext (199));{}
- cursor (w2, 2,11); out (w2, anwendungstext (200));{} cursor (w2, 2,12); out (w2, anwendungstext (201));{} cursor (w2, 2,13); out (w2, anwendungstext (202)).{} stelle frage nach veraenderung:{} cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (205))));{} cursor (w3, 2, 3);{} IF no (anwendungstext (206)){} THEN LEAVE wertungsschluessel veraendern{} ELSE gib hinweis auf linkes fenster{} FI.{} gib hinweis auf linkes fenster:{} cleop (w3, 2, 3); out (w3, anwendungstext (211));{}
- cursor (w3, 2, 4); out (w3, anwendungstext (212));{} cursor (w3, 2, 5); out (w3, anwendungstext (213)).{} neueinstellung:{} INT VAR zeiger;{} cursor an;{} FOR zeiger FROM 1 UPTO 11 REP{} gehe auf aktuelle punktposition;{} lasse verschieben{} PER;{} cursor aus.{} gehe auf aktuelle punktposition:{} cursor (w1, ordinate + 3 * zeiger, abszisse - nachkommastelle).{} nachkommastelle:{} int (bewertung [zeiger] * 10.0).{} lasse verschieben:{} TEXT VAR eingabezeichen; INT VAR position;{}
- REP{} inchar (eingabezeichen);{} position := pos (oben unten return, eingabezeichen);{} fuehre angemessene reaktion aus{} UNTIL position = 3 PER.{} fuehre angemessene reaktion aus:{} SELECT position OF{} CASE 1: steige auf{} CASE 2: steige ab{} CASE 3: (* tue nichts *){} OTHERWISE piepse{} END SELECT.{} steige auf:{} IF bewertung [zeiger] < 1.0{} THEN loesche alten punkt;{} bewertung [zeiger] INCR 0.1;{} schreibe neuen punkt{}
- ELSE piepse{} FI.{} steige ab:{} IF bewertung [zeiger] > 0.0{} THEN loesche alten punkt;{} bewertung [zeiger] DECR 0.1;{} schreibe neuen punkt{} ELSE piepse{} FI.{} loesche alten punkt:{} INT VAR tabspalte, tabzeile;{} gehe auf aktuelle punktposition;{} get cursor (w1, tabspalte, tabzeile);{} IF tabspalte = ordinate + 3 OR tabzeile = abszisse{} THEN out (w1, "|"){} ELSE out (w1, blank){} FI.{} schreibe neuen punkt:{} gehe auf aktuelle punktposition;{}
- out (w1, punkt und zurueck).{} benutzer ist einverstanden:{} cleop (w3, 2, 3);{} IF yes (w3, anwendungstext (207)){} THEN TRUE{} ELSE gib hinweis auf linkes fenster;{} FALSE{} FI.{}END PROC wertungsschluessel veraendern;{}PROC cleol (WINDOW VAR w, INT CONST cursorspalte, cursorzeile):{} cursor (w, cursorspalte, cursorzeile);{} IF remaining lines (w) > 1{} THEN out (w, (areaxsize (w) - cursorspalte + 1) * blank){} ELSE out (w, (areaxsize (w) - cursorspalte) * blank){}
- FI;{} cursor (w, cursorspalte, cursorzeile){}END PROC cleol;{}PROC cleop (WINDOW VAR w, INT CONST cursorspalte, cursorzeile):{} cleol (w, cursorspalte, cursorzeile);{} INT VAR i;{} FOR i FROM 1 UPTO remaining lines (w) REP{} cleol (w, 1, cursorzeile + i){} PER;{} cursor (w, cursorspalte, cursorzeile){}END PROC cleop;{}PROC cursor an:{} INT VAR spalte, zeile;{} get cursor (spalte, zeile); cursor on; cursor (spalte, zeile){}END PROC cursor an;{}PROC cursor aus:{} INT VAR spalte, zeile;{}
- get cursor (spalte, zeile); cursor off; cursor (spalte, zeile){}END PROC cursor aus;{}INT PROC eingabe mit intervallanzeige (WINDOW VAR w, INT CONST minwert,{} maxwert, anfangswert, cursorspalte,{} cursorzeile):{} BOOL VAR ist aufsteigend :: minwert = anfangswert;{} INT VAR aktueller wert :: anfangswert, alter wert, eingelesener wert;{} REP{} hole position aus vorgabe (oben unten return, eingelesener wert);{} SELECT eingelesener wert OF{}
- CASE 1: erniedrige aktuellen wert wenn moeglich{} CASE 2: erhoehe aktuellen wert wenn moeglich{} END SELECT{} UNTIL eingelesener wert = 3 PER;{} aktueller wert.{} erniedrige aktuellen wert wenn moeglich:{} IF aktueller wert > minwert{} THEN alter wert := aktueller wert;{} aktueller wert DECR 1;{} IF ist aufsteigend{} THEN loesche alte markierung{} ELSE markiere neues zeichen{} FI{} ELSE piepse{} FI.{} erhoehe aktuellen wert wenn moeglich:{}
- IF aktueller wert < maxwert{} THEN alter wert := aktueller wert;{} aktueller wert INCR 1;{} IF ist aufsteigend{} THEN markiere neues zeichen{} ELSE loesche alte markierung{} FI{} ELSE piepse{} FI.{} loesche alte markierung:{} positioniere cursor in zeichenkette (w, 33, alter wert);{} out (w, code (alter wert) + " ");{} cursor (cursorspalte, cursorzeile).{} markiere neues zeichen:{} positioniere cursor in zeichenkette (w, 33, aktueller wert);{}
- out (w, invers (code (aktueller wert)));{} cursor (cursorspalte, cursorzeile).{}END PROC eingabe mit intervallanzeige;{}INT PROC eingabe mit elementanzeige (WINDOW VAR w, INT CONST minwert,{} maxwert, anfangswert,{} cursorspalte, cursorzeile):{} INT VAR aktueller wert :: anfangswert, alter wert, eingelesener wert;{} REP{} hole position aus vorgabe (oben unten return, eingelesener wert);{} SELECT eingelesener wert OF{}
- CASE 1: erniedrige aktuellen wert wenn moeglich{} CASE 2: erhoehe aktuellen wert wenn moeglich{} END SELECT{} UNTIL eingelesener wert = 3 PER;{} aktueller wert.{} erniedrige aktuellen wert wenn moeglich:{} IF aktueller wert > minwert{} THEN alter wert := aktueller wert;{} aktueller wert DECR 1;{} loesche alte markierung;{} markiere neues zeichen{} ELSE piepse{} FI.{} erhoehe aktuellen wert wenn moeglich:{} IF aktueller wert < maxwert{}
- THEN alter wert := aktueller wert;{} aktueller wert INCR 1;{} loesche alte markierung;{} markiere neues zeichen{} ELSE piepse{} FI.{} loesche alte markierung:{} positioniere cursor in zeichenkette (w, minwert, alter wert);{} out (w, code (alter wert) + " ");{} cursor (cursorspalte, cursorzeile).{} markiere neues zeichen:{} positioniere cursor in zeichenkette (w, minwert, aktueller wert);{} out (w, invers (code (aktueller wert)));{}
- cursor (cursorspalte, cursorzeile).{}END PROC eingabe mit elementanzeige;{}PROC werkstueck zeigen (WINDOW VAR w):{} INT VAR zaehler, spalte, zeile;{} page (w);{} werkstueckaufhaenger (spalte, zeile);{} schreibe werkstueck zeilenweise.{} schreibe werkstueck zeilenweise:{} FOR zaehler FROM 1 UPTO aktuelle werkstueckhoehe REP{} positioniere den cursor;{} bastle eine zeile;{} gib eine zeile aus{} PER.{} positioniere den cursor:{} cursor (w, spalte, zeile + zaehler - 1).{}
- bastle eine zeile:{} TEXT VAR zeileninhalt := "";{} INT VAR z;{} FOR z FROM 1 UPTO aktuelle werkstueckbreite REP{} zeileninhalt CAT code (random (kleinster aktueller zeichencode,{} groesster aktueller zeichencode)){} PER.{} gib eine zeile aus:{} IF inversdarstellung{} THEN out (w, invers (zeileninhalt)){} ELSE out (w, zeileninhalt){} FI.{}END PROC werkstueck zeigen;{}PROC werkstueckaufhaenger (INT VAR spalte, zeile):{} spalte := ((maxspalten - aktuelle werkstueckbreite) DIV 2) + 3;{}
- zeile := ((maxzeilen - aktuelle werkstueckhoehe ) DIV 2) + 2;{} IF inversdarstellung THEN spalte DECR 1 FI{}END PROC werkstueckaufhaenger;{}PROC gib zeichenkette aus (WINDOW VAR w,{} INT CONST kleinster, groesster, markiertes):{} INT VAR zaehler;{} FOR zaehler FROM kleinster UPTO groesster REP{} positioniere cursor in zeichenkette (w, kleinster, zaehler);{} IF zaehler = markiertes{} THEN out (w, invers (code (zaehler))){} ELSE out (w, code (zaehler)){}
- FI{} PER{}END PROC gib zeichenkette aus;{}PROC positioniere cursor in zeichenkette (WINDOW VAR w,{} INT CONST mincode, position):{} cursor (w, 4 + ((position - mincode) DIV 19) * 5,{} 3 + ((position - mincode) MOD 19)){}END PROC positioniere cursor in zeichenkette;{}TEXT PROC tastenbezeichnung (TEXT CONST zeichen):{} IF code (zeichen) >= 33 AND code (zeichen) <= 126{} THEN "<" + zeichen + ">"{} ELSE umgesetzter code{} FI.{} umgesetzter code:{}
- SELECT code (zeichen) OF{} CASE 1: anwendungstext (31){} CASE 2: anwendungstext (32){} CASE 3: anwendungstext (33){} CASE 8: anwendungstext (34){} CASE 9: anwendungstext (35){} CASE 10: anwendungstext (36){} CASE 11: anwendungstext (37){} CASE 12: anwendungstext (38){} CASE 13: anwendungstext (39){} CASE 16: anwendungstext (40){} CASE 27: anwendungstext (41){} CASE 32: anwendungstext (42){} CASE 214: anwendungstext (43){}
- CASE 215: anwendungstext (44){} CASE 216: anwendungstext (45){} CASE 217: anwendungstext (46){} CASE 218: anwendungstext (47){} CASE 219: anwendungstext (48){} CASE 251: anwendungstext (49){} OTHERWISE anwendungstext (50){} END SELECT{}END PROC tastenbezeichnung;{}INT PROC ermittelter wert (INT CONST minimum, maximum, startwert):{} INT VAR aktueller wert, eingelesener wert;{} cursor an;{} aktueller wert := startwert;{} REP{} gib dreistellig aus und positioniere zurueck (aktueller wert, FALSE);{}
- hole position aus vorgabe (oben unten return, eingelesener wert);{} SELECT eingelesener wert OF{} CASE 1: erhoehe aktuellen wert wenn moeglich{} CASE 2: erniedrige aktuellen wert wenn moeglich{} END SELECT{} UNTIL eingelesener wert = 3 PER;{} cursor aus;{} aktueller wert.{} erhoehe aktuellen wert wenn moeglich:{} IF aktueller wert < maximum{} THEN aktueller wert INCR 1{} ELSE piepse{} FI.{} erniedrige aktuellen wert wenn moeglich:{} IF aktueller wert > minimum{}
- THEN aktueller wert DECR 1{} ELSE piepse{} FI.{}END PROC ermittelter wert;{}PROC gib dreistellig aus und positioniere zurueck (INT CONST wert,{} BOOL CONST mit wertwandel):{} INT VAR spalte, zeile; get cursor (spalte, zeile);{} IF mit wertwandel{} THEN out ("'" + code (wert) + "'"){} ELSE out (text (wert, 3)){} FI;{} cursor (spalte, zeile);{}END PROC gib dreistellig aus und positioniere zurueck;{}PROC hole position aus vorgabe (TEXT CONST vorgabe, INT VAR position):{}
- TEXT VAR eingabezeichen; INT VAR spa, zei;{} REP{} get cursor (spa, zei); inchar (eingabezeichen); cursor (spa, zei);{} position := pos (vorgabe, eingabezeichen);{} IF position = 0 THEN piepse; cursor (spa, zei) FI{} UNTIL position > 0 PER{}END PROC hole position aus vorgabe;{}PROC piepse:{} INT VAR spa, zei; get cursor (spa, zei); out (piep); cursor (spa, zei){}END PROC piepse;{}END PACKET ls mp bap 1;{}stdvoreinstellung der parameter{}
+LET maxspalten = 70,
+ maxzeilen = 14,
+ kleinster wert = 1,
+ oben unten return = ""3""10""13"",
+ punkt = "+",
+ punkt und zurueck = "+"8"",
+ piep = ""7"",
+ blank = " ";
+INT VAR aktuelle werkstueckbreite,
+ aktuelle werkstueckhoehe,
+ kleinster aktueller zeichencode,
+ groesster aktueller zeichencode,
+ aktuelle anzahl der arbeitsphasen,
+
+ aktuelle arbeitsphasendauer in minuten,
+ aktuelle pausendauer in minuten;
+TEXT VAR aktuelles fehlerzeichen,
+ nach rechts,
+ nach links,
+ nach oben,
+ nach unten,
+ ausbesserung,
+ naechstes;
+BOOL VAR inversdarstellung;
+ROW 11 REAL VAR bewertung;
+WINDOW VAR w1, w2, w3, w4;
+PROC stdvoreinstellung der parameter:
+ aktuelle werkstueckbreite := 15;
+ aktuelle werkstueckhoehe := 12;
+ kleinster aktueller zeichencode := 65;
+
+ groesster aktueller zeichencode := 90;
+ aktuelle anzahl der arbeitsphasen := 3;
+ aktuelle arbeitsphasendauer in minuten := 10;
+ aktuelle pausendauer in minuten := 2;
+ aktuelles fehlerzeichen := "F";
+ nach rechts := ""2"";
+ nach links := ""8"";
+ nach oben := ""3"";
+ nach unten := ""10"";
+ ausbesserung := ""1"";
+
+ naechstes := ""27"";
+ inversdarstellung := FALSE;
+ bewertung := ROW 11 REAL : (0.0, 0.1, 0.2, 0.3, 0.4, 0.5,
+ 0.6, 0.7, 0.8, 0.9, 1.0)
+END PROC stdvoreinstellung der parameter;
+PROC werkstueckdefinition (INT VAR breite, hoehe, kleinster, groesster,
+ TEXT VAR fzeichen, BOOL VAR invers):
+ breite := aktuelle werkstueckbreite;
+ hoehe := aktuelle werkstueckhoehe;
+
+ kleinster := kleinster aktueller zeichencode;
+ groesster := groesster aktueller zeichencode;
+ fzeichen := aktuelles fehlerzeichen;
+ invers := inversdarstellung
+END PROC werkstueckdefinition;
+PROC tastendefinition (TEXT VAR rechts, links, hoch, runter, aus, nach):
+ rechts := nach rechts;
+ links := nach links;
+ hoch := nach oben;
+ runter := nach unten;
+ aus := ausbesserung;
+ nach := naechstes
+END PROC tastendefinition;
+
+PROC phasendefinition (INT VAR aphasenzahl, aphasendauer, pausendauer):
+ aphasenzahl := aktuelle anzahl der arbeitsphasen;
+ aphasendauer := aktuelle arbeitsphasendauer in minuten;
+ pausendauer := aktuelle pausendauer in minuten
+END PROC phasendefinition;
+PROC bewertungsschluessel (ROW 11 REAL VAR schluessel):
+ INT VAR zeiger;
+ FOR zeiger FROM 1 UPTO 11 REP
+ schluessel [zeiger] := bewertung [zeiger]
+ PER
+END PROC bewertungsschluessel;
+PROC mp bap einstellung anzeigen:
+ aktuellen parameterzustand anzeigen;
+
+ regenerate menuscreen
+END PROC mp bap einstellung anzeigen;
+PROC mp bap standardwerte:
+ standardwerte einstellen;
+ regenerate menuscreen
+END PROC mp bap standardwerte;
+PROC mp bap breite des werkstuecks:
+ breite des werkstuecks einstellen;
+ regenerate menuscreen
+END PROC mp bap breite des werkstuecks;
+PROC mp bap hoehe des werkstuecks:
+ hoehe des werkstuecks einstellen;
+ regenerate menuscreen
+END PROC mp bap hoehe des werkstuecks;
+PROC mp bap invers normal:
+ werkstueckdarstellung einstellen;
+
+ regenerate menuscreen
+END PROC mp bap invers normal;
+PROC mp bap zeichensatz:
+ zeichensatz einstellen;
+ regenerate menuscreen
+END PROC mp bap zeichensatz;
+PROC mp bap fehlerzeichen:
+ fehlerzeichen veraendern;
+ regenerate menuscreen
+END PROC mp bap fehlerzeichen;
+PROC mp bap tastenbelegung:
+ tastaturbelegung einstellen;
+ regenerate menuscreen
+END PROC mp bap tastenbelegung;
+PROC mp bap anzahl arbeitsphasen:
+ anzahl der arbeitsphasen festlegen;
+ regenerate menuscreen
+END PROC mp bap anzahl arbeitsphasen;
+
+PROC mp bap dauer einer arbeitsphase:
+ dauer einer arbeitsphase festlegen;
+ regenerate menuscreen
+END PROC mp bap dauer einer arbeitsphase;
+PROC mp bap pausendauer:
+ pausendauer festlegen;
+ regenerate menuscreen
+END PROC mp bap pausendauer;
+PROC mp bap wertungsschluessel:
+ wertungsschluessel veraendern;
+ regenerate menuscreen
+END PROC mp bap wertungsschluessel;
+PROC aktuellen parameterzustand anzeigen:
+ zeige die fenster;
+ fuelle die fenster mit inhalt;
+ gib hinweis aus.
+
+ zeige die fenster:
+ w1 := window ( 2, 2, 37, 20);
+ w2 := window (41, 2, 38, 20);
+ w3 := window ( 1, 1, 79, 24);
+ page; show (w1); show (w2).
+ fuelle die fenster mit inhalt:
+ zeige inhalt fenster 1;
+ zeige inhalt fenster 2.
+ zeige inhalt fenster 1:
+ zeige eingestellte parameter an (w1).
+ zeige inhalt fenster 2:
+ gib bewertungsschluessel aus (w2).
+ gib hinweis aus:
+ out footnote (w3, anwendungstext (2)); pause.
+END PROC aktuellen parameterzustand anzeigen;
+
+PROC zeige eingestellte parameter an (WINDOW VAR w):
+ zeige ueberschrift;
+ zeige werkstueckdefinition;
+ zeige tastenbelegung;
+ zeige simulationszeiten.
+ zeige ueberschrift:
+ cursor (w, 1, 1); out (w, center (w, invers (anwendungstext ( 1)))).
+ zeige werkstueckdefinition:
+ cursor (w, 2, 3); out (w, anwendungstext ( 6));
+ out (w, text (aktuelle werkstueckbreite, 3));
+ out (w, anwendungstext (28));
+ cursor (w, 2, 4); out (w, anwendungstext ( 7));
+
+ out (w, text (aktuelle werkstueckhoehe, 3));
+ out (w, anwendungstext (28));
+ cursor (w, 2, 5); out (w, anwendungstext ( 8));
+ IF inversdarstellung
+ THEN out (w, anwendungstext (29))
+ ELSE out (w, anwendungstext (30))
+ FI;
+ cursor (w, 2, 6); out (w, anwendungstext ( 9));
+ out (w, zeichensatz);
+ cursor (w, 2, 7); out (w, anwendungstext (10));
+
+ out (blank + aktuelles fehlerzeichen).
+ zeige tastenbelegung:
+ cursor (w, 2, 9); out (w, anwendungstext (11));
+ out (w, tastenbezeichnung (nach rechts));
+ cursor (w, 2, 10); out (w, anwendungstext (12));
+ out (w, tastenbezeichnung (nach links));
+ cursor (w, 2, 11); out (w, anwendungstext (13));
+ out (w, tastenbezeichnung (nach oben));
+ cursor (w, 2, 12); out (w, anwendungstext (14));
+ out (w, tastenbezeichnung (nach unten));
+
+ cursor (w, 2, 13); out (w, anwendungstext (15));
+ out (w, tastenbezeichnung (ausbesserung));
+ cursor (w, 2, 14); out (w, anwendungstext (16));
+ out (w, tastenbezeichnung (naechstes)).
+ zeige simulationszeiten:
+ cursor (w, 2, 16); out (w, anwendungstext (17));
+ out (w, text (aktuelle anzahl der arbeitsphasen, 4));
+ cursor (w, 2, 17); out (w, anwendungstext (18));
+ out (w, text (aktuelle arbeitsphasendauer in minuten, 4));
+
+ out (w, anwendungstext (51));
+ cursor (w, 2, 18); out (w, anwendungstext (19));
+ out (w, text (aktuelle pausendauer in minuten, 4));
+ out (w, anwendungstext (51));
+ cursor (w, 2, 20); out (w, anwendungstext ( 5));
+ out (w, gesamtdauerangabe).
+ zeichensatz:
+ blank + code (kleinster aktueller zeichencode) + "..." +
+ code (groesster aktueller zeichencode) + " (" +
+ text (groesster aktueller zeichencode
+
+ - kleinster aktueller zeichencode + 1, 2) +
+ anwendungstext (28) + ")".
+ gesamtdauerangabe:
+ text ( arbeitsdauer + pausendauer, 4) + anwendungstext (51).
+ arbeitsdauer:
+ aktuelle anzahl der arbeitsphasen
+ * aktuelle arbeitsphasendauer in minuten.
+ pausendauer:
+ (aktuelle anzahl der arbeitsphasen - 1)
+ * aktuelle pausendauer in minuten.
+END PROC zeige eingestellte parameter an;
+PROC gib bewertungsschluessel aus (WINDOW VAR w):
+ zeichne koordinatenkreuz;
+
+ trage messwerte ein.
+ zeichne koordinatenkreuz:
+ cursor (w, 1, 1); out (w, center (w, invers (anwendungstext ( 4))));
+ cursor (w, 2, 3); out (w, anwendungstext (20));
+ cursor (w, 2, 4); out (w, anwendungstext (21));
+ cursor (w, 2, 6); out (w, anwendungstext (23));
+ cursor (w, 2, 7); out (w, anwendungstext (22));
+ cursor (w, 2, 8); out (w, anwendungstext (22));
+ cursor (w, 2, 9); out (w, anwendungstext (22));
+ cursor (w, 2, 10); out (w, anwendungstext (22));
+
+ cursor (w, 2, 11); out (w, anwendungstext (24));
+ cursor (w, 2, 12); out (w, anwendungstext (22));
+ cursor (w, 2, 13); out (w, anwendungstext (22));
+ cursor (w, 2, 14); out (w, anwendungstext (22));
+ cursor (w, 2, 15); out (w, anwendungstext (22));
+ cursor (w, 2, 16); out (w, anwendungstext (25));
+ cursor (w, 2, 17); out (w, anwendungstext (26));
+ cursor (w, 2, 19); out (w, anwendungstext (27)).
+ trage messwerte ein:
+ INT CONST abszisse :: 16, ordinate :: 2;
+
+ INT VAR nr;
+ FOR nr FROM 1 UPTO 11 REP
+ zeichne einen punkt
+ PER.
+ zeichne einen punkt:
+ cursor (w, ordinate + 3 * nr, abszisse - nachkommastelle); out (punkt).
+ nachkommastelle:
+ int(bewertung [nr] * 10.0).
+END PROC gib bewertungsschluessel aus;
+PROC standardwerte einstellen:
+ zeige fenster;
+ zeige eingestellte parameter an (w1);
+ gib information aus;
+ hole bestaetigung ein.
+ zeige fenster:
+ w1 := window ( 2, 2, 37, 20);
+ w2 := window (41, 10, 37, 12);
+
+ w3 := window (41, 2, 37, 6);
+ page; show (w1); show (w2); show (w3).
+ gib information aus:
+ cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));
+ cursor (w2, 2, 3); out (w2, anwendungstext (67));
+ cursor (w2, 2, 4); out (w2, anwendungstext (68));
+ cursor (w2, 2, 7); out (w2, anwendungstext (69));
+ cursor (w2, 2, 9); out (w2, anwendungstext (70));
+ cursor (w2, 2,10); out (w2, anwendungstext (71));
+ cursor (w2, 2,11); out (w2, anwendungstext (72));
+
+ cursor (w2, 2,12); out (w2, anwendungstext (73)).
+ hole bestaetigung ein:
+ cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (66))));
+ cursor (w3, 2, 3);
+ IF yes (w3, anwendungstext (66))
+ THEN stdvoreinstellung der parameter;
+ gib positive rueckmeldung
+ FI.
+ gib positive rueckmeldung:
+ page (w1);
+ zeige eingestellte parameter an (w1);
+ cleop (w3, 2, 3); out (anwendungstext (221));
+ cursor (w3, 2, 5); out (anwendungstext ( 3));
+
+ pause.
+END PROC standardwerte einstellen;
+PROC breite des werkstuecks einstellen:
+ zeige die fenster;
+ hinweise an den benutzer ausgeben;
+ werkstueck zeigen (w3);
+ erfrage veraenderung;
+ REP
+ neuen wert vom bildschirm holen
+ UNTIL benutzer ist einverstanden PER.
+ zeige die fenster:
+ w1 := window ( 2, 2, 26, 6);
+ w2 := window (30, 2, 48, 6);
+ w3 := window (2, 9, 77, 16);
+ page; show (w1); show (w2).
+ hinweise an den benutzer ausgeben:
+ cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));
+
+ cursor (w1, 2, 3); out (w1, anwendungstext (53));
+ out (w1, text (kleinster wert, 3));
+ cursor (w1, 2, 4); out (w1, anwendungstext (54));
+ out (w1, text (maxspalten, 3));
+ cursor (w1, 2, 6); out (w1, anwendungstext (55));
+ out (w1, text (aktuelle werkstueckbreite, 3)).
+ erfrage veraenderung:
+ cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (57))));
+ cursor (w2, 2, 3);
+ IF no (anwendungstext (216))
+
+ THEN LEAVE breite des werkstuecks einstellen
+ FI.
+ neuen wert vom bildschirm holen:
+ cleop (w2, 2, 3); out (w2, anwendungstext (58));
+ cursor (w2, 2, 4); out (w2, anwendungstext (59));
+ cursor (w2, 2, 6); out (w2, anwendungstext (60));
+ aktuelle werkstueckbreite := ermittelter wert (1, maxspalten,
+ aktuelle werkstueckbreite).
+ benutzer ist einverstanden :
+ gib aktuelle infos aus;
+ hole bestaetigung.
+ gib aktuelle infos aus:
+
+ hinweise an den benutzer ausgeben;
+ werkstueck zeigen (w3);
+ cleop (w2, 1, 3).
+ hole bestaetigung:
+ cursor (w2, 2, 3);
+ IF yes (w2, anwendungstext (62))
+ THEN TRUE
+ ELSE FALSE
+ FI.
+END PROC breite des werkstuecks einstellen;
+PROC hoehe des werkstuecks einstellen:
+ fenster zeigen;
+ hinweise an den benutzer ausgeben;
+ werkstueck zeigen (w3);
+ erfrage veraenderung;
+ REP
+ neuen wert vom bildschirm holen
+ UNTIL benutzer ist einverstanden PER.
+
+ fenster zeigen:
+ w1 := window ( 2, 2, 26, 6);
+ w2 := window (30, 2, 48, 6);
+ w3 := window (2, 9, 77, 16);
+ page; show (w1); show (w2).
+ hinweise an den benutzer ausgeben:
+ cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));
+ cursor (w1, 2, 3); out (w1, anwendungstext (53));
+ out (w1, text (kleinster wert, 3));
+ cursor (w1, 2, 4); out (w1, anwendungstext (54));
+ out (w1, text (maxzeilen, 3));
+ cursor (w1, 2, 6); out (w1, anwendungstext (55));
+
+ out (w1, text (aktuelle werkstueckhoehe, 3)).
+ erfrage veraenderung:
+ cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (63))));
+ cursor (w2, 2, 3);
+ IF no (anwendungstext (217))
+ THEN LEAVE hoehe des werkstuecks einstellen
+ FI.
+ neuen wert vom bildschirm holen:
+ cleop (w2, 2, 3); out (w2, anwendungstext (58));
+ cursor (w2, 2, 4); out (w2, anwendungstext (59));
+ cursor (w2, 2, 6); out (w2, anwendungstext (64));
+ aktuelle werkstueckhoehe := ermittelter wert (1, maxzeilen,
+
+ aktuelle werkstueckhoehe).
+ benutzer ist einverstanden :
+ gib aktuelle infos aus;
+ hole bestaetigung.
+ gib aktuelle infos aus:
+ hinweise an den benutzer ausgeben;
+ werkstueck zeigen (w3);
+ cleop (w2, 1, 3).
+ hole bestaetigung:
+ cursor (w2, 2, 3);
+ IF yes (w2, anwendungstext (65))
+ THEN TRUE
+ ELSE FALSE
+ FI.
+END PROC hoehe des werkstuecks einstellen;
+PROC werkstueckdarstellung einstellen:
+ fenster zeigen;
+
+ hinweise an den benutzer ausgeben;
+ werkstueck zeigen (w3);
+ REP
+ bestaetigung einholen;
+ hinweise an den benutzer ausgeben;
+ werkstueck zeigen (w3)
+ UNTIL benutzer ist einverstanden PER.
+ fenster zeigen:
+ w1 := window ( 2, 2, 28, 6);
+ w2 := window (32, 2, 46, 6);
+ w3 := window ( 2, 9, 77, 16);
+ page; show (w1); show (w2).
+ hinweise an den benutzer ausgeben:
+ cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));
+ cursor (w1, 2, 3); out (w1, anwendungstext (74));
+
+ out (w1, anwendungstext (76));
+ cursor (w1, 2, 4); out (w1, anwendungstext (74));
+ out (w1, anwendungstext (77));
+ cursor (w1, 2, 6); out (w1, anwendungstext (75));
+ IF inversdarstellung
+ THEN out (w1, anwendungstext (77))
+ ELSE out (w1, anwendungstext (76))
+ FI.
+ bestaetigung einholen:
+ page (w2);
+ cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (89))));
+
+ cursor (w2, 2, 3);
+ IF yes (w2, anwendungstext (78))
+ THEN veraendere darstellungsart
+ ELSE LEAVE werkstueckdarstellung einstellen
+ FI.
+ veraendere darstellungsart:
+ IF inversdarstellung
+ THEN inversdarstellung := FALSE
+ ELSE inversdarstellung := TRUE
+ FI.
+ benutzer ist einverstanden:
+ cleop (w2, 1, 3);
+ cursor (w2, 2, 3);
+ IF yes (w2, anwendungstext (99))
+ THEN TRUE
+ ELSE FALSE
+ FI.
+END PROC werkstueckdarstellung einstellen;
+
+PROC zeichensatz einstellen:
+ zeige fenster;
+ gib eingestellten zeichensatz an;
+ gib bedienhinweise aus;
+ erfrage neueinstellung;
+ REP
+ erfrage das neue fehlerzeichen;
+ ermittle das kleinste zeichen;
+ ermittle das groesste zeichen;
+ page (w1);
+ gib eingestellten zeichensatz an
+ UNTIL benutzer ist einverstanden PER.
+ zeige fenster:
+ w1 := window ( 2, 2, 28, 22);
+ w2 := window (32, 10, 46, 14);
+ w3 := window (32, 2, 46, 6);
+ page; show (w1); show (w2); show (w3).
+
+ gib eingestellten zeichensatz an:
+ cursor (w1, 1, 1);
+ out (w1, center (w1, invers (anwendungstext (79))));
+ gib zeichenkette aus (w1, kleinster aktueller zeichencode,
+ groesster aktueller zeichencode,
+ code (aktuelles fehlerzeichen)).
+ gib bedienhinweise aus:
+ cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));
+ cursor (w2, 2, 3); out (w2, anwendungstext (80));
+ cursor (w2, 2, 4); out (w2, anwendungstext (81));
+
+ cursor (w2, 2, 5); out (w2, anwendungstext (82));
+ cursor (w2, 2, 6); out (w2, anwendungstext (83));
+ cursor (w2, 2, 8); out (w2, anwendungstext (84));
+ cursor (w2, 2, 9); out (w2, anwendungstext (85));
+ cursor (w2, 2,10); out (w2, anwendungstext (86));
+ cursor (w2, 2,12); out (w2, anwendungstext (87));
+ cursor (w2, 2,13); out (w2, anwendungstext (88)).
+ erfrage neueinstellung:
+ cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (90))));
+ cursor (w3, 2, 3);
+
+ IF no (w3, anwendungstext (91))
+ THEN LEAVE zeichensatz einstellen
+ FI.
+ erfrage das neue fehlerzeichen:
+ gib vollstaendigen zeichensatz aus;
+ gib fehlerzeicheninformationen aus;
+ REP
+ lasse fehlerzeichen eingeben
+ UNTIL fehlerzeichen ist ok PER.
+ gib vollstaendigen zeichensatz aus:
+ page (w1); page (w2); page (w3);
+ cursor (w1, 1, 1);
+ out (w1, center (w1, invers (anwendungstext (92))));
+ gib zeichenkette aus (w1, 33, 126, 0).
+ gib fehlerzeicheninformationen aus:
+
+ cursor (w2, 1, 1);
+ out (w2, center (w2, invers (anwendungstext (52))));
+ cursor (w2, 2, 3); out (w2, anwendungstext (95));
+ cursor (w2, 2, 4); out (w2, anwendungstext (96));
+ cursor (w2, 2, 6); out (w2, anwendungstext (97)).
+ lasse fehlerzeichen eingeben:
+ cursor (w3, 1, 1);
+ out (w3, center (w3, invers (anwendungstext (100))));
+ cursor (w3, 2, 3);
+ out (w3, anwendungstext (101));
+ cursor on; inchar (aktuelles fehlerzeichen); cursor off;
+ IF fehlerzeichen ist ok
+
+ THEN out (w3, aktuelles fehlerzeichen);
+ markiere das fehlerzeichen im ersten fenster;
+ ELSE lege beschwerde ein
+ FI.
+ fehlerzeichen ist ok:
+ code (aktuelles fehlerzeichen) >= 33
+ AND code (aktuelles fehlerzeichen) <= 126.
+ markiere das fehlerzeichen im ersten fenster:
+ positioniere cursor in zeichenkette (w1, 33, code (aktuelles fehlerzeichen));
+ out (w1, invers (aktuelles fehlerzeichen)).
+ lege beschwerde ein:
+ piepse;
+ cursor (w2, 2, 8); out (w2, anwendungstext (102));
+
+ cursor (w2, 2,10); out (w2, anwendungstext (103));
+ cursor (w2, 2,11); out (w2, anwendungstext (104));
+ cursor (w2, 2,12); out (w2, anwendungstext (105));
+ cursor (w2, 2,13); out (w2, anwendungstext (106));
+ cursor (w2, 2,14); out (w2, anwendungstext (107)).
+ ermittle das kleinste zeichen:
+ page (w2); page (w3);
+ gib kleinste zeichencode informationen aus;
+ lasse den vorbereich festlegen.
+ ermittle das groesste zeichen:
+ lasse den nachbereich festlegen.
+ gib kleinste zeichencode informationen aus:
+
+ cursor (w2, 1, 1);
+ out (w2, center (w2, invers (anwendungstext (52))));
+ cursor (w2, 2, 3); out (w2, anwendungstext (111));
+ cursor (w2, 2, 4); out (w2, anwendungstext (112));
+ cursor (w2, 2, 5); out (w2, anwendungstext (113));
+ cursor (w2, 2, 6); out (w2, anwendungstext (114));
+ cursor (w2, 2, 8); out (w2, anwendungstext (115));
+ cursor (w2, 2, 9); out (w2, anwendungstext (116));
+ cursor (w2, 2,10); out (w2, anwendungstext (117));
+ cursor (w2, 2,11); out (w2, anwendungstext (118));
+
+ cursor (w2, 2,13); out (w2, anwendungstext (119));
+ cursor (w2, 2,14); out (w2, anwendungstext (120)).
+ lasse den vorbereich festlegen:
+ INT VAR s, z; page (w3); cursor (w3, 1, 1);
+ out (w3, center (w3, invers (anwendungstext (121))));
+ cursor (w3, 2, 3); out (w3, anwendungstext (122));
+ cursor (w3, 2, 4); out (w3, anwendungstext (123));
+ cursor (w3, 2, 5); out (w3, anwendungstext (125));
+ get cursor (s, z); cursor on;
+ kleinster aktueller zeichencode := code (aktuelles fehlerzeichen);
+
+ groesster aktueller zeichencode := code (aktuelles fehlerzeichen);
+ kleinster aktueller zeichencode := eingabe mit intervallanzeige ( w1, 33,
+ code (aktuelles fehlerzeichen),
+ kleinster aktueller zeichencode, s, z);
+ cursor off.
+ lasse den nachbereich festlegen:
+ cursor (w3, 1, 1);
+ out (w3, center (w3, invers (anwendungstext (121))));
+ cursor (w3, 2, 3); out (w3, anwendungstext (122));
+ cursor (w3, 2, 4); out (w3, anwendungstext (124));
+
+ cursor (w3, 2, 5); out (w3, anwendungstext (125));
+ get cursor (s, z); cursor on;
+ groesster aktueller zeichencode := eingabe mit intervallanzeige ( w1,
+ code (aktuelles fehlerzeichen), 126,
+ groesster aktueller zeichencode, s, z);
+ cursor off.
+ benutzer ist einverstanden:
+ page (w3); cursor (w3, 1, 1);
+ out (w3, center (w3, invers (anwendungstext (90))));
+ cursor (w3, 2, 3);
+ IF yes (w3, anwendungstext (126))
+
+ THEN TRUE
+ ELSE FALSE
+ FI.
+END PROC zeichensatz einstellen;
+PROC fehlerzeichen veraendern:
+ fenster zeigen;
+ gib eingestellten zeichensatz an;
+ gib bedienhinweise aus;
+ erfrage neueinstellung;
+ REP
+ lasse fehlerzeichen einstellen
+ UNTIL benutzer ist einverstanden PER.
+ fenster zeigen:
+ w1 := window ( 2, 2, 28, 22);
+ w2 := window (32, 10, 46, 14);
+ w3 := window (32, 2, 46, 6);
+ page; show (w1); show (w2); show (w3).
+ gib eingestellten zeichensatz an:
+
+ cursor (w1, 1, 1);
+ out (w1, center (w1, invers (anwendungstext (79))));
+ gib zeichenkette aus (w1, kleinster aktueller zeichencode,
+ groesster aktueller zeichencode,
+ code (aktuelles fehlerzeichen)).
+ gib bedienhinweise aus:
+ cursor (w2, 1, 1);
+ out (w2, center (w2, invers (anwendungstext (52))));
+ cursor (w2, 2, 3); out (w2, anwendungstext (131));
+ cursor (w2, 2, 4); out (w2, anwendungstext (132));
+ cursor (w2, 2, 5); out (w2, anwendungstext (133));
+
+ cursor (w2, 2, 7); out (w2, anwendungstext (134));
+ cursor (w2, 2, 8); out (w2, anwendungstext (135));
+ cursor (w2, 2, 9); out (w2, anwendungstext (136)).
+ erfrage neueinstellung:
+ cursor (w3, 1, 1);
+ out (w3, center (w3, invers (anwendungstext (130))));
+ cursor (w3, 2, 3);
+ IF no (w3, anwendungstext (137))
+ THEN LEAVE fehlerzeichen veraendern
+ FI.
+ lasse fehlerzeichen einstellen:
+ INT VAR s, z, fehlercode :: code (aktuelles fehlerzeichen);
+ page (w3); cursor (w3, 1, 1);
+
+ out (w3, center (w3, invers (anwendungstext (138))));
+ cursor (w3, 2, 3); out (w3, anwendungstext (139));
+ cursor (w3, 2, 4); out (w3, anwendungstext (140));
+ cursor (w3, 2, 5); out (w3, anwendungstext (141));
+ get cursor (s, z); cursor on;
+ fehlercode := eingabe mit elementanzeige (w1,
+ kleinster aktueller zeichencode,
+ groesster aktueller zeichencode,
+ fehlercode, s, z);
+
+ cursor off;
+ aktuelles fehlerzeichen := code (fehlercode).
+ benutzer ist einverstanden:
+ page (w3); cursor (w3, 1, 1);
+ out (w3, center (w3, invers (anwendungstext (130))));
+ cursor (w3, 2, 3);
+ IF yes (w3, anwendungstext (142))
+ THEN TRUE
+ ELSE FALSE
+ FI.
+END PROC fehlerzeichen veraendern;
+PROC tastaturbelegung einstellen:
+ ROW 6 TEXT VAR tastenname, taste;
+ fenster zeigen;
+ REP
+ tastaturneubelegung vornehmen
+ UNTIL benutzer ist einverstanden PER.
+
+ fenster zeigen:
+ w1 := window ( 2, 2, 28, 10);
+ w2 := window ( 2, 14, 28, 10);
+ w3 := window (32, 10, 46, 14);
+ w4 := window (32, 2, 46, 6);
+ page; show (w1); show (w2); show (w3); show (w4).
+ tastaturneubelegung vornehmen:
+ alte tastenbelegung einlesen;
+ tastenbelegung anzeigen;
+ bedienhinweise ausgeben;
+ veraenderung erfragen;
+ neue tastenbelegung erfragen;
+ hinweis zur bewertung und stand ausgeben.
+ alte tastenbelegung einlesen:
+ INT VAR z1;
+
+ FOR z1 FROM 1 UPTO 6 REP
+ tastenname [z1] := anwendungstext (z1 + 10)
+ PER;
+ taste [1] := nach rechts;
+ taste [2] := nach links;
+ taste [3] := nach oben;
+ taste [4] := nach unten;
+ taste [5] := ausbesserung;
+ taste [6] := naechstes;
+ cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (151)))).
+ tastenbelegung anzeigen:
+ INT VAR cspa, czei;
+ cursor (w1, 2, 3); out (w1, tastenname [1]);
+ out (w1, tastenbezeichnung (taste [1]));
+
+ get cursor (w1, cspa, czei); cleol (w1, cspa, czei);
+ cursor (w1, 2, 4); out (w1, tastenname [2]);
+ out (w1, tastenbezeichnung (taste [2]));
+ get cursor (w1, cspa, czei); cleol (w1, cspa, czei);
+ cursor (w1, 2, 5); out (w1, tastenname [3]);
+ out (w1, tastenbezeichnung (taste [3]));
+ get cursor (w1, cspa, czei); cleol (w1, cspa, czei);
+ cursor (w1, 2, 6); out (w1, tastenname [4]);
+
+ out (w1, tastenbezeichnung (taste [4]));
+ get cursor (w1, cspa, czei); cleol (w1, cspa, czei);
+ cursor (w1, 2, 8); out (w1, tastenname [5]);
+ out (w1, tastenbezeichnung (taste [5]));
+ get cursor (w1, cspa, czei); cleol (w1, cspa, czei);
+ cursor (w1, 2,10); out (w1, tastenname [6]);
+ out (w1, tastenbezeichnung (taste [6]));
+ get cursor (w1, cspa, czei); cleol (w1, cspa, czei).
+
+ bedienhinweise ausgeben:
+ cursor (w2, 1, 1); out (center (w2, invers (anwendungstext (152))));
+ cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (52))));
+ cursor (w3, 2, 3); out (w3, anwendungstext (153));
+ cursor (w3, 2, 4); out (w3, anwendungstext (154));
+ cursor (w3, 2, 6); out (w3, anwendungstext (155));
+ cursor (w3, 2, 7); out (w3, anwendungstext (156));
+ cursor (w3, 2, 8); out (w3, anwendungstext (157));
+ cursor (w3, 2, 9); out (w3, anwendungstext (158));
+
+ cursor (w3, 2,11); out (w3, anwendungstext (159));
+ cursor (w3, 2,12); out (w3, anwendungstext (160));
+ cursor (w3, 2,13); out (w3, anwendungstext (161));
+ cursor (w3, 2,14); out (w3, anwendungstext (162)).
+ veraenderung erfragen:
+ cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));
+ cursor (w4, 2, 3);
+ IF no (w4, anwendungstext (164))
+ THEN LEAVE tastaturbelegung einstellen
+ FI.
+ neue tastenbelegung erfragen:
+ INT VAR z2; page (w4);
+
+ cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));
+ cursor (w4, 2, 3); out (w4, anwendungstext (165));
+ FOR z2 FROM 1 UPTO 6 REP
+ gib tastenhinweis;
+ hole tastatureingabe;
+ tastenbelegung anzeigen
+ PER.
+ gib tastenhinweis:
+ cleol (w4, 2, 5); out (w4, tastenname [z2]).
+ hole tastatureingabe:
+ INT VAR s, z; get cursor (w4, s, z);
+ cursor on; inchar (taste [z2]); cursor off;
+ cursor (w4, s, z); out (w4, tastenbezeichnung (taste [z2])).
+
+ hinweis zur bewertung und stand ausgeben:
+ IF neue tastenbelegung ist ok
+ THEN akzeptiere
+ ELSE akzeptiere nicht
+ FI.
+ neue tastenbelegung ist ok:
+ INT VAR zeiger; TEXT VAR tastenkette :: "";
+ FOR zeiger FROM 1 UPTO 6 REP
+ IF pos (tastenkette, taste [zeiger]) > 0
+ THEN LEAVE neue tastenbelegung ist ok WITH FALSE
+ ELSE tastenkette CAT taste [zeiger]
+ FI
+ PER;
+ TRUE.
+ akzeptiere:
+ cursor (w2, 3, 4);
+ out (w2, anwendungstext (166));
+
+ cursor (w2, 7, 6);
+ out (w2, anwendungstext (167)).
+ akzeptiere nicht:
+ cursor (w2, 3, 3); out (w2, anwendungstext (168));
+ cursor (w2, 3, 4); out (w2, anwendungstext (169));
+ cursor (w2, 3, 6); out (w2, anwendungstext (170));
+ cursor (w2, 3, 7); out (w2, anwendungstext (171));
+ cursor (w2, 3, 9); out (w2, anwendungstext (172));
+ cursor (w2, 5,10); out (w2, anwendungstext (173)).
+ benutzer ist einverstanden:
+ page (w4);
+ cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));
+
+ IF neue tastenbelegung ist ok
+ THEN gib hinweis auf abspeicherung
+ ELSE frage nach neueingabe
+ FI.
+ gib hinweis auf abspeicherung:
+ cursor (w4, 3, 3); out (w4, anwendungstext (174));
+ neue tastenbelegung festschreiben;
+ cursor (w4, 3, 5); out (w4, anwendungstext ( 2));
+ cursor on; pause; cursor off;
+ TRUE.
+ neue tastenbelegung festschreiben:
+ nach rechts := taste [1];
+ nach links := taste [2];
+ nach oben := taste [3];
+ nach unten := taste [4];
+
+ ausbesserung := taste [5];
+ naechstes := taste [6].
+ frage nach neueingabe:
+ cursor (w4, 2, 3);
+ IF yes (w4, anwendungstext (175))
+ THEN cleop (w2, 1, 3); FALSE
+ ELSE alte tastenbelegung einlesen;
+ tastenbelegung anzeigen;
+ cleop (w4, 2, 3); out (w4, anwendungstext (176));
+ cursor (w4, 3, 5); out (w4, anwendungstext ( 2));
+ cursor on; pause; cursor off;
+ TRUE
+ FI.
+END PROC tastaturbelegung einstellen;
+
+PROC simulationszeiten anzeigen (WINDOW VAR w):
+ cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (181))));
+ cursor (w, 2, 3); out (w, anwendungstext (17));
+ out (w, text (aktuelle anzahl der arbeitsphasen, 4));
+ cursor (w, 2, 4); out (w, anwendungstext (18));
+ out (w, text (aktuelle arbeitsphasendauer in minuten, 4));
+ out (w, anwendungstext (51));
+ cursor (w, 2, 5); out (w, anwendungstext (19));
+ out (w, text (aktuelle pausendauer in minuten, 4));
+
+ out (w, anwendungstext (51));
+ cursor (w, 2, 7); out (w, anwendungstext ( 5));
+ out (w, gesamtdauerangabe).
+ gesamtdauerangabe:
+ text ( arbeitsdauer + pausendauer, 4) + anwendungstext (51).
+ arbeitsdauer:
+ aktuelle anzahl der arbeitsphasen
+ * aktuelle arbeitsphasendauer in minuten.
+ pausendauer:
+ (aktuelle anzahl der arbeitsphasen - 1)
+ * aktuelle pausendauer in minuten.
+END PROC simulationszeiten anzeigen;
+PROC anzahl der arbeitsphasen festlegen:
+
+ INT CONST minwert :: 2, maxwert :: 20;
+ zeige fenster;
+ hinweise an den benutzer ausgeben;
+ simulationszeiten anzeigen (w2);
+ erfrage veraenderung;
+ REP
+ neuen wert vom bildschirm holen
+ UNTIL benutzer ist einverstanden PER.
+ zeige fenster:
+ w1 := window ( 2, 2, 28, 6);
+ w2 := window (22, 12, 37, 7);
+ w3 := window (32, 2, 47, 6);
+ page; show (w1); show (w2); show (w3).
+ hinweise an den benutzer ausgeben:
+ cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));
+
+ cursor (w1, 2, 3); out (w1, anwendungstext (53));
+ out (w1, text (minwert, 2));
+ cursor (w1, 2, 4); out (w1, anwendungstext (54));
+ out (w1, text (maxwert, 2));
+ cursor (w1, 2, 6); out (w1, anwendungstext (55));
+ out (w1, text (aktuelle anzahl der arbeitsphasen, 2)).
+ erfrage veraenderung:
+ cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (182))));
+ cursor (w3, 2, 3);
+ IF no (anwendungstext (218))
+
+ THEN LEAVE anzahl der arbeitsphasen festlegen
+ FI.
+ neuen wert vom bildschirm holen:
+ cleop (w3, 2, 3); out (w3, anwendungstext ( 58));
+ cursor (w3, 2, 4); out (w3, anwendungstext ( 59));
+ cursor (w3, 2, 6); out (w3, anwendungstext (183));
+ aktuelle anzahl der arbeitsphasen := ermittelter wert (minwert, maxwert,
+ aktuelle anzahl der arbeitsphasen).
+ benutzer ist einverstanden:
+ hinweise an den benutzer ausgeben;
+ simulationszeiten anzeigen (w2);
+
+ cleop (w3, 2, 3);
+ IF yes (w3, anwendungstext (184))
+ THEN TRUE
+ ELSE FALSE
+ FI.
+END PROC anzahl der arbeitsphasen festlegen;
+PROC dauer einer arbeitsphase festlegen:
+ INT CONST minwert :: 1, maxwert :: 60;
+ zeige fenster;
+ hinweise an den benutzer ausgeben;
+ simulationszeiten anzeigen (w2);
+ erfrage veraenderung;
+ REP
+ neuen wert vom bildschirm holen
+ UNTIL benutzer ist einverstanden PER.
+ zeige fenster:
+ w1 := window ( 2, 2, 28, 6);
+ w2 := window (22, 12, 37, 7);
+
+ w3 := window (32, 2, 47, 6);
+ page; show (w1); show (w2); show (w3).
+ hinweise an den benutzer ausgeben:
+ cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));
+ cursor (w1, 2, 3); out (w1, anwendungstext (53));
+ out (w1, text (minwert, 2));
+ out (w1, anwendungstext (51));
+ cursor (w1, 2, 4); out (w1, anwendungstext (54));
+ out (w1, text (maxwert, 2));
+ out (w1, anwendungstext (51));
+
+ cursor (w1, 2, 6); out (w1, anwendungstext (55));
+ out (w1, text (aktuelle arbeitsphasendauer in minuten, 2));
+ out (w1, anwendungstext (51)).
+ erfrage veraenderung:
+ cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (187))));
+ cursor (w3, 2, 3);
+ IF no (anwendungstext (219))
+ THEN LEAVE dauer einer arbeitsphase festlegen
+ FI.
+ neuen wert vom bildschirm holen:
+ INT VAR spa, zei;
+ cleop (w3, 2, 3); out (w3, anwendungstext ( 58));
+
+ cursor (w3, 2, 3); out (w3, anwendungstext ( 58));
+ cursor (w3, 2, 4); out (w3, anwendungstext ( 59));
+ cursor (w3, 2, 6); out (w3, anwendungstext (188));
+ get cursor (w3, spa, zei);
+ cursor (w3, spa + 3, zei); out (w3, anwendungstext (51));
+ cursor (w3, spa, zei);
+ aktuelle arbeitsphasendauer in minuten
+ := ermittelter wert (minwert, maxwert,
+ aktuelle arbeitsphasendauer in minuten).
+ benutzer ist einverstanden:
+
+ hinweise an den benutzer ausgeben;
+ simulationszeiten anzeigen (w2);
+ cleop (w3, 2, 3);
+ IF yes (w3, anwendungstext (189))
+ THEN TRUE
+ ELSE FALSE
+ FI.
+END PROC dauer einer arbeitsphase festlegen;
+PROC pausendauer festlegen:
+ INT CONST minwert :: 1, maxwert :: 30;
+ zeige fenster;
+ hinweise an den benutzer ausgeben;
+ simulationszeiten anzeigen (w2);
+ erfrage veraenderung;
+ REP
+ neuen wert vom bildschirm holen
+ UNTIL benutzer ist einverstanden PER.
+
+ zeige fenster:
+ w1 := window ( 2, 2, 28, 6);
+ w2 := window (22, 12, 37, 7);
+ w3 := window (32, 2, 47, 6);
+ page; show (w1); show (w2); show (w3).
+ hinweise an den benutzer ausgeben:
+ cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));
+ cursor (w1, 2, 3); out (w1, anwendungstext (53));
+ out (w1, text (minwert, 2));
+ out (w1, anwendungstext (51));
+ cursor (w1, 2, 4); out (w1, anwendungstext (54));
+
+ out (w1, text (maxwert, 2));
+ out (w1, anwendungstext (51));
+ cursor (w1, 2, 6); out (w1, anwendungstext (55));
+ out (w1, text (aktuelle pausendauer in minuten, 2));
+ out (w1, anwendungstext (51)).
+ erfrage veraenderung:
+ cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (191))));
+ cursor (w3, 2, 3);
+ IF no (anwendungstext (220))
+ THEN LEAVE pausendauer festlegen
+ FI.
+
+ neuen wert vom bildschirm holen:
+ INT VAR spa, zei;
+ cleop (w3, 2, 3); out (w3, anwendungstext ( 58));
+ cursor (w3, 2, 4); out (w3, anwendungstext ( 59));
+ cursor (w3, 2, 6); out (w3, anwendungstext (192));
+ get cursor (w3, spa, zei);
+ cursor (w3, spa + 3, zei); out (w3, anwendungstext (51));
+ cursor (w3, spa, zei);
+ aktuelle pausendauer in minuten
+ := ermittelter wert (minwert, maxwert,
+ aktuelle pausendauer in minuten).
+
+ benutzer ist einverstanden:
+ hinweise an den benutzer ausgeben;
+ simulationszeiten anzeigen (w2);
+ cleop (w3, 2, 3);
+ IF yes (w3, anwendungstext (193))
+ THEN TRUE
+ ELSE FALSE
+ FI.
+END PROC pausendauer festlegen;
+PROC wertungsschluessel veraendern:
+ INT CONST abszisse :: 16, ordinate :: 2;
+ zeige fenster;
+ gib bewertungsschluessel aus (w1);
+ gib informationen aus;
+ stelle frage nach veraenderung;
+ REP
+ neueinstellung
+ UNTIL benutzer ist einverstanden PER.
+
+ zeige fenster:
+ w1 := window ( 2, 2, 38, 22);
+ w2 := window (42, 10, 37, 14);
+ w3 := window (42, 2, 37, 6);
+ page; show (w1); show (w2); show (w3).
+ gib informationen aus:
+ cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));
+ cursor (w2, 2, 3); out (w2, anwendungstext (195));
+ cursor (w2, 2, 4); out (w2, anwendungstext (196));
+ cursor (w2, 2, 6); out (w2, anwendungstext (197));
+ cursor (w2, 2, 7); out (w2, anwendungstext (198));
+ cursor (w2, 2, 8); out (w2, anwendungstext (199));
+
+ cursor (w2, 2,11); out (w2, anwendungstext (200));
+ cursor (w2, 2,12); out (w2, anwendungstext (201));
+ cursor (w2, 2,13); out (w2, anwendungstext (202)).
+ stelle frage nach veraenderung:
+ cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (205))));
+ cursor (w3, 2, 3);
+ IF no (anwendungstext (206))
+ THEN LEAVE wertungsschluessel veraendern
+ ELSE gib hinweis auf linkes fenster
+ FI.
+ gib hinweis auf linkes fenster:
+ cleop (w3, 2, 3); out (w3, anwendungstext (211));
+
+ cursor (w3, 2, 4); out (w3, anwendungstext (212));
+ cursor (w3, 2, 5); out (w3, anwendungstext (213)).
+ neueinstellung:
+ INT VAR zeiger;
+ cursor an;
+ FOR zeiger FROM 1 UPTO 11 REP
+ gehe auf aktuelle punktposition;
+ lasse verschieben
+ PER;
+ cursor aus.
+ gehe auf aktuelle punktposition:
+ cursor (w1, ordinate + 3 * zeiger, abszisse - nachkommastelle).
+ nachkommastelle:
+ int (bewertung [zeiger] * 10.0).
+ lasse verschieben:
+ TEXT VAR eingabezeichen; INT VAR position;
+
+ REP
+ inchar (eingabezeichen);
+ position := pos (oben unten return, eingabezeichen);
+ fuehre angemessene reaktion aus
+ UNTIL position = 3 PER.
+ fuehre angemessene reaktion aus:
+ SELECT position OF
+ CASE 1: steige auf
+ CASE 2: steige ab
+ CASE 3: (* tue nichts *)
+ OTHERWISE piepse
+ END SELECT.
+ steige auf:
+ IF bewertung [zeiger] < 1.0
+ THEN loesche alten punkt;
+ bewertung [zeiger] INCR 0.1;
+ schreibe neuen punkt
+
+ ELSE piepse
+ FI.
+ steige ab:
+ IF bewertung [zeiger] > 0.0
+ THEN loesche alten punkt;
+ bewertung [zeiger] DECR 0.1;
+ schreibe neuen punkt
+ ELSE piepse
+ FI.
+ loesche alten punkt:
+ INT VAR tabspalte, tabzeile;
+ gehe auf aktuelle punktposition;
+ get cursor (w1, tabspalte, tabzeile);
+ IF tabspalte = ordinate + 3 OR tabzeile = abszisse
+ THEN out (w1, "|")
+ ELSE out (w1, blank)
+ FI.
+ schreibe neuen punkt:
+ gehe auf aktuelle punktposition;
+
+ out (w1, punkt und zurueck).
+ benutzer ist einverstanden:
+ cleop (w3, 2, 3);
+ IF yes (w3, anwendungstext (207))
+ THEN TRUE
+ ELSE gib hinweis auf linkes fenster;
+ FALSE
+ FI.
+END PROC wertungsschluessel veraendern;
+PROC cleol (WINDOW VAR w, INT CONST cursorspalte, cursorzeile):
+ cursor (w, cursorspalte, cursorzeile);
+ IF remaining lines (w) > 1
+ THEN out (w, (areaxsize (w) - cursorspalte + 1) * blank)
+ ELSE out (w, (areaxsize (w) - cursorspalte) * blank)
+
+ FI;
+ cursor (w, cursorspalte, cursorzeile)
+END PROC cleol;
+PROC cleop (WINDOW VAR w, INT CONST cursorspalte, cursorzeile):
+ cleol (w, cursorspalte, cursorzeile);
+ INT VAR i;
+ FOR i FROM 1 UPTO remaining lines (w) REP
+ cleol (w, 1, cursorzeile + i)
+ PER;
+ cursor (w, cursorspalte, cursorzeile)
+END PROC cleop;
+PROC cursor an:
+ INT VAR spalte, zeile;
+ get cursor (spalte, zeile); cursor on; cursor (spalte, zeile)
+END PROC cursor an;
+PROC cursor aus:
+ INT VAR spalte, zeile;
+
+ get cursor (spalte, zeile); cursor off; cursor (spalte, zeile)
+END PROC cursor aus;
+INT PROC eingabe mit intervallanzeige (WINDOW VAR w, INT CONST minwert,
+ maxwert, anfangswert, cursorspalte,
+ cursorzeile):
+ BOOL VAR ist aufsteigend :: minwert = anfangswert;
+ INT VAR aktueller wert :: anfangswert, alter wert, eingelesener wert;
+ REP
+ hole position aus vorgabe (oben unten return, eingelesener wert);
+ SELECT eingelesener wert OF
+
+ CASE 1: erniedrige aktuellen wert wenn moeglich
+ CASE 2: erhoehe aktuellen wert wenn moeglich
+ END SELECT
+ UNTIL eingelesener wert = 3 PER;
+ aktueller wert.
+ erniedrige aktuellen wert wenn moeglich:
+ IF aktueller wert > minwert
+ THEN alter wert := aktueller wert;
+ aktueller wert DECR 1;
+ IF ist aufsteigend
+ THEN loesche alte markierung
+ ELSE markiere neues zeichen
+ FI
+ ELSE piepse
+ FI.
+ erhoehe aktuellen wert wenn moeglich:
+
+ IF aktueller wert < maxwert
+ THEN alter wert := aktueller wert;
+ aktueller wert INCR 1;
+ IF ist aufsteigend
+ THEN markiere neues zeichen
+ ELSE loesche alte markierung
+ FI
+ ELSE piepse
+ FI.
+ loesche alte markierung:
+ positioniere cursor in zeichenkette (w, 33, alter wert);
+ out (w, code (alter wert) + " ");
+ cursor (cursorspalte, cursorzeile).
+ markiere neues zeichen:
+ positioniere cursor in zeichenkette (w, 33, aktueller wert);
+
+ out (w, invers (code (aktueller wert)));
+ cursor (cursorspalte, cursorzeile).
+END PROC eingabe mit intervallanzeige;
+INT PROC eingabe mit elementanzeige (WINDOW VAR w, INT CONST minwert,
+ maxwert, anfangswert,
+ cursorspalte, cursorzeile):
+ INT VAR aktueller wert :: anfangswert, alter wert, eingelesener wert;
+ REP
+ hole position aus vorgabe (oben unten return, eingelesener wert);
+ SELECT eingelesener wert OF
+
+ CASE 1: erniedrige aktuellen wert wenn moeglich
+ CASE 2: erhoehe aktuellen wert wenn moeglich
+ END SELECT
+ UNTIL eingelesener wert = 3 PER;
+ aktueller wert.
+ erniedrige aktuellen wert wenn moeglich:
+ IF aktueller wert > minwert
+ THEN alter wert := aktueller wert;
+ aktueller wert DECR 1;
+ loesche alte markierung;
+ markiere neues zeichen
+ ELSE piepse
+ FI.
+ erhoehe aktuellen wert wenn moeglich:
+ IF aktueller wert < maxwert
+
+ THEN alter wert := aktueller wert;
+ aktueller wert INCR 1;
+ loesche alte markierung;
+ markiere neues zeichen
+ ELSE piepse
+ FI.
+ loesche alte markierung:
+ positioniere cursor in zeichenkette (w, minwert, alter wert);
+ out (w, code (alter wert) + " ");
+ cursor (cursorspalte, cursorzeile).
+ markiere neues zeichen:
+ positioniere cursor in zeichenkette (w, minwert, aktueller wert);
+ out (w, invers (code (aktueller wert)));
+
+ cursor (cursorspalte, cursorzeile).
+END PROC eingabe mit elementanzeige;
+PROC werkstueck zeigen (WINDOW VAR w):
+ INT VAR zaehler, spalte, zeile;
+ page (w);
+ werkstueckaufhaenger (spalte, zeile);
+ schreibe werkstueck zeilenweise.
+ schreibe werkstueck zeilenweise:
+ FOR zaehler FROM 1 UPTO aktuelle werkstueckhoehe REP
+ positioniere den cursor;
+ bastle eine zeile;
+ gib eine zeile aus
+ PER.
+ positioniere den cursor:
+ cursor (w, spalte, zeile + zaehler - 1).
+
+ bastle eine zeile:
+ TEXT VAR zeileninhalt := "";
+ INT VAR z;
+ FOR z FROM 1 UPTO aktuelle werkstueckbreite REP
+ zeileninhalt CAT code (random (kleinster aktueller zeichencode,
+ groesster aktueller zeichencode))
+ PER.
+ gib eine zeile aus:
+ IF inversdarstellung
+ THEN out (w, invers (zeileninhalt))
+ ELSE out (w, zeileninhalt)
+ FI.
+END PROC werkstueck zeigen;
+PROC werkstueckaufhaenger (INT VAR spalte, zeile):
+ spalte := ((maxspalten - aktuelle werkstueckbreite) DIV 2) + 3;
+
+ zeile := ((maxzeilen - aktuelle werkstueckhoehe ) DIV 2) + 2;
+ IF inversdarstellung THEN spalte DECR 1 FI
+END PROC werkstueckaufhaenger;
+PROC gib zeichenkette aus (WINDOW VAR w,
+ INT CONST kleinster, groesster, markiertes):
+ INT VAR zaehler;
+ FOR zaehler FROM kleinster UPTO groesster REP
+ positioniere cursor in zeichenkette (w, kleinster, zaehler);
+ IF zaehler = markiertes
+ THEN out (w, invers (code (zaehler)))
+ ELSE out (w, code (zaehler))
+
+ FI
+ PER
+END PROC gib zeichenkette aus;
+PROC positioniere cursor in zeichenkette (WINDOW VAR w,
+ INT CONST mincode, position):
+ cursor (w, 4 + ((position - mincode) DIV 19) * 5,
+ 3 + ((position - mincode) MOD 19))
+END PROC positioniere cursor in zeichenkette;
+TEXT PROC tastenbezeichnung (TEXT CONST zeichen):
+ IF code (zeichen) >= 33 AND code (zeichen) <= 126
+ THEN "<" + zeichen + ">"
+ ELSE umgesetzter code
+ FI.
+ umgesetzter code:
+
+ SELECT code (zeichen) OF
+ CASE 1: anwendungstext (31)
+ CASE 2: anwendungstext (32)
+ CASE 3: anwendungstext (33)
+ CASE 8: anwendungstext (34)
+ CASE 9: anwendungstext (35)
+ CASE 10: anwendungstext (36)
+ CASE 11: anwendungstext (37)
+ CASE 12: anwendungstext (38)
+ CASE 13: anwendungstext (39)
+ CASE 16: anwendungstext (40)
+ CASE 27: anwendungstext (41)
+ CASE 32: anwendungstext (42)
+ CASE 214: anwendungstext (43)
+
+ CASE 215: anwendungstext (44)
+ CASE 216: anwendungstext (45)
+ CASE 217: anwendungstext (46)
+ CASE 218: anwendungstext (47)
+ CASE 219: anwendungstext (48)
+ CASE 251: anwendungstext (49)
+ OTHERWISE anwendungstext (50)
+ END SELECT
+END PROC tastenbezeichnung;
+INT PROC ermittelter wert (INT CONST minimum, maximum, startwert):
+ INT VAR aktueller wert, eingelesener wert;
+ cursor an;
+ aktueller wert := startwert;
+ REP
+ gib dreistellig aus und positioniere zurueck (aktueller wert, FALSE);
+
+ hole position aus vorgabe (oben unten return, eingelesener wert);
+ SELECT eingelesener wert OF
+ CASE 1: erhoehe aktuellen wert wenn moeglich
+ CASE 2: erniedrige aktuellen wert wenn moeglich
+ END SELECT
+ UNTIL eingelesener wert = 3 PER;
+ cursor aus;
+ aktueller wert.
+ erhoehe aktuellen wert wenn moeglich:
+ IF aktueller wert < maximum
+ THEN aktueller wert INCR 1
+ ELSE piepse
+ FI.
+ erniedrige aktuellen wert wenn moeglich:
+ IF aktueller wert > minimum
+
+ THEN aktueller wert DECR 1
+ ELSE piepse
+ FI.
+END PROC ermittelter wert;
+PROC gib dreistellig aus und positioniere zurueck (INT CONST wert,
+ BOOL CONST mit wertwandel):
+ INT VAR spalte, zeile; get cursor (spalte, zeile);
+ IF mit wertwandel
+ THEN out ("'" + code (wert) + "'")
+ ELSE out (text (wert, 3))
+ FI;
+ cursor (spalte, zeile);
+END PROC gib dreistellig aus und positioniere zurueck;
+PROC hole position aus vorgabe (TEXT CONST vorgabe, INT VAR position):
+
+ TEXT VAR eingabezeichen; INT VAR spa, zei;
+ REP
+ get cursor (spa, zei); inchar (eingabezeichen); cursor (spa, zei);
+ position := pos (vorgabe, eingabezeichen);
+ IF position = 0 THEN piepse; cursor (spa, zei) FI
+ UNTIL position > 0 PER
+END PROC hole position aus vorgabe;
+PROC piepse:
+ INT VAR spa, zei; get cursor (spa, zei); out (piep); cursor (spa, zei)
+END PROC piepse;
+END PACKET ls mp bap 1;
+stdvoreinstellung der parameter
+
diff --git a/mp-bap/ls-MP BAP 2 b/mp-bap/ls-MP BAP 2
index 0cd66ff..4ae047c 100644
--- a/mp-bap/ls-MP BAP 2
+++ b/mp-bap/ls-MP BAP 2
@@ -22,105 +22,1375 @@ LET maxeintraege = 800,
auswertdateipostfix = " - Auswertung",
protokolldateityp = 1955,
maxspalten = 70,
- maxzeilen = 14,{} blank = " ",{} trenn = "|",{} werkstueckendekennung = 1,{} pausenendekennung = 2,{} simulationsendekennung = 3,{} markierung ein = ""15"",{} markierung aus = " "14"",{} stdschrifttyp = "",{}
- stdxstart = 0.0,{} stdystart = 0.0,{} stdfeldbreite = 21.0,{} stdfeldlaenge = 29.5;{}LET KONTROLLTABELLE = STRUCT (INT letzter eintrag,{} breite, hoehe,{} kleinster code, groesster code,{} anzahl aphasen, aphasendauer,{} pausendauer,{}
- TEXT datum, uhrzeit, fehlerzeichen,{} nach rechts, nach links,{} nach oben, nach unten,{} ausbesserung, naechstes,{} BOOL inversdarstellung,{} ROW 11 REAL bewertung,{} ROW maxeintraege KONTROLLE tabelle),{} KONTROLLE = STRUCT (INT eintragskennung,{} produktionsfehler,{}
- anzahl korrekturen,{} anzahl bedienfehler,{} REAL anfang, ende, differenz),{} WERKSTUECK = ROW maxspalten ROW maxzeilen INT;{}INT VAR breite, hoehe, kleinster code, groesster code,{} anzahl aphasen, aphasendauer, pausendauer,{} eckspalte, eckzeile, x, y, xsize, ysize;{}TEXT VAR fehlerzeichen, nach rechts, nach links, nach oben, nach unten,{} ausbesserung, naechstes, datum, uhrzeit;{}
-TEXT VAR protokollschrifttyp :: stdschrifttyp;{}REAL VAR xstart :: stdxstart,{} ystart :: stdystart,{} schreibfeldbreite :: stdfeldbreite,{} schreibfeldlaenge :: stdfeldlaenge;{}ROW 11 REAL VAR bewertung;{}BOOL VAR inversdarstellung,{} kontrolldatei zur vatertask :: TRUE,{} mit kurzprotokoll :: TRUE,{} mit anmerkungen :: TRUE,{} auswertung geht zum drucker :: FALSE;{}WERKSTUECK VAR werkstueck;{}
-PROC bildschirmarbeitsplatz:{} kontrolldatei zur vatertask := FALSE;{} install menu (menukarte);{} handle menu (menubezeichnung);{}END PROC bildschirmarbeitsplatz;{}PROC bap:{} bildschirmarbeitsplatz{}END PROC bap;{}PROC materialpruefung:{} TEXT VAR benutzerkennung :: "", protokollname, alter dateiname :: std;{} install menu (menukarte, FALSE);{} kontrolldatei zur vatertask := TRUE;{} ermittle eingestellte parameter;{} bereite den bildschirm vor;{} ermittle die benutzerkennung;{} gib benutzerhinweise aus;{}
- arbeitsplatzsimulation ausfuehren (benutzerkennung, protokollname);{} forget (protokollname, quiet);{} last param (alter dateiname).{} bereite den bildschirm vor:{} WINDOW VAR w :: window ( 2, 10, 77, 14);{} page;{} show (w);{} out (w, center (w, anwendungstext (400))).{} ermittle die benutzerkennung:{} benutzerkennung := compress (boxanswer (w, anwendungstext (401), "", 5));{} IF benutzerkennung = ""{} THEN cursor on; page;{} LEAVE materialpruefung{} FI.{}
- gib benutzerhinweise aus:{} boxinfo (w, anwendungstext (402));{} boxinfo (w, anwendungstext (403));{} boxinfo (w, anwendungstext (404));{} gib bedieninformationen aus (2);{} boxinfo (w, anwendungstext (405));{} boxinfo (w, anwendungstext (406));{} boxinfo (w, anwendungstext (407));{} boxinfo (w, anwendungstext (408)).{}END PROC materialpruefung;{}PROC mp:{} materialpruefung{}END PROC mp;{}PROC mp bap simulation ausfuehren:{} TEXT VAR benutzerkennung :: "", dateiname;{}
- kontrolldatei zur vatertask := FALSE;{} ermittle eingestellte parameter;{} bereite den bildschirm vor;{} ermittle die benutzerkennung;{} arbeitsplatzsimulation ausfuehren (benutzerkennung, dateiname);{} regenerate menuscreen.{} bereite den bildschirm vor:{} WINDOW VAR w :: window (2,2,77,22);{} page;{} out (w, center (w, anwendungstext (399))).{} ermittle die benutzerkennung:{} benutzerkennung := compress (boxanswer (w, anwendungstext (401), "", 5));{} IF benutzerkennung = ""{}
- THEN regenerate menuscreen;{} LEAVE mp bap simulation ausfuehren{} FI.{}END PROC mp bap simulation ausfuehren;{}PROC mp bap auswertung auf bildschirm:{} auswertung geht zum drucker := FALSE;{} lasse protokolldateien auswaehlen;{} werte protokolldateien aus;{} regenerate menuscreen.{} lasse protokolldateien auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := infix namen (ALL myself, protokolldateipraefix,{} protokolldateityp);{}
- IF NOT not empty (verfuegbare){} THEN noch kein protokoll{} ELSE biete auswahl an{} FI.{} noch kein protokoll:{} regenerate menuscreen;{} menuinfo (anwendungstext (424));{} LEAVE mp bap auswertung auf bildschirm.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, anwendungstext (421),{} anwendungstext (422), FALSE).{} werte protokolldateien aus:{} INT VAR k;{} steige ggf bei leerem thesaurus aus;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}
- IF name (verfuegbare, k) <> ""{} THEN disable stop;{} gib hinweis auf auswertung;{} simulationsauswertung (name (verfuegbare, k), TRUE);{} forget (name (verfuegbare, k) + auswertdateipostfix, quiet);{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN regenerate menuscreen;{} menuinfo (anwendungstext (423));{} LEAVE mp bap auswertung auf bildschirm{}
- FI.{} gib hinweis auf auswertung:{} page;{} WINDOW VAR fenster :: window ( 2, 2, 77, 22);{} show (fenster);{} cursor (fenster, 1, 9); out (fenster, center (fenster, name (verfuegbare, k)));{} cursor (fenster, 1, 12); out (fenster, center (anwendungstext (274))).{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE mp bap auswertung auf bildschirm{} FI.{}
-END PROC mp bap auswertung auf bildschirm;{}PROC mp bap drucken von auswertungen:{} auswertung geht zum drucker := TRUE;{} lasse protokolldateien auswaehlen;{} werte protokolldateien aus;{} regenerate menuscreen.{} lasse protokolldateien auswaehlen:{} THESAURUS VAR verfuegbare;{} verfuegbare := infix namen (ALL myself, protokolldateipraefix,{} protokolldateityp);{} IF NOT not empty (verfuegbare){} THEN noch kein protokoll{} ELSE biete auswahl an{}
- FI.{} noch kein protokoll:{} regenerate menuscreen;{} menuinfo (anwendungstext (424));{} LEAVE mp bap drucken von auswertungen.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, anwendungstext (425),{} anwendungstext (422), FALSE).{} werte protokolldateien aus:{} INT VAR k;{} steige ggf bei leerem thesaurus aus;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} gib hinweis auf auswertung;{}
- simulationsauswertung (name (verfuegbare, k), FALSE);{} print (name (verfuegbare, k) + auswertdateipostfix);{} forget (name (verfuegbare, k) + auswertdateipostfix, quiet);{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN regenerate menuscreen;{} menuinfo (anwendungstext (423));{} LEAVE mp bap drucken von auswertungen{} FI.{} gib hinweis auf auswertung:{}
- page;{} WINDOW VAR fenster :: window ( 2, 2, 77, 22);{} show (fenster);{} cursor (fenster, 1, 9); out (fenster, center (fenster, name (verfuegbare, k)));{} cursor (fenster, 1, 12); out (fenster, center (anwendungstext (270))).{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (invers (errormessage));{} clear error; enable stop;{} LEAVE mp bap drucken von auswertungen{} FI.{}END PROC mp bap drucken von auswertungen;{}
-PROC mp bap protokollumfang festlegen:{} page;{} zeige aktuellen protokollumfang an;{} gib erlaeuterungen zum protokollumfang;{} frage nach umfangsaenderung;{} regenerate menuscreen{}END PROC mp bap protokollumfang festlegen;{}PROC mp bap kurzauswertung:{} page;{} zeige aktuelle kurzauswertungseinstellung an;{} gib erlaeuterungen zur kurzauswertung;{} frage nach kurzauswertungsaenderung;{} regenerate menuscreen{}END PROC mp bap kurzauswertung;{}PROC druckereinstellung fuer protokolldatei (TEXT CONST schrifttyp,{}
- REAL CONST linker rand,{} oberer rand,{} feldbreite,{} feldlaenge):{} protokollschrifttyp := schrifttyp;{} xstart := linker rand;{} ystart := oberer rand;{} schreibfeldbreite := feldbreite;{} schreibfeldlaenge := feldlaenge;{}END PROC druckereinstellung fuer protokolldatei;{}
-PROC stddruckereinstellung fuer protokolldatei:{} protokollschrifttyp := stdschrifttyp;{} xstart := stdxstart;{} ystart := stdystart;{} schreibfeldbreite := stdfeldbreite;{} schreibfeldlaenge := stdfeldlaenge{}END PROC stddruckereinstellung fuer protokolldatei;{} (********************************){}PROC arbeitsplatzsimulation ausfuehren (TEXT CONST kennung,{} TEXT VAR dateiname):{} ermittle eingestellte parameter;{}
- lege datei mit kennung an (kennung, dateiname);{} cursor on;{} fuehre simulation durch (dateiname);{} schicke ggf protokolldatei zur vatertask;{} gib ggf kurzprotokoll aus.{} schicke ggf protokolldatei zur vatertask:{} IF kontrolldatei zur vatertask{} THEN command dialogue (FALSE);{} save (dateiname);{} command dialogue (TRUE){} FI.{} gib ggf kurzprotokoll aus:{} IF mit kurzprotokoll{} THEN kurzauswertung auf bildschirm (dateiname){} ELSE page; put (anwendungstext (271)){}
- FI.{}END PROC arbeitsplatzsimulation ausfuehren;{}PROC ermittle eingestellte parameter:{} werkstueckdefinition (breite, hoehe, kleinster code, groesster code,{} fehlerzeichen, inversdarstellung);{} tastendefinition (nach rechts, nach links, nach oben, nach unten,{} ausbesserung, naechstes);{} phasendefinition (anzahl aphasen, aphasendauer, pausendauer);{} bewertungsschluessel (bewertung);{}END PROC ermittle eingestellte parameter;{}PROC lege datei mit kennung an (TEXT CONST kennung, TEXT VAR datname):{}
- BOUND KONTROLLTABELLE VAR tab;{} TEXT VAR interner name :: protokolldateipraefix;{} interner name CAT kennung;{} lege neue datei an;{} type (old (datname), protokolldateityp).{} lege neue datei an:{} INT VAR i :: 0; TEXT VAR bezeichnung;{} REP{} i INCR 1;{} bezeichnung := interner name + " /" + text (i){} UNTIL NOT exists (bezeichnung) PER;{} tab := new (bezeichnung);{} initialisiere tabelle;{} datname := bezeichnung.{} initialisiere tabelle:{} tab.letzter eintrag := 0.{}
-END PROC lege datei mit kennung an;{}PROC fuehre simulation durch (TEXT CONST dateiname):{} BOUND KONTROLLTABELLE VAR tab :: old (dateiname);{} TEXT CONST moegliche eingabezeichen :: nach rechts + nach links +{} nach oben + nach unten +{} ausbesserung + naechstes;{} treffe vorbereitungen;{} trage grunddaten in tabelle;{} simuliere.{} treffe vorbereitungen:{} initialisierungen;{} WINDOW VAR fenster :: window ( 1, 9, 79, 16);{}
- page;{} gib bedieninformationen aus (2);{} werkstueckaufhaenger (eckspalte, eckzeile);{} weise auf arbeitsbeginn hin;{} beginn der arbeitsphase := clock (1);{} beginn der bearbeitung := beginn der arbeitsphase;{} arbeitsphasenlaenge := real (aphasendauer * 60).{} initialisierungen:{} INT VAR eintragzaehler :: 0,{} arbeitsphasenzaehler :: 1,{} werkstueckzaehler :: 0,{} bedienfehlerzaehler :: 0,{}
- korrekturzaehler :: 0,{} produktionsfehler,{} cursorspalte relativ,{} cursorzeile relativ;{} REAL VAR beginn der arbeitsphase,{} beginn der bearbeitung,{} arbeitsphasenlaenge,{} arbeitsphasenueberziehung,{} pausenueberziehung.{} weise auf arbeitsbeginn hin:{} page (fenster);{} boxinfo (fenster, anwendungstext (252), 5, maxint);{} clear buffer.{} trage grunddaten in tabelle:{} tab.datum := date;{}
- tab.uhrzeit := time of day;{} tab.breite := breite;{} tab.hoehe := hoehe;{} tab.kleinster code := kleinster code;{} tab.groesster code := groesster code;{} tab.anzahl aphasen := anzahl aphasen;{} tab.aphasendauer := aphasendauer;{} tab.pausendauer := pausendauer;{} tab.fehlerzeichen := fehlerzeichen;{} tab.nach rechts := nach rechts;{} tab.nach links := nach links;{} tab.nach oben := nach oben;{}
- tab.nach unten := nach unten;{} tab.ausbesserung := ausbesserung;{} tab.naechstes := naechstes;{} tab.inversdarstellung := inversdarstellung;{} tab.bewertung := bewertung;{} eintragzaehler := 1.{} simuliere:{} REP{} gib holehinweis;{} hole werkstueck (werkstueck, produktionsfehler);{} zeige werkstueck (werkstueck, fenster);{} lasse werkstueck bearbeiten{} UNTIL simulationsende erreicht PER.{} gib holehinweis:{}
- page (fenster);{} cursor (fenster, 2, 3); out (fenster, anwendungstext (253)).{} lasse werkstueck bearbeiten:{} initialisiere den relativcursor;{} setze cursor;{} clear buffer;{} bearbeite das werkstueck.{} initialisiere den relativcursor:{} cursorspalte relativ := 1;{} cursorzeile relativ := 1.{} setze cursor:{} IF inversdarstellung{} THEN cursor (fenster, eckspalte + cursorspalte relativ,{} eckzeile + cursorzeile relativ - 1);{}
- ELSE cursor (fenster, eckspalte + cursorspalte relativ - 1,{} eckzeile + cursorzeile relativ - 1);{} FI.{} bearbeite das werkstueck:{} BOOL VAR werkstueck voll bearbeitet :: FALSE;{} REP{} hole eingabe und werte aus{} UNTIL werkstueck voll bearbeitet PER.{} hole eingabe und werte aus:{} TEXT VAR eingabezeichen := incharety (100);{} SELECT eingabezeichenposition OF{} CASE 1: wenn moeglich nach rechts{} CASE 2: wenn moeglich nach links{}
- CASE 3: wenn moeglich nach oben{} CASE 4: wenn moeglich nach unten{} CASE 5: wenn moeglich ausbessern{} CASE 6: beende werkstueckbearbeitung{} OTHERWISE entscheide ob gepiepst wird{} END SELECT.{} eingabezeichenposition:{} pos (moegliche eingabezeichen, eingabezeichen).{} wenn moeglich nach rechts:{} IF cursorspalte relativ < breite{} THEN cursorspalte relativ INCR 1;{} setze cursor{} ELSE registriere bedienfehler{} FI.{} wenn moeglich nach links:{}
- IF cursorspalte relativ > 1{} THEN cursorspalte relativ DECR 1;{} setze cursor{} ELSE registriere bedienfehler{} FI.{} wenn moeglich nach oben:{} IF cursorzeile relativ > 1{} THEN cursorzeile relativ DECR 1;{} setze cursor{} ELSE registriere bedienfehler{} FI.{} wenn moeglich nach unten:{} IF cursorzeile relativ < hoehe{} THEN cursorzeile relativ INCR 1;{} setze cursor{} ELSE registriere bedienfehler{} FI.{}
- wenn moeglich ausbessern:{} IF werkstueck [cursorspalte relativ][cursorzeile relativ] = code (fehlerzeichen){} THEN werkstueck [cursorspalte relativ][cursorzeile relativ] := code (blank);{} korrekturzaehler INCR 1;{} get cursor (fenster, x, y);{} out (fenster, blank);{} cursor (fenster, x, y);{} ELSE registriere bedienfehler{} FI.{} registriere bedienfehler:{} piepse; bedienfehlerzaehler INCR 1.{} entscheide ob gepiepst wird:{} IF eingabezeichen <> "" THEN piepse FI.{}
- beende werkstueckbearbeitung:{} IF simulationsende erreicht{} THEN trage simulationsende in tabelle ein{} ELIF arbeitsphasenende erreicht{} THEN trage werkstueckdaten in tabelle ein;{} ermittle ueberziehung der arbeitsphase;{} lege eine pause ein{} ELSE trage werkstueckdaten in tabelle ein{} FI;{} werkstueck voll bearbeitet := TRUE.{} lege eine pause ein:{} nimm pausendaten;{} weise auf pausenanfang hin;{} pausiere;{} weise auf pausenende hin;{}
- registriere pausenueberziehung.{} nimm pausendaten:{} REAL VAR pausenanfang :: clock (1),{} pausenende :: pausenanfang + real (pausendauer * 60);.{} weise auf pausenanfang hin:{} page (fenster);{} boxnotice (fenster, anwendungstext (255), 5, x, y, xsize, ysize).{} pausiere:{} REP{} pause (int ((pausenende - clock (1)) * 10.0)){} UNTIL clock (1) >= pausenende PER.{} weise auf pausenende hin:{} page (fenster);{} pausenanfang := clock (1);{} piepse;{}
- clear buffer;{} boxinfo (fenster, anwendungstext (256), 5, maxint);{} pausenende := clock (1).{} registriere pausenueberziehung:{} pausenueberziehung := pausenende - pausenanfang;{} trage pausenueberziehung in tabelle ein.{} trage werkstueckdaten in tabelle ein:{} REAL VAR bearbeitungsende :: clock (1);{} tab.tabelle [eintragzaehler].eintragskennung := werkstueckendekennung;{} tab.tabelle [eintragzaehler].produktionsfehler := produktionsfehler;{} tab.tabelle [eintragzaehler].anzahl korrekturen := korrekturzaehler;{}
- tab.tabelle [eintragzaehler].anzahl bedienfehler:= bedienfehlerzaehler;{} tab.tabelle [eintragzaehler].anfang := beginn der bearbeitung;{} tab.tabelle [eintragzaehler].ende := bearbeitungsende;{} tab.tabelle [eintragzaehler].differenz := bearbeitungszeit;{} erhoehe eintragzaehler;{} beginn der bearbeitung := clock (1);{} werkstueckzaehler INCR 1;{} bedienfehlerzaehler := 0;{} korrekturzaehler := 0.{} trage pausenueberziehung in tabelle ein:{}
- tab.tabelle [eintragzaehler].eintragskennung := pausenendekennung;{} tab.tabelle [eintragzaehler].produktionsfehler := 0;{} tab.tabelle [eintragzaehler].anzahl korrekturen := 0;{} tab.tabelle [eintragzaehler].anzahl bedienfehler:= 0;{} tab.tabelle [eintragzaehler].anfang := pausenanfang;{} tab.tabelle [eintragzaehler].ende := pausenende;{} tab.tabelle [eintragzaehler].differenz := pausenueberziehung;{} erhoehe eintragzaehler;{} arbeitsphasenzaehler INCR 1;{}
- beginn der bearbeitung := clock (1);{} beginn der arbeitsphase := clock (1);{} bearbeitungslaenge bestimmen.{} trage simulationsende in tabelle ein:{} bearbeitungsende := clock (1);{} tab.tabelle [eintragzaehler].eintragskennung := simulationsendekennung;{} tab.tabelle [eintragzaehler].produktionsfehler := produktionsfehler;{} tab.tabelle [eintragzaehler].anzahl korrekturen := korrekturzaehler;{} tab.tabelle [eintragzaehler].anzahl bedienfehler:= bedienfehlerzaehler;{}
- tab.tabelle [eintragzaehler].anfang := beginn der bearbeitung;{} tab.tabelle [eintragzaehler].ende := bearbeitungsende;{} tab.tabelle [eintragzaehler].differenz := bearbeitungszeit;{} tab.letzter eintrag := eintragzaehler.{} bearbeitungszeit:{} bearbeitungsende - beginn der bearbeitung.{} erhoehe eintragzaehler:{} IF eintragzaehler < maxeintraege{} THEN eintragzaehler INCR 1{} ELSE trage simulationsende in tabelle ein;{}
- errorstop (anwendungstext (254)){} FI.{} ermittle ueberziehung der arbeitsphase:{} arbeitsphasenueberziehung := clock (1) - beginn der arbeitsphase{} - arbeitsphasenlaenge.{} bearbeitungslaenge bestimmen:{} arbeitsphasenlaenge := real (aphasendauer * 60){} - arbeitsphasenueberziehung{} - pausenueberziehung.{} arbeitsphasenende erreicht:{} clock (1) - beginn der arbeitsphase >= arbeitsphasenlaenge.{}
- simulationsende erreicht:{} arbeitsphasenzaehler = anzahl aphasen AND arbeitsphasenende erreicht.{}END PROC fuehre simulation durch;{}PROC gib bedieninformationen aus (INT CONST zeile):{} WINDOW VAR f1 :: window ( 2, zeile, 35, 6),{} f2 :: window (40, zeile, 39, 6);{} show (f1); show (f2);{} cursor (f1, 2, 1); out (f1, anwendungstext (11));{} out (f1, tastenbezeichnung ( nach rechts));{} cursor (f1, 2, 2); out (f1, anwendungstext (12));{} out (f1, tastenbezeichnung ( nach links));{}
- cursor (f1, 2, 3); out (f1, anwendungstext (13));{} out (f1, tastenbezeichnung ( nach oben));{} cursor (f1, 2, 4); out (f1, anwendungstext (14));{} out (f1, tastenbezeichnung ( nach unten));{} cursor (f1, 2, 5); out (f1, anwendungstext (15));{} out (f1, tastenbezeichnung ( ausbesserung));{} cursor (f1, 2, 6); out (f1, anwendungstext (16));{} out (f1, tastenbezeichnung ( naechstes));{} cursor (f2, 2, 1); out (f2, anwendungstext (17));{}
- out (f2, text (anzahl aphasen, 4));{} cursor (f2, 2, 2); out (f2, anwendungstext (18));{} out (f2, text (aphasendauer, 4));{} out (f2, anwendungstext (51));{} cursor (f2, 2, 3); out (f2, anwendungstext (19));{} out (f2, text (pausendauer, 4));{} out (f2, anwendungstext (51));{} cursor (f2, 2, 4); out (f2, anwendungstext ( 5));{} out (f2, text (gesamtzeit, 4));{} out (f2, anwendungstext (51));{}
- cursor (f2, 2, 6); out (f2, anwendungstext (251));{} out (f2, 3 * blank);{} out (f2, fehlerzeichen).{}END PROC gib bedieninformationen aus;{}INT PROC gesamtzeit:{} anzahl aphasen * aphasendauer + (anzahl aphasen - 1) * pausendauer{}END PROC gesamtzeit;{}PROC hole werkstueck (WERKSTUECK VAR w, INT VAR anzahl fehler):{} INT VAR spaltenzaehler, zeilenzaehler;{} anzahl fehler := 0;{} FOR zeilenzaehler FROM 1 UPTO hoehe REP{} ermittle eine zeile{} PER.{}
- ermittle eine zeile:{} FOR spaltenzaehler FROM 1 UPTO breite REP{} ermittle eine position;{} ggf fehler registrieren{} PER.{} ermittle eine position:{} w [spaltenzaehler][zeilenzaehler] := zufallscode.{} zufallscode:{} random (kleinster code, groesster code).{} ggf fehler registrieren:{} IF w [spaltenzaehler][zeilenzaehler] = code (fehlerzeichen){} THEN anzahl fehler INCR 1{} FI.{}END PROC hole werkstueck;{}PROC zeige werkstueck (WERKSTUECK CONST w, WINDOW VAR f):{}
- INT VAR spaltenzaehler, zeilenzaehler;{} page (f);{} FOR zeilenzaehler FROM 1 UPTO hoehe REP{} zeige eine zeile{} PER.{} zeige eine zeile:{} cursor (f, eckspalte, eckzeile + zeilenzaehler - 1);{} ggf invers einschalten;{} FOR spaltenzaehler FROM 1 UPTO breite REP{} out (f, code (w [spaltenzaehler][zeilenzaehler])){} PER;{} ggf invers ausschalten.{} ggf invers einschalten:{} IF inversdarstellung THEN out (f, markierung ein) FI.{} ggf invers ausschalten:{} IF inversdarstellung THEN out (f, markierung aus) FI.{}
-END PROC zeige werkstueck;{}PROC kurzauswertung auf bildschirm (TEXT CONST dateiname):{} WINDOW VAR fenster :: window ( 2, 10, 77, 13);{} show (fenster);{} clear buffer;{} notiere ueberschrift;{} notiere ergebnis.{} notiere ueberschrift:{} cursor (fenster, 1, 1);{} out (fenster, center (fenster, anwendungstext (275)));{} cursor (fenster, 1, 2);{} out (fenster, center (fenster, anwendungstext (276))).{} notiere ergebnis:{} BOUND KONTROLLTABELLE CONST k := old (dateiname);{} ermittle die simulationsdaten;{}
- notiere gesamtzahl werkstuecke;{} notiere zeichengesamtzahl;{} notiere bedienfehler;{} notiere benoetigte zeit;{} notiere gesamtausbesserungsrate;{} notiere gesamtbewertungsfaktor;{} notiere gesamtbewertungszahl mit pausenueberziehung;{} cursor (1, 24); out (anwendungstext (2));{} pause.{} ermittle die simulationsdaten:{} INT VAR z, anzahl zeichen pro werkstueck,{} anzahl werkstuecke :: 0,{} anzahl bedienfehler :: 0,{} anzahl produktionsfehler :: 0,{}
- anzahl korrekturen :: 0;{} REAL VAR gesamtzahl zeichen, anteil korrekturen,{} gesamtzeit :: 0.0,{} pausenueberzug :: 0.0;{} FOR z FROM 1 UPTO k.letzter eintrag REP{} IF k.tabelle [z].eintragskennung = werkstueckendekennung{} THEN anzahl werkstuecke INCR 1;{} anzahl bedienfehler INCR k.tabelle [z].anzahl bedienfehler;{} anzahl produktionsfehler INCR k.tabelle [z].produktionsfehler;{}
- anzahl korrekturen INCR k.tabelle [z].anzahl korrekturen;{} gesamtzeit INCR k.tabelle [z].differenz;{} ELIF k.tabelle [z].eintragskennung = pausenendekennung{} THEN pausenueberzug INCR k.tabelle [z].differenz;{} FI{} PER;{} anzahl zeichen pro werkstueck := k.breite * k.hoehe;{} gesamtzahl zeichen := real (anzahl werkstuecke){} * real (anzahl zeichen pro werkstueck);{}
- IF anzahl produktionsfehler = 0{} THEN anteil korrekturen := 1.0{} ELSE anteil korrekturen := real (anzahl korrekturen){} / real (anzahl produktionsfehler){} FI.{} notiere gesamtzahl werkstuecke:{} cursor (fenster, 12, 4); out (fenster, anwendungstext (277));{} out (fenster, text (anzahl werkstuecke, 8)).{} notiere zeichengesamtzahl:{} cursor (fenster, 12, 5); out (fenster, anwendungstext (278));{} out (fenster, zahl aus zeichenkette).{}
- zahl aus zeichenkette:{} subtext (text (gesamtzahl zeichen, 9, 0), 1, 8).{} notiere bedienfehler:{} cursor (fenster, 12, 6); out (fenster, anwendungstext (279));{} out (fenster, text (anzahl bedienfehler, 8)).{} notiere benoetigte zeit:{} cursor (fenster, 12, 7); out (fenster, anwendungstext (280));{} out (fenster, text (gesamtzeit, 8, 2)).{} notiere gesamtausbesserungsrate:{} cursor (fenster, 12, 9); out (fenster, anwendungstext (281));{}
- out (fenster, text (anteil korrekturen, 8, 2)).{} notiere gesamtbewertungsfaktor:{} cursor (fenster, 12,10); out (fenster, anwendungstext (282));{} out (fenster, text (bewertungsfaktor, 8, 2)).{} bewertungsfaktor:{} bewertungsmasszahl (anteil korrekturen).{} notiere gesamtbewertungszahl mit pausenueberziehung:{} cursor (fenster, 12, 12); out (fenster, (anwendungstext (283)));{} out (fenster, text (gesamtwertung, 8, 2));{}
- cursor (fenster, 12, 13); out (fenster, (anwendungstext (284)));{} out (fenster, 8 * "=").{} gesamtwertung:{} IF gesamtzeit = 0.0{} THEN 0.0{} ELSE gesamtzahl zeichen / (gesamtzeit + pausenueberzug){} * bewertungsfaktor{} FI.{}END PROC kurzauswertung auf bildschirm;{}PROC simulationsauswertung (TEXT CONST dateiname, BOOL CONST mit zeigen):{} TEXT CONST auswertdatei :: dateiname + auswertdateipostfix;{} ermittle die kenndaten aus der protokolldatei (dateiname);{}
- notiere ueberschrift 1 (auswertdatei);{} notiere die kenndaten der simulation (auswertdatei);{} notiere die werkstueckkenndaten (auswertdatei);{} notiere ein beispielwerkstueck (auswertdatei);{} notiere ueberschrift 2 (auswertdatei);{} notiere gesamtergebnisse (auswertdatei, dateiname);{} notiere ueberschrift 3 (auswertdatei);{} notiere tabellenkopf (auswertdatei);{} notiere einzelne werkstueckdaten (auswertdatei, dateiname);{}
- notiere ggf die anmerkungen;{} zeige ggf auswertung auf bildschirm.{} notiere ggf die anmerkungen:{} IF mit anmerkungen{} THEN notiere anmerkungen (auswertdatei);{} FI.{} zeige ggf auswertung auf bildschirm:{} IF mit zeigen{} THEN cursor on; show (auswertdatei); cursor off{} FI.{}END PROC simulationsauswertung;{}PROC ermittle die kenndaten aus der protokolldatei (TEXT CONST dateiname):{} BOUND KONTROLLTABELLE CONST k := old (dateiname);{} breite := k.breite;{}
- hoehe := k.hoehe;{} kleinster code := k.kleinster code;{} groesster code := k.groesster code;{} fehlerzeichen := k.fehlerzeichen;{} inversdarstellung := k.inversdarstellung;{} nach rechts := k.nach rechts;{} nach links := k.nach links;{} nach oben := k.nach oben;{} nach unten := k.nach unten;{} ausbesserung := k.ausbesserung;{} naechstes := k.naechstes;{}
- anzahl aphasen := k.anzahl aphasen;{} aphasendauer := k.aphasendauer;{} pausendauer := k.pausendauer;{} datum := k.datum;{} uhrzeit := k.uhrzeit;{} bewertung := k.bewertung;{}END PROC ermittle die kenndaten aus der protokolldatei;{}PROC notiere ueberschrift 1 (TEXT CONST auswertdatei):{} IF exists (auswertdatei){} THEN forget (auswertdatei, quiet){} FI;{} FILE VAR f :: sequential file (output, auswertdatei);{}
- IF auswertung geht zum drucker{} THEN schreibe druckeranweisungen{} FI;{} putline (f, center (auswertdatei));{} putline (f, center (length (auswertdatei) * "="));{} put (f, anwendungstext (272)); put (f, datum); put (f, 26 * blank);{} put (f, anwendungstext (273)); putline (f, uhrzeit);{} line (f);{} putline (f, center (anwendungstext (291)));{} putline (f, center (length (anwendungstext (291)) * "=")).{} schreibe druckeranweisungen:{} write (f, "#type (""");{} write (f, protokollschrifttyp);{}
- write (f, """)##limit (");{} write (f, text (schreibfeldbreite));{} write (f, ")##pagelength (");{} write (f, text (schreibfeldlaenge));{} write (f, ")##start (");{} write (f, text (xstart));{} write (f, ",");{} write (f, text (ystart));{} write (f, ")#"); line (f).{}END PROC notiere ueberschrift 1;{}PROC notiere ueberschrift 2 (TEXT CONST auswertdatei):{} FILE VAR f :: sequential file (output, auswertdatei);{} putline (f, center (anwendungstext (285)));{} putline (f, center (length (anwendungstext (285)) * "=")){}
-END PROC notiere ueberschrift 2;{}PROC notiere ueberschrift 3 (TEXT CONST auswertdatei):{} FILE VAR f :: sequential file (output, auswertdatei);{} line (f, 2);{} putline (f, center (anwendungstext (311)));{} putline (f, center (length (anwendungstext (311)) * "="));{} line (f){}END PROC notiere ueberschrift 3;{}PROC notiere die kenndaten der simulation (TEXT CONST auswertdatei):{} FILE VAR f :: sequential file (output, auswertdatei);{} ROW 6 TEXT VAR ausgabe;{} bestuecke ausgabezeilen;{} schreibe ausgabezeilen.{}
- bestuecke ausgabezeilen:{} ausgabe [1] := anwendungstext (11){} + gleichlang (tastenbezeichnung (nach rechts ), 23){} + anwendungstext (17){} + text (anzahl aphasen, 4);{} ausgabe [2] := anwendungstext (12){} + gleichlang (tastenbezeichnung (nach links ), 23){} + anwendungstext (18){} + text (aphasendauer, 4) + anwendungstext (51);{} ausgabe [3] := anwendungstext (13){}
- + gleichlang (tastenbezeichnung (nach oben ), 23){} + anwendungstext (19){} + text (pausendauer, 4) + anwendungstext (51);{} ausgabe [4] := anwendungstext (14){} + gleichlang (tastenbezeichnung (nach unten ), 23){} + anwendungstext ( 5){} + text (simulationsdauer, 4) + anwendungstext (51);{} ausgabe [5] := anwendungstext (15){} + gleichlang (tastenbezeichnung (ausbesserung), 23);{}
- ausgabe [6] := anwendungstext (16){} + gleichlang (tastenbezeichnung (naechstes ), 23){} + anwendungstext (251){} + (3 * blank) + fehlerzeichen.{} simulationsdauer:{} anzahl aphasen * aphasendauer + (anzahl aphasen - 1) * pausendauer.{} schreibe ausgabezeilen:{} INT VAR i;{} FOR i FROM 1 UPTO 6 REP{} putline (f, ausgabe [i]){} PER;{} line (f).{}END PROC notiere die kenndaten der simulation;{}PROC notiere die werkstueckkenndaten (TEXT CONST auswertdatei):{}
- FILE VAR f :: sequential file (output, auswertdatei);{} ROW 4 TEXT VAR ausgabe;{} bestuecke ausgabezeilen;{} schreibe ausgabezeilen.{} bestuecke ausgabezeilen:{} ausgabe [1] := anwendungstext (292) + text (breite, 4) +{} anwendungstext (296);{} ausgabe [2] := anwendungstext (293) + text (hoehe, 4) +{} anwendungstext (296);{} ausgabe [3] := anwendungstext (294) + text (breite * hoehe, 4) +{} anwendungstext (296);{}
- ausgabe [4] := anwendungstext (295) + zeichenumfang.{} zeichenumfang:{} " " + code (kleinster code) + " ... " + code (groesster code) +{} " (" + text (groesster code - kleinster code + 1, 3) +{} anwendungstext (296) + ")".{} schreibe ausgabezeilen:{} INT VAR i;{} FOR i FROM 1 UPTO 4 REP putline (f, ausgabe [i]) PER;{} line (f).{}END PROC notiere die werkstueckkenndaten;{}PROC notiere ein beispielwerkstueck (TEXT CONST auswertdatei):{} FILE VAR f :: sequential file (output, auswertdatei);{}
- WERKSTUECK VAR beispiel;{} INT VAR beispielfehler;{} hole werkstueck (beispiel, beispielfehler);{} notiere ueberschrift;{} notiere werkstueckzeilen;{} notiere werkstueckleerzeilen.{} notiere ueberschrift:{} putline (f, center (anwendungstext (297)));{} putline (f, center (length (anwendungstext (297)) * "-")).{} notiere werkstueckzeilen:{} INT VAR bs, bz;{} FOR bz FROM 1 UPTO hoehe REP{} notiere eine zeile{} PER.{} notiere eine zeile:{} TEXT VAR beispielzeile :: "";{}
- konstruiere beispielzeile;{} gib beispielzeile aus.{} konstruiere beispielzeile:{} beispielzeile CAT (((80 - breite) DIV 2) * blank);{} FOR bs FROM 1 UPTO breite REP{} beispielzeile CAT code (beispiel [bs][bz]){} PER.{} gib beispielzeile aus:{} putline (f, beispielzeile).{} notiere werkstueckleerzeilen:{} line (f, maxzeilen - hoehe + 1).{}END PROC notiere ein beispielwerkstueck;{}PROC notiere gesamtergebnisse (TEXT CONST auswertdatei, protokolldatei):{} FILE VAR f :: sequential file (output, auswertdatei);{}
- BOUND KONTROLLTABELLE CONST k :: old (protokolldatei);{} ermittle die simulationsdaten;{} notiere gesamtzahl werkstuecke;{} notiere anzahl zeichen pro werkstueck;{} notiere zeichengesamtzahl;{} notiere bedienfehler;{} notiere produktionsfehlerzahl;{} notiere fehlerkorrekturen;{} notiere gesamtzeit mit pausenueberziehung;{} notiere zeichenzahl pro sekunde mit;{} notiere gesamtausbesserungsrate;{} notiere gesamtbewertungsfaktor mit;{} notiere gesamtbewertungszahl mit;{}
- notiere gesamtzeit ohne pausenueberziehung;{} notiere zeichenzahl pro sekunde ohne;{} notiere gesamtbewertungszahl ohne.{} ermittle die simulationsdaten:{} INT VAR z, anzahl zeichen pro werkstueck,{} anzahl werkstuecke :: 0,{} anzahl bedienfehler :: 0,{} anzahl produktionsfehler :: 0,{} anzahl korrekturen :: 0;{} REAL VAR gesamtzahl zeichen, anteil korrekturen,{} gesamtzeit :: 0.0,{}
- pausenueberzug :: 0.0;{} FOR z FROM 1 UPTO k.letzter eintrag REP{} IF k.tabelle [z].eintragskennung = werkstueckendekennung{} THEN anzahl werkstuecke INCR 1;{} anzahl bedienfehler INCR k.tabelle [z].anzahl bedienfehler;{} anzahl produktionsfehler INCR k.tabelle [z].produktionsfehler;{} anzahl korrekturen INCR k.tabelle [z].anzahl korrekturen;{} gesamtzeit INCR k.tabelle [z].differenz;{}
- ELIF k.tabelle [z].eintragskennung = pausenendekennung{} THEN pausenueberzug INCR k.tabelle [z].differenz;{} FI{} PER;{} anzahl zeichen pro werkstueck := k.breite * k.hoehe;{} gesamtzahl zeichen := real (anzahl werkstuecke){} * real (anzahl zeichen pro werkstueck);{} IF anzahl produktionsfehler = 0{} THEN anteil korrekturen := 1.0{} ELSE anteil korrekturen := real (anzahl korrekturen){}
- / real (anzahl produktionsfehler){} FI.{} notiere gesamtzahl werkstuecke:{} put (f, anwendungstext (277)); putline (f, text (anzahl werkstuecke, 8)).{} notiere anzahl zeichen pro werkstueck:{} put (f, anwendungstext (286)); putline (f, text (breite * hoehe, 8)).{} notiere zeichengesamtzahl:{} put (f, anwendungstext (278)); putline (f, zahl aus zeichenkette);{} line (f).{} zahl aus zeichenkette:{} subtext (text (gesamtzahl zeichen, 9, 0), 1, 8).{}
- notiere produktionsfehlerzahl:{} put (f, anwendungstext (287)); putline (f, text (anzahl produktionsfehler, 8)).{} notiere fehlerkorrekturen:{} put (f, anwendungstext (288)); putline (f, text (anzahl korrekturen, 8)).{} notiere bedienfehler:{} put (f, anwendungstext (279)); putline (f, text (anzahl bedienfehler,8));{} line (f).{} notiere gesamtzeit mit pausenueberziehung:{} put (f, anwendungstext (301)); put (f, text (gesamtzeit mit, 8, 1));{} putline (f, anwendungstext (300)).{}
- gesamtzeit mit:{} gesamtzeit + pausenueberzug.{} notiere zeichenzahl pro sekunde mit:{} put (f, anwendungstext (302));{} putline (f, text (zeichenpro sec mit, 8, 1));{} line (f).{} zeichen pro sec mit:{} IF gesamtzeit + pausenueberzug > 0.0{} THEN gesamtzahl zeichen / (gesamtzeit + pausenueberzug){} ELSE 0.0{} FI.{} notiere gesamtausbesserungsrate:{} put (f, anwendungstext (281)); putline (f, text (anteil korrekturen, 8, 1)).{} notiere gesamtbewertungsfaktor mit:{}
- put (f, anwendungstext (282)); putline (f, text (bewertungsfaktor, 8, 1));{} line (f).{} bewertungsfaktor:{} bewertungsmasszahl (anteil korrekturen).{} notiere gesamtbewertungszahl mit:{} put (f, (anwendungstext (283))); putline (f, text (gesamtwertung mit, 8, 1));{} put (f, (anwendungstext (284))); putline (f, 8 * "=").{} gesamtwertung mit:{} IF gesamtzeit = 0.0{} THEN 0.0{} ELSE gesamtzahl zeichen / (gesamtzeit + pausenueberzug){} * bewertungsfaktor{}
- FI.{} notiere gesamtzeit ohne pausenueberziehung:{} put (f, anwendungstext (303)); put (f, text (gesamtzeit, 8, 1));{} putline (f, anwendungstext (300)).{} notiere zeichenzahl pro sekunde ohne:{} put (f, anwendungstext (302));{} putline (f, text (zeichenpro sec ohne, 8, 1)).{} zeichen pro sec ohne:{} IF gesamtzeit > 0.0{} THEN gesamtzahl zeichen / gesamtzeit{} ELSE 0.0{} FI.{} notiere gesamtbewertungszahl ohne:{} put (f, (anwendungstext (304))); putline (f, text (gesamtwertung ohne, 8, 1));{}
- put (f, (anwendungstext (284))); putline (f, 8 * "=").{} gesamtwertung ohne:{} IF gesamtzeit = 0.0{} THEN 0.0{} ELSE gesamtzahl zeichen / gesamtzeit * bewertungsfaktor{} FI.{}END PROC notiere gesamtergebnisse;{}PROC notiere tabellenkopf (TEXT CONST auswertdatei):{} FILE VAR f :: sequential file (output, auswertdatei);{} putline (f, anwendungstext (312));{} putline (f, anwendungstext (313));{} putline (f, anwendungstext (314));{} putline (f, anwendungstext (315));{} putline (f, anwendungstext (316));{}
- putline (f, anwendungstext (317));{} putline (f, anwendungstext (318));{}END PROC notiere tabellenkopf;{}PROC notiere einzelne werkstueckdaten (TEXT CONST auswertdatei, dateiname):{} BOUND KONTROLLTABELLE CONST k :: old (dateiname);{} FILE VAR f :: sequential file (output, auswertdatei);{} INT VAR zeiger, werkstuecknummer :: 0;{} TEXT VAR ausgabezeile :: "";{} FOR zeiger FROM 1 UPTO k.letzter eintrag REP{} notiere bearbeitungszeile{} PER.{} notiere bearbeitungszeile:{} IF k.tabelle [zeiger].eintragskennung = werkstueckendekennung{}
- THEN werkstuecknummer INCR 1;{} schreibe werkstueckzeile{} ELIF k.tabelle [zeiger].eintragskennung = pausenendekennung{} THEN schreibe pausenzeile{} ELIF k.tabelle [zeiger].eintragskennung = simulationsendekennung{} THEN werkstuecknummer INCR 1;{} schreibe abschluss{} ELSE putline (f, 75 * "?"){} FI.{} schreibe werkstueckzeile:{} konstruiere ausgabezeile;{} putline (f, ausgabezeile).{} konstruiere ausgabezeile:{} ausgabezeile := "";{}
- ausgabezeile CAT text (werkstuecknummer, 5);{} ausgabezeile CAT 2 * blank;{} ausgabezeile CAT trenn;{} ausgabezeile CAT text (k.tabelle [zeiger].anzahl bedienfehler, 5);{} ausgabezeile CAT 3 * blank;{} ausgabezeile CAT trenn;{} ausgabezeile CAT text (k.tabelle [zeiger].produktionsfehler, 6);{} ausgabezeile CAT 2 * blank;{} ausgabezeile CAT trenn;{} ausgabezeile CAT text (k.tabelle [zeiger].anzahl korrekturen, 6);{} ausgabezeile CAT 2 * blank;{} ausgabezeile CAT trenn;{}
- ausgabezeile CAT text (k.tabelle [zeiger].differenz, 6, 1);{} ausgabezeile CAT blank;{} ausgabezeile CAT trenn;{} ausgabezeile CAT text (zeichen pro zeiteinheit, 6, 1);{} ausgabezeile CAT blank;{} ausgabezeile CAT trenn;{} ausgabezeile CAT text (einzelausbesserungsrate, 6, 1);{} ausgabezeile CAT blank;{} ausgabezeile CAT trenn;{} ausgabezeile CAT text (bewertungsmasszahl (einzelausbesserungsrate), 6, 1);{} ausgabezeile CAT blank;{} ausgabezeile CAT trenn;{}
- ausgabezeile CAT text (endbewertungszahl, 6, 1);{} ausgabezeile CAT blank.{} zeichen pro zeiteinheit:{} real (breite * hoehe) / k.tabelle [zeiger].differenz.{} einzelausbesserungsrate:{} IF k.tabelle [zeiger].produktionsfehler = 0{} THEN 0.0{} ELSE real (k.tabelle [zeiger].anzahl korrekturen){} / real (k.tabelle [zeiger].produktionsfehler ){} FI.{} endbewertungszahl:{} real (breite * hoehe) / k.tabelle [zeiger].differenz{} * bewertungsmasszahl (einzelausbesserungsrate).{}
- schreibe pausenzeile:{} line (f);{} put (f, anwendungstext (320));{} put (f, text (k.tabelle [zeiger].differenz, 6, 1));{} putline (f, anwendungstext (300));{} line (f).{} schreibe abschluss:{} putline (f, anwendungstext (318));{} putline (f, anwendungstext (319));{} line (f);{} konstruiere ausgabezeile;{} ausgabezeile := "(" +{} subtext (ausgabezeile, 2, length (ausgabezeile) - 1) +{} ")";{} putline (f, ausgabezeile).{}
-END PROC notiere einzelne werkstueckdaten;{}PROC notiere anmerkungen (TEXT CONST auswertdatei):{} FILE VAR f :: sequential file (output, auswertdatei);{} line (f);{} schreibe kopf;{} schreibe hinweis auf letztes werkstueck;{} schreibe hinweis auf bedienfehler;{} erlaeutere bewertungsschluessel;{} stelle bewertungsschluessel graphisch dar;{} schreibe rest.{} schreibe kopf:{} putline (f, center (anwendungstext (325)));{} putline (f, center (length (anwendungstext (325)) * "="));{} line (f).{}
- schreibe hinweis auf letztes werkstueck:{} INT VAR i;{} FOR i FROM 326 UPTO 337 REP{} putline (f, anwendungstext (i)){} PER;{} line (f).{} schreibe hinweis auf bedienfehler:{} FOR i FROM 339 UPTO 341 REP{} putline (f, anwendungstext (i)){} PER;{} line (f).{} erlaeutere bewertungsschluessel:{} FOR i FROM 343 UPTO 372 REP{} putline (f, anwendungstext (i)){} PER.{} stelle bewertungsschluessel graphisch dar:{} putline (f, anwendungstext (374));{} putline (f, anwendungstext (375));{}
- ermittle die startposition;{} zeichne diagramm;{} trage werte ein.{} ermittle die startposition:{} modify (f);{} INT VAR zeilenpos :: lines (f) + 2, spaltenpos :: 18.{} zeichne diagramm:{} cursor (f, spaltenpos, zeilenpos , anwendungstext (20));{} cursor (f, spaltenpos, zeilenpos + 1, anwendungstext (21));{} cursor (f, spaltenpos, zeilenpos + 3, anwendungstext (23));{} cursor (f, spaltenpos, zeilenpos + 4, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 5, anwendungstext (22));{}
- cursor (f, spaltenpos, zeilenpos + 6, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 7, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 8, anwendungstext (24));{} cursor (f, spaltenpos, zeilenpos + 9, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 10, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 11, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 12, anwendungstext (22));{} cursor (f, spaltenpos, zeilenpos + 13, anwendungstext (25));{}
- cursor (f, spaltenpos, zeilenpos + 14, anwendungstext (26));{} cursor (f, spaltenpos, zeilenpos + 15, anwendungstext (27)).{} trage werte ein:{} zeilenpos INCR 13;{} INT VAR bwzeiger;{} FOR bwzeiger FROM 1 UPTO 11 REP{} cursor (f, spaltenpos + 3 * bwzeiger, zeilenpos - konkreter wert, "+"){} PER.{} konkreter wert:{} int (bewertung [bwzeiger] * 10.0).{} schreibe rest:{} output (f);{} line (f, 2);{} FOR i FROM 377 UPTO 387 REP{} putline (f, anwendungstext (i)){}
- PER;{} haenge an jede zeile ein blank an.{} haenge an jede zeile ein blank an:{} TEXT VAR inhalt;{} INT VAR zeilenzeiger;{} modify (f);{} FOR zeilenzeiger FROM 1 UPTO lines (f) REP{} to line (f, zeilenzeiger);{} read record (f, inhalt);{} inhalt CAT blank;{} write record (f, inhalt){} PER;{} to line (f,1).{}END PROC notiere anmerkungen;{}PROC cursor (FILE VAR f, INT CONST spa, zei, TEXT CONST text):{} positioniere an zeile;{} positioniere an spalte;{}
- gib text an position aus.{} positioniere an zeile:{} IF zeile noch nicht vorhanden{} THEN schaffe zeile und gehe dorthin{} ELSE to line (f,zei){} FI.{} zeile noch nicht vorhanden:{} zei > lines (f).{} schaffe zeile und gehe dorthin:{} INT VAR zaehler 1;{} IF lines (f) = 0{} THEN to line (f,lines (f));{} insert record (f);{} FI;{} FOR zaehler 1 FROM lines (f) UPTO zei REP{} to line (f,lines (f));{} down (f);insert record (f){} PER;{}
- to line(f,zei).{} positioniere an spalte:{} TEXT VAR alter satz :: "", neuer satz :: "", restsatz ::"";{} INT VAR satzlaenge;{} read record (f,alter satz);{} satzlaenge := length (alter satz);{} IF satzlaenge = 0{} THEN neuer satz CAT (spa -1) * " "{} ELIF satzlaenge >= spa{} THEN neuer satz := subtext(alter satz,1,spa-1);{} restsatz := subtext(alter satz, spa + length (text));{} ELSE neuer satz := alter satz;{} neuer satz CAT (spa - satzlaenge - 1) * " "{}
- FI.{} gib text an position aus:{} neuer satz CAT text;{} IF restsatz <> ""{} THEN neuer satz CAT restsatz{} FI;{} write record(f,neuer satz).{} END PROC cursor;{}TEXT PROC gleichlang (TEXT CONST text, INT CONST laenge):{} TEXT VAR intern :: compress (text);{} INT VAR anzahl :: laenge - length (intern);{} IF anzahl < 0{} THEN subtext (intern, 1, laenge){} ELSE intern + (anzahl * blank){} FI{}END PROC gleichlang;{}REAL PROC bewertungsmasszahl (REAL CONST wert):{} REAL VAR interner wert := round (wert, 1);{}
- IF interner wert > wert{} THEN interner wert DECR 0.1{} FI;{} interpoliere.{} interpoliere:{} REAL VAR unterer wert, oberer wert;{} unterer wert := interner wert;{} IF unterer wert = 1.0{} THEN oberer wert := 1.0{} ELSE oberer wert := unterer wert + 0.1{} FI;{} unterer wert := bewertung (int (unterer wert * 10.0) + 1);{} oberer wert := bewertung (int (oberer wert * 10.0) + 1);{} unterer wert + (oberer wert - unterer wert) * faktor.{} faktor:{} frac (wert * 10.0).{}
-END PROC bewertungsmasszahl;{}PROC zeige aktuellen protokollumfang an:{} WINDOW VAR w :: window (2, 2, 34, 5);{} show (w);{} cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (431))));{} IF mit anmerkungen{} THEN cursor (w, 2, 4); out (w, anwendungstext (432)){} ELSE cursor (w, 2, 4); out (w, anwendungstext (433));{} FI.{}END PROC zeige aktuellen protokollumfang an;{}PROC gib erlaeuterungen zum protokollumfang:{} WINDOW VAR f :: window ( 2, 9, 77, 15);{} show (f);{} cursor (f, 1, 1); out (f, center (f, invers (anwendungstext (434))));{}
- cursor (f, 5, 3); out (f, anwendungstext (435));{} cursor (f, 5, 4); out (f, anwendungstext (436));{} cursor (f, 5, 5); out (f, anwendungstext (437));{} cursor (f, 5, 6); out (f, anwendungstext (438));{} cursor (f, 5, 8); out (f, anwendungstext (439));{} cursor (f, 5, 9); out (f, anwendungstext (440));{} cursor (f, 5,10); out (f, anwendungstext (441));{} cursor (f, 5,11); out (f, anwendungstext (442));{} cursor (f, 5,13); out (f, anwendungstext (443));{} cursor (f, 5,14); out (f, anwendungstext (444));{}
-END PROC gib erlaeuterungen zum protokollumfang;{}PROC frage nach umfangsaenderung:{} WINDOW VAR fenster :: window (38, 2, 41, 5);{} show (fenster);{} cursor (fenster, 1, 1); out (fenster, center (fenster, invers (anwendungstext (451))));{} cursor (fenster, 4, 3); out (fenster, anwendungstext (452));{} cursor (fenster, 4, 4);{} IF yes (fenster, anwendungstext (453)){} THEN mit anmerkungen := NOT mit anmerkungen{} FI.{}END PROC frage nach umfangsaenderung;{}PROC zeige aktuelle kurzauswertungseinstellung an:{}
- WINDOW VAR w :: window ( 2, 2, 34, 5);{} show (w);{} cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (431))));{} IF mit kurzprotokoll{} THEN cursor (w, 7, 4); out (w, anwendungstext (461));{} ELSE cursor (w, 7, 4); out (w, anwendungstext (462));{} FI.{}END PROC zeige aktuelle kurzauswertungseinstellung an;{}PROC gib erlaeuterungen zur kurzauswertung:{} WINDOW VAR f :: window ( 2, 9, 77, 15);{} show (f);{} cursor (f, 1, 1); out (f, center (f, invers (anwendungstext (463))));{}
- cursor (f, 5, 3); out (f, anwendungstext (464));{} cursor (f, 5, 4); out (f, anwendungstext (465));{} cursor (f, 5, 5); out (f, anwendungstext (466));{} cursor (f, 5, 6); out (f, anwendungstext (467));{} cursor (f, 5, 8); out (f, anwendungstext (468));{} cursor (f, 5, 9); out (f, anwendungstext (469));{} cursor (f, 5,10); out (f, anwendungstext (470));{} cursor (f, 5,11); out (f, anwendungstext (471));{} cursor (f, 5,13); out (f, anwendungstext (472));{} cursor (f, 5,14); out (f, anwendungstext (473));{}
-END PROC gib erlaeuterungen zur kurzauswertung;{}PROC frage nach kurzauswertungsaenderung:{} WINDOW VAR fenster :: window (38, 2, 41, 5);{} show (fenster);{} cursor (fenster, 1, 1); out (fenster, center (fenster, invers (anwendungstext (481))));{} cursor (fenster, 5, 3); out (fenster, anwendungstext (482));{} cursor (fenster, 5, 4);{} IF yes (fenster, anwendungstext (483)){} THEN mit kurzprotokoll := NOT mit kurzprotokoll{} FI.{}END PROC frage nach kurzauswertungsaenderung;{}END PACKET ls mp bap 2;{}
+ maxzeilen = 14,
+ blank = " ",
+ trenn = "|",
+ werkstueckendekennung = 1,
+ pausenendekennung = 2,
+ simulationsendekennung = 3,
+ markierung ein = ""15"",
+ markierung aus = " "14"",
+ stdschrifttyp = "",
+
+ stdxstart = 0.0,
+ stdystart = 0.0,
+ stdfeldbreite = 21.0,
+ stdfeldlaenge = 29.5;
+LET KONTROLLTABELLE = STRUCT (INT letzter eintrag,
+ breite, hoehe,
+ kleinster code, groesster code,
+ anzahl aphasen, aphasendauer,
+ pausendauer,
+
+ TEXT datum, uhrzeit, fehlerzeichen,
+ nach rechts, nach links,
+ nach oben, nach unten,
+ ausbesserung, naechstes,
+ BOOL inversdarstellung,
+ ROW 11 REAL bewertung,
+ ROW maxeintraege KONTROLLE tabelle),
+ KONTROLLE = STRUCT (INT eintragskennung,
+ produktionsfehler,
+
+ anzahl korrekturen,
+ anzahl bedienfehler,
+ REAL anfang, ende, differenz),
+ WERKSTUECK = ROW maxspalten ROW maxzeilen INT;
+INT VAR breite, hoehe, kleinster code, groesster code,
+ anzahl aphasen, aphasendauer, pausendauer,
+ eckspalte, eckzeile, x, y, xsize, ysize;
+TEXT VAR fehlerzeichen, nach rechts, nach links, nach oben, nach unten,
+ ausbesserung, naechstes, datum, uhrzeit;
+
+TEXT VAR protokollschrifttyp :: stdschrifttyp;
+REAL VAR xstart :: stdxstart,
+ ystart :: stdystart,
+ schreibfeldbreite :: stdfeldbreite,
+ schreibfeldlaenge :: stdfeldlaenge;
+ROW 11 REAL VAR bewertung;
+BOOL VAR inversdarstellung,
+ kontrolldatei zur vatertask :: TRUE,
+ mit kurzprotokoll :: TRUE,
+ mit anmerkungen :: TRUE,
+ auswertung geht zum drucker :: FALSE;
+WERKSTUECK VAR werkstueck;
+
+PROC bildschirmarbeitsplatz:
+ kontrolldatei zur vatertask := FALSE;
+ install menu (menukarte);
+ handle menu (menubezeichnung);
+END PROC bildschirmarbeitsplatz;
+PROC bap:
+ bildschirmarbeitsplatz
+END PROC bap;
+PROC materialpruefung:
+ TEXT VAR benutzerkennung :: "", protokollname, alter dateiname :: std;
+ install menu (menukarte, FALSE);
+ kontrolldatei zur vatertask := TRUE;
+ ermittle eingestellte parameter;
+ bereite den bildschirm vor;
+ ermittle die benutzerkennung;
+ gib benutzerhinweise aus;
+
+ arbeitsplatzsimulation ausfuehren (benutzerkennung, protokollname);
+ forget (protokollname, quiet);
+ last param (alter dateiname).
+ bereite den bildschirm vor:
+ WINDOW VAR w :: window ( 2, 10, 77, 14);
+ page;
+ show (w);
+ out (w, center (w, anwendungstext (400))).
+ ermittle die benutzerkennung:
+ benutzerkennung := compress (boxanswer (w, anwendungstext (401), "", 5));
+ IF benutzerkennung = ""
+ THEN cursor on; page;
+ LEAVE materialpruefung
+ FI.
+
+ gib benutzerhinweise aus:
+ boxinfo (w, anwendungstext (402));
+ boxinfo (w, anwendungstext (403));
+ boxinfo (w, anwendungstext (404));
+ gib bedieninformationen aus (2);
+ boxinfo (w, anwendungstext (405));
+ boxinfo (w, anwendungstext (406));
+ boxinfo (w, anwendungstext (407));
+ boxinfo (w, anwendungstext (408)).
+END PROC materialpruefung;
+PROC mp:
+ materialpruefung
+END PROC mp;
+PROC mp bap simulation ausfuehren:
+ TEXT VAR benutzerkennung :: "", dateiname;
+
+ kontrolldatei zur vatertask := FALSE;
+ ermittle eingestellte parameter;
+ bereite den bildschirm vor;
+ ermittle die benutzerkennung;
+ arbeitsplatzsimulation ausfuehren (benutzerkennung, dateiname);
+ regenerate menuscreen.
+ bereite den bildschirm vor:
+ WINDOW VAR w :: window (2,2,77,22);
+ page;
+ out (w, center (w, anwendungstext (399))).
+ ermittle die benutzerkennung:
+ benutzerkennung := compress (boxanswer (w, anwendungstext (401), "", 5));
+ IF benutzerkennung = ""
+
+ THEN regenerate menuscreen;
+ LEAVE mp bap simulation ausfuehren
+ FI.
+END PROC mp bap simulation ausfuehren;
+PROC mp bap auswertung auf bildschirm:
+ auswertung geht zum drucker := FALSE;
+ lasse protokolldateien auswaehlen;
+ werte protokolldateien aus;
+ regenerate menuscreen.
+ lasse protokolldateien auswaehlen:
+ THESAURUS VAR verfuegbare;
+ verfuegbare := infix namen (ALL myself, protokolldateipraefix,
+ protokolldateityp);
+
+ IF NOT not empty (verfuegbare)
+ THEN noch kein protokoll
+ ELSE biete auswahl an
+ FI.
+ noch kein protokoll:
+ regenerate menuscreen;
+ menuinfo (anwendungstext (424));
+ LEAVE mp bap auswertung auf bildschirm.
+ biete auswahl an:
+ verfuegbare := menusome (verfuegbare, anwendungstext (421),
+ anwendungstext (422), FALSE).
+ werte protokolldateien aus:
+ INT VAR k;
+ steige ggf bei leerem thesaurus aus;
+ FOR k FROM 1 UPTO highest entry (verfuegbare) REP
+
+ IF name (verfuegbare, k) <> ""
+ THEN disable stop;
+ gib hinweis auf auswertung;
+ simulationsauswertung (name (verfuegbare, k), TRUE);
+ forget (name (verfuegbare, k) + auswertdateipostfix, quiet);
+ fehlerbehandlung
+ FI
+ PER.
+ steige ggf bei leerem thesaurus aus:
+ IF NOT not empty (verfuegbare)
+ THEN regenerate menuscreen;
+ menuinfo (anwendungstext (423));
+ LEAVE mp bap auswertung auf bildschirm
+
+ FI.
+ gib hinweis auf auswertung:
+ page;
+ WINDOW VAR fenster :: window ( 2, 2, 77, 22);
+ show (fenster);
+ cursor (fenster, 1, 9); out (fenster, center (fenster, name (verfuegbare, k)));
+ cursor (fenster, 1, 12); out (fenster, center (anwendungstext (274))).
+ fehlerbehandlung:
+ IF is error
+ THEN regenerate menuscreen;
+ menuinfo (invers (errormessage));
+ clear error; enable stop;
+ LEAVE mp bap auswertung auf bildschirm
+ FI.
+
+END PROC mp bap auswertung auf bildschirm;
+PROC mp bap drucken von auswertungen:
+ auswertung geht zum drucker := TRUE;
+ lasse protokolldateien auswaehlen;
+ werte protokolldateien aus;
+ regenerate menuscreen.
+ lasse protokolldateien auswaehlen:
+ THESAURUS VAR verfuegbare;
+ verfuegbare := infix namen (ALL myself, protokolldateipraefix,
+ protokolldateityp);
+ IF NOT not empty (verfuegbare)
+ THEN noch kein protokoll
+ ELSE biete auswahl an
+
+ FI.
+ noch kein protokoll:
+ regenerate menuscreen;
+ menuinfo (anwendungstext (424));
+ LEAVE mp bap drucken von auswertungen.
+ biete auswahl an:
+ verfuegbare := menusome (verfuegbare, anwendungstext (425),
+ anwendungstext (422), FALSE).
+ werte protokolldateien aus:
+ INT VAR k;
+ steige ggf bei leerem thesaurus aus;
+ FOR k FROM 1 UPTO highest entry (verfuegbare) REP
+ IF name (verfuegbare, k) <> ""
+ THEN disable stop;
+ gib hinweis auf auswertung;
+
+ simulationsauswertung (name (verfuegbare, k), FALSE);
+ print (name (verfuegbare, k) + auswertdateipostfix);
+ forget (name (verfuegbare, k) + auswertdateipostfix, quiet);
+ fehlerbehandlung
+ FI
+ PER.
+ steige ggf bei leerem thesaurus aus:
+ IF NOT not empty (verfuegbare)
+ THEN regenerate menuscreen;
+ menuinfo (anwendungstext (423));
+ LEAVE mp bap drucken von auswertungen
+ FI.
+ gib hinweis auf auswertung:
+
+ page;
+ WINDOW VAR fenster :: window ( 2, 2, 77, 22);
+ show (fenster);
+ cursor (fenster, 1, 9); out (fenster, center (fenster, name (verfuegbare, k)));
+ cursor (fenster, 1, 12); out (fenster, center (anwendungstext (270))).
+ fehlerbehandlung:
+ IF is error
+ THEN regenerate menuscreen;
+ menuinfo (invers (errormessage));
+ clear error; enable stop;
+ LEAVE mp bap drucken von auswertungen
+ FI.
+END PROC mp bap drucken von auswertungen;
+
+PROC mp bap protokollumfang festlegen:
+ page;
+ zeige aktuellen protokollumfang an;
+ gib erlaeuterungen zum protokollumfang;
+ frage nach umfangsaenderung;
+ regenerate menuscreen
+END PROC mp bap protokollumfang festlegen;
+PROC mp bap kurzauswertung:
+ page;
+ zeige aktuelle kurzauswertungseinstellung an;
+ gib erlaeuterungen zur kurzauswertung;
+ frage nach kurzauswertungsaenderung;
+ regenerate menuscreen
+END PROC mp bap kurzauswertung;
+PROC druckereinstellung fuer protokolldatei (TEXT CONST schrifttyp,
+
+ REAL CONST linker rand,
+ oberer rand,
+ feldbreite,
+ feldlaenge):
+ protokollschrifttyp := schrifttyp;
+ xstart := linker rand;
+ ystart := oberer rand;
+ schreibfeldbreite := feldbreite;
+ schreibfeldlaenge := feldlaenge;
+END PROC druckereinstellung fuer protokolldatei;
+
+PROC stddruckereinstellung fuer protokolldatei:
+ protokollschrifttyp := stdschrifttyp;
+ xstart := stdxstart;
+ ystart := stdystart;
+ schreibfeldbreite := stdfeldbreite;
+ schreibfeldlaenge := stdfeldlaenge
+END PROC stddruckereinstellung fuer protokolldatei;
+ (********************************)
+PROC arbeitsplatzsimulation ausfuehren (TEXT CONST kennung,
+ TEXT VAR dateiname):
+ ermittle eingestellte parameter;
+
+ lege datei mit kennung an (kennung, dateiname);
+ cursor on;
+ fuehre simulation durch (dateiname);
+ schicke ggf protokolldatei zur vatertask;
+ gib ggf kurzprotokoll aus.
+ schicke ggf protokolldatei zur vatertask:
+ IF kontrolldatei zur vatertask
+ THEN command dialogue (FALSE);
+ save (dateiname);
+ command dialogue (TRUE)
+ FI.
+ gib ggf kurzprotokoll aus:
+ IF mit kurzprotokoll
+ THEN kurzauswertung auf bildschirm (dateiname)
+ ELSE page; put (anwendungstext (271))
+
+ FI.
+END PROC arbeitsplatzsimulation ausfuehren;
+PROC ermittle eingestellte parameter:
+ werkstueckdefinition (breite, hoehe, kleinster code, groesster code,
+ fehlerzeichen, inversdarstellung);
+ tastendefinition (nach rechts, nach links, nach oben, nach unten,
+ ausbesserung, naechstes);
+ phasendefinition (anzahl aphasen, aphasendauer, pausendauer);
+ bewertungsschluessel (bewertung);
+END PROC ermittle eingestellte parameter;
+PROC lege datei mit kennung an (TEXT CONST kennung, TEXT VAR datname):
+
+ BOUND KONTROLLTABELLE VAR tab;
+ TEXT VAR interner name :: protokolldateipraefix;
+ interner name CAT kennung;
+ lege neue datei an;
+ type (old (datname), protokolldateityp).
+ lege neue datei an:
+ INT VAR i :: 0; TEXT VAR bezeichnung;
+ REP
+ i INCR 1;
+ bezeichnung := interner name + " /" + text (i)
+ UNTIL NOT exists (bezeichnung) PER;
+ tab := new (bezeichnung);
+ initialisiere tabelle;
+ datname := bezeichnung.
+ initialisiere tabelle:
+ tab.letzter eintrag := 0.
+
+END PROC lege datei mit kennung an;
+PROC fuehre simulation durch (TEXT CONST dateiname):
+ BOUND KONTROLLTABELLE VAR tab :: old (dateiname);
+ TEXT CONST moegliche eingabezeichen :: nach rechts + nach links +
+ nach oben + nach unten +
+ ausbesserung + naechstes;
+ treffe vorbereitungen;
+ trage grunddaten in tabelle;
+ simuliere.
+ treffe vorbereitungen:
+ initialisierungen;
+ WINDOW VAR fenster :: window ( 1, 9, 79, 16);
+
+ page;
+ gib bedieninformationen aus (2);
+ werkstueckaufhaenger (eckspalte, eckzeile);
+ weise auf arbeitsbeginn hin;
+ beginn der arbeitsphase := clock (1);
+ beginn der bearbeitung := beginn der arbeitsphase;
+ arbeitsphasenlaenge := real (aphasendauer * 60).
+ initialisierungen:
+ INT VAR eintragzaehler :: 0,
+ arbeitsphasenzaehler :: 1,
+ werkstueckzaehler :: 0,
+ bedienfehlerzaehler :: 0,
+
+ korrekturzaehler :: 0,
+ produktionsfehler,
+ cursorspalte relativ,
+ cursorzeile relativ;
+ REAL VAR beginn der arbeitsphase,
+ beginn der bearbeitung,
+ arbeitsphasenlaenge,
+ arbeitsphasenueberziehung,
+ pausenueberziehung.
+ weise auf arbeitsbeginn hin:
+ page (fenster);
+ boxinfo (fenster, anwendungstext (252), 5, maxint);
+ clear buffer.
+ trage grunddaten in tabelle:
+ tab.datum := date;
+
+ tab.uhrzeit := time of day;
+ tab.breite := breite;
+ tab.hoehe := hoehe;
+ tab.kleinster code := kleinster code;
+ tab.groesster code := groesster code;
+ tab.anzahl aphasen := anzahl aphasen;
+ tab.aphasendauer := aphasendauer;
+ tab.pausendauer := pausendauer;
+ tab.fehlerzeichen := fehlerzeichen;
+ tab.nach rechts := nach rechts;
+ tab.nach links := nach links;
+ tab.nach oben := nach oben;
+
+ tab.nach unten := nach unten;
+ tab.ausbesserung := ausbesserung;
+ tab.naechstes := naechstes;
+ tab.inversdarstellung := inversdarstellung;
+ tab.bewertung := bewertung;
+ eintragzaehler := 1.
+ simuliere:
+ REP
+ gib holehinweis;
+ hole werkstueck (werkstueck, produktionsfehler);
+ zeige werkstueck (werkstueck, fenster);
+ lasse werkstueck bearbeiten
+ UNTIL simulationsende erreicht PER.
+ gib holehinweis:
+
+ page (fenster);
+ cursor (fenster, 2, 3); out (fenster, anwendungstext (253)).
+ lasse werkstueck bearbeiten:
+ initialisiere den relativcursor;
+ setze cursor;
+ clear buffer;
+ bearbeite das werkstueck.
+ initialisiere den relativcursor:
+ cursorspalte relativ := 1;
+ cursorzeile relativ := 1.
+ setze cursor:
+ IF inversdarstellung
+ THEN cursor (fenster, eckspalte + cursorspalte relativ,
+ eckzeile + cursorzeile relativ - 1);
+
+ ELSE cursor (fenster, eckspalte + cursorspalte relativ - 1,
+ eckzeile + cursorzeile relativ - 1);
+ FI.
+ bearbeite das werkstueck:
+ BOOL VAR werkstueck voll bearbeitet :: FALSE;
+ REP
+ hole eingabe und werte aus
+ UNTIL werkstueck voll bearbeitet PER.
+ hole eingabe und werte aus:
+ TEXT VAR eingabezeichen := incharety (100);
+ SELECT eingabezeichenposition OF
+ CASE 1: wenn moeglich nach rechts
+ CASE 2: wenn moeglich nach links
+
+ CASE 3: wenn moeglich nach oben
+ CASE 4: wenn moeglich nach unten
+ CASE 5: wenn moeglich ausbessern
+ CASE 6: beende werkstueckbearbeitung
+ OTHERWISE entscheide ob gepiepst wird
+ END SELECT.
+ eingabezeichenposition:
+ pos (moegliche eingabezeichen, eingabezeichen).