home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / parcelems.mod (.txt) < prev    next >
Oberon Text  |  1994-10-17  |  23KB  |  515 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. MODULE ParcElems;    (** CAS/MH/HM 20.4.1993 **)
  5.     IMPORT
  6.         SYSTEM, Input, Display, Files, Oberon, Fonts, Texts, TextFrames, TextPrinter;
  7.     CONST
  8.         (**StateMsg.id*)
  9.             set* = 0; get* = 1;
  10.         mm = TextFrames.mm; unit = TextFrames.Unit; Unit = TextPrinter.Unit;
  11.         Scale = mm DIV 10; MinTabDelta = 5*mm; ParcHeight = 3*mm; ColumnGap = 7*mm;
  12.         gridAdj = TextFrames.gridAdj; leftAdj = TextFrames.leftAdj; rightAdj = TextFrames.rightAdj;
  13.         pageBreak = TextFrames.pageBreak;
  14.         twoColumns = TextFrames.twoColumns;
  15.         AdjMask = {leftAdj, rightAdj};
  16.         rightKey = 0; middleKey = 1; leftKey = 2; cancel = {rightKey, middleKey, leftKey};
  17.         black = Display.black; white = Display.white;
  18.         SepH = 5;
  19.         MargW = 5; MargH = 5;
  20.     TYPE
  21.         StateMsg* = RECORD (Texts.ElemMsg)
  22.             id*: INTEGER;
  23.             pos*: LONGINT;
  24.             frame*: TextFrames.Frame;
  25.             par*: Texts.Scanner;
  26.             log*: Texts.Text
  27.         END;
  28.         W: Texts.Writer;
  29.         TabMarkImage: ARRAY 6 OF SET;
  30.         TabPat: LONGINT;
  31.     PROCEDURE RdSet (VAR r: Files.Rider; VAR s: SET);
  32.     BEGIN Files.ReadNum(r, SYSTEM.VAL(LONGINT, s))
  33.     END RdSet;
  34.     PROCEDURE WrtSet (VAR r: Files.Rider; s: SET);
  35.     BEGIN Files.WriteNum(r, SYSTEM.VAL(LONGINT, s))
  36.     END WrtSet;
  37.     PROCEDURE Str (s: ARRAY OF CHAR);
  38.     BEGIN Texts.WriteString(W, s)
  39.     END Str;
  40.     PROCEDURE Int (n: LONGINT);
  41.     BEGIN Texts.Write(W, " "); Texts.WriteInt(W, n, 0)
  42.     END Int;
  43.     PROCEDURE Ln;
  44.     BEGIN Texts.WriteLn(W)
  45.     END Ln;
  46.     PROCEDURE Min (x, y: LONGINT): LONGINT;
  47.     BEGIN
  48.         IF x < y THEN RETURN x ELSE RETURN y END
  49.     END Min;
  50.     PROCEDURE Max (x, y: LONGINT): LONGINT;
  51.     BEGIN
  52.         IF x > y THEN RETURN x ELSE RETURN y END
  53.     END Max;
  54.     PROCEDURE Matches (VAR S: Texts.Scanner; key: ARRAY OF CHAR): BOOLEAN;
  55.         VAR i: INTEGER;
  56.     BEGIN i := 0;
  57.         WHILE (S.s[i] # 0X) & (CAP(S.s[i]) = key[i]) DO INC(i) END;
  58.         RETURN (S.class = Texts.Name) & ((key[i] = 0X) OR (i >= 3)) & (S.s[i] = 0X)
  59.     END Matches;
  60.     PROCEDURE GetNextInt (VAR S: Texts.Scanner; lo, hi, def: LONGINT);    (*constrained int w/ default*)
  61.     BEGIN Texts.Scan(S);
  62.         IF Matches(S, "DEFAULT") THEN S.class := Texts.Int; S.i := def
  63.         ELSIF S.class = Texts.Int THEN
  64.             IF (S.i < lo) OR (S.i >= hi) THEN S.i := def END
  65.         END
  66.     END GetNextInt;
  67.     PROCEDURE Grid (x: LONGINT): LONGINT;
  68.     BEGIN RETURN x + (-x) MOD (1 * mm)
  69.     END Grid;
  70.     PROCEDURE DrawCursor (x, y: INTEGER);
  71.     BEGIN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  72.     END DrawCursor;
  73.     PROCEDURE TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET);
  74.     BEGIN Input.Mouse(keys, x, y); DrawCursor(x, y); keysum := keysum + keys
  75.     END TrackMouse;
  76.     PROCEDURE FirstMark (col: SHORTINT; x, y0: INTEGER);
  77.     BEGIN Display.ReplConst(col, x, y0 + SepH+1, 2, 5, Display.paint)
  78.     END FirstMark;
  79.     PROCEDURE FlipFirst (P: TextFrames.Parc; x0, y0: INTEGER);
  80.     BEGIN Display.ReplConst(white, x0 + SHORT((P.left + P.first) DIV unit), y0 + SepH+1, 2, 5, Display.invert)
  81.     END FlipFirst;
  82.     PROCEDURE MoveFirst (P: TextFrames.Parc; x0, y0, dw: INTEGER);
  83.         VAR px: LONGINT;
  84.     BEGIN px := Grid(LONG(dw) * unit);
  85.         px := Max(px, -P.left); px := Min(px, P.width);
  86.         IF px # P.first THEN FlipFirst(P, x0, y0); P.first := px; FlipFirst(P, x0, y0) END
  87.     END MoveFirst;
  88.     PROCEDURE FlipLeft (P: TextFrames.Parc; x0, y0: INTEGER);
  89.     BEGIN Display.ReplConst(white, x0 + SHORT(P.left DIV unit), y0+SepH-MargH+1, MargW, MargH, Display.invert)
  90.     END FlipLeft;
  91.     PROCEDURE MoveLeft (P: TextFrames.Parc; rm: LONGINT; x0, y0, dw: INTEGER);
  92.         VAR px: LONGINT;
  93.     BEGIN px := Grid(LONG(dw) * unit);
  94.         px := Max(px, 0); px := Min(px, rm);
  95.         IF px # P.left THEN FlipLeft(P, x0, y0); P.left := px; FlipLeft(P, x0, y0) END
  96.     END MoveLeft;
  97.     PROCEDURE FlipRight (P: TextFrames.Parc; x0, y0: INTEGER);
  98.     BEGIN Display.ReplConst(white, x0+SHORT((P.left + P.width) DIV unit) - MargW, y0+SepH-MargH+1, MargW, MargH, Display.invert)
  99.     END FlipRight;
  100.     PROCEDURE MoveRight (P: TextFrames.Parc; rm: LONGINT; x0, y0, dw: INTEGER);
  101.         VAR px: LONGINT;
  102.     BEGIN px := Grid(LONG(dw) * unit);
  103.         px := Max(px, P.left + 10*mm); px := Min(px, rm);
  104.         IF px # P.left + P.width THEN FlipRight(P, x0, y0); P.width := px - P.left; FlipRight(P, x0, y0) END
  105.     END MoveRight;
  106.     PROCEDURE TabMark (col: SHORTINT; x, y: INTEGER);
  107.     BEGIN Display.CopyPattern(col, TabPat, x, y, Display.replace)
  108.     END TabMark;
  109.     PROCEDURE FlipTab (P: TextFrames.Parc; i, x0, y0: INTEGER);
  110.     BEGIN Display.CopyPattern(white, TabPat, x0 + SHORT(P.tab[i] DIV unit), y0, Display.invert)
  111.     END FlipTab;
  112.     PROCEDURE GrabTab (P: TextFrames.Parc; x0, y0, dw: INTEGER; VAR i: INTEGER; VAR new: BOOLEAN);
  113.         CONST Gravity = 2*mm;
  114.         VAR j: INTEGER; lx, px, rx: LONGINT;
  115.     BEGIN
  116.         i := 0; j := P.nofTabs; new := FALSE; px := Grid(LONG(dw) * unit);
  117.         WHILE (i < j) & (P.tab[i] < px - Gravity) DO INC(i) END;
  118.         IF i < TextFrames.MaxTabs THEN
  119.             IF (i = j) OR (P.tab[i] >= px + Gravity) THEN
  120.                 IF i = 0 THEN lx := MinTabDelta ELSE lx := P.tab[i - 1] + MinTabDelta END;
  121.                 IF i = P.nofTabs THEN rx := P.width ELSE rx := P.tab[i] - MinTabDelta END;
  122.                 IF px < lx THEN px := lx END;
  123.                 IF px < rx THEN INC(P.nofTabs); new := TRUE;
  124.                     WHILE j > i DO P.tab[j] := P.tab[j - 1]; DEC(j) END
  125.                 END
  126.             ELSE px := P.tab[i]
  127.             END
  128.         ELSE DEC(i); px := P.tab[i]
  129.         END;
  130.         IF ~new THEN FlipTab(P, i, x0, y0) END;
  131.         P.tab[i] := px; FlipTab(P, i, x0, y0)
  132.     END GrabTab;
  133.     PROCEDURE MoveTab (P: TextFrames.Parc; rm: LONGINT; i, x0, y0, dw: INTEGER);
  134.         VAR lx, px, rx: LONGINT;
  135.     BEGIN px := Grid(LONG(dw) * unit);
  136.         IF i = 0 THEN lx := MinTabDelta ELSE lx := P.tab[i - 1] + MinTabDelta END;
  137.         IF i = P.nofTabs - 1 THEN rx := P.width ELSE rx := P.tab[i + 1] - MinTabDelta END;
  138.         px := Max(px, lx); px := Min(px, rx); px := Min(px, rm);
  139.         IF px # P.tab[i] THEN FlipTab(P, i, x0, y0); P.tab[i] := px; FlipTab(P, i, x0, y0) END
  140.     END MoveTab;
  141.     PROCEDURE RemoveTab (P: TextFrames.Parc; i: INTEGER);
  142.     BEGIN
  143.         WHILE i < P.nofTabs - 1 DO P.tab[i] := P.tab[i + 1]; INC(i) END;
  144.         DEC(P.nofTabs)
  145.     END RemoveTab;
  146.     PROCEDURE Changed (E: Texts.Elem; beg: LONGINT);
  147.         VAR T: Texts.Text;
  148.     BEGIN T := Texts.ElemBase(E); Texts.ChangeLooks(T, beg, beg+1, {}, NIL, 0, 0)
  149.     END Changed;
  150.     PROCEDURE ParcExtent* (T: Texts.Text; beg: LONGINT; VAR end: LONGINT);
  151.         VAR R: Texts.Reader;
  152.     BEGIN Texts.OpenReader(R, T, beg + 1);
  153.         REPEAT Texts.ReadElem(R) UNTIL R.eot OR (R.elem IS TextFrames.Parc);
  154.         IF R.eot THEN end := T.len ELSE end := Texts.Pos(R) - 1 END
  155.     END ParcExtent;
  156.     PROCEDURE ChangedParc* (P: TextFrames.Parc; beg: LONGINT);
  157.         VAR T: Texts.Text; end: LONGINT;
  158.     BEGIN T := Texts.ElemBase(P); ParcExtent(T, beg, end); Texts.ChangeLooks(T, beg, end, {}, NIL, 0, 0)
  159.     END ChangedParc;
  160.     PROCEDURE LoadParc* (P: TextFrames.Parc; VAR r: Files.Rider);
  161.         VAR version, i, j, k: LONGINT;
  162.     BEGIN Files.ReadNum(r, version);    (*version 1*)
  163.         Files.ReadNum(r, P.first); Files.ReadNum(r, P.left); Files.ReadNum(r, P.width);
  164.         Files.ReadNum(r, P.lead); Files.ReadNum(r, P.lsp); Files.ReadNum(r, P.dsr);
  165.         RdSet(r, P.opts); Files.ReadNum(r, i);
  166.         IF i <= TextFrames.MaxTabs THEN P.nofTabs := SHORT(i) ELSE P.nofTabs := TextFrames.MaxTabs END;
  167.         j := 0; WHILE j < P.nofTabs DO Files.ReadNum(r, P.tab[j]); INC(j) END;
  168.         WHILE j < i DO Files.ReadNum(r, k); INC(j) END;
  169.     END LoadParc;
  170.     PROCEDURE StoreParc* (P: TextFrames.Parc; VAR r: Files.Rider);
  171.         VAR i: INTEGER;
  172.     BEGIN Files.WriteNum(r, 1);    (*version 1*)
  173.         Files.WriteNum(r, P.first); Files.WriteNum(r, P.left); Files.WriteNum(r, P.width);
  174.         Files.WriteNum(r, P.lead); Files.WriteNum(r, P.lsp); Files.WriteNum(r, P.dsr);
  175.         WrtSet(r, P.opts); Files.WriteNum(r, P.nofTabs); i := 0;
  176.         WHILE i < P.nofTabs DO Files.WriteNum(r, P.tab[i]); INC(i) END
  177.     END StoreParc;
  178.     PROCEDURE CopyParc* (SP, DP: TextFrames.Parc);
  179.         VAR i: INTEGER;
  180.     BEGIN Texts.CopyElem(SP, DP);
  181.         DP.first := SP.first; DP.left := SP.left; DP.width := SP.width;
  182.         DP.lead := SP.lead; DP.lsp := SP.lsp; DP.dsr := SP.dsr;
  183.         DP.opts := SP.opts; DP.nofTabs := SP.nofTabs; i := SP.nofTabs;
  184.         WHILE i > 0 DO DEC(i); DP.tab[i] := SP.tab[i] END
  185.     END CopyParc;
  186.     PROCEDURE Prepare* (P: TextFrames.Parc; indent, unit: LONGINT);
  187.     BEGIN P.W := 9999 * unit; P.H := ParcHeight + P.lead;
  188.         IF gridAdj IN P.opts THEN INC(P.H, (-P.lead) MOD P.lsp) END
  189.     END Prepare;
  190.     PROCEDURE Draw* (P: TextFrames.Parc; F: Display.Frame; col: SHORTINT; x0, y0: INTEGER);
  191.         VAR i, x1, px, w, n: INTEGER;
  192.     B