diff options
Diffstat (limited to 'menugenerator')
| -rw-r--r-- | menugenerator/ls-Menu-Generator 1 | 373 | ||||
| -rw-r--r-- | menugenerator/ls-Menu-Generator 2 | 720 | ||||
| -rw-r--r-- | menugenerator/ls-Menu-Generator-gen | 92 |
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. + |