(*
*********************************************************
*********************************************************
** **
** 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;