Oberon/V2/TextFrames
< Oberon
MODULE TextFrames; (*JG 8.10.90*)
IMPORT Input, Modules, Display, Viewers, MenuViewers, Fonts, Texts, Oberon;
CONST
replace* = 0; insert* = 1; delete* = 2; (*message id*)
CR = 0DX;
TYPE
Line = POINTER TO LineDesc;
LineDesc = RECORD
len: LONGINT;
wid: INTEGER;
eot: BOOLEAN;
next: Line
END;
Location* = RECORD
org*, pos*: LONGINT;
dx*, x*, y*: INTEGER;
lin: Line
END;
Frame* = POINTER TO FrameDesc;
FrameDesc* = RECORD (Display.FrameDesc)
text*: Texts.Text;
org*: LONGINT;
col*: INTEGER;
lsp*: INTEGER;
left*, right*, top*, bot*: INTEGER;
markH*: INTEGER;
time*: LONGINT;
mark*, car*, sel*: INTEGER;
carloc*: Location;
selbeg*, selend*: Location;
trailer: Line
END;
(*mark < 0: arrow mark
mark = 0: no mark
mark > 0: position mark*)
UpdateMsg* = RECORD (Display.FrameMsg)
id*: INTEGER;
text*: Texts.Text;
beg*, end*: LONGINT
END;
VAR
menuH*, barW*, left*, right*, top*, bot*, lsp*: INTEGER; (*standard sizes*)
asr, dsr, selH, markW, eolW: INTEGER;
par: Oberon.ParList; nextCh: CHAR;
W, KW: Texts.Writer; (*keyboard writer*)
PROCEDURE Min (i, j: INTEGER): INTEGER;
BEGIN IF i >= j THEN RETURN j ELSE RETURN i END
END Min;
(*------------------display support------------------------*)
PROCEDURE ReplConst (col: INTEGER; F: Frame; X, Y, W, H: INTEGER; mode: INTEGER);
BEGIN
IF X + W <= F.X + F.W THEN Display.ReplConst(col, X, Y, W, H, mode)
ELSIF X < F.X + F.W THEN Display.ReplConst(col, X, Y, F.X + F.W - X, H, mode)
END
END ReplConst;
PROCEDURE FlipMark (F: Frame);
BEGIN
IF (F.mark > 0) & (F.left >= barW) THEN
Display.ReplConst(Display.white, F.X + 1, F.Y + F.H - 1 - F.markH, markW, 1, 2)
END
END FlipMark;
PROCEDURE UpdateMark (F: Frame);
VAR oldH: INTEGER;
BEGIN
oldH := F.markH; F.markH := SHORT(F.org * F.H DIV (F.text.len + 1));
IF (F.mark > 0) & (F.left >= barW) & (F.markH # oldH) THEN
Display.ReplConst(Display.white, F.X + 1, F.Y + F.H - 1 - oldH, markW, 1, 2);
Display.ReplConst(Display.white, F.X + 1, F.Y + F.H - 1 - F.markH, markW, 1, 2)
END
END UpdateMark;
PROCEDURE Width (VAR R: Texts.Reader; len: LONGINT): INTEGER;
VAR pat: Display.Pattern; pos: LONGINT; ox, dx, x, y, w, h: INTEGER;
BEGIN pos := 0; ox := 0;
WHILE pos # len DO
Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat);
ox := ox + dx; INC(pos); Texts.Read(R, nextCh)
END;
RETURN ox
END Width;
PROCEDURE DisplayLine (F: Frame; L: Line;
VAR R: Texts.Reader; X, Y: INTEGER; len: LONGINT);
VAR pat: Display.Pattern; NX, dx, x, y, w, h: INTEGER;
BEGIN NX := F.X + F.W;
WHILE (nextCh # CR) & (R.fnt # NIL) DO
Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat);
IF (X + x + w <= NX) & (h # 0) THEN
Display.CopyPattern(R.col, pat, X + x, Y + y, 2)
END;
X := X + dx; INC(len); Texts.Read(R, nextCh)
END;
L.len := len + 1; L.wid := X + eolW - (F.X + F.left);
L.eot := R.fnt = NIL; Texts.Read(R, nextCh)
END DisplayLine;
PROCEDURE Validate (T: Texts.Text; VAR pos: LONGINT);
VAR R: Texts.Reader;
BEGIN
IF pos > T.len THEN pos := T.len
ELSIF pos > 0 THEN
DEC(pos); Texts.OpenReader(R, T, pos);
REPEAT Texts.Read(R, nextCh); INC(pos) UNTIL R.eot OR (nextCh = CR)
ELSE pos := 0
END
END Validate;
PROCEDURE Mark* (F: Frame; mark: INTEGER);
BEGIN
IF ((mark >= 0) = (F.mark < 0)) & (F.H >= 16) THEN
Display.CopyPattern(Display.white, Display.downArrow, F.X, F.Y, 2)
END;
IF ((mark > 0) = (F.mark <= 0)) & (F.H > 0) & (F.left >= barW) THEN
Display.ReplConst(Display.white, F.X + 1, F.Y + F.H - 1 - F.markH, markW, 1, 2)
END;
F.mark := mark
END Mark;
PROCEDURE Restore* (F: Frame);
VAR R: Texts.Reader; L, l: Line; curY, botY: INTEGER;
BEGIN (*F.mark = 0*)
Display.ReplConst(F.col, F.X, F.Y, F.W, F.H, 0);
IF F.left >= barW THEN
Display.ReplConst(Display.white, F.X + barW - 1, F.Y, 1, F.H, 2)
END;
Validate(F.text, F.org);
botY := F.Y + F.bot + dsr;
Texts.OpenReader(R, F.text, F.org); Texts.Read(R, nextCh);
L := F.trailer; curY := F.Y + F.H - F.top - asr;
WHILE ~L.eot & (curY >= botY) DO
NEW(l);
DisplayLine(F, l, R, F.X + F.left, curY, 0);
L.next := l; L := l; curY := curY - lsp
END;
L.next := F.trailer;
F.markH := SHORT(F.org * F.H DIV (F.text.len + 1))
END Restore;
PROCEDURE Suspend* (F: Frame);
BEGIN (*F.mark = 0*)
F.trailer.next := F.trailer
END Suspend;
PROCEDURE Extend* (F: Frame; newY: INTEGER);
VAR R: Texts.Reader; L, l: Line; org: LONGINT; curY, botY: INTEGER;
BEGIN (*F.mark = 0*)
Display.ReplConst(F.col, F.X, newY, F.W, F.Y - newY, 0);
IF F.left >= barW THEN
Display.ReplConst(Display.white, F.X + barW - 1, newY, 1, F.Y - newY, 2)
END;
F.H := F.H + F.Y - newY; F.Y := newY;
IF F.trailer.next = F.trailer THEN Validate(F.text, F.org) END;
L := F.trailer; org := F.org; curY := F.Y + F.H - F.top - asr;
WHILE L.next # F.trailer DO
L := L.next; org := org + L.len; curY := curY - lsp
END;
botY := F.Y + F.bot + dsr;
Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);
WHILE ~L.eot & (curY >= botY) DO NEW(l);
DisplayLine(F, l, R, F.X + F.left, curY, 0);
L.next := l; L := l; curY := curY - lsp
END;
L.next := F.trailer;
F.markH := SHORT(F.org * F.H DIV (F.text.len + 1))
END Extend;
PROCEDURE Reduce* (F: Frame; newY: INTEGER);
VAR L: Line; curY, botY: INTEGER;
BEGIN (*F.mark = 0*)
F.H := F.H + F.Y - newY; F.Y := newY;
botY := F.Y + F.bot + dsr;
L := F.trailer; curY := F.Y + F.H - F.top - asr;
WHILE (L.next # F.trailer) & (curY >= botY) DO
L := L.next; curY := curY - lsp
END;
L.next := F.trailer;
IF curY + asr > F.Y THEN
Display.ReplConst(F.col, F.X + F.left, F.Y, F.W - F.left, curY + asr - F.Y, 0)
END;
F.markH := SHORT(F.org * F.H DIV (F.text.len + 1));
Mark(F, 1)
END Reduce;
PROCEDURE Show* (F: Frame; pos: LONGINT);
VAR R: Texts.Reader; L, l: Line;
org: LONGINT; curY, botY, Y0: INTEGER; keys: SET;
BEGIN
IF F.trailer.next # F.trailer THEN
Validate(F.text, pos);
IF pos < F.org THEN Mark(F, 0);
Display.ReplConst(F.col, F.X + F.left, F.Y, F.W - F.left, F.H, 0);
botY := F.Y; F.Y := F.Y + F.H; F.H := 0;
F.org := pos; F.trailer.next := F.trailer; Extend(F, botY);
Mark(F, 1)
ELSIF pos > F.org THEN
org := F.org; L := F.trailer.next; curY := F.Y + F.H - F.top - asr;
WHILE (L.next # F.trailer) & (org # pos) DO
org := org + L.len; L := L.next; curY := curY - lsp;
END;
IF org = pos THEN
F.org := org; F.trailer.next := L; Y0 := curY;
WHILE L.next # F.trailer DO
org := org + L.len; L := L.next; curY := curY - lsp
END;
Display.CopyBlock
(F.X + F.left, curY - dsr, F.W - F.left, Y0 + asr - (curY - dsr),
F.X + F.left, curY - dsr + F.Y + F.H - F.top - asr - Y0, 0);
curY := curY + F.Y + F.H - F.top - asr - Y0;
Display.ReplConst(F.col, F.X + F.left, F.Y, F.W - F.left, curY - dsr - F.Y, 0);
botY := F.Y + F.bot + dsr;
org := org + L.len; curY := curY - lsp;
Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);
WHILE ~L.eot & (curY >= botY) DO NEW(l);
DisplayLine(F, l, R, F.X + F.left, curY, 0);
L.next := l; L := l; curY := curY - lsp
END;
L.next := F.trailer;
UpdateMark(F)
ELSE Mark(F, 0);
Display.ReplConst(F.col, F.X + F.left, F.Y, F.W - F.left, F.H, 0);
botY := F.Y; F.Y := F.Y + F.H; F.H := 0;
F.org := pos; F.trailer.next := F.trailer; Extend(F, botY);
Mark(F, 1)
END
END
END
END Show;
PROCEDURE LocateLine (F: Frame; y: INTEGER; VAR loc: Location);
VAR T: Texts.Text; L: Line; org: LONGINT; cury: INTEGER;
BEGIN T := F.text;
org := F.org; L := F.trailer.next; cury := F.H - F.top - asr;
WHILE (L.next # F.trailer) & (cury > y + dsr) DO
org := org + L.len; L := L.next; cury := cury - lsp
END;
loc.org := org; loc.lin := L; loc.y := cury
END LocateLine;
PROCEDURE LocateString (F: Frame; x, y: INTEGER; VAR loc: Location);
VAR R: Texts.Reader; pat: Display.Pattern;
bpos, pos, lim: LONGINT; bx, ex, ox, dx, u, v, w, h: INTEGER;
BEGIN LocateLine(F, y, loc);
lim := loc.org + loc.lin.len - 1;
bpos := loc.org; bx := F.left;
pos := loc.org; ox := F.left;
Texts.OpenReader(R, F.text, loc.org); Texts.Read(R, nextCh);
LOOP
LOOP (*scan string*)
IF (pos = lim) OR (nextCh <= " ") THEN EXIT END;
Display.GetChar(R.fnt.raster, nextCh, dx, u, v, w, h, pat);
INC(pos); ox := ox + dx; Texts.Read(R, nextCh)
END;
ex := ox;
LOOP (*scan gap*)
IF (pos = lim) OR (nextCh > " ") THEN EXIT END;
Display.GetChar(R.fnt.raster, nextCh, dx, u, v, w, h, pat);
INC(pos); ox := ox + dx; Texts.Read(R, nextCh)
END;
IF (pos = lim) OR (ox > x) THEN EXIT END;
Display.GetChar(R.fnt.raster, nextCh, dx, u, v, w, h, pat);
bpos := pos; bx := ox;
INC(pos); ox := ox + dx; Texts.Read(R, nextCh)
END;
loc.pos := bpos; loc.dx := ex - bx; loc.x := bx
END LocateString;
PROCEDURE LocateChar (F: Frame; x, y: INTEGER; VAR loc: Location);
VAR R: Texts.Reader; pat: Display.Pattern;
pos, lim: LONGINT; ox, dx, u, v, w, h: INTEGER;
BEGIN LocateLine(F, y, loc);
lim := loc.org + loc.lin.len - 1;
pos := loc.org; ox := F.left;
Texts.OpenReader(R, F.text, loc.org); Texts.Read(R, nextCh);
LOOP
IF pos = lim THEN dx := eolW; EXIT END;
Display.GetChar(R.fnt.raster, nextCh, dx, u, v, w, h, pat);
IF ox + dx > x THEN EXIT END;
INC(pos); ox := ox + dx; Texts.Read(R, nextCh)
END;
loc.pos := pos; loc.dx := dx; loc.x := ox
END LocateChar;
PROCEDURE LocatePos (F: Frame; pos: LONGINT; VAR loc: Location);
VAR T: Texts.Text; R: Texts.Reader; L: Line; org: LONGINT; cury: INTEGER;
BEGIN T := F.text;
org := F.org; L := F.trailer.next; cury := F.H - F.top - asr;
IF pos < org THEN pos := org END;
WHILE (L.next # F.trailer) & (pos >= org + L.len) DO
org := org + L.len; L := L.next; cury := cury - lsp
END;
IF pos >= org + L.len THEN pos := org + L.len - 1 END;
Texts.OpenReader(R, T, org); Texts.Read(R, nextCh);
loc.org := org; loc.pos := pos; loc.lin := L;
loc.x := F.left + Width(R, pos - org); loc.y := cury
END LocatePos;
PROCEDURE Pos* (F: Frame; X, Y: INTEGER): LONGINT;
VAR loc: Location;
BEGIN LocateChar(F, X - F.X, Y - F.Y, loc);
RETURN loc.pos
END Pos;
PROCEDURE FlipCaret (F: Frame);
BEGIN
IF F.carloc.x < F.W THEN
IF (F.carloc.y >= 10) & (F.carloc.x + 12 < F.W) THEN
Display.CopyPattern(Display.white, Display.hook, F.X + F.carloc.x, F.Y + F.carloc.y - 10, 2)
END
END
END FlipCaret;
PROCEDURE SetCaret* (F: Frame; pos: LONGINT);
BEGIN LocatePos(F, pos, F.carloc); FlipCaret(F); F.car := 1
END SetCaret;
PROCEDURE TrackCaret* (F: Frame; X, Y: INTEGER; VAR keysum: SET);
VAR loc: Location; keys: SET;
BEGIN
IF F.trailer.next # F.trailer THEN
LocateChar(F, X - F.X, Y - F.Y, F.carloc);
FlipCaret(F);
keysum := {};
REPEAT
Input.Mouse(keys, X, Y);
keysum := keysum + keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
LocateChar(F, X - F.X, Y - F.Y, loc);
IF loc.pos # F.carloc.pos THEN FlipCaret(F); F.carloc := loc; FlipCaret(F) END
UNTIL keys = {};
F.car := 1
END
END TrackCaret;
PROCEDURE RemoveCaret* (F: Frame);
BEGIN IF F.car # 0 THEN FlipCaret(F); F.car := 0 END
END RemoveCaret;
PROCEDURE FlipSelection (F: Frame; VAR beg, end: Location);
VAR T: Texts.Text; L: Line; Y: INTEGER;
BEGIN T := F.text;
L := beg.lin; Y := F.Y + beg.y - 2;
IF L = end.lin THEN ReplConst(Display.white, F, F.X + beg.x, Y, end.x - beg.x, selH, 2)
ELSE
ReplConst(Display.white, F, F.X + beg.x, Y, F.left + L.wid - beg.x, selH, 2);
LOOP
L := L.next; Y := Y - lsp;
IF L = end.lin THEN EXIT END;
ReplConst(Display.white, F, F.X + F.left, Y, L.wid, selH, 2)
END;
ReplConst(Display.white, F, F.X + F.left, Y, end.x - F.left, selH, 2)
END
END FlipSelection;
PROCEDURE SetSelection* (F: Frame; beg, end: LONGINT);
BEGIN
IF F.sel # 0 THEN FlipSelection(F, F.selbeg, F.selend) END;
LocatePos(F, beg, F.selbeg); LocatePos(F, end, F.selend);
IF F.selbeg.pos < F.selend.pos THEN
FlipSelection(F, F.selbeg, F.selend); F.time := Oberon.Time(); F.sel := 1
END
END SetSelection;
PROCEDURE TrackSelection* (F: Frame; X, Y: INTEGER; VAR keysum: SET);
VAR loc: Location; keys: SET;
BEGIN
IF F.trailer.next # F.trailer THEN
IF F.sel # 0 THEN FlipSelection(F, F.selbeg, F.selend) END;
LocateChar(F, X - F.X, Y - F.Y, loc);
IF (F.sel # 0) & (loc.pos = F.selbeg.pos) & (F.selend.pos = F.selbeg.pos + 1) THEN
LocateChar(F, F.left, Y - F.Y, F.selbeg)
ELSE F.selbeg := loc
END;
INC(loc.pos); loc.x := loc.x + loc.dx; F.selend := loc;
FlipSelection(F, F.selbeg, F.selend);
keysum := {};
REPEAT
Input.Mouse(keys, X, Y);
keysum := keysum + keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
LocateChar(F, X - F.X, Y - F.Y, loc);
IF loc.pos < F.selbeg.pos THEN loc := F.selbeg END;
INC(loc.pos); loc.x := loc.x + loc.dx;
IF loc.pos < F.selend.pos THEN FlipSelection(F, loc, F.selend); F.selend := loc
ELSIF loc.pos > F.selend.pos THEN FlipSelection(F, F.selend, loc); F.selend := loc
END
UNTIL keys = {};
F.time := Oberon.Time(); F.sel := 1
END
END TrackSelection;
PROCEDURE RemoveSelection* (F: Frame);
BEGIN IF F.sel # 0 THEN FlipSelection(F, F.selbeg, F.selend); F.sel := 0 END
END RemoveSelection;
PROCEDURE TrackLine* (F: Frame; X, Y: INTEGER; VAR org: LONGINT; VAR keysum: SET);
VAR T: Texts.Text; old, new: Location; keys: SET;
BEGIN
IF F.trailer.next # F.trailer THEN T := F.text;
LocateLine(F, Y - F.Y, old);
ReplConst(Display.white, F, F.X + F.left, F.Y + old.y - dsr, old.lin.wid, 2, 2);
keysum := {};
REPEAT
Input.Mouse(keys, X, Y);
keysum := keysum + keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
LocateLine(F, Y - F.Y, new);
IF new.org # old.org THEN
ReplConst(Display.white, F, F.X + F.left, F.Y + old.y - dsr, old.lin.wid, 2, 2);
ReplConst(Display.white, F, F.X + F.left, F.Y + new.y - dsr, new.lin.wid, 2, 2);
old := new
END
UNTIL keys = {};
ReplConst(Display.white, F, F.X + F.left, F.Y + new.y - dsr, new.lin.wid, 2, 2);
org := new.org
ELSE org := -1
END
END TrackLine;
PROCEDURE TrackWord* (F: Frame; X, Y: INTEGER; VAR pos: LONGINT; VAR keysum:
SET);
VAR T: Texts.Text; old, new: Location; keys: SET;
BEGIN
IF F.trailer.next # F.trailer THEN T := F.text;
LocateString(F, X - F.X, Y - F.Y, old);
ReplConst(Display.white, F, F.X + old.x, F.Y + old.y - dsr, old.dx, 2, 2);
keysum := {};
REPEAT
Input.Mouse(keys, X, Y);
keysum := keysum + keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
LocateString(F, X - F.X, Y - F.Y, new);
IF new.pos # old.pos THEN
ReplConst(Display.white, F, F.X + old.x, F.Y + old.y - dsr, old.dx, 2, 2);
ReplConst(Display.white, F, F.X + new.x, F.Y + new.y - dsr, new.dx, 2, 2);
old := new
END
UNTIL keys = {};
ReplConst(Display.white, F, F.X + new.x, F.Y + new.y - dsr, new.dx, 2, 2);
pos := new.pos
ELSE pos := -1
END
END TrackWord;
PROCEDURE Replace* (F: Frame; beg, end: LONGINT);
VAR R: Texts.Reader; L: Line; org, len: LONGINT; curY, wid: INTEGER;
BEGIN
IF end > F.org THEN
IF beg < F.org THEN beg := F.org END;
org := F.org; L := F.trailer.next; curY := F.Y + F.H - F.top - asr;
WHILE (L # F.trailer) & (org + L.len <= beg) DO
org := org + L.len; L := L.next; curY := curY - lsp
END;
IF L # F.trailer THEN
Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);
len := beg - org; wid := Width(R, len);
ReplConst(F.col, F, F.X + F.left + wid, curY - dsr, L.wid - wid, lsp, 0);
DisplayLine(F, L, R, F.X + F.left + wid, curY, len);
org := org + L.len; L := L.next; curY := curY - lsp;
WHILE (L # F.trailer) & (org <= end) DO
Display.ReplConst(F.col, F.X + F.left, curY - dsr, F.W - F.left, lsp, 0);
DisplayLine(F, L, R, F.X + F.left, curY, 0);
org := org + L.len; L := L.next; curY := curY - lsp
END
END
END;
UpdateMark(F)
END Replace;
PROCEDURE Insert* (F: Frame; beg, end: LONGINT);
VAR R: Texts.Reader; L, L0, l: Line;
org, len: LONGINT; curY, botY, Y0, Y1, Y2, dY, wid: INTEGER;
BEGIN
IF beg < F.org THEN F.org := F.org + (end - beg)
ELSE
org := F.org; L := F.trailer.next; curY := F.Y + F.H - F.top - asr;
WHILE (L # F.trailer) & (org + L.len <= beg) DO
org := org + L.len; L := L.next; curY := curY - lsp
END;
IF L # F.trailer THEN
botY := F.Y + F.bot + dsr;
Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);
len := beg - org; wid := Width(R, len);
ReplConst (F.col, F, F.X + F.left + wid, curY - dsr, L.wid - wid, lsp, 0);
DisplayLine(F, L, R, F.X + F.left + wid, curY, len);
org := org + L.len; curY := curY - lsp;
Y0 := curY; L0 := L.next;
WHILE (org <= end) & (curY >= botY) DO NEW(l);
Display.ReplConst(F.col, F.X + F.left, curY - dsr, F.W - F.left, lsp, 0);
DisplayLine(F, l, R, F.X + F.left, curY, 0);
L.next := l; L := l;
org := org + L.len; curY := curY - lsp
END;
IF L0 # L.next THEN Y1 := curY;
L.next := L0;
WHILE (L.next # F.trailer) & (curY >= botY) DO
L := L.next; curY := curY - lsp
END;
L.next := F.trailer;
dY := Y0 - Y1;
IF Y1 > curY + dY THEN
Display.CopyBlock
(F.X + F.left, curY + dY + lsp - dsr, F.W - F.left, Y1 - curY - dY,
F.X + F.left, curY + lsp - dsr,
0);
Y2 := Y1 - dY
ELSE Y2 := curY
END;
curY := Y1; L := L0;
WHILE curY # Y2 DO
Display.ReplConst(F.col, F.X + F.left, curY - dsr, F.W - F.left, lsp, 0);
DisplayLine(F, L, R, F.X + F.left, curY, 0);
L := L.next; curY := curY - lsp
END
END
END
END;
UpdateMark(F)
END Insert;
PROCEDURE Delete* (F: Frame; beg, end: LONGINT);
VAR R: Texts.Reader; L, L0, l: Line;
org, org0, len: LONGINT; curY, botY, Y0, Y1, wid: INTEGER;
BEGIN
IF end <= F.org THEN F.org := F.org - (end - beg)
ELSE
IF beg < F.org THEN
F.trailer.next.len := F.trailer.next.len + (F.org - beg);
F.org := beg
END;
org := F.org; L := F.trailer.next; curY := F.Y + F.H - F.top - asr;
WHILE (L # F.trailer) & (org + L.len <= beg) DO
org := org + L.len; L := L.next; curY := curY - lsp
END;
IF L # F.trailer THEN
botY := F.Y + F.bot + dsr;
org0 := org; L0 := L; Y0 := curY;
WHILE (L # F.trailer) & (org <= end) DO
org := org + L.len; L := L.next; curY := curY - lsp
END;
Y1 := curY;
Texts.OpenReader(R, F.text, org0); Texts.Read(R, nextCh);
len := beg - org0; wid := Width(R, len);
ReplConst (F.col, F, F.X + F.left + wid, Y0 - dsr, L0.wid - wid, lsp, 0);
DisplayLine(F, L0, R, F.X + F.left + wid, Y0, len);
Y0 := Y0 - lsp;
IF L # L0.next THEN
L0.next := L;
L := L0; org := org0 + L0.len;
WHILE L.next # F.trailer DO
L := L.next; org := org + L.len; curY := curY - lsp
END;
Display.CopyBlock
(F.X + F.left, curY + lsp - dsr, F.W - F.left, Y1 - curY,
F.X + F.left, curY + lsp - dsr + (Y0 - Y1), 0);
curY := curY + (Y0 - Y1);
Display.ReplConst (F.col, F.X + F.left, F.Y, F.W - F.left, curY + lsp - (F.Y + dsr), 0);
Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);
WHILE ~L.eot & (curY >= botY) DO NEW(l);
DisplayLine(F, l, R, F.X + F.left, curY, 0);
L.next := l; L := l; curY := curY - lsp
END;
L.next := F.trailer
END
END
END;
UpdateMark(F)
END Delete;
(*------------------message handling------------------------*)
PROCEDURE RemoveMarks (F: Frame);
BEGIN RemoveCaret(F); RemoveSelection(F)
END RemoveMarks;
PROCEDURE NotifyDisplay* (T: Texts.Text; op: INTEGER; beg, end: LONGINT);
VAR M: UpdateMsg;
BEGIN M.id := op; M.text := T; M.beg := beg; M.end := end; Viewers.Broadcast(M)
END NotifyDisplay;
PROCEDURE Call* (F: Frame; pos: LONGINT; new: BOOLEAN);
VAR S: Texts.Scanner; res: INTEGER;
BEGIN
Texts.OpenScanner(S, F.text, pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
par.vwr := Viewers.This(F.X, F.Y);
par.frame := F; par.text := F.text; par.pos := pos + S.len;
Oberon.Call(S.s, par, new, res);
IF res > 1 THEN
Texts.WriteString(W, "Call error: ");
IF res = 2 THEN
Texts.WriteString(W, " not an obj-file or error in file")
ELSIF res = 3 THEN
Texts.WriteString(W, Modules.imported);
Texts.WriteString(W, " imported with bad key from ");
Texts.WriteString(W, Modules.importing)
ELSIF res = 4 THEN
Texts.WriteString(W, " not enough space")
END;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END
END Call;
PROCEDURE Write* (F: Frame; ch: CHAR; fnt: Fonts.Font; col, voff: SHORTINT);
BEGIN (*F.car # 0*)
IF ch = 7FX THEN
IF F.carloc.pos > F.org THEN
Texts.Delete(F.text, F.carloc.pos - 1, F.carloc.pos);
SetCaret(F, F.carloc.pos - 1)
END
ELSIF (20X <= ch) & (ch < 86X) OR (ch = 0DX) OR (ch = 9X) THEN
KW.fnt := fnt; KW.col := col; KW.voff := voff; Texts.Write(KW, ch);
Texts.Insert(F.text, F.carloc.pos, KW.buf);
SetCaret(F, F.carloc.pos + 1)
END
END Write;
PROCEDURE Defocus* (F: Frame);
BEGIN RemoveCaret(F)
END Defocus;
PROCEDURE Neutralize* (F: Frame);
BEGIN RemoveMarks(F)
END Neutralize;
PROCEDURE Modify* (F: Frame; id, dY, Y, H: INTEGER);
BEGIN
Mark(F, 0); RemoveMarks(F);
IF id = MenuViewers.extend THEN
IF dY > 0 THEN
Display.CopyBlock(F.X, F.Y, F.W, F.H, F.X, F.Y + dY, 0); F.Y := F.Y + dY
END;
Extend(F, Y)
ELSIF id = MenuViewers.reduce THEN
Reduce(F, Y + dY);
IF dY > 0 THEN Display.CopyBlock(F.X, F.Y, F.W, F.H, F.X, Y, 0); F.Y := Y END
END;
IF F.H > 0 THEN Mark(F, 1) END
END Modify;
PROCEDURE Open* (
F: Frame; H: Display.Handler; T: Texts.Text; org: LONGINT;
col, left, right, top, bot, lsp: INTEGER);
VAR L: Line;
BEGIN NEW(L);
L.len := 0; L.wid := 0; L.eot := FALSE; L.next := L;
F.handle := H; F.text := T; F.org := org; F.trailer := L;
F.left := left; F.right := right; F.top := top; F.bot := bot;
F.lsp := lsp; F.col := col; F.mark := 0; F.car := 0; F.sel := 0
END Open;
PROCEDURE Copy* (F: Frame; VAR F1: Frame);
BEGIN NEW(F1);
Open(F1, F.handle, F.text, F.org, F.col, F.left, F.right, F.top, F.bot, F.lsp)
END Copy;
PROCEDURE CopyOver* (F: Frame; text: Texts.Text; beg, end: LONGINT);
VAR buf: Texts.Buffer;
BEGIN
IF F.car > 0 THEN
NEW(buf); Texts.OpenBuf(buf);
Texts.Save(text, beg, end, buf);
Texts.Insert(F.text, F.carloc.pos, buf);
SetCaret(F, F.carloc.pos + (end - beg))
END
END CopyOver;
PROCEDURE GetSelection* (F: Frame; VAR text: Texts.Text; VAR beg, end, time: LONGINT);
BEGIN
IF F.sel > 0 THEN
IF F.time > time THEN
text := F.text; beg := F.selbeg.pos; end := F.selend.pos; time := F.time
ELSIF F.text = text THEN
IF (F.time < time) & (F.selbeg.pos < beg) THEN beg := F.selbeg.pos
ELSIF (F.time > time) & (F.selend.pos > end) THEN end := F.selend.pos; time := F.time
END
END
END
END GetSelection;
PROCEDURE Update* (F: Frame; VAR M: UpdateMsg);
BEGIN (*F.text = M.text*)
RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
IF M.id = replace THEN Replace(F, M.beg, M.end)
ELSIF M.id = insert THEN Insert(F, M.beg, M.end)
ELSIF M.id = delete THEN Delete(F, M.beg, M.end)
END
END Update;
PROCEDURE Edit* (F: Frame; X, Y: INTEGER; Keys: SET);
VAR M: Oberon.CopyOverMsg;
T: Texts.Text; R: Texts.Reader; buf: Texts.Buffer;
time, pos, beg, end: LONGINT; keysum: SET; ch: CHAR;
BEGIN
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
IF X < F.X + Min(F.left, barW) THEN
IF (0 IN Keys) OR (1 IN Keys) THEN keysum := Keys;
REPEAT
Input.Mouse(Keys, X, Y);
keysum := keysum + Keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y)
UNTIL Keys = {};
IF ~(2 IN keysum) THEN
RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
IF (0 IN keysum) OR (F.Y + F.H < Y) THEN pos := 0
ELSE pos := (F.Y + F.H - Y) * (F.text.len) DIV F.H
END;
RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
Show(F, pos)
ELSIF ~(0 IN keysum) THEN
RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
Show(F, F.text.len)
END
ELSIF 2 IN Keys THEN
TrackLine(F, X, Y, pos, keysum);
IF (pos >= 0) & ~(0 IN keysum) THEN
RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
Show(F, pos)
END
END
ELSE
IF 0 IN Keys THEN
TrackSelection(F, X, Y, keysum);
IF F.sel # 0 THEN
IF (2 IN keysum) & ~(1 IN keysum) THEN (*delete text*)
Oberon.PassFocus(MenuViewers.Ancestor);
Oberon.GetSelection(T, beg, end, time);
Texts.Delete(T, beg, end); SetCaret(F, beg)
ELSIF (1 IN keysum) & ~(2 IN keysum) THEN (*copy to focus*)
Oberon.GetSelection(T, beg, end, time);
M.text := T; M.beg := beg; M.end := end;
Oberon.FocusViewer.handle(Oberon.FocusViewer, M)
END
END
ELSIF 1 IN Keys THEN
TrackWord(F, X, Y, pos, keysum);
IF (pos >= 0) & ~(0 IN keysum) THEN Call(F, pos, 2 IN keysum) END
ELSIF 2 IN Keys THEN
Oberon.PassFocus(Viewers.This(F.X, F.Y)); TrackCaret(F, X, Y, keysum);
IF F.car # 0 THEN
IF (1 IN keysum) & ~(0 IN keysum) THEN (*copy from selection*)
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
NEW(buf); Texts.OpenBuf(buf);
Texts.Save(T, beg, end, buf);
Texts.Insert(F.text, F.carloc.pos, buf);
SetCaret(F, F.carloc.pos + (end - beg))
END
ELSIF (0 IN keysum) & ~(1 IN keysum) THEN (*copy font*)
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
Texts.OpenReader(R, F.text, F.carloc.pos); Texts.Read(R, ch);
Texts.ChangeLooks(T, beg, end, {0, 1, 2}, R.fnt, R.col, R.voff)
END
END
END
END
END
END Edit;
PROCEDURE Handle* (F: Display.Frame; VAR M: Display.FrameMsg);
VAR F1: Frame;
BEGIN
WITH F: Frame DO
IF M IS Oberon.InputMsg THEN
WITH M: Oberon.InputMsg DO
IF M.id = Oberon.track THEN Edit(F, M.X, M.Y, M.keys)
ELSIF M.id = Oberon.consume THEN
IF F.car # 0 THEN Write(F, M.ch, M.fnt, M.col, M.voff) END
END
END
ELSIF M IS Oberon.ControlMsg THEN
WITH M: Oberon.ControlMsg DO
IF M.id = Oberon.defocus THEN Defocus(F)
ELSIF M.id = Oberon.neutralize THEN Neutralize(F)
END
END
ELSIF M IS Oberon.SelectionMsg THEN
WITH M: Oberon.SelectionMsg DO GetSelection(F, M.text, M.beg, M.end, M.time) END
ELSIF M IS Oberon.CopyOverMsg THEN
WITH M: Oberon.CopyOverMsg DO CopyOver(F, M.text, M.beg, M.end) END
ELSIF M IS Oberon.CopyMsg THEN
WITH M: Oberon.CopyMsg DO Copy(F, F1); M.F := F1 END
ELSIF M IS MenuViewers.ModifyMsg THEN
WITH M: MenuViewers.ModifyMsg DO Modify(F, M.id, M.dY, M.Y, M.H) END
ELSIF M IS UpdateMsg THEN
WITH M: UpdateMsg DO
IF F.text = M.text THEN Update(F, M) END
END
END
END
END Handle;
(*creation*)
PROCEDURE Menu (name, commands: ARRAY OF CHAR): Texts.Text;
VAR T: Texts.Text;
BEGIN
NEW(T); T.notify := NotifyDisplay; Texts.Open(T, "");
Texts.WriteString(W, name); Texts.WriteString(W, " | "); Texts.WriteString(W, commands);
Texts.Append(T, W.buf);
RETURN T
END Menu;
PROCEDURE Text* (name: ARRAY OF CHAR): Texts.Text;
VAR T: Texts.Text;
BEGIN NEW(T); T.notify := NotifyDisplay; Texts.Open(T, name); RETURN T
END Text;
PROCEDURE NewMenu* (name, commands: ARRAY OF CHAR): Frame;
VAR F: Frame;
BEGIN NEW(F);
Open(F, Handle, Menu(name, commands), 0, Display.white, left DIV 4, 0, 0, 0, lsp);
RETURN F
END NewMenu;
PROCEDURE NewText* (text: Texts.Text; pos: LONGINT): Frame;
VAR F: Frame;
BEGIN NEW(F);
Open(F, Handle, text, pos, Display.black, left, right, top, bot, lsp);
RETURN F
END NewText;
BEGIN
menuH := Fonts.Default.height + 2; barW := menuH;
left := barW + Fonts.Default.height DIV 2; right := Fonts.Default.height DIV 2;
top := Fonts.Default.height DIV 2; bot := Fonts.Default.height DIV 2;
asr := Fonts.Default.maxY; dsr := -Fonts.Default.minY; lsp := Fonts.Default.height;
selH := Fonts.Default.height; markW := Fonts.Default.height DIV 2;
eolW := Fonts.Default.height DIV 2;
Texts.OpenWriter(W); Texts.OpenWriter(KW);
NEW(par)
END TextFrames.