(* ********************************************************* ********************************************************* ** ** ** ls-Menu-Generator 2 ** ** ** ** Version 1.0 ** ** ** ** (Stand: 30.03.88) ** ** ** ** ** ** Autor: Wolfgang Weber, Bielefeld ** ** ** ** ** ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** ** ** ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** ** ** ********************************************************* ********************************************************* *) PACKET ls menu generator 2 DEFINES oeffne menukarte, oeffne menu, oberbegriff, menufunktion, trennlinie, schliesse menu, schliesse menukarte, testinstallation: LET menutafeltype = 1954, kennung = "ls - Menu - Generator", mm taskname = "ls-MENUKARTEN", menutafelpraefix = "ls-MENUKARTE:", menu grundtext = "ls-MENUBASISTEXTE", zwischenablagename = "MENU-ZWISCHENABLAGEDATEI INTERN"; LET maxmenus = 6, maxmenutexte = 300, maxinfotexte = 2000, maxhauptmenupunkte = 10, maxuntermenupunkte = 15, maxmenubreite = 71; (* Breite der Hauptmenüzeile - 2 *) LET blank = " ", cleop = ""4"", piep = ""7"", trennzeilensymbol = "###", bleibt leer symbol = "***", hauptmenuluecke = " "; LET dummyname = "Dummy für Anwendertexte", install finished = "Installation abgeschlossen!", card finished = "Menukartengenerierung abgeschlossen!", filetype = 1003; 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); ROW 14 TEXT CONST aussage :: ROW 14 TEXT : ( "ACHTUNG - Eine Menukarte mit diesem Namen existiert bereits - ACHTUNG", "Kann die bereits existierende Menukarte gelöscht werden", "Dann kann keine neue Menukarte mit diesem Namen erstellt werden!", "Zum Weitermachen bitte irgendeine Taste tippen!", "Sollen auch Anwendungstexte in die Menukarte aufgenommen werden", "Auswahl der Datei, in der die Anwendungstexte stehen.", "Bitte die gewünschte Datei ankreuzen!", "Durchgang 1 von 2 Durchgängen - in Arbeit ist Zeile: ", "Durchgang 2 von 2 Durchgängen - in Arbeit ist Zeile: ", "", "Einlesen von Texten aus Datei : ", "Bearbeitet wird Menu : ", "Eingetragen wird Oberbegriff : ", "Eingetragen wird Menufunktion : " ); ROW 22 TEXT CONST fehlermeldung :: ROW 22 TEXT : ( "Ohne die Datei '", "' "13""10""10" ist die Menuerstellung "15"unmöglich "14"!!", "Hier muß unbedingt eine Datei angekreuzt werden!", "Ausgewählte Datei hat falschen Typ (<> 1003) )", "Zu viele Anwendungstexte in der Datei ", "Anführungszeichen fehlt am Anfang oder Ende der Zeile ", "Anführungszeichen fehlt irgendwo in Zeile ", "Die angegebene Datei existiert nicht!", "Menukarte noch nicht geöffnet ('oeffne menukarte' fehlt)! ", "Vorausgehendes Menu nicht geschlossen! ", "Zu viele Menus in der Menukarte (> " + text (maxmenus) + ")!", "Menuname ist mehrfach vorhanden!", "Menu noch nicht geoeffnet ('oeffne menu' fehlt)!", "Zu viele Oberbegriffe in einem Menu (> " + text (maxhauptmenupunkte) + ")!", "Die Kopfzeile ist zu lang (> " + text (maxmenubreite) + ")!", "Menupunkt-Kürzel ist länger als ein Zeichen!", "Menupunkt-Kürzel kommt mehrfach vor (nicht eindeutig)!", "Menupunkt-Bezeichnung ist zu lang!", "Zu viele (> " + text (maxuntermenupunkte) + ") Menupunkte in einem Pull-Down-Menu!", "Menukarte '", "' gibt es nicht in dieser Task!", "' hat falsche(n) Typ/Bezeichnung" ); TEXT VAR menuinfotextdateiname, aktueller menudateiname; BOOL VAR menuleiste ist bereit :: FALSE, menu ist geoeffnet :: FALSE; BOUND MENULEISTE VAR menuleiste; BOUND MENUTEXT VAR basistexte; BOUND MENU VAR aktuelles menu; DATASPACE VAR ds; OP := (MENUTEXT VAR ziel, MENUTEXT VAR quelle): INT VAR z; ziel.anzahl menutexte := quelle.anzahl menutexte; FOR z FROM 1 UPTO quelle.anzahl menutexte REP ziel.platz [z] := quelle.platz [z] PER END OP :=; OP := (MENU VAR ziel, MENU CONST quelle): CONCR (ziel) := CONCR (quelle) END OP :=; OP := (EINZELMENU VAR ziel, EINZELMENU CONST quelle): CONCR (ziel) := CONCR (quelle) END OP :=; OP := (MENUPUNKT VAR ziel, MENUPUNKT CONST quelle): CONCR (ziel) := CONCR (quelle) END OP :=; PROC oeffne menukarte (TEXT CONST menukartenname): gib bildschirmhinweis aus; ueberpruefe voraussetzungen; erfrage den namen der datei mit den anwendertexten; erstelle neue menuleiste. gib bildschirmhinweis aus: page; out (center (invers (kennung))). ueberpruefe voraussetzungen: ueberpruefe ob basistexte vorhanden sind; ueberpruefe ob menukarte schon vorhanden ist. ueberpruefe ob basistexte vorhanden sind: IF NOT exists (menu grundtext) THEN gib hinweis und brich ab FI. gib hinweis und brich ab: disable stop; fetch (menu grundtext, /mm taskname); IF is error THEN clear error; enable stop; cursor (1, 4); out (cleop); errorstop (fehlermeldung [1] + menu grundtext + fehlermeldung [2]) ELSE clear error; enable stop FI. ueberpruefe ob menukarte schon vorhanden ist: IF exists (menukarte) THEN gib hinweis auf vorhandene menukarte; frage ob die alte karte geloescht werden darf FI. menukarte: menutafelpraefix + menukartenname. gib hinweis auf vorhandene menukarte: cursor (1, 4); out (cleop); cursor (1, 4); out (center (menukarte)); cursor (1, 6); out (center (invers (aussage [1]))). frage ob die alte karte geloescht werden darf: cursor (2, 9); IF yes (aussage [2]) THEN forget (menukarte, quiet) ELSE weiterarbeit ist unmoeglich FI. weiterarbeit ist unmoeglich: cursor (1, 12); out (center (invers (aussage [3]))); cursor (2, 15); out (aussage [4]); cursor (2, 16); pause; page; errorstop (""). erfrage den namen der datei mit den anwendertexten: cursor (1, 4); out (cleop); IF yes (aussage [5]) THEN biete dateiauswahl an ELSE erzeuge dateidummy FI. biete dateiauswahl an: menuinfotextdateiname := one (2, 6, 77, 19, ALL myself, aussage [6], aussage [7]); ueberpruefe den dateinamen; ueberpruefe den dateityp. ueberpruefe den dateinamen: IF compress (menuinfotextdateiname) = "" THEN page; errorstop (fehlermeldung [3]) FI. ueberpruefe den dateityp: IF datei hat falschen typ THEN page; errorstop (fehlermeldung [4]) FI. datei hat falschen typ: ds := old (menuinfotextdateiname); IF type (ds) <> filetype THEN forget (ds); TRUE ELSE forget (ds); FALSE FI. erzeuge dateidummy: forget (dummyname, quiet); FILE VAR datei :: sequential file (modify, dummyname); to line (datei, 1); menuinfotextdateiname := dummyname. erstelle neue menuleiste: INT VAR zeiger; TEXT VAR zeileninhalt; initialisiere werte; aktueller menudateiname := menukarte; menuleiste := new (aktueller menudateiname); type (old (aktueller menudateiname), menutafeltype); menuleiste.belegt := 0; menuleiste ist bereit := TRUE; trage menubasistexte ein; trage anwendungstexte ein. initialisiere werte: menuleiste ist bereit := FALSE; menu ist geoeffnet := FALSE. trage menubasistexte ein: basistexte := old (menu grundtext); menuleiste.menutext := basistexte. trage anwendungstexte ein: konvertiere (menuinfotextdateiname, zwischenablagename, menuleiste.infotext.anzahl infotexte); ueberpruefe anwendungstextanzahl; trage anwendungstexte in die menuleiste. ueberpruefe anwendungstextanzahl: IF menuleiste.infotext.anzahl infotexte > maxinfotexte THEN forget (zwischenablagename, quiet); forget (aktueller menudateiname, quiet); errorstop (fehlermeldung [5] + "'" + menuinfotextdateiname + "'") FI. trage anwendungstexte in die menuleiste: gib hinweis auf anwendungstexteintrag; FILE VAR ein :: sequential file (input, zwischenablagename); FOR zeiger FROM 1 UPTO menuleiste.infotext.anzahl infotexte REP getline (ein, zeileninhalt); menuleiste.infotext.stelle [zeiger] := zeileninhalt; cout (zeiger) PER; forget (zwischenablagename, quiet); forget (dummyname , quiet). gib hinweis auf anwendungstexteintrag: cursor (1, 7); out (aussage [9]). END PROC oeffne menukarte; PROC konvertiere (TEXT CONST eingabedatei, ausgabedatei, INT VAR anzahl konvertierter saetze): loesche ausgabedatei; untersuche eingabedatei; konvertiere saetze. loesche ausgabedatei: IF exists (ausgabedatei) THEN forget (ausgabedatei, quiet) FI. untersuche eingabedatei: IF NOT exists (eingabedatei) THEN errorstop (fehlermeldung [8]) FI. konvertiere saetze: gib hinweis; konvertiere satzweise. gib hinweis: cursor (1, 4); out (cleop); cursor (1, 4); out (aussage [11] + "'" + eingabedatei + "'"); cursor (1, 6); out (aussage [ 8]); anzahl konvertierter saetze := 0. konvertiere satzweise: TEXT VAR zeileninhalt :: ""; FILE VAR eingabe :: sequential file (input, eingabedatei); WHILE NOT eof (eingabe) REP behandle eine dateizeile PER; optimiere ausgabedatei. behandle eine dateizeile: getline (eingabe, zeileninhalt); anzahl konvertierter saetze INCR 1; cout (anzahl konvertierter saetze); untersuche zeile; wandle die zeile um; FILE VAR aus :: sequential file (output, ausgabedatei); write (aus, textausgabe). untersuche zeile: zeileninhalt := compress (zeileninhalt); IF zeileninhalt = "" THEN zeileninhalt := """""" FI; IF (zeileninhalt SUB 1) <> """" OR (zeileninhalt SUB length (zeileninhalt)) <> """" THEN bereite abgang vor; errorstop (fehlermeldung [6] + text (anzahl konvertierter saetze)) FI. wandle die zeile um: TEXT VAR textausgabe :: "", codekette; zeileninhalt := subtext (zeileninhalt, 2, length (zeileninhalt) - 1); WHILE gaensefuesschenposition > 0 REP textausgabe CAT subtext (zeileninhalt, 1, gaensefuesschenposition - 1); zeileninhalt := subtext (zeileninhalt, gaensefuesschenposition); codekette := subtext (zeileninhalt, 1, pos (zeileninhalt, """", 2)); IF codekette = """7""" THEN textausgabe CAT ""7"" ELIF codekette = """5""" THEN textausgabe CAT ""5"" ELIF codekette = """4""" THEN textausgabe CAT ""4"" ELIF codekette = """10""" THEN textausgabe CAT ""10"" ELIF codekette = """13""" THEN textausgabe CAT ""13"" ELIF codekette = """14""" THEN textausgabe CAT ""14"" ELIF codekette = """15""" THEN textausgabe CAT ""15"" ELIF codekette = """""" THEN textausgabe CAT """" ELSE errorstop (fehlermeldung [7] + text (anzahl konvertierter saetze)) FI; zeileninhalt := subtext (zeileninhalt, 1 + length (codekette)) PER; textausgabe CAT zeileninhalt. gaensefuesschenposition: pos (zeileninhalt, """"). bereite abgang vor: forget (ausgabedatei, quiet); line (2). optimiere ausgabedatei: FILE VAR ausgabe :: sequential file (modify, ausgabedatei); WHILE lines (ausgabe) > 0 CAND letzter satz ist leer REP to line (ausgabe, lines (ausgabe)); delete record (ausgabe); anzahl konvertierter saetze DECR 1; cout (anzahl konvertierter saetze ) PER. letzter satz ist leer: TEXT VAR satz; to line (ausgabe,lines (ausgabe)); read record (ausgabe, satz); IF compress (satz) = "" OR compress (satz) = ""13"" THEN TRUE ELSE FALSE FI. END PROC konvertiere; PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc, itext, ltext, vtext): gib hinweis auf geoeffnetes menu; ueberpruefe auf ungereimtheiten; nimm eintragungen in datenraum vor. gib hinweis auf geoeffnetes menu: cursor (1, 4); out (cleop); out (aussage [12]); out (invers (name)); cursor (1, 6). ueberpruefe auf ungereimtheiten: pruefe auf bereits geoeffnete menuliste; pruefe auf noch geoeffnetes menu; pruefe auf noch freie menuplaetze; pruefe auf schon vorhandenen menunamen. pruefe auf bereits geoeffnete menuliste: IF NOT menuleiste ist bereit THEN bereinige eintragungen (9) FI. pruefe auf noch geoeffnetes menu: IF menu ist geoeffnet THEN bereinige eintragungen (10) FI. pruefe auf noch freie menuplaetze: IF menuleiste.belegt = maxmenus THEN bereinige eintragungen (11) FI. pruefe auf schon vorhandenen menunamen: IF menuname schon vorhanden THEN bereinige eintragungen (12) FI. menuname schon vorhanden: INT VAR i; FOR i FROM 1 UPTO menuleiste.belegt REP untersuche einzelnen menunamen PER; FALSE. untersuche einzelnen menunamen: IF menuleiste.menu [i].menuname = compress (name) THEN LEAVE menuname schon vorhanden WITH TRUE FI. nimm eintragungen in datenraum vor: forget (ds); ds := nilspace; aktuelles menu := ds; init (aktuelles menu); aktuelles menu.menuname := compress (name); aktuelles menu.menueingangsprozedur := compress (einstiegsproc); aktuelles menu.menuausgangsprozedur := compress (ausstiegsproc); IF itext <> "" THEN aktuelles menu.menuinfo := itext; aktuelles menu.lizenznummer := ltext; aktuelles menu.versionsnummer := vtext ELSE aktuelles menu.menuinfo := bleibt leer symbol; aktuelles menu.lizenznummer := ""; aktuelles menu.versionsnummer := "" FI; menu ist geoeffnet := TRUE. END PROC oeffne menu; PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc): oeffne menu (name, einstiegsproc, ausstiegsproc, "", "", "") END PROC oeffne menu; PROC oeffne menu (TEXT CONST name): oeffne menu (name, "", "", "", "", "") END PROC oeffne menu; PROC bereinige eintragungen (INT CONST nummer): forget (ds); forget (aktueller menudateiname, quiet); menuleiste ist bereit := FALSE; menu ist geoeffnet := FALSE; errorstop (fehlermeldung [nummer]) END PROC bereinige eintragungen; PROC init (MENU VAR m): m.menuname := ""; m.hauptmenuzeiger := 1; m.untermenuanfang := 0; m.untermenuzeiger := 0; m.menueingangsprozedur := ""; m.menuausgangsprozedur := ""; m.menuinfo := ""; m.versionsnummer := ""; m.anzahl hauptmenupunkte := 0; belege hauptmenupunkte. belege hauptmenupunkte: INT VAR i; FOR i FROM 1 UPTO maxhauptmenupunkte REP aktuelles einzelmenu.belegt := 0; aktuelles einzelmenu.ueberschrift := ""; aktuelles einzelmenu.anfangsposition := 0; aktuelles einzelmenu.maxlaenge := 0; aktuelles einzelmenu.aktueller untermenupunkt := 1; aktuelles einzelmenu.startprozedurname := ""; aktuelles einzelmenu.leaveprozedurname := ""; belege untermenuepunkte PER. belege untermenuepunkte: INT VAR j; FOR j FROM 1 UPTO maxuntermenupunkte REP aktueller menupunkt.punktkuerzel := ""; aktueller menupunkt.punktname := ""; aktueller menupunkt.procname := ""; aktueller menupunkt.boxtext := ""; aktueller menupunkt.aktiv := TRUE; aktueller menupunkt.angewaehlt := FALSE PER. aktuelles einzelmenu: m.einzelmenu [i]. aktueller menupunkt: aktuelles einzelmenu.menupunkt [j]. END PROC init; PROC oberbegriff (TEXT CONST punktname, startprocname, leaveprocname): gib hinweis auf oberbegriff; untersuche ob menu geoeffnet und bereit ist; untersuche oberbegriffe; trage neuen oberbegriff ein; notiere die anfangsposition; notiere start und leaveprozedur; erhoehe die anzahl der oberbegriffe. gib hinweis auf oberbegriff: cursor (1, 6); out (cleop); cursor (1, 6); out (aussage [13]); out (invers (punktname)); line. untersuche ob menu geoeffnet und bereit ist: IF NOT menuleiste ist bereit THEN bereinige eintragungen ( 9) FI; IF NOT menu ist geoeffnet THEN bereinige eintragungen (13) FI. untersuche oberbegriffe: IF zu viele oberbegriffe THEN bereinige eintragungen (14) FI; IF gesamtlaenge > maxmenubreite THEN bereinige eintragungen (15) FI. zu viele oberbegriffe: aktuelles menu.anzahl hauptmenupunkte = maxhauptmenupunkte. gesamtlaenge: gesamtlaenge ohne letzten punkt + length (compress (punktname)). gesamtlaenge ohne letzten punkt: length (hauptmenuzeile). hauptmenuzeile: INT VAR zaehler; TEXT VAR zeile :: ""; schreibe menunamen; schreibe oberbegriffe; zeile. schreibe menunamen: IF aktuelles menu. menuname <> "" THEN zeile CAT aktuelles menu.menuname; zeile CAT ":" FI. schreibe oberbegriffe: FOR zaehler FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP zeile CAT hauptmenuluecke; zeile CAT aktuelles menu. einzelmenu [zaehler].ueberschrift PER; zeile CAT hauptmenuluecke. trage neuen oberbegriff ein: neuer menupunkt.ueberschrift := compress (punktname). notiere die anfangsposition: neuer menupunkt.anfangsposition := gesamtlaenge ohne letzten punkt + 1. notiere start und leaveprozedur: neuer menupunkt.startprozedurname := compress (startprocname); neuer menupunkt.leaveprozedurname := compress (leaveprocname). neuer menupunkt: aktuelles menu.einzelmenu [aktuelles menu.anzahl hauptmenupunkte + 1]. erhoehe die anzahl der oberbegriffe: aktuelles menu.anzahl hauptmenupunkte INCR 1. END PROC oberbegriff; PROC oberbegriff (TEXT CONST punktname): oberbegriff (punktname, "", "") END PROC oberbegriff; PROC menufunktionseintrag (TEXT CONST kuerzel, punktbezeichnung, prozedurname, infotext, BOOL CONST ist aktiv): gib hinweis auf menufunktionseintrag; trage menupunkt ein; organisiere menu neu. gib hinweis auf menufunktionseintrag: line; out (aussage [14]); out ("'" + kuerzelzeichen + "' - " + punktname). kuerzelzeichen: IF kuerzel = "" THEN " " ELSE kuerzel FI. punktname: IF punktbezeichnung = trennzeilensymbol THEN "----------" ELSE punktbezeichnung FI. trage menupunkt ein: ueberpruefe das kuerzel; ueberpruefe die punktbreite; ueberpruefe die eintragsnummer; aktuelles menu.einzelmenu [stelle].belegt INCR 1; aktueller menupunkt.punktkuerzel := compress (kuerzel); aktueller menupunkt.punktname := normierter menupunkt; aktueller menupunkt.procname := compress (prozedurname); aktueller menupunkt.boxtext := infotext; aktueller menupunkt.aktiv := ist aktiv; aktueller menupunkt.angewaehlt := FALSE. aktueller menupunkt: aktuelles untermenu.menupunkt [aktuelles untermenu.belegt]. aktuelles untermenu: aktuelles menu.einzelmenu [stelle]. stelle: aktuelles menu.anzahl hauptmenupunkte. normierter menupunkt: blank + compress (punktbezeichnung). ueberpruefe das kuerzel: TEXT VAR kurz :: compress (kuerzel); IF kuerzel ist zu lang THEN bereinige eintragungen (16) ELIF kuerzel ist schon vorhanden THEN bereinige eintragungen (17) FI. kuerzel ist zu lang: length (kurz) > 1. kuerzel ist schon vorhanden: (length (kurz) = 1) AND (pos (vorhandene kuerzel, kurz) > 0). vorhandene kuerzel: TEXT VAR liste :: ""; INT VAR zeiger; FOR zeiger FROM 1 UPTO aktuelles untermenu.belegt REP liste CAT aktuelles untermenu.menupunkt [zeiger].punktkuerzel PER; liste. ueberpruefe die punktbreite: IF length (compress (punktbezeichnung)) > maxmenubreite - 10 THEN bereinige eintragungen (18) FI. ueberpruefe die eintragsnummer: IF aktuelles untermenu.belegt = maxuntermenupunkte THEN bereinige eintragungen (19) FI. organisiere menu neu: IF neue punktlaenge > aktuelles untermenu.maxlaenge THEN aktuelles untermenu.maxlaenge := neue punktlaenge FI. neue punktlaenge: length (aktueller menupunkt.punktname). END PROC menufunktionseintrag; PROC menufunktion (TEXT CONST kuerzel, punktbezeichnung, prozedurname, infotext): menufunktionseintrag (kuerzel, punktbezeichnung, prozedurname, infotext, TRUE) END PROC menufunktion; PROC trennlinie: menufunktionseintrag ("", trennzeilensymbol, "", "", FALSE) END PROC trennlinie; PROC schliesse menu: menuleiste. belegt INCR 1; menuleiste.menu [menuleiste.belegt] := aktuelles menu; menu ist geoeffnet := FALSE END PROC schliesse menu; PROC schliesse menukarte: forget (ds); page; out (piep); put (card finished) END PROC schliesse menukarte; PROC testinstallation (TEXT CONST kartenname): ueberpruefe menukarte; nimm installation vor. ueberpruefe menukarte: IF NOT exists (kartenname) THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [21]) ELIF (pos (kartenname, menutafelpraefix) <> 1) OR (type (old (kartenname)) <> menutafeltype) THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [22]) FI. nimm installation vor: TEXT CONST neuer kartenname :: kartenname + " von Task '" + name (myself) + "'"; command dialogue (FALSE); rename (kartenname, neuer kartenname); save (neuer kartenname,task (mmtaskname)); forget (neuer kartenname, quiet); reset dialog; install menu (neuer kartenname, FALSE); fetch (neuer kartenname, task (mmtaskname)); rename (neuer kartenname, kartenname); command dialogue (TRUE); page; out (piep); put (install finished) END PROC testinstallation; END PACKET ls menu generator 2;