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