home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / keplerframes.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  25KB  |  725 lines

  1. Syntax10.Scn.Fnt
  2. MODULE KeplerFrames;    (* J. Templ, 18.06.92, for PowerMac *)
  3.     IMPORT
  4.         KeplerPorts, KeplerGraphs, TextFrames, Viewers, MenuViewers, Display, Oberon, Files, Input, Texts, Fonts, TextPrinter;
  5.     CONST
  6.         invFoc = 2;    (* notify op-codes *)
  7.         xlen = 3 * 4;
  8.         eps = xlen + 4;
  9.         ML = 2; MM = 1; MR = 0;
  10.         cancel = {ML, MM, MR};
  11.         DEL = 7FX; BS = 08X;
  12.         fg = Display.white;
  13.     TYPE
  14.         FocusPoint* = POINTER TO FocusPointDesc;
  15.         FocusPointDesc* = RECORD
  16.             next*: FocusPoint;
  17.             p*: KeplerGraphs.Star;
  18.         END ;
  19.         Button* = POINTER TO ButtonDesc;
  20.         ButtonDesc* = RECORD
  21.             (KeplerGraphs.ConsDesc)
  22.             cmd*, par*: ARRAY 32 OF CHAR
  23.         END ;
  24.         Caption* = POINTER TO CaptionDesc;
  25.         CaptionDesc* = RECORD
  26.             (KeplerGraphs.ConsDesc)
  27.             s*: ARRAY 128 OF CHAR;
  28.             fnt*: Fonts.Font;
  29.             align*: SHORTINT (* 0 = left, 1 = centerX, 2 = right, 3 = centerXY *)
  30.         END ;
  31.         Frame* = POINTER TO FrameDesc;
  32.         FrameDesc* = RECORD (KeplerPorts.DisplayPortDesc);
  33.             G*: KeplerGraphs.Graph;
  34.             col*, grid*: INTEGER;
  35.         END ;
  36.         UpdateMsg* = RECORD
  37.             (Display.FrameMsg)
  38.             id*: INTEGER;
  39.             G*: KeplerGraphs.Graph;
  40.             O*: KeplerGraphs.Object;
  41.             P*: KeplerPorts.Port
  42.         END ;
  43.         SelMsg* = RECORD
  44.             (Display.FrameMsg)
  45.             time*: LONGINT;
  46.             G*: KeplerGraphs.Graph
  47.         END ;
  48.         Notifier* = PROCEDURE (op: INTEGER; G: KeplerGraphs.Graph; O: KeplerGraphs.Object; P: KeplerPorts.Port);
  49.         (*the graphics caret consists of a number of focus points and an optional focus caption *)
  50.         Focus*: KeplerGraphs.Graph;
  51.         first*, last*: FocusPoint;
  52.         nofpts*: INTEGER;
  53.         focus*: Caption;
  54.         carpos*: INTEGER;
  55.         upd: Frame;
  56.     PROCEDURE Min(x, y: INTEGER): INTEGER;
  57.     BEGIN IF x < y THEN RETURN x ELSE RETURN y END
  58.     END Min;
  59.     PROCEDURE Max(x, y: INTEGER): INTEGER;
  60.     BEGIN IF x > y THEN RETURN x ELSE RETURN y END
  61.     END Max;
  62.     PROCEDURE NotifyDisplay* (op: INTEGER; G: KeplerGraphs.Graph; O: KeplerGraphs.Object; P: KeplerPorts.Port);
  63.         VAR M: UpdateMsg;
  64.     BEGIN M.id := op; M.G := G; M.O := O; M.P := P; Viewers.Broadcast(M)
  65.     END NotifyDisplay;
  66.     PROCEDURE AppendFocusPoint*(p: KeplerGraphs.Star);
  67.         VAR fp: FocusPoint;
  68.     BEGIN NEW(fp); fp.p := p; fp.next := NIL;
  69.         IF last = NIL THEN first := fp ELSE last.next := fp END ;
  70.         last := fp; INC(nofpts);
  71.         NotifyDisplay(invFoc, Focus, p, NIL)
  72.     END AppendFocusPoint;
  73.     PROCEDURE DeleteFocusPoint*(F: Frame);
  74.         VAR p: FocusPoint;
  75.     BEGIN
  76.         IF last # NIL THEN
  77.             NotifyDisplay(invFoc, Focus, last.p, NIL);
  78.             IF nofpts = 1 THEN
  79.                 first := NIL; last := NIL; nofpts := 0
  80.             ELSIF nofpts > 1 THEN p := first;
  81.                 WHILE p^.next # last DO
  82.                     p := p^.next
  83.                 END ;
  84.                 p.next := NIL; DEC(nofpts); last := p
  85.             END
  86.         END
  87.     END DeleteFocusPoint;
  88.     PROCEDURE IsFocusPoint*(p: KeplerGraphs.Star): BOOLEAN;
  89.         VAR fp: FocusPoint;
  90.     BEGIN fp := first;
  91.         WHILE (fp # NIL) & (fp.p # p) DO fp := fp.next END ;
  92.         RETURN fp # NIL
  93.     END IsFocusPoint;
  94.     PROCEDURE ThisButton*(G: KeplerGraphs.Graph; x, y: INTEGER): Button;
  95.         VAR b: Button; c: KeplerGraphs.Constellation; p0, p1: KeplerGraphs.Star;
  96.     BEGIN
  97.         c := G.cons; b := NIL;
  98.         WHILE c # NIL DO
  99.             IF c IS Button THEN p0 := c.p[0]; p1 := c.p[1];
  100.                 IF ((x > p0.x) = (x < p1.x)) & ((y > p0.y) = (y < p1.y)) THEN b := c(Button) END
  101.             END ;
  102.             c := c.next
  103.         END ;
  104.         RETURN b
  105.     END ThisButton;
  106.     PROCEDURE MarkedButton*(): Button;
  107.         VAR V: Viewers.Viewer; F: Frame;
  108.     BEGIN
  109.         V := Oberon.MarkedViewer();
  110.         IF (V.dsc # NIL) & (V.dsc.next # NIL) & (V.dsc.next IS Frame) THEN
  111.             F := V.dsc.next(Frame);
  112.             RETURN ThisButton(F.G, F.Cx(Oberon.Pointer.X), F.Cy(Oberon.Pointer.Y))
  113.         ELSE RETURN NIL
  114.         END
  115.     END MarkedButton;
  116.     PROCEDURE ThisPoint(G: KeplerGraphs.Graph; x, y: INTEGER): KeplerGraphs.Star;
  117.         VAR fp: FocusPoint; p: KeplerGraphs.Star;
  118.     BEGIN fp := first;
  119.         WHILE (fp # NIL) & ((ABS(fp.p.x - x) > eps) OR (ABS(fp.p.y - y) > eps)) DO fp := fp.next END ;
  120.         IF (fp = NIL) OR (fp.p.refcnt = 0) OR (fp.p IS KeplerGraphs.Planet) OR (G # Focus) THEN
  121.             p := G.stars;
  122.             WHILE (p # NIL) & ((ABS(p.x - x) > eps) OR (ABS(p.y - y) > eps)) DO p := p.next END ;
  123.         ELSE p := fp.p
  124.         END ;
  125.         RETURN p
  126.     END ThisPoint;
  127.     PROCEDURE ThisCaption*(G: KeplerGraphs.Graph; x, y: INTEGER): Caption;
  128.         VAR s: Caption; c: KeplerGraphs.Constellation; p: KeplerPorts.BalloonPort;
  129.     BEGIN
  130.         IF ThisPoint(G, x, y) # NIL THEN RETURN NIL END ;
  131.         c := G.cons; s := NIL; NEW(p);
  132.         WHILE c # NIL DO
  133.             IF c IS Caption THEN
  134.                 KeplerPorts.InitBalloon(p); c.Draw(p);
  135.                 IF (x > p.X) & (x <= p.X + p.W) & (y > p.Y) & (y < p.Y + p.H) THEN s := c(Caption) END
  136.             END ;
  137.             c := c.next
  138.         END ;
  139.         RETURN s
  140.     END ThisCaption;
  141.     PROCEDURE GetPoint* (VAR p: KeplerGraphs.Star);
  142.         VAR fp: FocusPoint;
  143.     BEGIN
  144.         fp := first; p := fp.p; first := fp.next;
  145.         IF first = NIL THEN last := NIL END;
  146.         NotifyDisplay(invFoc, Focus, p, NIL);
  147.         DEC(nofpts)
  148.     END GetPoint;
  149.     PROCEDURE ConsumePoint* (VAR p: KeplerGraphs.Star);
  150.     BEGIN
  151.         GetPoint(p);
  152.         IF (p.refcnt = 0) & ~(p IS KeplerGraphs.Planet) THEN Focus.Append(p) END ;
  153.         INC(p.refcnt)
  154.     END ConsumePoint;
  155.     PROCEDURE SelectObjects(G: KeplerGraphs.Graph; x, y: INTEGER);
  156.         VAR
  157.             c: KeplerGraphs.Constellation;
  158.             B: KeplerPorts.BalloonPort;
  159.             i: INTEGER;
  160.     BEGIN
  161.         c := G.cons; NEW(B);
  162.         WHILE c # NIL DO
  163.             KeplerPorts.InitBalloon(B);
  164.             c.Draw(B);
  165.             IF (B.X <= x) & (B.X + B.W >= x) & (B.Y <= y) & (B.Y + B.H >= y) THEN
  166.                 FOR i := 0 TO c.nofpts-1 DO
  167.                     IF ~c.p[i].sel THEN G.FlipSelection(c.p[i]) END
  168.                 END
  169.             END ;
  170.             c := c.next
  171.         END
  172.     END SelectObjects;
  173.     PROCEDURE SelectPoints(G: KeplerGraphs.Graph; x0, y0, x1, y1: INTEGER);
  174.         VAR p: KeplerGraphs.Star;
  175.     BEGIN p := G.stars;
  176.         IF (x0 = x1) & (y0 = y1) THEN
  177.             WHILE p # NIL DO
  178.                 IF (p.x >= x0-12) & (p.x <= x0+12) & (p.y >= y0-12) & (p.y <= y0+12) THEN
  179.                     G.FlipSelection(p);
  180.                     RETURN
  181.                 END ;
  182.                 p := p.next
  183.             END ;
  184.             SelectObjects(G, x0, y0)
  185.         ELSE
  186.             WHILE p # NIL DO
  187.                 IF ~p.sel THEN
  188.                     IF (p.x >= x0) & (p.x <= x1) & (p.y >= y0) & (p.y <= y1) THEN
  189.                         G.FlipSelection(p)    (* direct selection *)
  190.                     END
  191.                 END ;
  192.                 p := p.next
  193.             END
  194.         END
  195.     END SelectPoints;
  196.     PROCEDURE AlignToGrid*(F: Frame; VAR X, Y: INTEGER);
  197.         VAR dX, dY: INTEGER;
  198.     BEGIN
  199.         IF F.grid > 0 THEN
  200.             dX := X - F.CX(0) + F.grid DIV 2; dY := Y - F.CY(0) + F.grid DIV 2;
  201.             X := F.CX(0) + dX - dX MOD F.grid;
  202.             Y := F.CY(0) + dY - dY MOD F.grid
  203.         END
  204.     END AlignToGrid;
  205.     PROCEDURE GetMouse* (F: Frame; VAR x, y: INTEGER; VAR keys: SET);
  206.         VAR X, Y: INTEGER;
  207.     BEGIN
  208.         Input.Mouse(keys, X, Y);
  209.         AlignToGrid(F, X, Y);
  210.         x := F.Cx(X); y := F.Cy(Y)
  211.     END GetMouse;
  212.     PROCEDURE DrawGrid(F: Frame);    (* aligned to (x0, y0) *)
  213.         CONST minGrid = 20;
  214.         VAR grid, i, j: INTEGER;
  215.     BEGIN
  216.         IF F.grid < minGrid THEN
  217.             grid := ((minGrid - 1) DIV F.grid + 1) * F.grid
  218.         ELSE grid := F.grid
  219.         END ;
  220.         i := F.X + F.x0 DIV F.scale MOD grid;
  221.         WHILE i < F.X + F.W DO
  222.             j := F.Y + (F.H + F.y0 DIV F.scale) MOD grid;
  223.             WHILE j < F.Y + F.H DO
  224.                 Display.ReplConst(Display.white, i, j, 1, 1, Display.replace);
  225.                 INC(j, grid)
  226.             END ;
  227.             INC(i, grid)
  228.         END
  229.     END DrawGrid;
  230. (* ------------------------------------ Button methods ------------------------------------ *)
  231.     PROCEDURE (B: Button) Execute* (keys: SET);
  232.         VAR res: INTEGER;
  233.             par: Oberon.ParList;
  234.             W: Texts.Writer;
  235.             cmd: ARRAY 32 OF CHAR;
  236.     BEGIN
  237.         IF keys = {MM} THEN
  238.             NEW(par); par.vwr := Viewers.This(Display.Width-1, Display.Height-1);
  239.             par.frame := par.vwr.dsc.next; par.text := TextFrames.Text(""); par.pos := 0;
  240.             Texts.OpenWriter(W); Texts.WriteString(W, B.par); Texts.Append(par.text, W.buf);
  241.             COPY(B.cmd, cmd); Oberon.Call(cmd, par, FALSE, res)
  242.         ELSIF keys = {MM, MR} THEN
  243.             Texts.OpenWriter(W); Texts.WriteString(W, B.cmd); Texts.Write(W, " "); Texts.WriteString(W, B.par); Texts.WriteLn(W);
  244.             Texts.Append(Oberon.Log, W.buf)
  245.         END
  246.     END Execute;
  247.     PROCEDURE^ (F: Frame) TrackMouse* (x, y: INTEGER; keys: SET);
  248.     PROCEDURE (B: Button) HandleMouse*(F: Frame; x, y: INTEGER; keys: SET);
  249.         VAR keySum: SET; x0, y0, w, h: INTEGER;
  250.     BEGIN
  251.         IF MM IN keys THEN
  252.             keySum := keys;
  253.             x0 := Min(B.p[0].x, B.p[1].x); y0 := Min(B.p[0].y, B.p[1].y);
  254.             w := ABS(B.p[0].x - B.p[1].x); h := ABS(B.p[0].y - B.p[1].y);
  255.             F.DrawRect(x0-4, y0-4, w+8, h+8, 5, Display.invert);
  256.             REPEAT
  257.                 F.TrackMouse(x, y, keys);
  258.                 GetMouse(F, x, y, keys);
  259.                 keySum := keySum + keys
  260.             UNTIL keys = {};
  261.             F.DrawRect(x0-4, y0-4, w+8, h+8, 5, Display.invert);
  262.             B.Execute(keySum)
  263.         END
  264.     END HandleMouse;
  265.     PROCEDURE (B: Button) Write* (VAR R: Files.Rider);
  266.     BEGIN Files.WriteString(R, B.cmd); Files.WriteString(R, B.par); B.Write^(R)
  267.     END Write;
  268.     PROCEDURE (B: Button) Read* (VAR R: Files.Rider);
  269.     BEGIN Files.ReadString(R, B.cmd); Files.ReadString(R, B.par); B.Read^(R)
  270.     END Read;
  271. (* ------------------------------- Caption ------------------------------- *)
  272.     PROCEDURE FlipCaret(p: KeplerPorts.Port; x, y, h: INTEGER);
  273.     BEGIN p.FillRect(x, y - 4, 4, h + 8, Display.white, 5, Display.invert)
  274.     END FlipCaret;
  275.     PROCEDURE CarPos(VAR s: ARRAY OF CHAR; fnt: Fonts.Font; carpos: INTEGER) : INTEGER;
  276.         VAR fno: SHORTINT; ch: CHAR; dx, w, i, sdx, sx, sy, sw, sh: INTEGER; p: LONGINT;
  277.     BEGIN
  278.         fno := TextPrinter.FontNo(fnt);
  279.         w := 0; i := 0; ch := s[0];
  280.         WHILE i < carpos DO
  281.             dx := SHORT(TextPrinter.DX(fno, ch) DIV 3048);
  282.             INC(w, dx); INC(i); ch := s[i]
  283.         END ;
  284.         RETURN w
  285.     END CarPos;
  286.     PROCEDURE (C: Caption) Draw*(F: KeplerPorts.Port);
  287.         VAR x, y, w: INTEGER; p: KeplerPorts.BalloonPort;
  288.     BEGIN
  289.         x := C.p[0].x; y := C.p[0].y;
  290.         IF C.align # 0 THEN
  291.             w := KeplerPorts.StringWidth(C.s, C.fnt);
  292.             IF C.align = 1 THEN DEC(x, w DIV 2) 
  293.             ELSIF C.align = 2 THEN DEC(x, w)
  294.             ELSIF C.align = 3 THEN DEC(x, w DIV 2); DEC(y, (C.fnt.height DIV 2 + C.fnt.minY) * 4)
  295.             ELSE DEC(y, C.fnt.maxY * 4);
  296.                 IF C.align = 5 THEN DEC(x, w DIV 2)
  297.                 ELSIF C.align = 6 THEN DEC(x, w)
  298.                 END
  299.             END
  300.         END ;
  301.         F.DrawString(x, y, C.s, C.fnt, Display.white, Display.paint);
  302.         IF (F IS Frame) & (focus = C) THEN
  303.             w := CarPos(C.s, C.fnt, carpos); NEW(p); KeplerPorts.InitBalloon(p); C.Draw(p);
  304.             FlipCaret(F, p.X + w, p.Y, p.H)
  305.         END
  306.     END Draw;
  307.     PROCEDURE (C: Caption) Write* (VAR R: Files.Rider);
  308.     BEGIN (*upward compatible encoding of C.align*)
  309.         IF C.align # 0 THEN Files.Write(R, C.align) END ;
  310.         Files.WriteString(R, C.s);
  311.         Files.WriteString(R, C.fnt.name);
  312.         C.Write^(R)
  313.     END Write;
  314.     PROCEDURE (C: Caption) Read* (VAR R: Files.Rider);
  315.         VAR fntname: ARRAY 32 OF CHAR;
  316.     BEGIN (*upward compatible encoding of C.align*)
  317.         Files.Read(R, C.align);
  318.         IF (C.align = 0) OR (C.align > 3) THEN C.align := 0; Files.Set(R, Files.Base(R), Files.Pos(R) - 1) END ;
  319.         Files.ReadString(R, C.s);
  320.         Files.ReadString(R, fntname);
  321.         C.fnt := Fonts.This(fntname); C.Read^(R)
  322.     END Read;
  323. (* ------------------------------------ Frame methods ------------------------------------ *)
  324.     PROCEDURE (F: Frame) TrackMouse* (x, y: INTEGER; keys: SET);
  325.     BEGIN
  326.         Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, Max(F.CX(x), 0), Min(F.CY(y), Display.Height));
  327.     END TrackMouse;
  328.     PROCEDURE (F: Frame) Reduce* (newY: INTEGER);
  329.     BEGIN
  330.         F.H := F.H + F.Y - newY; F.Y := newY;
  331.     END Reduce;
  332.     PROCEDURE (F: Frame) Invert* (p: KeplerGraphs.Star);
  333.     BEGIN
  334.         IF (p IS KeplerGraphs.Planet) OR (p.refcnt > 0) THEN (* + *)
  335.             F.DrawLine(p.x - xlen - 4, p.y, p.x + xlen + 4, p.y, Display.white, Display.invert);
  336.             F.DrawLine(p.x, p.y + xlen + 4, p.x, p.y - xlen - 4, Display.white, Display.invert)
  337.         ELSE (* x *)
  338.             F.DrawLine(p.x - xlen, p.y - xlen, p.x + xlen, p.y + xlen, Display.white, Display.invert);
  339.             F.DrawLine(p.x - xlen, p.y + xlen, p.x + xlen, p.y - xlen, Display.white, Display.invert)
  340.         END
  341.     END Invert;
  342.     PROCEDURE Intersect(F: Frame; VAR X, Y, W, H: INTEGER): BOOLEAN;
  343.         VAR t: INTEGER;
  344.     BEGIN
  345.         t := X+W;
  346.         IF F.X > X THEN X := F.X END;
  347.         IF F.X+F.W < t THEN W := F.X+F.W-X ELSE W := t-X END;
  348.         IF W <= 0 THEN RETURN FALSE END;
  349.         t := Y+H;
  350.         IF F.Y > Y THEN Y := F.Y END;
  351.         IF F.Y+F.H < t THEN H := F.Y+F.H-Y ELSE H := t-Y END;
  352.         RETURN H > 0
  353.     END Intersect;
  354.     PROCEDURE InvFocus(F: Frame);
  355.         VAR fp: FocusPoint;
  356.     BEGIN
  357.         IF Focus = F.G THEN
  358.             fp := first;
  359.             WHILE fp # NIL DO F.Invert(fp.p); fp := fp.next END
  360.         END
  361.     END InvFocus;
  362.     PROCEDURE (F: Frame) Extend*(newY: INTEGER);
  363.         VAR dY, newH: INTEGER;
  364.     BEGIN dY := F.Y - newY;
  365.         Display.ReplConst(F.col, F.X, newY, F.W, F.Y - newY, Display.replace);
  366.         F.H := F.H + F.Y - newY; F.Y := newY; newH := F.H;
  367.         INC(F.y0, (newH - dY) * F.scale); F.H := dY;
  368.         IF F.grid > 0 THEN DrawGrid(F) END;
  369.         F.G.Draw(F);
  370.         InvFocus(F);
  371.         F.H := newH; DEC(F.y0, (newH - dY) * F.scale)
  372.     END Extend;
  373.     PROCEDURE (F: Frame) Restore*(X, Y, W, H: INTEGER);
  374.     BEGIN
  375.         IF (W > 0) & (H > 0) THEN
  376.             upd.col := F.col; upd.G := F.G; upd.grid := F.grid; upd.scale := F.scale;
  377.             upd.X := X; upd.Y := Y; upd.W := W; upd.H := H;
  378.             IF Intersect(F, upd.X, upd.Y, upd.W, upd.H) THEN
  379.                 H := upd.H;
  380.                 upd.x0 := F.x0 + (F.X - upd.X) * F.scale;
  381.                 upd.y0 := F.y0 + (F.Y + F.H - upd.Y - upd.H) * F.scale;
  382.                 Oberon.RemoveMarks(upd.X, upd.Y, upd.W, upd.H);
  383.                 upd.Reduce(upd.Y + upd.H); upd.Extend(upd.Y - H)
  384.             END
  385.         END
  386.     END Restore;
  387.     PROCEDURE MoveOrigin*(F: Frame; x0, y0: INTEGER);
  388.         VAR X, Y, W, H, dX, dY: INTEGER;
  389.     BEGIN
  390.         dX := (x0 - F.x0) DIV F.scale; dY := (y0 - F.y0) DIV F.scale;
  391.         IF (dX # 0) OR (dY # 0) THEN
  392.             F.x0 := x0; F.y0 := y0;
  393.             Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  394.             X := F.X + dX; Y := F.Y + dY; W := F.W; H := F.H;
  395.             IF Intersect(F, X, Y, W, H) THEN Display.CopyBlock(X-dX, Y-dY, W, H, X, Y, Display.replace) END ;
  396.             IF dY > 0 THEN F.Restore(F.X, F.Y, F.W, dY); Y := F.Y + dY
  397.             ELSIF dY < 0 THEN F.Restore(F.X, F.Y + F.H + dY, F.W, -dY); Y := F.Y
  398.             END;
  399.             IF dX > 0 THEN F.Restore(F.X, Y, dX, F.H - ABS(dY))
  400.             ELSIF dX < 0 THEN F.Restore(F.X + F.W + dX, Y, -dX, F.H - ABS(dY))
  401.             END
  402.         END
  403.     END MoveOrigin;
  404.     PROCEDURE Move(F: Frame; x1, y1: INTEGER);
  405.         VAR keySum, keys: SET; x0, y0, x10, y10, x2, y2: INTEGER;
  406.             dragSel, dragOrg: BOOLEAN;
  407.     BEGIN
  408.         x0 := F.x0; y0 := F.y0; x10 := x1; y10 := y1; keySum := {MM};
  409.         dragSel := FALSE; dragOrg := FALSE;
  410.         REPEAT
  411.             GetMouse(F, x2, y2, keys);
  412.             F.TrackMouse(x2, y2, keys);
  413.             keySum := keySum + keys;
  414.             IF keySum = cancel THEN
  415.                 IF dragSel THEN F.G.MoveSelection(x10 - x1, y10 - y1); dragSel := FALSE
  416.                 ELSIF dragOrg THEN MoveOrigin(F, x0, y0); dragOrg := FALSE
  417.                 END
  418.             ELSIF keySum = {MM, ML} THEN
  419.                 IF (x1 # x2) OR (y1 # y2) THEN F.G.MoveSelection(x2 - x1, y2 - y1); x1 := x2; y1 := y2; dragSel := TRUE END ;
  420.             ELSIF keySum = {MM, MR} THEN dragOrg := TRUE;
  421.                 MoveOrigin(F, F.x0 + x2 - x1, F.y0 + y2 - y1)
  422.             END
  423.         UNTIL keys = {};
  424.         IF keySum = {MM} THEN F.G.MoveSelection(x2 - x1, y2 - y1) END
  425.     END Move;
  426.     PROCEDURE DrawFrame(F: Frame; x1, y1, x2, y2: INTEGER);
  427.         VAR t: INTEGER;
  428.     BEGIN
  429.         IF x1 > x2 THEN t := x1; x1 := x2; x2 := t END;
  430.         IF y1 > y2 THEN t := y1; y1 := y2; y2 := t END;
  431.         t := F.scale;
  432.         F.FillRect(x1, y1, x2-x1, t, fg, 5, Display.invert);
  433.         F.FillRect(x1, y2, x2-x1, t, fg, 5, Display.invert);
  434.         F.FillRect(x1, y1, t, y2-y1, fg, 5, Display.invert);
  435.         F.FillRect(x2, y1, t, y2-y1, fg, 5, Display.invert)
  436.     END DrawFrame;
  437.     PROCEDURE Select(F: Frame; x, y: INTEGER);
  438.         VAR x1, y1, x2, y2: INTEGER; keySum, keys: SET; p0, p1: KeplerGraphs.Star;
  439.     BEGIN keySum := {MR};
  440.         x1 := x; y1 := y; keys := {};
  441.         DrawFrame(F, x, y, x1, y1); (* for symmetry only *)
  442.         LOOP
  443.             F.TrackMouse(x1, y1, keys);
  444.             GetMouse(F, x2, y2, keys);
  445.             keySum := keySum + keys;
  446.             IF keys = {} THEN EXIT END;
  447.             IF x2 # x1 THEN DrawFrame(F, x1, y, x2, y1); x1 := x2 END;
  448.             IF y2 # y1 THEN DrawFrame(F, x, y1, x1, y2); y1 := y2 END
  449.         END;
  450.         DrawFrame(F, x, y, x1, y1);
  451.         IF keySum # cancel THEN
  452.             SelectPoints(F.G, Min(x, x1), Min(y, y1), Max(x, x1), Max(y, y1));
  453.             IF keySum = {ML, MR} THEN F.G.DeleteSelection(2)
  454.             ELSIF (keySum = {MM, MR}) & (nofpts >= 2) THEN
  455.                 GetPoint(p0); GetPoint(p1); Focus.CopySelection(F.G, p1.x - p0.x, p1.y - p0.y)
  456.             END
  457.         END
  458.     END Select;
  459.     PROCEDURE GetSelection*(VAR sel: KeplerGraphs.Graph);
  460.         VAR M: SelMsg;
  461.     BEGIN
  462.         M.time := -1; M.G := NIL;
  463.         Viewers.Broadcast(M);
  464.         sel := M.G
  465.     END GetSelection;
  466.     PROCEDURE Defocus;
  467.         VAR p: KeplerPorts.BalloonPort;
  468.     BEGIN
  469.         IF focus # NIL THEN
  470.             NEW(p); KeplerPorts.InitBalloon(p); focus.Draw(p);
  471.             focus := NIL;
  472.             Focus.notify(KeplerGraphs.restore, Focus, NIL, p);
  473.         END
  474.     END Defocus;
  475.     PROCEDURE DeFocus;
  476.         VAR s: KeplerGraphs.Star;
  477.     BEGIN WHILE nofpts > 0 DO GetPoint(s) END ;
  478.     END DeFocus;
  479.     PROCEDURE PassFocus(G: KeplerGraphs.Graph);
  480.     BEGIN Defocus; DeFocus; Focus := G
  481.     END PassFocus;
  482.     PROCEDURE Modify (F: Display.Frame; id, dY, Y, H: INTEGER);
  483.     BEGIN
  484.         WITH F: Frame DO
  485.             Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  486.             IF id = MenuViewers.extend THEN
  487.                 IF dY > 0 THEN
  488.                     Display.CopyBlock(F.X, F.Y, F.W, F.H, F.X, F.Y + dY, Display.replace); INC(F.Y, dY)
  489.                 END;
  490.                 F.Extend(Y)
  491.             ELSIF id = MenuViewers.reduce THEN
  492.                 F.Reduce(Y + dY);
  493.                 IF dY > 0 THEN Display.CopyBlock(F.X, F.Y, F.W, F.H, F.X, Y, Display.replace); F.Y := Y END
  494.             END
  495.         END
  496.     END Modify;
  497.     PROCEDURE Drag(F: Frame; p: KeplerGraphs.Star);
  498.         VAR keySum, keys: SET; x, y, x0, y0: INTEGER;
  499.     BEGIN
  500.         PassFocus(Focus);
  501.         x0 := p.x; y0 := p.y; keys := {ML, MR}; keySum := {};
  502.         WHILE keys # {} DO
  503.             GetMouse(F, x, y, keys);
  504.             F.TrackMouse(x, y, keys);
  505.             keySum := keySum + keys;
  506.             IF (x # p.x) OR (y # p.y) THEN Focus.Move(p, x-p.x, y-p.y) END ;
  507.         END ;
  508.         IF keySum = cancel THEN Focus.Move(p, x0-p.x, y0-p.y) END
  509.     END Drag;
  510.     PROCEDURE Point(F: Frame; x, y: INTEGER; keys: SET);
  511.         VAR keySum: SET; p: KeplerGraphs.Star; new: BOOLEAN; sel: KeplerGraphs.Graph; b: Button;
  512.     BEGIN
  513.         keySum := keys;
  514.         p := ThisPoint(F.G, x, y);
  515.         IF p = NIL THEN new := TRUE; NEW(p); p.x := x; p.y := y; p.refcnt := 0 ELSE new := FALSE END ;
  516.         F.Invert(p);
  517.         WHILE keys # {} DO
  518.             F.TrackMouse(x, y, keys);
  519.             GetMouse(F, x, y, keys);
  520.             keySum := keySum + keys;
  521.             IF new & (keySum # {ML, MR}) & ((x # p.x) OR (y # p.y)) THEN F.Invert(p); p.x := x; p.y := y; F.Invert(p)
  522.             ELSIF (keySum = {ML, MR}) & ~(p IS KeplerGraphs.Planet) THEN    (*experimental *)
  523.                 F.Invert(p);
  524.                 IF Focus # F.G THEN PassFocus(F.G) END ;
  525.                 IF new THEN p.x := x; p.y := y; AppendFocusPoint(p);
  526.                     b := MarkedButton();
  527.                     IF b # NIL THEN b.Execute({MM});
  528.                         Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, Oberon.Pointer.X, Oberon.Pointer.Y)
  529.                     END
  530.                 END ;
  531.                 Drag(F, p);
  532.                 RETURN
  533.             END
  534.         END ;
  535.         F.Invert(p);
  536.         IF keySum = {ML, MM} THEN
  537.             IF nofpts >= 1 THEN GetSelection(sel);
  538.                 F.G.CopySelection(sel, x - first.p.x, y - first.p.y)
  539.             END
  540.         ELSIF keySum # cancel THEN
  541.             IF Focus # F.G THEN PassFocus(F.G) END ;
  542.             IF new THEN p.x := x; p.y := y;
  543.                 AppendFocusPoint(p);
  544.             ELSIF IsFocusPoint(p) & ~(p IS KeplerGraphs.Planet) THEN
  545.                 PassFocus(Focus);
  546.                 Focus.Move(p, x - p.x, y - p.y);
  547.                 AppendFocusPoint(p)
  548.             ELSE AppendFocusPoint(p)
  549.             END
  550.         END
  551.     END Point;
  552.     PROCEDURE SetCaret (F: Frame; c: Caption; x: INTEGER);
  553.         VAR y, i, dx, w, oldw: INTEGER; keys: SET; ch: CHAR; fno: SHORTINT; p: KeplerPorts.BalloonPort;
  554.     BEGIN
  555.         NEW(p); KeplerPorts.InitBalloon(p); c.Draw(p); oldw := -1;
  556.         REPEAT
  557.             i := 0; w := 0; ch := c.s[i]; fno := TextPrinter.FontNo(c.fnt);
  558.             dx := SHORT(TextPrinter.DX(fno, ch) DIV 3048);
  559.             WHILE (ch # 0X) & (p.X + w + (dx DIV 2) < x) DO
  560.                 INC(w, dx); INC(i); ch := c.s[i];
  561.                 dx := SHORT(TextPrinter.DX(fno, ch) DIV 3048)
  562.             END ;
  563.             IF w # oldw THEN
  564.                 IF oldw # -1 THEN FlipCaret(F, p.X + oldw, p.Y, p.H) END ;
  565.                 FlipCaret(F, p.X + w, p.Y, p.H)
  566.             END ;
  567.             Input.Mouse(keys, x, y); x := F.Cx(x); y := F.Cy(y); F.TrackMouse(x, y, keys); oldw := w
  568.         UNTIL keys = {};
  569.         IF Focus # F.G THEN PassFocus(F.G) END ;
  570.         focus := c; carpos := i;
  571.     END SetCaret;
  572.     PROCEDURE (F: Frame) EditFrame* (x, y: INTEGER; keys: SET);
  573.         VAR b: Button; c: Caption;
  574.     BEGIN
  575.         GetMouse(F, x, y, keys);
  576.         IF keys = {MM} THEN b := ThisButton(F.G, x, y);
  577.             IF b # NIL THEN b.HandleMouse(F, x, y, keys)
  578.             ELSE Move(F, x, y)
  579.             END
  580.         ELSIF keys = {ML} THEN
  581.             IF (focus = NIL) & (first = NIL) OR (Focus # F.G) THEN Oberon.PassFocus(Viewers.This(F.X, F.Y)); PassFocus(F.G) END;
  582.             c := ThisCaption(F.G, x, y);
  583.             Defocus;
  584.             IF c # NIL THEN SetCaret(F, c, x)
  585.             ELSE Point(F, x, y, keys)
  586.             END
  587.         ELSIF keys = {MR} THEN Select(F, x, y)
  588.         END
  589.     END EditFrame;
  590.     PROCEDURE NewCaption(s: ARRAY OF CHAR; fnt: Fonts.Font; align, carp: INTEGER);
  591.         VAR o: Caption;
  592.     BEGIN
  593.         IF nofpts > 0 THEN Defocus;
  594.             NEW(o); o.nofpts := 1; o.align := SHORT(align); COPY(s, o.s); o.fnt := fnt;
  595.             focus := o; carpos := carp;
  596.             ConsumePoint(o.p[0]); Focus.Append(o);
  597.         END
  598.     END NewCaption;
  599.     PROCEDURE (F: Frame) Consume* (ch: CHAR);
  600.         VAR i: INTEGER; p: KeplerPorts.BalloonPort; o: Caption; s: ARRAY 2 OF CHAR;
  601.     BEGIN
  602.         IF focus # NIL THEN
  603.             NEW(p); KeplerPorts.InitBalloon(p); focus.Draw(p); (*old size*)
  604.             LOOP
  605.                 IF (ch = DEL) OR (ch = BS) THEN
  606.                     IF carpos > 0 THEN i := carpos;
  607.                         REPEAT focus.s[i-1] := focus.s[i]; INC(i) UNTIL focus.s[i-1] = 0X;
  608.                         DEC(carpos)
  609.                     END
  610.                 ELSIF (ch = 09X) OR (ch = 0DX) OR (ch = 0AX) THEN NewCaption("", focus.fnt, focus.align, 0);
  611.                     RETURN
  612.                 ELSIF ch # DEL THEN i := carpos;
  613.                     WHILE focus.s[i] # 0X DO INC(i) END ;
  614.                     IF i+1 < LEN(focus.s) THEN
  615.                         REPEAT focus.s[i+1] := focus.s[i]; DEC(i) UNTIL i+1 = carpos;
  616.                         focus.s[i+1] := ch; INC(carpos)
  617.                     END
  618.                 END ;
  619.                 IF (ch >= " ") & (Input.Available() > 0) THEN Input.Read(ch) ELSE EXIT END
  620.             END ;
  621.             focus.Draw(p); (*plus new size*)
  622.             F.G.notify(KeplerGraphs.restore, F.G, NIL, p);
  623.         ELSE
  624.             IF ch = DEL THEN F.G.DeleteSelection(1)
  625.             ELSIF ch = BS THEN DeleteFocusPoint(F)
  626.             ELSIF ch = 0C1X THEN F.G.MoveSelection(0, F.scale)
  627.             ELSIF ch = 0C2X THEN F.G.MoveSelection(0, -F.scale)
  628.             ELSIF ch = 0C3X THEN F.G.MoveSelection(F.scale, 0)
  629.             ELSIF ch = 0C4X THEN F.G.MoveSelection(-F.scale, 0)
  630.             ELSIF ORD(ch) = 145 THEN F.Restore(F.X, F.Y, F.W, F.H)
  631.             ELSE s[0] := ch; s[1] := 0X; NewCaption(s, Oberon.CurFnt, 0, 1)
  632.             END ;
  633.             WHILE Input.Available() > 0 DO Input.Read(ch) END
  634.         END
  635.     END Consume;
  636.     PROCEDURE (F: Frame) Neutralize*;
  637.     BEGIN F.G.All(0); Defocus; DeFocus
  638.     END Neutralize;
  639.     PROCEDURE CopyOver(T: Texts.Text; beg, end: LONGINT);
  640.         VAR R: Texts.Reader; s, t: ARRAY 128 OF CHAR; fnt: Fonts.Font; ch: CHAR; i, j: INTEGER;
  641.             p: KeplerPorts.BalloonPort; 
  642.     BEGIN
  643.         Texts.OpenReader(R, T, beg); Texts.Read(R, ch); fnt := R.fnt; i := 0;
  644.         WHILE (i < LEN(t)-1) & (Texts.Pos(R) <= end) & (ch # 0DX) DO s[i] := ch; INC(i); Texts.Read(R, ch) END ;
  645.         s[i] := 0X;
  646.         IF focus = NIL THEN NewCaption(s, fnt, 0, i)
  647.         ELSE COPY(focus.s, t); i := 0; j := carpos;
  648.             WHILE s[i] # 0X DO focus.s[j] := s[i]; INC(i); INC(j) END ;
  649.             i := carpos-1; carpos := j;
  650.             REPEAT INC(i); focus.s[j] := t[i]; INC(j) UNTIL t[i] = 0X;
  651.             NEW(p); KeplerPorts.InitBalloon(p); focus.Draw(p);
  652.             Focus.notify(KeplerGraphs.restore, Focus, NIL, p)
  653.         END
  654.     END CopyOver;
  655.     PROCEDURE TextSelection(G: KeplerGraphs.Graph): Texts.Text;
  656.         VAR W: Texts.Writer; T: Texts.Text; c: KeplerGraphs.Constellation; i: INTEGER;
  657.     BEGIN
  658.         T := TextFrames.Text(""); c := G.cons; Texts.OpenWriter(W);
  659.         WHILE c # NIL DO
  660.             WITH c: Caption DO
  661.                 IF c.State() = 2 THEN Texts.SetFont(W, c.fnt); i := 0;
  662.                     WHILE c.s[i] # 0X DO Texts.Write(W, c.s[i]); INC(i) END ;
  663.                     Texts.WriteLn(W)
  664.                 END
  665.             ELSE
  666.             END ;
  667.             c := c.next
  668.         END ;
  669.         Texts.Append(T, W.buf);
  670.         RETURN T
  671.     END TextSelection;
  672.     PROCEDURE Handle* (F: Display.Frame; VAR M: Display.FrameMsg);
  673.         VAR F1: Frame;
  674.     BEGIN
  675.         WITH F: Frame DO
  676.             WITH M: Oberon.InputMsg DO
  677.                             IF (M.id = Oberon.track) & (M.keys # {}) THEN F.EditFrame(M.X-F.X-F.x0, M.Y-F.Y-F.H-F.y0, M.keys)
  678.                             ELSIF M.id = Oberon.track THEN F.TrackMouse(F.Cx(M.X), F.Cy(M.Y), M.keys)
  679.                             ELSIF M.id = Oberon.consume THEN F.Consume(M.ch)
  680.                             END
  681.             | M: Oberon.ControlMsg DO
  682.                             IF M.id = Oberon.neutralize THEN F.Neutralize
  683.                             ELSIF M.id = Oberon.defocus THEN Defocus; DeFocus
  684.                             END
  685.             | M: MenuViewers.ModifyMsg DO
  686.                             Modify(F, M.id, M.dY, M.Y, M.H)
  687.             | M: UpdateMsg DO
  688.                             IF M.G = F.G THEN
  689.                                 IF M.id = KeplerGraphs.draw THEN
  690.                                     Oberon.RemoveMarks(F.X, F.Y, F.W, F.H); InvFocus(F); M.O.Draw(F); InvFocus(F);
  691.                                     (* IF M.O IS KeplerGraphs.Star THEN (*invert*) M.O.Draw(F)
  692.                                     ELSE ClipFrames.InitBalloon(B); M.O.Draw(B);
  693.                                         F.Restore(F.CX(B.X) - 1, F.CY(B.Y) - 1, B.W DIV F.scale + 3, B.H DIV F.scale + 3)
  694.                                     END *)
  695.                                 ELSIF M.id = KeplerGraphs.restore THEN
  696.                                     F.Restore(F.CX(M.P.X) - 1, F.CY(M.P.Y) - 1, M.P.W DIV F.scale + 3, M.P.H DIV F.scale + 3);
  697.                                 ELSIF (M.id = invFoc) & (Focus = F.G) THEN F.Invert(M.O(KeplerGraphs.Star))
  698.                                 END
  699.                             END
  700.             | M: SelMsg DO
  701.                             IF F.G.seltime > M.time THEN
  702.                                 M.G := F.G; M.time := F.G.seltime
  703.                             END
  704.             | M: Oberon.SelectionMsg DO
  705.                             IF F.G.seltime > M.time THEN M.text := TextSelection(F.G);
  706.                                 M.time := F.G.seltime; M.beg := 0; M.end := M.text.len
  707.                             END
  708.             | M: Oberon.CopyMsg DO
  709.                             NEW(F1); M.F := F1; F1^ := F^
  710.             | M: Oberon.CopyOverMsg DO CopyOver(M.text, M.beg, M.end)
  711.             ELSE
  712.             END
  713.         END
  714.     END Handle;
  715.     PROCEDURE Open*(F: Frame; G: KeplerGraphs.Graph; grid, scale: INTEGER; notify: KeplerGraphs.Notifier; handle: Display.Handler);
  716.     BEGIN
  717.         F.G := G; F.grid := grid; F.scale := scale; G.notify := notify; F.handle := handle
  718.     END Open;
  719.     PROCEDURE New*(G: KeplerGraphs.Graph): Frame;
  720.         VAR F: Frame;
  721.     BEGIN NEW(F); Open(F, G, 0, 4, NotifyDisplay, Handle); RETURN F
  722.     END New;
  723. BEGIN NEW(upd); NEW(Focus)
  724. END KeplerFrames.
  725.