home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / parcelems.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  24KB  |  545 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. Syntax10b.Scn.Fnt
  4. MODULE ParcElems;    (** CAS/MH/HM 26.5.1993 **)
  5.     IMPORT
  6.         SYSTEM, Input, Display, Files, Oberon, Fonts, Texts, TextFrames, TextPrinter;
  7.     CONST
  8.         BigEndianSet = FALSE; (* TRUE for HP-Oberon and POWERoberon *)
  9.         (**StateMsg.id*)
  10.             set* = 0; get* = 1;
  11.         mm = TextFrames.mm; unit = TextFrames.Unit; Unit = TextPrinter.Unit;
  12.         Scale = mm DIV 10; MinTabDelta = 5*mm; ParcHeight = 3*mm; ColumnGap = 7*mm;
  13.         gridAdj = TextFrames.gridAdj; leftAdj = TextFrames.leftAdj; rightAdj = TextFrames.rightAdj;
  14.         pageBreak = TextFrames.pageBreak;
  15.         twoColumns = TextFrames.twoColumns;
  16.         AdjMask = {leftAdj, rightAdj};
  17.         rightKey = 0; middleKey = 1; leftKey = 2; cancel = {rightKey, middleKey, leftKey};
  18.         black = Display.black; (*white = Display.white;*) replace = Display.replace; invert = Display.invert;
  19.         SepH = 5;
  20.         MargW = 5; MargH = 5;
  21.     TYPE
  22.         StateMsg* = RECORD (Texts.ElemMsg)
  23.             id*: INTEGER;
  24.             pos*: LONGINT;
  25.             frame*: TextFrames.Frame;
  26.             par*: Texts.Scanner;
  27.             log*: Texts.Text
  28.         END;
  29.         W: Texts.Writer;
  30.         TabMarkImage: ARRAY 6 OF SET;
  31.         TabPat: LONGINT;
  32.         white: SHORTINT;
  33.     PROCEDURE FlipBits (s: SET): SET;
  34.         VAR d: SET; i: INTEGER;
  35.     BEGIN
  36.         d := {}; i := 0;
  37.         WHILE i < 32 DO
  38.             IF i IN s THEN INCL(d, 31-i) END;
  39.             INC(i);
  40.         END;
  41.         RETURN d
  42.     END FlipBits;
  43.     PROCEDURE RdSet (VAR r: Files.Rider; VAR s: SET);
  44.     BEGIN
  45.         Files.ReadNum(r, SYSTEM.VAL(LONGINT, s));
  46.         IF BigEndianSet THEN s := FlipBits(s) END;
  47.     END RdSet;
  48.     PROCEDURE WrtSet (VAR r: Files.Rider; s: SET);
  49.     BEGIN
  50.         IF BigEndianSet THEN s := FlipBits(s) END;
  51.         Files.WriteNum(r, SYSTEM.VAL(LONGINT, s));
  52.     END WrtSet;
  53.     PROCEDURE Str (s: ARRAY OF CHAR);
  54.     BEGIN Texts.WriteString(W, s)
  55.     END Str;
  56.     PROCEDURE Int (n: LONGINT);
  57.     BEGIN Texts.Write(W, " "); Texts.WriteInt(W, n, 0)
  58.     END Int;
  59.     PROCEDURE Ln;
  60.     BEGIN Texts.WriteLn(W)
  61.     END Ln;
  62.     PROCEDURE Min (x, y: LONGINT): LONGINT;
  63.     BEGIN
  64.         IF x < y THEN RETURN x ELSE RETURN y END
  65.     END Min;
  66.     PROCEDURE Max (x, y: LONGINT): LONGINT;
  67.     BEGIN
  68.         IF x > y THEN RETURN x ELSE RETURN y END
  69.     END Max;
  70.     PROCEDURE Matches (VAR S: Texts.Scanner; key: ARRAY OF CHAR): BOOLEAN;
  71.         VAR i: INTEGER;
  72.     BEGIN i := 0;
  73.         WHILE (S.s[i] # 0X) & (CAP(S.s[i]) = key[i]) DO INC(i) END;
  74.         RETURN (S.class = Texts.Name) & ((key[i] = 0X) OR (i >= 3)) & (S.s[i] = 0X)
  75.     END Matches;
  76.     PROCEDURE GetNextInt (VAR S: Texts.Scanner; VAR units: LONGINT; lo, hi, def: LONGINT);
  77.         (*constrained int w/ default*)
  78.     BEGIN Texts.Scan(S);
  79.         IF Matches(S, "DEFAULT") THEN S.class := Texts.Int; S.i := def; units := S.i * Scale;
  80.         ELSIF S.class = Texts.Int THEN
  81.             IF (S.i < lo) OR (S.i >= hi) THEN S.i := def END;
  82.             units := S.i * Scale;
  83.         END;
  84.     END GetNextInt;
  85.     PROCEDURE Grid (x: LONGINT): LONGINT;
  86.     BEGIN RETURN x + (-x) MOD (1 * mm)
  87.     END Grid;
  88.     PROCEDURE DrawCursor (x, y: INTEGER);
  89.     BEGIN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  90.     END DrawCursor;
  91.     PROCEDURE TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET);
  92.     BEGIN Input.Mouse(keys, x, y); DrawCursor(x, y); keysum := keysum + keys
  93.     END TrackMouse;
  94.     PROCEDURE FirstMark (col: SHORTINT; x, y0: INTEGER);
  95.     BEGIN Display.ReplConst(col, x, y0 + SepH+1, 2, 5, Display.paint)
  96.     END FirstMark;
  97.     PROCEDURE FlipFirst (P: TextFrames.Parc; x0, y0: INTEGER);
  98.     BEGIN Display.ReplConst(white, x0 + SHORT((P.left + P.first) DIV unit), y0 + SepH+1, 2, 5, invert)
  99.     END FlipFirst;
  100.     PROCEDURE MoveFirst (P: TextFrames.Parc; x0, y0, dw: INTEGER);
  101.         VAR px: LONGINT;
  102.     BEGIN px := Grid(LONG(dw) * unit);
  103.         px := Max(px, -P.left); px := Min(px, P.W-P.left(*P.width*)-MinTabDelta);
  104.         IF px # P.first THEN FlipFirst(P, x0, y0); P.first := px; FlipFirst(P, x0, y0) END
  105.     END MoveFirst;
  106.     PROCEDURE FlipLeft (P: TextFrames.Parc; x0, y0: INTEGER);
  107.     BEGIN Display.ReplConst(white, x0 + SHORT(P.left DIV unit), y0+SepH-MargH+1, MargW, MargH, invert)
  108.     END FlipLeft;
  109.     PROCEDURE MoveLeft (P: TextFrames.Parc; rm: LONGINT; x0, y0, dw: INTEGER);
  110.         VAR px: LONGINT;
  111.     BEGIN px := Grid(LONG(dw) * unit);
  112.         px := Max(px, 0); px := Min(px, rm);
  113.         IF px # P.left THEN FlipLeft(P, x0, y0); P.left := px; FlipLeft(P, x0, y0) END
  114.     END MoveLeft;
  115.     PROCEDURE FlipRight (P: TextFrames.Parc; x0, y0: INTEGER);
  116.     BEGIN Display.ReplConst(white, x0+SHORT((P.left + P.width) DIV unit) - MargW, y0+SepH-MargH+1, MargW, MargH, invert)
  117.     END FlipRight;
  118.     PROCEDURE MoveRight (P: TextFrames.Parc; rm: LONGINT; x0, y0, dw: INTEGER);
  119.         VAR px: LONGINT;
  120.     BEGIN px := Grid(LONG(dw) * unit);
  121.         px := Max(px, P.left + 10*mm); px := Min(px, rm);
  122.         IF px # P.left + P.width THEN FlipRight(P, x0, y0); P.width := px - P.left; FlipRight(P, x0, y0) END
  123.     END MoveRight;
  124.     PROCEDURE TabMark (col: SHORTINT; x, y: INTEGER);
  125.     BEGIN Display.CopyPattern(col, TabPat, x, y, replace)
  126.     END TabMark;
  127.     PROCEDURE FlipTab (P: TextFrames.Parc; i, x0, y0: INTEGER);
  128.     BEGIN Display.CopyPattern(white, TabPat, x0 + SHORT(P.tab[i] DIV unit), y0, invert)
  129.     END FlipTab;
  130.     PROCEDURE GrabTab (P: TextFrames.Parc; x0, y0, dw: INTEGER; VAR i: INTEGER; VAR new: BOOLEAN);
  131.         CONST Gravity = 2*mm;
  132.         VAR j: INTEGER; lx, px, rx: LONGINT;
  133.     BEGIN
  134.         i := 0; j := P.nofTabs; new := FALSE; px := Grid(LONG(dw) * unit);
  135.         WHILE (i < j) & (P.tab[i] < px - Gravity) DO INC(i) END;
  136.         IF i < TextFrames.MaxTabs THEN
  137.             IF (i = j) OR (P.tab[i] >= px + Gravity) THEN
  138.                 IF i = 0 THEN lx := MinTabDelta ELSE lx := P.tab[i - 1] + MinTabDelta END;
  139.                 IF i = P.nofTabs THEN rx := P.width ELSE rx := P.tab[i] - MinTabDelta END;
  140.                 IF px < lx THEN px := lx END;
  141.                 IF px < rx THEN INC(P.nofTabs); new := TRUE;
  142.                     WHILE j > i DO P.tab[j] := P.tab[j - 1]; DEC(j) END
  143.                 END
  144.             ELSE px := P.tab[i]
  145.             END
  146.         ELSE DEC(i); px := P.tab[i]
  147.         END;
  148.         IF ~new THEN FlipTab(P, i, x0, y0) END;
  149.         P.tab[i] := px; FlipTab(P, i, x0, y0)
  150.     END GrabTab;
  151.     PROCEDURE MoveTab (P: TextFrames.Parc; rm: LONGINT; i, x0, y0, dw: INTEGER);
  152.         VAR lx, px, rx: LONGINT;
  153.     BEGIN px := Grid(LONG(dw) * unit);
  154.         IF i = 0 THEN lx := MinTabDelta ELSE lx := P.tab[i - 1] + MinTabDelta END;
  155.         IF i = P.nofTabs - 1 THEN rx := P.width ELSE rx := P.tab[i + 1] - MinTabDelta END;
  156.         px := Max(px, lx); px := Min(px, rx); px := Min(px, rm);
  157.         IF px # P.tab[i] THEN FlipTab(P, i, x0, y0); P.tab[i] := px; FlipTab(P, i, x0, y0) END
  158.     END MoveTab;
  159.     PROCEDURE RemoveTab (P: TextFrames.Parc; i: INTEGER);
  160.     BEGIN
  161.         WHILE i < P.nofTabs - 1 DO P.tab[i] := P.tab[i + 1]; INC(i) END;
  162.         DEC(P.nofTabs)
  163.     END RemoveTab;
  164.     PROCEDURE ParcExtent* (T: Texts.Text; beg: LONGINT; VAR end: LONGINT);
  165.         VAR R: Texts.Reader;
  166.     BEGIN Texts.OpenReader(R, T, beg + 1);
  167.         REPEAT Texts.ReadElem(R) UNTIL R.eot OR (R.elem IS TextFrames.Parc);
  168.         IF R.eot THEN end := T.len ELSE end := Texts.Pos(R) - 1 END
  169.     END ParcExtent;
  170.     PROCEDURE ChangedParc* (P: TextFrames.Parc; beg: LONGINT);
  171.         VAR T: Texts.Text; end: LONGINT;
  172.     BEGIN T := Texts.ElemBase(P); ParcExtent(T, beg, end); Texts.ChangeLooks(T, beg, end, {}, NIL, 0, 0)
  173.     END ChangedParc;
  174.     PROCEDURE LoadParc* (P: TextFrames.Parc; VAR r: Files.Rider);
  175.         VAR version, i, j, k: LONGINT;
  176.     BEGIN Files.ReadNum(r, version);    (*version 1*)
  177.         Files.ReadNum(r, P.first); Files.ReadNum(r, P.left); Files.ReadNum(r, P.width);
  178.         Files.ReadNum(r, P.lead); Files.ReadNum(r, P.lsp); Files.ReadNum(r, P.dsr);
  179.         RdSet(r, P.opts); Files.ReadNum(r, i);
  180.         IF i <= TextFrames.MaxTabs THEN P.nofTabs := SHORT(i) ELSE P.nofTabs := TextFrames.MaxTabs END;
  181.         j := 0; WHILE j < P.nofTabs DO Files.ReadNum(r, P.tab[j]); INC(j) END;
  182.         WHILE j < i DO Files.ReadNum(r, k); INC(j) END;
  183.     END LoadParc;
  184.     PROCEDURE StoreParc* (P: TextFrames.Parc; VAR r: Files.Rider);
  185.         VAR i: INTEGER;
  186.     BEGIN Files.WriteNum(r, 1);    (*version 1*)
  187.         Files.WriteNum(r, P.first); Files.WriteNum(r, P.left); Files.WriteNum(r, P.width);
  188.         Files.WriteNum(r, P.lead); Files.WriteNum(r, P.lsp); Files.WriteNum(r, P.dsr);
  189.         WrtSet(r, P.opts); Files.WriteNum(r, P.nofTabs); i := 0;
  190.         WHILE i < P.nofTabs DO Files.WriteNum(r, P.tab[i]); INC(i) END
  191.     END StoreParc;
  192.     PROCEDURE CopyParc* (SP, DP: TextFrames.Parc);
  193.         VAR i: INTEGER;
  194.     BEGIN Texts.CopyElem(SP, DP);
  195.         DP.first := SP.first; DP.left := SP.left; DP.width := SP.width;
  196.         DP.lead := SP.lead; DP.lsp := SP.lsp; DP.dsr := SP.dsr;
  197.         DP.opts := SP.opts; DP.nofTabs := SP.nofTabs; i := SP.nofTabs;
  198.         WHILE i > 0 DO DEC(i); DP.tab[i] := SP.tab[i] END
  199.     END CopyParc;
  200.     PROCEDURE Prepare* (P: TextFrames.Parc; indent, unit: LONGINT);
  201.     BEGIN P.W := 9999 * unit; P.H := ParcHeight + P.lead;
  202.         IF gridAdj IN P.opts THEN INC(P.H, (-P.lead) MOD P.lsp) END
  203.     END Prepare;
  204.     PROCEDURE Draw* (P: TextFrames.Parc; F: Display.Frame; col: SHORTINT; x0, y0: INTEGER);
  205.         VAR i, x1, px, w, w0, n: INTEGER;
  206.     BEGIN x1 := x0 + SHORT(P.left DIV unit);
  207.         w := SHORT(P.width DIV unit);  (* width of parc *)
  208.         w0 := SHORT((P.W - P.left) DIV unit); (* width of visible part of parc *)
  209.         IF twoColumns IN P.opts THEN n := 2 ELSE n := 1 END;
  210.         WHILE n > 0 DO DEC(n);
  211.             IF w > 20 THEN i := 0;
  212.                 LOOP
  213.                     IF i = P.nofTabs THEN EXIT END;
  214.                     px := SHORT(x1 + P.tab[i] DIV unit);
  215.                     IF px > x1 + w THEN EXIT END;
  216.                     TabMark(col, px, y0); INC(i)
  217.                 END;
  218.                 IF pageBreak IN P.opts THEN Display.ReplConst(col, x1, y0 + SepH, w0, 1, replace)
  219.                 ELSE Display.ReplPatternC(F, col, Display.grey1, x1, y0 + SepH, w0, 1, x1, y0 + SepH, replace)
  220.                 END;
  221.                 Display.ReplPatternC(F, col, Display.grey1, x1, y0+SepH-MargH+1, MargW, MargH, x1, y0+SepH-MargH+1, replace);
  222.                 Display.ReplPatternC(F, col, Display.grey1, x1+w-MargW, y0+SepH-MargH+1, MargW, MargH, x1+w-MargW, y0+SepH-MargH+1, replace);
  223.                 IF ~(leftAdj IN P.opts) THEN
  224.                     Display.ReplConstC(F, black, x1+1, y0+SepH-MargH+2, MargW-2, MargH-2, replace);
  225.                 END;
  226.                 IF ~(rightAdj IN P.opts) THEN
  227.                     Display.ReplConstC(F, black, x1+w-MargW+1, y0+SepH-MargH+2, MargW-2, MargH-2, replace);
  228.                 END;
  229.                 FirstMark(col, x0 + SHORT((P.left + P.first) DIV unit), y0);
  230.                 WITH F: TextFrames.Frame DO    (*recalc base measures for second column*)
  231.                     x0 := SHORT(Max( x1 + w + ColumnGap DIV unit, x0 + (F.W - F.left - F.right + ColumnGap DIV unit) DIV 2 ));
  232.                     x1 := x0 + SHORT(P.left DIV unit);
  233.                     w := SHORT(Min( (F.X + F.W - F.right) - x1, (P.W - P.left) DIV unit ))
  234.                 END
  235.             END
  236.         END
  237.     END Draw;
  238.     PROCEDURE Edit* (P: TextFrames.Parc; F: TextFrames.Frame; pos: LONGINT; x0, y0, x, y : INTEGER; keysum: SET);
  239.         CONST MargGravity = 3;
  240.         VAR keys: SET; old, rx: LONGINT; i, x1, dw, dh, dx, w, w0: INTEGER; changed, new: BOOLEAN;
  241.     BEGIN
  242.         IF (middleKey IN keysum) & F.showsParcs THEN changed := FALSE;
  243.             x1 := x0 + SHORT(P.left DIV unit); (* left end of separation line *)
  244.             w := SHORT(P.width DIV unit); (* width of separation line *)
  245.             w0 := SHORT((P.W - P.left) DIV unit); (* width of visible part of separation line *)
  246.             dh := y - y0; dw := x - x1;
  247.             Oberon.RemoveMarks(x0, y0, SHORT(P.W DIV unit), SHORT(P.H DIV unit));
  248.             IF (dh <= SepH) & (dw >= -MargGravity) & (dw <= MargW+MargGravity) THEN (* left margin handle *)
  249.                 old := P.left; rx := P.left + LONG(w0)*unit(*P.width*) - 10*mm;
  250.                 REPEAT TrackMouse(x, y, keys, keysum); MoveLeft(P, rx, x0, y0, (x - x0) - dw) UNTIL keys = {};
  251.                 IF keysum = {middleKey} THEN DEC(P.width, P.left - old); changed := TRUE
  252.                 ELSE FlipLeft(P, x0, y0); P.left := old; FlipLeft(P, x0, y0);
  253.                 END
  254.             ELSIF (dh <= SepH) & (dw >=  w-MargW-MargGravity) & (dw <= w+MargGravity) THEN (* right margin handle *)
  255.                 old := P.width;
  256.                 rx := LONG(F.W - F.left - F.right) * unit; dx := dw - SHORT(P.width DIV unit);
  257.                 REPEAT TrackMouse(x, y, keys, keysum); MoveRight(P, rx, x0, y0, (x - x0) - dx) UNTIL keys = {};
  258.                 IF keysum = {middleKey} THEN changed := TRUE
  259.                 ELSE FlipRight(P, x0, y0); P.width := old; FlipRight(P, x0, y0);
  260.                 END;
  261.             ELSIF (dw >= 0) & (dh <= SepH) THEN (* below separation line *)
  262.                 IF dw > 0 THEN changed := TRUE; GrabTab(P, x1, y0, x - x1, i, new); old := P.tab[i];
  263.                     (*rx := P.width - MinTabDelta (*LONG(F.W - F.left - F.right) * unit - P.left*) ;*)
  264.                     rx := P.left + LONG(w0)*unit - MinTabDelta;
  265.                     REPEAT TrackMouse(x, y, keys, keysum); MoveTab(P, rx, i, x1, y0, (x - x1)) UNTIL keys = {};
  266.                     IF keysum = {middleKey} THEN FlipTab(P, i, x1, y0)
  267.                     ELSIF keysum = {middleKey, rightKey} THEN FlipTab(P, i, x1, y0); rx := P.tab[i] - old;
  268.                         WHILE i < P.nofTabs-1 DO INC(i); INC(P.tab[i], rx) END
  269.                     ELSIF new OR (keysum = {middleKey, leftKey}) THEN RemoveTab(P, i)
  270.                     ELSE changed := FALSE; FlipTab(P, i, x1, y0); P.tab[i] := old; FlipTab(P, i, x1, y0)
  271.                     END
  272.                 END
  273.             ELSIF dh > SepH THEN (* above separation line *)
  274.                 IF (P.first DIV unit <= dw) & (dw < P.first DIV unit + 5) THEN (* first mark *)
  275.                     old := P.first;
  276.                     REPEAT TrackMouse(x, y, keys, keysum); MoveFirst(P, x0, y0, (x - x1) - 4) UNTIL keys = {};
  277.                     IF keysum # cancel THEN changed := TRUE;
  278.                     ELSE FlipFirst(P, x0, y0); P.first := old; FlipFirst(P, x0, y0);
  279.                     END;
  280.                 ELSE (* toggle adjust marks *)
  281.                     IF dw < w0 DIV 2 THEN Display.ReplConst(white, x1, y0+SepH+1, w0 DIV 2, 4, invert)
  282.                     ELSE Display.ReplConst(white, x1 + w0 DIV 2, y0+SepH+1, w0 DIV 2, 4, invert)
  283.                     END;
  284.                     REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {};
  285.                     IF dw < w0 DIV 2 THEN Display.ReplConst(white, x1, y0+SepH+1, w0 DIV 2, 4, invert)
  286.                     ELSE Display.ReplConst(white, x1 + w0 DIV 2, y0+SepH+1, w0 DIV 2, 4, invert)
  287.                     END;
  288.                     IF keysum = {middleKey} THEN
  289.                         IF dw < w0 DIV 2 THEN P.opts := P.opts / {leftAdj}; changed := TRUE;
  290.                         ELSE P.opts := P.opts / {rightAdj}; changed := TRUE;
  291.                         END
  292.                     END
  293.                 END
  294.             END;
  295.             IF P.left + P.first < 0 THEN P.first := -P.left; changed := TRUE
  296.             ELSIF P.first > P.width-MinTabDelta THEN P.first := P.width-MinTabDelta; changed := TRUE
  297.             END;
  298.             IF changed THEN ChangedParc(P, pos) END
  299.         END
  300.     END Edit;
  301.     PROCEDURE SetAttr* (P: TextFrames.Parc; F: TextFrames.Frame; pos: LONGINT;
  302.                                     VAR S: Texts.Scanner; log: Texts.Text);
  303.         VAR fnt: Fonts.Font; def, pt, lsp, dsr, new: LONGINT; changed: BOOLEAN;
  304.         PROCEDURE SetMeasure (new: LONGINT; VAR old: LONGINT);
  305.         BEGIN
  306.             IF new # old THEN old := new; ChangedParc(P, pos) END
  307.         END SetMeasure;
  308.         PROCEDURE SetOpts (opts: SET);
  309.         BEGIN
  310.             IF P.opts #opts THEN P.opts := opts; ChangedParc(P, pos) END
  311.         END SetOpts;
  312.         PROCEDURE Err (s: ARRAY OF CHAR; n: INTEGER);
  313.         BEGIN Str("Set "); Str(s); Str(" failed (bad ");
  314.             CASE n OF
  315.                 0: Str("number)")
  316.             |  1: Str("indentation)")
  317.             |  2: Str("option)")
  318.             |  3: Str("selector)")
  319.             END;
  320.             Ln;
  321.         END Err;
  322.     BEGIN
  323.         changed := FALSE;
  324.         IF Matches(S, "LEAD") THEN def := TextFrames.defParc.lead DIV Scale;
  325.             GetNextInt(S, new, 0, 10000, def);
  326.             IF S.class = Texts.Int THEN SetMeasure(new, P.lead)
  327.             ELSIF S.class = Texts.Name THEN fnt := Fonts.This(S.s);
  328.                 lsp := Max(fnt.height, fnt.maxY - fnt.minY) * unit; INC(lsp, (-lsp) MOD Scale);
  329.                 SetMeasure(lsp, P.lead)
  330.             ELSE Err("lead", 0)
  331.             END
  332.         ELSIF Matches(S, "LINE") THEN def := TextFrames.defParc.lsp DIV Scale;
  333.             GetNextInt(S, new, 10,10000, def);
  334.             IF S.class = Texts.Int THEN lsp := new; dsr := lsp DIV 4; INC(dsr, (-dsr) MOD Scale)
  335.             ELSIF S.class = Texts.Name THEN fnt := Fonts.This(S.s);
  336.                 lsp := Max(fnt.height, fnt.maxY - fnt.minY) * unit; INC(lsp, (-lsp) MOD Scale);
  337.                 dsr := LONG(-fnt.minY) * unit; INC(dsr, (-dsr) MOD Scale)
  338.             ELSE Err("line", 0); lsp := P.lsp; dsr := P.dsr
  339.             END;
  340.             IF (P.lsp # lsp) OR (P.dsr # dsr) THEN P.lsp := lsp; P.dsr := dsr; changed := TRUE END
  341.         ELSIF Matches(S, "FIRST") THEN def := TextFrames.defParc.first DIV Scale;
  342.             GetNextInt(S, new, -10000, 10000, def);
  343.             IF S.class = Texts.Int THEN
  344.                 IF (0 <= P.left + new) & (new <= P.width-MinTabDelta) THEN SetMeasure(new, P.first)
  345.                 ELSE Err("first", 1)
  346.                 END
  347.             ELSE Err("first", 0)
  348.             END
  349.         ELSIF Matches(S, "LEFT") THEN def := TextFrames.defParc.left DIV Scale;
  350.             GetNextInt(S, new, 0, 10000, def);
  351.             IF S.class = Texts.Int THEN
  352.                 IF (0 <= new) & (new <= P.left + P.width - 10*mm) THEN
  353.                     IF new # P.left THEN
  354.                         INC(P.width, P.left - new); P.left := new;
  355.                         IF P.left + P.first < 0 THEN P.first := -P.left END;
  356.                         changed := TRUE;
  357.                     END;
  358.                 ELSE Err("left", 0)
  359.                 END
  360.             ELSE Err("left", 0)
  361.             END
  362.         ELSIF Matches(S, "RIGHT") THEN def := (TextFrames.defParc.left + TextFrames.defParc.width) DIV Scale;
  363.             GetNextInt(S, new, 0, 10000, def);
  364.             IF S.class = Texts.Int THEN
  365.                 IF P.left + 10*mm <= new THEN
  366.                     IF new - P.left # P.width THEN P.width := new - P.left;
  367.                         IF P.first > P.width-MinTabDelta THEN P.first := P.width-MinTabDelta END;
  368.                         changed := TRUE;
  369.                     END
  370.                 ELSE Err("right", 0)
  371.                 END
  372.             ELSE Err("right", 0)
  373.             END
  374.         ELSIF Matches(S, "WIDTH") THEN def := TextFrames.defParc.width DIV Scale;
  375.             GetNextInt(S, new, 100, 10000, def);
  376.             IF S.class = Texts.Int THEN
  377.                 IF new # P.width THEN P.width := new;
  378.                     IF P.first > P.width-MinTabDelta THEN P.first := P.width-MinTabDelta END;
  379.                     changed := TRUE;
  380.                 END
  381.             ELSE Err("width", 0)
  382.             END
  383.         ELSIF Matches(S, "GRID") THEN Texts.Scan(S);
  384.             IF Matches(S, "ON") THEN SetOpts(P.opts + {gridAdj})
  385.             ELSIF Matches(S, "OFF") THEN SetOpts(P.opts - {gridAdj})
  386.             ELSE Err("grid", 2)
  387.             END
  388.         ELSIF Matches(S, "ADJUST") THEN Texts.Scan(S);
  389.             IF Matches(S, "LEFT") THEN SetOpts(P.opts - AdjMask + {leftAdj})
  390.             ELSIF Matches(S, "RIGHT") THEN SetOpts(P.opts - AdjMask + {rightAdj})
  391.             ELSIF Matches(S, "CENTER") THEN SetOpts(P.opts - AdjMask)
  392.             ELSIF Matches(S, "BLOCK") THEN SetOpts(P.opts + AdjMask)
  393.             ELSE Err("adjust", 2)
  394.             END
  395.         ELSIF Matches(S, "BREAK") THEN Texts.Scan(S);
  396.             IF Matches(S, "BEFORE") THEN SetOpts(P.opts + {pageBreak})
  397.             ELSIF Matches(S, "NORMAL") THEN SetOpts(P.opts - {pageBreak})
  398.             ELSE Err("break", 2)
  399.             END
  400.         ELSIF Matches(S, "COLUMNS") THEN GetNextInt(S, new, 1, 3, 1);
  401.             IF S.class = Texts.Int THEN
  402.                 IF S.i = 1 THEN
  403.                     IF twoColumns IN P.opts THEN
  404.                         P.opts := P.opts - {twoColumns}; P.width := P.width * 2 + ColumnGap; ChangedParc(P, pos)
  405.                     END
  406.                 ELSE
  407.                     IF ~(twoColumns IN P.opts) THEN
  408.                         P.opts := P.opts + {twoColumns}; P.width := (P.width - ColumnGap) DIV 2; ChangedParc(P, pos)
  409.                     END
  410.                 END
  411.             ELSE Err("left", 0)
  412.             END
  413.         ELSIF Matches(S, "TABS") THEN
  414.             IF P.nofTabs # 0 THEN changed := TRUE END;
  415.             Texts.Scan(S); P.nofTabs := 0; pt := 0;
  416.             IF (S.class = Texts.Char) & (S.c = "*") THEN Texts.Scan(S);
  417.                 IF (S.class = Texts.Int) & (S.i * Scale >= MinTabDelta) THEN
  418.                     changed := TRUE;
  419.                     WHILE (P.nofTabs < TextFrames.MaxTabs) & (pt < 3000) DO
  420.                         INC(pt, S.i); P.tab[P.nofTabs] := pt * Scale; INC(P.nofTabs)
  421.                     END
  422.                 END
  423.             ELSE
  424.                 WHILE (S.class = Texts.Int) & (S.i * Scale >= pt * Scale + MinTabDelta)
  425.                 & (P.nofTabs < TextFrames.MaxTabs) DO changed := TRUE;
  426.                     pt := S.i; P.tab[P.nofTabs] := pt * Scale; INC(P.nofTabs); Texts.Scan(S)
  427.                 END
  428.             END;
  429.         ELSE Str(S.s); Int(S.i); Err("", 3);
  430.         END;
  431.         IF changed THEN ChangedParc(P, pos) END;
  432.         IF W.buf.len # 0 THEN Texts.Append(log, W.buf) END;
  433.     END SetAttr;
  434.     PROCEDURE GetAttr* (P: TextFrames.Parc; F: TextFrames.Frame; VAR S: Texts.Scanner; log: Texts.Text);
  435.         VAR n: INTEGER;
  436.         PROCEDURE Out (n: INTEGER);
  437.             VAR i: INTEGER; d: LONGINT;
  438.         BEGIN
  439.             CASE n OF
  440.                 0: Str("lead"); Int(P.lead DIV Scale)
  441.             |  1: Str("line"); Int(P.lsp DIV Scale)
  442.             |  2: Str("left"); Int(P.left DIV Scale)
  443.             |  3: Str("first"); Int(P.first DIV Scale)
  444.             |  4: Str("width"); Int(P.width DIV Scale)
  445.             |  5: Str("right"); Int((P.left + P.width) DIV Scale)
  446.             |  6: IF gridAdj IN P.opts THEN Str("grid on") ELSE Str("grid off") END
  447.             |  7: IF leftAdj IN P.opts THEN
  448.                         IF rightAdj IN P.opts THEN Str("adjust block") ELSE Str("adjust left") END
  449.                     ELSIF rightAdj IN P.opts THEN Str("adjust right")
  450.                     ELSE Str("adjust center")
  451.                     END
  452.             |  8: IF pageBreak IN P.opts THEN Str("break before") ELSE Str("break normal") END
  453.             |  9: IF twoColumns IN P.opts THEN Str("columns 2") ELSE Str("columns 1") END
  454.             | 10: Str("tabs"); i := 0;
  455.                     IF P.nofTabs > 0 THEN d := P.tab[0]; i := 1;
  456.                         WHILE (i < P.nofTabs) & (P.tab[i] - P.tab[i - 1] = d) DO INC(i) END
  457.                     END;
  458.                     IF (P.nofTabs > 1) & (i = P.nofTabs) & (P.tab[i - 1] + MinTabDelta > P.width) THEN
  459.                         Str(" *"); Int(d DIV Scale)
  460.                     ELSE i := 0;
  461.                         WHILE i < P.nofTabs DO Int(P.tab[i] DIV Scale); INC(i) END;
  462.                         Str(" ~")
  463.                     END
  464.             END
  465.         END Out;
  466.     BEGIN
  467.         IF S.class # Texts.Name THEN Out(0); n := 1;
  468.             REPEAT Ln; Out(n); INC(n) UNTIL n = 11;
  469.             Ln;
  470.         ELSIF Matches(S, "LEAD") THEN Out(0)
  471.         ELSIF Matches(S, "LINE") THEN Out(1)
  472.         ELSIF Matches(S, "LEFT") THEN Out(2)
  473.         ELSIF Matches(S, "FIRST") THEN Out(3)
  474.         ELSIF Matches(S, "WIDTH") THEN Out(4)
  475.         ELSIF Matches(S, "RIGHT") THEN Out(5)
  476.         ELSIF Matches(S, "GRID") THEN Out(6)
  477.         ELSIF Matches(S, "ADJUST") THEN Out(7)
  478.         ELSIF Matches(S, "BREAK") THEN Out(8)
  479.         ELSIF Matches(S, "COLUMNS") THEN Out(9)
  480.         ELSIF Matches(S, "TABS") THEN Out(10)
  481.         ELSE Str("failed (bad selector)")
  482.         END;
  483.         Texts.Append(log, W.buf)
  484.     END GetAttr;
  485.     PROCEDURE Handle* (E: Texts.Elem; VAR msg: Texts.ElemMsg);
  486.         VAR e: TextFrames.Parc;
  487.     BEGIN
  488.         WITH E: TextFrames.Parc DO
  489.             IF msg IS TextFrames.DisplayMsg THEN
  490.                 WITH msg: TextFrames.DisplayMsg DO
  491.                     IF msg.prepare THEN Prepare(E, msg.indent, unit)
  492.                     ELSE Draw(E, msg.frame, msg.col, msg.X0, msg.Y0)
  493.                     END
  494.                 END
  495.             ELSIF msg IS TextPrinter.PrintMsg THEN
  496.                 WITH msg: TextPrinter.PrintMsg DO
  497.                     IF msg.prepare THEN Prepare(E, msg.indent, Unit) END
  498.                 END
  499.             ELSIF msg IS Texts.CopyMsg THEN NEW(e); CopyParc(E, e); msg(Texts.CopyMsg).e := e
  500.             ELSIF msg IS TextFrames.TrackMsg THEN
  501.                 WITH msg: TextFrames.TrackMsg DO
  502.                     Edit(E, msg.frame(TextFrames.Frame), msg.pos, msg.X0, msg.Y0, msg.X, msg.Y, msg.keys)
  503.                 END
  504.             ELSIF msg IS Texts.IdentifyMsg THEN
  505.                 WITH msg: Texts.IdentifyMsg DO msg.mod := "ParcElems"; msg.proc := "Alloc" END
  506.             ELSIF msg IS Texts.FileMsg THEN
  507.                 WITH msg: Texts.FileMsg DO
  508.                     IF msg.id = Texts.load THEN LoadParc(E, msg.r)
  509.                     ELSIF msg.id = Texts.store THEN StoreParc(E, msg.r)
  510.                     END
  511.                 END
  512.             ELSIF msg IS StateMsg THEN
  513.                 WITH msg: StateMsg DO
  514.                     IF msg.id = set THEN SetAttr(E, msg.frame, msg.pos, msg.par, msg.log)
  515.                     ELSIF msg.id = get THEN GetAttr(E, msg.frame, msg.par, msg.log)
  516.                     END
  517.                 END
  518.             END
  519.         END
  520.     END Handle;
  521.     PROCEDURE Alloc*;
  522.         VAR e: TextFrames.Parc;
  523.     BEGIN NEW(e); e.handle := Handle; Texts.new := e
  524.     END Alloc;
  525.     PROCEDURE InitDefParc (VAR def: TextFrames.Parc);
  526.         VAR (*w,*) h, lsp, dsr: LONGINT; i: INTEGER;
  527.     BEGIN
  528.         lsp := Max(Fonts.Default.height, Fonts.Default.maxY - Fonts.Default.minY) * unit;
  529.         dsr := LONG(-Fonts.Default.minY) * unit;
  530.         NEW(def); def.W := 99; def.H := ParcHeight; def.handle := Handle;
  531.         def.first := 0; def.left := 0; (*def.width := 165*mm;*)
  532.         (*w := ((Display.Width DIV 8 * 5) - TextFrames.left - TextFrames.right - 2) * LONG(unit);*)
  533.         def.width := 165*mm; (*Max(165*mm, w);*)
  534.         def.lead := 0; def.lsp := lsp + (-lsp) MOD Scale; def.dsr := dsr + (-dsr) MOD Scale;
  535.         def.opts := {leftAdj}; def.nofTabs := 0
  536.     END InitDefParc;
  537.     PROCEDURE InitPatterns;
  538.     BEGIN
  539.         TabMarkImage[1] := {0..4}; TabMarkImage[2] := {0..3}; TabMarkImage[3] := {0..2};
  540.         TabMarkImage[4] := {0, 1}; TabMarkImage[5] := {0};
  541.         TabPat := Display.NewPattern(TabMarkImage, 32, 5);
  542.     END InitPatterns;
  543. BEGIN Texts.OpenWriter(W); InitDefParc(TextFrames.defParc); InitPatterns; white := Display.white
  544. END ParcElems.
  545.