summaryrefslogtreecommitdiff
path: root/dialog/ls-DIALOG 5
diff options
context:
space:
mode:
Diffstat (limited to 'dialog/ls-DIALOG 5')
-rw-r--r--dialog/ls-DIALOG 51480
1 files changed, 1387 insertions, 93 deletions
diff --git a/dialog/ls-DIALOG 5 b/dialog/ls-DIALOG 5
index 1772b99..9902098 100644
--- a/dialog/ls-DIALOG 5
+++ b/dialog/ls-DIALOG 5
@@ -22,97 +22,1391 @@
*)
-PACKET ls dialog 5 DEFINES{} menufootnote, old menufootnote,{} menuinfo,menualternative,{} menuyes, menuno, menuone,{} menusome,menuanswer,{} menuanswerone, menuanswersome,{} install menu, handle menu,{} refresh submenu, deactivate,{} regenerate menuscreen, activate,{} write menunotice, erase menunotice,{} menubasistext, anwendungstext,{} show menuwindow, menuwindowpage,{} menuwindowout, menuwindowget,{} menuwindoweditget, menuwindowedit,{}
- menuwindowshow, menuwindowline,{} menuwindowyes, menuwindowno,{} menuwindowcursor, get menuwindowcursor,{} remaining menuwindowlines,{} menuwindowcenter, menuwindowstop,{} editorinformationen,stdinfoedit,{} menukartenname, current menuwindow,{} reset dialog, only intern, ausstieg,{} direktstart:{}LET systemkuerzel = "ls-DIALOG",{} menutafeltaskname = "ls-MENUKARTEN",{} menutafeltype = 1954,{} menutafelpraefix = "ls-MENUKARTE:",{}
- stdmenukartenname = "ls-MENUKARTE:Archiv",{} versionsnummer = "1.1",{} copyright1 = " (C) 1987/88 Eva Latta-Weber",{} copyright2 = " (C) 1988 ERGOS GmbH";{}LET maxmenus = 6,{} maxmenutexte = 300,{} maxinfotexte = 2000,{} maxhauptmenupunkte = 10,{} maxuntermenupunkte = 15,{} erste untermenuzeile = 3;{}LET blank = " ",{} piep = ""7"",{}
- cleol = ""5"",{} cleop = ""4"",{} trennzeilensymbol = "###",{} bleibt leer symbol = "***",{} hauptmenuluecke = " ";{}LET auswahlstring1 = ""8""2""10""3""13""27"?";{}TYPE MENUPUNKT = STRUCT (TEXT punktkuerzel,{} punktname,{} procname,{} boxtext,{} BOOL aktiv,{} angewaehlt),{}
- EINZELMENU = STRUCT (INT belegt,{} TEXT ueberschrift,{} INT anfangsposition,{} maxlaenge,{} ROW maxuntermenupunkte MENUPUNKT menupunkt,{} INT aktueller untermenupunkt,{} TEXT startprozedurname,{} leaveprozedurname),{} MENU = STRUCT (TEXT menuname,{} INT anzahl hauptmenupunkte,{}
- ROW maxhauptmenupunkte EINZELMENU einzelmenu,{} TEXT menueingangsprozedur,{} menuausgangsprozedur,{} menuinfo,{} lizenznummer,{} versionsnummer,{} INT hauptmenuzeiger,{} untermenuanfang,{} untermenuzeiger),{} INFOTEXT = STRUCT (INT anzahl infotexte,{}
- ROW maxinfotexte TEXT stelle),{} MENUTEXT = STRUCT (INT anzahl menutexte,{} ROW maxmenutexte TEXT platz),{} MENULEISTE = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,{} ROW maxmenus MENU menu,{} MENUTEXT menutext,{} INFOTEXT infotext);{}BOUND MENULEISTE VAR menuleiste;{}DATASPACE VAR ds;{}WINDOW VAR menuwindow, schreibfenster, editorinfofenster;{}
-INITFLAG VAR in this task :: FALSE;{}INT VAR anzahl offener menus :: 0;{}INT VAR menunotizx, menunotizxsize,{} menunotizy, menunotizysize,{} menunotizposition;{}TEXT VAR angekoppelte menutafel :: "",{} permanent footnote :: "",{} menunotiztext;{}BOOL VAR menunotiz ist gesetzt :: FALSE,{} nur interne verwendung :: FALSE,{} mit ausstieg :: FALSE;{}REAL VAR zeitpunkt :: clock (1);{}
-ROW 13 TEXT CONST fehlermeldung :: ROW 13 TEXT : ({}"Die Task '" + menutafeltaskname + "' existiert nicht!",{}"Die Menukarte '",{}"' existiert nicht in der Task '" + menutafeltaskname + "'!",{}"' hat falschen Typ/Bezeichnung (keine 'MENUKARTE')!",{}"Das Menu '",{}"' ist nicht in der angekoppelten Menukarte!",{}"Zu viele geoeffnete Menus ( > 2 )!",{}"Kein Menu geoeffnet!",{}"Menu enthaelt keine Menupunkte!",{}"Menupunkt ist nicht im Menu enthalten!",{}"Kein Text vorhanden!",{}"Zugriff unmöglich!",{}
-"Einschränkung unzulässig!"{});{}ROW 1 TEXT CONST vergleichstext :: ROW 1 TEXT : ({}"gibt es nicht"{});{}ROW 3 TEXT CONST hinweis :: ROW 3 TEXT : ({}"Info:<ESC><?>/<?> Wahl:<Pfeile> Ausführen:<RETURN> Verlassen:<ESC><q>",{}" Zum Weitermachen bitte irgendeine Taste tippen!",{}"Bitte warten ... Ich räume auf!"{});{}ROW 3 TEXT CONST infotext :: ROW 3 TEXT : ({}" Für diesen Menupunkt ist (noch) keine "13""13" Funktion eingetragen!",{}" Möchten Sie dieses Menu tatsächlich verlassen",{}" Leider ist zu diesem Menupunkt "13""13" kein Info - Text eingetragen!"{}
- );{}PROC install menu (TEXT CONST menutafelname):{} installmenu (menutafelname, TRUE){}END PROC install menu;{}PROC install menu (TEXT CONST menutafelname, BOOL CONST mit kennung):{} TEXT VAR letzter parameter;{} IF mit kennung{} THEN zeige menukennung{} FI;{} initialisiere menu ggf;{} IF menutafel noch nicht angekoppelt{} THEN letzter parameter := std;{} hole menutafel;{} kopple menutafel an;{} last param (letzter parameter){} FI.{} initialisiere menu ggf:{}
- IF NOT initialized (in this task){} THEN angekoppelte menutafel := "";{} anzahl offener menus := 0;{} menunotiz ist gesetzt := FALSE;{} nur interne verwendung := FALSE{} FI.{} menutafel noch nicht angekoppelt:{} menutafelname <> angekoppelte menutafel.{} hole menutafel:{} IF NOT exists task (menutafeltaskname){} THEN bereinige situation; cursor on;{} errorstop (fehlermeldung [1]){} FI;{} disable stop;{} fetch (menutafelname, /menutafeltaskname);{}
- IF is error AND pos (errormessage, vergleichstext [1]) > 0{} THEN clear error; enable stop;{} bereinige situation; cursor on;{} errorstop (fehlermeldung [2] + menutafelname +{} fehlermeldung [3]){} ELIF is error{} THEN clear error; enable stop;{} bereinige situation; cursor on;{} errorstop (errormessage){} ELSE enable stop{} FI.{} kopple menutafel an:{} IF type (old (menutafelname)) = menutafeltype{}
- AND pos (menutafelname,menutafelpraefix) = 1{} THEN forget (ds);{} ds := old (menutafelname);{} menuleiste := ds;{} angekoppelte menutafel := menutafelname;{} forget (menutafelname, quiet){} ELSE bereinige situation; cursor on;{} errorstop ("'" + menutafelname + fehlermeldung [4]){} FI.{}END PROC install menu;{}PROC only intern (BOOL CONST wert):{} nur interne verwendung := wert{}END PROC only intern;{}
-PROC ausstieg (BOOL CONST wert):{} mit ausstieg := wert{}END PROC ausstieg;{}TEXT PROC menukartenname:{} IF NOT initialized (in this task){} THEN angekoppelte menutafel := "";{} anzahl offener menus := 0;{} menunotiz ist gesetzt := FALSE;{} FI;{} angekoppelte menutafel{}END PROC menukartenname;{}PROC handle menu (TEXT CONST menuname):{} nur interne verwendung := FALSE;{} mit ausstieg := TRUE;{} handle menu (menuname, ""){}END PROC handle menu;{}
-PROC handle menu (TEXT CONST menuname, ausstiegsproc):{} cursor off;{} IF nur interne verwendung{} THEN oeffne menu (menuname){} ELSE biete menu an{} FI;{} lasse menupunkte auswaehlen;{} IF nur interne verwendung{} THEN do (ausstiegsproc);{} anzahl offener menus DECR 1;{} IF anzahl offener menus < 1 THEN erase menunotice FI;{} menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{} menuwindow := window (1,1,79, 24);{} nur interne verwendung := FALSE;{}
- mit ausstieg := TRUE;{} cursor on{} ELSE schliesse menu;{} leere ggf den bildschirm{} FI.{} biete menu an:{} REAL VAR zwischenzeit :: clock (1) - zeitpunkt;{} IF zwischenzeit < 2.0{} THEN pause (20 - int (10.0 * zwischenzeit)){} FI;{} oeffne menu (menuname).{} leere ggf den bildschirm:{} IF anzahl offener menus < 1{} THEN erase menunotice;{} page; cursor on{} FI.{} lasse menupunkte auswaehlen:{} TEXT VAR kuerzelkette :: "";{}
- starte aktuelle untermenuoperationen;{} REP{} cursor in warteposition;{} ermittle aktuelle kuerzelkette;{} nimm zeichen auf;{} interpretiere zeichen;{} UNTIL menu verlassen gewuenscht PER.{} nimm zeichen auf:{} TEXT CONST erlaubte zeichen ::auswahlstring1 + kuerzelkette;{} TEXT VAR eingabezeichen;{} INT VAR zeichenposition;{} REP{} inchar (eingabezeichen);{} zeichenposition := pos (erlaubte zeichen, eingabezeichen);{} piepse ggf{} UNTIL zeichenposition > 0 PER.{}
- piepse ggf:{} IF zeichenposition = 0 THEN out (piep) FI.{} menu verlassen gewuenscht:{} zeichenposition = 6 AND (zweites zeichen = "q").{} interpretiere zeichen:{} SELECT zeichenposition OF{} CASE 1: gehe einen hauptmenupunkt nach links{} CASE 2: gehe einen hauptmenupunkt nach rechts{} CASE 3: gehe einen untermenupunkt nach unten{} CASE 4: gehe einen untermenupunkt nach oben{} CASE 5: fuehre aktuellen menupunkt aus{} CASE 6: hole esc sequenz{} CASE 7: zeige erklaerungstext im menu an{}
- OTHERWISE werte kuerzeleingabe aus{} END SELECT.{} gehe einen hauptmenupunkt nach links:{} INT VAR anzahl schritte :: 1;{} beende aktuelle untermenuoperationen;{} loesche aktuelles untermenu auf bildschirm;{} loesche alte hauptmenumarkierung;{} anzahl schritte INCR clear buffer and count (""8"");{} ermittle linke menuposition;{} stelle aktuellen hauptmenupunkt invers dar;{} starte aktuelle untermenuoperationen;{} schreibe aktuelles untermenu auf bildschirm.{} gehe einen hauptmenupunkt nach rechts:{}
- anzahl schritte := 1;{} beende aktuelle untermenuoperationen;{} loesche aktuelles untermenu auf bildschirm;{} loesche alte hauptmenumarkierung;{} anzahl schritte INCR clear buffer and count (""2"");{} ermittle rechte menuposition;{} stelle aktuellen hauptmenupunkt invers dar;{} starte aktuelle untermenuoperationen;{} schreibe aktuelles untermenu auf bildschirm.{} loesche alte hauptmenumarkierung:{} erase invers (area (menuwindow), startpos, 1, ueberschriftlaenge);{}
- out (area (menuwindow), startpos, 1, ueberschrifttext).{} startpos:{} aktuelles untermenu.anfangsposition.{} ueberschriftlaenge:{} length (ueberschrifttext).{} ueberschrifttext:{} aktuelles untermenu.ueberschrift.{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} ermittle linke menuposition:{} INT VAR positionszaehler;{} FOR positionszaehler FROM 1 UPTO anzahl schritte REP{}
- drehe die menuposition um einen wert runter{} PER.{} ermittle rechte menuposition:{} FOR positionszaehler FROM 1 UPTO anzahl schritte REP{} drehe die menuposition um einen wert hoch{} PER.{} drehe die menuposition um einen wert runter:{} IF aktuelles menu.hauptmenuzeiger > 1{} THEN aktuelles menu.hauptmenuzeiger DECR 1{} ELSE aktuelles menu.hauptmenuzeiger{} := aktuelles menu.anzahl hauptmenupunkte{} FI.{} drehe die menuposition um einen wert hoch:{}
- IF aktuelles menu.hauptmenuzeiger{} < aktuelles menu.anzahl hauptmenupunkte{} THEN aktuelles menu.hauptmenuzeiger INCR 1{} ELSE aktuelles menu.hauptmenuzeiger := 1{} FI.{} gehe einen untermenupunkt nach unten:{} INT VAR naechster aktiver := folgender aktiver untermenupunkt;{} nimm ummarkierung vor.{} gehe einen untermenupunkt nach oben:{} naechster aktiver := vorausgehender aktiver untermenupunkt;{} nimm ummarkierung vor.{} nimm ummarkierung vor:{} IF ueberhaupt aktive menupunkte vorhanden{}
- THEN demarkiere aktuellen untermenupunkt;{} gehe zum folgenden untermenupunkt;{} markiere aktuellen untermenupunkt{} FI.{} ueberhaupt aktive menupunkte vorhanden:{} (aktuelles untermenu.belegt > 0) CAND (naechster aktiver > 0).{} gehe zum folgenden untermenupunkt:{} aktuelles menu.untermenuzeiger := naechster aktiver.{} stelle aktuellen hauptmenupunkt invers dar:{} out invers (area (menuwindow), startpos, 1, ueberschrifttext).{} fuehre aktuellen menupunkt aus:{}
- IF nur interne verwendung AND mit ausstieg{} THEN kennzeichne als angetickt;{} disable stop;{} do (ausstiegsproc);{} do (menuanweisung);{} aktueller menupunkt.angewaehlt := FALSE;{} IF is error THEN put error; clear error FI;{} enable stop;{} anzahl offener menus DECR 1;{} menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{} menuwindow := window (1,1,79, 24);{} nur interne verwendung := FALSE;{}
- cursor on;{} LEAVE handle menu{} ELSE kennzeichne als angetickt;{} fuehre operation aus (menuanweisung);{} nimm kennzeichnung zurueck{} FI.{} kennzeichne als angetickt:{} aktueller menupunkt.angewaehlt := TRUE;{} markiere aktuellen untermenupunkt.{} nimm kennzeichnung zurueck:{} aktueller menupunkt.angewaehlt := FALSE;{} markiere aktuellen untermenupunkt.{} menuanweisung:{} compress (aktueller menupunkt.procname).{} aktueller menupunkt:{}
- aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].{} hole esc sequenz:{} TEXT VAR zweites zeichen;{} inchar (zweites zeichen);{} SELECT pos ("q?$", zweites zeichen) OF{} CASE 1: erfrage abbruch{} CASE 2: zeige menubedienhinweise{} CASE 3: gib info aus{} OTHERWISE out (piep){} END SELECT.{} erfrage abbruch:{} IF menuno (infotext [2], 5){} THEN zweites zeichen := "n" (* gleichgültig, nur nicht 'q' *){} FI.{} zeige menubedienhinweise:{}
- INT VAR gewaehlt;{} REP{} gewaehlt := menualternative ( alttext, altwahl, altzusatz, 5, FALSE);{} erfuelle den wunsch{} UNTIL ausstieg aus bedienhinweisen gewuenscht PER.{} alttext:{} menuleiste.menutext.platz [1].{} altwahl:{} menuleiste.menutext.platz [2].{} altzusatz:{} menuleiste.menutext.platz [3].{} erfuelle den wunsch:{} SELECT gewaehlt OF{} CASE 1,101,106: menuinfo (menuleiste.menutext.platz [4], 5, maxint){} CASE 2,102,107: menuinfo (menuleiste.menutext.platz [5], 5, maxint){}
- CASE 3,103,108: menuinfo (menuleiste.menutext.platz [6], 5, maxint){} CASE 4,104,109: menuinfo (menuleiste.menutext.platz [7], 5, maxint){} END SELECT.{} ausstieg aus bedienhinweisen gewuenscht:{} gewaehlt = 5 OR gewaehlt = 105 OR gewaehlt = 110.{} gib info aus:{} menuinfo (menuleiste.menutext.platz [20]).{} zeige erklaerungstext im menu an:{} IF compress (erklaerungstext) = ""{} THEN menuinfo (infotext [3]){} ELSE menuinfo (erklaerungstext){} FI.{} erklaerungstext:{}
- aktueller menupunkt.boxtext.{} werte kuerzeleingabe aus:{} naechster aktiver := pos (kuerzelkette, eingabezeichen);{} nimm ummarkierung vor;{} fuehre aktuellen menupunkt aus.{} starte aktuelle untermenuoperationen:{} ermittle aktuelle kuerzelkette;{} IF startoperation <> ""{} THEN fuehre operation aus (startoperation){} FI.{} startoperation:{} compress (aktuelles untermenu.startprozedurname).{} ermittle aktuelle kuerzelkette:{} kuerzelkette := "";{} INT VAR kuerzelzeiger;{}
- FOR kuerzelzeiger FROM 1 UPTO aktuelles untermenu.belegt REP{} IF compress (aktuelles punktkuerzel) = ""{} THEN kuerzelkette CAT ""0"" { beliebiger Code der Länge 1 }{} ELSE haenge ggf kuerzel an{} FI{} PER.{} aktuelles punktkuerzel:{} aktuelles untermenu.menupunkt [kuerzelzeiger].punktkuerzel.{} haenge ggf kuerzel an:{} IF betrachteter punkt ist aktiv{} THEN kuerzelkette CAT aktuelles punktkuerzel{} ELSE kuerzelkette CAT ""0""{} FI.{} betrachteter punkt ist aktiv:{}
- aktuelles untermenu.menupunkt [kuerzelzeiger].aktiv.{} beende aktuelle untermenuoperationen:{} kuerzelkette := "".{}END PROC handle menu;{}PROC oeffne menu (TEXT CONST menuname):{} cursor off;{} suche eingestelltes menu;{} IF menu existiert nicht{} THEN cursor on;{} page;{} errorstop (fehlermeldung [5] + menuname + fehlermeldung [6]){} FI;{} anzahl offener menus INCR 1;{} ggf neue seite aufschlagen;{} ueberpruefe anzahl offener menus;{} lege ggf aktuelles menu auf eis;{}
- initialisiere den menubildschirm;{} IF NOT nur interne verwendung{} THEN aktuelles menu.hauptmenuzeiger := 1;{} aktuelles menu.untermenuzeiger := 0;{} aktuelles menu.untermenuanfang := 0;{} FI;{} show menu;{} fuehre ggf menueingangsprozedur aus;{} zeige ggf menukenndaten an.{} suche eingestelltes menu:{} INT VAR i, suchzeiger;{} BOOL VAR gefunden :: FALSE;{} FOR i FROM 1 UPTO menuleiste.belegt REP{} IF menuleiste.menu [i].menuname = menuname{}
- THEN gefunden := TRUE;{} suchzeiger := i;{} FI{} UNTIL menuleiste.menu [i].menuname = menuname PER.{} menu existiert nicht:{} NOT gefunden.{} ueberpruefe anzahl offener menus:{} IF anzahl offener menus > 2{} THEN anzahl offener menus := 0; cursor on;{} errorstop (fehlermeldung [7]){} FI.{} lege ggf aktuelles menu auf eis:{} IF anzahl offener menus = 2{} THEN menuleiste.zeigerhintergrund := menuleiste.zeigeraktuell{} FI;{} menuleiste.zeigeraktuell := suchzeiger.{}
- initialisiere den menubildschirm:{} IF anzahl offener menus = 2{} THEN menuwindow := window (6, 4, 73, 20){} ELSE menuwindow := window (1, 1, 79, 24);{} FI.{} fuehre ggf menueingangsprozedur aus:{} IF aktuelles menu.menueingangsprozedur <> ""{} THEN fuehre operation aus (aktuelles menu.menueingangsprozedur){} FI.{} ggf neue seite aufschlagen:{} IF anzahl offener menus = 1 THEN page FI.{} zeige ggf menukenndaten an:{} IF anzahl offener menus = 1 AND aktuelles menu.menuinfo <> bleibt leer symbol{}
- THEN write menunotice (vollstaendiger infotext, 4);{} pause (100);{} erase menunotice{} FI.{} vollstaendiger infotext:{} aktuelles menu.menuinfo +{} aktuelles menu.lizenznummer +{} aktuelles menu.versionsnummer.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{}END PROC oeffne menu;{}PROC show menu:{} ueberpruefe menudaten;{} stelle hauptmenuleiste zusammen;{} zeige hauptmenu an;{} stelle aktuellen hauptmenupunkt invers dar;{} schreibe aktuelles untermenu auf bildschirm;{}
- zeige informationszeile an.{} ueberpruefe menudaten:{} IF anzahl offener menus = 0{} THEN errorstop (fehlermeldung [8]){} ELIF aktuelles menu.anzahl hauptmenupunkte < 1{} THEN errorstop (fehlermeldung [9]){} FI.{} stelle hauptmenuleiste zusammen:{} TEXT VAR hauptmenuzeile :: "";{} INT VAR zeiger;{} hauptmenuzeile CAT aktuelles menu.menuname;{} hauptmenuzeile CAT ":";{} FOR zeiger FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP{} haenge hauptmenupunkt an{}
- PER.{} haenge hauptmenupunkt an:{} hauptmenuzeile CAT hauptmenuluecke;{} hauptmenuzeile CAT hauptmenupunktname.{} hauptmenupunktname:{} aktuelles menu.einzelmenu [zeiger].ueberschrift.{} zeige hauptmenu an:{} page (menuwindow, TRUE);{} out menuframe (area (menuwindow));{} cursor (menuwindow, 1, 1);{} out (menuwindow, hauptmenuzeile).{} stelle aktuellen hauptmenupunkt invers dar:{} cursor (menuwindow, startposition, 1);{} out (menuwindow, invers (ueberschrifttext)).{}
- startposition:{} aktuelles untermenu.anfangsposition - 1.{} ueberschrifttext:{} aktuelles untermenu.ueberschrift.{} zeige informationszeile an:{} write permanent footnote (hinweis [1]).{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC show menu;{}PROC schreibe aktuelles untermenu auf bildschirm:{} ermittle linke obere ecke des untermenukastens;{} wirf untermenu aus;{}
- show menunotice;{} cursor in warteposition.{} ermittle linke obere ecke des untermenukastens:{} aktuelles menu.untermenuanfang := menumitte - halbe menubreite;{} achte auf randextrema.{} menumitte:{} startposition + (length (ueberschrifttext) DIV 2) - 1.{} startposition:{} aktuelles untermenu.anfangsposition.{} ueberschrifttext:{} aktuelles untermenu.ueberschrift.{} halbe menubreite:{} aktuelles untermenu.maxlaenge DIV 2.{} achte auf randextrema:{} gleiche ggf linken rand aus;{}
- gleiche ggf rechten rand aus.{} gleiche ggf linken rand aus:{} IF aktuelles menu.untermenuanfang < 4{} THEN aktuelles menu.untermenuanfang := 4{} FI.{} gleiche ggf rechten rand aus:{} IF (aktuelles menu.untermenuanfang + aktuelles untermenu.maxlaenge) >{} (areaxsize (menuwindow) - 3){} THEN aktuelles menu.untermenuanfang{} := areaxsize (menuwindow) - aktuelles untermenu.maxlaenge - 3{} FI.{} wirf untermenu aus:{} IF aktuelles menu.untermenuzeiger = 0{}
- THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt{} FI;{} wirf untermenukopfzeile aus;{} wirf untermenurumpf aus;{} wirf untermenufusszeile aus;{} markiere aktuellen untermenupunkt.{} wirf untermenukopfzeile aus:{} cursor (menuwindow, spalte, anfangszeile);{} out (balken oben); striche; out (balken oben).{} wirf untermenufusszeile aus:{} cursor (menuwindow, spalte, endezeile);{} out (ecke unten links); striche; out (ecke unten rechts).{} spalte:{}
- aktuelles menu.untermenuanfang - 3.{} anfangszeile:{} erste untermenuzeile - 1.{} endezeile:{} erste untermenuzeile + aktuelles untermenu.belegt.{} striche:{} (aktuelles untermenu.maxlaenge + 5) TIMESOUT waagerecht.{} wirf untermenurumpf aus:{} INT VAR laufvar;{} INT CONST aktuelle punktlaenge :: aktuelles untermenu.maxlaenge + 1;{} FOR laufvar FROM 1 UPTO aktuelles untermenu.belegt REP{} wirf eine einzelne menuzeile aus{} PER.{} wirf eine einzelne menuzeile aus:{}
- out with beam (area (menuwindow), menuspalte, menuzeile,{} aktueller punktname, laenge).{} menuspalte:{} aktuelles menu.untermenuanfang.{} menuzeile:{} erste untermenuzeile + laufvar - 1.{} aktueller punktname:{} untermenubezeichnung (laufvar).{} laenge:{} aktuelle punktlaenge.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC schreibe aktuelles untermenu auf bildschirm;{}
-PROC loesche aktuelles untermenu auf bildschirm:{} beende aktuelle untermenuoperationen;{} loesche untermenu auf bildschirm;{} schreibe balken wieder hin;{} aktuelles menu.untermenuzeiger := 1.{} beende aktuelle untermenuoperationen:{} IF leaveoperation <> ""{} THEN fuehre operation aus (leaveoperation){} FI.{} leaveoperation:{} compress (aktuelles untermenu.leaveprozedurname).{} loesche untermenu auf bildschirm:{} INT VAR laufvar;{} FOR laufvar FROM aktuelles untermenu.belegt + 1 DOWNTO 1 REP{}
- loesche eine einzelne menuzeile{} PER.{} loesche eine einzelne menuzeile:{} erase with beam (area (menuwindow), menuspalte, menuzeile, laenge).{} menuspalte:{} aktuelles menu.untermenuanfang.{} menuzeile:{} erste untermenuzeile + laufvar - 1.{} laenge:{} aktuelles untermenu.maxlaenge + 1.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{} schreibe balken wieder hin:{}
- cursor (menuwindow, spalte, anfangszeile);{} (aktuelles untermenu.maxlaenge + 7) TIMESOUT waagerecht.{} spalte:{} aktuelles menu.untermenuanfang - 3.{} anfangszeile:{} erste untermenuzeile - 1.{}END PROC loesche aktuelles untermenu auf bildschirm;{}PROC markiere aktuellen untermenupunkt:{} IF aktuelles menu.untermenuzeiger <> 0{} THEN laufe ggf zum naechsten aktiven menupunkt;{} out invers with beam (area (menuwindow), menuspalte, menuzeile,{} aktueller punktname, laenge){}
- FI.{} laufe ggf zum naechsten aktiven menupunkt:{} IF NOT aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].aktiv{} THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt{} FI.{} menuspalte:{} aktuelles menu.untermenuanfang.{} menuzeile:{} erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.{} aktueller punktname:{} untermenubezeichnung (aktuelles menu.untermenuzeiger).{} laenge:{} aktuelles untermenu.maxlaenge + 1.{} aktuelles menu:{}
- menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC markiere aktuellen untermenupunkt;{}PROC demarkiere aktuellen untermenupunkt:{} IF aktuelles menu.untermenuzeiger <> 0{} THEN erase invers (area (menuwindow), menuspalte, menuzeile, laenge);{} out (area (menuwindow), menuspalte, menuzeile,{} aktueller punktname, laenge){} FI.{} menuspalte:{} aktuelles menu.untermenuanfang.{}
- menuzeile:{} erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.{} aktueller punktname:{} untermenubezeichnung (aktuelles menu.untermenuzeiger).{} laenge:{} aktuelles untermenu.maxlaenge + 1.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC demarkiere aktuellen untermenupunkt;{}INT PROC folgender aktiver untermenupunkt:{} INT VAR anzahl aktiver menupunkte :: 0;{}
- untersuche anzahl aktiver menupunkte;{} IF kein aktiver menupunkt vorhanden{} THEN 0{} ELIF nur ein aktiver menupunkt vorhanden{} THEN liefere einzigen aktiven menupunkt{} ELSE liefere naechsten aktiven menupunkt{} FI.{} untersuche anzahl aktiver menupunkte:{} INT VAR zaehler, position;{} FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP{} IF aktuelles untermenu.menupunkt [zaehler].aktiv{} THEN anzahl aktiver menupunkte INCR 1;{} position := zaehler{}
- FI{} UNTIL anzahl aktiver menupunkte > 1 PER.{} kein aktiver menupunkt vorhanden:{} anzahl aktiver menupunkte = 0.{} nur ein aktiver menupunkt vorhanden:{} anzahl aktiver menupunkte = 1.{} liefere einzigen aktiven menupunkt:{} position.{} liefere naechsten aktiven menupunkt:{} INT VAR interner zeiger;{} stelle internen zeiger auf den naechsten menupunkt;{} WHILE NOT punkt ist aktiv REP{} untersuche naechsten menupunkt{} PER;{} ergebnis.{} stelle internen zeiger auf den naechsten menupunkt:{}
- IF aktuelles menu.untermenuzeiger = letzter untermenupunkt{} THEN interner zeiger := 1{} ELSE interner zeiger := aktuelles menu.untermenuzeiger + 1{} FI.{} letzter untermenupunkt:{} aktuelles untermenu.belegt.{} punkt ist aktiv:{} aktuelles untermenu.menupunkt [interner zeiger].aktiv.{} untersuche naechsten menupunkt:{} IF interner zeiger = letzter untermenupunkt{} THEN interner zeiger := 1{} ELSE interner zeiger INCR 1{} FI.{}
- ergebnis:{} interner zeiger.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC folgender aktiver untermenupunkt;{}INT PROC vorausgehender aktiver untermenupunkt:{} INT VAR anzahl aktiver menupunkte :: 0;{} untersuche anzahl aktiver menupunkte;{} IF kein aktiver menupunkt vorhanden{} THEN 0{} ELIF nur ein aktiver menupunkt vorhanden{} THEN liefere einzigen aktiven menupunkt{}
- ELSE liefere vorausgehenden aktiven menupunkt{} FI.{} untersuche anzahl aktiver menupunkte:{} INT VAR zaehler, position;{} FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP{} IF aktuelles untermenu.menupunkt [zaehler].aktiv{} THEN anzahl aktiver menupunkte INCR 1;{} position := zaehler{} FI{} UNTIL anzahl aktiver menupunkte > 1 PER.{} kein aktiver menupunkt vorhanden:{} anzahl aktiver menupunkte = 0.{} nur ein aktiver menupunkt vorhanden:{} anzahl aktiver menupunkte = 1.{}
- liefere einzigen aktiven menupunkt:{} position.{} liefere vorausgehenden aktiven menupunkt:{} INT VAR interner zeiger;{} stelle internen zeiger auf vorausgehenden menupunkt;{} WHILE NOT punkt ist aktiv REP{} untersuche vorausgehenden menupunkt{} PER;{} ergebnis.{} stelle internen zeiger auf vorausgehenden menupunkt:{} IF aktuelles menu.untermenuzeiger <= 1{} THEN interner zeiger := letzter untermenupunkt{} ELSE interner zeiger := aktuelles menu.untermenuzeiger - 1{}
- FI.{} letzter untermenupunkt:{} aktuelles untermenu.belegt.{} punkt ist aktiv:{} aktuelles untermenu.menupunkt [interner zeiger].aktiv.{} untersuche vorausgehenden menupunkt:{} IF interner zeiger = 1{} THEN interner zeiger := letzter untermenupunkt{} ELSE interner zeiger DECR 1{} FI.{} ergebnis:{} interner zeiger.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}
-END PROC vorausgehender aktiver untermenupunkt;{}PROC cursor in warteposition:{} cursor (areax (menuwindow), areay (menuwindow) + 1){}END PROC cursor in warteposition;{}TEXT PROC untermenubezeichnung (INT CONST position):{} TEXT VAR bezeichnung :: "";{} bezeichnung CAT kennzeichnung;{} bezeichnung CAT punktkennung;{} bezeichnung.{} kennzeichnung:{} IF aktueller menupunkt.aktiv{} AND aktueller menupunkt.angewaehlt{} THEN "*"{} ELIF aktueller menupunkt.aktiv{}
- AND aktueller menupunkt.punktkuerzel <> ""{} THEN aktueller menupunkt.punktkuerzel{} ELIF aktueller menupunkt.aktiv{} AND aktueller menupunkt.punktkuerzel = ""{} THEN blank{} ELSE "-"{} FI.{} punktkennung:{} IF menupunkt ist trennzeile{} THEN strichellinie{} ELSE aktueller menupunkt.punktname{} FI.{} menupunkt ist trennzeile:{} aktueller menupunkt.punktname = (blank + trennzeilensymbol).{} strichellinie:{}
- (aktuelles untermenu.maxlaenge + 1) * "-".{} aktueller menupunkt:{} aktuelles untermenu.menupunkt [position].{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC untermenubezeichnung;{}PROC fuehre operation aus (TEXT CONST operation):{} disable stop;{} IF operation = ""{} THEN menuinfo (infotext [1]);{} LEAVE fuehre operation aus{} FI;{} do (operation);{}
- IF is error{} THEN menuinfo (errormessage, 5);{} clear error{} FI;{} old menufootnote;{} enable stop;{} cursor off{}END PROC fuehre operation aus;{}PROC veraendere aktivierung (TEXT CONST unterpunkt, BOOL CONST eintrag):{} INT VAR unterpunktposition :: 0, zeiger;{} suche unterpunkt;{} aendere aktivierung.{} suche unterpunkt:{} FOR zeiger FROM 1 UPTO untermenuende REP{} IF untermenupunkt = blank + compress (unterpunkt){} THEN unterpunktposition := zeiger;{} LEAVE suche unterpunkt{}
- FI{} PER;{} LEAVE veraendere aktivierung.{} untermenuende:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.{} untermenupunkt:{} aktuelles untermenu.menupunkt [zeiger].punktname.{} aendere aktivierung:{} aktuelles untermenu.menupunkt [unterpunktposition].aktiv := eintrag.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC veraendere aktivierung;{}
-PROC veraendere aktivierung (INT CONST punktnummer, BOOL CONST eintrag):{} IF punktnummer >= 1 AND punktnummer <= untermenuende{} THEN aktuelles untermenu.menupunkt [punktnummer].aktiv := eintrag{} FI.{} untermenuende:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC veraendere aktivierung;{}PROC veraendere anwahl (TEXT CONST unterpunkt, BOOL CONST eintrag):{}
- INT VAR unterpunktposition :: 0, zeiger;{} suche unterpunkt;{} aendere anwahl.{} suche unterpunkt:{} FOR zeiger FROM 1 UPTO untermenuende REP{} IF untermenupunkt = blank + compress (unterpunkt){} THEN unterpunktposition := zeiger;{} LEAVE suche unterpunkt{} FI{} PER;{} enable stop;{} errorstop (fehlermeldung [10]).{} untermenuende:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.{} untermenupunkt:{} aktuelles untermenu.menupunkt [zeiger].punktname.{}
- aendere anwahl:{} aktuelles untermenu.menupunkt [unterpunktposition].angewaehlt := eintrag.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC veraendere anwahl;{}PROC activate (TEXT CONST unterpunkt):{} enable stop;{} veraendere aktivierung (unterpunkt, TRUE){}END PROC activate;{}PROC activate (INT CONST punktnummer):{} enable stop;{} veraendere aktivierung (punktnummer, TRUE){}
-END PROC activate;{}PROC deactivate (TEXT CONST unterpunkt):{} enable stop;{} veraendere aktivierung (unterpunkt, FALSE){}END PROC deactivate;{}PROC deactivate (INT CONST punktnummer):{} enable stop;{} veraendere aktivierung (punktnummer, FALSE){}END PROC deactivate;{}PROC select (TEXT CONST unterpunkt):{} enable stop;{} veraendere anwahl (unterpunkt, TRUE){}END PROC select;{}PROC deselect (TEXT CONST unterpunkt):{} enable stop;{} veraendere anwahl (unterpunkt, FALSE){}END PROC deselect;{}
-PROC schliesse menu:{} IF aktuelles menu.menuausgangsprozedur <> ""{} THEN menufootnote (hinweis [3]);{} fuehre operation aus (aktuelles menu.menuausgangsprozedur){} FI;{} anzahl offener menus DECR 1;{} IF anzahl offener menus = 1{} THEN aktiviere das auf eis gelegte menu{} FI.{} aktiviere das auf eis gelegte menu:{} menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{} menuwindow := window (1, 1, 79, 24);{} show menu.{} aktuelles menu:{} menuleiste.menu [menuleiste.zeigeraktuell].{}
-END PROC schliesse menu;{}PROC refresh submenu:{} schreibe aktuelles untermenu auf bildschirm;{} show menunotice;{}END PROC refresh submenu;{}PROC regenerate menuscreen:{} IF anzahl offener menus = 0{} THEN errorstop (fehlermeldung [8]){} ELIF anzahl offener menus = 1{} THEN page;{} show menu;{} show menunotice{} ELSE zeige erstes menu an;{} zeige zweites menu an;{} show menunotice{} FI.{} zeige erstes menu an:{} INT VAR menuzeiger :: menuleiste.zeigeraktuell;{}
- menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{} menuwindow := window (1, 1, 79, 24);{} anzahl offener menus := 1;{} show menu.{} zeige zweites menu an:{} menuleiste.zeigeraktuell := menuzeiger;{} menuwindow := window (6, 4, 73, 20);{} anzahl offener menus := 2;{} show menu.{}END PROC regenerate menuscreen;{}PROC menuinfo (TEXT CONST t, INT CONST position, timelimit):{} boxinfo (menuwindow, t, position, timelimit, FALSE);{} schreibe aktuelles untermenu auf bildschirm;{}
- old menufootnote{}END PROC menuinfo;{}PROC menuinfo (TEXT CONST t, INT CONST position):{} menuinfo (t, position, maxint){}END PROC menuinfo;{}PROC menuinfo (TEXT CONST t):{} menuinfo (t, 5, maxint){}END PROC menuinfo;{}INT PROC menualternative (TEXT CONST t, auswahlliste, zusatztasten,{} INT CONST position, BOOL CONST mit abbruch):{} INT VAR ergebnis := boxalternative (menuwindow, t, auswahlliste,{} zusatztasten, position, mit abbruch, FALSE);{}
- schreibe aktuelles untermenu auf bildschirm;{} old menufootnote;{} ergebnis{}END PROC menualternative;{}BOOL PROC menuyes (TEXT CONST frage, INT CONST position):{} BOOL VAR wert := boxyes (menuwindow, frage, position, FALSE);{} schreibe aktuelles untermenu auf bildschirm;{} old menufootnote;{} wert{}END PROC menuyes;{}BOOL PROC menuno (TEXT CONST frage, INT CONST position):{} NOT menuyes (frage, position){}END PROC menuno;{}TEXT PROC menuone (THESAURUS CONST thes, TEXT CONST t1, t2,{} BOOL CONST mit reinigung):{}
- TEXT CONST wert :: boxone (menuwindow, thes, t1, t2, mit reinigung);{} IF mit reinigung{} THEN schreibe aktuelles untermenu auf bildschirm;{} old menufootnote{} FI;{} wert{}END PROC menuone;{}THESAURUS PROC menusome (THESAURUS CONST thes, TEXT CONST t1, t2,{} BOOL CONST mit reinigung):{} THESAURUS CONST thesaurus :: boxsome (menuwindow, thes, t1, t2,{} mit reinigung);{} IF mit reinigung{} THEN schreibe aktuelles untermenu auf bildschirm;{}
- old menufootnote{} FI;{} thesaurus{}END PROC menusome;{}TEXT PROC menuanswer (TEXT CONST t, vorgabe, INT CONST position):{} TEXT VAR wert :: boxanswer (menuwindow, t, vorgabe, position, FALSE);{} schreibe aktuelles untermenu auf bildschirm;{} old menufootnote;{} wert{}END PROC menuanswer;{}TEXT PROC menuanswerone (TEXT CONST t, vorgabe, THESAURUS CONST thes,{} TEXT CONST t1, t2, BOOL CONST mit reinigung):{} TEXT VAR wert :: boxanswerone (menuwindow, t, vorgabe, thes, t1, t2,{}
- mit reinigung, FALSE){} IF mit reinigung{} THEN schreibe aktuelles untermenu auf bildschirm;{} old menufootnote{} FI;{} wert{}END PROC menuanswer one;{}THESAURUS PROC menuanswersome (TEXT CONST t, vorgabe, THESAURUS CONST thes,{} TEXT CONST t1, t2, BOOL CONST mit reinigung):{} THESAURUS VAR wert :: boxanswersome (menuwindow, t, vorgabe,{} thes, t1, t2, mit reinigung, FALSE){}
- IF mit reinigung{} THEN schreibe aktuelles untermenu auf bildschirm;{} old menufootnote{} FI;{} wert{}END PROC menuanswersome;{}PROC menufootnote (TEXT CONST t):{} cursor (menuwindow, 1, areaysize (menuwindow) - 1);{} areaxsize (menuwindow) TIMESOUT waagerecht;{} cursor (menuwindow, 1, areaysize (menuwindow));{} outtext (t, 1, areaxsize (menuwindow)){}END PROC menufootnote;{}PROC old menufootnote:{} menufootnote (permanent footnote){}END PROC old menufootnote;{}TEXT PROC menubasistext (INT CONST nummer):{}
- IF nummer <= 20{} THEN fehlermeldung [12]{} ELIF nummer > menuleiste.menutext.anzahl menutexte{} THEN fehlermeldung [11]{} ELSE menuleiste.menutext.platz [nummer]{} FI{}END PROC menubasistext;{}TEXT PROC anwendungstext (INT CONST nummer):{} IF nummer > menuleiste.infotext.anzahl infotexte{} THEN fehlermeldung [11]{} ELSE menuleiste.infotext.stelle [nummer]{} FI{}END PROC anwendungstext;{}PROC zeige menukennung:{} IF anzahl offener menus = 0{} THEN zeige angaben und emblem;{}
- FI.{} zeige angaben und emblem:{} ROW 5 WINDOW VAR w;{} w [ 1] := window (40, 3, 30, 9);{} w [ 2] := window (36, 5, 30, 9);{} w [ 3] := window (30, 7, 30, 9);{} w [ 4] := window (22, 9, 30, 9);{} w [ 5] := window (12, 11, 30, 9);{} page;{} show (w [1]); out (w [1], center (w [1], invers (systemkuerzel)));{} show (w [2]); out (w [2], " Version " + versionsnummer);{} show (w [3]); out (w [3], copyright1);{} show (w [4]); out (w [4], copyright2);{} show (w [5]);{}
- cursor (w [5], 1, 2);out (w [5], " lll sssssssss ");{} cursor (w [5], 1, 3);out (w [5], " lll sss sss ");{} cursor (w [5], 1, 4);out (w [5], " lll sss ");{} cursor (w [5], 1, 5);out (w [5], " lll sssssssss ");{} cursor (w [5], 1, 6);out (w [5], " lll sss ");{} cursor (w [5], 1, 7);out (w [5], " lll latta soft sss ");{} cursor (w [5], 1, 8);out (w [5], " lllllllll sssssssss ");{} cursor (79, 24);{}
- zeitpunkt := clock (1);{}END PROC zeige menukennung;{}PROC reset dialog:{} angekoppelte menutafel := "";{} anzahl offener menus := 0{}END PROC reset dialog;{}PROC write permanent footnote (TEXT CONST t):{} permanent footnote := t;{} cursor (menuwindow, 1, areaysize (menuwindow));{} outtext (t, 1, areaxsize (menuwindow)){}END PROC write permanent footnote;{}PROC write menunotice (TEXT CONST t, INT CONST position):{} erase menunotice;{} boxnotice (menuwindow, t, position, menunotizx, menunotizy,{}
- menunotizxsize, menunotizysize);{} menunotiztext := t;{} menunotizposition := position;{} menunotiz ist gesetzt := TRUE{}END PROC write menunotice;{}PROC show menunotice:{} IF menunotiz ist gesetzt{} THEN boxnotice (menuwindow, menunotiztext, menunotizposition,{} menunotizx, menunotizy, menunotizxsize, menunotizysize);{} FI{}END PROC show menunotice;{}PROC erase menunotice:{} INT VAR spa, zei;{} get cursor (spa, zei);{}
- IF menunotiz ist gesetzt{} THEN page up (menunotizx, menunotizy, menunotizxsize, menunotizysize);{} menunotiz ist gesetzt := FALSE;{} cursor (spa, zei){} FI{}END PROC erase menunotice;{}PROC initialize menuwindow:{} schreibfenster := window (areax (menuwindow) + 1,{} areay (menuwindow) + 3,{} areaxsize (menuwindow) - 2,{} areaysize (menuwindow) - 4){}END PROC initialize menuwindow;{}
-PROC show menuwindow:{} initialize menuwindow;{} show (schreibfenster);{}END PROC show menuwindow;{}PROC menuwindow page:{} initialize menuwindow;{} page (schreibfenster){}END PROC menuwindow page;{}PROC menuwindowout (TEXT CONST text):{} out (schreibfenster, text){}END PROC menuwindow out;{}PROC menuwindowget (TEXT VAR text):{} get (schreibfenster, text){}END PROC menuwindowget;{}PROC menuwindoweditget (TEXT VAR text):{} editget (schreibfenster, text){}END PROC menuwindoweditget;{}PROC menuwindowedit (TEXT CONST dateiname):{}
- initialize menuwindow;{} edit (schreibfenster, dateiname){}END PROC menuwindowedit;{}PROC menuwindowedit (FILE VAR f):{} initialize menuwindow;{} edit (schreibfenster, f){}END PROC menuwindowedit;{}PROC menuwindowshow (TEXT CONST dateiname):{} initialize menuwindow;{} show (schreibfenster, dateiname){}END PROC menuwindowshow;{}PROC menuwindowshow (FILE VAR f):{} initialize menuwindow;{} show (schreibfenster, f){}END PROC menuwindowshow;{}BOOL PROC menuwindowyes (TEXT CONST frage):{} yes (schreibfenster, frage){}
-END PROC menuwindowyes;{}BOOL PROC menuwindowno (TEXT CONST frage):{} no (schreibfenster, frage){}END PROC menuwindowno;{}PROC menuwindowline:{} menuwindowline (1){}END PROC menuwindowline;{}PROC menuwindowline (INT CONST anzahl):{} line (schreibfenster, anzahl){}END PROC menuwindowline;{}PROC menuwindowcursor (INT CONST spa, zei):{} cursor (schreibfenster, spa, zei){}END PROC menuwindowcursor;{}PROC get menuwindowcursor (INT VAR spa, zei):{} get cursor (schreibfenster, spa, zei){}END PROC get menuwindowcursor;{}
-INT PROC remaining menuwindowlines:{} remaining lines (schreibfenster){}END PROC remaining menuwindowlines;{}TEXT PROC menuwindowcenter (TEXT CONST t):{} center (schreibfenster, t){}END PROC menuwindowcenter;{}PROC menuwindowstop:{} menuwindowstop (2){}END PROC menuwindowstop;{}PROC menuwindowstop (INT CONST anzahl):{} stop (schreibfenster, anzahl){}END PROC menuwindowstop;{}WINDOW PROC current menuwindow:{} initialize menuwindow;{} schreibfenster{}END PROC current menuwindow;{}PROC stdinfoedit (FILE VAR f, INT CONST oberste zeile):{}
- IF oberste zeile < 1 OR oberste zeile > 3{} THEN errorstop (fehlermeldung [13]);{} FI;{} garantiere menukarte;{} cursor (1, oberste zeile); out (cleop);{} cursor (1, 23); out(79 * waagerecht);{} cursor (1, 24); outtext (menubasistext (141), 1, 79);{} editorinfofenster := window (1, oberste zeile + 1, 79, 24 - oberste zeile);{} kommando auf taste legen ("?", "editorinformationen");{} command dialogue (FALSE);{} cursor on; edit (f, 1, oberste zeile, 79, 23 - oberste zeile);{} command dialogue (TRUE);{}
- kommando auf taste legen ("?", "").{} garantiere menukarte:{} TEXT VAR name := compress (menukartenname);{} IF name = ""{} THEN install menu (stdmenukartenname, FALSE){} FI.{}END PROC stdinfoedit;{}PROC stdinfoedit (FILE VAR f):{} stdinfoedit (f, 1){}END PROC stdinfoedit;{}PROC stdinfoedit (TEXT CONST dateiname, INT CONST oberste zeile):{} FILE VAR f :: sequential file (modify, dateiname);{} stdinfoedit (f, oberste zeile);{}END PROC stdinfoedit;{}PROC stdinfoedit (TEXT CONST dateiname):{}
- stdinfoedit (dateiname, 1){}END PROC stdinfoedit;{}PROC editorinformationen:{} BOOL VAR ende gewuenscht :: FALSE; INT VAR z;{} FOR z FROM startwert UPTO 22 REP{} cursor (1, z); out (cleol);{} PER;{} REP{} INT VAR erg := boxalternative (editorinfofenster,{} menubasistext (149),{} menubasistext (150),{} menubasistext (151),{} 5, FALSE, FALSE);{} erfuelle den wunsch{}
- UNTIL ende gewuenscht PER;{} cursor (2, 23); 77 TIMESOUT waagerecht;{} cursor (1, 24); outtext (menubasistext (141), 1, 79).{} startwert:{} areay (editorinfofenster) + 1.{} erfuelle den wunsch:{} SELECT erg OF{} CASE 1, 101, 109: boxinfo (editorinfofenster, menubasistext (142), 5, maxint, FALSE){} CASE 2, 102, 110: boxinfo (editorinfofenster, menubasistext (143), 5, maxint, FALSE){} CASE 3, 103, 111: boxinfo (editorinfofenster, menubasistext (144), 5, maxint, FALSE){} CASE 4, 104, 112: boxinfo (editorinfofenster, menubasistext (145), 5, maxint, FALSE){}
- CASE 5, 105, 113: boxinfo (editorinfofenster, menubasistext (146), 5, maxint, FALSE){} CASE 6, 106, 114: boxinfo (editorinfofenster, menubasistext (147), 5, maxint, FALSE){} CASE 7, 107, 115: boxinfo (editorinfofenster, menubasistext (148), 5, maxint, FALSE){} CASE 8, 108, 116: ende gewuenscht := TRUE{} OTHERWISE (*tue nichts*){} END SELECT{}END PROC editorinformationen;{}PROC bereinige situation:{} page;{} forget (ds);{} reset dialog{}END PROC bereinige situation;{}
-PROC direktstart (TEXT CONST procname, BOOL CONST autoloeschen):{} TEXT VAR datname := "Selbststartergenerierungsdatei", letzter := std;{} kopple archivmenukarte an;{} schreibe programm;{} insertiere programm;{} abkoppeln.{} kopple archivmenukarte an:{} install menu (stdmenukartenname, FALSE).{} schreibe programm:{} forget (datname, quiet);{} FILE VAR f :: sequential file (output, datname);{} putline (f, menubasistext (191));{} putline (f, "do (""reset dialog; erase menunotice; " + procname + """);");{}
- putline (f, menubasistext (192));{} IF autoloeschen{} THEN putline (f, menubasistext (193)){} ELSE putline (f, menubasistext (194)){} FI;{} putline (f, menubasistext (195));{} putline (f, menubasistext (196)).{} insertiere programm:{} TEXT VAR t := "insert (""" + datname + """)"; do (t).{} abkoppeln:{} forget (datname, quiet); last param (letzter);{} reset dialog;{} global manager.{}END PROC direktstart;{}END PACKET ls dialog 5;{}
+PACKET ls dialog 5 DEFINES
+ menufootnote, old menufootnote,
+ menuinfo,menualternative,
+ menuyes, menuno, menuone,
+ menusome,menuanswer,
+ menuanswerone, menuanswersome,
+ install menu, handle menu,
+ refresh submenu, deactivate,
+ regenerate menuscreen, activate,
+ write menunotice, erase menunotice,
+ menubasistext, anwendungstext,
+ show menuwindow, menuwindowpage,
+ menuwindowout, menuwindowget,
+ menuwindoweditget, menuwindowedit,
+
+ menuwindowshow, menuwindowline,
+ menuwindowyes, menuwindowno,
+ menuwindowcursor, get menuwindowcursor,
+ remaining menuwindowlines,
+ menuwindowcenter, menuwindowstop,
+ editorinformationen,stdinfoedit,
+ menukartenname, current menuwindow,
+ reset dialog, only intern, ausstieg,
+ direktstart:
+LET systemkuerzel = "ls-DIALOG",
+ menutafeltaskname = "ls-MENUKARTEN",
+ menutafeltype = 1954,
+ menutafelpraefix = "ls-MENUKARTE:",
+
+ stdmenukartenname = "ls-MENUKARTE:Archiv",
+ versionsnummer = "1.1",
+ copyright1 = " (C) 1987/88 Eva Latta-Weber",
+ copyright2 = " (C) 1988 ERGOS GmbH";
+LET maxmenus = 6,
+ maxmenutexte = 300,
+ maxinfotexte = 2000,
+ maxhauptmenupunkte = 10,
+ maxuntermenupunkte = 15,
+ erste untermenuzeile = 3;
+LET blank = " ",
+ piep = ""7"",
+
+ cleol = ""5"",
+ cleop = ""4"",
+ trennzeilensymbol = "###",
+ bleibt leer symbol = "***",
+ hauptmenuluecke = " ";
+LET auswahlstring1 = ""8""2""10""3""13""27"?";
+TYPE MENUPUNKT = STRUCT (TEXT punktkuerzel,
+ punktname,
+ procname,
+ boxtext,
+ BOOL aktiv,
+ angewaehlt),
+
+ EINZELMENU = STRUCT (INT belegt,
+ TEXT ueberschrift,
+ INT anfangsposition,
+ maxlaenge,
+ ROW maxuntermenupunkte MENUPUNKT menupunkt,
+ INT aktueller untermenupunkt,
+ TEXT startprozedurname,
+ leaveprozedurname),
+ MENU = STRUCT (TEXT menuname,
+ INT anzahl hauptmenupunkte,
+
+ ROW maxhauptmenupunkte EINZELMENU einzelmenu,
+ TEXT menueingangsprozedur,
+ menuausgangsprozedur,
+ menuinfo,
+ lizenznummer,
+ versionsnummer,
+ INT hauptmenuzeiger,
+ untermenuanfang,
+ untermenuzeiger),
+ INFOTEXT = STRUCT (INT anzahl infotexte,
+
+ ROW maxinfotexte TEXT stelle),
+ MENUTEXT = STRUCT (INT anzahl menutexte,
+ ROW maxmenutexte TEXT platz),
+ MENULEISTE = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,
+ ROW maxmenus MENU menu,
+ MENUTEXT menutext,
+ INFOTEXT infotext);
+BOUND MENULEISTE VAR menuleiste;
+DATASPACE VAR ds;
+WINDOW VAR menuwindow, schreibfenster, editorinfofenster;
+
+INITFLAG VAR in this task :: FALSE;
+INT VAR anzahl offener menus :: 0;
+INT VAR menunotizx, menunotizxsize,
+ menunotizy, menunotizysize,
+ menunotizposition;
+TEXT VAR angekoppelte menutafel :: "",
+ permanent footnote :: "",
+ menunotiztext;
+BOOL VAR menunotiz ist gesetzt :: FALSE,
+ nur interne verwendung :: FALSE,
+ mit ausstieg :: FALSE;
+REAL VAR zeitpunkt :: clock (1);
+
+ROW 13 TEXT CONST fehlermeldung :: ROW 13 TEXT : (
+"Die Task '" + menutafeltaskname + "' existiert nicht!",
+"Die Menukarte '",
+"' existiert nicht in der Task '" + menutafeltaskname + "'!",
+"' hat falschen Typ/Bezeichnung (keine 'MENUKARTE')!",
+"Das Menu '",
+"' ist nicht in der angekoppelten Menukarte!",
+"Zu viele geoeffnete Menus ( > 2 )!",
+"Kein Menu geoeffnet!",
+"Menu enthaelt keine Menupunkte!",
+"Menupunkt ist nicht im Menu enthalten!",
+"Kein Text vorhanden!",
+"Zugriff unmöglich!",
+
+"Einschränkung unzulässig!"
+);
+ROW 1 TEXT CONST vergleichstext :: ROW 1 TEXT : (
+"gibt es nicht"
+);
+ROW 3 TEXT CONST hinweis :: ROW 3 TEXT : (
+"Info:<ESC><?>/<?> Wahl:<Pfeile> Ausführen:<RETURN> Verlassen:<ESC><q>",
+" Zum Weitermachen bitte irgendeine Taste tippen!",
+"Bitte warten ... Ich räume auf!"
+);
+ROW 3 TEXT CONST infotext :: ROW 3 TEXT : (
+" Für diesen Menupunkt ist (noch) keine "13""13" Funktion eingetragen!",
+" Möchten Sie dieses Menu tatsächlich verlassen",
+" Leider ist zu diesem Menupunkt "13""13" kein Info - Text eingetragen!"
+
+ );
+PROC install menu (TEXT CONST menutafelname):
+ installmenu (menutafelname, TRUE)
+END PROC install menu;
+PROC install menu (TEXT CONST menutafelname, BOOL CONST mit kennung):
+ TEXT VAR letzter parameter;
+ IF mit kennung
+ THEN zeige menukennung
+ FI;
+ initialisiere menu ggf;
+ IF menutafel noch nicht angekoppelt
+ THEN letzter parameter := std;
+ hole menutafel;
+ kopple menutafel an;
+ last param (letzter parameter)
+ FI.
+ initialisiere menu ggf:
+
+ IF NOT initialized (in this task)
+ THEN angekoppelte menutafel := "";
+ anzahl offener menus := 0;
+ menunotiz ist gesetzt := FALSE;
+ nur interne verwendung := FALSE
+ FI.
+ menutafel noch nicht angekoppelt:
+ menutafelname <> angekoppelte menutafel.
+ hole menutafel:
+ IF NOT exists task (menutafeltaskname)
+ THEN bereinige situation; cursor on;
+ errorstop (fehlermeldung [1])
+ FI;
+ disable stop;
+ fetch (menutafelname, /menutafeltaskname);
+
+ IF is error AND pos (errormessage, vergleichstext [1]) > 0
+ THEN clear error; enable stop;
+ bereinige situation; cursor on;
+ errorstop (fehlermeldung [2] + menutafelname +
+ fehlermeldung [3])
+ ELIF is error
+ THEN clear error; enable stop;
+ bereinige situation; cursor on;
+ errorstop (errormessage)
+ ELSE enable stop
+ FI.
+ kopple menutafel an:
+ IF type (old (menutafelname)) = menutafeltype
+
+ AND pos (menutafelname,menutafelpraefix) = 1
+ THEN forget (ds);
+ ds := old (menutafelname);
+ menuleiste := ds;
+ angekoppelte menutafel := menutafelname;
+ forget (menutafelname, quiet)
+ ELSE bereinige situation; cursor on;
+ errorstop ("'" + menutafelname + fehlermeldung [4])
+ FI.
+END PROC install menu;
+PROC only intern (BOOL CONST wert):
+ nur interne verwendung := wert
+END PROC only intern;
+
+PROC ausstieg (BOOL CONST wert):
+ mit ausstieg := wert
+END PROC ausstieg;
+TEXT PROC menukartenname:
+ IF NOT initialized (in this task)
+ THEN angekoppelte menutafel := "";
+ anzahl offener menus := 0;
+ menunotiz ist gesetzt := FALSE;
+ FI;
+ angekoppelte menutafel
+END PROC menukartenname;
+PROC handle menu (TEXT CONST menuname):
+ nur interne verwendung := FALSE;
+ mit ausstieg := TRUE;
+ handle menu (menuname, "")
+END PROC handle menu;
+
+PROC handle menu (TEXT CONST menuname, ausstiegsproc):
+ cursor off;
+ IF nur interne verwendung
+ THEN oeffne menu (menuname)
+ ELSE biete menu an
+ FI;
+ lasse menupunkte auswaehlen;
+ IF nur interne verwendung
+ THEN do (ausstiegsproc);
+ anzahl offener menus DECR 1;
+ IF anzahl offener menus < 1 THEN erase menunotice FI;
+ menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;
+ menuwindow := window (1,1,79, 24);
+ nur interne verwendung := FALSE;
+
+ mit ausstieg := TRUE;
+ cursor on
+ ELSE schliesse menu;
+ leere ggf den bildschirm
+ FI.
+ biete menu an:
+ REAL VAR zwischenzeit :: clock (1) - zeitpunkt;
+ IF zwischenzeit < 2.0
+ THEN pause (20 - int (10.0 * zwischenzeit))
+ FI;
+ oeffne menu (menuname).
+ leere ggf den bildschirm:
+ IF anzahl offener menus < 1
+ THEN erase menunotice;
+ page; cursor on
+ FI.
+ lasse menupunkte auswaehlen:
+ TEXT VAR kuerzelkette :: "";
+
+ starte aktuelle untermenuoperationen;
+ REP
+ cursor in warteposition;
+ ermittle aktuelle kuerzelkette;
+ nimm zeichen auf;
+ interpretiere zeichen;
+ UNTIL menu verlassen gewuenscht PER.
+ nimm zeichen auf:
+ TEXT CONST erlaubte zeichen ::auswahlstring1 + kuerzelkette;
+ TEXT VAR eingabezeichen;
+ INT VAR zeichenposition;
+ REP
+ inchar (eingabezeichen);
+ zeichenposition := pos (erlaubte zeichen, eingabezeichen);
+ piepse ggf
+ UNTIL zeichenposition > 0 PER.
+
+ piepse ggf:
+ IF zeichenposition = 0 THEN out (piep) FI.
+ menu verlassen gewuenscht:
+ zeichenposition = 6 AND (zweites zeichen = "q").
+ interpretiere zeichen:
+ SELECT zeichenposition OF
+ CASE 1: gehe einen hauptmenupunkt nach links
+ CASE 2: gehe einen hauptmenupunkt nach rechts
+ CASE 3: gehe einen untermenupunkt nach unten
+ CASE 4: gehe einen untermenupunkt nach oben
+ CASE 5: fuehre aktuellen menupunkt aus
+ CASE 6: hole esc sequenz
+ CASE 7: zeige erklaerungstext im menu an
+
+ OTHERWISE werte kuerzeleingabe aus
+ END SELECT.
+ gehe einen hauptmenupunkt nach links:
+ INT VAR anzahl schritte :: 1;
+ beende aktuelle untermenuoperationen;
+ loesche aktuelles untermenu auf bildschirm;
+ loesche alte hauptmenumarkierung;
+ anzahl schritte INCR clear buffer and count (""8"");
+ ermittle linke menuposition;
+ stelle aktuellen hauptmenupunkt invers dar;
+ starte aktuelle untermenuoperationen;
+ schreibe aktuelles untermenu auf bildschirm.
+ gehe einen hauptmenupunkt nach rechts:
+
+ anzahl schritte := 1;
+ beende aktuelle untermenuoperationen;
+ loesche aktuelles untermenu auf bildschirm;
+ loesche alte hauptmenumarkierung;
+ anzahl schritte INCR clear buffer and count (""2"");
+ ermittle rechte menuposition;
+ stelle aktuellen hauptmenupunkt invers dar;
+ starte aktuelle untermenuoperationen;
+ schreibe aktuelles untermenu auf bildschirm.
+ loesche alte hauptmenumarkierung:
+ erase invers (area (menuwindow), startpos, 1, ueberschriftlaenge);
+
+ out (area (menuwindow), startpos, 1, ueberschrifttext).
+ startpos:
+ aktuelles untermenu.anfangsposition.
+ ueberschriftlaenge:
+ length (ueberschrifttext).
+ ueberschrifttext:
+ aktuelles untermenu.ueberschrift.
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ ermittle linke menuposition:
+ INT VAR positionszaehler;
+ FOR positionszaehler FROM 1 UPTO anzahl schritte REP
+
+ drehe die menuposition um einen wert runter
+ PER.
+ ermittle rechte menuposition:
+ FOR positionszaehler FROM 1 UPTO anzahl schritte REP
+ drehe die menuposition um einen wert hoch
+ PER.
+ drehe die menuposition um einen wert runter:
+ IF aktuelles menu.hauptmenuzeiger > 1
+ THEN aktuelles menu.hauptmenuzeiger DECR 1
+ ELSE aktuelles menu.hauptmenuzeiger
+ := aktuelles menu.anzahl hauptmenupunkte
+ FI.
+ drehe die menuposition um einen wert hoch:
+
+ IF aktuelles menu.hauptmenuzeiger
+ < aktuelles menu.anzahl hauptmenupunkte
+ THEN aktuelles menu.hauptmenuzeiger INCR 1
+ ELSE aktuelles menu.hauptmenuzeiger := 1
+ FI.
+ gehe einen untermenupunkt nach unten:
+ INT VAR naechster aktiver := folgender aktiver untermenupunkt;
+ nimm ummarkierung vor.
+ gehe einen untermenupunkt nach oben:
+ naechster aktiver := vorausgehender aktiver untermenupunkt;
+ nimm ummarkierung vor.
+ nimm ummarkierung vor:
+ IF ueberhaupt aktive menupunkte vorhanden
+
+ THEN demarkiere aktuellen untermenupunkt;
+ gehe zum folgenden untermenupunkt;
+ markiere aktuellen untermenupunkt
+ FI.
+ ueberhaupt aktive menupunkte vorhanden:
+ (aktuelles untermenu.belegt > 0) CAND (naechster aktiver > 0).
+ gehe zum folgenden untermenupunkt:
+ aktuelles menu.untermenuzeiger := naechster aktiver.
+ stelle aktuellen hauptmenupunkt invers dar:
+ out invers (area (menuwindow), startpos, 1, ueberschrifttext).
+ fuehre aktuellen menupunkt aus:
+
+ IF nur interne verwendung AND mit ausstieg
+ THEN kennzeichne als angetickt;
+ disable stop;
+ do (ausstiegsproc);
+ do (menuanweisung);
+ aktueller menupunkt.angewaehlt := FALSE;
+ IF is error THEN put error; clear error FI;
+ enable stop;
+ anzahl offener menus DECR 1;
+ menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;
+ menuwindow := window (1,1,79, 24);
+ nur interne verwendung := FALSE;
+
+ cursor on;
+ LEAVE handle menu
+ ELSE kennzeichne als angetickt;
+ fuehre operation aus (menuanweisung);
+ nimm kennzeichnung zurueck
+ FI.
+ kennzeichne als angetickt:
+ aktueller menupunkt.angewaehlt := TRUE;
+ markiere aktuellen untermenupunkt.
+ nimm kennzeichnung zurueck:
+ aktueller menupunkt.angewaehlt := FALSE;
+ markiere aktuellen untermenupunkt.
+ menuanweisung:
+ compress (aktueller menupunkt.procname).
+ aktueller menupunkt:
+
+ aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].
+ hole esc sequenz:
+ TEXT VAR zweites zeichen;
+ inchar (zweites zeichen);
+ SELECT pos ("q?$", zweites zeichen) OF
+ CASE 1: erfrage abbruch
+ CASE 2: zeige menubedienhinweise
+ CASE 3: gib info aus
+ OTHERWISE out (piep)
+ END SELECT.
+ erfrage abbruch:
+ IF menuno (infotext [2], 5)
+ THEN zweites zeichen := "n" (* gleichgültig, nur nicht 'q' *)
+ FI.
+ zeige menubedienhinweise:
+
+ INT VAR gewaehlt;
+ REP
+ gewaehlt := menualternative ( alttext, altwahl, altzusatz, 5, FALSE);
+ erfuelle den wunsch
+ UNTIL ausstieg aus bedienhinweisen gewuenscht PER.
+ alttext:
+ menuleiste.menutext.platz [1].
+ altwahl:
+ menuleiste.menutext.platz [2].
+ altzusatz:
+ menuleiste.menutext.platz [3].
+ erfuelle den wunsch:
+ SELECT gewaehlt OF
+ CASE 1,101,106: menuinfo (menuleiste.menutext.platz [4], 5, maxint)
+ CASE 2,102,107: menuinfo (menuleiste.menutext.platz [5], 5, maxint)
+
+ CASE 3,103,108: menuinfo (menuleiste.menutext.platz [6], 5, maxint)
+ CASE 4,104,109: menuinfo (menuleiste.menutext.platz [7], 5, maxint)
+ END SELECT.
+ ausstieg aus bedienhinweisen gewuenscht:
+ gewaehlt = 5 OR gewaehlt = 105 OR gewaehlt = 110.
+ gib info aus:
+ menuinfo (menuleiste.menutext.platz [20]).
+ zeige erklaerungstext im menu an:
+ IF compress (erklaerungstext) = ""
+ THEN menuinfo (infotext [3])
+ ELSE menuinfo (erklaerungstext)
+ FI.
+ erklaerungstext:
+
+ aktueller menupunkt.boxtext.
+ werte kuerzeleingabe aus:
+ naechster aktiver := pos (kuerzelkette, eingabezeichen);
+ nimm ummarkierung vor;
+ fuehre aktuellen menupunkt aus.
+ starte aktuelle untermenuoperationen:
+ ermittle aktuelle kuerzelkette;
+ IF startoperation <> ""
+ THEN fuehre operation aus (startoperation)
+ FI.
+ startoperation:
+ compress (aktuelles untermenu.startprozedurname).
+ ermittle aktuelle kuerzelkette:
+ kuerzelkette := "";
+ INT VAR kuerzelzeiger;
+
+ FOR kuerzelzeiger FROM 1 UPTO aktuelles untermenu.belegt REP
+ IF compress (aktuelles punktkuerzel) = ""
+ THEN kuerzelkette CAT ""0"" { beliebiger Code der Länge 1 }
+ ELSE haenge ggf kuerzel an
+ FI
+ PER.
+ aktuelles punktkuerzel:
+ aktuelles untermenu.menupunkt [kuerzelzeiger].punktkuerzel.
+ haenge ggf kuerzel an:
+ IF betrachteter punkt ist aktiv
+ THEN kuerzelkette CAT aktuelles punktkuerzel
+ ELSE kuerzelkette CAT ""0""
+ FI.
+ betrachteter punkt ist aktiv:
+
+ aktuelles untermenu.menupunkt [kuerzelzeiger].aktiv.
+ beende aktuelle untermenuoperationen:
+ kuerzelkette := "".
+END PROC handle menu;
+PROC oeffne menu (TEXT CONST menuname):
+ cursor off;
+ suche eingestelltes menu;
+ IF menu existiert nicht
+ THEN cursor on;
+ page;
+ errorstop (fehlermeldung [5] + menuname + fehlermeldung [6])
+ FI;
+ anzahl offener menus INCR 1;
+ ggf neue seite aufschlagen;
+ ueberpruefe anzahl offener menus;
+ lege ggf aktuelles menu auf eis;
+
+ initialisiere den menubildschirm;
+ IF NOT nur interne verwendung
+ THEN aktuelles menu.hauptmenuzeiger := 1;
+ aktuelles menu.untermenuzeiger := 0;
+ aktuelles menu.untermenuanfang := 0;
+ FI;
+ show menu;
+ fuehre ggf menueingangsprozedur aus;
+ zeige ggf menukenndaten an.
+ suche eingestelltes menu:
+ INT VAR i, suchzeiger;
+ BOOL VAR gefunden :: FALSE;
+ FOR i FROM 1 UPTO menuleiste.belegt REP
+ IF menuleiste.menu [i].menuname = menuname
+
+ THEN gefunden := TRUE;
+ suchzeiger := i;
+ FI
+ UNTIL menuleiste.menu [i].menuname = menuname PER.
+ menu existiert nicht:
+ NOT gefunden.
+ ueberpruefe anzahl offener menus:
+ IF anzahl offener menus > 2
+ THEN anzahl offener menus := 0; cursor on;
+ errorstop (fehlermeldung [7])
+ FI.
+ lege ggf aktuelles menu auf eis:
+ IF anzahl offener menus = 2
+ THEN menuleiste.zeigerhintergrund := menuleiste.zeigeraktuell
+ FI;
+ menuleiste.zeigeraktuell := suchzeiger.
+
+ initialisiere den menubildschirm:
+ IF anzahl offener menus = 2
+ THEN menuwindow := window (6, 4, 73, 20)
+ ELSE menuwindow := window (1, 1, 79, 24);
+ FI.
+ fuehre ggf menueingangsprozedur aus:
+ IF aktuelles menu.menueingangsprozedur <> ""
+ THEN fuehre operation aus (aktuelles menu.menueingangsprozedur)
+ FI.
+ ggf neue seite aufschlagen:
+ IF anzahl offener menus = 1 THEN page FI.
+ zeige ggf menukenndaten an:
+ IF anzahl offener menus = 1 AND aktuelles menu.menuinfo <> bleibt leer symbol
+
+ THEN write menunotice (vollstaendiger infotext, 4);
+ pause (100);
+ erase menunotice
+ FI.
+ vollstaendiger infotext:
+ aktuelles menu.menuinfo +
+ aktuelles menu.lizenznummer +
+ aktuelles menu.versionsnummer.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+END PROC oeffne menu;
+PROC show menu:
+ ueberpruefe menudaten;
+ stelle hauptmenuleiste zusammen;
+ zeige hauptmenu an;
+ stelle aktuellen hauptmenupunkt invers dar;
+ schreibe aktuelles untermenu auf bildschirm;
+
+ zeige informationszeile an.
+ ueberpruefe menudaten:
+ IF anzahl offener menus = 0
+ THEN errorstop (fehlermeldung [8])
+ ELIF aktuelles menu.anzahl hauptmenupunkte < 1
+ THEN errorstop (fehlermeldung [9])
+ FI.
+ stelle hauptmenuleiste zusammen:
+ TEXT VAR hauptmenuzeile :: "";
+ INT VAR zeiger;
+ hauptmenuzeile CAT aktuelles menu.menuname;
+ hauptmenuzeile CAT ":";
+ FOR zeiger FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP
+ haenge hauptmenupunkt an
+
+ PER.
+ haenge hauptmenupunkt an:
+ hauptmenuzeile CAT hauptmenuluecke;
+ hauptmenuzeile CAT hauptmenupunktname.
+ hauptmenupunktname:
+ aktuelles menu.einzelmenu [zeiger].ueberschrift.
+ zeige hauptmenu an:
+ page (menuwindow, TRUE);
+ out menuframe (area (menuwindow));
+ cursor (menuwindow, 1, 1);
+ out (menuwindow, hauptmenuzeile).
+ stelle aktuellen hauptmenupunkt invers dar:
+ cursor (menuwindow, startposition, 1);
+ out (menuwindow, invers (ueberschrifttext)).
+
+ startposition:
+ aktuelles untermenu.anfangsposition - 1.
+ ueberschrifttext:
+ aktuelles untermenu.ueberschrift.
+ zeige informationszeile an:
+ write permanent footnote (hinweis [1]).
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC show menu;
+PROC schreibe aktuelles untermenu auf bildschirm:
+ ermittle linke obere ecke des untermenukastens;
+ wirf untermenu aus;
+
+ show menunotice;
+ cursor in warteposition.
+ ermittle linke obere ecke des untermenukastens:
+ aktuelles menu.untermenuanfang := menumitte - halbe menubreite;
+ achte auf randextrema.
+ menumitte:
+ startposition + (length (ueberschrifttext) DIV 2) - 1.
+ startposition:
+ aktuelles untermenu.anfangsposition.
+ ueberschrifttext:
+ aktuelles untermenu.ueberschrift.
+ halbe menubreite:
+ aktuelles untermenu.maxlaenge DIV 2.
+ achte auf randextrema:
+ gleiche ggf linken rand aus;
+
+ gleiche ggf rechten rand aus.
+ gleiche ggf linken rand aus:
+ IF aktuelles menu.untermenuanfang < 4
+ THEN aktuelles menu.untermenuanfang := 4
+ FI.
+ gleiche ggf rechten rand aus:
+ IF (aktuelles menu.untermenuanfang + aktuelles untermenu.maxlaenge) >
+ (areaxsize (menuwindow) - 3)
+ THEN aktuelles menu.untermenuanfang
+ := areaxsize (menuwindow) - aktuelles untermenu.maxlaenge - 3
+ FI.
+ wirf untermenu aus:
+ IF aktuelles menu.untermenuzeiger = 0
+
+ THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt
+ FI;
+ wirf untermenukopfzeile aus;
+ wirf untermenurumpf aus;
+ wirf untermenufusszeile aus;
+ markiere aktuellen untermenupunkt.
+ wirf untermenukopfzeile aus:
+ cursor (menuwindow, spalte, anfangszeile);
+ out (balken oben); striche; out (balken oben).
+ wirf untermenufusszeile aus:
+ cursor (menuwindow, spalte, endezeile);
+ out (ecke unten links); striche; out (ecke unten rechts).
+ spalte:
+
+ aktuelles menu.untermenuanfang - 3.
+ anfangszeile:
+ erste untermenuzeile - 1.
+ endezeile:
+ erste untermenuzeile + aktuelles untermenu.belegt.
+ striche:
+ (aktuelles untermenu.maxlaenge + 5) TIMESOUT waagerecht.
+ wirf untermenurumpf aus:
+ INT VAR laufvar;
+ INT CONST aktuelle punktlaenge :: aktuelles untermenu.maxlaenge + 1;
+ FOR laufvar FROM 1 UPTO aktuelles untermenu.belegt REP
+ wirf eine einzelne menuzeile aus
+ PER.
+ wirf eine einzelne menuzeile aus:
+
+ out with beam (area (menuwindow), menuspalte, menuzeile,
+ aktueller punktname, laenge).
+ menuspalte:
+ aktuelles menu.untermenuanfang.
+ menuzeile:
+ erste untermenuzeile + laufvar - 1.
+ aktueller punktname:
+ untermenubezeichnung (laufvar).
+ laenge:
+ aktuelle punktlaenge.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC schreibe aktuelles untermenu auf bildschirm;
+
+PROC loesche aktuelles untermenu auf bildschirm:
+ beende aktuelle untermenuoperationen;
+ loesche untermenu auf bildschirm;
+ schreibe balken wieder hin;
+ aktuelles menu.untermenuzeiger := 1.
+ beende aktuelle untermenuoperationen:
+ IF leaveoperation <> ""
+ THEN fuehre operation aus (leaveoperation)
+ FI.
+ leaveoperation:
+ compress (aktuelles untermenu.leaveprozedurname).
+ loesche untermenu auf bildschirm:
+ INT VAR laufvar;
+ FOR laufvar FROM aktuelles untermenu.belegt + 1 DOWNTO 1 REP
+
+ loesche eine einzelne menuzeile
+ PER.
+ loesche eine einzelne menuzeile:
+ erase with beam (area (menuwindow), menuspalte, menuzeile, laenge).
+ menuspalte:
+ aktuelles menu.untermenuanfang.
+ menuzeile:
+ erste untermenuzeile + laufvar - 1.
+ laenge:
+ aktuelles untermenu.maxlaenge + 1.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+ schreibe balken wieder hin:
+
+ cursor (menuwindow, spalte, anfangszeile);
+ (aktuelles untermenu.maxlaenge + 7) TIMESOUT waagerecht.
+ spalte:
+ aktuelles menu.untermenuanfang - 3.
+ anfangszeile:
+ erste untermenuzeile - 1.
+END PROC loesche aktuelles untermenu auf bildschirm;
+PROC markiere aktuellen untermenupunkt:
+ IF aktuelles menu.untermenuzeiger <> 0
+ THEN laufe ggf zum naechsten aktiven menupunkt;
+ out invers with beam (area (menuwindow), menuspalte, menuzeile,
+ aktueller punktname, laenge)
+
+ FI.
+ laufe ggf zum naechsten aktiven menupunkt:
+ IF NOT aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].aktiv
+ THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt
+ FI.
+ menuspalte:
+ aktuelles menu.untermenuanfang.
+ menuzeile:
+ erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.
+ aktueller punktname:
+ untermenubezeichnung (aktuelles menu.untermenuzeiger).
+ laenge:
+ aktuelles untermenu.maxlaenge + 1.
+ aktuelles menu:
+
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC markiere aktuellen untermenupunkt;
+PROC demarkiere aktuellen untermenupunkt:
+ IF aktuelles menu.untermenuzeiger <> 0
+ THEN erase invers (area (menuwindow), menuspalte, menuzeile, laenge);
+ out (area (menuwindow), menuspalte, menuzeile,
+ aktueller punktname, laenge)
+ FI.
+ menuspalte:
+ aktuelles menu.untermenuanfang.
+
+ menuzeile:
+ erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.
+ aktueller punktname:
+ untermenubezeichnung (aktuelles menu.untermenuzeiger).
+ laenge:
+ aktuelles untermenu.maxlaenge + 1.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC demarkiere aktuellen untermenupunkt;
+INT PROC folgender aktiver untermenupunkt:
+ INT VAR anzahl aktiver menupunkte :: 0;
+
+ untersuche anzahl aktiver menupunkte;
+ IF kein aktiver menupunkt vorhanden
+ THEN 0
+ ELIF nur ein aktiver menupunkt vorhanden
+ THEN liefere einzigen aktiven menupunkt
+ ELSE liefere naechsten aktiven menupunkt
+ FI.
+ untersuche anzahl aktiver menupunkte:
+ INT VAR zaehler, position;
+ FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP
+ IF aktuelles untermenu.menupunkt [zaehler].aktiv
+ THEN anzahl aktiver menupunkte INCR 1;
+ position := zaehler
+
+ FI
+ UNTIL anzahl aktiver menupunkte > 1 PER.
+ kein aktiver menupunkt vorhanden:
+ anzahl aktiver menupunkte = 0.
+ nur ein aktiver menupunkt vorhanden:
+ anzahl aktiver menupunkte = 1.
+ liefere einzigen aktiven menupunkt:
+ position.
+ liefere naechsten aktiven menupunkt:
+ INT VAR interner zeiger;
+ stelle internen zeiger auf den naechsten menupunkt;
+ WHILE NOT punkt ist aktiv REP
+ untersuche naechsten menupunkt
+ PER;
+ ergebnis.
+ stelle internen zeiger auf den naechsten menupunkt:
+
+ IF aktuelles menu.untermenuzeiger = letzter untermenupunkt
+ THEN interner zeiger := 1
+ ELSE interner zeiger := aktuelles menu.untermenuzeiger + 1
+ FI.
+ letzter untermenupunkt:
+ aktuelles untermenu.belegt.
+ punkt ist aktiv:
+ aktuelles untermenu.menupunkt [interner zeiger].aktiv.
+ untersuche naechsten menupunkt:
+ IF interner zeiger = letzter untermenupunkt
+ THEN interner zeiger := 1
+ ELSE interner zeiger INCR 1
+ FI.
+
+ ergebnis:
+ interner zeiger.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC folgender aktiver untermenupunkt;
+INT PROC vorausgehender aktiver untermenupunkt:
+ INT VAR anzahl aktiver menupunkte :: 0;
+ untersuche anzahl aktiver menupunkte;
+ IF kein aktiver menupunkt vorhanden
+ THEN 0
+ ELIF nur ein aktiver menupunkt vorhanden
+ THEN liefere einzigen aktiven menupunkt
+
+ ELSE liefere vorausgehenden aktiven menupunkt
+ FI.
+ untersuche anzahl aktiver menupunkte:
+ INT VAR zaehler, position;
+ FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP
+ IF aktuelles untermenu.menupunkt [zaehler].aktiv
+ THEN anzahl aktiver menupunkte INCR 1;
+ position := zaehler
+ FI
+ UNTIL anzahl aktiver menupunkte > 1 PER.
+ kein aktiver menupunkt vorhanden:
+ anzahl aktiver menupunkte = 0.
+ nur ein aktiver menupunkt vorhanden:
+ anzahl aktiver menupunkte = 1.
+
+ liefere einzigen aktiven menupunkt:
+ position.
+ liefere vorausgehenden aktiven menupunkt:
+ INT VAR interner zeiger;
+ stelle internen zeiger auf vorausgehenden menupunkt;
+ WHILE NOT punkt ist aktiv REP
+ untersuche vorausgehenden menupunkt
+ PER;
+ ergebnis.
+ stelle internen zeiger auf vorausgehenden menupunkt:
+ IF aktuelles menu.untermenuzeiger <= 1
+ THEN interner zeiger := letzter untermenupunkt
+ ELSE interner zeiger := aktuelles menu.untermenuzeiger - 1
+
+ FI.
+ letzter untermenupunkt:
+ aktuelles untermenu.belegt.
+ punkt ist aktiv:
+ aktuelles untermenu.menupunkt [interner zeiger].aktiv.
+ untersuche vorausgehenden menupunkt:
+ IF interner zeiger = 1
+ THEN interner zeiger := letzter untermenupunkt
+ ELSE interner zeiger DECR 1
+ FI.
+ ergebnis:
+ interner zeiger.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+
+END PROC vorausgehender aktiver untermenupunkt;
+PROC cursor in warteposition:
+ cursor (areax (menuwindow), areay (menuwindow) + 1)
+END PROC cursor in warteposition;
+TEXT PROC untermenubezeichnung (INT CONST position):
+ TEXT VAR bezeichnung :: "";
+ bezeichnung CAT kennzeichnung;
+ bezeichnung CAT punktkennung;
+ bezeichnung.
+ kennzeichnung:
+ IF aktueller menupunkt.aktiv
+ AND aktueller menupunkt.angewaehlt
+ THEN "*"
+ ELIF aktueller menupunkt.aktiv
+
+ AND aktueller menupunkt.punktkuerzel <> ""
+ THEN aktueller menupunkt.punktkuerzel
+ ELIF aktueller menupunkt.aktiv
+ AND aktueller menupunkt.punktkuerzel = ""
+ THEN blank
+ ELSE "-"
+ FI.
+ punktkennung:
+ IF menupunkt ist trennzeile
+ THEN strichellinie
+ ELSE aktueller menupunkt.punktname
+ FI.
+ menupunkt ist trennzeile:
+ aktueller menupunkt.punktname = (blank + trennzeilensymbol).
+ strichellinie:
+
+ (aktuelles untermenu.maxlaenge + 1) * "-".
+ aktueller menupunkt:
+ aktuelles untermenu.menupunkt [position].
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC untermenubezeichnung;
+PROC fuehre operation aus (TEXT CONST operation):
+ disable stop;
+ IF operation = ""
+ THEN menuinfo (infotext [1]);
+ LEAVE fuehre operation aus
+ FI;
+ do (operation);
+
+ IF is error
+ THEN menuinfo (errormessage, 5);
+ clear error
+ FI;
+ old menufootnote;
+ enable stop;
+ cursor off
+END PROC fuehre operation aus;
+PROC veraendere aktivierung (TEXT CONST unterpunkt, BOOL CONST eintrag):
+ INT VAR unterpunktposition :: 0, zeiger;
+ suche unterpunkt;
+ aendere aktivierung.
+ suche unterpunkt:
+ FOR zeiger FROM 1 UPTO untermenuende REP
+ IF untermenupunkt = blank + compress (unterpunkt)
+ THEN unterpunktposition := zeiger;
+ LEAVE suche unterpunkt
+
+ FI
+ PER;
+ LEAVE veraendere aktivierung.
+ untermenuende:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.
+ untermenupunkt:
+ aktuelles untermenu.menupunkt [zeiger].punktname.
+ aendere aktivierung:
+ aktuelles untermenu.menupunkt [unterpunktposition].aktiv := eintrag.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC veraendere aktivierung;
+
+PROC veraendere aktivierung (INT CONST punktnummer, BOOL CONST eintrag):
+ IF punktnummer >= 1 AND punktnummer <= untermenuende
+ THEN aktuelles untermenu.menupunkt [punktnummer].aktiv := eintrag
+ FI.
+ untermenuende:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC veraendere aktivierung;
+PROC veraendere anwahl (TEXT CONST unterpunkt, BOOL CONST eintrag):
+
+ INT VAR unterpunktposition :: 0, zeiger;
+ suche unterpunkt;
+ aendere anwahl.
+ suche unterpunkt:
+ FOR zeiger FROM 1 UPTO untermenuende REP
+ IF untermenupunkt = blank + compress (unterpunkt)
+ THEN unterpunktposition := zeiger;
+ LEAVE suche unterpunkt
+ FI
+ PER;
+ enable stop;
+ errorstop (fehlermeldung [10]).
+ untermenuende:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.
+ untermenupunkt:
+ aktuelles untermenu.menupunkt [zeiger].punktname.
+
+ aendere anwahl:
+ aktuelles untermenu.menupunkt [unterpunktposition].angewaehlt := eintrag.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+ aktuelles untermenu:
+ aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
+END PROC veraendere anwahl;
+PROC activate (TEXT CONST unterpunkt):
+ enable stop;
+ veraendere aktivierung (unterpunkt, TRUE)
+END PROC activate;
+PROC activate (INT CONST punktnummer):
+ enable stop;
+ veraendere aktivierung (punktnummer, TRUE)
+
+END PROC activate;
+PROC deactivate (TEXT CONST unterpunkt):
+ enable stop;
+ veraendere aktivierung (unterpunkt, FALSE)
+END PROC deactivate;
+PROC deactivate (INT CONST punktnummer):
+ enable stop;
+ veraendere aktivierung (punktnummer, FALSE)
+END PROC deactivate;
+PROC select (TEXT CONST unterpunkt):
+ enable stop;
+ veraendere anwahl (unterpunkt, TRUE)
+END PROC select;
+PROC deselect (TEXT CONST unterpunkt):
+ enable stop;
+ veraendere anwahl (unterpunkt, FALSE)
+END PROC deselect;
+
+PROC schliesse menu:
+ IF aktuelles menu.menuausgangsprozedur <> ""
+ THEN menufootnote (hinweis [3]);
+ fuehre operation aus (aktuelles menu.menuausgangsprozedur)
+ FI;
+ anzahl offener menus DECR 1;
+ IF anzahl offener menus = 1
+ THEN aktiviere das auf eis gelegte menu
+ FI.
+ aktiviere das auf eis gelegte menu:
+ menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;
+ menuwindow := window (1, 1, 79, 24);
+ show menu.
+ aktuelles menu:
+ menuleiste.menu [menuleiste.zeigeraktuell].
+
+END PROC schliesse menu;
+PROC refresh submenu:
+ schreibe aktuelles untermenu auf bildschirm;
+ show menunotice;
+END PROC refresh submenu;
+PROC regenerate menuscreen:
+ IF anzahl offener menus = 0
+ THEN errorstop (fehlermeldung [8])
+ ELIF anzahl offener menus = 1
+ THEN page;
+ show menu;
+ show menunotice
+ ELSE zeige erstes menu an;
+ zeige zweites menu an;
+ show menunotice
+ FI.
+ zeige erstes menu an:
+ INT VAR menuzeiger :: menuleiste.zeigeraktuell;
+
+ menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;
+ menuwindow := window (1, 1, 79, 24);
+ anzahl offener menus := 1;
+ show menu.
+ zeige zweites menu an:
+ menuleiste.zeigeraktuell := menuzeiger;
+ menuwindow := window (6, 4, 73, 20);
+ anzahl offener menus := 2;
+ show menu.
+END PROC regenerate menuscreen;
+PROC menuinfo (TEXT CONST t, INT CONST position, timelimit):
+ boxinfo (menuwindow, t, position, timelimit, FALSE);
+ schreibe aktuelles untermenu auf bildschirm;
+
+ old menufootnote
+END PROC menuinfo;
+PROC menuinfo (TEXT CONST t, INT CONST position):
+ menuinfo (t, position, maxint)
+END PROC menuinfo;
+PROC menuinfo (TEXT CONST t):
+ menuinfo (t, 5, maxint)
+END PROC menuinfo;
+INT PROC menualternative (TEXT CONST t, auswahlliste, zusatztasten,
+ INT CONST position, BOOL CONST mit abbruch):
+ INT VAR ergebnis := boxalternative (menuwindow, t, auswahlliste,
+ zusatztasten, position, mit abbruch, FALSE);
+
+ schreibe aktuelles untermenu auf bildschirm;
+ old menufootnote;
+ ergebnis
+END PROC menualternative;
+BOOL PROC menuyes (TEXT CONST frage, INT CONST position):
+ BOOL VAR wert := boxyes (menuwindow, frage, position, FALSE);
+ schreibe aktuelles untermenu auf bildschirm;
+ old menufootnote;
+ wert
+END PROC menuyes;
+BOOL PROC menuno (TEXT CONST frage, INT CONST position):
+ NOT menuyes (frage, position)
+END PROC menuno;
+TEXT PROC menuone (THESAURUS CONST thes, TEXT CONST t1, t2,
+ BOOL CONST mit reinigung):
+
+ TEXT CONST wert :: boxone (menuwindow, thes, t1, t2, mit reinigung);
+ IF mit reinigung
+ THEN schreibe aktuelles untermenu auf bildschirm;
+ old menufootnote
+ FI;
+ wert
+END PROC menuone;
+THESAURUS PROC menusome (THESAURUS CONST thes, TEXT CONST t1, t2,
+ BOOL CONST mit reinigung):
+ THESAURUS CONST thesaurus :: boxsome (menuwindow, thes, t1, t2,
+ mit reinigung);
+ IF mit reinigung
+ THEN schreibe aktuelles untermenu auf bildschirm;
+
+ old menufootnote
+ FI;
+ thesaurus
+END PROC menusome;
+TEXT PROC menuanswer (TEXT CONST t, vorgabe, INT CONST position):
+ TEXT VAR wert :: boxanswer (menuwindow, t, vorgabe, position, FALSE);
+ schreibe aktuelles untermenu auf bildschirm;
+ old menufootnote;
+ wert
+END PROC menuanswer;
+TEXT PROC menuanswerone (TEXT CONST t, vorgabe, THESAURUS CONST thes,
+ TEXT CONST t1, t2, BOOL CONST mit reinigung):
+ TEXT VAR wert :: boxanswerone (menuwindow, t, vorgabe, thes, t1, t2,
+
+ mit reinigung, FALSE)
+ IF mit reinigung
+ THEN schreibe aktuelles untermenu auf bildschirm;
+ old menufootnote
+ FI;
+ wert
+END PROC menuanswer one;
+THESAURUS PROC menuanswersome (TEXT CONST t, vorgabe, THESAURUS CONST thes,
+ TEXT CONST t1, t2, BOOL CONST mit reinigung):
+ THESAURUS VAR wert :: boxanswersome (menuwindow, t, vorgabe,
+ thes, t1, t2, mit reinigung, FALSE)
+
+ IF mit reinigung
+ THEN schreibe aktuelles untermenu auf bildschirm;
+ old menufootnote
+ FI;
+ wert
+END PROC menuanswersome;
+PROC menufootnote (TEXT CONST t):
+ cursor (menuwindow, 1, areaysize (menuwindow) - 1);
+ areaxsize (menuwindow) TIMESOUT waagerecht;
+ cursor (menuwindow, 1, areaysize (menuwindow));
+ outtext (t, 1, areaxsize (menuwindow))
+END PROC menufootnote;
+PROC old menufootnote:
+ menufootnote (permanent footnote)
+END PROC old menufootnote;
+TEXT PROC menubasistext (INT CONST nummer):
+
+ IF nummer <= 20
+ THEN fehlermeldung [12]
+ ELIF nummer > menuleiste.menutext.anzahl menutexte
+ THEN fehlermeldung [11]
+ ELSE menuleiste.menutext.platz [nummer]
+ FI
+END PROC menubasistext;
+TEXT PROC anwendungstext (INT CONST nummer):
+ IF nummer > menuleiste.infotext.anzahl infotexte
+ THEN fehlermeldung [11]
+ ELSE menuleiste.infotext.stelle [nummer]
+ FI
+END PROC anwendungstext;
+PROC zeige menukennung:
+ IF anzahl offener menus = 0
+ THEN zeige angaben und emblem;
+
+ FI.
+ zeige angaben und emblem:
+ ROW 5 WINDOW VAR w;
+ w [ 1] := window (40, 3, 30, 9);
+ w [ 2] := window (36, 5, 30, 9);
+ w [ 3] := window (30, 7, 30, 9);
+ w [ 4] := window (22, 9, 30, 9);
+ w [ 5] := window (12, 11, 30, 9);
+ page;
+ show (w [1]); out (w [1], center (w [1], invers (systemkuerzel)));
+ show (w [2]); out (w [2], " Version " + versionsnummer);
+ show (w [3]); out (w [3], copyright1);
+ show (w [4]); out (w [4], copyright2);
+ show (w [5]);
+
+ cursor (w [5], 1, 2);out (w [5], " lll sssssssss ");
+ cursor (w [5], 1, 3);out (w [5], " lll sss sss ");
+ cursor (w [5], 1, 4);out (w [5], " lll sss ");
+ cursor (w [5], 1, 5);out (w [5], " lll sssssssss ");
+ cursor (w [5], 1, 6);out (w [5], " lll sss ");
+ cursor (w [5], 1, 7);out (w [5], " lll latta soft sss ");
+ cursor (w [5], 1, 8);out (w [5], " lllllllll sssssssss ");
+ cursor (79, 24);
+
+ zeitpunkt := clock (1);
+END PROC zeige menukennung;
+PROC reset dialog:
+ angekoppelte menutafel := "";
+ anzahl offener menus := 0
+END PROC reset dialog;
+PROC write permanent footnote (TEXT CONST t):
+ permanent footnote := t;
+ cursor (menuwindow, 1, areaysize (menuwindow));
+ outtext (t, 1, areaxsize (menuwindow))
+END PROC write permanent footnote;
+PROC write menunotice (TEXT CONST t, INT CONST position):
+ erase menunotice;
+ boxnotice (menuwindow, t, position, menunotizx, menunotizy,
+
+ menunotizxsize, menunotizysize);
+ menunotiztext := t;
+ menunotizposition := position;
+ menunotiz ist gesetzt := TRUE
+END PROC write menunotice;
+PROC show menunotice:
+ IF menunotiz ist gesetzt
+ THEN boxnotice (menuwindow, menunotiztext, menunotizposition,
+ menunotizx, menunotizy, menunotizxsize, menunotizysize);
+ FI
+END PROC show menunotice;
+PROC erase menunotice:
+ INT VAR spa, zei;
+ get cursor (spa, zei);
+
+ IF menunotiz ist gesetzt
+ THEN page up (menunotizx, menunotizy, menunotizxsize, menunotizysize);
+ menunotiz ist gesetzt := FALSE;
+ cursor (spa, zei)
+ FI
+END PROC erase menunotice;
+PROC initialize menuwindow:
+ schreibfenster := window (areax (menuwindow) + 1,
+ areay (menuwindow) + 3,
+ areaxsize (menuwindow) - 2,
+ areaysize (menuwindow) - 4)
+END PROC initialize menuwindow;
+
+PROC show menuwindow:
+ initialize menuwindow;
+ show (schreibfenster);
+END PROC show menuwindow;
+PROC menuwindow page:
+ initialize menuwindow;
+ page (schreibfenster)
+END PROC menuwindow page;
+PROC menuwindowout (TEXT CONST text):
+ out (schreibfenster, text)
+END PROC menuwindow out;
+PROC menuwindowget (TEXT VAR text):
+ get (schreibfenster, text)
+END PROC menuwindowget;
+PROC menuwindoweditget (TEXT VAR text):
+ editget (schreibfenster, text)
+END PROC menuwindoweditget;
+PROC menuwindowedit (TEXT CONST dateiname):
+
+ initialize menuwindow;
+ edit (schreibfenster, dateiname)
+END PROC menuwindowedit;
+PROC menuwindowedit (FILE VAR f):
+ initialize menuwindow;
+ edit (schreibfenster, f)
+END PROC menuwindowedit;
+PROC menuwindowshow (TEXT CONST dateiname):
+ initialize menuwindow;
+ show (schreibfenster, dateiname)
+END PROC menuwindowshow;
+PROC menuwindowshow (FILE VAR f):
+ initialize menuwindow;
+ show (schreibfenster, f)
+END PROC menuwindowshow;
+BOOL PROC menuwindowyes (TEXT CONST frage):
+ yes (schreibfenster, frage)
+
+END PROC menuwindowyes;
+BOOL PROC menuwindowno (TEXT CONST frage):
+ no (schreibfenster, frage)
+END PROC menuwindowno;
+PROC menuwindowline:
+ menuwindowline (1)
+END PROC menuwindowline;
+PROC menuwindowline (INT CONST anzahl):
+ line (schreibfenster, anzahl)
+END PROC menuwindowline;
+PROC menuwindowcursor (INT CONST spa, zei):
+ cursor (schreibfenster, spa, zei)
+END PROC menuwindowcursor;
+PROC get menuwindowcursor (INT VAR spa, zei):
+ get cursor (schreibfenster, spa, zei)
+END PROC get menuwindowcursor;
+
+INT PROC remaining menuwindowlines:
+ remaining lines (schreibfenster)
+END PROC remaining menuwindowlines;
+TEXT PROC menuwindowcenter (TEXT CONST t):
+ center (schreibfenster, t)
+END PROC menuwindowcenter;
+PROC menuwindowstop:
+ menuwindowstop (2)
+END PROC menuwindowstop;
+PROC menuwindowstop (INT CONST anzahl):
+ stop (schreibfenster, anzahl)
+END PROC menuwindowstop;
+WINDOW PROC current menuwindow:
+ initialize menuwindow;
+ schreibfenster
+END PROC current menuwindow;
+PROC stdinfoedit (FILE VAR f, INT CONST oberste zeile):
+
+ IF oberste zeile < 1 OR oberste zeile > 3
+ THEN errorstop (fehlermeldung [13]);
+ FI;
+ garantiere menukarte;
+ cursor (1, oberste zeile); out (cleop);
+ cursor (1, 23); out(79 * waagerecht);
+ cursor (1, 24); outtext (menubasistext (141), 1, 79);
+ editorinfofenster := window (1, oberste zeile + 1, 79, 24 - oberste zeile);
+ kommando auf taste legen ("?", "editorinformationen");
+ command dialogue (FALSE);
+ cursor on; edit (f, 1, oberste zeile, 79, 23 - oberste zeile);
+ command dialogue (TRUE);
+
+ kommando auf taste legen ("?", "").
+ garantiere menukarte:
+ TEXT VAR name := compress (menukartenname);
+ IF name = ""
+ THEN install menu (stdmenukartenname, FALSE)
+ FI.
+END PROC stdinfoedit;
+PROC stdinfoedit (FILE VAR f):
+ stdinfoedit (f, 1)
+END PROC stdinfoedit;
+PROC stdinfoedit (TEXT CONST dateiname, INT CONST oberste zeile):
+ FILE VAR f :: sequential file (modify, dateiname);
+ stdinfoedit (f, oberste zeile);
+END PROC stdinfoedit;
+PROC stdinfoedit (TEXT CONST dateiname):
+
+ stdinfoedit (dateiname, 1)
+END PROC stdinfoedit;
+PROC editorinformationen:
+ BOOL VAR ende gewuenscht :: FALSE; INT VAR z;
+ FOR z FROM startwert UPTO 22 REP
+ cursor (1, z); out (cleol);
+ PER;
+ REP
+ INT VAR erg := boxalternative (editorinfofenster,
+ menubasistext (149),
+ menubasistext (150),
+ menubasistext (151),
+ 5, FALSE, FALSE);
+ erfuelle den wunsch
+
+ UNTIL ende gewuenscht PER;
+ cursor (2, 23); 77 TIMESOUT waagerecht;
+ cursor (1, 24); outtext (menubasistext (141), 1, 79).
+ startwert:
+ areay (editorinfofenster) + 1.
+ erfuelle den wunsch:
+ SELECT erg OF
+ CASE 1, 101, 109: boxinfo (editorinfofenster, menubasistext (142), 5, maxint, FALSE)
+ CASE 2, 102, 110: boxinfo (editorinfofenster, menubasistext (143), 5, maxint, FALSE)
+ CASE 3, 103, 111: boxinfo (editorinfofenster, menubasistext (144), 5, maxint, FALSE)
+ CASE 4, 104, 112: boxinfo (editorinfofenster, menubasistext (145), 5, maxint, FALSE)
+
+ CASE 5, 105, 113: boxinfo (editorinfofenster, menubasistext (146), 5, maxint, FALSE)
+ CASE 6, 106, 114: boxinfo (editorinfofenster, menubasistext (147), 5, maxint, FALSE)
+ CASE 7, 107, 115: boxinfo (editorinfofenster, menubasistext (148), 5, maxint, FALSE)
+ CASE 8, 108, 116: ende gewuenscht := TRUE
+ OTHERWISE (*tue nichts*)
+ END SELECT
+END PROC editorinformationen;
+PROC bereinige situation:
+ page;
+ forget (ds);
+ reset dialog
+END PROC bereinige situation;
+
+PROC direktstart (TEXT CONST procname, BOOL CONST autoloeschen):
+ TEXT VAR datname := "Selbststartergenerierungsdatei", letzter := std;
+ kopple archivmenukarte an;
+ schreibe programm;
+ insertiere programm;
+ abkoppeln.
+ kopple archivmenukarte an:
+ install menu (stdmenukartenname, FALSE).
+ schreibe programm:
+ forget (datname, quiet);
+ FILE VAR f :: sequential file (output, datname);
+ putline (f, menubasistext (191));
+ putline (f, "do (""reset dialog; erase menunotice; " + procname + """);");
+
+ putline (f, menubasistext (192));
+ IF autoloeschen
+ THEN putline (f, menubasistext (193))
+ ELSE putline (f, menubasistext (194))
+ FI;
+ putline (f, menubasistext (195));
+ putline (f, menubasistext (196)).
+ insertiere programm:
+ TEXT VAR t := "insert (""" + datname + """)"; do (t).
+ abkoppeln:
+ forget (datname, quiet); last param (letzter);
+ reset dialog;
+ global manager.
+END PROC direktstart;
+END PACKET ls dialog 5;
+