diff options
Diffstat (limited to 'dialog')
| -rw-r--r-- | dialog/ls-DIALOG 1 | 548 | ||||
| -rw-r--r-- | dialog/ls-DIALOG 2 | 844 | ||||
| -rw-r--r-- | dialog/ls-DIALOG 3 | 416 | ||||
| -rw-r--r-- | dialog/ls-DIALOG 4 | 741 | ||||
| -rw-r--r-- | dialog/ls-DIALOG 5 | 1412 | ||||
| -rw-r--r-- | dialog/ls-DIALOG 6 | 1186 | ||||
| -rw-r--r-- | dialog/ls-DIALOG 7 | 460 | ||||
| -rw-r--r-- | dialog/ls-DIALOG MENUKARTEN MANAGER | 66 | ||||
| -rw-r--r-- | dialog/ls-DIALOG MM-gen | 50 | ||||
| -rw-r--r-- | dialog/ls-DIALOG decompress | 153 | ||||
| -rw-r--r-- | dialog/ls-DIALOG-gen | 130 | ||||
| -rw-r--r-- | dialog/ls-MENUKARTE:Archiv | bin | 40960 -> 0 bytes |
12 files changed, 0 insertions, 6006 deletions
diff --git a/dialog/ls-DIALOG 1 b/dialog/ls-DIALOG 1 deleted file mode 100644 index b4a2408..0000000 --- a/dialog/ls-DIALOG 1 +++ /dev/null @@ -1,548 +0,0 @@ -(* - - ********************************************************* - ********************************************************* - ** ** - ** ls-DIALOG 1 ** - ** ** - ** Version 1.2 ** - ** ** - ** (Stand: 04.11.88) ** - ** ** - ** ** - ** Autor: Wolfgang Weber, Bielefeld ** - ** ** - ** ** - ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** - ** ** - ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** - ** ** - ********************************************************* - ********************************************************* - - *) -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; - - diff --git a/dialog/ls-DIALOG 2 b/dialog/ls-DIALOG 2 deleted file mode 100644 index 7fb5d36..0000000 --- a/dialog/ls-DIALOG 2 +++ /dev/null @@ -1,844 +0,0 @@ -(* - - ********************************************************* - ********************************************************* - ** ** - ** ls-DIALOG 2 ** - ** ** - ** Version 1.2 ** - ** ** - ** (Stand: 04.11.88) ** - ** ** - ** ** - ** Autor: Wolfgang Weber, Bielefeld ** - ** ** - ** ** - ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** - ** ** - ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** - ** ** - ********************************************************* - ********************************************************* - - *) -PACKET ls dialog 2 DEFINES - some, - one, - infix namen, - ohne praefix, - not empty: -LET maxentries = 200; -LET zeichenstring = ""1""27""3""10""13""12"xo?", - oben unten return rubout kreuz kringel = ""3""10""13""12"xo", - q eins neun h = "q19h"; -LET zurueck = ""8"", - piep = ""7""; -LET hop = 1, - esc = 2, - oben = 3, - unten = 4, - return = 5, - rubout = 6, - - kreuz = 7, - kringel = 8, - frage = 9; -LET punkt = ".", - gleich = "=", - blank = " "; -INT VAR x, - y, - xsize, - ysize, - maxeintraege, - anzahl, - erste auswahlzeile, - virtueller cursor, - reeller cursor; -TEXT VAR kennzeile 1, - kennzeile 2, - registrierkette :: ""; -BOOL VAR abbruch, - auswahlende; -BOUND ROW max entries TEXT VAR eintrag; -ROW 2 TEXT CONST fehlermeldung :: ROW 2 TEXT : ( - - "Unzulässige Cursorwerte bei der Auswahl", - "Fenster für Auswahl zu klein (x < 56 / y < 15)"); -ROW 24 TEXT CONST hinweis :: ROW 24 TEXT : ( - " Bitte warten... Ich sortiere und räume auf!", - " Info: <?> Fertig: <ESC><q> Abbrechen: <ESC><h>", - " Zum Weitermachen bitte irgendeine Taste tippen!", - "Weitere Dateien!", - "INFORMATIONEN: Auswahl mehrerer Dateien", - "INFORMATIONEN: Auswahl einer Datei", - " "15"Positionierungen: "14"", - " hoch : zum vorausgehenden Namen", - - " runter : zum folgenden Namen", - " HOP hoch : auf den ersten Namen der Seite", (***********) - " HOP runter : auf den letzten Namen der Seite", (* bitte *) - " ESC 1 : auf den ersten Namen der Liste", (* diese *) - " ESC 9 : auf den letzten Namen der Liste", (* Länge *) - " "15"Auswahl treffen: "14"", (* nicht *) - " RETURN / x : diesen Namen ankreuzen ", (* über- *) - - " RUBOUT / o : Kreuz vor dem Namen loeschen", (* schrei-*) - " HOP RETURN / HOP x : alle folgende Namen ankreuzen", (* ten! *) - " HOP RUBOUT / HOP o : alle folgende Kreuze loeschen", (***********) - " "15"Auswahl verlassen: "14"", - " ESC q : Auswahl verlassen", - " ESC h : Auswahl abbrechen", - " Auswahl m e h r e r e r Dateien durch Ankreuzen", - " Auswahl e i n e r Datei durch Ankreuzen", - " Bitte warten... Ich breche die Auswahl ab!" - - ); -THESAURUS PROC auswahl (THESAURUS CONST t, - BOOL CONST mehrere moeglich, - TEXT CONST t1, t2): - werte initialisieren; - namen besorgen; - bildschirm aufbauen; - auswaehlen lassen; - abgang vorbereiten. - werte initialisieren: - THESAURUS VAR ausgabe :: empty thesaurus; - DATASPACE VAR ds := nilspace; - eintrag := ds; - kennzeile 1 := t1; - kennzeile 2 := t2; - abbruch := FALSE; - - erste auswahlzeile := y + 7; - anzahl := 0; - maxeintraege := ysize - 11; - virtueller cursor := 1; - reeller cursor := 1. - namen besorgen: - fische die namen aus dem thesaurus; - IF kein eintrag vorhanden - THEN LEAVE auswahl WITH ausgabe - FI. - bildschirm aufbauen: - schreibe kopfzeile; - gib hinweis aus (kennzeile 1, kennzeile 2); - gib erklaerungszeile aus (mehrere moeglich); - baue bildschirm auf (1); - footnote (x, y, xsize, ysize, hinweis [2]); - - schreibe fusszeile; - reellen cursor setzen . - schreibe kopfzeile: - cursor (x, y); - out(ecke oben links); - (xsize - 2) TIMESOUT waagerecht; - out(ecke oben rechts). - schreibe fusszeile: - cursor (x, y + ysize - 1); - out (ecke unten links); - (xsize - 2) TIMESOUT waagerecht; - out (ecke unten rechts). - auswaehlen lassen: - kreuze an (mehrere moeglich). - abgang vorbereiten: - IF abbruch - THEN change footnote (x, y, xsize, ysize, hinweis [24]) - - ELSE change footnote (x, y, xsize, ysize, hinweis [ 1]) - FI; - cursor (x + 1, y + ysize - 1); - ausgabe erzeugen; - forget (ds); - ausgabe. - fische die namen aus dem thesaurus: - INT VAR zeiger; - FOR zeiger FROM 1 UPTO highest entry (t) REP - IF name (t, zeiger) <> "" - THEN anzahl INCR 1; - eintrag [anzahl] := name (t, zeiger) - FI - PER. - kein eintrag vorhanden: - anzahl = 0. - ausgabe erzeugen: - TEXT VAR nummer; - WHILE registrierkette <> "" REP - - nummer := subtext (registrierkette, 1, 3); - registrierkette := subtext (registrierkette, 5); - insert (ausgabe, eintrag [ int (nummer)]) - PER. -END PROC auswahl; -PROC reellen cursor setzen: - cursor (x + 1, erste auswahlzeile + reeller cursor - 1); - out (marke (virtueller cursor, TRUE) + (8 * zurueck)) -END PROC reellen cursor setzen; -PROC baue bildschirm auf (INT CONST anfang): - gib kopfzeile aus; - gib namenstabelle aus; - gib fusszeile aus; - loesche ggf restbereich. - - gib kopfzeile aus: - cursor (x, erste auswahlzeile - 1); out (senkrecht); - IF reeller cursor = virtueller cursor - THEN (xsize - 2) TIMESOUT punkt - ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt; - out (invers (hinweis [4])) - FI; - out (senkrecht); - line. - gib namenstabelle aus: - INT VAR zeiger, zaehler :: -1; - FOR zeiger FROM anfang UPTO grenze REP - zaehler INCR 1; - cursor (x, erste auswahlzeile + zaehler); - out (senkrecht); out (marke (zeiger, FALSE)); - - outtext (subtext (eintrag [zeiger], 1, xsize - 10), 1, xsize - 10); - out (senkrecht); - PER. - gib fusszeile aus: - cursor (x, erste auswahlzeile + zaehler + 1); - out (senkrecht); - IF NOT ((virtueller cursor + maxeintraege - reeller cursor) < anzahl) - THEN (xsize - 2) TIMESOUT punkt - ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt; - out (invers (hinweis [4])) - FI; - out (senkrecht). - loesche ggf restbereich: - IF zaehler + 1 < maxeintraege - - THEN loesche bildschirmrest - FI. - loesche bildschirmrest: - FOR zeiger FROM restanfang UPTO restende REP - cursor (x, zeiger); out (senkrecht); - (xsize - 2) TIMESOUT blank; - out (senkrecht) - PER. - restanfang: - erste auswahlzeile + zaehler + 2. - restende: - erste auswahlzeile + maxeintraege. - grenze: - min (anzahl, anfang + max eintraege - 1). -END PROC baue bildschirm auf; -TEXT PROC marke (INT CONST zeiger, BOOL CONST mit cursor): - - INT VAR platz := nr (zeiger); - IF platz = 0 - THEN leer - ELSE mit zahl - FI. - mit zahl: - IF mit cursor - THEN "==>" + (3 - length (text (platz))) * blank + text (platz) + "x " - ELSE " " + (3 - length (text (platz))) * blank + text (platz) + "x " - FI. - leer: - IF mit cursor - THEN "==> o " - ELSE " o " - FI. -END PROC marke; -INT PROC nr (INT CONST zeiger): - IF pos (registrierkette, textstring (zeiger)) = 0 - THEN 0 - ELSE (pos (registrierkette, textstring (zeiger)) DIV 4) + 1 - - FI -END PROC nr; -TEXT PROC textstring (INT CONST nr): - text (nr, 3) + "!" -END PROC textstring; -PROC info (BOOL CONST mehrere): - notiere hinweisueberschrift; - notiere positionierhinweise; - IF noch platz vorhanden - THEN notiere auswahlmoeglichkeiten auf alter seite - ELSE wechsle auf naechste seite; - notiere hinweisueberschrift; - notiere auswahlmoeglichtkeiten auf neuer seite - FI; - stelle alten bildschirmzustand wieder her. - notiere hinweisueberschrift: - - cursor (x + 1, y + 1); - IF mehrere - THEN out (center(xsize - 2, invers (hinweis [5]))) - ELSE out (center(xsize - 2, invers (hinweis [6]))) - FI; - cursor (x + 1, y + 2); out ("", xsize - 2). - notiere positionierhinweise: - cursor (x + 1, y + 3); out (hinweis [ 7], xsize - 2); - cursor (x + 1, y + 4); out (hinweis [ 8], xsize - 2); - cursor (x + 1, y + 5); out (hinweis [ 9], xsize - 2); - cursor (x + 1, y + 6); out (hinweis [10], xsize - 2); - cursor (x + 1, y + 7); out (hinweis [11], xsize - 2); - - cursor (x + 1, y + 8); out (hinweis [12], xsize - 2); - cursor (x + 1, y + 9); out (hinweis [13], xsize - 2). - notiere auswahlmoeglichkeiten auf alter seite: - cursor (x + 1, y + 10); out ("", xsize - 2); - cursor (x + 1, y + 11); out (hinweis [14], xsize - 2); - cursor (x + 1, y + 12); out (hinweis [15], xsize - 2); - IF mehrere - THEN gib alle auswahlmoeglichkeiten auf der alten seite an - ELSE gib eine auswahlmoeglichkeit auf der alten seite an - FI; - - notiere verlassmoeglichkeiten auf der alten seite; - loesche die restlichen zeilen; - change footnote (x, y, xsize, ysize, hinweis [3]); - cursor in ruhestellung; - clear buffer. - gib alle auswahlmoeglichkeiten auf der alten seite an: - cursor (x + 1, y + 13); out (hinweis [16], xsize - 2); - cursor (x + 1, y + 14); out (hinweis [17], xsize - 2); - cursor (x + 1, y + 15); out (hinweis [18], xsize - 2). - gib eine auswahlmoeglichkeit auf der alten seite an: - cursor (x + 1, y + 13); out ("", xsize - 2); - - cursor (x + 1, y + 14); out ("", xsize - 2); - cursor (x + 1, y + 15); out ("", xsize - 2). - notiere verlassmoeglichkeiten auf der alten seite: - cursor (x + 1, y + 16); out ("", xsize - 2); - cursor (x + 1, y + 17); out (hinweis [19], xsize - 2); - cursor (x + 1, y + 18); out (hinweis [20], xsize - 2); - cursor (x + 1, y + 19); out (hinweis [21], xsize - 2). - loesche die restlichen zeilen: - IF ysize = 24 - THEN cursor (x + 1, y + 20); out ("", xsize - 2) - FI. - - wechsle auf naechste seite: - loesche seitenrest; - change footnote (x, y, xsize, ysize, hinweis [3]); - cursor in ruhestellung; - clear buffer; - pause. - loesche seitenrest: - INT VAR zaehler; - FOR zaehler FROM 10 UPTO ysize - 4 REP - cursor (x + 1, y + zaehler); out ("", xsize - 2) - PER. - notiere auswahlmoeglichtkeiten auf neuer seite: - cursor (x + 1, y + 3); out (hinweis [14], xsize - 2); - cursor (x + 1, y + 4); out (hinweis [15], xsize - 2); - IF mehrere - - THEN gib alle auswahlmoeglichkeiten auf der neuen seite an - ELSE gib eine auswahlmoeglichkeit auf der neuen seite an - FI; - notiere verlassmoeglichkeiten auf der neuen seite. - gib alle auswahlmoeglichkeiten auf der neuen seite an: - cursor (x + 1, y + 5); out (hinweis [16], xsize - 2); - cursor (x + 1, y + 6); out (hinweis [17], xsize - 2); - cursor (x + 1, y + 7); out (hinweis [18], xsize - 2). - gib eine auswahlmoeglichkeit auf der neuen seite an: - cursor (x + 1, y + 5); out ("", xsize - 2); - - cursor (x + 1, y + 6); out ("", xsize - 2); - cursor (x + 1, y + 7); out ("", xsize - 2). - notiere verlassmoeglichkeiten auf der neuen seite: - cursor (x + 1, y + 8); out ("", xsize - 2); - cursor (x + 1, y + 9); out (hinweis [19], xsize - 2); - cursor (x + 1, y + 10); out (hinweis [20], xsize - 2); - cursor (x + 1, y + 11); out (hinweis [21], xsize - 2); - cursor in ruhestellung. - cursor in ruhestellung: - cursor (x + 1, y + ysize - 2). - stelle alten bildschirmzustand wieder her: - - clear buffer; - pause; - gib hinweis aus (kennzeile 1, kennzeile 2); - gib erklaerungszeile aus (mehrere); - virtueller cursor := 1; - reeller cursor := 1; - baue bildschirm auf (1); - change footnote (x, y, xsize, ysize, hinweis [2]); - reellen cursor setzen. - noch platz vorhanden: - (ysize - 4) > 18. -END PROC info; -PROC kreuze an (BOOL CONST mehrere): - auswahlende := FALSE; - REP - zeichen lesen; zeichen interpretieren - UNTIL auswahlende PER. - zeichen lesen: - - TEXT VAR zeichen; - getchar (zeichen). - zeichen interpretieren: - SELECT pos (zeichenstring, zeichen) OF - CASE hop : hop kommando verarbeiten (mehrere) - CASE esc : esc kommando verarbeiten - CASE oben : nach oben - CASE unten : nach unten - CASE kreuz : ankreuzen; evtl aufhoeren - CASE return : ankreuzen weiter; evtl aufhoeren - CASE rubout : auskreuzen weiter - CASE kringel : auskreuzen - CASE frage : info (mehrere) - - OTHERWISE out (piep) - END SELECT. - evtl aufhoeren: - IF NOT mehrere - THEN LEAVE kreuze an - FI. -END PROC kreuze an; -PROC hop kommando verarbeiten (BOOL CONST mehrere): - zweites zeichen lesen; - zeichen interpretieren. - zweites zeichen lesen: - TEXT VAR zweites zeichen; - getchar(zweites zeichen). - zeichen interpretieren: - SELECT pos (oben unten return rubout kreuz kringel, zweites zeichen) OF - CASE 1 : hop nach oben - CASE 2 : hop nach unten - - CASE 3, 5 : IF mehrere THEN alle darunter ankreuzen FI - CASE 4, 6 : IF mehrere THEN alle darunter loeschen FI - OTHERWISE out (piep) - END SELECT. - alle darunter ankreuzen: - INT VAR i; - FOR i FROM virtueller cursor UPTO anzahl REP - IF nr (i) = 0 - THEN ankreuzen - FI - PER; - bild aktualisieren ; - reellen cursor setzen . - ankreuzen: - registrierkette CAT textstring (i). - alle darunter loeschen: - INT VAR j, position; - FOR j FROM virtueller cursor UPTO anzahl REP - - position := nr (j); - IF position > 0 - THEN rausschmeissen; - FI - PER; - bild aktualisieren; - reellen cursor setzen. - rausschmeissen: - registrierkette := subtext (registrierkette, 1, (4 * position) - 4) + - subtext (registrierkette, (4 * position) + 1). - hop nach oben: - IF ganz oben - THEN out (piep) - ELIF oben auf der seite - THEN raufblaettern - ELSE top of page - FI. - ganz oben: - virtueller cursor = 1. - - oben auf der seite: - reeller cursor = 1. - raufblaettern: - virtueller cursor DECR max eintraege; - virtueller cursor := max (virtueller cursor, 1); - baue bildschirm auf (virtueller cursor); - reellen cursor setzen. - top of page: - loesche marke; - virtueller cursor DECR (reeller cursor - 1); - reeller cursor := 1; - reellen cursor setzen. - hop nach unten: - IF ganz unten - THEN out (piep) - ELIF unten auf der seite - THEN runterblaettern - - ELSE bottom of page - FI. - ganz unten: - virtueller cursor = anzahl. - unten auf der seite: - reeller cursor > max eintraege - 1. - runterblaettern: - INT VAR alter virtueller cursor :: virtueller cursor; - virtueller cursor INCR max eintraege; - virtueller cursor := min (virtueller cursor, anzahl); - reeller cursor := virtueller cursor - alter virtueller cursor; - baue bildschirm auf (alter virtueller cursor + 1); - reellen cursor setzen. - bottom of page: - - loesche marke; - alter virtueller cursor := virtueller cursor; - virtueller cursor INCR (max eintraege - reeller cursor); - virtueller cursor := min (anzahl, virtueller cursor); - reeller cursor INCR (virtueller cursor - alter virtueller cursor); - reellen cursor setzen. -END PROC hop kommando verarbeiten; -PROC esc kommando verarbeiten: - TEXT VAR zweites zeichen; - getchar (zweites zeichen); - SELECT pos (q eins neun h, zweites zeichen) OF - CASE 1 : auswahlende := TRUE - - CASE 2 : zeige anfang - CASE 3 : zeige ende - CASE 4 : abbruch := TRUE; - auswahlende := TRUE; - registrierkette := "" - OTHERWISE out (piep) - END SELECT. - zeige anfang: - IF virtueller cursor = 1 - THEN out (piep) - ELIF virtueller cursor = reeller cursor - THEN loesche marke; - virtueller cursor := 1; - reeller cursor := 1; - reellen cursor setzen - ELSE virtueller cursor := 1; - - reeller cursor := 1; - baue bildschirm auf (1); - reellen cursor setzen - FI. - zeige ende: - IF virtueller cursor = anzahl - THEN out (piep) - ELIF ende auf bildschirm - THEN loesche marke; - reeller cursor INCR (anzahl - virtueller cursor); - virtueller cursor := anzahl; - reellen cursor setzen - ELSE virtueller cursor := anzahl; - reeller cursor := max eintraege; - - baue bildschirm auf (anzahl - (max eintraege - 1)); - reellen cursor setzen - FI. - ende auf bildschirm: - (reeller cursor + anzahl - virtueller cursor) < max eintraege + 1. -END PROC esc kommando verarbeiten; -PROC ankreuzen: - INT VAR platz :: nr (virtueller cursor); - IF platz <> 0 - THEN out (piep); - LEAVE ankreuzen - FI; - registrierkette CAT textstring (virtueller cursor); - reellen cursor setzen -END PROC ankreuzen; -PROC ankreuzen weiter: - - INT VAR platz :: nr (virtueller cursor); - IF platz <> 0 - THEN out (piep); - LEAVE ankreuzen weiter - FI; - registrierkette CAT textstring (virtueller cursor); - IF virtueller cursor < anzahl - THEN nach unten - FI; - IF virtueller cursor = anzahl - THEN reellen cursor setzen - FI -END PROC ankreuzen weiter; -PROC auskreuzen weiter: - INT VAR position :: nr (virtueller cursor); - IF position = 0 - THEN out (piep); - LEAVE auskreuzen weiter - FI; - rausschmeissen; - - IF virtueller cursor < anzahl - THEN nach unten - ELSE loesche marke - FI; - bild aktualisieren; - reellen cursor setzen. - rausschmeissen: - registrierkette := subtext (registrierkette, 1, 4 * position - 4) + - subtext (registrierkette, 4 * position + 1). -END PROC auskreuzen weiter; -PROC auskreuzen: - INT VAR position :: nr (virtueller cursor); - IF position = 0 - THEN out (piep); - LEAVE auskreuzen - FI; - rausschmeissen; - loesche marke; - - bild aktualisieren; - reellen cursor setzen. - rausschmeissen: - registrierkette := subtext (registrierkette, 1, 4 * position - 4) + - subtext (registrierkette, 4 * position + 1). -END PROC auskreuzen; -PROC bild aktualisieren: - INT VAR ob, un, i, zaehler :: -1; - ob := virtueller cursor - reeller cursor + 1; - un := min (ob + max eintraege - 1, anzahl); - FOR i FROM ob UPTO un REP - zaehler INCR 1; - cursor (x + 1, erste auswahlzeile + zaehler); - out (marke (i,FALSE)) PER - -END PROC bild aktualisieren; -PROC nach oben: - IF noch nicht oben (*virtuell*) - THEN gehe nach oben - ELSE out (piep) - FI. - noch nicht oben: - virtueller cursor > 1. - gehe nach oben: - IF reeller cursor = 1 THEN scroll down ELSE cursor up FI. - scroll down: - virtueller cursor DECR 1; - baue bildschirm auf (virtueller cursor); - reellen cursor setzen. - cursor up: - loesche marke; - virtueller cursor DECR 1; - reeller cursor DECR 1; - reellen cursor setzen - -END PROC nach oben; -PROC nach unten: - IF noch nicht unten (*virtuell*) - THEN gehe nach unten - ELSE out (piep) - FI. - noch nicht unten: - virtueller cursor < anzahl. - gehe nach unten: - IF reeller cursor > max eintraege - 1 THEN scroll up ELSE cursor down FI. - scroll up: - virtueller cursor INCR 1; - baue bildschirm auf (virtueller cursor - (max eintraege - 1)); - reellen cursor setzen. - cursor down: - loesche marke; - virtueller cursor INCR 1; - reeller cursor INCR 1; - - reellen cursor setzen -END PROC nach unten; -PROC loesche marke: - out (marke (virtueller cursor, FALSE)) -END PROC loesche marke; -PROC footnote (INT CONST x, y, xsize, ysize, TEXT CONST text): - cursor (x, y + ysize - 3); - out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts); - change footnote (x, y, xsize, ysize, text) -END PROC footnote; -PROC change footnote (INT CONST x, y, xsize, ysize, TEXT CONST text): - cursor (x, y + ysize - 2); - out (senkrecht); outtext (text, 1, xsize - 2); out (senkrecht) - -END PROC change footnote; -PROC gib hinweis aus (TEXT CONST t1, t2): - cursor (x, y + 1); out (senkrecht); - out (center (xsize - 2, invers (t1))); - out (senkrecht); - cursor (x, y + 2); out (senkrecht); - out ("", xsize - 2); - out (senkrecht); - cursor (x, y + 3); out (senkrecht); - out (center (xsize - 2, t2)); - out (senkrecht) -END PROC gib hinweis aus; -PROC gib erklaerungszeile aus (BOOL CONST mehrere): - - cursor (x, y + 4); out (senkrecht); - out ((xsize - 2) * gleich); - out (senkrecht); - cursor (x, y + 5); out (senkrecht); - IF mehrere - THEN out (erklaerungszeile mehrere) - ELSE out (erklaerungszeile eine) - FI; - out (senkrecht). - erklaerungszeile mehrere: - invers (text 1 + (rest1 * blank)). - erklaerungszeile eine: - invers (text 2 + (rest2 * blank)). - - text1: - hinweis [22]. - text2: - hinweis [23]. - rest1: (***************************) - xsize - length (text1) - 5. (* durch 'invers' wird ein *) - (* Blank angehängt und zu- *) - rest2: (* sätzlich noch durch *) - xsize - length (text2) - 5. (* 'relativcenter' - außer-*) -END PROC gib erklaerungszeile aus; (* dem nimmt die Markierung*) - (* selbst eine Position ein*) - - (***************************) -THESAURUS PROC infix namen (THESAURUS CONST t, TEXT CONST infix): - THESAURUS VAR tt :: empty thesaurus; - INT VAR i; - FOR i FROM 1 UPTO highest entry (t) REP - TEXT VAR eintrag :: name (t,i); - IF eintrag enthaelt infix - THEN insert (tt, eintrag) - FI - PER; - tt. - eintrag enthaelt infix: - pos (eintrag, infix) <> 0 -END PROC infix namen; -THESAURUS PROC infix namen (THESAURUS CONST t, INT CONST dateityp): - - THESAURUS VAR tt :: empty thesaurus; - INT VAR i; - FOR i FROM 1 UPTO highest entry (t) REP - TEXT VAR eintrag :: name (t,i); - IF eintrag enthaelt infix - THEN insert (tt, eintrag) - FI - PER; - tt. - eintrag enthaelt infix: - type (old (eintrag)) = dateityp. -END PROC infix namen; -THESAURUS PROC infix namen (THESAURUS CONST t, - TEXT CONST infix 1, INT CONST dateityp): - THESAURUS VAR tt :: empty thesaurus; - INT VAR i; - FOR i FROM 1 UPTO highest entry (t) REP - - TEXT VAR eintrag :: name (t,i); - IF eintrag enthaelt infix - THEN insert (tt, eintrag) - FI - PER; - tt. - eintrag enthaelt infix: - (pos (eintrag, infix 1) <> 0) AND (type (old (eintrag)) = dateityp). -END PROC infix namen; -THESAURUS PROC infix namen (THESAURUS CONST t, - TEXT CONST infix 1, infix 2): - THESAURUS VAR tt :: empty thesaurus; - INT VAR i; - FOR i FROM 1 UPTO highest entry (t) REP - TEXT VAR eintrag :: name (t,i); - IF eintrag enthaelt infix - - THEN insert (tt, eintrag) - FI - PER; - tt. - eintrag enthaelt infix: - (pos (eintrag, infix 1) <> 0) OR (pos (eintrag, infix 2) <> 0) -END PROC infix namen; -THESAURUS PROC infix namen (TEXT CONST infix): - infix namen (ALL myself, infix) -END PROC infix namen; -THESAURUS PROC infix namen (TEXT CONST infix 1, infix 2): - infix namen (ALL myself, infix 1, infix 2) -END PROC infix namen; -THESAURUS PROC ohne praefix (THESAURUS CONST thesaurus, TEXT CONST praefix): - THESAURUS VAR t :: empty thesaurus; - - INT VAR zaehler; - FOR zaehler FROM 1 UPTO highest entry (thesaurus) REP - IF name (thesaurus, zaehler) <> "" - AND pos (name (thesaurus, zaehler), praefix) = 1 - THEN insert (t, subtext (name (thesaurus, zaehler), - length (praefix) + 1)) - FI; - PER; - t -END PROC ohne praefix; -BOOL PROC not empty (THESAURUS CONST t): - INT VAR i; - FOR i FROM 1 UPTO highest entry (t) REP - IF name (t, i) <> "" - THEN LEAVE not empty WITH TRUE - - FI - PER; - FALSE -END PROC not empty; -PROC untersuche bildschirmmasszahlen (TEXT CONST t1, t2): - IF unzulaessige cursorwerte - THEN errorstop (fehlermeldung [1]) - ELIF fenster ist zu klein - THEN errorstop (fehlermeldung [2]) - FI. - unzulaessige cursorwerte: - (x + xsize) > 80 COR (y + ysize) > 25 COR x < 1 COR y < 1 - COR xsize > 79 COR ysize > 24. - fenster ist zu klein: - (xsize) < 56 COR (ysize) < 15 - COR length (t1) > (xsize - 5) COR length (t2) > (xsize - 5). - -END PROC untersuche bildschirmmasszahlen; -TEXT PROC ggf gekuerzter text (TEXT CONST text): - IF length (text) > (xsize - 5) - THEN subtext (text, 1, xsize - 7) + ".." - ELSE text - FI -END PROC ggf gekuerzter text; -THESAURUS PROC some (INT CONST spa, zei, breite, hoehe, - THESAURUS CONST t, - TEXT CONST t1, t2): - TEXT VAR text 1, text 2; - x := spa; - y := zei; - xsize := breite; - ysize := hoehe; - text 1 := ggf gekuerzter text (t1); - - text 2 := ggf gekuerzter text (t2); - untersuche bildschirmmasszahlen (text 1, text 2); - auswahl (t, TRUE, text 1, text 2) -END PROC some; -THESAURUS PROC some (INT CONST spa, zei, - THESAURUS CONST t, - TEXT CONST t1, t2): - some (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2) -END PROC some; -THESAURUS PROC some (THESAURUS CONST t, - TEXT CONST t1, t2): - some (1, 1, 79, 24, t, t1, t2) -END PROC some; -TEXT PROC one (INT CONST spa, zei, breite, hoehe, - - THESAURUS CONST t, - TEXT CONST t1, t2): - TEXT VAR text 1, text 2; - x := spa; - y := zei; - xsize := breite; - ysize := hoehe; - text 1 := ggf gekuerzter text (t1); - text 2 := ggf gekuerzter text (t2); - untersuche bildschirmmasszahlen (text 1, text 2); - name (auswahl (t, FALSE, text 1, text 2), 1) -END PROC one; -TEXT PROC one (INT CONST spa, zei, - THESAURUS CONST t, - TEXT CONST t1, t2): - one (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2) - -END PROC one; -TEXT PROC one (THESAURUS CONST t, TEXT CONST t1, t2): - one (1, 1, 79, 24, t, t1, t2) -END PROC one; -END PACKET ls dialog 2; - - diff --git a/dialog/ls-DIALOG 3 b/dialog/ls-DIALOG 3 deleted file mode 100644 index 2460820..0000000 --- a/dialog/ls-DIALOG 3 +++ /dev/null @@ -1,416 +0,0 @@ -(* - - ********************************************************* - ********************************************************* - ** ** - ** ls-DIALOG 3 ** - ** ** - ** Version 1.2 ** - ** ** - ** (Stand: 04.11.88) ** - ** ** - ** ** - ** Autor: Wolfgang Weber, Bielefeld ** - ** ** - ** ** - ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** - ** ** - ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** - ** ** - ********************************************************* - ********************************************************* - - *) - -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 deleted file mode 100644 index e1d38c4..0000000 --- a/dialog/ls-DIALOG 4 +++ /dev/null @@ -1,741 +0,0 @@ -(* - - ********************************************************* - ********************************************************* - ** ** - ** ls-DIALOG 4 ** - ** ** - ** Version 1.2 ** - ** ** - ** (Stand: 04.11.88) ** - ** ** - ** ** - ** Autor: Wolfgang Weber, Bielefeld ** - ** ** - ** ** - ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** - ** ** - ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** - ** ** - ********************************************************* - ********************************************************* - - *) - -PACKET ls dialog 4 DEFINES - boxinfo, - boxnotice, - boxalternative, - boxyes, - boxno, - boxanswer, - boxone, - boxanswerone, - boxsome, - boxanswersome, - out footnote, - erase footnote: -LET mark ein = ""15"", - mark aus = ""14"", - delimiter = ""13"", - piep = ""7"", - rechts links esc return = ""2""8""27""13"", - - rechts links null return = ""2""8""0""13"" , - blank = " ", - niltext = "", - janeintasten = "jJyYnN"; -ROW 8 TEXT CONST aussage :: ROW 8 TEXT : ( -" Zum Weitermachen bitte irgendeine Taste tippen!", -" Ändern: <Pfeile> Bestätigen: <RETURN> Abbruch: <ESC> <h>", -" Ändern: <Pfeile> Bestätigen: <RETURN> Ja: <j> Nein: <n>", -" Ändern: <Pfeile> Bestätigen: <RETURN>", -" Fertig: <RETURN> Zeigen: <ESC><z> Abbruch: <ESC><h>", - -" Fertig: <RETURN> Abbruch: <ESC><h>", -"Ja"13"Nein", -" Eingabe: " -); -PROC boxinfo (WINDOW VAR w, TEXT CONST t, - INT CONST position, timelimit, - INT VAR x, y, xsize, ysize): - INT VAR spa, zei; - get cursor (w, spa, zei); - schreibe box (w, t, position, timelimit, x, y, xsize, ysize); - cursor (w, spa, zei); -END PROC boxinfo; -PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position, - timelimit, BOOL CONST trennlinie weg): - INT VAR x, y, xsize, ysize, spa, zei; - - get cursor (w, spa, zei); - schreibe box (w, t, position, timelimit, x, y, xsize, ysize); - page up (x, y, xsize, ysize); - IF trennlinie weg - THEN erase footnote (w, TRUE) - ELSE erase footnote (w, FALSE) - FI; - cursor (w, spa, zei) -END PROC boxinfo; -PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position, timelimit): - boxinfo (w, t, position, timelimit, TRUE) -END PROC boxinfo; -PROC boxinfo (WINDOW VAR w, TEXT CONST t): - boxinfo (w, t, 5, maxint, TRUE) -END PROC boxinfo; - -PROC boxnotice (WINDOW VAR w, TEXT CONST t, INT CONST position, - INT VAR x, y, xsize, ysize): - INT VAR spa, zei; - get cursor (w, spa, zei); - schreibe notiz (w, t, position, x, y, xsize, ysize); - cursor (w, spa, zei) -END PROC boxnotice; -INT PROC boxalternative (WINDOW VAR w, TEXT CONST t, - auswahlliste, zusatztasten, - INT CONST position, BOOL CONST mit abbruch, - INT VAR x, y, xsize, ysize): - - INT VAR ergebnis, spa, zei; - get cursor (w, spa, zei); - schreibe alternativen (w, t, auswahlliste, zusatztasten, position, - mit abbruch, x, y, xsize, ysize, ergebnis); - cursor (w, spa, zei); - ergebnis -END PROC boxalternative; -INT PROC boxalternative (WINDOW VAR w, TEXT CONST t, auswahlliste, - zusatztasten, INT CONST position, - BOOL CONST mit abbruch, trennlinie weg): - INT VAR x, y, xsize, ysize, ergebnis, spa, zei; - - get cursor (w, spa, zei); - ergebnis := boxalternative (w, t, auswahlliste, zusatztasten, position, - mit abbruch, x, y, xsize, ysize); - page up (x, y, xsize, ysize); - IF trennlinie weg - THEN erase footnote (w, TRUE) - ELSE erase footnote (w, FALSE) - FI; - cursor (w, spa, zei); - ergebnis -END PROC boxalternative; -INT PROC boxalternative (WINDOW VAR w, TEXT CONST t, - auswahlliste, zusatztasten, - INT CONST position, BOOL CONST mit abbruch): - - boxalternative (w, t, auswahlliste, zusatztasten, - position, mit abbruch, TRUE) -END PROC boxalternative; -BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position, - INT VAR x, y, xsize, ysize): - INT VAR spa, zei; - get cursor (w, spa, zei); - BOOL CONST wert :: ja (w, t, position, x, y, xsize, ysize); - cursor (w, spa, zei); - wert -END PROC boxyes; -BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, - INT CONST position, BOOL CONST trennlinie weg): - - INT VAR x, y, xsize, ysize, spa, zei; - get cursor (w, spa, zei); - BOOL VAR wert :: ja (w, t, position, x, y, xsize, ysize); - page up (x, y, xsize, ysize); - IF trennlinie weg - THEN erase footnote (w, TRUE) - ELSE erase footnote (w, FALSE); - FI; - cursor (w, spa, zei); - wert -END PROC boxyes; -BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position): - boxyes (w, t, position, TRUE) -END PROC boxyes; -BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position, - - INT VAR x, y, xsize, ysize): - NOT boxyes (w, t, position, x, y, xsize, ysize) -END PROC boxno; -BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, - INT CONST position, BOOL CONST trennlinie weg): - NOT boxyes (w, t, position, trennlinie weg) -END PROC boxno; -BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position): - boxno (w, t, position) -END PROC boxno; -TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe, - INT CONST position, INT VAR x, y, xsize, ysize): - - INT VAR spa, zei; - TEXT VAR wert; - get cursor (w, spa, zei); - wert := hole antwort (w, t, vorgabe, position, FALSE, x, y, xsize, ysize); - cursor (spa, zei); - wert -END PROC boxanswer; -TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe, - INT CONST position, BOOL CONST trennlinie weg): - INT VAR x, y, xsize, ysize, spa, zei; - get cursor (w, spa, zei); - TEXT VAR wert := hole antwort (w, t, vorgabe, position, FALSE, - x, y, xsize, ysize); - - page up (x, y, xsize, ysize); - IF trennlinie weg - THEN erase footnote (w, TRUE) - ELSE erase footnote (w, FALSE) - FI; - cursor (w, spa, zei); - wert -END PROC boxanswer; -TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe, - INT CONST position): - boxanswer (w, t, vorgabe, position, TRUE) -END PROC boxanswer; -TEXT PROC boxone (WINDOW VAR w, THESAURUS CONST thesaurus, - TEXT CONST text1, text2, BOOL CONST mit reinigung): - - INT VAR spa, zei; - get cursor (w, spa, zei); - TEXT VAR wert :: one (areax (w) + 2, areay (w) + 2, - areaxsize (w) - 4, areaysize (w) - 2, - thesaurus, text1, text2); - IF mit reinigung - THEN page up (areax (w) + 2, areay (w) + 2, - areaxsize (w) - 4, areaysize (w) - 2); - erase footnote (w) - FI; - cursor (w, spa, zei); - wert -END PROC boxone; -TEXT PROC boxanswerone (WINDOW VAR w, TEXT CONST text, vorgabe, - - THESAURUS CONST thesaurus, TEXT CONST t1, t2, - BOOL CONST mit reinigung, trennlinie weg): - INT VAR x,y, xsize, ysize, spa, zei; - get cursor (w, spa, zei); - TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE, - x, y, xsize, ysize); - IF wert = ""27"z" - THEN lasse auswaehlen - ELSE uebernimm den wert - FI; - cursor (w, spa, zei); - wert. - lasse auswaehlen: - IF mit reinigung - THEN wert := boxone (w, thesaurus, t1, t2, TRUE ) - - ELSE wert := boxone (w, thesaurus, t1, t2, FALSE) - FI. - uebernimm den wert: - IF mit reinigung - THEN page up (x, y, xsize, ysize); - entferne ggf die trennlinie - FI. - entferne ggf die trennlinie: - IF trennlinie weg - THEN erase footnote (w, TRUE) - ELSE erase footnote (w, FALSE) - FI. -END PROC boxanswer one; -TEXT PROC boxanswerone (WINDOW VAR w, TEXT CONST text, vorgabe, - THESAURUS CONST thesaurus, TEXT CONST t1, t2, - - BOOL CONST mit reinigung): - boxanswerone (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE) -END PROC boxanswer one; -THESAURUS PROC boxsome (WINDOW VAR w, THESAURUS CONST thesaurus, - TEXT CONST text1, text2, - BOOL CONST mit reinigung): - INT VAR spa, zei; - get cursor (w, spa, zei); - THESAURUS VAR wert :: some (areax (w) + 2, areay (w) + 2, - areaxsize (w) - 4, areaysize (w) - 2, - - thesaurus, text1, text2); - IF mit reinigung - THEN page up (areax (w) + 2, areay (w) + 2, - areaxsize (w) - 4, areaysize (w) - 2); - erase footnote (w) - FI; - cursor (w, spa, zei); - wert -END PROC boxsome; -THESAURUS PROC boxanswersome (WINDOW VAR w, TEXT CONST text, vorgabe, - THESAURUS CONST thesaurus, - TEXT CONST t1, t2, - BOOL CONST mit reinigung, trennlinie weg): - - THESAURUS VAR ergebnis :: empty thesaurus; - INT VAR x, y, xsize, ysize, spa, zei; - get cursor (w, spa, zei); - TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE, - x, y, xsize, ysize); - IF wert = ""27"z" - THEN lasse auswaehlen - ELSE uebernimm den wert - FI; - cursor (w, spa, zei); - ergebnis. - lasse auswaehlen: - IF mit reinigung - THEN ergebnis := boxsome (w, thesaurus, t1, t2, TRUE ) - ELSE ergebnis := boxsome (w, thesaurus, t1, t2, FALSE) - - FI. - uebernimm den wert: - IF wert <> niltext - THEN insert (ergebnis, wert) - FI; - IF mit reinigung - THEN page up (x, y, xsize, ysize); - entferne ggf die trennlinie - FI. - entferne ggf die trennlinie: - IF trennlinie weg - THEN erase footnote (w, TRUE) - ELSE erase footnote (w, FALSE) - FI. -END PROC boxanswer some; -THESAURUS PROC boxanswersome (WINDOW VAR w, TEXT CONST text, vorgabe, - THESAURUS CONST thesaurus, - - TEXT CONST t1, t2, - BOOL CONST mit reinigung): - boxanswersome (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE) -END PROC boxanswersome; -PROC out footnote (WINDOW VAR w, BOOL CONST mit trennlinie, TEXT CONST text): - INT VAR spa, zei; - get cursor (w, spa, zei); - IF mit trennlinie - THEN cursor (w, 1, areaysize (w) - 1); - areaxsize (w) TIMESOUT waagerecht - FI; - cursor (w, 1, areaysize (w)); - outtext (text, 1, areaxsize (w)); - - cursor (w, spa, zei) -END PROC out footnote; -PROC out footnote (WINDOW VAR w, TEXT CONST t): - out footnote (w, TRUE, t) -END PROC out footnote; -PROC erase footnote (WINDOW VAR w, BOOL CONST auch trennlinie): - INT VAR spa, zei; - get cursor (w, spa, zei); - IF auch trennlinie - THEN cursor (w, 1, areaysize (w) - 1); - outtext ("", 1, areaxsize (w)) - FI; - cursor (w, 1, areaysize (w)); - outtext ("", 1, areaxsize (w)); - cursor (w, spa, zei) -END PROC erase footnote; -PROC erase footnote (WINDOW VAR w): - - erase footnote (w, TRUE) -END PROC erase footnote; -PROC schreibe boxtext (WINDOW VAR w, TEXT CONST t, - INT CONST position, zusatzlaenge, - mindestbreite, mindesthoehe, - INT VAR x, y, xsize, ysize): - ermittle boxbreite und boxhoehe; - ermittle rahmenwerte; - schreibe boxkopf; - schreibe boxrumpf. - ermittle boxbreite und boxhoehe: - TEXT VAR intern :: t + delimiter; - entferne fuehrende delimiter; - INT VAR anfang :: 1, - - ende :: pos (intern, delimiter, anfang) - 1; - xsize := 0; - ysize := 0; - WHILE ende > 0 REP - ysize INCR 1; - lege ggf boxbreite fest; - bestimme neue positionen - PER. - entferne fuehrende delimiter: - WHILE (intern SUB 1) = delimiter REP - intern := subtext (intern, 2) - PER. - lege ggf boxbreite fest: - IF length (subtext (intern, anfang, ende)) > xsize - THEN xsize := length (subtext (intern, anfang, ende)) - FI. - bestimme neue positionen: - - anfang := ende + 2; - ende := pos (intern, delimiter, anfang) - 1. - ermittle rahmenwerte: - schlage notwendige groessen auf; - kill ueberlaengen; - lege bildschirmpositionen fest. - schlage notwendige groessen auf: - IF xsize < mindestbreite - THEN xsize := mindestbreite - FI; - IF ysize < mindesthoehe - THEN ysize := mindesthoehe - FI; - ysize INCR zusatzlaenge; - ysize INCR 2; (* Für den Rahmen *) - xsize INCR 2. (* Für den Rahmen *) - kill ueberlaengen: - - IF ysize > (areaysize (w) - 4) - THEN ysize := areaysize (w) - 4 - FI; - IF xsize > (areaxsize (w) - 4) - THEN xsize := areaxsize (w) - 4 - FI. - lege bildschirmpositionen fest: - SELECT position OF - CASE 1: plazierung links oben - CASE 2: plazierung rechts oben - CASE 3: plazierung links unten - CASE 4: plazierung rechts unten - OTHERWISE plazierung im zentrum - END SELECT. - plazierung links oben: - x := areax (w) + 2; - y := areay (w) + 2. - - plazierung rechts oben: - x := areax (w) + areaxsize (w) - xsize - 2; - y := areay (w) + 2. - plazierung links unten: - x := areax (w) + 2; - y := areay (w) + areaysize (w) - ysize - 2. - plazierung rechts unten: - x := areax (w) + areaxsize (w) - xsize - 2; - y := areay (w) + areaysize (w) - ysize - 2. - plazierung im zentrum: - x := areax (w) + ((areaxsize (w) - (xsize + 2)) DIV 2) + 1; - y := areay (w) + ((areaysize (w) - ysize) DIV 2). - schreibe boxkopf: - - cursor (x, y); - out (ecke oben links); - (xsize - 2) TIMESOUT waagerecht; - out (ecke oben rechts). - schreibe boxrumpf: - INT VAR i; - intern := t + delimiter; - entferne fuehrende delimiter; - anfang := 1; - ende := pos (intern, delimiter, anfang) - 1; - FOR i FROM y + 1 UPTO y + ysize - zusatzlaenge - 2 REP - cursor (x, i); - out (senkrecht); - outtext (subtext (intern, anfang, ende), 1, xsize - 2); - out (senkrecht); - anfang := ende + 2; - - ende := pos (intern, delimiter, anfang) - 1 - PER -END PROC schreibe boxtext; -PROC schreibe boxfuss (WINDOW VAR w, - INT CONST x, y, xsize, ysize, limit): - schreibe abschlusszeile; - out footnote (w, aussage [1]); - cursor in position und warten. - schreibe abschlusszeile: - cursor (x, y + ysize - 1); - out (ecke unten links); - (xsize - 2) TIMESOUT waagerecht; - out (ecke unten rechts). - cursor in position und warten: - cursor parken (w); - - clear buffer; - pause (limit) -END PROC schreibe boxfuss; -PROC cursor parken (WINDOW VAR w): - cursor (w, 1, 2) -END PROC cursor parken; -PROC schreibe box (WINDOW VAR w, TEXT CONST t, - INT CONST position, timelimit, - INT VAR x, y, xsize, ysize): - schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize); - schreibe boxfuss (w, x, y, xsize, ysize, timelimit) -END PROC schreibe box; -PROC schreibe notizfuss (WINDOW VAR w, INT CONST x, y, xsize, ysize): - - schreibe abschlusszeile; - cursor parken (w). - schreibe abschlusszeile: - cursor (x, y + ysize - 1); - out (ecke unten links); - (xsize - 2) TIMESOUT waagerecht; - out (ecke unten rechts). -END PROC schreibe notizfuss; -PROC schreibe notiz (WINDOW VAR w, TEXT CONST t, INT CONST position, - INT VAR x, y, xsize, ysize): - schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize); - schreibe notizfuss (w, x, y, xsize, ysize) -END PROC schreibe notiz; -PROC schreibe alternativen (WINDOW VAR w, TEXT CONST t, altzeile, sonst, - - INT CONST position, BOOL CONST mit abbruch, - INT VAR x, y, xsize, ysize, ergebnis): - ROW 10 STRUCT (TEXT alternat, INT anfang, laenge) VAR altliste; - normiere alternativen; - untersuche alternativen; - schreibe boxtext (w, textintern, position, 2, altbreite, - 0, x, y, xsize, ysize); - schreibe alternativenfuss; - lasse auswaehlen; - liefere ergebnis. - textintern: - IF sonst = janeintasten - THEN TEXT VAR zwischen; - - zwischen := t; - kuerze um folgende blanks; - zwischen + "? " - ELSE t - FI. - kuerze um folgende blanks: - WHILE (zwischen SUB (length (zwischen))) = blank REP - zwischen := subtext (zwischen , 1, length (zwischen) - 1) - PER. - normiere alternativen: - TEXT VAR altintern :: altzeile; - altintern CAT delimiter. - untersuche alternativen: - INT VAR altanzahl :: 1, altbreite, first :: - 2, anfang :: 1, - ende :: pos (altintern, delimiter, anfang) - 1; - - WHILE ende > 0 AND altanzahl <= 10 REP - trage alternative ein; - trage alternativenanfang ein; - trage alternativenlaenge ein; - setze neue positionen fest - PER; - ermittle gesamtalternativenbreite. - trage alternative ein: - altliste [altanzahl].alternat := - compress (subtext (altintern, anfang, ende)). - trage alternativenanfang ein: - first INCR 3; - altliste [altanzahl].anfang := first. - trage alternativenlaenge ein: - - altliste [altanzahl].laenge := length (altliste [altanzahl].alternat); - first INCR altliste [altanzahl].laenge. - setze neue positionen fest: - anfang := ende + 2; - ende := pos (altintern, delimiter, anfang) - 1; - altanzahl INCR 1. - ermittle gesamtalternativenbreite: - altanzahl DECR 1; - altbreite := altliste [altanzahl].anfang; - altbreite INCR (altliste [altanzahl].laenge + 3); - IF altbreite > areaxsize (w) - 6 - THEN LEAVE schreibe alternativen - - FI. - schreibe alternativenfuss: - schreibe leerzeile; - schreibe antwortmoeglichkeiten; - schreibe abschlusszeile; - IF mit abbruch - THEN out footnote (w, aussage [2]) - ELSE beruecksichtige ja nein hinweis - FI. - schreibe leerzeile: - cursor (x, y + ysize - 3); - out (senkrecht); - (xsize - 2) TIMESOUT blank; - out (senkrecht). - schreibe antwortmoeglichkeiten: - cursor (x, y + ysize - 2); - out (senkrecht); - einrueckbreite TIMESOUT blank; - - out (antwortleiste); - rest TIMESOUT blank; - out (senkrecht). - einrueckbreite: - (xsize - 2 - length (antwortleiste)) DIV 2. - antwortleiste: - INT VAR zeiger; TEXT VAR ausgabe :: ""; - FOR zeiger FROM 1 UPTO altanzahl REP - ausgabe CAT altliste [zeiger].alternat; - ausgabe CAT " " - PER; - compress (ausgabe). - rest: - xsize - 2 - einrueckbreite - length (antwortleiste). - schreibe abschlusszeile: - cursor (x, y + ysize - 1); - out (ecke unten links); - - (xsize - 2) TIMESOUT waagerecht; - out (ecke unten rechts). - beruecksichtige ja nein hinweis: - IF sonst = janeintasten - THEN out footnote (w, aussage [3]) - ELSE out footnote (w, aussage [4]) - FI. - lasse auswaehlen: - INT VAR altzeiger :: 1; - stelle erste alternative invers dar; - REP - hole eingabe; - werte eingabe aus und reagiere - UNTIL alternative gefunden PER. - stelle erste alternative invers dar: - cursor (x + einrueckbreite, y + ysize - 2); - - out (mark ein); - out (altliste [altzeiger].alternat); out (blank); - out (mark aus); - cursor (x + einrueckbreite, y + ysize - 2). - hole eingabe: - TEXT VAR moegliche, eingabe; - IF mit abbruch - THEN moegliche := rechts links esc return + sonst - ELSE moegliche := rechts links null return + sonst - FI; - clear buffer; - REP - inchar (eingabe); - piepse bei unzulaessiger eingabe - UNTIL pos (moegliche, eingabe) > 0 PER. - piepse bei unzulaessiger eingabe: - - IF pos (moegliche, eingabe) = 0 THEN out (piep) FI. - werte eingabe aus und reagiere: - SELECT pos (moegliche, eingabe) OF - CASE 1: zur naechsten alternative - CASE 2: zur vorausgehenden alternative - CASE 3: esc kommando verarbeiten - END SELECT. - zur naechsten alternative: - loesche aktuelle alternative; - ermittle rechte alternative; - stelle neue alternative invers dar. - zur vorausgehenden alternative: - loesche aktuelle alternative; - ermittle linke alternative; - - stelle neue alternative invers dar. - loesche aktuelle alternative: - cursor (alternativenanfang - 1, y + ysize - 2); - out (blank); - out (altliste [altzeiger].alternat); - out (2 * blank). - alternativenanfang: - x + einrueckbreite + altliste [altzeiger].anfang. - ermittle rechte alternative: - IF altzeiger = altanzahl - THEN altzeiger := 1 - ELSE altzeiger INCR 1 - FI. - ermittle linke alternative: - IF altzeiger = 1 - THEN altzeiger := altanzahl - - ELSE altzeiger DECR 1 - FI. - stelle neue alternative invers dar: - cursor (alternativenanfang - 1, y + ysize - 2); - out (mark ein); - out (altliste [altzeiger].alternat); out (blank); - out (mark aus); - cursor (alternativenanfang - 1, y + ysize - 2). - esc kommando verarbeiten: - inchar (eingabe); - IF eingabe = "h" - THEN ergebnis := 0; - LEAVE schreibe alternativen - ELSE out (piep); eingabe := "" - FI. - alternative gefunden: - pos (moegliche, eingabe) > 3. - - liefere ergebnis: - IF pos (moegliche, eingabe) = 4 - THEN ergebnis := altzeiger - ELSE ergebnis := 100 + pos (sonst, eingabe) - FI. -END PROC schreibe alternativen; -BOOL PROC ja (WINDOW VAR w, TEXT CONST t, INT CONST position, - INT VAR x, y, xsize, ysize): - INT VAR ergebnis; - schreibe alternativen (w, t, aussage [7], janeintasten, position, - FALSE, x, y, xsize, ysize, ergebnis); - SELECT ergebnis OF - CASE 2, 105, 106: FALSE - OTHERWISE TRUE - - END SELECT. -END PROC ja; -TEXT PROC hole antwort (WINDOW VAR w, TEXT CONST t, vorgabe, - INT CONST position, BOOL CONST mit auswahl, - INT VAR x, y, xsize, ysize): - TEXT VAR eingabe :: compress (vorgabe); - schreibe boxtext (w, t, position, 2, length (aussage [8]) + 12, 2, - x, y, xsize, ysize); - schreibe antwortfuss; - clear buffer; - REP - IF eingabe = "break" - THEN eingabe := "" - FI; - lasse eintragen - - UNTIL eingabe <> "break" PER; - liefere ergebnis. - schreibe antwortfuss: - schreibe leerzeile; - schreibe eingabezeile; - schreibe abschlusszeile; - IF mit auswahl - THEN out footnote (w, aussage [5]) - ELSE out footnote (w, aussage [6]) - FI. - schreibe leerzeile: - cursor (x, y + ysize - 3); - out (senkrecht); - (xsize - 2) TIMESOUT blank; - out (senkrecht). - schreibe eingabezeile: - cursor (x, y + ysize - 2); - out (senkrecht); - out (aussage [8]); - - (xsize - 2 - length (aussage [8])) TIMESOUT blank; - out (senkrecht). - schreibe abschlusszeile: - cursor (x, y + ysize - 1); - out (ecke unten links); - (xsize - 2) TIMESOUT waagerecht; - out (ecke unten rechts). - lasse eintragen: - TEXT VAR exit :: ""; - cursor on; - cursor (x + length (aussage [8]) + 1, y + ysize - 2); - IF mit auswahl - THEN editget (eingabe, maxtextlength, textlaenge, "", "hz", exit) - ELSE editget (eingabe, maxtextlength, textlaenge, "", "h", exit) - - FI; - cursor off; - IF exit = ""27"h" - THEN eingabe := "" - ELIF mit auswahl AND (exit = ""27"z") - THEN eingabe := ""27"z" - ELSE eingabe := compress (eingabe) - FI. - textlaenge: - xsize - 2 - length (aussage [8]). - liefere ergebnis: - eingabe. -END PROC hole antwort; -END PACKET ls dialog 4; - - diff --git a/dialog/ls-DIALOG 5 b/dialog/ls-DIALOG 5 deleted file mode 100644 index 9902098..0000000 --- a/dialog/ls-DIALOG 5 +++ /dev/null @@ -1,1412 +0,0 @@ -(* - - ********************************************************* - ********************************************************* - ** ** - ** ls-DIALOG 5 ** - ** ** - ** Version 1.2 ** - ** ** - ** (Stand: 04.11.88) ** - ** ** - ** ** - ** Autor: Wolfgang Weber, Bielefeld ** - ** ** - ** ** - ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** - ** ** - ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** - ** ** - ********************************************************* - ********************************************************* - - *) - -PACKET ls dialog 5 DEFINES - menufootnote, old menufootnote, - menuinfo,menualternative, - menuyes, menuno, menuone, - menusome,menuanswer, - menuanswerone, menuanswersome, - install menu, handle menu, - refresh submenu, deactivate, - regenerate menuscreen, activate, - write menunotice, erase menunotice, - menubasistext, anwendungstext, - show menuwindow, menuwindowpage, - menuwindowout, menuwindowget, - menuwindoweditget, menuwindowedit, - - menuwindowshow, menuwindowline, - menuwindowyes, menuwindowno, - menuwindowcursor, get menuwindowcursor, - remaining menuwindowlines, - menuwindowcenter, menuwindowstop, - editorinformationen,stdinfoedit, - menukartenname, current menuwindow, - reset dialog, only intern, ausstieg, - direktstart: -LET systemkuerzel = "ls-DIALOG", - menutafeltaskname = "ls-MENUKARTEN", - menutafeltype = 1954, - menutafelpraefix = "ls-MENUKARTE:", - - stdmenukartenname = "ls-MENUKARTE:Archiv", - versionsnummer = "1.1", - copyright1 = " (C) 1987/88 Eva Latta-Weber", - copyright2 = " (C) 1988 ERGOS GmbH"; -LET maxmenus = 6, - maxmenutexte = 300, - maxinfotexte = 2000, - maxhauptmenupunkte = 10, - maxuntermenupunkte = 15, - erste untermenuzeile = 3; -LET blank = " ", - piep = ""7"", - - cleol = ""5"", - cleop = ""4"", - trennzeilensymbol = "###", - bleibt leer symbol = "***", - hauptmenuluecke = " "; -LET auswahlstring1 = ""8""2""10""3""13""27"?"; -TYPE MENUPUNKT = STRUCT (TEXT punktkuerzel, - punktname, - procname, - boxtext, - BOOL aktiv, - angewaehlt), - - EINZELMENU = STRUCT (INT belegt, - TEXT ueberschrift, - INT anfangsposition, - maxlaenge, - ROW maxuntermenupunkte MENUPUNKT menupunkt, - INT aktueller untermenupunkt, - TEXT startprozedurname, - leaveprozedurname), - MENU = STRUCT (TEXT menuname, - INT anzahl hauptmenupunkte, - - ROW maxhauptmenupunkte EINZELMENU einzelmenu, - TEXT menueingangsprozedur, - menuausgangsprozedur, - menuinfo, - lizenznummer, - versionsnummer, - INT hauptmenuzeiger, - untermenuanfang, - untermenuzeiger), - INFOTEXT = STRUCT (INT anzahl infotexte, - - ROW maxinfotexte TEXT stelle), - MENUTEXT = STRUCT (INT anzahl menutexte, - ROW maxmenutexte TEXT platz), - MENULEISTE = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund, - ROW maxmenus MENU menu, - MENUTEXT menutext, - INFOTEXT infotext); -BOUND MENULEISTE VAR menuleiste; -DATASPACE VAR ds; -WINDOW VAR menuwindow, schreibfenster, editorinfofenster; - -INITFLAG VAR in this task :: FALSE; -INT VAR anzahl offener menus :: 0; -INT VAR menunotizx, menunotizxsize, - menunotizy, menunotizysize, - menunotizposition; -TEXT VAR angekoppelte menutafel :: "", - permanent footnote :: "", - menunotiztext; -BOOL VAR menunotiz ist gesetzt :: FALSE, - nur interne verwendung :: FALSE, - mit ausstieg :: FALSE; -REAL VAR zeitpunkt :: clock (1); - -ROW 13 TEXT CONST fehlermeldung :: ROW 13 TEXT : ( -"Die Task '" + menutafeltaskname + "' existiert nicht!", -"Die Menukarte '", -"' existiert nicht in der Task '" + menutafeltaskname + "'!", -"' hat falschen Typ/Bezeichnung (keine 'MENUKARTE')!", -"Das Menu '", -"' ist nicht in der angekoppelten Menukarte!", -"Zu viele geoeffnete Menus ( > 2 )!", -"Kein Menu geoeffnet!", -"Menu enthaelt keine Menupunkte!", -"Menupunkt ist nicht im Menu enthalten!", -"Kein Text vorhanden!", -"Zugriff unmöglich!", - -"Einschränkung unzulässig!" -); -ROW 1 TEXT CONST vergleichstext :: ROW 1 TEXT : ( -"gibt es nicht" -); -ROW 3 TEXT CONST hinweis :: ROW 3 TEXT : ( -"Info:<ESC><?>/<?> Wahl:<Pfeile> Ausführen:<RETURN> Verlassen:<ESC><q>", -" Zum Weitermachen bitte irgendeine Taste tippen!", -"Bitte warten ... Ich räume auf!" -); -ROW 3 TEXT CONST infotext :: ROW 3 TEXT : ( -" Für diesen Menupunkt ist (noch) keine "13""13" Funktion eingetragen!", -" Möchten Sie dieses Menu tatsächlich verlassen", -" Leider ist zu diesem Menupunkt "13""13" kein Info - Text eingetragen!" - - ); -PROC install menu (TEXT CONST menutafelname): - installmenu (menutafelname, TRUE) -END PROC install menu; -PROC install menu (TEXT CONST menutafelname, BOOL CONST mit kennung): - TEXT VAR letzter parameter; - IF mit kennung - THEN zeige menukennung - FI; - initialisiere menu ggf; - IF menutafel noch nicht angekoppelt - THEN letzter parameter := std; - hole menutafel; - kopple menutafel an; - last param (letzter parameter) - FI. - initialisiere menu ggf: - - IF NOT initialized (in this task) - THEN angekoppelte menutafel := ""; - anzahl offener menus := 0; - menunotiz ist gesetzt := FALSE; - nur interne verwendung := FALSE - FI. - menutafel noch nicht angekoppelt: - menutafelname <> angekoppelte menutafel. - hole menutafel: - IF NOT exists task (menutafeltaskname) - THEN bereinige situation; cursor on; - errorstop (fehlermeldung [1]) - FI; - disable stop; - fetch (menutafelname, /menutafeltaskname); - - IF is error AND pos (errormessage, vergleichstext [1]) > 0 - THEN clear error; enable stop; - bereinige situation; cursor on; - errorstop (fehlermeldung [2] + menutafelname + - fehlermeldung [3]) - ELIF is error - THEN clear error; enable stop; - bereinige situation; cursor on; - errorstop (errormessage) - ELSE enable stop - FI. - kopple menutafel an: - IF type (old (menutafelname)) = menutafeltype - - AND pos (menutafelname,menutafelpraefix) = 1 - THEN forget (ds); - ds := old (menutafelname); - menuleiste := ds; - angekoppelte menutafel := menutafelname; - forget (menutafelname, quiet) - ELSE bereinige situation; cursor on; - errorstop ("'" + menutafelname + fehlermeldung [4]) - FI. -END PROC install menu; -PROC only intern (BOOL CONST wert): - nur interne verwendung := wert -END PROC only intern; - -PROC ausstieg (BOOL CONST wert): - mit ausstieg := wert -END PROC ausstieg; -TEXT PROC menukartenname: - IF NOT initialized (in this task) - THEN angekoppelte menutafel := ""; - anzahl offener menus := 0; - menunotiz ist gesetzt := FALSE; - FI; - angekoppelte menutafel -END PROC menukartenname; -PROC handle menu (TEXT CONST menuname): - nur interne verwendung := FALSE; - mit ausstieg := TRUE; - handle menu (menuname, "") -END PROC handle menu; - -PROC handle menu (TEXT CONST menuname, ausstiegsproc): - cursor off; - IF nur interne verwendung - THEN oeffne menu (menuname) - ELSE biete menu an - FI; - lasse menupunkte auswaehlen; - IF nur interne verwendung - THEN do (ausstiegsproc); - anzahl offener menus DECR 1; - IF anzahl offener menus < 1 THEN erase menunotice FI; - menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund; - menuwindow := window (1,1,79, 24); - nur interne verwendung := FALSE; - - mit ausstieg := TRUE; - cursor on - ELSE schliesse menu; - leere ggf den bildschirm - FI. - biete menu an: - REAL VAR zwischenzeit :: clock (1) - zeitpunkt; - IF zwischenzeit < 2.0 - THEN pause (20 - int (10.0 * zwischenzeit)) - FI; - oeffne menu (menuname). - leere ggf den bildschirm: - IF anzahl offener menus < 1 - THEN erase menunotice; - page; cursor on - FI. - lasse menupunkte auswaehlen: - TEXT VAR kuerzelkette :: ""; - - starte aktuelle untermenuoperationen; - REP - cursor in warteposition; - ermittle aktuelle kuerzelkette; - nimm zeichen auf; - interpretiere zeichen; - UNTIL menu verlassen gewuenscht PER. - nimm zeichen auf: - TEXT CONST erlaubte zeichen ::auswahlstring1 + kuerzelkette; - TEXT VAR eingabezeichen; - INT VAR zeichenposition; - REP - inchar (eingabezeichen); - zeichenposition := pos (erlaubte zeichen, eingabezeichen); - piepse ggf - UNTIL zeichenposition > 0 PER. - - piepse ggf: - IF zeichenposition = 0 THEN out (piep) FI. - menu verlassen gewuenscht: - zeichenposition = 6 AND (zweites zeichen = "q"). - interpretiere zeichen: - SELECT zeichenposition OF - CASE 1: gehe einen hauptmenupunkt nach links - CASE 2: gehe einen hauptmenupunkt nach rechts - CASE 3: gehe einen untermenupunkt nach unten - CASE 4: gehe einen untermenupunkt nach oben - CASE 5: fuehre aktuellen menupunkt aus - CASE 6: hole esc sequenz - CASE 7: zeige erklaerungstext im menu an - - OTHERWISE werte kuerzeleingabe aus - END SELECT. - gehe einen hauptmenupunkt nach links: - INT VAR anzahl schritte :: 1; - beende aktuelle untermenuoperationen; - loesche aktuelles untermenu auf bildschirm; - loesche alte hauptmenumarkierung; - anzahl schritte INCR clear buffer and count (""8""); - ermittle linke menuposition; - stelle aktuellen hauptmenupunkt invers dar; - starte aktuelle untermenuoperationen; - schreibe aktuelles untermenu auf bildschirm. - gehe einen hauptmenupunkt nach rechts: - - anzahl schritte := 1; - beende aktuelle untermenuoperationen; - loesche aktuelles untermenu auf bildschirm; - loesche alte hauptmenumarkierung; - anzahl schritte INCR clear buffer and count (""2""); - ermittle rechte menuposition; - stelle aktuellen hauptmenupunkt invers dar; - starte aktuelle untermenuoperationen; - schreibe aktuelles untermenu auf bildschirm. - loesche alte hauptmenumarkierung: - erase invers (area (menuwindow), startpos, 1, ueberschriftlaenge); - - out (area (menuwindow), startpos, 1, ueberschrifttext). - startpos: - aktuelles untermenu.anfangsposition. - ueberschriftlaenge: - length (ueberschrifttext). - ueberschrifttext: - aktuelles untermenu.ueberschrift. - aktuelles untermenu: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger]. - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. - ermittle linke menuposition: - INT VAR positionszaehler; - FOR positionszaehler FROM 1 UPTO anzahl schritte REP - - drehe die menuposition um einen wert runter - PER. - ermittle rechte menuposition: - FOR positionszaehler FROM 1 UPTO anzahl schritte REP - drehe die menuposition um einen wert hoch - PER. - drehe die menuposition um einen wert runter: - IF aktuelles menu.hauptmenuzeiger > 1 - THEN aktuelles menu.hauptmenuzeiger DECR 1 - ELSE aktuelles menu.hauptmenuzeiger - := aktuelles menu.anzahl hauptmenupunkte - FI. - drehe die menuposition um einen wert hoch: - - IF aktuelles menu.hauptmenuzeiger - < aktuelles menu.anzahl hauptmenupunkte - THEN aktuelles menu.hauptmenuzeiger INCR 1 - ELSE aktuelles menu.hauptmenuzeiger := 1 - FI. - gehe einen untermenupunkt nach unten: - INT VAR naechster aktiver := folgender aktiver untermenupunkt; - nimm ummarkierung vor. - gehe einen untermenupunkt nach oben: - naechster aktiver := vorausgehender aktiver untermenupunkt; - nimm ummarkierung vor. - nimm ummarkierung vor: - IF ueberhaupt aktive menupunkte vorhanden - - THEN demarkiere aktuellen untermenupunkt; - gehe zum folgenden untermenupunkt; - markiere aktuellen untermenupunkt - FI. - ueberhaupt aktive menupunkte vorhanden: - (aktuelles untermenu.belegt > 0) CAND (naechster aktiver > 0). - gehe zum folgenden untermenupunkt: - aktuelles menu.untermenuzeiger := naechster aktiver. - stelle aktuellen hauptmenupunkt invers dar: - out invers (area (menuwindow), startpos, 1, ueberschrifttext). - fuehre aktuellen menupunkt aus: - - IF nur interne verwendung AND mit ausstieg - THEN kennzeichne als angetickt; - disable stop; - do (ausstiegsproc); - do (menuanweisung); - aktueller menupunkt.angewaehlt := FALSE; - IF is error THEN put error; clear error FI; - enable stop; - anzahl offener menus DECR 1; - menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund; - menuwindow := window (1,1,79, 24); - nur interne verwendung := FALSE; - - cursor on; - LEAVE handle menu - ELSE kennzeichne als angetickt; - fuehre operation aus (menuanweisung); - nimm kennzeichnung zurueck - FI. - kennzeichne als angetickt: - aktueller menupunkt.angewaehlt := TRUE; - markiere aktuellen untermenupunkt. - nimm kennzeichnung zurueck: - aktueller menupunkt.angewaehlt := FALSE; - markiere aktuellen untermenupunkt. - menuanweisung: - compress (aktueller menupunkt.procname). - aktueller menupunkt: - - aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger]. - hole esc sequenz: - TEXT VAR zweites zeichen; - inchar (zweites zeichen); - SELECT pos ("q?$", zweites zeichen) OF - CASE 1: erfrage abbruch - CASE 2: zeige menubedienhinweise - CASE 3: gib info aus - OTHERWISE out (piep) - END SELECT. - erfrage abbruch: - IF menuno (infotext [2], 5) - THEN zweites zeichen := "n" (* gleichgültig, nur nicht 'q' *) - FI. - zeige menubedienhinweise: - - INT VAR gewaehlt; - REP - gewaehlt := menualternative ( alttext, altwahl, altzusatz, 5, FALSE); - erfuelle den wunsch - UNTIL ausstieg aus bedienhinweisen gewuenscht PER. - alttext: - menuleiste.menutext.platz [1]. - altwahl: - menuleiste.menutext.platz [2]. - altzusatz: - menuleiste.menutext.platz [3]. - erfuelle den wunsch: - SELECT gewaehlt OF - CASE 1,101,106: menuinfo (menuleiste.menutext.platz [4], 5, maxint) - CASE 2,102,107: menuinfo (menuleiste.menutext.platz [5], 5, maxint) - - CASE 3,103,108: menuinfo (menuleiste.menutext.platz [6], 5, maxint) - CASE 4,104,109: menuinfo (menuleiste.menutext.platz [7], 5, maxint) - END SELECT. - ausstieg aus bedienhinweisen gewuenscht: - gewaehlt = 5 OR gewaehlt = 105 OR gewaehlt = 110. - gib info aus: - menuinfo (menuleiste.menutext.platz [20]). - zeige erklaerungstext im menu an: - IF compress (erklaerungstext) = "" - THEN menuinfo (infotext [3]) - ELSE menuinfo (erklaerungstext) - FI. - erklaerungstext: - - aktueller menupunkt.boxtext. - werte kuerzeleingabe aus: - naechster aktiver := pos (kuerzelkette, eingabezeichen); - nimm ummarkierung vor; - fuehre aktuellen menupunkt aus. - starte aktuelle untermenuoperationen: - ermittle aktuelle kuerzelkette; - IF startoperation <> "" - THEN fuehre operation aus (startoperation) - FI. - startoperation: - compress (aktuelles untermenu.startprozedurname). - ermittle aktuelle kuerzelkette: - kuerzelkette := ""; - INT VAR kuerzelzeiger; - - FOR kuerzelzeiger FROM 1 UPTO aktuelles untermenu.belegt REP - IF compress (aktuelles punktkuerzel) = "" - THEN kuerzelkette CAT ""0"" { beliebiger Code der Länge 1 } - ELSE haenge ggf kuerzel an - FI - PER. - aktuelles punktkuerzel: - aktuelles untermenu.menupunkt [kuerzelzeiger].punktkuerzel. - haenge ggf kuerzel an: - IF betrachteter punkt ist aktiv - THEN kuerzelkette CAT aktuelles punktkuerzel - ELSE kuerzelkette CAT ""0"" - FI. - betrachteter punkt ist aktiv: - - aktuelles untermenu.menupunkt [kuerzelzeiger].aktiv. - beende aktuelle untermenuoperationen: - kuerzelkette := "". -END PROC handle menu; -PROC oeffne menu (TEXT CONST menuname): - cursor off; - suche eingestelltes menu; - IF menu existiert nicht - THEN cursor on; - page; - errorstop (fehlermeldung [5] + menuname + fehlermeldung [6]) - FI; - anzahl offener menus INCR 1; - ggf neue seite aufschlagen; - ueberpruefe anzahl offener menus; - lege ggf aktuelles menu auf eis; - - initialisiere den menubildschirm; - IF NOT nur interne verwendung - THEN aktuelles menu.hauptmenuzeiger := 1; - aktuelles menu.untermenuzeiger := 0; - aktuelles menu.untermenuanfang := 0; - FI; - show menu; - fuehre ggf menueingangsprozedur aus; - zeige ggf menukenndaten an. - suche eingestelltes menu: - INT VAR i, suchzeiger; - BOOL VAR gefunden :: FALSE; - FOR i FROM 1 UPTO menuleiste.belegt REP - IF menuleiste.menu [i].menuname = menuname - - THEN gefunden := TRUE; - suchzeiger := i; - FI - UNTIL menuleiste.menu [i].menuname = menuname PER. - menu existiert nicht: - NOT gefunden. - ueberpruefe anzahl offener menus: - IF anzahl offener menus > 2 - THEN anzahl offener menus := 0; cursor on; - errorstop (fehlermeldung [7]) - FI. - lege ggf aktuelles menu auf eis: - IF anzahl offener menus = 2 - THEN menuleiste.zeigerhintergrund := menuleiste.zeigeraktuell - FI; - menuleiste.zeigeraktuell := suchzeiger. - - initialisiere den menubildschirm: - IF anzahl offener menus = 2 - THEN menuwindow := window (6, 4, 73, 20) - ELSE menuwindow := window (1, 1, 79, 24); - FI. - fuehre ggf menueingangsprozedur aus: - IF aktuelles menu.menueingangsprozedur <> "" - THEN fuehre operation aus (aktuelles menu.menueingangsprozedur) - FI. - ggf neue seite aufschlagen: - IF anzahl offener menus = 1 THEN page FI. - zeige ggf menukenndaten an: - IF anzahl offener menus = 1 AND aktuelles menu.menuinfo <> bleibt leer symbol - - THEN write menunotice (vollstaendiger infotext, 4); - pause (100); - erase menunotice - FI. - vollstaendiger infotext: - aktuelles menu.menuinfo + - aktuelles menu.lizenznummer + - aktuelles menu.versionsnummer. - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. -END PROC oeffne menu; -PROC show menu: - ueberpruefe menudaten; - stelle hauptmenuleiste zusammen; - zeige hauptmenu an; - stelle aktuellen hauptmenupunkt invers dar; - schreibe aktuelles untermenu auf bildschirm; - - zeige informationszeile an. - ueberpruefe menudaten: - IF anzahl offener menus = 0 - THEN errorstop (fehlermeldung [8]) - ELIF aktuelles menu.anzahl hauptmenupunkte < 1 - THEN errorstop (fehlermeldung [9]) - FI. - stelle hauptmenuleiste zusammen: - TEXT VAR hauptmenuzeile :: ""; - INT VAR zeiger; - hauptmenuzeile CAT aktuelles menu.menuname; - hauptmenuzeile CAT ":"; - FOR zeiger FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP - haenge hauptmenupunkt an - - PER. - haenge hauptmenupunkt an: - hauptmenuzeile CAT hauptmenuluecke; - hauptmenuzeile CAT hauptmenupunktname. - hauptmenupunktname: - aktuelles menu.einzelmenu [zeiger].ueberschrift. - zeige hauptmenu an: - page (menuwindow, TRUE); - out menuframe (area (menuwindow)); - cursor (menuwindow, 1, 1); - out (menuwindow, hauptmenuzeile). - stelle aktuellen hauptmenupunkt invers dar: - cursor (menuwindow, startposition, 1); - out (menuwindow, invers (ueberschrifttext)). - - startposition: - aktuelles untermenu.anfangsposition - 1. - ueberschrifttext: - aktuelles untermenu.ueberschrift. - zeige informationszeile an: - write permanent footnote (hinweis [1]). - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. - aktuelles untermenu: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger]. -END PROC show menu; -PROC schreibe aktuelles untermenu auf bildschirm: - ermittle linke obere ecke des untermenukastens; - wirf untermenu aus; - - show menunotice; - cursor in warteposition. - ermittle linke obere ecke des untermenukastens: - aktuelles menu.untermenuanfang := menumitte - halbe menubreite; - achte auf randextrema. - menumitte: - startposition + (length (ueberschrifttext) DIV 2) - 1. - startposition: - aktuelles untermenu.anfangsposition. - ueberschrifttext: - aktuelles untermenu.ueberschrift. - halbe menubreite: - aktuelles untermenu.maxlaenge DIV 2. - achte auf randextrema: - gleiche ggf linken rand aus; - - gleiche ggf rechten rand aus. - gleiche ggf linken rand aus: - IF aktuelles menu.untermenuanfang < 4 - THEN aktuelles menu.untermenuanfang := 4 - FI. - gleiche ggf rechten rand aus: - IF (aktuelles menu.untermenuanfang + aktuelles untermenu.maxlaenge) > - (areaxsize (menuwindow) - 3) - THEN aktuelles menu.untermenuanfang - := areaxsize (menuwindow) - aktuelles untermenu.maxlaenge - 3 - FI. - wirf untermenu aus: - IF aktuelles menu.untermenuzeiger = 0 - - THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt - FI; - wirf untermenukopfzeile aus; - wirf untermenurumpf aus; - wirf untermenufusszeile aus; - markiere aktuellen untermenupunkt. - wirf untermenukopfzeile aus: - cursor (menuwindow, spalte, anfangszeile); - out (balken oben); striche; out (balken oben). - wirf untermenufusszeile aus: - cursor (menuwindow, spalte, endezeile); - out (ecke unten links); striche; out (ecke unten rechts). - spalte: - - aktuelles menu.untermenuanfang - 3. - anfangszeile: - erste untermenuzeile - 1. - endezeile: - erste untermenuzeile + aktuelles untermenu.belegt. - striche: - (aktuelles untermenu.maxlaenge + 5) TIMESOUT waagerecht. - wirf untermenurumpf aus: - INT VAR laufvar; - INT CONST aktuelle punktlaenge :: aktuelles untermenu.maxlaenge + 1; - FOR laufvar FROM 1 UPTO aktuelles untermenu.belegt REP - wirf eine einzelne menuzeile aus - PER. - wirf eine einzelne menuzeile aus: - - out with beam (area (menuwindow), menuspalte, menuzeile, - aktueller punktname, laenge). - menuspalte: - aktuelles menu.untermenuanfang. - menuzeile: - erste untermenuzeile + laufvar - 1. - aktueller punktname: - untermenubezeichnung (laufvar). - laenge: - aktuelle punktlaenge. - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. - aktuelles untermenu: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger]. -END PROC schreibe aktuelles untermenu auf bildschirm; - -PROC loesche aktuelles untermenu auf bildschirm: - beende aktuelle untermenuoperationen; - loesche untermenu auf bildschirm; - schreibe balken wieder hin; - aktuelles menu.untermenuzeiger := 1. - beende aktuelle untermenuoperationen: - IF leaveoperation <> "" - THEN fuehre operation aus (leaveoperation) - FI. - leaveoperation: - compress (aktuelles untermenu.leaveprozedurname). - loesche untermenu auf bildschirm: - INT VAR laufvar; - FOR laufvar FROM aktuelles untermenu.belegt + 1 DOWNTO 1 REP - - loesche eine einzelne menuzeile - PER. - loesche eine einzelne menuzeile: - erase with beam (area (menuwindow), menuspalte, menuzeile, laenge). - menuspalte: - aktuelles menu.untermenuanfang. - menuzeile: - erste untermenuzeile + laufvar - 1. - laenge: - aktuelles untermenu.maxlaenge + 1. - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. - aktuelles untermenu: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger]. - schreibe balken wieder hin: - - cursor (menuwindow, spalte, anfangszeile); - (aktuelles untermenu.maxlaenge + 7) TIMESOUT waagerecht. - spalte: - aktuelles menu.untermenuanfang - 3. - anfangszeile: - erste untermenuzeile - 1. -END PROC loesche aktuelles untermenu auf bildschirm; -PROC markiere aktuellen untermenupunkt: - IF aktuelles menu.untermenuzeiger <> 0 - THEN laufe ggf zum naechsten aktiven menupunkt; - out invers with beam (area (menuwindow), menuspalte, menuzeile, - aktueller punktname, laenge) - - FI. - laufe ggf zum naechsten aktiven menupunkt: - IF NOT aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].aktiv - THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt - FI. - menuspalte: - aktuelles menu.untermenuanfang. - menuzeile: - erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger. - aktueller punktname: - untermenubezeichnung (aktuelles menu.untermenuzeiger). - laenge: - aktuelles untermenu.maxlaenge + 1. - aktuelles menu: - - menuleiste.menu [menuleiste.zeigeraktuell]. - aktuelles untermenu: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger]. -END PROC markiere aktuellen untermenupunkt; -PROC demarkiere aktuellen untermenupunkt: - IF aktuelles menu.untermenuzeiger <> 0 - THEN erase invers (area (menuwindow), menuspalte, menuzeile, laenge); - out (area (menuwindow), menuspalte, menuzeile, - aktueller punktname, laenge) - FI. - menuspalte: - aktuelles menu.untermenuanfang. - - menuzeile: - erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger. - aktueller punktname: - untermenubezeichnung (aktuelles menu.untermenuzeiger). - laenge: - aktuelles untermenu.maxlaenge + 1. - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. - aktuelles untermenu: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger]. -END PROC demarkiere aktuellen untermenupunkt; -INT PROC folgender aktiver untermenupunkt: - INT VAR anzahl aktiver menupunkte :: 0; - - untersuche anzahl aktiver menupunkte; - IF kein aktiver menupunkt vorhanden - THEN 0 - ELIF nur ein aktiver menupunkt vorhanden - THEN liefere einzigen aktiven menupunkt - ELSE liefere naechsten aktiven menupunkt - FI. - untersuche anzahl aktiver menupunkte: - INT VAR zaehler, position; - FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP - IF aktuelles untermenu.menupunkt [zaehler].aktiv - THEN anzahl aktiver menupunkte INCR 1; - position := zaehler - - FI - UNTIL anzahl aktiver menupunkte > 1 PER. - kein aktiver menupunkt vorhanden: - anzahl aktiver menupunkte = 0. - nur ein aktiver menupunkt vorhanden: - anzahl aktiver menupunkte = 1. - liefere einzigen aktiven menupunkt: - position. - liefere naechsten aktiven menupunkt: - INT VAR interner zeiger; - stelle internen zeiger auf den naechsten menupunkt; - WHILE NOT punkt ist aktiv REP - untersuche naechsten menupunkt - PER; - ergebnis. - stelle internen zeiger auf den naechsten menupunkt: - - IF aktuelles menu.untermenuzeiger = letzter untermenupunkt - THEN interner zeiger := 1 - ELSE interner zeiger := aktuelles menu.untermenuzeiger + 1 - FI. - letzter untermenupunkt: - aktuelles untermenu.belegt. - punkt ist aktiv: - aktuelles untermenu.menupunkt [interner zeiger].aktiv. - untersuche naechsten menupunkt: - IF interner zeiger = letzter untermenupunkt - THEN interner zeiger := 1 - ELSE interner zeiger INCR 1 - FI. - - ergebnis: - interner zeiger. - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. - aktuelles untermenu: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger]. -END PROC folgender aktiver untermenupunkt; -INT PROC vorausgehender aktiver untermenupunkt: - INT VAR anzahl aktiver menupunkte :: 0; - untersuche anzahl aktiver menupunkte; - IF kein aktiver menupunkt vorhanden - THEN 0 - ELIF nur ein aktiver menupunkt vorhanden - THEN liefere einzigen aktiven menupunkt - - ELSE liefere vorausgehenden aktiven menupunkt - FI. - untersuche anzahl aktiver menupunkte: - INT VAR zaehler, position; - FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP - IF aktuelles untermenu.menupunkt [zaehler].aktiv - THEN anzahl aktiver menupunkte INCR 1; - position := zaehler - FI - UNTIL anzahl aktiver menupunkte > 1 PER. - kein aktiver menupunkt vorhanden: - anzahl aktiver menupunkte = 0. - nur ein aktiver menupunkt vorhanden: - anzahl aktiver menupunkte = 1. - - liefere einzigen aktiven menupunkt: - position. - liefere vorausgehenden aktiven menupunkt: - INT VAR interner zeiger; - stelle internen zeiger auf vorausgehenden menupunkt; - WHILE NOT punkt ist aktiv REP - untersuche vorausgehenden menupunkt - PER; - ergebnis. - stelle internen zeiger auf vorausgehenden menupunkt: - IF aktuelles menu.untermenuzeiger <= 1 - THEN interner zeiger := letzter untermenupunkt - ELSE interner zeiger := aktuelles menu.untermenuzeiger - 1 - - FI. - letzter untermenupunkt: - aktuelles untermenu.belegt. - punkt ist aktiv: - aktuelles untermenu.menupunkt [interner zeiger].aktiv. - untersuche vorausgehenden menupunkt: - IF interner zeiger = 1 - THEN interner zeiger := letzter untermenupunkt - ELSE interner zeiger DECR 1 - FI. - ergebnis: - interner zeiger. - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. - aktuelles untermenu: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger]. - -END PROC vorausgehender aktiver untermenupunkt; -PROC cursor in warteposition: - cursor (areax (menuwindow), areay (menuwindow) + 1) -END PROC cursor in warteposition; -TEXT PROC untermenubezeichnung (INT CONST position): - TEXT VAR bezeichnung :: ""; - bezeichnung CAT kennzeichnung; - bezeichnung CAT punktkennung; - bezeichnung. - kennzeichnung: - IF aktueller menupunkt.aktiv - AND aktueller menupunkt.angewaehlt - THEN "*" - ELIF aktueller menupunkt.aktiv - - AND aktueller menupunkt.punktkuerzel <> "" - THEN aktueller menupunkt.punktkuerzel - ELIF aktueller menupunkt.aktiv - AND aktueller menupunkt.punktkuerzel = "" - THEN blank - ELSE "-" - FI. - punktkennung: - IF menupunkt ist trennzeile - THEN strichellinie - ELSE aktueller menupunkt.punktname - FI. - menupunkt ist trennzeile: - aktueller menupunkt.punktname = (blank + trennzeilensymbol). - strichellinie: - - (aktuelles untermenu.maxlaenge + 1) * "-". - aktueller menupunkt: - aktuelles untermenu.menupunkt [position]. - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. - aktuelles untermenu: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger]. -END PROC untermenubezeichnung; -PROC fuehre operation aus (TEXT CONST operation): - disable stop; - IF operation = "" - THEN menuinfo (infotext [1]); - LEAVE fuehre operation aus - FI; - do (operation); - - IF is error - THEN menuinfo (errormessage, 5); - clear error - FI; - old menufootnote; - enable stop; - cursor off -END PROC fuehre operation aus; -PROC veraendere aktivierung (TEXT CONST unterpunkt, BOOL CONST eintrag): - INT VAR unterpunktposition :: 0, zeiger; - suche unterpunkt; - aendere aktivierung. - suche unterpunkt: - FOR zeiger FROM 1 UPTO untermenuende REP - IF untermenupunkt = blank + compress (unterpunkt) - THEN unterpunktposition := zeiger; - LEAVE suche unterpunkt - - FI - PER; - LEAVE veraendere aktivierung. - untermenuende: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt. - untermenupunkt: - aktuelles untermenu.menupunkt [zeiger].punktname. - aendere aktivierung: - aktuelles untermenu.menupunkt [unterpunktposition].aktiv := eintrag. - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. - aktuelles untermenu: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger]. -END PROC veraendere aktivierung; - -PROC veraendere aktivierung (INT CONST punktnummer, BOOL CONST eintrag): - IF punktnummer >= 1 AND punktnummer <= untermenuende - THEN aktuelles untermenu.menupunkt [punktnummer].aktiv := eintrag - FI. - untermenuende: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt. - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. - aktuelles untermenu: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger]. -END PROC veraendere aktivierung; -PROC veraendere anwahl (TEXT CONST unterpunkt, BOOL CONST eintrag): - - INT VAR unterpunktposition :: 0, zeiger; - suche unterpunkt; - aendere anwahl. - suche unterpunkt: - FOR zeiger FROM 1 UPTO untermenuende REP - IF untermenupunkt = blank + compress (unterpunkt) - THEN unterpunktposition := zeiger; - LEAVE suche unterpunkt - FI - PER; - enable stop; - errorstop (fehlermeldung [10]). - untermenuende: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt. - untermenupunkt: - aktuelles untermenu.menupunkt [zeiger].punktname. - - aendere anwahl: - aktuelles untermenu.menupunkt [unterpunktposition].angewaehlt := eintrag. - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. - aktuelles untermenu: - aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger]. -END PROC veraendere anwahl; -PROC activate (TEXT CONST unterpunkt): - enable stop; - veraendere aktivierung (unterpunkt, TRUE) -END PROC activate; -PROC activate (INT CONST punktnummer): - enable stop; - veraendere aktivierung (punktnummer, TRUE) - -END PROC activate; -PROC deactivate (TEXT CONST unterpunkt): - enable stop; - veraendere aktivierung (unterpunkt, FALSE) -END PROC deactivate; -PROC deactivate (INT CONST punktnummer): - enable stop; - veraendere aktivierung (punktnummer, FALSE) -END PROC deactivate; -PROC select (TEXT CONST unterpunkt): - enable stop; - veraendere anwahl (unterpunkt, TRUE) -END PROC select; -PROC deselect (TEXT CONST unterpunkt): - enable stop; - veraendere anwahl (unterpunkt, FALSE) -END PROC deselect; - -PROC schliesse menu: - IF aktuelles menu.menuausgangsprozedur <> "" - THEN menufootnote (hinweis [3]); - fuehre operation aus (aktuelles menu.menuausgangsprozedur) - FI; - anzahl offener menus DECR 1; - IF anzahl offener menus = 1 - THEN aktiviere das auf eis gelegte menu - FI. - aktiviere das auf eis gelegte menu: - menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund; - menuwindow := window (1, 1, 79, 24); - show menu. - aktuelles menu: - menuleiste.menu [menuleiste.zeigeraktuell]. - -END PROC schliesse menu; -PROC refresh submenu: - schreibe aktuelles untermenu auf bildschirm; - show menunotice; -END PROC refresh submenu; -PROC regenerate menuscreen: - IF anzahl offener menus = 0 - THEN errorstop (fehlermeldung [8]) - ELIF anzahl offener menus = 1 - THEN page; - show menu; - show menunotice - ELSE zeige erstes menu an; - zeige zweites menu an; - show menunotice - FI. - zeige erstes menu an: - INT VAR menuzeiger :: menuleiste.zeigeraktuell; - - menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund; - menuwindow := window (1, 1, 79, 24); - anzahl offener menus := 1; - show menu. - zeige zweites menu an: - menuleiste.zeigeraktuell := menuzeiger; - menuwindow := window (6, 4, 73, 20); - anzahl offener menus := 2; - show menu. -END PROC regenerate menuscreen; -PROC menuinfo (TEXT CONST t, INT CONST position, timelimit): - boxinfo (menuwindow, t, position, timelimit, FALSE); - schreibe aktuelles untermenu auf bildschirm; - - old menufootnote -END PROC menuinfo; -PROC menuinfo (TEXT CONST t, INT CONST position): - menuinfo (t, position, maxint) -END PROC menuinfo; -PROC menuinfo (TEXT CONST t): - menuinfo (t, 5, maxint) -END PROC menuinfo; -INT PROC menualternative (TEXT CONST t, auswahlliste, zusatztasten, - INT CONST position, BOOL CONST mit abbruch): - INT VAR ergebnis := boxalternative (menuwindow, t, auswahlliste, - zusatztasten, position, mit abbruch, FALSE); - - schreibe aktuelles untermenu auf bildschirm; - old menufootnote; - ergebnis -END PROC menualternative; -BOOL PROC menuyes (TEXT CONST frage, INT CONST position): - BOOL VAR wert := boxyes (menuwindow, frage, position, FALSE); - schreibe aktuelles untermenu auf bildschirm; - old menufootnote; - wert -END PROC menuyes; -BOOL PROC menuno (TEXT CONST frage, INT CONST position): - NOT menuyes (frage, position) -END PROC menuno; -TEXT PROC menuone (THESAURUS CONST thes, TEXT CONST t1, t2, - BOOL CONST mit reinigung): - - TEXT CONST wert :: boxone (menuwindow, thes, t1, t2, mit reinigung); - IF mit reinigung - THEN schreibe aktuelles untermenu auf bildschirm; - old menufootnote - FI; - wert -END PROC menuone; -THESAURUS PROC menusome (THESAURUS CONST thes, TEXT CONST t1, t2, - BOOL CONST mit reinigung): - THESAURUS CONST thesaurus :: boxsome (menuwindow, thes, t1, t2, - mit reinigung); - IF mit reinigung - THEN schreibe aktuelles untermenu auf bildschirm; - - old menufootnote - FI; - thesaurus -END PROC menusome; -TEXT PROC menuanswer (TEXT CONST t, vorgabe, INT CONST position): - TEXT VAR wert :: boxanswer (menuwindow, t, vorgabe, position, FALSE); - schreibe aktuelles untermenu auf bildschirm; - old menufootnote; - wert -END PROC menuanswer; -TEXT PROC menuanswerone (TEXT CONST t, vorgabe, THESAURUS CONST thes, - TEXT CONST t1, t2, BOOL CONST mit reinigung): - TEXT VAR wert :: boxanswerone (menuwindow, t, vorgabe, thes, t1, t2, - - mit reinigung, FALSE) - IF mit reinigung - THEN schreibe aktuelles untermenu auf bildschirm; - old menufootnote - FI; - wert -END PROC menuanswer one; -THESAURUS PROC menuanswersome (TEXT CONST t, vorgabe, THESAURUS CONST thes, - TEXT CONST t1, t2, BOOL CONST mit reinigung): - THESAURUS VAR wert :: boxanswersome (menuwindow, t, vorgabe, - thes, t1, t2, mit reinigung, FALSE) - - IF mit reinigung - THEN schreibe aktuelles untermenu auf bildschirm; - old menufootnote - FI; - wert -END PROC menuanswersome; -PROC menufootnote (TEXT CONST t): - cursor (menuwindow, 1, areaysize (menuwindow) - 1); - areaxsize (menuwindow) TIMESOUT waagerecht; - cursor (menuwindow, 1, areaysize (menuwindow)); - outtext (t, 1, areaxsize (menuwindow)) -END PROC menufootnote; -PROC old menufootnote: - menufootnote (permanent footnote) -END PROC old menufootnote; -TEXT PROC menubasistext (INT CONST nummer): - - IF nummer <= 20 - THEN fehlermeldung [12] - ELIF nummer > menuleiste.menutext.anzahl menutexte - THEN fehlermeldung [11] - ELSE menuleiste.menutext.platz [nummer] - FI -END PROC menubasistext; -TEXT PROC anwendungstext (INT CONST nummer): - IF nummer > menuleiste.infotext.anzahl infotexte - THEN fehlermeldung [11] - ELSE menuleiste.infotext.stelle [nummer] - FI -END PROC anwendungstext; -PROC zeige menukennung: - IF anzahl offener menus = 0 - THEN zeige angaben und emblem; - - FI. - zeige angaben und emblem: - ROW 5 WINDOW VAR w; - w [ 1] := window (40, 3, 30, 9); - w [ 2] := window (36, 5, 30, 9); - w [ 3] := window (30, 7, 30, 9); - w [ 4] := window (22, 9, 30, 9); - w [ 5] := window (12, 11, 30, 9); - page; - show (w [1]); out (w [1], center (w [1], invers (systemkuerzel))); - show (w [2]); out (w [2], " Version " + versionsnummer); - show (w [3]); out (w [3], copyright1); - show (w [4]); out (w [4], copyright2); - show (w [5]); - - cursor (w [5], 1, 2);out (w [5], " lll sssssssss "); - cursor (w [5], 1, 3);out (w [5], " lll sss sss "); - cursor (w [5], 1, 4);out (w [5], " lll sss "); - cursor (w [5], 1, 5);out (w [5], " lll sssssssss "); - cursor (w [5], 1, 6);out (w [5], " lll sss "); - cursor (w [5], 1, 7);out (w [5], " lll latta soft sss "); - cursor (w [5], 1, 8);out (w [5], " lllllllll sssssssss "); - cursor (79, 24); - - zeitpunkt := clock (1); -END PROC zeige menukennung; -PROC reset dialog: - angekoppelte menutafel := ""; - anzahl offener menus := 0 -END PROC reset dialog; -PROC write permanent footnote (TEXT CONST t): - permanent footnote := t; - cursor (menuwindow, 1, areaysize (menuwindow)); - outtext (t, 1, areaxsize (menuwindow)) -END PROC write permanent footnote; -PROC write menunotice (TEXT CONST t, INT CONST position): - erase menunotice; - boxnotice (menuwindow, t, position, menunotizx, menunotizy, - - menunotizxsize, menunotizysize); - menunotiztext := t; - menunotizposition := position; - menunotiz ist gesetzt := TRUE -END PROC write menunotice; -PROC show menunotice: - IF menunotiz ist gesetzt - THEN boxnotice (menuwindow, menunotiztext, menunotizposition, - menunotizx, menunotizy, menunotizxsize, menunotizysize); - FI -END PROC show menunotice; -PROC erase menunotice: - INT VAR spa, zei; - get cursor (spa, zei); - - IF menunotiz ist gesetzt - THEN page up (menunotizx, menunotizy, menunotizxsize, menunotizysize); - menunotiz ist gesetzt := FALSE; - cursor (spa, zei) - FI -END PROC erase menunotice; -PROC initialize menuwindow: - schreibfenster := window (areax (menuwindow) + 1, - areay (menuwindow) + 3, - areaxsize (menuwindow) - 2, - areaysize (menuwindow) - 4) -END PROC initialize menuwindow; - -PROC show menuwindow: - initialize menuwindow; - show (schreibfenster); -END PROC show menuwindow; -PROC menuwindow page: - initialize menuwindow; - page (schreibfenster) -END PROC menuwindow page; -PROC menuwindowout (TEXT CONST text): - out (schreibfenster, text) -END PROC menuwindow out; -PROC menuwindowget (TEXT VAR text): - get (schreibfenster, text) -END PROC menuwindowget; -PROC menuwindoweditget (TEXT VAR text): - editget (schreibfenster, text) -END PROC menuwindoweditget; -PROC menuwindowedit (TEXT CONST dateiname): - - initialize menuwindow; - edit (schreibfenster, dateiname) -END PROC menuwindowedit; -PROC menuwindowedit (FILE VAR f): - initialize menuwindow; - edit (schreibfenster, f) -END PROC menuwindowedit; -PROC menuwindowshow (TEXT CONST dateiname): - initialize menuwindow; - show (schreibfenster, dateiname) -END PROC menuwindowshow; -PROC menuwindowshow (FILE VAR f): - initialize menuwindow; - show (schreibfenster, f) -END PROC menuwindowshow; -BOOL PROC menuwindowyes (TEXT CONST frage): - yes (schreibfenster, frage) - -END PROC menuwindowyes; -BOOL PROC menuwindowno (TEXT CONST frage): - no (schreibfenster, frage) -END PROC menuwindowno; -PROC menuwindowline: - menuwindowline (1) -END PROC menuwindowline; -PROC menuwindowline (INT CONST anzahl): - line (schreibfenster, anzahl) -END PROC menuwindowline; -PROC menuwindowcursor (INT CONST spa, zei): - cursor (schreibfenster, spa, zei) -END PROC menuwindowcursor; -PROC get menuwindowcursor (INT VAR spa, zei): - get cursor (schreibfenster, spa, zei) -END PROC get menuwindowcursor; - -INT PROC remaining menuwindowlines: - remaining lines (schreibfenster) -END PROC remaining menuwindowlines; -TEXT PROC menuwindowcenter (TEXT CONST t): - center (schreibfenster, t) -END PROC menuwindowcenter; -PROC menuwindowstop: - menuwindowstop (2) -END PROC menuwindowstop; -PROC menuwindowstop (INT CONST anzahl): - stop (schreibfenster, anzahl) -END PROC menuwindowstop; -WINDOW PROC current menuwindow: - initialize menuwindow; - schreibfenster -END PROC current menuwindow; -PROC stdinfoedit (FILE VAR f, INT CONST oberste zeile): - - IF oberste zeile < 1 OR oberste zeile > 3 - THEN errorstop (fehlermeldung [13]); - FI; - garantiere menukarte; - cursor (1, oberste zeile); out (cleop); - cursor (1, 23); out(79 * waagerecht); - cursor (1, 24); outtext (menubasistext (141), 1, 79); - editorinfofenster := window (1, oberste zeile + 1, 79, 24 - oberste zeile); - kommando auf taste legen ("?", "editorinformationen"); - command dialogue (FALSE); - cursor on; edit (f, 1, oberste zeile, 79, 23 - oberste zeile); - command dialogue (TRUE); - - kommando auf taste legen ("?", ""). - garantiere menukarte: - TEXT VAR name := compress (menukartenname); - IF name = "" - THEN install menu (stdmenukartenname, FALSE) - FI. -END PROC stdinfoedit; -PROC stdinfoedit (FILE VAR f): - stdinfoedit (f, 1) -END PROC stdinfoedit; -PROC stdinfoedit (TEXT CONST dateiname, INT CONST oberste zeile): - FILE VAR f :: sequential file (modify, dateiname); - stdinfoedit (f, oberste zeile); -END PROC stdinfoedit; -PROC stdinfoedit (TEXT CONST dateiname): - - stdinfoedit (dateiname, 1) -END PROC stdinfoedit; -PROC editorinformationen: - BOOL VAR ende gewuenscht :: FALSE; INT VAR z; - FOR z FROM startwert UPTO 22 REP - cursor (1, z); out (cleol); - PER; - REP - INT VAR erg := boxalternative (editorinfofenster, - menubasistext (149), - menubasistext (150), - menubasistext (151), - 5, FALSE, FALSE); - erfuelle den wunsch - - UNTIL ende gewuenscht PER; - cursor (2, 23); 77 TIMESOUT waagerecht; - cursor (1, 24); outtext (menubasistext (141), 1, 79). - startwert: - areay (editorinfofenster) + 1. - erfuelle den wunsch: - SELECT erg OF - CASE 1, 101, 109: boxinfo (editorinfofenster, menubasistext (142), 5, maxint, FALSE) - CASE 2, 102, 110: boxinfo (editorinfofenster, menubasistext (143), 5, maxint, FALSE) - CASE 3, 103, 111: boxinfo (editorinfofenster, menubasistext (144), 5, maxint, FALSE) - CASE 4, 104, 112: boxinfo (editorinfofenster, menubasistext (145), 5, maxint, FALSE) - - CASE 5, 105, 113: boxinfo (editorinfofenster, menubasistext (146), 5, maxint, FALSE) - CASE 6, 106, 114: boxinfo (editorinfofenster, menubasistext (147), 5, maxint, FALSE) - CASE 7, 107, 115: boxinfo (editorinfofenster, menubasistext (148), 5, maxint, FALSE) - CASE 8, 108, 116: ende gewuenscht := TRUE - OTHERWISE (*tue nichts*) - END SELECT -END PROC editorinformationen; -PROC bereinige situation: - page; - forget (ds); - reset dialog -END PROC bereinige situation; - -PROC direktstart (TEXT CONST procname, BOOL CONST autoloeschen): - TEXT VAR datname := "Selbststartergenerierungsdatei", letzter := std; - kopple archivmenukarte an; - schreibe programm; - insertiere programm; - abkoppeln. - kopple archivmenukarte an: - install menu (stdmenukartenname, FALSE). - schreibe programm: - forget (datname, quiet); - FILE VAR f :: sequential file (output, datname); - putline (f, menubasistext (191)); - putline (f, "do (""reset dialog; erase menunotice; " + procname + """);"); - - putline (f, menubasistext (192)); - IF autoloeschen - THEN putline (f, menubasistext (193)) - ELSE putline (f, menubasistext (194)) - FI; - putline (f, menubasistext (195)); - putline (f, menubasistext (196)). - insertiere programm: - TEXT VAR t := "insert (""" + datname + """)"; do (t). - abkoppeln: - forget (datname, quiet); last param (letzter); - reset dialog; - global manager. -END PROC direktstart; -END PACKET ls dialog 5; - - diff --git a/dialog/ls-DIALOG 6 b/dialog/ls-DIALOG 6 deleted file mode 100644 index 7d28f7f..0000000 --- a/dialog/ls-DIALOG 6 +++ /dev/null @@ -1,1186 +0,0 @@ -(* - - ********************************************************* - ********************************************************* - ** ** - ** ls-DIALOG 6 ** - ** Archiv-/Taskhandling ** - ** Version 1.2 ** - ** ** - ** (Stand: 04.11.88) ** - ** ** - ** ** - ** Autor: Wolfgang Weber, Bielefeld ** - ** ** - ** ** - ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** - ** ** - ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** - ** ** - ********************************************************* - ********************************************************* - - *) - -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 deleted file mode 100644 index bc43410..0000000 --- a/dialog/ls-DIALOG 7 +++ /dev/null @@ -1,460 +0,0 @@ -(* - - ********************************************************* - ********************************************************* - ** ** - ** ls-DIALOG 7 ** - ** Dateihandling ** - ** Version 1.2 ** - ** ** - ** (Stand: 04.11.88) ** - ** ** - ** ** - ** Autor: Wolfgang Weber, Bielefeld ** - ** ** - ** ** - ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** - ** ** - ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** - ** ** - ********************************************************* - ********************************************************* - - *) - -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 deleted file mode 100644 index a6fcb1f..0000000 --- a/dialog/ls-DIALOG MENUKARTEN MANAGER +++ /dev/null @@ -1,66 +0,0 @@ -(* - - ********************************************************* - ********************************************************* - ** ** - ** ls-DIALOG ** - ** MENUKARTEN-MANAGER ** - ** Version 1.2 ** - ** ** - ** (Stand: 04.11.88) ** - ** ** - ** ** - ** Autor: Wolfgang Weber, Bielefeld ** - ** ** - ** ** - ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** - ** ** - ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** - ** ** - ********************************************************* - ********************************************************* - - *) - -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 deleted file mode 100644 index 213a826..0000000 --- a/dialog/ls-DIALOG MM-gen +++ /dev/null @@ -1,50 +0,0 @@ -(* - - ********************************************************* - ********************************************************* - ** ** - ** ls-DIALOG ** - ** MENUKARTEN MANAGER ** - ** Generator-Programm ** - ** Version 1.2 ** - ** ** - ** (Stand: 04.11.88) ** - ** ** - ** Autor: Wolfgang Weber, Bielefeld ** - ** ** - ** ** - ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** - ** ** - ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** - ** ** - ********************************************************* - ********************************************************* - - *) - -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 deleted file mode 100644 index fdda0d6..0000000 --- a/dialog/ls-DIALOG decompress +++ /dev/null @@ -1,153 +0,0 @@ -(* - - ********************************************************* - ********************************************************* - ** ** - ** ls-DIALOG - DECOMPRESS ** - ** ** - ** Version 1.2 ** - ** ** - ** (Stand: 04.11.88) ** - ** ** - ** ** - ** Autor: Wolfgang Weber, Bielefeld ** - ** ** - ** ** - ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** - ** ** - ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** - ** ** - ********************************************************* - ********************************************************* - - *) -PACKET ls dialog decompress DEFINES - - komprimiere, - dekomprimiere: - -LET verweis = "Angegebene Datei existiert nicht!", - falscher typ = "Angegebenen Datei hat falschen Typ!", - filetype = 1003; - -PROC komprimiere (TEXT CONST dateiname): - INT VAR zeiger; - ueberpruefe existenz; - ueberpruefe dateityp; - initialisiere; - FOR zeiger FROM 1 UPTO 24 REP - getline (ein, eingabezeile); - putline (aus, eingabezeile); - PER; - WHILE NOT eof (ein) REP - getline (ein, eingabezeile); - zaehler INCR 1; cout (zaehler); - zwischenzeile := abgeschnitten (eingabezeile); - haenge zeilentrenner an; - haenge zwischenzeile an ausgabezeile; - schreibe ausgabezeile ggf weg - PER; - schreibe ausgabezeile weg; - mache ausgabedatei zur eingabedatei. - - ueberpruefe existenz: - IF NOT exists (dateiname) - THEN errorstop (verweis); - FI. - - ueberpruefe dateityp: - IF type (old (dateiname)) <> filetype - THEN errorstop (falscher typ) - FI. - - initialisiere: - FILE VAR ein := sequential file (input, dateiname); - FILE VAR aus := sequential file (output, "KOMPRIM"); - maxlinelength (aus, 600); - INT VAR zaehler :: 1; - TEXT VAR eingabezeile :: "", zwischenzeile :: "", ausgabezeile :: "". - - haenge zeilentrenner an: - IF zwischenzeile <> "" - THEN zwischenzeile CAT " -" - FI. - - haenge zwischenzeile an ausgabezeile: - ausgabezeile CAT zwischenzeile. - - schreibe ausgabezeile ggf weg: - IF length (ausgabezeile) > 500 - THEN schreibe ausgabezeile weg - FI. - - schreibe ausgabezeile weg: - IF ausgabezeile <> "" - THEN putline (aus, ausgabezeile); - ausgabezeile := "" - FI. - -mache ausgabedatei zur eingabedatei: - forget (dateiname, quiet); - rename ("KOMPRIM", dateiname). -END PROC komprimiere; - -TEXT PROC abgeschnitten (TEXT CONST zeile): - TEXT VAR t :: zeile; - WHILE (t SUB length (t)) = " " REP - t := subtext (t, 1, length (t) - 1) - PER; - t -END PROC abgeschnitten; - -PROC dekomprimiere (TEXT CONST dateiname): - INT VAR zeiger; - ueberpruefe existenz; - ueberpruefe dateityp; - initialisiere; - FOR zeiger FROM 1 UPTO 24 REP - getline (ein, eingabezeile); - putline (aus, eingabezeile); - PER; - WHILE NOT eof (ein) REP - getline (ein, eingabezeile); - zerlege zeile - PER; - forget (dateiname, quiet); - rename ("DEKOMPRIM", dateiname). - - ueberpruefe existenz: - IF NOT exists (dateiname) - THEN errorstop (verweis) - FI. - - ueberpruefe dateityp: - IF type (old (dateiname)) <> filetype - THEN errorstop (falscher typ) - FI. - - initialisiere: - FILE VAR ein := sequential file (input, dateiname); - FILE VAR aus := sequential file (output, "DEKOMPRIM"); - INT VAR zaehler :: 1; - TEXT VAR eingabezeile :: "", ausgabezeile :: "". - - zerlege zeile: - WHILE eingabezeile <> "" REP - nimm das erste stueck und schreibe es weg; - entferne den zeilentrenner - PER. - - nimm das erste stueck und schreibe es weg: - ausgabezeile := subtext (eingabezeile, 1, pos (eingabezeile, " -") - 1); - putline (aus, ausgabezeile); - zaehler INCR 1; - cout (zaehler). - - entferne den zeilentrenner: - 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 deleted file mode 100644 index b5c7867..0000000 --- a/dialog/ls-DIALOG-gen +++ /dev/null @@ -1,130 +0,0 @@ -(* - - ********************************************************* - ********************************************************* - ** ** - ** ls-DIALOG ** - ** GENERATORPROGRAMM ** - ** Version 1.2 ** - ** ** - ** (Stand: 04.11.88) ** - ** ** - ** ** - ** Autor: Wolfgang Weber, Bielefeld ** - ** ** - ** ** - ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** - ** ** - ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** - ** ** - ********************************************************* - ********************************************************* - - *) - -LET mm taskname = "ls-MENUKARTEN", - datei 1 = "ls-DIALOG 1", - datei 2 = "ls-DIALOG 2", - datei 3 = "ls-DIALOG 3", - datei 4 = "ls-DIALOG 4", - datei 5 = "ls-DIALOG 5", - datei 6 = "ls-DIALOG 6", - datei 7 = "ls-DIALOG 7", - menukarte = "ls-MENUKARTE:Archiv"; -PROC stelle existenz des mm sicher: - cursor (1, 5); out (""4""); - IF NOT exists (task (mm taskname)) - THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!"); - FI - -END PROC stelle existenz des mm sicher; -PROC vom archiv (TEXT CONST datei): - cursor (1,5); out (""4""); - out (" """); out (datei); putline (""" wird geholt."); - fetch (datei, archive) -END PROC vom archiv; -PROC hole (TEXT CONST datei): - IF NOT exists (datei) THEN vom archiv (datei) FI -END PROC hole; -PROC in (TEXT CONST datei): - hole (datei); - cursor (1, 5); out (""4""); - out (" """); out (datei); out (""" wird übersetzt: "); - insert (datei); - forget (datei, quiet); -END PROC in; - -PROC schicke (TEXT CONST datei): - cursor (1, 5); out (""4""); - out (" """); out(datei); - out (""" wird zum MENUKARTEN-MANAGER geschickt!"); - command dialogue (FALSE); - save (datei, task (mm taskname)); - command dialogue (TRUE); - forget (datei, quiet) -END PROC schicke; -INT VAR size, used; -BOOL VAR einzeln; -storage (size, used); -einzeln := size - used < 500; -forget ("ls-DIALOG/gen", quiet); -wirf kopfzeile aus; -stelle existenz des mm sicher; -hole die dateien; -insertiere die dateien; - -mache global manager aus der task. -wirf kopfzeile aus: - page; - putline (" "15"ls-DIALOG - Automatische Generierung "14""). -hole die dateien: - IF NOT exists (datei 1) COR NOT exists (datei 2) - COR NOT exists (datei 3) COR NOT exists (datei 4) - COR NOT exists (datei 5) COR NOT exists (datei 6) - COR NOT exists (datei 7) COR NOT exists (menukarte) - THEN hole dateien vom archiv - FI. -hole dateien vom archiv: - cursor (1,3); - IF yes ("Ist das Archiv angemeldet und die 'ls-DIALOG' - Diskette eingelegt") - - THEN lese ein - ELSE line (2); - errorstop ("Ohne die Diskette kann ich das System nicht generieren!") - FI. -lese ein: - cursor (1, 3); out (""4""); - out (" "15"Bitte die Diskette eingelegt lassen! "14""); - IF NOT einzeln - THEN hole (datei 1); - hole (datei 2); - hole (datei 3); - hole (datei 4); - hole (datei 5); - hole (datei 6); - hole (datei 7); - hole (menukarte); - cursor (1, 3); out(""4""); - - out (" "15"Die Diskette wird nicht mehr benötigt! "14""); - release (archive) - FI. -insertiere die dateien: - check off; - in (datei 1); - in (datei 2); - in (datei 3); - in (datei 4); - in (datei 5); - in (datei 6); - in (datei 7); - schicke (menukarte); - IF einzeln THEN release (archive) FI; - check on. -mache global manager aus der task: - global manager. - - - - - diff --git a/dialog/ls-MENUKARTE:Archiv b/dialog/ls-MENUKARTE:Archiv Binary files differdeleted file mode 100644 index c859d22..0000000 --- a/dialog/ls-MENUKARTE:Archiv +++ /dev/null |