home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / examples.lha / Examples / Oberon0 / TextFrames0.Mod < prev    next >
Encoding:
Text File  |  1995-04-15  |  12.3 KB  |  327 lines
  1. MODULE TextFrames0;  (*HM 17-Dec-1991*)
  2. IMPORT OS, Viewers0, Texts0;
  3.  
  4. CONST
  5.   EOL = 0DX; DEL = 7FX;
  6.   scrollW = 12;  (*width of scroll bar*)
  7.  
  8. TYPE
  9.   Line = POINTER TO LineDesc;
  10.   LineDesc = RECORD
  11.     len, asc, dsc, wid: INTEGER;  (*length, ascender, descender, width*)
  12.     eol: BOOLEAN;  (*TRUE if line is terminated with EOL*)
  13.     next: Line
  14.   END;
  15.   Position* = RECORD  (*position of a character c on the screen*)
  16.     x-, y-, dx-: INTEGER;  (*(x,y) = left point on base line; dx = width of c*)
  17.     org-, pos-: LONGINT; (*origin of line containing c; text position of c*)
  18.     L: Line  (*line containing c*)
  19.   END;
  20.   Frame* = POINTER TO FrameDesc;
  21.   FrameDesc* = RECORD (Viewers0.FrameDesc)
  22.     text*: Texts0.Text;
  23.     org-: LONGINT;  (*index of first character in the frame*)
  24.     caret-: Position; (*caret visible of caret.pos >= 0*)
  25.     selBeg-, selEnd-: Position; (*selection; visible if selBeg.pos >= 0*)
  26.     selTime: LONGINT;  (*time stamp of selection*)
  27.     lsp, margin: INTEGER;  (*space between lines; space between frame border and text*)
  28.     lines: Line  (*list of lines in frame*)
  29.   END;
  30.   SelectionMsg = RECORD (OS.Message) f: Frame END;
  31.  
  32. VAR
  33.   cmdFrame-: Frame;  (*frame from which most recent command was invoked*)
  34.   cmdPos-: LONGINT;  (*text position after most recent command*)
  35.  
  36.  
  37. (*auxiliary procedures*)
  38.  
  39. PROCEDURE GetMetric (at: Texts0.Attribute; ch: CHAR; VAR dx, x, y, asc, dsc:
  40. INTEGER; VAR pat: OS.Pattern);
  41.   VAR w, h: INTEGER;
  42. BEGIN
  43.   IF at.elem = NIL THEN OS.GetCharMetric(at.fnt, ch, dx, x, y, w, h, pat);
  44.     asc := at.fnt.maxY; dsc := -at.fnt.minY
  45.   ELSE dx := at.elem.w; x := 0; y := 0; dsc := at.elem.dsc; asc := at.elem.h - dsc
  46.   END
  47. END GetMetric;
  48.  
  49. PROCEDURE MeasureLine (t: Texts0.Text; VAR L: Line);
  50.   VAR ch: CHAR; dx, x, y, asc, dsc: INTEGER; pat: OS.Pattern;
  51. BEGIN L.len := 0; L.asc := 0; L.dsc := 0; L.wid := 0; ch := " ";
  52.   WHILE (ch # EOL) & (t.pos < t.len) DO t.Read(ch); INC(L.len);
  53.     GetMetric(t.attr, ch, dx, x, y, asc, dsc, pat);
  54.     INC(L.wid, dx);
  55.     IF asc > L.asc THEN L.asc := asc END;
  56.     IF dsc > L.dsc THEN L.dsc := dsc END
  57.   END;
  58.   L.eol := ch = EOL
  59. END MeasureLine;
  60.  
  61. PROCEDURE DrawLine (t: Texts0.Text; len, left, right, base: INTEGER);
  62.   VAR ch: CHAR; dx, x, y, w, h: INTEGER; pat: OS.Pattern;
  63. BEGIN
  64.   WHILE len > 0 DO t.Read(ch); DEC(len);
  65.     IF t.attr.elem = NIL THEN OS.GetCharMetric(t.attr.fnt, ch, dx, x, y, w, h, pat);
  66.       IF left + dx < right THEN OS.DrawPattern(pat, left + x, base + y) END
  67.     ELSE dx := t.attr.elem.w;
  68.       IF left + dx < right THEN t.attr.elem.Draw(left, base) END
  69.     END;
  70.     INC(left, dx)
  71.   END
  72. END DrawLine;
  73.  
  74. (*methods of class Frame*)
  75.  
  76. PROCEDURE (f: Frame) FlipCaret;
  77. BEGIN OS.DrawPattern(OS.Caret, f.caret.x, f.caret.y - 10)
  78. END FlipCaret;
  79.  
  80. PROCEDURE (f: Frame) FlipSelection (a, b: Position);
  81.   VAR x, y: INTEGER; L: Line;
  82. BEGIN L := a.L; x := a.x; y := a.y - L.dsc;
  83.   WHILE L # b.L DO OS.InvertBlock(x, y, f.x + f.w - x, L.asc + L.dsc);
  84.     L := L.next; x := f.x + scrollW + f.margin; y := y - f.lsp - L.asc - L.dsc
  85.   END;
  86.   OS.InvertBlock(x, y, b.x - x, L.asc + L.dsc)
  87. END FlipSelection;
  88.  
  89. PROCEDURE (f: Frame) RedrawFrom (top: INTEGER);
  90.   VAR t: Texts0.Text; L, L0: Line; y: INTEGER; org: LONGINT;
  91. BEGIN
  92.   (*find first line to be redrawn*)
  93.   y := f.y + f.h - f.margin; org := f.org; L0 := f.lines; L := L0.next;
  94.   WHILE (L # f.lines) & (y - L.asc - L.dsc >= top) DO DEC(y, L.asc + L.dsc + f.lsp); org := org + L.len; L0 := L; L := L.next END;
  95.   IF y > top THEN top := y END;
  96.   OS.FadeCursor; OS.EraseBlock(f.x, f.y, f.w, top - f.y);
  97.   (*draw scroll bar*)
  98.   IF f.margin > 0 THEN OS.InvertBlock(f.x + scrollW, f.y, 1, top - f.y) END;
  99.   (*redraw lines and build new line descriptors; L0 is last valid line descriptor*)
  100.   t := f.text;
  101.   LOOP NEW(L);
  102.     t.SetPos(org); MeasureLine(t, L); IF (L.len = 0) OR (y - L.asc - L.dsc < f.y + f.margin) THEN EXIT END;
  103.     t.SetPos(org); DrawLine(t, L.len, f.x + scrollW + f.margin, f.x + f.w - f.margin, y - L.asc); org := org + L.len;
  104.     DEC(y, L.asc + L.dsc + f.lsp); L0.next := L; L0 := L; IF t.pos >= t.len THEN EXIT END
  105.   END;
  106.   L0.next := f.lines
  107. END RedrawFrom;
  108.  
  109. PROCEDURE (f: Frame) GetPointPos (x0, y0: INTEGER; VAR p: Position);
  110.   VAR t: Texts0.Text; ch: CHAR; L: Line; dx, x, y, asc, dsc: INTEGER; pat: OS.Pattern;
  111. BEGIN
  112.   (*find line containing y0*)
  113.   L := f.lines.next; p.y := f.y + f.h - f.margin; p.org := f.org;
  114.   WHILE (L # f.lines) & (y0 < p.y - L.asc - L.dsc - f.lsp) & L.eol DO
  115.     DEC(p.y, L.asc + L.dsc + f.lsp); p.org := p.org + L.len; L := L.next
  116.   END;
  117.   DEC(p.y, L.asc);
  118.   (*find character containing x0*)
  119.   p.x := f.x + scrollW + f.margin; p.L := L; p.pos := p.org; t := f.text; t.SetPos(p.pos);
  120.   LOOP IF t.pos >= t.len THEN p.dx := 0; EXIT END;
  121.     t.Read(ch); GetMetric(t.attr, ch, dx, x, y, asc, dsc, pat);
  122.     IF (ch = EOL) OR (p.x + dx > x0) THEN p.dx := dx; EXIT ELSE INC(p.pos); INC(p.x, dx) END;
  123.   END
  124. END GetPointPos;
  125.  
  126. PROCEDURE (f: Frame) GetCharPos (pos: LONGINT; VAR p: Position);
  127.   VAR t: Texts0.Text; ch: CHAR; L: Line; dx, x, y, asc, dsc: INTEGER; pat: OS.Pattern;
  128. i: LONGINT;
  129. BEGIN
  130.   (*find line containing pos*)
  131.   L := f.lines.next; p.y := f.y + f.h - f.margin; p.org := f.org; p.pos := pos;
  132.   WHILE (L # f.lines) & (pos >= p.org + L.len) & L.eol DO p.org := p.org + L.len; DEC(p.y, L.asc + L.dsc + f.lsp); L := L.next END;
  133.   DEC(p.y, L.asc); p.L := L;
  134.   (*find character at pos*)
  135.   p.x := f.x + scrollW + f.margin; t := f.text; t.SetPos(p.org);
  136.   FOR i := 1 TO p.pos - p.org DO
  137.     t.Read(ch); GetMetric(t.attr, ch, dx, x, y, asc, dsc, pat);
  138.     INC(p.x, dx)
  139.   END;
  140.   IF t.pos >= t.len THEN p.dx := 0 ELSE t.Read(ch); GetMetric(t.attr, ch, p.dx, x, y, asc, dsc, pat) END
  141. END GetCharPos;
  142.  
  143. PROCEDURE (f: Frame) CallCommand;
  144.   VAR x, y, i: INTEGER; buttons: SET; p: Position; t: Texts0.Text; ch: CHAR; cmd: ARRAY 64 OF CHAR;
  145. BEGIN REPEAT OS.GetMouse(buttons, x, y) UNTIL buttons = {};
  146.   f.GetPointPos(x, y, p); t := f.text; t.SetPos(p.org); t.Read(ch);
  147.   REPEAT
  148.     WHILE (t.pos < t.len) & (ch # EOL) & ((CAP(ch) < "A") OR (CAP(ch) > "Z")) DO t.Read(ch) END;
  149.     i := 0;
  150.     WHILE (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch >= "0") & (ch <= "9") OR (ch = ".") DO
  151.       cmd[i] := ch; INC(i); t.Read(ch)
  152.     END;
  153.     cmd[i] := 0X;
  154.   UNTIL (t.pos >= t.len) OR (ch = EOL) OR (t.pos > p.pos);
  155.   cmdFrame := f; cmdPos := t.pos; OS.Call(cmd)
  156. END CallCommand;
  157.  
  158. PROCEDURE (f: Frame) RemoveCaret*;
  159. BEGIN
  160.   IF f.caret.pos >= 0 THEN f.FlipCaret; f.caret.pos := -1 END
  161. END RemoveCaret;
  162.  
  163. PROCEDURE (f: Frame) SetCaret* (pos: LONGINT);
  164.   VAR p: Position;
  165. BEGIN
  166.   IF pos < 0 THEN pos := 0 ELSIF pos > f.text.len THEN pos := f.text.len END;
  167.   f.SetFocus; f.GetCharPos(pos, p);
  168.   IF p.x < f.x + f.w - f.margin THEN f.caret := p; f.FlipCaret END
  169. END SetCaret;
  170.  
  171. PROCEDURE (f: Frame) RemoveSelection*;
  172. BEGIN IF f.selBeg.pos >= 0 THEN f.FlipSelection(f.selBeg, f.selEnd); f.selBeg.pos := -1 END
  173. END RemoveSelection;
  174.  
  175. PROCEDURE (f: Frame) SetSelection* (from, to: LONGINT);
  176. BEGIN f.RemoveSelection;
  177.   f.GetCharPos(from, f.selBeg); f.GetCharPos(to, f.selEnd); f.FlipSelection(f.selBeg, f.selEnd); f.selTime := OS.Time()
  178. END SetSelection;
  179.  
  180. PROCEDURE (f: Frame) Defocus*;
  181. BEGIN f.RemoveCaret; f.Defocus^
  182. END Defocus;
  183.  
  184. PROCEDURE (f: Frame) Neutralize*;
  185. BEGIN f.RemoveCaret; f.RemoveSelection
  186. END Neutralize;
  187.  
  188. PROCEDURE (f: Frame) Draw*;
  189. BEGIN f.RedrawFrom(f.y + f.h)
  190. END Draw;
  191.  
  192. PROCEDURE (f: Frame) Modify* (dy: INTEGER);
  193.   VAR y: INTEGER;
  194. BEGIN y := f.y; f.Modify^ (dy);
  195.   IF y > f.y THEN f.RedrawFrom(y) ELSE f.RedrawFrom(f.y) END
  196. END Modify;
  197.  
  198. PROCEDURE (f: Frame) HandleMouse* (x, y: INTEGER; buttons: SET);
  199.   VAR p: Position; b: SET; t: Texts0.Text; ch: CHAR; f1: Frame;
  200. BEGIN f.HandleMouse^ (x, y, buttons);
  201.   t := f.text;
  202.   IF (x < f.x + scrollW) & (buttons # {}) THEN (*handle click in scroll bar*)
  203.     REPEAT OS.GetMouse(b, x, y); buttons := buttons + b UNTIL b = {};
  204.     f.Neutralize;
  205.     IF OS.left IN buttons THEN f.GetPointPos(x, y, p); f.org := p.org
  206.     ELSIF OS.right IN buttons THEN f.org := 0
  207.     ELSIF OS.middle IN buttons THEN t.SetPos((f.y + f.h - y) * f.text.len DIV f.h);
  208.       REPEAT t.Read(ch) UNTIL (ch = EOL) OR (t.pos >= t.len);
  209.       f.org := t.pos
  210.     END;
  211.     f.RedrawFrom(f.y + f.h)
  212.   ELSE (*handle click in text area*)
  213.     f.GetPointPos(x, y, p);
  214.     IF OS.left IN buttons THEN
  215.       IF p.pos # f.caret.pos THEN f.SetCaret(p.pos) END
  216.     ELSIF OS.middle IN buttons THEN t.SetPos(p.pos); t.Read(ch);
  217.       IF t.attr.elem = NIL THEN f.CallCommand ELSE t.attr.elem.HandleMouse(f, x, y) END
  218.     ELSIF OS.right IN buttons THEN f.RemoveSelection;
  219.       f.selBeg := p; f.selEnd := p; f.selTime := OS.Time();
  220.       LOOP OS.GetMouse(b, x, y); buttons := buttons + b; IF b = {} THEN EXIT END;
  221.         OS.DrawCursor(x, y); f.GetPointPos(x, y, p);
  222.         IF p.pos < f.selBeg.pos THEN p := f.selBeg END; (*dont expand selection to the left*)
  223.         IF p.pos < t.len THEN INC(p.pos); INC(p.x, p.dx) END;
  224.         IF p.pos # f.selEnd.pos THEN
  225.           IF p.pos > f.selEnd.pos THEN f.FlipSelection(f.selEnd, p) ELSE f.FlipSelection(p, f.selEnd) END;
  226.           f.selEnd := p
  227.         END
  228.       END;
  229.       (*handle interclick*)
  230.       IF OS.left IN buttons THEN t.Delete(f.selBeg.pos, f.selEnd.pos)
  231.       ELSIF (OS.middle IN buttons) & (Viewers0.focus # NIL) & (Viewers0.focus IS Frame) THEN
  232.         f1 := Viewers0.focus(Frame);
  233.         IF f1.caret.pos >= 0 THEN f1.text.Insert(f1.caret.pos, t, f.selBeg.pos, f.selEnd.pos) END
  234.       END
  235.     END
  236.   END
  237. END HandleMouse;
  238.  
  239. PROCEDURE (f: Frame) HandleKey* (ch: CHAR);
  240.   VAR pos: LONGINT;
  241. BEGIN pos := f.caret.pos;
  242.   IF pos >= 0 THEN
  243.     IF ch = DEL THEN
  244.       IF pos > 0 THEN f.text.Delete(pos - 1, pos); f.SetCaret(pos - 1) END 
  245.     ELSE f.text.SetPos(pos); f.text.Write(ch); f.SetCaret(pos + 1)
  246.     END
  247.   END
  248. END HandleKey;
  249.  
  250. PROCEDURE (f: Frame) Handle* (VAR m: OS.Message);
  251.   VAR t: Texts0.Text; ch: CHAR; VAR dx, x, y, asc, dsc: INTEGER; pat: OS.Pattern; p: Position;
  252. BEGIN
  253.   t := f.text;
  254.   WITH
  255.     m: Texts0.NotifyInsMsg DO
  256.       IF m.t = t THEN
  257.         IF m.beg < f.org THEN f.org := f.org + (m.end - m.beg)
  258.         ELSE
  259.           f.Neutralize; OS.FadeCursor;
  260.           f.GetCharPos(m.beg, p);
  261.           t.SetPos(m.beg); t.Read(ch); GetMetric(t.attr, ch, dx, x, y, asc, dsc, pat);
  262.           IF (m.end = m.beg+1) & (ch # EOL) & (p.L # f.lines) & (asc+dsc <= p.L.asc+p.L.dsc) THEN
  263.             IF p.x + dx <= f.x + f.w - f.margin THEN
  264.               OS.CopyBlock(p.x, p.y-p.L.dsc, f.x+f.w-f.margin-dx-p.x, p.L.asc+p.L.dsc,
  265.                 p.x+dx, p.y-p.L.dsc);
  266.               OS.EraseBlock(p.x, p.y-p.L.dsc, dx, p.L.asc + p.L.dsc);
  267.               IF t.attr.elem = NIL THEN OS.DrawPattern(pat, p.x + x, p.y + y)
  268.               ELSE t.attr.elem.Draw(p.x, p.y)
  269.               END
  270.             ELSE OS.EraseBlock(p.x, p.y-p.L.dsc, f.x+f.w-p.x, p.L.asc+p.L.dsc)
  271.             END;
  272.             INC(p.L.len); INC(p.L.wid, dx)
  273.           ELSE f.RedrawFrom(p.y + p.L.asc)
  274.           END
  275.         END
  276.       END
  277.   | m: Texts0.NotifyDelMsg DO
  278.       IF m.t = t THEN
  279.         IF m.end <= f.org THEN f.org := f.org - (m.end - m.beg)
  280.         ELSE
  281.           f.Neutralize;
  282.           IF m.beg < f.org THEN f.org := m.beg; f.RedrawFrom(f.y + f.h)
  283.           ELSE f.GetCharPos(m.beg, p); f.RedrawFrom(p.y + p.L.asc)
  284.           END
  285.         END
  286.       END
  287.   | m: Texts0.NotifyReplMsg DO
  288.       IF (m.t = t) & (m.end > f.org) THEN
  289.         f.Neutralize;
  290.         IF m.beg < f.org THEN m.beg := f.org END;
  291.         f.GetCharPos(m.beg, p); f.RedrawFrom(p.y + p.L.asc)
  292.       END
  293.   | m: SelectionMsg DO
  294.       IF (f.selBeg.pos >= 0) & ((m.f = NIL) OR (m.f.selTime < f.selTime)) THEN m.f := f END
  295.   ELSE
  296.   END
  297. END Handle;
  298.  
  299. PROCEDURE New* (t: Texts0.Text): Frame;
  300.   VAR f: Frame; fnt: OS.Font;
  301. BEGIN NEW(f); f.text := t;
  302.   f.org := 0; f.caret.pos := -1; f.selBeg.pos := -1; f.lsp := 2; f.margin := 5;
  303.   NEW(f.lines); f.lines.next := f.lines; fnt := OS.DefaultFont(); f.lines.asc := fnt.maxY; f.lines.dsc := -fnt.minY; f.lines.len := 0;
  304.   RETURN f
  305. END New;
  306.  
  307. PROCEDURE NewMenu* (name, menu: ARRAY OF CHAR): Frame;
  308.   VAR t: Texts0.Text; f: Frame; i: INTEGER;
  309. BEGIN NEW(t); t.Clear;
  310.   i := 0; WHILE name[i] # 0X DO t.Write(name[i]); INC(i) END;
  311.   t.Write(" "); t.Write("|"); t.Write(" ");
  312.   i := 0; WHILE menu[i] # 0X DO t.Write(menu[i]); INC(i) END;
  313.   f := New(t); f.margin := 0; RETURN f
  314. END NewMenu;
  315.  
  316. PROCEDURE (f: Frame) Copy* (): Viewers0.Frame;
  317.   VAR f1: Frame;
  318. BEGIN f1 := New(f.text); f1.margin := f.margin; RETURN f1
  319. END Copy;
  320.  
  321. PROCEDURE GetSelection* (VAR f: Frame);
  322.   VAR m: SelectionMsg;
  323. BEGIN m.f := NIL; Viewers0.Broadcast(m); f := m.f
  324. END GetSelection;
  325.  
  326. END TextFrames0.
  327.