PACKET eudas std listen
(*************************************************************************)
(* *)
(* Drucken von Standardlisten ohne Druckmuster *)
(* *)
(* Version 01 *)
(* *)
(* Autor: Thomas Berlage *)
(* Stand: 06.02.89 *)
(* *)
(*************************************************************************)
DEFINES
drucke standardlisten,
std listenbreite,
std listenlaenge,
std listenfont :
LET
listendruckmuster = "******* Listendruckmuster *******";
FILE VAR f;
TEXT VAR puffer, feldname;
TEXT VAR std font := "";
INT VAR
std breite := 70,
std laenge := 60;
PROC std listenbreite (INT CONST breite) :
std breite := breite
END PROC std listenbreite;
INT PROC std listenbreite :
std breite
END PROC std listenbreite;
PROC std listenlaenge (INT CONST laenge) :
std laenge := laenge
END PROC std listenlaenge;
INT PROC std listenlaenge :
std laenge
END PROC std listenlaenge;
PROC std listenfont (TEXT CONST font) :
std font := font
END PROC std listenfont;
TEXT PROC std listenfont :
std font
END PROC std listenfont;
PROC drucke standardlisten (INT CONST listenform, TEXT CONST feldliste) :
forget (listendruckmuster, quiet);
f := sequential file (output, listendruckmuster);
maxlinelength (f, std breite);
IF kommaliste THEN
generiere komma druckmuster (feldliste)
ELSE
generiere spalten druckmuster (feldliste)
END IF;
TEXT CONST last := std;
drucke (listendruckmuster);
forget (listendruckmuster, quiet);
last param (last) .
kommaliste :
listenform = 2 .
END PROC drucke standardlisten;
ROW 100 INT VAR feld max;
INT VAR
zeilen pro satz,
zeilenlaenge,
feldlaenge,
druckfelder,
ges max;
PROC generiere listenkopf :
IF std font <> "" THEN
putline (f, "#type(" + textdarstellung (std font) + ")#")
END IF;
putline (f, "% GRUPPE 1 seitennummer");
putline (f, "% VOR");
put (f, date); put (f, time of day); put (f, "Uhr:");
put (f, eudas dateiname (1));
write (f, (std breite - length (eudas dateiname (1)) - 25) * " ");
putline (f, "&&-S");
line (f)
END PROC generiere listenkopf;
PROC generiere seitenvorschub :
putline (f, "% NACH");
putline (f, "#page#");
putline (f, "% ABK");
putline (f, "&? : lfd nr .");
putline (f, "&-S : seitennummer .");
putline (f, "seitennummer :");
putline (f, " text (int (lfd nr) DIV saetze pro seite + 1) .");
write (f, "saetze pro seite : ");
put (f, (std laenge - 2) DIV zeilen pro satz - 1);
putline (f, ".")
END PROC generiere seitenvorschub;
PROC generiere komma druckmuster (TEXT CONST feldliste) :
generiere listenkopf;
generiere feldueberschriften;
generiere wiederholungsteil;
generiere seitenvorschub .
generiere feldueberschriften :
write (f, "Nr. ");
FOR i FROM 1 UPTO length (feldliste) REP
feldnamen lesen (code (feldliste SUB i), feldname);
IF i < length (feldliste) THEN
write (f, feldname + ", ")
ELSE
write (f, feldname)
END IF
END REP;
line (f);
putline (f, maxlinelength (f) * "-");
zeilen pro satz := 1 .
generiere wiederholungsteil :
putline (f, "% WDH");
INT CONST max alt := maxlinelength (f);
INT VAR i;
maxlinelength (f, 10000);
write (f, "&&? ");
FOR i FROM 1 UPTO length (feldliste) REP
ein feldname als muster
END REP;
line (f);
maxlinelength (f, max alt) .
ein feldname als muster :
write (f, "%<");
feldnamen lesen (code (feldliste SUB i), feldname);
write (f, feldname);
write (f, ">");
IF i < length (feldliste) THEN write (f, ", ") END IF .
END PROC generiere komma druckmuster;
PROC maxima suchen (TEXT CONST feldliste) :
INT VAR i;
maxima initialisieren;
auf satz (1);
INT VAR modus;
IF markierte saetze > 0 THEN
modus := 3;
IF NOT satz markiert THEN weiter (3) END IF
ELSE
modus := 2;
IF NOT satz ausgewaehlt THEN weiter (2) END IF
END IF;
WHILE NOT dateiende REP
einen satz testen;
weiter (modus)
END REP .
maxima initialisieren :
druckfelder := length (feldliste);
FOR i FROM 1 UPTO druckfelder REP
feld max (i) := 2
END REP;
ges max := 0 .
einen satz testen :
INT VAR gesamt := 0;
FOR i FROM 1 UPTO druckfelder REP
feld bearbeiten (code (feldliste SUB i),
PROC (TEXT CONST, INT CONST, INT CONST) fl);
IF feldlaenge > feld max (i) THEN feld max (i) := feldlaenge END IF;
gesamt INCR feldlaenge
END REP;
IF gesamt > ges max THEN ges max := gesamt END IF .
END PROC maxima suchen;
PROC fl (TEXT CONST satz, INT CONST von, bis) :
feldlaenge := bis - von + 1
END PROC fl;
PROC generiere spalten druckmuster (TEXT CONST feldliste) :
maxima suchen (feldliste);
generiere listenkopf;
generiere feldueberschriften;
generiere wiederholungsteil;
generiere abkuerzungen;
generiere seitenvorschub .
generiere feldueberschriften :
TEXT VAR abk felder := "";
INT VAR i;
zeilenlaenge := 4;
zeilen pro satz := 1;
write (f, "Nr. ");
FOR i FROM 1 UPTO length (feldliste) REP
feldnamen lesen (code (feldliste SUB i), feldname);
IF length (feldname) + 2 >= feld max (i) THEN
abkuerzung einfuehren
END IF;
zeilenlaenge INCR feld max (i) + 1;
IF zeilenlaenge > std breite THEN
line (f); zeilenlaenge := feld max (i) + 1; zeilen pro satz INCR 1
END IF;
write (f, text (feldname, feld max (i) + 1))
END REP;
line (f);
putline (f, maxlinelength (f) * "-") .
abkuerzung einfuehren :
abk felder CAT (feldliste SUB i) .
generiere wiederholungsteil :
putline (f, "% WDH");
write (f, "&&? ");
FOR i FROM 1 UPTO length (feldliste) REP
ein feldmuster erzeugen
END REP;
line (f) .
ein feldmuster erzeugen :
INT CONST abk pos := pos (abk felder, feldliste SUB i);
puffer := "&";
IF abk pos > 0 THEN
puffer CAT text (code (abk pos + 64), feld max (i))
ELSE
feldnamen lesen (code (feldliste SUB i), feldname);
puffer CAT text ("<" + feldname + ">", feld max (i))
END IF;
write (f, puffer) .
generiere abkuerzungen :
IF abk felder <> "" THEN
putline (f, "% ABK");
FOR i FROM 1 UPTO length (abk felder) REP
eine abkuerzung generieren
END REP
END IF .
eine abkuerzung generieren :
write (f, "&");
write (f, code (i + 64));
write (f, " : ");
write (f, "f (");
feldnamen lesen (code (abk felder SUB i), feldname);
write (f, textdarstellung (feldname));
putline (f, ") .") .
END PROC generiere spalten druckmuster;
END PACKET eudas std listen;