home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / demos / captionedit.mod (.txt) next >
Oberon Text  |  1995-04-06  |  52KB  |  1,147 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 30 Jan 95
  6. Syntax10b.Scn.Fnt
  7. MODULE CaptionEdit; (* Copyright: ww 
  8.     IMPORT
  9.         Oberon, MenuViewers, Viewers, TextFrames, Texts, Display, Fonts, Input, Modules, Files;
  10.     CONST
  11.         (* Model *)
  12.         remove* = 10; insert* = 11; move* = 12; tofront* = 13;
  13.             VersionName = "CaptionEdit (ww 15 Nov 94)";
  14.         (* Frames *)
  15.         ML = 2; MM = 1; MR = 0;    Space = 5;
  16.         NoFocus* = 0; PointFocus* = 1; CaretFocus* = 2;
  17.         (* Editor *)
  18.         Menu = "System.Close  System.Copy  System.Grow  CaptionEdit.Store ";
  19.     TYPE
  20.         (* Model *)
  21.         Panel* = POINTER TO PanelDesc;
  22.         Caption* = POINTER TO CaptionDesc;
  23.         Notifier* = PROCEDURE (panel: Panel; caption: Caption; op, beg, end: LONGINT);
  24.         CaptionDesc* = RECORD(Texts.TextDesc)
  25.             host*: Panel;
  26.             next*: Caption;
  27.             x*, y*: LONGINT;
  28.             inserted: BOOLEAN
  29.         END;
  30.         PanelDesc* = RECORD
  31.             first*: Caption;
  32.             notify*: Notifier
  33.         END;
  34.         (* Frames *)
  35.         CapInfo = POINTER TO CapInfoDesc;
  36.         CapInfoDesc = RECORD
  37.             next: CapInfo;
  38.             text: Caption;
  39.             x, y, w, h, baseH: INTEGER;
  40.             ok, marked: BOOLEAN
  41.         END;
  42.         Location* = RECORD
  43.             cap*: Caption;
  44.             pos*: LONGINT;
  45.             x*, y*: INTEGER
  46.         END;
  47.         Frame* = POINTER TO FrameDesc;
  48.         FrameDesc* = RECORD(Display.FrameDesc)
  49.             panel*: Panel;
  50.             x0*, y0*: LONGINT;
  51.             hasSel*: BOOLEAN;
  52.             selTime*: LONGINT;
  53.             selBeg*, selEnd*: Location;
  54.             focus*: INTEGER;
  55.             focusPos*: Location;
  56.             subFocus*: Display.Frame;
  57.             grid*: LONGINT;
  58.             info: CapInfo
  59.         END;
  60.         UpdateMsg* = RECORD(Display.FrameMsg)
  61.             panel*: Panel;
  62.             cap*: Caption;
  63.             op*, beg*, end*: LONGINT
  64.         END;
  65.         w, wattr: Texts.Writer;
  66.         framePat: Display.Pattern;
  67.     PROCEDURE ASSERT(b: BOOLEAN);
  68.     BEGIN IF ~b THEN HALT(99) END
  69.     END ASSERT;
  70. (* Model *)
  71.     PROCEDURE Insert*(host: Panel; cap: Caption; x, y: LONGINT);
  72.         VAR q: Caption;
  73.     BEGIN ASSERT(~cap.inserted);
  74.         q := host.first;
  75.         IF q # NIL THEN
  76.             WHILE q.next # NIL DO q := q.next END;
  77.             q.next := cap
  78.         ELSE host.first := cap
  79.         END;
  80.         cap.next := NIL; cap.inserted := TRUE; cap.host := host; cap.x := x; cap.y := y;
  81.         host.notify(host, cap, insert, 0, 0)
  82.     END Insert;
  83.     PROCEDURE Remove*(cap: Caption);
  84.         VAR q: Caption; host: Panel;
  85.     BEGIN
  86.         IF cap.inserted THEN host := cap.host; q := host.first;
  87.             IF q # cap THEN
  88.                 WHILE q.next # cap DO q := q.next END;
  89.                 q.next := cap.next
  90.             ELSE host.first := cap.next
  91.             END;
  92.             cap.inserted := FALSE;
  93.             host.notify(host, cap, remove, 0, 0)
  94.         END
  95.     END Remove;
  96.     PROCEDURE Move*(cap: Caption; x, y: LONGINT);
  97.         VAR host: Panel;
  98.     BEGIN cap.x := x; cap.y := y; host := cap.host; host.notify(host, cap, move, 0, 0)
  99.     END Move;
  100.     PROCEDURE BringToFront*(cap: Caption);
  101.         VAR q: Caption; host: Panel;
  102.     BEGIN
  103.         IF cap.inserted & (cap.next # NIL) THEN host := cap.host; q := host.first;
  104.             IF q # cap THEN
  105.                 WHILE q.next # cap DO q := q.next END;
  106.                 q.next := cap.next
  107.             ELSE host.first := cap.next
  108.             END;
  109.             WHILE q.next # NIL DO q := q.next END;
  110.             q.next := cap; cap.next := NIL;
  111.             host.notify(host, cap, tofront, 0, 0)
  112.         END
  113.     END BringToFront;
  114.     PROCEDURE NotifyPanel*(t: Texts.Text; op: INTEGER; beg, end: LONGINT);
  115.         VAR c: Caption; p: Panel;
  116.     BEGIN c := t(Caption); p := c.host;
  117.         IF c.inserted THEN
  118.             IF (op = Texts.delete) & (c.len = 0) THEN Remove(c)
  119.             ELSE p.notify(p, c, op, beg, end)
  120.             END
  121.         ELSIF (p # NIL) & (op = Texts.insert) THEN Insert(p, c, c.x, c.y)
  122.         END
  123.     END NotifyPanel;
  124.     PROCEDURE OpenCaption*(cap: Caption; text: Texts.Text; beg, end: LONGINT);
  125.         VAR buf: Texts.Buffer;
  126.     BEGIN Texts.Open(cap, ""); cap.notify := NotifyPanel; cap.inserted := FALSE;
  127.         IF (text # NIL) & (beg < end) THEN
  128.             NEW(buf); Texts.OpenBuf(buf); Texts.Save(text, beg, end, buf); Texts.Append(cap, buf)
  129.         END
  130.     END OpenCaption;
  131.     PROCEDURE OpenPanel*(p: Panel; notifier: Notifier);
  132.     BEGIN p.first := NIL; p.notify := notifier
  133.     END OpenPanel;
  134.     PROCEDURE LoadPanel*(VAR r: Files.Rider; p: Panel);
  135.         VAR i: LONGINT; c, prev, anchor: Caption;
  136.     BEGIN OpenPanel(p, p.notify); NEW(anchor); prev := anchor; Files.ReadLInt(r, i);
  137.         WHILE i # 0 DO NEW(c); OpenCaption(c, NIL, 0, 0); prev.next := c; prev := c; c.host := p; c.inserted := TRUE;
  138.             Files.ReadLInt(r, c.x); Files.ReadLInt(r, c.y); Texts.Load(r, c);
  139.             DEC(i)
  140.         END;
  141.         p.first := anchor.next
  142.     END LoadPanel;
  143.     PROCEDURE ThisPanel*(f: Files.File; notifier: Notifier): Panel;
  144.         VAR ch: CHAR; p: Panel; r:Files.Rider;
  145.     BEGIN NEW(p); OpenPanel(p, notifier);
  146.         IF f # NIL THEN Files.Set(r, f, 0); Files.Read(r, ch);
  147.             IF ch = 0F7X THEN Files.Read(r, ch);
  148.                 IF ch = 1X THEN LoadPanel(r, p) END
  149.             END
  150.         END;
  151.         RETURN p
  152.     END ThisPanel;
  153.     PROCEDURE StorePanel*(VAR r: Files.Rider; p: Panel);
  154.         VAR i: LONGINT; c: Caption;
  155.     BEGIN i := 0; c := p.first;
  156.         WHILE c # NIL DO INC(i); c := c.next END;
  157.         Files.WriteLInt(r, i); c := p.first;
  158.         WHILE c # NIL DO Files.WriteLInt(r, c.x); Files.WriteLInt(r, c.y); Texts.Store(r, c); c := c.next END
  159.     END StorePanel;
  160.     PROCEDURE File*(p: Panel; name: ARRAY OF CHAR): Files.File;
  161.         VAR f: Files.File; r: Files.Rider;
  162.     BEGIN f := Files.New(name);
  163.         Files.Set(r, f, 0); Files.Write(r, 0F7X); Files.Write(r, 1X); StorePanel(r, p);
  164.         RETURN f
  165.     END File;
  166. (* Frames *)
  167. (* Measurement *)
  168.     PROCEDURE MeasureChar(VAR r: Texts.Reader; ch: CHAR; VAR w, minY, maxY: INTEGER);
  169.         VAR chX, chY, chW, chH, voff: INTEGER; pat: Display.Pattern; msg: TextFrames.DisplayMsg;
  170.     BEGIN voff := r.fnt.height * r.voff DIV 64;
  171.         IF r.elem # NIL THEN msg.prepare := TRUE; msg.fnt := r.fnt; msg.col := r.col;
  172.             msg.pos := Texts.Pos(r) - 1; msg.indent := 0; msg.Y0 := r.fnt.minY;
  173.             r.elem.handle(r.elem, msg);
  174.             IF r.elem IS TextFrames.Parc THEN r.elem.W := 0; r.elem.H := 0; msg.Y0 := 0 END;
  175.             w := SHORT(r.elem.W DIV TextFrames.Unit);
  176.             minY := voff + msg.Y0; maxY := SHORT(r.elem.H DIV TextFrames.Unit) + minY
  177.         ELSE Display.GetChar(r.fnt.raster, ch, w, chX, chY, chW, chH, pat);
  178.             minY := r.fnt.minY + voff; maxY := r.fnt.maxY + voff
  179.         END
  180.     END MeasureChar;
  181.     PROCEDURE GetBoundingBox(t: Texts.Text; beg, end: LONGINT; VAR w, h, baseH: INTEGER);
  182.         VAR pos: LONGINT; minY, maxY, w1, minY1, maxY1: INTEGER; ch: CHAR; r: Texts.Reader;
  183.     BEGIN w := 0; minY := 0; maxY := 0;
  184.         Texts.OpenReader(r, t, 0); Texts.Read(r, ch); pos := 1;
  185.         WHILE ~r.eot DO MeasureChar(r, ch, w1, minY1, maxY1);
  186.             IF minY1 < minY THEN minY := minY1 END;
  187.             IF maxY1 > maxY THEN maxY := maxY1 END;
  188.             IF (pos > beg) & (pos <= end) THEN w := w + w1 END;
  189.             Texts.Read(r, ch); INC(pos)
  190.         END;
  191.         h := maxY - minY; baseH := -minY
  192.     END GetBoundingBox;
  193.     PROCEDURE Width(t: Texts.Text; beg, end: LONGINT): INTEGER;
  194.         VAR w, h, baseH: INTEGER;
  195.     BEGIN GetBoundingBox(t, beg, end, w, h, baseH); RETURN w
  196.     END Width;
  197.     PROCEDURE Offset(t: Texts.Text; dX: INTEGER): LONGINT;
  198.         VAR i: LONGINT; w, minY, maxY: INTEGER; ch: CHAR; r: Texts.Reader;
  199.     BEGIN i := 0; Texts.OpenReader(r, t, 0);
  200.         WHILE (i < t.len) & (dX > 0) DO Texts.Read(r, ch); INC(i);
  201.             MeasureChar(r, ch, w, minY, maxY); dX := dX - w
  202.         END;
  203.         IF (dX < 0) & (i # 0) THEN DEC(i) END;
  204.         RETURN i
  205.     END Offset;
  206. (* Caption_Info *)
  207.     PROCEDURE NewInfo(f: Frame; cap: Caption; w, h, baseH: INTEGER): CapInfo;
  208.         VAR info: CapInfo;
  209.     BEGIN NEW(info); info.text := cap; info.x := SHORT(cap.x - f.x0); info.y := SHORT(cap.y - f.y0);
  210.         info.w := w; info.h := h; info.baseH := baseH;
  211.         info.ok := FALSE; info.marked := FALSE;
  212.         RETURN info
  213.     END NewInfo;
  214.     PROCEDURE ThisCaption(f: Frame; x, y: INTEGER): CapInfo;
  215.         VAR c, this: CapInfo;
  216.     BEGIN x := x - f.X; y := y - (f.Y + f.H);
  217.         c := f.info; this := NIL;
  218.         WHILE c # NIL DO
  219.             IF (c.x <= x) & (x < c.x + c.w) & (c.y <= y) & (y < c.y + c.h) THEN this := c END;
  220.             c := c.next
  221.         END;
  222.         RETURN this
  223.     END ThisCaption;
  224.     PROCEDURE SetReader(f: Frame; x, y: INTEGER; VAR r: Texts.Reader; VAR cap: CapInfo);
  225.         VAR t: Caption;
  226.     BEGIN cap := ThisCaption(f, x, y);
  227.         IF cap # NIL THEN t := cap.text; Texts.OpenReader(r, t, Offset(t, x - f.X - cap.x)) END
  228.     END SetReader;
  229.     PROCEDURE InfoAbout(f: Frame; cap: Caption): CapInfo;
  230.         VAR c: CapInfo;
  231.     BEGIN c := f.info;
  232.         WHILE (c # NIL) & (c.text # cap) DO c := c.next END;
  233.         RETURN c
  234.     END InfoAbout;
  235.     PROCEDURE InsertInfo(f: Frame; cap: CapInfo);
  236.         VAR info, p: CapInfo; q, t: Caption;
  237.     BEGIN info := f.info; p := NIL; q := f.panel.first; t := cap.text;
  238.         WHILE q # t DO
  239.             IF (info # NIL)