summaryrefslogtreecommitdiff
path: root/menugenerator
diff options
context:
space:
mode:
authorLars-Dominik Braun <lars@6xq.net>2016-10-09 11:28:19 +0200
committerLars-Dominik Braun <lars@6xq.net>2016-10-09 11:28:19 +0200
commitafd4c3c448381f6eb706090911a15c162fdaf8af (patch)
tree90955166d185de4acd210c3880dc78640ecd31fa /menugenerator
parent724cc003460ec67eda269911da85c9f9e40aa6cf (diff)
downloadeumel-src-afd4c3c448381f6eb706090911a15c162fdaf8af.zip
eumel-src-afd4c3c448381f6eb706090911a15c162fdaf8af.tar.gz
eumel-src-afd4c3c448381f6eb706090911a15c162fdaf8af.tar.bz2
Decompress source files
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.
Diffstat (limited to 'menugenerator')
-rw-r--r--menugenerator/ls-Menu-Generator 1373
-rw-r--r--menugenerator/ls-Menu-Generator 2720
-rw-r--r--menugenerator/ls-Menu-Generator-gen92
3 files changed, 1111 insertions, 74 deletions
diff --git a/menugenerator/ls-Menu-Generator 1 b/menugenerator/ls-Menu-Generator 1
index b9dfd73..4dea777 100644
--- a/menugenerator/ls-Menu-Generator 1
+++ b/menugenerator/ls-Menu-Generator 1
@@ -22,26 +22,355 @@
*)
-PACKET ls menu generator 1 DEFINES{} textprozedur,{} textzeile:{}LET maxzeilenzahl = 14,{} maxzeichenzahl = 65,{} zentrierkennung = "%",{} beginmarkkennung = "$",{} endmarkkennung = "&",{} unblockkennung = "�",{} blank = " ",{} dateikennung = ".a";{}LET dateieintrag = "#type (""10"")##limit (16.5)#",{} stdfonttabelle = "fonttab.ls-Menu-Generator";{}ROW 3 TEXT CONST fehlermeldung :: ROW 3 TEXT : ({}"existiert nicht!",{}
-""15"Text ist zu lang - bitte kürzen! "14"",{}""15"Zeilenformatierung mit <ESC> abgebrochen! "14""{});{}ROW 6 TEXT CONST hinweis :: ROW 6 TEXT : ({}"Bitte warten ...",{}"Zulässige Zeilenzahl: ",{}"Tatsächliche Zeilenzahl: ",{}"Textlänge ist in Ordnung!",{}"Textprozedur ist erstellt!",{}"Textzeile ist erstellt!"{});{}PROC textprozedur (TEXT CONST dateiname, prozedurname):{} BOOL VAR mit fehler;{} formatiere (dateiname, mit fehler);{} IF mit fehler{} THEN errorstop (fehlermeldung [3]){} FI;{}
- bereite den text auf (dateiname);{} erzeuge textprozedur (dateiname, prozedurname);{} out (""7""); out (hinweis [5]);{} last param (dateiname + dateikennung){}END PROC textprozedur;{}PROC textzeile (TEXT CONST dateiname):{} BOOL VAR mit fehler;{} formatiere (dateiname, mit fehler);{} IF mit fehler{} THEN errorstop (fehlermeldung [3]){} FI;{} bereite den text auf (dateiname);{} erzeuge textzeile (dateiname);{} out (""7""); out (hinweis [6]);{} last param (dateiname + dateikennung){}
-END PROC textzeile;{}PROC gib wartehinweis:{} page;{} out (hinweis [1]){}END PROC gib wartehinweis;{}PROC formatiere (TEXT CONST dateiname, BOOL VAR mit fehler):{} TEXT VAR fonttabelle, zeileninhalt;{} kontrolliere existenz;{} stelle fonttabelle ein;{} schreibe font in die datei;{} zeilenformatierung;{} entferne ggf font aus der datei;{} stelle fonttabelle zurueck;{} streiche restleerzeilen weg;{} untersuche ggf datei auf korrektheit.{} kontrolliere existenz:{} IF NOT exists (dateiname){}
- THEN page; errorstop ("'" + dateiname + "' " + fehlermeldung [1]){} FI.{} stelle fonttabelle ein:{} gib wartehinweis;{} fonttabelle := fonttable;{} fonttable (stdfonttabelle).{} schreibe font in die datei:{} FILE VAR datei :: sequential file (modify, dateiname);{} to line (datei, 1);{} insert record (datei);{} write record (datei, dateieintrag + blank).{} zeilenformatierung:{} disable stop;{} lineform (dateiname);{} IF is error{} THEN clear error;{}
- mit fehler := TRUE{} ELSE mit fehler := FALSE{} FI;{} enable stop.{} entferne ggf font aus der datei:{} to line (datei, 1);{} read record (datei, zeileninhalt);{} IF pos (zeileninhalt, dateieintrag) > 0{} THEN delete record (datei){} FI.{} stelle fonttabelle zurueck:{} fonttable (fonttabelle).{} streiche restleerzeilen weg:{} REP{} streiche ggf letzte zeile{} UNTIL zeile ist nicht leer PER.{} streiche ggf letzte zeile:{} to line (datei, lines (datei));{}
- read record (datei, zeileninhalt);{} IF compress (zeileninhalt) = ""{} THEN delete record (datei){} FI.{} zeile ist nicht leer:{} compress (zeileninhalt) <> "".{} untersuche ggf datei auf korrektheit:{} IF NOT mit fehler{} THEN untersuche zeilenzahl{} FI.{} untersuche zeilenzahl:{} IF lines (datei) > maxzeilenzahl{} THEN page;{} out (hinweis [2] + text (maxzeilenzahl)); line;{} out (hinweis [3] + text (lines (datei))); line (2);{} errorstop (fehlermeldung [2]){}
- ELSE page;{} out (hinweis [4]){} FI.{}END PROC formatiere;{}PROC bereite den text auf (TEXT CONST dateiname):{} INT VAR zaehler;{} TEXT VAR zeileninhalt;{} FILE VAR f :: sequential file (modify, dateiname);{} gib wartehinweis;{} vernichte ggf aufbereitete datei;{} richte datei neu ein;{} uebertrage die zeilen.{} vernichte ggf aufbereitete datei:{} IF exists (dateiname + dateikennung){} THEN forget (dateiname + dateikennung, quiet){} FI.{} richte datei neu ein:{}
- FILE VAR aus :: sequential file (output, dateiname + dateikennung).{} uebertrage die zeilen:{} FOR zaehler FROM 1 UPTO lines (f) REP{} bereite eine zeile auf{} PER.{} bereite eine zeile auf:{} to line (f, zaehler);{} read record (f, zeileninhalt);{} ersetze alle gaensefuesschen;{} haenge ggf absatzmarke an;{} behandle zeile;{} putline (aus, zeileninhalt).{} ersetze alle gaensefuesschen:{} change all (zeileninhalt, """", "'").{} haenge ggf absatzmarke an:{} IF (zeileninhalt SUB (length (zeileninhalt))) = blank{}
- THEN IF (zeileninhalt SUB 1) <> zentrierkennung{} THEN zeileninhalt CAT unblockkennung{} FI{} FI.{} behandle zeile:{} IF zeile soll zentriert werden{} THEN zentriere zeile{} ELIF zeile ist leerzeile{} THEN kennzeichne leerzeile{} ELSE blocke zeile auf stdlaenge{} FI.{} zeile soll zentriert werden:{} (zeileninhalt SUB 1) = zentrierkennung.{} zeile ist leerzeile:{} compress (zeileninhalt) = "".{} zentriere zeile:{} zeileninhalt := subtext (zeileninhalt, 2);{}
- zeileninhalt := anfangsblanks + zeileninhalt;{} zeilenabschluss.{} anfangsblanks:{} ((maxzeichenzahl - length (zeileninhalt)) DIV 2) * blank.{} zeilenabschluss:{} ersetze markierungszeichen;{} setze 13.{} ersetze markierungszeichen:{} change all (zeileninhalt, beginmarkkennung, """15""");{} change all (zeileninhalt, endmarkkennung, """14""").{} setze 13:{} zeileninhalt CAT " ""13""".{} kennzeichne leerzeile:{} zeileninhalt := """13""".{} blocke zeile auf stdlaenge:{}
- IF zeile darf nicht geblockt werden{} THEN ersetze endezeichen{} ELSE fuehre blockung aus{} FI.{} zeile darf nicht geblockt werden:{} (zeileninhalt SUB length (zeileninhalt)) = unblockkennung.{} ersetze endezeichen:{} zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 1);{} ersetze markierungszeichen;{} setze 13.{} fuehre blockung aus:{} ROW maxzeichenzahl INT VAR leerzeichen;{} INT VAR gezaehlte blanks, zu verteilende blanks;{} ordne anfangswerte zu;{}
- verteile blanks gleichmaessig;{} verteile blanks zufaellig;{} baue zeile zusammen;{} ersetze markierungszeichen;{} setze 13.{} ordne anfangswerte zu:{} bestimme blankanzahl in der zeile;{} bestimme zu verteilende blanks;{} initialisiere die reihung.{} bestimme blankanzahl in der zeile:{} gezaehlte blanks := 0;{} INT VAR zeiger;{} FOR zeiger FROM 1 UPTO length (zeileninhalt) REP{} IF (zeileninhalt SUB zeiger) = blank{} THEN gezaehlte blanks INCR 1{}
- FI{} PER.{} bestimme zu verteilende blanks:{} zu verteilende blanks := maxzeichenzahl - length (zeileninhalt).{} initialisiere die reihung:{} FOR zeiger FROM 1 UPTO gezaehlte blanks REP{} leerzeichen [zeiger] := 1{} PER.{} verteile blanks gleichmaessig:{} WHILE (zu verteilende blanks DIV gezaehlte blanks) > 0 REP{} schlag je ein blank auf;{} zu verteilende blanks DECR gezaehlte blanks{} PER.{} schlag je ein blank auf:{} FOR zeiger FROM 1 UPTO gezaehlte blanks REP{}
- leerzeichen [zeiger] INCR 1{} PER.{} verteile blanks zufaellig:{} FOR zeiger FROM 1 UPTO zu verteilende blanks REP{} leerzeichen [random (1, gezaehlte blanks)] INCR 1{} PER.{} baue zeile zusammen:{} TEXT VAR zwischen := zeileninhalt;{} INT VAR aktuelles blank := 0;{} zeileninhalt := "";{} FOR zeiger FROM 1 UPTO length (zwischen) REP{} TEXT VAR aktuelles zeichen :: (zwischen SUB zeiger);{} IF aktuelles zeichen = blank{} THEN aktuelles blank INCR 1;{}
- zeileninhalt CAT (leerzeichen [aktuelles blank] * blank){} ELSE zeileninhalt CAT aktuelles zeichen{} FI{} PER{}END PROC bereite den text auf;{}PROC erzeuge textprozedur (TEXT CONST dateiname, prozedurname):{} mache aus den zeilen einzeltexte;{} entferne ueberfluessige restzeilen;{} erstelle eine textprozedur.{} mache aus den zeilen einzeltexte:{} INT VAR zeiger;{} FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);{} FOR zeiger FROM 1 UPTO lines (ausdatei) REP{}
- bearbeite eine zeile{} PER.{} bearbeite eine zeile:{} TEXT VAR zeileninhalt;{} to line (ausdatei, zeiger);{} read record (ausdatei, zeileninhalt);{} zeileninhalt := """ " + zeileninhalt + """ +";{} change all (zeileninhalt, "­", "-");{} write record (ausdatei, zeileninhalt).{} entferne ueberfluessige restzeilen:{} REP{} entferne ggf eine zeile{} UNTIL zeileninhalt <> """ ""13"""" +" PER;{} entferne return aus letzter zeile.{} entferne ggf eine zeile:{}
- IF compress (zeileninhalt) = """ ""13"""" +"{} THEN delete record (ausdatei){} FI.{} entferne return aus letzter zeile:{} to line (ausdatei, lines (ausdatei));{} read record (ausdatei, zeileninhalt);{} zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 6);{} write record (ausdatei, zeileninhalt).{} erstelle eine textprozedur:{} schreibe procanfang;{} schreibe procende.{} schreibe procanfang:{} to line (ausdatei, 1);{} insert record (ausdatei);{}
- write record (ausdatei, "TEXT PROC " + prozedurname + ":").{} schreibe procende:{} to line (ausdatei, lines (ausdatei) + 1);{} insert record (ausdatei);{} write record (ausdatei, "END PROC " + prozedurname + ";").{}END PROC erzeuge textprozedur;{}PROC erzeuge textzeile (TEXT CONST dateiname):{} entferne ueberfluessige restzeilen;{} entferne return aus letzter zeile;{} erstelle eine textzeile.{} entferne ueberfluessige restzeilen:{} TEXT VAR zeileninhalt;{} INT VAR zeiger;{}
- FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);{} REP{} entferne ggf eine zeile{} UNTIL compress (zeileninhalt) <> """13""" PER.{} entferne ggf eine zeile:{} to line (ausdatei, lines (ausdatei));{} read record (ausdatei, zeileninhalt);{} IF compress (zeileninhalt) = """13"""{} THEN delete record (ausdatei){} FI.{} entferne return aus letzter zeile:{} to line (ausdatei, lines (ausdatei));{} read record (ausdatei, zeileninhalt);{} change all (zeileninhalt, """13""", "");{}
- write record (ausdatei, zeileninhalt).{} erstelle eine textzeile:{} haenge die zeilen aneinander;{} fasse zeile in gaensefuesschen;{} schreibe einzelzeile in ausgabedatei.{} haenge die zeilen aneinander:{} TEXT VAR zeile :: "";{} FOR zeiger FROM 1 UPTO lines (ausdatei) REP{} to line (ausdatei, zeiger);{} read record (ausdatei, zeileninhalt);{} zeile CAT (" " + zeileninhalt){} PER.{} fasse zeile in gaensefuesschen:{} zeile := """" + zeile + """";{} change all (zeile, "­","-").{}
- schreibe einzelzeile in ausgabedatei:{} forget (dateiname + dateikennung, quiet);{} FILE VAR fertig :: sequential file (modify, dateiname + dateikennung);{} to line (fertig, 1);{} insert record (fertig);{} write record (fertig, zeile){}END PROC erzeuge textzeile;{}END PACKET ls menu generator 1;{}
+PACKET ls menu generator 1 DEFINES
+ textprozedur,
+ textzeile:
+LET maxzeilenzahl = 14,
+ maxzeichenzahl = 65,
+ zentrierkennung = "%",
+ beginmarkkennung = "$",
+ endmarkkennung = "&",
+ unblockkennung = "�",
+ blank = " ",
+ dateikennung = ".a";
+LET dateieintrag = "#type (""10"")##limit (16.5)#",
+ stdfonttabelle = "fonttab.ls-Menu-Generator";
+ROW 3 TEXT CONST fehlermeldung :: ROW 3 TEXT : (
+"existiert nicht!",
+
+""15"Text ist zu lang - bitte kürzen! "14"",
+""15"Zeilenformatierung mit <ESC> abgebrochen! "14""
+);
+ROW 6 TEXT CONST hinweis :: ROW 6 TEXT : (
+"Bitte warten ...",
+"Zulässige Zeilenzahl: ",
+"Tatsächliche Zeilenzahl: ",
+"Textlänge ist in Ordnung!",
+"Textprozedur ist erstellt!",
+"Textzeile ist erstellt!"
+);
+PROC textprozedur (TEXT CONST dateiname, prozedurname):
+ BOOL VAR mit fehler;
+ formatiere (dateiname, mit fehler);
+ IF mit fehler
+ THEN errorstop (fehlermeldung [3])
+ FI;
+
+ bereite den text auf (dateiname);
+ erzeuge textprozedur (dateiname, prozedurname);
+ out (""7""); out (hinweis [5]);
+ last param (dateiname + dateikennung)
+END PROC textprozedur;
+PROC textzeile (TEXT CONST dateiname):
+ BOOL VAR mit fehler;
+ formatiere (dateiname, mit fehler);
+ IF mit fehler
+ THEN errorstop (fehlermeldung [3])
+ FI;
+ bereite den text auf (dateiname);
+ erzeuge textzeile (dateiname);
+ out (""7""); out (hinweis [6]);
+ last param (dateiname + dateikennung)
+
+END PROC textzeile;
+PROC gib wartehinweis:
+ page;
+ out (hinweis [1])
+END PROC gib wartehinweis;
+PROC formatiere (TEXT CONST dateiname, BOOL VAR mit fehler):
+ TEXT VAR fonttabelle, zeileninhalt;
+ kontrolliere existenz;
+ stelle fonttabelle ein;
+ schreibe font in die datei;
+ zeilenformatierung;
+ entferne ggf font aus der datei;
+ stelle fonttabelle zurueck;
+ streiche restleerzeilen weg;
+ untersuche ggf datei auf korrektheit.
+ kontrolliere existenz:
+ IF NOT exists (dateiname)
+
+ THEN page; errorstop ("'" + dateiname + "' " + fehlermeldung [1])
+ FI.
+ stelle fonttabelle ein:
+ gib wartehinweis;
+ fonttabelle := fonttable;
+ fonttable (stdfonttabelle).
+ schreibe font in die datei:
+ FILE VAR datei :: sequential file (modify, dateiname);
+ to line (datei, 1);
+ insert record (datei);
+ write record (datei, dateieintrag + blank).
+ zeilenformatierung:
+ disable stop;
+ lineform (dateiname);
+ IF is error
+ THEN clear error;
+
+ mit fehler := TRUE
+ ELSE mit fehler := FALSE
+ FI;
+ enable stop.
+ entferne ggf font aus der datei:
+ to line (datei, 1);
+ read record (datei, zeileninhalt);
+ IF pos (zeileninhalt, dateieintrag) > 0
+ THEN delete record (datei)
+ FI.
+ stelle fonttabelle zurueck:
+ fonttable (fonttabelle).
+ streiche restleerzeilen weg:
+ REP
+ streiche ggf letzte zeile
+ UNTIL zeile ist nicht leer PER.
+ streiche ggf letzte zeile:
+ to line (datei, lines (datei));
+
+ read record (datei, zeileninhalt);
+ IF compress (zeileninhalt) = ""
+ THEN delete record (datei)
+ FI.
+ zeile ist nicht leer:
+ compress (zeileninhalt) <> "".
+ untersuche ggf datei auf korrektheit:
+ IF NOT mit fehler
+ THEN untersuche zeilenzahl
+ FI.
+ untersuche zeilenzahl:
+ IF lines (datei) > maxzeilenzahl
+ THEN page;
+ out (hinweis [2] + text (maxzeilenzahl)); line;
+ out (hinweis [3] + text (lines (datei))); line (2);
+ errorstop (fehlermeldung [2])
+
+ ELSE page;
+ out (hinweis [4])
+ FI.
+END PROC formatiere;
+PROC bereite den text auf (TEXT CONST dateiname):
+ INT VAR zaehler;
+ TEXT VAR zeileninhalt;
+ FILE VAR f :: sequential file (modify, dateiname);
+ gib wartehinweis;
+ vernichte ggf aufbereitete datei;
+ richte datei neu ein;
+ uebertrage die zeilen.
+ vernichte ggf aufbereitete datei:
+ IF exists (dateiname + dateikennung)
+ THEN forget (dateiname + dateikennung, quiet)
+ FI.
+ richte datei neu ein:
+
+ FILE VAR aus :: sequential file (output, dateiname + dateikennung).
+ uebertrage die zeilen:
+ FOR zaehler FROM 1 UPTO lines (f) REP
+ bereite eine zeile auf
+ PER.
+ bereite eine zeile auf:
+ to line (f, zaehler);
+ read record (f, zeileninhalt);
+ ersetze alle gaensefuesschen;
+ haenge ggf absatzmarke an;
+ behandle zeile;
+ putline (aus, zeileninhalt).
+ ersetze alle gaensefuesschen:
+ change all (zeileninhalt, """", "'").
+ haenge ggf absatzmarke an:
+ IF (zeileninhalt SUB (length (zeileninhalt))) = blank
+
+ THEN IF (zeileninhalt SUB 1) <> zentrierkennung
+ THEN zeileninhalt CAT unblockkennung
+ FI
+ FI.
+ behandle zeile:
+ IF zeile soll zentriert werden
+ THEN zentriere zeile
+ ELIF zeile ist leerzeile
+ THEN kennzeichne leerzeile
+ ELSE blocke zeile auf stdlaenge
+ FI.
+ zeile soll zentriert werden:
+ (zeileninhalt SUB 1) = zentrierkennung.
+ zeile ist leerzeile:
+ compress (zeileninhalt) = "".
+ zentriere zeile:
+ zeileninhalt := subtext (zeileninhalt, 2);
+
+ zeileninhalt := anfangsblanks + zeileninhalt;
+ zeilenabschluss.
+ anfangsblanks:
+ ((maxzeichenzahl - length (zeileninhalt)) DIV 2) * blank.
+ zeilenabschluss:
+ ersetze markierungszeichen;
+ setze 13.
+ ersetze markierungszeichen:
+ change all (zeileninhalt, beginmarkkennung, """15""");
+ change all (zeileninhalt, endmarkkennung, """14""").
+ setze 13:
+ zeileninhalt CAT " ""13""".
+ kennzeichne leerzeile:
+ zeileninhalt := """13""".
+ blocke zeile auf stdlaenge:
+
+ IF zeile darf nicht geblockt werden
+ THEN ersetze endezeichen
+ ELSE fuehre blockung aus
+ FI.
+ zeile darf nicht geblockt werden:
+ (zeileninhalt SUB length (zeileninhalt)) = unblockkennung.
+ ersetze endezeichen:
+ zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 1);
+ ersetze markierungszeichen;
+ setze 13.
+ fuehre blockung aus:
+ ROW maxzeichenzahl INT VAR leerzeichen;
+ INT VAR gezaehlte blanks, zu verteilende blanks;
+ ordne anfangswerte zu;
+
+ verteile blanks gleichmaessig;
+ verteile blanks zufaellig;
+ baue zeile zusammen;
+ ersetze markierungszeichen;
+ setze 13.
+ ordne anfangswerte zu:
+ bestimme blankanzahl in der zeile;
+ bestimme zu verteilende blanks;
+ initialisiere die reihung.
+ bestimme blankanzahl in der zeile:
+ gezaehlte blanks := 0;
+ INT VAR zeiger;
+ FOR zeiger FROM 1 UPTO length (zeileninhalt) REP
+ IF (zeileninhalt SUB zeiger) = blank
+ THEN gezaehlte blanks INCR 1
+
+ FI
+ PER.
+ bestimme zu verteilende blanks:
+ zu verteilende blanks := maxzeichenzahl - length (zeileninhalt).
+ initialisiere die reihung:
+ FOR zeiger FROM 1 UPTO gezaehlte blanks REP
+ leerzeichen [zeiger] := 1
+ PER.
+ verteile blanks gleichmaessig:
+ WHILE (zu verteilende blanks DIV gezaehlte blanks) > 0 REP
+ schlag je ein blank auf;
+ zu verteilende blanks DECR gezaehlte blanks
+ PER.
+ schlag je ein blank auf:
+ FOR zeiger FROM 1 UPTO gezaehlte blanks REP
+
+ leerzeichen [zeiger] INCR 1
+ PER.
+ verteile blanks zufaellig:
+ FOR zeiger FROM 1 UPTO zu verteilende blanks REP
+ leerzeichen [random (1, gezaehlte blanks)] INCR 1
+ PER.
+ baue zeile zusammen:
+ TEXT VAR zwischen := zeileninhalt;
+ INT VAR aktuelles blank := 0;
+ zeileninhalt := "";
+ FOR zeiger FROM 1 UPTO length (zwischen) REP
+ TEXT VAR aktuelles zeichen :: (zwischen SUB zeiger);
+ IF aktuelles zeichen = blank
+ THEN aktuelles blank INCR 1;
+
+ zeileninhalt CAT (leerzeichen [aktuelles blank] * blank)
+ ELSE zeileninhalt CAT aktuelles zeichen
+ FI
+ PER
+END PROC bereite den text auf;
+PROC erzeuge textprozedur (TEXT CONST dateiname, prozedurname):
+ mache aus den zeilen einzeltexte;
+ entferne ueberfluessige restzeilen;
+ erstelle eine textprozedur.
+ mache aus den zeilen einzeltexte:
+ INT VAR zeiger;
+ FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);
+ FOR zeiger FROM 1 UPTO lines (ausdatei) REP
+
+ bearbeite eine zeile
+ PER.
+ bearbeite eine zeile:
+ TEXT VAR zeileninhalt;
+ to line (ausdatei, zeiger);
+ read record (ausdatei, zeileninhalt);
+ zeileninhalt := """ " + zeileninhalt + """ +";
+ change all (zeileninhalt, "­", "-");
+ write record (ausdatei, zeileninhalt).
+ entferne ueberfluessige restzeilen:
+ REP
+ entferne ggf eine zeile
+ UNTIL zeileninhalt <> """ ""13"""" +" PER;
+ entferne return aus letzter zeile.
+ entferne ggf eine zeile:
+
+ IF compress (zeileninhalt) = """ ""13"""" +"
+ THEN delete record (ausdatei)
+ FI.
+ entferne return aus letzter zeile:
+ to line (ausdatei, lines (ausdatei));
+ read record (ausdatei, zeileninhalt);
+ zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 6);
+ write record (ausdatei, zeileninhalt).
+ erstelle eine textprozedur:
+ schreibe procanfang;
+ schreibe procende.
+ schreibe procanfang:
+ to line (ausdatei, 1);
+ insert record (ausdatei);
+
+ write record (ausdatei, "TEXT PROC " + prozedurname + ":").
+ schreibe procende:
+ to line (ausdatei, lines (ausdatei) + 1);
+ insert record (ausdatei);
+ write record (ausdatei, "END PROC " + prozedurname + ";").
+END PROC erzeuge textprozedur;
+PROC erzeuge textzeile (TEXT CONST dateiname):
+ entferne ueberfluessige restzeilen;
+ entferne return aus letzter zeile;
+ erstelle eine textzeile.
+ entferne ueberfluessige restzeilen:
+ TEXT VAR zeileninhalt;
+ INT VAR zeiger;
+
+ FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);
+ REP
+ entferne ggf eine zeile
+ UNTIL compress (zeileninhalt) <> """13""" PER.
+ entferne ggf eine zeile:
+ to line (ausdatei, lines (ausdatei));
+ read record (ausdatei, zeileninhalt);
+ IF compress (zeileninhalt) = """13"""
+ THEN delete record (ausdatei)
+ FI.
+ entferne return aus letzter zeile:
+ to line (ausdatei, lines (ausdatei));
+ read record (ausdatei, zeileninhalt);
+ change all (zeileninhalt, """13""", "");
+
+ write record (ausdatei, zeileninhalt).
+ erstelle eine textzeile:
+ haenge die zeilen aneinander;
+ fasse zeile in gaensefuesschen;
+ schreibe einzelzeile in ausgabedatei.
+ haenge die zeilen aneinander:
+ TEXT VAR zeile :: "";
+ FOR zeiger FROM 1 UPTO lines (ausdatei) REP
+ to line (ausdatei, zeiger);
+ read record (ausdatei, zeileninhalt);
+ zeile CAT (" " + zeileninhalt)
+ PER.
+ fasse zeile in gaensefuesschen:
+ zeile := """" + zeile + """";
+ change all (zeile, "­","-").
+
+ schreibe einzelzeile in ausgabedatei:
+ forget (dateiname + dateikennung, quiet);
+ FILE VAR fertig :: sequential file (modify, dateiname + dateikennung);
+ to line (fertig, 1);
+ insert record (fertig);
+ write record (fertig, zeile)
+END PROC erzeuge textzeile;
+END PACKET ls menu generator 1;
+
diff --git a/menugenerator/ls-Menu-Generator 2 b/menugenerator/ls-Menu-Generator 2
index 608f680..e38fc7e 100644
--- a/menugenerator/ls-Menu-Generator 2
+++ b/menugenerator/ls-Menu-Generator 2
@@ -22,51 +22,677 @@
*)
-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;{}
+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;
+
diff --git a/menugenerator/ls-Menu-Generator-gen b/menugenerator/ls-Menu-Generator-gen
index 9a4c3fc..ca26366 100644
--- a/menugenerator/ls-Menu-Generator-gen
+++ b/menugenerator/ls-Menu-Generator-gen
@@ -22,9 +22,91 @@
*)
-LET mm taskname = "ls-MENUKARTEN",{} datei 1 = "Generatordatei: Archivmenu",{} datei 2 = "ls-MENUBASISTEXTE",{} datei 3 = "ls-Menu-Generator 1",{} datei 4 = "ls-Menu-Generator 2";{}PROC stelle existenz des mm sicher:{} cursor (1, 5); out (""4"");{} IF NOT exists (task (mm taskname)){} THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!");{} FI{}END PROC stelle existenz des mm sicher;{}PROC vom archiv (TEXT CONST datei):{} cursor (1,5); out (""4"");{}
- out (" """); out (datei); putline (""" wird geholt.");{} fetch (datei, archive){}END PROC vom archiv;{}PROC hole (TEXT CONST datei):{} IF NOT exists (datei) THEN vom archiv (datei) FI{}END PROC hole;{}PROC in (TEXT CONST datei):{} hole (datei);{} cursor (1, 5); out (""4"");{} out (" """); out (datei); out (""" wird übersetzt: ");{} insert (datei);{} forget (datei, quiet);{}END PROC in;{}PROC schicke (TEXT CONST datei):{} cursor (1, 5); out (""4"");{} out (" """); out(datei);{} out (""" wird zum MENUKARTEN-MANAGER geschickt!");{}
- command dialogue (FALSE);{} save (datei, task (mm taskname));{} command dialogue (TRUE);{} forget (datei, quiet){}END PROC schicke;{}INT VAR size, used;{}BOOL VAR einzeln;{}storage (size, used);{}einzeln := size - used < 500;{}forget ("ls-Menu-Generator/gen", quiet);{}wirf kopfzeile aus;{}stelle existenz des mm sicher;{}hole die dateien;{}insertiere die dateien;{}mache global manager aus der task.{}wirf kopfzeile aus:{} page;{} putline (" "15"ls-Menu-Generator - Automatische Generierung "14"").{}
-hole die dateien:{} IF NOT exists (datei 1) COR NOT exists (datei 2){} COR NOT exists (datei 3) COR NOT exists (datei 4){} THEN hole dateien vom archiv{} FI.{}hole dateien vom archiv:{} cursor (1,3);{} say ("Ist das Archiv angemeldet und die "); line;{} IF yes ("'ls-Menu-Generator'-Diskette eingelegt"){} THEN lese ein{} ELSE line (2);{} errorstop ("Ohne die Diskette kann ich das System nicht generieren!"){} FI.{}lese ein:{} cursor (1, 3); out (""4"");{} out (" "15"Bitte die Diskette eingelegt lassen! "14"");{}
- IF NOT einzeln{} THEN hole (datei 1);{} hole (datei 2);{} hole (datei 3);{} hole (datei 4);{} cursor (1, 3); out(""4"");{} out (" "15"Die Diskette wird nicht mehr benötigt! "14"");{} release (archive){} FI.{}insertiere die dateien:{} check off;{} schicke (datei 2);{} in (datei 3);{} in (datei 4);{} IF einzeln THEN release (archive) FI;{} check on.{}mache global manager aus der task:{} global manager.{}
+LET mm taskname = "ls-MENUKARTEN",
+ datei 1 = "Generatordatei: Archivmenu",
+ datei 2 = "ls-MENUBASISTEXTE",
+ datei 3 = "ls-Menu-Generator 1",
+ datei 4 = "ls-Menu-Generator 2";
+PROC stelle existenz des mm sicher:
+ cursor (1, 5); out (""4"");
+ IF NOT exists (task (mm taskname))
+ THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!");
+ FI
+END PROC stelle existenz des mm sicher;
+PROC vom archiv (TEXT CONST datei):
+ cursor (1,5); out (""4"");
+
+ out (" """); out (datei); putline (""" wird geholt.");
+ fetch (datei, archive)
+END PROC vom archiv;
+PROC hole (TEXT CONST datei):
+ IF NOT exists (datei) THEN vom archiv (datei) FI
+END PROC hole;
+PROC in (TEXT CONST datei):
+ hole (datei);
+ cursor (1, 5); out (""4"");
+ out (" """); out (datei); out (""" wird übersetzt: ");
+ insert (datei);
+ forget (datei, quiet);
+END PROC in;
+PROC schicke (TEXT CONST datei):
+ cursor (1, 5); out (""4"");
+ out (" """); out(datei);
+ out (""" wird zum MENUKARTEN-MANAGER geschickt!");
+
+ command dialogue (FALSE);
+ save (datei, task (mm taskname));
+ command dialogue (TRUE);
+ forget (datei, quiet)
+END PROC schicke;
+INT VAR size, used;
+BOOL VAR einzeln;
+storage (size, used);
+einzeln := size - used < 500;
+forget ("ls-Menu-Generator/gen", quiet);
+wirf kopfzeile aus;
+stelle existenz des mm sicher;
+hole die dateien;
+insertiere die dateien;
+mache global manager aus der task.
+wirf kopfzeile aus:
+ page;
+ putline (" "15"ls-Menu-Generator - Automatische Generierung "14"").
+
+hole die dateien:
+ IF NOT exists (datei 1) COR NOT exists (datei 2)
+ COR NOT exists (datei 3) COR NOT exists (datei 4)
+ THEN hole dateien vom archiv
+ FI.
+hole dateien vom archiv:
+ cursor (1,3);
+ say ("Ist das Archiv angemeldet und die "); line;
+ IF yes ("'ls-Menu-Generator'-Diskette eingelegt")
+ THEN lese ein
+ ELSE line (2);
+ errorstop ("Ohne die Diskette kann ich das System nicht generieren!")
+ FI.
+lese ein:
+ cursor (1, 3); out (""4"");
+ out (" "15"Bitte die Diskette eingelegt lassen! "14"");
+
+ IF NOT einzeln
+ THEN hole (datei 1);
+ hole (datei 2);
+ hole (datei 3);
+ hole (datei 4);
+ cursor (1, 3); out(""4"");
+ out (" "15"Die Diskette wird nicht mehr benötigt! "14"");
+ release (archive)
+ FI.
+insertiere die dateien:
+ check off;
+ schicke (datei 2);
+ in (datei 3);
+ in (datei 4);
+ IF einzeln THEN release (archive) FI;
+ check on.
+mache global manager aus der task:
+ global manager.
+