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