home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 11 / druck / druck.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1987-09-01  |  20.4 KB  |  469 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                             DRUCK.PAS                                   *)
  3. (* Schoenschrift-Ausdruck selbst gemacht. Hier mit WordStar 3.40, NEC P6   *)
  4. (*                    24-Nadel-Drucker und Turbo-Pascal                    *)
  5.  
  6. PROGRAM Druck;
  7. CONST
  8.    check      = FALSE;                    (* true: diagnostischer Output *)
  9.    ESC        = '#';                      (* Escape-Signal *)
  10.    bell       = 7;                        (* ASCII-Code Klingelsignal *)
  11.    MaxLen     = 130;                      (* max. Zeilenlaenge *)
  12.    MIN        = 16;                       (* min/max. Ausdehnung fuer *)
  13.    MAX        = 56;                       (*  Blanks in 360stel Zoll *)
  14.    LeftMargin = 16;
  15.    CwFileName = 'CHRDATA.TXT';            (* enthaelt Schrittweitentabelle *)
  16.  
  17. TYPE
  18.    signset   = SET OF CHAR;
  19.    strmaxlen = STRING[MaxLen];
  20.    string80  = STRING[80];
  21.    str50     = STRING[50];                                (* f. Dateinamen *)
  22. VAR
  23.    CR, stop, checking,                   (* checking ist fuer Diagnostik ! *)
  24.    dotline                : BOOLEAN;
  25.    spaces, chars, allchars: signset;
  26.    Word, Line, Linebuf    : strmaxlen;
  27.    WSFileName, OutFileName: str50;
  28.    LeftJust, FullJust     : STRING[3];
  29.    cwf, inp, out          : TEXT;
  30.    cw                     : ARRAY[30..255] OF INTEGER;
  31.    Wordcount, Sum, mmTab,
  32.    Tab, ladj, BOLFont,
  33.    Font, blanks, adj,
  34.    RightMargin            : INTEGER;
  35. (* ----------------------------------------------------------------------- *)
  36. PROCEDURE Cursor (row, col: INTEGER);              (* Cursor positionieren *)
  37. BEGIN GotoXY(col, row); END;
  38.  
  39. PROCEDURE BlackOnWhite;              (* inverse Textdarstellung aktivieren *)
  40. BEGIN  TextColor(Black);  TextBackground(White);  END;
  41.  
  42. PROCEDURE WhiteOnBlack;              (* und wieder normale Textdarstellung *)
  43. BEGIN  NormVideo;  END;
  44. (* ----------------------------------------------------------------------- *)
  45. PROCEDURE Initialize;
  46. VAR
  47.    i: INTEGER;   c: CHAR;  temp: str50;
  48. BEGIN
  49.    allchars := [];
  50.    FOR i := 30 TO 255 DO allchars := allchars + [Chr(i)];
  51.       (* Proportional-Schrittweitentabelle der Zeichen lesen:              *)
  52.       (* Datei zu lesen oeffnen, andere Pascal-C.: ReSet(cwf, CwFileName); *)
  53.    Assign(cwf, CwFileName); ReSet(cwf);
  54.    ReadLn(cwf);            (* erste Kommentarzeile in der Datei ueberlesen *)
  55.    (* Schrittweiten fuer die IBM-Sonderzeichen initialisieren, die nicht   *)
  56.    (* in der Datei enthalten sind:                                         *)
  57.    FOR i := 127 TO 255 DO cw[i] := 30;
  58.    cw[30]  := 30;  cw[31]  := 30;  cw[132] := 32;
  59.    cw[148] := 30;  cw[129] := 34;  cw[225] := 30;
  60.    cw[142] := 42;  cw[153] := 38;  cw[154] := 36;
  61.    FOR i := 32 TO 126 DO BEGIN                (* Rest aus der Datei lesen: *)
  62.       Read(cwf, c, c, cw[i]);
  63.       IF Eoln(cwf) THEN ReadLn(cwf) ELSE Read(cwf, c);
  64.    END;
  65.    Close(cwf);
  66.    Write('WordStar-Datei             : '); ReadLn(WSFileName);
  67.    Assign(inp, WSFileName); ReSet(inp);                            (* s.o. *)
  68.    OutFileName := 'LST:';                       (* Ausgabe auf den Drucker *)
  69.    Write('Ausgabe (RETURN -> Drucker): '); ReadLn(temp);
  70.    IF temp <> '' THEN OutFileName := temp;
  71. (* Ausgabedatei oeffnen, fuer andere Pascal-C.: ReWrite(out, OutFileName); *)
  72.    Assign(out, OutFileName); ReWrite(out);
  73.    Write('Zeilenspiegel (mm)         : '); ReadLn(mmTab);
  74.    Tab := Round(mmTab*7.0733*2.0);
  75.    FOR i := 1 TO 79 DO Write('-');
  76.    WriteLn; WriteLn;
  77.    Line := '';    Word := '';     Sum := 0;
  78.    adj := 100;    Font := 0;      BOLFont := 0;
  79.    stop := FALSE; CR := TRUE;     Wordcount := 0;
  80.    Linebuf := ''; spaces := [' '];
  81.    chars := allchars - spaces;    checking := FALSE;
  82.    RightMargin := Round(mmTab * 0.79) + LeftMargin;
  83.    dotline:=FALSE;  stop:=FALSE;
  84.    Write(out, Chr(28),Chr(64));                           (* Drucker-Reset *)
  85.    Write(out, Chr(28),Chr(73),Chr(1));                    (* IBM-Zeichens. *)
  86.    Write(out, Chr(27),Chr(33),Chr(5));                  (* 20 Zeichen/Zoll *)
  87.    Write(out, Chr(27),Chr(108),Chr(LeftMargin));           (* linker Rand  *)
  88.    Write(out, Chr(27),Chr(81),Chr(RightMargin));           (* rechter Rand *)
  89.    Write(out, Chr(27),Chr(120),Chr(1));                (* Schoendruck (LQ) *)
  90.    Write(out, Chr(27),Chr(33),Chr(2));           (* proportional = default *)
  91.                                            (* NEC P6/P7 Randausgleich AUS: *)
  92.    LeftJust := Concat(Chr(27),Chr(97),Chr(0));
  93.                                             (* NEC P6/P7 Randausgleich AN: *)
  94.    FullJust := Concat(Chr(27),Chr(97),Chr(3));
  95. END;
  96. (* ----------------------------------------------------------------------- *)
  97. (*             Auswahl aus den Escape-Sequenzen fuer NEC P6/P7             *)
  98. PROCEDURE PtrEscape (c: CHAR);
  99. BEGIN
  100.    CASE c OF
  101.       '0': Write(out, Chr(27),Chr(33),Chr(2));       (* Proportional       *)
  102.       '1': Write(out, Chr(27),Chr(33),Chr(0));       (* Courier            *)
  103.       '2': Write(out, Chr(27),Chr(33),Chr(1));       (* Elite              *)
  104.       'a': Write(out, Chr(27),Chr(51),Chr(30));      (* einzeilig          *)
  105.       'b': Write(out, Chr(27),Chr(51),Chr(45));      (* anderthalbzeilig   *)
  106.       'd': Write(out, Chr(28),Chr(86),Chr(1),
  107.                       Chr(28),Chr(69),Chr(1));       (* gross + breit      *)
  108.       'D': Write(out, Chr(28),Chr(86),Chr(0),
  109.                       Chr(28),Chr(69),Chr(0));       (* dto. AUS           *)
  110.       '/': Write(out, Chr(27),Chr(52));              (* kursiv             *)
  111.       '%': Write(out, Chr(27),Chr(120),Chr(0));      (* Draft              *)
  112.       '&': Write(out, Chr(27),Chr(120),Chr(1));      (* Letter Quality     *)
  113.       'k': Write(out, Chr(27),Chr(45),Chr(1));       (* unterstreichen AN  *)
  114.       'K': Write(out, Chr(27),Chr(45),Chr(0));       (* unterstreichen AUS *)
  115.       's': Write(out, Chr(27),Chr(69));              (* Schattendruck      *)
  116.       'h': Write(out, Chr(27),Chr(83),Chr(0));       (* Superskript AN     *)
  117.       't': Write(out, Chr(27),Chr(84));              (* Superskript AUS    *)
  118.       'z': Write(out, Chr(27),Chr(97),Chr(1));       (* zentrieren         *)
  119.    END; (* Case *)
  120. END; (* Escape *)
  121. (* ----------------------------------------------------------------------- *)
  122. (*           Unterbrechung nach jeder Kommentarzeile oder .pa              *)
  123. PROCEDURE ContactUser;
  124. VAR c: CHAR;
  125.     i: INTEGER;
  126. BEGIN
  127.    FOR i := 1 TO 79 DO Write('-'); WriteLn(Chr(bell));
  128.    Write('weiter: CR   stop: ESC   naechste Seite: "n" ');
  129.    Read(Kbd, c);         (* Zeichen ohne Bildschirmecho von Tastatur lesen *)
  130.    WriteLn;
  131.    IF Ord(c) = 27 THEN stop := TRUE
  132.    ELSE IF c = 'n' THEN Write(out, Chr(12));             (* Seitenvorschub *)
  133. END;
  134. (* ----------------------------------------------------------------------- *)
  135. PROCEDURE PrintLn (Line: strmaxlen);
  136. VAR
  137.    i: INTEGER;
  138.    c: CHAR;
  139.    Escapeflag : BOOLEAN;
  140. BEGIN
  141.  dotline := (Copy(Line,1,3) = '.pa') OR (Copy(Line,1,2) = '..');
  142.  IF dotline THEN ContactUser
  143.  ELSE BEGIN
  144.    Escapeflag := FALSE;
  145.    i := Length(Line);
  146.    IF Line[i] = Chr(254) THEN                               (* Absatzende? *)
  147.      BEGIN  Delete(Line, i, 1);  Write(out, LeftJust); END
  148.    ELSE Write(out, FullJust);
  149.    FOR i := 1 TO Length(Line) DO BEGIN
  150.       c := Line[i];
  151.       IF Escapeflag THEN
  152.         BEGIN  PtrEscape(c); Escapeflag := FALSE;  END
  153.       ELSE IF c = ESC THEN Escapeflag := TRUE
  154.       ELSE IF c = '@' THEN Write(out, '#')
  155.       ELSE Write(out, c);
  156.    END;
  157.    WriteLn(out);
  158.  END;
  159. END;
  160. (* ----------------------------------------------------------------------- *)
  161. (*                    wandelt WordStar-Zeile in ASCII                      *)
  162. PROCEDURE Readline (VAR Line: strmaxlen);
  163. VAR
  164.    c: CHAR;   k: INTEGER;   HardCR, HyphenCon: BOOLEAN;
  165. BEGIN
  166.    HyphenCon := FALSE;  c := ' ';  Line := '';  HardCR := FALSE;
  167.    WHILE NOT Eof(inp) AND (c <> Chr(10)) DO        (* Chr(10) = Zeilenende *)
  168.    BEGIN
  169.       Read(inp, c);
  170.       IF c = Chr(13) THEN HardCR := TRUE                 (* Zeilenvorschub *)
  171.       ELSE IF (Ord(c) = 27) OR (Ord(c) = 155) THEN
  172.         BEGIN
  173.          IF NOT Eof(inp) THEN Read(inp, c);
  174.         END
  175.       ELSE IF Ord(c) > 127 THEN c := Chr(Ord(c) - 128);
  176.       IF (Ord(c) >= 30) AND (Ord(c) <> 138) THEN Line := Concat(Line,c);
  177.    END;
  178.    IF Line > '' THEN                     (* folgende Leerzeichen loeschen: *)
  179.      WHILE Line[Length(Line)] = ' ' DO Delete(Line, Length(Line), 1);
  180.    k := Length(Line);
  181.    IF k > 1 THEN                                       (* Trennvorschlag ? *)
  182.      HyphenCon :=  (Line[k] = '-') AND (Line[k - 1] <> ' ');
  183.    IF HardCR THEN Line := Concat(Line, Chr(254))               (* Absatz ? *)
  184.    ELSE IF NOT HyphenCon THEN Line := Concat(Line,  ' ');
  185. END;
  186. (* ----------------------------------------------------------------------- *)
  187. PROCEDURE Span (signs: signset; VAR sp: string80);
  188. VAR
  189.    outcon: BOOLEAN;
  190. BEGIN
  191.    sp := '';  outcon := FALSE;
  192.    REPEAT
  193.       IF Linebuf[1] IN signs THEN
  194.         BEGIN
  195.           sp := Concat(sp, Linebuf[1]);  Delete(Linebuf, 1, 1);
  196.         END
  197.       ELSE outcon := TRUE;
  198.    UNTIL (Linebuf = '') OR outcon;
  199. END;
  200. (* ----------------------------------------------------------------------- *)
  201. PROCEDURE Readword;
  202. VAR temp: string80;
  203. BEGIN
  204.    IF (Linebuf = '') THEN BEGIN
  205.       IF NOT Eof(inp) THEN Readline(Linebuf)
  206.       ELSE BEGIN  stop := TRUE; Linebuf := Concat(' ',Chr(254));  END;
  207.    END;
  208.    Span(spaces, temp);  Word := temp;
  209.    Span(chars, temp);   Word := Concat(Word,temp);
  210.    Span(spaces, temp);  Word := Concat(Word,temp);
  211. END;
  212. (* ----------------------------------------------------------------------- *)
  213. PROCEDURE Escape (c: CHAR);
  214. BEGIN
  215.    CASE c OF
  216.       '0': Font :=  0; (* proportional *)
  217.       '1': Font := 36; (* Courier *)
  218.       '2': Font := 30; (* Elite *)
  219.    END;
  220. END;
  221. (* ----------------------------------------------------------------------- *)
  222. (*               errechnet die Ausdehnung eines Strings                    *)
  223. PROCEDURE Sigma (OldSum: INTEGER; Line: strmaxlen);
  224. VAR
  225.    i, Width, space : INTEGER;
  226.    Escflag, BOL    : BOOLEAN;                   (* BOL = beginning of line *)
  227.    x               : CHAR;
  228. BEGIN
  229.    Sum := OldSum;   BOL:= Sum = 0;   Escflag := FALSE;
  230.    IF Sum = 0 THEN Font := BOLFont;
  231.    FOR i := 1 TO Length(Line) DO BEGIN
  232.       Width := 0;  x := Line[i];
  233.       IF x <> ' ' THEN BOL := FALSE;
  234.       IF Escflag THEN BEGIN  Escape(x);  Escflag := FALSE;  END
  235.       ELSE IF x = ESC THEN Escflag := TRUE              (* Esc ausfuehren? *)
  236.       ELSE IF BOL THEN                                  (* b.o.l. blanks ? *)
  237.         BEGIN
  238.           IF Font = 0 THEN Width := 30 ELSE Width := Font;
  239.         END
  240.       ELSE IF Ord(x) = 30 THEN Width :=  30
  241.       ELSE IF Ord(x) > 32 THEN                         (* non-b.o.l. chars *)
  242.         BEGIN
  243.           IF Font = 0 THEN Width := cw[Ord(x)] ELSE Width := Font;
  244.         END;
  245.       Sum := Sum + Width;
  246.       IF checking THEN Write(Width, ' ');
  247.    END;
  248.    space := Tab - Sum;
  249.    IF blanks > 0 THEN adj := Round(space/blanks) ELSE adj := space;
  250.    IF checking THEN BEGIN
  251.       WriteLn;
  252.       Write('CHARS: ', Length(Line), ' CR: ', CR, ' SUM: ', Sum);
  253.       WriteLn(' BLANKS: ', blanks, ' ADJ: ', adj);
  254.    END;
  255. END;
  256. (* ----------------------------------------------------------------------- *)
  257. PROCEDURE Hyphenate;                      (* interaktiver Trennalgorithmus *)
  258. VAR
  259.    c: CHAR;          Option, p, row, n, FixAdj, FixLadj: INTEGER;
  260.    syllab: str50;    TempLine, TempWord: strmaxlen;
  261.  
  262.  PROCEDURE HyphenWindow;
  263.   CONST  lenx  = 78; leny  = 2;
  264.   VAR    i: INTEGER;
  265.  BEGIN
  266.    WhiteOnBlack;
  267.  (* fuer den Rahmen nach Bedarf schoenere Zeichen Ihres Systems einsetzen: *)
  268.    Cursor(row, 1);         FOR i := 1 TO lenx DO Write('-');     (* Kanten *)
  269.    Cursor(row + leny, 1);  FOR i := 1 TO lenx DO Write('-');
  270.    Cursor(row + 1, 1);     Write('!');
  271.    Cursor(row + 1, lenx);  Write('!');
  272.    Cursor(row, 1);            Write('+');                         (* Ecken *)
  273.    Cursor(row, lenx);         Write('+');
  274.    Cursor(row + leny, 1);     Write('+');
  275.    Cursor(row + leny, lenx);  Write('+');
  276.    Cursor(row + 1, 12);  Write('!');                             (* Waende *)
  277.    Cursor(row + 1, 22);  Write('!');
  278.    Cursor(row, 12);         Write('+');                       (* T-Stuecke *)
  279.    Cursor(row, 22);         Write('+');
  280.    Cursor(row + leny, 12);  Write('+');
  281.    Cursor(row + leny, 22);  Write('+');
  282.    Cursor(row, 4);      Write('mit');                              (* Text *)
  283.    Cursor(row, 14);     Write('ohne');
  284.    Cursor(row, 25);     Write('trenne');
  285.    Cursor(row + 1, 25); Write(Word);
  286.    Cursor(row + 1, 4);  Write(FixLadj:3, '(', MIN, ')');
  287.    Cursor(row + 1, 14); Write(FixAdj:3, '(',  MAX, ')');
  288.  END;
  289.  
  290.  PROCEDURE writeOption (i: INTEGER);
  291.  BEGIN
  292.    CASE Option OF
  293.       1: BEGIN
  294.            Cursor(row+1,4); Write(FixLadj:3,'(', MIN,')'); Cursor(row+1,4);
  295.          END;
  296.       2: BEGIN
  297.            Cursor(row+1,14); Write(FixAdj:3,'(',MAX,')'); Cursor(row+1,14);
  298.          END;
  299.       3: BEGIN  Cursor(row+1,25);  Write(Word);  Cursor(row+1,25);  END;
  300.    END; (* case *)
  301.  END;
  302.  
  303.  PROCEDURE OptionHandler (change: INTEGER);
  304.  BEGIN
  305.    WhiteOnBlack;  writeOption(Option);  Option := change + Option;
  306.    IF Option > 3 THEN Option := 1
  307.    ELSE IF Option  < 1 THEN Option := 3;
  308.    p := 0;  BlackOnWhite;  writeOption(Option);
  309.  END;
  310.  
  311.  PROCEDURE MenuLoop;
  312.   VAR i: INTEGER;  ch : CHAR;  ok: BOOLEAN;
  313.  
  314.    PROCEDURE ParallelDisplay;
  315.     VAR hyph: BOOLEAN;  temp: strmaxlen;
  316.    BEGIN
  317.      blanks := blanks + 1;      hyph := Word[p] = '-';
  318.      temp := Copy(Word, 1, p);  temp := Concat(Line, temp);
  319.      IF hyph THEN Sigma(0, temp)
  320.      ELSE BEGIN  temp := Concat(temp, '-');  Sigma(0, temp);  END;
  321.      blanks := blanks - 1;  Cursor(row, 35);  Write(adj:3, ' OK?(CR)');
  322.    END;
  323.  
  324.  BEGIN (* MenuLoop *)
  325.    ok := FALSE;
  326.    REPEAT (* option loop *)
  327.       Read(Kbd, c);      (* Zeichen ohne Bildschirmecho von Tastatur lesen *)
  328.       CASE Ord(c) OF
  329.           27: BEGIN                          (* behandle IBM-Cursortasten: *)
  330.                 IF KeyPressed THEN  (* es folgt der Code einer Cursortaste *)
  331.                   Read(Kbd, c)
  332.                 ELSE         (* sonst wurde die ESC-Taste gedrueckt und... *)
  333.                   BEGIN                (* ...ESC-Taste bricht Programm ab! *)
  334.                     WriteLn(out); Close(inp); Close(out);
  335.                     Halt;                          (* beendet das Programm *)
  336.                   END;
  337.                 IF Option < 3 THEN             (* Zeile mit oder ohne Wort *)
  338.                   CASE Ord(c) OF
  339.                     77: OptionHandler(1);                 (* Cursor rechts *)
  340.                     75: OptionHandler(-1);                 (* Cursor links *)
  341.                    ELSE Write(Chr(bell));
  342.                   END
  343.                 ELSE                    (* Trennposition im Word bestimmen *)
  344.                   BEGIN
  345.                     CASE Ord(c) OF
  346.                       77: IF p < Length(Word) THEN
  347.                             BEGIN             (* im Word nach rechts gehen *)
  348.                               WhiteOnBlack;  p := p + 1;  ParallelDisplay;
  349.                               Cursor(row+1,p+24);  Write(Word[p]);
  350.                             END
  351.                           ELSE                 (* in den Punkt "mit" gehen *)
  352.                             OptionHandler(1);
  353.                       75: IF p > 1 THEN
  354.                             BEGIN              (* im Word nach links gehen *)
  355.                               BlackOnWhite;
  356.                               Cursor(row+1,p+24);  Write(Word[p]);
  357.                               p := p - 1;  ParallelDisplay;
  358.                               Cursor(row+1,p+24);
  359.                             END
  360.                           ELSE                (* in den Punkt "ohne" gehen *)
  361.                             OptionHandler(-1);
  362.                       ELSE Write(Chr(bell));
  363.                     END;
  364.                   END;
  365.               END; (* OF 27 *)
  366.           13: BEGIN                                 (* CR trifft eine Wahl *)
  367.                 CASE Option OF
  368.                   1: BEGIN      (* letztes ADJ akzeptiert: inkludiere Wort *)
  369.                        Line := Concat(Line,Word);  blanks := blanks+1;
  370.                        Sigma(0, Line);  Word := '';  ok := TRUE;
  371.                      END;
  372.                   2: ok := TRUE;        (* ADJ akzeptiert: Wort auf Vorrat *)
  373.                   3: BEGIN                          (* Hyphenation Routine *)
  374.                        syllab := Copy(Word, 1, p);  blanks := blanks + 1;
  375.                        n := Length(Word);           ch := ' ';
  376.                        IF syllab[p] = '-' THEN
  377.                          TempLine := Concat(Line, syllab)
  378.                        ELSE
  379.                          TempLine := Concat(Line, syllab, '-');
  380.                        TempWord := Copy(Word, p+1, n-p);
  381.                        Sigma(0, TempLine);
  382.                        IF adj IN [MIN .. MAX] THEN BEGIN
  383.                          Line := TempLine;  Word := TempWord;
  384.                          ok := TRUE;
  385.                        END;
  386.                      END;
  387.                 END; (* CASE option *)
  388.               END; (* OF 13 *)
  389.           ELSE Write(Chr(bell));
  390.       END; (* CASE *)
  391.    UNTIL ok;
  392.  END; (* menu loop *)
  393.  
  394. BEGIN (* Hyphenate *)
  395.    WriteLn(Line);  WriteLn(Word);  WriteLn(Chr(bell));
  396.    WriteLn;  WriteLn;  WriteLn;  WriteLn;  WriteLn;
  397.    row := 22;  Option := 3;    FixAdj := adj;  FixLadj := ladj;
  398.    HyphenWindow;   OptionHandler(1);   MenuLoop;
  399.    WhiteOnBlack;  WriteLn;  WriteLn;
  400. END;
  401. (* ----------------------------------------------------------------------- *)
  402. PROCEDURE reinitial;
  403. BEGIN
  404.    Line := '';             (* neue Zeile; Word moeglicherweise nicht leer *)
  405.    Sum := 0;   BOLFont := Font;   Wordcount := 0;   adj := 100;
  406. END;
  407. (* ----------------------------------------------------------------------- *)
  408. (*        fuellt Line so lange mit Woertern bis ADJ < MIN oder CR          *)
  409. PROCEDURE Umbruch;
  410. VAR  c : CHAR;
  411. BEGIN
  412.   IF Word = '' THEN Readword;
  413.   CR := Word[Length(Word)] = Chr(254);
  414.   blanks := Wordcount;   Wordcount := Wordcount + 1;
  415.   Sigma(Sum, Word);              (* wie gross sind wir mit dem neuen Wort? *)
  416.   ladj := adj;                                      (* Ergebnis festhalten *)
  417.   IF (adj < MIN) OR CR THEN             (* Abschlussbedingungen erfuellt ? *)
  418.     BEGIN
  419.       IF CR  THEN
  420.         BEGIN
  421.           IF adj >= 30 THEN
  422.             BEGIN                                   (* 1: CR und adj >= 30 *)
  423.               Line := Concat(Line, Word);  Word := '';
  424.               WriteLn(Line);               PrintLn(Line);
  425.               IF check THEN WriteLn('EXIT: 1 ');
  426.             END
  427.           ELSE                                            (* fuer adj < 30 *)
  428.             BEGIN                                    (* 2: CR und adj < 30 *)
  429.               blanks := blanks - 1;  Sigma(0, Line);
  430.               IF adj > MAX THEN Hyphenate;
  431.               WriteLn(Line);  PrintLn(Line);
  432.               IF Length(Word) > 0 THEN BEGIN
  433.                  WHILE Word[1] = ' ' DO Delete(Word, 1, 1);
  434.                  WriteLn(Word);  PrintLn(Word);
  435.               END;
  436.               IF check THEN WriteLn('EXIT: 2 ');
  437.               Word := '';
  438.             END;
  439.         END (* IF CR *)
  440.       ELSE                                       (* 3: nicht CR, adj < min *)
  441.         BEGIN
  442.           blanks := blanks - 1;  Sigma(0, Line);
  443.           IF (adj > MAX) THEN Hyphenate;
  444.           WriteLn(Line);  PrintLn(Line);     (* Wort ist nicht Nullstring! *)
  445.           IF check THEN WriteLn('EXIT: 3 ');
  446.         END;
  447.       IF check THEN BEGIN
  448.         checking := TRUE;  Sigma(0, Line);
  449.         Read(Kbd, c);  WriteLn;  checking := FALSE;
  450.       END;
  451.       reinitial;
  452.     END (* IF (adj < MIN) OR CR *)
  453.   ELSE                                         (*  (adj >= MIN) and not CR *)
  454.     BEGIN
  455.       Line := Concat(Line, Word);         (* solange bis ADJ < MIN oder CR *)
  456.       Word := '';
  457.     END;
  458. END;  (* UmbruchRoutine *)
  459. (* ----------------------------------------------------------------------- *)
  460. BEGIN (* MAIN *)
  461.    WriteLn;  WriteLn;
  462.    WriteLn('Umbruch & Druck  (c) 1987  M.Jahn & PASCAL INT.');  WriteLn;
  463.    Initialize;
  464.    WHILE NOT stop DO Umbruch;
  465.    WriteLn(Concat(Line, Word));  PrintLn(Concat(Line, Word));
  466.    Close(inp);  Close(out);
  467.    WriteLn;  WriteLn('fertig...');
  468. END.
  469.