From afd4c3c448381f6eb706090911a15c162fdaf8af Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Sun, 9 Oct 2016 11:28:19 +0200 Subject: Decompress source files MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit EUMEL’s TEXT dataspaces wastes a lot of storage space. Some files were therefore “compressed” by storing them as a single line, reducing overhead significantly. --- dialog/ls-DIALOG 1 | 558 ++++++++++++- dialog/ls-DIALOG 2 | 871 +++++++++++++++++++-- dialog/ls-DIALOG 3 | 414 +++++++++- dialog/ls-DIALOG 4 | 762 ++++++++++++++++-- dialog/ls-DIALOG 5 | 1480 ++++++++++++++++++++++++++++++++--- dialog/ls-DIALOG 6 | 1238 +++++++++++++++++++++++++++-- dialog/ls-DIALOG 7 | 464 ++++++++++- dialog/ls-DIALOG MENUKARTEN MANAGER | 44 +- dialog/ls-DIALOG MM-gen | 27 +- dialog/ls-DIALOG decompress | 9 +- dialog/ls-DIALOG-gen | 108 ++- 11 files changed, 5606 insertions(+), 369 deletions(-) (limited to 'dialog') 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: Abbrechen: ",{} " 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: Abbrechen: ", + " 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: Bestätigen: Abbruch: ",{}" Ändern: Bestätigen: Ja: Nein: ",{}" Ändern: Bestätigen: ",{}" Fertig: Zeigen: Abbruch: ",{} -" Fertig: Abbruch: ",{}"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: Bestätigen: Abbruch: ", +" Ändern: Bestätigen: Ja: Nein: ", +" Ändern: Bestätigen: ", +" Fertig: Zeigen: Abbruch: ", + +" Fertig: Abbruch: ", +"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:/ Wahl: Ausführen: Verlassen:",{}" 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:/ Wahl: Ausführen: Verlassen:", +" 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. + -- cgit v1.2.3