home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / curves.mod (.txt) < prev    next >
Oberon Text  |  2012-04-20  |  9KB  |  225 lines
  1. Syntax10.Scn.Fnt
  2. MODULE Curves;  (*NW 8.11.90 / 1.2.91*)
  3.     IMPORT Display, Files, Printer, Oberon, Graphics, GraphicFrames;
  4.     TYPE
  5.         Curve* = POINTER TO CurveDesc;
  6.         CurveDesc* = RECORD (Graphics.ObjectDesc)
  7.                 kind*, lw*: INTEGER
  8.             END ;
  9.     (*kind: 0 = up-line, 1 = down-line, 2 = circle, 3 = ellipse*)
  10.     VAR method*: Graphics.Method;
  11.     PROCEDURE mark(f: GraphicFrames.Frame; col, x, y: INTEGER);
  12.     BEGIN
  13.         Display.ReplConstC(f, col, x, y, 4, 4, 0)
  14.     END mark;
  15.     PROCEDURE line(f: GraphicFrames.Frame; col: INTEGER; x, y, w, h, d: LONGINT);
  16.         VAR x1, y1, u: LONGINT;
  17.     BEGIN
  18.         IF h < w THEN
  19.             x1 := x+w; u := (h-w) DIV 2;
  20.             IF d = -1 THEN INC(y, h) END ;
  21.             WHILE x < x1 DO
  22.                 Display.DotC(f, col, SHORT(x), SHORT(y), 0); INC(x);
  23.                 IF u < 0 THEN INC(u, h) ELSE INC(u, h-w); INC(y, d) END
  24.             END
  25.         ELSE y1 := y+h; u := (w-h) DIV 2;
  26.             IF d = -1 THEN INC(x, w) END ;
  27.             WHILE y < y1 DO
  28.                 Display.DotC(f, col, SHORT(x), SHORT(y), 0); INC(y);
  29.                 IF u < 0 THEN INC(u, w) ELSE INC(u, w-h); INC(x, d) END
  30.             END
  31.         END
  32.     END line;
  33.     PROCEDURE circle(f: GraphicFrames.Frame; col: INTEGER; x0, y0, r: LONGINT);
  34.         VAR x, y, u: LONGINT;
  35.     BEGIN u := 1 - r; x := r; y := 0;
  36.         WHILE y <= x DO
  37.             Display.DotC(f, col, SHORT(x0+x), SHORT(y0+y), 0);
  38.             Display.DotC(f, col, SHORT(x0+y), SHORT(y0+x), 0);
  39.             Display.DotC(f, col, SHORT(x0-y), SHORT(y0+x), 0);
  40.             Display.DotC(f, col, SHORT(x0-x), SHORT(y0+y), 0);
  41.             Display.DotC(f, col, SHORT(x0-x), SHORT(y0-y), 0);
  42.             Display.DotC(f, col, SHORT(x0-y), SHORT(y0-x), 0);
  43.             Display.DotC(f, col, SHORT(x0+y), SHORT(y0-x), 0);
  44.             Display.DotC(f, col, SHORT(x0+x), SHORT(y0-y), 0);
  45.             IF u < 0 THEN INC(u, 2*y+3) ELSE INC(u, 2*(y-x)+5); DEC(x) END ;
  46.             INC(y)
  47.         END
  48.     END circle;
  49.     PROCEDURE ellipse(f: GraphicFrames.Frame; col: INTEGER; x0, y0, a, b: LONGINT);
  50.         VAR x, y, y1, aa, bb, d, g, h: LONGINT;
  51.     BEGIN aa := a*a; bb := b*b;
  52.         h := (aa DIV 4) - b*aa + bb; g := (9*aa DIV 4) - 3*b*aa + bb; x := 0; y := b;
  53.         WHILE g < 0 DO
  54.             Display.DotC(f, col, SHORT(x0+x), SHORT(y0+y), 0);
  55.             Display.DotC(f, col, SHORT(x0-x), SHORT(y0+y), 0);
  56.             Display.DotC(f, col, SHORT(x0-x), SHORT(y0-y), 0);
  57.             Display.DotC(f, col, SHORT(x0+x), SHORT(y0-y), 0);
  58.             IF h < 0 THEN d := (2*x+3)*bb; INC(g, d)
  59.             ELSE d := (2*x+3)*bb - 2*(y-1)*aa; INC(g, d + 2*aa); DEC(y)
  60.             END ;
  61.             INC(h, d); INC(x)
  62.         END ;
  63.         y1 := y; h := (bb DIV 4) - a*bb + aa; x := a; y := 0;
  64.         WHILE y <= y1 DO
  65.             Display.DotC(f, col, SHORT(x0+x), SHORT(y0+y), 0);
  66.             Display.DotC(f, col, SHORT(x0-x), SHORT(y0+y), 0);
  67.             Display.DotC(f, col, SHORT(x0-x), SHORT(y0-y), 0);
  68.             Display.DotC(f, col, SHORT(x0+x), SHORT(y0-y), 0);
  69.             IF h < 0 THEN INC(h, (2*y+3)*aa) ELSE INC(h, (2*y+3)*aa - 2*(x-1)*bb); DEC(x) END ;
  70.             INC(y)
  71.         END
  72.     END ellipse;
  73.     PROCEDURE New*;
  74.         VAR c: Curve;
  75.     BEGIN NEW(c); c.do := method; Graphics.new := c
  76.     END New;
  77.     PROCEDURE Copy(src, dst: Graphics.Object);
  78.     BEGIN dst.x := src.x; dst.y := src.y; dst.w := src.w; dst.h := src.h; dst.col := src.col;
  79.         dst(Curve).kind := src(Curve).kind; dst(Curve).lw := src(Curve).lw
  80.     END Copy;
  81.     PROCEDURE Draw(obj: Graphics.Object; VAR M: Graphics.Msg);
  82.         VAR x, y, w, h, col: INTEGER; f: GraphicFrames.Frame;
  83.     BEGIN
  84.         WITH M: GraphicFrames.DrawMsg DO
  85.             x := obj.x + M.x; y := obj.y + M.y; w := obj.w; h := obj.h; f := M.f;
  86.             IF M.col = Display.black THEN col := obj.col ELSE col := M.col END ;
  87.             IF (x < f.X1) & (f.X <= x+w) & (y < f.Y1) & (f.Y <= y+h) THEN
  88.                 IF obj(Curve).kind = 0 THEN  (*up-line*)
  89.                     IF M.mode = 0 THEN
  90.                         IF obj.selected THEN mark(f, Display.white, x, y) END ;
  91.                         line(f, col, x, y, w, h, 1)
  92.                     ELSIF M.mode = 1 THEN mark(f, Display.white, x, y)
  93.                     ELSIF M.mode = 2 THEN mark(f, f.col, x, y)
  94.                     ELSE mark(f, f.col, x, y); line(f, f.col, x, y, w, h, 1)
  95.                     END
  96.                 ELSIF obj(Curve).kind = 1 THEN  (*down-line*)
  97.                     IF M.mode = 0 THEN
  98.                         IF obj.selected THEN mark(f, Display.white, x, y+h) END ;
  99.                         line(f, col, x, y, w, h, -1)
  100.                     ELSIF M.mode = 1 THEN mark(f, Display.white, x, y+h)
  101.                     ELSIF M.mode = 2 THEN mark(f, f.col, x, y+h)
  102.                     ELSE mark(f, f.col, x, y+h); line(f, f.col, x, y, w, h, -1)
  103.                     END
  104.                 ELSIF obj(Curve).kind = 2 THEN  (*circle*)
  105.                     w := w DIV 2;
  106.                     IF M.mode = 0 THEN
  107.                         IF obj.selected THEN mark(f, Display.white, x+w, y-4) END ;
  108.                         circle(f, col, x+w, y+w, w)
  109.                     ELSIF M.mode = 1 THEN mark(f, Display.white, x+w, y-4)
  110.                     ELSIF M.mode = 2 THEN mark(f, f.col, x+w, y-4)
  111.                     ELSE mark(f, f.col, x+w, y-4); circle(f, f.col, x+w, y+w, w)
  112.                     END
  113.                 ELSIF obj(Curve).kind = 3 THEN  (*ellipse*)
  114.                     w := w DIV 2; h := h DIV 2;
  115.                     IF M.mode = 0 THEN
  116.                         IF obj.selected THEN mark(f, Display.white, x+w, y-4) END ;
  117.                         ellipse(f, col, x+w, y+h, w, h)
  118.                     ELSIF M.mode = 1 THEN mark(f, Display.white, x+w, y-4)
  119.                     ELSIF M.mode = 2 THEN mark(f, f.col, x+w, y-4)
  120.                     ELSE mark(f, f.col, x+w, y-4); ellipse(f, f.col, x+w, y+h, w, h)
  121.                     END
  122.                 END
  123.             END
  124.         END
  125.     END Draw;
  126.     PROCEDURE Selectable(obj: Graphics.Object; x, y: INTEGER): BOOLEAN;
  127.         VAR xm, y0, w, h: INTEGER;
  128.     BEGIN
  129.         IF obj(Curve).kind <= 1 THEN  (*line*)
  130.             w := obj.w; h := obj.h;
  131.             IF obj(Curve).kind = 1 THEN y0 := obj.y + h; h := -h ELSE y0 := obj.y END ;
  132.             RETURN (obj.x <= x) & (x < obj.x + w) & (ABS(LONG(y-y0)*w - LONG(x-obj.x)*h) < w*4)
  133.         ELSE (*circle or ellipse*)
  134.             xm := obj.w DIV 2 + obj.x;
  135.             RETURN (xm - 4 <= x) & (x <= xm + 4) & (obj.y - 4 <= y) & (y <= obj.y + 4)
  136.         END
  137.     END Selectable;
  138.     PROCEDURE Handle(obj: Graphics.Object; VAR M: Graphics.Msg);
  139.     BEGIN
  140.         IF M IS Graphics.ColorMsg THEN obj.col := M(Graphics.ColorMsg).col END
  141.     END Handle;
  142.     PROCEDURE Read(obj: Graphics.Object; VAR R: Files.Rider; VAR C: Graphics.Context);
  143.         VAR len: INTEGER;
  144.     BEGIN Files.ReadInt(R, len); Files.ReadInt(R, obj(Curve).kind); Files.ReadInt(R, obj(Curve).lw)
  145.     END Read;
  146.     PROCEDURE Write(obj: Graphics.Object; cno: SHORTINT; VAR W: Files.Rider; VAR C: Graphics.Context);
  147.     BEGIN Graphics.WriteObj(W, cno, obj);
  148.         Files.WriteInt(W, 4); Files.WriteInt(W, obj(Curve).kind); Files.WriteInt(W, obj(Curve).lw)
  149.     END Write;
  150.     PROCEDURE Print(obj: Graphics.Object; x, y: INTEGER);
  151.         VAR x0, y0: INTEGER;
  152.     BEGIN
  153.         IF obj(Curve).kind = 0 THEN
  154.             x0 := obj.x * 4 + x; y0 := obj.y * 4 + y;
  155.             Printer.Line(x0, y0, obj.w * 4 + x0, obj.h * 4 + y0)
  156.         ELSIF obj(Curve).kind = 1 THEN
  157.             x0 := obj.x * 4 + x; y0 := obj.y * 4 + y;
  158.             Printer.Line(x0, obj.h * 4 + y0, obj.w * 4 + x0, y0)
  159.         ELSIF obj(Curve).kind = 2 THEN
  160.             Printer.Circle((obj.x*2 + obj.w)*2 + x, (obj.y*2 + obj.h)*2 + y, obj.w*2)
  161.         ELSE
  162.             Printer.Ellipse((obj.x*2 + obj.w)*2 + x, (obj.y*2 + obj.h)*2 + y, obj.w*2, obj.h*2)
  163.         END
  164.     END Print;
  165.     PROCEDURE MakeLine*;  (*command*)
  166.         VAR x0, x1, y0, y1: INTEGER;
  167.             c: Curve;
  168.             G: GraphicFrames.Frame;
  169.     BEGIN G := GraphicFrames.Focus();
  170.         IF (G # NIL) & (G.mark.next # NIL) THEN
  171.             GraphicFrames.Deselect(G);
  172.             x0 := G.mark.x; y0 := G.mark.y; x1 := G.mark.next.x; y1 := G.mark.next.y;
  173.             NEW(c); c.col := Oberon.CurCol;
  174.             c.w := ABS(x1-x0); c.h := ABS(y1-y0); c.lw := Graphics.width;
  175.             IF x0 <= x1 THEN c.x := x0;
  176.                 IF y0 <= y1 THEN c.kind := 0; c.y := y0 ELSE c.kind := 1; c.y := y1 END
  177.             ELSE c.x := x1;
  178.                 IF y1 < y0 THEN c.kind := 0; c.y := y1 ELSE c.kind := 1; c.y := y0 END
  179.             END ;
  180.             DEC(c.x, G.x); DEC(c.y, G.y); c.do := method;
  181.             Graphics.Add(G.graph, c);
  182.             GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, c)
  183.         END
  184.     END MakeLine;
  185.     PROCEDURE MakeCircle*;  (*command*)
  186.         VAR x0, y0, r: INTEGER;
  187.             c: Curve;
  188.             G: GraphicFrames.Frame;
  189.     BEGIN G := GraphicFrames.Focus();
  190.         IF (G # NIL) & (G.mark.next # NIL) THEN
  191.             GraphicFrames.Deselect(G);
  192.             x0 := G.mark.x; y0 := G.mark.y; r := ABS(G.mark.next.x-x0);
  193.             IF r > 4 THEN
  194.                 NEW(c); c.x := x0 - r - G.x; c.y := y0 - r - G.y; c.w := 2*r+1; c.h := c.w;
  195.                 c.kind := 2; c.col := Oberon.CurCol;
  196.                 c.lw := Graphics.width; c.do := method;
  197.                 Graphics.Add(G.graph, c);
  198.                 GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, c)
  199.             END
  200.         END
  201.     END MakeCircle;
  202.     PROCEDURE MakeEllipse*;  (*command*)
  203.         VAR x0, y0, a, b: INTEGER;
  204.             c: Curve;
  205.             G: GraphicFrames.Frame;
  206.     BEGIN G := GraphicFrames.Focus();
  207.         IF (G # NIL) & (G.mark.next # NIL) & (G.mark.next.next # NIL) THEN
  208.             GraphicFrames.Deselect(G);
  209.             x0 := G.mark.x; y0 := G.mark.y;
  210.             a := ABS(G.mark.next.x-x0); b := ABS(G.mark.next.next.y - y0);
  211.             IF (a > 4) & (b > 4) THEN
  212.                 NEW(c); c.x := x0 - a - G.x; c.y := y0 - b - G.y; c.w := 2*a+1; c.h := 2*b+1;
  213.                 c.kind := 3; c.col := Oberon.CurCol;
  214.                 c.lw := Graphics.width; c.do := method;
  215.                 Graphics.Add(G.graph, c);
  216.                 GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, c)
  217.             END
  218.         END
  219.     END MakeEllipse;
  220. BEGIN NEW(method); method.module := "Curves"; method.allocator := "New";
  221.     method.new := New; method.copy := Copy; method.draw := Draw;
  222.     method.selectable := Selectable; method.handle := Handle;
  223.     method.read := Read; method.write := Write; method.print := Print
  224. END Curves.
  225.