path: root/system/multiuser/1.7.5/src/pager

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