diff options
Diffstat (limited to 'system/multiuser/1.7.5/src/pager')
| -rw-r--r-- | system/multiuser/1.7.5/src/pager | 2451 |
1 files changed, 2451 insertions, 0 deletions
diff --git a/system/multiuser/1.7.5/src/pager b/system/multiuser/1.7.5/src/pager new file mode 100644 index 0000000..35189a4 --- /dev/null +++ b/system/multiuser/1.7.5/src/pager @@ -0,0 +1,2451 @@ +(*-------------------- VERSION 197 vom 05.05.86 -------(1.7.5)------ *) +PACKET seiten formatieren DEFINES pageform, + auto pageform, + number empty lines before foot, + first head, + last bottom: + +(* Programm zur interaktiven Formatierung von Seiten, Fussnoten, Kopf- und + Fusszeilen, Seitennummern usw. + Autor: Rainer Hahn + *) + +(***************** Deklarationen fuer pageform ************) + +LET type1 = 1, + linefeed = 3, + limit = 4, + free = 5, + page command0= 6, + page command1= 7, + pagenr = 8, + pagelength = 9, + foot = 10, + end = 11, + head = 12, + headeven = 13, + headodd = 14, + bottom = 15, + bottomeven = 16, + bottomodd = 17, + columns = 18, + columnsend = 19, + topage = 20, + goalpage = 21, + count0 = 22, + count1 = 23, + setcount = 24, + value0 = 25, + value1 = 26, + on = 27, + off = 28, + head on = 29, + head off = 30, + bottom on = 31, + bottom off = 32, + count per page=33, + foot contd = 34, + table = 35, + table end = 36, + r pos = 37, + l pos = 38, + c pos = 39, + d pos = 40, + b pos = 41, + clearpos0 = 42, + clearpos1 = 43, + fillchar = 44, + pageblock = 45, + counter1 = 46, + counter2 = 47, + counter store= 48, + countervalue0= 49, + countervalue1= 50, + set counter = 51, + u = 52, + d = 53, + e = 54, + fehler index = 100, + hop = ""1"", + upchar = ""3"", + cl eop = ""4"", + cl eol = ""5"", + downchar = ""10"", + rub in = ""11"", + rub out = ""12"", + return = ""13"", + end mark = ""14"", + begin mark = ""15"", + begin end mark = ""15""14"", + esc = ""27"", + blank = " ", + kommando zeichen = "#", + kopf = 1, + kopf gerade = 2, + fuss = 3, + fuss gerade = 4, + kopf ungerade = 5, + fuss ungerade = 6, + foot note = 7, + dina4 limit = "16.0", + dina4 pagelength = 25.0, + pos seitengrenze = 17, + zeilen nach oben = 13, + zeilen nach unten = 6, + max foot zeilen = 120, + max zeilen zahl = 15, + max refers = 300, + max anz seitenzeichen = 3; + +BOOL VAR interaktiv, + bereich aufnehmen, + zeile noch nicht verarbeitet, + es war ein linefeed in der zeile, + mindestens ein topage gewesen, + insert first head :: TRUE, + insert last bottom :: TRUE, + pageblock on, + ausgeschalteter head, + ausgeschalteter bottom, + count seitenzaehlung, + file works, + in tabelle, + in nullter seite, + letzte textzeile war mit absatz, + letztes seitenende war mit absatz, + letztes seitenende war in tabelle; + +INT VAR kommando anfangs pos, + kommando ende pos, + kommando index, + number blank lines before foot :: 1, + in index oder exponent, + durchgang, + nummer erste seite, + nummer letzte seite, + laufende spaltennr, + anz refers, + counter, + anz spalten, + anz zeilen nach oben, + anz vertauschte zeilen, + font nr, + type zeilenvorschub, + berechneter zeilenvorschub, + max zeilenvorschub, + max type zeilenvorschub, + textbegin zeilennr, + anz textzeilen, + text laenge vor columns, + bereichshoehe, + aktuelle seitenlaenge, + eingestellte seitenlaenge; + +REAL VAR real eingestellter zeilenvorschub, + realparam; + +TEXT VAR kommando, + par1, par2, + macro line, + vor macro, + nach macro, + dummy, + fehlerdummy, + modifikation, + modifikations speicher, + kommando seitenspeicher, + dec value, + counter numbering store, + counter reference store, + letzte kommandoleiste, + kommando speicher, + tab pos speicher, + bereich kommando speicher, + seitenzeichen, + name druck datei, + name eingabe datei, + zeile, + eingestellter typ, + eingestelltes limit; + +TEXT VAR kommando liste :: +"type:1.1linefeed:3.1limit:4.1free:5.1page:6.01pagenr:8.2pagelength:9.1 +foot:10.0end:11.0head:12.0headeven:13.0headodd:14.0bottom:15.0bottomeven:16.0 +bottomodd:17.0columns:18.2columnsend:19.0topage:20.1goalpage:21.1count:22.01 +setcount:24.1"; + +kommando liste CAT +"value:25.01on:27.1off:28.1headon:29.0headoff:30.0bottomon:31.0bottomoff:32.0 +countperpage:33.0footcontinued:34.0table:35.0tableend:36.0rpos:37.1lpos:38.1 +cpos:39.1dpos:40.2bpos:41.2clearpos:42.01fillchar:44.1pageblock:45.0"; + +kommando liste CAT +"counter:46.12storecounter:48.1putcounter:49.01setcounter:51.2u:52.0d:53.0 +e:54.0"; + +FILE VAR eingabe, + ausgabe; + +ROW 6 ROW max zeilenzahl TEXT VAR kopf fuss zeilen; + +ROW max foot zeilen TEXT VAR foot zeilen; + +ROW max foot zeilen BOOL VAR kommandos vorhanden; + +ROW 7 INT VAR anz kopf oder fuss zeilen, + kopf oder fuss laenge; + +ROW max anz seitenzeichen INT VAR laufende seitennr; + +BOUND ROW max refers REFER VAR refer sammler; + +LET REFER = STRUCT (TEXT kennzeichen, INT nummer, BOOL referenced); + +DATASPACE VAR ds; + +(********************* Einstell-Prozeduren ***************************) + +PROC first head (BOOL CONST was): + insert first head := was +END PROC first head; + +PROC last bottom (BOOL CONST was): + insert last bottom := was +END PROC last bottom; + +PROC number empty lines before foot (INT CONST n): + IF n >= 0 AND n < 10 + THEN number blank lines before foot := n + ELSE errorstop ("nur einstellbar zwischen 0 und 9") + FI +END PROC number empty lines before foot; + +(************************** Fehlermeldungen **********************) + +PROC fehler (INT CONST nr, TEXT CONST addition): + IF durchgang = 1 OR + kommando index = goalpage OR kommandoindex = count0 OR + kommando index = count1 OR kommando index = value1 OR + kommando index = topage OR kommando index = pagelength OR + kommando index = counterstoreOR kommando index = counter1 OR + kommando index = counter2 OR kommando index = countervalue1 + THEN fehler melden; + fehlermeldung auf terminal ausgeben + FI. + +fehler melden: + report text processing error (nr, line no (ausgabe), fehlerdummy, addition). + +fehlermeldung auf terminal ausgeben: + IF interaktiv + THEN cursor(1,2); out(cleop); + ELSE line + FI; + out (fehlerdummy); + line. +END PROC fehler; + +PROC warnung (INT CONST nr, TEXT CONST addition): + IF durchgang = 1 OR + kommando index = goalpage OR kommandoindex = count0 OR + kommando index = count1 OR kommando index = value1 OR + kommando index = topage OR kommando index = set counter + THEN fehler melden; + meldung auf terminal ausgeben + FI. + +fehler melden: + report text processing warning (nr, line no (ausgabe), fehlerdummy, addition). + +meldung auf terminal ausgeben: + IF interaktiv + THEN cursor(1,2); out(cleop); + ELSE line + FI; + out (fehlerdummy); + line. +END PROC warnung; + +(*************************** Globale Dateibehandlung **************) + +PROC datei assoziieren: + IF exists (name eingabe datei) + THEN ausgabe datei einrichten + ELSE errorstop (name eingabe datei + " existiert nicht") + FI. + +ausgabe datei einrichten: + IF name eingabe datei = name druck datei + THEN errorstop ("Name Eingabedatei = Name Ausgabedatei") + ELIF subtext (name eingabe datei, length (name eingabe datei) - 1) = ".p" + THEN errorstop ("Druckdatei kann nicht nochmal formatiert werden") + ELSE eingabe := sequential file (input, name eingabe datei); + copy (name eingabedatei, name druck datei); + ausgabe := sequential file (modify, name druck datei); + copy attributes (eingabe, ausgabe); + headline (ausgabe, name druck datei); + FI +END PROC datei assoziieren; + +PROC record einfuegen (TEXT CONST rec): + insert record (ausgabe); + write record (ausgabe, rec); + down (ausgabe); +END PROC record einfuegen; + +(******************** Kopf- oder Fusszeilen aufnehmen *************) + +PROC fussnote aufnehmen: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN aufnehmen (footnote) + ELSE fehler (19, kommando) + FI; + in index oder exponent := 0; + bereich aufnehmen := FALSE +END PROC fussnote aufnehmen; + +PROC aufnehmen (INT CONST was): + kommando zustand vor bereich speichern; + aktuelle zeile ggf mitzaehlen; + aufnehmen initialisieren; + kopf oder fuss zeilen aufnehmen. + +kommando zustand vor bereich speichern: + kommandos in dummy speichern; + bereich kommando speicher := dummy. + +aktuelle zeile ggf mitzaehlen: +INT VAR einleitungs kommando anfang :: kommando anfangs pos; + IF kommando anfangs pos > 1 + THEN IF NOT only command line (zeile) + THEN aktuelle seitenlaenge INCR max zeilenvorschub + FI; + read record (ausgabe, zeile) + FI. + +aufnehmen initialisieren: + IF was = foot note + THEN initialisierung fuer fussnoten + ELSE anz kopf oder fuss zeilen [was] := 1; + kommandos in dummy speichern; + kopf fuss zeilen [was] [1] := dummy; + kopf oder fuss laenge [was] := 0; + FI; + bereichshoehe := kopf oder fusslaenge [was]. + +initialisierung fuer fussnoten: + INT CONST fussnotenlaenge vorher :: kopf oder fuss laenge [footnote], + anz fusszeilen vorher :: anz kopf oder fusszeilen [footnote]; + anz kopf oder fuss zeilen [footnote] INCR 1; + kommandos in dummy speichern; + kommandoleiste in fussnote speichern; (* davor *) + IF anz kopf oder fuss zeilen [footnote] = 1 + THEN unterstreichungsstrich + FI. + +kommandoleiste in fussnote speichern: + foot zeilen [anz kopf oder fuss zeilen [footnote]] := dummy; + kommandos vorhanden [anz kopf oder fuss zeilen [footnote]]:= TRUE. + +unterstreichungsstrich: + FOR i FROM 2 UPTO max foot zeilen REP + kommandos vorhanden [i] := FALSE + ENDREP; + FOR i FROM 1 UPTO number blank lines before foot REP + foot zeilen [i + 1] := " " + END REP; + foot zeilen [number blank lines before foot + 2] := + "#on(""underline"")# #off(""underline"")# "; + kopf oder fuss laenge [footnote] := + (number blank lines before foot + 1) * berechneter zeilenvorschub; + anz kopf oder fuss zeilen [footnote] := number blank lines before foot + 2. + +kopf oder fuss zeilen aufnehmen: +INT VAR anzahl :: 1; + REP + naechste zeile lesen; + cout (line no (ausgabe)); + IF mindestens ein kommando vorhanden + THEN kommandos von kopf oder fuss verarbeiten + FI; + in index oder exponent := 0; + zeile aufnehmen; + anzahl INCR 1 + UNTIL eof (ausgabe) END REP; + errorstop ("end fehlt bei Dateiende"). + +kommandos von kopf oder fuss verarbeiten: + max zeilenvorschub := berechneter zeilenvorschub; + max type zeilenvorschub := type zeilenvorschub; + kommando anfangs pos := pos (zeile, kommando zeichen); + WHILE kommando anfangs pos <> 0 REP + verarbeite kommando; + kommandos von kopf oder fuss pruefen; + kommando anfangs pos := + pos (zeile, kommando zeichen, kommando ende pos + 1) + END REP. + +kommandos von kopf oder fuss pruefen: + IF kommandoindex = end + THEN aufnehmen beenden + ELIF kommando index = free + THEN IF y step conversion (realparam) >= eingestellte seitenlaenge + THEN fehler (24, text (realparam)) + ELSE kopf oder fusslaenge [was] INCR y step conversion (realparam) + FI + ELIF seitenende + THEN INT VAR xx := durchgang; + durchgang := 1; + fehler (25, ""); + durchgang := xx; + zeile zurueck lesen; + kommando index := end; + LEAVE aufnehmen + ELIF kommando index = fehler index + THEN LEAVE aufnehmen + ELIF kommando index > free AND kommando index < to page + THEN fehler (11, kommando); + kommando index := fehler index; + LEAVE aufnehmen + FI. + +aufnehmen beenden: + IF kommando anfangs pos > 1 + THEN IF absatzzeile + THEN zeile := subtext (zeile, 1, kommando anfangs pos -1); + zeile CAT blank; + ELSE zeile := subtext (zeile, 1, kommando anfangs pos -1); + FI; + zeile aufnehmen + FI; + IF NOT (durchgang = 1 AND was = footnote) + THEN die aufgenommenen zeilen in druckdatei loeschen + FI; + LEAVE aufnehmen. + +die aufgenommenen zeilen in druckdatei loeschen: + INT VAR i; + delete record (ausgabe); + FOR i FROM 1 UPTO anzahl - 1 REP + up (ausgabe); + delete record (ausgabe) + END REP; + zeile zurueck lesen; + letztes kommando dieser zeile loeschen; + ggf kommandoleiste generieren. + +letztes kommando dieser zeile loeschen: + IF einleitungs kommando anfang = 1 + THEN delete record (ausgabe); + IF line no (ausgabe) = 1 + THEN zeile noch nicht verarbeitet := TRUE + ELSE zeile zurueck lesen + FI + ELSE dummy := subtext (zeile, 1, einleitungs kommando anfang - 1); + IF absatz zeile + THEN dummy CAT blank; + ELIF (dummy SUB length (dummy)) = " " + THEN delete char (dummy, length (dummy)) + FI; + write record (ausgabe, dummy) + FI. + +ggf kommandoleiste generieren: + kommandos in dummy speichern; + IF was = footnote + THEN anz kopf oder fusszeilen [footnote] INCR 1; + kommandoleiste in fussnote speichern (* danach *) + FI; + IF dummy <> bereich kommando speicher + THEN down (ausgabe); + record einfuegen (dummy); + up (ausgabe, 2); + FI. + +zeile aufnehmen: + zeile speichern (was, anzahl); + IF erreichte seitenlaenge > eingestellte seitenlaenge + THEN bereich aufnehmen := FALSE; + IF kommando index = end + THEN seitenende nach geteilter fussnote + ELSE seitenende vor der fussnote + FI; + kommando index := end; + LEAVE aufnehmen + FI. + +seitenende nach geteilter fussnote: + kopf oder fuss laenge [footnote] DECR max zeilenvorschub; + anz kopf oder fuss zeilen [footnote] DECR 1; + seitenende einbringen und zurueck. + +seitenende vor der fussnote: + kopf oder fuss laenge [footnote] := fussnotenlaenge vorher; + anz kopf oder fuss zeilen [footnote] := anz fusszeilen vorher; + ende einer seite. +END PROC aufnehmen; + +PROC zeile speichern (INT CONST was, anzahl): + zeile mitzaehlen; + IF was = footnote + THEN fussnote aufnehmen + ELIF anz kopf oder fuss zeilen [was] > max zeilenzahl + THEN errorstop ("Zu viele 'head' oder 'bottom' Zeilen"); + ELSE kopf fuss zeilen [was] [anz kopf oder fuss zeilen [was]] := zeile + FI. + +zeile mitzaehlen: + anz kopf oder fuss zeilen [was] INCR 1; + IF NOT only command line (zeile) + THEN IF mindestens ein kommando vorhanden + THEN kopf oder fuss laenge [was] INCR max zeilenvorschub; + bereichshoehe INCR max zeilenvorschub + ELSE kopf oder fuss laenge [was] INCR berechneter zeilenvorschub; + bereichshoehe INCR berechneter zeilenvorschub + FI; + IF bereichshoehe >= eingestellte seitenlaenge + THEN errorstop + ("head, bottom oder footzeilen > Seitenlänge (end vergessen?)") + FI + FI; + IF es war ein linefeed in der zeile + THEN berechne zeilenvorschub; + es war ein linefeed in der zeile := FALSE + FI; + IF erreichte seitenlaenge > eingestellte seitenlaenge + THEN fussnotenumbruch pruefung + FI. + +fussnote aufnehmen: + IF anz kopf oder fuss zeilen [footnote] > max footzeilen + THEN errorstop ("Zu viele Fußnotenzeilen") + ELIF bereichshoehe > eingestellte seitenlaenge - seitenlaenge fester teil + - (eingestellte seitenlaenge DIV 100 * 15) + THEN errorstop ("Fußnote > 85% der Seitenlänge (end vergessen?)") + ELSE foot zeilen [anz kopf oder fuss zeilen [footnote]] := zeile + FI. + +fussnotenumbruch pruefung: + IF fussnotenumbruch moeglich + THEN ggf fussnote aufbrechen + ELSE lese rueckwaerts um (anzahl); + IF only command line (zeile) + THEN lese rueckwaerts um (1) + FI + FI. + +fussnotenumbruch moeglich: + was = footnote AND anzahl > 2. + +ggf fussnote aufbrechen: + up (ausgabe); + IF interaktiv + THEN fussnotenumbruch anfrage; + line (2) + FI; + anweisungen fuer umbruch einfuegen. + +fussnotenumbruch anfrage: + schreibe titelzeile ("Weiterführen der Fußnote auf nächster Seite (j/n)?"); + line (2); + schreibe bildschirm; + cursor (53, 1); + skip input; + REP + TEXT VAR steuerzeichen; + inchar (steuerzeichen); + IF steuerzeichen = "n" + THEN lese rueckwaerts um (anzahl - 1); + IF only command line (zeile) + THEN lese rueckwaerts um (1) + FI; + LEAVE ggf fussnote aufbrechen + ELIF steuerzeichen = "j" OR steuerzeichen = return + THEN LEAVE fussnotenumbruch anfrage + ELIF steuerzeichen = esc + THEN errorstop ("Abbruch durch ESC") + FI + END REP. + +anweisungen fuer umbruch einfuegen: + record einfuegen ("#end#"); + record einfuegen ("#foot continued#"); + kommandos in dummy speichern; + record einfuegen (dummy); + record einfuegen ("Forts. von letzter Seite: "); + lese rueckwaerts um (3); + kommando index := end. +END PROC zeile speichern; + +PROC lese rueckwaerts um (INT CONST anzahl): + to line (ausgabe, line no (ausgabe) - anzahl); + read record (ausgabe, zeile) +END PROC lese rueckwaerts um; + +PROC schreibe kopf oder fuss (INT CONST was): + IF was = footnote + THEN fussnoten generieren + ELIF laufende spaltennr < 2 + THEN kopf oder fuss zeilen generieren + FI. + +kopf oder fusszeilen generieren: +INT VAR i :: 1; +BOOL VAR in generierter zeile war kommando :: FALSE; + ggf anfangs kommandos generieren; + FOR i FROM 2 UPTO anz kopf oder fuss zeilen [was] REP + dummy := kopf fuss zeilen [was] [i]; + IF NOT in generierter zeile war kommando + THEN in generierter zeile war kommando := + pos (dummy, kommandozeichen) <> 0 + FI; + fuege seitennr ein; + record einfuegen (dummy) + END REP; + ggf ende kommandos generieren. + +ggf anfangs kommandos generieren: + kommandos in dummy speichern; + IF dummy <> kopf fuss zeilen [was] [1] + THEN record einfuegen (kopf fuss zeilen [was] [1]) + FI. + +ggf ende kommandos generieren: + kommandos in dummy speichern; + IF dummy <> kopf fuss zeilen [was] [1] OR + in generierter zeile war kommando + THEN record einfuegen (dummy) + FI. + +fuege seitennr ein: +INT VAR k; + change all (dummy, + (seitenzeichen SUB 1) + (seitenzeichen SUB 1), + text (laufende seitennr [1] +1)); + FOR k FROM 1 UPTO length (seitenzeichen) REP + change all (dummy, seitenzeichen SUB k, text (laufende seitennr [k])); + END REP. + +fussnoten generieren: + kommandos in dummy speichern; + letzte kommandoleiste := dummy; + i := 1; + WHILE i < anz kopf oder fusszeilen [footnote] REP + IF kommandos vorhanden [i] + THEN IF letzte kommandoleiste <> footzeilen [i] + THEN record einfuegen (footzeilen [i]); + letzte kommandoleiste := footzeilen [i] + FI + ELSE record einfuegen (footzeilen [i]) + FI; + i INCR 1 + END REP; + IF footzeilen [i] <> dummy + THEN record einfuegen (dummy) + FI +END PROC schreibe kopf oder fuss; + +PROC fussnoten loeschen: + kopf oder fuss laenge [footnote] := 0; + anz kopf oder fuss zeilen [footnote] := 0 +END PROC fussnoten loeschen; + +PROC schreibe ggf fuss: + record einfuegen ("#text end#"); + ggf tabellenende generieren; + letztes seitenende war mit absatz := letzte textzeile war mit absatz; + IF erreichte seitenlaenge <> eingestellte seitenlaenge + THEN schreibe freien platz + FI; + IF kopf oder fuss laenge [footnote] > 0 + THEN ggf tabellenende generieren; + schreibe kopf oder fuss (footnote); + fussnoten loeschen + FI; + IF (NOT insert last bottom AND laufende seitennr [1] = nummer letzte seite) + OR ausgeschalteter bottom + THEN + ELSE schreibe mal fussbereich + FI. + +schreibe mal fussbereich: + IF kopf oder fuss laenge [fuss] > 0 + THEN schreibe kopf oder fuss (fuss) + ELIF kopf oder fuss laenge [fuss gerade] > 0 AND + (laufende seitennr [1] MOD 2 = 0) + THEN schreibe kopf oder fuss (fuss gerade) + ELIF kopf oder fuss laenge [fuss ungerade] > 0 AND + (laufende seitennr [1] MOD 2 <> 0) + THEN schreibe kopf oder fuss (fuss ungerade) + FI. + +ggf tabellenende generieren: + IF tab pos speicher <> "" + THEN record einfuegen ("#clear pos# ") + FI; + IF in tabelle + THEN record einfuegen ("#table end# "); + letztes seitenende war in tabelle := TRUE; + in tabelle := FALSE + FI. + +schreibe freien platz: + IF pageblock on + THEN schreibe ggf stauchung oder streckungs anweisung + ELSE schreibe free (eingestellte seitenlaenge - erreichte seitenlaenge) + FI. + +schreibe ggf stauchung oder streckungs anweisung: + IF interaktiv AND seitenluecke > fuenf prozent der seitenlaenge + THEN cursor (1, 2); + dummy := begin mark; + dummy CAT "Soll die Seite beim Druck gestreckt werden ("; + dummy CAT text (ystepconversion (seitenluecke)); + dummy CAT " cm)"; + dummy CAT end mark; + IF no (dummy) + THEN cursor (1, 2); + out (cl eol); + schreibe free + (eingestellte seitenlaenge - erreichte seitenlaenge); + line; + LEAVE schreibe ggf stauchung oder streckungs anweisung + FI; + cursor (1, 2); + out (cl eol); + line + FI; + INT VAR i :: lineno (ausgabe); + to line (ausgabe, textbegin zeilennr); + dummy := "#textbegin ("; + dummy CAT text (anz textzeilen); + dummy CAT ", """; + dummy CAT text (ystepconversion (seitenluecke)); + dummy CAT """)#"; + read record (ausgabe, zeile); + IF (zeile SUB length (zeile)) = blank + THEN dummy CAT blank + FI; + write record (ausgabe, dummy); + to line (ausgabe, i). + +seitenluecke: + eingestellte seitenlaenge - erreichte seitenlaenge. + +fuenf prozent der seitenlaenge: + ((eingestellte seitenlaenge + 99) DIV 100) * 5. +END PROC schreibe ggf fuss; + +(**************************** kommando speicherung *****************) + +PROC grenzmarkierung in dummy speichern: + dummy := "#page##"; + dummy CAT (3 * "-----------"); + dummy CAT " Ende der Seite "; + IF in nullter seite + THEN dummy CAT "0 " + ELSE dummy CAT (text (laufende seitennr [1]) + blank) + FI; + IF anz spalten > 1 + THEN dummy CAT "und Spalte "; + dummy CAT (text (laufende spaltennr) + blank) + ELSE dummy CAT "-----------" + FI; + dummy CAT kommando zeichen +END PROC grenzmarkierung in dummy speichern; + +PROC kommandos in dummy speichern: + type speichern; + dummy CAT modifikation; + limit speichern; + linefeed mit absatzblank speichern. + +type speichern: + dummy := "#type("""; + dummy CAT eingestellter typ; + dummy CAT """)#". + +limit speichern: + dummy CAT "#limit("; + dummy CAT eingestelltes limit; + dummy CAT ")#". + +linefeed mit absatzblank speichern: + dummy CAT "#linefeed(0"; + dummy CAT text (real eingestellter zeilenvorschub); + dummy CAT ")# ". +END PROC kommandos in dummy speichern; + +PROC kommandos aufheben: + kommandos in dummy speichern; + kommando speicher := dummy +END PROC kommandos aufheben; + +PROC kommandos wiederherstellen: + zeile := kommando speicher; + kommandos verarbeiten; + berechneter zeilenvorschub := + int (real (type zeilenvorschub) * real eingestellter zeilenvorschub + 0.5); + max zeilenvorschub := berechneter zeilenvorschub; + max type zeilenvorschub := type zeilenvorschub +END PROC kommandos wiederherstellen; + +(**************************** headzeilen einfuegen ************************) + +PROC schreibe ggf kopf: + IF (NOT insert first head AND laufende seiten nr [1] = nummer erste seite) + OR ausgeschalteter head + THEN + ELSE schreibe mal + FI; + ggf tabellenanfang generieren; + text begin anweisung generieren. + +schreibe mal: + IF kopf oder fuss laenge [kopf] > 0 + THEN schreibe kopf oder fuss (kopf); + aktuelle seitenlaenge INCR kopf oder fuss laenge [kopf] + ELIF kopf oder fuss laenge [kopf gerade] > 0 + AND (laufende seitennr [1] MOD 2 = 0) + THEN schreibe kopf oder fuss (kopf gerade); + aktuelle seitenlaenge INCR kopf oder fuss laenge [kopf gerade] + ELIF kopf oder fuss laenge [kopf ungerade] > 0 + AND (laufende seitennr [1] MOD 2 <> 0) + THEN schreibe kopf oder fuss (kopf ungerade); + aktuelle seitenlaenge INCR kopf oder fuss laenge [kopf ungerade] + FI. + +ggf tabellenanfang generieren: + IF tab pos speicher <> "" + THEN record einfuegen ("#clearpos#"); + record einfuegen (tab pos speicher) + FI; + IF letztes seitenende war in tabelle + THEN record einfuegen ("#table# "); + letztes seitenende war in tabelle := FALSE; + in tabelle := TRUE + FI. + +text begin anweisung generieren: + dummy := "#text begin#"; + IF letztes seitenende war mit absatz + THEN dummy CAT " " + FI; + record einfuegen (dummy); + textbegin zeilennr := line no (ausgabe) - 1. +END PROC schreibe ggf kopf; + +PROC erhoehe seiten und spaltennr: + IF anz spalten > 1 + THEN erhoehe spaltennummer + FI; + IF NOT in nullter seite + THEN erhoehe seitennummer + FI. + +erhoehe spaltennummer: + laufende spaltennr INCR 1; + IF laufende spaltennr > anz spalten + THEN laufende spaltennr := 1; + text laenge vor columns := 0 + ELSE LEAVE erhoehe seiten und spaltennr + FI. + +erhoehe seitennummer: + INT VAR i; + FOR i FROM 1 UPTO length (seitenzeichen) REP + laufende seitennr [i] INCR 1 + END REP +END PROC erhoehe seiten und spaltennr; + +PROC seitennummer setzen (INT CONST akt nummer): + IF pos (seitenzeichen, par1) = 0 + THEN IF length (seitenzeichen) >= max anz seitenzeichen + THEN fehler (16, ""); + LEAVE seitennummer setzen + FI; + seitenzeichen CAT par1 + FI; + laufende seitennr [pos (seitenzeichen, par1)] := akt nummer. +END PROC seitennummer setzen; + +PROC kommando seitenspeicher fuellen: + kommando seitenspeicher CAT "#"; + kommando seitenspeicher CAT kommando; + kommando seitenspeicher CAT "#" +END PROC kommando seitenspeicher fuellen; + +(************************** kommandos verarbeiten ********************) + +PROC verarbeite kommando: +INT VAR anz params, intparam; + kommando ende pos := + pos (zeile, kommando zeichen, kommando anfangs pos + 1); + IF kommando ende pos <> 0 + THEN kommando oder kommentar kommando verarbeiten + ELSE fehler (2, + subtext (zeile, kommandoanfangspos, kommandoanfangspos+9)+"..."); + zeile CAT kommando zeichen; + write record (ausgabe, zeile); + kommando ende pos := length (zeile) + FI. + +kommando oder kommentar kommando verarbeiten: + IF pos ("-/"":", zeile SUB kommando anfangs pos + 1) = 0 + THEN kommando := + subtext (zeile, kommando anfangs pos + 1, kommando ende pos - 1); + scanne kommando; + setze kommando um + ELSE kommando index := 0 + FI. + +scanne kommando: + analyze command (kommandoliste, kommando, 3, + kommando index, anz params, par1, par2); + disable stop; + command error; + IF is error + THEN dummy := error message; + clear error; + dummy CAT " -> "; + dummy CAT kommando; + fehler (22, dummy); + enable stop; + LEAVE verarbeite kommando + FI; + enable stop. + +setze kommando um: + IF durchgang = 3 AND kommando index <> value1 AND kommando index <> to page + AND kommando index <> counter value1 + THEN LEAVE verarbeite kommando + FI; + SELECT kommando index OF + +CASE type1: + modifikation := ""; + IF in index oder exponent > 0 + THEN LEAVE setze kommando um + ELIF font exists (par1) + THEN font nr := font (par1); + eingestellter typ := par1; + type zeilenvorschub := + font height (fontnr) + font lead (fontnr) + font depth (fontnr); + IF type zeilenvorschub > max type zeilenvorschub + THEN max type zeilenvorschub := type zeilenvorschub + FI + ELSE fehler (1, par1) + FI; + berechne zeilenvorschub + +CASE linefeed: + realparam := real (par1); + IF last conversion ok AND pos (par1, ".") <> 0 + THEN real eingestellter zeilenvorschub := realparam; + es war ein linefeed in der zeile := TRUE + ELSE fehler (4, par1) + FI + +CASE limit: + eingestelltes limit := par1 + +CASE free: + realparam := real (par1); + IF last conversion ok AND pos (par1, ".") <> 0 + THEN IF keine zeichen ausser blank nach dem kommando + THEN free kommando ausfuehren + ELSE fehler (19, kommando); + FI + ELSE fehler (4, par1) + FI + +CASE page command0: + IF keine zeichen ausser blank nach dem kommando + THEN page behandlung; + schreibe titelzeile + ELSE fehler (19, kommando) + FI + +CASE page command1: + IF keine zeichen ausser blank nach dem kommando + THEN INT VAR seitennummer mit page := int (par1); + page behandlung; + laufende spaltennr := 1; + text laenge vor columns := 0; + IF seitennummer mit page <= 0 + THEN fehler (27, "page (" + text (seitennummer mit page) + ")") + ELSE laufende seitennr [1] := seitennummer mit page + FI + ELSE fehler (19, kommando) + FI + +CASE pagenr: + IF in nullter seite OR durchgang = 4 + THEN intparam := int (par2); + IF length (par1) <> 1 + THEN fehler (14, "") + ELIF NOT last conversion ok + THEN fehler (5, kommando) + ELIF intparam <= 0 + THEN fehler (27, kommando) + ELSE seitennummer setzen (intparam) + FI + ELIF durchgang = 2 + THEN kommando seitenspeicher fuellen + FI + +CASE pagelength: + realparam := real (par1); + IF last conversion ok AND pos (par1, ".") <> 0 + THEN IF in nullter seite OR durchgang = 4 + THEN eingestellte seitenlaenge := y step conversion (realparam) + ELIF durchgang = 2 + THEN kommando seitenspeicher fuellen + FI + ELSE fehler (4, kommando) + FI + +CASE foot, foot contd: + fussnote aufnehmen + +CASE end: + IF NOT bereich aufnehmen + THEN fehler (31, "") + FI; + bereich aufnehmen := FALSE; + kommando index := end; + IF NOT keine zeichen ausser blank nach dem kommando + THEN fehler (19, kommando) + FI + +CASE head: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN kopf oder fuss laenge [kopf ungerade] := 0; + kopf oder fuss laenge [kopf gerade] := 0; + aufnehmen (kopf) + ELSE fehler (19, kommando) + FI; + bereich aufnehmen := FALSE + +CASE headeven: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN kopf oder fuss laenge [kopf] := 0; + aufnehmen (kopf gerade) + ELSE fehler (19, kommando) + FI; + bereich aufnehmen := FALSE + +CASE headodd: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN kopf oder fuss laenge [kopf] := 0; + aufnehmen (kopf ungerade) + ELSE fehler (19, kommando) + FI; + bereich aufnehmen := FALSE + +CASE bottom: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN kopf oder fuss laenge [fuss ungerade] := 0; + kopf oder fuss laenge [fuss gerade] := 0; + aufnehmen (fuss) + ELSE fehler (19, kommando) + FI; + bereich aufnehmen := FALSE + +CASE bottomeven: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN kopf oder fuss laenge [fuss] := 0; + aufnehmen (fuss gerade) + ELSE fehler (19, kommando) + FI; + bereich aufnehmen := FALSE + +CASE bottomodd: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN kopf oder fuss laenge [fuss] := 0; + aufnehmen (fuss ungerade) + ELSE fehler (19, kommando) + FI; + bereich aufnehmen := FALSE + +CASE columns: + IF anz spalten > 1 + THEN fehler (29, "") + ELSE anz spalten := int (par1); + laufende spalten nr := 1; + IF anz spalten < 2 + THEN fehler (26, ""); + anz spalten := 2 + FI; + text laenge vor columns := + aktuelle seitenlaenge + kopf oder fuss laenge [footnote] + FI + +CASE columnsend: + IF durchgang = 1 + THEN delete record (ausgabe); + IF NOT nur dateiende danach + THEN seitenende einbringen und zurueck; + record einfuegen ("#columnsend#"); + text laenge vor columns := 0; + laufende spaltennr := 1; + anz spalten := 1; + kommando index := page command0; + down (ausgabe) + FI + FI + +CASE topage: + IF durchgang > 1 + THEN ggf gespeicherte nummer einsetzen (par1); + mindestens ein topage gewesen := TRUE + FI + +CASE goalpage: + IF durchgang > 1 + THEN nummer und kennzeichen speichern (laufende seitennr[1], par1) + FI + +CASE count0, count1: + IF durchgang > 1 + THEN counter INCR 1; + change (zeile, + kommando anfangs pos, kommando ende pos, text(counter)); + kommando ende pos := kommando anfangs pos; + write record (ausgabe, zeile); + IF anz params = 1 + THEN nummer und kennzeichen speichern (counter, par1) + FI + FI + +CASE setcount: + intparam := int (par1); + IF last conversion ok AND intparam >= 0 + THEN counter := intparam - 1 + ELSE fehler (30, par1) + FI + +CASE value0: + IF durchgang > 1 + THEN change (zeile, kommando anfangs pos, kommando ende pos, + text (counter)); + write record (ausgabe, zeile); + kommando ende pos := kommando anfangs pos + FI + +CASE value1: + IF durchgang > 1 + THEN ggf gespeicherte nummer einsetzen (par1) + FI + +CASE on: + change all (par1, " ", ""); + par1 := (par1 SUB 1); + modifikation CAT "#on(""" + par1 + """)#" + +CASE off: + change all (par1, " ", ""); + par1 := (par1 SUB 1); + changeall (modifikation, "#on(""" + par1 + """)#", ""); + +CASE head on: ausgeschalteter head := FALSE +CASE head off: ausgeschalteter head := TRUE + +CASE bottom on: ausgeschalteter bottom := FALSE +CASE bottom off: ausgeschalteter bottom := TRUE + +CASE count per page: count seitenzaehlung := TRUE + +CASE table: + IF durchgang > 1 + THEN in tabelle := TRUE + FI + +CASE table end: + IF durchgang > 1 + THEN in tabelle := FALSE + FI + +CASE r pos, l pos, c pos, d pos, b pos, clearpos1, fillchar: + IF durchgang > 1 + THEN tab pos speicher CAT "#"; + tab pos speicher CAT kommando; + tab pos speicher CAT "#" + FI + +CASE clearpos0: + IF durchgang > 1 + THEN tab pos speicher := "" + FI + +CASE pageblock : pageblock on := TRUE + +CASE counter1, counter2: + IF durchgang > 1 + THEN process counter + FI + +CASE set counter: + IF durchgang > 1 + THEN process set counter + FI + +CASE counter store: + IF durchgang > 1 + THEN process counter store + FI + +CASE counter value0: + IF durchgang > 1 + THEN write dec value into file + FI + +CASE counter value1: + IF durchgang > 1 + THEN process counter value + FI + +CASE u, d: + in index oder exponent INCR 1 + +CASE e: + in index oder exponent DECR 1 + +OTHERWISE + kommando index := 0; + IF macro command and then process parameters (kommando) + THEN ersetze macro + FI +END SELECT. + +nur dateiende danach: + INT VAR diese zeile :: line no (ausgabe); + WHILE NOT eof (ausgabe) REP + read record (ausgabe, zeile); + IF length (zeile) > 1 + THEN to line (ausgabe, diese zeile); + read record (ausgabe, zeile); + LEAVE nur dateiende danach WITH FALSE + FI; + down (ausgabe) + END REP; + to line (ausgabe, diese zeile); + read record (ausgabe, zeile); + TRUE. +END PROC verarbeite kommando; + +(************************ Makro-Ersetzung **************************) + +PROC ersetze macro: + INT VAR erste zeile :: line no (ausgabe); + hole texte um macro herum; + fuege macro zeilen ein; + fuege text nach macro an; + positioniere zurueck. + +hole texte um macro herum: + vor macro := subtext (zeile, 1, kommando anfangs pos - 1); + nach macro := subtext (zeile, kommando ende pos + 1). + +fuege macro zeilen ein: + INT VAR anz :: 1; + WHILE anz < number macro lines REP + get macro line (macro line); + IF anz = 1 + THEN vor macro CAT macro line ; + write record (ausgabe, vor macro); + ELSE down (ausgabe); + insert record (ausgabe); + write record (ausgabe, macro line) + FI; + anz INCR 1 + END REP. + +fuege text nach macro an: + read record (ausgabe, zeile); + IF length (nach macro) <> 0 + THEN zeile CAT nach macro + ELIF (zeile SUB length (zeile)) <> blank AND number macro lines > 2 + THEN delete record (ausgabe); + read record (ausgabe, dummy); + zeile CAT dummy + FI; + IF subtext (zeile, length (zeile) - 1, length (zeile)) = " " + THEN delete char (zeile, length (zeile)) + FI; + write record (ausgabe, zeile). + +positioniere zurueck: + to line (ausgabe, erste zeile); + read record (ausgabe, zeile); + IF in nullter seite + THEN zeile noch nicht verarbeitet := TRUE + FI; + kommando ende pos := kommando anfangs pos - 1. +END PROC ersetze macro; + +(************************ Zeilenvorschub-Berechnung ****************) + +PROC berechne zeilenvorschub: + berechneter zeilenvorschub := + int (real (type zeilenvorschub) * real eingestellter zeilenvorschub + 0.5); + IF real eingestellter zeilenvorschub >= 1.0 + THEN max zeilenvorschub := max + (int (real (max type zeilenvorschub)*real eingestellter zeilenvorschub + 0.5), + berechneter zeilenvorschub) + ELIF berechneter zeilenvorschub > max zeilenvorschub + THEN max zeilenvorschub := berechneter zeilenvorschub + FI +END PROC berechne zeilenvorschub; + +(**************************** counter processing **********************) + +PROC process counter: + dummy := "#"; + dummy CAT par1; + dummy CAT "#"; + IF pos (counter numbering store, dummy) = 0 + THEN fehler (34, par1); + LEAVE process counter + FI; + get dec value (counter numbering store); + IF kommando index = counter2 + THEN resize dec value to needed points + FI; + IF dec value was just initialized + THEN dec value := subtext (dec value, 2) + ELIF kommando index = counter1 + THEN digit value := int (dec value); + digit value INCR 1; + dec value := text (digit value) + ELSE incr counter value + FI; + write dec value into file; + replace value in numbering store (dec value). + +resize dec value to needed points: + INT VAR needed points :: int (par2), + begin of last digit :: 1; + WHILE needed points > 0 REP + IF next point pos = 0 + THEN IF needed points = 1 + THEN dec value CAT ".0" + ELSE dec value CAT ".1" + FI; + begin of last digit := length (dec value) + ELSE begin of last digit := next point pos + 1 + FI; + needed points DECR 1 + END REP; + INT VAR end of last digit := next point pos - 1; + IF end of last digit < 0 + THEN end of last digit := length (dec value) + FI; + dec value := subtext (dec value, 1, end of last digit). + +next point pos: + pos (dec value, ".", begin of last digit). + +dec value was just initialized: + (dec value SUB 1) = "i". + +incr counter value: + INT VAR digit value :: int ( + subtext (dec value, begin of last digit, end of last digit)); + digit value INCR 1; + change (dec value, begin of last digit, end of last digit, + text (digit value)). +END PROC process counter; + +PROC process set counter: + dummy := "#"; + dummy CAT par1; + dummy CAT "#"; + IF pos (counter numbering store, dummy) <> 0 + THEN warnung (15, par1); + replace value in numbering store (par2); + INT VAR begin pos :: pos (counter numbering store, dummy) + 1; + begin pos := pos (counter numbering store, "#", beginpos) + 1; + insert char (counter numbering store, "i", begin pos) + ELSE counter numbering store CAT dummy; + counter numbering store CAT "i"; + counter numbering store CAT par2 + FI. +END PROC process set counter; + +PROC process counter store: + IF pos (counter reference store, par1) <> 0 + THEN fehler (35, par1) + ELSE store it + FI. + +store it: + counter reference store CAT "#"; + counter reference store CAT par1; + counter reference store CAT "#"; + counter reference store CAT dec value +END PROC process counter store; + +PROC process counter value: + dummy := "#"; + dummy CAT par1; + dummy CAT "#"; + IF pos (counter reference store, dummy) <> 0 + THEN get dec value (counter reference store); + write dec value into file + ELIF durchgang = 3 + THEN fehler (61, par1) + FI. +END PROC process counter value; + +PROC replace value in numbering store (TEXT CONST val): + INT VAR begin pos :: pos (counter numbering store, dummy) + 1; + begin pos := pos (counter numbering store, "#", begin pos) + 1; + INT VAR end pos := pos (counter numbering store, "#", begin pos)-1; + IF end pos <= 0 + THEN end pos := length (counter numbering store) + FI; + change (counter numbering store, begin pos, end pos, val) +END PROC replace value in numbering store; + +PROC write dec value into file: + change (zeile, kommando anfangs pos, kommando ende pos, dec value); + kommando ende pos := kommando anfangs pos; + write record (ausgabe, zeile) +END PROC write dec value into file; + +PROC get dec value (TEXT CONST store): + INT VAR value begin :: pos (store, dummy); + value begin := pos (store, "#", value begin + 1) + 1; + INT VAR value end :: pos (store, "#", value begin)-1; + IF value end < 0 + THEN value end := length (store) + FI; + dec value := subtext (store, value begin, value end). +END PROC get dec value; + +(************************** Zaehler routinen ('refer') ***************) + +PROC nummer und kennzeichen speichern (INT CONST number, TEXT VAR kennung): + ueberpruefe auf bereits vorhandenes kennzeichen; + anz refers INCR 1; + IF anz refers > max refers + THEN errorstop ("Anzahl Referenzen zu gross") + FI; + refer sammler [anz refers] . kennzeichen := kennung; + refer sammler [anz refers] . nummer := number; + refer sammler [anz refers] . referenced := FALSE. + +ueberpruefe auf bereits vorhandenes kennzeichen: + INT VAR i; + FOR i FROM 1 UPTO anz refers REP + IF refer sammler [i] . kennzeichen = kennung + THEN warnung (9, kennung); + LEAVE nummer und kennzeichen speichern + FI + END REP. +END PROC nummer und kennzeichen speichern; + +PROC ggf gespeicherte nummer einsetzen (TEXT VAR kennung): + IF kennzeichen vorhanden + THEN change (zeile, kommando anfangs pos, kommando ende pos, textnummer); + refer sammler [i] . referenced := TRUE; + kommando ende pos := kommando anfangs pos; + write record (ausgabe, zeile) + ELIF durchgang = 3 + THEN warnung (4, kennung) + FI. + +textnummer: + text (refer sammler [i] . nummer). + +kennzeichen vorhanden: +INT VAR i; + FOR i FROM 1 UPTO anz refers REP + IF refer sammler [i] . kennzeichen = kennung + THEN LEAVE kennzeichen vorhanden WITH TRUE + FI + END REP; + FALSE. +END PROC ggf gespeicherte nummer einsetzen; + +(************************** free-Kommando *****************************) + +PROC free kommando ausfuehren: +INT CONST wert in y steps :: y step conversion (realparam); + IF bereich aufnehmen + THEN + ELIF wert in y steps>=eingestellte seitenlaenge - seitenlaenge fester teil + THEN fehler (13, "") + ELIF erreichte seitenlaenge + wert in y steps > eingestellte seitenlaenge + THEN ende einer seite; + kommando index := fehler index + ELSE aktuelle seitenlaenge INCR wert in y steps + FI +END PROC free kommando ausfuehren; + +(*************************** page-Kommando ******************************) + +PROC page behandlung: +TEXT VAR steuerzeichen; + page kommando entfernen; + IF aktuelle seitenlaenge <= 0 + THEN IF line no (ausgabe) = 1 + THEN zeile noch nicht verarbeitet := TRUE + ELSE up (ausgabe) + FI; + LEAVE page behandlung + FI; + IF interaktiv + THEN initialisiere bildschirm fuer page; + mit page interaktiv formatieren; + schreibe titelzeile; + FI; + BOOL CONST hilf :: pageblock on; + pageblock on := FALSE; + seitenende einbringen und zurueck; + pageblock on := hilf; + kommando index := page command0. + +page kommando entfernen: + IF kommando anfangs pos = 1 + THEN delete record (ausgabe); + IF line no (ausgabe) = 1 + THEN zeile noch nicht verarbeitet := TRUE + FI + ELSE zeile := subtext (zeile, 1, kommando anfangs pos - 1); + write record (ausgabe, zeile); + IF NOT only command line (zeile) + THEN aktuelle seitenlaenge INCR max zeilenvorschub + FI; + down (ausgabe) + FI. + +initialisiere bildschirm fuer page: + schreibe titelzeile + ("#page# bestaetigen: RETURN / loeschen: HOP RUBOUT / Abbruch: ESC"); + line ; out (cleol); + put ("#page# nach"); + put (y step conversion (erreichte seitenlaenge)); put ("cm"); + schreibe bildschirm; + out (hop). + +mit page interaktiv formatieren: + REP + inchar (steuerzeichen); + IF steuerzeichen = return + THEN zeilenmitteilung loeschen; + LEAVE mit page interaktiv formatieren + ELIF steuerzeichen = rubout + THEN weitermachen + ELIF steuerzeichen = esc + THEN errorstop ("Abbruch mit ESC") + FI + END REP. + +weitermachen: + zeilenmitteilung loeschen; + up (ausgabe); + LEAVE page behandlung. + +zeilenmitteilung loeschen: + cursor (1, 2); out (cleol); line. +END PROC page behandlung; + +PROC seite nochmal durchgehen: + zurueck bis seitenende; + kommandos wiederherstellen; + down (ausgabe); + IF count seitenzaehlung + THEN counter := 0 + FI; + schreibe ggf kopf; + read record (ausgabe, zeile); + seitenlaenge initialisieren; + fussnoten loeschen; + bis seitenende lesen und kommandos verarbeiten; + schreibe ggf fuss; + initialisieren fuer neue seite. + +bis seitenende lesen und kommandos verarbeiten: + durchgang := 2; + zeilen und kommandos verarbeiten; + durchgang := 1. + +zeilen und kommandos verarbeiten: + anz textzeilen := 0; + WHILE NOT seitenende REP + IF mindestens ein kommando vorhanden + THEN IF NOT only command line (zeile) + THEN anz textzeilen INCR 1 + FI; + kommandos verarbeiten und ggf zeile mitzaehlen; + ELSE aktuelle seitenlaenge INCR berechneter zeilenvorschub; + anz textzeilen INCR 1 + FI; + naechste zeile lesen + END REP. + +initialisieren fuer neue seite: + kommandos aufheben; + fussnoten loeschen; + erhoehe seiten und spaltennr; + seitenlaenge initialisieren +END PROC seite nochmal durchgehen; + +PROC seitenlaenge initialisieren: + IF anz spalten > 1 AND laufende spaltennr > 1 + THEN aktuelle seitenlaenge := text laenge vor columns + ELSE aktuelle seitenlaenge := 0; + verarbeite seitenkommandos + FI. + +verarbeite seitenkommandos: + IF kommando seitenspeicher <> "" + THEN zeile := kommando seitenspeicher; + kommando seitenspeicher := ""; + INT CONST xx := durchgang; + durchgang := 4; + kommandos verarbeiten; + durchgang := xx + FI. +END PROC seitenlaenge initialisieren; + +PROC zurueck bis seitenende: + up (ausgabe, "#page##---", line no (ausgabe)); + IF anz spalten > 1 AND laufende spaltennr > 1 + THEN down (ausgabe); + schreibe free (text laenge vor columns + head laenge); + up (ausgabe) + FI; + read record (ausgabe, zeile); + cout (line no (ausgabe)); +END PROC zurueck bis seitenende; + +BOOL PROC seitenende: + pos (zeile, "#page#") = 1 AND pos (zeile, "-----", 8) = 8 +END PROC seitenende; + +(**************************** eigentliche seitenform-routine *********) + +PROC seiten form: + enable stop; + datei assoziieren; + page form initialisieren; + to line (ausgabe, 1); + read record (ausgabe, zeile); + in nullter seite := TRUE; + nullte seite verarbeiten; + nullte seitengrenze einfuegen; + in nullter seite := FALSE; + formieren. + +nullte seite verarbeiten: + aktuelle seitenlaenge := 0; + WHILE only command line (zeile) REP + IF seitenende + THEN errorstop ("Bitte Originaldatei bearbeiten (keine Druckdatei)") + FI; + kommandos verarbeiten; + IF es war ein free kommando OR tabellen kommando + THEN LEAVE nullte seite verarbeiten + ELIF es war ein linefeed in der zeile + THEN berechne zeilenvorschub; + es war ein linefeed in der zeile := FALSE; + naechste zeile lesen + ELIF zeile noch nicht verarbeitet + THEN read record (ausgabe, zeile); + zeile noch nicht verarbeitet := FALSE + ELSE naechste zeile lesen + FI; + cout (line no (ausgabe)) + ENDREP. + +es war ein free kommando: + aktuelle seitenlaenge <> 0. + +tabellen kommando: + kommando index >= 35 AND kommando index <= 44. + +nullte seitengrenze einfuegen: + laufende spaltennr := 0; + grenzmarkierung in dummy speichern; + record einfuegen (dummy); + read record (ausgabe, zeile); + kommandos aufheben; + aktuelle seitenlaenge := 0; + erhoehe seiten und spaltennr; + nummer erste seite := laufende seiten nr [1]. + +formieren: + REP + cout (line no (ausgabe)); + IF mindestens ein kommando vorhanden + THEN kommandos verarbeiten und ggf zeile mitzaehlen + ELSE aktuelle seitenlaenge INCR berechneter zeilenvorschub; + FI; + IF erreichte seitenlaenge > eingestellte seitenlaenge + THEN ende einer seite + FI; + IF eof (ausgabe) + THEN eof behandlung; + LEAVE formieren + ELSE down (ausgabe); + IF eof (ausgabe) + THEN eof behandlung; + LEAVE formieren + ELSE read record (ausgabe, zeile) + FI + FI + END REP. +END PROC seiten form; + +PROC eof behandlung: + grenzmarkierung in dummy speichern; + insert record (ausgabe); + write record (ausgabe, dummy); + nummer letzte seite := laufende seiten nr [1]; + pageblock on := FALSE; + seite nochmal durchgehen; + IF anz refers <> 0 OR mindestens ein topage gewesen + OR counter reference store <> "" + THEN ausgabe datei nochmals durchgehen; + offene referenzen pruefen + FI. + +ausgabe datei nochmals durchgehen: + to line (ausgabe, 1); col (ausgabe, 1); + durchgang := 3; + REP + down (ausgabe, "#", lines (ausgabe)); + IF pattern found + THEN read record (ausgabe, zeile); + cout (line no (ausgabe)); + kommandos verarbeiten; + IF eof (ausgabe) + THEN LEAVE ausgabe datei nochmals durchgehen + ELSE down (ausgabe); col (ausgabe, 1) + FI + ELSE LEAVE ausgabe datei nochmals durchgehen + FI + END REP. + +offene referenzen pruefen: + INT VAR i; + FOR i FROM 1 UPTO anz refers REP + IF NOT refer sammler [i] . referenced + THEN report text processing warning + (3, 0, fehlerdummy, CONCR(refersammler) [i] . kennzeichen) + FI + END REP. +END PROC eof behandlung; + +(************************** kommando verarbeitung **********) + +BOOL PROC mindestens ein kommando vorhanden: + pos (zeile, kommando zeichen) <> 0. +END PROC mindestens ein kommando vorhanden; + +PROC kommandos verarbeiten: + kommando anfangs pos := pos (zeile, kommando zeichen); + WHILE kommando anfangs pos <> 0 REP + verarbeite kommando; + IF kommando index = end OR kommando index = page command0 + OR kommando index = page command1 OR kommando index = fehler index + THEN LEAVE kommandos verarbeiten + ELSE kommando anfangs pos := + pos (zeile, kommando zeichen, kommando ende pos + 1) + FI + END REP. +END PROC kommandos verarbeiten; + +PROC kommandos verarbeiten und ggf zeile mitzaehlen: + max zeilenvorschub := berechneter zeilenvorschub; + max type zeilenvorschub := type zeilenvorschub; + kommandos verarbeiten; + in index oder exponent := 0; + zeile zur seitenlaenge ggf addieren; + IF es war ein linefeed in der zeile + THEN berechne zeilenvorschub; + es war ein linefeed in der zeile := FALSE + FI. + +zeile zur seitenlaenge ggf addieren: + IF only command line (zeile) OR + kommando index = end OR kommando index = page command0 OR + kommando index = page command1 OR kommando index = fehler index + THEN + ELSE aktuelle seitenlaenge INCR max zeilenvorschub; + FI. +END PROC kommandos verarbeiten und ggf zeile mitzaehlen; + +BOOL PROC keine zeichen ausser blank nach dem kommando: + IF kommando anfangs pos > 1 AND + pos (zeile, ""33"", ""255"", 1) = kommando anfangs pos + THEN warnung (13, kommando) + FI; + kommando ende pos = length (zeile) OR + pos (zeile, ""33"", ""254"", kommando ende pos + 1) = 0 +END PROC keine zeichen ausser blank nach dem kommando; + +BOOL PROC absatz zeile: + (zeile SUB length (zeile)) = blank +END PROC absatz zeile; + +(********************** routinen fuers seitenende *************) + +INT PROC erreichte seitenlaenge: + aktuelle seitenlaenge + kopf oder fuss laenge [footnote] + + seitenlaenge fester teil +END PROC erreichte seitenlaenge; + +INT PROC seitenlaenge fester teil: + head laenge + bottom laenge. + +bottom laenge: + IF (NOT insert last bottom AND laufende seitennr [1] = nummer letzte seite) + OR ausgeschalteter bottom + THEN 0 + ELSE kopf oder fuss laenge [fuss] + + bottom laenge fuer gerade oder ungerade seiten + FI. + +bottom laenge fuer gerade oder ungerade seiten: + IF laufende seitennr [1] MOD 2 = 0 + THEN kopf oder fuss laenge [fuss gerade] + ELSE kopf oder fuss laenge [fuss ungerade] + FI. +END PROC seitenlaenge fester teil; + +INT PROC head laenge: + IF (NOT insert first head AND laufende seitennr [1] = nummer erste seite) + OR ausgeschalteter head + THEN 0 + ELSE kopf oder fuss laenge [kopf] + + head laenge fuer gerade oder ungerade seiten + FI. + +head laenge fuer gerade oder ungerade seiten: + IF laufende seitennr [1] MOD 2 = 0 + THEN kopf oder fuss laenge [koπ3Πφ&η6φζ� + ELSE kopf oder fuss laenge [kopf ungerade] + FI. +END PROC head laenge; + +PROC ende einer seite: + IF interaktiv + THEN seitenende ggf verschieben + ELSE seitenende fuer autopageform ggf verschieben + FI; + seitenende einbringen und zurueck. + +seitenende ggf verschieben: + BOOL VAR veraenderungen in der seite :: FALSE; + formatiere ueber bildschirm (veraenderungen in der seite); + schreibe titelzeile; + IF veraenderungen in der seite + THEN zum seitenanfang zur erneuten bearbeitung; + LEAVE ende einer seite + FI. + +seitenende fuer autopageform ggf verschieben: +INT VAR i, hier :: line no (ausgabe); + FOR i FROM 1 UPTO 4 REP + zeile zurueck lesen; + IF absatz zeile OR line no (ausgabe) <= 2 + THEN ggf um leerzeilen nach oben lesen; + naechste zeile lesen; + LEAVE seitenende fuer autopageform ggf verschieben + FI + END REP; + to line (ausgabe, hier); + read record (ausgabe, zeile); + IF pageblock on + THEN FOR i FROM 1 UPTO 4 REP + IF absatz zeile OR eof (ausgabe) OR pos (zeile, "#foot") <> 0 + OR pos (zeile, "#free") <> 0 + THEN naechste zeile lesen; + LEAVE seitenende fuer autopageform ggf verschieben + FI; + naechste zeile lesen + END REP; + to line (ausgabe, hier); + read record (ausgabe, zeile) + FI. + +ggf um leerzeilen nach oben lesen: + INT VAR ii := i; + WHILE zeile = " " AND pageblock on AND ii <= 4 REP + IF line no (ausgabe) <= 2 + THEN LEAVE ggf um leerzeilen nach oben lesen + FI; + zeile zurueck lesen; + ii INCR 1 + END REP. +END PROC ende einer seite; + +PROC seitenende einbringen und zurueck: + letzte textzeile war mit absatz := letzte zeile; + down (ausgabe); + grenzmarkierung in dummy speichern; + record einfuegen (dummy); + up (ausgabe); + seite nochmal durchgehen. + +letzte zeile: + up (ausgabe); + read record (ausgabe, zeile); + absatz zeile. +END PROC seitenende einbringen und zurueck; + +PROC zum seitenanfang zur erneuten bearbeitung: + zurueck bis seitenende; + durchgang := 1; + aktuelle seitenlaenge := 0; + fussnoten loeschen; + kommandos wiederherstellen +END PROC zum seitenanfang zur erneuten bearbeitung; + +(********************** positionierungs routinen ************) + +PROC naechste zeile lesen: + down (ausgabe); + read record (ausgabe, zeile) +END PROC naechste zeile lesen; + +PROC zeile zurueck lesen: + up (ausgabe); + read record (ausgabe, zeile); +END PROC zeile zurueck lesen; + +(***************** seitenende interaktiv positionieren **********) + +PROC formatiere ueber bildschirm (BOOL VAR veraenderungen): + veraenderungen := FALSE; + anz zeilen nach oben := 0; + erste bildschirmzeile schreiben; + schreibe bildschirm; + REP + positioniere lfd satz nach steuerzeichen und ggf schirm schreiben + END REP. + +positioniere lfd satz nach steuerzeichen und ggf schirm schreiben: +TEXT VAR steuerzeichen; + inchar (steuerzeichen); + IF steuerzeichen = upchar + THEN nach oben; + IF fussnoten ende + THEN ueberspringe fussnote nach oben; + schreibe bildschirm + FI + ELIF steuerzeichen = downchar + THEN IF fussnoten anfang + THEN ueberspringe fussnote nach unten; + schreibe bildschirm + ELSE nach unten; + IF fussnoten anfang + THEN ueberspringe fussnote nach unten; + schreibe bildschirm + FI + FI + ELIF steuerzeichen = hop + THEN sprung oder leerzeilen veraenderung; + schreibe bildschirm; + ELIF steuerzeichen = return + THEN IF anz zeilen nach oben < 0 + THEN down (ausgabe); + read record (ausgabe, zeile) + FI; + IF zeile = "" OR zeile = " " + THEN leerzeilen vor neuer seite loeschen + FI; + LEAVE formatiere ueber bildschirm + ELIF steuerzeichen = esc + THEN errorstop ("Abbruch mit ESC") + FI. + +fussnoten anfang: + pos (zeile, "#foot") <> 0 AND anz zeilen nach oben > 0. + +fussnoten ende: + pos (zeile, "#end") <> 0. + +nach oben: + IF anz zeilen nach oben < 0 + THEN nach oben unterhalb der seitengrenze + ELIF eine zeile nach oben war moeglich + THEN IF fussnoten ende + THEN ueberspringe fussnote nach oben; + schreibe bildschirm + ELIF anz vertauschte zeilen < zeilen nach oben + THEN out (upchar); raus; out (upchar); + schreibe seitenbegrenzung auf bildschirm; + anz vertauschte zeilen INCR 1 + ELSE schreibe bildschirm + FI + FI. + +nach oben unterhalb der seitengrenze: + IF anz zeilen nach oben = -1 + THEN cursor (1, pos seitengrenze); out (cl eop); + schreibe seitenbegrenzung auf bildschirm; + cursor (1, pos seitengrenze); + schreibe untere zeilen; + anz zeilen nach oben := 0 + ELSE INT VAR bildschirmzeile unterhalb :: + pos seitengrenze + abs (anz zeilen nach oben) + 1; + cursor (1, bildschirmzeile unterhalb); + out (cl eol); + outsubtext (zeile, 1, 76); + anz zeilen nach oben INCR 1; + bildschirmzeile unterhalb DECR 1; + cursor (1, bildschirmzeile unterhalb); + schreibe seitenbegrenzung auf bildschirm; + zeile zurueck lesen; + cursor (1, pos seitengrenze) + FI. + +nach unten: + IF anz zeilen nach oben < -4 + THEN + ELIF anz zeilen nach oben < 1 + THEN ggf nach unten formatieren + ELIF anz vertauschte zeilen > 0 + THEN out (upchar); raus; line ; + schreibe seitenbegrenzung auf bildschirm; + eine zeile nach unten wenn moeglich; + anz vertauschte zeilen DECR 1 + ELSE eine zeile nach unten wenn moeglich; + IF fussnoten anfang + THEN ueberspringe fussnote nach unten; + FI; + schreibe bildschirm + FI. + +ggf nach unten formatieren: + IF pageblock on + THEN zeile nach unten ueber seitengrenze; + cursor (1, pos seitengrenze); + FI. + +zeile nach unten ueber seitengrenze: + IF eof (ausgabe) OR page oder free oder foot anweisung + THEN LEAVE zeile nach unten ueber seitengrenze + ELSE naechste zeile lesen; + IF eof (ausgabe) OR page oder free oder foot anweisung + THEN zeile zurueck lesen; + LEAVE zeile nach unten ueber seitengrenze + FI; + zeile zurueck lesen + FI; + IF anz zeilen nach oben = 0 + THEN out (cl eol); + out (begin mark); + out ("Über Seitenende hinaus (Stauchung): UP/DOWN"); + out (end mark); + cursor (1, pos seitengrenze + 1); + schreibe untere zeilen; + ELSE naechste zeile lesen; + FI; + cursor (1, pos seitengrenze + abs (anz zeilen nach oben) + 1); + out (cl eol); + outsubtext (zeile, 1, 76); + anz zeilen nach oben DECR 1; + cursor (1, pos seitengrenze + abs (anz zeilen nach oben) + 1); + schreibe seitenbegrenzung auf bildschirm. + +page oder free oder foot anweisung: + pos (zeile, "#page") <> 0 OR pos (zeile, "#free") <> 0 + OR pos (zeile, "#foot") <> 0. + +sprung oder leerzeilen veraenderung: + INT VAR i :: 0; + REP + inchar (steuerzeichen); + IF steuerzeichen = upchar + THEN sprung nach oben + ELIF steuerzeichen = downchar + THEN sprung nach unten + ELIF steuerzeichen = rub out + THEN zeile loeschen; + ELIF steuerzeichen = rub in + THEN leerzeilen einfuegen; + FI + END REP. + +sprung nach oben: + WHILE eine zeile nach oben war moeglich REP + i INCR 1; + IF fussnoten ende + THEN ueberspringe fussnote nach oben; + LEAVE sprung oder leerzeilen veraenderung + FI + UNTIL i >= zeilen nach oben END REP; + LEAVE sprung oder leerzeilen veraenderung. + +sprung nach unten: + WHILE i < zeilen nach oben REP + IF fussnoten anfang + THEN ueberspringe fussnote nach unten; + LEAVE sprung oder leerzeilen veraenderung + ELSE eine zeile nach unten wenn moeglich; + i INCR 1; + FI; + IF fussnoten anfang + THEN ueberspringe fussnote nach unten; + LEAVE sprung oder leerzeilen veraenderung + FI + END REP; + LEAVE sprung oder leerzeilen veraenderung. + +zeile loeschen: + veraenderungen := TRUE; + up (ausgabe); + read record (ausgabe, zeile); + IF seiten ende + THEN down (ausgabe); + ELSE delete record (ausgabe); + FI; + LEAVE formatiere ueber bildschirm. + +leerzeilen einfuegen: + veraenderungen := TRUE; + out (cl eop); + REP + inchar (steuerzeichen); + IF steuerzeichen = return + THEN insert record (ausgabe); + zeile := " "; + write record (ausgabe, zeile); + out (upchar); + raus; + line + ELIF steuerzeichen = rubin + THEN LEAVE formatiere ueber bildschirm + FI + END REP. +END PROC formatiere ueber bildschirm; + +PROC leerzeilen vor neuer seite loeschen: + WHILE zeile = "" OR zeile = " " REP + delete record (ausgabe); + IF eof (ausgabe) + THEN LEAVE leerzeilen vor neuer seite loeschen + ELSE read record (ausgabe, zeile) + FI + END REP. +END PROC leerzeilen vor neuer seite loeschen; + +PROC ueberspringe fussnote nach oben: + WHILE eine zeile nach oben war moeglich REP + IF fussnoten anfang + THEN IF eine zeile nach oben war moeglich + THEN + FI; + LEAVE ueberspringe fussnote nach oben + FI + END REP. + +fussnoten anfang: + pos (zeile, "#foot#") <> 0. +END PROC ueberspringe fussnote nach oben; + +PROC ueberspringe fussnote nach unten: + REP + eine zeile nach unten wenn moeglich; + IF fussnoten ende + THEN eine zeile nach unten wenn moeglich; + LEAVE ueberspringe fussnote nach unten + FI + END REP. + +fussnoten ende: + pos (zeile, "#end#") <> 0. +END PROC ueberspringe fussnote nach unten; + +PROC schreibe free (INT CONST wert): +REAL CONST wert in y steps :: y step conversion (wert); + dummy := "#free("; + IF wert in y steps < 1.0 + THEN dummy CAT "0"; + FI; + dummy CAT text (wert in y steps); + dummy CAT ")#"; + record einfuegen (dummy); +END PROC schreibe free; + +BOOL PROC eine zeile nach oben war moeglich: + IF line no (ausgabe) = 1 + THEN FALSE + ELSE zeile zurueck lesen; + IF seitenende OR columns kommando in dieser zeile + THEN naechste zeile lesen; + FALSE + ELSE anz zeilen nach oben INCR 1; + TRUE + FI + FI. + +columns kommando in dieser zeile: + anz spalten > 1 AND pos (zeile, "#columns") <> 0. +END PROC eine zeile nach oben war moeglich; + +PROC eine zeile nach unten wenn moeglich: + IF anz zeilen nach oben > 0 + THEN naechste zeile lesen; + anz zeilen nach oben DECR 1 + FI +END PROC eine zeile nach unten wenn moeglich; + +PROC erste bildschirmzeile schreiben: + IF anz spalten > 1 + THEN dummy := "Spalten" + ELSE dummy := "Seiten" + FI; + dummy CAT "ende verschieben: UP, DOWN / bestaetigen: RETURN / Abbruch: ESC"; + schreibe titelzeile (dummy). +END PROC erste bildschirmzeile schreiben; + +PROC schreibe bildschirm: + anz vertauschte zeilen := 0; + cursor (1, 3); + out (cl eop); + gehe zurueck; + wieder nach vorne und zeilen ausgeben; + cursor (1, pos seitengrenze); + schreibe seitenbegrenzung auf bildschirm; + cursor (1, pos seitengrenze); + schreibe untere zeilen. + +gehe zurueck: + INT VAR hier :: line no (ausgabe) -1; + to line (ausgabe, hier - zeilen nach oben + 1); + INT VAR anz read zeilen :: hier - line no (ausgabe) + 2. + + wieder nach vorne und zeilen ausgeben: + IF line no (ausgabe) = 1 + THEN ggf leerzeilen auf bildschirm schreiben; + FI; + WHILE line no (ausgabe) <= hier REP + read record (ausgabe, zeile); + raus; + down (ausgabe); + END REP; + read record (ausgabe, zeile). + +ggf leerzeilen auf bildschirm schreiben: + IF zeilen nach oben - anz read zeilen >= 0 + THEN INT VAR i; + FOR i FROM 1 UPTO zeilen nach oben - anz read zeilen REP + line ; out (cl eol); out(" ") + END REP; + line ; out (cl eol); + out ("<< DATEI ANFANG >>"); out (return) + FI. +END PROC schreibe bildschirm; + +PROC schreibe untere zeilen: + gehe weiter und gebe zeilen aus; + gehe wieder zurueck; + skip input; + cursor (1, pos seitengrenze). + +gehe weiter und gebe zeilen aus: +INT VAR anz read zeilen :: 0, + i :: line no (ausgabe); + WHILE anz read zeilen < zeilen nach unten REP + IF eof (ausgabe) + THEN line ; out (cleol); out ("<< DATEI ENDE >>"); + LEAVE gehe weiter und gebe zeilen aus + FI; + raus; + naechste zeile lesen; + anz read zeilen INCR 1 + END REP. + +gehe wieder zurueck: + to line (ausgabe, i); + read record (ausgabe, zeile). +END PROC schreibe untere zeilen; + +(***************** schreib-routinen fuer den bildschirm ************) + +PROC schreibe seitenbegrenzung auf bildschirm: + out (cl eol); out (begin mark); + grenzmarkierung in dummy speichern; + out (dummy); + out (end mark); + out (return) +END PROC schreibe seitenbegrenzung auf bildschirm; + +PROC raus: +INT VAR xzeile, yspalte; + line ; out (cl eol); + outsubtext (zeile, 1, 76); + IF absatz zeile + THEN get cursor (yspalte, xzeile); + cursor (77, xzeile); + out (begin end mark) + FI; + out (return) +END PROC raus; + +PROC schreibe titelzeile: + IF online + THEN schreibe + FI. + +schreibe: + out (hop); out (cleol); + put ("PAGEFORM"); put ("(für"); put (lines (ausgabe)); put ("Zeilen):"); + put (name eingabe datei); + put ("->"); + put (name druck datei); + cursor (1, 3). +END PROC schreibe titelzeile; + +PROC schreibe titelzeile (TEXT CONST t): + IF online + THEN schreibe + FI. + +schreibe: + out (hop); out (cl eol); + out (begin mark); + out (t); + out (end mark) +END PROC schreibe titelzeile; + +(************************** initialisierungs-routine ************) + +PROC page form initialisieren: +BOOL VAR exists; +INT VAR i; + letzte textzeile war mit absatz := TRUE; + letztes seitenende war mit absatz := TRUE; + pageblock on := FALSE; + zeile noch nicht verarbeitet := FALSE; + bereich aufnehmen := FALSE; + count seitenzaehlung := FALSE; + ausgeschalteter head := FALSE; + ausgeschalteter bottom := FALSE; + in tabelle := FALSE; + es war ein linefeed in der zeile := FALSE; + letztes seitenende war in tabelle := FALSE; + mindestens ein topage gewesen := FALSE; + in index oder exponent := 0; + anz refers := 0; + kommando index := 0; + counter := 0; + laufende seitennr [1] := 1; + durchgang := 1; + anz spalten := 1; + modifikation := ""; + tab pos speicher := ""; + kommando seitenspeicher := ""; + counter numbering store := ""; + counter reference store := ""; + dec value := ""; + seitenzeichen := "%"; + eingestelltes limit := dina4 limit; + IF NOT file works + THEN font nr := 1; + eingestellter typ := font (1); + type zeilenvorschub := + font height (1) + font lead (1) + font depth (1); + eingestellte seitenlaenge := y step conversion (dina4 pagelength); + real eingestellter zeilenvorschub := 1.0 + FI; + berechneter zeilenvorschub := + int (real (type zeilenvorschub) * real eingestellter zeilenvorschub + 0.5); + max zeilenvorschub := berechneter zeilenvorschub; + max type zeilenvorschub := type zeilenvorschub; + FOR i FROM 1 UPTO 7 REP + kopf oder fuss laenge [i] := 0; + anz kopf oder fuss zeilen [i] := 0 + END REP; + IF online + THEN page + FI; + IF command dialogue + THEN interaktiv := TRUE; + ELSE interaktiv := FALSE; + FI; + IF online + THEN page + FI; + schreibe titelzeile +END PROC page form initialisieren; + +PROC central pagefo9ü̈NSγJr+�Cβ+̂γ��{s�β�KrΓλγb�#Τκ�ZK�� + name eingabe datei := input; + name druck datei := druck; + IF exists (druck) + THEN forget (druck, quiet) + FI; + disable stop; + ds := nilspace; + refer sammler := ds; + seiten form; + forget(ds); + IF is error + THEN put error; + clear error; + last param (name eingabe datei) + ELSE last param (name druck datei) + FI; + enable stop; + IF anything noted + THEN note edit (ausgabe) + FI. +END PROC central pageform routine; + +PROC pageform (TEXT CONST input, druck): + file works := FALSE; + central pageform routine (input, druck). +END PROC pageform; + +PROC pageform (TEXT CONST input): + file works := FALSE; + central pageform routine (input, input + ".p"). +END PROC pageform; + +PROC pageform: + file works := FALSE; + pageform (last param) +END PROC pageform; + +PROC pageform (TEXT CONST input, REAL CONST lf, seitenlaenge): + file works := TRUE; + eingestellte seitenlaenge := y step conversion (seitenlaenge); + real eingestellter zeilenvorschub := lf; + central pageform routine (input, input + ".p") +END PROC pageform; + +PROC autopageform: + autopageform (last param) +END PROC autopageform; + +PROC autopageform (TEXT CONST input): + command dialogue (false); + pageform (input); + command dialogue (true) +END PROC autopageform; +END PACKET seiten formatieren; +(* +REP + IF yes ("autopageform") + THEN autopageform ("pfehler") + ELSE pageform ("pfehler") + FI; + edit("pfehler.p"); +UNTIL yes ("ENDE") ENDREP; +*) + |