home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / textpframes.mod (.txt) < prev    next >
Oberon Text  |  2012-04-20  |  53KB  |  1,097 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. Math12.Scn.Fnt
  5. Syntax12.Scn.Fnt
  6. MODULE TextPFrames;    (** CAS 18-Jun-92 / MH 23 May 1993 / JT 07.10.93  (Rel. 2.43) **)
  7.     IMPORT
  8.         Modules, Input, Display, Fonts, Viewers, Oberon, MenuViewers, Texts, TextFrames, TextPrinter;
  9.     CONST
  10.         mm = TextFrames.mm; Scale = mm DIV 10;
  11.         unit = TextFrames.Unit; Unit = TextPrinter.Unit;
  12.         gridAdj = 0;  leftAdj = 1;  rightAdj = 2;  pageBreak = 3;
  13.         AdjMask = {leftAdj, rightAdj};
  14.         TAB = 9X; LF = 0AX; CR = 0DX; DEL = 7FX; BRK = 0ACX; ShiftBRK = 0ADX; CRSL = 0C4X; CRSR = 0C3X;
  15.         AdjustSpan = 30; MinTabWidth = 1 * Scale; StdTabWidth = 4 * mm;
  16.         rightKey = 0; middleKey = 1; leftKey = 2; cancel = {rightKey, middleKey, leftKey};
  17.     TYPE
  18.         TextLine = POINTER TO TextLineDesc;
  19.         Location* = RECORD
  20.             org*, pos*: LONGINT;
  21.             x*, y*, dx*, dy*: INTEGER;
  22.             line: TextLine;
  23.             trunc: BOOLEAN
  24.         END;
  25.         TextLineDesc = RECORD
  26.             next: TextLine;
  27.             eot: BOOLEAN;    (*contains end of text; first line after page break*)
  28.             indent: LONGINT;    (* first line indentation in units *)
  29.             pno: INTEGER;    (*3 0: page number of page containing first line after page break*)
  30.             w, h, dsr: INTEGER;    (**bounding box clipped to frame*)
  31.             nob: INTEGER;    (*number of contained blanks; > 0 if text line wraps around*)
  32.             org, len, span: LONGINT;    (*len w/o; span w/ trailing CR or white space, if any*)
  33.             P: TextFrames.Parc;
  34.             pbeg: LONGINT
  35.         END;
  36.         Frame* = POINTER TO FrameDesc;
  37.         FrameDesc* = RECORD (TextFrames.FrameDesc)
  38.             CarLoc*, SelBeg*, SelEnd*: Location;
  39.             trailer: TextLine;    (*ring with trailer and header*)
  40.             pages, first, width: INTEGER;    (*nof pages; if > 0: no of first page, print body width in print units*)
  41.             porg: ARRAY 1024 OF LONGINT
  42.         END;
  43.         SelectMsg = RECORD (Display.FrameMsg)
  44.             text: Texts.Text;
  45.             beg, end: LONGINT;
  46.             time: LONGINT
  47.         END;
  48.         pfnt: Fonts.Font;
  49.         (*shared globals => get rid off in a later version?*)
  50.         W: Texts.Writer;
  51.         WL: Texts.Writer;
  52.         PB: Texts.Buffer;
  53.         B: Texts.Buffer;
  54.         P: TextFrames.Parc;
  55.         pbeg: LONGINT;    (*inv Pos(P) = pbeg*)
  56.         R: Texts.Reader;
  57.         nextCh: CHAR;    (*inv Base(R) = T => T[Pos(R)-1] = nextCh]*)
  58.     PROCEDURE Min (x, y: INTEGER): INTEGER;
  59.     BEGIN
  60.         IF x < y THEN RETURN x ELSE RETURN y END
  61.     END Min;
  62.     PROCEDURE Max (x, y: INTEGER): INTEGER;
  63.     BEGIN
  64.         IF x > y THEN RETURN x ELSE RETURN y END
  65.     END Max;
  66.     PROCEDURE PU (x: INTEGER): INTEGER;    (*screen to printer space*)
  67.     BEGIN RETURN SHORT((x * LONG(unit) + Unit DIV 2) DIV Unit)
  68.     END PU;
  69.     PROCEDURE SU (x: INTEGER): INTEGER;    (*printer to screen space*)
  70.     BEGIN RETURN SHORT((x * LONG(Unit) + unit DIV 2) DIV unit)
  71.     END SU;
  72.     PROCEDURE MarkMenu (F: Frame);
  73.         VAR R: Texts.Reader; V: Viewers.Viewer; T: Texts.Text; ch: CHAR;
  74.     BEGIN V := Viewers.This(F.X, F.Y);
  75.         IF (V IS MenuViewers.Viewer) & (V.dsc IS TextFrames.Frame) THEN
  76.             T := V.dsc(TextFrames.Frame).text;
  77.             IF T.len > 0 THEN Texts.OpenReader(R, T, T.len - 1); Texts.Read(R, ch) ELSE ch := 0X END;
  78.             IF ch # "!" THEN Texts.Write(WL, "!"); Texts.Append(T, WL.buf) END
  79.         END
  80.     END MarkMenu;
  81.     (* Element Subframes *)
  82.     PROCEDURE InvertBorder (F: Display.Frame);
  83.     BEGIN
  84.         Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y-1, F.W+2, 1, Display.invert);
  85.         Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y+F.H, F.W+2, 1, Display.invert);
  86.         Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y, 1, F.H, Display.invert);
  87.         Display.ReplPattern(Display.white, Display.grey1, F.X+F.W, F.Y, 1, F.H, Display.invert)
  88.     END InvertBorder;
  89.     PROCEDURE InvalSubFrames (F: Frame; x, y, w, h: INTEGER);
  90.         VAR p, f: Display.Frame; msg: MenuViewers.ModifyMsg;
  91.     BEGIN
  92.         IF (w > 0) & (h > 0) THEN f := F.dsc;
  93.             IF f # NIL THEN p := f; f := p.next END;
  94.             WHILE f # NIL DO
  95.                 IF (f.X < x + w) & (f.X + f.W > x) & (f.Y < y + h) & (f.Y + f.H > y) THEN p.next := f.next;
  96.                     msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := 0;
  97.                     f.handle(f, msg)
  98.                 ELSE p := f
  99.                 END;
  100.                 f := p.next
  101.             END;
  102.             f := F.dsc;
  103.             IF (f # NIL) & (f.X < x + w) & (f.X + f.W > x) & (f.Y < y + h) & (f.Y + f.H > y) THEN F.dsc := F.dsc.next;
  104.                 msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := 0;
  105.                 f.handle(f, msg)
  106.             END
  107.         END
  108.     END InvalSubFrames;
  109.     PROCEDURE ShiftSubFrames (F: Frame; oldY, newY, h: INTEGER);
  110.         VAR f: Display.Frame; msg: MenuViewers.ModifyMsg;
  111.     BEGIN
  112.         IF oldY > newY THEN InvalSubFrames(F, F.X, newY, F.W, oldY - newY)
  113.         ELSE InvalSubFrames(F, F.X, oldY + h, F.W, newY - oldY)
  114.         END;
  115.         f := F.dsc;
  116.         WHILE f # NIL DO
  117.             IF (f.Y < oldY + h) & (f.Y + f.H > oldY) THEN INC(f.Y, newY - oldY);
  118.                 msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := f.H;
  119.                 f.handle(f, msg)
  120.             END;
  121.             f := f.next
  122.         END
  123.     END ShiftSubFrames;
  124.     (* Display Primitives *)
  125.     PROCEDURE DrawCursor (x, y: INTEGER);
  126.     BEGIN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  127.     END DrawCursor;
  128.     PROCEDURE TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET);
  129.     BEGIN Input.Mouse(keys, x, y); keysum := keysum + keys; DrawCursor(x, y)
  130.     END TrackMouse;
  131.     PROCEDURE EraseRect (F: Frame; x, y, w, h: INTEGER);
  132.     BEGIN Display.ReplConst(Display.black, x, y, w, h, Display.replace); InvalSubFrames(F, x, y, w, h)
  133.     END EraseRect;
  134.     PROCEDURE Erase (F: Frame; x, y, w, h: INTEGER);    (*RemoveMarks optimization*)
  135.     BEGIN
  136.         IF h > 0 THEN Oberon.RemoveMarks(x, y, w, h); EraseRect(F, x, y, w, h) END
  137.     END Erase;
  138.     PROCEDURE Shift (F: Frame; oldY, newY, h: INTEGER);    (*RemoveMarks optimization*)
  139.     BEGIN
  140.         IF (oldY # newY) & (h > 0) THEN
  141.             Oberon.RemoveMarks(F.X + F.left, Min(oldY, newY), F.W - F.left, Max(oldY, newY) + h);
  142.             Display.CopyBlock(F.X + F.left, oldY, F.W - F.left, h, F.X + F.left, newY, Display.replace);
  143.             ShiftSubFrames(F, oldY, newY, h)
  144.         END
  145.     END Shift;
  146.     PROCEDURE InvertCaret (F: Frame);
  147.         VAR loc: Location;
  148.     BEGIN loc := F.CarLoc; Display.CopyPattern(Display.white, Display.hook, loc.x, loc.y + loc.line.dsr - 6, Display.invert)
  149.     END InvertCaret;
  150.     PROCEDURE InvertRect (F: Frame; x, y, w, h: INTEGER);    (*clips to right and bottom frame margin*)
  151.     BEGIN
  152.         IF x + w > F.X + F.W - F.right THEN w := F.X + F.W - F.right - x END;
  153.         IF y >= F.Y + F.bot THEN Display.ReplConst(Display.white, x, y, w, h, Display.invert) END
  154.     END InvertRect;
  155.     PROCEDURE InvertSelection (F: Frame; beg, end: Location);
  156.         VAR t: TextLine; ex, rx, w, py: INTEGER;
  157.     BEGIN rx := F.X + F.W - F.right; t := end.line;
  158.         IF t.eot OR (end.pos <= t.org + t.len) THEN ex := end.x ELSE ex := rx END;
  159.         IF beg.line = end.line THEN InvertRect(F, beg.x, beg.y, ex - beg.x, beg.line.h)
  160.         ELSE t := beg.line; py := beg.y; w := F.W - F.left - F.right;
  161.             InvertRect(F, beg.x, py, rx - beg.x, t.h); t := t.next; DEC(py, t.h);
  162.             WHILE t # end.line DO InvertRect(F, F.X + F.left, py, w, t.h); t := t.next; DEC(py, t.h) END;
  163.             IF end.line.eot THEN InvertRect(F, F.X + F.left, py, end.x - (F.X + F.left), t.h)
  164.             ELSE InvertRect(F, F.X + F.left, py, ex - (F.X + F.left), t.h)
  165.             END
  166.         END
  167.     END InvertSelection;
  168.     PROCEDURE CoordToPos (F: Frame; mh: INTEGER): LONGINT;
  169.         VAR h: INTEGER;
  170.     BEGIN h := F.H - 1;
  171.         IF h > 0 THEN RETURN ((h - mh) * F.text.len + h DIV 2) DIV h ELSE RETURN 0 END
  172.     END CoordToPos;
  173.     PROCEDURE ShowBar (F: Frame; botH, topH: INTEGER);
  174.     BEGIN
  175.         IF (F.left > F.barW) & (F.barW > 0) THEN
  176.             Display.ReplConst(Display.white, F.X + F.barW - 1, F.Y + botH, 1, topH - botH, Display.replace)
  177.         END
  178.     END ShowBar;
  179.     PROCEDURE Tick (F: Frame);
  180.     BEGIN
  181.         IF (0 <= F.markH) & (F.markH < F.H) & (F.left > F.barW) & (F.barW > 6) & (F.H > 1) THEN
  182.             Display.ReplConst(Display.white, F.X + 1, F.Y + F.markH, F.barW - 6, 1, Display.invert)
  183.         END
  184.     END Tick;
  185.     PROCEDURE ShowTick (F: Frame);    (*removes global marks as needed*)
  186.         VAR h, mh: INTEGER; len: LONGINT;
  187.     BEGIN h := F.H - 1; len := F.text.len;
  188.         IF len > 0 THEN mh := SHORT(h - h * F.org DIV len) ELSE mh := h END;
  189.         IF F.markH # mh THEN Oberon.RemoveMarks(F.X, F.Y, F.barW, F.H);
  190.             Tick(F); F.markH := mh; Tick(F)
  191.         END
  192.     END ShowTick;
  193.     (** Pagination Support **)
  194.     PROCEDURE LocatePage* (F: Frame; org: LONGINT; VAR porg: LONGINT; VAR pno: INTEGER);
  195.         VAR i: INTEGER;
  196.     BEGIN i := 0;
  197.         WHILE (i < F.pages) & (F.porg[i] < org) DO INC(i) END;
  198.         IF i < F.pages THEN porg := F.porg[i]; pno := F.first + i
  199.         ELSE porg := F.text.len; pno := LEN(F.porg)
  200.         END
  201.     END LocatePage;
  202.     PROCEDURE GetPagination* (F: Frame; VAR pages, first, width: INTEGER; VAR porg: ARRAY OF LONGINT);
  203.         VAR i: INTEGER;
  204.     BEGIN pages := Min(F.pages, SHORT(LEN(porg))); first := F.first; width := F.width; i := pages;
  205.         WHILE i > 0 DO DEC(i); F.porg[i] := porg[i] END
  206.     END GetPagination;
  207.     PROCEDURE SetPagination* (F: Frame; pages, first, width: INTEGER; VAR porg: ARRAY OF LONGINT);
  208.     BEGIN pages := Min(pages, LEN(F.porg)); F.pages := pages; F.first := first; F.width := width;
  209.         WHILE pages > 0 DO DEC(pages); F.porg[pages] := porg[pages] END
  210.     END SetPagination;
  211.     (* Screen Metrics *)
  212.     PROCEDURE GetChar (fnt: Fonts.Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER; VAR pat: Display.Pattern);
  213.         (*dx, x, w: printer space*)
  214.     BEGIN Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat);
  215.         dx := SHORT(TextPrinter.DX(TextPrinter.FontNo(fnt), ch) DIV Unit);
  216.         x := PU(x); w := PU(w)
  217.     END GetChar;
  218.     PROCEDURE Tab (dw: INTEGER; VAR dx: INTEGER);    (*P set*)
  219.         VAR i, n: INTEGER; w: LONGINT;
  220.     BEGIN i := 0; n := P.nofTabs; w := LONG(dw) * Unit + MinTabWidth;
  221.         IF dw < 0 THEN dx := -dw
  222.         ELSE
  223.             WHILE (i < n) & (P.tab[i] < w) DO INC(i) END;
  224.             IF i < n THEN dx := SHORT((P.tab[i] - LONG(dw) * Unit) DIV Unit)
  225.             ELSE dx := StdTabWidth DIV Unit
  226.             END
  227.         END
  228.     END Tab;
  229.     PROCEDURE MeasureSpecial (dw: INTEGER; VAR dx, x, y, w, h: INTEGER; VAR trunc: BOOLEAN);
  230.         (*P, R, nextCh set*)    (*dx, x, w: printer space*)
  231.         VAR e: Texts.Elem; pat: Display.Pattern; pw, ph: LONGINT;
  232.             msg: TextFrames.DisplayMsg; pmsg: TextPrinter.PrintMsg;
  233.     BEGIN
  234.         IF nextCh = " " THEN GetChar(R.fnt, nextCh, dx, x, y, w, h, pat);
  235.             x := 0; y := 0; w := dx; h := 0; trunc := FALSE
  236.         ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0; trunc := FALSE
  237.         ELSIF R.elem # NIL THEN e := R.elem;
  238.             pmsg.prepare := TRUE; pmsg.indent := LONG(dw) * Unit;
  239.             pmsg.fnt := R.fnt; pmsg.col := R.col; pmsg.pos := Texts.Pos(R)-1;
  240.             pmsg.Y0 := -SHORT(P.dsr DIV Unit);
  241.             e.handle(e, pmsg); pw := e.W; ph := e.H;
  242.             msg.prepare := TRUE; msg.indent := LONG(dw) * Unit;
  243.             msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R)-1;
  244.             msg.Y0 := -SHORT(P.dsr DIV unit);
  245.             e.handle(e, msg);
  246.             w := SHORT(pw DIV Unit); h := SHORT(ph DIV unit); dx := w; x := 0; y := msg.Y0;
  247.             trunc := ~(e IS TextFrames.Parc) & ((pw < e.W) OR (ph < e.H))
  248.         ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat); trunc := FALSE
  249.         END
  250.     END MeasureSpecial;
  251.     PROCEDURE GetSpecial (F: Frame; VAR n: INTEGER; cn, ddx, dw: INTEGER;
  252.             VAR dx, x, y, w, h: INTEGER; VAR trunc: BOOLEAN);
  253.         (*P, R, nextCh set*)    (*ddx, dw, dx, x, w: printer space*)
  254.         VAR e: Texts.Elem; pat: Display.Pattern;
  255.     BEGIN
  256.         IF nextCh = " " THEN GetChar(R.fnt, nextCh, dx, x, y, w, h, pat);
  257.             x := 0; y := 0; INC(dx, ddx); INC(n); IF n <= cn THEN INC(dx) END;    (*space correction for block adjustment*)
  258.             w := dx; h := 0; trunc := FALSE
  259.         ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0; trunc := FALSE
  260.         ELSIF R.elem # NIL THEN e := R.elem;
  261.             IF (e IS TextFrames.Parc) & (P.W = 9999 * Unit) THEN
  262.                 w := Min(SHORT((P.width + P.left) DIV Unit), PU(F.W - F.right - F.left));
  263.                 e.W := w * LONG(Unit); h := SHORT(e.H DIV unit); trunc := FALSE
  264.             ELSE MeasureSpecial(dw, dx, x, y, w, h, trunc)
  265.             END;
  266.             dx := w; x := 0; y := -SHORT(P.dsr DIV unit)
  267.         ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat); trunc := FALSE
  268.         END
  269.     END GetSpecial;
  270.     PROCEDURE NextLine (T: Texts.Text; VAR org: LONGINT);    (*R, nextCh set*)
  271.         VAR pat: Display.Pattern; pos, bk, d: LONGINT; width, tw, dx, x, y, w, h: INTEGER; trunc: BOOLEAN;
  272.             R1: Texts.Reader; peekCh: CHAR; indent: LONGINT;
  273.     BEGIN tw := 0; dx := 0; w := 0; bk := -999;    (*org = Texts.Pos(R)-1*)
  274.         pos := org; TextFrames.ParcBefore(T, pos, P, pbeg); width := SHORT(P.width DIV Unit);
  275.         indent := 0;
  276.         IF org > 0 THEN Texts.OpenReader(R1, T, org - 1); Texts.Read(R1, peekCh);
  277.             IF (peekCh = CR) OR (R1.elem # NIL) & (R1.elem IS TextFrames.Parc) THEN indent := P.first END;
  278.         END;
  279.         DEC(width, SHORT(indent DIV Unit));
  280.         LOOP INC(pos);    (*inv pos = Texts.Pos(R), ~R.eof => nextCh = text[pos-1]*)
  281.             IF R.eot OR (nextCh = CR) THEN EXIT END;
  282.             INC(tw, dx);
  283.             IF nextCh <= " " THEN MeasureSpecial(tw + SHORT(indent DIV Unit), dx, x, y, w, h, trunc)
  284.             ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat)
  285.             END;
  286.             IF tw + x + dx > width THEN d := pos - bk;
  287.                 IF (0 <= d) & (d < AdjustSpan) & (nextCh > " ") THEN pos := bk
  288.                 ELSIF ((nextCh > " ") OR (nextCh = Texts.ElemChar)) & (pos > org + 1) THEN DEC(pos)
  289.                 END;
  290.                 Texts.OpenReader(R, T, pos); Texts.Read(R, nextCh);
  291.                 EXIT
  292.             END;
  293.             IF (nextCh <= " ") & (nextCh # Texts.ElemChar) THEN bk := pos END;
  294.             Texts.Read(R, nextCh)
  295.         END;
  296.         org := pos
  297.     END NextLine;
  298.     PROCEDURE BegOfLine* (T: Texts.Text; VAR pos: LONGINT; adjust: BOOLEAN);
  299.         VAR p, org: LONGINT;
  300.     BEGIN
  301.         IF pos <= 0 THEN pos := 0
  302.         ELSE
  303.             IF pos <= T.len THEN org := pos ELSE org := T.len END;
  304.             LOOP    (*search backwards for CR*)
  305.                 IF org = 0 THEN EXIT END;
  306.                 Texts.OpenReader(R, T, org - 1); Texts.Read(R, nextCh);
  307.                 IF nextCh = CR THEN EXIT END;
  308.                 DEC(org)
  309.             END;
  310.             IF adjust THEN    (*search forward for actual line origin*)
  311.                 Texts.OpenReader(R, T, org); Texts.Read(R, nextCh); p := org;
  312.                 REPEAT org := p; NextLine(T, p) UNTIL (p > pos) OR R.eot
  313.             END;
  314.             pos := org
  315.         END
  316.     END BegOfLine;
  317.     PROCEDURE AdjustMetrics (F: Frame; t: TextLine; VAR pw, tw, ddx, cn: INTEGER);
  318.         (*t.org set*)    (*pw, tw, ddx, cn: printer space*)
  319.         VAR w: INTEGER;
  320.     BEGIN P := t.P; pbeg := t.pbeg;
  321.         pw := PU(F.left); tw := PU(t.w); ddx := 0; cn := 0;
  322.         IF t.pbeg # t.org THEN
  323.             INC(pw, SHORT((P.left + t.indent) DIV Unit));
  324.             DEC(tw, SHORT(t.indent DIV Unit));
  325.             IF leftAdj IN P.opts THEN
  326.                 IF (rightAdj IN P.opts) & (t.nob > 0) THEN
  327.                     w := tw; tw := SHORT((P.width - t.indent) DIV Unit);
  328.                     ddx := (tw - w) DIV t.nob; cn := (tw - w) MOD t.nob
  329.                 END
  330.             ELSIF rightAdj IN P.opts THEN INC(pw, SHORT(P.width DIV Unit) - tw)
  331.             ELSE (*center*) INC(pw, (SHORT(P.width DIV Unit) - tw) DIV 2)
  332.             END
  333.         END
  334.     END AdjustMetrics;
  335.     (* Screen Placement *)
  336.     PROCEDURE DrawSpecial (F: Frame; px, py, x, y: INTEGER);    (*R, nextCh set*)    (*px, x: printer space*)
  337.         VAR e: Texts.Elem; pat: Display.Pattern; dx, w, h: INTEGER;
  338.             msg: TextFrames.DisplayMsg;
  339.     BEGIN
  340.         IF (nextCh = " ") OR (nextCh = CR) OR (nextCh = TAB) THEN (*skip*)
  341.         ELSIF R.elem # NIL THEN e := R.elem;
  342.             IF ~(e IS TextFrames.Parc) OR F.showsParcs THEN
  343.                 msg.prepare := FALSE;
  344.                 msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R) - 1;
  345.                 msg.frame := F; msg.X0 := SU(px + x); msg.Y0 := py + y;
  346.                 msg.elemFrame := NIL;
  347.                 e.handle(e, msg);
  348.                 IF msg.elemFrame # NIL THEN msg.elemFrame.next := F.dsc; F.dsc := msg.elemFrame END
  349.             ELSIF (e IS TextFrames.Parc) & ~F.showsParcs & (pageBreak IN e(TextFrames.Parc).opts) THEN
  350.                 Display.ReplPattern(Display.white, Display.grey1, SU(px + x), py, SHORT(e.W DIV Unit), 1, Display.replace)
  351.             END
  352.         ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat);
  353.             Display.CopyPattern(R.col, pat, SU(px + x), py + y, Display.replace)
  354.         END;
  355.     END DrawSpecial;
  356.     PROCEDURE DrawBanner (F: Frame; pno, bw, px, py, th, mw: INTEGER);
  357.         VAR pat: Display.Pattern; i, j, dx, x, y, w, h: INTEGER; pstr: ARRAY 5 OF CHAR;
  358.     BEGIN
  359.         IF bw <= mw THEN
  360.             Display.ReplPattern(Display.white, Display.grey1, px + bw, py, 1, th, Display.replace);
  361.             DEC(bw, 2)
  362.         ELSE bw := mw
  363.         END;
  364.         INC(py, th - 18);
  365.         i := 0; j := pno;
  366.         REPEAT pstr[i] := CHR(30H + j MOD 10); j := j DIV 10; INC(i) UNTIL j = 0;
  367.         WHILE j < i DO Display.GetChar(pfnt.raster, pstr[j], dx, x, y, w, h, pat); DEC(bw, dx); INC(j) END;
  368.         Display.ReplConst(Display.white, px, py, bw - 2, 1, Display.replace);
  369.         Display.ReplConst(Display.white, px, py + 2, bw - 2, 1, Display.replace);
  370.         INC(px, bw);
  371.         WHILE i > 0 DO DEC(i); Display.GetChar(pfnt.raster, pstr[i], dx, x, y, w, h, pat);
  372.             Display.CopyPattern(Display.white, pat, px + x, py + y, Display.replace);
  373.             INC(px, dx)
  374.         END
  375.     END DrawBanner;
  376.     PROCEDURE ShowLine (F: Frame; t: TextLine; left, right, py: INTEGER);    (*left, right: printer space*)
  377.         VAR pat: Display.Pattern; i: LONGINT; trunc: BOOLEAN;
  378.             n, cn, lm, px, pw, tw, ddx, dx, x, y, w, h: INTEGER;
  379.     BEGIN Texts.OpenReader(R, F.text, t.org); AdjustMetrics(F, t, pw, tw, ddx, cn);
  380.         IF F.pages > 0 THEN
  381.             IF SU(F.width) < F.W - F.left - F.right THEN
  382.                 Display.ReplPattern(Display.white, Display.grey1, F.X + F.left + SU(F.width), py, 1, t.h, Display.replace)
  383.             END;
  384.             IF t.pno >= 0 THEN
  385.                 DrawBanner(F, t.pno, SU(F.width), F.X + F.left, py, t.h, F.W - F.left - F.right)
  386.             END
  387.         END;
  388.         lm := PU(F.X + F.left) + SHORT(P.left DIV Unit); px := PU(F.X) + pw; INC(py, t.dsr); i := 0; n := 0;
  389.         WHILE i < t.len DO Texts.Read(R, nextCh);
  390.             IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, px - lm, dx, x, y, w, h, trunc)
  391.             ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat)
  392.             END;
  393.             INC(y, R.fnt.height * R.voff DIV 64);
  394.             IF px + x + w <= right THEN
  395.                 IF px + x >= left THEN
  396.                     IF nextCh <= " " THEN
  397.                         IF trunc THEN
  398.                             Display.ReplPattern(R.col, Display.grey0, SU(px + x), py + y, SU(w), h, Display.replace)
  399.                         ELSE DrawSpecial(F, px, py, x, y)
  400.                         END
  401.                     ELSE Display.CopyPattern(R.col, pat, SU(px + x), py + y, Display.replace)
  402.                     END
  403.                 END;
  404.                 INC(px, dx); INC(i)
  405.             ELSE i := t.len
  406.             END
  407.         END
  408.     END ShowLine;
  409.     PROCEDURE ShowLines (F: Frame; botH, topH: INTEGER);
  410.         VAR t: TextLine; ph: INTEGER;
  411.     BEGIN t := F.trailer.next; ph := F.H - F.top;
  412.         WHILE (t # F.trailer) & (ph - t.h >= topH) DO DEC(ph, t.h); t := t.next END;
  413.         WHILE (t # F.trailer) & (ph - t.h >= botH) DO DEC(ph, t.h);
  414.             ShowLine(F, t, PU(F.X + F.left), PU(F.X + F.W - F.right), F.Y + ph); t := t.next
  415.         END
  416.     END ShowLines;
  417.     PROCEDURE ShowLinesErasing (F: Frame; botH, topH: INTEGER);
  418.         VAR t: TextLine; ph: INTEGER;
  419.     BEGIN t := F.trailer.next; ph := F.H - F.top;
  420.         WHILE (t # F.trailer) & (ph - t.h >= topH) DO DEC(ph, t.h); t := t.next END;
  421.         WHILE (t # F.trailer) & (ph - t.h >= botH) DO DEC(ph, t.h);
  422.             Erase(F, F.X + F.left, F.Y + ph, F.W - F.right - F.left, t.h);
  423.             ShowLine(F, t, PU(F.X + F.left), PU(F.X + F.W - F.right), F.Y + ph); t := t.next
  424.         END
  425.     END ShowLinesErasing;
  426.     (* Screen Casting *)
  427.     PROCEDURE MeasureLine (F: Frame; maxW: INTEGER; t: TextLine);    (*R, nextCh set*)
  428.         VAR pat: Display.Pattern; porg, len, bklen, d: LONGINT; eol, trunc: BOOLEAN;
  429.             nob, bknob, width, minY, bkminY, maxY, bkmaxY, tw, bktw, lsp, dsr, dx, x, y, w, h: INTEGER;
  430.             R1: Texts.Reader; peekCh: CHAR;
  431.     BEGIN len := 0; nob := 0; bklen := -999; tw := 0; dx := 0; minY := 0; maxY := 0;
  432.         TextFrames.ParcBefore(F.text, t.org, P, pbeg);
  433.         lsp := SHORT(P.lsp DIV unit); dsr := SHORT(P.dsr DIV unit); width := SHORT(P.width DIV Unit);
  434.         t.indent := 0;
  435.         IF t.org > 0 THEN Texts.OpenReader(R1, F.text, t.org - 1); Texts.Read(R1, peekCh);
  436.             IF (peekCh = CR) OR (R1.elem # NIL) & (R1.elem IS TextFrames.Parc) THEN t.indent := P.first END;
  437.         END;
  438.         DEC(width, SHORT(t.indent DIV Unit));
  439.         LOOP INC(tw, dx);
  440.             IF R.eot OR (nextCh = CR) THEN nob := 0; eol := ~R.eot; EXIT END;
  441.             IF nextCh <= " " THEN MeasureSpecial(tw + SHORT(t.indent DIV Unit), dx, x, y, w, h, trunc)
  442.             ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat)
  443.             END;
  444.             IF tw + x + dx > width THEN d := len - bklen;
  445.                 IF (0 <= d) & (d < AdjustSpan) & (nextCh > " ") THEN eol := TRUE;
  446.                     Texts.OpenReader(R, F.text, Texts.Pos(R) - d);
  447.                     nob := bknob; len := bklen; tw := bktw; minY := bkminY; maxY := bkmaxY
  448.                 ELSIF len = 0 THEN    (*force at least one character on each line*)
  449.                     INC(len); INC(y, R.fnt.height * R.voff DIV 64); minY := Min(minY, y); maxY := Max(maxY, y + h);
  450.                     Texts.Read(R, nextCh); eol := FALSE; tw := maxW
  451.                 ELSE eol := (nextCh <= " ") & (nextCh # Texts.ElemChar)
  452.                 END;
  453.                 EXIT
  454.             END;
  455.             IF (nextCh <= " ") & (nextCh # Texts.ElemChar) THEN
  456.                 bknob := nob; bklen := len; bktw := tw; bkminY := minY; bkmaxY := maxY;
  457.                 IF nextCh = " " THEN INC(nob) END
  458.             END;
  459.             INC(len); INC(y, R.fnt.height * R.voff DIV 64); minY := Min(minY, y); maxY := Max(maxY, y + h);
  460.             Texts.Read(R, nextCh)
  461.         END;
  462.         IF ~F.showsParcs & (pbeg = t.org) THEN dsr := 0; t.h := SHORT(P.lead DIV unit) + 1
  463.         ELSIF gridAdj IN P.opts THEN
  464.             WHILE dsr < -minY DO INC(dsr, lsp) END;
  465.             t.h := Max(lsp, dsr + maxY); INC(t.h, (-t.h) MOD lsp)
  466.         ELSE dsr := Max(dsr, -minY); t.h := Max(lsp, dsr + maxY)
  467.         END;
  468.         LocatePage(F, t.org, porg, t.pno);
  469.         IF t.org = porg THEN INC(t.h, 20) ELSE t.pno := -1 END;
  470.         t.len := len; t.w := Min(SU(tw), maxW); t.dsr := dsr;
  471.         t.nob := nob; t.eot := R.eot; t.P := P; t.pbeg := pbeg;
  472.         IF eol THEN Texts.Read(R, nextCh); t.span := len + 1 ELSE t.span := len END
  473.     END MeasureLine;
  474.     PROCEDURE MeasureLines (F: Frame; org: LONGINT; VAR trailer: TextLine);
  475.         VAR s, t: TextLine; ph: INTEGER;
  476.     BEGIN NEW(trailer); s := trailer;
  477.         Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); ph := F.H - F.top;
  478.         LOOP NEW(t); t.org := org; MeasureLine(F, F.W - F.left - F.right, t);
  479.             IF ph - t.h < F.bot THEN EXIT END;
  480.             s.next := t; s := t; INC(org, s.span); DEC(ph, s.h);
  481.             IF R.eot THEN EXIT END
  482.         END;
  483.         s.next := trailer; trailer.eot := TRUE; trailer.org := org; trailer.len := 0; trailer.w := 0;
  484.         trailer.h := SHORT(TextFrames.defParc.lsp DIV unit); trailer.P := P; trailer.pbeg := pbeg
  485.     END MeasureLines;
  486.     (** Locators **)
  487.     PROCEDURE LocateLineTop (F: Frame; trailer: TextLine; org: LONGINT; VAR loc: Location);
  488.         VAR t: TextLine; ph: INTEGER;
  489.     BEGIN ph := F.H - F.top; t := trailer.next;
  490.         WHILE (t # trailer) & (t.org # org) DO DEC(ph, t.h); t := t.next END;
  491.         loc.org := org; loc.line := t; loc.y := F.Y + ph
  492.     END LocateLineTop;
  493.     PROCEDURE Width (F: Frame; t: TextLine; pos: LONGINT; VAR pw, dx, dy: INTEGER);    (*pw, dx: printer space*)
  494.         VAR pat: Display.Pattern; i: LONGINT; n, mw, lm, tw, ddx, cn, x, y, w, h: INTEGER; trunc: BOOLEAN;
  495.     BEGIN AdjustMetrics(F, t, pw, tw, ddx, cn); dy := 0; lm := PU(F.left) + SHORT(P.left DIV Unit);
  496.         IF t # F.trailer THEN Texts.OpenReader(R, F.text, t.org); Texts.Read(R, nextCh);
  497.             i := 0; n := 0; DEC(pos, t.org); dx := 0; mw := PU(F.W - F.right);
  498.             WHILE ~R.eot & (i < t.len) & (i <= pos) & (pw + dx <= mw) DO INC(i); INC(pw, dx);
  499.                 IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, pw - lm, dx, x, y, w, h, trunc)
  500.                 ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat)
  501.                 END;
  502.                 dy := R.fnt.height * R.voff DIV 64;
  503.                 Texts.Read(R, nextCh)
  504.             END;
  505.             IF (i <= pos) & (pw + dx <= mw) THEN INC(i); INC(pw, dx) END
  506.         ELSE dx := PU(4)
  507.         END
  508.     END Width;
  509.     PROCEDURE LocatePos* (F: Frame; pos: LONGINT; VAR loc: Location);
  510.         VAR t: TextLine; pw, dx, dy: INTEGER;
  511.     BEGIN
  512.         IF pos < F.org THEN pos := F.org; t := F.trailer.next
  513.         ELSIF pos < F.trailer.org THEN t := F.trailer;
  514.             WHILE (t.next # F.trailer) & (t.next.org <= pos) DO t := t.next END
  515.         ELSE pos := F.trailer.org; t := F.trailer.next;
  516.             WHILE ~t.eot DO t := t.next END
  517.         END;
  518.         Width(F, t, pos, pw, dx, dy); LocateLineTop(F, F.trailer, t.org, loc); DEC(loc.y, loc.line.h);
  519.         loc.org := t.org; loc.pos := pos; loc.x := F.X + SU(pw); loc.dx := SU(dx); loc.dy := dy;
  520.         loc.line := t; loc.trunc := FALSE
  521.     END LocatePos;
  522.     PROCEDURE LocateLine* (F: Frame; y: INTEGER; VAR loc: Location);
  523.         VAR t: TextLine; h, ph, pw, tw, ddx, cn: INTEGER;
  524.     BEGIN t := F.trailer.next; h := y - F.Y; ph := F.H - F.top - t.h;
  525.         WHILE ~t.eot & (ph - t.next.h >= F.bot) & (ph > h) DO t := t.next; DEC(ph, t.h) END;
  526.         AdjustMetrics(F, t, pw, tw, ddx, cn);
  527.         IF pw >= PU(F.X + F.W - F.right) THEN pw := PU(F.X + F.W - F.right - 4) END;
  528.         loc.org := t.org; loc.pos := loc.org;
  529.         loc.x := F.X + SU(pw); loc.y := F.Y + ph; loc.dx := SU(tw); loc.dy := 0;
  530.         loc.line := t; loc.trunc := FALSE
  531.     END LocateLine;
  532.     PROCEDURE LocateChar* (F: Frame; x, y: INTEGER; VAR loc: Location);
  533.         VAR t: TextLine; pat: Display.Pattern; i: LONGINT; trunc: BOOLEAN;
  534.             n, w, lm, pw, tw, ddx, cn, dx, xc, yc, wc, hc: INTEGER;
  535.     BEGIN LocateLine(F, y, loc); t := loc.line; w := PU(x - F.X); AdjustMetrics(F, t, pw, tw, ddx, cn);
  536.         lm := PU(F.left) + SHORT(P.left DIV Unit);
  537.         IF (t # F.trailer) & (w > pw) THEN Texts.OpenReader(R, F.text, t.org);
  538.             i := 0; n := 0; dx := 0; nextCh := 0X;
  539.             WHILE (i < t.len) & (pw + dx < w) DO Texts.Read(R, nextCh); INC(i); INC(pw, dx);
  540.                 IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, pw - lm, dx, xc, yc, wc, hc, trunc)
  541.                 ELSE GetChar(R.fnt, nextCh, dx, xc, yc, wc, hc, pat); trunc := FALSE
  542.                 END
  543.             END;
  544.             IF pw + dx < w THEN INC(i); INC(pw, dx); R.elem := NIL END;
  545.             INC(loc.pos, i - 1); loc.x := F.X + SU(pw); loc.trunc := trunc;
  546.             IF i < t.len THEN loc.dx := SU(dx); loc.dy := R.fnt.height * R.voff DIV 64 ELSE loc.dx := 4 END
  547.         ELSE loc.dx := 4
  548.         END
  549.     END LocateChar;
  550.     PROCEDURE LocateWord* (F: Frame; x, y: INTEGER; VAR loc: Location);
  551.         VAR t: TextLine; pos, i: LONGINT; px, rx: INTEGER; pat: Display.Pattern; dx, xc, yc, wc, hc: INTEGER;
  552.     BEGIN LocateChar(F, x, y, loc); pos := loc.pos + 1;
  553.         REPEAT DEC(pos); Texts.OpenReader(R, F.text, pos); Texts.Read(R, nextCh)
  554.         UNTIL (pos < loc.org) OR (nextCh > " ");
  555.         INC(pos);
  556.         REPEAT DEC(pos); Texts.OpenReader(R, F.text, pos); Texts.Read(R, nextCh)
  557.         UNTIL (pos < loc.org) OR (nextCh <= " ");
  558.         LocatePos(F, pos + 1, loc); t := loc.line; i := loc.pos - loc.org;
  559.         IF i < t.len THEN px := PU(loc.x); rx := PU(F.X + F.W - F.right);
  560.             Texts.OpenReader(R, F.text, loc.pos); dx := 0; wc := 0; nextCh := "x";
  561.             WHILE (i < t.len) & (nextCh > " ") & (px + dx < rx) DO Texts.Read(R, nextCh); INC(i); INC(px, dx);
  562.                 GetChar(R.fnt, nextCh, dx, xc, yc, wc, hc, pat)
  563.             END;
  564.             IF (nextCh > " ") & (px + dx < rx) THEN INC(i); INC(px, dx) END;
  565.             loc.dx := SU(px) - loc.x
  566.         ELSE loc.dx := 0
  567.         END
  568.     END LocateWord;
  569.     PROCEDURE Pos* (F: Frame; x, y: INTEGER): LONGINT;
  570.         VAR loc: Location;
  571.     BEGIN LocateChar(F, x, y, loc); RETURN loc.pos
  572.     END Pos;
  573.     PROCEDURE ThisSubFrame* (F: Frame; x, y: INTEGER): Display.Frame;
  574.         VAR f: Display.Frame;
  575.     BEGIN f := F.dsc;
  576.         WHILE (f # NIL) & ((x < f.X) OR (x >= f.X + f.W) OR (y < f.Y) OR (y >= f.Y + f.H)) DO f := f.next END;
  577.         RETURN f
  578.     END ThisSubFrame;
  579.     (** Caret & Selection **)
  580.     PROCEDURE PassSubFocus* (F: Frame; f: Display.Frame);
  581.         VAR loc: Location; f1: Display.Frame; ctrl: Oberon.ControlMsg; focus: TextFrames.FocusMsg;
  582.     BEGIN
  583.         IF F.focus # NIL THEN f1 := F.focus;
  584.             ctrl.id := Oberon.defocus; f1.handle(f1, ctrl);
  585.             LocateChar(F, f1.X + 1, f1.Y + 1, loc);
  586.             focus.focus := FALSE; focus.elemFrame := f1; focus.frame := F; R.elem.handle(R.elem, focus);
  587.             InvertBorder(f1)
  588.         END;
  589.         IF f # NIL THEN
  590.             LocateChar(F, f.X + 1, f.Y + 1, loc);
  591.             focus.focus := TRUE; focus.elemFrame := f; focus.frame := F; R.elem.handle(R.elem, focus);
  592.             InvertBorder(f)
  593.         END;
  594.         F.focus := f
  595.     END PassSubFocus;
  596.     PROCEDURE RemoveSelection* (F: Frame);
  597.     BEGIN
  598.         IF F.hasSel THEN InvertSelection(F, F.SelBeg, F.SelEnd); F.hasSel := FALSE END
  599.     END RemoveSelection;
  600.     PROCEDURE SetSelection* (F: Frame; beg, end: LONGINT);    (**forces range to visible bounds**)
  601.         VAR loc: Location;
  602.     BEGIN
  603.         IF end > F.text.len THEN end := F.text.len END;
  604.         IF end > beg THEN
  605.             IF F.hasSel & (F.SelBeg.pos = beg) THEN
  606.                 IF (F.SelEnd.pos < end) & (F.SelEnd.pos < F.trailer.org) THEN
  607.                     LocatePos(F, F.SelEnd.pos, loc); LocatePos(F, end, F.SelEnd); InvertSelection(F, loc, F.SelEnd)
  608.                 ELSIF end < F.SelEnd.pos THEN
  609.                     LocatePos(F, end, loc); InvertSelection(F, loc, F.SelEnd); LocatePos(F, end, F.SelEnd)
  610.                 END
  611.             ELSIF ~F.hasSel OR (F.SelBeg.pos # beg) OR (F.SelEnd.pos # end) THEN
  612.                 RemoveSelection(F); PassSubFocus(F, NIL);
  613.                 LocatePos(F, beg, F.SelBeg); LocatePos(F, end, F.SelEnd); InvertSelection(F, F.SelBeg, F.SelEnd)
  614.             END;
  615.             F.hasSel := TRUE; F.time := Oberon.Time()
  616.         END
  617.     END SetSelection;
  618.     PROCEDURE RemoveCaret* (F: Frame);
  619.         VAR msg: Oberon.ControlMsg;
  620.     BEGIN
  621.         IF F.focus # NIL THEN msg.id := Oberon.defocus; F.focus.handle(F.focus, msg) END;
  622.         IF F.hasCar THEN InvertCaret(F); F.hasCar := FALSE END
  623.     END RemoveCaret;
  624.     PROCEDURE SetCaret* (F: Frame; pos: LONGINT);    (**only done if within visible bounds**)
  625.     BEGIN
  626.         IF ~F.hasCar OR (F.CarLoc.pos # pos) THEN RemoveCaret(F); PassSubFocus(F, NIL);
  627.             LocatePos(F, pos, F.CarLoc);
  628.             IF (F.H - F.top - F.bot >= F.CarLoc.line.h) & (F.CarLoc.x <= F.X + F.W - F.right) THEN
  629.                 LocateChar(F, F.CarLoc.x + 1, F.CarLoc.y, F.CarLoc); (*prevent "dangling" caret at right margin*)
  630.                 IF F.CarLoc.pos = pos THEN InvertCaret(F); F.hasCar := TRUE END
  631.             END
  632.         END
  633.     END SetCaret;
  634.     PROCEDURE Neutralize* (F: Frame);
  635.         VAR f: Display.Frame; msg: Oberon.ControlMsg;
  636.     BEGIN RemoveCaret(F); RemoveSelection(F);
  637.         f := F.dsc; msg.id := Oberon.neutralize;
  638.         WHILE f # NIL DO f.handle(f, msg);
  639.             IF f = F.focus THEN PassSubFocus(F, NIL) END;
  640.             f := f.next
  641.         END
  642.     END Neutralize;
  643.     (** Display Range **)
  644.     PROCEDURE Complete (F: Frame; trailer: TextLine; VAR s: TextLine; VAR org: LONGINT; VAR ph: INTEGER);
  645.         VAR u: TextLine;
  646.     BEGIN
  647.         IF ph > F.bot THEN    (*try to add new lines to the bottom*)
  648.             Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);
  649.             LOOP
  650.                 IF R.eot THEN EXIT END;
  651.                 NEW(u); u.org := org; MeasureLine(F, F.W - F.left - F.right, u);
  652.                 IF ph - u.h < F.bot THEN EXIT END;
  653.                 s.next := u; s := s.next; DEC(ph, s.h); INC(org, s.span)
  654.             END
  655.         END;
  656.         s.next := trailer; trailer.eot := TRUE; trailer.org := org; trailer.len := 0; trailer.w := 0;
  657.         trailer.h := SHORT(TextFrames.defParc.lsp DIV unit); trailer.P := P; trailer.pbeg := pbeg
  658.     END Complete;
  659.     PROCEDURE ShowFrom (F: Frame; pos: LONGINT);    (*removes global marks as needed and neutralizes F*)
  660.         VAR new, s: TextLine; beg, end: Location; org: LONGINT; ph, y0, dy: INTEGER;
  661.     BEGIN Neutralize(F);
  662.         IF (F.trailer # NIL) & (F.org < pos) & (pos < F.trailer.org) THEN    (*shift up and extend to the bottom*)
  663.             LocateLineTop(F, F.trailer, pos, beg); LocateLineTop(F, F.trailer, F.trailer.org, end);
  664.             dy := (F.Y + F.H - F.top) - beg.y; Shift(F, end.y, end.y + dy, beg.y - end.y);
  665.             Erase(F, F.X + F.left, end.y, F.W - F.left, dy);
  666.             s := F.trailer.next; WHILE s.org # pos DO s := s.next END;
  667.             F.trailer.next := s; org := s.org + s.span; ph := F.H - F.top - s.h;
  668.             Complete(F, F.trailer, s, org, ph); F.org := pos; ShowLines(F, F.bot, end.y + dy - F.Y)
  669.         ELSIF (F.trailer = NIL) OR (pos # F.org) THEN MeasureLines(F, pos, new);
  670.             IF (F.trailer # NIL) & (pos < F.org) & (F.org <= new.org) THEN    (*shift down and extend to the top*)
  671.                 LocateLineTop(F, new, F.org, beg); LocateLineTop(F, new, new.org, end);
  672.                 y0 := F.Y + F.H - F.top; Shift(F, y0 - (beg.y - end.y), end.y, beg.y - end.y);
  673.                 Erase(F, F.X + F.left, beg.y, F.W - F.left, y0 - beg.y);
  674.                 Erase(F, F.X + F.left, F.Y + F.bot, F.W - F.left, end.y - (F.Y + F.bot));
  675.                 F.org := pos; F.trailer := new; ShowLines(F, beg.y - F.Y, F.H - F.top)
  676.             ELSE    (*full redisplay*)
  677.                 IF F.trailer = NIL THEN Erase(F, F.X, F.Y, F.W, F.H); ShowBar(F, 0, F.H); F.markH := -1
  678.                 ELSE Erase(F, F.X + F.left, F.Y + F.bot, F.W - F.left, F.H - F.bot - F.top)
  679.                 END;
  680.                 F.org := pos; F.trailer := new; ShowLines(F, F.bot, F.H - F.top)
  681.             END
  682.         END;
  683.         ShowTick(F)
  684.     END ShowFrom;
  685.     PROCEDURE Show* (F: Frame; pos: LONGINT);    (**removes global marks as needed and neutralizes F**)
  686.     BEGIN BegOfLine(F.text, pos, TRUE); ShowFrom(F, pos)
  687.     END Show;
  688.     PROCEDURE Resize* (F: Frame; x, y, w, h: INTEGER);
  689.         VAR loc: Location; oldY, oldH, dh: INTEGER;
  690.     BEGIN
  691.         IF (w = 0) OR (h = 0) THEN InvalSubFrames(F, F.X, F.Y, F.W, F.H);
  692.             F.X := x; F.Y := y; F.W := w; F.H := h; F.trailer := NIL
  693.         ELSIF (F.trailer # NIL) & (x = F.X) & (w = F.W) THEN
  694.             oldY := F.Y; oldH := F.H; Tick(F); F.markH := -1; F.Y := y; F.H := h;
  695.             IF h > oldH THEN dh := h - oldH;
  696.                 Display.CopyBlock(x, oldY, w, oldH, x, y + dh, Display.replace);
  697.                 ShiftSubFrames(F, oldY, y + dh, oldH);
  698.                 EraseRect(F, x, y, w, dh); ShowBar(F, 0, dh);
  699.                 LocateLineTop(F, F.trailer, F.trailer.org, loc); MeasureLines(F, F.org, F.trailer);
  700.                 ShowLines(F, F.bot, loc.y - F.Y)
  701.             ELSE dh := oldH - h;
  702.                 MeasureLines(F, F.org, F.trailer); LocateLineTop(F, F.trailer, F.trailer.org, loc);
  703.                 Display.CopyBlock(x, oldY + dh, w, h, x, y, Display.replace);
  704.                 ShiftSubFrames(F, oldY + dh, y, h);
  705.                 EraseRect(F, x + F.left, y, w - F.left, loc.y - F.Y);
  706.                 InvalSubFrames(F, x, oldY, w, y - oldY); InvalSubFrames(F, x, y + h, w, dh - (y - oldY))
  707.             END;
  708.             ShowTick(F)
  709.         ELSE F.X := x; F.Y := y; F.W := w; F.H := h; F.trailer := NIL; Show(F, F.org)
  710.         END
  711.     END Resize;
  712.     (** Contents Update **)
  713.     PROCEDURE Update* (F: Frame; VAR msg: TextFrames.UpdateMsg);    (**removes global marks as needed**)
  714.         VAR t: TextLine; org, d: LONGINT;
  715.         PROCEDURE Begin (VAR beg: LONGINT; VAR org0: LONGINT; VAR q: TextLine);
  716.             (*returns q # NIL if beg > org0*)
  717.             VAR trailer, t: TextLine; p: LONGINT;
  718.         BEGIN trailer := F.trailer; t := trailer; q := NIL;
  719.             WHILE (t.next # trailer) & (t.next.org + t.next.span <= beg) & ~t.next.eot DO t := t.next END;
  720.             IF (t # trailer) & (t.next # trailer) & (beg <= t.next.org + t.next.span) THEN
  721.                 Texts.OpenReader(R, F.text, t.org); Texts.Read(R, nextCh); p := t.org; NextLine(F.text, p);
  722.                 IF p = t.next.org THEN q := t.next; org0 := q.org ELSE org0 := t.org; beg := org0 END
  723.             ELSE BegOfLine(F.text, beg, TRUE);
  724.                 IF (msg.beg < beg + AdjustSpan) & (F.org < beg) THEN DEC(beg); BegOfLine(F.text, beg, TRUE) END;
  725.                 org0 := beg
  726.             END
  727.         END Begin;
  728.         PROCEDURE Adjust (end, delta: LONGINT);
  729.             VAR new, old, s, t, u, p, q: TextLine; bot: Location;
  730.                 org, org0, beg: LONGINT; ph, h0, h1, H1, h2, lm, dx, dy: INTEGER;
  731.         BEGIN q := NIL; LocateLineTop(F, F.trailer, F.trailer.org, bot);
  732.             IF msg.beg < F.org THEN org0 := F.org; beg := org0 ELSE beg := msg.beg; Begin(beg, org0, q) END;
  733.             NEW(new); s := new; old := F.trailer; t := old; org := F.org; ph := F.H - F.top;
  734.             WHILE (t.next # old) & (t.next.org # org0) DO t := t.next;    (*transfer unchanged prefix*)
  735.                 s.next := t; s := t; DEC(ph, s.h); INC(org, s.span)
  736.             END;
  737.             h0 := ph; H1 := h0; t := t.next; p := s;
  738.             Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);    (*rebuilt at least one line descriptor*)
  739.             LOOP NEW(u); u.org := org; MeasureLine(F, F.W - F.left - F.right, u);
  740.                 IF ph - u.h < F.bot THEN h1 := ph; h2 := h1; EXIT END;
  741.                 s.next := u; s := s.next; DEC(ph, s.h); INC(org, s.span);
  742.                 IF R.eot THEN h1 := ph; h2 := h1; EXIT END;
  743.                 IF org > end THEN
  744.                     WHILE (t # old) & (org > t.org + delta) DO DEC(H1, t.h); t := t.next END;
  745.                     IF (org = t.org + delta) & (P = t.P) THEN h1 := ph;    (*resynchronized*)
  746.                         WHILE (t # old) & (ph - t.h >= F.bot) DO    (*transfer unchanged suffix*)
  747.                             s.next := t; s := t; s.org := org; TextFrames.ParcBefore(F.text, s.org, s.P, s.pbeg);
  748.                             DEC(ph, s.h); INC(org, s.span); t := t.next
  749.                         END;
  750.                         h2 := ph; EXIT
  751.                     END
  752.                 END
  753.             END;
  754.             Shift(F, F.Y + h2 + (H1 - h1), F.Y + h2, h1 - h2);
  755.             Complete(F, new, s, org, ph); F.trailer := new; t := p.next;
  756.             IF (q # NIL) & (q.h = t.h) & (q.dsr = t.dsr) & (q.org = t.org) & (q.P = t.P) & (end <= t.org + t.len) THEN
  757.                 P := t.P; pbeg := t.pbeg;
  758.                 IF (P.opts * AdjMask = {leftAdj}) OR (P.opts * AdjMask = AdjMask) & (q.nob = 0) & (t.nob = 0) THEN
  759.                     Width(F, t, beg, lm, dx, dy);    (*preserve prefix of first affected line*)
  760.                     DEC(h0, t.h); Erase(F, F.X + SU(lm), F.Y + h0, F.W - SU(lm), t.h);
  761.                     ShowLine(F, t, PU(F.X) + lm, PU(F.X + F.W - F.right), F.Y + h0)
  762.                 END
  763.             END;
  764.             ShowLinesErasing(F, h1, h0);
  765.             Erase(F, F.X + F.left, bot.y, F.W - F.left, h2 - (bot.y - F.Y)); ShowLines(F, F.bot, h2)
  766.         END Adjust;
  767.     BEGIN
  768.         IF (msg.id = Texts.insert) & (msg.beg < F.org) THEN t := F.trailer; d := msg.end - msg.beg; INC(F.org, d);
  769.             REPEAT INC(t.org, d); t := t.next UNTIL t = F.trailer
  770.         ELSIF (msg.id = Texts.delete) & (msg.end <= F.org) THEN t := F.trailer; d := msg.end - msg.beg; DEC(F.org, d);
  771.             REPEAT DEC(t.org, d); t := t.next UNTIL t = F.trailer
  772.         END;
  773.         org := F.org;
  774.         IF msg.beg <= F.org + AdjustSpan THEN BegOfLine(F.text, org, TRUE) END;
  775.         TextFrames.ParcBefore(F.text, org, P, d);
  776.         IF (org # F.org) OR (P # F.trailer.next.P) OR (F.pages # 0) THEN
  777.             F.trailer := NIL; F.pages := 0; Show(F, F.org)
  778.         ELSIF (msg.end > org) & (msg.beg < F.trailer.org + AdjustSpan) THEN
  779.             IF msg.id = Texts.replace THEN Adjust(msg.end, 0)
  780.             ELSIF msg.id = Texts.insert THEN Adjust(msg.end, msg.end - msg.beg)
  781.             ELSIF msg.id = Texts.delete THEN Adjust(msg.beg, msg.beg - msg.end)
  782.             END
  783.         END;
  784.         ShowTick(F)
  785.     END Update;
  786.     (** User Interface **)
  787.     PROCEDURE TrackLine* (F: Frame; VAR x, y: INTEGER; VAR org: LONGINT; VAR keysum: SET);
  788.         VAR keys: SET; new, old: Location;
  789.     BEGIN LocateLine(F, y, old); InvertRect(F, old.x, old.y, old.dx + 4, 2);
  790.         REPEAT TrackMouse(x, y, keys, keysum); LocateLine(F, y, new);
  791.             IF new.org # old.org THEN
  792.                 InvertRect(F, new.x, new.y, new.dx + 4, 2); InvertRect(F, old.x, old.y, old.dx + 4, 2); old := new
  793.             END
  794.         UNTIL keys = {};
  795.         InvertRect(F, new.x, new.y, new.dx + 4, 2); org := new.org
  796.     END TrackLine;
  797.     PROCEDURE TrackWord* (F: Frame; VAR x, y: INTEGER; VAR pos: LONGINT; VAR keysum: SET);
  798.         VAR keys: SET; new, old: Location;
  799.     BEGIN LocateWord(F, x, y, old); InvertRect(F, old.x, old.y, old.dx, 2);
  800.         REPEAT TrackMouse(x, y, keys, keysum); LocateWord(F, x, y, new);
  801.             IF new.pos # old.pos THEN
  802.                 InvertRect(F, new.x, new.y, new.dx, 2); InvertRect(F, old.x, old.y, old.dx, 2); old := new
  803.             END
  804.         UNTIL keys = {};
  805.         InvertRect(F, new.x, new.y, new.dx, 2); pos := new.pos
  806.     END TrackWord;
  807.     PROCEDURE TrackCaret* (F: Frame; VAR x, y: INTEGER; VAR keysum: SET);
  808.         VAR keys: SET;
  809.     BEGIN
  810.         REPEAT TrackMouse(x, y, keys, keysum); SetCaret(F, Pos(F, x, y)) UNTIL keys = {}
  811.     END TrackCaret;
  812.     PROCEDURE TrackSelection* (F: Frame; VAR x, y: INTEGER; VAR keysum: SET);
  813.         VAR keys: SET; pos: LONGINT; V: Viewers.Viewer; f: Frame;
  814.     BEGIN V := Viewers.This(F.X, F.Y); V := V.next(Viewers.Viewer);
  815.         IF (V.dsc # NIL) & (V.dsc.next # NIL) & (V.dsc.next IS Frame) THEN f := V.dsc.next(Frame);
  816.             IF f.hasSel & (f.text = F.text) THEN
  817.                 IF (f.SelBeg.pos < f.trailer.org) & (f.org < f.SelEnd.pos) & (f.SelBeg.pos <= Pos(F, x, y)) THEN
  818.                     SetSelection(F, f.SelBeg.pos, Pos(F, x, y) + 1)
  819.                 ELSE RemoveSelection(f); f := NIL
  820.                 END
  821.             ELSE f := NIL
  822.             END
  823.         ELSE f := NIL
  824.         END;
  825.         IF f = NIL THEN
  826.             IF F.hasSel & (F.SelBeg.pos + 1 = F.SelEnd.pos) & (Pos(F, x, y) = F.SelBeg.pos) THEN
  827.                 SetSelection(F, F.SelBeg.org, Pos(F, x, y) + 1)
  828.             ELSE SetSelection(F, Pos(F, x, y), Pos(F, x, y) + 1)
  829.             END
  830.         END;
  831.         REPEAT TrackMouse(x, y, keys, keysum); pos := Pos(F, x, y) + 1;
  832.             IF F.hasSel THEN
  833.                 IF pos > F.SelBeg.pos THEN SetSelection(F, F.SelBeg.pos, pos);
  834.                     IF f # NIL THEN SetSelection(f, f.SelBeg.pos, pos); f.SelEnd.pos := F.SelEnd.pos END
  835.                 END
  836.             ELSE SetSelection(F, Pos(F, x, y), Pos(F, x, y) + 1)
  837.             END
  838.         UNTIL keys = {};
  839.         IF f # NIL THEN F.SelBeg.pos := f.SelBeg.pos END
  840.     END TrackSelection;
  841.     PROCEDURE Call* (F: Frame; pos: LONGINT; new: BOOLEAN);
  842.         VAR S: Texts.Scanner; par: Oberon.ParList; res: INTEGER;
  843.     BEGIN Texts.OpenScanner(S, F.text, pos); Texts.Scan(S);
  844.         IF (S.line = 0) & (S.class = Texts.Name) THEN NEW(par); par.frame := F; par.text := F.text; par.pos := Texts.Pos(S)-1;
  845.             Oberon.Call(S.s, par, new, res);
  846.             IF res > 1 THEN Texts.WriteString(WL, "Call error: "); Texts.WriteString(WL, Modules.importing);
  847.                 IF res = 2 THEN Texts.WriteString(WL, " not an obj-file")
  848.                 ELSIF res = 3 THEN Texts.WriteString(WL, " imports ");
  849.                     Texts.WriteString(WL, Modules.imported); Texts.WriteString(WL, " with bad key")
  850.                 ELSIF res = 4 THEN Texts.WriteString(WL, " corrupted obj file")
  851.                 ELSIF res = 6 THEN Texts.WriteString(WL, " has too many imports")
  852.                 ELSIF res = 7 THEN Texts.WriteString(WL, " not enough space")
  853.                 END;
  854.                 Texts.WriteLn(WL); Texts.Append(Oberon.Log, WL.buf)
  855.             END
  856.         END
  857.     END Call;
  858.     PROCEDURE ShiftBlock (F: Frame; delta: INTEGER);
  859.         VAR text: Texts.Text; pos, beg, end, time: LONGINT; select: SelectMsg; ch: CHAR;
  860.     BEGIN Oberon.GetSelection(text, beg, end, time);
  861.         IF (time >= 0) & (text = F.text) THEN BegOfLine(F.text, beg, FALSE); pos := beg;
  862.             WHILE pos < end DO Texts.OpenReader(R, F.text, pos); Texts.Read(R, ch);
  863.                 WHILE (R.elem # NIL) & (R.elem IS TextFrames.Parc) & (pos < end) DO Texts.Read(R, ch); INC(pos) END;
  864.                 IF pos < end THEN
  865.                     IF delta < 0 THEN
  866.                         IF (ch <= " ") & (ch # CR) & (ch # Texts.ElemChar) THEN
  867.                             Texts.Delete(F.text, pos, pos + 1); DEC(end)
  868.                         END
  869.                     ELSE
  870.                         IF (ch <= " ") & (ch # CR) & (ch # Texts.ElemChar) THEN Texts.Write(W, ch)    (*first char extension*)
  871.                         ELSE Texts.Write(W, TAB)
  872.                         END;
  873.                         Texts.Insert(F.text, pos, W.buf); INC(end); INC(pos)
  874.                     END;
  875.                     Texts.OpenReader(R, F.text, pos);
  876.                     REPEAT Texts.Read(R, ch) UNTIL R.eot OR (ch = CR);
  877.                     pos := Texts.Pos(R)
  878.                 END
  879.             END;
  880.             select.text := F.text; select.beg := beg; select.end := pos; select.time := Oberon.Time();
  881.             Viewers.Broadcast(select)
  882.         END
  883.     END ShiftBlock;
  884.     PROCEDURE Write* (F: Frame; ch: CHAR; fnt: Fonts.Font; col, voff: SHORTINT);
  885.         VAR loc: Location; parc: TextFrames.Parc; org, pos, pbeg: LONGINT; i: INTEGER; ch0: CHAR;
  886.             buf: ARRAY 32 OF CHAR;
  887.             copy: Texts.CopyMsg; input: Oberon.InputMsg;
  888.         PROCEDURE Visible(ch: CHAR): BOOLEAN;
  889.             VAR pat: Display.Pattern; dx, x, y, w, h: INTEGER;
  890.         BEGIN GetChar(W.fnt, ch, dx, x, y, w, h, pat); RETURN dx > 0
  891.         END Visible;
  892.         PROCEDURE InsertBuffer;
  893.             VAR i, j: INTEGER; ch: CHAR;
  894.         BEGIN i := 0; j := 0; ch := buf[i];
  895.             WHILE ch # 0X DO
  896.                 IF (ch = TAB) OR (ch = CR) OR (ch = " ") OR Visible(ch) THEN Texts.Write(W, ch); INC(j) END;
  897.                 INC(i); ch := buf[i]
  898.             END; 
  899.             IF j > 0 THEN Texts.Insert(F.text, pos, W.buf); INC(pos, LONG(j)) END
  900.         END InsertBuffer;
  901.         PROCEDURE Flush;
  902.             VAR ch: CHAR;
  903.         BEGIN
  904.             WHILE Input.Available() > 0 DO Input.Read(ch) END
  905.         END Flush;
  906.     BEGIN
  907.         IF F.hasCar THEN pos := F.CarLoc.pos;
  908.             IF (ch = DEL) & (pos > F.org) THEN DEC(pos); Texts.Delete(F.text, pos, pos + 1); Flush
  909.             ELSIF (ch = CRSL) & (pos > 0) THEN DEC(pos)
  910.             ELSIF (ch = CRSR) & (pos < F.text.len) THEN INC(pos)
  911.             ELSIF (ch = BRK) OR (ch = ShiftBRK) THEN
  912.                 TextFrames.ParcBefore(F.text, pos, P, pbeg); P.handle(P, copy); parc := copy.e(TextFrames.Parc);
  913.                 IF ch = BRK THEN EXCL(parc.opts, pageBreak) ELSE INCL(parc.opts, pageBreak) END;
  914.                 Texts.SetFont(W, fnt); Texts.SetColor(W, col); Texts.SetOffset(W, voff);
  915.                 Texts.WriteElem(W, parc); Texts.Insert(F.text, pos, W.buf); INC(pos)
  916.             ELSIF (ch = TAB) OR (ch = LF) OR (ch = CR) OR (ch >= " ") THEN
  917.                 IF F.text.len > 0 THEN
  918.                     IF pos < F.text.len THEN Texts.OpenReader(R, F.text, pos); Texts.Read(R, ch0) END;
  919.                     IF (pos > 0) & ((pos = F.text.len) OR (ch0 <= " ")) THEN
  920.                         Texts.OpenReader(R, F.text, pos - 1); Texts.Read(R, ch0)
  921.                     END;
  922.                     Texts.SetFont(W, R.fnt); Texts.SetColor(W, R.col);
  923.                     IF (ch = CR) OR (ch = TAB) OR (ch = LF) THEN Texts.SetOffset(W, voff) ELSE Texts.SetOffset(W, R.voff) END
  924.                 ELSE Texts.SetFont(W, fnt); Texts.SetColor(W, col); Texts.SetOffset(W, voff)
  925.                 END;
  926.                 IF ch = LF THEN buf[0] := CR; i := 1; org := F.CarLoc.org; BegOfLine(F.text, org, FALSE);
  927.                     Texts.OpenReader(R, F.text, org);
  928.                     REPEAT Texts.Read(R, ch) UNTIL (R.elem = NIL) OR ~(R.elem IS TextFrames.Parc);
  929.                     WHILE (Texts.Pos(R) <= pos) & (ch <= " ") & (ch # Texts.ElemChar) & (i < 31) DO
  930.                         buf[i] := ch; INC(i); Texts.Read(R, ch)
  931.                     END
  932.                 ELSE buf[0] := ch; i := 1
  933.                 END;
  934.                 WHILE (Input.Available() > 0) & (i < 31) & (ch >= " ") & (ch < DEL) DO Input.Read(buf[i]); INC(i) END;
  935.                 buf[i] := 0X; InsertBuffer
  936.             END;
  937.             IF pos < F.org THEN Show(F, F.org - 1)
  938.             ELSIF pos < F.text.len THEN org := -1;
  939.                 WHILE (pos >= F.trailer.org) & (F.org # org) DO Show(F, F.trailer.next.next.org); Flush; org := F.org END
  940.             ELSE LocatePos(F, pos, loc); LocateChar(F, loc.x + 1, loc.y, loc);
  941.                 IF pos # loc.pos THEN Show(F, F.trailer.next.next.org); Flush END
  942.             END;
  943.             SetCaret(F, pos)
  944.         ELSIF F.focus # NIL THEN input.id := Oberon.consume; input.ch := ch;
  945.             input.fnt := fnt; input.col := col; input.voff := voff; F.focus.handle(F.focus, input)
  946.         ELSIF F.hasSel THEN
  947.             IF ch = CRSL THEN ShiftBlock(F, -1); Flush ELSIF ch = CRSR THEN ShiftBlock(F, 1); Flush END
  948.         END
  949.     END Write;
  950.     PROCEDURE TouchElem* (F: Frame; VAR x, y: INTEGER; VAR keysum: SET);
  951.         VAR loc: Location; e: Texts.Elem; pbeg: LONGINT; y0: INTEGER;
  952.             track: TextFrames.TrackMsg;
  953.     BEGIN LocateChar(F, x, y, loc); e := R.elem;
  954.         IF (e # NIL) & (loc.x + e.W DIV unit <= F.X + F.W - F.right) THEN
  955.             TextFrames.ParcBefore(F.text, loc.pos, P, pbeg);
  956.             y0 := loc.y + loc.line.dsr - SHORT(P.dsr DIV unit) + loc.dy;
  957.             IF (loc.x <= x) & (x < loc.x + e.W DIV unit) & ~loc.trunc THEN
  958.                 track.X := x; track.Y := y; track.keys := keysum;
  959.                 track.fnt := R.fnt; track.col := R.col; track.pos := Texts.Pos(R) - 1;
  960.                 track.frame := F; track.X0 := loc.x; track.Y0 := y0;
  961.                 e.handle(e, track); Input.Mouse(keysum, x, y)
  962.             END
  963.         END
  964.     END TouchElem;
  965.     PROCEDURE Edit* (F: Frame; x, y: INTEGER; keysum: SET);
  966.         VAR ef: Display.Frame; text: Texts.Text; beg, end, time, pos: LONGINT; keys: SET; ch: CHAR;
  967.             copyover: Oberon.CopyOverMsg; input: Oberon.InputMsg;
  968.     BEGIN
  969.         IF x < F.X + F.barW THEN    (*scroll bar*)
  970.             IF leftKey IN keysum THEN TrackLine(F, x, y, pos, keysum)
  971.             ELSIF middleKey IN keysum THEN
  972.                 REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {};
  973.                 IF keysum = {middleKey, leftKey} THEN pos := F.text.len; BegOfLine(F.text, pos, TRUE)
  974.                 ELSIF keysum = {middleKey, rightKey} THEN pos := 0
  975.                 ELSIF (F.Y <= y) & (y <= F.Y + F.H) THEN pos := CoordToPos(F, y - F.Y); BegOfLine(F.text, pos, TRUE)
  976.                 ELSE pos := F.org
  977.                 END
  978.             ELSIF rightKey IN keysum THEN
  979.                 REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {};
  980.                 pos := 0
  981.             ELSE DrawCursor(x, y)
  982.             END;
  983.             IF (keysum # {}) & (keysum # cancel) THEN ShowFrom(F, pos) END
  984.         ELSE    (*text area*)
  985.             ef := ThisSubFrame(F, x, y);
  986.             IF ef # NIL THEN    (*within sub-frame*)
  987.                 IF (F.focus # ef) & (keysum = {leftKey}) THEN
  988.                     REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {};
  989.                     IF keysum = {leftKey} THEN RemoveSelection(F); RemoveCaret(F); PassSubFocus(F, ef); RETURN
  990.                     END
  991.                 ELSIF F.focus = ef THEN input.id := Oberon.track; input.keys := keysum; input.X := x; input.Y := y;
  992.                     ef.handle(ef, input); RETURN
  993.                 END
  994.             END;
  995.             IF keysum # {} THEN TouchElem(F, x, y, keysum) END;
  996.             IF leftKey IN keysum THEN Oberon.PassFocus(Viewers.This(F.X, F.Y)); TrackCaret(F, x, y, keysum);
  997.                 IF (keysum = {leftKey, middleKey}) & F.hasCar THEN Oberon.GetSelection(text, beg, end, time);
  998.                     IF time >= 0 THEN Texts.Save(text, beg, end, B);
  999.                         Texts.Insert(F.text, F.CarLoc.pos, B); SetCaret(F, F.CarLoc.pos + (end - beg))
  1000.                     END
  1001.                 ELSIF (keysum = {leftKey, rightKey}) & F.hasCar & (F.CarLoc.pos < F.text.len) THEN
  1002.                     Oberon.GetSelection(text, beg, end, time);
  1003.                     IF time >= 0 THEN Texts.OpenReader(R, F.text, F.CarLoc.pos); Texts.Read(R, ch);
  1004.                         Texts.ChangeLooks(text, beg, end, {0, 1, 2}, R.fnt, R.col, R.voff)
  1005.                     END
  1006.                 END
  1007.             ELSIF middleKey IN keysum THEN TrackWord(F, x, y, pos, keysum);
  1008.                 IF keysum # cancel THEN Call(F, pos, keysum = {middleKey, leftKey}) END
  1009.             ELSIF rightKey IN keysum THEN TrackSelection(F, x, y, keysum);
  1010.                 IF keysum = {rightKey, middleKey} THEN
  1011.                     copyover.text := F.text; copyover.beg := F.SelBeg.pos; copyover.end := F.SelEnd.pos;
  1012.                     Oberon.FocusViewer.handle(Oberon.FocusViewer, copyover)
  1013.                 ELSIF (keysum = {rightKey, leftKey}) & F.hasSel THEN Oberon.PassFocus(Viewers.This(F.X, F.Y));
  1014.                     Texts.Delete(F.text, F.SelBeg.pos, F.SelEnd.pos); SetCaret(F, F.SelBeg.pos)
  1015.                 END
  1016.             ELSE DrawCursor(x, y)
  1017.             END
  1018.         END
  1019.     END Edit;
  1020.     (** General **)
  1021.     PROCEDURE NotifyElems* (F: Frame; VAR msg: Display.FrameMsg);
  1022.         VAR p, f: Display.Frame;
  1023.     BEGIN f := F.dsc;
  1024.         IF msg IS TextFrames.NotifyMsg THEN msg(TextFrames.NotifyMsg).frame := F END;
  1025.         WHILE f # NIL DO p := f; f := f.next; p.handle(p, msg) END
  1026.     END NotifyElems;
  1027.     PROCEDURE Copy* (SF, DF: Frame);
  1028.         VAR i: INTEGER;
  1029.     BEGIN (*TextFrames.Copy(SF, DF)*)
  1030.         DF.handle := SF.handle; DF.text := SF.text; DF.org := SF.org;
  1031.         DF.left := SF.left; DF.right := SF.right; DF.top := SF.top; DF.bot := SF.bot;
  1032.         DF.barW := SF.barW; DF.hasCar := FALSE; DF.hasSel := FALSE;
  1033.         DF.trailer := NIL; DF.pages := SF.pages; DF.first := SF.first; DF.width := SF.width;
  1034.         i := SF.pages;
  1035.         WHILE i > 0 DO DEC(i); DF.porg[i] := SF.porg[i] END
  1036.     END Copy;
  1037.     PROCEDURE Open* (F: Frame; T: Texts.Text; pos: LONGINT);
  1038.     BEGIN TextFrames.Open(F, T, pos);
  1039.         F.trailer := NIL; F.pages := 0
  1040.     END Open;
  1041.     PROCEDURE Handle* (f: Display.Frame; VAR msg: Display.FrameMsg);
  1042.         VAR F, F1: Frame;
  1043.     BEGIN F := f(Frame);
  1044.         IF msg IS Oberon.InputMsg THEN
  1045.             WITH msg: Oberon.InputMsg DO
  1046.                 IF msg.id = Oberon.consume THEN Write(F, msg.ch, msg.fnt, msg.col, msg.voff)
  1047.                 ELSIF msg.id = Oberon.track THEN Edit(F, msg.X, msg.Y, msg.keys)
  1048.                 END
  1049.             END
  1050.         ELSIF msg IS Oberon.ControlMsg THEN NotifyElems(F, msg);
  1051.             WITH msg: Oberon.ControlMsg DO
  1052.                 IF msg.id = Oberon.defocus THEN RemoveCaret(F)
  1053.                 ELSIF msg.id = Oberon.neutralize THEN Neutralize(F)
  1054.                 END
  1055.             END
  1056.         ELSIF msg IS Oberon.CopyMsg THEN NEW(F1); Copy(F, F1); msg(Oberon.CopyMsg).F := F1
  1057.         ELSIF msg IS TextFrames.UpdateMsg THEN NotifyElems(F, msg);
  1058.             WITH msg: TextFrames.UpdateMsg DO
  1059.                 IF msg.text = F.text THEN MarkMenu(F); Neutralize(F); Update(F, msg) END
  1060.             END
  1061.         ELSIF msg IS Oberon.SelectionMsg THEN NotifyElems(F, msg);
  1062.             WITH msg: Oberon.SelectionMsg DO
  1063.                 IF F.hasSel & (F.time > msg.time) THEN
  1064.                     msg.text := F.text; msg.beg := F.SelBeg.pos; msg.end := F.SelEnd.pos; msg.time := F.time
  1065.                 END
  1066.             END
  1067.         ELSIF msg IS Oberon.CopyOverMsg THEN NotifyElems(F, msg);
  1068.             WITH msg: Oberon.CopyOverMsg DO
  1069.                 IF F.hasCar THEN Texts.Save(msg.text, msg.beg, msg.end, B);
  1070.                     Texts.Insert(F.text, F.CarLoc.pos, B); SetCaret(F, F.CarLoc.pos + (msg.end - msg.beg))
  1071.                 END
  1072.             END
  1073.         ELSIF msg IS MenuViewers.ModifyMsg THEN
  1074.             WITH msg: MenuViewers.ModifyMsg DO Neutralize(F); Resize(F, F.X, msg.Y, F.W, msg.H) END
  1075.         ELSIF msg IS SelectMsg THEN NotifyElems(F, msg);
  1076.             WITH msg: SelectMsg DO
  1077.                 IF (msg.text = F.text) & ~F.hasSel THEN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H); Neutralize(F);
  1078.                     SetSelection(F, msg.beg, msg.end); F.time := msg.time;
  1079.                     IF F.hasSel THEN F.SelBeg.pos := msg.beg; F.SelEnd.pos := msg.end END
  1080.                 END
  1081.             END
  1082.         ELSE NotifyElems(F, msg)
  1083.         END
  1084.     END Handle;
  1085.     PROCEDURE NewText* (T: Texts.Text; pos: LONGINT): Frame;
  1086.         VAR frame: Frame;
  1087.     BEGIN NEW(frame);
  1088.         TextFrames.Open(frame, T, pos);
  1089.         frame.handle := Handle;
  1090.         RETURN frame
  1091.     END NewText;
  1092. BEGIN Texts.OpenWriter(W); Texts.OpenWriter(WL);
  1093.     NEW(PB); Texts.OpenBuf(PB); NEW(B); Texts.OpenBuf(B);
  1094.     pfnt := Fonts.This("Syntax8.Scn.Fnt");
  1095.     TextPrinter.InitFonts
  1096. END TextPFrames.
  1097.