(* ------------------- VERSION 406 vom 28.05.86 ----(1.7.5)------------- *)
PACKET liner DEFINES line form,
                     autoform,
                     hyphenation width,
                     additional commands:

(* Programm zur Zeilenformatierung mit unterschiedlichen Schriftypen
   Autor: Rainer Hahn
   Stand: 1.7.1 Febr. 1984
          1.7.3 Juli  1984
          1.7.4 Juni  1985 
          1.7.5 ab Okt. 1985 
 *)

(********************* form deklarationen ********************)

TEXT VAR zeichen,
         aufzaehlungszeichen,
         par 1,
         par 2,
         kommando,
         command store,
         zielreferenzen,
         herkunftsreferenzen,
         aktuelle referenz,
         alter schriftname, 
         dummy,
         fehlerdummy,
         footdummy,
         scan symbol,
         font table name :: "",
         trennwort,
         trennwort ohne komm,
         wort1,
         wort1 ohne komm,
         wort2,
         font nr speicher,
         modifikations speicher,
         mod zeilennr speicher,
         index speicher,
         ind zeilennr speicher,
         counter numbering store,
         counter reference store,
         trennsymbol,
         puffer,
         neue zeile,
         zeile,
         einrueckung zweite zeile,
         aktuelle blanks,
         alte blanks,
         zusaetzliche commands :: "",
         kommando liste;

INT CONST rueckwaerts :: -1,
          esc char ohne zweites byte ausgang :: - maxint - 1;

INT VAR anz tabs,
        mitzuzaehlende zeichen,
        anz blanks freihalten,
        kommando index,
        scan type,
        font nr :: 1,
        blankbreite fuer diesen schrifttyp,
        aktuelle     pitch zeilenlaenge,
        eingestellte indentation pitch,
        einrueckbreite,
        zeilenbreite,
        trennbreite in prozent :: 7,
        trennbreite,
        max trennlaenge,
        max trenn laenge ohne komm,
        zeichenwert ausgang,
        formelbreite,
        formelanfang,
        zeilennr,
        wortanfang,
        wortende,
        erste fehler zeilennr,
        macro kommando ende,
        von,
        pufferlaenge,
        zeichenpos,
        zeichenpos bereits verarbeitet;

BOOL VAR ask type and limit,
         format file in situ,
         lineform mode,
         macro works,
         kommandos speichern,
         letzter puffer war absatz,
         in d und e verarbeitung,
         in tabelle,
         in foot uebertrag,
         in foot;

LET hop          = ""1"",
    rechts       = ""2"",
    cl eol       = ""5"",
    links        = ""8"",
    return       = ""13"",
    begin mark   = ""15"",
    end mark     = ""14"",
    escape       = ""27"",
    trennzeichen = ""221"",
    trenn k      = ""220"",
    blank        = " ",
    bindestrich  = "-",
    buchstaben   =
               "abcdefghijklmnopqrstuvwxyzüäößABCDEFGHIJKLMNOPQRSTUVWXYZÄÜö",
    kommando zeichen = "#",
    max tabs              = 30,
    extended char ausgang = 32767,
    blank      ausgang    = 32766,
    kommando   ausgang    = 32765,
    such       ausgang    = 32764,
    zeilenende ausgang    = 0,
    vorwaerts          = 1,
    type1        = 1,
    linefeed     = 3,
    limit        = 4,
    free         = 5,
    page command0= 6,
    page command1= 7,
    on           = 8,
    off          = 9,
    page nr      = 10,
    pagelength   = 11,
    start        = 12,
    foot         = 13,
    end          = 14,
    head         = 15,
    headeven     = 16,
    headodd      = 17,
    bottom       = 18,
    bottomeven   = 19,
    bottomodd    = 20,
    block        = 21,
    material     = 22,
    columns      = 23,
    columnsend   = 24,
    ib0          = 25,
    ib1          = 26,
    ib2          = 27,
    ie0          = 28,
    ie1          = 29,
    ie2          = 30,
    topage       = 31,
    goalpage     = 32,
    count0       = 33,
    count1       = 34,
    setcount     = 35,
    value0       = 36,
    value1       = 37,
    table        = 38,
    table end    = 39,
    r pos        = 40,
    l pos        = 41,
    c pos        = 42,
    d pos        = 43,
    b pos        = 44,
    clear pos0   = 45,
    clear pos1   = 46,
    right        = 47,
    center       = 48,
    skip         = 49,
    skip end     = 50,
    u command    = 51,
    d command    = 52,
    e command    = 53,
    head on      = 54,
    head off     = 55,
    bottom on    = 56,
    bottom off   = 57,
    count per page=58,
    fillchar     = 59,
    mark command = 60,
    mark end     = 61,
    pageblock    = 62,
    bsp          = 63,
    counter1     = 64,
    counter2     = 65,
    setcounter   = 66,
    putcounter0  = 67,
    putcounter1  = 68,
    storecounter = 69,
    ub           = 70,
    ue           = 71,
    fb           = 72,
    fe           = 73;

REAL VAR limit in cm :: 16.0,
         fehler wert :: -1.0;

FILE VAR eingabe,
         ausgabe,
         file;

FRANGE VAR alter bereich; 
 
DATASPACE VAR ds;

ROW 256 INT VAR pitch table;
ROW max tabs TEXT VAR tab zeichen;
ROW max tabs ROW 3 INT VAR tabs;
(* 1. Eintrag: Position
   2. Eintrag: Art
   3. Eintrag: Bis-Position
*)
 
(************************** liner state-Routinen **********************)

TYPE LINERSTATE =
  STRUCT (INT position, from,
          BOOL in macro,
          TEXT buffer line, next line,
               old blanks, actual blanks,
               new line);

LINERSTATE VAR before macro state,
               before foot state;

PROC get liner state (LINERSTATE VAR l):
  l . position    := zeichenpos;
  l . from        := von;
  l . in macro    := macro works;
  l . buffer line := puffer;
  l . next line   := zeile;
  l . old blanks  := alte blanks;
  l . actualblanks:= aktuelle blanks;
  l . new line    := neue zeile;
END PROC get liner state;

PROC put liner state (LINERSTATE CONST l):
  zeichenpos          := l . position;
  von                 := l . from;
  macro works         := l . in macro;
  puffer              := l . buffer line ;
  zeile               := l . next line ;
  alte blanks         := l . old blanks;
  aktuelle blanks     := l . actual blanks;
  neue zeile          := l . new line ;
  pufferlaenge := length (puffer);
END PROC put liner state;

(*********************** Utility Routinen **************************)

PROC delete int (TEXT VAR resultat, INT CONST delete pos) :
    change  (resultat, delete pos * 2 - 1, delete pos * 2, "")
END PROC delete int; 

OP CAT (TEXT VAR resultat, INT CONST zahl) :
    resultat CAT "  ";
    replace (resultat, LENGTH resultat DIV 2, zahl);
END OP CAT;

PROC conversion (REAL VAR cm, INT VAR pitches):
  disable stop;
    INT VAR i :: x step conversion (cm);
    IF is error
      THEN dummy := error message;
           clear error;
           dummy CAT " -> ";
           dummy CAT text (cm);
           fehler (38, dummy);
           cm := fehler wert
    ELIF i < 0
      THEN fehler (38, "negativ");
           cm := fehler wert
      ELSE pitches := i
    FI;
  enable stop
END PROC conversion;

(************************** Fehlermeldungen **********************)
 
PROC fehler (INT CONST nr, TEXT CONST addition):
  fehler melden;
  meldung auf terminal ausgeben und ggf zeilennummer merken.
 
fehler melden:
  report text processing error (nr, zeilen nr, fehlerdummy, addition).
END PROC fehler;
 
PROC warnung (INT CONST nr, TEXT CONST addition):
  warnung melden;
  meldung auf terminal ausgeben und ggf zeilennummer merken.
 
warnung melden:
  report text processing warning (nr, zeilennr, fehlerdummy, addition).
END PROC warnung;

PROC meldung auf terminal ausgeben und ggf zeilennummer merken:
  IF online
    THEN line ;
         out (fehlerdummy);
         line ;
  FI;
  IF erste fehler zeilennr = 0
    THEN erste fehler zeilennr := zeilennr
  FI
END PROC meldung auf terminal ausgeben und ggf zeilennummer merken;

(*********************** Macro-Bearbeitung ***********************)

PROC fuehre initialisierung fuer macro aus:
  get liner state (before macro state);
  get macro line (puffer);
  pufferlaenge := length (puffer);
  get macro line (zeile);
  zeichenpos := 1;
  von := 1;
  macro works := TRUE.
END PROC fuehre initialisierung fuer macro aus;

PROC macro end command: 
  kommando := subtext (kommando, 2);
  scan (kommando);
  next symbol (scan symbol, scan type); 
  IF NOT macro works
    THEN fehler (40, kommando);
         LEAVE macro end command
  ELIF scan symbol <> "macroend" 
    THEN fehler (33, kommando) 
    ELSE put liner state (before macro state);
  FI
END PROC macro end command; 
 
(************************** Schrifttyp einstellen *********************)

PROC stelle font ein:
  IF alter schriftname = par1
    THEN IF zeilen nr > 2
           THEN warnung (8, par1)
           ELSE LEAVE stelle font ein
         FI
  ELIF font exists (par1)
    THEN font nr := font (par1);
    ELSE fehler (1, par1);
         par1 := font (1);
         font nr := 1
  FI;
  alter schriftname := par1;
  hole font und stelle trennbreite ein
END PROC stelle font ein;
 
PROC hole font:
  INT VAR x; (* height Werte *)
  get font (font nr, eingestellte indentation pitch, x, x, x, pitch table);
  pitch table [code (kommandozeichen) + 1] := kommando ausgang;
  blankbreite fuer diesen schrifttyp := pitch table [code (blank) + 1] 
END PROC hole font;

PROC hole font und stelle trennbreite ein:
  hole font;
  trennbreite setzen
END PROC hole font und stelle trennbreite ein;

PROC trennbreite setzen:
  trennbreite := berechnete trennbreite.

berechnete trennbreite:
  INT VAR eingestellte trennbreite;
  conversion (limit in cm, eingestellte trennbreite);
  eingestellte trennbreite := eingestellte trennbreite
                                            DIV 100 * trennbreite in prozent;
  IF eingestellte trennbreite <= zweimal blankbreite
    THEN zweimal blankbreite
    ELSE eingestellte trennbreite
  FI.

zweimal blankbreite:
  2 * eingestellte indentation pitch.
END PROC trennbreite setzen; 
 
PROC hyphenation width (INT CONST prozente): 
  IF prozente < 4 OR prozente > 20 
    THEN putline ("Fehler: Einstellbare Trennbreite zwischen 4 und 20%") 
    ELSE trennbreite in prozent := prozente
  FI 
END PROC hyphenation width;

(************************** kommando verarbeitung ****************)

PROC additional commands (TEXT CONST k): 
  zusaetzliche commands := k 
END PROC additional commands; 
 
TEXT PROC additional commands:
  zusaetzliche commands
END PROC additional commands;

BOOL PROC hinter dem kommando steht nix (INT CONST komm ende):
  komm ende = pufferlaenge OR absatz hinter dem kommando.

absatz hinter dem kommando:
  komm ende + 1 = pufferlaenge AND puffer hat absatz.
END PROC hinter dem kommando steht nix;

PROC verarbeite kommando und neue zeile auffuellen:
  neue zeile auffuellen (von, zeichenpos - 1);
  von := zeichenpos;
  verarbeite kommando;
  neue zeile auffuellen (von, zeichenpos - 1);
  von := zeichenpos
END PROC verarbeite kommando und neue zeile auffuellen;

PROC speichere kommando:
  command store CAT "#";
  command store CAT kommando;
  command store CAT "#"
END PROC speichere kommando;

PROC execute stored commands:
  IF length (command store) <> 0
    THEN kommandos speichern := FALSE;
         dummy := puffer;
         INT VAR zpos := zeichenpos;
         zeichenpos := 1;
         puffer := command store;
         pufferlaenge := length (puffer);
         execute commands;
         puffer := dummy;
         pufferlaenge := length (puffer);
         zeichenpos := zpos;
         command store := "";
  FI;
  kommandos speichern := TRUE.

execute commands:
  WHILE zeichenpos < pufferlaenge REP
    verarbeite kommando
  END REP.
END PROC execute stored commands;

PROC verarbeite kommando:
INT VAR  anz params,
         intparam,
         kommando ende;
REAL VAR realparam;
   zeichenpos INCR 1;
   kommando ende := pos (puffer, kommando zeichen, zeichenpos);
   IF kommando ende <> 0
     THEN kommando oder kommentar kommando verarbeiten;
          zeichenpos := kommando ende + 1
     ELSE fehler (2, "")
  FI.

kommando oder kommentar kommando verarbeiten:
  kommando := subtext (puffer, zeichenpos, kommando ende - 1);
  TEXT CONST erstes kommandozeichen :: (kommando SUB 1);
  IF pos ("-/"":*", erstes kommandozeichen) = 0
    THEN scanne kommando und fuehre es aus
    ELSE restliche kommandos
  FI.

