summaryrefslogtreecommitdiff
path: root/system/multiuser/1.7.5/src/liner
diff options
context:
space:
mode:
Diffstat (limited to 'system/multiuser/1.7.5/src/liner')
-rw-r--r--system/multiuser/1.7.5/src/liner3079
1 files changed, 3079 insertions, 0 deletions
diff --git a/system/multiuser/1.7.5/src/liner b/system/multiuser/1.7.5/src/liner
new file mode 100644
index 0000000..bc1f41d
--- /dev/null
+++ b/system/multiuser/1.7.5/src/liner
@@ -0,0 +1,3079 @@
+(* ------------------- 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;
+*)
+