Syntax10.Scn.Fnt Syntax10b.Scn.Fnt Syntax10i.Scn.Fnt Math12.Scn.Fnt Syntax12.Scn.Fnt MODULE TextPFrames; (** CAS 18-Jun-92 / MH 23 May 1993 / JT 07.10.93 (Rel. 2.43) **) IMPORT Modules, Input, Display, Fonts, Viewers, Oberon, MenuViewers, Texts, TextFrames, TextPrinter; CONST mm = TextFrames.mm; Scale = mm DIV 10; unit = TextFrames.Unit; Unit = TextPrinter.Unit; gridAdj = 0; leftAdj = 1; rightAdj = 2; pageBreak = 3; AdjMask = {leftAdj, rightAdj}; TAB = 9X; LF = 0AX; CR = 0DX; DEL = 7FX; BRK = 0ACX; ShiftBRK = 0ADX; CRSL = 0C4X; CRSR = 0C3X; AdjustSpan = 30; MinTabWidth = 1 * Scale; StdTabWidth = 4 * mm; rightKey = 0; middleKey = 1; leftKey = 2; cancel = {rightKey, middleKey, leftKey}; TYPE TextLine = POINTER TO TextLineDesc; Location* = RECORD org*, pos*: LONGINT; x*, y*, dx*, dy*: INTEGER; line: TextLine; trunc: BOOLEAN END; TextLineDesc = RECORD next: TextLine; eot: BOOLEAN; (*contains end of text; first line after page break*) indent: LONGINT; (* first line indentation in units *) pno: INTEGER; (*3 0: page number of page containing first line after page break*) w, h, dsr: INTEGER; (**bounding box clipped to frame*) nob: INTEGER; (*number of contained blanks; > 0 if text line wraps around*) org, len, span: LONGINT; (*len w/o; span w/ trailing CR or white space, if any*) P: TextFrames.Parc; pbeg: LONGINT END; Frame* = POINTER TO FrameDesc; FrameDesc* = RECORD (TextFrames.FrameDesc) CarLoc*, SelBeg*, SelEnd*: Location; trailer: TextLine; (*ring with trailer and header*) pages, first, width: INTEGER; (*nof pages; if > 0: no of first page, print body width in print units*) porg: ARRAY 1024 OF LONGINT END; SelectMsg = RECORD (Display.FrameMsg) text: Texts.Text; beg, end: LONGINT; time: LONGINT END; pfnt: Fonts.Font; (*shared globals => get rid off in a later version?*) W: Texts.Writer; WL: Texts.Writer; PB: Texts.Buffer; B: Texts.Buffer; P: TextFrames.Parc; pbeg: LONGINT; (*inv Pos(P) = pbeg*) R: Texts.Reader; nextCh: CHAR; (*inv Base(R) = T => T[Pos(R)-1] = nextCh]*) PROCEDURE Min (x, y: INTEGER): INTEGER; BEGIN IF x < y THEN RETURN x ELSE RETURN y END END Min; PROCEDURE Max (x, y: INTEGER): INTEGER; BEGIN IF x > y THEN RETURN x ELSE RETURN y END END Max; PROCEDURE PU (x: INTEGER): INTEGER; (*screen to printer space*) BEGIN RETURN SHORT((x * LONG(unit) + Unit DIV 2) DIV Unit) END PU; PROCEDURE SU (x: INTEGER): INTEGER; (*printer to screen space*) BEGIN RETURN SHORT((x * LONG(Unit) + unit DIV 2) DIV unit) END SU; PROCEDURE MarkMenu (F: Frame); VAR R: Texts.Reader; V: Viewers.Viewer; T: Texts.Text; ch: CHAR; BEGIN V := Viewers.This(F.X, F.Y); IF (V IS MenuViewers.Viewer) & (V.dsc IS TextFrames.Frame) THEN T := V.dsc(TextFrames.Frame).text; IF T.len > 0 THEN Texts.OpenReader(R, T, T.len - 1); Texts.Read(R, ch) ELSE ch := 0X END; IF ch # "!" THEN Texts.Write(WL, "!"); Texts.Append(T, WL.buf) END END END MarkMenu; (* Element Subframes *) PROCEDURE InvertBorder (F: Display.Frame); BEGIN Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y-1, F.W+2, 1, Display.invert); Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y+F.H, F.W+2, 1, Display.invert); Display.ReplPattern(Display.white, Display.grey1, F.X-1, F.Y, 1, F.H, Display.invert); Display.ReplPattern(Display.white, Display.grey1, F.X+F.W, F.Y, 1, F.H, Display.invert) END InvertBorder; PROCEDURE InvalSubFrames (F: Frame; x, y, w, h: INTEGER); VAR p, f: Display.Frame; msg: MenuViewers.ModifyMsg; BEGIN IF (w > 0) & (h > 0) THEN f := F.dsc; IF f # NIL THEN p := f; f := p.next END; WHILE f # NIL DO IF (f.X < x + w) & (f.X + f.W > x) & (f.Y < y + h) & (f.Y + f.H > y) THEN p.next := f.next; msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := 0; f.handle(f, msg) ELSE p := f END; f := p.next END; f := F.dsc; 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; msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := 0; f.handle(f, msg) END END END InvalSubFrames; PROCEDURE ShiftSubFrames (F: Frame; oldY, newY, h: INTEGER); VAR f: Display.Frame; msg: MenuViewers.ModifyMsg; BEGIN IF oldY > newY THEN InvalSubFrames(F, F.X, newY, F.W, oldY - newY) ELSE InvalSubFrames(F, F.X, oldY + h, F.W, newY - oldY) END; f := F.dsc; WHILE f # NIL DO IF (f.Y < oldY + h) & (f.Y + f.H > oldY) THEN INC(f.Y, newY - oldY); msg.id := MenuViewers.reduce; msg.dY := 0; msg.Y := f.Y; msg.H := f.H; f.handle(f, msg) END; f := f.next END END ShiftSubFrames; (* Display Primitives *) PROCEDURE DrawCursor (x, y: INTEGER); BEGIN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y) END DrawCursor; PROCEDURE TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET); BEGIN Input.Mouse(keys, x, y); keysum := keysum + keys; DrawCursor(x, y) END TrackMouse; PROCEDURE EraseRect (F: Frame; x, y, w, h: INTEGER); BEGIN Display.ReplConst(Display.black, x, y, w, h, Display.replace); InvalSubFrames(F, x, y, w, h) END EraseRect; PROCEDURE Erase (F: Frame; x, y, w, h: INTEGER); (*RemoveMarks optimization*) BEGIN IF h > 0 THEN Oberon.RemoveMarks(x, y, w, h); EraseRect(F, x, y, w, h) END END Erase; PROCEDURE Shift (F: Frame; oldY, newY, h: INTEGER); (*RemoveMarks optimization*) BEGIN IF (oldY # newY) & (h > 0) THEN Oberon.RemoveMarks(F.X + F.left, Min(oldY, newY), F.W - F.left, Max(oldY, newY) + h); Display.CopyBlock(F.X + F.left, oldY, F.W - F.left, h, F.X + F.left, newY, Display.replace); ShiftSubFrames(F, oldY, newY, h) END END Shift; PROCEDURE InvertCaret (F: Frame); VAR loc: Location; BEGIN loc := F.CarLoc; Display.CopyPattern(Display.white, Display.hook, loc.x, loc.y + loc.line.dsr - 6, Display.invert) END InvertCaret; PROCEDURE InvertRect (F: Frame; x, y, w, h: INTEGER); (*clips to right and bottom frame margin*) BEGIN IF x + w > F.X + F.W - F.right THEN w := F.X + F.W - F.right - x END; IF y >= F.Y + F.bot THEN Display.ReplConst(Display.white, x, y, w, h, Display.invert) END END InvertRect; PROCEDURE InvertSelection (F: Frame; beg, end: Location); VAR t: TextLine; ex, rx, w, py: INTEGER; BEGIN rx := F.X + F.W - F.right; t := end.line; IF t.eot OR (end.pos <= t.org + t.len) THEN ex := end.x ELSE ex := rx END; IF beg.line = end.line THEN InvertRect(F, beg.x, beg.y, ex - beg.x, beg.line.h) ELSE t := beg.line; py := beg.y; w := F.W - F.left - F.right; InvertRect(F, beg.x, py, rx - beg.x, t.h); t := t.next; DEC(py, t.h); WHILE t # end.line DO InvertRect(F, F.X + F.left, py, w, t.h); t := t.next; DEC(py, t.h) END; IF end.line.eot THEN InvertRect(F, F.X + F.left, py, end.x - (F.X + F.left), t.h) ELSE InvertRect(F, F.X + F.left, py, ex - (F.X + F.left), t.h) END END END InvertSelection; PROCEDURE CoordToPos (F: Frame; mh: INTEGER): LONGINT; VAR h: INTEGER; BEGIN h := F.H - 1; IF h > 0 THEN RETURN ((h - mh) * F.text.len + h DIV 2) DIV h ELSE RETURN 0 END END CoordToPos; PROCEDURE ShowBar (F: Frame; botH, topH: INTEGER); BEGIN IF (F.left > F.barW) & (F.barW > 0) THEN Display.ReplConst(Display.white, F.X + F.barW - 1, F.Y + botH, 1, topH - botH, Display.replace) END END ShowBar; PROCEDURE Tick (F: Frame); BEGIN IF (0 <= F.markH) & (F.markH < F.H) & (F.left > F.barW) & (F.barW > 6) & (F.H > 1) THEN Display.ReplConst(Display.white, F.X + 1, F.Y + F.markH, F.barW - 6, 1, Display.invert) END END Tick; PROCEDURE ShowTick (F: Frame); (*removes global marks as needed*) VAR h, mh: INTEGER; len: LONGINT; BEGIN h := F.H - 1; len := F.text.len; IF len > 0 THEN mh := SHORT(h - h * F.org DIV len) ELSE mh := h END; IF F.markH # mh THEN Oberon.RemoveMarks(F.X, F.Y, F.barW, F.H); Tick(F); F.markH := mh; Tick(F) END END ShowTick; (** Pagination Support **) PROCEDURE LocatePage* (F: Frame; org: LONGINT; VAR porg: LONGINT; VAR pno: INTEGER); VAR i: INTEGER; BEGIN i := 0; WHILE (i < F.pages) & (F.porg[i] < org) DO INC(i) END; IF i < F.pages THEN porg := F.porg[i]; pno := F.first + i ELSE porg := F.text.len; pno := LEN(F.porg) END END LocatePage; PROCEDURE GetPagination* (F: Frame; VAR pages, first, width: INTEGER; VAR porg: ARRAY OF LONGINT); VAR i: INTEGER; BEGIN pages := Min(F.pages, SHORT(LEN(porg))); first := F.first; width := F.width; i := pages; WHILE i > 0 DO DEC(i); F.porg[i] := porg[i] END END GetPagination; PROCEDURE SetPagination* (F: Frame; pages, first, width: INTEGER; VAR porg: ARRAY OF LONGINT); BEGIN pages := Min(pages, LEN(F.porg)); F.pages := pages; F.first := first; F.width := width; WHILE pages > 0 DO DEC(pages); F.porg[pages] := porg[pages] END END SetPagination; (* Screen Metrics *) PROCEDURE GetChar (fnt: Fonts.Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER; VAR pat: Display.Pattern); (*dx, x, w: printer space*) BEGIN Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat); dx := SHORT(TextPrinter.DX(TextPrinter.FontNo(fnt), ch) DIV Unit); x := PU(x); w := PU(w) END GetChar; PROCEDURE Tab (dw: INTEGER; VAR dx: INTEGER); (*P set*) VAR i, n: INTEGER; w: LONGINT; BEGIN i := 0; n := P.nofTabs; w := LONG(dw) * Unit + MinTabWidth; IF dw < 0 THEN dx := -dw ELSE WHILE (i < n) & (P.tab[i] < w) DO INC(i) END; IF i < n THEN dx := SHORT((P.tab[i] - LONG(dw) * Unit) DIV Unit) ELSE dx := StdTabWidth DIV Unit END END END Tab; PROCEDURE MeasureSpecial (dw: INTEGER; VAR dx, x, y, w, h: INTEGER; VAR trunc: BOOLEAN); (*P, R, nextCh set*) (*dx, x, w: printer space*) VAR e: Texts.Elem; pat: Display.Pattern; pw, ph: LONGINT; msg: TextFrames.DisplayMsg; pmsg: TextPrinter.PrintMsg; BEGIN IF nextCh = " " THEN GetChar(R.fnt, nextCh, dx, x, y, w, h, pat); x := 0; y := 0; w := dx; h := 0; trunc := FALSE ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0; trunc := FALSE ELSIF R.elem # NIL THEN e := R.elem; pmsg.prepare := TRUE; pmsg.indent := LONG(dw) * Unit; pmsg.fnt := R.fnt; pmsg.col := R.col; pmsg.pos := Texts.Pos(R)-1; pmsg.Y0 := -SHORT(P.dsr DIV Unit); e.handle(e, pmsg); pw := e.W; ph := e.H; msg.prepare := TRUE; msg.indent := LONG(dw) * Unit; msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R)-1; msg.Y0 := -SHORT(P.dsr DIV unit); e.handle(e, msg); w := SHORT(pw DIV Unit); h := SHORT(ph DIV unit); dx := w; x := 0; y := msg.Y0; trunc := ~(e IS TextFrames.Parc) & ((pw < e.W) OR (ph < e.H)) ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat); trunc := FALSE END END MeasureSpecial; PROCEDURE GetSpecial (F: Frame; VAR n: INTEGER; cn, ddx, dw: INTEGER; VAR dx, x, y, w, h: INTEGER; VAR trunc: BOOLEAN); (*P, R, nextCh set*) (*ddx, dw, dx, x, w: printer space*) VAR e: Texts.Elem; pat: Display.Pattern; BEGIN IF nextCh = " " THEN GetChar(R.fnt, nextCh, dx, x, y, w, h, pat); x := 0; y := 0; INC(dx, ddx); INC(n); IF n <= cn THEN INC(dx) END; (*space correction for block adjustment*) w := dx; h := 0; trunc := FALSE ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0; trunc := FALSE ELSIF R.elem # NIL THEN e := R.elem; IF (e IS TextFrames.Parc) & (P.W = 9999 * Unit) THEN w := Min(SHORT((P.width + P.left) DIV Unit), PU(F.W - F.right - F.left)); e.W := w * LONG(Unit); h := SHORT(e.H DIV unit); trunc := FALSE ELSE MeasureSpecial(dw, dx, x, y, w, h, trunc) END; dx := w; x := 0; y := -SHORT(P.dsr DIV unit) ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat); trunc := FALSE END END GetSpecial; PROCEDURE NextLine (T: Texts.Text; VAR org: LONGINT); (*R, nextCh set*) VAR pat: Display.Pattern; pos, bk, d: LONGINT; width, tw, dx, x, y, w, h: INTEGER; trunc: BOOLEAN; R1: Texts.Reader; peekCh: CHAR; indent: LONGINT; BEGIN tw := 0; dx := 0; w := 0; bk := -999; (*org = Texts.Pos(R)-1*) pos := org; TextFrames.ParcBefore(T, pos, P, pbeg); width := SHORT(P.width DIV Unit); indent := 0; IF org > 0 THEN Texts.OpenReader(R1, T, org - 1); Texts.Read(R1, peekCh); IF (peekCh = CR) OR (R1.elem # NIL) & (R1.elem IS TextFrames.Parc) THEN indent := P.first END; END; DEC(width, SHORT(indent DIV Unit)); LOOP INC(pos); (*inv pos = Texts.Pos(R), ~R.eof => nextCh = text[pos-1]*) IF R.eot OR (nextCh = CR) THEN EXIT END; INC(tw, dx); IF nextCh <= " " THEN MeasureSpecial(tw + SHORT(indent DIV Unit), dx, x, y, w, h, trunc) ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat) END; IF tw + x + dx > width THEN d := pos - bk; IF (0 <= d) & (d < AdjustSpan) & (nextCh > " ") THEN pos := bk ELSIF ((nextCh > " ") OR (nextCh = Texts.ElemChar)) & (pos > org + 1) THEN DEC(pos) END; Texts.OpenReader(R, T, pos); Texts.Read(R, nextCh); EXIT END; IF (nextCh <= " ") & (nextCh # Texts.ElemChar) THEN bk := pos END; Texts.Read(R, nextCh) END; org := pos END NextLine; PROCEDURE BegOfLine* (T: Texts.Text; VAR pos: LONGINT; adjust: BOOLEAN); VAR p, org: LONGINT; BEGIN IF pos <= 0 THEN pos := 0 ELSE IF pos <= T.len THEN org := pos ELSE org := T.len END; LOOP (*search backwards for CR*) IF org = 0 THEN EXIT END; Texts.OpenReader(R, T, org - 1); Texts.Read(R, nextCh); IF nextCh = CR THEN EXIT END; DEC(org) END; IF adjust THEN (*search forward for actual line origin*) Texts.OpenReader(R, T, org); Texts.Read(R, nextCh); p := org; REPEAT org := p; NextLine(T, p) UNTIL (p > pos) OR R.eot END; pos := org END END BegOfLine; PROCEDURE AdjustMetrics (F: Frame; t: TextLine; VAR pw, tw, ddx, cn: INTEGER); (*t.org set*) (*pw, tw, ddx, cn: printer space*) VAR w: INTEGER; BEGIN P := t.P; pbeg := t.pbeg; pw := PU(F.left); tw := PU(t.w); ddx := 0; cn := 0; IF t.pbeg # t.org THEN INC(pw, SHORT((P.left + t.indent) DIV Unit)); DEC(tw, SHORT(t.indent DIV Unit)); IF leftAdj IN P.opts THEN IF (rightAdj IN P.opts) & (t.nob > 0) THEN w := tw; tw := SHORT((P.width - t.indent) DIV Unit); ddx := (tw - w) DIV t.nob; cn := (tw - w) MOD t.nob END ELSIF rightAdj IN P.opts THEN INC(pw, SHORT(P.width DIV Unit) - tw) ELSE (*center*) INC(pw, (SHORT(P.width DIV Unit) - tw) DIV 2) END END END AdjustMetrics; (* Screen Placement *) PROCEDURE DrawSpecial (F: Frame; px, py, x, y: INTEGER); (*R, nextCh set*) (*px, x: printer space*) VAR e: Texts.Elem; pat: Display.Pattern; dx, w, h: INTEGER; msg: TextFrames.DisplayMsg; BEGIN IF (nextCh = " ") OR (nextCh = CR) OR (nextCh = TAB) THEN (*skip*) ELSIF R.elem # NIL THEN e := R.elem; IF ~(e IS TextFrames.Parc) OR F.showsParcs THEN msg.prepare := FALSE; msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R) - 1; msg.frame := F; msg.X0 := SU(px + x); msg.Y0 := py + y; msg.elemFrame := NIL; e.handle(e, msg); IF msg.elemFrame # NIL THEN msg.elemFrame.next := F.dsc; F.dsc := msg.elemFrame END ELSIF (e IS TextFrames.Parc) & ~F.showsParcs & (pageBreak IN e(TextFrames.Parc).opts) THEN Display.ReplPattern(Display.white, Display.grey1, SU(px + x), py, SHORT(e.W DIV Unit), 1, Display.replace) END ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat); Display.CopyPattern(R.col, pat, SU(px + x), py + y, Display.replace) END; END DrawSpecial; PROCEDURE DrawBanner (F: Frame; pno, bw, px, py, th, mw: INTEGER); VAR pat: Display.Pattern; i, j, dx, x, y, w, h: INTEGER; pstr: ARRAY 5 OF CHAR; BEGIN IF bw <= mw THEN Display.ReplPattern(Display.white, Display.grey1, px + bw, py, 1, th, Display.replace); DEC(bw, 2) ELSE bw := mw END; INC(py, th - 18); i := 0; j := pno; REPEAT pstr[i] := CHR(30H + j MOD 10); j := j DIV 10; INC(i) UNTIL j = 0; WHILE j < i DO Display.GetChar(pfnt.raster, pstr[j], dx, x, y, w, h, pat); DEC(bw, dx); INC(j) END; Display.ReplConst(Display.white, px, py, bw - 2, 1, Display.replace); Display.ReplConst(Display.white, px, py + 2, bw - 2, 1, Display.replace); INC(px, bw); WHILE i > 0 DO DEC(i); Display.GetChar(pfnt.raster, pstr[i], dx, x, y, w, h, pat); Display.CopyPattern(Display.white, pat, px + x, py + y, Display.replace); INC(px, dx) END END DrawBanner; PROCEDURE ShowLine (F: Frame; t: TextLine; left, right, py: INTEGER); (*left, right: printer space*) VAR pat: Display.Pattern; i: LONGINT; trunc: BOOLEAN; n, cn, lm, px, pw, tw, ddx, dx, x, y, w, h: INTEGER; BEGIN Texts.OpenReader(R, F.text, t.org); AdjustMetrics(F, t, pw, tw, ddx, cn); IF F.pages > 0 THEN IF SU(F.width) < F.W - F.left - F.right THEN Display.ReplPattern(Display.white, Display.grey1, F.X + F.left + SU(F.width), py, 1, t.h, Display.replace) END; IF t.pno >= 0 THEN DrawBanner(F, t.pno, SU(F.width), F.X + F.left, py, t.h, F.W - F.left - F.right) END END; lm := PU(F.X + F.left) + SHORT(P.left DIV Unit); px := PU(F.X) + pw; INC(py, t.dsr); i := 0; n := 0; WHILE i < t.len DO Texts.Read(R, nextCh); IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, px - lm, dx, x, y, w, h, trunc) ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat) END; INC(y, R.fnt.height * R.voff DIV 64); IF px + x + w <= right THEN IF px + x >= left THEN IF nextCh <= " " THEN IF trunc THEN Display.ReplPattern(R.col, Display.grey0, SU(px + x), py + y, SU(w), h, Display.replace) ELSE DrawSpecial(F, px, py, x, y) END ELSE Display.CopyPattern(R.col, pat, SU(px + x), py + y, Display.replace) END END; INC(px, dx); INC(i) ELSE i := t.len END END END ShowLine; PROCEDURE ShowLines (F: Frame; botH, topH: INTEGER); VAR t: TextLine; ph: INTEGER; BEGIN t := F.trailer.next; ph := F.H - F.top; WHILE (t # F.trailer) & (ph - t.h >= topH) DO DEC(ph, t.h); t := t.next END; WHILE (t # F.trailer) & (ph - t.h >= botH) DO DEC(ph, t.h); ShowLine(F, t, PU(F.X + F.left), PU(F.X + F.W - F.right), F.Y + ph); t := t.next END END ShowLines; PROCEDURE ShowLinesErasing (F: Frame; botH, topH: INTEGER); VAR t: TextLine; ph: INTEGER; BEGIN t := F.trailer.next; ph := F.H - F.top; WHILE (t # F.trailer) & (ph - t.h >= topH) DO DEC(ph, t.h); t := t.next END; WHILE (t # F.trailer) & (ph - t.h >= botH) DO DEC(ph, t.h); Erase(F, F.X + F.left, F.Y + ph, F.W - F.right - F.left, t.h); ShowLine(F, t, PU(F.X + F.left), PU(F.X + F.W - F.right), F.Y + ph); t := t.next END END ShowLinesErasing; (* Screen Casting *) PROCEDURE MeasureLine (F: Frame; maxW: INTEGER; t: TextLine); (*R, nextCh set*) VAR pat: Display.Pattern; porg, len, bklen, d: LONGINT; eol, trunc: BOOLEAN; nob, bknob, width, minY, bkminY, maxY, bkmaxY, tw, bktw, lsp, dsr, dx, x, y, w, h: INTEGER; R1: Texts.Reader; peekCh: CHAR; BEGIN len := 0; nob := 0; bklen := -999; tw := 0; dx := 0; minY := 0; maxY := 0; TextFrames.ParcBefore(F.text, t.org, P, pbeg); lsp := SHORT(P.lsp DIV unit); dsr := SHORT(P.dsr DIV unit); width := SHORT(P.width DIV Unit); t.indent := 0; IF t.org > 0 THEN Texts.OpenReader(R1, F.text, t.org - 1); Texts.Read(R1, peekCh); IF (peekCh = CR) OR (R1.elem # NIL) & (R1.elem IS TextFrames.Parc) THEN t.indent := P.first END; END; DEC(width, SHORT(t.indent DIV Unit)); LOOP INC(tw, dx); IF R.eot OR (nextCh = CR) THEN nob := 0; eol := ~R.eot; EXIT END; IF nextCh <= " " THEN MeasureSpecial(tw + SHORT(t.indent DIV Unit), dx, x, y, w, h, trunc) ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat) END; IF tw + x + dx > width THEN d := len - bklen; IF (0 <= d) & (d < AdjustSpan) & (nextCh > " ") THEN eol := TRUE; Texts.OpenReader(R, F.text, Texts.Pos(R) - d); nob := bknob; len := bklen; tw := bktw; minY := bkminY; maxY := bkmaxY ELSIF len = 0 THEN (*force at least one character on each line*) INC(len); INC(y, R.fnt.height * R.voff DIV 64); minY := Min(minY, y); maxY := Max(maxY, y + h); Texts.Read(R, nextCh); eol := FALSE; tw := maxW ELSE eol := (nextCh <= " ") & (nextCh # Texts.ElemChar) END; EXIT END; IF (nextCh <= " ") & (nextCh # Texts.ElemChar) THEN bknob := nob; bklen := len; bktw := tw; bkminY := minY; bkmaxY := maxY; IF nextCh = " " THEN INC(nob) END END; INC(len); INC(y, R.fnt.height * R.voff DIV 64); minY := Min(minY, y); maxY := Max(maxY, y + h); Texts.Read(R, nextCh) END; IF ~F.showsParcs & (pbeg = t.org) THEN dsr := 0; t.h := SHORT(P.lead DIV unit) + 1 ELSIF gridAdj IN P.opts THEN WHILE dsr < -minY DO INC(dsr, lsp) END; t.h := Max(lsp, dsr + maxY); INC(t.h, (-t.h) MOD lsp) ELSE dsr := Max(dsr, -minY); t.h := Max(lsp, dsr + maxY) END; LocatePage(F, t.org, porg, t.pno); IF t.org = porg THEN INC(t.h, 20) ELSE t.pno := -1 END; t.len := len; t.w := Min(SU(tw), maxW); t.dsr := dsr; t.nob := nob; t.eot := R.eot; t.P := P; t.pbeg := pbeg; IF eol THEN Texts.Read(R, nextCh); t.span := len + 1 ELSE t.span := len END END MeasureLine; PROCEDURE MeasureLines (F: Frame; org: LONGINT; VAR trailer: TextLine); VAR s, t: TextLine; ph: INTEGER; BEGIN NEW(trailer); s := trailer; Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); ph := F.H - F.top; LOOP NEW(t); t.org := org; MeasureLine(F, F.W - F.left - F.right, t); IF ph - t.h < F.bot THEN EXIT END; s.next := t; s := t; INC(org, s.span); DEC(ph, s.h); IF R.eot THEN EXIT END END; s.next := trailer; trailer.eot := TRUE; trailer.org := org; trailer.len := 0; trailer.w := 0; trailer.h := SHORT(TextFrames.defParc.lsp DIV unit); trailer.P := P; trailer.pbeg := pbeg END MeasureLines; (** Locators **) PROCEDURE LocateLineTop (F: Frame; trailer: TextLine; org: LONGINT; VAR loc: Location); VAR t: TextLine; ph: INTEGER; BEGIN ph := F.H - F.top; t := trailer.next; WHILE (t # trailer) & (t.org # org) DO DEC(ph, t.h); t := t.next END; loc.org := org; loc.line := t; loc.y := F.Y + ph END LocateLineTop; PROCEDURE Width (F: Frame; t: TextLine; pos: LONGINT; VAR pw, dx, dy: INTEGER); (*pw, dx: printer space*) VAR pat: Display.Pattern; i: LONGINT; n, mw, lm, tw, ddx, cn, x, y, w, h: INTEGER; trunc: BOOLEAN; BEGIN AdjustMetrics(F, t, pw, tw, ddx, cn); dy := 0; lm := PU(F.left) + SHORT(P.left DIV Unit); IF t # F.trailer THEN Texts.OpenReader(R, F.text, t.org); Texts.Read(R, nextCh); i := 0; n := 0; DEC(pos, t.org); dx := 0; mw := PU(F.W - F.right); WHILE ~R.eot & (i < t.len) & (i <= pos) & (pw + dx <= mw) DO INC(i); INC(pw, dx); IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, pw - lm, dx, x, y, w, h, trunc) ELSE GetChar(R.fnt, nextCh, dx, x, y, w, h, pat) END; dy := R.fnt.height * R.voff DIV 64; Texts.Read(R, nextCh) END; IF (i <= pos) & (pw + dx <= mw) THEN INC(i); INC(pw, dx) END ELSE dx := PU(4) END END Width; PROCEDURE LocatePos* (F: Frame; pos: LONGINT; VAR loc: Location); VAR t: TextLine; pw, dx, dy: INTEGER; BEGIN IF pos < F.org THEN pos := F.org; t := F.trailer.next ELSIF pos < F.trailer.org THEN t := F.trailer; WHILE (t.next # F.trailer) & (t.next.org <= pos) DO t := t.next END ELSE pos := F.trailer.org; t := F.trailer.next; WHILE ~t.eot DO t := t.next END END; Width(F, t, pos, pw, dx, dy); LocateLineTop(F, F.trailer, t.org, loc); DEC(loc.y, loc.line.h); loc.org := t.org; loc.pos := pos; loc.x := F.X + SU(pw); loc.dx := SU(dx); loc.dy := dy; loc.line := t; loc.trunc := FALSE END LocatePos; PROCEDURE LocateLine* (F: Frame; y: INTEGER; VAR loc: Location); VAR t: TextLine; h, ph, pw, tw, ddx, cn: INTEGER; BEGIN t := F.trailer.next; h := y - F.Y; ph := F.H - F.top - t.h; WHILE ~t.eot & (ph - t.next.h >= F.bot) & (ph > h) DO t := t.next; DEC(ph, t.h) END; AdjustMetrics(F, t, pw, tw, ddx, cn); IF pw >= PU(F.X + F.W - F.right) THEN pw := PU(F.X + F.W - F.right - 4) END; loc.org := t.org; loc.pos := loc.org; loc.x := F.X + SU(pw); loc.y := F.Y + ph; loc.dx := SU(tw); loc.dy := 0; loc.line := t; loc.trunc := FALSE END LocateLine; PROCEDURE LocateChar* (F: Frame; x, y: INTEGER; VAR loc: Location); VAR t: TextLine; pat: Display.Pattern; i: LONGINT; trunc: BOOLEAN; n, w, lm, pw, tw, ddx, cn, dx, xc, yc, wc, hc: INTEGER; BEGIN LocateLine(F, y, loc); t := loc.line; w := PU(x - F.X); AdjustMetrics(F, t, pw, tw, ddx, cn); lm := PU(F.left) + SHORT(P.left DIV Unit); IF (t # F.trailer) & (w > pw) THEN Texts.OpenReader(R, F.text, t.org); i := 0; n := 0; dx := 0; nextCh := 0X; WHILE (i < t.len) & (pw + dx < w) DO Texts.Read(R, nextCh); INC(i); INC(pw, dx); IF nextCh <= " " THEN GetSpecial(F, n, cn, ddx, pw - lm, dx, xc, yc, wc, hc, trunc) ELSE GetChar(R.fnt, nextCh, dx, xc, yc, wc, hc, pat); trunc := FALSE END END; IF pw + dx < w THEN INC(i); INC(pw, dx); R.elem := NIL END; INC(loc.pos, i - 1); loc.x := F.X + SU(pw); loc.trunc := trunc; IF i < t.len THEN loc.dx := SU(dx); loc.dy := R.fnt.height * R.voff DIV 64 ELSE loc.dx := 4 END ELSE loc.dx := 4 END END LocateChar; PROCEDURE LocateWord* (F: Frame; x, y: INTEGER; VAR loc: Location); VAR t: TextLine; pos, i: LONGINT; px, rx: INTEGER; pat: Display.Pattern; dx, xc, yc, wc, hc: INTEGER; BEGIN LocateChar(F, x, y, loc); pos := loc.pos + 1; REPEAT DEC(pos); Texts.OpenReader(R, F.text, pos); Texts.Read(R, nextCh) UNTIL (pos < loc.org) OR (nextCh > " "); INC(pos); REPEAT DEC(pos); Texts.OpenReader(R, F.text, pos); Texts.Read(R, nextCh) UNTIL (pos < loc.org) OR (nextCh <= " "); LocatePos(F, pos + 1, loc); t := loc.line; i := loc.pos - loc.org; IF i < t.len THEN px := PU(loc.x); rx := PU(F.X + F.W - F.right); Texts.OpenReader(R, F.text, loc.pos); dx := 0; wc := 0; nextCh := "x"; WHILE (i < t.len) & (nextCh > " ") & (px + dx < rx) DO Texts.Read(R, nextCh); INC(i); INC(px, dx); GetChar(R.fnt, nextCh, dx, xc, yc, wc, hc, pat) END; IF (nextCh > " ") & (px + dx < rx) THEN INC(i); INC(px, dx) END; loc.dx := SU(px) - loc.x ELSE loc.dx := 0 END END LocateWord; PROCEDURE Pos* (F: Frame; x, y: INTEGER): LONGINT; VAR loc: Location; BEGIN LocateChar(F, x, y, loc); RETURN loc.pos END Pos; PROCEDURE ThisSubFrame* (F: Frame; x, y: INTEGER): Display.Frame; VAR f: Display.Frame; BEGIN f := F.dsc; 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; RETURN f END ThisSubFrame; (** Caret & Selection **) PROCEDURE PassSubFocus* (F: Frame; f: Display.Frame); VAR loc: Location; f1: Display.Frame; ctrl: Oberon.ControlMsg; focus: TextFrames.FocusMsg; BEGIN IF F.focus # NIL THEN f1 := F.focus; ctrl.id := Oberon.defocus; f1.handle(f1, ctrl); LocateChar(F, f1.X + 1, f1.Y + 1, loc); focus.focus := FALSE; focus.elemFrame := f1; focus.frame := F; R.elem.handle(R.elem, focus); InvertBorder(f1) END; IF f # NIL THEN LocateChar(F, f.X + 1, f.Y + 1, loc); focus.focus := TRUE; focus.elemFrame := f; focus.frame := F; R.elem.handle(R.elem, focus); InvertBorder(f) END; F.focus := f END PassSubFocus; PROCEDURE RemoveSelection* (F: Frame); BEGIN IF F.hasSel THEN InvertSelection(F, F.SelBeg, F.SelEnd); F.hasSel := FALSE END END RemoveSelection; PROCEDURE SetSelection* (F: Frame; beg, end: LONGINT); (**forces range to visible bounds**) VAR loc: Location; BEGIN IF end > F.text.len THEN end := F.text.len END; IF end > beg THEN IF F.hasSel & (F.SelBeg.pos = beg) THEN IF (F.SelEnd.pos < end) & (F.SelEnd.pos < F.trailer.org) THEN LocatePos(F, F.SelEnd.pos, loc); LocatePos(F, end, F.SelEnd); InvertSelection(F, loc, F.SelEnd) ELSIF end < F.SelEnd.pos THEN LocatePos(F, end, loc); InvertSelection(F, loc, F.SelEnd); LocatePos(F, end, F.SelEnd) END ELSIF ~F.hasSel OR (F.SelBeg.pos # beg) OR (F.SelEnd.pos # end) THEN RemoveSelection(F); PassSubFocus(F, NIL); LocatePos(F, beg, F.SelBeg); LocatePos(F, end, F.SelEnd); InvertSelection(F, F.SelBeg, F.SelEnd) END; F.hasSel := TRUE; F.time := Oberon.Time() END END SetSelection; PROCEDURE RemoveCaret* (F: Frame); VAR msg: Oberon.ControlMsg; BEGIN IF F.focus # NIL THEN msg.id := Oberon.defocus; F.focus.handle(F.focus, msg) END; IF F.hasCar THEN InvertCaret(F); F.hasCar := FALSE END END RemoveCaret; PROCEDURE SetCaret* (F: Frame; pos: LONGINT); (**only done if within visible bounds**) BEGIN IF ~F.hasCar OR (F.CarLoc.pos # pos) THEN RemoveCaret(F); PassSubFocus(F, NIL); LocatePos(F, pos, F.CarLoc); IF (F.H - F.top - F.bot >= F.CarLoc.line.h) & (F.CarLoc.x <= F.X + F.W - F.right) THEN LocateChar(F, F.CarLoc.x + 1, F.CarLoc.y, F.CarLoc); (*prevent "dangling" caret at right margin*) IF F.CarLoc.pos = pos THEN InvertCaret(F); F.hasCar := TRUE END END END END SetCaret; PROCEDURE Neutralize* (F: Frame); VAR f: Display.Frame; msg: Oberon.ControlMsg; BEGIN RemoveCaret(F); RemoveSelection(F); f := F.dsc; msg.id := Oberon.neutralize; WHILE f # NIL DO f.handle(f, msg); IF f = F.focus THEN PassSubFocus(F, NIL) END; f := f.next END END Neutralize; (** Display Range **) PROCEDURE Complete (F: Frame; trailer: TextLine; VAR s: TextLine; VAR org: LONGINT; VAR ph: INTEGER); VAR u: TextLine; BEGIN IF ph > F.bot THEN (*try to add new lines to the bottom*) Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); LOOP IF R.eot THEN EXIT END; NEW(u); u.org := org; MeasureLine(F, F.W - F.left - F.right, u); IF ph - u.h < F.bot THEN EXIT END; s.next := u; s := s.next; DEC(ph, s.h); INC(org, s.span) END END; s.next := trailer; trailer.eot := TRUE; trailer.org := org; trailer.len := 0; trailer.w := 0; trailer.h := SHORT(TextFrames.defParc.lsp DIV unit); trailer.P := P; trailer.pbeg := pbeg END Complete; PROCEDURE ShowFrom (F: Frame; pos: LONGINT); (*removes global marks as needed and neutralizes F*) VAR new, s: TextLine; beg, end: Location; org: LONGINT; ph, y0, dy: INTEGER; BEGIN Neutralize(F); IF (F.trailer # NIL) & (F.org < pos) & (pos < F.trailer.org) THEN (*shift up and extend to the bottom*) LocateLineTop(F, F.trailer, pos, beg); LocateLineTop(F, F.trailer, F.trailer.org, end); dy := (F.Y + F.H - F.top) - beg.y; Shift(F, end.y, end.y + dy, beg.y - end.y); Erase(F, F.X + F.left, end.y, F.W - F.left, dy); s := F.trailer.next; WHILE s.org # pos DO s := s.next END; F.trailer.next := s; org := s.org + s.span; ph := F.H - F.top - s.h; Complete(F, F.trailer, s, org, ph); F.org := pos; ShowLines(F, F.bot, end.y + dy - F.Y) ELSIF (F.trailer = NIL) OR (pos # F.org) THEN MeasureLines(F, pos, new); IF (F.trailer # NIL) & (pos < F.org) & (F.org <= new.org) THEN (*shift down and extend to the top*) LocateLineTop(F, new, F.org, beg); LocateLineTop(F, new, new.org, end); y0 := F.Y + F.H - F.top; Shift(F, y0 - (beg.y - end.y), end.y, beg.y - end.y); Erase(F, F.X + F.left, beg.y, F.W - F.left, y0 - beg.y); Erase(F, F.X + F.left, F.Y + F.bot, F.W - F.left, end.y - (F.Y + F.bot)); F.org := pos; F.trailer := new; ShowLines(F, beg.y - F.Y, F.H - F.top) ELSE (*full redisplay*) IF F.trailer = NIL THEN Erase(F, F.X, F.Y, F.W, F.H); ShowBar(F, 0, F.H); F.markH := -1 ELSE Erase(F, F.X + F.left, F.Y + F.bot, F.W - F.left, F.H - F.bot - F.top) END; F.org := pos; F.trailer := new; ShowLines(F, F.bot, F.H - F.top) END END; ShowTick(F) END ShowFrom; PROCEDURE Show* (F: Frame; pos: LONGINT); (**removes global marks as needed and neutralizes F**) BEGIN BegOfLine(F.text, pos, TRUE); ShowFrom(F, pos) END Show; PROCEDURE Resize* (F: Frame; x, y, w, h: INTEGER); VAR loc: Location; oldY, oldH, dh: INTEGER; BEGIN IF (w = 0) OR (h = 0) THEN InvalSubFrames(F, F.X, F.Y, F.W, F.H); F.X := x; F.Y := y; F.W := w; F.H := h; F.trailer := NIL ELSIF (F.trailer # NIL) & (x = F.X) & (w = F.W) THEN oldY := F.Y; oldH := F.H; Tick(F); F.markH := -1; F.Y := y; F.H := h; IF h > oldH THEN dh := h - oldH; Display.CopyBlock(x, oldY, w, oldH, x, y + dh, Display.replace); ShiftSubFrames(F, oldY, y + dh, oldH); EraseRect(F, x, y, w, dh); ShowBar(F, 0, dh); LocateLineTop(F, F.trailer, F.trailer.org, loc); MeasureLines(F, F.org, F.trailer); ShowLines(F, F.bot, loc.y - F.Y) ELSE dh := oldH - h; MeasureLines(F, F.org, F.trailer); LocateLineTop(F, F.trailer, F.trailer.org, loc); Display.CopyBlock(x, oldY + dh, w, h, x, y, Display.replace); ShiftSubFrames(F, oldY + dh, y, h); EraseRect(F, x + F.left, y, w - F.left, loc.y - F.Y); InvalSubFrames(F, x, oldY, w, y - oldY); InvalSubFrames(F, x, y + h, w, dh - (y - oldY)) END; ShowTick(F) ELSE F.X := x; F.Y := y; F.W := w; F.H := h; F.trailer := NIL; Show(F, F.org) END END Resize; (** Contents Update **) PROCEDURE Update* (F: Frame; VAR msg: TextFrames.UpdateMsg); (**removes global marks as needed**) VAR t: TextLine; org, d: LONGINT; PROCEDURE Begin (VAR beg: LONGINT; VAR org0: LONGINT; VAR q: TextLine); (*returns q # NIL if beg > org0*) VAR trailer, t: TextLine; p: LONGINT; BEGIN trailer := F.trailer; t := trailer; q := NIL; WHILE (t.next # trailer) & (t.next.org + t.next.span <= beg) & ~t.next.eot DO t := t.next END; IF (t # trailer) & (t.next # trailer) & (beg <= t.next.org + t.next.span) THEN Texts.OpenReader(R, F.text, t.org); Texts.Read(R, nextCh); p := t.org; NextLine(F.text, p); IF p = t.next.org THEN q := t.next; org0 := q.org ELSE org0 := t.org; beg := org0 END ELSE BegOfLine(F.text, beg, TRUE); IF (msg.beg < beg + AdjustSpan) & (F.org < beg) THEN DEC(beg); BegOfLine(F.text, beg, TRUE) END; org0 := beg END END Begin; PROCEDURE Adjust (end, delta: LONGINT); VAR new, old, s, t, u, p, q: TextLine; bot: Location; org, org0, beg: LONGINT; ph, h0, h1, H1, h2, lm, dx, dy: INTEGER; BEGIN q := NIL; LocateLineTop(F, F.trailer, F.trailer.org, bot); IF msg.beg < F.org THEN org0 := F.org; beg := org0 ELSE beg := msg.beg; Begin(beg, org0, q) END; NEW(new); s := new; old := F.trailer; t := old; org := F.org; ph := F.H - F.top; WHILE (t.next # old) & (t.next.org # org0) DO t := t.next; (*transfer unchanged prefix*) s.next := t; s := t; DEC(ph, s.h); INC(org, s.span) END; h0 := ph; H1 := h0; t := t.next; p := s; Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh); (*rebuilt at least one line descriptor*) LOOP NEW(u); u.org := org; MeasureLine(F, F.W - F.left - F.right, u); IF ph - u.h < F.bot THEN h1 := ph; h2 := h1; EXIT END; s.next := u; s := s.next; DEC(ph, s.h); INC(org, s.span); IF R.eot THEN h1 := ph; h2 := h1; EXIT END; IF org > end THEN WHILE (t # old) & (org > t.org + delta) DO DEC(H1, t.h); t := t.next END; IF (org = t.org + delta) & (P = t.P) THEN h1 := ph; (*resynchronized*) WHILE (t # old) & (ph - t.h >= F.bot) DO (*transfer unchanged suffix*) s.next := t; s := t; s.org := org; TextFrames.ParcBefore(F.text, s.org, s.P, s.pbeg); DEC(ph, s.h); INC(org, s.span); t := t.next END; h2 := ph; EXIT END END END; Shift(F, F.Y + h2 + (H1 - h1), F.Y + h2, h1 - h2); Complete(F, new, s, org, ph); F.trailer := new; t := p.next; 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 P := t.P; pbeg := t.pbeg; IF (P.opts * AdjMask = {leftAdj}) OR (P.opts * AdjMask = AdjMask) & (q.nob = 0) & (t.nob = 0) THEN Width(F, t, beg, lm, dx, dy); (*preserve prefix of first affected line*) DEC(h0, t.h); Erase(F, F.X + SU(lm), F.Y + h0, F.W - SU(lm), t.h); ShowLine(F, t, PU(F.X) + lm, PU(F.X + F.W - F.right), F.Y + h0) END END; ShowLinesErasing(F, h1, h0); Erase(F, F.X + F.left, bot.y, F.W - F.left, h2 - (bot.y - F.Y)); ShowLines(F, F.bot, h2) END Adjust; BEGIN IF (msg.id = Texts.insert) & (msg.beg < F.org) THEN t := F.trailer; d := msg.end - msg.beg; INC(F.org, d); REPEAT INC(t.org, d); t := t.next UNTIL t = F.trailer ELSIF (msg.id = Texts.delete) & (msg.end <= F.org) THEN t := F.trailer; d := msg.end - msg.beg; DEC(F.org, d); REPEAT DEC(t.org, d); t := t.next UNTIL t = F.trailer END; org := F.org; IF msg.beg <= F.org + AdjustSpan THEN BegOfLine(F.text, org, TRUE) END; TextFrames.ParcBefore(F.text, org, P, d); IF (org # F.org) OR (P # F.trailer.next.P) OR (F.pages # 0) THEN F.trailer := NIL; F.pages := 0; Show(F, F.org) ELSIF (msg.end > org) & (msg.beg < F.trailer.org + AdjustSpan) THEN IF msg.id = Texts.replace THEN Adjust(msg.end, 0) ELSIF msg.id = Texts.insert THEN Adjust(msg.end, msg.end - msg.beg) ELSIF msg.id = Texts.delete THEN Adjust(msg.beg, msg.beg - msg.end) END END; ShowTick(F) END Update; (** User Interface **) PROCEDURE TrackLine* (F: Frame; VAR x, y: INTEGER; VAR org: LONGINT; VAR keysum: SET); VAR keys: SET; new, old: Location; BEGIN LocateLine(F, y, old); InvertRect(F, old.x, old.y, old.dx + 4, 2); REPEAT TrackMouse(x, y, keys, keysum); LocateLine(F, y, new); IF new.org # old.org THEN InvertRect(F, new.x, new.y, new.dx + 4, 2); InvertRect(F, old.x, old.y, old.dx + 4, 2); old := new END UNTIL keys = {}; InvertRect(F, new.x, new.y, new.dx + 4, 2); org := new.org END TrackLine; PROCEDURE TrackWord* (F: Frame; VAR x, y: INTEGER; VAR pos: LONGINT; VAR keysum: SET); VAR keys: SET; new, old: Location; BEGIN LocateWord(F, x, y, old); InvertRect(F, old.x, old.y, old.dx, 2); REPEAT TrackMouse(x, y, keys, keysum); LocateWord(F, x, y, new); IF new.pos # old.pos THEN InvertRect(F, new.x, new.y, new.dx, 2); InvertRect(F, old.x, old.y, old.dx, 2); old := new END UNTIL keys = {}; InvertRect(F, new.x, new.y, new.dx, 2); pos := new.pos END TrackWord; PROCEDURE TrackCaret* (F: Frame; VAR x, y: INTEGER; VAR keysum: SET); VAR keys: SET; BEGIN REPEAT TrackMouse(x, y, keys, keysum); SetCaret(F, Pos(F, x, y)) UNTIL keys = {} END TrackCaret; PROCEDURE TrackSelection* (F: Frame; VAR x, y: INTEGER; VAR keysum: SET); VAR keys: SET; pos: LONGINT; V: Viewers.Viewer; f: Frame; BEGIN V := Viewers.This(F.X, F.Y); V := V.next(Viewers.Viewer); IF (V.dsc # NIL) & (V.dsc.next # NIL) & (V.dsc.next IS Frame) THEN f := V.dsc.next(Frame); IF f.hasSel & (f.text = F.text) THEN IF (f.SelBeg.pos < f.trailer.org) & (f.org < f.SelEnd.pos) & (f.SelBeg.pos <= Pos(F, x, y)) THEN SetSelection(F, f.SelBeg.pos, Pos(F, x, y) + 1) ELSE RemoveSelection(f); f := NIL END ELSE f := NIL END ELSE f := NIL END; IF f = NIL THEN IF F.hasSel & (F.SelBeg.pos + 1 = F.SelEnd.pos) & (Pos(F, x, y) = F.SelBeg.pos) THEN SetSelection(F, F.SelBeg.org, Pos(F, x, y) + 1) ELSE SetSelection(F, Pos(F, x, y), Pos(F, x, y) + 1) END END; REPEAT TrackMouse(x, y, keys, keysum); pos := Pos(F, x, y) + 1; IF F.hasSel THEN IF pos > F.SelBeg.pos THEN SetSelection(F, F.SelBeg.pos, pos); IF f # NIL THEN SetSelection(f, f.SelBeg.pos, pos); f.SelEnd.pos := F.SelEnd.pos END END ELSE SetSelection(F, Pos(F, x, y), Pos(F, x, y) + 1) END UNTIL keys = {}; IF f # NIL THEN F.SelBeg.pos := f.SelBeg.pos END END TrackSelection; PROCEDURE Call* (F: Frame; pos: LONGINT; new: BOOLEAN); VAR S: Texts.Scanner; par: Oberon.ParList; res: INTEGER; BEGIN Texts.OpenScanner(S, F.text, pos); Texts.Scan(S); IF (S.line = 0) & (S.class = Texts.Name) THEN NEW(par); par.frame := F; par.text := F.text; par.pos := Texts.Pos(S)-1; Oberon.Call(S.s, par, new, res); IF res > 1 THEN Texts.WriteString(WL, "Call error: "); Texts.WriteString(WL, Modules.importing); IF res = 2 THEN Texts.WriteString(WL, " not an obj-file") ELSIF res = 3 THEN Texts.WriteString(WL, " imports "); Texts.WriteString(WL, Modules.imported); Texts.WriteString(WL, " with bad key") ELSIF res = 4 THEN Texts.WriteString(WL, " corrupted obj file") ELSIF res = 6 THEN Texts.WriteString(WL, " has too many imports") ELSIF res = 7 THEN Texts.WriteString(WL, " not enough space") END; Texts.WriteLn(WL); Texts.Append(Oberon.Log, WL.buf) END END END Call; PROCEDURE ShiftBlock (F: Frame; delta: INTEGER); VAR text: Texts.Text; pos, beg, end, time: LONGINT; select: SelectMsg; ch: CHAR; BEGIN Oberon.GetSelection(text, beg, end, time); IF (time >= 0) & (text = F.text) THEN BegOfLine(F.text, beg, FALSE); pos := beg; WHILE pos < end DO Texts.OpenReader(R, F.text, pos); Texts.Read(R, ch); WHILE (R.elem # NIL) & (R.elem IS TextFrames.Parc) & (pos < end) DO Texts.Read(R, ch); INC(pos) END; IF pos < end THEN IF delta < 0 THEN IF (ch <= " ") & (ch # CR) & (ch # Texts.ElemChar) THEN Texts.Delete(F.text, pos, pos + 1); DEC(end) END ELSE IF (ch <= " ") & (ch # CR) & (ch # Texts.ElemChar) THEN Texts.Write(W, ch) (*first char extension*) ELSE Texts.Write(W, TAB) END; Texts.Insert(F.text, pos, W.buf); INC(end); INC(pos) END; Texts.OpenReader(R, F.text, pos); REPEAT Texts.Read(R, ch) UNTIL R.eot OR (ch = CR); pos := Texts.Pos(R) END END; select.text := F.text; select.beg := beg; select.end := pos; select.time := Oberon.Time(); Viewers.Broadcast(select) END END ShiftBlock; PROCEDURE Write* (F: Frame; ch: CHAR; fnt: Fonts.Font; col, voff: SHORTINT); VAR loc: Location; parc: TextFrames.Parc; org, pos, pbeg: LONGINT; i: INTEGER; ch0: CHAR; buf: ARRAY 32 OF CHAR; copy: Texts.CopyMsg; input: Oberon.InputMsg; PROCEDURE Visible(ch: CHAR): BOOLEAN; VAR pat: Display.Pattern; dx, x, y, w, h: INTEGER; BEGIN GetChar(W.fnt, ch, dx, x, y, w, h, pat); RETURN dx > 0 END Visible; PROCEDURE InsertBuffer; VAR i, j: INTEGER; ch: CHAR; BEGIN i := 0; j := 0; ch := buf[i]; WHILE ch # 0X DO IF (ch = TAB) OR (ch = CR) OR (ch = " ") OR Visible(ch) THEN Texts.Write(W, ch); INC(j) END; INC(i); ch := buf[i] END; IF j > 0 THEN Texts.Insert(F.text, pos, W.buf); INC(pos, LONG(j)) END END InsertBuffer; PROCEDURE Flush; VAR ch: CHAR; BEGIN WHILE Input.Available() > 0 DO Input.Read(ch) END END Flush; BEGIN IF F.hasCar THEN pos := F.CarLoc.pos; IF (ch = DEL) & (pos > F.org) THEN DEC(pos); Texts.Delete(F.text, pos, pos + 1); Flush ELSIF (ch = CRSL) & (pos > 0) THEN DEC(pos) ELSIF (ch = CRSR) & (pos < F.text.len) THEN INC(pos) ELSIF (ch = BRK) OR (ch = ShiftBRK) THEN TextFrames.ParcBefore(F.text, pos, P, pbeg); P.handle(P, copy); parc := copy.e(TextFrames.Parc); IF ch = BRK THEN EXCL(parc.opts, pageBreak) ELSE INCL(parc.opts, pageBreak) END; Texts.SetFont(W, fnt); Texts.SetColor(W, col); Texts.SetOffset(W, voff); Texts.WriteElem(W, parc); Texts.Insert(F.text, pos, W.buf); INC(pos) ELSIF (ch = TAB) OR (ch = LF) OR (ch = CR) OR (ch >= " ") THEN IF F.text.len > 0 THEN IF pos < F.text.len THEN Texts.OpenReader(R, F.text, pos); Texts.Read(R, ch0) END; IF (pos > 0) & ((pos = F.text.len) OR (ch0 <= " ")) THEN Texts.OpenReader(R, F.text, pos - 1); Texts.Read(R, ch0) END; Texts.SetFont(W, R.fnt); Texts.SetColor(W, R.col); IF (ch = CR) OR (ch = TAB) OR (ch = LF) THEN Texts.SetOffset(W, voff) ELSE Texts.SetOffset(W, R.voff) END ELSE Texts.SetFont(W, fnt); Texts.SetColor(W, col); Texts.SetOffset(W, voff) END; IF ch = LF THEN buf[0] := CR; i := 1; org := F.CarLoc.org; BegOfLine(F.text, org, FALSE); Texts.OpenReader(R, F.text, org); REPEAT Texts.Read(R, ch) UNTIL (R.elem = NIL) OR ~(R.elem IS TextFrames.Parc); WHILE (Texts.Pos(R) <= pos) & (ch <= " ") & (ch # Texts.ElemChar) & (i < 31) DO buf[i] := ch; INC(i); Texts.Read(R, ch) END ELSE buf[0] := ch; i := 1 END; WHILE (Input.Available() > 0) & (i < 31) & (ch >= " ") & (ch < DEL) DO Input.Read(buf[i]); INC(i) END; buf[i] := 0X; InsertBuffer END; IF pos < F.org THEN Show(F, F.org - 1) ELSIF pos < F.text.len THEN org := -1; WHILE (pos >= F.trailer.org) & (F.org # org) DO Show(F, F.trailer.next.next.org); Flush; org := F.org END ELSE LocatePos(F, pos, loc); LocateChar(F, loc.x + 1, loc.y, loc); IF pos # loc.pos THEN Show(F, F.trailer.next.next.org); Flush END END; SetCaret(F, pos) ELSIF F.focus # NIL THEN input.id := Oberon.consume; input.ch := ch; input.fnt := fnt; input.col := col; input.voff := voff; F.focus.handle(F.focus, input) ELSIF F.hasSel THEN IF ch = CRSL THEN ShiftBlock(F, -1); Flush ELSIF ch = CRSR THEN ShiftBlock(F, 1); Flush END END END Write; PROCEDURE TouchElem* (F: Frame; VAR x, y: INTEGER; VAR keysum: SET); VAR loc: Location; e: Texts.Elem; pbeg: LONGINT; y0: INTEGER; track: TextFrames.TrackMsg; BEGIN LocateChar(F, x, y, loc); e := R.elem; IF (e # NIL) & (loc.x + e.W DIV unit <= F.X + F.W - F.right) THEN TextFrames.ParcBefore(F.text, loc.pos, P, pbeg); y0 := loc.y + loc.line.dsr - SHORT(P.dsr DIV unit) + loc.dy; IF (loc.x <= x) & (x < loc.x + e.W DIV unit) & ~loc.trunc THEN track.X := x; track.Y := y; track.keys := keysum; track.fnt := R.fnt; track.col := R.col; track.pos := Texts.Pos(R) - 1; track.frame := F; track.X0 := loc.x; track.Y0 := y0; e.handle(e, track); Input.Mouse(keysum, x, y) END END END TouchElem; PROCEDURE Edit* (F: Frame; x, y: INTEGER; keysum: SET); VAR ef: Display.Frame; text: Texts.Text; beg, end, time, pos: LONGINT; keys: SET; ch: CHAR; copyover: Oberon.CopyOverMsg; input: Oberon.InputMsg; BEGIN IF x < F.X + F.barW THEN (*scroll bar*) IF leftKey IN keysum THEN TrackLine(F, x, y, pos, keysum) ELSIF middleKey IN keysum THEN REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {}; IF keysum = {middleKey, leftKey} THEN pos := F.text.len; BegOfLine(F.text, pos, TRUE) ELSIF keysum = {middleKey, rightKey} THEN pos := 0 ELSIF (F.Y <= y) & (y <= F.Y + F.H) THEN pos := CoordToPos(F, y - F.Y); BegOfLine(F.text, pos, TRUE) ELSE pos := F.org END ELSIF rightKey IN keysum THEN REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {}; pos := 0 ELSE DrawCursor(x, y) END; IF (keysum # {}) & (keysum # cancel) THEN ShowFrom(F, pos) END ELSE (*text area*) ef := ThisSubFrame(F, x, y); IF ef # NIL THEN (*within sub-frame*) IF (F.focus # ef) & (keysum = {leftKey}) THEN REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {}; IF keysum = {leftKey} THEN RemoveSelection(F); RemoveCaret(F); PassSubFocus(F, ef); RETURN END ELSIF F.focus = ef THEN input.id := Oberon.track; input.keys := keysum; input.X := x; input.Y := y; ef.handle(ef, input); RETURN END END; IF keysum # {} THEN TouchElem(F, x, y, keysum) END; IF leftKey IN keysum THEN Oberon.PassFocus(Viewers.This(F.X, F.Y)); TrackCaret(F, x, y, keysum); IF (keysum = {leftKey, middleKey}) & F.hasCar THEN Oberon.GetSelection(text, beg, end, time); IF time >= 0 THEN Texts.Save(text, beg, end, B); Texts.Insert(F.text, F.CarLoc.pos, B); SetCaret(F, F.CarLoc.pos + (end - beg)) END ELSIF (keysum = {leftKey, rightKey}) & F.hasCar & (F.CarLoc.pos < F.text.len) THEN Oberon.GetSelection(text, beg, end, time); IF time >= 0 THEN Texts.OpenReader(R, F.text, F.CarLoc.pos); Texts.Read(R, ch); Texts.ChangeLooks(text, beg, end, {0, 1, 2}, R.fnt, R.col, R.voff) END END ELSIF middleKey IN keysum THEN TrackWord(F, x, y, pos, keysum); IF keysum # cancel THEN Call(F, pos, keysum = {middleKey, leftKey}) END ELSIF rightKey IN keysum THEN TrackSelection(F, x, y, keysum); IF keysum = {rightKey, middleKey} THEN copyover.text := F.text; copyover.beg := F.SelBeg.pos; copyover.end := F.SelEnd.pos; Oberon.FocusViewer.handle(Oberon.FocusViewer, copyover) ELSIF (keysum = {rightKey, leftKey}) & F.hasSel THEN Oberon.PassFocus(Viewers.This(F.X, F.Y)); Texts.Delete(F.text, F.SelBeg.pos, F.SelEnd.pos); SetCaret(F, F.SelBeg.pos) END ELSE DrawCursor(x, y) END END END Edit; (** General **) PROCEDURE NotifyElems* (F: Frame; VAR msg: Display.FrameMsg); VAR p, f: Display.Frame; BEGIN f := F.dsc; IF msg IS TextFrames.NotifyMsg THEN msg(TextFrames.NotifyMsg).frame := F END; WHILE f # NIL DO p := f; f := f.next; p.handle(p, msg) END END NotifyElems; PROCEDURE Copy* (SF, DF: Frame); VAR i: INTEGER; BEGIN (*TextFrames.Copy(SF, DF)*) DF.handle := SF.handle; DF.text := SF.text; DF.org := SF.org; DF.left := SF.left; DF.right := SF.right; DF.top := SF.top; DF.bot := SF.bot; DF.barW := SF.barW; DF.hasCar := FALSE; DF.hasSel := FALSE; DF.trailer := NIL; DF.pages := SF.pages; DF.first := SF.first; DF.width := SF.width; i := SF.pages; WHILE i > 0 DO DEC(i); DF.porg[i] := SF.porg[i] END END Copy; PROCEDURE Open* (F: Frame; T: Texts.Text; pos: LONGINT); BEGIN TextFrames.Open(F, T, pos); F.trailer := NIL; F.pages := 0 END Open; PROCEDURE Handle* (f: Display.Frame; VAR msg: Display.FrameMsg); VAR F, F1: Frame; BEGIN F := f(Frame); IF msg IS Oberon.InputMsg THEN WITH msg: Oberon.InputMsg DO IF msg.id = Oberon.consume THEN Write(F, msg.ch, msg.fnt, msg.col, msg.voff) ELSIF msg.id = Oberon.track THEN Edit(F, msg.X, msg.Y, msg.keys) END END ELSIF msg IS Oberon.ControlMsg THEN NotifyElems(F, msg); WITH msg: Oberon.ControlMsg DO IF msg.id = Oberon.defocus THEN RemoveCaret(F) ELSIF msg.id = Oberon.neutralize THEN Neutralize(F) END END ELSIF msg IS Oberon.CopyMsg THEN NEW(F1); Copy(F, F1); msg(Oberon.CopyMsg).F := F1 ELSIF msg IS TextFrames.UpdateMsg THEN NotifyElems(F, msg); WITH msg: TextFrames.UpdateMsg DO IF msg.text = F.text THEN MarkMenu(F); Neutralize(F); Update(F, msg) END END ELSIF msg IS Oberon.SelectionMsg THEN NotifyElems(F, msg); WITH msg: Oberon.SelectionMsg DO IF F.hasSel & (F.time > msg.time) THEN msg.text := F.text; msg.beg := F.SelBeg.pos; msg.end := F.SelEnd.pos; msg.time := F.time END END ELSIF msg IS Oberon.CopyOverMsg THEN NotifyElems(F, msg); WITH msg: Oberon.CopyOverMsg DO IF F.hasCar THEN Texts.Save(msg.text, msg.beg, msg.end, B); Texts.Insert(F.text, F.CarLoc.pos, B); SetCaret(F, F.CarLoc.pos + (msg.end - msg.beg)) END END ELSIF msg IS MenuViewers.ModifyMsg THEN WITH msg: MenuViewers.ModifyMsg DO Neutralize(F); Resize(F, F.X, msg.Y, F.W, msg.H) END ELSIF msg IS SelectMsg THEN NotifyElems(F, msg); WITH msg: SelectMsg DO IF (msg.text = F.text) & ~F.hasSel THEN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H); Neutralize(F); SetSelection(F, msg.beg, msg.end); F.time := msg.time; IF F.hasSel THEN F.SelBeg.pos := msg.beg; F.SelEnd.pos := msg.end END END END ELSE NotifyElems(F, msg) END END Handle; PROCEDURE NewText* (T: Texts.Text; pos: LONGINT): Frame; VAR frame: Frame; BEGIN NEW(frame); TextFrames.Open(frame, T, pos); frame.handle := Handle; RETURN frame END NewText; BEGIN Texts.OpenWriter(W); Texts.OpenWriter(WL); NEW(PB); Texts.OpenBuf(PB); NEW(B); Texts.OpenBuf(B); pfnt := Fonts.This("Syntax8.Scn.Fnt"); TextPrinter.InitFonts END TextPFrames.