restliche kommandos:
  IF erstes kommandozeichen = "-" OR erstes kommandozeichen = "/"
    THEN
  ELIF erstes kommandozeichen = """"
    THEN scan (kommando);
         next symbol (scan symbol, scan type);
         INT VAR scan type2;
         next symbol (scan symbol, scan type2);
         IF scan type <> 4 OR scan type2 <> 7
           THEN fehler (58, kommando)
         FI
  ELIF erstes kommandozeichen = "*"
    THEN zeichenpos := kommando ende + 1;
         macroend command;
         LEAVE verarbeite kommando
  ELIF erstes kommandozeichen = ":"
    THEN disable stop;
         delete char (kommando, 1);
         INT CONST line no before do := line no (eingabe);
         do (kommando);
         to line (eingabe, line no before do);
         IF is error
           THEN dummy := error message;
                clear error;
                dummy CAT " -> ";
                dummy CAT kommando;
                fehler (9, dummy)
         FI;
         enable stop
  FI.
 
scanne kommando und fuehre es aus:
   analyze command (kommando liste, 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 scanne kommando und fuehre es aus
   FI;
   enable stop;
   setze kommando um.

setze kommando um:
   SELECT kommando index OF
 
CASE type1:
     stelle font ein;
     modifikations speicher := "";
     mod zeilennr speicher  := ""
 
CASE limit:
     realparam := real (par1); 
     IF kommandos speichern
       THEN speichere kommando
     ELIF last conversion ok AND pos (par1, ".") <> 0
       THEN IF realparam = 0.0
              THEN fehler (37, "")
              ELSE conversion (realparam, aktuelle pitch zeilenlaenge);
                   IF realparam <> fehlerwert
                     THEN limit in cm := realparam;
                          trennbreite setzen
                   FI
            FI
       ELSE fehler (4, par1);
     FI
 
CASE on, ub, fb:
     TEXT VAR mod zeichen;
     IF kommando index = ub
       THEN mod zeichen := "u"
     ELIF kommando index = fb
       THEN mod zeichen := "b"
       ELSE mod zeichen := (par1 SUB 1);
     FI;
     INT VAR position :: pos (modifikations speicher, mod zeichen);
     IF position <> 0
       THEN dummy := mod zeichen + " in Zeile ";
            dummy CAT text (mod zeilennr speicher ISUB position);
            fehler (54, dummy);
            replace (mod zeilennr speicher, position, zeilennr);
       ELSE modifikations speicher CAT mod zeichen;
            mod zeilennr speicher CAT zeilennr
     FI
 
CASE off, fe, ue:
     IF kommando index = ue
       THEN mod zeichen := "u"
     ELIF kommando index = fe
       THEN mod zeichen := "b"
       ELSE mod zeichen := (par1 SUB 1);
     FI;
     position := pos (modifikations speicher, mod zeichen);
     IF position  = 0
       THEN fehler (55, mod zeichen)
       ELSE delete char (modifikations speicher, position);
            delete int (mod zeilennr speicher, position)
     FI
 
CASE pagenr, pagelength, start, block, material, setcount, right, center,
     linefeed:
 
CASE head, headodd, headeven, bottom, bottomodd, bottomeven, end, free,
          page command0, page command1, columns, columnsend:
     IF NOT hinter dem kommando steht nix (kommando ende)
       THEN fehler (19, kommando)
     ELIF kommando ende = pufferlaenge
       THEN IF (neue zeile SUB length (neue zeile)) = blank
              THEN delete char (neue zeile, length (neue zeile))
            FI;
            puffer CAT blank;
            pufferlaenge := length (puffer)
     FI;
     in foot := FALSE
 
CASE foot:
     IF in foot uebertrag
       THEN zeilenbreite := aktuelle pitch zeilenlaenge + 1
     ELIF in foot
       THEN fehler (3, "")
       ELSE fuelle ggf zeile vor foot auf (kommando ende)
     FI
 
CASE ib0, ib1, ib2:
     TEXT VAR ind zeichen;
     IF kommando index = ib0
       THEN ind zeichen:= "1"
       ELSE ind zeichen := par1
     FI;
     position := pos (index speicher, ind zeichen);
     IF position <> 0
       THEN dummy := ind zeichen + " in Zeile ";
            dummy CAT text (ind zeilennr speicher ISUB position);
            fehler (56, dummy);
            replace (ind zeilennr speicher, position, zeilennr)
       ELSE index speicher CAT ind zeichen;
            ind zeilennr speicher CAT zeilennr
     FI

CASE ie0, ie1, ie2:
     IF kommando index = ie0
       THEN ind zeichen := "1"
       ELSE ind zeichen := par1
     FI;
     position := pos (index speicher, ind zeichen);
     IF position = 0
       THEN fehler (57, ind zeichen)
       ELSE delete char (index speicher, position);
            delete int (ind zeilennr speicher, position)
     FI

CASE topage, count1: 
     herkunftsreferenzen speichern;
     zeilenbreite um blankbreite erhoehen (3)
 
CASE count0: 
     zeilenbreite um blankbreite erhoehen (3)
 
CASE value0, value1: 
     IF anz params <> 0
       THEN zielreferenzen speichern ohne warnung
     FI;
     zeilenbreite um blankbreite erhoehen (3)

CASE goalpage: 
     zielreferenzen speichern

CASE table:
     IF in tabelle
       THEN fehler (41, "")
       ELSE IF hinter dem kommando steht nix (kommando ende)
              THEN zeichenpos := pufferlaenge;
                   neue zeile auffuellen und ausgabe bei zeilenende
              ELSE neue zeile auffuellen (von, kommando ende);
                   puffer := subtext (puffer, kommandoende + 1);
                   schreibe und initialisiere neue zeile
            FI;
            verarbeite tabelle;
            LEAVE verarbeite kommando
     FI

CASE table end:
     IF NOT in tabelle
       THEN fehler (59, "")
     FI

CASE r pos:
     IF kommandos speichern
       THEN speichere kommando
       ELSE tabulatorposition eintragen (r pos)
     FI

CASE l pos:
     IF kommandos speichern
       THEN speichere kommando
       ELSE tabulatorposition eintragen (l pos)
     FI

CASE c pos:
     IF kommandos speichern
       THEN speichere kommando
       ELSE tabulatorposition eintragen (c pos)
     FI

CASE d pos:
     IF kommandos speichern
       THEN speichere kommando
       ELSE tabulatorposition eintragen (d pos)
     FI

CASE b pos:
     IF kommandos speichern
       THEN speichere kommando
       ELSE tabulatorposition eintragen (b pos)
     FI

CASE clear pos0:
     IF kommandos speichern
       THEN speichere kommando
       ELSE anz tabs := 0;
     FI

CASE clear pos1:
     IF kommandos speichern
       THEN speichere kommando
       ELSE tabulatorposition loeschen
     FI

CASE skip:
     IF hinter dem kommando steht nix (kommando ende)
       THEN neue zeile auffuellen und ausgabe bei zeilenende
       ELSE neue zeile auffuellen (von, kommandoende);
            puffer := subtext (puffer, kommandoende + 1);
            schreibe und initialisiere neue zeile
     FI;
     skip zeilen verarbeiten;
     kommando ende := zeichenpos;

CASE skip end:

CASE u command, d command:
     INT VAR next smaller font;
     speichere font nr;
     IF next smaller font exists (font nr, next smaller font)
       THEN font nr := next smaller font
     FI;
     hole font und stelle trennbreite ein;
     IF NOT in d und e verarbeitung
       THEN verarbeite index und exponenten;
            LEAVE verarbeite kommando
     FI

CASE e command:
     entspeichere font nr

CASE head on, head off, bottom on, bottom off, count per page, fillchar,
     mark command, markend, pageblock:

CASE bsp:
     zeichenpos DECR 2;
     IF kommandoende = length (puffer) OR
        (puffer SUB kommandoende + 1) = kommandozeichen OR
        zeichenpos < 1 OR
        (puffer SUB zeichenpos) = kommandozeichen
       THEN fehler (28, "");
            LEAVE setze kommando um
     FI;
     begin of this char (puffer, zeichenpos);
     kommandoende INCR 1;
     INT VAR diese breite    :: breite (puffer, zeichenpos),
             naechste breite :: breite (puffer, kommandoende);
     IF in d und e verarbeitung
       THEN formelbreite DECR diese breite;
            formelbreite INCR max (diese breite, naechste breite)
       ELSE zeilenbreite DECR diese breite;
            zeilenbreite INCR max (diese breite, naechste breite) 
     FI;
     zeichenpos := kommandoende;
     char pos move (vorwaerts);
     LEAVE verarbeite kommando

CASE counter1, counter2:
     dummy := "#";
     dummy CAT par1;
     dummy CAT "#";
     IF pos (counter numbering store, dummy) = 0
       THEN fehler (34, par1);
     FI;
     IF kommando index = counter1
       THEN par2 := "0"
     FI;
     anz blanks freihalten := 3 + 2 * int (par2);
     zeilenbreite um blankbreite erhoehen (anz blanks freihalten)

CASE set counter:
     dummy := "#";
     dummy CAT par1;
     dummy CAT "#";
     IF pos (counter numbering store, dummy) = 0
       THEN counter numbering store CAT dummy
       ELSE warnung (15, par1)
     FI

CASE put counter0:
     zeilenbreite um blankbreite erhoehen (anz blanks freihalten) 

CASE put counter1:
     dummy := "#";
     dummy CAT par1;
     dummy CAT "#";
     INT VAR begin pos :: pos (counter reference store, dummy);
     IF begin pos = 0
       THEN counter reference store CAT "u";
            counter reference store CAT dummy
     ELIF (counter reference store SUB begin pos - 1) <> "u"
       THEN insert char (counter reference store,"u", max (begin pos, 1))
     FI;
     zeilenbreite um blankbreite erhoehen (5)

CASE store counter:
     dummy := "#";
     dummy CAT par1;
     dummy CAT "#";
     begin pos := pos (counter reference store, dummy);
     IF begin pos <> 0
       THEN IF (counter reference store SUB begin pos - 1) = "i" OR
               (counter reference store SUB begin pos - 2) = "i"
              THEN fehler (35, par1)
            ELIF (counter reference store SUB begin pos - 1) = "u"
              THEN insert char (counter reference store, "i",
                                max (begin pos - 1, 1))
              ELSE insert char (counter reference store, "i",
                                max (begin pos, 1))
            FI
       ELSE counter reference store CAT "i";
            counter reference store CAT dummy
     FI

OTHERWISE
     IF macro command and then process parameters (kommando)
       THEN IF macro works
              THEN fehler (15, kommando)
              ELSE zeichenpos := kommando ende + 1;
                   neue zeile auffuellen (von, zeichenpos - 1);
                   von := zeichenpos;
                   fuehre initialisierung fuer macro aus;
                   LEAVE verarbeite kommando
            FI
     ELIF zusaetzliche commands <> ""
       THEN analyze command (zusaetzliche commands, kommando, 3,
                             kommando index, anz params, par1, par2);
            IF kommando index = 0
              THEN fehler (8, kommando)
            FI
       ELSE fehler (8, kommando)
     FI;
END SELECT.
END PROC verarbeite kommando;
 
(************************* Indizes und Exponenten **********************)

PROC zeilenbreite um blankbreite erhoehen (INT CONST anz):
  INT CONST blankbreite mal anz :: anz * eingestellte indentation pitch;
  IF in d und e verarbeitung 
    THEN formelbreite INCR blankbreite mal anz
    ELSE zeilenbreite INCR blankbreite mal anz
  FI;
  mitzuzaehlende zeichen INCR anz
END PROC zeilenbreite um blankbreite erhoehen;

PROC speichere font nr:
  IF index oder exponent anfang
    THEN suche wortanfang in neuer zeile;
         zeilenbreite DECR formelbreite
  FI;
  font nr speicher CAT " ";
  font nr speicher CAT text (font nr).

index oder exponent anfang:
  font nr speicher = "".

suche wortanfang in neuer zeile:
  auf das letzte zeichen stellen;
  WHILE NOT wortanfang vor formel REP
    formelbreite INCR breite (neue zeile, formelanfang);
    IF formelanfang = 1
      THEN LEAVE suche wortanfang in neuer zeile
    FI;
    char pos move (neue zeile, formelanfang, rueckwaerts);
  END REP;
  char pos move (neue zeile, formelanfang, vorwaerts).

wortanfang vor formel:
  pos (" #", neue zeile SUB formelanfang) <> 0.

auf das letzte zeichen stellen:
  formelanfang := length (neue zeile);
  formelbreite := 0;
  IF formelanfang > 0
    THEN begin of this char (neue zeile, formelanfang);
    ELSE formelanfang := 1;
         LEAVE suche wortanfang in neuer zeile
  FI
END PROC speichere font nr;

PROC verarbeite index und exponenten:
  in d und e verarbeitung := TRUE;
  zeichenpos := pos (puffer, kommandozeichen, zeichenpos) + 1;
  INT VAR altes zeichenpos := zeichenpos;
  verarbeite index oder exponenten zeichen;
  fehler (52, "");
  entspeichere font nr.

verarbeite index oder exponenten zeichen:
  REP
    stranalyze (pitch table, formelbreite,
               aktuelle pitch zeilenlaenge - zeilenbreite,
                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
    IF zeichenwert ausgang = kommando ausgang
      THEN verarbeite zeichen vor kommando;
           verarbeite kommando und neue zeile auffuellen;
           IF NOT in d und e verarbeitung
             THEN zeilenbreite INCR formelbreite;
                  LEAVE verarbeite index und exponenten
           FI;
           altes zeichenpos := zeichenpos
    ELIF zeichenwert ausgang = extended char ausgang
      THEN char pos move (vorwaerts);
           zeilenbreite INCR breite (puffer, zeichenpos);
           char pos move (vorwaerts)
    ELIF     zeichenpos >= pufferlaenge
         AND formelbreite + zeilenbreite < aktuelle pitch zeilenlaenge
      THEN LEAVE verarbeite index oder exponenten zeichen
    ELIF formelanfang <= 1
      THEN fehler (53, "");
           formelbreite := 0;
    ELIF zeichenwert ausgang = esc char ohne zweites byte ausgang
      THEN fehler (23, "");
           LEAVE verarbeite index oder exponenten zeichen
      ELSE schreibe neue zeile vor formelanfang
    FI
  END REP.

verarbeite zeichen vor kommando:
  mitzuzaehlende zeichen INCR
                         number chars (puffer, altes zeichenpos, zeichenpos);
  IF (puffer SUB zeichenpos) <> blank
    THEN aufzaehlungszeichen := (puffer SUB zeichenpos)
  FI;
  char pos move (vorwaerts).

schreibe neue zeile vor formelanfang:
  dummy := subtext (neue zeile, formelanfang);
  neue zeile := subtext (neue zeile, 1, formelanfang - 1);
  loesche nachfolgende blanks;
  schreibe und initialisiere neue zeile;
  neue zeile CAT dummy;
  formelanfang := 1;
  char pos move (vorwaerts)
END PROC verarbeite index und exponenten;

PROC entspeichere font nr:
  INT VAR index := length (font nr speicher);
  IF index <= 1
    THEN fehler (51, "")
    ELSE suche nr anfang;
         entspeichere;
  FI.

suche nr anfang:
  WHILE (font nr speicher SUB index) <> " " AND index <> 0 REP
    index DECR 1
  END REP.

entspeichere:
  font nr := int (subtext (font nr speicher, index + 1));
  IF index <= 1
    THEN font nr speicher := "";
         in d und e verarbeitung := FALSE
    ELSE font nr speicher := subtext (font nr speicher, 1, index - 1)
  FI;
  hole font und stelle trennbreite ein
END PROC entspeichere font nr;

(*************************** skip zeilen ****************************)

PROC skip zeilen verarbeiten:
  REP
    IF dateiende
      THEN errorstop ("Dateiende während skip-Anweisung")
    ELIF skip ende kommando
      THEN LEAVE skip zeilen verarbeiten
    FI;
    neue zeile auffuellen und ausgabe bei zeilenende
  END REP.

dateiende:
  pufferlaenge = 0.

skip ende kommando:
  TEXT VAR kliste :: "skipend:1.0", k;
  INT VAR k anf :: pos (puffer, kommandozeichen),
          kende, anz params, kindex;
  WHILE noch ein kommando vorhanden REP
    kindex := 0;
    analysiere das kommando
  END REP;
  FALSE.

noch ein kommando vorhanden:
  kanf <> 0.

analysiere das kommando:
  kende := pos (puffer, kommandozeichen, kanf + 1);
  IF kende = 0
    THEN fehler (2, "");
         LEAVE skip ende kommando WITH FALSE
  FI;
  k := subtext (puffer, kanf + 1, kende - 1);
  analyze command (kliste, k, 3, kindex, anz params, par1, par2);
  IF kindex = 1
    THEN zeichenpos := kende;
         LEAVE skip ende kommando WITH TRUE
  FI;
  kanf := pos (puffer, kommandozeichen, kende + 1).
END PROC skip zeilen verarbeiten;

(**************** sonderbehandlung von zeilen vor foot *******************)

PROC fuelle ggf zeile vor foot auf (INT VAR com ende):
  IF foot am zeilenende ohne absatz AND NOT macro works
    THEN letzter puffer war absatz := TRUE;
         IF text vor foot AND NOT zeile hat richtige laenge
           THEN INT VAR   foot zeilennr := line no (eingabe);
                INT CONST x1            := com ende;
                in foot uebertrag := TRUE;
                get liner state (before foot state);
                formatiere diese zeile;
                to line (eingabe, foot zeilennr);
                footdummy := neue zeile;
                put liner state (before foot state);
                neue zeile := footdummy;
                com ende := x1;
                in foot uebertrag := FALSE
         FI
  ELIF NOT hinter dem kommando steht nix (com ende)
    THEN fehler (19, kommando);
         LEAVE fuelle ggf zeile vor foot auf
  FI;
  in foot := TRUE.

foot am zeilenende ohne absatz:
  com ende = pufferlaenge.

text vor foot:
  pos (neue zeile, ""33"", ""255"", 1) <> 0.

formatiere diese zeile:
  foot anweisung entfernen;
  lese eingabe datei bis end kommando;
  zeile nach end in zeile;
  formatiere;
  schreibe die veraenderte zeile nach end.
 
foot anweisung entfernen:
  zeichenpos := com ende;
  ueberspringe das kommando (puffer, zeichenpos, rueckwaerts);
  zeichenpos DECR 1;
  puffer := subtext (puffer, 1, zeichenpos);
  WHILE NOT within kanji (puffer, zeichenpos) AND
        (puffer SUB zeichenpos) = blank AND foot stand nicht am zeilenanfang
        REP
    zeilenbreite DECR breite (blank);
    delete char (puffer, zeichenpos);
    delete char (neue zeile, length (neue zeile));
    zeichenpos DECR 1
  END REP;
  pufferlaenge := length (puffer).

foot stand nicht am zeilenanfang:
  zeichenpos > 0.

lese eingabe datei bis end kommando:
  TEXT VAR kliste :: "end:1.0";
  dummy := zeile;
  WHILE NOT foot ende kommando REP
    IF eof (eingabe)
      THEN LEAVE formatiere diese zeile
    FI;
    read record (eingabe, dummy);
    down (eingabe);
  ENDREP;
  INT CONST zeile nach end := line no (eingabe);
  IF NOT end kommando steht am zeilenende
    THEN LEAVE formatiere diese zeile
  FI.

end kommando steht am zeilenende:
  k ende = length (dummy) OR k ende + 1 = length (dummy).

foot ende kommando:
  INT VAR k anf, k ende :: 0, anz params, k index;
  WHILE noch ein kommando vorhanden REP
    k ende := pos (dummy, kommandozeichen, k anf + 1);
    IF k ende = 0
      THEN LEAVE foot ende kommando WITH FALSE
      ELSE kommando := subtext (dummy, k anf + 1, k ende - 1);
    FI;
    analyze command (kliste, kommando, 3, kindex, anz params, par1, par2);
    IF k index = 1
      THEN LEAVE foot ende kommando WITH TRUE
    FI;
  END REP;
  FALSE.

noch ein kommando vorhanden:
  k anf := pos (dummy, kommandozeichen, k ende + 1);
  k anf <> 0.

zeile nach end in zeile:
  read record (eingabe, zeile);
  INT VAR text anf := pos (zeile, ""33"", ""255"", 1);
  IF zeile nach end ist leerzeile
    THEN LEAVE formatiere diese zeile
    ELSE IF text anf > 1
           THEN aktuelle blanks := subtext (zeile, 1, text anf - 1);
                zeile := subtext (zeile, text anf)
         FI;
  FI.

zeile nach end ist leerzeile:
  text anf <= 0.

formatiere:
  IF foot stand nicht am zeilenanfang
    THEN verarbeite letztes zeichen von puffer
    ELSE puffer CAT zeile;
         pufferlaenge := length (puffer)
  FI;
  REP
    stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge,
                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
    IF zeichenwert ausgang = kommando ausgang
      THEN zeichenpos INCR 1;
           neue zeile auffuellen (von, zeichenpos - 1);
           von := zeichenpos;
           INT VAR ende der neuen zeile := length (neue zeile),
                   zpos davor := zeichenpos;
           verarbeite kommando;
           neue zeile auffuellen (von, zeichenpos - 1);
           von := zeichenpos;
           IF kommando index = foot
             THEN behandlung der zeile vor foot;
                  LEAVE formatiere
           ELIF zeichenpos >= pufferlaenge
              OR zeilenbreite > aktuelle pitch zeilenlaenge
             THEN ende einer neuen zeile;
                  LEAVE formatiere
           FI
    ELIF zeichenwert ausgang = extended char ausgang
      THEN char pos move (vorwaerts);
           zeilenbreite INCR breite (puffer, zeichenpos);
           char pos move (vorwaerts)
    ELIF zeichenwert ausgang = zeilenende ausgang
         OR zeichenwert ausgang = esc char ohne zweites byte ausgang
      THEN up (eingabe);
           delete record (eingabe);
           neue zeile auffuellen;
           IF zeichenwert ausgang = esc char ohne zweites byte ausgang
             THEN fehler (23, "")
           FI;
           LEAVE formatiere diese zeile
      ELSE ende einer neuen zeile;
           LEAVE formatiere
    FI
  END REP.

behandlung der zeile vor foot:
  neue zeile := subtext (neue zeile, 1, ende der neuen zeile);
  zeichenpos := zpos davor.

schreibe die veraenderte zeile nach end:
  to line (eingabe, zeile nach end);
  dummy := (text anf - 1) * blank;
  dummy CAT subtext (puffer, zeichenpos);
  IF format file in situ
    THEN insert record (eingabe)
  FI;
  write record (eingabe, dummy).
END PROC fuelle ggf zeile vor foot auf;

(*************** Tabulator- und Tabellen verarbeitung ******************)

PROC tabulatorposition eintragen (INT CONST tab type):
  ROW 3 INT VAR akt tab pos;
  IF anz tabs >= max tabs
    THEN fehler (32, "")
  ELIF tab in cm umwandeln (par1, tab pos in pitches)
    THEN IF tab type = b pos AND tab in cm umwandeln (par2, bis tab)
           THEN 
           ELSE bis tab := 0
         FI;
         TEXT VAR zentrierzeichen;
         IF tab type = d pos
           THEN zentrierzeichen := par2
           ELSE zentrierzeichen := ""
         FI;
        tabs sortiert eintragen
  FI.

tabs sortiert eintragen:
  INT VAR i;
  type tab := tab type;
  FOR i FROM 1 UPTO anz tabs REP
    IF tab pos in pitches = tabs [i] [1]
      THEN fehler (42, par1);
           LEAVE tabulatorposition eintragen
    ELIF tabs [i] [1] > tab pos in pitches
      THEN vertauschen
    FI;
    IF ueberschneidende bpos
      THEN fehler (12, text (xstepconversion (tab pos in pitches)))
    FI;
  END REP;
  anz tabs INCR 1;
  tabs [anz tabs]        := akt tab pos;
  tab zeichen [anz tabs] := zentrierzeichen.

ueberschneidende bpos:
  tabs [i] [2] = bpos AND naechste anfang pos liegt in diesem bpos bereich.

naechste anfang pos liegt in diesem bpos bereich:
  tab pos in pitches <= tabs [i] [3].

vertauschen:
  ROW 3 INT CONST hilf1 :: tabs [i];
  TEXT CONST thilf      :: tab zeichen [i];
  tabs [i]        := akt tab pos;
  tab zeichen [i] := zentrierzeichen;
  akt tab pos     := hilf1;
  zentrierzeichen := thilf.

tab pos in pitches: 
  akt tab pos [1].

type tab:
  akt tab pos [2].

bis tab:
  akt tab pos [3].
END PROC tabulatorposition eintragen;

BOOL PROC tab in cm umwandeln (TEXT CONST text wert, INT VAR f breite):
  REAL VAR cm := real (text wert);
  IF last conversion ok AND pos (text wert, ".") <> 0
    THEN umwandeln
    ELSE fehler (4, par1);
         TRUE
  FI.

umwandeln:
  conversion (cm, f breite);
  IF f breite > aktuelle pitch zeilenlaenge
    THEN fehler (39, par1)
  ELIF cm = fehlerwert
    THEN
    ELSE LEAVE tab in cm umwandeln WITH TRUE
  FI;
  FALSE
END PROC tab in cm umwandeln;

PROC cm angabe der druckposition in dummy (INT CONST nr):
  dummy := text (x step conversion (tabs [nr] [1]));
  IF (dummy SUB length (dummy)) = "."
    THEN dummy CAT "0"
  FI;
  dummy CAT " cm"
END PROC cm angabe der druckposition in dummy;

PROC tabulator position loeschen:
  INT VAR tab pos in pitches;
  IF tab in cm umwandeln (par1, tab pos in pitches)
    THEN versuche zu loeschen
  FI.

versuche zu loeschen:
  INT VAR i;
  FOR i FROM 1 UPTO anz tabs REP
    IF tab pos in pitches = tabs [i] [1]
      THEN verschiebe eintraege nach unten;
           LEAVE tabulator position loeschen
    FI
  END REP;
  fehler (43, par1).

verschiebe eintraege nach unten:
  INT VAR k;
  FOR k FROM i UPTO anz tabs - 1 REP
    tabs [k] := tabs [k + 1];
    tab zeichen [k] := tab zeichen [k + 1];
  END REP;
  anz tabs DECR 1.
END PROC tabulatorposition loeschen;

PROC verarbeite tabelle:
  in tabelle := TRUE;
  pitch table auf blank ausgang setzen;
  verarbeite tabellenzeilen;
  pitch table auf blank setzen;
  IF suchausgang gesetzt
    THEN pitch table [pos tab zeichen in pitch table] :=
                                                breite erstes dezimalzeichen;
         suchausgang gesetzt := FALSE; 
  FI;
  in tabelle := FALSE.

verarbeite tabellenzeilen:
  WHILE pufferlaenge <> 0 REP
    ueberpruefe tabellenzeile;
    zeichenpos := pufferlaenge;
    neue zeile auffuellen und ausgabe bei zeilenende
  END REP;
  puffer       := " ";
  pufferlaenge := 1;
  zeichenpos   := 1;
  fehler (49, "").

ueberpruefe tabellenzeile:
(* Achtung: Zeilenbreite ist Spaltenbreite;
            tab zeilen breite ist Summe der Spalten und Positionen *)
  INT VAR tab zeilen breite :: 0,
          tab no   :: 1;
  WHILE noch tab positionen OR only command line (puffer) REP
    positioniere auf naechste spalte;
    errechne spaltenbreite;
    IF anz tabs > 0
      THEN ueberpruefe ob es passt;
    FI;
    tab no INCR 1
  END REP;
  IF tabellenzeile breiter als limit
    THEN warnung (10, "")
  ELIF noch mehr spaltentexte AND anz tabs <> 0
    THEN warnung (11, subtext (puffer, zeichenpos))
  FI.

noch tab positionen: 
  tab no <= anz tabs.

positioniere auf naechste spalte:
  zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos);
  IF leerzeile oder rest der zeile ist leer 
    THEN IF NOT only command line (puffer) AND pufferlaenge > 1
           THEN warnung (14, "")
         FI;
         LEAVE ueberpruefe tabellenzeile
  FI.

leerzeile oder rest der zeile ist leer:
  zeichenpos <= 0.

errechne spaltenbreite:
  zeilenbreite := 0;
  BOOL VAR suchausgang gesetzt :: FALSE;
  IF diese position ist dezimal pos
    THEN setze dezimalzeichen auf suchausgang
  FI;
  REP
    stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge,
                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
    zeichenpos INCR 1;
    IF zeichenwert ausgang = blank ausgang
      THEN behandele dieses blank
    ELIF zeichenwert ausgang = kommando ausgang
      THEN verarbeite das kommando
    ELIF zeichenwert ausgang = extended char ausgang
      THEN char pos move (vorwaerts);
           zeilenbreite INCR breite (puffer, zeichenpos);
           char pos move (vorwaerts)
    ELIF zeichenwert ausgang = such ausgang
      THEN verarbeite ersten teil der dezimal zentrierung 
    ELIF zeichenwert ausgang = esc char ohne zweites byte ausgang
      THEN fehler (23, "");
           LEAVE ueberpruefe tabellenzeile
    ELIF zeilenbreite + zeichenwert ausgang > aktuelle pitch zeilenlaenge
      THEN fehler (36, "");
           LEAVE ueberpruefe tabellenzeile
      ELSE tabellenzeile ohne absatz
    FI
  END REP.
 
diese position ist dezimal pos:
  tabs [tab no] [2] = dpos.

setze dezimalzeichen auf suchausgang:
  INT CONST pos tab zeichen in pitch table ::
                 code (tab zeichen [tab no] SUB 1) + 1;
  INT VAR breite erstes dezimalzeichen :=breite (tab zeichen [tab no] SUB 1),
          breite excl dezimalzeichen := 0;
  suchausgang gesetzt := TRUE;
  pitch table [pos tab zeichen in pitch table] := such ausgang.

verarbeite ersten teil der dezimal zentrierung:
  IF pos (puffer, tab zeichen [tab no], zeichenpos) = zeichenpos
    THEN pitch table [pos tab zeichen in pitch table] :=
                                           breite erstes dezimalzeichen;
         suchausgang gesetzt := FALSE;
         breite excl dezimalzeichen := zeilenbreite
  FI;
  zeilenbreite INCR breite (puffer SUB zeichenpos);
  zeichenpos INCR 1.

behandele dieses blank:
  IF doppelblank OR absatz
    THEN LEAVE errechne spaltenbreite
    ELSE zeilenbreite INCR blankbreite fuer diesen schrifttyp;
         zeichenpos INCR 1
  FI.

doppelblank:
  (puffer SUB zeichenpos + 1) = blank.

verarbeite das kommando:
  pitch table auf blank setzen;
  verarbeite kommando und neue zeile auffuellen;
  pitch table auf blank ausgang setzen;
  IF kommando index = table end
    THEN LEAVE verarbeite tabellenzeilen
  ELIF suchausgang gesetzt AND
       pitch table [pos tab zeichen in pitch table] <> suchausgang
    THEN pitch table [pos tab zeichen in pitch table] := suchausgang
  FI.

tabellenzeile ohne absatz:
  IF zeilenende eines macros
    THEN zeile in puffer und zeile lesen;
         zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos);
    ELSE LEAVE errechne spaltenbreite
  FI.

zeilenende eines macros:
  zeichenwert ausgang = zeilenende ausgang AND macro works.

ueberpruefe ob es passt:
  INT CONST akt tab pos :: tabs [tab no] [1];
  IF vorherige spalte ueberschreibt tabulator position 
    THEN cm angabe der druckposition in dummy (tab no - 1);
         fehler (44, dummy);
         tab zeilenbreite := akt tab pos
  ELIF only command line (puffer)
    THEN
    ELSE ueberpruefe nach art des tabulators
  FI.

ueberpruefe nach art des tabulators:
  IF   tabs [tab no] [2] = r pos
    THEN nach links schreibend
  ELIF tabs [tab no] [2] = l pos
    THEN nach rechts schreibend
  ELIF tabs [tab no] [2] = b pos
    THEN nach rechts blockend schreibend
  ELIF tabs [tab no] [2] = c pos
    THEN zentrierend
    ELSE zentrierend um zeichen
  FI.

vorherige spalte ueberschreibt tabulator position:
  tab zeilenbreite > akt tab pos.

nach links schreibend:
  IF tab zeilenbreite + zeilenbreite > akt tab pos
    THEN cm angabe der druckposition in dummy (tab no); 
         fehler (45, dummy);
  FI;
  tab zeilenbreite := akt tab pos.

nach rechts schreibend:
  tab zeilenbreite := akt tab pos + zeilenbreite.

nach rechts blockend schreibend:
  IF akt tab pos + zeilenbreite > tabs [tab no] [3]
    THEN cm angabe der druckposition in dummy (tab no);
         fehler (48, dummy)
  FI;
  tab zeilenbreite := tabs [tab no] [3].

zentrierend:
  IF tab zeilenbreite + (zeilenbreite DIV 2) > akt tab pos
    THEN cm angabe der druckposition in dummy (tab no);
         fehler (46, dummy)
  FI;
  tab zeilenbreite := akt tab pos + (zeilenbreite DIV 2).

zentrierend um zeichen:
  IF breite excl dezimalzeichen = 0
    THEN cm angabe der druckposition in dummy (tab no);
         fehler (50, dummy)
  ELIF tab zeilenbreite + breite excl dezimalzeichen > akt tab pos
    THEN cm angabe der druckposition in dummy (tab no);
         fehler (47, dummy)
  FI;
  IF suchausgang gesetzt
    THEN pitch table [pos tab zeichen in pitch table] :=
                                                breite erstes dezimalzeichen;
         suchausgang gesetzt := FALSE; 
  FI;
  tab zeilenbreite := akt tab pos +
                                 (zeilenbreite - breite excl dezimalzeichen).

tabellenzeile breiter als limit:
  tab zeilenbreite > aktuelle pitch zeilenlaenge + einrueckbreite.

noch mehr spaltentexte:
  pos (puffer, ""33"", ""255"", zeichenpos) <> 0.
END PROC verarbeite tabelle;
 
(*********************** referenzen ueberpruefen **********************)
 
PROC aktuelle referenz erstellen:
  aktuelle referenz := "#";
  aktuelle referenz CAT par1;
  aktuelle referenz CAT "#";
END PROC aktuelle referenz erstellen;

PROC zielreferenzen speichern ohne warnung:
  aktuelle referenz erstellen;
  IF pos (zielreferenzen, aktuelle referenz) = 0 
    THEN delete char (aktuelle referenz, 1);
         zielreferenzen CAT aktuelle referenz
  FI 
END PROC zielreferenzen speichern ohne warnung;

PROC zielreferenzen speichern:
  aktuelle referenz erstellen;
  IF pos (zielreferenzen, aktuelle referenz) <> 0 
    THEN warnung (9, par1) 
    ELSE delete char (aktuelle referenz, 1);
         zielreferenzen CAT aktuelle referenz
  FI 
END PROC zielreferenzen speichern;
 
PROC herkunftsreferenzen speichern:
  aktuelle referenz erstellen;
  IF pos (herkunftsreferenzen, aktuelle referenz) = 0 
    THEN delete char (aktuelle referenz, 1);
         herkunftsreferenzen CAT aktuelle referenz
  FI 
END PROC herkunftsreferenzen speichern; 
 
PROC referenzen ueberpruefen: 
  ueberpruefe zielreferenzen; 
  ueberpruefe restliche herkunftsreferenzen. 
 
ueberpruefe zielreferenzen: 
  REP 
    hole naechste zielreferenz; 
    IF pos (herkunfts referenzen, aktuelle referenz) = 0 
      THEN change all (aktuelle referenz,"#", ""); 
           warnung (3, aktuelle referenz)
      ELSE delete char (aktuelle referenz, length (aktuelle referenz));
           change (herkunftsreferenzen, aktuelle referenz, ""); 
    FI
  END REP. 
 
hole naechste zielreferenz: 
  IF length (zielreferenzen) > 1
    THEN aktuelle referenz :=
            subtext (zielreferenzen, 1, pos (zielreferenzen, "#", 2));
         zielreferenzen := 
            subtext (zielreferenzen, pos (zielreferenzen, "#", 2))
    ELSE LEAVE ueberpruefe zielreferenzen 
  FI. 
 
ueberpruefe restliche herkunftsreferenzen: 
  WHILE length (herkunftsreferenzen) > 1 REP 
    aktuelle referenz :=
     subtext (herkunftsreferenzen, 1, pos (herkunftsreferenzen, "#", 2) - 1);
    change (herkunftsreferenzen, aktuelle referenz, "");
    delete char (aktuelle referenz, 1); 
    warnung (4, aktuelle referenz) 
  END REP. 
END PROC referenzen ueberpruefen;
 
(*************************** Utilities *******************************)

INT PROC breite (TEXT CONST z):
  INT VAR b;
  IF z = ""
    THEN display and pause (1)
  ELIF z = kommandozeichen
    THEN display and pause (2); b := 1
    ELSE b := pitch table [code (z) + 1]
  FI;
  IF zeilenbreite > maxint - b
    THEN display and pause (3); b := 1
  FI;
  b.
END PROC breite;

INT PROC breite (TEXT CONST ein text, INT CONST zpos):
  TEXT CONST z :: ein text SUB zpos;
  INT VAR zeichen breite;
  IF z = ""
    THEN display and pause (4); zeichen breite := 1
  ELIF z = kommandozeichen
    THEN display and pause (6); zeichen breite := 1
    ELSE zeichen breite := pitch table [code (z) + 1]
  FI;
  IF zeichen breite = extended char ausgang
    THEN zeichen breite := extended char pitch (font nr,
           ein text SUB zpos, ein text SUB zpos + 1)
  FI;
  zeichen breite
END PROC breite;

PROC char pos move (INT CONST richtung):
  char pos move (zeichenpos, richtung)
END PROC char pos move;

PROC char pos move (INT VAR zpos, INT CONST richtung):
  char pos move (puffer, zpos, richtung)
END PROC char pos move;

BOOL PROC absatz:
  zeichenpos = pufferlaenge AND puffer hat absatz
END PROC absatz;

BOOL PROC puffer hat absatz:
  NOT within kanji (puffer, pufferlaenge) AND
  (puffer SUB pufferlaenge) = blank
END PROC puffer hat absatz;

PROC pitch table auf blank ausgang setzen:
  IF pitch table [code (blank) + 1] <> blank ausgang
    THEN blank breite fuer diesen schrifttyp := breite (blank);
         pitch table [code (blank) + 1] := blank ausgang
  FI
END PROC pitch table auf blank ausgang setzen;

PROC pitch table auf blank setzen:
  pitch table [code (blank) + 1] := blank breite fuer diesen schrifttyp
END PROC pitch table auf blank setzen;

(*PROC zustands test (TEXT CONST anf):
line ;put(anf);
line ;put("zeilenbreite, aktuelle pitch zeilenlaenge:");
     put(zeilenbreite);put(aktuelle pitch zeilenlaenge);
line ;put("zeichenpos, pufferlaenge, ausgang, zeichen:");
put(zeichenpos);put(pufferlaenge);
IF zeichenwert ausgang = blank ausgang
  THEN put ("blank")
ELIF zeichenwert ausgang = kommando ausgang
  THEN put ("kommando")
ELIF zeichenwert ausgang = such ausgang
  THEN put ("such")
ELIF zeichenwert ausgang = zeilenende ausgang
  THEN put ("zeilenende")
  ELSE put(zeichenwert ausgang);
FI; put ("ausgang");
out(">");out(puffer SUB zeichenpos);out("<");
line ;out("puffer >");
IF length (puffer) > 65
  THEN outsubtext (puffer, 1, 65);
       line ; outsubtext (puffer, 66)
  ELSE out(puffer);
FI;
out("<");
line ;out("zeile >");
IF length (zeile) > 65
  THEN outsubtext (zeile, 1, 65);
       line ; outsubtext (zeile, 66)
  ELSE out (zeile);
FI;
out("<");
line ;out("neue zeile >");
IF length (neue zeile) > 65
  THEN outsubtext (neue zeile, 1, 65);
       line ; outsubtext (neue zeile, 66)
  ELSE out(neue zeile);
FI;
out("<");
line ; 
END PROC zustands test;*)

(*************************** eigentliche form routine ********************)

PROC zeilen form (TEXT CONST datei):
  enable stop;
  form initialisieren (datei);
  formiere absatzweise;
  letzte neue zeile ausgeben.

formiere absatzweise:
  REP
    letzter puffer war absatz := FALSE;
    einrueckbreite := eingestellte indentation pitch;
    IF einfacher absatz nach absatz
      THEN gebe einfachen absatz aus
      ELSE verarbeite abschnitt nach absatz
    FI
  UNTIL pufferlaenge = 0 END REP.

einfacher absatz nach absatz:
  absatz.

gebe einfachen absatz aus:
  neue zeile := blank;
  ausgabe bei zeilenende.

verarbeite abschnitt nach absatz:
  berechne erste zeile nach absatz;
  IF NOT letzter puffer war absatz
    THEN formiere
  FI.

formiere:
  INT VAR letzte zeilennr;
  REP
    stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge,
                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
    IF zeichenwert ausgang   = kommando ausgang
      THEN zeichenpos INCR 1;
           verarbeite kommando und neue zeile auffuellen;
           IF letzter puffer war absatz
             THEN ausgabe bei zeilenende;
                  LEAVE verarbeite abschnitt nach absatz
           ELIF zeichenpos > pufferlaenge OR absatz
             THEN letzte zeilennr := zeilennr;
                  verarbeite letztes zeichen von puffer;
                  IF neue zeile ausgeloest
                    THEN LEAVE verarbeite abschnitt nach absatz
                    ELSE letzter puffer war absatz := FALSE
                  FI
           FI
    ELIF zeichenwert ausgang = extended char ausgang
      THEN char pos move (vorwaerts);
           zeilenbreite INCR breite (puffer, zeichenpos);
           char pos move (vorwaerts)
    ELIF zeichenwert ausgang = zeilenende ausgang
         OR zeichenwert ausgang = esc char ohne zweites byte ausgang
      THEN letzte zeilennr := zeilennr;
           verarbeite letztes zeichen von puffer;
           IF zeichenwert ausgang = esc char ohne zweites byte ausgang
             THEN fehler (23, "")
           FI;
           IF neue zeile ausgeloest
             THEN LEAVE verarbeite abschnitt nach absatz
             ELSE letzter puffer war absatz := FALSE
           FI
      ELSE ende einer neuen zeile
    FI;
  UNTIL pufferlaenge = 0 END REP. 

neue zeile ausgeloest:
  letzte zeilennr < zeilennr.
END PROC zeilen form;

PROC berechne erste zeile nach absatz:
  INT CONST anz einrueckungszeichen :: zeilenbreite DIV einrueckbreite;
  INT VAR anz zeichen fuer einzeilige einrueckung :: 0,
          anz zeichen          :: 0,
          schlepper zeichenpos :: 1,
          letzte zeilennr;
  BOOL CONST puffer hatte anfangs absatz :: puffer hat absatz;
  BOOL VAR   noch kein blank gewesen :: TRUE;
  pitch table auf blank ausgang setzen;
  berechne erste zeile;
  pitch table auf blank setzen.

berechne erste zeile:
  REP
    stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge,
                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
    IF zeichenwert ausgang   = blank ausgang
      THEN verarbeite text
    ELIF zeichenwert ausgang = extended char ausgang
      THEN char pos move (vorwaerts);
           zeilenbreite INCR breite (puffer, zeichenpos);
           char pos move (vorwaerts)
    ELIF zeichenwert ausgang = kommando ausgang
      THEN verarbeite dieses kommando
    ELIF zeichenwert ausgang = zeilenende ausgang
         OR zeichenwert ausgang = esc char ohne zweites byte ausgang
      THEN behandele zu kurze zeile
      ELSE behandele zu lange zeile
    FI
  END REP.

verarbeite dieses kommando:
  textzeichen mitzaehlen;
  IF pos (" #", (puffer SUB zeichenpos)) = 0
    THEN aufzaehlungszeichen := (puffer SUB zeichenpos)
  FI;
  char pos move (vorwaerts);
  mitzuzaehlende zeichen := 0;
  pitch table auf blank setzen;
  verarbeite kommando und neue zeile auffuellen;
  pitch table auf blank ausgang setzen;
  IF letzter puffer war absatz
    THEN neue zeile auffuellen und ausgabe bei zeilenende;
         LEAVE berechne erste zeile
  ELIF zeichenpos > pufferlaenge OR absatz
    THEN letzte zeilennr := zeilennr;
         verarbeite letztes zeichen von puffer;
         IF neue zeile ausgeloest
           THEN LEAVE berechne erste zeile
           ELSE letzter puffer war absatz := FALSE
         FI
  ELIF anweisung erlaubt keine aufzaehlung
    THEN LEAVE berechne erste zeile
  FI;
  anz zeichen INCR mitzuzaehlende zeichen;
  schlepper zeichenpos := zeichenpos.

neue zeile ausgeloest:
  letzte zeilennr < zeilennr.

anweisung erlaubt keine aufzaehlung:
  kommando index = center OR kommando index = right.

verarbeite text:
  char pos move (vorwaerts);
  IF absatz
    THEN verarbeite letztes zeichen von puffer;
         LEAVE berechne erste zeile
  ELIF zeilenbreite + blankbreite fuer diesen schrifttyp >
                                                  aktuelle pitch zeilenlaenge
    THEN behandele zu lange zeile
  ELIF mehrfaches blank
    THEN positionierung mit doppelblank
  ELIF noch kein blank gewesen AND
       anz zeichen +
                number chars (puffer, schlepper zeichenpos, zeichenpos) <= 20
    THEN ggf aufzaehlung aufnehmen
    ELSE zeilenbreite INCR blankbreite fuer diesen schrifttyp
  FI;
  noch kein blank gewesen := FALSE;
  zeichenpos INCR 1.

mehrfaches blank:
  (puffer SUB zeichenpos + 1) = blank.

positionierung mit doppelblank:
  WHILE NOT within kanji (puffer, zeichenpos + 1) AND
        (puffer SUB zeichenpos + 1) = blank REP
    zeichenpos INCR 1
  END REP;
  textzeichen mitzaehlen;
  pruefe auf ueberschreibung
              (zeilenbreite, anz zeichen + anz einrueckungszeichen).

ggf aufzaehlung aufnehmen:
  IF NOT within kanji (puffer, zeichenpos - 1) AND
     (puffer SUB zeichenpos - 1) <> kommandozeichen
    THEN aufzaehlungszeichen := (puffer SUB zeichenpos - 1);
  FI;
  textzeichen mitzaehlen;
  IF    aufzaehlungszeichen = ":"
     OR (aufzaehlungszeichen = "-" AND anz zeichen <= 2)
     OR (anz zeichen <= 7 AND (   aufzaehlungszeichen = ")"
                               OR aufzaehlungszeichen = "."))
    THEN anz zeichen fuer einzeilige einrueckung := anz zeichen;
         pruefe auf ueberschreibung
               (zeilenbreite, anz zeichen + anz einrueckungszeichen)
    ELSE zeilenbreite INCR blankbreite fuer diesen schrifttyp
  FI.

textzeichen mitzaehlen:
  anz zeichen INCR number chars (puffer, schlepper zeichenpos, zeichenpos);
  IF is kanji esc (puffer SUB zeichenpos)
    THEN schlepper zeichenpos := zeichenpos + 2
    ELSE schlepper zeichenpos := zeichenpos + 1
  FI.

behandele zu kurze zeile:
  textzeichen mitzaehlen;
  IF zeichenwert ausgang = esc char ohne zweites byte ausgang
    THEN fehler (23, "");
         neue zeile auffuellen;
         schreibe und initialisiere neue zeile;
         zeichenpos := 1;
         LEAVE berechne erste zeile
  FI;
  letzte zeilennr := zeilennr;
  verarbeite letztes zeichen von puffer;
  IF neue zeile ausgeloest
    THEN LEAVE berechne erste zeile
  FI;
  schlepper zeichenpos := 1.

behandele zu lange zeile:
  pitch table auf blank setzen;
  IF zeilenende bei erstem zeichen
    THEN loesche nachfolgende blanks;
         schreibe und initialisiere neue zeile;
         zeichenpos := 1;
         LEAVE berechne erste zeile
  ELIF (puffer SUB zeichenpos) = kommandozeichen
    THEN zeichenpos INCR 1
    ELSE zeilenbreite DECR breite (puffer, zeichenpos)
  FI;
  IF puffer hatte anfangs absatz
    THEN einrueckung gemaess pufferanfang
  FI;
  LEAVE berechne erste zeile.

zeilenende bei erstem zeichen:
  zeichenpos < 1.

einrueckung gemaess pufferanfang:
alte blanks :=
(anz einrueckungszeichen + anz zeichen fuer einzeilige einrueckung) * blank.
END PROC berechne erste zeile nach absatz;

PROC pruefe auf ueberschreibung (INT CONST aufzaehlungsbreite,
                                           anz aufzaehlungszeichen):
  IF ueberschreibung
    THEN fehlende blanks errechnen;
         INT VAR aufzaehlungsende :: zeichenpos - 1;
         WHILE (puffer SUB aufzaehlungsende) = blank REP
           aufzaehlungsende DECR 1
         END REP;
         dummy := ">"; 
         dummy CAT subtext (puffer,
                            aufzaehlungsende - 15, aufzaehlungsende);
         dummy CAT "< Fehlende Blanks: ";
         dummy CAT text (anz fehlende blanks);
         warnung (12, dummy)
  FI;
  zeilenbreite := anz aufzaehlungszeichen * einrueckbreite.

ueberschreibung:
  INT CONST anz zeichen mal einrueckbreite ::
                                anz aufzaehlungszeichen * einrueckbreite,
            min zwischenraum :: (einrueckbreite DIV 4);
  aufzaehlungsbreite + min zwischenraum > anz zeichen mal einrueckbreite.

fehlende blanks errechnen:
  INT VAR anz fehlende blanks ::
  (aufzaehlungsbreite + min zwischenraum
                   - anz zeichen mal einrueckbreite + einrueckbreite - 1)
   DIV einrueckbreite.
END PROC pruefe auf ueberschreibung;

(********************** eingabe routinen **************************)

PROC zeile lesen:
  alte blanks := aktuelle blanks;
  hole zeile;
  behandele einrueckung.

hole zeile:
  IF macro works
    THEN get macro line (zeile);
  ELIF eof (eingabe)
    THEN zeile := "";
         LEAVE zeile lesen
    ELSE lesen
  FI;
  IF zeile = ""
    THEN zeile := blank
  ELIF (zeile SUB length (zeile) - 1) = blank
    THEN ggf ueberfluessige leerzeichen am ende entfernen
  FI.

lesen:
  IF format file in situ
    THEN read record (eingabe, zeile);
         delete record (eingabe)
    ELSE read record (eingabe, zeile);
         down (eingabe)
  FI.
 
ggf ueberfluessige leerzeichen am ende entfernen:
  WHILE NOT within kanji (zeile, length (zeile) - 1) AND
        subtext (zeile, length (zeile) - 1) = "  " REP 
    delete char (zeile, length (zeile)) 
  END REP. 
 
behandele einrueckung:
  aktuelle blanks := "";
  IF zeile <> blank
    THEN INT VAR einrueckung := pos (zeile, ""33"", ""255"", 1);
         IF einrueckung > 1
           THEN aktuelle blanks := subtext (zeile, 1, einrueckung - 1);
                zeile := subtext (zeile, einrueckung)
         FI
  FI
END PROC zeile lesen;

PROC zeile in puffer und zeile lesen:
  puffer := zeile;
  zeichenpos := 1;
  von        := 1;
  zeile lesen;
  pufferlaenge := length (puffer);
  ggf absatz an puffer anfuegen;
END PROC zeile in puffer und zeile lesen;

PROC ggf absatz an puffer anfuegen:
  IF    (zeile ist nur absatz AND NOT puffer hat absatz)
     OR (NOT puffer hat absatz AND only command line (puffer)
         AND only command line (zeile))
    THEN puffer CAT blank;
         pufferlaenge := length (puffer)
  ELIF puffer ist nur absatz AND (zeile SUB length (zeile)) <> " " AND
       only command line (zeile)
    THEN zeile CAT " "
  FI. 
 
puffer ist nur absatz:
  puffer = blank.

zeile ist nur absatz: 
  zeile = blank. 
END PROC ggf absatz an puffer anfuegen;

(****************** routinen fuer zeilenende behandlung ***********)

PROC verarbeite letztes zeichen von puffer:
  zeichenpos := length (puffer);
  begin of this char (puffer, zeichenpos);
  zeichen := puffer SUB zeichenpos;
  IF trennung vorhanden
    THEN IF zeile hat richtige laenge
           THEN neue zeile auffuellen und ausgabe bei zeilenende
           ELSE getrennte zeilen zusammenziehen
         FI
  ELSE neue zeile auffuellen;
       IF absatz
         THEN letzter puffer war absatz := TRUE;
              IF letztes kommando war macro AND macro hat absatz getaetigt
                THEN zeile in puffer und zeile lesen;
                     initialisiere neue zeile;
                ELSE ausgabe bei zeilenende;
              FI
         ELSE neue zeile ggf weiterfuehren
       FI
  FI.
 
neue zeile ggf weiterfuehren:
  IF macro end in dieser oder naechster zeile
    THEN
  ELIF zeile = ""
    THEN schreibe und initialisiere neue zeile;
         letzter puffer war absatz := TRUE
  ELIF zeilenbreite + blank breite fuer diesen schrifttyp >
                                                 aktuelle pitch zeilenlaenge
    THEN loesche nachfolgende blanks;
         schreibe und initialisiere neue zeile
  ELIF in neuer zeile steht etwas
    THEN neue zeile CAT blank;
         zeilenbreite INCR blank breite fuer diesen schrifttyp
  FI;
  zeile in puffer und zeile lesen.

macro end in dieser oder naechster zeile:
  macro works AND (pos (puffer, "#*") <> 0 OR pos (zeile, "#*") <> 0).

in neuer zeile steht etwas:
  pos (neue zeile, ""33"", ""255"", 1) <> 0.

letztes kommando war macro:
  pos (kommando, "macro") <> 0.

macro hat absatz getaetigt:
  NOT in neuer zeile steht etwas.
END PROC verarbeite letztes zeichen von puffer;
 
PROC getrennte zeilen zusammenziehen:
  zeichen := puffer SUB pufferlaenge;
  IF NOT within kanji (puffer, pufferlaenge) AND zeichen = trennzeichen
    THEN zeilenbreite DECR breite (trennzeichen);
         delete char (puffer, pufferlaenge);
         pufferlaenge := length (puffer);
         IF ((puffer SUB pufferlaenge) = trenn k) AND ((zeile SUB 1) = "k")
           THEN replace (puffer, pufferlaenge, "c");
                zeilenbreite DECR breite ("k");
                zeilenbreite INCR breite ("c");
         FI;
         zeichenpos := pufferlaenge + 1
  FI;
  puffer CAT zeile;
  zeile lesen;
  pufferlaenge := length (puffer);
  ggf absatz an puffer anfuegen;
END PROC getrennte zeilen zusammenziehen;
 
BOOL PROC trennung vorhanden:
  IF within kanji (puffer, pufferlaenge)
    THEN LEAVE trennung vorhanden WITH FALSE
  FI;
  zeichen := puffer SUB pufferlaenge;
  zeichen = trennzeichen OR wort mit bindestrich.

wort mit bindestrich:
  zeichen = bindestrich AND kein leerzeichen davor
   AND NOT naechstes wort ist konjunktion AND kein loser gedankenstrich.

kein leerzeichen davor:
 NOT within kanji (puffer, pufferlaenge - 1) AND
     (puffer SUB pufferlaenge - 1) <> blank.

naechstes wort ist konjunktion:
     pos (zeile, "und")   = 1
  OR pos (zeile, "oder")  = 1
  OR pos (zeile, "bzw")   = 1
  OR pos (zeile, "sowie") = 1.

kein loser gedankenstrich:
  pufferlaenge > 1.
END PROC trennung vorhanden;
 
BOOL PROC zeile hat richtige laenge:
  zeilenbreite > aktuelle pitch zeilenlaenge - trennbreite
END PROC zeile hat richtige laenge;

(*********************** ausgabe routinen *******************)

PROC ende einer neuen zeile:
  IF zeichenpos > 0
    THEN begin of this char (puffer, zeichenpos);
  FI;
  zeichen := puffer SUB zeichenpos;
  zeichenpos bereits verarbeitet := 0;
  IF naechstes zeichen ist absatz
    THEN zeichenpos := pufferlaenge;
         verarbeite letztes zeichen von puffer;
         LEAVE ende einer neuen zeile 
  ELIF zeichen = blank
    THEN neue zeile auffuellen (von, zeichenpos - 1);
         zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos); 
         von := zeichenpos;
  ELIF nach zeichenpos beginnt ein neues wort
    THEN neue zeile auffuellen (von, zeichenpos); 
         zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos + 1);
         von := zeichenpos
  ELIF letzter puffer passte genau
    THEN (* erstes zeichen des neuen puffers > zeilenbreite *)
         zeichenpos := 1;
         von := 1
    ELSE zeichenpos bereits verarbeitet := zeichenpos;
         trennung eventuell vornehmen;
         IF erstes wort auf der absatzzeile laesst sich nicht trennen
           THEN alte blanks := aktuelle blanks
         FI
  FI;
  loesche nachfolgende blanks;
  IF NOT in foot uebertrag
    THEN schreibe und initialisiere neue zeile;
         zeilenbreite und zeichenpos auf das bereits verarbeitete
         zeichen setzen;
  FI.

erstes wort auf der absatzzeile laesst sich nicht trennen:
  pos (neue zeile, ""33"", ""255"", 1) = 0 AND  (*keine buchstaben*)
  length (neue zeile) > 1 AND                   (*einrueckung*)
  (neue zeile SUB length (neue zeile)) = blank. (* Absatz *)

naechstes zeichen ist absatz:
  zeichenpos + 1 = pufferlaenge AND puffer hat absatz.

nach zeichenpos beginnt ein neues wort:
  (pufferlaenge > zeichenpos + 2) AND (puffer SUB zeichenpos + 1) = blank.

letzter puffer passte genau:
  zeichenpos <= 0.

zeilenbreite und zeichenpos auf das bereits verarbeitete zeichen setzen:
  IF zeichenpos bereits verarbeitet <> 0
    THEN INT VAR bis := zeichenpos, einfuege pos := bis;
         zeilenbreite um die bereits verarbeiteten zeichen erhoehen; 
         zeichenpos := zeichenpos bereits verarbeitet;
         IF einfuege pos > 1
           THEN insert char (puffer, blank, einfuege pos);
                pufferlaenge := length (puffer);
                von := einfuege pos + 1;
                char pos move (vorwaerts)
         FI;
         char pos move (vorwaerts);
  FI.

zeilenbreite um die bereits verarbeiteten zeichen erhoehen:
  zeichenpos := zeichenpos bereits verarbeitet;
  WHILE (puffer SUB bis) = kommandozeichen REP
    bis := pos (puffer, kommandozeichen, bis + 1) + 1
  END REP;
  begin of this char (puffer, zeichenpos);
  WHILE zeichenpos >= bis REP
    IF (puffer SUB zeichenpos) = kommandozeichen
      THEN ueberspringe das kommando (puffer, zeichenpos, rueckwaerts)
      ELSE zeilenbreite INCR breite (puffer, zeichenpos);
    FI;
    IF zeichenpos <= 1
      THEN LEAVE zeilenbreite um die bereits verarbeiteten zeichen erhoehen
    FI;
    char pos move (rueckwaerts)
  END REP.
END PROC ende einer neuen zeile;
 
PROC loesche nachfolgende blanks:
  WHILE NOT within kanji (neue zeile, length (neue zeile)) AND
        (neue zeile SUB length (neue zeile)) = blank REP
    delete char (neue zeile, length (neue zeile))
  END REP
END PROC loesche nachfolgende blanks; 
 
PROC neue zeile auffuellen:
   dummy := subtext (puffer, von);
   neue zeile CAT dummy
END PROC neue zeile auffuellen;

PROC neue zeile auffuellen (INT CONST from, to):
   dummy := subtext (puffer, from, to);
   neue zeile CAT dummy
END PROC neue zeile auffuellen;

PROC schreibe neue zeile:
  IF macro works
    THEN IF alte neue zeile einschliesslich macro ist auszugeben
           THEN schreibe textteil einschliesslich macro;
         FI
  ELSE schreibe;
       pruefe auf abbruch
  FI.

alte neue zeile:
  before macro state . new line.

alter puffer:
  before macro state . buffer line.

alte neue zeile einschliesslich macro ist auszugeben:
  INT VAR text anf :: pos (alte neue zeile, ""33"", ""255"", 1);
  text anf <> 0.

schreibe textteil einschliesslich macro:
  dummy := neue zeile;
  neue zeile := alte neue zeile;
  IF macro hatte absatz danach
    THEN neue zeile CAT " "
    ELSE zeilennr INCR 1
  FI;
  schreibe;
  neue zeile := dummy;
  alte neue zeile := subtext (alte neue zeile, 1, text anf - 1).

macro hatte absatz danach:
  length (alter puffer) - 1 = length (alte neue zeile) AND
     (alter puffer SUB length (alter puffer)) = " ".

pruefe auf abbruch:
  IF incharety = escape
    THEN errorstop ("Abbruch mit ESC")
  FI.
END PROC schreibe neue zeile;

PROC schreibe:
  IF format file in situ
    THEN insert record (eingabe);
         write record (eingabe, neue zeile);
         down (eingabe)
    ELSE insert record (ausgabe);
         write record  (ausgabe, neue zeile);
         down (ausgabe);
         speicher ueberlauf
  FI;
  execute stored commands;
  IF (neue zeile SUB length (neue zeile)) = blank
    THEN einrueckbreite := eingestellte indentation pitch
  FI.

speicher ueberlauf:
  INT VAR size, used;
  storage (size, used);
  IF used > size
    THEN errorstop ("Speicherengpaß")
  FI.
END PROC schreibe;

PROC schreibe und initialisiere neue zeile:
   schreibe neue zeile;
   initialisiere neue zeile
END PROC schreibe und initialisiere neue zeile;

PROC ausgabe bei zeilenende:
  schreibe und initialisiere neue zeile;
  zeile in puffer und zeile lesen
END PROC ausgabe bei zeilenende;

PROC neue zeile auffuellen und ausgabe bei zeilenende:
  neue zeile auffuellen;
  schreibe und initialisiere neue zeile;
  zeile in puffer und zeile lesen
END PROC neue zeile auffuellen und ausgabe bei zeilenende;

PROC initialisiere neue zeile:
  einrueckung in die neue zeile;
  zeilennummer mitzaehlen.

einrueckung in die neue zeile:
  IF  zeichenpos < pufferlaenge AND
      (puffer hat absatz OR foot ohne absatz am zeilenende)
    THEN neue zeile := alte blanks
    ELSE neue zeile := aktuelle blanks
  FI;
  zeilenbreite := length (neue zeile) * einrueckbreite;
  IF zeilenbreite +trennbreite +einrueckbreite >= aktuelle pitch zeilenlaenge
    THEN fehler (10, "");
         zeilenbreite := 0;
  FI.

foot ohne absatz am zeilenende:
  pos (puffer, "#foot#") > 1 AND pos (puffer, "#foot#") = length (puffer) -5.

zeilennummer mitzaehlen:
  IF NOT macro works
    THEN zeilennr INCR 1;
         cout (zeilennr);
  FI.
END PROC initialisiere neue zeile;

PROC letzte neue zeile ausgeben:
  IF pos (neue zeile, ""33"", ""255"", 1) <> 0
    THEN schreibe neue zeile
  FI;
  offene modifikationen ausgeben;
  offene indizes ausgeben;
  IF aktueller editor < 1
    THEN referenzen ueberpruefen;
         offene counter referenzen ausgeben;
  FI.

offene modifikationen ausgeben:
  WHILE length (modifikations speicher) <> 0 REP
    dummy := (modifikations speicher SUB 1);
    delete char (modifikations speicher, 1);
    dummy CAT " in Zeile ";
    dummy CAT text (mod zeilennr speicher ISUB 1);
    delete int (mod zeilennr speicher, 1);
    warnung (5, dummy)
  END REP.

offene indizes ausgeben:
  WHILE length (index speicher) <> 0 REP
    dummy := (index speicher SUB 1);
    delete char (index speicher, 1);
    dummy CAT " in Zeile ";
    dummy CAT text (ind zeilennr speicher ISUB 1);
    delete int (ind zeilennr speicher, 1);
    warnung (6, dummy)
  END REP.

offene counter referenzen ausgeben:
  INT VAR begin pos := pos (counter reference store, "#");
  WHILE begin pos > 0 REP
    INT VAR end pos := pos (counter reference store, "#", begin pos + 1);
    IF (counter reference store SUB begin pos - 1) <> "u"
      THEN fehler (60, subtext (counter reference store, begin pos + 1,
                                end pos - 1))
    ELIF (counter reference store SUB begin pos - 2) <> "i"
      THEN fehler (61, subtext (counter reference store, begin pos + 1,
                                end pos - 1))
    FI;
    begin pos := pos (counter reference store, "#", end pos + 1)
  END REP.
END PROC letzte neue zeile ausgeben;

(*********************** silbentrenn routinen *******************)

INT PROC position von (TEXT CONST such zeichen, INT CONST richtung,
                       INT VAR anz zeich, breite der z):
  INT VAR index :: zeichenpos;
  TEXT VAR akt z;
  anz zeich    := 0;
  breite der z := 0;
  WHILE index > 1 AND index < pufferlaenge REP
    akt z := puffer SUB index;
    IF akt z   = such zeichen
      THEN LEAVE position von WITH index
    ELIF akt z = kommandozeichen
      THEN ueberspringe das kommando (puffer, index, richtung);
           IF nur ein kommandozeichen gefunden
             THEN gehe nur bis erstes kommandozeichen
           ELIF index <= 1 OR index >= pufferlaenge
             THEN LEAVE position von WITH index
           FI
      ELSE anz zeich INCR 1;
           breite der z INCR breite (puffer, index)
    FI;
    char pos move (index, richtung)
  END REP;
  anz zeich INCR 1;
  breite der z INCR breite (puffer, index);
  index.

nur ein kommandozeichen gefunden:
  (puffer SUB index) <> kommandozeichen.

gehe nur bis erstes kommandozeichen:
  index := zeichenpos; anz zeich := 0; breite der z := 0;
  WHILE (puffer SUB index) <> kommandozeichen REP
    anz zeich INCR 1;
    breite der z INCR breite (puffer, index);
    char pos move (index, richtung)
  END REP;
  IF richtung <> rueckwaerts
    THEN index DECR 1
  FI;
  LEAVE position von WITH index.
END PROC position von;

PROC ueberspringe das kommando (TEXT CONST t, INT VAR i, INT CONST richtung):
  REP
    i INCR richtung;
    IF within kanji (t, i)
      THEN i INCR richtung
    FI
  UNTIL (t SUB i) = kommandozeichen OR i <= 1 OR i >= length (t) END REP.
END PROC ueberspringe das kommando;

PROC trennung eventuell vornehmen: 
INT VAR xwort1, ywort1,
        anz zeichen davor,
        breite davor;
  IF macro works
    THEN fehler (6, "")
  FI;
  trennsymbol := trennzeichen;
  wortanfang := position von
                       (blank, rueckwaerts, anz zeichen davor, breite davor);
  bereite neue zeile bis wortanfang auf;
  IF trennung sinnvoll
    THEN versuche zu trennen
    ELSE zeichenpos := wortanfang
  FI.
 
bereite neue zeile bis wortanfang auf:
  IF wortanfang > 1
    THEN wortanfang INCR 1
  FI;
  IF von > wortanfang
    THEN eliminiere zeichen in neuer zeile bis wortanfang
    ELSE neue zeile auffuellen (von, wortanfang - 1)
  FI;
  von := wortanfang.

eliminiere zeichen in neuer zeile bis wortanfang:
  INT VAR y :: length (neue zeile);
  begin of this char (neue zeile, y);
  WHILE y >= 1 REP
    IF (neue zeile SUB y) = kommandozeichen
      THEN ueberspringe das kommando (neue zeile, y, rueckwaerts)
    FI;
    char pos move (neue zeile, y, rueckwaerts)
  UNTIL (neue zeile SUB y) = blank END REP;
  neue zeile := subtext (neue zeile, 1, y).

trennung sinnvoll:
  anz zeichen davor > 2 AND breite davor > trennbreite.

versuche zu trennen: 
  INT CONST k := zeichenpos;
  naechste zeile ggf heranziehen;
  zeichenpos := k;
  wortteile holen;
  trenn (trennwort ohne komm, wort1 ohne komm, trennsymbol,
                                               max trennlaenge ohne komm);
  wort1 mit komm ermitteln;
  IF lineform mode
    THEN wort2 := subtext (trennwort, length (wort1) + 1, max trennlaenge);
         display vorherige zeile bis wortanfang;
         schreibe nicht trennbaren teil des trennwortes;
         schreibe zeile nach trennwort;
         skip input;
         interaktive worttrennung
  FI;
  neue zeile mit trennwort versehen;
  IF wort1 <> "" AND NOT lineform mode
    THEN note (zeilen nr); note (": ");
         note (trennwort);
         note (" --> ");
         note (wort1); note (trennsymbol);
         wort2 := subtext (trennwort, length (wort1) + 1);
         note (wort2);
         note line
  FI.

wortteile holen:
  zeichenpos durch trennzeichenbreite verschieben;
  wort1 := subtext (puffer, wortanfang, zeichenpos);
  max trennlaenge := length (wort1);
  wortende ermitteln;
  wort2 := subtext (puffer, zeichenpos, wortende);
  trennwort := subtext (puffer, wortanfang, wortende);
  trennwort ohne komm ermitteln;
  wort1 ohne komm := subtext (trennwort ohne komm, 1, anz zeichen davor);
  max trenn laenge ohne komm := anz zeichen davor.

trennwort ohne komm ermitteln:
  trennwort ohne komm := trennwort;
  WHILE pos (trennwort ohne komm, kommando zeichen) <> 0 REP
    INT CONST komm anf := pos (trennwort ohne komm, kommando zeichen),
              komm ende:= pos (trennwort ohne komm, kommando zeichen,
                                        komm anf + 1);
    IF komm ende = 0
      THEN LEAVE trennwort ohne komm ermitteln
    FI;
    dummy := subtext (trennwort ohne komm, komm ende + 1);
    trennwort ohne komm := subtext (trennwort ohne komm, 1, komm anf - 1);
    trennwort ohne komm CAT dummy;
  END REP.

wort1 mit komm ermitteln:
  IF length (wort1 ohne komm) = 0
    THEN wort1 := "";
         LEAVE wort1 mit komm ermitteln
  FI;
  INT VAR index ohne := 0,
          index mit  := 0;
  REP
    index ohne INCR 1;
    index mit  INCR 1;
    WHILE (wort1 SUB index mit) = kommando zeichen REP
      index mit := pos (wort1, kommando zeichen, index mit + 1) + 1
    END REP;
  UNTIL index ohne >= length (wort1 ohne komm) END REP;
  wort1 := subtext (wort1, 1, index mit). 

zeichenpos durch trennzeichenbreite verschieben:
  REP
    zeichen := puffer SUB zeichenpos;
    IF zeichen = kommandozeichen
      THEN ueberspringe das kommando (puffer, zeichenpos, rueckwaerts);
           char pos move (rueckwaerts)
    ELIF zeichenpos < wortanfang + 1
      THEN zeichenpos := wortanfang;
           LEAVE trennung eventuell vornehmen
      ELSE zeilenbreite DECR breite (puffer, zeichenpos);
           anz zeichen davor DECR 1;
           char pos move (rueckwaerts);
           IF zeilenbreite+breite(trennzeichen) <= aktuellepitchzeilenlaenge
              AND (puffer SUB zeichenpos) <> kommandozeichen
             THEN LEAVE zeichenpos durch trennzeichenbreite verschieben
           FI
    FI;
  END REP.
 
wortende ermitteln:
  INT VAR x1, x2;
  wortende := position von (blank, 1, x1, x2);
  IF pufferlaenge > wortende
   THEN wortende DECR 1
  FI.

display vorherige zeile bis wortanfang:
  dummy := neue zeile;
  dummy CAT subtext (puffer, von, wortanfang - 2);
  line ;
  outsubtext (dummy, length (dummy) - 78).

schreibe nicht trennbaren teil des trennwortes:
  line ;
  get cursor (xwort1, ywort1);
  IF length (trennwort) < 70
    THEN cursor (max trennlaenge + 4, ywort1);
         outsubtext (trennwort, max trennlaenge + 1)
  FI.
 
schreibe zeile nach trennwort: 
   dummy := subtext (puffer, wortende + 1);
   get cursor (trennwort endepos, ywort1);
   IF length (trennwort) >= 70
     THEN
   ELIF length (dummy) > 75 - trennwort ende pos
     THEN outsubtext (dummy, 1, 75 - trennwort endepos);
     ELSE out (dummy);
          IF (dummy SUB length (dummy)) = blank
            THEN cursor (78, ywort1);
                 out (begin mark);
                 out (end mark)
          FI
   FI.
 
trennwort endepos: 
  xwort1.
 
interaktive worttrennung:
   REP
      out (return); 
      schreibe erstes wort;
      get cursor (xwort1, ywort1);
      schreibe trennung;
      schreibe zweites wort;
      schreibe rest bei zu langem trennwort;
      cursor (xwort1, ywort1);
      hole steuerzeichen und veraendere worte
   END REP.

schreibe erstes wort:
  out (begin mark);
  IF length (trennwort) < 70
    THEN out (wort1)
    ELSE outsubtext (wort1, length (wort1) - 60)
  FI.

schreibe trennung:
  IF ck vorhanden
    THEN out (links); out ("k");
  FI;
  out (trennsymbol).

schreibe zweites wort:
  IF length (trennwort) < 70
    THEN out (wort2)
    ELSE outsubtext (wort2, 1, 70 - xwort1);
  FI;
  out (end mark).

schreibe rest bei zu langem trennwort:
  IF length (trennwort) >= 70 
    THEN INT VAR xakt pos;
         out (cl eol);
         get cursor (xakt pos, ywort1);
         outsubtext (trennwort, max trennlaenge + 1,
                                max trennlaenge + 1 + (78 - xakt pos))
  FI.

ck vorhanden: 
  (wort1 SUB length (wort1)) = "c" AND
              (trennwort SUB (length (wort1) + 1)) = "k".
 
hole steuerzeichen und veraendere worte:
TEXT VAR steuerzeichen;
   inchar (steuerzeichen);
   IF steuerzeichen = links
     THEN nach links
   ELIF steuerzeichen = rechts
     THEN nach rechts
   ELIF steuerzeichen = hop
     THEN sprung
   ELIF steuerzeichen = return
     THEN line ;
          LEAVE interaktive worttrennung
   ELIF steuerzeichen = escape
     THEN errorstop ("Abbruch mit ESC")
   ELIF code (steuerzeichen) < 32
     THEN
     ELSE trennsymbol := steuerzeichen;
          LEAVE hole steuerzeichen und veraendere worte
   FI;
   IF wort1 = ""
      OR (wort1 SUB length (wort1)) = bindestrich 
     THEN trennsymbol := blank 
     ELSE trennsymbol := trennzeichen 
   FI. 
 
nach links:
TEXT VAR ein zeichen;
INT VAR  position;
   IF length (wort1) <> 0
     THEN position := length (wort1);
          IF (wort1 SUB position) = kommando zeichen
            THEN ueberspringe das kommando (wort1, position, rueckwaerts);
          FI;
          position DECR 1;
          wort1 := subtext (trennwort, 1, position);
          wort2 := subtext (trennwort, position + 1, max trennlaenge); 
          IF rechtes teilwort mit bindestrich
            THEN ein zeichen := (wort1 SUB length (wort1));
                 delete char (wort1, length (wort1));
                 insert char (wort2, ein zeichen, 1)
          FI
   FI.

nach rechts:
   IF length (wort1) <  max trennlaenge
     THEN position := length (wort1) + 1;
          IF (trennwort SUB position) = kommando zeichen
            THEN ueberspringe das kommando (trennwort, position, +1);
          FI;
          wort1 := subtext (trennwort, 1, position);
          wort2 := subtext (trennwort, position + 1, max trennlaenge); 
          IF rechtes teilwort mit bindestrich
            THEN wort1 CAT bindestrich;
                 delete char (wort2, 1)
          FI
   FI.
 
rechtes teilwort mit bindestrich:
  (wort2 SUB 1) = bindestrich AND
                             pos (buchstaben, wort1 SUB length (wort1)) <> 0.

sprung:
   inchar(steuerzeichen);
   IF steuerzeichen = rechts
     THEN wort1 := subtext (trennwort, 1, max trennlaenge);
          wort2 := ""
   ELIF steuerzeichen = links
     THEN wort1 := "";
          wort2 := subtext (trennwort, 1, max trennlaenge)
   FI.

neue zeile mit trennwort versehen:
  IF wort1 = ""
    THEN keine trennung
    ELSE zeichenpos := wortanfang + length (wort1); 
         mit trennsymbol trennen;
         von := zeichenpos
  FI.
 
keine trennung:
  IF wort ist zu lang fuer limit
    THEN warnung (7, trennwort);
         neue zeile CAT trennwort;
         zeichenpos := wortende + 1;
         zeichenpos bereits verarbeitet := 0;
         von := zeichenpos
    ELSE loesche nachfolgende blanks;
         zeichenpos := wortanfang
  FI.

wort ist zu lang fuer limit:
  length (alte blanks) * einrueckbreite + breite davor + trennbreite
                                             >= aktuelle pitch zeilenlaenge.

mit trennsymbol trennen:
  IF (wort1 SUB length (wort1)) = "c" AND
      (trennwort SUB (length (wort1) + 1)) = "k"
    THEN replace (wort1, length (wort1), trenn k)
  FI;
  neue zeile CAT wort1;
  IF trennsymbol <> blank
    THEN neue zeile CAT trennsymbol
  FI.
END PROC trennung eventuell vornehmen;
 
PROC naechste zeile ggf heranziehen:
  IF puffer hat absatz
     OR puffer hat noch mindestens zwei woerter
     OR zeile hat eine foot anweisung
     OR in foot uebertrag
    THEN LEAVE naechste zeile ggf heranziehen
  ELIF trennung vorhanden
    THEN IF zeichenpos < pufferlaenge
           THEN zeilenbreite INCR breite (trennzeichen)
         FI;
         getrennte zeilen zusammenziehen;
         LEAVE naechste zeile ggf heranziehen
  FI;
  puffer CAT blank;
  puffer CAT zeile;
  zeile lesen;
  pufferlaenge := length (puffer);
  ggf absatz an puffer anfuegen.
 
puffer hat noch mindestens zwei woerter:
  INT VAR anz :: 0, i :: zeichenpos;
  WHILE pos (puffer, " ", i) > 0 REP
    anz INCR 1;
    i := pos (puffer, " ", i) + 1
  END REP;
  anz > 1.

zeile hat eine foot anweisung:
  pos (puffer, "#foot") <> 0.
END PROC naechste zeile ggf heranziehen; 
 
(******************** initialisierungs routine *******************)

PROC form initialisieren (TEXT CONST datei):
   kommando liste :=
"type:1.1linefeed:3.1limit:4.1free:5.1page:6.01on:8.1off:9.1pagenr:10.2
pagelength:11.1start:12.2foot:13.0end:14.0head:15.0headeven:16.0
headodd:17.0bottom:18.0bottomeven:19.0bottomodd:20.0block:21.0";
   kommando liste CAT
"material:22.1columns:23.2columnsend:24.0ib:25.012ie:28.012topage:31.1
goalpage:32.1count:33.01setcount:35.1value:36.01table:38.0tableend:39.0
rpos:40.1lpos:41.1cpos:42.1dpos:43.2bpos:44.2clearpos:45.01right:47.0";
  kommando liste CAT
"center:48.0skip:49.0skipend:50.0u:51.0d:52.0e:53.0headon:54.0headoff:55.0
bottomon:56.0bottomoff:57.0countperpage:58.0fillchar:59.1mark:60.2
markend:61.0pageblock:62.0b:63.0counter:64.12setcounter:66.2putcounter:67.01
storecounter:69.1";
  kommando liste CAT 
"ub:70.0ue:71.0fb:72.0fe:73.0";
  line ;
  erste fehlerzeilennr    := 0;
  anz tabs                := 0;
  zeilennr                := 0;
  zeilenbreite            := 0;
  anz blanks freihalten   := 3;
  herkunftsreferenzen     := "#";
  zielreferenzen          := "#";
  aktuelle blanks         := "";
  font nr speicher        := "";
  modifikationsspeicher   := "";
  mod zeilennr speicher   := "";
  index speicher          := "";
  ind zeilennr speicher   := "";
  counter numbering store := "";
  counter reference store := "";
  command store           := "";
  kommando                := "";
  neue zeile              := "";
  zeile                   := "";
  puffer                  := " ";
  macro works             := FALSE;
  in tabelle              := FALSE;
  in d und e verarbeitung := FALSE;
  kommandos speichern     := TRUE;
  in foot                 := FALSE;
  in foot uebertrag       := FALSE;
  test ob font table vorhanden;
  bildschirm initialisieren;
  zeile lesen;
  zeile in puffer und zeile lesen;
  einrueckung zweite zeile := "xxx";
  limit und type ggf anfragen;
  einrueckbreite := eingestellte indentation pitch ;
  initialisiere neue zeile;
  IF einrueckung zweite zeile <> "xxx"
    THEN aktuelle blanks := einrueckung zweite zeile
  FI.

test ob font table vorhanden:
  INT VAR xxx :: x step conversion (0.0). 

bildschirm initialisieren:
  IF online
    THEN init
  FI.

init:
   page;
   IF lineform mode
     THEN put ("LINEFORM") 
     ELSE put ("AUTOFORM")
   FI;
   put ("(für"); put (lines (eingabe)); put ("Zeilen):");
   put (datei);
   cursor (1, 3).
END PROC form initialisieren;

PROC limit und type ggf anfragen:
  conversion (limit in cm, aktuelle pitch zeilenlaenge);
  IF ask type and limit
    THEN type und limit setzen
    ELSE alter schriftname := kein vorhandener schriftname;
         stelle font ein
  FI;
  REAL VAR x :: limit in cm;
  conversion (x, aktuelle pitch zeilenlaenge);
  IF x = fehler wert
    THEN limit in cm := 16.0;
         conversion (limit in cm, aktuelle pitch zeilenlaenge)
    ELSE limit in cm := x
  FI;
  trennbreite setzen.

type und limit setzen:
  LET type text                    = "#type (""",
      limit text                   = "#limit (",
      kommando ende text           = ")#",
      kein vorhandener schriftname = "#####";
  IF type und limit anweisungen nicht vorhanden
    THEN type und limit fragen
    ELSE hole font;
         alter schriftname := kein vorhandener schriftname
  FI.

