summaryrefslogtreecommitdiff
path: root/menugenerator/ls-Menu-Generator 1
diff options
context:
space:
mode:
Diffstat (limited to 'menugenerator/ls-Menu-Generator 1')
-rw-r--r--menugenerator/ls-Menu-Generator 1376
1 files changed, 0 insertions, 376 deletions
diff --git a/menugenerator/ls-Menu-Generator 1 b/menugenerator/ls-Menu-Generator 1
deleted file mode 100644
index 4dea777..0000000
--- a/menugenerator/ls-Menu-Generator 1
+++ /dev/null
@@ -1,376 +0,0 @@
-(*
-
- *********************************************************
- *********************************************************
- ** **
- ** ls-Menu-Generator 1 **
- ** **
- ** Version 1.0 **
- ** **
- ** (Stand: 30.03.88) **
- ** **
- ** **
- ** Autor: Wolfgang Weber, Bielefeld **
- ** **
- ** **
- ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld **
- ** **
- ** Copyright (C) 1988 ERGOS GmbH, Siegburg **
- ** **
- *********************************************************
- *********************************************************
-
- *)
-
-PACKET ls menu generator 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;
-
-
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-04 06:31:51 +0000