diff options
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). + 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; + diff --git a/mp-bap/ls-MP BAP-gen b/mp-bap/ls-MP BAP-gen index 26a84c3..40df0b4 100644 --- a/mp-bap/ls-MP BAP-gen +++ b/mp-bap/ls-MP BAP-gen @@ -22,9 +22,79 @@ 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 (eigener name, 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-MP BAP - Automatische Generierung "14"").{} -hole die dateien:{} IF NOT exists (datei 1){} COR NOT exists (datei 2){} COR NOT exists (menukarte){} THEN hole dateien vom archiv; LEAVE hole die dateien{} 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 2);{} 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;{} cursor (1, 3); out(""4"");{} out (" "15"Die Diskette wird nicht mehr benötigt! "14"");{} in (datei 1);{} in (datei 2);{} schicke (menukarte);{} IF einzeln THEN release (archive) FI;{} - check on.{}mache global manager aus der task:{} global manager.{} + 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 (eigener name, 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-MP BAP - Automatische Generierung "14""). + +hole die dateien: + IF NOT exists (datei 1) + COR NOT exists (datei 2) + COR NOT exists (menukarte) + THEN hole dateien vom archiv; LEAVE hole die dateien + 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 2); + 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; + cursor (1, 3); out(""4""); + out (" "15"Die Diskette wird nicht mehr benötigt! "14""); + in (datei 1); + in (datei 2); + schicke (menukarte); + IF einzeln THEN release (archive) FI; + + check on. +mache global manager aus der task: + global manager. + diff --git a/prozess/ls-Prozess 1 für AKTRONIC-Adapter b/prozess/ls-Prozess 1 für AKTRONIC-Adapter index c42cfa5..d49d9d2 100644 --- a/prozess/ls-Prozess 1 für AKTRONIC-Adapter +++ b/prozess/ls-Prozess 1 für AKTRONIC-Adapter @@ -22,36 +22,536 @@ *) PACKET ls prozess 1 DEFINES - run pdv,{} run pdv again,{} initialisiere interface,{} schalte alles aus,{} ausgeben,{} eingabe,{} warte,{} abbruch gewuenscht,{} tue nichts,{} trage kanaldaten ein,{} beende kanaldaten eintragen,{} hole spannungsbereich,{} letzte ausgabe,{} pruefe kanal,{} pruefe abbruch,{} teste interface,{} oeffne interface,{} schliesse interface,{} nicht belegt,{} digital aus,{} analog aus,{} - digital ein,{} analog ein,{} kanalbreite,{} ganzzahl obergrenze,{} adapterart,{} (* ------------------------- *){} kanalkoppler,{} interface kanal,{} oeffne interface direkt,{} schliesse interface direkt,{} initialisiere interface direkt,{} direkt ausgeben,{} direkt eingabe:{}(******** A N P A S S U N G A N A K T R O N I C - A D A P T E R ********){}LET interface test code = ""240"",{} interface open code = ""176"",{} - interface close code = ""176"",{} adresse 0 code = ""176"",{} interface write code = 64 ,{} interface read code = 192 ;{}TEXT CONST adapterart :: "AKTRONIC-Adapter";{}TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode):{} IF es ist ein ausgabekanal{} THEN code (interface write code + device + faktor * steuerungscode){} ELIF es ist ein eingabekanal{} THEN lesecode in abhaengigkeit von der taktzahl{} ELSE ""{} FI.{} es ist ein ausgabekanal:{} - kanal [kanalnummer].betriebsart < 0.{} es ist ein eingabekanal:{} kanal [kanalnummer].betriebsart > 0.{} device:{} IF steckplatznummer < 3{} THEN 16{} ELSE 32{} FI.{} faktor:{} IF steckplatznummer MOD 2 = 0{} THEN 4{} ELSE 1{} FI.{} steckplatznummer:{} IF kanalnummer < 10{} THEN 1{} ELSE kanalnummer DIV 10{} FI.{} lesecode in abhaengigkeit von der taktzahl:{} SELECT kanal [kanalnummer].taktzahl OF{} CASE 1: code fuer digital oder analog eingang{} - CASE 2: code fuer kombi e1{} CASE 3: code fuer kombi e2{} OTHERWISE "" END SELECT.{} code fuer digital oder analog eingang:{} IF kanal [kanalnummer].betriebsart = analog ein{} THEN kanal [kanalnummer].taktzahl := 2; (* ad wandler muss hier *){} lesecode + lesecode (* 2x gelesen werden! *){} ELSE lesecode{} FI.{} lesecode : code (interface read code + device + faktor * steuerungscode).{} code fuer kombi e1:{} kanal [kanalnummer].taktzahl INCR 1; (* bei Analogport1 der Kombikarte *){} - adresse 0 code + (3 * lesecode). (* sind hier 3 Takte noetig ! *){} code fuer kombi e2:{} kanal [kanalnummer].taktzahl DECR 1; (* hier nur 2 Takte noetig ! *){} adresse 0 code + lesecode + lesecode.{}END PROC interface anpassung;{}(************ H A R D W A R E U N A B H Ä N G I G E R T E I L ************){}LET max kanalanzahl = 49,{} initcode = 50,{} endcode = 51,{} alles aus code = 52,{} - endezeichen = "q",{} abbruchzeichen = "h",{} esc = ""27"";{}INT CONST analog aus :: -2, (* Betriebsarten *){} digital aus :: -1,{} nicht belegt :: 0,{} digital ein :: 1,{} analog ein :: 2,{} kanalbreite :: 8,{} ganzzahl obergrenze :: 2 ** kanalbreite,{} configuration error code :: -1,{} - kanal besetzt code :: -3,{} interface error code :: -4,{} not init code :: -5;{}INT VAR interfacechannel :: 2,{} dummy;{}TEXT VAR meldung :: "";{}BOOL VAR kanaldaten sind eingetragen :: FALSE,{} endezeichen gegeben :: FALSE,{} programm mit pdv gestartet :: FALSE,{} fehler zu melden :: FALSE;{}TASK VAR interface task :: niltask;{}DATASPACE VAR ds :: nilspace;{} -TYPE KANAL = STRUCT (INT betriebsart, taktzahl, TEXT steuercode),{} SPANNUNG = STRUCT (REAL minimalwert, maximalwert);{}ROW max kanalanzahl INT VAR vorherige ausgabe;{}ROW max kanalanzahl KANAL VAR kanal;{}ROW max kanalanzahl SPANNUNG VAR spannung;{}ROW 5 TEXT CONST fehlermeldung :: ROW 5 TEXT :{} ("Interface ist noch nicht konfiguriert!",{} "Interface-Task ist besetzt!",{} "Interface-Kanal ist belegt!",{} "Interface meldet sich nicht!",{} "Interface kann nicht geöffnet werden!");{} -PROC run pdv:{} run pdv (last param){}END PROC run pdv;{}PROC run pdv (TEXT CONST programmname):{} enable stop;{} last param (programmname);{} programm mit pdv gestartet := TRUE;{} teste interface;{} disable stop;{} run (programmname);{} IF is error{} THEN fehlerbehandlung{} ELSE melde programmende{} FI;{} schliesse interface;{} programm mit pdv gestartet := FALSE;{} enable stop;{} IF fehler zu melden{} THEN errorstop (meldung){} FI{}END PROC run pdv;{}PROC run pdv again:{} - enable stop;{} programm mit pdv gestartet := TRUE;{} teste interface;{} disable stop;{} run again;{} IF is error{} THEN fehlerbehandlung{} ELSE melde programmende{} FI;{} schliesse interface;{} programm mit pdv gestartet := FALSE;{} enable stop;{} IF fehler zu melden{} THEN errorstop (meldung){} FI{}END PROC run pdv again;{}PROC melde programmende:{} page;{} menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen.");{} pause;{} schalte alles aus{}END PROC melde programmende;{} -PROC initialisiere interface:{} enable stop;{} pruefe abbruch;{} IF programm mit pdv gestartet{} THEN schalte alles aus{} ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!"){} FI{}END PROC initialisiere interface;{}PROC schalte alles aus:{} INT VAR k;{} FOR k FROM 1 UPTO max kanalanzahl REP{} vorherige ausgabe [k] := 0{} PER;{} forget (ds); ds := nilspace;{} call (interface task, alles aus code, ds, dummy){}END PROC schalte alles aus;{}PROC ausgeben (INT CONST kanalnummer, wert):{} - merke wert;{} gib wert aus.{} merke wert:{} vorherige ausgabe [kanalnummer] := wert.{} gib wert aus:{} call (interface task, 256 * kanalnummer + wert, ds, dummy).{}END PROC ausgeben;{}INT PROC eingabe (INT CONST kanalnummer):{} INT VAR eingabewert;{} call (interface task, kanalnummer, ds, eingabewert);{} eingabewert{}END PROC eingabe;{}PROC warte (REAL CONST sekunden):{} TEXT VAR eingabe;{} pruefe abbruch;{} eingabe := incharety (int (sekunden * 10.0 + 0.5));{} IF eingabe = esc{} - THEN untersuche naechstes zeichen{} FI.{} untersuche naechstes zeichen:{} eingabe := incharety (30);{} IF eingabe = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF eingabe = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <ESC><"{} + abbruchzeichen + ">!"){} FI.{}END PROC warte;{}PROC warte (INT CONST sekunden):{} TEXT VAR eingabe;{} pruefe abbruch;{} eingabe := incharety (sekunden * 10);{} IF eingabe = esc{} THEN untersuche naechstes zeichen{} - FI.{} untersuche naechstes zeichen:{} eingabe := incharety (30);{} IF eingabe = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF eingabe = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <ESC><"{} + abbruchzeichen + ">!"){} FI.{}END PROC warte;{}BOOL PROC abbruch gewuenscht:{} pruefe abbruch;{} BOOL VAR entscheidung :: endezeichen gegeben;{} endezeichen gegeben := FALSE;{} entscheidung{}END PROC abbruch gewuenscht;{}PROC tue nichts:{} - pruefe abbruch{}END PROC tue nichts;{}PROC trage kanaldaten ein (INT CONST kanalnummer,{} ROW 2 REAL CONST spannungsbereich,{} ROW 3 INT CONST kanalparameter):{} spannung [kanalnummer].minimalwert := spannungsbereich [1];{} spannung [kanalnummer].maximalwert := spannungsbereich [2];{} kanal [kanalnummer].betriebsart := kanalparameter [1];{} kanal [kanalnummer].taktzahl := kanalparameter [2];{} kanal [kanalnummer].steuercode := interface anpassung{} - (kanalnummer, kanalparameter [3]){}END PROC trage kanaldaten ein;{}PROC beende kanaldaten eintragen:{} loesche interface task;{} begin (PROC kanal koppler, interface task);{} kanaldaten sind eingetragen := TRUE.{} loesche interface task:{} disable stop;{} end (interface task);{} IF is error{} THEN clear error{} FI;{} enable stop.{}END PROC beende kanaldaten eintragen;{}PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR u min, u max):{} - u min := spannung [kanalnummer].minimalwert;{} u max := spannung [kanalnummer].maximalwert{}END PROC hole spannungsbereich;{}INT PROC letzte ausgabe (INT CONST kanalnummer):{} vorherige ausgabe [kanalnummer]{}END PROC letzte ausgabe;{}PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart):{} pruefe abbruch;{} pruefe kanalnummer;{} pruefe betriebsart.{} pruefe kanalnummer:{} IF kanalnummer < 1 OR kanalnummer > max kanalanzahl{} THEN errorstop ("Kanalnummer " + text (kanalnummer) +{} - " ist unzulaessig !"){} FI.{} pruefe betriebsart:{} IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart{} THEN errorstop ("An Kanal " + text (kanalnummer) +{} " keine " + wunsch + " moeglich!"){} FI.{} wunsch:{} IF gewuenschte betriebsart = analog aus{} THEN "Analog-Ausgabe"{} ELIF gewuenschte betriebsart = digital aus{} THEN "Digital-Ausgabe"{} ELIF gewuenschte betriebsart = digital ein{} THEN "Digital-Eingabe"{} - ELIF gewuenschte betriebsart = analog ein{} THEN "Analog-Eingabe"{} ELSE "Ein- oder Ausgabe"{} FI.{}END PROC pruefe kanal;{}PROC pruefe abbruch:{} IF incharety = esc{} THEN pruefe weiter{} FI.{} pruefe weiter:{} TEXT CONST zeichen :: incharety (30);{} IF zeichen = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF zeichen = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <ESC><"{} + abbruchzeichen + ">!"){} - FI.{}END PROC pruefe abbruch;{}PROC oeffne interface (INT VAR status):{} enable stop;{} forget (ds); ds := nilspace;{} IF kanaldaten sind eingetragen{} THEN pingpong (interfacetask, initcode, ds, status){} ELSE status := configuration error code{} FI;{} IF status > 0 THEN status DECR maxint FI;{} forget (ds); ds := nilspace{}END PROC oeffne interface;{}PROC schliesse interface:{} enable stop;{} forget (ds); ds := nilspace;{} pingpong (interface task, end code, ds, dummy);{} forget (ds); ds := nilspace{} -END PROC schliesse interface;{}PROC teste interface:{} INT VAR test;{} oeffne interface (test);{} IF test < 0{} THEN errorstop (fehlermeldung [min (5, abs (test))]){} ELSE fehler zu melden := FALSE;{} endezeichen gegeben := FALSE{} FI{}END PROC teste interface;{}PROC fehlerbehandlung:{} meldung := errormessage;{} IF meldung <> ""{} THEN meldung CAT fehlerzeile;{} fehler zu melden := TRUE{} FI;{} clear error;{} initialisiere interface.{} fehlerzeile:{} - IF errorline = 0{} THEN ""{} ELSE " (bei Zeile " + text (errorline) + ")"{} FI.{}END PROC fehlerbehandlung;{}(******************** EIN-/AUSGABE AM INTERFACE-KANAL ********************){}PROC kanalkoppler:{} IF name (myself) <> "-"{} THEN errorstop ("Unzulässiges Kommando!"){} ELSE warte auf anrufe{} FI.{} warte auf anrufe:{} TASK VAR absender;{} TEXT VAR dummy;{} INT VAR codenummer, antwort;{} disable stop;{} REP forget (ds);{} wait (ds, codenummer, absender);{} - IF codenummer = initcode{} THEN kopple an interface kanal;{} IF interface ist betriebsbereit{} THEN bearbeite weitere auftraege{} ELSE gib negative rueckmeldung{} FI;{} gib kanal frei{} ELSE antwort := not init code;{} gib negative rueckmeldung{} FI{} PER.{} kopple an interface kanal:{} continue (interface channel);{} IF is error{} THEN clear error;{} antwort := kanal besetzt code{} - ELSE oeffne interface direkt (antwort){} FI.{} interface ist betriebsbereit: antwort = 0.{} gib negative rueckmeldung: send (absender, antwort, ds).{} gib kanal frei:{} break (quiet);{} send (absender, 0, ds, antwort);{} collect heap garbage.{} bearbeite weitere auftraege:{} REP call (absender, antwort, ds, codenummer);{} IF codenummer > 255{} THEN sende wert an interface{} ELIF codenummer < 50{} THEN hole wert von interface{} ELIF codenummer = alles aus code{} - THEN initialisiere interface direkt{} FI{} UNTIL codenummer = endcode PER;{} IF is error THEN clear error FI;{} schliesse interface direkt.{} sende wert an interface:{} out (kanal [codenummer DIV 256].steuercode);{} out (code (codenummer)).{} hole wert von interface:{} out (kanal [codenummer].steuercode);{} SELECT kanal [codenummer].taktzahl OF{} CASE 1 : antwort := erstes zeichen{} CASE 2 : antwort := zweites zeichen{} CASE 3 : antwort := drittes zeichen{} - OTHERWISE antwort := -1{} END SELECT.{} erstes zeichen:{} code (incharety (1)).{} zweites zeichen:{} dummy := incharety (1);{} code (incharety (1)).{} drittes zeichen:{} dummy := incharety (1);{} dummy := incharety (1);{} code (incharety (1)).{}END PROC kanalkoppler;{}PROC interface kanal (INT CONST kanalnummer):{} enable stop;{} IF kanalnummer < 1 OR kanalnummer > 24{} THEN errorstop ("Unzulaessige Kanalnummer"){} ELSE interface channel := kanalnummer{} - FI{}END PROC interface kanal;{}INT PROC interface kanal:{} interface channel{}END PROC interface kanal;{}PROC oeffne interface direkt (INT VAR status):{} leere puffer;{} out (interface test code);{} IF antwort <> ""{} THEN status := 0;{} out (interface open code){} ELSE status := interface error code{} FI.{} leere puffer:{} REP UNTIL incharety = "" PER.{} antwort: incharety (1).{}END PROC oeffne interface direkt;{}PROC schliesse interface direkt:{} out (interface close code){} -END PROC schliesse interface direkt;{}PROC initialisiere interface direkt:{} schalte alles aus.{} schalte alles aus:{} INT VAR kanalnummer, kanalbetriebsart;{} FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{} kanalbetriebsart := kanal [kanalnummer].betriebsart;{} IF kanalbetriebsart = digital aus{} THEN direkt ausgeben (kanalnummer, 0){} ELIF kanalbetriebsart = analog aus{} THEN direkt ausgeben (kanalnummer, gewandelte nullspannung){} FI{} - PER.{} gewandelte nullspannung:{} int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5).{} u max : spannung [kanalnummer].maximalwert.{} u min : spannung [kanalnummer].minimalwert.{}END PROC initialisiere interface direkt;{}PROC direkt ausgeben (INT CONST kanalnummer, wert):{} out (kanal [kanalnummer].steuercode);{} out (code (wert)){}END PROC direkt ausgeben;{}INT PROC direkt eingabe (INT CONST kanalnummer):{} gib lesecode aus;{} erhaltene antwort.{} gib lesecode aus:{} - out (kanal [kanalnummer].steuercode).{} erhaltene antwort:{} TEXT VAR dummy;{} SELECT kanal [kanalnummer].taktzahl OF{} CASE 1 : erstes zeichen{} CASE 2 : zweites zeichen{} CASE 3 : drittes zeichen{} OTHERWISE -1{} END SELECT.{} erstes zeichen:{} code (incharety (1)).{} zweites zeichen:{} dummy := incharety (1);{} code (incharety (1)).{} drittes zeichen:{} dummy := incharety (1);{} dummy := incharety (1);{} code (incharety (1)).{} -END PROC direkt eingabe;{}PROC initialisiere die kanaele:{} INT VAR kanalnummer;{} FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{} trage kanaldaten ein (kanalnummer, keine spannung, leere karte);{} vorherige ausgabe [kanalnummer] := 0{} PER.{} keine spannung:{} ROW 2 REAL : (0.0, 0.0).{} leere karte:{} ROW 3 INT : (nicht belegt, 0, 0).{}END PROC initialisiere die kanaele;{}initialisiere die kanaele;{}END PACKET ls prozess 1{} + run pdv, + run pdv again, + initialisiere interface, + schalte alles aus, + ausgeben, + eingabe, + warte, + abbruch gewuenscht, + tue nichts, + trage kanaldaten ein, + beende kanaldaten eintragen, + hole spannungsbereich, + letzte ausgabe, + pruefe kanal, + pruefe abbruch, + teste interface, + oeffne interface, + schliesse interface, + nicht belegt, + digital aus, + analog aus, + + digital ein, + analog ein, + kanalbreite, + ganzzahl obergrenze, + adapterart, + (* ------------------------- *) + kanalkoppler, + interface kanal, + oeffne interface direkt, + schliesse interface direkt, + initialisiere interface direkt, + direkt ausgeben, + direkt eingabe: +(******** A N P A S S U N G A N A K T R O N I C - A D A P T E R ********) +LET interface test code = ""240"", + interface open code = ""176"", + + interface close code = ""176"", + adresse 0 code = ""176"", + interface write code = 64 , + interface read code = 192 ; +TEXT CONST adapterart :: "AKTRONIC-Adapter"; +TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode): + IF es ist ein ausgabekanal + THEN code (interface write code + device + faktor * steuerungscode) + ELIF es ist ein eingabekanal + THEN lesecode in abhaengigkeit von der taktzahl + ELSE "" + FI. + es ist ein ausgabekanal: + + kanal [kanalnummer].betriebsart < 0. + es ist ein eingabekanal: + kanal [kanalnummer].betriebsart > 0. + device: + IF steckplatznummer < 3 + THEN 16 + ELSE 32 + FI. + faktor: + IF steckplatznummer MOD 2 = 0 + THEN 4 + ELSE 1 + FI. + steckplatznummer: + IF kanalnummer < 10 + THEN 1 + ELSE kanalnummer DIV 10 + FI. + lesecode in abhaengigkeit von der taktzahl: + SELECT kanal [kanalnummer].taktzahl OF + CASE 1: code fuer digital oder analog eingang + + CASE 2: code fuer kombi e1 + CASE 3: code fuer kombi e2 + OTHERWISE "" END SELECT. + code fuer digital oder analog eingang: + IF kanal [kanalnummer].betriebsart = analog ein + THEN kanal [kanalnummer].taktzahl := 2; (* ad wandler muss hier *) + lesecode + lesecode (* 2x gelesen werden! *) + ELSE lesecode + FI. + lesecode : code (interface read code + device + faktor * steuerungscode). + code fuer kombi e1: + kanal [kanalnummer].taktzahl INCR 1; (* bei Analogport1 der Kombikarte *) + + adresse 0 code + (3 * lesecode). (* sind hier 3 Takte noetig ! *) + code fuer kombi e2: + kanal [kanalnummer].taktzahl DECR 1; (* hier nur 2 Takte noetig ! *) + adresse 0 code + lesecode + lesecode. +END PROC interface anpassung; +(************ H A R D W A R E U N A B H Ä N G I G E R T E I L ************) +LET max kanalanzahl = 49, + initcode = 50, + endcode = 51, + alles aus code = 52, + + endezeichen = "q", + abbruchzeichen = "h", + esc = ""27""; +INT CONST analog aus :: -2, (* Betriebsarten *) + digital aus :: -1, + nicht belegt :: 0, + digital ein :: 1, + analog ein :: 2, + kanalbreite :: 8, + ganzzahl obergrenze :: 2 ** kanalbreite, + configuration error code :: -1, + + kanal besetzt code :: -3, + interface error code :: -4, + not init code :: -5; +INT VAR interfacechannel :: 2, + dummy; +TEXT VAR meldung :: ""; +BOOL VAR kanaldaten sind eingetragen :: FALSE, + endezeichen gegeben :: FALSE, + programm mit pdv gestartet :: FALSE, + fehler zu melden :: FALSE; +TASK VAR interface task :: niltask; +DATASPACE VAR ds :: nilspace; + +TYPE KANAL = STRUCT (INT betriebsart, taktzahl, TEXT steuercode), + SPANNUNG = STRUCT (REAL minimalwert, maximalwert); +ROW max kanalanzahl INT VAR vorherige ausgabe; +ROW max kanalanzahl KANAL VAR kanal; +ROW max kanalanzahl SPANNUNG VAR spannung; +ROW 5 TEXT CONST fehlermeldung :: ROW 5 TEXT : + ("Interface ist noch nicht konfiguriert!", + "Interface-Task ist besetzt!", + "Interface-Kanal ist belegt!", + "Interface meldet sich nicht!", + "Interface kann nicht geöffnet werden!"); + +PROC run pdv: + run pdv (last param) +END PROC run pdv; +PROC run pdv (TEXT CONST programmname): + enable stop; + last param (programmname); + programm mit pdv gestartet := TRUE; + teste interface; + disable stop; + run (programmname); + IF is error + THEN fehlerbehandlung + ELSE melde programmende + FI; + schliesse interface; + programm mit pdv gestartet := FALSE; + enable stop; + IF fehler zu melden + THEN errorstop (meldung) + FI +END PROC run pdv; +PROC run pdv again: + + enable stop; + programm mit pdv gestartet := TRUE; + teste interface; + disable stop; + run again; + IF is error + THEN fehlerbehandlung + ELSE melde programmende + FI; + schliesse interface; + programm mit pdv gestartet := FALSE; + enable stop; + IF fehler zu melden + THEN errorstop (meldung) + FI +END PROC run pdv again; +PROC melde programmende: + page; + menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen."); + pause; + schalte alles aus +END PROC melde programmende; + +PROC initialisiere interface: + enable stop; + pruefe abbruch; + IF programm mit pdv gestartet + THEN schalte alles aus + ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!") + FI +END PROC initialisiere interface; +PROC schalte alles aus: + INT VAR k; + FOR k FROM 1 UPTO max kanalanzahl REP + vorherige ausgabe [k] := 0 + PER; + forget (ds); ds := nilspace; + call (interface task, alles aus code, ds, dummy) +END PROC schalte alles aus; +PROC ausgeben (INT CONST kanalnummer, wert): + + merke wert; + gib wert aus. + merke wert: + vorherige ausgabe [kanalnummer] := wert. + gib wert aus: + call (interface task, 256 * kanalnummer + wert, ds, dummy). +END PROC ausgeben; +INT PROC eingabe (INT CONST kanalnummer): + INT VAR eingabewert; + call (interface task, kanalnummer, ds, eingabewert); + eingabewert +END PROC eingabe; +PROC warte (REAL CONST sekunden): + TEXT VAR eingabe; + pruefe abbruch; + eingabe := incharety (int (sekunden * 10.0 + 0.5)); + IF eingabe = esc + + THEN untersuche naechstes zeichen + FI. + untersuche naechstes zeichen: + eingabe := incharety (30); + IF eingabe = endezeichen + THEN endezeichen gegeben := TRUE + ELIF eingabe = abbruchzeichen + THEN errorstop ("Programm-Abbruch durch <ESC><" + + abbruchzeichen + ">!") + FI. +END PROC warte; +PROC warte (INT CONST sekunden): + TEXT VAR eingabe; + pruefe abbruch; + eingabe := incharety (sekunden * 10); + IF eingabe = esc + THEN untersuche naechstes zeichen + + FI. + untersuche naechstes zeichen: + eingabe := incharety (30); + IF eingabe = endezeichen + THEN endezeichen gegeben := TRUE + ELIF eingabe = abbruchzeichen + THEN errorstop ("Programm-Abbruch durch <ESC><" + + abbruchzeichen + ">!") + FI. +END PROC warte; +BOOL PROC abbruch gewuenscht: + pruefe abbruch; + BOOL VAR entscheidung :: endezeichen gegeben; + endezeichen gegeben := FALSE; + entscheidung +END PROC abbruch gewuenscht; +PROC tue nichts: + + pruefe abbruch +END PROC tue nichts; +PROC trage kanaldaten ein (INT CONST kanalnummer, + ROW 2 REAL CONST spannungsbereich, + ROW 3 INT CONST kanalparameter): + spannung [kanalnummer].minimalwert := spannungsbereich [1]; + spannung [kanalnummer].maximalwert := spannungsbereich [2]; + kanal [kanalnummer].betriebsart := kanalparameter [1]; + kanal [kanalnummer].taktzahl := kanalparameter [2]; + kanal [kanalnummer].steuercode := interface anpassung + + (kanalnummer, kanalparameter [3]) +END PROC trage kanaldaten ein; +PROC beende kanaldaten eintragen: + loesche interface task; + begin (PROC kanal koppler, interface task); + kanaldaten sind eingetragen := TRUE. + loesche interface task: + disable stop; + end (interface task); + IF is error + THEN clear error + FI; + enable stop. +END PROC beende kanaldaten eintragen; +PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR u min, u max): + + u min := spannung [kanalnummer].minimalwert; + u max := spannung [kanalnummer].maximalwert +END PROC hole spannungsbereich; +INT PROC letzte ausgabe (INT CONST kanalnummer): + vorherige ausgabe [kanalnummer] +END PROC letzte ausgabe; +PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart): + pruefe abbruch; + pruefe kanalnummer; + pruefe betriebsart. + pruefe kanalnummer: + IF kanalnummer < 1 OR kanalnummer > max kanalanzahl + THEN errorstop ("Kanalnummer " + text (kanalnummer) + + + " ist unzulaessig !") + FI. + pruefe betriebsart: + IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart + THEN errorstop ("An Kanal " + text (kanalnummer) + + " keine " + wunsch + " moeglich!") + FI. + wunsch: + IF gewuenschte betriebsart = analog aus + THEN "Analog-Ausgabe" + ELIF gewuenschte betriebsart = digital aus + THEN "Digital-Ausgabe" + ELIF gewuenschte betriebsart = digital ein + THEN "Digital-Eingabe" + + ELIF gewuenschte betriebsart = analog ein + THEN "Analog-Eingabe" + ELSE "Ein- oder Ausgabe" + FI. +END PROC pruefe kanal; +PROC pruefe abbruch: + IF incharety = esc + THEN pruefe weiter + FI. + pruefe weiter: + TEXT CONST zeichen :: incharety (30); + IF zeichen = endezeichen + THEN endezeichen gegeben := TRUE + ELIF zeichen = abbruchzeichen + THEN errorstop ("Programm-Abbruch durch <ESC><" + + abbruchzeichen + ">!") + + FI. +END PROC pruefe abbruch; +PROC oeffne interface (INT VAR status): + enable stop; + forget (ds); ds := nilspace; + IF kanaldaten sind eingetragen + THEN pingpong (interfacetask, initcode, ds, status) + ELSE status := configuration error code + FI; + IF status > 0 THEN status DECR maxint FI; + forget (ds); ds := nilspace +END PROC oeffne interface; +PROC schliesse interface: + enable stop; + forget (ds); ds := nilspace; + pingpong (interface task, end code, ds, dummy); + forget (ds); ds := nilspace + +END PROC schliesse interface; +PROC teste interface: + INT VAR test; + oeffne interface (test); + IF test < 0 + THEN errorstop (fehlermeldung [min (5, abs (test))]) + ELSE fehler zu melden := FALSE; + endezeichen gegeben := FALSE + FI +END PROC teste interface; +PROC fehlerbehandlung: + meldung := errormessage; + IF meldung <> "" + THEN meldung CAT fehlerzeile; + fehler zu melden := TRUE + FI; + clear error; + initialisiere interface. + fehlerzeile: + + IF errorline = 0 + THEN "" + ELSE " (bei Zeile " + text (errorline) + ")" + FI. +END PROC fehlerbehandlung; +(******************** EIN-/AUSGABE AM INTERFACE-KANAL ********************) +PROC kanalkoppler: + IF name (myself) <> "-" + THEN errorstop ("Unzulässiges Kommando!") + ELSE warte auf anrufe + FI. + warte auf anrufe: + TASK VAR absender; + TEXT VAR dummy; + INT VAR codenummer, antwort; + disable stop; + REP forget (ds); + wait (ds, codenummer, absender); + + IF codenummer = initcode + THEN kopple an interface kanal; + IF interface ist betriebsbereit + THEN bearbeite weitere auftraege + ELSE gib negative rueckmeldung + FI; + gib kanal frei + ELSE antwort := not init code; + gib negative rueckmeldung + FI + PER. + kopple an interface kanal: + continue (interface channel); + IF is error + THEN clear error; + antwort := kanal besetzt code + + ELSE oeffne interface direkt (antwort) + FI. + interface ist betriebsbereit: antwort = 0. + gib negative rueckmeldung: send (absender, antwort, ds). + gib kanal frei: + break (quiet); + send (absender, 0, ds, antwort); + collect heap garbage. + bearbeite weitere auftraege: + REP call (absender, antwort, ds, codenummer); + IF codenummer > 255 + THEN sende wert an interface + ELIF codenummer < 50 + THEN hole wert von interface + ELIF codenummer = alles aus code + + THEN initialisiere interface direkt + FI + UNTIL codenummer = endcode PER; + IF is error THEN clear error FI; + schliesse interface direkt. + sende wert an interface: + out (kanal [codenummer DIV 256].steuercode); + out (code (codenummer)). + hole wert von interface: + out (kanal [codenummer].steuercode); + SELECT kanal [codenummer].taktzahl OF + CASE 1 : antwort := erstes zeichen + CASE 2 : antwort := zweites zeichen + CASE 3 : antwort := drittes zeichen + + OTHERWISE antwort := -1 + END SELECT. + erstes zeichen: + code (incharety (1)). + zweites zeichen: + dummy := incharety (1); + code (incharety (1)). + drittes zeichen: + dummy := incharety (1); + dummy := incharety (1); + code (incharety (1)). +END PROC kanalkoppler; +PROC interface kanal (INT CONST kanalnummer): + enable stop; + IF kanalnummer < 1 OR kanalnummer > 24 + THEN errorstop ("Unzulaessige Kanalnummer") + ELSE interface channel := kanalnummer + + FI +END PROC interface kanal; +INT PROC interface kanal: + interface channel +END PROC interface kanal; +PROC oeffne interface direkt (INT VAR status): + leere puffer; + out (interface test code); + IF antwort <> "" + THEN status := 0; + out (interface open code) + ELSE status := interface error code + FI. + leere puffer: + REP UNTIL incharety = "" PER. + antwort: incharety (1). +END PROC oeffne interface direkt; +PROC schliesse interface direkt: + out (interface close code) + +END PROC schliesse interface direkt; +PROC initialisiere interface direkt: + schalte alles aus. + schalte alles aus: + INT VAR kanalnummer, kanalbetriebsart; + FOR kanalnummer FROM 1 UPTO max kanalanzahl REP + kanalbetriebsart := kanal [kanalnummer].betriebsart; + IF kanalbetriebsart = digital aus + THEN direkt ausgeben (kanalnummer, 0) + ELIF kanalbetriebsart = analog aus + THEN direkt ausgeben (kanalnummer, gewandelte nullspannung) + FI + + PER. + gewandelte nullspannung: + int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5). + u max : spannung [kanalnummer].maximalwert. + u min : spannung [kanalnummer].minimalwert. +END PROC initialisiere interface direkt; +PROC direkt ausgeben (INT CONST kanalnummer, wert): + out (kanal [kanalnummer].steuercode); + out (code (wert)) +END PROC direkt ausgeben; +INT PROC direkt eingabe (INT CONST kanalnummer): + gib lesecode aus; + erhaltene antwort. + gib lesecode aus: + + out (kanal [kanalnummer].steuercode). + erhaltene antwort: + TEXT VAR dummy; + SELECT kanal [kanalnummer].taktzahl OF + CASE 1 : erstes zeichen + CASE 2 : zweites zeichen + CASE 3 : drittes zeichen + OTHERWISE -1 + END SELECT. + erstes zeichen: + code (incharety (1)). + zweites zeichen: + dummy := incharety (1); + code (incharety (1)). + drittes zeichen: + dummy := incharety (1); + dummy := incharety (1); + code (incharety (1)). + +END PROC direkt eingabe; +PROC initialisiere die kanaele: + INT VAR kanalnummer; + FOR kanalnummer FROM 1 UPTO max kanalanzahl REP + trage kanaldaten ein (kanalnummer, keine spannung, leere karte); + vorherige ausgabe [kanalnummer] := 0 + PER. + keine spannung: + ROW 2 REAL : (0.0, 0.0). + leere karte: + ROW 3 INT : (nicht belegt, 0, 0). +END PROC initialisiere die kanaele; +initialisiere die kanaele; +END PACKET ls prozess 1 + diff --git a/prozess/ls-Prozess 1 für MUFI als Endgerät b/prozess/ls-Prozess 1 für MUFI als Endgerät index 4d2a5f4..3408230 100644 --- a/prozess/ls-Prozess 1 für MUFI als Endgerät +++ b/prozess/ls-Prozess 1 für MUFI als Endgerät @@ -22,36 +22,529 @@ *) PACKET ls prozess 1 DEFINES - run pdv,{} run pdv again,{} initialisiere interface,{} schalte alles aus,{} ausgeben,{} eingabe,{} warte,{} abbruch gewuenscht,{} tue nichts,{} trage kanaldaten ein,{} beende kanaldaten eintragen,{} hole spannungsbereich,{} letzte ausgabe,{} pruefe kanal,{} pruefe abbruch,{} teste interface,{} oeffne interface,{} schliesse interface,{} nicht belegt,{} digital aus,{} analog aus,{} - digital ein,{} analog ein,{} kanalbreite,{} ganzzahl obergrenze,{} adapterart,{} (* ------------------------- *){} kanalkoppler,{} interface kanal,{} oeffne interface direkt,{} schliesse interface direkt,{} initialisiere interface direkt,{} direkt ausgeben,{} direkt eingabe:{}(******************** A N P A S S U N G A N M U F I ********************){}LET interface test code = ""27""27"10",{} interface okay code = ""27""27"00",{} - interface open code = ""27""27"1A18",{} interface close code = ""25""27""27"13",{} adresse 0 code = ""61"",{} leertakt code = ""62"",{} interface write code = 80 ,{} interface read code = 64 ,{} erwartete zeichen = 4 ;{}TEXT CONST adapterart :: "MUFI als Endgerät";{}TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode):{} IF es ist ein ausgabekanal{} THEN code (interface write code + device + 4 * steuerungscode){} ELIF es ist ein eingabekanal{} - THEN lesecode in abhaengigkeit von der taktzahl{} ELSE ""{} FI.{} es ist ein ausgabekanal:{} kanal [kanalnummer].betriebsart < 0.{} es ist ein eingabekanal:{} kanal [kanalnummer].betriebsart > 0.{} device:{} IF kanalnummer < 10{} THEN 0{} ELSE kanalnummer DIV 10 - 1{} FI.{} lesecode in abhaengigkeit von der taktzahl:{} SELECT kanal [kanalnummer].taktzahl OF{} CASE 1: lesecode{} CASE 2: adresse 0 code + lesecode + lesecode{} CASE 3: adresse 0 code + lesecode + zwei weitere takte{} - OTHERWISE "" END SELECT.{} lesecode : code (interface read code + device + 4 * steuerungscode).{} zwei weitere takte:{} IF leertakt code = ""{} THEN lesecode + lesecode{} ELSE kanal [kanalnummer].taktzahl DECR 1;{} leertakt code + lesecode{} FI.{}END PROC interface anpassung;{}(************ H A R D W A R E U N A B H Ä N G I G E R T E I L ************){}LET max kanalanzahl = 49,{} initcode = 50,{} endcode = 51,{} - alles aus code = 52,{} endezeichen = "q",{} abbruchzeichen = "h",{} esc = ""27"";{}INT CONST analog aus :: -2, (* Betriebsarten *){} digital aus :: -1,{} nicht belegt :: 0,{} digital ein :: 1,{} analog ein :: 2,{} kanalbreite :: 8,{} ganzzahl obergrenze :: 2 ** kanalbreite,{} - configuration error code :: -1,{} kanal besetzt code :: -3,{} interface error code :: -4,{} not init code :: -5;{}INT VAR interfacechannel :: 2,{} dummy;{}TEXT VAR meldung :: "";{}BOOL VAR kanaldaten sind eingetragen :: FALSE,{} endezeichen gegeben :: FALSE,{} programm mit pdv gestartet :: FALSE,{} fehler zu melden :: FALSE;{}TASK VAR interface task :: niltask;{} -DATASPACE VAR ds :: nilspace;{}TYPE KANAL = STRUCT (INT betriebsart, taktzahl, TEXT steuercode),{} SPANNUNG = STRUCT (REAL minimalwert, maximalwert);{}ROW max kanalanzahl INT VAR vorherige ausgabe;{}ROW max kanalanzahl KANAL VAR kanal;{}ROW max kanalanzahl SPANNUNG VAR spannung;{}ROW 5 TEXT CONST fehlermeldung :: ROW 5 TEXT :{} ("Interface ist noch nicht konfiguriert!",{} "Interface-Task ist besetzt!",{} "Interface-Kanal ist belegt!",{} "Interface meldet sich nicht!",{} "Interface kann nicht geöffnet werden!");{} -PROC run pdv:{} run pdv (last param){}END PROC run pdv;{}PROC run pdv (TEXT CONST programmname):{} enable stop;{} last param (programmname);{} programm mit pdv gestartet := TRUE;{} teste interface;{} disable stop;{} run (programmname);{} IF is error{} THEN fehlerbehandlung{} ELSE melde programmende{} FI;{} schliesse interface;{} programm mit pdv gestartet := FALSE;{} enable stop;{} IF fehler zu melden{} THEN errorstop (meldung){} FI{}END PROC run pdv;{}PROC run pdv again:{} - enable stop;{} programm mit pdv gestartet := TRUE;{} teste interface;{} disable stop;{} run again;{} IF is error{} THEN fehlerbehandlung{} ELSE melde programmende{} FI;{} schliesse interface;{} programm mit pdv gestartet := FALSE;{} enable stop;{} IF fehler zu melden{} THEN errorstop (meldung){} FI{}END PROC run pdv again;{}PROC melde programmende:{} page;{} menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen.");{} pause;{} schalte alles aus{}END PROC melde programmende;{} -PROC initialisiere interface:{} enable stop;{} pruefe abbruch;{} IF programm mit pdv gestartet{} THEN schalte alles aus{} ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!"){} FI{}END PROC initialisiere interface;{}PROC schalte alles aus:{} INT VAR k;{} FOR k FROM 1 UPTO max kanalanzahl REP{} vorherige ausgabe [k] := 0{} PER;{} forget (ds); ds := nilspace;{} call (interface task, alles aus code, ds, dummy){}END PROC schalte alles aus;{}PROC ausgeben (INT CONST kanalnummer, wert):{} - merke wert;{} gib wert aus.{} merke wert:{} vorherige ausgabe [kanalnummer] := wert.{} gib wert aus:{} call (interface task, 256 * kanalnummer + wert, ds, dummy).{}END PROC ausgeben;{}INT PROC eingabe (INT CONST kanalnummer):{} INT VAR eingabewert;{} call (interface task, kanalnummer, ds, eingabewert);{} eingabewert{}END PROC eingabe;{}PROC warte (REAL CONST sekunden):{} TEXT VAR eingabe;{} pruefe abbruch;{} eingabe := incharety (int (sekunden * 10.0 + 0.5));{} IF eingabe = esc{} - THEN untersuche naechstes zeichen{} FI.{} untersuche naechstes zeichen:{} eingabe := incharety (30);{} IF eingabe = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF eingabe = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <ESC><"{} + abbruchzeichen + ">!"){} FI.{}END PROC warte;{}PROC warte (INT CONST sekunden):{} TEXT VAR eingabe;{} pruefe abbruch;{} eingabe := incharety (sekunden * 10);{} IF eingabe = esc{} THEN untersuche naechstes zeichen{} - FI.{} untersuche naechstes zeichen:{} eingabe := incharety (30);{} IF eingabe = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF eingabe = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <ESC><"{} + abbruchzeichen + ">!"){} FI.{}END PROC warte;{}BOOL PROC abbruch gewuenscht:{} pruefe abbruch;{} BOOL VAR entscheidung :: endezeichen gegeben;{} endezeichen gegeben := FALSE;{} entscheidung{}END PROC abbruch gewuenscht;{}PROC tue nichts:{} - pruefe abbruch{}END PROC tue nichts;{}PROC trage kanaldaten ein (INT CONST kanalnummer,{} ROW 2 REAL CONST spannungsbereich,{} ROW 3 INT CONST kanalparameter):{} spannung [kanalnummer].minimalwert := spannungsbereich [1];{} spannung [kanalnummer].maximalwert := spannungsbereich [2];{} kanal [kanalnummer].betriebsart := kanalparameter [1];{} kanal [kanalnummer].taktzahl := kanalparameter [2];{} kanal [kanalnummer].steuercode := interface anpassung{} - (kanalnummer, kanalparameter [3]){}END PROC trage kanaldaten ein;{}PROC beende kanaldaten eintragen:{} loesche interface task;{} begin (PROC kanal koppler, interface task);{} kanaldaten sind eingetragen := TRUE.{} loesche interface task:{} disable stop;{} end (interface task);{} IF is error{} THEN clear error{} FI;{} enable stop.{}END PROC beende kanaldaten eintragen;{}PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR u min, u max):{} - u min := spannung [kanalnummer].minimalwert;{} u max := spannung [kanalnummer].maximalwert{}END PROC hole spannungsbereich;{}INT PROC letzte ausgabe (INT CONST kanalnummer):{} vorherige ausgabe [kanalnummer]{}END PROC letzte ausgabe;{}PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart):{} pruefe abbruch;{} pruefe kanalnummer;{} pruefe betriebsart.{} pruefe kanalnummer:{} IF kanalnummer < 1 OR kanalnummer > max kanalanzahl{} THEN errorstop ("Kanalnummer " + text (kanalnummer) +{} - " ist unzulaessig !"){} FI.{} pruefe betriebsart:{} IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart{} THEN errorstop ("An Kanal " + text (kanalnummer) +{} " keine " + wunsch + " moeglich!"){} FI.{} wunsch:{} IF gewuenschte betriebsart = analog aus{} THEN "Analog-Ausgabe"{} ELIF gewuenschte betriebsart = digital aus{} THEN "Digital-Ausgabe"{} ELIF gewuenschte betriebsart = digital ein{} THEN "Digital-Eingabe"{} - ELIF gewuenschte betriebsart = analog ein{} THEN "Analog-Eingabe"{} ELSE "Ein- oder Ausgabe"{} FI.{}END PROC pruefe kanal;{}PROC pruefe abbruch:{} IF incharety = esc{} THEN pruefe weiter{} FI.{} pruefe weiter:{} TEXT CONST zeichen :: incharety (30);{} IF zeichen = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF zeichen = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <ESC><"{} + abbruchzeichen + ">!"){} - FI.{}END PROC pruefe abbruch;{}PROC oeffne interface (INT VAR status):{} enable stop;{} forget (ds); ds := nilspace;{} IF kanaldaten sind eingetragen{} THEN pingpong (interfacetask, initcode, ds, status){} ELSE status := configuration error code{} FI;{} IF status > 0 THEN status DECR maxint FI;{} forget (ds); ds := nilspace{}END PROC oeffne interface;{}PROC schliesse interface:{} enable stop;{} forget (ds); ds := nilspace;{} pingpong (interface task, end code, ds, dummy);{} forget (ds); ds := nilspace{} -END PROC schliesse interface;{}PROC teste interface:{} INT VAR test;{} oeffne interface (test);{} IF test < 0{} THEN errorstop (fehlermeldung [min (5, abs (test))]){} ELSE fehler zu melden := FALSE;{} endezeichen gegeben := FALSE{} FI{}END PROC teste interface;{}PROC fehlerbehandlung:{} meldung := errormessage;{} IF meldung <> ""{} THEN meldung CAT fehlerzeile;{} fehler zu melden := TRUE{} FI;{} clear error;{} initialisiere interface.{} fehlerzeile:{} - IF errorline = 0{} THEN ""{} ELSE " (bei Zeile " + text (errorline) + ")"{} FI.{}END PROC fehlerbehandlung;{}(******************** EIN-/AUSGABE AM INTERFACE-KANAL ********************){}PROC kanalkoppler:{} IF name (myself) <> "-"{} THEN errorstop ("Unzulässiges Kommando!"){} ELSE warte auf anrufe{} FI.{} warte auf anrufe:{} TASK VAR absender;{} TEXT VAR dummy;{} INT VAR codenummer, antwort;{} disable stop;{} REP forget (ds);{} wait (ds, codenummer, absender);{} - IF codenummer = initcode{} THEN kopple an interface kanal;{} IF interface ist betriebsbereit{} THEN bearbeite weitere auftraege{} ELSE gib negative rueckmeldung{} FI;{} gib kanal frei{} ELSE antwort := not init code;{} gib negative rueckmeldung{} FI{} PER.{} kopple an interface kanal:{} continue (interface channel);{} IF is error{} THEN clear error;{} antwort := kanal besetzt code{} - ELSE oeffne interface direkt (antwort){} FI.{} interface ist betriebsbereit: antwort = 0.{} gib negative rueckmeldung: send (absender, antwort, ds).{} gib kanal frei:{} break (quiet);{} send (absender, 0, ds, antwort);{} collect heap garbage.{} bearbeite weitere auftraege:{} REP call (absender, antwort, ds, codenummer);{} IF codenummer > 255{} THEN sende wert an interface{} ELIF codenummer < 50{} THEN hole wert von interface{} ELIF codenummer = alles aus code{} - THEN initialisiere interface direkt{} FI{} UNTIL codenummer = endcode PER;{} IF is error THEN clear error FI;{} schliesse interface direkt.{} sende wert an interface:{} out (kanal [codenummer DIV 256].steuercode);{} out (code (codenummer)).{} hole wert von interface:{} out (kanal [codenummer].steuercode);{} SELECT kanal [codenummer].taktzahl OF{} CASE 1 : antwort := erstes zeichen{} CASE 2 : antwort := zweites zeichen{} CASE 3 : antwort := drittes zeichen{} - OTHERWISE antwort := -1{} END SELECT.{} erstes zeichen:{} code (incharety (1)).{} zweites zeichen:{} dummy := incharety (1);{} code (incharety (1)).{} drittes zeichen:{} dummy := incharety (1);{} dummy := incharety (1);{} code (incharety (1)).{}END PROC kanalkoppler;{}PROC interface kanal (INT CONST kanalnummer):{} enable stop;{} IF kanalnummer < 1 OR kanalnummer > 24{} THEN errorstop ("Unzulaessige Kanalnummer"){} ELSE interface channel := kanalnummer{} - FI{}END PROC interface kanal;{}INT PROC interface kanal:{} interface channel{}END PROC interface kanal;{}PROC oeffne interface direkt (INT VAR status):{} leere puffer;{} out (interface test code);{} fange antwort;{} IF antwort = interface okay code{} THEN status := 0;{} out (interface open code){} ELSE status := interface error code{} FI.{} leere puffer:{} REP UNTIL incharety = "" PER.{} fange antwort:{} INT VAR zaehler;{} TEXT VAR antwort :: "";{} FOR zaehler FROM 1 UPTO erwartete zeichen REP{} - antwort CAT incharety (1){} PER.{}END PROC oeffne interface direkt;{}PROC schliesse interface direkt:{} out (interface close code){}END PROC schliesse interface direkt;{}PROC initialisiere interface direkt:{} schalte alles aus.{} schalte alles aus:{} INT VAR kanalnummer, kanalbetriebsart;{} FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{} kanalbetriebsart := kanal [kanalnummer].betriebsart;{} IF kanalbetriebsart = digital aus{} THEN direkt ausgeben (kanalnummer, 0){} - ELIF kanalbetriebsart = analog aus{} THEN direkt ausgeben (kanalnummer, gewandelte nullspannung){} FI{} PER.{} gewandelte nullspannung:{} int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5).{} u max : spannung [kanalnummer].maximalwert.{} u min : spannung [kanalnummer].minimalwert.{}END PROC initialisiere interface direkt;{}PROC direkt ausgeben (INT CONST kanalnummer, wert):{} out (kanal [kanalnummer].steuercode);{} out (code (wert)){}END PROC direkt ausgeben;{} -INT PROC direkt eingabe (INT CONST kanalnummer):{} gib lesecode aus;{} erhaltene antwort.{} gib lesecode aus:{} out (kanal [kanalnummer].steuercode).{} erhaltene antwort:{} TEXT VAR dummy;{} SELECT kanal [kanalnummer].taktzahl OF{} CASE 1 : erstes zeichen{} CASE 2 : zweites zeichen{} CASE 3 : drittes zeichen{} OTHERWISE -1{} END SELECT.{} erstes zeichen:{} code (incharety (1)).{} zweites zeichen:{} dummy := incharety (1);{} code (incharety (1)).{} - drittes zeichen:{} dummy := incharety (1);{} dummy := incharety (1);{} code (incharety (1)).{}END PROC direkt eingabe;{}PROC initialisiere die kanaele:{} INT VAR kanalnummer;{} FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{} trage kanaldaten ein (kanalnummer, keine spannung, leere karte);{} vorherige ausgabe [kanalnummer] := 0{} PER.{} keine spannung:{} ROW 2 REAL : (0.0, 0.0).{} leere karte:{} ROW 3 INT : (nicht belegt, 0, 0).{}END PROC initialisiere die kanaele;{} -initialisiere die kanaele;{}END PACKET ls prozess 1{} + run pdv, + run pdv again, + initialisiere interface, + schalte alles aus, + ausgeben, + eingabe, + warte, + abbruch gewuenscht, + tue nichts, + trage kanaldaten ein, + beende kanaldaten eintragen, + hole spannungsbereich, + letzte ausgabe, + pruefe kanal, + pruefe abbruch, + teste interface, + oeffne interface, + schliesse interface, + nicht belegt, + digital aus, + analog aus, + + digital ein, + analog ein, + kanalbreite, + ganzzahl obergrenze, + adapterart, + (* ------------------------- *) + kanalkoppler, + interface kanal, + oeffne interface direkt, + schliesse interface direkt, + initialisiere interface direkt, + direkt ausgeben, + direkt eingabe: +(******************** A N P A S S U N G A N M U F I ********************) +LET interface test code = ""27""27"10", + interface okay code = ""27""27"00", + + interface open code = ""27""27"1A18", + interface close code = ""25""27""27"13", + adresse 0 code = ""61"", + leertakt code = ""62"", + interface write code = 80 , + interface read code = 64 , + erwartete zeichen = 4 ; +TEXT CONST adapterart :: "MUFI als Endgerät"; +TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode): + IF es ist ein ausgabekanal + THEN code (interface write code + device + 4 * steuerungscode) + ELIF es ist ein eingabekanal + + THEN lesecode in abhaengigkeit von der taktzahl + ELSE "" + FI. + es ist ein ausgabekanal: + kanal [kanalnummer].betriebsart < 0. + es ist ein eingabekanal: + kanal [kanalnummer].betriebsart > 0. + device: + IF kanalnummer < 10 + THEN 0 + ELSE kanalnummer DIV 10 - 1 + FI. + lesecode in abhaengigkeit von der taktzahl: + SELECT kanal [kanalnummer].taktzahl OF + CASE 1: lesecode + CASE 2: adresse 0 code + lesecode + lesecode + CASE 3: adresse 0 code + lesecode + zwei weitere takte + + OTHERWISE "" END SELECT. + lesecode : code (interface read code + device + 4 * steuerungscode). + zwei weitere takte: + IF leertakt code = "" + THEN lesecode + lesecode + ELSE kanal [kanalnummer].taktzahl DECR 1; + leertakt code + lesecode + FI. +END PROC interface anpassung; +(************ H A R D W A R E U N A B H Ä N G I G E R T E I L ************) +LET max kanalanzahl = 49, + initcode = 50, + endcode = 51, + + alles aus code = 52, + endezeichen = "q", + abbruchzeichen = "h", + esc = ""27""; +INT CONST analog aus :: -2, (* Betriebsarten *) + digital aus :: -1, + nicht belegt :: 0, + digital ein :: 1, + analog ein :: 2, + kanalbreite :: 8, + ganzzahl obergrenze :: 2 ** kanalbreite, + + configuration error code :: -1, + kanal besetzt code :: -3, + interface error code :: -4, + not init code :: -5; +INT VAR interfacechannel :: 2, + dummy; +TEXT VAR meldung :: ""; +BOOL VAR kanaldaten sind eingetragen :: FALSE, + endezeichen gegeben :: FALSE, + programm mit pdv gestartet :: FALSE, + fehler zu melden :: FALSE; +TASK VAR interface task :: niltask; + +DATASPACE VAR ds :: nilspace; +TYPE KANAL = STRUCT (INT betriebsart, taktzahl, TEXT steuercode), + SPANNUNG = STRUCT (REAL minimalwert, maximalwert); +ROW max kanalanzahl INT VAR vorherige ausgabe; +ROW max kanalanzahl KANAL VAR kanal; +ROW max kanalanzahl SPANNUNG VAR spannung; +ROW 5 TEXT CONST fehlermeldung :: ROW 5 TEXT : + ("Interface ist noch nicht konfiguriert!", + "Interface-Task ist besetzt!", + "Interface-Kanal ist belegt!", + "Interface meldet sich nicht!", + "Interface kann nicht geöffnet werden!"); + +PROC run pdv: + run pdv (last param) +END PROC run pdv; +PROC run pdv (TEXT CONST programmname): + enable stop; + last param (programmname); + programm mit pdv gestartet := TRUE; + teste interface; + disable stop; + run (programmname); + IF is error + THEN fehlerbehandlung + ELSE melde programmende + FI; + schliesse interface; + programm mit pdv gestartet := FALSE; + enable stop; + IF fehler zu melden + THEN errorstop (meldung) + FI +END PROC run pdv; +PROC run pdv again: + + enable stop; + programm mit pdv gestartet := TRUE; + teste interface; + disable stop; + run again; + IF is error + THEN fehlerbehandlung + ELSE melde programmende + FI; + schliesse interface; + programm mit pdv gestartet := FALSE; + enable stop; + IF fehler zu melden + THEN errorstop (meldung) + FI +END PROC run pdv again; +PROC melde programmende: + page; + menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen."); + pause; + schalte alles aus +END PROC melde programmende; + +PROC initialisiere interface: + enable stop; + pruefe abbruch; + IF programm mit pdv gestartet + THEN schalte alles aus + ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!") + FI +END PROC initialisiere interface; +PROC schalte alles aus: + INT VAR k; + FOR k FROM 1 UPTO max kanalanzahl REP + vorherige ausgabe [k] := 0 + PER; + forget (ds); ds := nilspace; + call (interface task, alles aus code, ds, dummy) +END PROC schalte alles aus; +PROC ausgeben (INT CONST kanalnummer, wert): + + merke wert; + gib wert aus. + merke wert: + vorherige ausgabe [kanalnummer] := wert. + gib wert aus: + call (interface task, 256 * kanalnummer + wert, ds, dummy). +END PROC ausgeben; +INT PROC eingabe (INT CONST kanalnummer): + INT VAR eingabewert; + call (interface task, kanalnummer, ds, eingabewert); + eingabewert +END PROC eingabe; +PROC warte (REAL CONST sekunden): + TEXT VAR eingabe; + pruefe abbruch; + eingabe := incharety (int (sekunden * 10.0 + 0.5)); + IF eingabe = esc + + THEN untersuche naechstes zeichen + FI. + untersuche naechstes zeichen: + eingabe := incharety (30); + IF eingabe = endezeichen + THEN endezeichen gegeben := TRUE + ELIF eingabe = abbruchzeichen + THEN errorstop ("Programm-Abbruch durch <ESC><" + + abbruchzeichen + ">!") + FI. +END PROC warte; +PROC warte (INT CONST sekunden): + TEXT VAR eingabe; + pruefe abbruch; + eingabe := incharety (sekunden * 10); + IF eingabe = esc + THEN untersuche naechstes zeichen + + FI. + untersuche naechstes zeichen: + eingabe := incharety (30); + IF eingabe = endezeichen + THEN endezeichen gegeben := TRUE + ELIF eingabe = abbruchzeichen + THEN errorstop ("Programm-Abbruch durch <ESC><" + + abbruchzeichen + ">!") + FI. +END PROC warte; +BOOL PROC abbruch gewuenscht: + pruefe abbruch; + BOOL VAR entscheidung :: endezeichen gegeben; + endezeichen gegeben := FALSE; + entscheidung +END PROC abbruch gewuenscht; +PROC tue nichts: + + pruefe abbruch +END PROC tue nichts; +PROC trage kanaldaten ein (INT CONST kanalnummer, + ROW 2 REAL CONST spannungsbereich, + ROW 3 INT CONST kanalparameter): + spannung [kanalnummer].minimalwert := spannungsbereich [1]; + spannung [kanalnummer].maximalwert := spannungsbereich [2]; + kanal [kanalnummer].betriebsart := kanalparameter [1]; + kanal [kanalnummer].taktzahl := kanalparameter [2]; + kanal [kanalnummer].steuercode := interface anpassung + + (kanalnummer, kanalparameter [3]) +END PROC trage kanaldaten ein; +PROC beende kanaldaten eintragen: + loesche interface task; + begin (PROC kanal koppler, interface task); + kanaldaten sind eingetragen := TRUE. + loesche interface task: + disable stop; + end (interface task); + IF is error + THEN clear error + FI; + enable stop. +END PROC beende kanaldaten eintragen; +PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR u min, u max): + + u min := spannung [kanalnummer].minimalwert; + u max := spannung [kanalnummer].maximalwert +END PROC hole spannungsbereich; +INT PROC letzte ausgabe (INT CONST kanalnummer): + vorherige ausgabe [kanalnummer] +END PROC letzte ausgabe; +PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart): + pruefe abbruch; + pruefe kanalnummer; + pruefe betriebsart. + pruefe kanalnummer: + IF kanalnummer < 1 OR kanalnummer > max kanalanzahl + THEN errorstop ("Kanalnummer " + text (kanalnummer) + + + " ist unzulaessig !") + FI. + pruefe betriebsart: + IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart + THEN errorstop ("An Kanal " + text (kanalnummer) + + " keine " + wunsch + " moeglich!") + FI. + wunsch: + IF gewuenschte betriebsart = analog aus + THEN "Analog-Ausgabe" + ELIF gewuenschte betriebsart = digital aus + THEN "Digital-Ausgabe" + ELIF gewuenschte betriebsart = digital ein + THEN "Digital-Eingabe" + + ELIF gewuenschte betriebsart = analog ein + THEN "Analog-Eingabe" + ELSE "Ein- oder Ausgabe" + FI. +END PROC pruefe kanal; +PROC pruefe abbruch: + IF incharety = esc + THEN pruefe weiter + FI. + pruefe weiter: + TEXT CONST zeichen :: incharety (30); + IF zeichen = endezeichen + THEN endezeichen gegeben := TRUE + ELIF zeichen = abbruchzeichen + THEN errorstop ("Programm-Abbruch durch <ESC><" + + abbruchzeichen + ">!") + + FI. +END PROC pruefe abbruch; +PROC oeffne interface (INT VAR status): + enable stop; + forget (ds); ds := nilspace; + IF kanaldaten sind eingetragen + THEN pingpong (interfacetask, initcode, ds, status) + ELSE status := configuration error code + FI; + IF status > 0 THEN status DECR maxint FI; + forget (ds); ds := nilspace +END PROC oeffne interface; +PROC schliesse interface: + enable stop; + forget (ds); ds := nilspace; + pingpong (interface task, end code, ds, dummy); + forget (ds); ds := nilspace + +END PROC schliesse interface; +PROC teste interface: + INT VAR test; + oeffne interface (test); + IF test < 0 + THEN errorstop (fehlermeldung [min (5, abs (test))]) + ELSE fehler zu melden := FALSE; + endezeichen gegeben := FALSE + FI +END PROC teste interface; +PROC fehlerbehandlung: + meldung := errormessage; + IF meldung <> "" + THEN meldung CAT fehlerzeile; + fehler zu melden := TRUE + FI; + clear error; + initialisiere interface. + fehlerzeile: + + IF errorline = 0 + THEN "" + ELSE " (bei Zeile " + text (errorline) + ")" + FI. +END PROC fehlerbehandlung; +(******************** EIN-/AUSGABE AM INTERFACE-KANAL ********************) +PROC kanalkoppler: + IF name (myself) <> "-" + THEN errorstop ("Unzulässiges Kommando!") + ELSE warte auf anrufe + FI. + warte auf anrufe: + TASK VAR absender; + TEXT VAR dummy; + INT VAR codenummer, antwort; + disable stop; + REP forget (ds); + wait (ds, codenummer, absender); + + IF codenummer = initcode + THEN kopple an interface kanal; + IF interface ist betriebsbereit + THEN bearbeite weitere auftraege + ELSE gib negative rueckmeldung + FI; + gib kanal frei + ELSE antwort := not init code; + gib negative rueckmeldung + FI + PER. + kopple an interface kanal: + continue (interface channel); + IF is error + THEN clear error; + antwort := kanal besetzt code + + ELSE oeffne interface direkt (antwort) + FI. + interface ist betriebsbereit: antwort = 0. + gib negative rueckmeldung: send (absender, antwort, ds). + gib kanal frei: + break (quiet); + send (absender, 0, ds, antwort); + collect heap garbage. + bearbeite weitere auftraege: + REP call (absender, antwort, ds, codenummer); + IF codenummer > 255 + THEN sende wert an interface + ELIF codenummer < 50 + THEN hole wert von interface + ELIF codenummer = alles aus code + + THEN initialisiere interface direkt + FI + UNTIL codenummer = endcode PER; + IF is error THEN clear error FI; + schliesse interface direkt. + sende wert an interface: + out (kanal [codenummer DIV 256].steuercode); + out (code (codenummer)). + hole wert von interface: + out (kanal [codenummer].steuercode); + SELECT kanal [codenummer].taktzahl OF + CASE 1 : antwort := erstes zeichen + CASE 2 : antwort := zweites zeichen + CASE 3 : antwort := drittes zeichen + + OTHERWISE antwort := -1 + END SELECT. + erstes zeichen: + code (incharety (1)). + zweites zeichen: + dummy := incharety (1); + code (incharety (1)). + drittes zeichen: + dummy := incharety (1); + dummy := incharety (1); + code (incharety (1)). +END PROC kanalkoppler; +PROC interface kanal (INT CONST kanalnummer): + enable stop; + IF kanalnummer < 1 OR kanalnummer > 24 + THEN errorstop ("Unzulaessige Kanalnummer") + ELSE interface channel := kanalnummer + + FI +END PROC interface kanal; +INT PROC interface kanal: + interface channel +END PROC interface kanal; +PROC oeffne interface direkt (INT VAR status): + leere puffer; + out (interface test code); + fange antwort; + IF antwort = interface okay code + THEN status := 0; + out (interface open code) + ELSE status := interface error code + FI. + leere puffer: + REP UNTIL incharety = "" PER. + fange antwort: + INT VAR zaehler; + TEXT VAR antwort :: ""; + FOR zaehler FROM 1 UPTO erwartete zeichen REP + + antwort CAT incharety (1) + PER. +END PROC oeffne interface direkt; +PROC schliesse interface direkt: + out (interface close code) +END PROC schliesse interface direkt; +PROC initialisiere interface direkt: + schalte alles aus. + schalte alles aus: + INT VAR kanalnummer, kanalbetriebsart; + FOR kanalnummer FROM 1 UPTO max kanalanzahl REP + kanalbetriebsart := kanal [kanalnummer].betriebsart; + IF kanalbetriebsart = digital aus + THEN direkt ausgeben (kanalnummer, 0) + + ELIF kanalbetriebsart = analog aus + THEN direkt ausgeben (kanalnummer, gewandelte nullspannung) + FI + PER. + gewandelte nullspannung: + int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5). + u max : spannung [kanalnummer].maximalwert. + u min : spannung [kanalnummer].minimalwert. +END PROC initialisiere interface direkt; +PROC direkt ausgeben (INT CONST kanalnummer, wert): + out (kanal [kanalnummer].steuercode); + out (code (wert)) +END PROC direkt ausgeben; + +INT PROC direkt eingabe (INT CONST kanalnummer): + gib lesecode aus; + erhaltene antwort. + gib lesecode aus: + out (kanal [kanalnummer].steuercode). + erhaltene antwort: + TEXT VAR dummy; + SELECT kanal [kanalnummer].taktzahl OF + CASE 1 : erstes zeichen + CASE 2 : zweites zeichen + CASE 3 : drittes zeichen + OTHERWISE -1 + END SELECT. + erstes zeichen: + code (incharety (1)). + zweites zeichen: + dummy := incharety (1); + code (incharety (1)). + + drittes zeichen: + dummy := incharety (1); + dummy := incharety (1); + code (incharety (1)). +END PROC direkt eingabe; +PROC initialisiere die kanaele: + INT VAR kanalnummer; + FOR kanalnummer FROM 1 UPTO max kanalanzahl REP + trage kanaldaten ein (kanalnummer, keine spannung, leere karte); + vorherige ausgabe [kanalnummer] := 0 + PER. + keine spannung: + ROW 2 REAL : (0.0, 0.0). + leere karte: + ROW 3 INT : (nicht belegt, 0, 0). +END PROC initialisiere die kanaele; + +initialisiere die kanaele; +END PACKET ls prozess 1 + diff --git a/prozess/ls-Prozess 1 für MUFI im Terminalkanal b/prozess/ls-Prozess 1 für MUFI im Terminalkanal index d1edbc1..712b8a2 100644 --- a/prozess/ls-Prozess 1 für MUFI im Terminalkanal +++ b/prozess/ls-Prozess 1 für MUFI im Terminalkanal @@ -22,34 +22,485 @@ *) PACKET altes incharety DEFINES old incharety: -TEXT PROC old incharety:{} incharety{}END PROC old incharety;{}TEXT PROC old incharety (INT CONST timelimit):{} incharety (timelimit){}END PROC old incharety;{}END PACKET altes incharety;{}PACKET ls prozess 1 DEFINES{} run pdv,{} run pdv again,{} initialisiere interface,{} ausgeben,{} eingabe,{} warte,{} abbruch gewuenscht,{} tue nichts,{} trage kanaldaten ein,{} beende kanaldaten eintragen,{} hole spannungsbereich,{} letzte ausgabe,{} - pruefe kanal,{} pruefe abbruch,{} teste interface,{} schalte alles aus,{} oeffne interface,{} schliesse interface,{} nicht belegt,{} digital aus,{} analog aus,{} digital ein,{} analog ein,{} kanalbreite,{} ganzzahl obergrenze,{} adapterart,{} incharety,{} inchar,{} pause:{}(******************** A N P A S S U N G A N M U F I ********************){}LET mufikennung = ""31""31"",{} erwartete zeichen = 4 ;{} -TEXT CONST adapterart :: "MUFI im Terminalkanal",{} interface test code :: ""27""27"10",{} interface okay code :: ""27""27"00",{} interface open code :: ""27""27"1C" + hex (mufikennung),{} interface close code :: mufikennung + "1C" + hex (""27""27""),{} adresse 0 code :: mufikennung + "3D",{} leertakt code :: mufikennung + "3E",{} interface write code :: mufikennung + "5" ,{} interface read code :: mufikennung + "4" ;{} -TEXT VAR puffer :: "";{}ROW 256 TEXT CONST hexcode :: ROW 256 TEXT : ({}"00","01","02","03","04","05","06","07","08","09","0A","0B","0C","0D","0E","0F",{}"10","11","12","13","14","15","16","17","18","19","1A","1B","1C","1D","1E","1F",{}"20","21","22","23","24","25","26","27","28","29","2A","2B","2C","2D","2E","2F",{}"30","31","32","33","34","35","36","37","38","39","3A","3B","3C","3D","3E","3F",{}"40","41","42","43","44","45","46","47","48","49","4A","4B","4C","4D","4E","4F",{}"50","51","52","53","54","55","56","57","58","59","5A","5B","5C","5D","5E","5F",{} -"60","61","62","63","64","65","66","67","68","69","6A","6B","6C","6D","6E","6F",{}"70","71","72","73","74","75","76","77","78","79","7A","7B","7C","7D","7E","7F",{}"80","81","82","83","84","85","86","87","88","89","8A","8B","8C","8D","8E","8F",{}"90","91","92","93","94","95","96","97","98","99","9A","9B","9C","9D","9E","9F",{}"A0","A1","A2","A3","A4","A5","A6","A7","A8","A9","AA","AB","AC","AD","AE","AF",{}"B0","B1","B2","B3","B4","B5","B6","B7","B8","B9","BA","BB","BC","BD","BE","BF",{}"C0","C1","C2","C3","C4","C5","C6","C7","C8","C9","CA","CB","CC","CD","CE","CF",{} -"D0","D1","D2","D3","D4","D5","D6","D7","D8","D9","DA","DB","DC","DD","DE","DF",{}"E0","E1","E2","E3","E4","E5","E6","E7","E8","E9","EA","EB","EC","ED","EE","EF",{}"F0","F1","F2","F3","F4","F5","F6","F7","F8","F9","FA","FB","FC","FD","FE","FF");{}TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode):{} LET hexzeichen = "0123456789ABCDEF";{} IF es ist ein ausgabekanal{} THEN interface write code{} + (hexzeichen SUB (device + 4 * steuerungscode)){} ELIF es ist ein eingabekanal{} - THEN lesecode in abhaengigkeit von der taktzahl{} ELSE ""{} FI.{} es ist ein ausgabekanal:{} kanal [kanalnummer].betriebsart < 0.{} es ist ein eingabekanal:{} kanal [kanalnummer].betriebsart > 0.{} device:{} IF kanalnummer < 10{} THEN 1{} ELSE kanalnummer DIV 10{} FI.{} lesecode in abhaengigkeit von der taktzahl:{} SELECT kanal [kanalnummer].taktzahl OF{} CASE 1: lesecode{} CASE 2: adresse 0 code + lesecode + lesecode{} CASE 3: adresse 0 code + lesecode + zwei weitere takte{} - OTHERWISE "" END SELECT.{} lesecode:{} interface read code + (hexzeichen SUB (device + 4 * steuerungscode)).{} zwei weitere takte:{} IF leertakt code = ""{} THEN lesecode + lesecode{} ELSE kanal [kanalnummer].taktzahl DECR 1;{} leertakt code + lesecode{} FI.{}END PROC interface anpassung;{}PROC ausgeben (INT CONST kanalnummer, wert):{} merke wert;{} gib wert aus.{} merke wert:{} vorherige ausgabe [kanalnummer] := wert.{} gib wert aus:{} out (kanal [kanalnummer].steuercode);{} - out (hexcode [wert + 1]).{}END PROC ausgeben;{}INT PROC eingabe (INT CONST kanalnummer):{} gib lesecode aus;{} erhaltene antwort.{} gib lesecode aus:{} out (kanal [kanalnummer].steuercode).{} erhaltene antwort:{} TEXT VAR dummy;{} SELECT kanal [kanalnummer].taktzahl OF{} CASE 1 : erste sendung{} CASE 2 : zweite sendung{} CASE 3 : dritte sendung{} OTHERWISE -1{} END SELECT.{} erste sendung:{} fange mufikennung;{} dezimalwert (old incharety (1), old incharety (1)).{} - zweite sendung:{} fange mufikennung;{} dummy := old incharety (1);{} dummy := old incharety (1);{} erste sendung.{} dritte sendung:{} fange mufikennung;{} dummy := old incharety (1);{} dummy := old incharety (1);{} zweite sendung.{} fange mufikennung:{} puffer CAT old incharety;{} REP puffer CAT old incharety{} UNTIL pos (puffer, mufikennung) > 0 PER;{} puffer := subtext (puffer, 1, length (puffer) - 2).{}END PROC eingabe;{}(************ H A R D W A R E U N A B H Ä N G I G E R T E I L ************){} -LET max kanalanzahl = 49,{} endezeichen = "q",{} abbruchzeichen = "h",{} esc = ""27"";{}INT CONST analog aus :: -2, (* Betriebsarten *){} digital aus :: -1,{} nicht belegt :: 0,{} digital ein :: 1,{} analog ein :: 2,{} kanalbreite :: 8,{} ganzzahl obergrenze :: 2 ** kanalbreite,{} - configuration error code :: -1,{} interface error code :: -4;{}TEXT VAR meldung :: "";{}BOOL VAR kanaldaten sind eingetragen :: FALSE,{} endezeichen gegeben :: FALSE,{} programm mit pdv gestartet :: FALSE,{} fehler zu melden :: FALSE;{}TYPE KANAL = STRUCT (INT betriebsart, taktzahl, TEXT steuercode),{} SPANNUNG = STRUCT (REAL minimalwert, maximalwert);{}ROW max kanalanzahl INT VAR vorherige ausgabe;{} -ROW max kanalanzahl KANAL VAR kanal;{}ROW max kanalanzahl SPANNUNG VAR spannung;{}PROC run pdv:{} run pdv (last param){}END PROC run pdv;{}PROC run pdv (TEXT CONST programmname):{} enable stop;{} last param (programmname);{} programm mit pdv gestartet := TRUE;{} teste interface;{} disable stop;{} run (programmname);{} IF is error{} THEN fehlerbehandlung{} ELSE melde programmende{} FI;{} schliesse interface;{} programm mit pdv gestartet := FALSE;{} enable stop;{} IF fehler zu melden{} - THEN errorstop (meldung){} FI{}END PROC run pdv;{}PROC run pdv again:{} enable stop;{} programm mit pdv gestartet := TRUE;{} teste interface;{} disable stop;{} run again;{} IF is error{} THEN fehlerbehandlung{} ELSE melde programmende{} FI;{} schliesse interface;{} programm mit pdv gestartet := FALSE;{} enable stop;{} IF fehler zu melden{} THEN errorstop (meldung){} FI{}END PROC run pdv again;{}PROC melde programmende:{} page;{} menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen.");{} - pause;{} schalte alles aus{}END PROC melde programmende;{}PROC initialisiere interface:{} enable stop;{} pruefe abbruch;{} IF programm mit pdv gestartet{} THEN schalte alles aus{} ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!"){} FI{}END PROC initialisiere interface;{}PROC schalte alles aus:{} INT VAR kanalnummer, kanalbetriebsart;{} FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{} kanalbetriebsart := kanal [kanalnummer].betriebsart;{} IF kanalbetriebsart = digital aus{} - THEN ausgeben (kanalnummer, 0){} ELIF kanalbetriebsart = analog aus{} THEN ausgeben (kanalnummer, gewandelte nullspannung){} FI{} PER.{} gewandelte nullspannung:{} int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5).{} u max : spannung [kanalnummer].maximalwert.{} u min : spannung [kanalnummer].minimalwert.{}END PROC schalte alles aus;{}PROC warte (REAL CONST sekunden):{} TEXT VAR eingabe;{} pruefe abbruch;{} eingabe := incharety (int (sekunden * 10.0 + 0.5));{} - IF eingabe = esc{} THEN untersuche naechstes zeichen{} FI.{} untersuche naechstes zeichen:{} eingabe := incharety (30);{} IF eingabe = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF eingabe = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <ESC><"{} + abbruchzeichen + ">!"){} FI.{}END PROC warte;{}PROC warte (INT CONST sekunden):{} TEXT VAR eingabe;{} pruefe abbruch;{} eingabe := incharety (sekunden * 10);{} IF eingabe = esc{} - THEN untersuche naechstes zeichen{} FI.{} untersuche naechstes zeichen:{} eingabe := incharety (30);{} IF eingabe = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF eingabe = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <ESC><"{} + abbruchzeichen + ">!"){} FI.{}END PROC warte;{}TEXT PROC incharety:{} IF puffer = ""{} THEN old incharety{} ELSE erstes zeichen von puffer{} FI.{} erstes zeichen von puffer:{} TEXT CONST zeichen :: puffer SUB 1;{} - puffer := subtext (puffer, 2);{} zeichen.{}END PROC incharety;{}TEXT PROC incharety (INT CONST timelimit):{} IF puffer = ""{} THEN old incharety (timelimit){} ELSE erstes zeichen von puffer{} FI.{} erstes zeichen von puffer:{} TEXT CONST zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC incharety;{}PROC inchar (TEXT VAR character):{} REP character := incharety{} UNTIL character <> "" PER{}END PROC inchar;{}PROC pause:{} TEXT VAR dummy;{} inchar (dummy){} -END PROC pause;{}PROC pause (INT CONST timelimit):{} TEXT VAR dummy := incharety (timelimit){}END PROC pause;{}BOOL PROC abbruch gewuenscht:{} pruefe abbruch;{} BOOL VAR entscheidung :: endezeichen gegeben;{} endezeichen gegeben := FALSE;{} entscheidung{}END PROC abbruch gewuenscht;{}PROC tue nichts:{} pruefe abbruch{}END PROC tue nichts;{}PROC trage kanaldaten ein (INT CONST kanalnummer,{} ROW 2 REAL CONST spannungsbereich,{} ROW 3 INT CONST kanalparameter):{} - spannung [kanalnummer].minimalwert := spannungsbereich [1];{} spannung [kanalnummer].maximalwert := spannungsbereich [2];{} kanal [kanalnummer].betriebsart := kanalparameter [1];{} kanal [kanalnummer].taktzahl := kanalparameter [2];{} kanal [kanalnummer].steuercode := interface anpassung{} (kanalnummer, kanalparameter [3]){}END PROC trage kanaldaten ein;{}PROC beende kanaldaten eintragen:{} kanaldaten sind eingetragen := TRUE{}END PROC beende kanaldaten eintragen;{} -PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR u min, u max):{} u min := spannung [kanalnummer].minimalwert;{} u max := spannung [kanalnummer].maximalwert{}END PROC hole spannungsbereich;{}INT PROC letzte ausgabe (INT CONST kanalnummer):{} vorherige ausgabe [kanalnummer]{}END PROC letzte ausgabe;{}PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart):{} pruefe abbruch;{} pruefe kanalnummer;{} pruefe betriebsart.{} pruefe kanalnummer:{} IF kanalnummer < 1 OR kanalnummer > max kanalanzahl{} - THEN errorstop ("Kanalnummer " + text (kanalnummer) +{} " ist unzulaessig !"){} FI.{} pruefe betriebsart:{} IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart{} THEN errorstop ("An Kanal " + text (kanalnummer) +{} " keine " + wunsch + " moeglich!"){} FI.{} wunsch:{} IF gewuenschte betriebsart = analog aus{} THEN "Analog-Ausgabe"{} ELIF gewuenschte betriebsart = digital aus{} THEN "Digital-Ausgabe"{} - ELIF gewuenschte betriebsart = digital ein{} THEN "Digital-Eingabe"{} ELIF gewuenschte betriebsart = analog ein{} THEN "Analog-Eingabe"{} ELSE "Ein- oder Ausgabe"{} FI.{}END PROC pruefe kanal;{}PROC pruefe abbruch:{} TEXT VAR zeichen :: incharety;{} IF zeichen = esc{} THEN pruefe weiter{} FI.{} pruefe weiter:{} zeichen := incharety (30);{} IF zeichen = endezeichen{} THEN endezeichen gegeben := TRUE{} ELIF zeichen = abbruchzeichen{} THEN errorstop ("Programm-Abbruch durch <ESC><"{} - + abbruchzeichen + ">!"){} FI.{}END PROC pruefe abbruch;{}PROC oeffne interface (INT VAR status):{} enable stop;{} IF kanaldaten sind eingetragen{} THEN teste interface funktion{} ELSE status := configuration error code{} FI.{} teste interface funktion:{} leere puffer;{} out (interface test code);{} fange antwort;{} IF antwort = interface okay code{} THEN status := 0;{} out (interface open code){} ELSE status := interface error code{} - FI.{} leere puffer:{} puffer := "";{} REP UNTIL old incharety = "" PER.{} fange antwort:{} INT VAR zaehler;{} TEXT VAR antwort :: "";{} FOR zaehler FROM 1 UPTO erwartete zeichen REP{} antwort CAT old incharety (1){} PER.{}END PROC oeffne interface;{}PROC schliesse interface:{} enable stop;{} out (interface close code){}END PROC schliesse interface;{}(********************* H I L F S P R O Z E D U R E N *********************){}PROC teste interface:{} INT VAR test;{} - warte etwas;{} oeffne interface (test);{} IF test < 0{} THEN errorstop (fehlermeldung){} ELSE endezeichen gegeben := FALSE;{} fehler zu melden := FALSE{} FI.{} warte etwas:{} pause (1); pause (1); pause (1); pause (1); pause (1).{} fehlermeldung:{} IF test = configuration error code{} THEN "Interface ist noch nicht konfiguriert!"{} ELIF test = interface error code{} THEN "Interface meldet sich nicht!"{} ELSE "Interface kann nicht geöffnet werden!"{} - FI.{}END PROC teste interface;{}PROC fehlerbehandlung:{} meldung := errormessage;{} IF meldung <> ""{} THEN meldung CAT fehlerzeile;{} fehler zu melden := TRUE{} FI;{} clear error;{} initialisiere interface.{} fehlerzeile:{} IF errorline = 0{} THEN ""{} ELSE " (bei Zeile " + text (errorline) + ")"{} FI.{}END PROC fehlerbehandlung;{}INT PROC dezimalwert (TEXT CONST zeichen 1, zeichen 2):{} 16 * pos (hexzeichen, zeichen 1) + pos (hexzeichen, zeichen 2).{} hexzeichen: "123456789ABCDEF".{} -END PROC dezimalwert;{}TEXT PROC hex (TEXT CONST zwei zeichen):{} hex (code (zwei zeichen SUB 1)) + hex (code (zwei zeichen SUB 2)){}END PROC hex;{}TEXT PROC hex (INT CONST wert):{} (hexzeichen SUB (wert DIV 16 + 1)) + (hexzeichen SUB (wert MOD 16 + 1)).{} hexzeichen: "0123456789ABCDEF".{}END PROC hex;{}PROC initialisiere die kanaele:{} INT VAR kanalnummer;{} FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{} trage kanaldaten ein (kanalnummer, keine spannung, leere karte);{} vorherige ausgabe [kanalnummer] := 0{} - PER.{} keine spannung:{} ROW 2 REAL : (0.0, 0.0).{} leere karte:{} ROW 3 INT : (nicht belegt, 0, 0).{}END PROC initialisiere die kanaele;{}initialisiere die kanaele{}END PACKET ls prozess 1{} +TEXT PROC old incharety: + incharety +END PROC old incharety; +TEXT PROC old incharety (INT CONST timelimit): + incharety (timelimit) +END PROC old incharety; +END PACKET altes incharety; +PACKET ls prozess 1 DEFINES + run pdv, + run pdv again, + initialisiere interface, + ausgeben, + eingabe, + warte, + abbruch gewuenscht, + tue nichts, + trage kanaldaten ein, + beende kanaldaten eintragen, + hole spannungsbereich, + letzte ausgabe, + + pruefe kanal, + pruefe abbruch, + teste interface, + schalte alles aus, + oeffne interface, + schliesse interface, + nicht belegt, + digital aus, + analog aus, + digital ein, + analog ein, + kanalbreite, + ganzzahl obergrenze, + adapterart, + incharety, + inchar, + pause: +(******************** A N P A S S U N G A N M U F I ********************) +LET mufikennung = ""31""31"", + erwartete zeichen = 4 ; + +TEXT CONST adapterart :: "MUFI im Terminalkanal", + interface test code :: ""27""27"10", + interface okay code :: ""27""27"00", + interface open code :: ""27""27"1C" + hex (mufikennung), + interface close code :: mufikennung + "1C" + hex (""27""27""), + adresse 0 code :: mufikennung + "3D", + leertakt code :: mufikennung + "3E", + interface write code :: mufikennung + "5" , + interface read code :: mufikennung + "4" ; + +TEXT VAR puffer :: ""; +ROW 256 TEXT CONST hexcode :: ROW 256 TEXT : ( +"00","01","02","03","04","05","06","07","08","09","0A","0B","0C","0D","0E","0F", +"10","11","12","13","14","15","16","17","18","19","1A","1B","1C","1D","1E","1F", +"20","21","22","23","24","25","26","27","28","29","2A","2B","2C","2D","2E","2F", +"30","31","32","33","34","35","36","37","38","39","3A","3B","3C","3D","3E","3F", +"40","41","42","43","44","45","46","47","48","49","4A","4B","4C","4D","4E","4F", +"50","51","52","53","54","55","56","57","58","59","5A","5B","5C","5D","5E","5F", + +"60","61","62","63","64","65","66","67","68","69","6A","6B","6C","6D","6E","6F", +"70","71","72","73","74","75","76","77","78","79","7A","7B","7C","7D","7E","7F", +"80","81","82","83","84","85","86","87","88","89","8A","8B","8C","8D","8E","8F", +"90","91","92","93","94","95","96","97","98","99","9A","9B","9C","9D","9E","9F", +"A0","A1","A2","A3","A4","A5","A6","A7","A8","A9","AA","AB","AC","AD","AE","AF", +"B0","B1","B2","B3","B4","B5","B6","B7","B8","B9","BA","BB","BC","BD","BE","BF", +"C0","C1","C2","C3","C4","C5","C6","C7","C8","C9","CA","CB","CC","CD","CE","CF", + +"D0","D1","D2","D3","D4","D5","D6","D7","D8","D9","DA","DB","DC","DD","DE","DF", +"E0","E1","E2","E3","E4","E5","E6","E7","E8","E9","EA","EB","EC","ED","EE","EF", +"F0","F1","F2","F3","F4","F5","F6","F7","F8","F9","FA","FB","FC","FD","FE","FF"); +TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode): + LET hexzeichen = "0123456789ABCDEF"; + IF es ist ein ausgabekanal + THEN interface write code + + (hexzeichen SUB (device + 4 * steuerungscode)) + ELIF es ist ein eingabekanal + + THEN lesecode in abhaengigkeit von der taktzahl + ELSE "" + FI. + es ist ein ausgabekanal: + kanal [kanalnummer].betriebsart < 0. + es ist ein eingabekanal: + kanal [kanalnummer].betriebsart > 0. + device: + IF kanalnummer < 10 + THEN 1 + ELSE kanalnummer DIV 10 + FI. + lesecode in abhaengigkeit von der taktzahl: + SELECT kanal [kanalnummer].taktzahl OF + CASE 1: lesecode + CASE 2: adresse 0 code + lesecode + lesecode + CASE 3: adresse 0 code + lesecode + zwei weitere takte + + OTHERWISE "" END SELECT. + lesecode: + interface read code + (hexzeichen SUB (device + 4 * steuerungscode)). + zwei weitere takte: + IF leertakt code = "" + THEN lesecode + lesecode + ELSE kanal [kanalnummer].taktzahl DECR 1; + leertakt code + lesecode + FI. +END PROC interface anpassung; +PROC ausgeben (INT CONST kanalnummer, wert): + merke wert; + gib wert aus. + merke wert: + vorherige ausgabe [kanalnummer] := wert. + gib wert aus: + out (kanal [kanalnummer].steuercode); + + out (hexcode [wert + 1]). +END PROC ausgeben; +INT PROC eingabe (INT CONST kanalnummer): + gib lesecode aus; + erhaltene antwort. + gib lesecode aus: + out (kanal [kanalnummer].steuercode). + erhaltene antwort: + TEXT VAR dummy; + SELECT kanal [kanalnummer].taktzahl OF + CASE 1 : erste sendung + CASE 2 : zweite sendung + CASE 3 : dritte sendung + OTHERWISE -1 + END SELECT. + erste sendung: + fange mufikennung; + dezimalwert (old incharety (1), old incharety (1)). + + zweite sendung: + fange mufikennung; + dummy := old incharety (1); + dummy := old incharety (1); + erste sendung. + dritte sendung: + fange mufikennung; + dummy := old incharety (1); + dummy := old incharety (1); + zweite sendung. + fange mufikennung: + puffer CAT old incharety; + REP puffer CAT old incharety + UNTIL pos (puffer, mufikennung) > 0 PER; + puffer := subtext (puffer, 1, length (puffer) - 2). +END PROC eingabe; +(************ H A R D W A R E U N A B H Ä N G I G E R T E I L ************) + +LET max kanalanzahl = 49, + endezeichen = "q", + abbruchzeichen = "h", + esc = ""27""; +INT CONST analog aus :: -2, (* Betriebsarten *) + digital aus :: -1, + nicht belegt :: 0, + digital ein :: 1, + analog ein :: 2, + kanalbreite :: 8, + ganzzahl obergrenze :: 2 ** kanalbreite, + + configuration error code :: -1, + interface error code :: -4; +TEXT VAR meldung :: ""; +BOOL VAR kanaldaten sind eingetragen :: FALSE, + endezeichen gegeben :: FALSE, + programm mit pdv gestartet :: FALSE, + fehler zu melden :: FALSE; +TYPE KANAL = STRUCT (INT betriebsart, taktzahl, TEXT steuercode), + SPANNUNG = STRUCT (REAL minimalwert, maximalwert); +ROW max kanalanzahl INT VAR vorherige ausgabe; + +ROW max kanalanzahl KANAL VAR kanal; +ROW max kanalanzahl SPANNUNG VAR spannung; +PROC run pdv: + run pdv (last param) +END PROC run pdv; +PROC run pdv (TEXT CONST programmname): + enable stop; + last param (programmname); + programm mit pdv gestartet := TRUE; + teste interface; + disable stop; + run (programmname); + IF is error + THEN fehlerbehandlung + ELSE melde programmende + FI; + schliesse interface; + programm mit pdv gestartet := FALSE; + enable stop; + IF fehler zu melden + + THEN errorstop (meldung) + FI +END PROC run pdv; +PROC run pdv again: + enable stop; + programm mit pdv gestartet := TRUE; + teste interface; + disable stop; + run again; + IF is error + THEN fehlerbehandlung + ELSE melde programmende + FI; + schliesse interface; + programm mit pdv gestartet := FALSE; + enable stop; + IF fehler zu melden + THEN errorstop (meldung) + FI +END PROC run pdv again; +PROC melde programmende: + page; + menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen."); + + pause; + schalte alles aus +END PROC melde programmende; +PROC initialisiere interface: + enable stop; + pruefe abbruch; + IF programm mit pdv gestartet + THEN schalte alles aus + ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!") + FI +END PROC initialisiere interface; +PROC schalte alles aus: + INT VAR kanalnummer, kanalbetriebsart; + FOR kanalnummer FROM 1 UPTO max kanalanzahl REP + kanalbetriebsart := kanal [kanalnummer].betriebsart; + IF kanalbetriebsart = digital aus + + THEN ausgeben (kanalnummer, 0) + ELIF kanalbetriebsart = analog aus + THEN ausgeben (kanalnummer, gewandelte nullspannung) + FI + PER. + gewandelte nullspannung: + int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5). + u max : spannung [kanalnummer].maximalwert. + u min : spannung [kanalnummer].minimalwert. +END PROC schalte alles aus; +PROC warte (REAL CONST sekunden): + TEXT VAR eingabe; + pruefe abbruch; + eingabe := incharety (int (sekunden * 10.0 + 0.5)); + + IF eingabe = esc + THEN untersuche naechstes zeichen + FI. + untersuche naechstes zeichen: + eingabe := incharety (30); + IF eingabe = endezeichen + THEN endezeichen gegeben := TRUE + ELIF eingabe = abbruchzeichen + THEN errorstop ("Programm-Abbruch durch <ESC><" + + abbruchzeichen + ">!") + FI. +END PROC warte; +PROC warte (INT CONST sekunden): + TEXT VAR eingabe; + pruefe abbruch; + eingabe := incharety (sekunden * 10); + IF eingabe = esc + + THEN untersuche naechstes zeichen + FI. + untersuche naechstes zeichen: + eingabe := incharety (30); + IF eingabe = endezeichen + THEN endezeichen gegeben := TRUE + ELIF eingabe = abbruchzeichen + THEN errorstop ("Programm-Abbruch durch <ESC><" + + abbruchzeichen + ">!") + FI. +END PROC warte; +TEXT PROC incharety: + IF puffer = "" + THEN old incharety + ELSE erstes zeichen von puffer + FI. + erstes zeichen von puffer: + TEXT CONST zeichen :: puffer SUB 1; + + puffer := subtext (puffer, 2); + zeichen. +END PROC incharety; +TEXT PROC incharety (INT CONST timelimit): + IF puffer = "" + THEN old incharety (timelimit) + ELSE erstes zeichen von puffer + FI. + erstes zeichen von puffer: + TEXT CONST zeichen :: puffer SUB 1; + puffer := subtext (puffer, 2); + zeichen. +END PROC incharety; +PROC inchar (TEXT VAR character): + REP character := incharety + UNTIL character <> "" PER +END PROC inchar; +PROC pause: + TEXT VAR dummy; + inchar (dummy) + +END PROC pause; +PROC pause (INT CONST timelimit): + TEXT VAR dummy := incharety (timelimit) +END PROC pause; +BOOL PROC abbruch gewuenscht: + pruefe abbruch; + BOOL VAR entscheidung :: endezeichen gegeben; + endezeichen gegeben := FALSE; + entscheidung +END PROC abbruch gewuenscht; +PROC tue nichts: + pruefe abbruch +END PROC tue nichts; +PROC trage kanaldaten ein (INT CONST kanalnummer, + ROW 2 REAL CONST spannungsbereich, + ROW 3 INT CONST kanalparameter): + + spannung [kanalnummer].minimalwert := spannungsbereich [1]; + spannung [kanalnummer].maximalwert := spannungsbereich [2]; + kanal [kanalnummer].betriebsart := kanalparameter [1]; + kanal [kanalnummer].taktzahl := kanalparameter [2]; + kanal [kanalnummer].steuercode := interface anpassung + (kanalnummer, kanalparameter [3]) +END PROC trage kanaldaten ein; +PROC beende kanaldaten eintragen: + kanaldaten sind eingetragen := TRUE +END PROC beende kanaldaten eintragen; + +PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR u min, u max): + u min := spannung [kanalnummer].minimalwert; + u max := spannung [kanalnummer].maximalwert +END PROC hole spannungsbereich; +INT PROC letzte ausgabe (INT CONST kanalnummer): + vorherige ausgabe [kanalnummer] +END PROC letzte ausgabe; +PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart): + pruefe abbruch; + pruefe kanalnummer; + pruefe betriebsart. + pruefe kanalnummer: + IF kanalnummer < 1 OR kanalnummer > max kanalanzahl + + THEN errorstop ("Kanalnummer " + text (kanalnummer) + + " ist unzulaessig !") + FI. + pruefe betriebsart: + IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart + THEN errorstop ("An Kanal " + text (kanalnummer) + + " keine " + wunsch + " moeglich!") + FI. + wunsch: + IF gewuenschte betriebsart = analog aus + THEN "Analog-Ausgabe" + ELIF gewuenschte betriebsart = digital aus + THEN "Digital-Ausgabe" + + ELIF gewuenschte betriebsart = digital ein + THEN "Digital-Eingabe" + ELIF gewuenschte betriebsart = analog ein + THEN "Analog-Eingabe" + ELSE "Ein- oder Ausgabe" + FI. +END PROC pruefe kanal; +PROC pruefe abbruch: + TEXT VAR zeichen :: incharety; + IF zeichen = esc + THEN pruefe weiter + FI. + pruefe weiter: + zeichen := incharety (30); + IF zeichen = endezeichen + THEN endezeichen gegeben := TRUE + ELIF zeichen = abbruchzeichen + THEN errorstop ("Programm-Abbruch durch <ESC><" + + + abbruchzeichen + ">!") + FI. +END PROC pruefe abbruch; +PROC oeffne interface (INT VAR status): + enable stop; + IF kanaldaten sind eingetragen + THEN teste interface funktion + ELSE status := configuration error code + FI. + teste interface funktion: + leere puffer; + out (interface test code); + fange antwort; + IF antwort = interface okay code + THEN status := 0; + out (interface open code) + ELSE status := interface error code + + FI. + leere puffer: + puffer := ""; + REP UNTIL old incharety = "" PER. + fange antwort: + INT VAR zaehler; + TEXT VAR antwort :: ""; + FOR zaehler FROM 1 UPTO erwartete zeichen REP + antwort CAT old incharety (1) + PER. +END PROC oeffne interface; +PROC schliesse interface: + enable stop; + out (interface close code) +END PROC schliesse interface; +(********************* H I L F S P R O Z E D U R E N *********************) +PROC teste interface: + INT VAR test; + + warte etwas; + oeffne interface (test); + IF test < 0 + THEN errorstop (fehlermeldung) + ELSE endezeichen gegeben := FALSE; + fehler zu melden := FALSE + FI. + warte etwas: + pause (1); pause (1); pause (1); pause (1); pause (1). + fehlermeldung: + IF test = configuration error code + THEN "Interface ist noch nicht konfiguriert!" + ELIF test = interface error code + THEN "Interface meldet sich nicht!" + ELSE "Interface kann nicht geöffnet werden!" + + FI. +END PROC teste interface; +PROC fehlerbehandlung: + meldung := errormessage; + IF meldung <> "" + THEN meldung CAT fehlerzeile; + fehler zu melden := TRUE + FI; + clear error; + initialisiere interface. + fehlerzeile: + IF errorline = 0 + THEN "" + ELSE " (bei Zeile " + text (errorline) + ")" + FI. +END PROC fehlerbehandlung; +INT PROC dezimalwert (TEXT CONST zeichen 1, zeichen 2): + 16 * pos (hexzeichen, zeichen 1) + pos (hexzeichen, zeichen 2). + hexzeichen: "123456789ABCDEF". + +END PROC dezimalwert; +TEXT PROC hex (TEXT CONST zwei zeichen): + hex (code (zwei zeichen SUB 1)) + hex (code (zwei zeichen SUB 2)) +END PROC hex; +TEXT PROC hex (INT CONST wert): + (hexzeichen SUB (wert DIV 16 + 1)) + (hexzeichen SUB (wert MOD 16 + 1)). + hexzeichen: "0123456789ABCDEF". +END PROC hex; +PROC initialisiere die kanaele: + INT VAR kanalnummer; + FOR kanalnummer FROM 1 UPTO max kanalanzahl REP + trage kanaldaten ein (kanalnummer, keine spannung, leere karte); + vorherige ausgabe [kanalnummer] := 0 + + PER. + keine spannung: + ROW 2 REAL : (0.0, 0.0). + leere karte: + ROW 3 INT : (nicht belegt, 0, 0). +END PROC initialisiere die kanaele; +initialisiere die kanaele +END PACKET ls prozess 1 + diff --git a/prozess/ls-Prozess 2 b/prozess/ls-Prozess 2 index 11cb4e7..3b8d407 100644 --- a/prozess/ls-Prozess 2 +++ b/prozess/ls-Prozess 2 @@ -22,18 +22,217 @@ *) PACKET ls prozess 2 DEFINES - wert an analogausgang ausgeben,{} spannungswert ausgeben,{} bitsymbol ausgeben,{} bitmuster ausgeben,{} dezimalwert ausgeben,{} bitmuster gleich,{} bit ist gesetzt,{} wert von analogeingang,{} spannungswert,{} bitsymbol,{} bitmuster,{} dezimalwert:{}LET eins = "I",{} null = "O",{} invers = "T",{} egal = "X";{}REAL CONST maximalwert :: real (ganzzahl obergrenze - 1);{}(********************* A U S G A B E - B E F E H L E *********************){} -PROC wert an analogausgang ausgeben (INT CONST kanal, wert):{} pruefe kanal (kanal, analog aus);{} ausgeben (kanal, wert MOD ganzzahlobergrenze){}END PROC wert an analogausgang ausgeben;{}PROC spannungswert ausgeben (INT CONST kanal, REAL CONST wert):{} pruefe kanal (kanal, analog aus);{} pruefe spannungswert;{} ausgeben (kanal, gewandelte spannung).{} pruefe spannungswert:{} REAL VAR u min, u max;{} hole spannungsbereich (kanal, u min, u max);{} IF wert < u min OR wert > u max{} THEN errorstop ("Der Spannungswert " + text (wert) +{} - " ist nicht zulaessig!"){} FI.{} gewandelte spannung:{} int (((wert - u min) * maximalwert) / (u max - u min) + 0.5).{}END PROC spannungswert ausgeben;{}PROC bitsymbol ausgeben (INT CONST kanal, bitnummer, TEXT CONST zeichen):{} pruefe kanal (kanal, digital aus);{} pruefe bitnummer (bitnummer);{} ausgeben (kanal, relativer dezimalwert (zeichen, bitnummer, kanal)){}END PROC bitsymbol ausgeben;{}PROC bitmuster ausgeben (INT CONST kanal, TEXT CONST zeichenkette):{} - pruefe kanal (kanal, digital aus);{} ausgeben (kanal, relativer dezimalwert (zeichenkette, kanal)){}END PROC bitmuster ausgeben;{}PROC dezimalwert ausgeben (INT CONST kanal, wert):{} pruefe kanal (kanal, digital aus);{} ausgeben (kanal, wert MOD ganzzahl obergrenze){}END PROC dezimalwert ausgeben;{}(********************* E I N G A B E - B E F E H L E *********************){}BOOL PROC bitmuster gleich (INT CONST kanal, TEXT CONST zeichenkette):{} INT CONST eingabewert :: dezimalwert (kanal);{} - pruefe zeichenkette;{} eingabe passt zur zeichenkette.{} pruefe zeichenkette:{} IF length (zeichenkette) <> kanalbreite{} THEN errorstop ("Das Bitmuster '" + zeichenkette +{} "' hat eine unzulaessige Laenge!"){} FI.{} eingabe passt zur zeichenkette:{} INT VAR stelle;{} BOOL VAR abweichung gefunden :: FALSE;{} FOR stelle FROM 1 UPTO kanalbreite REP{} teste bit an dieser stelle{} UNTIL abweichung gefunden PER;{} NOT abweichung gefunden.{} teste bit an dieser stelle:{} - TEXT CONST einzelbit :: zeichenkette SUB stelle;{} IF einzelbit = eins{} THEN teste eingabebit auf eins{} ELIF einzelbit = null{} THEN teste eingabebit auf null{} ELIF einzelbit = egal{} THEN eingabebit ist beliebig{} ELSE errorstop ("'" + einzelbit + "' ist unzulaessiges " +{} "Bitsymbol in '" + zeichenkette + "'!"){} FI.{} teste eingabebit auf eins:{} IF NOT bit (eingabewert, kanalbreite - stelle){} THEN abweichung gefunden := TRUE{} FI.{} - teste eingabebit auf null:{} IF bit (eingabewert, kanalbreite - stelle){} THEN abweichung gefunden := TRUE{} FI.{} eingabebit ist beliebig:{} .{}END PROC bitmuster gleich;{}BOOL PROC bit ist gesetzt (INT CONST kanal, bitnummer):{} pruefe kanal (kanal, digital ein);{} pruefe bitnummer (bitnummer);{} IF bit (eingabe (kanal), bitnummer){} THEN TRUE{} ELSE FALSE{} FI{}END PROC bit ist gesetzt;{}INT PROC wert von analogeingang (INT CONST kanal):{} pruefe kanal (kanal, analog ein);{} - eingabe (kanal){}END PROC wert von analogeingang;{}REAL PROC spannungswert (INT CONST kanal):{} INT CONST dezimalwert :: wert von analogeingang (kanal);{} REAL VAR u min, u max;{} hole spannungsbereich (kanal, u min, u max);{} round (real (dezimalwert) * (u max - u min) / maximalwert + u min, 3){}END PROC spannungswert;{}TEXT PROC bitsymbol (INT CONST kanal, bitnummer):{} pruefe kanal (kanal, digital ein);{} pruefe bitnummer (bitnummer);{} IF bit (eingabe (kanal), bitnummer){} THEN eins{} - ELSE null{} FI{}END PROC bitsymbol;{}TEXT PROC bitmuster (INT CONST kanal):{} TEXT VAR zeichenkette :: "";{} INT CONST wert :: dezimalwert (kanal);{} wandle wert;{} zeichenkette.{} wandle wert:{} INT VAR zeiger;{} FOR zeiger FROM kanalbreite - 1 DOWNTO 0 REP{} IF bit (wert, zeiger){} THEN zeichenkette CAT eins{} ELSE zeichenkette CAT null{} FI{} PER.{}END PROC bitmuster;{}INT PROC dezimalwert (INT CONST kanal):{} pruefe kanal (kanal, digital ein);{} - eingabe (kanal){}END PROC dezimalwert;{}(******************** H I L F S - P R O Z E D U R E N ********************){}INT PROC relativer dezimalwert (TEXT CONST zeichenkette, INT CONST kanal):{} INT VAR wert := letzte ausgabe (kanal);{} pruefe zeichenkette auf korrekte laenge;{} veraendere alten wert;{} wert.{} pruefe zeichenkette auf korrekte laenge:{} IF length (zeichenkette) <> kanalbreite{} THEN errorstop ("Bitmuster '" + zeichenkette + "' hat "{} + "unzulaessige Laenge!"){} - FI.{} veraendere alten wert:{} INT VAR zeiger;{} FOR zeiger FROM 1 UPTO kanalbreite REP{} veraendere dieses bit{} PER.{} veraendere dieses bit:{} TEXT CONST einzelbit :: zeichenkette SUB zeiger;{} IF einzelbit = eins THEN setze bit{} ELIF einzelbit = null THEN loesche bit{} ELIF einzelbit = invers THEN invertiere bit{} ELIF einzelbit = egal THEN lasse bit{} ELSE errorstop ("'" + einzelbit + "' ist unzulaessiges " +{} "Bitsymbol in '" + zeichenkette + "'!"){} - FI.{} setze bit:{} set bit (wert, kanalbreite - zeiger).{} loesche bit:{} reset bit (wert, kanalbreite - zeiger).{} invertiere bit:{} IF bit (wert, kanalbreite - zeiger){} THEN loesche bit{} ELSE setze bit{} FI.{} lasse bit:{} .{} END PROC relativer dezimalwert;{}INT PROC relativer dezimalwert (TEXT CONST bitzeichen,{} INT CONST bitnummer, kanal):{} INT VAR wert :: letzte ausgabe (kanal);{} IF bitzeichen = eins THEN setze bit{} - ELIF bitzeichen = null THEN loesche bit{} ELIF bitzeichen = invers THEN invertiere bit{} ELIF bitzeichen = egal THEN lasse bit{} ELSE errorstop ("'" + bitzeichen + "' ist ein unzulaessiges " +{} "Bitsymbol!"){} FI;{} wert.{} setze bit:{} set bit (wert, bitnummer).{} loesche bit:{} reset bit (wert, bitnummer).{} invertiere bit:{} IF bit (wert, bitnummer){} THEN loesche bit{} ELSE setze bit{} FI.{} lasse bit:{} - .{}END PROC relativer dezimalwert;{}PROC pruefe bitnummer (INT CONST bitnummer):{} IF bitnummer < 0 OR bitnummer > kanalbreite - 1{} THEN errorstop ("Bitnummer " + text (bitnummer) +{} " ist nicht zulaessig!"){} FI{}END PROC pruefe bitnummer{}END PACKET ls prozess 2{} + wert an analogausgang ausgeben, + spannungswert ausgeben, + bitsymbol ausgeben, + bitmuster ausgeben, + dezimalwert ausgeben, + bitmuster gleich, + bit ist gesetzt, + wert von analogeingang, + spannungswert, + bitsymbol, + bitmuster, + dezimalwert: +LET eins = "I", + null = "O", + invers = "T", + egal = "X"; +REAL CONST maximalwert :: real (ganzzahl obergrenze - 1); +(********************* A U S G A B E - B E F E H L E *********************) + +PROC wert an analogausgang ausgeben (INT CONST kanal, wert): + pruefe kanal (kanal, analog aus); + ausgeben (kanal, wert MOD ganzzahlobergrenze) +END PROC wert an analogausgang ausgeben; +PROC spannungswert ausgeben (INT CONST kanal, REAL CONST wert): + pruefe kanal (kanal, analog aus); + pruefe spannungswert; + ausgeben (kanal, gewandelte spannung). + pruefe spannungswert: + REAL VAR u min, u max; + hole spannungsbereich (kanal, u min, u max); + IF wert < u min OR wert > u max + THEN errorstop ("Der Spannungswert " + text (wert) + + + " ist nicht zulaessig!") + FI. + gewandelte spannung: + int (((wert - u min) * maximalwert) / (u max - u min) + 0.5). +END PROC spannungswert ausgeben; +PROC bitsymbol ausgeben (INT CONST kanal, bitnummer, TEXT CONST zeichen): + pruefe kanal (kanal, digital aus); + pruefe bitnummer (bitnummer); + ausgeben (kanal, relativer dezimalwert (zeichen, bitnummer, kanal)) +END PROC bitsymbol ausgeben; +PROC bitmuster ausgeben (INT CONST kanal, TEXT CONST zeichenkette): + + pruefe kanal (kanal, digital aus); + ausgeben (kanal, relativer dezimalwert (zeichenkette, kanal)) +END PROC bitmuster ausgeben; +PROC dezimalwert ausgeben (INT CONST kanal, wert): + pruefe kanal (kanal, digital aus); + ausgeben (kanal, wert MOD ganzzahl obergrenze) +END PROC dezimalwert ausgeben; +(********************* E I N G A B E - B E F E H L E *********************) +BOOL PROC bitmuster gleich (INT CONST kanal, TEXT CONST zeichenkette): + INT CONST eingabewert :: dezimalwert (kanal); + + pruefe zeichenkette; + eingabe passt zur zeichenkette. + pruefe zeichenkette: + IF length (zeichenkette) <> kanalbreite + THEN errorstop ("Das Bitmuster '" + zeichenkette + + "' hat eine unzulaessige Laenge!") + FI. + eingabe passt zur zeichenkette: + INT VAR stelle; + BOOL VAR abweichung gefunden :: FALSE; + FOR stelle FROM 1 UPTO kanalbreite REP + teste bit an dieser stelle + UNTIL abweichung gefunden PER; + NOT abweichung gefunden. + teste bit an dieser stelle: + + TEXT CONST einzelbit :: zeichenkette SUB stelle; + IF einzelbit = eins + THEN teste eingabebit auf eins + ELIF einzelbit = null + THEN teste eingabebit auf null + ELIF einzelbit = egal + THEN eingabebit ist beliebig + ELSE errorstop ("'" + einzelbit + "' ist unzulaessiges " + + "Bitsymbol in '" + zeichenkette + "'!") + FI. + teste eingabebit auf eins: + IF NOT bit (eingabewert, kanalbreite - stelle) + THEN abweichung gefunden := TRUE + FI. + + teste eingabebit auf null: + IF bit (eingabewert, kanalbreite - stelle) + THEN abweichung gefunden := TRUE + FI. + eingabebit ist beliebig: + . +END PROC bitmuster gleich; +BOOL PROC bit ist gesetzt (INT CONST kanal, bitnummer): + pruefe kanal (kanal, digital ein); + pruefe bitnummer (bitnummer); + IF bit (eingabe (kanal), bitnummer) + THEN TRUE + ELSE FALSE + FI +END PROC bit ist gesetzt; +INT PROC wert von analogeingang (INT CONST kanal): + pruefe kanal (kanal, analog ein); + + eingabe (kanal) +END PROC wert von analogeingang; +REAL PROC spannungswert (INT CONST kanal): + INT CONST dezimalwert :: wert von analogeingang (kanal); + REAL VAR u min, u max; + hole spannungsbereich (kanal, u min, u max); + round (real (dezimalwert) * (u max - u min) / maximalwert + u min, 3) +END PROC spannungswert; +TEXT PROC bitsymbol (INT CONST kanal, bitnummer): + pruefe kanal (kanal, digital ein); + pruefe bitnummer (bitnummer); + IF bit (eingabe (kanal), bitnummer) + THEN eins + + ELSE null + FI +END PROC bitsymbol; +TEXT PROC bitmuster (INT CONST kanal): + TEXT VAR zeichenkette :: ""; + INT CONST wert :: dezimalwert (kanal); + wandle wert; + zeichenkette. + wandle wert: + INT VAR zeiger; + FOR zeiger FROM kanalbreite - 1 DOWNTO 0 REP + IF bit (wert, zeiger) + THEN zeichenkette CAT eins + ELSE zeichenkette CAT null + FI + PER. +END PROC bitmuster; +INT PROC dezimalwert (INT CONST kanal): + pruefe kanal (kanal, digital ein); + + eingabe (kanal) +END PROC dezimalwert; +(******************** H I L F S - P R O Z E D U R E N ********************) +INT PROC relativer dezimalwert (TEXT CONST zeichenkette, INT CONST kanal): + INT VAR wert := letzte ausgabe (kanal); + pruefe zeichenkette auf korrekte laenge; + veraendere alten wert; + wert. + pruefe zeichenkette auf korrekte laenge: + IF length (zeichenkette) <> kanalbreite + THEN errorstop ("Bitmuster '" + zeichenkette + "' hat " + + "unzulaessige Laenge!") + + FI. + veraendere alten wert: + INT VAR zeiger; + FOR zeiger FROM 1 UPTO kanalbreite REP + veraendere dieses bit + PER. + veraendere dieses bit: + TEXT CONST einzelbit :: zeichenkette SUB zeiger; + IF einzelbit = eins THEN setze bit + ELIF einzelbit = null THEN loesche bit + ELIF einzelbit = invers THEN invertiere bit + ELIF einzelbit = egal THEN lasse bit + ELSE errorstop ("'" + einzelbit + "' ist unzulaessiges " + + "Bitsymbol in '" + zeichenkette + "'!") + + FI. + setze bit: + set bit (wert, kanalbreite - zeiger). + loesche bit: + reset bit (wert, kanalbreite - zeiger). + invertiere bit: + IF bit (wert, kanalbreite - zeiger) + THEN loesche bit + ELSE setze bit + FI. + lasse bit: + . + END PROC relativer dezimalwert; +INT PROC relativer dezimalwert (TEXT CONST bitzeichen, + INT CONST bitnummer, kanal): + INT VAR wert :: letzte ausgabe (kanal); + IF bitzeichen = eins THEN setze bit + + ELIF bitzeichen = null THEN loesche bit + ELIF bitzeichen = invers THEN invertiere bit + ELIF bitzeichen = egal THEN lasse bit + ELSE errorstop ("'" + bitzeichen + "' ist ein unzulaessiges " + + "Bitsymbol!") + FI; + wert. + setze bit: + set bit (wert, bitnummer). + loesche bit: + reset bit (wert, bitnummer). + invertiere bit: + IF bit (wert, bitnummer) + THEN loesche bit + ELSE setze bit + FI. + lasse bit: + + . +END PROC relativer dezimalwert; +PROC pruefe bitnummer (INT CONST bitnummer): + IF bitnummer < 0 OR bitnummer > kanalbreite - 1 + THEN errorstop ("Bitnummer " + text (bitnummer) + + " ist nicht zulaessig!") + FI +END PROC pruefe bitnummer +END PACKET ls prozess 2 + diff --git a/prozess/ls-Prozess 3 b/prozess/ls-Prozess 3 index 28ef825..b66cbe6 100644 --- a/prozess/ls-Prozess 3 +++ b/prozess/ls-Prozess 3 @@ -22,5 +22,12 @@ *) PACKET ls prozess 3 DEFINES - temperatur:{}LET thermometerkonstante = 50.0,{} minimaltemperatur = 10.0;{}REAL PROC temperatur (REAL CONST spannungswert):{} spannungswert * thermometerkonstante - minimaltemperatur{}END PROC temperatur{}END PACKET ls prozess 3{} + temperatur: +LET thermometerkonstante = 50.0, + minimaltemperatur = 10.0; +REAL PROC temperatur (REAL CONST spannungswert): + spannungswert * thermometerkonstante - minimaltemperatur +END PROC temperatur +END PACKET ls prozess 3 + diff --git a/prozess/ls-Prozess 4 b/prozess/ls-Prozess 4 index 158b548..59a1493 100644 --- a/prozess/ls-Prozess 4 +++ b/prozess/ls-Prozess 4 @@ -22,40 +22,574 @@ *) PACKET ls prozess 4 DEFINES - pdv befehlsuebersicht anzeigen,{} pdv ausgabebefehle anzeigen,{} pdv eingabebefehle anzeigen,{} pdv testbefehle anzeigen,{} pdv weitere befehle anzeigen,{} pdv bitmuster erlaeutern,{} pdv symbole erlaeutern,{} pdv digital analog werte,{} pdv programm neu erstellen,{} pdv programm ansehen,{} pdv programm starten,{} pdv programm wiederholen,{} pdv dateien verzeichnis,{} - pdv datei kopieren,{} pdv datei umbenennen,{} pdv dateien loeschen,{} pdv dateien drucken,{} init pdv,{} pdv:{}LET menukarte = "ls-MENUKARTE:Prozess",{} niltext = "",{} maxlaenge = 45,{} maxnamenslaenge = 35;{}WINDOW VAR w :: window (1, 3, 79, 19);{}TEXT VAR programmname :: "";{}BOOL VAR noch kein programm gelaufen :: TRUE;{}PROC pdv:{} init pdv;{} install menu (menukarte, FALSE);{} - handle menu ("PDV"){}END PROC pdv;{}PROC init pdv:{} programmname := "";{} noch kein programm gelaufen := TRUE;{} cursor off;{}END PROC init pdv;{}PROC pdv befehlsuebersicht anzeigen:{} menuinfo (anwendungstext (20)){}END PROC pdv befehlsuebersicht anzeigen;{}PROC pdv ausgabebefehle anzeigen:{} INT VAR i;{} REP{} i := menualternative (anwendungstext (1), anwendungstext (3),{} anwendungstext (4), 5, TRUE);{} SELECT i OF{} CASE 1, 101: menuinfo (anwendungstext (21)){} - CASE 2, 102: menuinfo (anwendungstext (22)){} CASE 3, 103: menuinfo (anwendungstext (23)){} CASE 4, 104: menuinfo (anwendungstext (24)){} CASE 5, 105: menuinfo (anwendungstext (25)){} END SELECT{} UNTIL i = 6 OR i = 106 PER;{}END PROC pdv ausgabebefehle anzeigen;{}PROC pdv eingabebefehle anzeigen:{} INT VAR i;{} REP{} i := menualternative (anwendungstext (2), anwendungstext (3),{} anwendungstext (4), 5, TRUE);{} SELECT i OF{} CASE 1, 101: menuinfo (anwendungstext (31)){} - CASE 2, 102: menuinfo (anwendungstext (32)){} CASE 3, 103: menuinfo (anwendungstext (33)){} CASE 4, 104: menuinfo (anwendungstext (34)){} CASE 5, 105: menuinfo (anwendungstext (35)){} END SELECT{} UNTIL i = 6 OR i = 106 PER;{}END PROC pdv eingabebefehle anzeigen;{}PROC pdv testbefehle anzeigen:{} INT VAR i;{} REP{} i := menualternative (anwendungstext (5), anwendungstext (7),{} anwendungstext (8), 5, TRUE);{} SELECT i OF{} CASE 1, 101: menuinfo (anwendungstext (41)){} - CASE 2, 102: menuinfo (anwendungstext (42)){} END SELECT{} UNTIL i = 3 OR i = 103 PER;{}END PROC pdv testbefehle anzeigen;{}PROC pdv weitere befehle anzeigen:{} INT VAR i;{} REP{} i := menualternative (anwendungstext (6), anwendungstext (7),{} anwendungstext (8), 5, TRUE);{} SELECT i OF{} CASE 1, 101: menuinfo (anwendungstext (43)){} CASE 2, 102: menuinfo (anwendungstext (44)){} END SELECT{} UNTIL i = 3 OR i = 103 PER;{}END PROC pdv weitere befehle anzeigen;{} -PROC pdv bitmuster erlaeutern:{} menuinfo (anwendungstext (46)){}END PROC pdv bitmuster erlaeutern;{}PROC pdv symbole erlaeutern:{} menuinfo (anwendungstext (47)){}END PROC pdv symbole erlaeutern;{}PROC pdv digital analog werte:{} menuinfo (anwendungstext (48)){}END PROC pdv digital analog werte;{}PROC pdvdateien verzeichnis:{} disable stop;{} forget ("Verzeichnis der Dateien", quiet);{} THESAURUS VAR programme :: ALL myself;{} FILE VAR f ::{} sequential file (output, "Verzeichnis der Dateien");{} - f FILLBY programme;{} modify (f);{} to line (f, 1); insert record (f);{} menufootnote ("Verlassen: <ESC> <q>");{} cursor on;{} show (w, f);{} cursor off;{} forget ("Verzeichnis der Dateien", quiet);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop{}END PROC pdvdateien verzeichnis;{}PROC pdvprogramm neu erstellen:{} hole programmname;{} - kontrolliere den programmnamen;{} command dialogue (FALSE);{} cursor on;{} disable stop;{} stdinfoedit (programmname, 3);{} cursor off;{} command dialogue (TRUE);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop.{} hole programmname:{} programmname := "";{} programmname := menuanswer (ausgabe, programmname, 5).{} ausgabe:{} center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13""{} - + " Bitte den Namen für das Programm "13""13"".{} kontrolliere den programmnamen:{} IF programmname = niltext{} THEN LEAVE pdvprogramm neu erstellen{} ELIF length (programmname) > maxnamenslaenge{} THEN meckere zu langen namen an;{} programmname := niltext;{} LEAVE pdvprogramm neu erstellen{} ELIF exists (programmname){} THEN meckere existierendes programm an;{} LEAVE pdvprogramm neu erstellen{} FI.{}END PROC pdvprogramm neu erstellen;{} -PROC pdvprogramm ansehen:{} IF programmname <> niltext CAND exists (programmname){} THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI;{} cursor on;{} disable stop;{} stdinfoedit (programmname, 3);{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop.{} frage nach diesem programm:{} IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name{} - + " Soll mit diesem Programm gearbeitet werden", 5){} THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare :: ALL myself;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE pdvprogramm ansehen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} - programmname := menuone (verfuegbare, "Programm ansehen/ändern",{} "Bitte das gewünschte Programm ankreuzen!",{} FALSE);{} IF programmname = niltext{} THEN menu bildschirm;{} LEAVE pdvprogramm ansehen{} FI.{}END PROC pdvprogramm ansehen;{}PROC pdvdateien drucken:{} lasse programme auswaehlen;{} drucke programme;{} menu bildschirm.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare :: ALL myself;{} IF NOT not empty (verfuegbare){} - THEN noch kein programm;{} LEAVE pdvdateien drucken{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Dateien drucken",{} "Bitte die Dateien ankreuzen, die gedruckt werden sollen!",{} FALSE).{} drucke programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Dateien drucken")));{} menuwindowline (2);{} command dialogue (FALSE);{} - fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (" Alle ausgewählten Dateien wurden gedruckt!");{} 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) +{} """ wird gedruckt!");{} menuwindowline;{} - print (name (verfuegbare, k));{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (" Es wurde keine Datei ausgewählt!");{} menuwindowstop;{} menu bildschirm;{} LEAVE pdvdateien 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; out (""7"");{} menuinfo (" " + invers (errormessage));{} clear error; enable stop;{} LEAVE pdvdateien drucken{} ELSE enable stop{} FI.{}END PROC pdvdateien drucken;{}PROC pdvdatei kopieren:{} ermittle alten programmnamen;{} erfrage neuen programmnamen;{} kopiere ggf das programm.{} ermittle alten programmnamen:{} IF NOT not empty (ALL myself){} THEN noch kein programm;{} - LEAVE pdvdatei kopieren{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone (ALL myself, "Datei kopieren",{} "Bitte die Datei ankreuzen, das kopiert werden soll!",FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE pdvdatei kopieren{} FI.{} erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + " Name der 'alten' Datei: " + bisheriger name{} - + " Bitte den Namen für die Kopie: ".{} ueberschrift:{} center (maxlaenge, invers ("Datei kopieren")) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} kopiere ggf das programm:{} IF neuer name = niltext{} THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} LEAVE pdvdatei kopieren{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE pdvdatei kopieren{} ELSE copy (alter name, neuer name){} - FI.{} mache vorwurf:{} menuinfo (" " + invers ("Eine Datei mit diesem Namen gibt es bereits!")).{}END PROC pdvdatei kopieren;{}PROC pdvdatei umbenennen:{} ermittle alten programmnamen;{} erfrage neuen programmnamen;{} benenne ggf das programm um.{} ermittle alten programmnamen:{} IF NOT not empty (ALL myself){} THEN noch kein programm;{} LEAVE pdvdatei umbenennen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( ALL myself, "Datei umbenennen",{} - "Bitte die Datei ankreuzen, die umbenannt werden soll!", FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE pdvdatei umbenennen{} FI.{} erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + " Bisheriger Dateiname: " + bisheriger name{} + " Zukünftiger Dateiname: ".{} ueberschrift:{} center (maxlaenge, invers ("Datei umbenennen")) + ""13""13"".{} bisheriger name:{} - ""13""13" " + invers (alter name) + ""13""13"".{} benenne ggf das programm um:{} IF neuer name = niltext{} THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} LEAVE pdvdatei umbenennen{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE pdvdatei umbenennen{} ELSE rename (alter name, neuer name);{} programmname := neuer name{} FI.{} mache vorwurf:{} menuinfo (" " + invers ("Eine Datei mit diesem Namen gibt es bereits!")).{} -END PROC pdvdatei umbenennen;{}PROC pdvdateien loeschen:{} lasse programme auswaehlen;{} loesche programme;{} menu bildschirm.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare :: ALL myself;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE pdvdateien loeschen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Dateien löschen",{} "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE).{} - loesche programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Dateien löschen")));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!");{} 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) + """ löschen"){} 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 (" Es wurde keine Datei ausgewählt!");{} menuwindowstop;{} - menu bildschirm;{} LEAVE pdvdateien 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; out (""7"");{} menuinfo (" " + invers (errormessage));{} clear error; enable stop;{} LEAVE pdvdateien loeschen{} ELSE enable stop{} FI.{}END PROC pdvdateien loeschen;{} -PROC pdvprogramm starten:{} programmname ermitteln;{} bildschirm vorbereiten;{} cursor on;{} disable stop;{} warnings off;{} check on;{} run pdv (programmname);{} noch kein programm gelaufen := FALSE;{} cursor off;{} IF is error{} THEN fehler ggf melden;{} clear error{} ELSE regenerate menuscreen{} FI;{} enable stop.{} bildschirm vorbereiten:{} cursor (17, 2); out (waagerecht);{} cursor (38, 2); out (waagerecht);{} cursor ( 1, 3); out (""4"");{} menufootnote ("Programmabbruch: <ESC><h>");{} - cursor (1, 5);{} out ("Das Programm wird übersetzt. Zeilen-Nr.: ").{} fehler ggf melden:{} IF errormessage <> ""{} THEN fehler melden{} FI.{} fehler melden:{} IF pos (errormessage, "'halt' vom Terminal") > 0{} THEN regenerate menuscreen;{} out (""7""); menuinfo (" "15"'halt' vom Terminal "14""){} ELIF pos (errormessage, "Programm-Abbruch durch <ESC><h>") > 0{} THEN regenerate menuscreen;{} out (""7""); menuinfo (" "15"Programm-Abbruch durch <ESC><h> "14""){} - ELIF pos (errormessage, "(bei Zeile") > 0 AND exists (programmname){} THEN programm mit fehler im notebook zeigen;{} regenerate menuscreen{} ELSE regenerate menuscreen;{} out (""7""); menuinfo (" " + invers ("FEHLER: "{} + subtext (errormessage, 1, 61))){} FI.{} programm mit fehler im notebook zeigen:{} noteline;{} note ("FEHLER: " + errormessage);{} INT VAR n; FOR n FROM 1 UPTO 9 REP noteline PER;{} note (""15"Verlassen: <ESC><q> "14"");{} - FILE VAR p :: sequential file (modify, programmname);{} to line (p, max (1, fehlerzeile));{} col (1);{} clear error;{} out (""7"");{} cursor on;{} noteedit (p);{} cursor off.{} fehlerzeile:{} int (subtext (errormessage, zahlposition)).{} zahlposition: pos (errormessage, "(bei Zeile") + 10.{} 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 + " Zuletzt bearbeitetes Programm: " +{} name + " Soll mit diesem Programm gearbeitet werden", 5){} THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm starten")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare :: ALL myself;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE pdvprogramm starten{} - ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, "Programm starten",{} "Bitte das gewünschte Programm ankreuzen!", FALSE);{} IF programmname = niltext{} THEN menubildschirm;{} LEAVE pdv programm starten{} FI.{}END PROC pdvprogramm starten;{}PROC pdv programm wiederholen:{} bildschirm vorbereiten;{} cursor on;{} disable stop;{} IF noch kein programm gelaufen{} THEN errorstop ("Eine Wiederholung ist nicht moeglich!"){} - ELSE run pdv again{} FI;{} cursor off;{} regenerate menuscreen;{} IF is error{} THEN zeige fehler;{} clear error{} FI;{} enable stop.{} bildschirm vorbereiten:{} cursor (17, 2); out (waagerecht);{} cursor (38, 2); out (waagerecht);{} cursor ( 1, 3); out (""4"");{} menufootnote ("Programmabbruch: <ESC><h>");{} cursor (1,3).{} zeige fehler:{} out (""7"");{} IF errormessage = "'run again' nicht moeglich"{} THEN menuinfo (" "15"Eine Wiederholung ist nicht moeglich! "14""){} - ELIF pos (errormessage, "'halt' vom Terminal") > 0{} THEN menuinfo (" "15"'halt' vom Terminal "14""){} ELIF pos (errormessage, "Programm-Abbruch durch <ESC><h>") > 0{} THEN menuinfo (" "15"Programm-Abbruch durch <ESC><h> "14""){} ELSE menuinfo (" " + invers ("FEHLER: "{} + subtext (errormessage, 1, 61))){} FI.{}END PROC pdv programm wiederholen;{}PROC meckere zu langen namen an:{} menuinfo (" " + invers ("Hier dürfen Namen höchstens "{} + text (max namenslaenge){} - + " Zeichen lang sein!")){}END PROC meckere zu langen namen an;{}PROC meckere existierendes programm an:{} menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")){}END PROC meckere existierendes programm an;{}PROC noch kein programm:{} menuinfo (" " + invers ("Es existiert noch kein Programm!")){}END PROC noch kein programm;{}PROC menu bildschirm:{} cursor (1, 2);{} out (5 * waagerecht);{} cursor (1, 3);{} out (""4"");{} cursor (1,23);{} out (79 * waagerecht);{} - refresh submenu{}END PROC menu bildschirm{}END PACKET ls prozess 4{} + pdv befehlsuebersicht anzeigen, + pdv ausgabebefehle anzeigen, + pdv eingabebefehle anzeigen, + pdv testbefehle anzeigen, + pdv weitere befehle anzeigen, + pdv bitmuster erlaeutern, + pdv symbole erlaeutern, + pdv digital analog werte, + pdv programm neu erstellen, + pdv programm ansehen, + pdv programm starten, + pdv programm wiederholen, + pdv dateien verzeichnis, + + pdv datei kopieren, + pdv datei umbenennen, + pdv dateien loeschen, + pdv dateien drucken, + init pdv, + pdv: +LET menukarte = "ls-MENUKARTE:Prozess", + niltext = "", + maxlaenge = 45, + maxnamenslaenge = 35; +WINDOW VAR w :: window (1, 3, 79, 19); +TEXT VAR programmname :: ""; +BOOL VAR noch kein programm gelaufen :: TRUE; +PROC pdv: + init pdv; + install menu (menukarte, FALSE); + + handle menu ("PDV") +END PROC pdv; +PROC init pdv: + programmname := ""; + noch kein programm gelaufen := TRUE; + cursor off; +END PROC init pdv; +PROC pdv befehlsuebersicht anzeigen: + menuinfo (anwendungstext (20)) +END PROC pdv befehlsuebersicht anzeigen; +PROC pdv ausgabebefehle anzeigen: + INT VAR i; + REP + i := menualternative (anwendungstext (1), anwendungstext (3), + anwendungstext (4), 5, TRUE); + SELECT i OF + CASE 1, 101: menuinfo (anwendungstext (21)) + + CASE 2, 102: menuinfo (anwendungstext (22)) + CASE 3, 103: menuinfo (anwendungstext (23)) + CASE 4, 104: menuinfo (anwendungstext (24)) + CASE 5, 105: menuinfo (anwendungstext (25)) + END SELECT + UNTIL i = 6 OR i = 106 PER; +END PROC pdv ausgabebefehle anzeigen; +PROC pdv eingabebefehle anzeigen: + INT VAR i; + REP + i := menualternative (anwendungstext (2), anwendungstext (3), + anwendungstext (4), 5, TRUE); + SELECT i OF + CASE 1, 101: menuinfo (anwendungstext (31)) + + CASE 2, 102: menuinfo (anwendungstext (32)) + CASE 3, 103: menuinfo (anwendungstext (33)) + CASE 4, 104: menuinfo (anwendungstext (34)) + CASE 5, 105: menuinfo (anwendungstext (35)) + END SELECT + UNTIL i = 6 OR i = 106 PER; +END PROC pdv eingabebefehle anzeigen; +PROC pdv testbefehle anzeigen: + INT VAR i; + REP + i := menualternative (anwendungstext (5), anwendungstext (7), + anwendungstext (8), 5, TRUE); + SELECT i OF + CASE 1, 101: menuinfo (anwendungstext (41)) + + CASE 2, 102: menuinfo (anwendungstext (42)) + END SELECT + UNTIL i = 3 OR i = 103 PER; +END PROC pdv testbefehle anzeigen; +PROC pdv weitere befehle anzeigen: + INT VAR i; + REP + i := menualternative (anwendungstext (6), anwendungstext (7), + anwendungstext (8), 5, TRUE); + SELECT i OF + CASE 1, 101: menuinfo (anwendungstext (43)) + CASE 2, 102: menuinfo (anwendungstext (44)) + END SELECT + UNTIL i = 3 OR i = 103 PER; +END PROC pdv weitere befehle anzeigen; + +PROC pdv bitmuster erlaeutern: + menuinfo (anwendungstext (46)) +END PROC pdv bitmuster erlaeutern; +PROC pdv symbole erlaeutern: + menuinfo (anwendungstext (47)) +END PROC pdv symbole erlaeutern; +PROC pdv digital analog werte: + menuinfo (anwendungstext (48)) +END PROC pdv digital analog werte; +PROC pdvdateien verzeichnis: + disable stop; + forget ("Verzeichnis der Dateien", quiet); + THESAURUS VAR programme :: ALL myself; + FILE VAR f :: + sequential file (output, "Verzeichnis der Dateien"); + + f FILLBY programme; + modify (f); + to line (f, 1); insert record (f); + menufootnote ("Verlassen: <ESC> <q>"); + cursor on; + show (w, f); + cursor off; + forget ("Verzeichnis der Dateien", quiet); + IF is error + THEN regenerate menuscreen; + out (""7""); + menuinfo (" " + invers ("FEHLER: " + errormessage)); + clear error + ELSE menu bildschirm + FI; + enable stop +END PROC pdvdateien verzeichnis; +PROC pdvprogramm neu erstellen: + hole programmname; + + kontrolliere den programmnamen; + command dialogue (FALSE); + cursor on; + disable stop; + stdinfoedit (programmname, 3); + cursor off; + command dialogue (TRUE); + IF is error + THEN regenerate menuscreen; + out (""7""); + menuinfo (" " + invers (errormessage)); + clear error + ELSE menu bildschirm + FI; + enable stop. + hole programmname: + programmname := ""; + programmname := menuanswer (ausgabe, programmname, 5). + ausgabe: + center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13"" + + + " Bitte den Namen für das Programm "13""13"". + kontrolliere den programmnamen: + IF programmname = niltext + THEN LEAVE pdvprogramm neu erstellen + ELIF length (programmname) > maxnamenslaenge + THEN meckere zu langen namen an; + programmname := niltext; + LEAVE pdvprogramm neu erstellen + ELIF exists (programmname) + THEN meckere existierendes programm an; + LEAVE pdvprogramm neu erstellen + FI. +END PROC pdvprogramm neu erstellen; + +PROC pdvprogramm ansehen: + IF programmname <> niltext CAND exists (programmname) + THEN frage nach diesem programm + ELSE lasse programm auswaehlen + FI; + cursor on; + disable stop; + stdinfoedit (programmname, 3); + cursor off; + IF is error + THEN regenerate menuscreen; + out (""7""); + menuinfo (" " + invers ("FEHLER: " + errormessage)); + clear error + ELSE menu bildschirm + FI; + enable stop. + frage nach diesem programm: + IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name + + + " Soll mit diesem Programm gearbeitet werden", 5) + THEN lasse programm auswaehlen + FI. + ueberschrift: + center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"". + name: + ""13""13" " + invers (programmname) + ""13""13"". + lasse programm auswaehlen: + THESAURUS VAR verfuegbare :: ALL myself; + IF NOT not empty (verfuegbare) + THEN noch kein programm; + LEAVE pdvprogramm ansehen + ELSE biete auswahl an + FI. + biete auswahl an: + + programmname := menuone (verfuegbare, "Programm ansehen/ändern", + "Bitte das gewünschte Programm ankreuzen!", + FALSE); + IF programmname = niltext + THEN menu bildschirm; + LEAVE pdvprogramm ansehen + FI. +END PROC pdvprogramm ansehen; +PROC pdvdateien drucken: + lasse programme auswaehlen; + drucke programme; + menu bildschirm. + lasse programme auswaehlen: + THESAURUS VAR verfuegbare :: ALL myself; + IF NOT not empty (verfuegbare) + + THEN noch kein programm; + LEAVE pdvdateien drucken + ELSE biete auswahl an + FI. + biete auswahl an: + verfuegbare := menusome (verfuegbare, "Dateien drucken", + "Bitte die Dateien ankreuzen, die gedruckt werden sollen!", + FALSE). + drucke programme: + show menuwindow; + steige ggf bei leerem thesaurus aus; + menuwindowout (menuwindowcenter (invers ("Dateien drucken"))); + menuwindowline (2); + command dialogue (FALSE); + + fuehre einzelne operationen aus; + command dialogue (TRUE); + schlage ggf neue seite auf; + menuwindowout (" Alle ausgewählten Dateien wurden gedruckt!"); + 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) + + """ wird gedruckt!"); + menuwindowline; + + print (name (verfuegbare, k)); + fehlerbehandlung + FI + PER. + steige ggf bei leerem thesaurus aus: + IF NOT not empty (verfuegbare) + THEN menuwindowline (2); + menuwindowout (" Es wurde keine Datei ausgewählt!"); + menuwindowstop; + menu bildschirm; + LEAVE pdvdateien 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; out (""7""); + menuinfo (" " + invers (errormessage)); + clear error; enable stop; + LEAVE pdvdateien drucken + ELSE enable stop + FI. +END PROC pdvdateien drucken; +PROC pdvdatei kopieren: + ermittle alten programmnamen; + erfrage neuen programmnamen; + kopiere ggf das programm. + ermittle alten programmnamen: + IF NOT not empty (ALL myself) + THEN noch kein programm; + + LEAVE pdvdatei kopieren + ELSE biete auswahl an + FI. + biete auswahl an: + TEXT VAR alter name := menuone (ALL myself, "Datei kopieren", + "Bitte die Datei ankreuzen, das kopiert werden soll!",FALSE); + menu bildschirm; + IF alter name = niltext + THEN LEAVE pdvdatei kopieren + FI. + erfrage neuen programmnamen: + TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5). + ausgabe: + ueberschrift + " Name der 'alten' Datei: " + bisheriger name + + + " Bitte den Namen für die Kopie: ". + ueberschrift: + center (maxlaenge, invers ("Datei kopieren")) + ""13""13"". + bisheriger name: + ""13""13" " + invers (alter name) + ""13""13"". + kopiere ggf das programm: + IF neuer name = niltext + THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!")); + LEAVE pdvdatei kopieren + ELIF exists (neuer name) + THEN mache vorwurf; + LEAVE pdvdatei kopieren + ELSE copy (alter name, neuer name) + + FI. + mache vorwurf: + menuinfo (" " + invers ("Eine Datei mit diesem Namen gibt es bereits!")). +END PROC pdvdatei kopieren; +PROC pdvdatei umbenennen: + ermittle alten programmnamen; + erfrage neuen programmnamen; + benenne ggf das programm um. + ermittle alten programmnamen: + IF NOT not empty (ALL myself) + THEN noch kein programm; + LEAVE pdvdatei umbenennen + ELSE biete auswahl an + FI. + biete auswahl an: + TEXT VAR alter name := menuone ( ALL myself, "Datei umbenennen", + + "Bitte die Datei ankreuzen, die umbenannt werden soll!", FALSE); + menu bildschirm; + IF alter name = niltext + THEN LEAVE pdvdatei umbenennen + FI. + erfrage neuen programmnamen: + TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5). + ausgabe: + ueberschrift + " Bisheriger Dateiname: " + bisheriger name + + " Zukünftiger Dateiname: ". + ueberschrift: + center (maxlaenge, invers ("Datei umbenennen")) + ""13""13"". + bisheriger name: + + ""13""13" " + invers (alter name) + ""13""13"". + benenne ggf das programm um: + IF neuer name = niltext + THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!")); + LEAVE pdvdatei umbenennen + ELIF exists (neuer name) + THEN mache vorwurf; + LEAVE pdvdatei umbenennen + ELSE rename (alter name, neuer name); + programmname := neuer name + FI. + mache vorwurf: + menuinfo (" " + invers ("Eine Datei mit diesem Namen gibt es bereits!")). + +END PROC pdvdatei umbenennen; +PROC pdvdateien loeschen: + lasse programme auswaehlen; + loesche programme; + menu bildschirm. + lasse programme auswaehlen: + THESAURUS VAR verfuegbare :: ALL myself; + IF NOT not empty (verfuegbare) + THEN noch kein programm; + LEAVE pdvdateien loeschen + ELSE biete auswahl an + FI. + biete auswahl an: + verfuegbare := menusome (verfuegbare, "Dateien löschen", + "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE). + + loesche programme: + show menuwindow; + steige ggf bei leerem thesaurus aus; + menuwindowout (menuwindowcenter (invers ("Dateien löschen"))); + menuwindowline (2); + command dialogue (FALSE); + fuehre einzelne operationen aus; + command dialogue (TRUE); + schlage ggf neue seite auf; + menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!"); + 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) + """ löschen") + 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 (" Es wurde keine Datei ausgewählt!"); + menuwindowstop; + + menu bildschirm; + LEAVE pdvdateien 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; out (""7""); + menuinfo (" " + invers (errormessage)); + clear error; enable stop; + LEAVE pdvdateien loeschen + ELSE enable stop + FI. +END PROC pdvdateien loeschen; + +PROC pdvprogramm starten: + programmname ermitteln; + bildschirm vorbereiten; + cursor on; + disable stop; + warnings off; + check on; + run pdv (programmname); + noch kein programm gelaufen := FALSE; + cursor off; + IF is error + THEN fehler ggf melden; + clear error + ELSE regenerate menuscreen + FI; + enable stop. + bildschirm vorbereiten: + cursor (17, 2); out (waagerecht); + cursor (38, 2); out (waagerecht); + cursor ( 1, 3); out (""4""); + menufootnote ("Programmabbruch: <ESC><h>"); + + cursor (1, 5); + out ("Das Programm wird übersetzt. Zeilen-Nr.: "). + fehler ggf melden: + IF errormessage <> "" + THEN fehler melden + FI. + fehler melden: + IF pos (errormessage, "'halt' vom Terminal") > 0 + THEN regenerate menuscreen; + out (""7""); menuinfo (" "15"'halt' vom Terminal "14"") + ELIF pos (errormessage, "Programm-Abbruch durch <ESC><h>") > 0 + THEN regenerate menuscreen; + out (""7""); menuinfo (" "15"Programm-Abbruch durch <ESC><h> "14"") + + ELIF pos (errormessage, "(bei Zeile") > 0 AND exists (programmname) + THEN programm mit fehler im notebook zeigen; + regenerate menuscreen + ELSE regenerate menuscreen; + out (""7""); menuinfo (" " + invers ("FEHLER: " + + subtext (errormessage, 1, 61))) + FI. + programm mit fehler im notebook zeigen: + noteline; + note ("FEHLER: " + errormessage); + INT VAR n; FOR n FROM 1 UPTO 9 REP noteline PER; + note (""15"Verlassen: <ESC><q> "14""); + + FILE VAR p :: sequential file (modify, programmname); + to line (p, max (1, fehlerzeile)); + col (1); + clear error; + out (""7""); + cursor on; + noteedit (p); + cursor off. + fehlerzeile: + int (subtext (errormessage, zahlposition)). + zahlposition: pos (errormessage, "(bei Zeile") + 10. + 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 + " Zuletzt bearbeitetes Programm: " + + name + " Soll mit diesem Programm gearbeitet werden", 5) + THEN lasse programm auswaehlen + FI. + ueberschrift: + center (maxlaenge, invers ("Programm starten")) + ""13""13"". + name: + ""13""13" " + invers (programmname) + ""13""13"". + lasse programm auswaehlen: + THESAURUS VAR verfuegbare :: ALL myself; + IF NOT not empty (verfuegbare) + THEN noch kein programm; + LEAVE pdvprogramm starten + + ELSE biete auswahl an + FI. + biete auswahl an: + programmname := menuone (verfuegbare, "Programm starten", + "Bitte das gewünschte Programm ankreuzen!", FALSE); + IF programmname = niltext + THEN menubildschirm; + LEAVE pdv programm starten + FI. +END PROC pdvprogramm starten; +PROC pdv programm wiederholen: + bildschirm vorbereiten; + cursor on; + disable stop; + IF noch kein programm gelaufen + THEN errorstop ("Eine Wiederholung ist nicht moeglich!") + + ELSE run pdv again + FI; + cursor off; + regenerate menuscreen; + IF is error + THEN zeige fehler; + clear error + FI; + enable stop. + bildschirm vorbereiten: + cursor (17, 2); out (waagerecht); + cursor (38, 2); out (waagerecht); + cursor ( 1, 3); out (""4""); + menufootnote ("Programmabbruch: <ESC><h>"); + cursor (1,3). + zeige fehler: + out (""7""); + IF errormessage = "'run again' nicht moeglich" + THEN menuinfo (" "15"Eine Wiederholung ist nicht moeglich! "14"") + + ELIF pos (errormessage, "'halt' vom Terminal") > 0 + THEN menuinfo (" "15"'halt' vom Terminal "14"") + ELIF pos (errormessage, "Programm-Abbruch durch <ESC><h>") > 0 + THEN menuinfo (" "15"Programm-Abbruch durch <ESC><h> "14"") + ELSE menuinfo (" " + invers ("FEHLER: " + + subtext (errormessage, 1, 61))) + FI. +END PROC pdv programm wiederholen; +PROC meckere zu langen namen an: + menuinfo (" " + invers ("Hier dürfen Namen höchstens " + + text (max namenslaenge) + + + " Zeichen lang sein!")) +END PROC meckere zu langen namen an; +PROC meckere existierendes programm an: + menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")) +END PROC meckere existierendes programm an; +PROC noch kein programm: + menuinfo (" " + invers ("Es existiert noch kein Programm!")) +END PROC noch kein programm; +PROC menu bildschirm: + cursor (1, 2); + out (5 * waagerecht); + cursor (1, 3); + out (""4""); + cursor (1,23); + out (79 * waagerecht); + + refresh submenu +END PROC menu bildschirm +END PACKET ls prozess 4 + diff --git a/prozess/ls-Prozess 5 b/prozess/ls-Prozess 5 index 66bdf94..a9b5028 100644 --- a/prozess/ls-Prozess 5 +++ b/prozess/ls-Prozess 5 @@ -22,63 +22,808 @@ *) PACKET ls prozess 5 DEFINES - pdv konfiguration zugelassen,{} pdv konfiguration evtl aktivieren,{} pdv konfiguration zeigen,{} pdv kanal konfigurieren,{} pdv interfaceausgabe testen,{} pdv interfaceeingabe testen:{}LET max steckplaetze = 4,{} max portanzahl = 4,{} anzahl kartensorten = 5,{} betriebsart = 1,{} keine karte = 1,{} ea karte = 2,{} kombi = 3,{} da karte = 4,{} ad karte = 5,{} - compact = 6,{} einzel = 7,{} mehrfach = 8;{}LET testfenster x = 11,{} testfenster y = 5,{} testfenster xsize = 59,{} testfenster ysize = 15;{}WINDOW VAR testfenster :: window (testfenster x, testfenster y,{} testfenster xsize, testfenster ysize);{}INT VAR steckplatzart :: 0;{}BOOL VAR mit konfigurationsmoeglichkeit :: TRUE;{}TASK VAR konfigurationsmanager :: niltask;{} -ROW max steckplaetze INT VAR kartenart :: ROW max steckplaetze INT :{} (keine karte, keine karte,{} keine karte, keine karte);{}LET SPANNUNG = ROW 2 REAL,{} PORT = ROW 3 INT,{} KARTE = ROW max portanzahl PORT;{}ROW anzahl kartensorten KARTE CONST karte :: ROW anzahl kartensorten KARTE :{}(* ---------------------------------------------------------------------- *){}( KARTE : ({}(* ---------------------------------------------------------------------- *){} -(* *) PORT : (nicht belegt, 0, 0), (* Port 1 *){}(* leere *) PORT : (nicht belegt, 0, 0), (* Port 2 *){}(* Karte *) PORT : (nicht belegt, 0, 0), (* Port 3 *){}(* *) PORT : (nicht belegt, 0, 0)), (* Port 4 *){}(*----------------------------------------------------------------------- *){} KARTE : ({}(* ---------------------------------------------------------------------- *){}(* *) PORT : (digital ein, 1, 3), (* Port 1 *){} -(* E/A *) PORT : (digital aus, 1, 1), (* Port 2 *){}(* Karte *) PORT : (digital ein, 1, 3), (* Port 3 *){}(* *) PORT : (digital aus, 1, 1)), (* Port 4 *){}(*----------------------------------------------------------------------- *){} KARTE : ({}(* ---------------------------------------------------------------------- *){}(* *) PORT : (analog ein, 2, 2), (* Port 1 *){}(* Kombi *) PORT : (analog ein, 3, 2), (* Port 2 *){} -(* Karte *) PORT : (digital ein, 1, 3), (* Port 3 *){}(* *) PORT : (digital aus, 1, 1 )), (* Port 4 *){}(*----------------------------------------------------------------------- *){} KARTE : ({}(* ---------------------------------------------------------------------- *){}(* *) PORT : (analog aus, 1, 1), (* Port 1 *){}(* D/A *) PORT : (analog aus, 1, 3), (* Port 2 *){}(* Wandler *) PORT : (nicht belegt, 0, 0), (* Port 3 *){} -(* *) PORT : (nicht belegt, 0, 0)), (* Port 4 *){}(*----------------------------------------------------------------------- *){} KARTE : ({}(* ---------------------------------------------------------------------- *){}(* *) PORT : (analog ein, 1, 1), (* Port 1 *){}(* A/D *) PORT : (analog ein, 1, 3), (* Port 2 *){}(* Wandler *) PORT : (nicht belegt, 0, 0), (* Port 3 *){}(* *) PORT : (nicht belegt, 0, 0)) (* Port 4 *){} -(*----------------------------------------------------------------------- *){} );{}PROC pdv konfiguration zugelassen (BOOL CONST wahrheitswert):{} teste berechtigung;{} mit konfigurationsmoeglichkeit := wahrheitswert;{} IF mit konfigurationsmoeglichkeit{} THEN konfigurationsmanager := niltask{} ELSE konfigurationsmanager := myself{} FI.{} teste berechtigung:{} enable stop;{} IF NOT (konfigurationsmanager = niltask OR{} - konfigurationsmanager = myself){} THEN errorstop ("Befehl ist nur in Task '" +{} name (konfigurationsmanager) + "' zugelassen!"){} FI.{}END PROC pdv konfiguration zugelassen;{}PROC pdv konfiguration evtl aktivieren:{} IF mit konfigurationsmoeglichkeit{} THEN activate (3){} ELSE deactivate (3){} FI{}END PROC pdv konfiguration evtl aktivieren;{}PROC pdv kanal konfigurieren:{} TEXT CONST info :: " "15"Auswahl der Steckplatzart "14" "13""13""{} - + " c Compactbox "13""{} + " e Einzelsteckplatz "13""{} + " m Mehrfachsteckplatz ",{} liste :: "Compact"13"Einzel"13"Mehrfach",{} tasten :: "cemCEM";{} INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE);{} SELECT auswahl OF{} CASE 1, 101, 104 : trage compactbox ein;{} zeige kanalbelegung (0){} CASE 2, 102, 105 : trage einzelplatzbelegung ein;{} - zeige kanalbelegung (0){} CASE 3, 103, 106 : bearbeite die steckplaetze einzeln{} END SELECT;{} beende kanaldaten eintragen.{} trage compactbox ein:{} steckplatzart := compact;{} trage steckplatzbelegung ein (1, kombi);{} trage steckplatzbelegung ein (2, keine karte);{} trage steckplatzbelegung ein (3, keine karte);{} trage steckplatzbelegung ein (4, keine karte).{} trage einzelplatzbelegung ein:{} steckplatzart := einzel;{} trage steckplatzbelegung ein (1, ermittelte kartenart (0));{} - trage steckplatzbelegung ein (2, keine karte);{} trage steckplatzbelegung ein (3, keine karte);{} trage steckplatzbelegung ein (4, keine karte).{} bearbeite die steckplaetze einzeln:{} INT VAR platz;{} steckplatzart := mehrfach;{} FOR platz FROM 1 UPTO max steckplaetze REP{} trage steckplatzbelegung ein (platz, ermittelte kartenart (platz));{} zeige kanalbelegung (platz * 10){} PER.{}END PROC pdv kanal konfigurieren;{}PROC pdv konfiguration zeigen:{} SELECT steckplatzart OF{} - CASE compact : zeige kanalbelegung (0){} CASE einzel : zeige kanalbelegung (0){} CASE mehrfach : zeige belegung einzelner steckplaetze{} OTHERWISE noch nicht konfiguriert{} END SELECT.{} noch nicht konfiguriert:{} menuinfo (" "15"Warnung: "14" "13""13""13""{} + " Das Interface wurde noch nicht konfiguriert! "13""13""{} + " In diesem Zustand sind weder Eingaben noch "13""{} + " Ausgaben über das Interface möglich. "13"").{} - zeige belegung einzelner steckplaetze:{} TEXT CONST info ::{} " "15"Eingestellt: Mehrfachsteckplatz "14" "13""13""{} + " 1 Info Steckplatz 1 "13""{} + " 2 Info Steckplatz 2 "13""{} + " 3 Info Steckplatz 3 "13""{} + " 4 Info Steckplatz 4 "13""13""{} + " z Zurück ins Hauptmenü ",{} liste :: "1"13"2"13"3"13"4"13"z",{} - tasten :: "1234zZ";{} INT VAR auswahl;{} REP auswahl := menualternative (info, liste, tasten, 5, FALSE);{} SELECT auswahl OF{} CASE 1, 101 : zeige kanalbelegung (10){} CASE 2, 102 : zeige kanalbelegung (20){} CASE 3, 103 : zeige kanalbelegung (30){} CASE 4, 104 : zeige kanalbelegung (40){} END SELECT{} UNTIL (auswahl = 5) OR (auswahl > 104) PER{}END PROC pdv konfiguration zeigen;{}PROC pdv interfaceausgabe testen:{} gestalte testfenster ("Ausgabetest");{} - disable stop;{} teste interface;{} IF NOT is error{} THEN teste interface ausgabe{} FI;{} IF is error{} THEN fehlerbehandlung{} ELSE schliesse interface;{} enable stop;{} beseitige testfenster;{} refresh submenu{} FI.{} fehlerbehandlung:{} TEXT VAR meldung :: errormessage;{} clear error;{} schalte alles aus;{} schliesse interface;{} enable stop;{} cursor off;{} regenerate menuscreen;{} menuinfo (" " + invers (meldung)).{}END PROC pdv interfaceausgabe testen;{} -PROC pdv interfaceeingabe testen:{} gestalte testfenster ("Eingabetest");{} disable stop;{} teste interface;{} IF NOT is error{} THEN teste interface eingabe{} FI;{} IF is error{} THEN fehlerbehandlung{} ELSE schliesse interface;{} enable stop;{} beseitige testfenster;{} refresh submenu{} FI.{} fehlerbehandlung:{} TEXT VAR meldung :: errormessage;{} clear error;{} schalte alles aus;{} schliesse interface;{} enable stop;{} cursor off;{} - regenerate menuscreen;{} menuinfo (" " + invers (meldung)).{}END PROC pdv interfaceeingabe testen;{}PROC beseitige testfenster:{} INT VAR z;{} FOR z FROM testfenster y + testfenster ysize DOWNTO testfenster y - 1 REP{} cursor (testfenster x - 1, z);{} out (""5""){} PER{}END PROC beseitige testfenster;{}PROC gestalte testfenster (TEXT CONST funktionsart):{} show (testfenster);{} cursor (testfenster x - 1, testfenster y + testfenster ysize - 2);{} out (balken links + (testfenster xsize * waagerecht) + balken rechts);{} - cursor (testfenster, 1, 2);{} out (testfenster, center (testfenster, invers (funktionsart))){}END PROC gestalte testfenster;{}PROC testfensterfussnote (TEXT CONST meldung):{} cursor (testfenster, 2, testfenster ysize);{} out (testfenster, meldung){}END PROC testfensterfussnote;{}PROC teste interfaceausgabe:{} INT VAR kanalnummer, steckplatz, port;{} TEXT VAR nummer :: "";{} enable stop;{} REP hole kanalnummer;{} teste ausgabe an kanal{} PER.{} hole kanalnummer:{} SELECT steckplatzart OF{} - CASE compact : kanalnummer := 4; steckplatz := 1; port := 4{} CASE einzel : kanalnummer muss evtl erfragt werden{} CASE mehrfach : kanalnummer muss erfragt werden{} OTHERWISE errorstop ("Interface ist noch nicht konfiguriert!"){} END SELECT;{} cursor (testfenster, 2, 5);{} out (testfenster, "Ausgabe an Kanal " + text (kanalnummer) + klammer +{} kanalbeschreibung (steckplatz, port));{} IF steckplatzart = mehrfach{} THEN cursor (testfenster, 25, 6);{} - out (testfenster, "in Steckplatz " + text (steckplatz)){} FI;{} out (testfenster, ")").{} klammer:{} IF kanalnummer < 10{} THEN " (= "{} ELSE " (= "{} FI.{} kanalnummer muss evtl erfragt werden:{} SELECT kartenart [1] OF{} CASE kombi : kanalnummer := 4; steckplatz := 1; port := 4{} CASE eakarte : kanalnummer := 2; steckplatz := 1; port := 2{} CASE dakarte : frage nach kanalnummer auf da karte;{} steckplatz := 1; port := kanalnummer{} - OTHERWISE errorstop ("Keine Ausgabe an " + kartenname + " möglich!"){} END SELECT.{} kartenname:{} IF kartenart [1] = ad karte{} THEN "A/D-Karte"{} ELSE "leeren Steckplatz"{} FI.{} frage nach kanalnummer auf da karte:{} menufootnote ("Zurück zum Hauptmenü: <ESC><q>");{} testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{} cursor (testfenster, 2, 5);{} out (testfenster, "Ausgabe - Kanal (1 oder 2): ");{} cursor on;{} REP inchar (nummer){} UNTIL (pos ("12", nummer) > 0) OR esc q gedrueckt PER;{} - cursor off;{} IF nummer = ""27""{} THEN LEAVE teste interface ausgabe{} ELSE kanalnummer := int (nummer){} FI.{} esc q gedrueckt:{} (nummer = ""27"") AND (incharety (20) = "q").{} kanalnummer muss erfragt werden:{} TEXT VAR exit char;{} menufootnote ("Zurück zum Hauptmenü: <ESC><q>");{} testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{} cursor (testfenster, 2, 5);{} out (testfenster, "Ausgabe - Kanal:");{} cursor on;{} REP cursor (testfenster, 19, 5);{} - editget (testfenster, nummer, 4, 4, "", "q", exit char){} UNTIL (exit char = ""27"q") OR ausgabekanal eingegeben PER;{} cursor off;{} IF exit char = ""27"q"{} THEN LEAVE teste interface ausgabe{} FI.{} ausgabekanal eingegeben:{} kanalnummer := abs (int (nummer));{} steckplatz := kanalnummer DIV 10;{} port := kanalnummer MOD 10;{} IF steckplatz = 0 THEN steckplatz := 1 FI;{} cursor (testfenster, 2, 7);{} IF (kanalnummer < 1) OR (kanalnummer > 49){} - THEN out (testfenster, "Unzulässige Kanalnummer! "); FALSE{} ELIF (port = 0) OR (port > max portanzahl) OR kein ausgabeport{} THEN out (testfenster, "Dies ist kein Ausgabe-Kanal! "); FALSE{} ELSE out (testfenster, " "); TRUE{} FI.{} kein ausgabeport:{} (port betriebsart <> digital aus) AND (port betriebsart <> analog aus).{} port betriebsart: karte [sorte][port][betriebsart].{} sorte : kartenart [steckplatz].{} - teste ausgabe an kanal:{} TEXT VAR wert;{} cursor (testfenster, 1, 8);{} out (testfenster, testfenster xsize * "-");{} cursor (testfenster, 2, 11);{} out (testfenster, "Ausgabewert: ");{} testfenster fussnote ("Bitte einen Wert zwischen 0 und 255 eingeben!");{} menufootnote ("'Werte ausgeben' beenden: <ESC><q>");{} cursor on;{} REP cursor (testfenster, 15, 11);{} wert := "0";{} editget (testfenster, wert, 4, 4, "", "qh", exit char);{} IF exit char = return{} - THEN ausgeben (kanalnummer, int (wert) MOD ganzzahlobergrenze){} ELIF exit char = ""27"h"{} THEN errorstop ("Programm-Abbruch durch <ESC><h>!"){} FI{} UNTIL exitchar = ""27"q" PER;{} cursor off;{} IF (steckplatzart = mehrfach) OR (kartenart [1] = da karte){} THEN cursor (testfenster, 1, 5);{} out (testfenster, (2 * testfenster xsize) * " ");{} cursor (testfenster, 2, 11);{} out (testfenster, " ");{} - testfenster fussnote ((testfenster xsize - 2) * " "){} ELSE LEAVE teste interfaceausgabe{} FI.{} return: ""13"".{}END PROC teste interfaceausgabe;{}PROC teste interfaceeingabe:{} INT VAR kanalnummer, steckplatz, port;{} TEXT VAR nummer :: "";{} enable stop;{} REP hole kanalnummer;{} teste eingabe vom kanal{} PER.{} hole kanalnummer:{} IF steckplatzart = 0{} THEN errorstop ("Interface ist noch nicht konfiguriert!"){} ELSE kanalnummer erfragen{} - FI;{} cursor (testfenster, 2, 5);{} out (testfenster, "Eingabe von Kanal " + text (kanalnummer) + klammer +{} kanalbeschreibung (steckplatz, port));{} IF steckplatzart = mehrfach{} THEN cursor (testfenster, 26, 6);{} out (testfenster, "in Steckplatz " + text (steckplatz)){} FI;{} out (testfenster, ")").{} klammer:{} IF kanalnummer < 10{} THEN " (= "{} ELSE " (= "{} FI.{} kanalnummer erfragen:{} SELECT steckplatzart OF{} - CASE compact : drei kanaele anbieten;{} steckplatz := 1; port := kanalnummer{} CASE einzel : zwei oder drei kanaele anbieten;{} steckplatz := 1; port := kanalnummer{} CASE mehrfach : alle kanaele moeglich{} END SELECT.{} drei kanaele anbieten:{} menufootnote ("Zurück zum Hauptmenü: <ESC><q>");{} testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{} cursor (testfenster, 2, 5);{} out (testfenster, "Eingabe - Kanal (1, 2 oder 3): ");{} - cursor on;{} REP inchar (nummer){} UNTIL (pos ("123", nummer) > 0) OR esc q gedrueckt PER;{} cursor off;{} IF nummer = ""27""{} THEN LEAVE teste interface eingabe{} ELSE kanalnummer := int (nummer){} FI.{} esc q gedrueckt:{} (nummer = ""27"") AND (incharety (20) = "q").{} zwei oder drei kanaele anbieten:{} SELECT kartenart [1] OF{} CASE kombi : drei kanaele anbieten{} CASE ad karte : zwei kanaele anbieten{} CASE ea karte : kanalnummer := 1{} - OTHERWISE errorstop ("Eingabe bei " + kartenname + " nicht möglich!"){} END SELECT.{} kartenname:{} IF kartenart [1] = da karte{} THEN "D/A-Karte"{} ELSE "leerem Steckplatz"{} FI.{} zwei kanaele anbieten:{} menufootnote ("Zurück zum Hauptmenü: <ESC><q>");{} testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{} cursor (testfenster, 2, 5);{} out (testfenster, "Eingabe - Kanal (1 oder 2): ");{} cursor on;{} REP inchar (nummer){} UNTIL (pos ("12", nummer) > 0) OR esc q gedrueckt PER;{} - cursor off;{} IF nummer = ""27""{} THEN LEAVE teste interface eingabe{} ELSE kanalnummer := int (nummer){} FI.{} alle kanaele moeglich:{} TEXT VAR exit char;{} menufootnote ("Zurück zum Hauptmenü: <ESC><q>");{} testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{} cursor (testfenster, 2, 5);{} out (testfenster, "Eingabe - Kanal:");{} cursor on;{} REP cursor (testfenster, 19, 5);{} editget (testfenster, nummer, 4, 4, "", "q", exit char){} UNTIL (exit char = ""27"q") OR eingabekanal eingegeben PER;{} - cursor off;{} IF exit char = ""27"q"{} THEN LEAVE teste interface eingabe{} FI.{} eingabekanal eingegeben:{} kanalnummer := abs (int (nummer));{} steckplatz := kanalnummer DIV 10;{} port := kanalnummer MOD 10;{} IF steckplatz = 0 THEN steckplatz := 1 FI;{} cursor (testfenster, 2, 7);{} IF (kanalnummer < 1) OR (kanalnummer > 49){} THEN out (testfenster, "Unzulässige Kanalnummer! "); FALSE{} ELIF (port = 0) OR (port > max portanzahl) OR kein eingabeport{} - THEN out (testfenster, "Dies ist kein Eingabe-Kanal! "); FALSE{} ELSE out (testfenster, " "); TRUE{} FI.{} kein eingabeport:{} (port betriebsart <> digital ein) AND (port betriebsart <> analog ein).{} port betriebsart: karte [sorte][port][betriebsart].{} sorte : kartenart [steckplatz].{} teste eingabe vom kanal:{} cursor (testfenster, 1, 8);{} out (testfenster, testfenster xsize * "-");{} cursor (testfenster, 2, 11);{} - out (testfenster, "Eingelesener Wert: ");{} testfenster fussnote (" ");{} menufootnote ("'Werte einlesen' beenden: <ESC><q>");{} REP cursor (testfenster, 21, 11);{} out (text (eingabe (kanalnummer), 3));{} warte (0.1){} UNTIL abbruch gewuenscht PER;{} IF (steckplatzart = einzel) AND (kartenart [1] = ea karte){} THEN LEAVE teste interfaceeingabe{} ELSE cursor (testfenster, 1, 5);{} out (testfenster, (2 * testfenster xsize) * " ");{} - cursor (testfenster, 2, 11);{} out (testfenster, " "){} FI.{}END PROC teste interfaceeingabe;{}TEXT PROC kanalbeschreibung (INT CONST steckplatz, port):{} IF steckplatzart = compact{} THEN port auf compactbox{} ELSE port auf steckkarte{} FI.{} port auf compactbox:{} portbeschreibung + " der Compact-Box".{} port auf steckkarte:{} SELECT kartenart [steckplatz] OF{} CASE kombi : portbeschreibung + " der Kombi-Karte"{} CASE ea karte : portbeschreibung + " der E/A-Karte"{} - CASE da karte : portbeschreibung + " der D/A-Karte"{} CASE ad karte : portbeschreibung + " der A/D-Karte"{} OTHERWISE ""{} END SELECT.{} portbeschreibung:{} SELECT 2 + karte [kartenart [steckplatz]][port][betriebsart] OF{} CASE 1 : "Digitalausgang"{} CASE 3 : "Digitaleingang"{} CASE 0 : "Analogausgang " + text (port){} CASE 4 : "Analogeingang " + text (port){} OTHERWISE ""{} END SELECT.{}END PROC kanalbeschreibung;{}PROC trage steckplatzbelegung ein (INT CONST steckplatz, art):{} - INT VAR port;{} kartenart [steckplatz] := art;{} klaere spannungsbereiche;{} FOR port FROM 1 UPTO max portanzahl REP{} trage kanaldaten ein (kanalnummer, spannungsbereich, portdaten);{} IF steckplatz = 1{} THEN trage kanaldaten ein (port, spannungsbereich, portdaten){} FI{} PER.{} kanalnummer: port + 10 * steckplatz.{} portdaten : karte [kartenart [steckplatz]][port].{} spannungsbereich:{} IF port = 1{} THEN bereich von e1{} ELIF port = 2{} THEN bereich von e2{} - ELSE SPANNUNG : (0.0, 0.0){} FI.{} klaere spannungsbereiche:{} SPANNUNG VAR bereich von e1, bereich von e2;{} SELECT kartenart [steckplatz] OF{} CASE kombi : spannungsbereich 0 bis 5 volt{} CASE da karte : setze spannungsbereiche{} CASE ad karte : erfrage adkarte schalterstellungen{} OTHERWISE alles auf 0 setzen{} END SELECT.{} spannungsbereich 0 bis 5 volt:{} bereich von e1 := SPANNUNG : (0.0, 5.0);{} bereich von e2 := SPANNUNG : (0.0, 5.0).{} setze spannungsbereiche:{} - bereich von e1 := SPANNUNG : (-5.0, 5.0);{} bereich von e2 := SPANNUNG : ( 0.0, 5.0).{} alles auf 0 setzen:{} bereich von e1 := SPANNUNG : (0.0, 0.0);{} bereich von e2 := SPANNUNG : (0.0, 0.0).{}erfrage adkarte schalterstellungen:{} REP{} hole schalterstellung{} UNTIL schalterstellung sinnvoll PER;{} bestimme spannungsbereiche (schalterzustand, bereich von e1, bereich von e2).{} hole schalterstellung:{} TEXT VAR schalterzustand := menuanswer (infotext, "00000000", 5).{} infotext:{} - ueberschrift{} + " Bitte die aktuelle Schalterstellung eintragen: "13""13""{} + " Es bedeutet : 1 - Schalterstellung 'on' "13""{} + " 0 - Schalterstellung 'off' "13""13""{} + " Nummer : 12345678 "13""{} + " |||||||| ".{} ueberschrift:{} IF steckplatzart = mehrfach{} THEN " "15"Angabe der Schalterstellungen auf der A/D-Karte "14""13""{} + " "15" in Steckplatz "{} + text (steckplatz) + ": "14""13""13""{} - ELSE " "15"Angabe der Schalterstellungen auf der A/D-Karte: "14""13""13""{} FI.{} schalterstellung sinnvoll:{} (length (schalterzustand) = 8) AND nur nullen und einsen.{} nur nullen und einsen:{} BOOL VAR ok := TRUE; INT VAR m;{} FOR m FROM 1 UPTO 8 REP{} IF NOT ((schalterzustand SUB m) = "1" OR (schalterzustand SUB m ) = "0"){} THEN ok := FALSE{} FI{} PER;{} ok.{}END PROC trage steckplatzbelegung ein;{}INT PROC ermittelte kartenart (INT CONST steckplatz):{} TEXT CONST info e :: " "15"Angabe der Interfacekarte: "14" "13""13""{} - + " k Kombikarte "13""{} + " e E / A - Karte "13""{} + " d D / A - Wandler - Karte "13""{} + " a A / D - Wandler - Karte "13""{} + " 0 Keine Steckkarte ",{} info m :: " "15"Angabe der Interfacekarte für Steckplatz "{} + text (steckplatz) + ": "14" "13""13""{} + " k Kombikarte "13""{} - + " e E / A - Karte "13""{} + " d D / A - Wandler - Karte "13""{} + " a A / D - Wandler - Karte "13""{} + " 0 Keine Steckkarte ",{} liste :: "Kombi"13"E/A"13"D/A"13"A/D"13"Keine",{} tasten :: "keda0KEDA";{} INT VAR auswahl := menualternative (infotext, liste, tasten, 5, FALSE);{} SELECT auswahl OF{} CASE 1, 101, 106 : kombi{} - CASE 2, 102, 107 : eakarte{} CASE 3, 103, 108 : dakarte{} CASE 4, 104, 109 : adkarte{} OTHERWISE keine karte{} END SELECT.{} infotext:{} IF steckplatz = 0{} THEN info e{} ELSE info m{} FI.{}END PROC ermittelte kartenart;{}PROC zeige kanalbelegung (INT CONST steckplatz):{} ROW 4 TEXT VAR kanalnummer;{} kanalnummer [1] := text (steckplatz + 1, 2);{} kanalnummer [2] := text (steckplatz + 2, 2);{} kanalnummer [3] := text (steckplatz + 3, 2);{} - kanalnummer [4] := text (steckplatz + 4, 2);{} IF steckplatzart = compact{} THEN zeige compactboxbelegung{} ELSE zeige steckplatz mit karte{} FI.{} zeige steckplatz mit karte:{} SELECT kartenart [steckplatznummer] OF{} CASE kombi : zeige steckplatz mit kombi{} CASE eakarte: zeige steckplatz mit eakarte{} CASE dakarte: zeige steckplatz mit dakarte{} CASE adkarte: zeige steckplatz mit adkarte{} OTHERWISE zeige steckplatz ohne karte{} END SELECT.{} - steckplatznummer:{} IF steckplatz = 0{} THEN 1{} ELSE steckplatz DIV 10{} FI.{} zeige compactboxbelegung:{} menuinfo ({} " "15"Eingestellt: Compactbox "14" "13""13""{} + " Belegung der Kanäle: "13""13""13""{} + kanalnummeranzeige kombikarte).{} zeige steckplatz mit kombi:{} menuinfo (ueberschrift + " mit Kombikarte: "14" "13""13""{} + " Belegung der Kanäle: "13""13""13""{} + kanalnummeranzeige kombikarte).{} - zeige steckplatz mit eakarte:{} menuinfo (ueberschrift + " mit E / A - Karte: "14" "13""13""{} + " Belegung der Kanäle: "13""13""13""{} + kanalnummeranzeige eakarte).{} zeige steckplatz mit dakarte:{} menuinfo (ueberschrift + " mit D / A - Karte: "14" "13""13""{} + " Belegung der Kanäle: "13""13""{} + kanalnummeranzeige dakarte).{} zeige steckplatz mit adkarte:{} hole spannungsbereiche;{} menuinfo (" " + ueberschrift + " mit A / D - Karte: "14""13""13""{} - + " Zwei analoge Eingänge stehen zur Verfügung: "13""13""{} + kanalnummeranzeige adkarte).{} hole spannungsbereiche:{} SPANNUNG VAR e1 bereich, e2 bereich;{} hole spannungsbereich (steckplatz + 1, e1 bereich [1], e1 bereich [2]);{} hole spannungsbereich (steckplatz + 2, e2 bereich [1], e2 bereich [2]).{} zeige steckplatz ohne karte:{} IF steckplatz = 0{} THEN menuinfo ({} " "15"Einzelsteckplatz ohne Steckkarte: "14" "13""13""13""{} + " Es sind weder Ein- noch Ausgaben möglich! "13""){} - ELSE menuinfo ({} " "15"Steckplatz "{} + text (steckplatz DIV 10) + " ohne Steckkarte: "14""13""13""13""{} + " Es sind hier weder Ein- noch Ausgaben möglich! "13""){} FI.{} ueberschrift:{} IF steckplatz = 0{} THEN " "15"Einzelsteckplatz"{} ELSE " "15"Steckplatz " + text (steckplatz DIV 10){} FI.{} kanalnummeranzeige kombikarte:{} " "15"Kanal " + kanalnummer [1]{} + ": "14" Analogeingang 1 (E1) "13""13""{} - + " "15"Kanal " + kanalnummer [2]{} + ": "14" Analogeingang 2 (E2) "13""13""{} + " "15"Kanal " + kanalnummer [3]{} + ": "14" Digitaleingang "13""13""{} + " "15"Kanal " + kanalnummer [4]{} + ": "14" Digitalausgang "13"".{} kanalnummeranzeige eakarte:{} " "15"Kanal " + kanalnummer [1]{} + ": "14" Digitaleingang "13""13""{} + " "15"Kanal " + kanalnummer [2]{} + ": "14" Digitalausgang "13""13""{} - + " ( "15"Kanal " + kanalnummer [3]{} + ": "14" Digitaleingang (= Kanal " + kanalnummer [1] + ") )"13""13""{} + " ( "15"Kanal " + kanalnummer [4]{} + ": "14" Digitalausgang (= Kanal " + kanalnummer [2] + ") )"13"".{} kanalnummeranzeige adkarte:{} " "15"Kanal " + kanalnummer [1]{} + ": "14" (E1) Spannungsbereich " + bereich1 + ""13""13""{} + " "15"Kanal " + kanalnummer [2]{} + ": "14" (E2) Spannungsbereich " + bereich2 + ""13"".{} - bereich1:{} IF e1 bereich [1] = 0.0{} THEN " 0.000 V - +" + text (e1 bereich [2], 6, 3) + " V "{} ELSE text (e1 bereich [1], 7, 3) + " V - +" + text (e1 bereich [2], 6, 3) + " V "{} FI.{} bereich2:{} IF e2 bereich [1] = 0.0{} THEN " 0.000 V - +" + text (e2 bereich [2], 6, 3) + " V"{} ELSE text (e2 bereich [1], 7, 3) + " V - +" + text (e2 bereich [2], 6, 3) + " V"{} FI.{} kanalnummeranzeige dakarte:{} " Die Karte stellt einen Analogausgang zur Verfügung, "13""{} - + " der auf zwei Arten angesprochen werden kann: "13""13""13""{} + " "15"Kanal " + kanalnummer [1]{} + ": "14" Spannungsbereich -5 V - +5 V "13""13""{} + " "15"Kanal " + kanalnummer [2]{} + ": "14" Spannungsbereich 0 V - +5 V "13"".{}END PROC zeige kanalbelegung;{}PROC bestimme spannungsbereiche (TEXT CONST schalterstellung,{} SPANNUNG VAR bereich von e1,{} SPANNUNG VAR bereich von e2):{} - bestimme bereich von e1;{} bestimme bereich von e2.{} bestimme bereich von e1:{} IF schalter 3 geschlossen{} THEN umax1 := 0.25{} ELIF schalter 2 geschlossen{} THEN umax1 := 2.5{} ELIF schalter 1 geschlossen{} THEN umax1 := 25.0{} ELSE umax1 := 0.0{} FI;{} IF schalter 8 geschlossen{} THEN symmetrische spannungsmessung ueber e1{} ELSE asymmetrische spannungsmessung ueber e1{} FI.{} schalter 1 geschlossen: (schalterstellung SUB 1) = on.{} - schalter 2 geschlossen: (schalterstellung SUB 2) = on.{} schalter 3 geschlossen: (schalterstellung SUB 3) = on.{} schalter 8 geschlossen: (schalterstellung SUB 8) = on.{} umin1: bereich von e1 [1].{} umax1: bereich von e1 [2].{} symmetrische spannungsmessung ueber e1:{} umax1 := umax1 / 2.0;{} umin1 := - umax1.{} asymmetrische spannungsmessung ueber e1:{} umin1 := 0.0.{} bestimme bereich von e2:{} IF schalter 6 geschlossen{} THEN umax2 := 0.25{} ELIF schalter 5 geschlossen{} - THEN umax2 := 2.5{} ELIF schalter 4 geschlossen{} THEN umax2 := 25.0{} ELSE umax2 := 0.0{} FI;{} IF schalter 7 geschlossen{} THEN symmetrische spannungsmessung ueber e2{} ELSE asymmetrische spannungsmessung ueber e2{} FI.{} schalter 4 geschlossen: (schalterstellung SUB 4) = on.{} schalter 5 geschlossen: (schalterstellung SUB 5) = on.{} schalter 6 geschlossen: (schalterstellung SUB 6) = on.{} schalter 7 geschlossen: (schalterstellung SUB 7) = on.{} - umin2: bereich von e2 [1].{} umax2: bereich von e2 [2].{} symmetrische spannungsmessung ueber e2:{} umax2 := umax2 / 2.0;{} umin2 := - umax2.{} asymmetrische spannungsmessung ueber e2:{} umin2 := 0.0.{} on: "1".{}END PROC bestimme spannungsbereiche{}END PACKET ls prozess 5{} + pdv konfiguration zugelassen, + pdv konfiguration evtl aktivieren, + pdv konfiguration zeigen, + pdv kanal konfigurieren, + pdv interfaceausgabe testen, + pdv interfaceeingabe testen: +LET max steckplaetze = 4, + max portanzahl = 4, + anzahl kartensorten = 5, + betriebsart = 1, + keine karte = 1, + ea karte = 2, + kombi = 3, + da karte = 4, + ad karte = 5, + + compact = 6, + einzel = 7, + mehrfach = 8; +LET testfenster x = 11, + testfenster y = 5, + testfenster xsize = 59, + testfenster ysize = 15; +WINDOW VAR testfenster :: window (testfenster x, testfenster y, + testfenster xsize, testfenster ysize); +INT VAR steckplatzart :: 0; +BOOL VAR mit konfigurationsmoeglichkeit :: TRUE; +TASK VAR konfigurationsmanager :: niltask; + +ROW max steckplaetze INT VAR kartenart :: ROW max steckplaetze INT : + (keine karte, keine karte, + keine karte, keine karte); +LET SPANNUNG = ROW 2 REAL, + PORT = ROW 3 INT, + KARTE = ROW max portanzahl PORT; +ROW anzahl kartensorten KARTE CONST karte :: ROW anzahl kartensorten KARTE : +(* ---------------------------------------------------------------------- *) +( KARTE : ( +(* ---------------------------------------------------------------------- *) + +(* *) PORT : (nicht belegt, 0, 0), (* Port 1 *) +(* leere *) PORT : (nicht belegt, 0, 0), (* Port 2 *) +(* Karte *) PORT : (nicht belegt, 0, 0), (* Port 3 *) +(* *) PORT : (nicht belegt, 0, 0)), (* Port 4 *) +(*----------------------------------------------------------------------- *) + KARTE : ( +(* ---------------------------------------------------------------------- *) +(* *) PORT : (digital ein, 1, 3), (* Port 1 *) + +(* E/A *) PORT : (digital aus, 1, 1), (* Port 2 *) +(* Karte *) PORT : (digital ein, 1, 3), (* Port 3 *) +(* *) PORT : (digital aus, 1, 1)), (* Port 4 *) +(*----------------------------------------------------------------------- *) + KARTE : ( +(* ---------------------------------------------------------------------- *) +(* *) PORT : (analog ein, 2, 2), (* Port 1 *) +(* Kombi *) PORT : (analog ein, 3, 2), (* Port 2 *) + +(* Karte *) PORT : (digital ein, 1, 3), (* Port 3 *) +(* *) PORT : (digital aus, 1, 1 )), (* Port 4 *) +(*----------------------------------------------------------------------- *) + KARTE : ( +(* ---------------------------------------------------------------------- *) +(* *) PORT : (analog aus, 1, 1), (* Port 1 *) +(* D/A *) PORT : (analog aus, 1, 3), (* Port 2 *) +(* Wandler *) PORT : (nicht belegt, 0, 0), (* Port 3 *) + +(* *) PORT : (nicht belegt, 0, 0)), (* Port 4 *) +(*----------------------------------------------------------------------- *) + KARTE : ( +(* ---------------------------------------------------------------------- *) +(* *) PORT : (analog ein, 1, 1), (* Port 1 *) +(* A/D *) PORT : (analog ein, 1, 3), (* Port 2 *) +(* Wandler *) PORT : (nicht belegt, 0, 0), (* Port 3 *) +(* *) PORT : (nicht belegt, 0, 0)) (* Port 4 *) + +(*----------------------------------------------------------------------- *) + ); +PROC pdv konfiguration zugelassen (BOOL CONST wahrheitswert): + teste berechtigung; + mit konfigurationsmoeglichkeit := wahrheitswert; + IF mit konfigurationsmoeglichkeit + THEN konfigurationsmanager := niltask + ELSE konfigurationsmanager := myself + FI. + teste berechtigung: + enable stop; + IF NOT (konfigurationsmanager = niltask OR + + konfigurationsmanager = myself) + THEN errorstop ("Befehl ist nur in Task '" + + name (konfigurationsmanager) + "' zugelassen!") + FI. +END PROC pdv konfiguration zugelassen; +PROC pdv konfiguration evtl aktivieren: + IF mit konfigurationsmoeglichkeit + THEN activate (3) + ELSE deactivate (3) + FI +END PROC pdv konfiguration evtl aktivieren; +PROC pdv kanal konfigurieren: + TEXT CONST info :: " "15"Auswahl der Steckplatzart "14" "13""13"" + + + " c Compactbox "13"" + + " e Einzelsteckplatz "13"" + + " m Mehrfachsteckplatz ", + liste :: "Compact"13"Einzel"13"Mehrfach", + tasten :: "cemCEM"; + INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE); + SELECT auswahl OF + CASE 1, 101, 104 : trage compactbox ein; + zeige kanalbelegung (0) + CASE 2, 102, 105 : trage einzelplatzbelegung ein; + + zeige kanalbelegung (0) + CASE 3, 103, 106 : bearbeite die steckplaetze einzeln + END SELECT; + beende kanaldaten eintragen. + trage compactbox ein: + steckplatzart := compact; + trage steckplatzbelegung ein (1, kombi); + trage steckplatzbelegung ein (2, keine karte); + trage steckplatzbelegung ein (3, keine karte); + trage steckplatzbelegung ein (4, keine karte). + trage einzelplatzbelegung ein: + steckplatzart := einzel; + trage steckplatzbelegung ein (1, ermittelte kartenart (0)); + + trage steckplatzbelegung ein (2, keine karte); + trage steckplatzbelegung ein (3, keine karte); + trage steckplatzbelegung ein (4, keine karte). + bearbeite die steckplaetze einzeln: + INT VAR platz; + steckplatzart := mehrfach; + FOR platz FROM 1 UPTO max steckplaetze REP + trage steckplatzbelegung ein (platz, ermittelte kartenart (platz)); + zeige kanalbelegung (platz * 10) + PER. +END PROC pdv kanal konfigurieren; +PROC pdv konfiguration zeigen: + SELECT steckplatzart OF + + CASE compact : zeige kanalbelegung (0) + CASE einzel : zeige kanalbelegung (0) + CASE mehrfach : zeige belegung einzelner steckplaetze + OTHERWISE noch nicht konfiguriert + END SELECT. + noch nicht konfiguriert: + menuinfo (" "15"Warnung: "14" "13""13""13"" + + " Das Interface wurde noch nicht konfiguriert! "13""13"" + + " In diesem Zustand sind weder Eingaben noch "13"" + + " Ausgaben über das Interface möglich. "13""). + + zeige belegung einzelner steckplaetze: + TEXT CONST info :: + " "15"Eingestellt: Mehrfachsteckplatz "14" "13""13"" + + " 1 Info Steckplatz 1 "13"" + + " 2 Info Steckplatz 2 "13"" + + " 3 Info Steckplatz 3 "13"" + + " 4 Info Steckplatz 4 "13""13"" + + " z Zurück ins Hauptmenü ", + liste :: "1"13"2"13"3"13"4"13"z", + + tasten :: "1234zZ"; + INT VAR auswahl; + REP auswahl := menualternative (info, liste, tasten, 5, FALSE); + SELECT auswahl OF + CASE 1, 101 : zeige kanalbelegung (10) + CASE 2, 102 : zeige kanalbelegung (20) + CASE 3, 103 : zeige kanalbelegung (30) + CASE 4, 104 : zeige kanalbelegung (40) + END SELECT + UNTIL (auswahl = 5) OR (auswahl > 104) PER +END PROC pdv konfiguration zeigen; +PROC pdv interfaceausgabe testen: + gestalte testfenster ("Ausgabetest"); + + disable stop; + teste interface; + IF NOT is error + THEN teste interface ausgabe + FI; + IF is error + THEN fehlerbehandlung + ELSE schliesse interface; + enable stop; + beseitige testfenster; + refresh submenu + FI. + fehlerbehandlung: + TEXT VAR meldung :: errormessage; + clear error; + schalte alles aus; + schliesse interface; + enable stop; + cursor off; + regenerate menuscreen; + menuinfo (" " + invers (meldung)). +END PROC pdv interfaceausgabe testen; + +PROC pdv interfaceeingabe testen: + gestalte testfenster ("Eingabetest"); + disable stop; + teste interface; + IF NOT is error + THEN teste interface eingabe + FI; + IF is error + THEN fehlerbehandlung + ELSE schliesse interface; + enable stop; + beseitige testfenster; + refresh submenu + FI. + fehlerbehandlung: + TEXT VAR meldung :: errormessage; + clear error; + schalte alles aus; + schliesse interface; + enable stop; + cursor off; + + regenerate menuscreen; + menuinfo (" " + invers (meldung)). +END PROC pdv interfaceeingabe testen; +PROC beseitige testfenster: + INT VAR z; + FOR z FROM testfenster y + testfenster ysize DOWNTO testfenster y - 1 REP + cursor (testfenster x - 1, z); + out (""5"") + PER +END PROC beseitige testfenster; +PROC gestalte testfenster (TEXT CONST funktionsart): + show (testfenster); + cursor (testfenster x - 1, testfenster y + testfenster ysize - 2); + out (balken links + (testfenster xsize * waagerecht) + balken rechts); + + cursor (testfenster, 1, 2); + out (testfenster, center (testfenster, invers (funktionsart))) +END PROC gestalte testfenster; +PROC testfensterfussnote (TEXT CONST meldung): + cursor (testfenster, 2, testfenster ysize); + out (testfenster, meldung) +END PROC testfensterfussnote; +PROC teste interfaceausgabe: + INT VAR kanalnummer, steckplatz, port; + TEXT VAR nummer :: ""; + enable stop; + REP hole kanalnummer; + teste ausgabe an kanal + PER. + hole kanalnummer: + SELECT steckplatzart OF + + CASE compact : kanalnummer := 4; steckplatz := 1; port := 4 + CASE einzel : kanalnummer muss evtl erfragt werden + CASE mehrfach : kanalnummer muss erfragt werden + OTHERWISE errorstop ("Interface ist noch nicht konfiguriert!") + END SELECT; + cursor (testfenster, 2, 5); + out (testfenster, "Ausgabe an Kanal " + text (kanalnummer) + klammer + + kanalbeschreibung (steckplatz, port)); + IF steckplatzart = mehrfach + THEN cursor (testfenster, 25, 6); + + out (testfenster, "in Steckplatz " + text (steckplatz)) + FI; + out (testfenster, ")"). + klammer: + IF kanalnummer < 10 + THEN " (= " + ELSE " (= " + FI. + kanalnummer muss evtl erfragt werden: + SELECT kartenart [1] OF + CASE kombi : kanalnummer := 4; steckplatz := 1; port := 4 + CASE eakarte : kanalnummer := 2; steckplatz := 1; port := 2 + CASE dakarte : frage nach kanalnummer auf da karte; + steckplatz := 1; port := kanalnummer + + OTHERWISE errorstop ("Keine Ausgabe an " + kartenname + " möglich!") + END SELECT. + kartenname: + IF kartenart [1] = ad karte + THEN "A/D-Karte" + ELSE "leeren Steckplatz" + FI. + frage nach kanalnummer auf da karte: + menufootnote ("Zurück zum Hauptmenü: <ESC><q>"); + testfensterfussnote ("Bitte eine Kanalnummer eingeben!"); + cursor (testfenster, 2, 5); + out (testfenster, "Ausgabe - Kanal (1 oder 2): "); + cursor on; + REP inchar (nummer) + UNTIL (pos ("12", nummer) > 0) OR esc q gedrueckt PER; + + cursor off; + IF nummer = ""27"" + THEN LEAVE teste interface ausgabe + ELSE kanalnummer := int (nummer) + FI. + esc q gedrueckt: + (nummer = ""27"") AND (incharety (20) = "q"). + kanalnummer muss erfragt werden: + TEXT VAR exit char; + menufootnote ("Zurück zum Hauptmenü: <ESC><q>"); + testfensterfussnote ("Bitte eine Kanalnummer eingeben!"); + cursor (testfenster, 2, 5); + out (testfenster, "Ausgabe - Kanal:"); + cursor on; + REP cursor (testfenster, 19, 5); + + editget (testfenster, nummer, 4, 4, "", "q", exit char) + UNTIL (exit char = ""27"q") OR ausgabekanal eingegeben PER; + cursor off; + IF exit char = ""27"q" + THEN LEAVE teste interface ausgabe + FI. + ausgabekanal eingegeben: + kanalnummer := abs (int (nummer)); + steckplatz := kanalnummer DIV 10; + port := kanalnummer MOD 10; + IF steckplatz = 0 THEN steckplatz := 1 FI; + cursor (testfenster, 2, 7); + IF (kanalnummer < 1) OR (kanalnummer > 49) + + THEN out (testfenster, "Unzulässige Kanalnummer! "); FALSE + ELIF (port = 0) OR (port > max portanzahl) OR kein ausgabeport + THEN out (testfenster, "Dies ist kein Ausgabe-Kanal! "); FALSE + ELSE out (testfenster, " "); TRUE + FI. + kein ausgabeport: + (port betriebsart <> digital aus) AND (port betriebsart <> analog aus). + port betriebsart: karte [sorte][port][betriebsart]. + sorte : kartenart [steckplatz]. + + teste ausgabe an kanal: + TEXT VAR wert; + cursor (testfenster, 1, 8); + out (testfenster, testfenster xsize * "-"); + cursor (testfenster, 2, 11); + out (testfenster, "Ausgabewert: "); + testfenster fussnote ("Bitte einen Wert zwischen 0 und 255 eingeben!"); + menufootnote ("'Werte ausgeben' beenden: <ESC><q>"); + cursor on; + REP cursor (testfenster, 15, 11); + wert := "0"; + editget (testfenster, wert, 4, 4, "", "qh", exit char); + IF exit char = return + + THEN ausgeben (kanalnummer, int (wert) MOD ganzzahlobergrenze) + ELIF exit char = ""27"h" + THEN errorstop ("Programm-Abbruch durch <ESC><h>!") + FI + UNTIL exitchar = ""27"q" PER; + cursor off; + IF (steckplatzart = mehrfach) OR (kartenart [1] = da karte) + THEN cursor (testfenster, 1, 5); + out (testfenster, (2 * testfenster xsize) * " "); + cursor (testfenster, 2, 11); + out (testfenster, " "); + + testfenster fussnote ((testfenster xsize - 2) * " ") + ELSE LEAVE teste interfaceausgabe + FI. + return: ""13"". +END PROC teste interfaceausgabe; +PROC teste interfaceeingabe: + INT VAR kanalnummer, steckplatz, port; + TEXT VAR nummer :: ""; + enable stop; + REP hole kanalnummer; + teste eingabe vom kanal + PER. + hole kanalnummer: + IF steckplatzart = 0 + THEN errorstop ("Interface ist noch nicht konfiguriert!") + ELSE kanalnummer erfragen + + FI; + cursor (testfenster, 2, 5); + out (testfenster, "Eingabe von Kanal " + text (kanalnummer) + klammer + + kanalbeschreibung (steckplatz, port)); + IF steckplatzart = mehrfach + THEN cursor (testfenster, 26, 6); + out (testfenster, "in Steckplatz " + text (steckplatz)) + FI; + out (testfenster, ")"). + klammer: + IF kanalnummer < 10 + THEN " (= " + ELSE " (= " + FI. + kanalnummer erfragen: + SELECT steckplatzart OF + + CASE compact : drei kanaele anbieten; + steckplatz := 1; port := kanalnummer + CASE einzel : zwei oder drei kanaele anbieten; + steckplatz := 1; port := kanalnummer + CASE mehrfach : alle kanaele moeglich + END SELECT. + drei kanaele anbieten: + menufootnote ("Zurück zum Hauptmenü: <ESC><q>"); + testfensterfussnote ("Bitte eine Kanalnummer eingeben!"); + cursor (testfenster, 2, 5); + out (testfenster, "Eingabe - Kanal (1, 2 oder 3): "); + + cursor on; + REP inchar (nummer) + UNTIL (pos ("123", nummer) > 0) OR esc q gedrueckt PER; + cursor off; + IF nummer = ""27"" + THEN LEAVE teste interface eingabe + ELSE kanalnummer := int (nummer) + FI. + esc q gedrueckt: + (nummer = ""27"") AND (incharety (20) = "q"). + zwei oder drei kanaele anbieten: + SELECT kartenart [1] OF + CASE kombi : drei kanaele anbieten + CASE ad karte : zwei kanaele anbieten + CASE ea karte : kanalnummer := 1 + + OTHERWISE errorstop ("Eingabe bei " + kartenname + " nicht möglich!") + END SELECT. + kartenname: + IF kartenart [1] = da karte + THEN "D/A-Karte" + ELSE "leerem Steckplatz" + FI. + zwei kanaele anbieten: + menufootnote ("Zurück zum Hauptmenü: <ESC><q>"); + testfensterfussnote ("Bitte eine Kanalnummer eingeben!"); + cursor (testfenster, 2, 5); + out (testfenster, "Eingabe - Kanal (1 oder 2): "); + cursor on; + REP inchar (nummer) + UNTIL (pos ("12", nummer) > 0) OR esc q gedrueckt PER; + + cursor off; + IF nummer = ""27"" + THEN LEAVE teste interface eingabe + ELSE kanalnummer := int (nummer) + FI. + alle kanaele moeglich: + TEXT VAR exit char; + menufootnote ("Zurück zum Hauptmenü: <ESC><q>"); + testfensterfussnote ("Bitte eine Kanalnummer eingeben!"); + cursor (testfenster, 2, 5); + out (testfenster, "Eingabe - Kanal:"); + cursor on; + REP cursor (testfenster, 19, 5); + editget (testfenster, nummer, 4, 4, "", "q", exit char) + UNTIL (exit char = ""27"q") OR eingabekanal eingegeben PER; + + cursor off; + IF exit char = ""27"q" + THEN LEAVE teste interface eingabe + FI. + eingabekanal eingegeben: + kanalnummer := abs (int (nummer)); + steckplatz := kanalnummer DIV 10; + port := kanalnummer MOD 10; + IF steckplatz = 0 THEN steckplatz := 1 FI; + cursor (testfenster, 2, 7); + IF (kanalnummer < 1) OR (kanalnummer > 49) + THEN out (testfenster, "Unzulässige Kanalnummer! "); FALSE + ELIF (port = 0) OR (port > max portanzahl) OR kein eingabeport + + THEN out (testfenster, "Dies ist kein Eingabe-Kanal! "); FALSE + ELSE out (testfenster, " "); TRUE + FI. + kein eingabeport: + (port betriebsart <> digital ein) AND (port betriebsart <> analog ein). + port betriebsart: karte [sorte][port][betriebsart]. + sorte : kartenart [steckplatz]. + teste eingabe vom kanal: + cursor (testfenster, 1, 8); + out (testfenster, testfenster xsize * "-"); + cursor (testfenster, 2, 11); + + out (testfenster, "Eingelesener Wert: "); + testfenster fussnote (" "); + menufootnote ("'Werte einlesen' beenden: <ESC><q>"); + REP cursor (testfenster, 21, 11); + out (text (eingabe (kanalnummer), 3)); + warte (0.1) + UNTIL abbruch gewuenscht PER; + IF (steckplatzart = einzel) AND (kartenart [1] = ea karte) + THEN LEAVE teste interfaceeingabe + ELSE cursor (testfenster, 1, 5); + out (testfenster, (2 * testfenster xsize) * " "); + + cursor (testfenster, 2, 11); + out (testfenster, " ") + FI. +END PROC teste interfaceeingabe; +TEXT PROC kanalbeschreibung (INT CONST steckplatz, port): + IF steckplatzart = compact + THEN port auf compactbox + ELSE port auf steckkarte + FI. + port auf compactbox: + portbeschreibung + " der Compact-Box". + port auf steckkarte: + SELECT kartenart [steckplatz] OF + CASE kombi : portbeschreibung + " der Kombi-Karte" + CASE ea karte : portbeschreibung + " der E/A-Karte" + + CASE da karte : portbeschreibung + " der D/A-Karte" + CASE ad karte : portbeschreibung + " der A/D-Karte" + OTHERWISE "" + END SELECT. + portbeschreibung: + SELECT 2 + karte [kartenart [steckplatz]][port][betriebsart] OF + CASE 1 : "Digitalausgang" + CASE 3 : "Digitaleingang" + CASE 0 : "Analogausgang " + text (port) + CASE 4 : "Analogeingang " + text (port) + OTHERWISE "" + END SELECT. +END PROC kanalbeschreibung; +PROC trage steckplatzbelegung ein (INT CONST steckplatz, art): + + INT VAR port; + kartenart [steckplatz] := art; + klaere spannungsbereiche; + FOR port FROM 1 UPTO max portanzahl REP + trage kanaldaten ein (kanalnummer, spannungsbereich, portdaten); + IF steckplatz = 1 + THEN trage kanaldaten ein (port, spannungsbereich, portdaten) + FI + PER. + kanalnummer: port + 10 * steckplatz. + portdaten : karte [kartenart [steckplatz]][port]. + spannungsbereich: + IF port = 1 + THEN bereich von e1 + ELIF port = 2 + THEN bereich von e2 + + ELSE SPANNUNG : (0.0, 0.0) + FI. + klaere spannungsbereiche: + SPANNUNG VAR bereich von e1, bereich von e2; + SELECT kartenart [steckplatz] OF + CASE kombi : spannungsbereich 0 bis 5 volt + CASE da karte : setze spannungsbereiche + CASE ad karte : erfrage adkarte schalterstellungen + OTHERWISE alles auf 0 setzen + END SELECT. + spannungsbereich 0 bis 5 volt: + bereich von e1 := SPANNUNG : (0.0, 5.0); + bereich von e2 := SPANNUNG : (0.0, 5.0). + setze spannungsbereiche: + + bereich von e1 := SPANNUNG : (-5.0, 5.0); + bereich von e2 := SPANNUNG : ( 0.0, 5.0). + alles auf 0 setzen: + bereich von e1 := SPANNUNG : (0.0, 0.0); + bereich von e2 := SPANNUNG : (0.0, 0.0). +erfrage adkarte schalterstellungen: + REP + hole schalterstellung + UNTIL schalterstellung sinnvoll PER; + bestimme spannungsbereiche (schalterzustand, bereich von e1, bereich von e2). + hole schalterstellung: + TEXT VAR schalterzustand := menuanswer (infotext, "00000000", 5). + infotext: + + ueberschrift + + " Bitte die aktuelle Schalterstellung eintragen: "13""13"" + + " Es bedeutet : 1 - Schalterstellung 'on' "13"" + + " 0 - Schalterstellung 'off' "13""13"" + + " Nummer : 12345678 "13"" + + " |||||||| ". + ueberschrift: + IF steckplatzart = mehrfach + THEN " "15"Angabe der Schalterstellungen auf der A/D-Karte "14""13"" + + " "15" in Steckplatz " + + text (steckplatz) + ": "14""13""13"" + + ELSE " "15"Angabe der Schalterstellungen auf der A/D-Karte: "14""13""13"" + FI. + schalterstellung sinnvoll: + (length (schalterzustand) = 8) AND nur nullen und einsen. + nur nullen und einsen: + BOOL VAR ok := TRUE; INT VAR m; + FOR m FROM 1 UPTO 8 REP + IF NOT ((schalterzustand SUB m) = "1" OR (schalterzustand SUB m ) = "0") + THEN ok := FALSE + FI + PER; + ok. +END PROC trage steckplatzbelegung ein; +INT PROC ermittelte kartenart (INT CONST steckplatz): + TEXT CONST info e :: " "15"Angabe der Interfacekarte: "14" "13""13"" + + + " k Kombikarte "13"" + + " e E / A - Karte "13"" + + " d D / A - Wandler - Karte "13"" + + " a A / D - Wandler - Karte "13"" + + " 0 Keine Steckkarte ", + info m :: " "15"Angabe der Interfacekarte für Steckplatz " + + text (steckplatz) + ": "14" "13""13"" + + " k Kombikarte "13"" + + + " e E / A - Karte "13"" + + " d D / A - Wandler - Karte "13"" + + " a A / D - Wandler - Karte "13"" + + " 0 Keine Steckkarte ", + liste :: "Kombi"13"E/A"13"D/A"13"A/D"13"Keine", + tasten :: "keda0KEDA"; + INT VAR auswahl := menualternative (infotext, liste, tasten, 5, FALSE); + SELECT auswahl OF + CASE 1, 101, 106 : kombi + + CASE 2, 102, 107 : eakarte + CASE 3, 103, 108 : dakarte + CASE 4, 104, 109 : adkarte + OTHERWISE keine karte + END SELECT. + infotext: + IF steckplatz = 0 + THEN info e + ELSE info m + FI. +END PROC ermittelte kartenart; +PROC zeige kanalbelegung (INT CONST steckplatz): + ROW 4 TEXT VAR kanalnummer; + kanalnummer [1] := text (steckplatz + 1, 2); + kanalnummer [2] := text (steckplatz + 2, 2); + kanalnummer [3] := text (steckplatz + 3, 2); + + kanalnummer [4] := text (steckplatz + 4, 2); + IF steckplatzart = compact + THEN zeige compactboxbelegung + ELSE zeige steckplatz mit karte + FI. + zeige steckplatz mit karte: + SELECT kartenart [steckplatznummer] OF + CASE kombi : zeige steckplatz mit kombi + CASE eakarte: zeige steckplatz mit eakarte + CASE dakarte: zeige steckplatz mit dakarte + CASE adkarte: zeige steckplatz mit adkarte + OTHERWISE zeige steckplatz ohne karte + END SELECT. + + steckplatznummer: + IF steckplatz = 0 + THEN 1 + ELSE steckplatz DIV 10 + FI. + zeige compactboxbelegung: + menuinfo ( + " "15"Eingestellt: Compactbox "14" "13""13"" + + " Belegung der Kanäle: "13""13""13"" + + kanalnummeranzeige kombikarte). + zeige steckplatz mit kombi: + menuinfo (ueberschrift + " mit Kombikarte: "14" "13""13"" + + " Belegung der Kanäle: "13""13""13"" + + kanalnummeranzeige kombikarte). + + zeige steckplatz mit eakarte: + menuinfo (ueberschrift + " mit E / A - Karte: "14" "13""13"" + + " Belegung der Kanäle: "13""13""13"" + + kanalnummeranzeige eakarte). + zeige steckplatz mit dakarte: + menuinfo (ueberschrift + " mit D / A - Karte: "14" "13""13"" + + " Belegung der Kanäle: "13""13"" + + kanalnummeranzeige dakarte). + zeige steckplatz mit adkarte: + hole spannungsbereiche; + menuinfo (" " + ueberschrift + " mit A / D - Karte: "14""13""13"" + + + " Zwei analoge Eingänge stehen zur Verfügung: "13""13"" + + kanalnummeranzeige adkarte). + hole spannungsbereiche: + SPANNUNG VAR e1 bereich, e2 bereich; + hole spannungsbereich (steckplatz + 1, e1 bereich [1], e1 bereich [2]); + hole spannungsbereich (steckplatz + 2, e2 bereich [1], e2 bereich [2]). + zeige steckplatz ohne karte: + IF steckplatz = 0 + THEN menuinfo ( + " "15"Einzelsteckplatz ohne Steckkarte: "14" "13""13""13"" + + " Es sind weder Ein- noch Ausgaben möglich! "13"") + + ELSE menuinfo ( + " "15"Steckplatz " + + text (steckplatz DIV 10) + " ohne Steckkarte: "14""13""13""13"" + + " Es sind hier weder Ein- noch Ausgaben möglich! "13"") + FI. + ueberschrift: + IF steckplatz = 0 + THEN " "15"Einzelsteckplatz" + ELSE " "15"Steckplatz " + text (steckplatz DIV 10) + FI. + kanalnummeranzeige kombikarte: + " "15"Kanal " + kanalnummer [1] + + ": "14" Analogeingang 1 (E1) "13""13"" + + + " "15"Kanal " + kanalnummer [2] + + ": "14" Analogeingang 2 (E2) "13""13"" + + " "15"Kanal " + kanalnummer [3] + + ": "14" Digitaleingang "13""13"" + + " "15"Kanal " + kanalnummer [4] + + ": "14" Digitalausgang "13"". + kanalnummeranzeige eakarte: + " "15"Kanal " + kanalnummer [1] + + ": "14" Digitaleingang "13""13"" + + " "15"Kanal " + kanalnummer [2] + + ": "14" Digitalausgang "13""13"" + + + " ( "15"Kanal " + kanalnummer [3] + + ": "14" Digitaleingang (= Kanal " + kanalnummer [1] + ") )"13""13"" + + " ( "15"Kanal " + kanalnummer [4] + + ": "14" Digitalausgang (= Kanal " + kanalnummer [2] + ") )"13"". + kanalnummeranzeige adkarte: + " "15"Kanal " + kanalnummer [1] + + ": "14" (E1) Spannungsbereich " + bereich1 + ""13""13"" + + " "15"Kanal " + kanalnummer [2] + + ": "14" (E2) Spannungsbereich " + bereich2 + ""13"". + + bereich1: + IF e1 bereich [1] = 0.0 + THEN " 0.000 V - +" + text (e1 bereich [2], 6, 3) + " V " + ELSE text (e1 bereich [1], 7, 3) + " V - +" + text (e1 bereich [2], 6, 3) + " V " + FI. + bereich2: + IF e2 bereich [1] = 0.0 + THEN " 0.000 V - +" + text (e2 bereich [2], 6, 3) + " V" + ELSE text (e2 bereich [1], 7, 3) + " V - +" + text (e2 bereich [2], 6, 3) + " V" + FI. + kanalnummeranzeige dakarte: + " Die Karte stellt einen Analogausgang zur Verfügung, "13"" + + + " der auf zwei Arten angesprochen werden kann: "13""13""13"" + + " "15"Kanal " + kanalnummer [1] + + ": "14" Spannungsbereich -5 V - +5 V "13""13"" + + " "15"Kanal " + kanalnummer [2] + + ": "14" Spannungsbereich 0 V - +5 V "13"". +END PROC zeige kanalbelegung; +PROC bestimme spannungsbereiche (TEXT CONST schalterstellung, + SPANNUNG VAR bereich von e1, + SPANNUNG VAR bereich von e2): + + bestimme bereich von e1; + bestimme bereich von e2. + bestimme bereich von e1: + IF schalter 3 geschlossen + THEN umax1 := 0.25 + ELIF schalter 2 geschlossen + THEN umax1 := 2.5 + ELIF schalter 1 geschlossen + THEN umax1 := 25.0 + ELSE umax1 := 0.0 + FI; + IF schalter 8 geschlossen + THEN symmetrische spannungsmessung ueber e1 + ELSE asymmetrische spannungsmessung ueber e1 + FI. + schalter 1 geschlossen: (schalterstellung SUB 1) = on. + + schalter 2 geschlossen: (schalterstellung SUB 2) = on. + schalter 3 geschlossen: (schalterstellung SUB 3) = on. + schalter 8 geschlossen: (schalterstellung SUB 8) = on. + umin1: bereich von e1 [1]. + umax1: bereich von e1 [2]. + symmetrische spannungsmessung ueber e1: + umax1 := umax1 / 2.0; + umin1 := - umax1. + asymmetrische spannungsmessung ueber e1: + umin1 := 0.0. + bestimme bereich von e2: + IF schalter 6 geschlossen + THEN umax2 := 0.25 + ELIF schalter 5 geschlossen + + THEN umax2 := 2.5 + ELIF schalter 4 geschlossen + THEN umax2 := 25.0 + ELSE umax2 := 0.0 + FI; + IF schalter 7 geschlossen + THEN symmetrische spannungsmessung ueber e2 + ELSE asymmetrische spannungsmessung ueber e2 + FI. + schalter 4 geschlossen: (schalterstellung SUB 4) = on. + schalter 5 geschlossen: (schalterstellung SUB 5) = on. + schalter 6 geschlossen: (schalterstellung SUB 6) = on. + schalter 7 geschlossen: (schalterstellung SUB 7) = on. + + umin2: bereich von e2 [1]. + umax2: bereich von e2 [2]. + symmetrische spannungsmessung ueber e2: + umax2 := umax2 / 2.0; + umin2 := - umax2. + asymmetrische spannungsmessung ueber e2: + umin2 := 0.0. + on: "1". +END PROC bestimme spannungsbereiche +END PACKET ls prozess 5 + diff --git a/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter b/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter index 36de5ef..0ac3237 100644 --- a/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter +++ b/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter @@ -22,15 +22,183 @@ *) PACKET ls warenhaus 0 DEFINES - interface anpassung,{} oeffne interface,{} schliesse interface,{} wert von interface,{} pressed key,{}(* --------------------------- *){} kanalkoppler,{} interfacechannel,{} init interfacechannel:{}TEXT CONST interface anpassung :: "mit Kartenleser an AKTRONIC-Adapter";{}LET max channel = 24,{} initcode = 26,{} endcode = 27,{} read code = 28;{}INT CONST nicht initialisiert code :: -3,{} interface error code :: -4,{} - kanal besetzt code :: -5;{}INT VAR interfacekanal :: 0;{}TEXT VAR puffer :: "";{}TASK VAR hardwaremanager :: niltask,{} interface task :: niltask,{} absender;{}DATASPACE VAR ds :: nilspace;{}INT PROC interfacechannel:{} interfacekanal{}END PROC interfacechannel;{}PROC oeffne interface (INT VAR status):{} puffer := "";{} forget (ds); ds := nilspace;{} pingpong (interfacetask, init code, ds, status);{} IF status > 0 THEN status DECR maxint FI;{} - forget (ds); ds := nilspace{}END PROC oeffne interface;{}INT PROC wert von interface:{} INT VAR wert;{} puffer CAT incharety (1);{} call (interface task, read code, ds, wert);{} wert.{}END PROC wert von interface;{}PROC schliesse interface:{} forget (ds); ds := nilspace;{} send (interface task, end code, ds);{} forget (ds); ds := nilspace{}END PROC schliesse interface;{}TEXT PROC pressed key:{} IF puffer = ""{} THEN incharety{} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} - TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{} IF puffer = ""{} THEN incharety (warten){} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}(*************************************************************************){}PROC kanalkoppler:{} enable stop;{} IF name (myself) <> "-"{} - THEN errorstop ("Unzulässiges Kommando!"){} ELSE warte auf anrufe{} FI.{} warte auf anrufe:{} INT VAR codenummer, antwort;{} disable stop;{} REP wait (ds, codenummer, absender);{} reagiere auf anruf;{} loesche ggf fehlerzustand{} PER.{} reagiere auf anruf:{} IF codenummer = initcode{} THEN kopple an interface;{} IF interface ist betriebsbereit{} THEN bearbeite weitere auftraege{} ELSE gib negative rueckmeldung{} - FI;{} gib kanal frei{} ELSE send (absender, nicht initialisiert code, ds){} FI.{} loesche ggf fehlerzustand:{} IF is error{} THEN clear error{} FI.{} kopple an interface:{} IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself{} THEN antwort := kanal besetzt code;{} ELSE continue (interfacekanal);{} teste interface{} FI.{} teste interface:{} leere puffer;{} out (""240"");{} IF incharety (1) <> ""{} THEN antwort := 0;{} - out (""176""){} ELSE antwort := interface error code{} FI.{} leere puffer:{} REP UNTIL incharety = "" PER.{} interface ist betriebsbereit: antwort = 0.{} gib negative rueckmeldung: send (absender, antwort, ds).{} gib kanal frei: break (quiet).{} ende: out (""176"").{} bearbeite weitere auftraege:{} REP pingpong (absender, antwort, ds, codenummer);{} IF codenummer = read code{} THEN hole wert von interface{} - ELIF codenummer < 0{} THEN send (absender, codenummer, ds);{} codenummer := endcode{} ELSE antwort := 0{} FI{} UNTIL codenummer = endcode PER;{} ende.{} hole wert von interface:{} out (""211"");{} antwort := code (incharety (1)).{}END PROC kanalkoppler;{}PROC init interfacechannel:{} teste auf zulaessigkeit;{} loesche interfacetask;{} erfrage interface kanal;{} generiere ggf neue interfacetask.{} teste auf zulaessigkeit:{} - enable stop;{} IF hardwaremanager <> niltask AND hardwaremanager <> myself{} THEN errorstop ("Dieses Kommando kann nur von der Task '" +{} name (hardwaremanager) + "' aus gegeben werden!"){} ELSE hardwaremanager := myself{} FI.{} loesche interfacetask:{} disable stop;{} end (interfacetask);{} IF is error THEN clear error FI;{} enable stop.{} generiere ggf neue interfacetask:{} IF interface kanal = 0{} THEN interface task := niltask;{} hardwaremanager := niltask{} - ELSE begin (PROC kanalkoppler, interface task);{} hardwaremanager := myself{} FI.{} erfrage interfacekanal:{} INT VAR kanalnummer;{} put ("Gib Interface - Kanal:");{} get (kanalnummer);{} set interfacechannel (kanalnummer).{}END PROC init interfacechannel;{}PROC set interface channel (INT CONST channel number):{} IF channel number < 0 OR channel number > max channel{} THEN errorstop ("Unzulässige Kanalnummer"){} ELSE interfacekanal := channel number{} FI{}END PROC set interface channel;{} -BOOL OP <> (TASK CONST t1, t2):{} NOT (t1 = t2){}END OP <>;{}init interfacechannel{}END PACKET ls warenhaus 0{} + interface anpassung, + oeffne interface, + schliesse interface, + wert von interface, + pressed key, +(* --------------------------- *) + kanalkoppler, + interfacechannel, + init interfacechannel: +TEXT CONST interface anpassung :: "mit Kartenleser an AKTRONIC-Adapter"; +LET max channel = 24, + initcode = 26, + endcode = 27, + read code = 28; +INT CONST nicht initialisiert code :: -3, + interface error code :: -4, + + kanal besetzt code :: -5; +INT VAR interfacekanal :: 0; +TEXT VAR puffer :: ""; +TASK VAR hardwaremanager :: niltask, + interface task :: niltask, + absender; +DATASPACE VAR ds :: nilspace; +INT PROC interfacechannel: + interfacekanal +END PROC interfacechannel; +PROC oeffne interface (INT VAR status): + puffer := ""; + forget (ds); ds := nilspace; + pingpong (interfacetask, init code, ds, status); + IF status > 0 THEN status DECR maxint FI; + + forget (ds); ds := nilspace +END PROC oeffne interface; +INT PROC wert von interface: + INT VAR wert; + puffer CAT incharety (1); + call (interface task, read code, ds, wert); + wert. +END PROC wert von interface; +PROC schliesse interface: + forget (ds); ds := nilspace; + send (interface task, end code, ds); + forget (ds); ds := nilspace +END PROC schliesse interface; +TEXT PROC pressed key: + IF puffer = "" + THEN incharety + ELSE erstes pufferzeichen + FI. + erstes pufferzeichen: + + TEXT VAR zeichen :: puffer SUB 1; + puffer := subtext (puffer, 2); + zeichen. +END PROC pressed key; +TEXT PROC pressed key (INT CONST warten): + IF puffer = "" + THEN incharety (warten) + ELSE erstes pufferzeichen + FI. + erstes pufferzeichen: + TEXT VAR zeichen :: puffer SUB 1; + puffer := subtext (puffer, 2); + zeichen. +END PROC pressed key; +(*************************************************************************) +PROC kanalkoppler: + enable stop; + IF name (myself) <> "-" + + THEN errorstop ("Unzulässiges Kommando!") + ELSE warte auf anrufe + FI. + warte auf anrufe: + INT VAR codenummer, antwort; + disable stop; + REP wait (ds, codenummer, absender); + reagiere auf anruf; + loesche ggf fehlerzustand + PER. + reagiere auf anruf: + IF codenummer = initcode + THEN kopple an interface; + IF interface ist betriebsbereit + THEN bearbeite weitere auftraege + ELSE gib negative rueckmeldung + + FI; + gib kanal frei + ELSE send (absender, nicht initialisiert code, ds) + FI. + loesche ggf fehlerzustand: + IF is error + THEN clear error + FI. + kopple an interface: + IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself + THEN antwort := kanal besetzt code; + ELSE continue (interfacekanal); + teste interface + FI. + teste interface: + leere puffer; + out (""240""); + IF incharety (1) <> "" + THEN antwort := 0; + + out (""176"") + ELSE antwort := interface error code + FI. + leere puffer: + REP UNTIL incharety = "" PER. + interface ist betriebsbereit: antwort = 0. + gib negative rueckmeldung: send (absender, antwort, ds). + gib kanal frei: break (quiet). + ende: out (""176""). + bearbeite weitere auftraege: + REP pingpong (absender, antwort, ds, codenummer); + IF codenummer = read code + THEN hole wert von interface + + ELIF codenummer < 0 + THEN send (absender, codenummer, ds); + codenummer := endcode + ELSE antwort := 0 + FI + UNTIL codenummer = endcode PER; + ende. + hole wert von interface: + out (""211""); + antwort := code (incharety (1)). +END PROC kanalkoppler; +PROC init interfacechannel: + teste auf zulaessigkeit; + loesche interfacetask; + erfrage interface kanal; + generiere ggf neue interfacetask. + teste auf zulaessigkeit: + + enable stop; + IF hardwaremanager <> niltask AND hardwaremanager <> myself + THEN errorstop ("Dieses Kommando kann nur von der Task '" + + name (hardwaremanager) + "' aus gegeben werden!") + ELSE hardwaremanager := myself + FI. + loesche interfacetask: + disable stop; + end (interfacetask); + IF is error THEN clear error FI; + enable stop. + generiere ggf neue interfacetask: + IF interface kanal = 0 + THEN interface task := niltask; + hardwaremanager := niltask + + ELSE begin (PROC kanalkoppler, interface task); + hardwaremanager := myself + FI. + erfrage interfacekanal: + INT VAR kanalnummer; + put ("Gib Interface - Kanal:"); + get (kanalnummer); + set interfacechannel (kanalnummer). +END PROC init interfacechannel; +PROC set interface channel (INT CONST channel number): + IF channel number < 0 OR channel number > max channel + THEN errorstop ("Unzulässige Kanalnummer") + ELSE interfacekanal := channel number + FI +END PROC set interface channel; + +BOOL OP <> (TASK CONST t1, t2): + NOT (t1 = t2) +END OP <>; +init interfacechannel +END PACKET ls warenhaus 0 + diff --git a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät index f108f7b..0098901 100644 --- a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät +++ b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät @@ -22,15 +22,190 @@ *) PACKET ls warenhaus 0 DEFINES - interface anpassung,{} oeffne interface,{} schliesse interface,{} wert von interface,{} pressed key,{}(* --------------------------- *){} kanalkoppler,{} interfacechannel,{} init interfacechannel:{}TEXT CONST interface anpassung :: "mit Kartenleser an MUFI als Endgerät";{}LET mufikennung = ""27""27"",{} max channel = 24,{} initcode = 26,{} endcode = 27,{} read code = 28;{}INT CONST nicht initialisiert code :: -3,{} interface error code :: -4,{} - kanal besetzt code :: -5;{}INT VAR interfacekanal :: 2;{}TEXT VAR puffer :: "";{}TASK VAR hardwaremanager :: niltask,{} interface task :: niltask,{} absender;{}DATASPACE VAR ds :: nilspace;{}INT PROC interfacechannel:{} interfacekanal{}END PROC interfacechannel;{}PROC oeffne interface (INT VAR status):{} puffer := "";{} forget (ds); ds := nilspace;{} pingpong (interfacetask, init code, ds, status);{} IF status > 0 THEN status DECR maxint FI;{} - forget (ds); ds := nilspace{}END PROC oeffne interface;{}INT PROC wert von interface:{} INT VAR wert;{} puffer CAT incharety (1);{} call (interface task, read code, ds, wert);{} wert.{}END PROC wert von interface;{}PROC schliesse interface:{} forget (ds); ds := nilspace;{} send (interface task, end code, ds);{} forget (ds); ds := nilspace{}END PROC schliesse interface;{}TEXT PROC pressed key:{} IF puffer = ""{} THEN incharety{} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} - TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{} IF puffer = ""{} THEN incharety (warten){} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}(*************************************************************************){}PROC kanalkoppler:{} enable stop;{} IF name (myself) <> "-"{} - THEN errorstop ("Unzulässiges Kommando!"){} ELSE warte auf anrufe{} FI.{} warte auf anrufe:{} INT VAR codenummer, antwort;{} disable stop;{} REP wait (ds, codenummer, absender);{} reagiere auf anruf;{} loesche ggf fehlerzustand{} PER.{} reagiere auf anruf:{} IF codenummer = initcode{} THEN kopple an interface;{} IF interface ist betriebsbereit{} THEN bearbeite weitere auftraege{} ELSE gib negative rueckmeldung{} - FI;{} gib kanal frei{} ELSE send (absender, nicht initialisiert code, ds){} FI.{} loesche ggf fehlerzustand:{} IF is error{} THEN clear error{} FI.{} kopple an interface:{} IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself{} THEN antwort := kanal besetzt code;{} ELSE continue (interfacekanal);{} teste interface{} FI.{} teste interface:{} leere puffer;{} out (mufikennung + "10");{} fange status;{} IF status = mufikennung + "00"{} - THEN antwort := 0;{} out (mufikennung + "1A18"22""){} ELSE antwort := interface error code{} FI.{} leere puffer:{} REP UNTIL incharety = "" PER.{} fange status:{} INT VAR zaehler;{} TEXT VAR status :: "";{} FOR zaehler FROM 1 UPTO 4 REP{} status CAT incharety (1){} PER.{} interface ist betriebsbereit: antwort = 0.{} gib negative rueckmeldung: send (absender, antwort, ds).{} gib kanal frei: break (quiet).{} ende: out (""25"").{} - bearbeite weitere auftraege:{} REP pingpong (absender, antwort, ds, codenummer);{} IF codenummer = read code{} THEN hole wert von interface{} ELIF codenummer < 0{} THEN send (absender, codenummer, ds);{} codenummer := endcode{} ELSE antwort := 0{} FI{} UNTIL codenummer = endcode PER;{} ende.{} hole wert von interface:{} out (""76"");{} antwort := code (incharety (1)).{}END PROC kanalkoppler;{}PROC init interfacechannel:{} - teste auf zulaessigkeit;{} loesche interfacetask;{} erfrage interface kanal;{} generiere ggf neue interfacetask.{} teste auf zulaessigkeit:{} enable stop;{} IF hardwaremanager <> niltask AND hardwaremanager <> myself{} THEN errorstop ("Dieses Kommando kann nur von der Task '" +{} name (hardwaremanager) + "' aus gegeben werden!"){} FI.{} loesche interfacetask:{} disable stop;{} end (interfacetask);{} IF is error THEN clear error FI;{} enable stop.{} generiere ggf neue interfacetask:{} - IF interface kanal = 0{} THEN interface task := niltask;{} hardwaremanager := niltask{} ELSE begin (PROC kanalkoppler, interface task);{} hardwaremanager := myself{} FI.{} erfrage interfacekanal:{} INT VAR kanalnummer;{} put ("Gib Interface - Kanal:");{} get (kanalnummer);{} set interfacechannel (kanalnummer).{}END PROC init interfacechannel;{}PROC set interface channel (INT CONST channel number):{} IF channel number < 0 OR channel number > max channel{} THEN errorstop ("Unzulässige Kanalnummer!"){} - ELSE interface kanal := channel number{} FI{}END PROC set interface channel;{}BOOL OP <> (TASK CONST t1, t2):{} NOT (t1 = t2){}END OP <>;{}init interfacechannel{}END PACKET ls warenhaus 0{} + interface anpassung, + oeffne interface, + schliesse interface, + wert von interface, + pressed key, +(* --------------------------- *) + kanalkoppler, + interfacechannel, + init interfacechannel: +TEXT CONST interface anpassung :: "mit Kartenleser an MUFI als Endgerät"; +LET mufikennung = ""27""27"", + max channel = 24, + initcode = 26, + endcode = 27, + read code = 28; +INT CONST nicht initialisiert code :: -3, + interface error code :: -4, + + kanal besetzt code :: -5; +INT VAR interfacekanal :: 2; +TEXT VAR puffer :: ""; +TASK VAR hardwaremanager :: niltask, + interface task :: niltask, + absender; +DATASPACE VAR ds :: nilspace; +INT PROC interfacechannel: + interfacekanal +END PROC interfacechannel; +PROC oeffne interface (INT VAR status): + puffer := ""; + forget (ds); ds := nilspace; + pingpong (interfacetask, init code, ds, status); + IF status > 0 THEN status DECR maxint FI; + + forget (ds); ds := nilspace +END PROC oeffne interface; +INT PROC wert von interface: + INT VAR wert; + puffer CAT incharety (1); + call (interface task, read code, ds, wert); + wert. +END PROC wert von interface; +PROC schliesse interface: + forget (ds); ds := nilspace; + send (interface task, end code, ds); + forget (ds); ds := nilspace +END PROC schliesse interface; +TEXT PROC pressed key: + IF puffer = "" + THEN incharety + ELSE erstes pufferzeichen + FI. + erstes pufferzeichen: + + TEXT VAR zeichen :: puffer SUB 1; + puffer := subtext (puffer, 2); + zeichen. +END PROC pressed key; +TEXT PROC pressed key (INT CONST warten): + IF puffer = "" + THEN incharety (warten) + ELSE erstes pufferzeichen + FI. + erstes pufferzeichen: + TEXT VAR zeichen :: puffer SUB 1; + puffer := subtext (puffer, 2); + zeichen. +END PROC pressed key; +(*************************************************************************) +PROC kanalkoppler: + enable stop; + IF name (myself) <> "-" + + THEN errorstop ("Unzulässiges Kommando!") + ELSE warte auf anrufe + FI. + warte auf anrufe: + INT VAR codenummer, antwort; + disable stop; + REP wait (ds, codenummer, absender); + reagiere auf anruf; + loesche ggf fehlerzustand + PER. + reagiere auf anruf: + IF codenummer = initcode + THEN kopple an interface; + IF interface ist betriebsbereit + THEN bearbeite weitere auftraege + ELSE gib negative rueckmeldung + + FI; + gib kanal frei + ELSE send (absender, nicht initialisiert code, ds) + FI. + loesche ggf fehlerzustand: + IF is error + THEN clear error + FI. + kopple an interface: + IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself + THEN antwort := kanal besetzt code; + ELSE continue (interfacekanal); + teste interface + FI. + teste interface: + leere puffer; + out (mufikennung + "10"); + fange status; + IF status = mufikennung + "00" + + THEN antwort := 0; + out (mufikennung + "1A18"22"") + ELSE antwort := interface error code + FI. + leere puffer: + REP UNTIL incharety = "" PER. + fange status: + INT VAR zaehler; + TEXT VAR status :: ""; + FOR zaehler FROM 1 UPTO 4 REP + status CAT incharety (1) + PER. + interface ist betriebsbereit: antwort = 0. + gib negative rueckmeldung: send (absender, antwort, ds). + gib kanal frei: break (quiet). + ende: out (""25""). + + bearbeite weitere auftraege: + REP pingpong (absender, antwort, ds, codenummer); + IF codenummer = read code + THEN hole wert von interface + ELIF codenummer < 0 + THEN send (absender, codenummer, ds); + codenummer := endcode + ELSE antwort := 0 + FI + UNTIL codenummer = endcode PER; + ende. + hole wert von interface: + out (""76""); + antwort := code (incharety (1)). +END PROC kanalkoppler; +PROC init interfacechannel: + + teste auf zulaessigkeit; + loesche interfacetask; + erfrage interface kanal; + generiere ggf neue interfacetask. + teste auf zulaessigkeit: + enable stop; + IF hardwaremanager <> niltask AND hardwaremanager <> myself + THEN errorstop ("Dieses Kommando kann nur von der Task '" + + name (hardwaremanager) + "' aus gegeben werden!") + FI. + loesche interfacetask: + disable stop; + end (interfacetask); + IF is error THEN clear error FI; + enable stop. + generiere ggf neue interfacetask: + + IF interface kanal = 0 + THEN interface task := niltask; + hardwaremanager := niltask + ELSE begin (PROC kanalkoppler, interface task); + hardwaremanager := myself + FI. + erfrage interfacekanal: + INT VAR kanalnummer; + put ("Gib Interface - Kanal:"); + get (kanalnummer); + set interfacechannel (kanalnummer). +END PROC init interfacechannel; +PROC set interface channel (INT CONST channel number): + IF channel number < 0 OR channel number > max channel + THEN errorstop ("Unzulässige Kanalnummer!") + + ELSE interface kanal := channel number + FI +END PROC set interface channel; +BOOL OP <> (TASK CONST t1, t2): + NOT (t1 = t2) +END OP <>; +init interfacechannel +END PACKET ls warenhaus 0 + diff --git a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal index 30c69da..54bb73e 100644 --- a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal +++ b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal @@ -22,9 +22,88 @@ *) PACKET ls warenhaus 0 DEFINES - interface anpassung,{} oeffne interface,{} schliesse interface,{} wert von interface,{} pressed key:{}TEXT CONST interface anpassung :: "mit Kartenleser an MUFI im Terminalkanal";{}LET mufikennung = ""31""31"";{}INT CONST interface error code :: -4;{}TEXT CONST readcode :: mufikennung + "4C";{}TEXT VAR puffer :: "";{}PROC oeffne interface (INT VAR status):{} cursor (2,24);{} warte etwas;{} leere eingangspuffer;{} out (""27""27"10");{} fange antwort;{} IF antwort = ""27""27"00"{} - THEN status := 0;{} out (""27""27"1C" + hex (mufikennung)){} ELSE status := interface error code{} FI.{} warte etwas:{} pause (1); pause (1); pause (1); pause (1); pause (1).{} leere eingangspuffer:{} puffer := "";{} REP UNTIL incharety = "" PER.{} fange antwort:{} TEXT VAR antwort :: incharety (1);{} INT VAR i;{} FOR i FROM 1 UPTO 3 REP{} antwort CAT incharety (1){} PER.{}END PROC oeffne interface;{}INT PROC wert von interface:{} puffer CAT incharety (1);{} - out (readcode);{} fange mufikennung;{} dezimalwert (incharety (1), incharety (1)).{} fange mufikennung:{} REP puffer CAT incharety{} UNTIL pos (puffer, mufikennung) > 0 PER;{} change (puffer, mufikennung, "").{}END PROC wert von interface;{}PROC schliesse interface:{} cursor (2,24);{} out (mufikennung + "1C" + hex (""27""27"")){}END PROC schliesse interface;{}TEXT PROC pressed key:{} IF puffer = ""{} THEN incharety{} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} - TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{} IF puffer = ""{} THEN incharety (warten){} ELSE erstes pufferzeichen{} FI.{} erstes pufferzeichen:{} TEXT VAR zeichen :: puffer SUB 1;{} puffer := subtext (puffer, 2);{} zeichen.{}END PROC pressed key;{}INT PROC dezimalwert (TEXT CONST zeichen 1, zeichen 2):{} 16 * pos (hexzeichen, zeichen 1) + pos (hexzeichen, zeichen 2).{} - hexzeichen: "123456789ABCDEF".{}END PROC dezimalwert;{}TEXT PROC hex (TEXT CONST zwei zeichen):{} hex (code (zwei zeichen SUB 1)) + hex (code (zwei zeichen SUB 2)){}END PROC hex;{}TEXT PROC hex (INT CONST wert):{} (hexzeichen SUB (wert DIV 16 + 1)) + (hexzeichen SUB (wert MOD 16 + 1)).{} hexzeichen: "0123456789ABCDEF".{}END PROC hex{}END PACKET ls warenhaus 0{} + interface anpassung, + oeffne interface, + schliesse interface, + wert von interface, + pressed key: +TEXT CONST interface anpassung :: "mit Kartenleser an MUFI im Terminalkanal"; +LET mufikennung = ""31""31""; +INT CONST interface error code :: -4; +TEXT CONST readcode :: mufikennung + "4C"; +TEXT VAR puffer :: ""; +PROC oeffne interface (INT VAR status): + cursor (2,24); + warte etwas; + leere eingangspuffer; + out (""27""27"10"); + fange antwort; + IF antwort = ""27""27"00" + + THEN status := 0; + out (""27""27"1C" + hex (mufikennung)) + ELSE status := interface error code + FI. + warte etwas: + pause (1); pause (1); pause (1); pause (1); pause (1). + leere eingangspuffer: + puffer := ""; + REP UNTIL incharety = "" PER. + fange antwort: + TEXT VAR antwort :: incharety (1); + INT VAR i; + FOR i FROM 1 UPTO 3 REP + antwort CAT incharety (1) + PER. +END PROC oeffne interface; +INT PROC wert von interface: + puffer CAT incharety (1); + + out (readcode); + fange mufikennung; + dezimalwert (incharety (1), incharety (1)). + fange mufikennung: + REP puffer CAT incharety + UNTIL pos (puffer, mufikennung) > 0 PER; + change (puffer, mufikennung, ""). +END PROC wert von interface; +PROC schliesse interface: + cursor (2,24); + out (mufikennung + "1C" + hex (""27""27"")) +END PROC schliesse interface; +TEXT PROC pressed key: + IF puffer = "" + THEN incharety + ELSE erstes pufferzeichen + FI. + erstes pufferzeichen: + + TEXT VAR zeichen :: puffer SUB 1; + puffer := subtext (puffer, 2); + zeichen. +END PROC pressed key; +TEXT PROC pressed key (INT CONST warten): + IF puffer = "" + THEN incharety (warten) + ELSE erstes pufferzeichen + FI. + erstes pufferzeichen: + TEXT VAR zeichen :: puffer SUB 1; + puffer := subtext (puffer, 2); + zeichen. +END PROC pressed key; +INT PROC dezimalwert (TEXT CONST zeichen 1, zeichen 2): + 16 * pos (hexzeichen, zeichen 1) + pos (hexzeichen, zeichen 2). + + hexzeichen: "123456789ABCDEF". +END PROC dezimalwert; +TEXT PROC hex (TEXT CONST zwei zeichen): + hex (code (zwei zeichen SUB 1)) + hex (code (zwei zeichen SUB 2)) +END PROC hex; +TEXT PROC hex (INT CONST wert): + (hexzeichen SUB (wert DIV 16 + 1)) + (hexzeichen SUB (wert MOD 16 + 1)). + hexzeichen: "0123456789ABCDEF". +END PROC hex +END PACKET ls warenhaus 0 + diff --git a/warenhaus/ls-Warenhaus 0: ohne Kartenleser b/warenhaus/ls-Warenhaus 0: ohne Kartenleser index 4912d64..96af5c1 100644 --- a/warenhaus/ls-Warenhaus 0: ohne Kartenleser +++ b/warenhaus/ls-Warenhaus 0: ohne Kartenleser @@ -22,6 +22,28 @@ *) PACKET ls warenhaus 0 DEFINES - interface anpassung,{} oeffne interface,{} schliesse interface,{} wert von interface,{} pressed key:{}TEXT CONST interface anpassung :: "ohne Kartenleser";{}PROC oeffne interface (INT VAR test):{} test := -6{}END PROC oeffne interface;{}PROC schliesse interface:{}END PROC schliesse interface;{}INT PROC wert von interface:{} INT VAR wert :: 0;{} wert{}END PROC wert von interface;{}TEXT PROC pressed key:{} incharety{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{} - incharety (warten){}END PROC pressed key;{}END PACKET ls warenhaus 0{} + interface anpassung, + oeffne interface, + schliesse interface, + wert von interface, + pressed key: +TEXT CONST interface anpassung :: "ohne Kartenleser"; +PROC oeffne interface (INT VAR test): + test := -6 +END PROC oeffne interface; +PROC schliesse interface: +END PROC schliesse interface; +INT PROC wert von interface: + INT VAR wert :: 0; + wert +END PROC wert von interface; +TEXT PROC pressed key: + incharety +END PROC pressed key; +TEXT PROC pressed key (INT CONST warten): + + incharety (warten) +END PROC pressed key; +END PACKET ls warenhaus 0 + diff --git a/warenhaus/ls-Warenhaus 1 b/warenhaus/ls-Warenhaus 1 index 81fd8ee..c3976b4 100644 --- a/warenhaus/ls-Warenhaus 1 +++ b/warenhaus/ls-Warenhaus 1 @@ -22,16 +22,214 @@ *) PACKET monitor alt DEFINES original monitor: - PROC original monitor:{} monitor{} END PROC originalmonitor{}END PACKET monitor alt;{}PACKET ls warenhaus 1 DEFINES{} zentrale,{} monitor,{} warenhaus direktstart,{} warenhaus hauptstelle,{} hauptstellenname:{}LET max kundenzahl = 31,{} min kundennummer = 129,{} kundendatei holen code = 100,{} kundendatei ergaenzen code = 200;{}TYPE KUNDENDATEN = STRUCT (TEXT nachname, vorname, geschlecht),{} KUNDENDATEI = ROW max kundenzahl KUNDENDATEN;{}{} -BOUND KUNDENDATEN VAR kundendaten;{}BOUND KUNDENDATEI VAR bound kundendatei;{}KUNDENDATEI VAR kundendatei;{}DATASPACE VAR ds;{}TASK VAR absender,{} zentraltask :: niltask,{} hauptstelle :: niltask,{} direktstartmanager :: niltask;{}BOOL VAR mit direktstart :: FALSE,{} mit loeschen :: FALSE;{}INT VAR codenummer;{}PROC zentrale:{} enable stop;{} IF pos (name (myself), ".Zentrale") = 0{} THEN errorstop ("Unzulaessiger Befehl!"){}{} - FI;{} disable stop;{} REP wait (ds, codenummer, absender);{} bearbeite auftrag;{} send (absender, codenummer, ds);{} IF is error THEN clear error FI{} PER.{} bearbeite auftrag:{} IF codenummer = kundendatei holen code{} THEN hole kundendatei{} ELIF codenummer = kundendatei ergaenzen code{} THEN ergaenze kundendatei{} ELIF codenummer >= min kundennummer{} THEN lies kundendaten{} ELSE speichere kundendaten{} FI.{}END PROC zentrale;{}{} -PROC hole kundendatei:{} bound kundendatei := ds;{} bound kundendatei := kundendatei{}END PROC hole kundendatei;{}PROC ergaenze kundendatei:{} INT VAR kundennummer;{} bound kundendatei := ds;{} FOR kundennummer FROM 1 UPTO max kundenzahl REP{} IF kundendatei [kundennummer].nachname = ""{} THEN kundendatei [kundennummer] := bound kundendatei [kundennummer]{} FI{} PER;{} init ds{}END PROC ergaenze kundendatei;{}PROC lies kundendaten:{} kundendaten := ds;{} kundendaten := kundendatei [platznummer].{}{} - platznummer: codenummer - min kundennummer + 1.{}END PROC lies kundendaten;{}PROC speichere kundendaten:{} kundendaten := ds;{} kundendatei [codenummer] := kundendaten;{} init ds{}END PROC speichere kundendaten;{}PROC warenhaus hauptstelle (BOOL CONST task soll hauptstelle sein):{} enable stop;{} IF task soll hauptstelle sein{} THEN mache task zur hauptstelle{} ELSE mache hauptstellenstatus rueckgaengig{} FI.{} mache task zur hauptstelle:{} sei eine hauptstelle;{} line (2);{}{} - IF NOT mit direktstart CAND yes ("Mit Direktstart"){} THEN warenhaus direktstart (TRUE){} ELSE global manager{} FI{}END PROC warenhaus hauptstelle;{}PROC sei eine hauptstelle:{} IF NOT (hauptstelle = niltask OR hauptstelle = myself){} THEN errorstop ("Hauptstelle ist bereits die Task '" +{} name (hauptstelle) + "'!"){} FI;{} disable stop;{} end (zentraltask);{} IF is error THEN clear error FI;{} enable stop;{} hauptstelle := niltask;{} begin (name (myself) + ".Zentrale", PROC zentrale, zentraltask);{}{} - hauptstelle := myself{}END PROC sei eine hauptstelle;{}PROC mache hauptstellenstatus rueckgaengig:{} IF NOT (hauptstelle = niltask OR hauptstelle = myself){} THEN errorstop ("Dieses Kommando darf nur in der Task '" +{} name (hauptstelle) + " gegeben werden!"){} FI;{} disable stop;{} end (zentraltask);{} IF is error THEN clear error FI;{} enable stop;{} hauptstelle := niltask;{} warenhaus direktstart (FALSE){}END PROC mache hauptstellenstatus rueckgaengig;{}PROC warenhaus direktstart (BOOL CONST wahl):{}{} - pruefe zulaessigkeit;{} mit direktstart := wahl;{} IF mit direktstart{} THEN direktstartmanager := myself;{} mit loeschen := yes ("Mit automatischem Löschen"){} ELSE direktstartmanager := niltask{} FI;{} global manager.{} pruefe zulaessigkeit:{} enable stop;{} IF NOT (direktstartmanager = niltask OR direktstartmanager = myself){} THEN errorstop ("Der Direktstart kann nur aus der Task '" +{} name (direktstartmanager) + "'geaendert werden!"){}{} - FI.{}END PROC warenhaus direktstart;{}TEXT PROC hauptstellenname:{} name (hauptstelle){}END PROC hauptstellenname;{}PROC monitor:{} IF mit direktstart{} THEN warenhaus monitor{} ELSE original monitor{} FI{}END PROC monitor;{}PROC warenhausmonitor:{} disable stop;{} INT VAR previous heapsize := heap size;{} REP command dialogue (TRUE);{} sysin (""); sysout ("");{} cry if not enough storage;{} reset dialog; erase menunotice;{} do ("warenhaus");{} IF is error{}{} - THEN clear error{} ELSE sitzungsende{} FI{} PER.{} sitzungsende:{} collect heap garbage if necessary;{} page;{} IF mit loeschen{} THEN break; end (myself){} ELSE end; break{} FI.{} collect heap garbage if necessary:{} IF heap size > previous heapsize + 10{} THEN collect heap garbage;{} previous heapsize := heap size{} FI.{} cry if not enough storage:{} INT VAR size, used;{} storage (size, used);{} IF used > size{} THEN out (""7"Speicher Engpass! Dateien loeschen!"13""10""){}{} - FI.{}END PROC warenhausmonitor;{}OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (KUNDENDATEI VAR ziel, KUNDENDATEI CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}PROC init ds:{} forget (ds); ds := nilspace{}END PROC init ds;{}PROC initialisiere kundendatei:{} KUNDENDATEN CONST leer :: KUNDENDATEN : ("", "", "");{} INT VAR nr;{} FOR nr FROM 1 UPTO max kundenzahl REP{} kundendatei [nr] := leer{} PER{}END PROC initialisiere kundendatei;{}{} -initialisiere kundendatei{}END PACKET ls warenhaus 1{}{} + PROC original monitor: + monitor + END PROC originalmonitor +END PACKET monitor alt; +PACKET ls warenhaus 1 DEFINES + zentrale, + monitor, + warenhaus direktstart, + warenhaus hauptstelle, + hauptstellenname: +LET max kundenzahl = 31, + min kundennummer = 129, + kundendatei holen code = 100, + kundendatei ergaenzen code = 200; +TYPE KUNDENDATEN = STRUCT (TEXT nachname, vorname, geschlecht), + KUNDENDATEI = ROW max kundenzahl KUNDENDATEN; + + +BOUND KUNDENDATEN VAR kundendaten; +BOUND KUNDENDATEI VAR bound kundendatei; +KUNDENDATEI VAR kundendatei; +DATASPACE VAR ds; +TASK VAR absender, + zentraltask :: niltask, + hauptstelle :: niltask, + direktstartmanager :: niltask; +BOOL VAR mit direktstart :: FALSE, + mit loeschen :: FALSE; +INT VAR codenummer; +PROC zentrale: + enable stop; + IF pos (name (myself), ".Zentrale") = 0 + THEN errorstop ("Unzulaessiger Befehl!") + + + FI; + disable stop; + REP wait (ds, codenummer, absender); + bearbeite auftrag; + send (absender, codenummer, ds); + IF is error THEN clear error FI + PER. + bearbeite auftrag: + IF codenummer = kundendatei holen code + THEN hole kundendatei + ELIF codenummer = kundendatei ergaenzen code + THEN ergaenze kundendatei + ELIF codenummer >= min kundennummer + THEN lies kundendaten + ELSE speichere kundendaten + FI. +END PROC zentrale; + + +PROC hole kundendatei: + bound kundendatei := ds; + bound kundendatei := kundendatei +END PROC hole kundendatei; +PROC ergaenze kundendatei: + INT VAR kundennummer; + bound kundendatei := ds; + FOR kundennummer FROM 1 UPTO max kundenzahl REP + IF kundendatei [kundennummer].nachname = "" + THEN kundendatei [kundennummer] := bound kundendatei [kundennummer] + FI + PER; + init ds +END PROC ergaenze kundendatei; +PROC lies kundendaten: + kundendaten := ds; + kundendaten := kundendatei [platznummer]. + + + platznummer: codenummer - min kundennummer + 1. +END PROC lies kundendaten; +PROC speichere kundendaten: + kundendaten := ds; + kundendatei [codenummer] := kundendaten; + init ds +END PROC speichere kundendaten; +PROC warenhaus hauptstelle (BOOL CONST task soll hauptstelle sein): + enable stop; + IF task soll hauptstelle sein + THEN mache task zur hauptstelle + ELSE mache hauptstellenstatus rueckgaengig + FI. + mache task zur hauptstelle: + sei eine hauptstelle; + line (2); + + + IF NOT mit direktstart CAND yes ("Mit Direktstart") + THEN warenhaus direktstart (TRUE) + ELSE global manager + FI +END PROC warenhaus hauptstelle; +PROC sei eine hauptstelle: + IF NOT (hauptstelle = niltask OR hauptstelle = myself) + THEN errorstop ("Hauptstelle ist bereits die Task '" + + name (hauptstelle) + "'!") + FI; + disable stop; + end (zentraltask); + IF is error THEN clear error FI; + enable stop; + hauptstelle := niltask; + begin (name (myself) + ".Zentrale", PROC zentrale, zentraltask); + + + hauptstelle := myself +END PROC sei eine hauptstelle; +PROC mache hauptstellenstatus rueckgaengig: + IF NOT (hauptstelle = niltask OR hauptstelle = myself) + THEN errorstop ("Dieses Kommando darf nur in der Task '" + + name (hauptstelle) + " gegeben werden!") + FI; + disable stop; + end (zentraltask); + IF is error THEN clear error FI; + enable stop; + hauptstelle := niltask; + warenhaus direktstart (FALSE) +END PROC mache hauptstellenstatus rueckgaengig; +PROC warenhaus direktstart (BOOL CONST wahl): + + + pruefe zulaessigkeit; + mit direktstart := wahl; + IF mit direktstart + THEN direktstartmanager := myself; + mit loeschen := yes ("Mit automatischem Löschen") + ELSE direktstartmanager := niltask + FI; + global manager. + pruefe zulaessigkeit: + enable stop; + IF NOT (direktstartmanager = niltask OR direktstartmanager = myself) + THEN errorstop ("Der Direktstart kann nur aus der Task '" + + name (direktstartmanager) + "'geaendert werden!") + + + FI. +END PROC warenhaus direktstart; +TEXT PROC hauptstellenname: + name (hauptstelle) +END PROC hauptstellenname; +PROC monitor: + IF mit direktstart + THEN warenhaus monitor + ELSE original monitor + FI +END PROC monitor; +PROC warenhausmonitor: + disable stop; + INT VAR previous heapsize := heap size; + REP command dialogue (TRUE); + sysin (""); sysout (""); + cry if not enough storage; + reset dialog; erase menunotice; + do ("warenhaus"); + IF is error + + + THEN clear error + ELSE sitzungsende + FI + PER. + sitzungsende: + collect heap garbage if necessary; + page; + IF mit loeschen + THEN break; end (myself) + ELSE end; break + FI. + collect heap garbage if necessary: + IF heap size > previous heapsize + 10 + THEN collect heap garbage; + previous heapsize := heap size + FI. + cry if not enough storage: + INT VAR size, used; + storage (size, used); + IF used > size + THEN out (""7"Speicher Engpass! Dateien loeschen!"13""10"") + + + FI. +END PROC warenhausmonitor; +OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle): + CONCR (ziel) := CONCR (quelle) +END OP :=; +OP := (KUNDENDATEI VAR ziel, KUNDENDATEI CONST quelle): + CONCR (ziel) := CONCR (quelle) +END OP :=; +PROC init ds: + forget (ds); ds := nilspace +END PROC init ds; +PROC initialisiere kundendatei: + KUNDENDATEN CONST leer :: KUNDENDATEN : ("", "", ""); + INT VAR nr; + FOR nr FROM 1 UPTO max kundenzahl REP + kundendatei [nr] := leer + PER +END PROC initialisiere kundendatei; + + +initialisiere kundendatei +END PACKET ls warenhaus 1 + + diff --git a/warenhaus/ls-Warenhaus 2 b/warenhaus/ls-Warenhaus 2 index 7048aff..f7a9945 100644 --- a/warenhaus/ls-Warenhaus 2 +++ b/warenhaus/ls-Warenhaus 2 @@ -22,91 +22,1236 @@ *) PACKET ls warenhaus 2 DEFINES - max artikelzahl,{} max kundenzahl,{} min kundennummer,{} max kundennummer,{} min artikelnummer,{} max artikelnummer,{} filialverwaltung,{} initialisiere verwaltung,{} hole artikeldaten,{} speichere artikeldaten,{} registriere verkauf,{} hole kundendaten,{} speichere kundendaten,{} sichere filialdaten,{} lade filialdaten,{} hole bestelliste,{} hole auskunft ein:{}LET max filialen = 10,{} max artikel = 15,{} - max kunden = 31,{} min kundennr = 129,{} max kundennr = 159,{} min artikelnr = 1,{} max artikelnr = 15;{}LET zentrale kundendatei holen code = 100,{} zentrale kundendatei ergaenzen code = 200,{} filialdaten holen code = 201,{} filialdaten ergaenzen code = 202;{}INT CONST max artikelzahl :: max artikel,{} max kundenzahl :: max kunden,{} min kundennummer :: min kundennr,{} max kundennummer :: max kundennr,{} - min artikelnummer :: min artikelnr,{} max artikelnummer :: max artikelnr;{}TYPE ARTIKELDATEN = STRUCT (TEXT artikelname, REAL preis,{} INT mindestbestand, bestand),{} KUNDENDATEN = STRUCT (TEXT nachname, vorname, geschlecht),{} WARENDATEI = ROW max artikel ARTIKELDATEN,{} KUNDENDATEI = ROW max kunden KUNDENDATEN,{} EINKAUFSDATEI = ROW max kunden ROW max artikel INT,{} VERKAUFSDATEI = ROW max artikel INT,{} FILIALDATEN = STRUCT (WARENDATEI waren, KUNDENDATEI kunden,{} - EINKAUFSDATEI einkaeufe,{} VERKAUFSDATEI hitliste);{}KUNDENDATEI VAR kunde;{}WARENDATEI VAR artikel;{}EINKAUFSDATEI VAR einkaufsdatei;{}VERKAUFSDATEI VAR verkaufszahl;{}DATASPACE VAR ds;{}INT VAR codenummer, reply code;{}TASK VAR zentrale, verwaltung, absender;{}TEXT VAR hauptstelle :: "",{} filialnummer :: "0",{} filialverwaltungsname :: "";{}PROC filialverwaltung:{} enable stop;{} - IF pos (name (myself), ".Filialverwaltung") = 0{} THEN errorstop ("Unzulaessiger Befehl!"){} FI;{} disable stop;{} REP wait (ds, codenummer, absender);{} bearbeite auftrag;{} send (absender, 0, ds);{} IF is error THEN clear error FI{} PER.{} bearbeite auftrag:{} IF codenummer <= max artikel{} THEN artikeldaten speichern{} ELIF codenummer <= max kundennr{} THEN kauf registrieren{} ELIF codenummer <= max kundennr + max kunden{} THEN kundendaten speichern{} - ELIF codenummer = filialdaten holen code{} THEN filialdaten holen{} ELIF codenummer = filialdaten ergaenzen code{} THEN filialdaten ergaenzen; init ds{} ELIF codenummer = 256{} THEN sperre task{} FI.{} sperre task:{} call (absender, 256, ds, codenummer).{}END PROC filialverwaltung;{}PROC artikeldaten speichern:{} BOUND ARTIKELDATEN VAR artikeldaten :: ds;{} artikel [codenummer] := artikeldaten;{} init ds{}END PROC artikeldaten speichern;{}PROC kauf registrieren:{} - artikelnummer aus ds lesen;{} artikel [artikelnummer].bestand DECR 1;{} verkaufszahl [artikelnummer] INCR 1;{} IF kundennummer > 0{} THEN einkaufsdatei [kundennummer][artikelnummer] INCR 1{} FI.{} artikelnummer aus ds lesen:{} BOUND INT VAR nummer :: ds;{} INT CONST artikelnummer :: nummer,{} kundennummer :: codenummer - min kundennr + 1;{} init ds{}END PROC kauf registrieren;{}PROC kundendaten speichern:{} BOUND KUNDENDATEN VAR kundendaten :: ds;{} kunde [codenummer - min kundennr - max kunden + 1] := kundendaten{} -END PROC kundendaten speichern;{}PROC filialdaten holen:{} init ds;{} BOUND FILIALDATEN VAR filialdaten :: ds;{} CONCR (filialdaten.waren) := CONCR (artikel);{} CONCR (filialdaten.kunden) := CONCR (kunde);{} CONCR (filialdaten.einkaeufe) := CONCR (einkaufsdatei);{} CONCR (filialdaten.hitliste) := CONCR (verkaufszahl){}END PROC filialdaten holen;{}PROC filialdaten ergaenzen:{} BOUND FILIALDATEN VAR neue daten :: ds;{} INT VAR kundennummer, artikelnummer;{} ergaenze artikeldatei und verkaufszahlen;{} - ergaenze kundendatei;{} ergaenze einkaufsdatei.{} ergaenze artikeldatei und verkaufszahlen:{} FOR artikelnummer FROM 1 UPTO max artikel REP{} verkaufszahl [artikelnummer] INCR neue daten.hitliste [artikelnummer];{} IF artikel [artikelnummer].artikelname = ""{} THEN artikel [artikelnummer] := neue daten.waren [artikelnummer]{} FI{} PER.{} ergaenze kundendatei:{} FOR kundennummer FROM 1 UPTO max kunden REP{} IF kunde [kundennummer].nachname = ""{} THEN kunde [kundennummer] := neue daten.kunden [kundennummer]{} - FI{} PER.{} ergaenze einkaufsdatei:{} FOR kundennummer FROM 1 UPTO max kunden REP{} FOR artikelnummer FROM 1 UPTO max artikel REP{} einkaufsdatei [kundennummer][artikelnummer]{} INCR neue daten.einkaeufe [kundennummer][artikelnummer]{} PER{} PER.{}END PROC filialdaten ergaenzen;{}OP := (ARTIKELDATEN VAR ziel, ARTIKELDATEN CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle):{} CONCR (ziel) := CONCR (quelle){} -END OP :=;{}PROC init ds:{} forget (ds); ds := nilspace{}END PROC init ds;{}(************************************************************************){}PROC initialisiere verwaltung:{} hauptstelle := hauptstellenname;{} zentrale := task (hauptstelle + ".Zentrale");{} filialnummer := text (channel (myself));{} filialverwaltungsname := hauptstellenname + ".Filialverwaltung ";{} begin (filialverwaltungsname + filialnummer,{} PROC filialverwaltung, verwaltung){}END PROC initialisiere verwaltung;{} -PROC hole artikeldaten (INT CONST artikelnummer,{} TEXT VAR name, REAL VAR preis,{} INT VAR mindestbestand, bestand):{} enable stop;{} pruefe artikelnummer;{} hole daten.{} pruefe artikelnummer:{} INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{} IF artikelindex < 1 OR artikelindex > max artikel{} THEN errorstop ("Unzulässige Artikelnummer!"){} FI.{} hole daten:{} name := artikel [artikelindex].artikelname;{} - preis := artikel [artikelindex].preis;{} mindestbestand := artikel [artikelindex].mindestbestand;{} bestand := artikel [artikelindex].bestand.{}END PROC hole artikeldaten;{}PROC speichere artikeldaten (INT CONST artikelnummer,{} TEXT CONST name, REAL CONST preis,{} INT CONST mindestbestand, bestand):{} enable stop;{} pruefe artikelnummer;{} speichere daten;{} schicke kopie an verwaltung.{} pruefe artikelnummer:{} - INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{} IF artikelindex < 1 OR artikelindex > max artikel{} THEN errorstop ("Unzulässige Artikelnummer!"){} FI.{} speichere daten:{} artikel [artikelindex].artikelname := name;{} artikel [artikelindex].preis := preis;{} artikel [artikelindex].mindestbestand:= mindestbestand;{} artikel [artikelindex].bestand := bestand.{} schicke kopie an verwaltung:{} init ds;{} BOUND ARTIKELDATEN VAR artikeldaten :: ds;{} - artikeldaten := artikel [artikelindex];{} call (verwaltung, artikelindex, ds, reply code).{}END PROC speichere artikeldaten;{}PROC registriere verkauf (INT CONST kundennummer, artikelnummer):{} enable stop;{} pruefe daten;{} speichere daten;{} schicke kopie zur verwaltung.{} pruefe daten:{} INT VAR kundenindex :: kundennummer - min kundennr + 1,{} artikelindex :: artikelnummer - min artikelnr + 1;{} IF kundenindex < 0 OR kundenindex > max kunden{} THEN errorstop ("Unzulässige Kundennummer!"){} - ELIF artikelindex < 1 OR artikelindex > max artikel{} THEN errorstop ("Unzulässige Artikelnummer!"){} FI.{} speichere daten:{} IF artikel [artikelindex].bestand > 0{} THEN artikel [artikelindex].bestand DECR 1;{} verkaufszahl [artikelindex] INCR 1;{} IF kundenindex > 0{} THEN trage evtl in einkaufsdatei ein{} FI FI.{} trage evtl in einkaufsdatei ein:{} IF kunde [kundenindex].nachname = ""{} THEN kundenindex := 0{} ELSE einkaufsdatei [kundenindex][artikelindex] INCR 1{} - FI.{} schicke kopie zur verwaltung:{} init ds;{} BOUND INT VAR nummer :: ds;{} nummer := artikelindex;{} call (verwaltung, kundenindex + min kundennr - 1, ds, reply code).{}END PROC registriere verkauf;{}PROC hole kundendaten (INT CONST kundennummer,{} TEXT VAR nachname, vorname, geschlecht):{} enable stop;{} pruefe kundennummer;{} rufe zentrale an;{} uebergib die zentraldaten;{} IF aenderungen vorhanden{} THEN aktualisiere filialdaten{} FI;{} forget (ds).{} - pruefe kundennummer:{} INT CONST index :: kundennummer - min kundennr + 1;{} IF index < 1 OR index > max kunden{} THEN errorstop ("Unzulässige Kundennummer!"){} FI.{} rufe zentrale an:{} init ds;{} call (zentrale, kundennummer, ds, reply code).{} aenderungen vorhanden:{} (kunde [index].nachname <> nachname ) OR{} (kunde [index].vorname <> vorname ) OR{} (kunde [index].geschlecht <> geschlecht).{} aktualisiere filialdaten:{} kunde [index] := daten von zentrale;{} - call (verwaltung, kundennummer + max kunden, ds, reply code).{} uebergib die zentraldaten:{} BOUND KUNDENDATEN VAR daten von zentrale :: ds;{} nachname := daten von zentrale.nachname;{} vorname := daten von zentrale.vorname;{} geschlecht := daten von zentrale.geschlecht.{}END PROC hole kundendaten;{}PROC speichere kundendaten(INT CONST kundennummer,{} TEXT CONST nachname, vorname, geschlecht):{} enable stop;{} pruefe kundennummer;{} IF kundendaten geaendert{} - THEN speichere daten;{} schicke kopie an verwaltung und zentrale{} FI.{} pruefe kundennummer:{} IF kundennummer < min kundennr OR kundennummer > max kundennr{} THEN errorstop ("Unzulässige Kundennummer!"){} FI.{} kundendaten geaendert:{} INT CONST index :: kundennummer - min kundennr + 1;{} nachname <> kunde [index].nachname OR{} vorname <> kunde [index].vorname OR{} geschlecht <> kunde [index].geschlecht.{} speichere daten:{} kunde [index].nachname := nachname;{} - kunde [index].vorname := vorname;{} kunde [index].geschlecht := geschlecht.{} schicke kopie an verwaltung und zentrale:{} init ds;{} BOUND KUNDENDATEN VAR kundendaten :: ds;{} kundendaten := kunde [index];{} call (verwaltung, kundennummer + max kunden, ds, reply code);{} call (zentrale, kundennummer - min kundennr + 1, ds, reply code);{} forget (ds).{}END PROC speichere kundendaten;{}PROC sichere filialdaten (TEXT CONST name):{} enable stop;{} filialdaten holen;{} - type (ds, 1951);{} forget (name, quiet);{} copy (ds, name);{} forget (ds){}END PROC sichere filialdaten;{}PROC lade filialdaten (TEXT CONST name):{} enable stop;{} forget (ds);{} ds := old (name);{} IF type (ds) = 1951{} THEN filialdaten ergaenzen;{} kopie an verwaltung schicken;{} kopie der kundendatei an zentrale schicken{} ELSE errorstop ("'" + name + "' enthält keine Filialdaten!"){} FI.{} kopie an verwaltung schicken:{} call (verwaltung, filialdaten ergaenzen code, ds, reply code).{} - kopie der kundendatei an zentrale schicken:{} BOUND KUNDENDATEI VAR kundendatei :: ds;{} CONCR (CONCR (kundendatei)) := CONCR (kunde);{} call (zentrale, zentrale kundendatei ergaenzen code, ds, reply code).{}END PROC lade filialdaten;{}PROC hole bestelliste (FILE VAR f):{} bereite datei vor;{} schreibe daten in datei.{} bereite datei vor:{} forget("Nachbestellung",quiet);{} f := sequential file (output, "Nachbestellung");{} line (f);{} write (f, " Nachbestellungen für " +{} - invers ("Filiale " + filialnummer)+":");{} line;{} write (f, " ==================================================");{} line (f, 2);{} write (f, " | Art.Nr. | Artikelname | Anzahl |");{} line (f);{} write (f, " +----------+-------------------------+-----------+");{} line (f).{} schreibe daten in datei:{} INT VAR artikelnummer;{} FOR artikelnummer FROM 1 UPTO max artikel REP{} IF artikel[artikelnummer].bestand{} - < artikel[artikelnummer].mindestbestand{} THEN bestelle artikel nach{} FI{} PER;{} write (f, " +----------+-------------------------+-----------+");{} line (f).{} bestelle artikel nach:{} write (f, " | " + wirkliche artikelnummer + " | "{} + text (artikel [artikelnummer].artikelname, 23) + " | "{} + text (nachzubestellende anzahl, 6) + " |");{} line (f);{} artikel [artikelnummer].bestand{} := 2 * artikel [artikelnummer].mindestbestand.{} - wirkliche artikelnummer:{} text (artikelnummer + min artikelnr - 1, 5).{} nachzubestellende anzahl:{} 2 * artikel [artikelnummer].mindestbestand{} - artikel [artikelnummer].bestand.{}END PROC hole bestelliste;{}PROC hole auskunft ein (INT CONST codenummer, artikel oder kundennummer,{} FILE VAR f):{} enable stop;{} hauptstelle := hauptstellenname;{} SELECT codenummer OF CASE 66 : hitliste von zentrale (f){} CASE 67 : hitliste von filiale (f){} - CASE 68 : hitlisten aller filialen (f){} (* --------------------------------------------- *){} CASE 73 : artikelkaeuferliste von zentrale{} (artikel oder kundennummer, f){} CASE 74 : artikelkaeuferliste von filiale{} (artikel oder kundennummer, f){} CASE 75 : artikelkaeuferlisten aller filialen{} (artikel oder kundennummer, f){} - (* --------------------------------------------- *){} CASE 77 : kundenliste von zentrale (f){} CASE 78 : kundenliste von filiale (f){} CASE 79 : kundenlisten aller filialen (f){} (* --------------------------------------------- *){} CASE 84 : kundeneinkaufsliste von zentrale{} (artikel oder kundennummer, f){} CASE 85 : kundeneinkaufsliste von filiale{} - (artikel oder kundennummer, f){} CASE 86 : kundeneinkaufslisten aller filialen{} (artikel oder kundennummer, f){} (* --------------------------------------------- *){} CASE 89 : lageruebersicht von zentrale (f){} CASE 90 : lageruebersicht von filiale (f){} CASE 91 : lageruebersichten aller filialen (f){} (* --------------------------------------------- *){} - OTHERWISE errorstop ("Unzulässige Code - Nummer bei Auskunft!"){} END SELECT{}END PROC hole auskunft ein;{}PROC hitliste von zentrale (FILE VAR f):{} INT VAR filialnr;{} beginne mit eigener filiale;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr <> int (filialnummer) CAND{} exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in zentralliste{} - FI{} PER;{} werte zentralliste aus.{} beginne mit eigener filiale:{} WARENDATEI VAR zentrale warendatei;{} CONCR (zentrale warendatei) := CONCR (artikel);{} VERKAUFSDATEI VAR zentrale verkaufsdatei;{} CONCR (zentrale verkaufsdatei) := CONCR (verkaufszahl).{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{} BOUND FILIALDATEN VAR aktuelle daten :: ds.{} schreibe daten in zentralliste:{} INT VAR i;{} - FOR i FROM 1 UPTO max artikel REP{} IF zentrale warendatei [i].artikelname = ""{} THEN zentrale warendatei [i] := aktuelle daten.waren [i]{} FI;{} zentrale verkaufsdatei [i] INCR aktuelle daten.hitliste [i]{} PER.{} werte zentralliste aus:{} forget (ds);{} forget ("Auskunft: Zentrale", quiet);{} f := sequential file (output, "Auskunft: Zentrale");{} line (f);{} write (f, " Zentrale Warenliste, geordnet nach Verkaufszahlen:");{} sortiere (zentrale warendatei, zentrale verkaufsdatei);{} - fuelle (f, zentrale warendatei, zentrale verkaufsdatei).{}END PROC hitliste von zentrale;{}PROC hitliste von filiale (FILE VAR f):{} bereite auskunftsdatei vor;{} kopiere artikeldatei und verkaufsdatei;{} sortiere (hilfsdatei artikel, hilfsdatei verkaufszahlen);{} fuelle (f,hilfsdatei artikel, hilfsdatei verkaufszahlen).{} kopiere artikeldatei und verkaufsdatei:{} WARENDATEI VAR hilfsdatei artikel;{} CONCR (hilfsdatei artikel) := CONCR (artikel);{} VERKAUFSDATEI VAR hilfsdatei verkaufszahlen;{} - CONCR (hilfsdatei verkaufszahlen) := CONCR (verkaufszahl).{} bereite auskunftsdatei vor:{} forget ("Auskunft: Filiale " + filialnummer, quiet);{} f := sequential file (output, "Auskunft: Filiale " + filialnummer);{} line (f);{} write (f, " Warenliste, geordnet nach Verkaufszahlen:").{}END PROC hitliste von filiale;{}PROC hitlisten aller filialen (FILE VAR f):{} WARENDATEI VAR aktuelle warendatei;{} VERKAUFSDATEI VAR aktuelle verkaufsdatei;{} INT VAR filialnr;{} - bereite auskunftsdatei vor;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr = int (filialnummer){} THEN nimm eigene daten{} ELIF exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} arbeite mit diesen daten{} FI{} PER;{} forget (ds).{} bereite auskunftsdatei vor:{} forget ("Auskunft: Alle Filialen", quiet);{} f := sequential file (output, "Auskunft: Alle Filialen");{} - line (f).{} nimm eigene daten:{} CONCR (aktuelle warendatei) := CONCR (artikel);{} CONCR (aktuelle verkaufsdatei) := CONCR (verkaufszahl);{} sortiere und fuelle.{} sortiere und fuelle:{} write (f, " Warenliste von " + invers ("Filiale " + text (filialnr)){} + ", geordnet nach Verkaufszahlen:");{} sortiere (aktuelle warendatei, aktuelle verkaufsdatei);{} fuelle (f,aktuelle warendatei, aktuelle verkaufsdatei).{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{} - BOUND FILIALDATEN VAR aktuelle daten :: ds.{} arbeite mit diesen daten:{} CONCR (aktuelle warendatei) := CONCR (aktuelle daten.waren);{} CONCR (aktuelle verkaufsdatei) := CONCR (aktuelle daten.hitliste);{} sortiere und fuelle.{}END PROC hitlisten aller filialen;{}PROC sortiere (WARENDATEI VAR warendatei, VERKAUFSDATEI VAR stueckzahl):{} INT VAR i,j;{} FOR i FROM 1 UPTO max artikel - 1 REP{} FOR j FROM i + 1 UPTO max artikel REP{} IF stueckzahl [i] < stueckzahl [j]{} THEN vertausche{} - FI{} PER PER.{} vertausche:{} INT CONST hilfsint :: stueckzahl [i];{} ARTIKELDATEN CONST hilfsartikel :: warendatei [i];{} stueckzahl [i] := stueckzahl [j];{} warendatei [i] := warendatei [j];{} stueckzahl [j] := hilfsint;{} warendatei [j] := hilfsartikel.{}END PROC sortiere;{}PROC fuelle (FILE VAR f, WARENDATEI VAR warendat, VERKAUFSDATEI VAR anzahl):{} INT VAR nummer, platz :: 0;{} bereite datei vor;{} schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f," ============================================================");{} - line (f,2);{} write(f," | Platz | Verk.Anzahl | Artikelname | Preis |");{} line (f);{} write(f," +-------+-------------+------------------------+-----------+");{} line (f).{}schreibe daten in datei:{} FOR nummer FROM 1 UPTO max artikel REP{} IF warendat [nummer].artikelname <> ""{} THEN schreibe in datei; line (f){} FI{} PER;{} write(f," +-------+-------------+------------------------+-----------+");{} line (f,3).{}schreibe in datei:{} platz INCR 1;{} write (f, " |" + text (platz, 5) + " |"{} - + text (anzahl [nummer], 9) + " | "{} + text (warendat [nummer].artikelname, 22) + " | "{} + text (warendat [nummer].preis,8,2) + " |").{}END PROC fuelle;{}PROC artikelkaeuferliste von zentrale (INT CONST artikelnummer, FILE VAR f):{} INT VAR filialnr;{} pruefe artikelnummer;{} beginne mit eigener filiale;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} - IF filialnr <> int (filialnummer) CAND{} exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in zentralliste{} FI{} PER;{} werte zentralliste aus.{} pruefe artikelnummer:{} INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{} IF artikelindex < 1 OR artikelindex > max artikel{} THEN errorstop ("Unzulässige Artikelnummer!"){} FI.{} beginne mit eigener filiale:{} TEXT VAR aktueller artikelname :: artikel [artikelindex].artikelname;{} - KUNDENDATEI VAR hilfsdatei;{} CONCR (hilfsdatei) := CONCR (kunde);{} ROW max kunden INT VAR kaeufe;{} INT VAR i;{} FOR i FROM 1 UPTO max kunden REP{} kaeufe [i] := einkaufsdatei [i][artikelindex]{} PER.{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).{} schreibe daten in zentralliste:{} BOUND FILIALDATEN VAR aktuelle daten :: ds;{} IF aktueller artikelname = ""{} THEN aktueller artikelname{} - := aktuelle daten.waren [artikelindex].artikelname{} FI;{} FOR i FROM 1 UPTO max kunden REP{} kaeufe [i] INCR aktuelle daten.einkaeufe [i][artikelindex];{} IF hilfsdatei [i].nachname = ""{} THEN hilfsdatei [i] := aktuelle daten.kunden [i]{} FI{} PER.{} werte zentralliste aus:{} forget (ds);{} forget ("Auskunft: Zentrale", quiet);{} f := sequential file (output, "Auskunft: Zentrale");{} line (f);{} IF aktueller artikelname = ""{} THEN write (f, " Der Artikel Nr. " + text (artikelindex){} - + " wird in keiner Filiale geführt.");{} line (f);{} write(f,{} " ============================================================");{} line (f,3);{} ELSE write (f, " Gesamtkäuferliste des Artikels "{} + invers (aktueller artikelname) + ":");{} fuelle (f, hilfsdatei, kaeufe){} FI.{}END PROC artikelkaeuferliste von zentrale;{}PROC artikelkaeuferliste von filiale (INT CONST artikelnummer, FILE VAR f):{} - pruefe artikelnummer;{} kopiere einkaufszahlen in hilfsliste;{} erstelle filialliste.{} pruefe artikelnummer:{} INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{} IF artikelindex < 1 OR artikelindex > max artikel{} THEN errorstop ("Unzulässige Artikelnummer!"){} FI.{} kopiere einkaufszahlen in hilfsliste:{} ROW max kunden INT VAR kaeufe;{} INT VAR i;{} FOR i FROM 1 UPTO max kunden REP{} kaeufe [i] := einkaufsdatei [i][artikelindex]{} PER.{} erstelle filialliste:{} - forget ("Auskunft: Filiale " + filialnummer, quiet);{} f := sequential file (output, "Auskunft: Filiale " + filialnummer);{} line (f);{} IF artikel [artikelindex].artikelname = ""{} THEN write (f, " Der Artikel Nr. " + text (artikelindex){} + " wird in dieser Filiale nicht geführt.");{} line (f);{} write(f,{} " ============================================================");{} line (f,3);{} ELSE write (f, " Käufer des Artikels "{} - + invers (artikel [artikelindex].artikelname){} + ":");{} fuelle (f, kunde, kaeufe){} FI.{}END PROC artikelkaeuferliste von filiale;{}PROC artikelkaeuferlisten aller filialen(INT CONST artikelnummer,FILE VAR f):{} INT VAR i, filialnr;{} ROW max kunden INT VAR kaeufe;{} pruefe artikelnummer;{} bereite datei vor;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} - IF filialnr = int (filialnummer){} THEN kopiere eigene einkaufszahlen in hilfsliste;{} schreibe eigene daten in auskunftsdatei{} ELIF exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in auskunftsdatei{} FI{} PER;{} forget (ds).{} pruefe artikelnummer:{} INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{} IF artikelindex < 1 OR artikelindex > max artikel{} THEN errorstop ("Unzulässige Artikelnummer!"){} - FI.{} bereite datei vor:{} forget ("Auskunft: Alle Filialen", quiet);{} f := sequential file (output, "Auskunft: Alle Filialen");{} line (f).{} kopiere eigene einkaufszahlen in hilfsliste:{} FOR i FROM 1 UPTO max kunden REP{} kaeufe [i] := einkaufsdatei [i][artikelindex]{} PER.{} schreibe eigene daten in auskunftsdatei:{} IF artikel [artikelindex].artikelname = ""{} THEN write (f, " Der Artikel Nr. " + text (artikelindex){} + " wird in "{} - + invers ("Filiale " + filialnummer){} + " nicht geführt.");{} line (f);{} write(f,{} " ============================================================");{} line (f,3){} ELSE write (f, " Käufer des Artikels '"{} + artikel [artikelindex].artikelname{} + "' in " + invers ("Filiale " + filialnummer) + ":");{} fuelle(f, kunde, kaeufe){} FI.{} hole daten dieser filiale:{} - init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{} BOUND FILIALDATEN VAR aktuelle daten :: ds;{} TEXT CONST aktueller artikelname{} := aktuelle daten.waren [artikelindex].artikelname{} FOR i FROM 1 UPTO max kunden REP{} kaeufe [i] := aktuelle daten.einkaeufe [i][artikelindex];{} PER.{} schreibe daten in auskunftsdatei:{} IF aktueller artikelname = ""{} THEN write (f, " Der Artikel Nr. " + text (artikelindex){} - + " wird in "{} + invers ("Filiale " + text (filialnr)){} + " nicht geführt.");{} line (f);{} write(f,{} " ============================================================");{} line (f,3){} ELSE write (f, " Käufer des Artikels '"{} + aktueller artikelname{} + "' in " + invers ("Filiale " + text(filialnr)) + ":");{} fuelle(f, aktuelle daten.kunden, kaeufe){} - FI.{}END PROC artikelkaeuferlisten aller filialen;{}PROC fuelle (FILE VAR f, KUNDENDATEI CONST kundenliste,{} ROW max kunden INT CONST einkaufszahlen):{} INT VAR kundennummer;{} bereite datei vor;{} schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f," ============================================================");{} line (f, 2);{} write(f," | Anzahl | Nachname, Vorname | Geschlecht |");{} line (f);{} write(f," +--------+------------------------------------+------------+");{} - line (f).{}schreibe daten in datei:{} FOR kundennummer FROM 1 UPTO max kunden REP{} IF einkaufszahlen [kundennummer] > 0{} THEN schreibe in datei; line (f);{} FI{} PER;{} write(f," +--------+------------------------------------+------------+");{} line (f, 3).{}schreibe in datei:{} write(f," |" + text(einkaufszahlen [kundennummer], 5) + " | "{} + text(kundenliste [kundennummer].nachname + ",", 17) + " "{} + text(kundenliste [kundennummer].vorname, 16) + " | ");{} - IF kundenliste [kundennummer].geschlecht = "m"{} THEN write (f, " männlich |"){} ELIF kundenliste [kundennummer].geschlecht = "w"{} THEN write (f, " weiblich |"){} ELSE write (f, " |"){} FI.{}END PROC fuelle;{}PROC kundenliste von zentrale (FILE VAR f):{} hole kundenliste von zentrale;{} bereite datei vor;{} schreibe daten in datei.{} hole kundenliste von zentrale:{} init ds;{} call (zentrale, zentrale kundendatei holen code, ds, reply code);{} BOUND KUNDENDATEI VAR zentrale kundenliste :: ds.{} - bereite datei vor:{} forget ("Auskunft: Zentrale", quiet);{} f := sequential file (output, "Auskunft: Zentrale");{} line (f);{} write (f, " Zentrale Kundenliste:").{} schreibe daten in datei:{} fuelle (f, zentrale kundenliste);{} forget (ds).{}END PROC kundenliste von zentrale;{}PROC kundenliste von filiale (FILE VAR f):{} bereite datei vor;{} schreibe daten in datei.{} bereite datei vor:{} forget ("Auskunft: Filiale " + filialnummer, quiet);{} f := sequential file (output, "Auskunft: Filiale " + filialnummer);{} - line (f);{} write (f," Kundenliste:").{} schreibe daten in datei:{} fuelle (f, kunde).{}END PROC kundenliste von filiale;{}PROC kundenlisten aller filialen (FILE VAR f):{} INT VAR filialnr;{} bereite datei vor;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr = int (filialnummer){} THEN schreibe eigene daten in auskunftsdatei{} ELIF exists task (aktuelle verwaltung){} - THEN hole daten dieser filiale;{} schreibe daten dieser filiale in auskunftsdatei{} FI{} PER.{} bereite datei vor:{} forget ("Auskunft: Alle Filialen", quiet);{} f := sequential file (output, "Auskunft: Alle Filialen");{} line (f).{} schreibe eigene daten in auskunftsdatei:{} schreibe ueberschrift;{} fuelle (f, kunde).{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{} BOUND FILIALDATEN VAR aktuelle filialdaten :: ds.{} - schreibe daten dieser filiale in auskunftsdatei:{} schreibe ueberschrift;{} fuelle (f, aktuelle filialdaten.kunden).{} schreibe ueberschrift:{} write (f, " Kundenliste für " +{} invers ("Filiale " + text (filialnr)) + ":").{}END PROC kundenlisten aller filialen;{}PROC fuelle (FILE VAR f, KUNDENDATEI VAR kundendatei):{} INT VAR kundennummer;{} bereite datei vor;{} schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f," ============================================================");{} - line (f,2);{} write(f," | Kun.Nr.| Nachname, Vorname | Geschlecht |");{} line (f);{} write(f," +--------+------------------------------------+------------+");{} line (f).{}schreibe daten in datei:{} FOR kundennummer FROM 1 UPTO max kunden REP{} IF kundendatei [kundennummer].nachname <> ""{} THEN schreibe in datei; line (f){} FI{} PER;{} write(f," +--------+------------------------------------+------------+");{} line (f, 3).{}schreibe in datei:{} write (f, " |" + text (kundennummer + min kundennummer - 1, 6) + " | "{} - + text (kundendatei [kundennummer].nachname + ",", 17) + " "{} + text (kundendatei [kundennummer].vorname, 16) + " | ");{} IF kundendatei [kundennummer].geschlecht = "m"{} THEN write (f, " männlich |"){} ELIF kundendatei [kundennummer].geschlecht = "w"{} THEN write (f, " weiblich |"){} ELSE write (f, " |"){} FI.{}END PROC fuelle;{}PROC kundeneinkaufsliste von zentrale (INT CONST kundennummer, FILE VAR f):{} INT VAR filialnr;{} - pruefe kundennummer;{} beginne mit eigener filiale;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr <> int (filialnummer) CAND{} exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in zentralliste{} FI{} PER;{} werte zentralliste aus.{} pruefe kundennummer:{} INT CONST kundenindex :: kundennummer - min kundennr + 1;{} - IF kundenindex < 1 OR kundenindex > max kunden{} THEN errorstop ("Unzulässige Kundennummer!"){} FI.{} beginne mit eigener filiale:{} KUNDENDATEN VAR aktueller kunde :: kunde [kundenindex];{} WARENDATEI VAR hilfsdatei;{} CONCR (hilfsdatei) := CONCR (artikel);{} ROW max artikel INT VAR kaeufe;{} INT VAR i;{} FOR i FROM 1 UPTO max artikel REP{} kaeufe [i] := einkaufsdatei [kundenindex][i]{} PER.{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).{} - schreibe daten in zentralliste:{} BOUND FILIALDATEN VAR aktuelle daten :: ds;{} IF aktueller kunde.nachname = ""{} THEN aktueller kunde := aktuelle daten.kunden [kundenindex]{} FI;{} FOR i FROM 1 UPTO max artikel REP{} kaeufe [i] INCR aktuelle daten.einkaeufe [kundenindex][i];{} IF hilfsdatei [i].artikelname = ""{} THEN hilfsdatei [i] := aktuelle daten.waren [i]{} FI{} PER.{} werte zentralliste aus:{} forget (ds);{} forget ("Auskunft: Zentrale", quiet);{} - f := sequential file (output, "Auskunft: Zentrale");{} line (f);{} IF aktueller kunde.nachname = ""{} THEN write (f, " Ein Kunde mit Nr. " + text (kundenindex){} + " ist in keiner Filiale bekannt.");{} line (f);{} write(f,{} " ============================================================");{} line (f,3);{} ELSE write (f, " Gesamteinkaufsliste " + anrede{} + invers (aktueller kundenname) + ":");{} - fuelle (f, hilfsdatei, kaeufe){} FI.{} anrede:{} IF aktueller kunde.geschlecht = "m"{} THEN "des Kunden "{} ELIF aktueller kunde.geschlecht = "w"{} THEN "der Kundin "{} ELSE "von "{} FI.{} aktueller kundenname:{} (aktueller kunde.vorname SUB 1) + ". " + aktueller kunde.nachname.{}END PROC kundeneinkaufsliste von zentrale;{}PROC kundeneinkaufsliste von filiale (INT CONST kundennummer, FILE VAR f):{} pruefe kundennummer;{} erstelle filialliste.{} - pruefe kundennummer:{} INT CONST kundenindex :: kundennummer - min kundennr + 1;{} IF kundenindex < 1 OR kundenindex > max kunden{} THEN errorstop ("Unzulässige Kundennummer!"){} FI.{} erstelle filialliste:{} forget ("Auskunft: Filiale " + filialnummer, quiet);{} f := sequential file (output, "Auskunft: Filiale " + filialnummer);{} line (f);{} IF kunde [kundenindex].nachname = ""{} THEN schicke leere liste zurueck{} ELSE schreibe dateikopf;{} fuelle (f, artikel, einkaufsdatei [kundenindex]){} - FI.{} schicke leere liste zurueck:{} write (f," Ein Kunde mit Nr. " + text (kundennummer) + " ist in "{} + "dieser Filiale nicht bekannt.");{} line (f);{} write (f,{} " ============================================================");{} line (f,3).{} schreibe dateikopf:{} write (f, " Einkaufsliste " + anrede +{} invers ((kunde [kundenindex].vorname SUB 1) + ". " +{} kunde [kundenindex].nachname) + ":").{} anrede:{} IF kunde [kundenindex].geschlecht = "m"{} - THEN "des Kunden "{} ELIF kunde [kundenindex].geschlecht = "w"{} THEN "der Kundin "{} ELSE "von "{} FI.{}END PROC kundeneinkaufsliste von filiale;{}PROC kundeneinkaufslisten aller filialen (INT CONST kundennummer,FILE VAR f):{} INT VAR filialnr;{} pruefe kundennummer;{} bereite datei vor;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr = int (filialnummer){} - THEN schreibe eigene daten in auskunftsdatei{} ELIF exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in auskunftsdatei{} FI{} PER;{} forget (ds).{} pruefe kundennummer:{} INT CONST kundenindex :: kundennummer - min kundennr + 1;{} IF kundenindex < 1 OR kundenindex > max kunden{} THEN errorstop ("Unzulässige Kundennummer!"){} FI.{} bereite datei vor:{} forget ("Auskunft: Alle Filialen", quiet);{} f := sequential file (output, "Auskunft: Alle Filialen");{} - line (f).{} schreibe eigene daten in auskunftsdatei:{} IF kunde [kundenindex].nachname = ""{} THEN write (f," Ein Kunde mit Nr. " + text (kundennummer){} + " ist in " + invers ("Filiale " + filialnummer){} + " nicht bekannt.");{} line (f);{} write(f,{} " ============================================================");{} line (f,3){} ELSE write (f, " Einkaufsliste " + anrede hier +{} (kunde [kundenindex].vorname SUB 1) + ". " +{} - kunde [kundenindex].nachname +{} " in " + invers ("Filiale " + filialnummer) + ":");{} fuelle (f, artikel, einkaufsdatei [kundenindex]){} FI.{} anrede hier:{} IF kunde [kundenindex].geschlecht = "m"{} THEN "des Kunden "{} ELIF kunde [kundenindex].geschlecht = "w"{} THEN "der Kundin "{} ELSE "von "{} FI.{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{} - BOUND FILIALDATEN VAR aktuelle daten :: ds;{} KUNDENDATEN CONST aktueller kunde := aktuelle daten.kunden [kundenindex].{} schreibe daten in auskunftsdatei:{} IF aktueller kunde.nachname = ""{} THEN write (f," Ein Kunde mit Nr. " + text (kundennummer){} + " ist in " + invers ("Filiale " + text (filialnr)){} + " nicht bekannt.");{} line (f);{} write(f,{} " ============================================================");{} - line (f,3){} ELSE write (f, " Einkaufsliste " + anrede +{} (aktueller kunde.vorname SUB 1) + ". " +{} aktueller kunde.nachname +{} " in " + invers ("Filiale " + text (filialnr)) + ":");{} fuelle (f, aktuelle daten.waren,{} aktuelle daten.einkaeufe [kundenindex]){} FI.{} anrede:{} IF aktueller kunde.geschlecht = "m"{} THEN "des Kunden "{} ELIF aktueller kunde.geschlecht = "w"{} - THEN "der Kundin "{} ELSE "von "{} FI.{}END PROC kundeneinkaufslisten aller filialen;{}PROC fuelle (FILE VAR f, WARENDATEI CONST warendatei,{} ROW max artikel INT CONST einkaufszahlen):{} INT VAR artikelnummer;{} REAL VAR gesamtpreis, summe :: 0.0;{} bereite datei vor;{} schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f," ============================================================");{} line (f,2);{} write(f," | Art.Nr.| Artikelname | Anzahl | Preis | Gesamt |");{} - line (f);{} write(f," +--------+-------------------+--------+---------+----------+");{} line (f).{}schreibe daten in datei:{} FOR artikelnummer FROM 1 UPTO max artikel REP{} IF einkaufszahlen [artikelnummer] > 0{} THEN schreibe in datei; line (f){} FI{} PER;{} write(f," +--------+-------------------+--------+---------+----------+");{} line (f);{} write(f," Summe: " +{} text (summe,8,2));{} - line (f, 3).{}schreibe in datei:{} gesamtpreis := real (einkaufszahlen [artikelnummer]) *{} warendatei [artikelnummer].preis;{} summe INCR gesamtpreis;{} write (f," |" + text(artikelnummer,5) + " | "{} + text(warendatei [artikelnummer].artikelname,17) + " | "{} + text(einkaufszahlen [artikelnummer],4) + " |"{} + text(warendatei [artikelnummer].preis,7,2) + " |"{} + text(gesamtpreis,8,2) + " |").{} -END PROC fuelle;{}PROC lageruebersicht von zentrale (FILE VAR f):{} INT VAR filialnr;{} beginne mit eigener filiale;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr <> int (filialnummer) CAND{} exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in zentralliste{} FI{} PER;{} werte zentralliste aus.{} beginne mit eigener filiale:{} - WARENDATEI VAR hilfsdatei;{} CONCR (hilfsdatei) := CONCR (artikel).{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).{} schreibe daten in zentralliste:{} BOUND FILIALDATEN VAR aktuelle daten :: ds;{} INT VAR i;{} FOR i FROM 1 UPTO max artikel REP{} IF hilfsdatei [i].artikelname = ""{} THEN hilfsdatei [i] := aktuelle daten.waren [i]{} ELSE hilfsdatei [i].mindestbestand INCR aktuell.mindestbestand;{} - hilfsdatei [i].bestand INCR aktuell.bestand{} FI{} PER.{} aktuell: aktuelle daten.waren [i].{} werte zentralliste aus:{} forget (ds);{} forget ("Auskunft: Zentrale", quiet);{} f := sequential file (output, "Auskunft: Zentrale");{} line (f);{} write (f, " Zentrale Lagerübersicht:");{} fuelle (f, hilfsdatei).{}END PROC lageruebersicht von zentrale;{}PROC lageruebersicht von filiale (FILE VAR f):{} forget ("Auskunft: Filiale " + filialnummer, quiet);{} - f := sequential file (output, "Auskunft: Filiale " + filialnummer);{} schreibe dateikopf;{} fuelle (f, artikel).{} schreibe dateikopf:{} line (f);{} write (f, " Lagerübersicht:").{}END PROC lageruebersicht von filiale;{}PROC lageruebersichten aller filialen (FILE VAR f):{} INT VAR filialnr;{} bereite datei vor;{} FOR filialnr FROM 1 UPTO max filialen REP{} TEXT CONST aktuelle verwaltung ::{} hauptstelle + ".Filialverwaltung " + text (filialnr);{} IF filialnr = int (filialnummer){} - THEN schreibe eigene daten in auskunftsdatei{} ELIF exists task (aktuelle verwaltung){} THEN hole daten dieser filiale;{} schreibe daten in auskunftsdatei{} FI{} PER;{} forget (ds).{} bereite datei vor:{} forget ("Auskunft: Alle Filialen", quiet);{} f := sequential file (output, "Auskunft: Alle Filialen").{} schreibe eigene daten in auskunftsdatei:{} line (f);{} write (f, " Lagerübersicht für " +{} invers ("Filiale " + filialnummer) + ":");{} - fuelle (f, artikel).{} hole daten dieser filiale:{} init ds;{} call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{} BOUND FILIALDATEN VAR aktuelle daten :: ds.{} schreibe daten in auskunftsdatei:{} line (f);{} write (f, " Lagerübersicht für " +{} invers ("Filiale " + text (filialnr)) + ":");{} fuelle (f, aktuelle daten.waren).{}END PROC lageruebersichten aller filialen;{}PROC fuelle (FILE VAR f, WARENDATEI CONST warendatei):{} INT VAR artikelnummer;{} - bereite datei vor;{} schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f," ============================================================");{} line (f,2);{} write(f," | Art.Nr.| Artikelname | Preis | Min.Best.| Bestand |");{} line (f);{} write(f," +--------+-------------------+--------+----------+---------+");{} line (f).{}schreibe daten in datei:{} FOR artikelnummer FROM 1 UPTO max artikel REP{} IF warendatei[artikelnummer].artikelname <> ""{} THEN schreibe in datei; line (f){} - FI{} PER;{} write(f," +--------+-------------------+--------+----------+---------+");{} line (f, 3).{}schreibe in datei:{} write (f, " |" + text(artikelnummer,5) + " | "{} + text(warendatei[artikelnummer].artikelname,17) + " |"{} + text(warendatei[artikelnummer].preis,7,2) + " | "{} + text(warendatei[artikelnummer].mindestbestand,6)+" | "{} + text(warendatei[artikelnummer].bestand,6) + " |").{}END PROC fuelle;{} -PROC initialisiere dateien:{} INT VAR kundennummer, artikelnummer;{} FOR kundennummer FROM 1 UPTO max kunden REP{} kunde [kundennummer].nachname := "";{} kunde [kundennummer].vorname := "";{} kunde [kundennummer].geschlecht := ""{} PER;{} FOR artikelnummer FROM 1 UPTO max artikel REP{} verkaufszahl [artikelnummer] := 0;{} artikel [artikelnummer].mindestbestand := 0;{} artikel [artikelnummer].bestand := 0;{} artikel [artikelnummer].artikelname := "";{} - artikel [artikelnummer].preis := 0.0;{} FOR kundennummer FROM 1 UPTO max kunden REP{} einkaufsdatei[kundennummer][artikelnummer] := 0{} PER;{} PER{}END PROC initialisiere dateien;{}initialisiere dateien{}END PACKET ls warenhaus 2{} + max artikelzahl, + max kundenzahl, + min kundennummer, + max kundennummer, + min artikelnummer, + max artikelnummer, + filialverwaltung, + initialisiere verwaltung, + hole artikeldaten, + speichere artikeldaten, + registriere verkauf, + hole kundendaten, + speichere kundendaten, + sichere filialdaten, + lade filialdaten, + hole bestelliste, + hole auskunft ein: +LET max filialen = 10, + max artikel = 15, + + max kunden = 31, + min kundennr = 129, + max kundennr = 159, + min artikelnr = 1, + max artikelnr = 15; +LET zentrale kundendatei holen code = 100, + zentrale kundendatei ergaenzen code = 200, + filialdaten holen code = 201, + filialdaten ergaenzen code = 202; +INT CONST max artikelzahl :: max artikel, + max kundenzahl :: max kunden, + min kundennummer :: min kundennr, + max kundennummer :: max kundennr, + + min artikelnummer :: min artikelnr, + max artikelnummer :: max artikelnr; +TYPE ARTIKELDATEN = STRUCT (TEXT artikelname, REAL preis, + INT mindestbestand, bestand), + KUNDENDATEN = STRUCT (TEXT nachname, vorname, geschlecht), + WARENDATEI = ROW max artikel ARTIKELDATEN, + KUNDENDATEI = ROW max kunden KUNDENDATEN, + EINKAUFSDATEI = ROW max kunden ROW max artikel INT, + VERKAUFSDATEI = ROW max artikel INT, + FILIALDATEN = STRUCT (WARENDATEI waren, KUNDENDATEI kunden, + + EINKAUFSDATEI einkaeufe, + VERKAUFSDATEI hitliste); +KUNDENDATEI VAR kunde; +WARENDATEI VAR artikel; +EINKAUFSDATEI VAR einkaufsdatei; +VERKAUFSDATEI VAR verkaufszahl; +DATASPACE VAR ds; +INT VAR codenummer, reply code; +TASK VAR zentrale, verwaltung, absender; +TEXT VAR hauptstelle :: "", + filialnummer :: "0", + filialverwaltungsname :: ""; +PROC filialverwaltung: + enable stop; + + IF pos (name (myself), ".Filialverwaltung") = 0 + THEN errorstop ("Unzulaessiger Befehl!") + FI; + disable stop; + REP wait (ds, codenummer, absender); + bearbeite auftrag; + send (absender, 0, ds); + IF is error THEN clear error FI + PER. + bearbeite auftrag: + IF codenummer <= max artikel + THEN artikeldaten speichern + ELIF codenummer <= max kundennr + THEN kauf registrieren + ELIF codenummer <= max kundennr + max kunden + THEN kundendaten speichern + + ELIF codenummer = filialdaten holen code + THEN filialdaten holen + ELIF codenummer = filialdaten ergaenzen code + THEN filialdaten ergaenzen; init ds + ELIF codenummer = 256 + THEN sperre task + FI. + sperre task: + call (absender, 256, ds, codenummer). +END PROC filialverwaltung; +PROC artikeldaten speichern: + BOUND ARTIKELDATEN VAR artikeldaten :: ds; + artikel [codenummer] := artikeldaten; + init ds +END PROC artikeldaten speichern; +PROC kauf registrieren: + + artikelnummer aus ds lesen; + artikel [artikelnummer].bestand DECR 1; + verkaufszahl [artikelnummer] INCR 1; + IF kundennummer > 0 + THEN einkaufsdatei [kundennummer][artikelnummer] INCR 1 + FI. + artikelnummer aus ds lesen: + BOUND INT VAR nummer :: ds; + INT CONST artikelnummer :: nummer, + kundennummer :: codenummer - min kundennr + 1; + init ds +END PROC kauf registrieren; +PROC kundendaten speichern: + BOUND KUNDENDATEN VAR kundendaten :: ds; + kunde [codenummer - min kundennr - max kunden + 1] := kundendaten + +END PROC kundendaten speichern; +PROC filialdaten holen: + init ds; + BOUND FILIALDATEN VAR filialdaten :: ds; + CONCR (filialdaten.waren) := CONCR (artikel); + CONCR (filialdaten.kunden) := CONCR (kunde); + CONCR (filialdaten.einkaeufe) := CONCR (einkaufsdatei); + CONCR (filialdaten.hitliste) := CONCR (verkaufszahl) +END PROC filialdaten holen; +PROC filialdaten ergaenzen: + BOUND FILIALDATEN VAR neue daten :: ds; + INT VAR kundennummer, artikelnummer; + ergaenze artikeldatei und verkaufszahlen; + + ergaenze kundendatei; + ergaenze einkaufsdatei. + ergaenze artikeldatei und verkaufszahlen: + FOR artikelnummer FROM 1 UPTO max artikel REP + verkaufszahl [artikelnummer] INCR neue daten.hitliste [artikelnummer]; + IF artikel [artikelnummer].artikelname = "" + THEN artikel [artikelnummer] := neue daten.waren [artikelnummer] + FI + PER. + ergaenze kundendatei: + FOR kundennummer FROM 1 UPTO max kunden REP + IF kunde [kundennummer].nachname = "" + THEN kunde [kundennummer] := neue daten.kunden [kundennummer] + + FI + PER. + ergaenze einkaufsdatei: + FOR kundennummer FROM 1 UPTO max kunden REP + FOR artikelnummer FROM 1 UPTO max artikel REP + einkaufsdatei [kundennummer][artikelnummer] + INCR neue daten.einkaeufe [kundennummer][artikelnummer] + PER + PER. +END PROC filialdaten ergaenzen; +OP := (ARTIKELDATEN VAR ziel, ARTIKELDATEN CONST quelle): + CONCR (ziel) := CONCR (quelle) +END OP :=; +OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle): + CONCR (ziel) := CONCR (quelle) + +END OP :=; +PROC init ds: + forget (ds); ds := nilspace +END PROC init ds; +(************************************************************************) +PROC initialisiere verwaltung: + hauptstelle := hauptstellenname; + zentrale := task (hauptstelle + ".Zentrale"); + filialnummer := text (channel (myself)); + filialverwaltungsname := hauptstellenname + ".Filialverwaltung "; + begin (filialverwaltungsname + filialnummer, + PROC filialverwaltung, verwaltung) +END PROC initialisiere verwaltung; + +PROC hole artikeldaten (INT CONST artikelnummer, + TEXT VAR name, REAL VAR preis, + INT VAR mindestbestand, bestand): + enable stop; + pruefe artikelnummer; + hole daten. + pruefe artikelnummer: + INT CONST artikelindex :: artikelnummer - min artikelnr + 1; + IF artikelindex < 1 OR artikelindex > max artikel + THEN errorstop ("Unzulässige Artikelnummer!") + FI. + hole daten: + name := artikel [artikelindex].artikelname; + + preis := artikel [artikelindex].preis; + mindestbestand := artikel [artikelindex].mindestbestand; + bestand := artikel [artikelindex].bestand. +END PROC hole artikeldaten; +PROC speichere artikeldaten (INT CONST artikelnummer, + TEXT CONST name, REAL CONST preis, + INT CONST mindestbestand, bestand): + enable stop; + pruefe artikelnummer; + speichere daten; + schicke kopie an verwaltung. + pruefe artikelnummer: + + INT CONST artikelindex :: artikelnummer - min artikelnr + 1; + IF artikelindex < 1 OR artikelindex > max artikel + THEN errorstop ("Unzulässige Artikelnummer!") + FI. + speichere daten: + artikel [artikelindex].artikelname := name; + artikel [artikelindex].preis := preis; + artikel [artikelindex].mindestbestand:= mindestbestand; + artikel [artikelindex].bestand := bestand. + schicke kopie an verwaltung: + init ds; + BOUND ARTIKELDATEN VAR artikeldaten :: ds; + + artikeldaten := artikel [artikelindex]; + call (verwaltung, artikelindex, ds, reply code). +END PROC speichere artikeldaten; +PROC registriere verkauf (INT CONST kundennummer, artikelnummer): + enable stop; + pruefe daten; + speichere daten; + schicke kopie zur verwaltung. + pruefe daten: + INT VAR kundenindex :: kundennummer - min kundennr + 1, + artikelindex :: artikelnummer - min artikelnr + 1; + IF kundenindex < 0 OR kundenindex > max kunden + THEN errorstop ("Unzulässige Kundennummer!") + + ELIF artikelindex < 1 OR artikelindex > max artikel + THEN errorstop ("Unzulässige Artikelnummer!") + FI. + speichere daten: + IF artikel [artikelindex].bestand > 0 + THEN artikel [artikelindex].bestand DECR 1; + verkaufszahl [artikelindex] INCR 1; + IF kundenindex > 0 + THEN trage evtl in einkaufsdatei ein + FI FI. + trage evtl in einkaufsdatei ein: + IF kunde [kundenindex].nachname = "" + THEN kundenindex := 0 + ELSE einkaufsdatei [kundenindex][artikelindex] INCR 1 + + FI. + schicke kopie zur verwaltung: + init ds; + BOUND INT VAR nummer :: ds; + nummer := artikelindex; + call (verwaltung, kundenindex + min kundennr - 1, ds, reply code). +END PROC registriere verkauf; +PROC hole kundendaten (INT CONST kundennummer, + TEXT VAR nachname, vorname, geschlecht): + enable stop; + pruefe kundennummer; + rufe zentrale an; + uebergib die zentraldaten; + IF aenderungen vorhanden + THEN aktualisiere filialdaten + FI; + forget (ds). + + pruefe kundennummer: + INT CONST index :: kundennummer - min kundennr + 1; + IF index < 1 OR index > max kunden + THEN errorstop ("Unzulässige Kundennummer!") + FI. + rufe zentrale an: + init ds; + call (zentrale, kundennummer, ds, reply code). + aenderungen vorhanden: + (kunde [index].nachname <> nachname ) OR + (kunde [index].vorname <> vorname ) OR + (kunde [index].geschlecht <> geschlecht). + aktualisiere filialdaten: + kunde [index] := daten von zentrale; + + call (verwaltung, kundennummer + max kunden, ds, reply code). + uebergib die zentraldaten: + BOUND KUNDENDATEN VAR daten von zentrale :: ds; + nachname := daten von zentrale.nachname; + vorname := daten von zentrale.vorname; + geschlecht := daten von zentrale.geschlecht. +END PROC hole kundendaten; +PROC speichere kundendaten(INT CONST kundennummer, + TEXT CONST nachname, vorname, geschlecht): + enable stop; + pruefe kundennummer; + IF kundendaten geaendert + + THEN speichere daten; + schicke kopie an verwaltung und zentrale + FI. + pruefe kundennummer: + IF kundennummer < min kundennr OR kundennummer > max kundennr + THEN errorstop ("Unzulässige Kundennummer!") + FI. + kundendaten geaendert: + INT CONST index :: kundennummer - min kundennr + 1; + nachname <> kunde [index].nachname OR + vorname <> kunde [index].vorname OR + geschlecht <> kunde [index].geschlecht. + speichere daten: + kunde [index].nachname := nachname; + + kunde [index].vorname := vorname; + kunde [index].geschlecht := geschlecht. + schicke kopie an verwaltung und zentrale: + init ds; + BOUND KUNDENDATEN VAR kundendaten :: ds; + kundendaten := kunde [index]; + call (verwaltung, kundennummer + max kunden, ds, reply code); + call (zentrale, kundennummer - min kundennr + 1, ds, reply code); + forget (ds). +END PROC speichere kundendaten; +PROC sichere filialdaten (TEXT CONST name): + enable stop; + filialdaten holen; + + type (ds, 1951); + forget (name, quiet); + copy (ds, name); + forget (ds) +END PROC sichere filialdaten; +PROC lade filialdaten (TEXT CONST name): + enable stop; + forget (ds); + ds := old (name); + IF type (ds) = 1951 + THEN filialdaten ergaenzen; + kopie an verwaltung schicken; + kopie der kundendatei an zentrale schicken + ELSE errorstop ("'" + name + "' enthält keine Filialdaten!") + FI. + kopie an verwaltung schicken: + call (verwaltung, filialdaten ergaenzen code, ds, reply code). + + kopie der kundendatei an zentrale schicken: + BOUND KUNDENDATEI VAR kundendatei :: ds; + CONCR (CONCR (kundendatei)) := CONCR (kunde); + call (zentrale, zentrale kundendatei ergaenzen code, ds, reply code). +END PROC lade filialdaten; +PROC hole bestelliste (FILE VAR f): + bereite datei vor; + schreibe daten in datei. + bereite datei vor: + forget("Nachbestellung",quiet); + f := sequential file (output, "Nachbestellung"); + line (f); + write (f, " Nachbestellungen für " + + + invers ("Filiale " + filialnummer)+":"); + line; + write (f, " =================================================="); + line (f, 2); + write (f, " | Art.Nr. | Artikelname | Anzahl |"); + line (f); + write (f, " +----------+-------------------------+-----------+"); + line (f). + schreibe daten in datei: + INT VAR artikelnummer; + FOR artikelnummer FROM 1 UPTO max artikel REP + IF artikel[artikelnummer].bestand + + < artikel[artikelnummer].mindestbestand + THEN bestelle artikel nach + FI + PER; + write (f, " +----------+-------------------------+-----------+"); + line (f). + bestelle artikel nach: + write (f, " | " + wirkliche artikelnummer + " | " + + text (artikel [artikelnummer].artikelname, 23) + " | " + + text (nachzubestellende anzahl, 6) + " |"); + line (f); + artikel [artikelnummer].bestand + := 2 * artikel [artikelnummer].mindestbestand. + + wirkliche artikelnummer: + text (artikelnummer + min artikelnr - 1, 5). + nachzubestellende anzahl: + 2 * artikel [artikelnummer].mindestbestand + - artikel [artikelnummer].bestand. +END PROC hole bestelliste; +PROC hole auskunft ein (INT CONST codenummer, artikel oder kundennummer, + FILE VAR f): + enable stop; + hauptstelle := hauptstellenname; + SELECT codenummer OF CASE 66 : hitliste von zentrale (f) + CASE 67 : hitliste von filiale (f) + + CASE 68 : hitlisten aller filialen (f) + (* --------------------------------------------- *) + CASE 73 : artikelkaeuferliste von zentrale + (artikel oder kundennummer, f) + CASE 74 : artikelkaeuferliste von filiale + (artikel oder kundennummer, f) + CASE 75 : artikelkaeuferlisten aller filialen + (artikel oder kundennummer, f) + + (* --------------------------------------------- *) + CASE 77 : kundenliste von zentrale (f) + CASE 78 : kundenliste von filiale (f) + CASE 79 : kundenlisten aller filialen (f) + (* --------------------------------------------- *) + CASE 84 : kundeneinkaufsliste von zentrale + (artikel oder kundennummer, f) + CASE 85 : kundeneinkaufsliste von filiale + + (artikel oder kundennummer, f) + CASE 86 : kundeneinkaufslisten aller filialen + (artikel oder kundennummer, f) + (* --------------------------------------------- *) + CASE 89 : lageruebersicht von zentrale (f) + CASE 90 : lageruebersicht von filiale (f) + CASE 91 : lageruebersichten aller filialen (f) + (* --------------------------------------------- *) + + OTHERWISE errorstop ("Unzulässige Code - Nummer bei Auskunft!") + END SELECT +END PROC hole auskunft ein; +PROC hitliste von zentrale (FILE VAR f): + INT VAR filialnr; + beginne mit eigener filiale; + FOR filialnr FROM 1 UPTO max filialen REP + TEXT CONST aktuelle verwaltung :: + hauptstelle + ".Filialverwaltung " + text (filialnr); + IF filialnr <> int (filialnummer) CAND + exists task (aktuelle verwaltung) + THEN hole daten dieser filiale; + schreibe daten in zentralliste + + FI + PER; + werte zentralliste aus. + beginne mit eigener filiale: + WARENDATEI VAR zentrale warendatei; + CONCR (zentrale warendatei) := CONCR (artikel); + VERKAUFSDATEI VAR zentrale verkaufsdatei; + CONCR (zentrale verkaufsdatei) := CONCR (verkaufszahl). + hole daten dieser filiale: + init ds; + call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code); + BOUND FILIALDATEN VAR aktuelle daten :: ds. + schreibe daten in zentralliste: + INT VAR i; + + FOR i FROM 1 UPTO max artikel REP + IF zentrale warendatei [i].artikelname = "" + THEN zentrale warendatei [i] := aktuelle daten.waren [i] + FI; + zentrale verkaufsdatei [i] INCR aktuelle daten.hitliste [i] + PER. + werte zentralliste aus: + forget (ds); + forget ("Auskunft: Zentrale", quiet); + f := sequential file (output, "Auskunft: Zentrale"); + line (f); + write (f, " Zentrale Warenliste, geordnet nach Verkaufszahlen:"); + sortiere (zentrale warendatei, zentrale verkaufsdatei); + + fuelle (f, zentrale warendatei, zentrale verkaufsdatei). +END PROC hitliste von zentrale; +PROC hitliste von filiale (FILE VAR f): + bereite auskunftsdatei vor; + kopiere artikeldatei und verkaufsdatei; + sortiere (hilfsdatei artikel, hilfsdatei verkaufszahlen); + fuelle (f,hilfsdatei artikel, hilfsdatei verkaufszahlen). + kopiere artikeldatei und verkaufsdatei: + WARENDATEI VAR hilfsdatei artikel; + CONCR (hilfsdatei artikel) := CONCR (artikel); + VERKAUFSDATEI VAR hilfsdatei verkaufszahlen; + + CONCR (hilfsdatei verkaufszahlen) := CONCR (verkaufszahl). + bereite auskunftsdatei vor: + forget ("Auskunft: Filiale " + filialnummer, quiet); + f := sequential file (output, "Auskunft: Filiale " + filialnummer); + line (f); + write (f, " Warenliste, geordnet nach Verkaufszahlen:"). +END PROC hitliste von filiale; +PROC hitlisten aller filialen (FILE VAR f): + WARENDATEI VAR aktuelle warendatei; + VERKAUFSDATEI VAR aktuelle verkaufsdatei; + INT VAR filialnr; + + bereite auskunftsdatei vor; + FOR filialnr FROM 1 UPTO max filialen REP + TEXT CONST aktuelle verwaltung :: + hauptstelle + ".Filialverwaltung " + text (filialnr); + IF filialnr = int (filialnummer) + THEN nimm eigene daten + ELIF exists task (aktuelle verwaltung) + THEN hole daten dieser filiale; + arbeite mit diesen daten + FI + PER; + forget (ds). + bereite auskunftsdatei vor: + forget ("Auskunft: Alle Filialen", quiet); + f := sequential file (output, "Auskunft: Alle Filialen"); + + line (f). + nimm eigene daten: + CONCR (aktuelle warendatei) := CONCR (artikel); + CONCR (aktuelle verkaufsdatei) := CONCR (verkaufszahl); + sortiere und fuelle. + sortiere und fuelle: + write (f, " Warenliste von " + invers ("Filiale " + text (filialnr)) + + ", geordnet nach Verkaufszahlen:"); + sortiere (aktuelle warendatei, aktuelle verkaufsdatei); + fuelle (f,aktuelle warendatei, aktuelle verkaufsdatei). + hole daten dieser filiale: + init ds; + call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code); + + BOUND FILIALDATEN VAR aktuelle daten :: ds. + arbeite mit diesen daten: + CONCR (aktuelle warendatei) := CONCR (aktuelle daten.waren); + CONCR (aktuelle verkaufsdatei) := CONCR (aktuelle daten.hitliste); + sortiere und fuelle. +END PROC hitlisten aller filialen; +PROC sortiere (WARENDATEI VAR warendatei, VERKAUFSDATEI VAR stueckzahl): + INT VAR i,j; + FOR i FROM 1 UPTO max artikel - 1 REP + FOR j FROM i + 1 UPTO max artikel REP + IF stueckzahl [i] < stueckzahl [j] + THEN vertausche + + FI + PER PER. + vertausche: + INT CONST hilfsint :: stueckzahl [i]; + ARTIKELDATEN CONST hilfsartikel :: warendatei [i]; + stueckzahl [i] := stueckzahl [j]; + warendatei [i] := warendatei [j]; + stueckzahl [j] := hilfsint; + warendatei [j] := hilfsartikel. +END PROC sortiere; +PROC fuelle (FILE VAR f, WARENDATEI VAR warendat, VERKAUFSDATEI VAR anzahl): + INT VAR nummer, platz :: 0; + bereite datei vor; + schreibe daten in datei. +bereite datei vor: + line (f); + write(f," ============================================================"); + + line (f,2); + write(f," | Platz | Verk.Anzahl | Artikelname | Preis |"); + line (f); + write(f," +-------+-------------+------------------------+-----------+"); + line (f). +schreibe daten in datei: + FOR nummer FROM 1 UPTO max artikel REP + IF warendat [nummer].artikelname <> "" + THEN schreibe in datei; line (f) + FI + PER; + write(f," +-------+-------------+------------------------+-----------+"); + line (f,3). +schreibe in datei: + platz INCR 1; + write (f, " |" + text (platz, 5) + " |" + + + text (anzahl [nummer], 9) + " | " + + text (warendat [nummer].artikelname, 22) + " | " + + text (warendat [nummer].preis,8,2) + " |"). +END PROC fuelle; +PROC artikelkaeuferliste von zentrale (INT CONST artikelnummer, FILE VAR f): + INT VAR filialnr; + pruefe artikelnummer; + beginne mit eigener filiale; + FOR filialnr FROM 1 UPTO max filialen REP + TEXT CONST aktuelle verwaltung :: + hauptstelle + ".Filialverwaltung " + text (filialnr); + + IF filialnr <> int (filialnummer) CAND + exists task (aktuelle verwaltung) + THEN hole daten dieser filiale; + schreibe daten in zentralliste + FI + PER; + werte zentralliste aus. + pruefe artikelnummer: + INT CONST artikelindex :: artikelnummer - min artikelnr + 1; + IF artikelindex < 1 OR artikelindex > max artikel + THEN errorstop ("Unzulässige Artikelnummer!") + FI. + beginne mit eigener filiale: + TEXT VAR aktueller artikelname :: artikel [artikelindex].artikelname; + + KUNDENDATEI VAR hilfsdatei; + CONCR (hilfsdatei) := CONCR (kunde); + ROW max kunden INT VAR kaeufe; + INT VAR i; + FOR i FROM 1 UPTO max kunden REP + kaeufe [i] := einkaufsdatei [i][artikelindex] + PER. + hole daten dieser filiale: + init ds; + call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code). + schreibe daten in zentralliste: + BOUND FILIALDATEN VAR aktuelle daten :: ds; + IF aktueller artikelname = "" + THEN aktueller artikelname + + := aktuelle daten.waren [artikelindex].artikelname + FI; + FOR i FROM 1 UPTO max kunden REP + kaeufe [i] INCR aktuelle daten.einkaeufe [i][artikelindex]; + IF hilfsdatei [i].nachname = "" + THEN hilfsdatei [i] := aktuelle daten.kunden [i] + FI + PER. + werte zentralliste aus: + forget (ds); + forget ("Auskunft: Zentrale", quiet); + f := sequential file (output, "Auskunft: Zentrale"); + line (f); + IF aktueller artikelname = "" + THEN write (f, " Der Artikel Nr. " + text (artikelindex) + + + " wird in keiner Filiale geführt."); + line (f); + write(f, + " ============================================================"); + line (f,3); + ELSE write (f, " Gesamtkäuferliste des Artikels " + + invers (aktueller artikelname) + ":"); + fuelle (f, hilfsdatei, kaeufe) + FI. +END PROC artikelkaeuferliste von zentrale; +PROC artikelkaeuferliste von filiale (INT CONST artikelnummer, FILE VAR f): + + pruefe artikelnummer; + kopiere einkaufszahlen in hilfsliste; + erstelle filialliste. + pruefe artikelnummer: + INT CONST artikelindex :: artikelnummer - min artikelnr + 1; + IF artikelindex < 1 OR artikelindex > max artikel + THEN errorstop ("Unzulässige Artikelnummer!") + FI. + kopiere einkaufszahlen in hilfsliste: + ROW max kunden INT VAR kaeufe; + INT VAR i; + FOR i FROM 1 UPTO max kunden REP + kaeufe [i] := einkaufsdatei [i][artikelindex] + PER. + erstelle filialliste: + + forget ("Auskunft: Filiale " + filialnummer, quiet); + f := sequential file (output, "Auskunft: Filiale " + filialnummer); + line (f); + IF artikel [artikelindex].artikelname = "" + THEN write (f, " Der Artikel Nr. " + text (artikelindex) + + " wird in dieser Filiale nicht geführt."); + line (f); + write(f, + " ============================================================"); + line (f,3); + ELSE write (f, " Käufer des Artikels " + + + invers (artikel [artikelindex].artikelname) + + ":"); + fuelle (f, kunde, kaeufe) + FI. +END PROC artikelkaeuferliste von filiale; +PROC artikelkaeuferlisten aller filialen(INT CONST artikelnummer,FILE VAR f): + INT VAR i, filialnr; + ROW max kunden INT VAR kaeufe; + pruefe artikelnummer; + bereite datei vor; + FOR filialnr FROM 1 UPTO max filialen REP + TEXT CONST aktuelle verwaltung :: + hauptstelle + ".Filialverwaltung " + text (filialnr); + + IF filialnr = int (filialnummer) + THEN kopiere eigene einkaufszahlen in hilfsliste; + schreibe eigene daten in auskunftsdatei + ELIF exists task (aktuelle verwaltung) + THEN hole daten dieser filiale; + schreibe daten in auskunftsdatei + FI + PER; + forget (ds). + pruefe artikelnummer: + INT CONST artikelindex :: artikelnummer - min artikelnr + 1; + IF artikelindex < 1 OR artikelindex > max artikel + THEN errorstop ("Unzulässige Artikelnummer!") + + FI. + bereite datei vor: + forget ("Auskunft: Alle Filialen", quiet); + f := sequential file (output, "Auskunft: Alle Filialen"); + line (f). + kopiere eigene einkaufszahlen in hilfsliste: + FOR i FROM 1 UPTO max kunden REP + kaeufe [i] := einkaufsdatei [i][artikelindex] + PER. + schreibe eigene daten in auskunftsdatei: + IF artikel [artikelindex].artikelname = "" + THEN write (f, " Der Artikel Nr. " + text (artikelindex) + + " wird in " + + + invers ("Filiale " + filialnummer) + + " nicht geführt."); + line (f); + write(f, + " ============================================================"); + line (f,3) + ELSE write (f, " Käufer des Artikels '" + + artikel [artikelindex].artikelname + + "' in " + invers ("Filiale " + filialnummer) + ":"); + fuelle(f, kunde, kaeufe) + FI. + hole daten dieser filiale: + + init ds; + call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code); + BOUND FILIALDATEN VAR aktuelle daten :: ds; + TEXT CONST aktueller artikelname + := aktuelle daten.waren [artikelindex].artikelname + FOR i FROM 1 UPTO max kunden REP + kaeufe [i] := aktuelle daten.einkaeufe [i][artikelindex]; + PER. + schreibe daten in auskunftsdatei: + IF aktueller artikelname = "" + THEN write (f, " Der Artikel Nr. " + text (artikelindex) + + + " wird in " + + invers ("Filiale " + text (filialnr)) + + " nicht geführt."); + line (f); + write(f, + " ============================================================"); + line (f,3) + ELSE write (f, " Käufer des Artikels '" + + aktueller artikelname + + "' in " + invers ("Filiale " + text(filialnr)) + ":"); + fuelle(f, aktuelle daten.kunden, kaeufe) + + FI. +END PROC artikelkaeuferlisten aller filialen; +PROC fuelle (FILE VAR f, KUNDENDATEI CONST kundenliste, + ROW max kunden INT CONST einkaufszahlen): + INT VAR kundennummer; + bereite datei vor; + schreibe daten in datei. +bereite datei vor: + line (f); + write(f," ============================================================"); + line (f, 2); + write(f," | Anzahl | Nachname, Vorname | Geschlecht |"); + line (f); + write(f," +--------+------------------------------------+------------+"); + + line (f). +schreibe daten in datei: + FOR kundennummer FROM 1 UPTO max kunden REP + IF einkaufszahlen [kundennummer] > 0 + THEN schreibe in datei; line (f); + FI + PER; + write(f," +--------+------------------------------------+------------+"); + line (f, 3). +schreibe in datei: + write(f," |" + text(einkaufszahlen [kundennummer], 5) + " | " + + text(kundenliste [kundennummer].nachname + ",", 17) + " " + + text(kundenliste [kundennummer].vorname, 16) + " | "); + + IF kundenliste [kundennummer].geschlecht = "m" + THEN write (f, " männlich |") + ELIF kundenliste [kundennummer].geschlecht = "w" + THEN write (f, " weiblich |") + ELSE write (f, " |") + FI. +END PROC fuelle; +PROC kundenliste von zentrale (FILE VAR f): + hole kundenliste von zentrale; + bereite datei vor; + schreibe daten in datei. + hole kundenliste von zentrale: + init ds; + call (zentrale, zentrale kundendatei holen code, ds, reply code); + BOUND KUNDENDATEI VAR zentrale kundenliste :: ds. + + bereite datei vor: + forget ("Auskunft: Zentrale", quiet); + f := sequential file (output, "Auskunft: Zentrale"); + line (f); + write (f, " Zentrale Kundenliste:"). + schreibe daten in datei: + fuelle (f, zentrale kundenliste); + forget (ds). +END PROC kundenliste von zentrale; +PROC kundenliste von filiale (FILE VAR f): + bereite datei vor; + schreibe daten in datei. + bereite datei vor: + forget ("Auskunft: Filiale " + filialnummer, quiet); + f := sequential file (output, "Auskunft: Filiale " + filialnummer); + + line (f); + write (f," Kundenliste:"). + schreibe daten in datei: + fuelle (f, kunde). +END PROC kundenliste von filiale; +PROC kundenlisten aller filialen (FILE VAR f): + INT VAR filialnr; + bereite datei vor; + FOR filialnr FROM 1 UPTO max filialen REP + TEXT CONST aktuelle verwaltung :: + hauptstelle + ".Filialverwaltung " + text (filialnr); + IF filialnr = int (filialnummer) + THEN schreibe eigene daten in auskunftsdatei + ELIF exists task (aktuelle verwaltung) + + THEN hole daten dieser filiale; + schreibe daten dieser filiale in auskunftsdatei + FI + PER. + bereite datei vor: + forget ("Auskunft: Alle Filialen", quiet); + f := sequential file (output, "Auskunft: Alle Filialen"); + line (f). + schreibe eigene daten in auskunftsdatei: + schreibe ueberschrift; + fuelle (f, kunde). + hole daten dieser filiale: + init ds; + call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code); + BOUND FILIALDATEN VAR aktuelle filialdaten :: ds. + + schreibe daten dieser filiale in auskunftsdatei: + schreibe ueberschrift; + fuelle (f, aktuelle filialdaten.kunden). + schreibe ueberschrift: + write (f, " Kundenliste für " + + invers ("Filiale " + text (filialnr)) + ":"). +END PROC kundenlisten aller filialen; +PROC fuelle (FILE VAR f, KUNDENDATEI VAR kundendatei): + INT VAR kundennummer; + bereite datei vor; + schreibe daten in datei. +bereite datei vor: + line (f); + write(f," ============================================================"); + + line (f,2); + write(f," | Kun.Nr.| Nachname, Vorname | Geschlecht |"); + line (f); + write(f," +--------+------------------------------------+------------+"); + line (f). +schreibe daten in datei: + FOR kundennummer FROM 1 UPTO max kunden REP + IF kundendatei [kundennummer].nachname <> "" + THEN schreibe in datei; line (f) + FI + PER; + write(f," +--------+------------------------------------+------------+"); + line (f, 3). +schreibe in datei: + write (f, " |" + text (kundennummer + min kundennummer - 1, 6) + " | " + + + text (kundendatei [kundennummer].nachname + ",", 17) + " " + + text (kundendatei [kundennummer].vorname, 16) + " | "); + IF kundendatei [kundennummer].geschlecht = "m" + THEN write (f, " männlich |") + ELIF kundendatei [kundennummer].geschlecht = "w" + THEN write (f, " weiblich |") + ELSE write (f, " |") + FI. +END PROC fuelle; +PROC kundeneinkaufsliste von zentrale (INT CONST kundennummer, FILE VAR f): + INT VAR filialnr; + + pruefe kundennummer; + beginne mit eigener filiale; + FOR filialnr FROM 1 UPTO max filialen REP + TEXT CONST aktuelle verwaltung :: + hauptstelle + ".Filialverwaltung " + text (filialnr); + IF filialnr <> int (filialnummer) CAND + exists task (aktuelle verwaltung) + THEN hole daten dieser filiale; + schreibe daten in zentralliste + FI + PER; + werte zentralliste aus. + pruefe kundennummer: + INT CONST kundenindex :: kundennummer - min kundennr + 1; + + IF kundenindex < 1 OR kundenindex > max kunden + THEN errorstop ("Unzulässige Kundennummer!") + FI. + beginne mit eigener filiale: + KUNDENDATEN VAR aktueller kunde :: kunde [kundenindex]; + WARENDATEI VAR hilfsdatei; + CONCR (hilfsdatei) := CONCR (artikel); + ROW max artikel INT VAR kaeufe; + INT VAR i; + FOR i FROM 1 UPTO max artikel REP + kaeufe [i] := einkaufsdatei [kundenindex][i] + PER. + hole daten dieser filiale: + init ds; + call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code). + + schreibe daten in zentralliste: + BOUND FILIALDATEN VAR aktuelle daten :: ds; + IF aktueller kunde.nachname = "" + THEN aktueller kunde := aktuelle daten.kunden [kundenindex] + FI; + FOR i FROM 1 UPTO max artikel REP + kaeufe [i] INCR aktuelle daten.einkaeufe [kundenindex][i]; + IF hilfsdatei [i].artikelname = "" + THEN hilfsdatei [i] := aktuelle daten.waren [i] + FI + PER. + werte zentralliste aus: + forget (ds); + forget ("Auskunft: Zentrale", quiet); + + f := sequential file (output, "Auskunft: Zentrale"); + line (f); + IF aktueller kunde.nachname = "" + THEN write (f, " Ein Kunde mit Nr. " + text (kundenindex) + + " ist in keiner Filiale bekannt."); + line (f); + write(f, + " ============================================================"); + line (f,3); + ELSE write (f, " Gesamteinkaufsliste " + anrede + + invers (aktueller kundenname) + ":"); + + fuelle (f, hilfsdatei, kaeufe) + FI. + anrede: + IF aktueller kunde.geschlecht = "m" + THEN "des Kunden " + ELIF aktueller kunde.geschlecht = "w" + THEN "der Kundin " + ELSE "von " + FI. + aktueller kundenname: + (aktueller kunde.vorname SUB 1) + ". " + aktueller kunde.nachname. +END PROC kundeneinkaufsliste von zentrale; +PROC kundeneinkaufsliste von filiale (INT CONST kundennummer, FILE VAR f): + pruefe kundennummer; + erstelle filialliste. + + pruefe kundennummer: + INT CONST kundenindex :: kundennummer - min kundennr + 1; + IF kundenindex < 1 OR kundenindex > max kunden + THEN errorstop ("Unzulässige Kundennummer!") + FI. + erstelle filialliste: + forget ("Auskunft: Filiale " + filialnummer, quiet); + f := sequential file (output, "Auskunft: Filiale " + filialnummer); + line (f); + IF kunde [kundenindex].nachname = "" + THEN schicke leere liste zurueck + ELSE schreibe dateikopf; + fuelle (f, artikel, einkaufsdatei [kundenindex]) + + FI. + schicke leere liste zurueck: + write (f," Ein Kunde mit Nr. " + text (kundennummer) + " ist in " + + "dieser Filiale nicht bekannt."); + line (f); + write (f, + " ============================================================"); + line (f,3). + schreibe dateikopf: + write (f, " Einkaufsliste " + anrede + + invers ((kunde [kundenindex].vorname SUB 1) + ". " + + kunde [kundenindex].nachname) + ":"). + anrede: + IF kunde [kundenindex].geschlecht = "m" + + THEN "des Kunden " + ELIF kunde [kundenindex].geschlecht = "w" + THEN "der Kundin " + ELSE "von " + FI. +END PROC kundeneinkaufsliste von filiale; +PROC kundeneinkaufslisten aller filialen (INT CONST kundennummer,FILE VAR f): + INT VAR filialnr; + pruefe kundennummer; + bereite datei vor; + FOR filialnr FROM 1 UPTO max filialen REP + TEXT CONST aktuelle verwaltung :: + hauptstelle + ".Filialverwaltung " + text (filialnr); + IF filialnr = int (filialnummer) + + THEN schreibe eigene daten in auskunftsdatei + ELIF exists task (aktuelle verwaltung) + THEN hole daten dieser filiale; + schreibe daten in auskunftsdatei + FI + PER; + forget (ds). + pruefe kundennummer: + INT CONST kundenindex :: kundennummer - min kundennr + 1; + IF kundenindex < 1 OR kundenindex > max kunden + THEN errorstop ("Unzulässige Kundennummer!") + FI. + bereite datei vor: + forget ("Auskunft: Alle Filialen", quiet); + f := sequential file (output, "Auskunft: Alle Filialen"); + + line (f). + schreibe eigene daten in auskunftsdatei: + IF kunde [kundenindex].nachname = "" + THEN write (f," Ein Kunde mit Nr. " + text (kundennummer) + + " ist in " + invers ("Filiale " + filialnummer) + + " nicht bekannt."); + line (f); + write(f, + " ============================================================"); + line (f,3) + ELSE write (f, " Einkaufsliste " + anrede hier + + (kunde [kundenindex].vorname SUB 1) + ". " + + + kunde [kundenindex].nachname + + " in " + invers ("Filiale " + filialnummer) + ":"); + fuelle (f, artikel, einkaufsdatei [kundenindex]) + FI. + anrede hier: + IF kunde [kundenindex].geschlecht = "m" + THEN "des Kunden " + ELIF kunde [kundenindex].geschlecht = "w" + THEN "der Kundin " + ELSE "von " + FI. + hole daten dieser filiale: + init ds; + call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code); + + BOUND FILIALDATEN VAR aktuelle daten :: ds; + KUNDENDATEN CONST aktueller kunde := aktuelle daten.kunden [kundenindex]. + schreibe daten in auskunftsdatei: + IF aktueller kunde.nachname = "" + THEN write (f," Ein Kunde mit Nr. " + text (kundennummer) + + " ist in " + invers ("Filiale " + text (filialnr)) + + " nicht bekannt."); + line (f); + write(f, + " ============================================================"); + + line (f,3) + ELSE write (f, " Einkaufsliste " + anrede + + (aktueller kunde.vorname SUB 1) + ". " + + aktueller kunde.nachname + + " in " + invers ("Filiale " + text (filialnr)) + ":"); + fuelle (f, aktuelle daten.waren, + aktuelle daten.einkaeufe [kundenindex]) + FI. + anrede: + IF aktueller kunde.geschlecht = "m" + THEN "des Kunden " + ELIF aktueller kunde.geschlecht = "w" + + THEN "der Kundin " + ELSE "von " + FI. +END PROC kundeneinkaufslisten aller filialen; +PROC fuelle (FILE VAR f, WARENDATEI CONST warendatei, + ROW max artikel INT CONST einkaufszahlen): + INT VAR artikelnummer; + REAL VAR gesamtpreis, summe :: 0.0; + bereite datei vor; + schreibe daten in datei. +bereite datei vor: + line (f); + write(f," ============================================================"); + line (f,2); + write(f," | Art.Nr.| Artikelname | Anzahl | Preis | Gesamt |"); + + line (f); + write(f," +--------+-------------------+--------+---------+----------+"); + line (f). +schreibe daten in datei: + FOR artikelnummer FROM 1 UPTO max artikel REP + IF einkaufszahlen [artikelnummer] > 0 + THEN schreibe in datei; line (f) + FI + PER; + write(f," +--------+-------------------+--------+---------+----------+"); + line (f); + write(f," Summe: " + + text (summe,8,2)); + + line (f, 3). +schreibe in datei: + gesamtpreis := real (einkaufszahlen [artikelnummer]) * + warendatei [artikelnummer].preis; + summe INCR gesamtpreis; + write (f," |" + text(artikelnummer,5) + " | " + + text(warendatei [artikelnummer].artikelname,17) + " | " + + text(einkaufszahlen [artikelnummer],4) + " |" + + text(warendatei [artikelnummer].preis,7,2) + " |" + + text(gesamtpreis,8,2) + " |"). + +END PROC fuelle; +PROC lageruebersicht von zentrale (FILE VAR f): + INT VAR filialnr; + beginne mit eigener filiale; + FOR filialnr FROM 1 UPTO max filialen REP + TEXT CONST aktuelle verwaltung :: + hauptstelle + ".Filialverwaltung " + text (filialnr); + IF filialnr <> int (filialnummer) CAND + exists task (aktuelle verwaltung) + THEN hole daten dieser filiale; + schreibe daten in zentralliste + FI + PER; + werte zentralliste aus. + beginne mit eigener filiale: + + WARENDATEI VAR hilfsdatei; + CONCR (hilfsdatei) := CONCR (artikel). + hole daten dieser filiale: + init ds; + call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code). + schreibe daten in zentralliste: + BOUND FILIALDATEN VAR aktuelle daten :: ds; + INT VAR i; + FOR i FROM 1 UPTO max artikel REP + IF hilfsdatei [i].artikelname = "" + THEN hilfsdatei [i] := aktuelle daten.waren [i] + ELSE hilfsdatei [i].mindestbestand INCR aktuell.mindestbestand; + + hilfsdatei [i].bestand INCR aktuell.bestand + FI + PER. + aktuell: aktuelle daten.waren [i]. + werte zentralliste aus: + forget (ds); + forget ("Auskunft: Zentrale", quiet); + f := sequential file (output, "Auskunft: Zentrale"); + line (f); + write (f, " Zentrale Lagerübersicht:"); + fuelle (f, hilfsdatei). +END PROC lageruebersicht von zentrale; +PROC lageruebersicht von filiale (FILE VAR f): + forget ("Auskunft: Filiale " + filialnummer, quiet); + + f := sequential file (output, "Auskunft: Filiale " + filialnummer); + schreibe dateikopf; + fuelle (f, artikel). + schreibe dateikopf: + line (f); + write (f, " Lagerübersicht:"). +END PROC lageruebersicht von filiale; +PROC lageruebersichten aller filialen (FILE VAR f): + INT VAR filialnr; + bereite datei vor; + FOR filialnr FROM 1 UPTO max filialen REP + TEXT CONST aktuelle verwaltung :: + hauptstelle + ".Filialverwaltung " + text (filialnr); + IF filialnr = int (filialnummer) + + THEN schreibe eigene daten in auskunftsdatei + ELIF exists task (aktuelle verwaltung) + THEN hole daten dieser filiale; + schreibe daten in auskunftsdatei + FI + PER; + forget (ds). + bereite datei vor: + forget ("Auskunft: Alle Filialen", quiet); + f := sequential file (output, "Auskunft: Alle Filialen"). + schreibe eigene daten in auskunftsdatei: + line (f); + write (f, " Lagerübersicht für " + + invers ("Filiale " + filialnummer) + ":"); + + fuelle (f, artikel). + hole daten dieser filiale: + init ds; + call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code); + BOUND FILIALDATEN VAR aktuelle daten :: ds. + schreibe daten in auskunftsdatei: + line (f); + write (f, " Lagerübersicht für " + + invers ("Filiale " + text (filialnr)) + ":"); + fuelle (f, aktuelle daten.waren). +END PROC lageruebersichten aller filialen; +PROC fuelle (FILE VAR f, WARENDATEI CONST warendatei): + INT VAR artikelnummer; + + bereite datei vor; + schreibe daten in datei. +bereite datei vor: + line (f); + write(f," ============================================================"); + line (f,2); + write(f," | Art.Nr.| Artikelname | Preis | Min.Best.| Bestand |"); + line (f); + write(f," +--------+-------------------+--------+----------+---------+"); + line (f). +schreibe daten in datei: + FOR artikelnummer FROM 1 UPTO max artikel REP + IF warendatei[artikelnummer].artikelname <> "" + THEN schreibe in datei; line (f) + + FI + PER; + write(f," +--------+-------------------+--------+----------+---------+"); + line (f, 3). +schreibe in datei: + write (f, " |" + text(artikelnummer,5) + " | " + + text(warendatei[artikelnummer].artikelname,17) + " |" + + text(warendatei[artikelnummer].preis,7,2) + " | " + + text(warendatei[artikelnummer].mindestbestand,6)+" | " + + text(warendatei[artikelnummer].bestand,6) + " |"). +END PROC fuelle; + +PROC initialisiere dateien: + INT VAR kundennummer, artikelnummer; + FOR kundennummer FROM 1 UPTO max kunden REP + kunde [kundennummer].nachname := ""; + kunde [kundennummer].vorname := ""; + kunde [kundennummer].geschlecht := "" + PER; + FOR artikelnummer FROM 1 UPTO max artikel REP + verkaufszahl [artikelnummer] := 0; + artikel [artikelnummer].mindestbestand := 0; + artikel [artikelnummer].bestand := 0; + artikel [artikelnummer].artikelname := ""; + + artikel [artikelnummer].preis := 0.0; + FOR kundennummer FROM 1 UPTO max kunden REP + einkaufsdatei[kundennummer][artikelnummer] := 0 + PER; + PER +END PROC initialisiere dateien; +initialisiere dateien +END PACKET ls warenhaus 2 + diff --git a/warenhaus/ls-Warenhaus 3 b/warenhaus/ls-Warenhaus 3 index 3473e0f..71ef216 100644 --- a/warenhaus/ls-Warenhaus 3 +++ b/warenhaus/ls-Warenhaus 3 @@ -22,61 +22,965 @@ *) PACKET ls warenhaus 3 DEFINES - artikelnummer lesen,{} artikeldaten eingeben,{} kundennummer lesen,{} kundendaten eingeben,{} neues blatt,{} rechnungskopf,{} artikel kaufen,{} abrechnung,{} nachbestellen,{} auskunft,{} stoptaste gedrueckt,{} stoptaste gedrückt,{} dezimalwert lesen,{} bitmuster lesen,{} bildschirm neu,{}(* ------------------------------ *){} tastatureingabe,{} eingabesicherheit,{} eingabe mit codekartenleser,{} - cursor w3 1 1:{}LET esc = ""27"",{} stopzeichen = "q",{} abbruchzeichen = "h";{}WINDOW VAR w1 :: window (43, 3, 36, 16),{} w2 :: window (43, 20, 36, 3),{} w3k :: window ( 2, 4, 40, 3),{} w3 :: window ( 2, 7, 40, 16),{} w4 :: window ( 8, 4, 66, 18);{}BOOL VAR ende gewuenscht := FALSE,{} artikelnummer ist eingelesen := FALSE,{} kundennummer ist eingelesen := FALSE,{} codekartenleser aktiviert := FALSE,{} - auf neuem blatt := TRUE;{}INT VAR artikelnummer :: 0,{} mindestbestand :: 0,{} bestand :: 0,{} kundennummer :: 0,{} sicherheit :: 5;{}TEXT VAR artikelname :: "",{} nachname :: "",{} vorname :: "",{} geschlecht :: "",{} ueberschrift :: " RECHNUNG",{} hilfstext, exit char;{}REAL VAR preis :: 0.0,{} summe :: 0.0;{}PROC eingabesicherheit (INT CONST wert):{} - sicherheit := abs (wert){}END PROC eingabesicherheit;{}PROC cursor w3 1 1:{} cursor (w1, 1, 1);{} cursor (w2, 1, 1);{} cursor (w3, 1, 1);{} cursor (w3k, 1, 1);{} forget ("WARENHAUS:Rechnung", quiet);{} setze variable in anfangszustand{}END PROC cursor w3 1 1;{}PROC setze variable in anfangszustand:{} ende gewuenscht := FALSE;{} artikelnummer ist eingelesen := FALSE;{} kundennummer ist eingelesen := FALSE;{} artikelnummer := 0;{} mindestbestand := 0;{} bestand := 0;{} - kundennummer := 0;{} artikelname := "";{} nachname := "";{} vorname := "";{} geschlecht := "";{} ueberschrift := " RECHNUNG";{} preis := 0.0;{} summe := 0.0{}END PROC setze variable in anfangszustand;{}PROC bildschirm neu:{} cursor off;{} pruefe abbruch;{} cursor (w1, 1, 1);{} cursor (w2, 1, 1);{} cursor (w3, 1, 1);{} cursor (w3k,1, 1);{} auf neuem blatt := TRUE;{} page;{} out ("WARENHAUS: Info Eingabeart Kommandos "15"Programme "14" " +{} - "Filialdaten Archiv"); line;{} out (ecke oben links + (40 * waagerecht) + balken oben{} + (36 * waagerecht) + ecke oben rechts);{} INT VAR zeile;{} FOR zeile FROM 3 UPTO 22 REP{} cursor ( 1, zeile); out (senkrecht);{} cursor (42, zeile); out (senkrecht);{} cursor (79, zeile); out (senkrecht){} PER;{} cursor (1, 23);{} out (ecke unten links + (40 * waagerecht) + balken unten{} + (36 * waagerecht) + ecke unten rechts);{} - cursor (42, 19);{} out (balken links + (36 * waagerecht) + balken rechts);{} cursor (2, 24);{} out ("Programmabbruch: <ESC><" + abbruchzeichen + ">");{} cursor on{}END PROC bildschirm neu;{}PROC pruefe abbruch:{} IF pressed key = esc{} THEN pruefe weiter{} FI.{} pruefe weiter:{} TEXT VAR naechstes zeichen :: pressed key (20);{} IF naechstes zeichen = stopzeichen{} THEN ende gewuenscht := TRUE{} ELIF naechstes zeichen = abbruch zeichen{} - THEN setze variable in anfangszustand;{} cursor off;{} errorstop (1951, "Programm - Abbruch durch <ESC><"{} + abbruchzeichen + ">"){} FI{}END PROC pruefe abbruch;{}PROC regeneriere w2:{} cursor (42, 19);{} out (ecke oben links + (36 * waagerecht));{} INT VAR zeile;{} FOR zeile FROM 20 UPTO 22 REP{} cursor (42, zeile); out (senkrecht);{} PER;{} cursor (42, 23); out (balken unten);{} page (w2){} -END PROC regeneriere w2;{}PROC fenster putzen:{} page (w1);{} page (w2){}END PROC fenster putzen;{}PROC lies nummer ein (INT VAR nummer):{} line (w2, 2);{} out (w2, " Stoptaste: <ESC><" + stopzeichen + ">");{} hilfstext := text (nummer);{} REP cursor (w1, 19, 2);{} editget (w1, hilfstext, 4, 4, "", stopzeichen + abbruchzeichen,{} exit char);{} pruefe exit char;{} change all (hilfstext, " ", ""){} UNTIL hilfstext >= "0" AND hilfstext <= "9999" PER;{} - nummer := int (hilfstext).{} pruefe exit char:{} IF exit char = esc + stopzeichen{} THEN ende gewuenscht := TRUE;{} cursor off; fenster putzen; cursor on;{} nummer := 0;{} LEAVE lies nummer ein{} ELIF exit char = esc + abbruchzeichen{} THEN setze variable in anfangszustand;{} errorstop (1951, "Progamm - Abbruch durch <ESC><"{} + abbruchzeichen + ">"){} ELSE ende gewuenscht := FALSE{} FI.{} -END PROC lies nummer ein;{}PROC lies artikelnummer ein:{} page (w2);{} cursor (w1, 2, 2);{} out (w1, "Artikelnummer : ");{} IF codekartenleser aktiviert{} THEN artikelnummer := gesicherter wert von interface{} (min artikelnummer , max artikelnummer, "Warenkarte"){} ELSE artikelnummer von tastatur lesen{} FI;{} IF ende gewuenscht{} THEN artikelnummer ist eingelesen := FALSE{} ELSE artikelnummer ist eingelesen := TRUE{} - FI.{} artikelnummer von tastatur lesen:{} cursor on;{} REP out (w2, " Artikelnummer eingeben");{} lies nummer ein (artikelnummer);{} UNTIL ende gewuenscht COR artikelnummer zulaessig PER.{} artikelnummer zulaessig:{} IF (artikelnummer < min artikelnummer OR{} artikelnummer > max artikelnummer){} THEN page (w2); out (""7"");{} out (w2, " Unzulässige Artikelnummer!");{} line (w2, 2);{} out (w2, " Bitte irgendeine Taste tippen!");{} - pause; page (w2);{} FALSE{} ELSE TRUE{} FI.{}END PROC lies artikelnummer ein;{}PROC artikelnummer lesen:{} pruefe abbruch;{} lies artikelnummer ein;{} IF artikelnummer ist eingelesen{} THEN hole artikeldaten (artikelnummer, artikelname, preis,{} mindestbestand, bestand){} FI{}END PROC artikelnummer lesen;{}PROC kundennummer lesen:{} pruefe abbruch;{} lies kundennummer ein;{} IF kundennummer ist eingelesen{} THEN hole kundendaten (kundennummer, nachname, vorname, geschlecht){} - FI{}END PROC kundennummer lesen;{}PROC lies kundennummer ein:{} page (w2);{} cursor (w1, 2, 2);{} out (w1, "Kundennummer : ");{} IF codekartenleser aktiviert{} THEN kundennummer := gesicherter wert von interface{} (min kundennummer , max kundennummer, "Kundenkarte"){} ELSE kundennummer von tastatur lesen{} FI;{} IF ende gewuenscht{} THEN kundennummer ist eingelesen := FALSE{} ELSE kundennummer ist eingelesen := TRUE{} FI.{} kundennummer von tastatur lesen:{} - cursor on;{} REP out (w2, " Kundennummer eingeben");{} lies nummer ein (kundennummer){} UNTIL ende gewuenscht COR kundennummer zulaessig PER.{} kundennummer zulaessig:{} IF (kundennummer < min kundennummer OR{} kundennummer > max kundennummer){} THEN page (w2); out (""7"");{} out (w2, " Unzulässige Kundennummer!");{} line (w2, 2);{} out (w2, " Bitte irgendeine Taste tippen!");{} pause; page (w2);{} FALSE{} - ELSE TRUE{} FI.{}END PROC lies kundennummer ein;{}PROC zeige artikeldaten:{} cursor (w1, 2, 6);{} out (w1, "Artikelname : " + text (artikelname, 16));{} cursor (w1, 2, 8);{} out (w1, "Preis : " + text preis + " ");{} cursor (w1, 2, 10);{} out (w1, "Mindestbestand : " + text (mindestbestand) + " ");{} cursor (w1, 2, 12);{} out (w1, "Bestand : " + text (bestand) + " ").{} text preis:{} TEXT VAR hilfe :: text (preis, min (8, pos(text(preis),".")+2), 2);{} - change (hilfe, " ", "0");{} hilfe.{}END PROC zeige artikeldaten;{}PROC zeige kundendaten:{} cursor (w1, 2, 6);{} out (w1, "Nachname : " + text (nachname, 16));{} cursor (w1, 2, 8);{} out (w1, "Vorname : " + text (vorname , 16));{} cursor (w1, 2, 10);{} out (w1, "Geschlecht : " + geschlecht + " ");{}END PROC zeige kundendaten;{}PROC artikeldaten speichern:{} pruefe abbruch;{} page (w2); line (w2);{} out (w2, " Artikeldaten werden gespeichert") ;{} - speichere artikeldaten (artikelnummer, artikelname, preis,{} mindestbestand, bestand);{} pause (10);{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI{}END PROC artikeldaten speichern;{}PROC kundendaten speichern:{} pruefe abbruch;{} page (w2); line (w2);{} out (w2, " Kundendaten werden gespeichert") ;{} speichere kundendaten (kundennummer, nachname,vorname, geschlecht);{} pause (10);{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} - FI{}END PROC kundendaten speichern;{}BOOL PROC stoptaste gedrueckt:{} pruefe abbruch;{} ende gewuenscht{}END PROC stoptaste gedrueckt;{}BOOL PROC stoptaste gedrückt:{} stoptaste gedrueckt{}END PROC stoptaste gedrückt;{}PROC neues blatt:{} pruefe abbruch;{} page (w3k);{} page (w3);{} auf neuem blatt := TRUE;{} forget ("WARENHAUS:Rechnung", quiet){}END PROC neues blatt;{}PROC nachbestellen:{} pruefe abbruch;{} FILE VAR f;{} warten in w2;{} hole bestelliste (f);{} pruefe abbruch;{} cursor (2,24);{} - out ("Weiter mit <ESC><q>; Cursor bewegen: <Pfeile>");{} cursor on;{} show (w4, f);{} cursor off;{} cursor (1, 24); out (""5"");{} WINDOW VAR w :: window(45,18,25,3);{} outframe (w);{} IF yes (w, "Bestelliste drucken", FALSE){} THEN drucke (headline (f)){} FI;{} cursor on;{} forget (headline (f), quiet){}END PROC nachbestellen;{}PROC warten in w2:{} cursor off;{} page (w2);{} line (w2);{} out (w2, " Bitte warten!");{} cursor on{}END PROC warten in w2;{}PROC codenummer von tastatur lesen (INT VAR codenummer):{} - codenummer := 0;{} out (w2, " Codenummer eingeben");{} cursor on;{} lies nummer ein (codenummer){}END PROC codenummer von tastatur lesen;{}PROC auskunft:{} pruefe abbruch;{} FILE VAR f;{} INT VAR codenummer :: 0;{} cursor (w1, 2, 2);{} out (w1, "Codenummer : ");{} page (w2);{} IF codekartenleser aktiviert{} THEN codenummer := gesicherter wert von interface (0,254, "Codekarte");{} lasse karte entfernen (FALSE){} ELSE codenummer von tastatur lesen (codenummer){} - FI;{} IF ende gewuenscht THEN LEAVE auskunft FI;{} SELECT codenummer OF CASE 66, 67, 68 : hitliste{} CASE 73, 74, 75 : kaeuferliste{} CASE 77, 78, 79 : kundenliste{} CASE 84, 85, 86 : einkaufsliste{} CASE 89, 90, 91 : lageruebersicht{} OTHERWISE teste auf artikel oder kundennummer{} END SELECT;{} IF codekartenleser aktiviert CAND wert von interface <> 255{} THEN karte entfernen{} FI.{} karte entfernen:{} - SELECT codenummer OF{} CASE 66, 67, 68, 73, 74, 75, 77, 78, 79, 84, 85, 86, 89, 90,{} 91: lasse karte entfernen (TRUE){} OTHERWISE lasse karte entfernen (FALSE){} END SELECT.{} teste auf artikel oder kundennummer:{} IF codenummer >= min artikelnummer AND codenummer <= max artikelnummer{} THEN gib auskunft ueber artikeldaten{} ELIF codenummer >= min kundennummer AND codenummer <= max kundennummer{} THEN gib auskunft ueber kundendaten{} ELSE unzulaessige codenummer{} - FI.{} unzulaessige codenummer:{} out (10 * ""7"");{} page (w2);{} out (w2, " Unzulässige Codenummer !!!");{} line (w2, 2);{} out (w2, " Bitte irgendeine Taste tippen!");{} pause;{} page (w2).{} gib auskunft ueber artikeldaten:{} hole artikeldaten (codenummer, artikelname, preis,{} mindestbestand, bestand);{} zeige artikeldaten;{} artikelnummer ist eingelesen := FALSE;{} stop w2;{} page (w1).{} gib auskunft ueber kundendaten:{} hole kundendaten (codenummer, nachname, vorname, geschlecht);{} - zeige kundendaten;{} kundennummer ist eingelesen := FALSE;{} stop w2;{} page (w1).{} hitliste:{} warten in w2;{} hole auskunft ein (codenummer, 0, f);{} zeige f.{} kundenliste:{} warten in w2;{} hole auskunft ein (codenummer, 0, f);{} zeige f.{} zeige f:{} pruefe abbruch;{} cursor (2, 24);{} out ("Weiter mit <ESC><q>; Cursor bewegen: <Pfeile>");{} show (w4, f);{} cursor (1, 24); out (""5"");{} evtl drucken.{} lageruebersicht:{} warten in w2;{} - hole auskunft ein (codenummer, 0, f);{} zeige f.{} kaeuferliste:{} lies artikelnummer ein;{} IF artikelnummer ist eingelesen{} THEN artikelnummer ist eingelesen := FALSE;{} warten in w2;{} hole auskunft ein (codenummer, artikelnummer, f);{} zeige f{} FI.{} einkaufsliste:{} lies kundennummer ein;{} IF kundennummer ist eingelesen{} THEN kundennummer ist eingelesen := FALSE;{} warten in w2;{} hole auskunft ein (codenummer, kundennummer, f);{} - zeige f{} FI.{} evtl drucken:{} WINDOW VAR w :: window(46,18,22,3);{} cursor off;{} outframe (w);{} IF yes (w, "Auskunft drucken", FALSE){} THEN drucke (headline (f)){} FI;{} cursor on;{} forget (headline (f), quiet).{}END PROC auskunft;{}PROC rechnungskopf:{} pruefe abbruch;{} IF kundennummer ist eingelesen AND nachname <> ""{} THEN ueberschrift := " RECHNUNG für " + anrede + (vorname SUB 1) +{} ". " + text (nachname, 10){} ELSE ueberschrift := " RECHNUNG"{} - FI;{} summe := 0.0;{} schreibe ueberschrift auf bildschirm;{} schreibe in rechnungsdatei;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI.{} schreibe in rechnungsdatei:{} sysout ("WARENHAUS:Rechnung");{} line;{} put (ueberschrift);{} line;{} put (" ==================================");{} line (2);{} sysout ("").{} anrede:{} IF geschlecht = "m"{} THEN "Herrn "{} ELIF geschlecht = "w"{} THEN "Frau "{} ELSE ""{} - FI.{}END PROC rechnungskopf;{}PROC schreibe ueberschrift auf bildschirm:{} INT VAR spalte, zeile;{} get cursor (w3, spalte, zeile);{} IF zeile = 1{} THEN auf neuem blatt := TRUE;{} schreibe in w3k{} ELSE auf neuem blatt := FALSE;{} schreibe in w3{} FI.{} schreibe in w3:{} IF remaining lines (w3) < 7{} THEN page (w3);{} page (w3k);{} auf neuem blatt := TRUE;{} schreibe in w3k{} ELSE line (w3);{} out (w3, ueberschrift);{} - line (w3);{} out (w3, " ==================================");{} line (w3, 2){} FI.{} schreibe in w3k:{} out (w3k, ueberschrift);{} line (w3k);{} out (w3k, " ==================================").{}END PROC schreibe ueberschrift auf bildschirm;{}PROC artikel kaufen:{} pruefe abbruch;{} IF artikelnummer ist eingelesen{} THEN kauf registrieren{} ELSE setze variable in anfangszustand;{} errorstop ("Es ist keine Artikelnummer eingelesen worden!"){} - FI;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI.{} kauf registrieren:{} artikelnummer ist eingelesen := FALSE;{} IF bestand > 0{} THEN artikel auf rechnung setzen;{} registrieren{} ELSE page (w2); out (""7"");{} IF artikelname = ""{} THEN out (w2, " Artikel hier nicht erhältlich!"){} ELSE out (w2, " Der Artikel ist ausverkauft!"){} FI;{} line (w2, 2);{} out (w2, " Weiter durch Tippen einer Taste");{} - pause{} FI.{} registrieren:{} IF kundennummer ist eingelesen{} THEN registriere verkauf (kundennummer, artikelnummer){} ELSE registriere verkauf (min kundennummer - 1, artikelnummer){} FI.{} artikel auf rechnung setzen:{} summe INCR preis;{} IF remaining lines (w3) < 3{} THEN beginne wieder oben{} FI;{} out (w3, " " + text (artikelname, 15) + text (preis, 12, 2));{} line (w3);{} sysout ("WARENHAUS:Rechnung");{} put (" " + text (artikelname, 15) + text preis);{} - line;{} sysout ("").{} beginne wieder oben:{} IF auf neuem blatt{} THEN page (w3){} ELSE schreibe ueberschrift auf bildschirm{} FI.{} text preis:{} TEXT VAR hilfe :: text (preis, 12, 2);{} INT VAR vor punkt :: pos (hilfe, ".") - 1;{} IF (hilfe SUB vor punkt) = " "{} THEN change (hilfe, vor punkt, vor punkt, "0"){} FI;{} hilfe.{}END PROC artikel kaufen;{}PROC abrechnung:{} pruefe abbruch;{} schreibe summe auf bildschirm;{} - schreibe summe in rechnungsdatei;{} setze variable zurueck;{} frage ob drucken;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI.{} schreibe summe auf bildschirm:{} IF remaining lines (w3) < 2{} THEN beginne wieder oben{} FI;{} put (w3, " -------------");{} line (w3);{} put (w3, " Summe " + text (summe, 12, 2));{} line (w3).{} beginne wieder oben:{} IF auf neuem blatt{} THEN page (w3){} ELSE schreibe ueberschrift auf bildschirm{} - FI.{} schreibe summe in rechnungsdatei:{} sysout ("WARENHAUS:Rechnung");{} put (" -------------");{} line;{} put (" Summe " + text (summe, 12, 2));{} line;{} sysout ("").{} setze variable zurueck:{} BOOL VAR alter wert :: ende gewuenscht;{} setze variable in anfangszustand;{} ende gewuenscht := alter wert.{} frage ob drucken:{} IF yes (w2, "Rechnung drucken", FALSE){} THEN cursor (3, 22);{} disable stop;{} print ("WARENHAUS:Rechnung");{} - IF is error THEN clear error FI;{} enable stop{} FI.{}END PROC abrechnung;{}PROC artikeldaten eingeben:{} pruefe abbruch;{} IF artikelnummer ist eingelesen{} THEN lies artikeldaten ein;{} artikeldaten speichern{} ELSE setze variable in anfangszustand;{} errorstop ("Es ist keine Artikelnummer eingelesen worden!"){} FI.{} lies artikeldaten ein:{} zeige artikeldaten;{} IF artikelname <> ""{} THEN vielleicht schon fertig{} ELSE page (w2){} - FI;{} REP line (w2);{} put (w2, " Artikeldaten eingeben");{} eingabe{} UNTIL yes (w2, "Alles richtig", TRUE){} PER;{} artikelnummer ist eingelesen := FALSE.{} vielleicht schon fertig:{} IF yes (w2, "Alles richtig", TRUE){} THEN artikelnummer ist eingelesen := FALSE;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI;{} LEAVE artikeldaten eingeben{} FI.{} eingabe:{} name holen;{} - preis holen;{} mindestbestand holen;{} bestand holen.{} name holen:{} REP cursor (w1, 19, 6);{} editget (w1, artikelname, 80, 80, "", abbruchzeichen + stopzeichen,{} exit char);{} teste auf abbruch{} UNTIL artikelname <> "" PER.{} preis holen:{} hilfstext := text (preis, pos(text(preis),".") + 2, 2);{} change (hilfstext, " ", "0");{} REP cursor (w1, 19, 8);{} editget (w1, hilfstext, 8, 8, "", abbruch zeichen + stopzeichen,{} - exit char);{} change (hilfstext, ",", ".");{} preis := round (real (hilfstext), 2);{} teste auf abbruch{} UNTIL preis >= 0.0 PER.{} mindestbestand holen:{} hilfstext := text (mindestbestand);{} REP cursor (w1, 19, 10);{} editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen,{} exit char);{} mindestbestand := int (hilfstext);{} teste auf abbruch{} UNTIL mindestbestand >= 0 PER.{} - bestand holen:{} hilfstext := text (bestand);{} REP cursor (w1, 19, 12);{} editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen,{} exit char);{} bestand := int (hilfstext);{} teste auf abbruch{} UNTIL bestand >= 0 PER.{} teste auf abbruch:{} IF exit char = esc + stopzeichen{} THEN ende gewuenscht := TRUE{} ELIF exit char = esc + abbruchzeichen{} THEN setze variable in anfangszustand;{} errorstop (1951, "Programm - Abbruch durch <ESC><"{} - + abbruchzeichen + ">"){} FI.{}END PROC artikeldaten eingeben;{}PROC kundendaten eingeben:{} IF kundennummer ist eingelesen{} THEN lies kundendaten ein;{} kundendaten speichern{} ELSE setze variable in anfangszustand;{} errorstop ("Es ist keine Kundennummer eingelesen worden!"){} FI.{} lies kundendaten ein:{} zeige kundendaten;{} IF nachname <> ""{} THEN vielleicht schon fertig{} ELSE page (w2){} FI;{} REP line (w2);{} - put (w2, " Kundendaten eingeben");{} eingabe{} UNTIL yes (w2, "Alles richtig", TRUE) PER;{} kundennummer ist eingelesen := FALSE.{} vielleicht schon fertig:{} IF yes (w2, "Alles richtig", TRUE){} THEN kundennummer ist eingelesen := FALSE;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI;{} LEAVE kundendaten eingeben{} FI.{} eingabe:{} nachname holen;{} vorname holen;{} geschlecht holen.{} - nachname holen:{} REP cursor (w1, 19, 6);{} editget (w1, nachname, 80, 80, "", abbruch zeichen + stopzeichen,{} exit char);{} teste auf abbruch{} UNTIL nachname <> "" PER.{} vorname holen:{} REP cursor (w1, 19, 8);{} editget (w1, vorname, 80, 80, "", abbruch zeichen + stopzeichen,{} exit char);{} teste auf abbruch{} UNTIL vorname <> "" PER.{} geschlecht holen:{} REP cursor (w1, 19, 10);{} - editget (w1, geschlecht, 9, 9, "", abbruchzeichen + stopzeichen,{} exit char);{} geschlecht := geschlecht SUB 1;{} teste auf abbruch{} UNTIL geschlecht = "m" OR geschlecht = "w" PER.{} teste auf abbruch:{} IF exit char = esc + stopzeichen{} THEN ende gewuenscht := TRUE{} ELIF exit char = esc + abbruchzeichen{} THEN setze variable in anfangszustand;{} errorstop (1951, "Programm - Abbruch durch <ESC><"{} - + abbruchzeichen + ">"){} FI.{}END PROC kundendaten eingeben;{}PROC drucke (TEXT CONST name):{} TEXT VAR zeile;{} FILE VAR f :: sequential file (modify, name);{} to line (f, 1);{} insert record (f);{} write record (f, "#center#" + name);{} down (f);{} insert record (f);{} down (f);{} WHILE NOT eof (f) REP{} read record (f, zeile);{} IF pos (zeile, ""15"") > 0{} THEN change (zeile, ""15"", "#on(""r"")#");{} change (zeile, ""14"", "#off(""r"")#");{} - write record (f, zeile){} FI;{} down (f){} PER;{} cursor (3, 22);{} print (name){}END PROC drucke;{}PROC stop w2:{} cursor off;{} page (w2);{} out (w2," Zum Weitermachen bitte");line(w2);{} out (w2," irgendeine Taste tippen!");{} pause;{} page (w2);{} cursor on{}END PROC stop w2;{}BOOL PROC yes (WINDOW VAR w, TEXT CONST frage, BOOL CONST default):{} BOOL VAR antwort :: default;{} TEXT VAR taste;{} INT CONST ja pos :: (areaxsize (w) - 9) DIV 2;{} cursor off;{} cursor (42,24); out ("Ändern: <Pfeile> Bestätigen: <RETURN>");{} - page (w);{} out (w, center (w, frage + " ?"));{} cursor (w, ja pos, 3);{} IF default{} THEN out (w, ""15"Ja "14" Nein ");{} cursor (w, ja pos, 3){} ELSE out (w, " Ja "15"Nein "14"");{} cursor (w, ja pos + 5, 3){} FI;{} tastendruck auswerten;{} page (w);{} cursor (42,24); out (""5"");{} cursor on;{} antwort.{} tastendruck auswerten:{} REP inchar (taste);{} SELECT code (taste) OF CASE 2, 8 : position aendern{} CASE 13 : LEAVE tastendruck auswerten{} - CASE 74, 106 : antwort := TRUE; (*Jj*){} LEAVE tastendruck auswerten{} CASE 78, 110 : antwort := FALSE; (*Nn*){} LEAVE tastendruck auswerten{} OTHERWISE out (""7"") END SELECT{} PER.{} position aendern:{} IF antwort THEN antwort := FALSE;{} cursor (w, ja pos, 3);{} out (w, " Ja "15"Nein "14"");{} - cursor (w, ja pos + 5, 3){} ELSE antwort := TRUE;{} cursor (w, ja pos, 3);{} out (w, ""15"Ja "14" Nein ");{} cursor (w, ja pos, 3){} FI.{}END PROC yes;{}PROC tastatureingabe (BOOL CONST erwuenscht, INT VAR rueckmeldung):{} IF erwuenscht{} THEN rueckmeldung := 0;{} codekartenleser aktiviert := FALSE;{} schliesse interface{} ELSE oeffne interface (rueckmeldung);{} IF rueckmeldung >= 0{} - THEN codekartenleser aktiviert := TRUE{} ELSE codekartenleser aktiviert := FALSE{} FI{} FI{}END PROC tastatureingabe;{}BOOL PROC eingabe mit codekartenleser:{} codekartenleser aktiviert{}END PROC eingabe mit codekartenleser;{}PROC dezimalwert lesen:{} pruefe abbruch;{} IF codekartenleser aktiviert{} THEN interfacewerte zeigen{} ELSE setze variable in anfangszustand;{} errorstop ("Eingabeart ist auf Tastatur eingestellt!"){} FI.{} interfacewerte zeigen:{} - cursor off;{} fenster putzen;{} line (w1, 4); line (w2);{} out (w1, " Dezimalwert :");{} out (w2, " Lesen beenden mit <ESC><q>");{} ende gewuenscht := FALSE;{} REP pruefe abbruch;{} cursor (w1, 17, 5);{} out (w1, text (wert von interface, 3)){} UNTIL ende gewuenscht PER;{} page (w2); cursor (w1, 1, 5); out (" ");{} cursor on.{}END PROC dezimalwert lesen;{}PROC bitmuster lesen:{} pruefe abbruch;{} IF codekartenleser aktiviert{} - THEN interfacewerte zeigen{} ELSE setze variable in anfangszustand;{} errorstop ("Eingabeart ist auf Tastatur eingestellt!"){} FI.{} interfacewerte zeigen:{} cursor off;{} fenster putzen;{} line (w1, 4); line (w2);{} out (w1, " Bitmuster :");{} out (w2, " Lesen beenden mit <ESC><q>");{} ende gewuenscht := FALSE;{} REP pruefe abbruch;{} cursor (w1, 16, 5);{} out (w1, bitmuster (wert von interface)){} UNTIL ende gewuenscht PER;{} page (w2); cursor (w1, 1, 5); out (" ");{} - cursor on.{}END PROC bitmuster lesen;{}TEXT PROC bitmuster (INT CONST wert):{} INT VAR bitnr;{} TEXT VAR muster :: "";{} FOR bitnr FROM 7 DOWNTO 0 REP{} IF bit (wert, bitnr){} THEN muster CAT "I"{} ELSE muster CAT "O"{} FI{} PER;{} muster{}END PROC bitmuster;{}PROC lasse karte entfernen (BOOL CONST mit rahmen):{} IF wert von interface <> 255{} THEN cursor off;{} IF mit rahmen THEN regeneriere w2 ELSE page (w2) FI;{} line (w2);{} out (w2, " Bitte Karte entfernen");{} - REP pruefe abbruch{} UNTIL (wert von interface = 255) OR ende gewuenscht PER;{} cursor on{} FI{}END PROC lasse karte entfernen;{}INT PROC gesicherter wert von interface (INT CONST von, bis,{} TEXT CONST kartenart):{} INT VAR wert, zaehler;{} ende gewuenscht := FALSE;{} cursor off;{} REP out (w2, " Bitte " + kartenart + " einschieben");{} line (w2, 2);{} out (w2, " Stoptaste: <ESC><" + stopzeichen + ">");{} cursor (79, 24);{} - gesicherten wert einlesen;{} cursor (w1, 19, 2);{} out (w1, text (wert, 3));{} IF wert < von OR wert > bis{} THEN warnung{} FI{} UNTIL wert >= von AND wert <= bis PER;{} cursor on;{} wert.{} gesicherten wert einlesen:{} REP zaehler := 0;{} warte auf karte;{} wert := wert von interface;{} lies wert{} UNTIL wert gesichert AND wert <> 255 PER.{} warte auf karte:{} REP beachte esc q{} UNTIL wert von interface <> 255 PER.{} beachte esc q:{} - pruefe abbruch;{} IF ende gewuenscht{} THEN cursor on;{} LEAVE gesicherter wert von interface WITH 0{} FI.{} lies wert:{} REP beachte esc q;{} IF wert = wert von interface{} THEN zaehler INCR 1{} ELSE LEAVE lies wert{} FI{} UNTIL wert gesichert PER.{} wert gesichert: zaehler = sicherheit.{} warnung:{} page (w2); out (""7"");{} out (w2, " Dies ist keine " + kartenart + "!");{} line (w2, 2);{} out (w2, " Bitte Karte entfernen");{} - REP beachte esc q{} UNTIL wert von interface = 255 PER;{} page (w2).{}END PROC gesicherter wert von interface{}END PACKET ls warenhaus 3{} + artikelnummer lesen, + artikeldaten eingeben, + kundennummer lesen, + kundendaten eingeben, + neues blatt, + rechnungskopf, + artikel kaufen, + abrechnung, + nachbestellen, + auskunft, + stoptaste gedrueckt, + stoptaste gedrückt, + dezimalwert lesen, + bitmuster lesen, + bildschirm neu, +(* ------------------------------ *) + tastatureingabe, + eingabesicherheit, + eingabe mit codekartenleser, + + cursor w3 1 1: +LET esc = ""27"", + stopzeichen = "q", + abbruchzeichen = "h"; +WINDOW VAR w1 :: window (43, 3, 36, 16), + w2 :: window (43, 20, 36, 3), + w3k :: window ( 2, 4, 40, 3), + w3 :: window ( 2, 7, 40, 16), + w4 :: window ( 8, 4, 66, 18); +BOOL VAR ende gewuenscht := FALSE, + artikelnummer ist eingelesen := FALSE, + kundennummer ist eingelesen := FALSE, + codekartenleser aktiviert := FALSE, + + auf neuem blatt := TRUE; +INT VAR artikelnummer :: 0, + mindestbestand :: 0, + bestand :: 0, + kundennummer :: 0, + sicherheit :: 5; +TEXT VAR artikelname :: "", + nachname :: "", + vorname :: "", + geschlecht :: "", + ueberschrift :: " RECHNUNG", + hilfstext, exit char; +REAL VAR preis :: 0.0, + summe :: 0.0; +PROC eingabesicherheit (INT CONST wert): + + sicherheit := abs (wert) +END PROC eingabesicherheit; +PROC cursor w3 1 1: + cursor (w1, 1, 1); + cursor (w2, 1, 1); + cursor (w3, 1, 1); + cursor (w3k, 1, 1); + forget ("WARENHAUS:Rechnung", quiet); + setze variable in anfangszustand +END PROC cursor w3 1 1; +PROC setze variable in anfangszustand: + ende gewuenscht := FALSE; + artikelnummer ist eingelesen := FALSE; + kundennummer ist eingelesen := FALSE; + artikelnummer := 0; + mindestbestand := 0; + bestand := 0; + + kundennummer := 0; + artikelname := ""; + nachname := ""; + vorname := ""; + geschlecht := ""; + ueberschrift := " RECHNUNG"; + preis := 0.0; + summe := 0.0 +END PROC setze variable in anfangszustand; +PROC bildschirm neu: + cursor off; + pruefe abbruch; + cursor (w1, 1, 1); + cursor (w2, 1, 1); + cursor (w3, 1, 1); + cursor (w3k,1, 1); + auf neuem blatt := TRUE; + page; + out ("WARENHAUS: Info Eingabeart Kommandos "15"Programme "14" " + + + "Filialdaten Archiv"); line; + out (ecke oben links + (40 * waagerecht) + balken oben + + (36 * waagerecht) + ecke oben rechts); + INT VAR zeile; + FOR zeile FROM 3 UPTO 22 REP + cursor ( 1, zeile); out (senkrecht); + cursor (42, zeile); out (senkrecht); + cursor (79, zeile); out (senkrecht) + PER; + cursor (1, 23); + out (ecke unten links + (40 * waagerecht) + balken unten + + (36 * waagerecht) + ecke unten rechts); + + cursor (42, 19); + out (balken links + (36 * waagerecht) + balken rechts); + cursor (2, 24); + out ("Programmabbruch: <ESC><" + abbruchzeichen + ">"); + cursor on +END PROC bildschirm neu; +PROC pruefe abbruch: + IF pressed key = esc + THEN pruefe weiter + FI. + pruefe weiter: + TEXT VAR naechstes zeichen :: pressed key (20); + IF naechstes zeichen = stopzeichen + THEN ende gewuenscht := TRUE + ELIF naechstes zeichen = abbruch zeichen + + THEN setze variable in anfangszustand; + cursor off; + errorstop (1951, "Programm - Abbruch durch <ESC><" + + abbruchzeichen + ">") + FI +END PROC pruefe abbruch; +PROC regeneriere w2: + cursor (42, 19); + out (ecke oben links + (36 * waagerecht)); + INT VAR zeile; + FOR zeile FROM 20 UPTO 22 REP + cursor (42, zeile); out (senkrecht); + PER; + cursor (42, 23); out (balken unten); + page (w2) + +END PROC regeneriere w2; +PROC fenster putzen: + page (w1); + page (w2) +END PROC fenster putzen; +PROC lies nummer ein (INT VAR nummer): + line (w2, 2); + out (w2, " Stoptaste: <ESC><" + stopzeichen + ">"); + hilfstext := text (nummer); + REP cursor (w1, 19, 2); + editget (w1, hilfstext, 4, 4, "", stopzeichen + abbruchzeichen, + exit char); + pruefe exit char; + change all (hilfstext, " ", "") + UNTIL hilfstext >= "0" AND hilfstext <= "9999" PER; + + nummer := int (hilfstext). + pruefe exit char: + IF exit char = esc + stopzeichen + THEN ende gewuenscht := TRUE; + cursor off; fenster putzen; cursor on; + nummer := 0; + LEAVE lies nummer ein + ELIF exit char = esc + abbruchzeichen + THEN setze variable in anfangszustand; + errorstop (1951, "Progamm - Abbruch durch <ESC><" + + abbruchzeichen + ">") + ELSE ende gewuenscht := FALSE + FI. + +END PROC lies nummer ein; +PROC lies artikelnummer ein: + page (w2); + cursor (w1, 2, 2); + out (w1, "Artikelnummer : "); + IF codekartenleser aktiviert + THEN artikelnummer := gesicherter wert von interface + (min artikelnummer , max artikelnummer, "Warenkarte") + ELSE artikelnummer von tastatur lesen + FI; + IF ende gewuenscht + THEN artikelnummer ist eingelesen := FALSE + ELSE artikelnummer ist eingelesen := TRUE + + FI. + artikelnummer von tastatur lesen: + cursor on; + REP out (w2, " Artikelnummer eingeben"); + lies nummer ein (artikelnummer); + UNTIL ende gewuenscht COR artikelnummer zulaessig PER. + artikelnummer zulaessig: + IF (artikelnummer < min artikelnummer OR + artikelnummer > max artikelnummer) + THEN page (w2); out (""7""); + out (w2, " Unzulässige Artikelnummer!"); + line (w2, 2); + out (w2, " Bitte irgendeine Taste tippen!"); + + pause; page (w2); + FALSE + ELSE TRUE + FI. +END PROC lies artikelnummer ein; +PROC artikelnummer lesen: + pruefe abbruch; + lies artikelnummer ein; + IF artikelnummer ist eingelesen + THEN hole artikeldaten (artikelnummer, artikelname, preis, + mindestbestand, bestand) + FI +END PROC artikelnummer lesen; +PROC kundennummer lesen: + pruefe abbruch; + lies kundennummer ein; + IF kundennummer ist eingelesen + THEN hole kundendaten (kundennummer, nachname, vorname, geschlecht) + + FI +END PROC kundennummer lesen; +PROC lies kundennummer ein: + page (w2); + cursor (w1, 2, 2); + out (w1, "Kundennummer : "); + IF codekartenleser aktiviert + THEN kundennummer := gesicherter wert von interface + (min kundennummer , max kundennummer, "Kundenkarte") + ELSE kundennummer von tastatur lesen + FI; + IF ende gewuenscht + THEN kundennummer ist eingelesen := FALSE + ELSE kundennummer ist eingelesen := TRUE + FI. + kundennummer von tastatur lesen: + + cursor on; + REP out (w2, " Kundennummer eingeben"); + lies nummer ein (kundennummer) + UNTIL ende gewuenscht COR kundennummer zulaessig PER. + kundennummer zulaessig: + IF (kundennummer < min kundennummer OR + kundennummer > max kundennummer) + THEN page (w2); out (""7""); + out (w2, " Unzulässige Kundennummer!"); + line (w2, 2); + out (w2, " Bitte irgendeine Taste tippen!"); + pause; page (w2); + FALSE + + ELSE TRUE + FI. +END PROC lies kundennummer ein; +PROC zeige artikeldaten: + cursor (w1, 2, 6); + out (w1, "Artikelname : " + text (artikelname, 16)); + cursor (w1, 2, 8); + out (w1, "Preis : " + text preis + " "); + cursor (w1, 2, 10); + out (w1, "Mindestbestand : " + text (mindestbestand) + " "); + cursor (w1, 2, 12); + out (w1, "Bestand : " + text (bestand) + " "). + text preis: + TEXT VAR hilfe :: text (preis, min (8, pos(text(preis),".")+2), 2); + + change (hilfe, " ", "0"); + hilfe. +END PROC zeige artikeldaten; +PROC zeige kundendaten: + cursor (w1, 2, 6); + out (w1, "Nachname : " + text (nachname, 16)); + cursor (w1, 2, 8); + out (w1, "Vorname : " + text (vorname , 16)); + cursor (w1, 2, 10); + out (w1, "Geschlecht : " + geschlecht + " "); +END PROC zeige kundendaten; +PROC artikeldaten speichern: + pruefe abbruch; + page (w2); line (w2); + out (w2, " Artikeldaten werden gespeichert") ; + + speichere artikeldaten (artikelnummer, artikelname, preis, + mindestbestand, bestand); + pause (10); + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + FI +END PROC artikeldaten speichern; +PROC kundendaten speichern: + pruefe abbruch; + page (w2); line (w2); + out (w2, " Kundendaten werden gespeichert") ; + speichere kundendaten (kundennummer, nachname,vorname, geschlecht); + pause (10); + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + + FI +END PROC kundendaten speichern; +BOOL PROC stoptaste gedrueckt: + pruefe abbruch; + ende gewuenscht +END PROC stoptaste gedrueckt; +BOOL PROC stoptaste gedrückt: + stoptaste gedrueckt +END PROC stoptaste gedrückt; +PROC neues blatt: + pruefe abbruch; + page (w3k); + page (w3); + auf neuem blatt := TRUE; + forget ("WARENHAUS:Rechnung", quiet) +END PROC neues blatt; +PROC nachbestellen: + pruefe abbruch; + FILE VAR f; + warten in w2; + hole bestelliste (f); + pruefe abbruch; + cursor (2,24); + + out ("Weiter mit <ESC><q>; Cursor bewegen: <Pfeile>"); + cursor on; + show (w4, f); + cursor off; + cursor (1, 24); out (""5""); + WINDOW VAR w :: window(45,18,25,3); + outframe (w); + IF yes (w, "Bestelliste drucken", FALSE) + THEN drucke (headline (f)) + FI; + cursor on; + forget (headline (f), quiet) +END PROC nachbestellen; +PROC warten in w2: + cursor off; + page (w2); + line (w2); + out (w2, " Bitte warten!"); + cursor on +END PROC warten in w2; +PROC codenummer von tastatur lesen (INT VAR codenummer): + + codenummer := 0; + out (w2, " Codenummer eingeben"); + cursor on; + lies nummer ein (codenummer) +END PROC codenummer von tastatur lesen; +PROC auskunft: + pruefe abbruch; + FILE VAR f; + INT VAR codenummer :: 0; + cursor (w1, 2, 2); + out (w1, "Codenummer : "); + page (w2); + IF codekartenleser aktiviert + THEN codenummer := gesicherter wert von interface (0,254, "Codekarte"); + lasse karte entfernen (FALSE) + ELSE codenummer von tastatur lesen (codenummer) + + FI; + IF ende gewuenscht THEN LEAVE auskunft FI; + SELECT codenummer OF CASE 66, 67, 68 : hitliste + CASE 73, 74, 75 : kaeuferliste + CASE 77, 78, 79 : kundenliste + CASE 84, 85, 86 : einkaufsliste + CASE 89, 90, 91 : lageruebersicht + OTHERWISE teste auf artikel oder kundennummer + END SELECT; + IF codekartenleser aktiviert CAND wert von interface <> 255 + THEN karte entfernen + FI. + karte entfernen: + + SELECT codenummer OF + CASE 66, 67, 68, 73, 74, 75, 77, 78, 79, 84, 85, 86, 89, 90, + 91: lasse karte entfernen (TRUE) + OTHERWISE lasse karte entfernen (FALSE) + END SELECT. + teste auf artikel oder kundennummer: + IF codenummer >= min artikelnummer AND codenummer <= max artikelnummer + THEN gib auskunft ueber artikeldaten + ELIF codenummer >= min kundennummer AND codenummer <= max kundennummer + THEN gib auskunft ueber kundendaten + ELSE unzulaessige codenummer + + FI. + unzulaessige codenummer: + out (10 * ""7""); + page (w2); + out (w2, " Unzulässige Codenummer !!!"); + line (w2, 2); + out (w2, " Bitte irgendeine Taste tippen!"); + pause; + page (w2). + gib auskunft ueber artikeldaten: + hole artikeldaten (codenummer, artikelname, preis, + mindestbestand, bestand); + zeige artikeldaten; + artikelnummer ist eingelesen := FALSE; + stop w2; + page (w1). + gib auskunft ueber kundendaten: + hole kundendaten (codenummer, nachname, vorname, geschlecht); + + zeige kundendaten; + kundennummer ist eingelesen := FALSE; + stop w2; + page (w1). + hitliste: + warten in w2; + hole auskunft ein (codenummer, 0, f); + zeige f. + kundenliste: + warten in w2; + hole auskunft ein (codenummer, 0, f); + zeige f. + zeige f: + pruefe abbruch; + cursor (2, 24); + out ("Weiter mit <ESC><q>; Cursor bewegen: <Pfeile>"); + show (w4, f); + cursor (1, 24); out (""5""); + evtl drucken. + lageruebersicht: + warten in w2; + + hole auskunft ein (codenummer, 0, f); + zeige f. + kaeuferliste: + lies artikelnummer ein; + IF artikelnummer ist eingelesen + THEN artikelnummer ist eingelesen := FALSE; + warten in w2; + hole auskunft ein (codenummer, artikelnummer, f); + zeige f + FI. + einkaufsliste: + lies kundennummer ein; + IF kundennummer ist eingelesen + THEN kundennummer ist eingelesen := FALSE; + warten in w2; + hole auskunft ein (codenummer, kundennummer, f); + + zeige f + FI. + evtl drucken: + WINDOW VAR w :: window(46,18,22,3); + cursor off; + outframe (w); + IF yes (w, "Auskunft drucken", FALSE) + THEN drucke (headline (f)) + FI; + cursor on; + forget (headline (f), quiet). +END PROC auskunft; +PROC rechnungskopf: + pruefe abbruch; + IF kundennummer ist eingelesen AND nachname <> "" + THEN ueberschrift := " RECHNUNG für " + anrede + (vorname SUB 1) + + ". " + text (nachname, 10) + ELSE ueberschrift := " RECHNUNG" + + FI; + summe := 0.0; + schreibe ueberschrift auf bildschirm; + schreibe in rechnungsdatei; + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + FI. + schreibe in rechnungsdatei: + sysout ("WARENHAUS:Rechnung"); + line; + put (ueberschrift); + line; + put (" =================================="); + line (2); + sysout (""). + anrede: + IF geschlecht = "m" + THEN "Herrn " + ELIF geschlecht = "w" + THEN "Frau " + ELSE "" + + FI. +END PROC rechnungskopf; +PROC schreibe ueberschrift auf bildschirm: + INT VAR spalte, zeile; + get cursor (w3, spalte, zeile); + IF zeile = 1 + THEN auf neuem blatt := TRUE; + schreibe in w3k + ELSE auf neuem blatt := FALSE; + schreibe in w3 + FI. + schreibe in w3: + IF remaining lines (w3) < 7 + THEN page (w3); + page (w3k); + auf neuem blatt := TRUE; + schreibe in w3k + ELSE line (w3); + out (w3, ueberschrift); + + line (w3); + out (w3, " =================================="); + line (w3, 2) + FI. + schreibe in w3k: + out (w3k, ueberschrift); + line (w3k); + out (w3k, " =================================="). +END PROC schreibe ueberschrift auf bildschirm; +PROC artikel kaufen: + pruefe abbruch; + IF artikelnummer ist eingelesen + THEN kauf registrieren + ELSE setze variable in anfangszustand; + errorstop ("Es ist keine Artikelnummer eingelesen worden!") + + FI; + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + FI. + kauf registrieren: + artikelnummer ist eingelesen := FALSE; + IF bestand > 0 + THEN artikel auf rechnung setzen; + registrieren + ELSE page (w2); out (""7""); + IF artikelname = "" + THEN out (w2, " Artikel hier nicht erhältlich!") + ELSE out (w2, " Der Artikel ist ausverkauft!") + FI; + line (w2, 2); + out (w2, " Weiter durch Tippen einer Taste"); + + pause + FI. + registrieren: + IF kundennummer ist eingelesen + THEN registriere verkauf (kundennummer, artikelnummer) + ELSE registriere verkauf (min kundennummer - 1, artikelnummer) + FI. + artikel auf rechnung setzen: + summe INCR preis; + IF remaining lines (w3) < 3 + THEN beginne wieder oben + FI; + out (w3, " " + text (artikelname, 15) + text (preis, 12, 2)); + line (w3); + sysout ("WARENHAUS:Rechnung"); + put (" " + text (artikelname, 15) + text preis); + + line; + sysout (""). + beginne wieder oben: + IF auf neuem blatt + THEN page (w3) + ELSE schreibe ueberschrift auf bildschirm + FI. + text preis: + TEXT VAR hilfe :: text (preis, 12, 2); + INT VAR vor punkt :: pos (hilfe, ".") - 1; + IF (hilfe SUB vor punkt) = " " + THEN change (hilfe, vor punkt, vor punkt, "0") + FI; + hilfe. +END PROC artikel kaufen; +PROC abrechnung: + pruefe abbruch; + schreibe summe auf bildschirm; + + schreibe summe in rechnungsdatei; + setze variable zurueck; + frage ob drucken; + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + FI. + schreibe summe auf bildschirm: + IF remaining lines (w3) < 2 + THEN beginne wieder oben + FI; + put (w3, " -------------"); + line (w3); + put (w3, " Summe " + text (summe, 12, 2)); + line (w3). + beginne wieder oben: + IF auf neuem blatt + THEN page (w3) + ELSE schreibe ueberschrift auf bildschirm + + FI. + schreibe summe in rechnungsdatei: + sysout ("WARENHAUS:Rechnung"); + put (" -------------"); + line; + put (" Summe " + text (summe, 12, 2)); + line; + sysout (""). + setze variable zurueck: + BOOL VAR alter wert :: ende gewuenscht; + setze variable in anfangszustand; + ende gewuenscht := alter wert. + frage ob drucken: + IF yes (w2, "Rechnung drucken", FALSE) + THEN cursor (3, 22); + disable stop; + print ("WARENHAUS:Rechnung"); + + IF is error THEN clear error FI; + enable stop + FI. +END PROC abrechnung; +PROC artikeldaten eingeben: + pruefe abbruch; + IF artikelnummer ist eingelesen + THEN lies artikeldaten ein; + artikeldaten speichern + ELSE setze variable in anfangszustand; + errorstop ("Es ist keine Artikelnummer eingelesen worden!") + FI. + lies artikeldaten ein: + zeige artikeldaten; + IF artikelname <> "" + THEN vielleicht schon fertig + ELSE page (w2) + + FI; + REP line (w2); + put (w2, " Artikeldaten eingeben"); + eingabe + UNTIL yes (w2, "Alles richtig", TRUE) + PER; + artikelnummer ist eingelesen := FALSE. + vielleicht schon fertig: + IF yes (w2, "Alles richtig", TRUE) + THEN artikelnummer ist eingelesen := FALSE; + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + FI; + LEAVE artikeldaten eingeben + FI. + eingabe: + name holen; + + preis holen; + mindestbestand holen; + bestand holen. + name holen: + REP cursor (w1, 19, 6); + editget (w1, artikelname, 80, 80, "", abbruchzeichen + stopzeichen, + exit char); + teste auf abbruch + UNTIL artikelname <> "" PER. + preis holen: + hilfstext := text (preis, pos(text(preis),".") + 2, 2); + change (hilfstext, " ", "0"); + REP cursor (w1, 19, 8); + editget (w1, hilfstext, 8, 8, "", abbruch zeichen + stopzeichen, + + exit char); + change (hilfstext, ",", "."); + preis := round (real (hilfstext), 2); + teste auf abbruch + UNTIL preis >= 0.0 PER. + mindestbestand holen: + hilfstext := text (mindestbestand); + REP cursor (w1, 19, 10); + editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen, + exit char); + mindestbestand := int (hilfstext); + teste auf abbruch + UNTIL mindestbestand >= 0 PER. + + bestand holen: + hilfstext := text (bestand); + REP cursor (w1, 19, 12); + editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen, + exit char); + bestand := int (hilfstext); + teste auf abbruch + UNTIL bestand >= 0 PER. + teste auf abbruch: + IF exit char = esc + stopzeichen + THEN ende gewuenscht := TRUE + ELIF exit char = esc + abbruchzeichen + THEN setze variable in anfangszustand; + errorstop (1951, "Programm - Abbruch durch <ESC><" + + + abbruchzeichen + ">") + FI. +END PROC artikeldaten eingeben; +PROC kundendaten eingeben: + IF kundennummer ist eingelesen + THEN lies kundendaten ein; + kundendaten speichern + ELSE setze variable in anfangszustand; + errorstop ("Es ist keine Kundennummer eingelesen worden!") + FI. + lies kundendaten ein: + zeige kundendaten; + IF nachname <> "" + THEN vielleicht schon fertig + ELSE page (w2) + FI; + REP line (w2); + + put (w2, " Kundendaten eingeben"); + eingabe + UNTIL yes (w2, "Alles richtig", TRUE) PER; + kundennummer ist eingelesen := FALSE. + vielleicht schon fertig: + IF yes (w2, "Alles richtig", TRUE) + THEN kundennummer ist eingelesen := FALSE; + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + FI; + LEAVE kundendaten eingeben + FI. + eingabe: + nachname holen; + vorname holen; + geschlecht holen. + + nachname holen: + REP cursor (w1, 19, 6); + editget (w1, nachname, 80, 80, "", abbruch zeichen + stopzeichen, + exit char); + teste auf abbruch + UNTIL nachname <> "" PER. + vorname holen: + REP cursor (w1, 19, 8); + editget (w1, vorname, 80, 80, "", abbruch zeichen + stopzeichen, + exit char); + teste auf abbruch + UNTIL vorname <> "" PER. + geschlecht holen: + REP cursor (w1, 19, 10); + + editget (w1, geschlecht, 9, 9, "", abbruchzeichen + stopzeichen, + exit char); + geschlecht := geschlecht SUB 1; + teste auf abbruch + UNTIL geschlecht = "m" OR geschlecht = "w" PER. + teste auf abbruch: + IF exit char = esc + stopzeichen + THEN ende gewuenscht := TRUE + ELIF exit char = esc + abbruchzeichen + THEN setze variable in anfangszustand; + errorstop (1951, "Programm - Abbruch durch <ESC><" + + + abbruchzeichen + ">") + FI. +END PROC kundendaten eingeben; +PROC drucke (TEXT CONST name): + TEXT VAR zeile; + FILE VAR f :: sequential file (modify, name); + to line (f, 1); + insert record (f); + write record (f, "#center#" + name); + down (f); + insert record (f); + down (f); + WHILE NOT eof (f) REP + read record (f, zeile); + IF pos (zeile, ""15"") > 0 + THEN change (zeile, ""15"", "#on(""r"")#"); + change (zeile, ""14"", "#off(""r"")#"); + + write record (f, zeile) + FI; + down (f) + PER; + cursor (3, 22); + print (name) +END PROC drucke; +PROC stop w2: + cursor off; + page (w2); + out (w2," Zum Weitermachen bitte");line(w2); + out (w2," irgendeine Taste tippen!"); + pause; + page (w2); + cursor on +END PROC stop w2; +BOOL PROC yes (WINDOW VAR w, TEXT CONST frage, BOOL CONST default): + BOOL VAR antwort :: default; + TEXT VAR taste; + INT CONST ja pos :: (areaxsize (w) - 9) DIV 2; + cursor off; + cursor (42,24); out ("Ändern: <Pfeile> Bestätigen: <RETURN>"); + + page (w); + out (w, center (w, frage + " ?")); + cursor (w, ja pos, 3); + IF default + THEN out (w, ""15"Ja "14" Nein "); + cursor (w, ja pos, 3) + ELSE out (w, " Ja "15"Nein "14""); + cursor (w, ja pos + 5, 3) + FI; + tastendruck auswerten; + page (w); + cursor (42,24); out (""5""); + cursor on; + antwort. + tastendruck auswerten: + REP inchar (taste); + SELECT code (taste) OF CASE 2, 8 : position aendern + CASE 13 : LEAVE tastendruck auswerten + + CASE 74, 106 : antwort := TRUE; (*Jj*) + LEAVE tastendruck auswerten + CASE 78, 110 : antwort := FALSE; (*Nn*) + LEAVE tastendruck auswerten + OTHERWISE out (""7"") END SELECT + PER. + position aendern: + IF antwort THEN antwort := FALSE; + cursor (w, ja pos, 3); + out (w, " Ja "15"Nein "14""); + + cursor (w, ja pos + 5, 3) + ELSE antwort := TRUE; + cursor (w, ja pos, 3); + out (w, ""15"Ja "14" Nein "); + cursor (w, ja pos, 3) + FI. +END PROC yes; +PROC tastatureingabe (BOOL CONST erwuenscht, INT VAR rueckmeldung): + IF erwuenscht + THEN rueckmeldung := 0; + codekartenleser aktiviert := FALSE; + schliesse interface + ELSE oeffne interface (rueckmeldung); + IF rueckmeldung >= 0 + + THEN codekartenleser aktiviert := TRUE + ELSE codekartenleser aktiviert := FALSE + FI + FI +END PROC tastatureingabe; +BOOL PROC eingabe mit codekartenleser: + codekartenleser aktiviert +END PROC eingabe mit codekartenleser; +PROC dezimalwert lesen: + pruefe abbruch; + IF codekartenleser aktiviert + THEN interfacewerte zeigen + ELSE setze variable in anfangszustand; + errorstop ("Eingabeart ist auf Tastatur eingestellt!") + FI. + interfacewerte zeigen: + + cursor off; + fenster putzen; + line (w1, 4); line (w2); + out (w1, " Dezimalwert :"); + out (w2, " Lesen beenden mit <ESC><q>"); + ende gewuenscht := FALSE; + REP pruefe abbruch; + cursor (w1, 17, 5); + out (w1, text (wert von interface, 3)) + UNTIL ende gewuenscht PER; + page (w2); cursor (w1, 1, 5); out (" "); + cursor on. +END PROC dezimalwert lesen; +PROC bitmuster lesen: + pruefe abbruch; + IF codekartenleser aktiviert + + THEN interfacewerte zeigen + ELSE setze variable in anfangszustand; + errorstop ("Eingabeart ist auf Tastatur eingestellt!") + FI. + interfacewerte zeigen: + cursor off; + fenster putzen; + line (w1, 4); line (w2); + out (w1, " Bitmuster :"); + out (w2, " Lesen beenden mit <ESC><q>"); + ende gewuenscht := FALSE; + REP pruefe abbruch; + cursor (w1, 16, 5); + out (w1, bitmuster (wert von interface)) + UNTIL ende gewuenscht PER; + page (w2); cursor (w1, 1, 5); out (" "); + + cursor on. +END PROC bitmuster lesen; +TEXT PROC bitmuster (INT CONST wert): + INT VAR bitnr; + TEXT VAR muster :: ""; + FOR bitnr FROM 7 DOWNTO 0 REP + IF bit (wert, bitnr) + THEN muster CAT "I" + ELSE muster CAT "O" + FI + PER; + muster +END PROC bitmuster; +PROC lasse karte entfernen (BOOL CONST mit rahmen): + IF wert von interface <> 255 + THEN cursor off; + IF mit rahmen THEN regeneriere w2 ELSE page (w2) FI; + line (w2); + out (w2, " Bitte Karte entfernen"); + + REP pruefe abbruch + UNTIL (wert von interface = 255) OR ende gewuenscht PER; + cursor on + FI +END PROC lasse karte entfernen; +INT PROC gesicherter wert von interface (INT CONST von, bis, + TEXT CONST kartenart): + INT VAR wert, zaehler; + ende gewuenscht := FALSE; + cursor off; + REP out (w2, " Bitte " + kartenart + " einschieben"); + line (w2, 2); + out (w2, " Stoptaste: <ESC><" + stopzeichen + ">"); + cursor (79, 24); + + gesicherten wert einlesen; + cursor (w1, 19, 2); + out (w1, text (wert, 3)); + IF wert < von OR wert > bis + THEN warnung + FI + UNTIL wert >= von AND wert <= bis PER; + cursor on; + wert. + gesicherten wert einlesen: + REP zaehler := 0; + warte auf karte; + wert := wert von interface; + lies wert + UNTIL wert gesichert AND wert <> 255 PER. + warte auf karte: + REP beachte esc q + UNTIL wert von interface <> 255 PER. + beachte esc q: + + pruefe abbruch; + IF ende gewuenscht + THEN cursor on; + LEAVE gesicherter wert von interface WITH 0 + FI. + lies wert: + REP beachte esc q; + IF wert = wert von interface + THEN zaehler INCR 1 + ELSE LEAVE lies wert + FI + UNTIL wert gesichert PER. + wert gesichert: zaehler = sicherheit. + warnung: + page (w2); out (""7""); + out (w2, " Dies ist keine " + kartenart + "!"); + line (w2, 2); + out (w2, " Bitte Karte entfernen"); + + REP beachte esc q + UNTIL wert von interface = 255 PER; + page (w2). +END PROC gesicherter wert von interface +END PACKET ls warenhaus 3 + diff --git a/warenhaus/ls-Warenhaus 4 b/warenhaus/ls-Warenhaus 4 index a19a6d6..e90e60a 100644 --- a/warenhaus/ls-Warenhaus 4 +++ b/warenhaus/ls-Warenhaus 4 @@ -22,27 +22,400 @@ *) PACKET ls warenhaus 4 DEFINES - uebersetze:{}TYPE VOKABEL = STRUCT (TEXT grin, elan),{} REFINEMENT = STRUCT (TEXT name, INT aufruf);{}LET befehlsanzahl = 10,{} max refinements = 20,{} max offene strukturen = 10,{} schleife = 1,{} abfrage = 2;{}ROW befehlsanzahl VOKABEL CONST befehl :: ROW befehlsanzahl VOKABEL :{} (VOKABEL : ("Artikelnummerlesen", "artikelnummer lesen"),{} VOKABEL : ("Artikeldateneingeben", "artikeldaten eingeben"),{} VOKABEL : ("Kundennummerlesen", "kundennummer lesen"),{}{} - VOKABEL : ("Kundendateneingeben", "kundendaten eingeben"),{} VOKABEL : ("Rechnungskopf", "rechnungskopf"),{} VOKABEL : ("Artikelkaufen", "artikel kaufen"),{} VOKABEL : ("Abrechnung", "abrechnung"),{} VOKABEL : ("Auskunft", "auskunft"),{} VOKABEL : ("neuesBlatt", "neues blatt"),{} VOKABEL : ("Bildschirmneu", "bildschirm neu"));{}ROW max refinements REFINEMENT VAR refinement;{}ROW max offene strukturen INT VAR offene struktur;{}{} -INT VAR zeilennummer, erster fehler;{}OP := (VOKABEL VAR links, VOKABEL CONST rechts):{} CONCR (links) := CONCR (rechts){}END OP :=;{}PROC uebersetze (TEXT CONST dateiname):{}forget ("elanprogramm", quiet);{}FILE VAR quelle :: sequential file (input, dateiname),{} ziel :: sequential file (output, "elanprogramm");{}suche programmanfang;{}WHILE NOT (eof (quelle) OR anything noted) REP{} bearbeite zeile{}PER;{}IF NOT anything noted{} THEN abschlusspruefung{}FI;{}IF anything noted{} THEN quelle := sequential file (modify, dateiname);{}{} - to line (quelle, erster fehler);{} col (1);{} noteedit (quelle);{} errorstop (""){}FI.{}abschlusspruefung:{} IF anzahl refinements > 0{} THEN pruefe refinementliste{} ELSE pruefe programmende{} FI.{}pruefe programmende:{} IF programmende fehlt{} THEN zeilennummer INCR 1;{} fehler (16){} FI.{}pruefe refinementliste:{} zeilennummer INCR 1;{} pruefe auf offene schleife oder abfrage;{} put (ziel, "END PROC refinement " + text (letztes refinement));{}{} - FOR index FROM 1 UPTO anzahl refinements REP{} IF refinement [index].aufruf > 0{} THEN zeilennummer := refinement [index].aufruf;{} fehler (25){} ELIF refinement [index].aufruf < 0{} THEN zeilennummer := - refinement [index].aufruf;{} fehler (26){} FI{} PER.{}suche programmanfang:{} TEXT VAR restzeile, zeile :: "";{} BOOL VAR programmende fehlt := FALSE,{} refinement muss folgen := FALSE;{} INT VAR anzahl refinements := 0,{} letztes refinement := 0,{}{} - letzte geoeffnete := 0,{} index;{} zeilennummer := 0;{} erster fehler := 0;{} WHILE NOT eof (quelle) AND zeile = "" REP{} getline (quelle, zeile);{} zeile := compress (zeile);{} zeilennummer INCR 1;{} cout (zeilennummer);{} IF zeile = "" THEN line (ziel) FI;{} PER;{} put (ziel, "bildschirm neu;");{} IF zeile = "" THEN LEAVE uebersetze{} ELIF pos (zeile, "PROGRAMM") = 1{} THEN programmende fehlt := TRUE{} ELSE fehler (1){} FI.{}bearbeite zeile:{}{} - zeilennummer INCR 1;{} cout (zeilennummer);{} getline (quelle, zeile);{} zeile := compress (zeile);{} change all (zeile, " ", "");{} IF zeile = ""{} THEN line (ziel){} ELSE analysiere und uebersetze{} FI.{}analysiere und uebersetze:{} IF refinement muss folgen{} THEN erstes refinement{} ELSE pruefe zunaechst auf schluesselworte;{} durchsuche befehlsliste{} FI.{}erstes refinement:{} IF pos (zeile, ":") = 0{} THEN fehler (19){} ELIF pos (zeile, ":") < length (zeile){}{} - THEN fehler (20){} ELIF (pos (zeile, "PROGRAMM") = 1) OR{} (pos (zeile, "ENDE") = 1) OR{} (pos (zeile, "WIEDERHOLE") = 1) OR{} (pos (zeile, "BIS") = 1) OR{} (pos (zeile, "WENN") = 1){} THEN fehler (21){} ELIF (zeile = "Stoptastegedrückt:") OR{} (zeile = "nichtStoptastegedrückt:") OR{} (zeile = "Stoptastegedrueckt:") OR{} (zeile = "nichtStoptastegedrueckt:"){} THEN fehler (22){} ELSE refinement muss folgen := FALSE;{}{} - line (ziel);{} trage befehlsdefinition ein{} FI.{}trage befehlsdefinition ein:{} change (zeile, ":", "");{} FOR index FROM 1 UPTO anzahl refinements REP{} IF refinement [index].name = zeile{} THEN pruefe aufruf; LEAVE trage befehlsdefinition ein{} FI{} PER;{} anzahl refinements INCR 1;{} IF anzahl refinements > max refinements{} THEN fehler (24){} ELSE refinement [anzahl refinements].name := zeile;{} refinement [anzahl refinements].aufruf := - zeilennummer;{}{} - letztes refinement := anzahl refinements;{} line (ziel);{} put (ziel, "PROC refinement " + text (anzahl refinements) + ":"){} FI.{}pruefe aufruf:{} IF refinement [index].aufruf > 0{} THEN refinement [index].aufruf := 0;{} line (ziel);{} put (ziel, "PROC refinement " + text (index) + ":");{} letztes refinement := index{} ELSE fehler (23){} FI.{}pruefe zunaechst auf schluesselworte:{} IF pos (zeile, "WIEDERHOLE") = 1{} THEN oeffne schleife; LEAVE analysiere und uebersetze{}{} - ELIF pos (zeile, "WENN") = 1{} THEN oeffne if; LEAVE analysiere und uebersetze{} ELIF pos (zeile, "BIS") = 1{} THEN schliesse mit until; LEAVE analysiere und uebersetze{} ELIF pos (zeile, "ENDE") = 1{} THEN schliesse; LEAVE analysiere und uebersetze{} ELIF pos (zeile, "PROGRAMM") = 1{} THEN fehler (18); LEAVE analysiere und uebersetze{} FI.{}oeffne schleife:{} IF letzte geoeffnete = max offene strukturen{} THEN fehler (2){} ELSE letzte geoeffnete INCR 1;{} offene struktur [letzte geoeffnete] := schleife;{}{} - analysiere schleifenart{} FI.{}analysiere schleifenart:{} IF zeile = "WIEDERHOLE"{} THEN line (ziel); put (ziel, "REPEAT"){} ELSE es muss eine zaehlschleife sein{} FI.{}es muss eine zaehlschleife sein:{} restzeile := subtext (zeile, 11);{} INT VAR malpos := pos (restzeile, "MAL");{} IF malpos > 0{} THEN zaehlschleife{} ELSE fehler (3){} FI.{}zaehlschleife:{} IF length (restzeile) > malpos + 2{} THEN fehler (4){} ELSE bestimme anzahl der wiederholungen{} FI.{}{} -bestimme anzahl der wiederholungen:{} INT VAR wdh := int (subtext (restzeile, 1, malpos - 1));{} IF last conversion ok{} THEN line (ziel);{} put (ziel, "INT VAR index" + text (zeilennummer) +{} "; FOR index" + text (zeilennummer) +{} " FROM 1 UPTO " + text (wdh) + " REPEAT"){} ELSE fehler (5){} FI.{}oeffne if:{} IF letzte geoeffnete = max offene strukturen{} THEN fehler (6){} ELSE letzte geoeffnete INCR 1;{} offene struktur [letzte geoeffnete] := abfrage;{}{} - uebersetze abfrage{} FI.{}uebersetze abfrage:{} restzeile := subtext (zeile, 5);{} IF (restzeile = "Stoptastegedrückt") OR{} (restzeile = "Stoptastegedrueckt"){} THEN line (ziel); put (ziel, "IF stoptaste gedrueckt THEN"){} ELIF (restzeile = "nichtStoptastegedrückt") OR{} (restzeile = "nichtStoptastegedrueckt"){} THEN line (ziel); put (ziel, "IF NOT stoptaste gedrueckt THEN"){} ELIF restzeile = ""{} THEN fehler (7){} ELSE fehler (8){} FI.{}schliesse mit until:{}{} - teste ob als letztes schleife offen;{} letzte geoeffnete DECR 1;{} restzeile := subtext (zeile, 4);{} IF (restzeile = "Stoptastegedrückt") OR{} (restzeile = "Stoptastegedrueckt"){} THEN line (ziel);{} put (ziel, "UNTIL stoptaste gedrueckt END REPEAT;");{} ELIF (restzeile = "nichtStoptastegedrückt") OR{} (restzeile = "nichtStoptastegedrueckt"){} THEN line (ziel);{} put (ziel, "UNTIL NOT stoptaste gedrueckt END REPEAT;");{} ELIF restzeile = ""{}{} - THEN fehler (9){} ELSE fehler (8){} FI.{}schliesse:{} restzeile := subtext (zeile, 5);{} IF restzeile = "WIEDERHOLE"{} THEN schliesse schleife{} ELIF restzeile = "WENN"{} THEN schliesse if{} ELIF restzeile = "PROGRAMM"{} THEN programmende{} ELSE fehler (10){} FI.{}schliesse schleife:{} teste ob als letztes schleife offen;{} letzte geoeffnete DECR 1;{} line (ziel); put (ziel, "END REPEAT;").{}teste ob als letztes schleife offen:{} IF letzte geoeffnete = 0{} THEN fehler (11);{}{} - LEAVE bearbeite zeile{} ELIF offene struktur [letzte geoeffnete] = abfrage{} THEN fehler (12){} FI.{}schliesse if:{} teste ob als letztes abfrage offen;{} line (ziel); put (ziel, "END IF;");{} letzte geoeffnete DECR 1.{}teste ob als letztes abfrage offen:{} IF letzte geoeffnete = 0{} THEN fehler (13);{} LEAVE bearbeite zeile{} ELIF offene struktur [letzte geoeffnete] = schleife{} THEN fehler (14){} FI.{}programmende:{} IF programmende fehlt{} THEN programmende fehlt := FALSE;{}{} - refinement muss folgen := TRUE{} ELSE fehler (17);{} LEAVE programmende{} FI;{} pruefe auf offene schleife oder abfrage.{}pruefe auf offene schleife oder abfrage:{} IF letzte geoeffnete = 0{} THEN alles okay{} ELIF offene struktur [letzte geoeffnete] = schleife{} THEN fehler (14){} ELSE fehler (12){} FI.{} alles okay: .{}durchsuche befehlsliste:{} IF pos (zeile, ":") > 0{} THEN auf refinementdefinition pruefen{} ELSE befehl suchen{} FI.{}befehl suchen:{}{} - BOOL VAR gefunden := FALSE;{} INT VAR i;{} verhindere bedingung;{} FOR i FROM 1 UPTO befehlsanzahl REP{} IF befehl [i].grin = zeile{} THEN gefunden := TRUE;{} line (ziel);{} put (ziel, befehl [i].elan + ";"){} FI{} UNTIL gefunden PER;{} IF NOT gefunden{} THEN trage in refinementliste ein{} FI.{}auf refinementdefinition pruefen:{} IF pos (zeile, ":") < length (zeile){} THEN fehler (20){} ELIF programmende fehlt{} THEN fehler (16){} ELIF (zeile = "Stoptastegedrückt:") OR{}{} - (zeile = "nichtStoptastegedrückt:") OR{} (zeile = "Stoptastegedrueckt:") OR{} (zeile = "nichtStoptastegedrueckt:"){} THEN fehler (22){} ELSE pruefe auf offene schleife oder abfrage;{} put (ziel, "END PROC refinement " + text (letztes refinement){} + ";");{} trage befehlsdefinition ein{} FI.{}trage in refinementliste ein:{} FOR index FROM 1 UPTO anzahl refinements REP{} IF refinement [index].name = zeile{}{} - THEN trage evtl aufruf ein;{} LEAVE trage in refinementliste ein{} FI{} PER;{} anzahl refinements INCR 1;{} IF anzahl refinements > max refinements{} THEN fehler (24){} ELSE refinement [anzahl refinements].name := zeile;{} refinement [anzahl refinements].aufruf := zeilennummer;{} line (ziel);{} put (ziel, "refinement " + text (anzahl refinements) + ";"){} FI.{}trage evtl aufruf ein:{} line (ziel);{} put (ziel, "refinement " + text (index) + ";");{}{} - IF refinement [index].aufruf < 0{} THEN refinement [index].aufruf := 0{} FI.{}verhindere bedingung:{} IF (zeile = "Stoptastegedrückt") OR (zeile = "nichtStoptastegedrückt") OR{} (zeile = "Stoptastegedrueckt") OR (zeile = "nichtStoptastegedrueckt"){} THEN fehler (15);{} LEAVE bearbeite zeile{} FI.{}END PROC uebersetze;{}PROC fehler (INT CONST fehlernr):{} noteline;{} note ("FEHLER in Zeile " + text (zeilennummer) + ": ");{} noteline;{} note (" " + anwendungstext (fehlernr + 20));{}{} - noteline;{} IF erster fehler = 0{} THEN erster fehler := zeilennummer{} FI{}END PROC fehler{}END PACKET ls warenhaus 4{}{} + uebersetze: +TYPE VOKABEL = STRUCT (TEXT grin, elan), + REFINEMENT = STRUCT (TEXT name, INT aufruf); +LET befehlsanzahl = 10, + max refinements = 20, + max offene strukturen = 10, + schleife = 1, + abfrage = 2; +ROW befehlsanzahl VOKABEL CONST befehl :: ROW befehlsanzahl VOKABEL : + (VOKABEL : ("Artikelnummerlesen", "artikelnummer lesen"), + VOKABEL : ("Artikeldateneingeben", "artikeldaten eingeben"), + VOKABEL : ("Kundennummerlesen", "kundennummer lesen"), + + + VOKABEL : ("Kundendateneingeben", "kundendaten eingeben"), + VOKABEL : ("Rechnungskopf", "rechnungskopf"), + VOKABEL : ("Artikelkaufen", "artikel kaufen"), + VOKABEL : ("Abrechnung", "abrechnung"), + VOKABEL : ("Auskunft", "auskunft"), + VOKABEL : ("neuesBlatt", "neues blatt"), + VOKABEL : ("Bildschirmneu", "bildschirm neu")); +ROW max refinements REFINEMENT VAR refinement; +ROW max offene strukturen INT VAR offene struktur; + + +INT VAR zeilennummer, erster fehler; +OP := (VOKABEL VAR links, VOKABEL CONST rechts): + CONCR (links) := CONCR (rechts) +END OP :=; +PROC uebersetze (TEXT CONST dateiname): +forget ("elanprogramm", quiet); +FILE VAR quelle :: sequential file (input, dateiname), + ziel :: sequential file (output, "elanprogramm"); +suche programmanfang; +WHILE NOT (eof (quelle) OR anything noted) REP + bearbeite zeile +PER; +IF NOT anything noted + THEN abschlusspruefung +FI; +IF anything noted + THEN quelle := sequential file (modify, dateiname); + + + to line (quelle, erster fehler); + col (1); + noteedit (quelle); + errorstop ("") +FI. +abschlusspruefung: + IF anzahl refinements > 0 + THEN pruefe refinementliste + ELSE pruefe programmende + FI. +pruefe programmende: + IF programmende fehlt + THEN zeilennummer INCR 1; + fehler (16) + FI. +pruefe refinementliste: + zeilennummer INCR 1; + pruefe auf offene schleife oder abfrage; + put (ziel, "END PROC refinement " + text (letztes refinement)); + + + FOR index FROM 1 UPTO anzahl refinements REP + IF refinement [index].aufruf > 0 + THEN zeilennummer := refinement [index].aufruf; + fehler (25) + ELIF refinement [index].aufruf < 0 + THEN zeilennummer := - refinement [index].aufruf; + fehler (26) + FI + PER. +suche programmanfang: + TEXT VAR restzeile, zeile :: ""; + BOOL VAR programmende fehlt := FALSE, + refinement muss folgen := FALSE; + INT VAR anzahl refinements := 0, + letztes refinement := 0, + + + letzte geoeffnete := 0, + index; + zeilennummer := 0; + erster fehler := 0; + WHILE NOT eof (quelle) AND zeile = "" REP + getline (quelle, zeile); + zeile := compress (zeile); + zeilennummer INCR 1; + cout (zeilennummer); + IF zeile = "" THEN line (ziel) FI; + PER; + put (ziel, "bildschirm neu;"); + IF zeile = "" THEN LEAVE uebersetze + ELIF pos (zeile, "PROGRAMM") = 1 + THEN programmende fehlt := TRUE + ELSE fehler (1) + FI. +bearbeite zeile: + + + zeilennummer INCR 1; + cout (zeilennummer); + getline (quelle, zeile); + zeile := compress (zeile); + change all (zeile, " ", ""); + IF zeile = "" + THEN line (ziel) + ELSE analysiere und uebersetze + FI. +analysiere und uebersetze: + IF refinement muss folgen + THEN erstes refinement + ELSE pruefe zunaechst auf schluesselworte; + durchsuche befehlsliste + FI. +erstes refinement: + IF pos (zeile, ":") = 0 + THEN fehler (19) + ELIF pos (zeile, ":") < length (zeile) + + + THEN fehler (20) + ELIF (pos (zeile, "PROGRAMM") = 1) OR + (pos (zeile, "ENDE") = 1) OR + (pos (zeile, "WIEDERHOLE") = 1) OR + (pos (zeile, "BIS") = 1) OR + (pos (zeile, "WENN") = 1) + THEN fehler (21) + ELIF (zeile = "Stoptastegedrückt:") OR + (zeile = "nichtStoptastegedrückt:") OR + (zeile = "Stoptastegedrueckt:") OR + (zeile = "nichtStoptastegedrueckt:") + THEN fehler (22) + ELSE refinement muss folgen := FALSE; + + + line (ziel); + trage befehlsdefinition ein + FI. +trage befehlsdefinition ein: + change (zeile, ":", ""); + FOR index FROM 1 UPTO anzahl refinements REP + IF refinement [index].name = zeile + THEN pruefe aufruf; LEAVE trage befehlsdefinition ein + FI + PER; + anzahl refinements INCR 1; + IF anzahl refinements > max refinements + THEN fehler (24) + ELSE refinement [anzahl refinements].name := zeile; + refinement [anzahl refinements].aufruf := - zeilennummer; + + + letztes refinement := anzahl refinements; + line (ziel); + put (ziel, "PROC refinement " + text (anzahl refinements) + ":") + FI. +pruefe aufruf: + IF refinement [index].aufruf > 0 + THEN refinement [index].aufruf := 0; + line (ziel); + put (ziel, "PROC refinement " + text (index) + ":"); + letztes refinement := index + ELSE fehler (23) + FI. +pruefe zunaechst auf schluesselworte: + IF pos (zeile, "WIEDERHOLE") = 1 + THEN oeffne schleife; LEAVE analysiere und uebersetze + + + ELIF pos (zeile, "WENN") = 1 + THEN oeffne if; LEAVE analysiere und uebersetze + ELIF pos (zeile, "BIS") = 1 + THEN schliesse mit until; LEAVE analysiere und uebersetze + ELIF pos (zeile, "ENDE") = 1 + THEN schliesse; LEAVE analysiere und uebersetze + ELIF pos (zeile, "PROGRAMM") = 1 + THEN fehler (18); LEAVE analysiere und uebersetze + FI. +oeffne schleife: + IF letzte geoeffnete = max offene strukturen + THEN fehler (2) + ELSE letzte geoeffnete INCR 1; + offene struktur [letzte geoeffnete] := schleife; + + + analysiere schleifenart + FI. +analysiere schleifenart: + IF zeile = "WIEDERHOLE" + THEN line (ziel); put (ziel, "REPEAT") + ELSE es muss eine zaehlschleife sein + FI. +es muss eine zaehlschleife sein: + restzeile := subtext (zeile, 11); + INT VAR malpos := pos (restzeile, "MAL"); + IF malpos > 0 + THEN zaehlschleife + ELSE fehler (3) + FI. +zaehlschleife: + IF length (restzeile) > malpos + 2 + THEN fehler (4) + ELSE bestimme anzahl der wiederholungen + FI. + + +bestimme anzahl der wiederholungen: + INT VAR wdh := int (subtext (restzeile, 1, malpos - 1)); + IF last conversion ok + THEN line (ziel); + put (ziel, "INT VAR index" + text (zeilennummer) + + "; FOR index" + text (zeilennummer) + + " FROM 1 UPTO " + text (wdh) + " REPEAT") + ELSE fehler (5) + FI. +oeffne if: + IF letzte geoeffnete = max offene strukturen + THEN fehler (6) + ELSE letzte geoeffnete INCR 1; + offene struktur [letzte geoeffnete] := abfrage; + + + uebersetze abfrage + FI. +uebersetze abfrage: + restzeile := subtext (zeile, 5); + IF (restzeile = "Stoptastegedrückt") OR + (restzeile = "Stoptastegedrueckt") + THEN line (ziel); put (ziel, "IF stoptaste gedrueckt THEN") + ELIF (restzeile = "nichtStoptastegedrückt") OR + (restzeile = "nichtStoptastegedrueckt") + THEN line (ziel); put (ziel, "IF NOT stoptaste gedrueckt THEN") + ELIF restzeile = "" + THEN fehler (7) + ELSE fehler (8) + FI. +schliesse mit until: + + + teste ob als letztes schleife offen; + letzte geoeffnete DECR 1; + restzeile := subtext (zeile, 4); + IF (restzeile = "Stoptastegedrückt") OR + (restzeile = "Stoptastegedrueckt") + THEN line (ziel); + put (ziel, "UNTIL stoptaste gedrueckt END REPEAT;"); + ELIF (restzeile = "nichtStoptastegedrückt") OR + (restzeile = "nichtStoptastegedrueckt") + THEN line (ziel); + put (ziel, "UNTIL NOT stoptaste gedrueckt END REPEAT;"); + ELIF restzeile = "" + + + THEN fehler (9) + ELSE fehler (8) + FI. +schliesse: + restzeile := subtext (zeile, 5); + IF restzeile = "WIEDERHOLE" + THEN schliesse schleife + ELIF restzeile = "WENN" + THEN schliesse if + ELIF restzeile = "PROGRAMM" + THEN programmende + ELSE fehler (10) + FI. +schliesse schleife: + teste ob als letztes schleife offen; + letzte geoeffnete DECR 1; + line (ziel); put (ziel, "END REPEAT;"). +teste ob als letztes schleife offen: + IF letzte geoeffnete = 0 + THEN fehler (11); + + + LEAVE bearbeite zeile + ELIF offene struktur [letzte geoeffnete] = abfrage + THEN fehler (12) + FI. +schliesse if: + teste ob als letztes abfrage offen; + line (ziel); put (ziel, "END IF;"); + letzte geoeffnete DECR 1. +teste ob als letztes abfrage offen: + IF letzte geoeffnete = 0 + THEN fehler (13); + LEAVE bearbeite zeile + ELIF offene struktur [letzte geoeffnete] = schleife + THEN fehler (14) + FI. +programmende: + IF programmende fehlt + THEN programmende fehlt := FALSE; + + + refinement muss folgen := TRUE + ELSE fehler (17); + LEAVE programmende + FI; + pruefe auf offene schleife oder abfrage. +pruefe auf offene schleife oder abfrage: + IF letzte geoeffnete = 0 + THEN alles okay + ELIF offene struktur [letzte geoeffnete] = schleife + THEN fehler (14) + ELSE fehler (12) + FI. + alles okay: . +durchsuche befehlsliste: + IF pos (zeile, ":") > 0 + THEN auf refinementdefinition pruefen + ELSE befehl suchen + FI. +befehl suchen: + + + BOOL VAR gefunden := FALSE; + INT VAR i; + verhindere bedingung; + FOR i FROM 1 UPTO befehlsanzahl REP + IF befehl [i].grin = zeile + THEN gefunden := TRUE; + line (ziel); + put (ziel, befehl [i].elan + ";") + FI + UNTIL gefunden PER; + IF NOT gefunden + THEN trage in refinementliste ein + FI. +auf refinementdefinition pruefen: + IF pos (zeile, ":") < length (zeile) + THEN fehler (20) + ELIF programmende fehlt + THEN fehler (16) + ELIF (zeile = "Stoptastegedrückt:") OR + + + (zeile = "nichtStoptastegedrückt:") OR + (zeile = "Stoptastegedrueckt:") OR + (zeile = "nichtStoptastegedrueckt:") + THEN fehler (22) + ELSE pruefe auf offene schleife oder abfrage; + put (ziel, "END PROC refinement " + text (letztes refinement) + + ";"); + trage befehlsdefinition ein + FI. +trage in refinementliste ein: + FOR index FROM 1 UPTO anzahl refinements REP + IF refinement [index].name = zeile + + + THEN trage evtl aufruf ein; + LEAVE trage in refinementliste ein + FI + PER; + anzahl refinements INCR 1; + IF anzahl refinements > max refinements + THEN fehler (24) + ELSE refinement [anzahl refinements].name := zeile; + refinement [anzahl refinements].aufruf := zeilennummer; + line (ziel); + put (ziel, "refinement " + text (anzahl refinements) + ";") + FI. +trage evtl aufruf ein: + line (ziel); + put (ziel, "refinement " + text (index) + ";"); + + + IF refinement [index].aufruf < 0 + THEN refinement [index].aufruf := 0 + FI. +verhindere bedingung: + IF (zeile = "Stoptastegedrückt") OR (zeile = "nichtStoptastegedrückt") OR + (zeile = "Stoptastegedrueckt") OR (zeile = "nichtStoptastegedrueckt") + THEN fehler (15); + LEAVE bearbeite zeile + FI. +END PROC uebersetze; +PROC fehler (INT CONST fehlernr): + noteline; + note ("FEHLER in Zeile " + text (zeilennummer) + ": "); + noteline; + note (" " + anwendungstext (fehlernr + 20)); + + + noteline; + IF erster fehler = 0 + THEN erster fehler := zeilennummer + FI +END PROC fehler +END PACKET ls warenhaus 4 + + diff --git a/warenhaus/ls-Warenhaus 5 b/warenhaus/ls-Warenhaus 5 index 6b05bad..3a64e00 100644 --- a/warenhaus/ls-Warenhaus 5 +++ b/warenhaus/ls-Warenhaus 5 @@ -22,82 +22,1278 @@ *) PACKET ls warenhaus 5 DEFINES - warenhaus,{} grin,{} direktbefehl 1,{} direktbefehl 2,{} direktbefehl 3,{} direktbefehl 4,{} direktbefehl 5,{} direktbefehl 6,{} direktbefehl 7,{} warenhausbefehle zeigen,{} eingabe grundeinstellung,{} tastatur einstellen,{} kartenleser einstellen,{} evtl d und b sperren,{} loesche zwischenraum,{} eingabeart anzeigen,{} filialdaten zusammenstellen,{} filialdaten eintragen,{} filialdaten verzeichnis,{} - filialdaten umbenennen,{} filialdaten loeschen,{} warenhausprogramme verzeichnis,{} warenhausprogramm neu erstellen,{} warenhausprogramm ansehen,{} warenhausprogramm kopieren,{} warenhausprogramm umbenennen,{} warenhausprogramme loeschen,{} warenhausprogramme drucken,{} warenhausprogramm starten,{} warenhausprogramm wiederholen:{}LET menukarte = "ls-MENUKARTE:Warenhaus",{} praefix = "Filialdaten:",{} filialdatentyp = 1951,{} - niltext = "",{} maxlaenge = 45,{} maxnamenslaenge = 35;{}TEXT VAR filialdatenname :: "",{} programmname :: "";{}INT VAR fehlerzeile :: 0;{}BOOL VAR grin version :: FALSE,{} noch kein programm gelaufen :: TRUE,{} bildschirm neu eingesetzt :: FALSE;{}WINDOW VAR w :: window (1, 3, 79, 19);{}INITFLAG VAR in this task :: FALSE;{}PROC warenhausbefehle zeigen:{} TEXT VAR info, liste, tasten;{} INT VAR grinoffset;{} - IF grin version{} THEN grinbefehle{} ELSE elanbefehle{} FI;{} REP{} INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE);{} SELECT auswahl OF{} CASE 1, 101, 105 : menuinfo (anwendungstext (1 + grinoffset)){} CASE 2, 102, 106 : menuinfo (anwendungstext (2 + grinoffset)){} CASE 3, 103, 107 : menuinfo (anwendungstext (3 + grinoffset)){} END SELECT{} UNTIL auswahl = 4 OR auswahl = 104 OR auswahl = 108 PER.{} grinbefehle:{} grinoffset := 13;{} info := " "15"Info zu den Programmierbefehlen "14""13""13""{} - + " d Datei - Bearbeitung "13""{} + " e Einkaufen und Auskunft "13""{} + " k Kontroll - Strukturen "13""13""{} + " z Zurück zum Hauptmenü ";{} liste := "Datei"13"Kaufen/Auskunft"13"Kontroll"13"Zurück";{} tasten := "dekzDEKZ".{} elanbefehle:{} grinoffset := 0;{} info := " "15"Info zu den Programmierbefehlen "14""13""13""{} + " d Datei - Bearbeitung "13""{} - + " e Einkaufen und Auskunft "13""{} + " s Sonstige Befehle "13""13""{} + " z Zurück zum Hauptmenü ";{} liste := "Datei"13"Kaufen/Auskunft"13"Sonstige"13"Zurück";{} tasten := "deszDESZ".{}END PROC warenhausbefehle zeigen;{}PROC eingabe grundeinstellung:{} INT VAR dummy;{} IF eingabe mit codekartenleser{} THEN tastatureingabe (TRUE, dummy){} FI{}END PROC eingabe grundeinstellung;{}PROC tastatur einstellen:{} - eingabe grundeinstellung;{} menuinfo (anwendungstext (6), 4){}END PROC tastatur einstellen;{}PROC kartenleser einstellen:{} INT VAR ergebnis;{} IF eingabe mit codekartenleser{} THEN tastatureingabe (TRUE, ergebnis){} FI;{} pause (10);{} tastatureingabe (FALSE, ergebnis);{} IF ergebnis < 0{} THEN menuinfo (anwendungstext (7 - ergebnis), 5){} ELSE menuinfo (anwendungstext (7), 4){} FI{}END PROC kartenleser einstellen;{}PROC loesche zwischenraum:{} INT VAR zeile;{} cursor (1, 2); out (79 * waagerecht + " ");{} - FOR zeile FROM 3 UPTO 22 REP{} cursor (1, zeile); out (""5"");{} PER;{} cursor (1, 23); out (79 * waagerecht + " ");{} cursor (1, 24); out (""5"");{}END PROC loesche zwischenraum;{}PROC ergaenze bildschirm:{} cursor ( 1, 2); out (ecke oben links);{} cursor (42, 2); out (balken oben);{} cursor (80, 2); out (ecke oben rechts);{} INT VAR zeile;{} FOR zeile FROM 3 UPTO 22 REP{} cursor ( 1, zeile); out (senkrecht);{} cursor (42, zeile); out (senkrecht);{} cursor (80, zeile); out (senkrecht){} - PER;{} cursor ( 1, 23); out (ecke unten links);{} cursor (42, 23); out (balken unten);{} cursor (80, 23); out (ecke unten rechts);{} cursor (42, 19);{} out (balken links + (37 * waagerecht) + balken rechts);{} cursor w3 1 1{}END PROC ergaenze bildschirm;{}PROC zweite zeile:{} cursor (1, 2); out (79 * waagerecht + " "){}END PROC zweite zeile;{}PROC evtl d und b sperren:{} IF eingabe mit codekartenleser{} THEN activate ( 9);{} activate (10){} ELSE deactivate ( 9);{} deactivate (10){} - FI{}END PROC evtl d und b sperren;{}PROC direktbefehl 1:{} disable stop;{} warendatei bearbeiten;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 1;{}PROC warendatei bearbeiten:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Warendatei bearbeiten"));{} REP artikelnummer lesen;{} - IF NOT stoptaste gedrueckt{} THEN artikeldaten eingeben{} FI{} UNTIL stoptaste gedrueckt PER{}END PROC warendatei bearbeiten;{}PROC direktbefehl 2:{} disable stop;{} kundendatei bearbeiten;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 2;{}PROC kundendatei bearbeiten:{} enable stop;{} loesche zwischenraum;{} - ergaenze bildschirm;{} cursor (2, 24); out (invers ("Kundendatei bearbeiten"));{} REP kundennummer lesen;{} IF NOT stoptaste gedrueckt{} THEN kundendaten eingeben{} FI{} UNTIL stoptaste gedrueckt PER{}END PROC kundendatei bearbeiten;{}PROC direktbefehl 3:{} disable stop;{} einkaufen gehen;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} - FI;{} enable stop{}END PROC direktbefehl 3;{}PROC einkaufen gehen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Einkaufen"));{} forget ("WARENHAUS:Rechnung", quiet);{} kundennummer lesen;{} rechnungskopf;{} REP einkaufen{} UNTIL stoptaste gedrueckt PER;{} abrechnung;{} forget ("WARENHAUS:Rechnung", quiet).{} einkaufen:{} artikelnummer lesen;{} IF NOT stoptaste gedrueckt{} THEN artikel kaufen{} FI.{}END PROC einkaufen gehen;{} -PROC direktbefehl 4:{} disable stop;{} auskunft einholen;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 4;{}PROC auskunft einholen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Auskunft"));{} auskunft{}END PROC auskunft einholen;{}PROC direktbefehl 5:{} disable stop;{} - ware nachbestellen;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 5;{}PROC ware nachbestellen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Nachbestellen"));{} nachbestellen{}END PROC ware nachbestellen;{}PROC direktbefehl 6:{} disable stop;{} dezimalwerte von interface lesen;{} - cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 6;{}PROC dezimalwerte von interface lesen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Dezimalwert lesen"));{} dezimalwert lesen{}END PROC dezimalwerte von interface lesen;{}PROC direktbefehl 7:{} disable stop;{} - bitmuster von interface lesen;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 7;{}PROC bitmuster von interface lesen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Bitmuster lesen"));{} bitmuster lesen{}END PROC bitmuster von interface lesen;{}PROC eingabeart anzeigen:{} - IF eingabe mit codekartenleser{} THEN menuinfo (anwendungstext (7), 4){} ELSE menuinfo (anwendungstext (6), 4){} FI{}END PROC eingabeart anzeigen;{}PROC warenhaus:{} BOOL VAR am ende loeschen :: TRUE;{} pruefe zulaessigkeit;{} installiere menukarte mit anfangsbild;{} initialisiere warenhaus;{} handle menu ("WARENHAUS");{} IF am ende loeschen{} THEN sperre verwaltungstask;{} end (task (verwaltung)){} FI.{} installiere menukarte mit anfangsbild:{} install menu (menukarte, TRUE);{} - cursor off;{} cursor (17, 20);{} out (" W A R E N H A U S ");{} cursor (21, 22);{} out (invers("Filiale " + text (channel (myself))));{} cursor (79, 24);{} pause (10).{} sperre verwaltungstask:{} DATASPACE VAR ds;{} INT VAR dummy;{} forget (ds); ds := nilspace;{} call (task (verwaltung), 256, ds, dummy).{} pruefe zulaessigkeit:{} IF hauptstellenname = ""{} THEN line;{} putline ("Keine uebergeordnete Task ist 'warenhaus hauptstelle'!");{} end; LEAVE warenhaus{} - ELIF name (myself) = hauptstellenname{} THEN errorstop ("Dieser Befehl darf nur von Söhnen dieser "{} + "Task aus gegeben werden!");{} LEAVE warenhaus{} FI.{} initialisiere warenhaus:{} TEXT CONST verwaltung :: hauptstellenname + ".Filialverwaltung "{} + text (channel (myself));{} IF NOT exists task (verwaltung){} THEN initialisiere verwaltung{} ELSE biete evtl loeschen an{} FI;{} IF NOT initialized (in this task){} - THEN filialdatenname := "";{} programmname := ""{} FI;{} noch kein programm gelaufen := TRUE.{} biete evtl loeschen an:{} access catalogue;{} IF NOT (father (task (verwaltung)) = myself){} THEN fehlermeldung;{} line;{} end;{} am ende loeschen := FALSE{} FI.{} fehlermeldung:{} cursor (1, 22);{} putline ("Filiale " + text (channel (myself)) +{} " ist bereits besetzt durch TASK '"{} + name (father (task (verwaltung))) + "'!");{} - putline ("Es ist so kein geregelter Warenhaus-Betrieb moeglich!").{}END PROC warenhaus;{}PROC grin (BOOL CONST entscheidung):{} enable stop;{} IF hauptstellenname = "" OR hauptstellenname = name (myself){} THEN grin version := entscheidung{} ELSE errorstop ("Dieser Befehl darf nur von der Task '" +{} hauptstellenname + "' aus gegeben werden!"){} FI;{} bildschirm neu eingesetzt := FALSE{}END PROC grin;{}PROC filialdaten verzeichnis:{} disable stop;{} THESAURUS VAR filialdaten ::{} - ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix);{} forget ("Verzeichnis der Filialdaten-Dateien", quiet);{} FILE VAR f ::{} sequential file (output, "Verzeichnis der Filialdaten-Dateien");{} f FILLBY filialdaten;{} modify (f);{} to line (f, 1); insert record (f);{} menufootnote ("Verlassen: <ESC> <q>");{} cursor on;{} show (w, f);{} cursor off;{} forget ("Verzeichnis der Filialdaten-Dateien", quiet);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} - menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop{}END PROC filialdaten verzeichnis;{}PROC warenhausprogramme verzeichnis:{} disable stop;{} forget ("Verzeichnis der Programme", quiet);{} THESAURUS VAR programme ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN programme := programme - "WARENHAUS:Rechnung"{} FI;{} FILE VAR f ::{} sequential file (output, "Verzeichnis der Programme");{} - f FILLBY programme;{} modify (f);{} to line (f, 1); insert record (f);{} menufootnote ("Verlassen: <ESC> <q>");{} cursor on;{} show (w, f);{} cursor off;{} forget ("Verzeichnis der Programme", quiet);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop{}END PROC warenhausprogramme verzeichnis;{}PROC filialdaten zusammenstellen:{} hole filialdatenname;{} - kontrolliere den filialdatennamen;{} disable stop;{} sichere filialdaten (praefix + filialdatenname);{} IF is error{} THEN out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE bestaetige{} FI;{} enable stop.{} hole filialdatenname:{} filialdatenname := menuanswer (ausgabe, filialdatenname, 5).{} ausgabe:{} center (maxlaenge, invers ("Filialdaten zusammenstellen")) + ""13""13""{} + " Bitte den Namen für die Filialdaten "13""13"".{} - kontrolliere den filialdatennamen:{} IF filialdatenname = niltext{} THEN enable stop; LEAVE filialdaten zusammenstellen{} ELIF length (filialdatenname) > maxnamenslaenge{} THEN meckere zu langen namen an;{} filialdatenname := niltext;{} enable stop; LEAVE filialdaten zusammenstellen{} ELIF exists (praefix + filialdatenname){} THEN meckere existierenden filialdatennamen an;{} enable stop; LEAVE filialdaten zusammenstellen{} - FI.{} bestaetige:{} menuinfo (" "15"Bestätigung "14" "13""13"" +{} " Die Filialdaten wurden von der "13"" +{} " Verwaltung unter dem gewünschten "13"" +{} " Namen zusammengestellt. "13"" , 3).{}END PROC filialdaten zusammenstellen;{}PROC warenhausprogramm neu erstellen:{} hole programmname;{} kontrolliere den programmnamen;{} command dialogue (FALSE);{} cursor on;{} disable stop;{} stdinfoedit (programmname, 3);{} - cursor off;{} command dialogue (TRUE);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop.{} hole programmname:{} programmname := "";{} programmname := menuanswer (ausgabe, programmname, 5).{} ausgabe:{} center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13""{} + " Bitte den Namen für das Programm "13""13"".{} kontrolliere den programmnamen:{} - IF programmname = niltext{} THEN LEAVE warenhausprogramm neu erstellen{} ELIF length (programmname) > maxnamenslaenge{} THEN meckere zu langen namen an;{} programmname := niltext;{} LEAVE warenhausprogramm neu erstellen{} ELIF exists (programmname){} THEN meckere existierendes programm an;{} LEAVE warenhausprogramm neu erstellen{} FI.{}END PROC warenhausprogramm neu erstellen;{}PROC warenhausprogramm ansehen:{} IF programmname <> niltext CAND exists (programmname){} - THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI;{} cursor on;{} disable stop;{} stdinfoedit (programmname, 3);{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop.{} frage nach diesem programm:{} IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name{} + " Soll mit diesem Programm gearbeitet werden", 5){} - THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} - LEAVE warenhausprogramm ansehen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, "Programm ansehen/ändern",{} "Bitte das gewünschte Programm ankreuzen!",{} FALSE);{} IF programmname = niltext{} THEN menu bildschirm;{} LEAVE warenhausprogramm ansehen{} FI.{}END PROC warenhausprogramm ansehen;{}PROC filialdaten eintragen:{} lasse filialdaten auswaehlen;{} - trage filialdaten ein;{} menu bildschirm.{} lasse filialdaten auswaehlen:{} THESAURUS VAR verfuegbare ::{} ohne praefix (infix namen (ALL myself,praefix,filialdatentyp),praefix);{} IF NOT not empty (verfuegbare){} THEN noch keine filialdaten;{} LEAVE filialdaten eintragen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, bezeichnung,{} "Bitte die Filialdaten ankreuzen, die eingetragen werden sollen!", FALSE).{} trage filialdaten ein:{} - 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:{} "Filialdaten eintragen/ergänzen".{} schlussbemerkung:{} " Alle ausgewählten Filialdaten wurden eingetragen!".{} fuehre einzelne operationen aus:{} - INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} menuwindowout ( " Filialdaten """ + name (verfuegbare, k){} + """ werden eingetragen!");{} menuwindowline;{} lade filialdaten (praefix + name (verfuegbare, k));{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} - THEN menuwindowline (2);{} menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!");{} menuwindowstop;{} menu bildschirm;{} LEAVE filialdaten eintragen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen; out (""7"");{} menuinfo (" " + invers (errormessage));{} - clear error; enable stop;{} LEAVE filialdaten eintragen{} ELSE enable stop{} FI.{}END PROC filialdaten eintragen;{}PROC warenhausprogramme drucken:{} lasse programme auswaehlen;{} drucke programme;{} menu bildschirm.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} - THEN noch kein programm;{} LEAVE warenhausprogramme drucken{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Programme drucken",{} "Bitte die Programme ankreuzen, die gedruckt werden sollen!",{} FALSE).{} drucke programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Programme drucken")));{} menuwindowline (2);{} command dialogue (FALSE);{} - fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (" Alle ausgewählten Programme wurden gedruckt!");{} 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) +{} """ wird gedruckt!");{} menuwindowline;{} - print (name (verfuegbare, k));{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (" Es wurde kein Programm ausgewählt!");{} menuwindowstop;{} menu bildschirm;{} LEAVE warenhausprogramme 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; out (""7"");{} menuinfo (" " + invers (errormessage));{} clear error; enable stop;{} LEAVE warenhausprogramme drucken{} ELSE enable stop{} FI.{}END PROC warenhausprogramme drucken;{}PROC warenhausprogramm kopieren:{} ermittle alten programmnamen;{} erfrage neuen programmnamen;{} kopiere ggf das programm.{} ermittle alten programmnamen:{} IF NOT not empty (bestand){} - THEN noch kein programm;{} LEAVE warenhausprogramm kopieren{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, "Programm kopieren",{} "Bitte das Programm ankreuzen, das kopiert werden soll!",FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE warenhausprogramm kopieren{} FI.{} bestand:{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp){} - "WARENHAUS:Rechnung".{} - erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + " Name des 'alten' Programms: " + bisheriger name{} + " Bitte den Namen für die Kopie: ".{} ueberschrift:{} center (maxlaenge, invers ("Programm kopieren")) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} kopiere ggf das programm:{} IF neuer name = niltext{} THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} - LEAVE warenhausprogramm kopieren{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE warenhausprogramm kopieren{} ELSE copy (alter name, neuer name){} FI.{} mache vorwurf:{} menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")).{}END PROC warenhausprogramm kopieren;{}PROC filialdaten umbenennen:{} ermittle alten filialdatennamen;{} erfrage neuen filialdatennamen;{} benenne ggf die filialdaten um.{} ermittle alten filialdatennamen:{} - IF NOT not empty (bestand){} THEN noch keine filialdaten;{} LEAVE filialdaten umbenennen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, text1, text2, FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE filialdaten umbenennen{} FI.{} bestand:{} ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix).{} text1: "Filialdaten umbenennen".{} text2:{} "Bitte die Filialdaten-Datei ankreuzen, die umbenannt werden soll!" .{} - erfrage neuen filialdatennamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + hinweis auf alt + bisheriger name + aufforderung.{} ueberschrift:{} center (maxlaenge, invers ("Filialdaten umbenennen")) + ""13""13"".{} hinweis auf alt:{} " Bisheriger Filialdaten-Name: ".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} aufforderung:{} " Zukünftiger Filialdaten-Name: ".{} benenne ggf die filialdaten um:{} IF neuer name = niltext{} - THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} LEAVE filialdaten umbenennen{} ELIF exists (praefix + neuer name){} THEN menuinfo (" " + invers("Filialdaten mit diesem Namen gibt es bereits!"));{} LEAVE filialdaten umbenennen{} ELSE rename (praefix + alter name, praefix + neuer name);{} filialdatenname := neuer name{} FI.{}END PROC filialdaten umbenennen;{}PROC warenhausprogramm 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 warenhausprogramm umbenennen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, "Programm umbenennen",{} "Bitte das Programm ankreuzen, das umbenannt werden soll!", FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE warenhausprogramm umbenennen{} - FI.{} bestand:{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp){} - "WARENHAUS:Rechnung".{} erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + " Bisheriger Programmname: " + bisheriger name{} + " Zukünftiger Programmname: ".{} ueberschrift:{} center (maxlaenge, invers ("Programm umbenennen")) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} - benenne ggf das programm um:{} IF neuer name = niltext{} THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} LEAVE warenhausprogramm umbenennen{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE warenhausprogramm umbenennen{} ELSE rename (alter name, neuer name);{} programmname := neuer name{} FI.{} mache vorwurf:{} menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")).{}END PROC warenhausprogramm umbenennen;{} -PROC filialdaten loeschen:{} lasse filialdaten auswaehlen;{} loesche filialdaten;{} menu bildschirm.{} lasse filialdaten auswaehlen:{} THESAURUS VAR verfuegbare ::{} ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix);{} IF NOT not empty (verfuegbare){} THEN noch keine filialdaten;{} LEAVE filialdaten loeschen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Filialdaten-Dateien löschen",{} "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE).{} - loesche filialdaten:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Filialdaten-Dateien löschen")));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!");{} 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){} + """ löschen"){} THEN forget (praefix + name (verfuegbare, k), quiet){} FI;{} fehlerbehandlung{} FI{} PER;{} filialdatenname := "".{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!");{} - menuwindowstop;{} menu bildschirm;{} LEAVE filialdaten 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 filialdaten loeschen{} ELSE enable stop{} FI.{} -END PROC filialdaten loeschen;{}PROC warenhausprogramme loeschen:{} lasse programme auswaehlen;{} loesche programme;{} menu bildschirm.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE warenhausprogramme loeschen{} - ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Programm löschen",{} "Bitte alle Programme ankreuzen, die gelöscht werden sollen!", FALSE).{} loesche programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Programme löschen")));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} - menuwindowout (" Alle ausgewählten Programme wurden gelöscht!");{} 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) + """ löschen"){} 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 (" Es wurde kein Programm ausgewählt!");{} menuwindowstop;{} menu bildschirm;{} LEAVE warenhausprogramme 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; out (""7"");{} - menuinfo (" " + invers (errormessage));{} clear error; enable stop;{} LEAVE warenhausprogramme loeschen{} ELSE enable stop{} FI.{}END PROC warenhausprogramme loeschen;{}PROC warenhausprogramm starten:{} IF grin version{} THEN warenhausprogramm uebersetzen und starten{} ELSE warenhausprogramm direkt starten{} FI{}END PROC warenhausprogramm starten;{}PROC warenhausprogramm direkt starten:{} programmname ermitteln;{} bildschirm neu eingesetzt := FALSE;{} - untersuche programmdatei auf bildschirm neu;{} cursor w3 1 1;{} cursor (1, 24); out(""5"Das Programm wird übersetzt. Zeilen-Nr.: ");{} cursor on;{} check on;{} warnings off;{} disable stop;{} run (programmname);{} noch kein programm gelaufen := FALSE;{} IF bildschirm neu eingesetzt{} THEN entferne befehl aus programmdatei{} FI;{} cursor off;{} fehlerbehandlung;{} cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));{} cursor (2,24);{} out ("Das Programm ist beendet. " +{} - "Zum Weitermachen bitte irgendeine Taste tippen!");{} pause;{} regenerate menuscreen.{} fehlerbehandlung:{} IF is error{} THEN fehler ggf melden{} ELSE enable stop{} FI.{} fehler ggf melden:{} IF errormessage = ""{} THEN regenerate menuscreen{} ELSE fehler melden{} FI;{} clear error; enable stop;{} LEAVE warenhausprogramm direkt starten.{} fehler melden:{} out (""7"");{} IF errorcode = 1 OR errorcode = 1951{} THEN regenerate menuscreen;{} - menuinfo (" " + invers (errormessage)){} ELSE programm mit fehler zeigen;{} regenerate menuscreen{} FI.{} 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 + " Zuletzt bearbeitetes Programm: " +{} name + " Soll mit diesem Programm gearbeitet werden", 5){} THEN lasse programm auswaehlen{} - FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm starten")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE warenhausprogramm direkt starten{} - ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, "Programm starten",{} "Bitte das gewünschte Programm ankreuzen!", FALSE);{} menubildschirm;{} menufootnote ("");{} IF programmname = niltext{} THEN LEAVE warenhaus programm direkt starten{} FI.{} untersuche programmdatei auf bildschirm neu:{} FILE VAR a :: sequential file (modify, programmname);{} TEXT VAR zeile;{} to line (a, 1);{} REP{} read record (a, zeile);{} - IF NOT eof (a) THEN down (a) FI{} UNTIL zeile <> "" OR eof (a) PER;{} change all (zeile, " ", "");{} IF pos (zeile, "bildschirmneu") = 0{} THEN setze befehl in datei ein{} FI.{} setze befehl in datei ein:{} to line (a, 1);{} zeile := "bildschirm neu; (* ergänzt *)";{} insert record (a);{} write record (a, zeile);{} bildschirm neu eingesetzt := TRUE.{} entferne befehl aus programmdatei:{} FILE VAR b :: sequential file (modify, programmname);{} to line (b, 1);{} - REP{} read record (b, zeile);{} IF NOT eof (b) THEN down (b) FI{} UNTIL zeile <> "" OR eof (b) PER;{} change all (zeile, " ", "");{} IF pos (zeile, "bildschirmneu;(*ergänzt*)") > 0{} THEN up (b); delete record (b){} FI.{}END PROC warenhausprogramm direkt starten;{}PROC warenhausprogramm uebersetzen und starten:{} programmname ermitteln;{} cursor w3 1 1;{} cursor (1, 24); out(""5"Das Programm wird übersetzt. Zeilen-Nr.: ");{} cursor on;{} disable stop;{} uebersetze (programmname);{} - IF NOT is error{} THEN check on;{} warnings off;{} run ("elanprogramm");{} noch kein programm gelaufen := FALSE{} FI;{} forget ("elanprogramm", quiet);{} cursor off;{} fehlerbehandlung;{} cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));{} cursor (2,24);{} out ("Das Programm ist beendet. " +{} "Zum Weitermachen bitte irgendeine Taste tippen!");{} pause;{} regenerate menuscreen.{} fehlerbehandlung:{} IF is error{} THEN fehler ggf melden{} - ELSE enable stop{} FI.{} fehler ggf melden:{} IF errormessage = ""{} THEN regenerate menuscreen{} ELSE fehler melden{} FI;{} clear error; enable stop;{} LEAVE warenhausprogramm uebersetzen und starten.{} fehler melden:{} out (""7"");{} IF errorcode = 1 OR errorcode = 1951{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage)){} ELSE programm mit fehler zeigen ;{} regenerate menuscreen{} FI.{} 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 + " Zuletzt bearbeitetes Programm: " +{} name + " Soll mit diesem Programm gearbeitet werden", 5){} THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm starten")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} - lasse programm auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE warenhausprogramm uebersetzen und starten{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, "Programm starten",{} - "Bitte das gewünschte Programm ankreuzen!", FALSE);{} menubildschirm;{} menufootnote ("");{} IF programmname = niltext{} THEN LEAVE warenhaus programm uebersetzen und starten{} FI.{}END PROC warenhausprogramm uebersetzen und starten;{}PROC programm mit fehler zeigen:{} IF exists (programmname){} THEN noteline;{} note (fehlermeldung mit zeilennummer);{} INT VAR i; FOR i FROM 1 UPTO 9 REP noteline PER;{} note (invers ("Verlassen: <ESC><q>"));{} - FILE VAR f :: sequential file (modify, programmname);{} to line (f, max (1, fehlerzeile));{} col (1);{} clear error;{} cursor on;{} noteedit (f);{} cursor off{} ELSE menuinfo (invers (fehlermeldung mit zeilennummer)){} FI{}END PROC programm mit fehler zeigen;{}PROC warenhausprogramm wiederholen:{} cursor on;{} disable stop;{} IF noch kein programm gelaufen{} THEN errorstop ("'run again' nicht moeglich"){} ELSE runagain{} FI;{} - cursor off;{} fehlerbehandlung;{} cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));{} cursor (2,24);{} out ("Das Programm ist beendet. " +{} "Zum Weitermachen bitte irgendeine Taste tippen!");{} pause;{} regenerate menuscreen.{}fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} fehler melden;{} clear error; enable stop;{} LEAVE warenhausprogramm wiederholen{} ELSE enable stop{} FI.{} fehler melden:{} - out (""7"");{} IF errorcode = 1 OR errorcode = 1951{} THEN menuinfo (" " + invers (errormessage)){} ELIF errormessage = "'run again' nicht moeglich"{} THEN menuinfo (" " + invers ("Wiederholung nicht möglich!")){} ELSE menuinfo (" " + invers (fehlermeldung mit zeilennummer)){} FI{}END PROC warenhausprogramm wiederholen;{}TEXT PROC fehlermeldung mit zeilennummer:{} TEXT VAR meldung :: "FEHLER: " + errormessage;{} fuege ggf fehlerzeile an;{} IF length (meldung) < 70{} - THEN meldung{} ELSE subtext (meldung, 1, 69){} FI.{} fuege ggf fehlerzeile an:{} fehlerzeile := errorline;{} IF errorline < 1{} THEN LEAVE fuege ggf fehlerzeile an{} ELIF bildschirm neu eingesetzt{} THEN meldung CAT " (bei Zeile " + text (errorline - 1) + ")"{} ELSE meldung CAT " (bei Zeile " + text (errorline) + ")"{} FI.{}END PROC fehlermeldung mit zeilennummer;{}PROC meckere zu langen namen an:{} menuinfo (" " + invers ("Hier dürfen Namen höchstens "{} - + text (max namenslaenge){} + " Zeichen lang sein!")){}END PROC meckere zu langen namen an;{}PROC meckere existierenden filialdatennamen an:{} menuinfo (" " + invers ("Filialdaten mit diesem Namen gibt es bereits!")){}END PROC meckere existierenden filialdatennamen an;{}PROC meckere existierendes programm an:{} menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")){}END PROC meckere existierendes programm an;{}PROC noch keine filialdaten:{} menuinfo (" " + invers ("Es existiert noch keine Filialdaten-Datei!")){} -END PROC noch keine filialdaten;{}PROC noch kein programm:{} menuinfo (" " + invers ("Es existiert noch kein Programm!")){}END PROC noch kein programm;{}PROC menu bildschirm:{} cursor (1, 2);{} out (5 * waagerecht);{} cursor (1, 3);{} out (""4"");{} cursor (1, 23);{} out (79 * waagerecht);{} refresh submenu{}END PROC menu bildschirm{}END PACKET ls warenhaus 5{} + warenhaus, + grin, + direktbefehl 1, + direktbefehl 2, + direktbefehl 3, + direktbefehl 4, + direktbefehl 5, + direktbefehl 6, + direktbefehl 7, + warenhausbefehle zeigen, + eingabe grundeinstellung, + tastatur einstellen, + kartenleser einstellen, + evtl d und b sperren, + loesche zwischenraum, + eingabeart anzeigen, + filialdaten zusammenstellen, + filialdaten eintragen, + filialdaten verzeichnis, + + filialdaten umbenennen, + filialdaten loeschen, + warenhausprogramme verzeichnis, + warenhausprogramm neu erstellen, + warenhausprogramm ansehen, + warenhausprogramm kopieren, + warenhausprogramm umbenennen, + warenhausprogramme loeschen, + warenhausprogramme drucken, + warenhausprogramm starten, + warenhausprogramm wiederholen: +LET menukarte = "ls-MENUKARTE:Warenhaus", + praefix = "Filialdaten:", + filialdatentyp = 1951, + + niltext = "", + maxlaenge = 45, + maxnamenslaenge = 35; +TEXT VAR filialdatenname :: "", + programmname :: ""; +INT VAR fehlerzeile :: 0; +BOOL VAR grin version :: FALSE, + noch kein programm gelaufen :: TRUE, + bildschirm neu eingesetzt :: FALSE; +WINDOW VAR w :: window (1, 3, 79, 19); +INITFLAG VAR in this task :: FALSE; +PROC warenhausbefehle zeigen: + TEXT VAR info, liste, tasten; + INT VAR grinoffset; + + IF grin version + THEN grinbefehle + ELSE elanbefehle + FI; + REP + INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE); + SELECT auswahl OF + CASE 1, 101, 105 : menuinfo (anwendungstext (1 + grinoffset)) + CASE 2, 102, 106 : menuinfo (anwendungstext (2 + grinoffset)) + CASE 3, 103, 107 : menuinfo (anwendungstext (3 + grinoffset)) + END SELECT + UNTIL auswahl = 4 OR auswahl = 104 OR auswahl = 108 PER. + grinbefehle: + grinoffset := 13; + info := " "15"Info zu den Programmierbefehlen "14""13""13"" + + + " d Datei - Bearbeitung "13"" + + " e Einkaufen und Auskunft "13"" + + " k Kontroll - Strukturen "13""13"" + + " z Zurück zum Hauptmenü "; + liste := "Datei"13"Kaufen/Auskunft"13"Kontroll"13"Zurück"; + tasten := "dekzDEKZ". + elanbefehle: + grinoffset := 0; + info := " "15"Info zu den Programmierbefehlen "14""13""13"" + + " d Datei - Bearbeitung "13"" + + + " e Einkaufen und Auskunft "13"" + + " s Sonstige Befehle "13""13"" + + " z Zurück zum Hauptmenü "; + liste := "Datei"13"Kaufen/Auskunft"13"Sonstige"13"Zurück"; + tasten := "deszDESZ". +END PROC warenhausbefehle zeigen; +PROC eingabe grundeinstellung: + INT VAR dummy; + IF eingabe mit codekartenleser + THEN tastatureingabe (TRUE, dummy) + FI +END PROC eingabe grundeinstellung; +PROC tastatur einstellen: + + eingabe grundeinstellung; + menuinfo (anwendungstext (6), 4) +END PROC tastatur einstellen; +PROC kartenleser einstellen: + INT VAR ergebnis; + IF eingabe mit codekartenleser + THEN tastatureingabe (TRUE, ergebnis) + FI; + pause (10); + tastatureingabe (FALSE, ergebnis); + IF ergebnis < 0 + THEN menuinfo (anwendungstext (7 - ergebnis), 5) + ELSE menuinfo (anwendungstext (7), 4) + FI +END PROC kartenleser einstellen; +PROC loesche zwischenraum: + INT VAR zeile; + cursor (1, 2); out (79 * waagerecht + " "); + + FOR zeile FROM 3 UPTO 22 REP + cursor (1, zeile); out (""5""); + PER; + cursor (1, 23); out (79 * waagerecht + " "); + cursor (1, 24); out (""5""); +END PROC loesche zwischenraum; +PROC ergaenze bildschirm: + cursor ( 1, 2); out (ecke oben links); + cursor (42, 2); out (balken oben); + cursor (80, 2); out (ecke oben rechts); + INT VAR zeile; + FOR zeile FROM 3 UPTO 22 REP + cursor ( 1, zeile); out (senkrecht); + cursor (42, zeile); out (senkrecht); + cursor (80, zeile); out (senkrecht) + + PER; + cursor ( 1, 23); out (ecke unten links); + cursor (42, 23); out (balken unten); + cursor (80, 23); out (ecke unten rechts); + cursor (42, 19); + out (balken links + (37 * waagerecht) + balken rechts); + cursor w3 1 1 +END PROC ergaenze bildschirm; +PROC zweite zeile: + cursor (1, 2); out (79 * waagerecht + " ") +END PROC zweite zeile; +PROC evtl d und b sperren: + IF eingabe mit codekartenleser + THEN activate ( 9); + activate (10) + ELSE deactivate ( 9); + deactivate (10) + + FI +END PROC evtl d und b sperren; +PROC direktbefehl 1: + disable stop; + warendatei bearbeiten; + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + FI; + enable stop +END PROC direktbefehl 1; +PROC warendatei bearbeiten: + enable stop; + loesche zwischenraum; + ergaenze bildschirm; + cursor (2, 24); out (invers ("Warendatei bearbeiten")); + REP artikelnummer lesen; + + IF NOT stoptaste gedrueckt + THEN artikeldaten eingeben + FI + UNTIL stoptaste gedrueckt PER +END PROC warendatei bearbeiten; +PROC direktbefehl 2: + disable stop; + kundendatei bearbeiten; + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + FI; + enable stop +END PROC direktbefehl 2; +PROC kundendatei bearbeiten: + enable stop; + loesche zwischenraum; + + ergaenze bildschirm; + cursor (2, 24); out (invers ("Kundendatei bearbeiten")); + REP kundennummer lesen; + IF NOT stoptaste gedrueckt + THEN kundendaten eingeben + FI + UNTIL stoptaste gedrueckt PER +END PROC kundendatei bearbeiten; +PROC direktbefehl 3: + disable stop; + einkaufen gehen; + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + + FI; + enable stop +END PROC direktbefehl 3; +PROC einkaufen gehen: + enable stop; + loesche zwischenraum; + ergaenze bildschirm; + cursor (2, 24); out (invers ("Einkaufen")); + forget ("WARENHAUS:Rechnung", quiet); + kundennummer lesen; + rechnungskopf; + REP einkaufen + UNTIL stoptaste gedrueckt PER; + abrechnung; + forget ("WARENHAUS:Rechnung", quiet). + einkaufen: + artikelnummer lesen; + IF NOT stoptaste gedrueckt + THEN artikel kaufen + FI. +END PROC einkaufen gehen; + +PROC direktbefehl 4: + disable stop; + auskunft einholen; + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + FI; + enable stop +END PROC direktbefehl 4; +PROC auskunft einholen: + enable stop; + loesche zwischenraum; + ergaenze bildschirm; + cursor (2, 24); out (invers ("Auskunft")); + auskunft +END PROC auskunft einholen; +PROC direktbefehl 5: + disable stop; + + ware nachbestellen; + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + FI; + enable stop +END PROC direktbefehl 5; +PROC ware nachbestellen: + enable stop; + loesche zwischenraum; + ergaenze bildschirm; + cursor (2, 24); out (invers ("Nachbestellen")); + nachbestellen +END PROC ware nachbestellen; +PROC direktbefehl 6: + disable stop; + dezimalwerte von interface lesen; + + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + FI; + enable stop +END PROC direktbefehl 6; +PROC dezimalwerte von interface lesen: + enable stop; + loesche zwischenraum; + ergaenze bildschirm; + cursor (2, 24); out (invers ("Dezimalwert lesen")); + dezimalwert lesen +END PROC dezimalwerte von interface lesen; +PROC direktbefehl 7: + disable stop; + + bitmuster von interface lesen; + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + FI; + enable stop +END PROC direktbefehl 7; +PROC bitmuster von interface lesen: + enable stop; + loesche zwischenraum; + ergaenze bildschirm; + cursor (2, 24); out (invers ("Bitmuster lesen")); + bitmuster lesen +END PROC bitmuster von interface lesen; +PROC eingabeart anzeigen: + + IF eingabe mit codekartenleser + THEN menuinfo (anwendungstext (7), 4) + ELSE menuinfo (anwendungstext (6), 4) + FI +END PROC eingabeart anzeigen; +PROC warenhaus: + BOOL VAR am ende loeschen :: TRUE; + pruefe zulaessigkeit; + installiere menukarte mit anfangsbild; + initialisiere warenhaus; + handle menu ("WARENHAUS"); + IF am ende loeschen + THEN sperre verwaltungstask; + end (task (verwaltung)) + FI. + installiere menukarte mit anfangsbild: + install menu (menukarte, TRUE); + + cursor off; + cursor (17, 20); + out (" W A R E N H A U S "); + cursor (21, 22); + out (invers("Filiale " + text (channel (myself)))); + cursor (79, 24); + pause (10). + sperre verwaltungstask: + DATASPACE VAR ds; + INT VAR dummy; + forget (ds); ds := nilspace; + call (task (verwaltung), 256, ds, dummy). + pruefe zulaessigkeit: + IF hauptstellenname = "" + THEN line; + putline ("Keine uebergeordnete Task ist 'warenhaus hauptstelle'!"); + end; LEAVE warenhaus + + ELIF name (myself) = hauptstellenname + THEN errorstop ("Dieser Befehl darf nur von Söhnen dieser " + + "Task aus gegeben werden!"); + LEAVE warenhaus + FI. + initialisiere warenhaus: + TEXT CONST verwaltung :: hauptstellenname + ".Filialverwaltung " + + text (channel (myself)); + IF NOT exists task (verwaltung) + THEN initialisiere verwaltung + ELSE biete evtl loeschen an + FI; + IF NOT initialized (in this task) + + THEN filialdatenname := ""; + programmname := "" + FI; + noch kein programm gelaufen := TRUE. + biete evtl loeschen an: + access catalogue; + IF NOT (father (task (verwaltung)) = myself) + THEN fehlermeldung; + line; + end; + am ende loeschen := FALSE + FI. + fehlermeldung: + cursor (1, 22); + putline ("Filiale " + text (channel (myself)) + + " ist bereits besetzt durch TASK '" + + name (father (task (verwaltung))) + "'!"); + + putline ("Es ist so kein geregelter Warenhaus-Betrieb moeglich!"). +END PROC warenhaus; +PROC grin (BOOL CONST entscheidung): + enable stop; + IF hauptstellenname = "" OR hauptstellenname = name (myself) + THEN grin version := entscheidung + ELSE errorstop ("Dieser Befehl darf nur von der Task '" + + hauptstellenname + "' aus gegeben werden!") + FI; + bildschirm neu eingesetzt := FALSE +END PROC grin; +PROC filialdaten verzeichnis: + disable stop; + THESAURUS VAR filialdaten :: + + ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix); + forget ("Verzeichnis der Filialdaten-Dateien", quiet); + FILE VAR f :: + sequential file (output, "Verzeichnis der Filialdaten-Dateien"); + f FILLBY filialdaten; + modify (f); + to line (f, 1); insert record (f); + menufootnote ("Verlassen: <ESC> <q>"); + cursor on; + show (w, f); + cursor off; + forget ("Verzeichnis der Filialdaten-Dateien", quiet); + IF is error + THEN regenerate menuscreen; + out (""7""); + + menuinfo (" " + invers ("FEHLER: " + errormessage)); + clear error + ELSE menu bildschirm + FI; + enable stop +END PROC filialdaten verzeichnis; +PROC warenhausprogramme verzeichnis: + disable stop; + forget ("Verzeichnis der Programme", quiet); + THESAURUS VAR programme :: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp); + IF exists ("WARENHAUS:Rechnung") + THEN programme := programme - "WARENHAUS:Rechnung" + FI; + FILE VAR f :: + sequential file (output, "Verzeichnis der Programme"); + + f FILLBY programme; + modify (f); + to line (f, 1); insert record (f); + menufootnote ("Verlassen: <ESC> <q>"); + cursor on; + show (w, f); + cursor off; + forget ("Verzeichnis der Programme", quiet); + IF is error + THEN regenerate menuscreen; + out (""7""); + menuinfo (" " + invers ("FEHLER: " + errormessage)); + clear error + ELSE menu bildschirm + FI; + enable stop +END PROC warenhausprogramme verzeichnis; +PROC filialdaten zusammenstellen: + hole filialdatenname; + + kontrolliere den filialdatennamen; + disable stop; + sichere filialdaten (praefix + filialdatenname); + IF is error + THEN out (""7""); + menuinfo (" " + invers ("FEHLER: " + errormessage)); + clear error + ELSE bestaetige + FI; + enable stop. + hole filialdatenname: + filialdatenname := menuanswer (ausgabe, filialdatenname, 5). + ausgabe: + center (maxlaenge, invers ("Filialdaten zusammenstellen")) + ""13""13"" + + " Bitte den Namen für die Filialdaten "13""13"". + + kontrolliere den filialdatennamen: + IF filialdatenname = niltext + THEN enable stop; LEAVE filialdaten zusammenstellen + ELIF length (filialdatenname) > maxnamenslaenge + THEN meckere zu langen namen an; + filialdatenname := niltext; + enable stop; LEAVE filialdaten zusammenstellen + ELIF exists (praefix + filialdatenname) + THEN meckere existierenden filialdatennamen an; + enable stop; LEAVE filialdaten zusammenstellen + + FI. + bestaetige: + menuinfo (" "15"Bestätigung "14" "13""13"" + + " Die Filialdaten wurden von der "13"" + + " Verwaltung unter dem gewünschten "13"" + + " Namen zusammengestellt. "13"" , 3). +END PROC filialdaten zusammenstellen; +PROC warenhausprogramm neu erstellen: + hole programmname; + kontrolliere den programmnamen; + command dialogue (FALSE); + cursor on; + disable stop; + stdinfoedit (programmname, 3); + + cursor off; + command dialogue (TRUE); + IF is error + THEN regenerate menuscreen; + out (""7""); + menuinfo (" " + invers (errormessage)); + clear error + ELSE menu bildschirm + FI; + enable stop. + hole programmname: + programmname := ""; + programmname := menuanswer (ausgabe, programmname, 5). + ausgabe: + center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13"" + + " Bitte den Namen für das Programm "13""13"". + kontrolliere den programmnamen: + + IF programmname = niltext + THEN LEAVE warenhausprogramm neu erstellen + ELIF length (programmname) > maxnamenslaenge + THEN meckere zu langen namen an; + programmname := niltext; + LEAVE warenhausprogramm neu erstellen + ELIF exists (programmname) + THEN meckere existierendes programm an; + LEAVE warenhausprogramm neu erstellen + FI. +END PROC warenhausprogramm neu erstellen; +PROC warenhausprogramm ansehen: + IF programmname <> niltext CAND exists (programmname) + + THEN frage nach diesem programm + ELSE lasse programm auswaehlen + FI; + cursor on; + disable stop; + stdinfoedit (programmname, 3); + cursor off; + IF is error + THEN regenerate menuscreen; + out (""7""); + menuinfo (" " + invers ("FEHLER: " + errormessage)); + clear error + ELSE menu bildschirm + FI; + enable stop. + frage nach diesem programm: + IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name + + " Soll mit diesem Programm gearbeitet werden", 5) + + THEN lasse programm auswaehlen + FI. + ueberschrift: + center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"". + name: + ""13""13" " + invers (programmname) + ""13""13"". + lasse programm auswaehlen: + THESAURUS VAR verfuegbare :: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp); + IF exists ("WARENHAUS:Rechnung") + THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung" + FI; + IF NOT not empty (verfuegbare) + THEN noch kein programm; + + LEAVE warenhausprogramm ansehen + ELSE biete auswahl an + FI. + biete auswahl an: + programmname := menuone (verfuegbare, "Programm ansehen/ändern", + "Bitte das gewünschte Programm ankreuzen!", + FALSE); + IF programmname = niltext + THEN menu bildschirm; + LEAVE warenhausprogramm ansehen + FI. +END PROC warenhausprogramm ansehen; +PROC filialdaten eintragen: + lasse filialdaten auswaehlen; + + trage filialdaten ein; + menu bildschirm. + lasse filialdaten auswaehlen: + THESAURUS VAR verfuegbare :: + ohne praefix (infix namen (ALL myself,praefix,filialdatentyp),praefix); + IF NOT not empty (verfuegbare) + THEN noch keine filialdaten; + LEAVE filialdaten eintragen + ELSE biete auswahl an + FI. + biete auswahl an: + verfuegbare := menusome (verfuegbare, bezeichnung, + "Bitte die Filialdaten ankreuzen, die eingetragen werden sollen!", FALSE). + trage filialdaten ein: + + 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: + "Filialdaten eintragen/ergänzen". + schlussbemerkung: + " Alle ausgewählten Filialdaten wurden eingetragen!". + fuehre einzelne operationen aus: + + INT VAR k; + FOR k FROM 1 UPTO highest entry (verfuegbare) REP + IF name (verfuegbare, k) <> "" + THEN disable stop; + menuwindowout ( " Filialdaten """ + name (verfuegbare, k) + + """ werden eingetragen!"); + menuwindowline; + lade filialdaten (praefix + name (verfuegbare, k)); + fehlerbehandlung + FI + PER. + steige ggf bei leerem thesaurus aus: + IF NOT not empty (verfuegbare) + + THEN menuwindowline (2); + menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!"); + menuwindowstop; + menu bildschirm; + LEAVE filialdaten eintragen + FI. + schlage ggf neue seite auf: + IF remaining menuwindowlines < 7 + THEN menuwindowpage; menuwindowline + ELSE menuwindowline (2) + FI. + fehlerbehandlung: + IF is error + THEN regenerate menuscreen; out (""7""); + menuinfo (" " + invers (errormessage)); + + clear error; enable stop; + LEAVE filialdaten eintragen + ELSE enable stop + FI. +END PROC filialdaten eintragen; +PROC warenhausprogramme drucken: + lasse programme auswaehlen; + drucke programme; + menu bildschirm. + lasse programme auswaehlen: + THESAURUS VAR verfuegbare :: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp); + IF exists ("WARENHAUS:Rechnung") + THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung" + FI; + IF NOT not empty (verfuegbare) + + THEN noch kein programm; + LEAVE warenhausprogramme drucken + ELSE biete auswahl an + FI. + biete auswahl an: + verfuegbare := menusome (verfuegbare, "Programme drucken", + "Bitte die Programme ankreuzen, die gedruckt werden sollen!", + FALSE). + drucke programme: + show menuwindow; + steige ggf bei leerem thesaurus aus; + menuwindowout (menuwindowcenter (invers ("Programme drucken"))); + menuwindowline (2); + command dialogue (FALSE); + + fuehre einzelne operationen aus; + command dialogue (TRUE); + schlage ggf neue seite auf; + menuwindowout (" Alle ausgewählten Programme wurden gedruckt!"); + 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) + + """ wird gedruckt!"); + menuwindowline; + + print (name (verfuegbare, k)); + fehlerbehandlung + FI + PER. + steige ggf bei leerem thesaurus aus: + IF NOT not empty (verfuegbare) + THEN menuwindowline (2); + menuwindowout (" Es wurde kein Programm ausgewählt!"); + menuwindowstop; + menu bildschirm; + LEAVE warenhausprogramme 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; out (""7""); + menuinfo (" " + invers (errormessage)); + clear error; enable stop; + LEAVE warenhausprogramme drucken + ELSE enable stop + FI. +END PROC warenhausprogramme drucken; +PROC warenhausprogramm kopieren: + ermittle alten programmnamen; + erfrage neuen programmnamen; + kopiere ggf das programm. + ermittle alten programmnamen: + IF NOT not empty (bestand) + + THEN noch kein programm; + LEAVE warenhausprogramm kopieren + ELSE biete auswahl an + FI. + biete auswahl an: + TEXT VAR alter name := menuone ( bestand, "Programm kopieren", + "Bitte das Programm ankreuzen, das kopiert werden soll!",FALSE); + menu bildschirm; + IF alter name = niltext + THEN LEAVE warenhausprogramm kopieren + FI. + bestand: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp) + - "WARENHAUS:Rechnung". + + erfrage neuen programmnamen: + TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5). + ausgabe: + ueberschrift + " Name des 'alten' Programms: " + bisheriger name + + " Bitte den Namen für die Kopie: ". + ueberschrift: + center (maxlaenge, invers ("Programm kopieren")) + ""13""13"". + bisheriger name: + ""13""13" " + invers (alter name) + ""13""13"". + kopiere ggf das programm: + IF neuer name = niltext + THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!")); + + LEAVE warenhausprogramm kopieren + ELIF exists (neuer name) + THEN mache vorwurf; + LEAVE warenhausprogramm kopieren + ELSE copy (alter name, neuer name) + FI. + mache vorwurf: + menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")). +END PROC warenhausprogramm kopieren; +PROC filialdaten umbenennen: + ermittle alten filialdatennamen; + erfrage neuen filialdatennamen; + benenne ggf die filialdaten um. + ermittle alten filialdatennamen: + + IF NOT not empty (bestand) + THEN noch keine filialdaten; + LEAVE filialdaten umbenennen + ELSE biete auswahl an + FI. + biete auswahl an: + TEXT VAR alter name := menuone ( bestand, text1, text2, FALSE); + menu bildschirm; + IF alter name = niltext + THEN LEAVE filialdaten umbenennen + FI. + bestand: + ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix). + text1: "Filialdaten umbenennen". + text2: + "Bitte die Filialdaten-Datei ankreuzen, die umbenannt werden soll!" . + + erfrage neuen filialdatennamen: + TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5). + ausgabe: + ueberschrift + hinweis auf alt + bisheriger name + aufforderung. + ueberschrift: + center (maxlaenge, invers ("Filialdaten umbenennen")) + ""13""13"". + hinweis auf alt: + " Bisheriger Filialdaten-Name: ". + bisheriger name: + ""13""13" " + invers (alter name) + ""13""13"". + aufforderung: + " Zukünftiger Filialdaten-Name: ". + benenne ggf die filialdaten um: + IF neuer name = niltext + + THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!")); + LEAVE filialdaten umbenennen + ELIF exists (praefix + neuer name) + THEN menuinfo (" " + invers("Filialdaten mit diesem Namen gibt es bereits!")); + LEAVE filialdaten umbenennen + ELSE rename (praefix + alter name, praefix + neuer name); + filialdatenname := neuer name + FI. +END PROC filialdaten umbenennen; +PROC warenhausprogramm 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 warenhausprogramm umbenennen + ELSE biete auswahl an + FI. + biete auswahl an: + TEXT VAR alter name := menuone ( bestand, "Programm umbenennen", + "Bitte das Programm ankreuzen, das umbenannt werden soll!", FALSE); + menu bildschirm; + IF alter name = niltext + THEN LEAVE warenhausprogramm umbenennen + + FI. + bestand: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp) + - "WARENHAUS:Rechnung". + erfrage neuen programmnamen: + TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5). + ausgabe: + ueberschrift + " Bisheriger Programmname: " + bisheriger name + + " Zukünftiger Programmname: ". + ueberschrift: + center (maxlaenge, invers ("Programm umbenennen")) + ""13""13"". + bisheriger name: + ""13""13" " + invers (alter name) + ""13""13"". + + benenne ggf das programm um: + IF neuer name = niltext + THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!")); + LEAVE warenhausprogramm umbenennen + ELIF exists (neuer name) + THEN mache vorwurf; + LEAVE warenhausprogramm umbenennen + ELSE rename (alter name, neuer name); + programmname := neuer name + FI. + mache vorwurf: + menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")). +END PROC warenhausprogramm umbenennen; + +PROC filialdaten loeschen: + lasse filialdaten auswaehlen; + loesche filialdaten; + menu bildschirm. + lasse filialdaten auswaehlen: + THESAURUS VAR verfuegbare :: + ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix); + IF NOT not empty (verfuegbare) + THEN noch keine filialdaten; + LEAVE filialdaten loeschen + ELSE biete auswahl an + FI. + biete auswahl an: + verfuegbare := menusome (verfuegbare, "Filialdaten-Dateien löschen", + "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE). + + loesche filialdaten: + show menuwindow; + steige ggf bei leerem thesaurus aus; + menuwindowout (menuwindowcenter (invers ("Filialdaten-Dateien löschen"))); + menuwindowline (2); + command dialogue (FALSE); + fuehre einzelne operationen aus; + command dialogue (TRUE); + schlage ggf neue seite auf; + menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!"); + 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) + + """ löschen") + THEN forget (praefix + name (verfuegbare, k), quiet) + FI; + fehlerbehandlung + FI + PER; + filialdatenname := "". + steige ggf bei leerem thesaurus aus: + IF NOT not empty (verfuegbare) + THEN menuwindowline (2); + menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!"); + + menuwindowstop; + menu bildschirm; + LEAVE filialdaten 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 filialdaten loeschen + ELSE enable stop + FI. + +END PROC filialdaten loeschen; +PROC warenhausprogramme loeschen: + lasse programme auswaehlen; + loesche programme; + menu bildschirm. + lasse programme auswaehlen: + THESAURUS VAR verfuegbare :: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp); + IF exists ("WARENHAUS:Rechnung") + THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung" + FI; + IF NOT not empty (verfuegbare) + THEN noch kein programm; + LEAVE warenhausprogramme loeschen + + ELSE biete auswahl an + FI. + biete auswahl an: + verfuegbare := menusome (verfuegbare, "Programm löschen", + "Bitte alle Programme ankreuzen, die gelöscht werden sollen!", FALSE). + loesche programme: + show menuwindow; + steige ggf bei leerem thesaurus aus; + menuwindowout (menuwindowcenter (invers ("Programme löschen"))); + menuwindowline (2); + command dialogue (FALSE); + fuehre einzelne operationen aus; + command dialogue (TRUE); + schlage ggf neue seite auf; + + menuwindowout (" Alle ausgewählten Programme wurden gelöscht!"); + 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) + """ löschen") + 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 (" Es wurde kein Programm ausgewählt!"); + menuwindowstop; + menu bildschirm; + LEAVE warenhausprogramme 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; out (""7""); + + menuinfo (" " + invers (errormessage)); + clear error; enable stop; + LEAVE warenhausprogramme loeschen + ELSE enable stop + FI. +END PROC warenhausprogramme loeschen; +PROC warenhausprogramm starten: + IF grin version + THEN warenhausprogramm uebersetzen und starten + ELSE warenhausprogramm direkt starten + FI +END PROC warenhausprogramm starten; +PROC warenhausprogramm direkt starten: + programmname ermitteln; + bildschirm neu eingesetzt := FALSE; + + untersuche programmdatei auf bildschirm neu; + cursor w3 1 1; + cursor (1, 24); out(""5"Das Programm wird übersetzt. Zeilen-Nr.: "); + cursor on; + check on; + warnings off; + disable stop; + run (programmname); + noch kein programm gelaufen := FALSE; + IF bildschirm neu eingesetzt + THEN entferne befehl aus programmdatei + FI; + cursor off; + fehlerbehandlung; + cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht)); + cursor (2,24); + out ("Das Programm ist beendet. " + + + "Zum Weitermachen bitte irgendeine Taste tippen!"); + pause; + regenerate menuscreen. + fehlerbehandlung: + IF is error + THEN fehler ggf melden + ELSE enable stop + FI. + fehler ggf melden: + IF errormessage = "" + THEN regenerate menuscreen + ELSE fehler melden + FI; + clear error; enable stop; + LEAVE warenhausprogramm direkt starten. + fehler melden: + out (""7""); + IF errorcode = 1 OR errorcode = 1951 + THEN regenerate menuscreen; + + menuinfo (" " + invers (errormessage)) + ELSE programm mit fehler zeigen; + regenerate menuscreen + FI. + 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 + " Zuletzt bearbeitetes Programm: " + + name + " Soll mit diesem Programm gearbeitet werden", 5) + THEN lasse programm auswaehlen + + FI. + ueberschrift: + center (maxlaenge, invers ("Programm starten")) + ""13""13"". + name: + ""13""13" " + invers (programmname) + ""13""13"". + lasse programm auswaehlen: + THESAURUS VAR verfuegbare :: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp); + IF exists ("WARENHAUS:Rechnung") + THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung" + FI; + IF NOT not empty (verfuegbare) + THEN noch kein programm; + LEAVE warenhausprogramm direkt starten + + ELSE biete auswahl an + FI. + biete auswahl an: + programmname := menuone (verfuegbare, "Programm starten", + "Bitte das gewünschte Programm ankreuzen!", FALSE); + menubildschirm; + menufootnote (""); + IF programmname = niltext + THEN LEAVE warenhaus programm direkt starten + FI. + untersuche programmdatei auf bildschirm neu: + FILE VAR a :: sequential file (modify, programmname); + TEXT VAR zeile; + to line (a, 1); + REP + read record (a, zeile); + + IF NOT eof (a) THEN down (a) FI + UNTIL zeile <> "" OR eof (a) PER; + change all (zeile, " ", ""); + IF pos (zeile, "bildschirmneu") = 0 + THEN setze befehl in datei ein + FI. + setze befehl in datei ein: + to line (a, 1); + zeile := "bildschirm neu; (* ergänzt *)"; + insert record (a); + write record (a, zeile); + bildschirm neu eingesetzt := TRUE. + entferne befehl aus programmdatei: + FILE VAR b :: sequential file (modify, programmname); + to line (b, 1); + + REP + read record (b, zeile); + IF NOT eof (b) THEN down (b) FI + UNTIL zeile <> "" OR eof (b) PER; + change all (zeile, " ", ""); + IF pos (zeile, "bildschirmneu;(*ergänzt*)") > 0 + THEN up (b); delete record (b) + FI. +END PROC warenhausprogramm direkt starten; +PROC warenhausprogramm uebersetzen und starten: + programmname ermitteln; + cursor w3 1 1; + cursor (1, 24); out(""5"Das Programm wird übersetzt. Zeilen-Nr.: "); + cursor on; + disable stop; + uebersetze (programmname); + + IF NOT is error + THEN check on; + warnings off; + run ("elanprogramm"); + noch kein programm gelaufen := FALSE + FI; + forget ("elanprogramm", quiet); + cursor off; + fehlerbehandlung; + cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht)); + cursor (2,24); + out ("Das Programm ist beendet. " + + "Zum Weitermachen bitte irgendeine Taste tippen!"); + pause; + regenerate menuscreen. + fehlerbehandlung: + IF is error + THEN fehler ggf melden + + ELSE enable stop + FI. + fehler ggf melden: + IF errormessage = "" + THEN regenerate menuscreen + ELSE fehler melden + FI; + clear error; enable stop; + LEAVE warenhausprogramm uebersetzen und starten. + fehler melden: + out (""7""); + IF errorcode = 1 OR errorcode = 1951 + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)) + ELSE programm mit fehler zeigen ; + regenerate menuscreen + FI. + 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 + " Zuletzt bearbeitetes Programm: " + + name + " Soll mit diesem Programm gearbeitet werden", 5) + THEN lasse programm auswaehlen + FI. + ueberschrift: + center (maxlaenge, invers ("Programm starten")) + ""13""13"". + name: + ""13""13" " + invers (programmname) + ""13""13"". + + lasse programm auswaehlen: + THESAURUS VAR verfuegbare :: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp); + IF exists ("WARENHAUS:Rechnung") + THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung" + FI; + IF NOT not empty (verfuegbare) + THEN noch kein programm; + LEAVE warenhausprogramm uebersetzen und starten + ELSE biete auswahl an + FI. + biete auswahl an: + programmname := menuone (verfuegbare, "Programm starten", + + "Bitte das gewünschte Programm ankreuzen!", FALSE); + menubildschirm; + menufootnote (""); + IF programmname = niltext + THEN LEAVE warenhaus programm uebersetzen und starten + FI. +END PROC warenhausprogramm uebersetzen und starten; +PROC programm mit fehler zeigen: + IF exists (programmname) + THEN noteline; + note (fehlermeldung mit zeilennummer); + INT VAR i; FOR i FROM 1 UPTO 9 REP noteline PER; + note (invers ("Verlassen: <ESC><q>")); + + FILE VAR f :: sequential file (modify, programmname); + to line (f, max (1, fehlerzeile)); + col (1); + clear error; + cursor on; + noteedit (f); + cursor off + ELSE menuinfo (invers (fehlermeldung mit zeilennummer)) + FI +END PROC programm mit fehler zeigen; +PROC warenhausprogramm wiederholen: + cursor on; + disable stop; + IF noch kein programm gelaufen + THEN errorstop ("'run again' nicht moeglich") + ELSE runagain + FI; + + cursor off; + fehlerbehandlung; + cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht)); + cursor (2,24); + out ("Das Programm ist beendet. " + + "Zum Weitermachen bitte irgendeine Taste tippen!"); + pause; + regenerate menuscreen. +fehlerbehandlung: + IF is error + THEN regenerate menuscreen; + fehler melden; + clear error; enable stop; + LEAVE warenhausprogramm wiederholen + ELSE enable stop + FI. + fehler melden: + + out (""7""); + IF errorcode = 1 OR errorcode = 1951 + THEN menuinfo (" " + invers (errormessage)) + ELIF errormessage = "'run again' nicht moeglich" + THEN menuinfo (" " + invers ("Wiederholung nicht möglich!")) + ELSE menuinfo (" " + invers (fehlermeldung mit zeilennummer)) + FI +END PROC warenhausprogramm wiederholen; +TEXT PROC fehlermeldung mit zeilennummer: + TEXT VAR meldung :: "FEHLER: " + errormessage; + fuege ggf fehlerzeile an; + IF length (meldung) < 70 + + THEN meldung + ELSE subtext (meldung, 1, 69) + FI. + fuege ggf fehlerzeile an: + fehlerzeile := errorline; + IF errorline < 1 + THEN LEAVE fuege ggf fehlerzeile an + ELIF bildschirm neu eingesetzt + THEN meldung CAT " (bei Zeile " + text (errorline - 1) + ")" + ELSE meldung CAT " (bei Zeile " + text (errorline) + ")" + FI. +END PROC fehlermeldung mit zeilennummer; +PROC meckere zu langen namen an: + menuinfo (" " + invers ("Hier dürfen Namen höchstens " + + + text (max namenslaenge) + + " Zeichen lang sein!")) +END PROC meckere zu langen namen an; +PROC meckere existierenden filialdatennamen an: + menuinfo (" " + invers ("Filialdaten mit diesem Namen gibt es bereits!")) +END PROC meckere existierenden filialdatennamen an; +PROC meckere existierendes programm an: + menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")) +END PROC meckere existierendes programm an; +PROC noch keine filialdaten: + menuinfo (" " + invers ("Es existiert noch keine Filialdaten-Datei!")) + +END PROC noch keine filialdaten; +PROC noch kein programm: + menuinfo (" " + invers ("Es existiert noch kein Programm!")) +END PROC noch kein programm; +PROC menu bildschirm: + cursor (1, 2); + out (5 * waagerecht); + cursor (1, 3); + out (""4""); + cursor (1, 23); + out (79 * waagerecht); + refresh submenu +END PROC menu bildschirm +END PACKET ls warenhaus 5 + diff --git a/warenhaus/ls-Warenhaus-gen b/warenhaus/ls-Warenhaus-gen index f4bd77f..2e0476e 100644 --- a/warenhaus/ls-Warenhaus-gen +++ b/warenhaus/ls-Warenhaus-gen @@ -22,8 +22,74 @@ *) LET kartenleserkennung = "ls-Warenhaus 0: mit Kartenleser"; -baue bildschirm auf;{}schicke menukarte ab;{}erfrage anpassung;{}check off;{}warnings off;{}insertiere (anpassung);{}loesche alle anpassungen;{}insertiere ("ls-Warenhaus 1");{}insertiere ("ls-Warenhaus 2");{}insertiere ("ls-Warenhaus 3");{}insertiere ("ls-Warenhaus 4");{}insertiere ("ls-Warenhaus 5");{}check on;{}frage nach grin;{}frage nach hauptstelle.{}baue bildschirm auf:{} page;{} cursor (18, 1);{} out (invers ("ls-Warenhaus : Automatische Generierung"));{} line (3).{}erfrage anpassung:{} - WINDOW VAR w :: window (1, 1, 79, 24);{} TEXT VAR anpassung :: boxone (w, alle kartenleser,{} "Auswahl einer Interface - Anpassung für den Codekartenleser",{} "Wenn kein Kartenleser benutzt wird, <ESC><q> tippen!", FALSE);{} IF anpassung = ""{} THEN anpassung := "ls-Warenhaus 0: ohne Kartenleser"{} FI;{} baue bildschirm auf.{}alle kartenleser:{} infix namen (ALL myself, kartenleserkennung).{}loesche alle anpassungen:{} command dialogue (FALSE);{} forget (infixnamen (ALL myself, "ls-Warenhaus 0"));{} - forget ("--------------------------------------------------------",quiet);{} command dialogue (TRUE).{}schicke menukarte ab:{} command dialogue (FALSE);{} save ("ls-MENUKARTE:Warenhaus", /"ls-MENUKARTEN");{} command dialogue (TRUE);{} forget ("ls-MENUKARTE:Warenhaus", quiet);{} forget ("ls-Warenhaus/gen", quiet).{}frage nach grin:{} line;{} IF yes ("Version für GRIN"){} THEN do ("grin (TRUE)"){} ELSE do ("grin (FALSE)"){} FI.{}frage nach hauptstelle:{} line (2);{} IF yes ("Soll diese Task Warenhaus - Hauptstelle sein"){} - THEN do ("warenhaus hauptstelle (TRUE)"){} ELSE global manager{} FI.{};{}PROC insertiere (TEXT CONST dateiname):{} INT VAR s, z;{} out ("'" + dateiname + "'");{} get cursor (s, z);{} out (" wird insertiert. ");{} insert (dateiname);{} forget (dateiname, quiet);{} cursor (s, z);{} out (""4"") ;{} line{}END PROC insertiere{} +baue bildschirm auf; +schicke menukarte ab; +erfrage anpassung; +check off; +warnings off; +insertiere (anpassung); +loesche alle anpassungen; +insertiere ("ls-Warenhaus 1"); +insertiere ("ls-Warenhaus 2"); +insertiere ("ls-Warenhaus 3"); +insertiere ("ls-Warenhaus 4"); +insertiere ("ls-Warenhaus 5"); +check on; +frage nach grin; +frage nach hauptstelle. +baue bildschirm auf: + page; + cursor (18, 1); + out (invers ("ls-Warenhaus : Automatische Generierung")); + line (3). +erfrage anpassung: + + WINDOW VAR w :: window (1, 1, 79, 24); + TEXT VAR anpassung :: boxone (w, alle kartenleser, + "Auswahl einer Interface - Anpassung für den Codekartenleser", + "Wenn kein Kartenleser benutzt wird, <ESC><q> tippen!", FALSE); + IF anpassung = "" + THEN anpassung := "ls-Warenhaus 0: ohne Kartenleser" + FI; + baue bildschirm auf. +alle kartenleser: + infix namen (ALL myself, kartenleserkennung). +loesche alle anpassungen: + command dialogue (FALSE); + forget (infixnamen (ALL myself, "ls-Warenhaus 0")); + + forget ("--------------------------------------------------------",quiet); + command dialogue (TRUE). +schicke menukarte ab: + command dialogue (FALSE); + save ("ls-MENUKARTE:Warenhaus", /"ls-MENUKARTEN"); + command dialogue (TRUE); + forget ("ls-MENUKARTE:Warenhaus", quiet); + forget ("ls-Warenhaus/gen", quiet). +frage nach grin: + line; + IF yes ("Version für GRIN") + THEN do ("grin (TRUE)") + ELSE do ("grin (FALSE)") + FI. +frage nach hauptstelle: + line (2); + IF yes ("Soll diese Task Warenhaus - Hauptstelle sein") + + THEN do ("warenhaus hauptstelle (TRUE)") + ELSE global manager + FI. +; +PROC insertiere (TEXT CONST dateiname): + INT VAR s, z; + out ("'" + dateiname + "'"); + get cursor (s, z); + out (" wird insertiert. "); + insert (dateiname); + forget (dateiname, quiet); + cursor (s, z); + out (""4"") ; + line +END PROC insertiere + |