home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / nonfpu / iconelems.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  9KB  |  247 lines
  1. Syntax24b.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax10.Scn.Fnt
  5. Syntax10i.Scn.Fnt
  6. (* Amiga NonFPU *) 
  7. MODULE IconElems; (* gri 18.3.91 / 28.9.93 *)
  8.     IMPORT Input, Display, Oberon, (* Math, *) AmigaMath, Viewers, Files, Printer, Texts, TextFrames, TextPrinter;
  9.     CONST
  10.         IStag = 753; (* icon stretch tag *)
  11.         left = 2; middle = 1; right = 0; (* mouse keys *)
  12.         HSide = MAX(SET)+1; Side = 2*HSide; PDot = 3; (* dimensions *)
  13.         MaxN = 64; Sleep = 100; (* in ms *)
  14.     TYPE
  15.         Icon = ARRAY 2 OF RECORD
  16.             addr: LONGINT;
  17.             image: ARRAY Side+1 OF SET
  18.         END;
  19.         Elem = POINTER TO ElemDesc;
  20.         ElemDesc = RECORD (Texts.ElemDesc)
  21.         END;
  22.         Frame = POINTER TO RECORD(Display.FrameDesc) col: SHORTINT END;
  23.         NotifyMsg = RECORD(TextFrames.NotifyMsg) END;
  24.         N: LONGINT; (* no. of figurs *)
  25.         Task: Oberon.Task;
  26.         State: LONGINT; (* actual figure state *)
  27.         Fig: ARRAY MaxN OF Icon;
  28.     PROCEDURE EmptyFig;
  29.         VAR j: INTEGER;
  30.     BEGIN N := 1; j := 1;
  31.         WHILE j <= Side DO
  32.             Fig[0, 0].image[j] := {};
  33.             Fig[0, 1].image[j] := {};
  34.             INC(j)
  35.         END;
  36.         Fig[0, 0].addr := Display.NewPattern(Fig[0, 0].image, HSide, Side);
  37.         Fig[0, 1].addr := Display.NewPattern(Fig[0, 1].image, HSide, Side)
  38.     END EmptyFig;
  39.     PROCEDURE LoadFig (file: ARRAY OF CHAR); (* read portable file format *)
  40.         VAR F: Files.File; R: Files.Rider; i, j: INTEGER;
  41.         PROCEDURE ReadInt (VAR x: LONGINT);
  42.             VAR n: LONGINT; i: SHORTINT; ch: CHAR;
  43.         BEGIN i := 0; n := 0; Files.Read(R, ch);
  44.             WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, i)); INC(i, 7); Files.Read(R, ch) END;
  45.             x := n + ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, i)
  46.         END ReadInt;
  47.         PROCEDURE ReadSet (VAR s: SET);
  48.             VAR x: LONGINT; i: INTEGER;
  49.         BEGIN ReadInt(x); s := {}; i := 0;
  50.             WHILE i < 32 DO
  51.                 IF ODD(x) THEN INCL(s, i) END;
  52.                 x := x DIV 2; INC(i)
  53.             END
  54.         END ReadSet;
  55.     BEGIN F := Files.Old(file);
  56.         IF F = NIL THEN EmptyFig; RETURN END;
  57.         Files.Set(R, F, 0); ReadInt(N);
  58.         IF N # IStag THEN EmptyFig; RETURN END;
  59.         ReadInt(N); i := 0;
  60.         WHILE i <= N DO j := 1;
  61.             WHILE j <= Side DO
  62.                 ReadSet(Fig[i, 0].image[j]);
  63.                 ReadSet(Fig[i, 1].image[j]);
  64.                 INC(j)
  65.             END;
  66.             Fig[i, 0].addr := Display.NewPattern(Fig[i, 0].image, HSide, Side);
  67.             Fig[i, 1].addr := Display.NewPattern(Fig[i, 1].image, HSide, Side);
  68.             INC(i)
  69.         END
  70.     END LoadFig;
  71.     PROCEDURE Draw (VAR icn: Icon; x, y, color: INTEGER);
  72.     BEGIN
  73.         Display.CopyPattern(color, icn[0].addr, x, y, Display.invert);
  74.         Display.CopyPattern(color, icn[1].addr, x + HSide, y, Display.invert)
  75.     END Draw;
  76.     PROCEDURE Print (VAR icn: Icon; x, y: INTEGER);
  77.         VAR i: INTEGER;
  78.         PROCEDURE PrintLine (x, y: INTEGER; line: SET);
  79.             VAR i, i0: INTEGER;
  80.         BEGIN i := 0;
  81.             WHILE i < HSide DO
  82.                 IF i IN line THEN i0 := i; INC(i);
  83.                     WHILE (i < HSide) & (i IN line) DO INC(i) END;
  84.                     Printer.ReplConst(x + i0*PDot, y, (i-i0)*PDot, PDot)
  85.                 END;
  86.                 INC(i)
  87.             END
  88.         END PrintLine;
  89.     BEGIN i := 0;
  90.         WHILE i < Side DO
  91.             PrintLine(x, y + i*PDot, icn[0].image[i+1]);
  92.             PrintLine(x + HSide*PDot, y + i*PDot, icn[1].image[i+1]);
  93.             INC(i)
  94.         END
  95.     END Print;
  96.     PROCEDURE HotSpot (X, Y, W, H, X0, Y0: INTEGER);
  97.         CONST d = 6;
  98.         VAR dx, dy: LONGINT; r: INTEGER; Dum1, Dum2: REAL;
  99.         PROCEDURE Block (x, y, w, h, col, mode: INTEGER);
  100.         BEGIN
  101.             IF x < X THEN DEC(w, X-x); x := X END;
  102.             IF x+w > X+W THEN w := X+W-x END;
  103.             IF w <= 0 THEN RETURN END;
  104.             IF y < Y THEN DEC(h, Y-y); y := Y END;
  105.             IF y+h > Y+H THEN h := Y+H-y END;
  106.             IF h <= 0 THEN RETURN END;
  107.             Display.ReplConst(col, x, y, w, h, mode)
  108.         END Block;
  109.         PROCEDURE Dot4 (x1, x2, y1, y2, col, mode: INTEGER);
  110.             CONST r = (d+1) DIV 2;
  111.         BEGIN
  112.             Block(x1-r, y1-r, 2*r+1, 2*r+1, col, mode);
  113.             Block(x1-r, y2-r, 2*r+1, 2*r+1, col, mode);
  114.             Block(x2-r, y1-r, 2*r+1, 2*r+1, col, mode);
  115.             Block(x2-r, y2-r, 2*r+1, 2*r+1, col, mode)
  116.         END Dot4;
  117.         PROCEDURE Circle (X, Y, R, col, mode: INTEGER);
  118.             VAR x, y, dx, dy, d: INTEGER;
  119.         BEGIN
  120.             x := R; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1 - 4*R;
  121.             WHILE x > y DO
  122.                 Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode);
  123.                 Dot4(X-y-1, X+y, Y-x-1, Y+x, col, mode);
  124.                 INC(d, dy); INC(dy, 8); INC(y);
  125.                 IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
  126.             END;
  127.             IF x = y THEN Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode) END
  128.         END Circle;
  129.     BEGIN
  130.         IF X0-X > X+W-X0 THEN dx := X0-X ELSE dx := X+W-X0 END;
  131.         IF Y0-Y > Y+H-Y0 THEN dy := Y0-Y ELSE dy := Y+H-Y0 END;
  132.         AmigaMath.IntToReal(dx, Dum1);AmigaMath.Mul(Dum1,Dum1,Dum1);
  133.         AmigaMath.IntToReal(dy, Dum2);AmigaMath.Mul(Dum2,Dum2,Dum2);
  134.         AmigaMath.Add(Dum1,Dum2,Dum1);
  135.         AmigaMath.Sqrt(Dum1,Dum1);
  136.         r := SHORT(AmigaMath.Entier(Dum1));
  137. (*        r := SHORT(ENTIER(Math.sqrt(dx*dx + dy*dy)));*)
  138.         WHILE r > 0 DO Circle(X0, Y0, r, Display.black, Display.replace); DEC(r, d) END
  139.     END HotSpot;
  140.     PROCEDURE SaveScreen (x0, y0: INTEGER; keys: SET; col: SHORTINT);
  141.         VAR sum: SET; x, y, w, h: INTEGER; msg: Viewers.ViewerMsg; wakeUp: LONGINT;
  142.     BEGIN
  143.         Display.ReplConst(Display.white, x0, y0, Side, Side, Display.invert); sum := keys;
  144.         REPEAT
  145.             Input.Mouse(keys, x, y); sum := sum+keys; 
  146.             Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  147.         UNTIL keys = {};
  148.         Display.ReplConst(Display.white, x0, y0, Side, Side, Display.invert);
  149.         IF sum # {left, middle, right} THEN
  150.             x := Oberon.UserTrack(x0); w := Oberon.DisplayWidth(x0);
  151.             y := Display.Bottom; h := Oberon.DisplayHeight(x0);
  152.             Oberon.RemoveMarks(x, y, w, h);
  153.             msg.id := Viewers.suspend; Viewers.Broadcast(msg);
  154.             HotSpot(x, y, w, h, x0 + Side DIV 2, y0 + Side DIV 2);
  155.             REPEAT
  156.                 Display.ReplConst(Display.black, x0, y0, Side, Side, Display.replace);
  157.                 INC(State); INC(x0, 10);
  158.                 IF x0+Side > x+w THEN x0 := x; INC(y0, Side);
  159.                     IF y0+Side > y+h THEN y0 := y END
  160.                 END;
  161.                 Draw(Fig[State MOD N], x0, y0, col);
  162.                 wakeUp := Oberon.Time() + Sleep*Input.TimeUnit DIV 1000;
  163.                 REPEAT UNTIL Oberon.Time() >= wakeUp
  164.             UNTIL Input.Available() > 0;
  165.             msg.id := Viewers.restore; Viewers.Broadcast(msg)
  166.         END
  167.     END SaveScreen;
  168.     PROCEDURE HandleFrame (F: Display.Frame; VAR M: Display.FrameMsg);
  169.         VAR r: INTEGER;
  170.     BEGIN
  171.         WITH F: Frame DO
  172.             IF M IS NotifyMsg THEN
  173.                 WITH M: NotifyMsg DO
  174.                     Draw(Fig[(State-1) MOD N], F.X, F.Y, F.col);
  175.                     Draw(Fig[State MOD N], F.X, F.Y, F.col)
  176.                 END
  177.             ELSIF M IS Oberon.InputMsg THEN
  178.                 WITH M: Oberon.InputMsg DO
  179.                     IF M.id = Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y) END
  180.                 END
  181.             END
  182.         END
  183.     END HandleFrame;
  184.     PROCEDURE Handle (E: Texts.Elem; VAR msg: Texts.ElemMsg);
  185.         VAR e: Elem; ch: CHAR; F: Frame;
  186.     BEGIN
  187.         WITH E: Elem DO
  188.             IF msg IS TextFrames.DisplayMsg THEN
  189.                 WITH msg: TextFrames.DisplayMsg DO
  190.                     IF ~msg.prepare THEN
  191.                         Draw(Fig[State MOD N], msg.X0, msg.Y0, msg.col);
  192.                         NEW(F); F.handle := HandleFrame; F.X := msg.X0; F.Y := msg.Y0; F.W := 64; F.H := 64; F.col := msg.col;
  193.                         msg.elemFrame := F
  194.                     END
  195.                 END
  196.             ELSIF msg IS TextPrinter.PrintMsg THEN
  197.                 WITH msg: TextPrinter.PrintMsg DO
  198.                     IF msg.prepare THEN
  199.                         E.W := Side * TextPrinter.Unit * PDot; E.H := E.W
  200.                     ELSE
  201.                         Print(Fig[State MOD N], msg.X0, msg.Y0);
  202.                         E.W := Side * TextFrames.Unit; E.H := E.W
  203.                     END
  204.                 END
  205.             ELSIF msg IS Texts.CopyMsg THEN
  206.                 NEW(e); Texts.CopyElem(E, e); msg(Texts.CopyMsg).e := e
  207.             ELSIF msg IS TextFrames.TrackMsg THEN
  208.                 WITH msg: TextFrames.TrackMsg DO
  209.                     IF middle IN msg.keys THEN SaveScreen(msg.X0, msg.Y0, msg.keys, msg.col) END
  210.                 END
  211.             ELSIF msg IS Texts.IdentifyMsg THEN
  212.                 WITH msg: Texts.IdentifyMsg DO
  213.                     msg.mod := "IconElems"; msg.proc := "New"
  214.                 END
  215.             ELSIF msg IS Texts.FileMsg THEN
  216.                 WITH msg: Texts.FileMsg DO
  217.                     IF msg.id = Texts.load THEN Files.Read(msg.r, ch) (* ignore in this version *)
  218.                     ELSIF msg.id = Texts.store THEN Files.Write(msg.r, 0X); (* version tag: used for future extensions *)
  219.                     END
  220.                 END
  221.             END
  222.         END
  223.     END Handle;
  224.     PROCEDURE Step;
  225.         VAR msg: NotifyMsg;
  226.     BEGIN
  227.         INC(State); Viewers.Broadcast(msg);
  228.         Oberon.CurTask.time := Oberon.Time() + Sleep*Input.TimeUnit DIV 1000
  229.     END Step;
  230.     PROCEDURE New*;
  231.         VAR E: Elem;
  232.     BEGIN NEW(E); E.handle := Handle; Texts.new := E; Oberon.Install(Task)
  233.     END New;
  234.     PROCEDURE Insert*;
  235.         VAR E: Elem; m: TextFrames.InsertElemMsg;
  236.     BEGIN NEW(E); E.W := Side * TextFrames.Unit; E.H := E.W; E.handle := Handle; m.e := E;
  237.         Oberon.FocusViewer.handle(Oberon.FocusViewer, m);
  238.         Oberon.Install(Task)
  239.     END Insert;
  240.     PROCEDURE Stop*;
  241.     BEGIN Oberon.Remove(Task);
  242.     END Stop;
  243. BEGIN
  244.     LoadFig("IconElems.Icon"); State := 0;
  245.     NEW(Task); Task.safe := FALSE; Task.time := 0; Task.handle := Step; Oberon.Install(Task)
  246. END IconElems.
  247.