Oberon/V2/TextFrames

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.