type und limit fragen:
  type anfragen;
  type in neue zeile;
  limit anfragen;
  limit in neue zeile;
  IF NOT format file in situ
    THEN schreibe neue zeile;
         zeilen nr INCR 1
  FI;
  IF NOT puffer hat absatz
    THEN einrueckung zweite zeile := aktuelle blanks;
         aktuelle blanks := alte blanks;(* Einrueckung fuer die erste zeile*)
  FI;
  line.

type und limit anweisungen nicht vorhanden:
  (pos (puffer, type text) <> 1 OR pos (puffer, "limit") < 12).

type anfragen:
  put ("Bitte Schrifttyp    :");
  IF font table name = font table
    THEN dummy := font (font nr);
    ELSE dummy := font (1);
         font table name := font table
  FI;
  REP
    editget (dummy);
    IF font exists (dummy)
      THEN alter schriftname := dummy;
           font nr := font (dummy);
           hole font;
           LEAVE type anfragen
      ELSE line ;
           put ("ERROR: unbekannter Schrifttyp");
           line (2);
           put ("Schrifttyp bitte nochmal:")
    FI
  END REP.

type in neue zeile:
  neue zeile := type text;
  neue zeile CAT dummy;
  neue zeile CAT """";
  neue zeile CAT kommando ende text.
 
limit anfragen:
  line ;
  put ("Zeilenbreite (in cm):");
  dummy := text (limit in cm);
  REP
    editget (dummy);
    limit in cm := real (dummy);
    IF last conversion ok AND pos (dummy, ".") <> 0
      THEN LEAVE limit anfragen
      ELSE line ;
           put ("ERROR: Falsche Angabe");
           line (2);
           put ("Zeilenbreite (in cm) bitte nochmal:");
    FI
  END REP.

limit in neue zeile:
  neue zeile CAT limit text;
  neue zeile CAT dummy;
  neue zeile CAT kommando ende text;
  neue zeile CAT " ".
END PROC limit und type ggf anfragen;

PROC start form (TEXT CONST datei): 
  IF NOT format file in situ 
    THEN last param (datei);
  FI;
  disable stop; 
     dateien assoziieren;
     zeilen form (datei);
     IF is error
       THEN fehlerbehandlung
       ELSE datei neu nach alt kopieren
     FI;
     zwischendatei loeschen;
  enable stop;
  col (eingabe, 1);
  IF aktueller editor > 0
    THEN set range (file, alter bereich)
  FI;
  IF anything noted
    THEN IF aktueller editor = 0
           THEN to line (eingabe, erste fehler zeilen nr);
           ELSE alles neu
         FI;
         note edit (eingabe)
  ELIF NOT format file in situ
    THEN to line (eingabe, 1)
  FI.

dateien assoziieren:
  IF format file in situ 
    THEN
  ELIF exists (datei)
    THEN IF subtext (datei, length (datei) - 1) = ".p"
           THEN errorstop
                ("'.p'-Datei kann nicht mit lineform bearbeitet werden")
         FI;
         eingabe := sequential file (modify, datei);
         ausgabe datei einrichten
    ELSE errorstop ("Datei existiert nicht")
  FI;
  to line (eingabe, 1);
  col (eingabe, 1).

ausgabe datei einrichten:
  ds := nilspace;
  ausgabe := sequential file (modify, ds);
  to line (ausgabe, 1);
  copy attributes (eingabe, ausgabe).

fehlerbehandlung:
  put error;
  clear error;
  font nr := 1;
  font table name := "";
  limit in cm := 16.0;
  IF format file in situ
    THEN insert record (eingabe);
         write record  (eingabe, neue zeile);
         down (eingabe);
         insert record (eingabe);
         write record  (eingabe, puffer);
         down (eingabe);
         insert record (eingabe);
         write record  (eingabe, zeile)
  FI.

datei neu nach alt kopieren:
  IF NOT format file in situ 
    THEN forget (datei, quiet);
         copy (ds, datei);
         eingabe := sequential file (modify, datei)
  FI. 

zwischendatei loeschen:
  IF NOT format file in situ 
    THEN forget (ds)
  FI.
END PROC start form;
 
(************** line/autoform fuer benannte Dateien ******************)

PROC lineform:
  IF aktueller editor > 0
    THEN IF mark
           THEN editor bereich bearbeiten
           ELSE errorstop ("kein markierter Bereich")
         FI
    ELSE lineform (last param)
  FI.

editor bereich bearbeiten:
  disable stop;
    file := editfile; 
    set marked range (file, alter bereich); 
    lineform (file);
  enable stop;
END PROC lineform;
 
PROC lineform (TEXT CONST datei):
  ask type and limit  := TRUE;
  lineform mode       := TRUE;
  format file in situ := FALSE; 
  start form (datei)
END PROC lineform;
 
PROC autoform:
  IF aktueller editor > 0
    THEN IF mark
           THEN editor bereich bearbeiten
           ELSE errorstop ("kein markierter Bereich")
         FI
    ELSE auto form (last param)
  FI.

editor bereich bearbeiten:
  disable stop;
    file := editfile; 
    set marked range (file, alter bereich); 
    autoform (file);
  enable stop
END PROC autoform;

PROC autoform (TEXT CONST datei):
  ask type and limit  := TRUE;
  lineform mode       := FALSE;
  format file in situ := FALSE; 
  start form (datei)
END PROC autoform;
 
(******************** line/autoform fuer files ************************)

PROC lineform (FILE VAR f):
  enable stop;
  eingabe := f; 
  format file in situ := TRUE;
  ask type and limit  := TRUE;
  lineform mode       := TRUE;
  start form ("");
END PROC lineform;

PROC autoform (FILE VAR f):
  enable stop;
  eingabe := f; 
  format file in situ := TRUE;
  ask type and limit  := TRUE;
  lineform mode       := FALSE;
  start form ("");
END PROC autoform;

PROC lineform (FILE VAR f, TEXT CONST type name, REAL CONST file limit): 
  eingabe := f; 
  format file in situ := TRUE;
  lineform mode       := TRUE; 
  ask type and limit  := FALSE;
  par1        := type name; 
  limit in cm := file limit;
  start form (""); 
END PROC lineform; 

PROC autoform (FILE VAR f, TEXT CONST type name, REAL CONST file limit): 
  eingabe := f; 
  format file in situ := TRUE;
  lineform mode       := FALSE; 
  ask type and limit  := FALSE;
  par1        := type name; 
  limit in cm := file limit;
  start form (""); 
END PROC autoform; 
END PACKET liner;
(*
REP
    copy("lfehler","zz");
    IF yes ("autoform")
      THEN autoform ("zz")
      ELSE lineform ("zz")
    FI;
    edit("zz");
    forget("zz")
UNTIL yes ("ENDE") ENDREP;
*)