home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system1 / dialoganalogclocks.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  8KB  |  199 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 11 Nov 94
  6. Syntax10b.Scn.Fnt
  7. MODULE DialogAnalogClocks;
  8.     (** Markus Knasm
  9. ller 14 Sep 94 - 
  10.     (* This sourcecode uses parts of ClockElems - gri 18.3.91 *)
  11.     IMPORT DialogClocks, DialogFrames, Dialogs, Display, In, Math, Oberon, Printer;
  12.     CONST
  13.         W* = 65; H* = W; Rmin = 12; Rdef = 8.2; black = 15;
  14.     TYPE
  15.         Item* = POINTER TO ItemDesc;
  16.         ItemDesc* = RECORD(DialogClocks.ItemDesc)
  17.         END;
  18.     VAR 
  19.         sin, cos: ARRAY 60 OF REAL;
  20.         Line: PROCEDURE (f: Display.Frame; x1, y1, x2, y2, color, mode: INTEGER);
  21.         Circle: PROCEDURE (f: Display.Frame; x0, y0, r, color, mode: INTEGER);
  22.     PROCEDURE Min (x, y: INTEGER): INTEGER;
  23.     BEGIN IF x < y THEN RETURN x ELSE RETURN y END
  24.     END Min;
  25.     PROCEDURE Init;
  26.         VAR i: INTEGER;
  27.     BEGIN i := 0;
  28.         WHILE i < 60 DO
  29.             sin[i] := Math.sin (2 * Math.pi / 60 * i);
  30.             cos[i] := Math.cos (2 * Math.pi / 60 * i);
  31.             INC (i)
  32.         END
  33.     END Init;
  34.     PROCEDURE Format (time: LONGINT; VAR sec, min, hour, hourm: INTEGER);
  35.     BEGIN 
  36.         hour := SHORT (time DIV 4096 MOD 32); 
  37.         min := SHORT (time DIV 64 MOD 64);
  38.         sec := SHORT (time MOD 64);
  39.         hourm := (hour MOD 12) * 5 + min DIV 12
  40.     END Format;
  41. (* graphics *)
  42.     PROCEDURE SCircle(f: Display.Frame; x0, y0, r, color, mode: INTEGER);
  43.         VAR x, y, dx, dy, d: INTEGER;
  44.         PROCEDURE Dot4(x1, x2, y1, y2, color, mode: INTEGER);
  45.         BEGIN
  46.             Display.DotC (f, color, x1, y1, mode);
  47.             Display.DotC (f, color, x1, y2, mode);
  48.             Display.DotC (f, color, x2, y1, mode);
  49.             Display.DotC (f, color, x2, y2, mode)
  50.         END Dot4;
  51.     BEGIN
  52.         x := r; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1-4*r;
  53.         WHILE x > y DO
  54.             Dot4(x0-x, x0+x, y0-y, y0+y, color, mode);
  55.             Dot4(x0-y, x0+y, y0-x, y0+x, color, mode);
  56.             INC(d, dy); INC(dy, 8); INC(y);
  57.             IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
  58.         END;
  59.         IF x = y THEN Dot4(x0-x, x0+x, y0-y, y0+y, color, mode) END
  60.     END SCircle;
  61.     PROCEDURE SLine(f: Display.Frame; x1, y1, x2, y2, color, mode: INTEGER);
  62.         VAR x, y, dx, dy, d, inc: INTEGER;
  63.     BEGIN
  64.         IF (y2 - y1) < (x1 - x2) THEN x := x1; x1 := x2; x2 := x; y := y1; y1 := y2; y2 := y END;
  65.         dx := 2 * (x2 - x1);
  66.         dy := 2 * (y2 - y1);
  67.         x := x1; y := y1; inc := 1;
  68.         IF dy > dx THEN
  69.             d := dy DIV 2;
  70.             IF dx < 0 THEN inc := -1; dx := -dx END;
  71.             WHILE y <= y2 DO
  72.                 Display.DotC (f, color, x, y, mode); 
  73.                 INC (y); DEC (d, dx);
  74.                 IF d < 0 THEN INC (d, dy); INC (x, inc) END
  75.             END
  76.         ELSE
  77.             d := dx DIV 2;
  78.             IF dy < 0 THEN inc := -1; dy := -dy END;
  79.             WHILE x <= x2 DO
  80.                 Display.DotC (f, color, x, y, mode);
  81.                 INC (x); DEC (d, dy);
  82.                 IF d < 0 THEN INC (d, dx); INC (y, inc) END
  83.             END
  84.         END 
  85.     END SLine;
  86.     PROCEDURE PCircle (f: Display.Frame; x0, y0, r, color, mode: INTEGER);
  87.     BEGIN Printer.Circle (x0, y0, r)
  88.     END PCircle;
  89.     PROCEDURE PLine (f: Display.Frame; x1, y1, x2, y2, color, mode: INTEGER);
  90.     BEGIN Printer.Line (x1, y1, x2, y2)
  91.     END PLine;
  92. (* view update *)
  93.     PROCEDURE Line2(f: Display.Frame; ang: INTEGER; x0, y0, r1, r2, color: INTEGER);
  94.         VAR x1, y1, x2, y2: INTEGER;
  95.     BEGIN
  96.         ang := (15-ang) MOD 60;
  97.         x1 := SHORT (ENTIER(r1 * cos[ang] + 0.5));
  98.         y1 := SHORT (ENTIER(r1 * sin[ang] + 0.5));
  99.         x2 := SHORT (ENTIER(r2 * cos[ang] + 0.5));
  100.         y2 := SHORT (ENTIER(r2 * sin[ang] + 0.5));
  101.         Line (f, x0 + x1, y0 + y1, x0 + x2, y0 + y2, color, Display.invert) 
  102.     END Line2;
  103.     PROCEDURE Line3(f: Display.Frame; ang: INTEGER; x0, y0, r1, r2, color: INTEGER);
  104.         VAR x1, y1, x2, y2: INTEGER;
  105.     BEGIN
  106.         ang := (15-ang) MOD 60;
  107.         x1 := SHORT (ENTIER(r1 * cos[ang] + 0.5));
  108.         y1 := SHORT (ENTIER(r1 * sin[ang] + 0.5));
  109.         x2 := SHORT (ENTIER(r2 * cos[ang] + 0.5));
  110.         y2 := SHORT (ENTIER(r2 * sin[ang] + 0.5));
  111.         Line (f, x0 + x1, y0 + y1, x0 + x2, y0 + y2, color, Display.paint) 
  112.     END Line3;
  113.     PROCEDURE (c: Item) Draw* (x, y: INTEGER; f: Display.Frame);
  114.     (** displays the object at (x, y) in frame f *)
  115.         VAR r, rh, rm, rs, i, sec, min, hour, hourm, mode, ox, oy, w, h: INTEGER;
  116.     BEGIN
  117.         Line := SLine; Circle := SCircle;
  118.         c.GetDim (ox, oy, w, h);
  119.         Display.ReplConstC (f, f(DialogFrames.Frame).col, x, y, w, h, Display.paint);
  120.         r := Min (w - 1 , h - 1) DIV 2; x := x + r; y := y + r;
  121.         IF c.selected THEN mode := Display.invert ELSE mode := Display.replace END;
  122.         IF r >= Rmin THEN
  123.             rh := 7 * r DIV 11; rm := 9 * r DIV 11; rs := 10 * r DIV 11; i := 0;
  124.             WHILE i < 60 DO Line3 (f, i, x, y, rm, r, black); INC (i, 5) END;
  125.             Format (DialogClocks.old.timeStamp, sec, min, hour, hourm); 
  126.             Line2 (f, sec, x, y, rm-r, rs, black); 
  127.             Line2 (f, min, x, y, 0, rm, black); 
  128.             Line2 (f, hourm, x, y, 0, rh, black); 
  129.             Circle (f, x, y, 2, black, mode)
  130.         END;
  131.         Circle(f, x, y, r, black, mode)
  132.     END Draw;
  133.     PROCEDURE (c: Item) Print* (x, y: INTEGER);
  134.     (** prints the object at printer coordinates (x, y)  *)
  135.         VAR ox, oy, w, h, r, sec, min, hour, hourm, mode, i, rh, rm, rs: INTEGER; f: Display.Frame; 
  136.     BEGIN
  137.         Line := PLine; Circle := PCircle;
  138.         c.GetPDim (ox, oy, w, h);
  139.         r := Min (w - 1 , h - 1) DIV 2; x := x + r; y := y + r;
  140.                 IF r >= Rmin THEN
  141.             rh := 7 * r DIV 11; rm := 9 * r DIV 11; rs := 10 * r DIV 11; i := 0;
  142.             WHILE i < 60 DO Line2 (f, i, x, y, rm, r, black); INC (i, 5) END;
  143.             Format (DialogClocks.old.timeStamp, sec, min, hour, hourm); 
  144.             Line2 (f, sec, x, y, rm-r, rs, black); 
  145.             Line2 (f, min, x, y, 0, rm, black); 
  146.             Line2 (f, hourm, x, y, 0, rh, black); 
  147.             Circle (f, x, y, SHORT (2 * Dialogs.dUnit DIV Dialogs.pUnit), black, Display.paint)
  148.         END;
  149.         Circle(f, x, y, r, black, mode)
  150.     END Print;
  151.     PROCEDURE (c: Item) Redraw* (f: Display.Frame; x, y: INTEGER; old, new: DialogClocks.Time);
  152.     (** handles messages which were sent to frame f *)
  153.         VAR rh, rm, rs, olds, oldm, oldh, oldhm, news, newm, newh, newhm, ox, oy, w, h, r, mode: INTEGER;
  154.     BEGIN
  155.         c.GetDim (ox, oy, w, h);
  156.         r := Min (w - 1, h - 1) DIV 2; x := x + r; y := y + r;
  157.         IF c.selected THEN RETURN END;
  158.         Line := SLine; Circle := SCircle;
  159.         IF r >= Rmin THEN
  160.             rh := 7*r DIV 11; rm := 9*r DIV 11; rs := 10*r DIV 11;
  161.             Format (old.timeStamp, olds, oldm, oldh, oldhm); Format (new.timeStamp, news, newm, newh, newhm);
  162.             IF olds # news THEN Line2 (f, olds, x, y, rm-r, rs, black); Line2(f, news, x, y, rm-r, rs, black) END;
  163.             IF oldm # newm THEN Line2(f, oldm, x, y, 0, rm, black); Line2(f, newm, x, y, 0, rm, black) END;
  164.             IF oldhm # newhm THEN Line2(f, oldhm, x, y, 0, rh, black); Line2(f, newhm, x, y, 0, rh, black) END;
  165.             Circle (f, x, y, 2, black, mode)
  166.         END
  167.     END Redraw;
  168.     PROCEDURE (c: Item) Copy* (VAR dup: Dialogs.Object);
  169.     (** allocates dup and makes a deep copy of o. Before calling this methode dup should be equal NIL *)
  170.         VAR x: Item;
  171.     BEGIN
  172.         IF dup = NIL THEN NEW (x); dup := x ELSE x := dup(Item) END;
  173.         c.Copy^ (dup);
  174.     END Copy;
  175.     PROCEDURE Insert*;
  176.     (** Insert ([name] [x y w h] | ^ ) inserts a clock - item in the panel containing the caret position *)
  177.         VAR x, y, x1, y1, w, h: INTEGER; c: Item; p: Dialogs.Panel; name: ARRAY 64 OF CHAR; 
  178.     BEGIN 
  179.         NEW (c);  
  180.         DialogFrames.GetCaretPosition (p, x, y);
  181.         IF (p # NIL) THEN 
  182.             c.Init; In.Open; In.Name (name);
  183.             IF ~In.Done THEN COPY ("", name); In.Open END;
  184.             c.SetName (name); 
  185.             In.Int (x1); In.Int (y1); In.Int (w); In.Int (h);
  186.             IF ~In.Done THEN x1 := x; y1 := y; w := W; h := H 
  187.             ELSE
  188.                 IF w < 0 THEN w := W END;
  189.                 IF h < 0 THEN h := H END
  190.             END;
  191.             c.SetDim (x, y, W, H, FALSE); p.Insert (c, FALSE) 
  192.         ELSE
  193.             Dialogs.res := Dialogs.noPanelSelected
  194.         END;
  195.         IF Dialogs.res # 0 THEN Dialogs.Error ("DialogClocks") END;
  196.     END Insert;
  197. BEGIN Init
  198. END DialogAnalogClocks.
  199.