home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / splines.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  9KB  |  238 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. MODULE Splines;  (*NW 3.11.90 / 1.2.92*)(*<< fix for REAL arithmetic *)
  4.     IMPORT Display, Files, Printer, Oberon, Graphics, GraphicFrames;
  5.     CONST N = 20;
  6.     TYPE Spline* = POINTER TO SplineDesc;
  7.         SplineDesc* = RECORD (Graphics.ObjectDesc)
  8.                 n*: INTEGER; open*: BOOLEAN;
  9.                 u*, v*: ARRAY N OF INTEGER
  10.             END ;
  11.         RealVector = ARRAY N OF REAL;
  12.         Poly = RECORD a, b, c, d, t: REAL END ;
  13.         PolyVector = ARRAY N OF Poly;
  14.     VAR method*: Graphics.Method;
  15.     PROCEDURE mark(f: GraphicFrames.Frame; col, x0, y0: INTEGER; sp: Spline);
  16.         VAR i, n, x, y: INTEGER;
  17.     BEGIN i := 1;
  18.         IF sp.open THEN n := sp.n ELSE n := sp.n-1 END ;
  19.         WHILE i < n DO
  20.             INC(i); Display.ReplConstC(f, col, sp.u[i] + x0, sp.v[i] + y0, 4, 4, 0)
  21.         END
  22.     END mark;
  23.     PROCEDURE markOrg(f: GraphicFrames.Frame; col, x, y: INTEGER; sp: Spline);
  24.     BEGIN INC(x, sp.u[0]); INC(y, sp.v[0]);
  25.         Display.ReplConstC(f, col, x, y, 4, 4, 0)
  26.     END markOrg;
  27.     PROCEDURE ShowPoly(f: GraphicFrames.Frame; col: INTEGER; VAR p, q: Poly; lim: REAL);
  28.         VAR t, temp1, temp2: REAL; x, y: LONGINT;    (* << due to REAL problem with compiler *) 
  29.     BEGIN
  30.         t := 0;
  31.         temp1 := p.a * t + p.b; temp1 := temp1 * t + p.c; temp1 := temp1 * t + p.d;
  32.         temp2 := q.a * t + q.b; temp2 := temp2 * t + q.c; temp2 := temp2 * t + q.d;
  33.         x := ENTIER(temp1); y := ENTIER(temp2);
  34.         Display.DotC(f, col, SHORT(x), SHORT(y), 0);
  35.         t := t + 1.0;
  36.         WHILE t < lim DO
  37.             temp1 := p.a * t + p.b; temp1 := temp1 * t + p.c; temp1 := temp1 * t + p.d;
  38.             temp2 := q.a * t + q.b; temp2 := temp2 * t + q.c; temp2 := temp2 * t + q.d;
  39.             x := ENTIER(temp1); y := ENTIER(temp2);
  40.             Display.DotC(f, col, SHORT(x), SHORT(y), 0);
  41.             t := t + 1.0
  42.         END;
  43.         REPEAT
  44.             Display.DotC(f, col, SHORT(ENTIER(((p.a * t + p.b) * t + p.c) * t + p.d)),
  45.                 SHORT(ENTIER(((q.a * t + q.b) * t + q.c) * t + q.d)), 0);
  46.             t := t + 1.0
  47.         UNTIL t >= lim
  48.     END ShowPoly;
  49.     PROCEDURE SolveTriDiag(VAR a, b, c, y: RealVector; n: INTEGER);
  50.         VAR i: INTEGER;
  51.     BEGIN (*a, b, c of tri-diag matrix T; solve Ty' = y for y', assign y' to y*)
  52.         i := 1;
  53.         WHILE i < n DO y[i] := y[i] - c[i-1]*y[i-1]; INC(i) END ;
  54.         i := n-1; y[i] := y[i]/a[i];
  55.         WHILE i > 0 DO DEC(i); y[i] := (y[i] - b[i]*y[i+1])/a[i] END
  56.     END SolveTriDiag;    
  57.     PROCEDURE OpenSpline(VAR x, y, d: RealVector; n: INTEGER);
  58.         VAR i: INTEGER; d1, d2: REAL;
  59.             a, b, c: RealVector;
  60.     BEGIN (*from x, y compute d = y'*)
  61.         b[0] := 1.0/(x[1] - x[0]); a[0] := 2.0*b[0]; c[0] := b[0];
  62.         d1 := (y[1] - y[0])*3.0*b[0]*b[0]; d[0] := d1; i := 1;
  63.         WHILE i < n-1 DO
  64.             b[i] := 1.0/(x[i+1] - x[i]);
  65.             a[i] := 2.0*(c[i-1] + b[i]);
  66.             c[i] := b[i];
  67.             d2 := (y[i+1] - y[i])*3.0*b[i]*b[i];
  68.             d[i] := d1 + d2; d1 := d2; INC(i)
  69.         END ;
  70.         a[i] := 2.0*b[i-1]; d[i] := d1; i := 0;
  71.         WHILE i < n-1 DO c[i] := c[i]/a[i]; a[i+1] := a[i+1] - c[i]*b[i]; INC(i) END ;
  72.         SolveTriDiag(a, b, c, d, n)
  73.     END OpenSpline;
  74.     PROCEDURE ClosedSpline(VAR x, y, d: RealVector; n: INTEGER);
  75.         VAR i: INTEGER; d1, d2, hn, dn: REAL;
  76.             a, b, c, w: RealVector;
  77.     BEGIN (*from x, y compute d = y'*)
  78.         hn := 1.0/(x[n-1] - x[n-2]);
  79.         dn := (y[n-1] - y[n-2])*3.0*hn*hn;
  80.         b[0] := 1.0/(x[1] - x[0]);
  81.         a[0] := 2.0*b[0] + hn;
  82.         c[0] := b[0];
  83.         d1 := (y[1] - y[0])*3.0*b[0]*b[0]; d[0] := dn + d1;
  84.         w[0] := 1.0; i := 1;
  85.         WHILE i < n-2 DO
  86.             b[i] := 1.0/(x[i+1] - x[i]);
  87.             a[i] := 2.0*(c[i-1] + b[i]);
  88.             c[i] := b[i];
  89.             d2 := (y[i+1] - y[i])*3.0*b[i]*b[i]; d[i] := d1 + d2; d1 := d2;
  90.             w[i] := 0; INC(i)
  91.         END ;
  92.         a[i] := 2.0*b[i-1] + hn; d[i] := d1 + dn;
  93.         w[i] := 1.0; i := 0;
  94.         WHILE i < n-2 DO c[i] := c[i]/a[i]; a[i+1] := a[i+1] - c[i]*b[i]; INC(i) END ;
  95.         SolveTriDiag(a, b, c, d, n-1); SolveTriDiag(a, b, c, w, n-1); 
  96.         d1 := (d[0] + d[i])/(w[0] + w[i] + x[i+1] - x[i]); i := 0;
  97.         WHILE i < n-1 DO d[i] := d[i] - d1*w[i]; INC(i) END ;
  98.         d[i] := d[0]
  99.     END ClosedSpline;
  100.     PROCEDURE CompSpline(f: GraphicFrames.Frame; col, x0, y0: INTEGER; sp: Spline);
  101.         VAR i, n: INTEGER; dx, dy, ds: REAL;
  102.             x, xd, y, yd, s: RealVector;
  103.             p, q: PolyVector;
  104.     BEGIN (*from u, v compute x, y, s*)
  105.         x[0] := sp.u[0] + x0; y[0] := sp.v[0] + y0; s[0] := 0; n := sp.n; i := 1;
  106.         WHILE i < n DO
  107.             x[i] := sp.u[i] + x0; dx := x[i] - x[i-1];
  108.             y[i] := sp.v[i] + y0; dy := y[i] - y[i-1];
  109.             s[i] := ABS(dx) + ABS(dy) + s[i-1]; INC(i)
  110.         END ;
  111.         IF sp.open THEN OpenSpline(s, x, xd, n); OpenSpline(s, y, yd, n)
  112.         ELSE ClosedSpline(s, x, xd, n); ClosedSpline(s, y, yd, n)
  113.         END ;
  114.         (*compute coefficients from x, y, xd, yd, s*)  i := 0;
  115.         WHILE i < n-1 DO
  116.             ds := 1.0/(s[i+1] - s[i]);
  117.             dx := (x[i+1] - x[i])*ds;
  118.             p[i].a := ds*ds*(xd[i] + xd[i+1] - 2.0*dx);
  119.             p[i].b := ds*(3.0*dx - 2.0*xd[i] -xd[i+1]);
  120.             p[i].c := xd[i];
  121.             p[i].d := x[i];
  122.             p[i].t := s[i];
  123.             dy := ds*(y[i+1] - y[i]);
  124.             q[i].a := ds*ds*(yd[i] + yd[i+1] - 2.0*dy);
  125.             q[i].b := ds*(3.0*dy - 2.0*yd[i] - yd[i+1]);
  126.             q[i].c := yd[i];
  127.             q[i].d := y[i];
  128.             q[i].t := s[i]; INC(i)
  129.         END ;
  130.         p[i].t := s[i]; q[i].t := s[i];
  131.         (*display polynomials*)
  132.         i := 0;
  133.         WHILE i < n-1 DO ShowPoly(f, col, p[i], q[i], p[i+1].t - p[i].t); INC(i) END
  134.     END CompSpline;
  135.     PROCEDURE New*;
  136.         VAR sp: Spline;
  137.     BEGIN NEW(sp); sp.do := method; Graphics.new := sp
  138.     END New;
  139.     PROCEDURE Copy(src, dst: Graphics.Object);
  140.     BEGIN dst(Spline)^ := src(Spline)^
  141.     END Copy;
  142.     PROCEDURE Draw(obj: Graphics.Object; VAR M: Graphics.Msg);
  143.         VAR x, y, w, h, col: INTEGER; f: GraphicFrames.Frame;
  144.     BEGIN
  145.         WITH M: GraphicFrames.DrawMsg DO
  146.             x := obj.x + M.x; y := obj.y + M.y; w := obj.w; h := obj.h; f := M.f;
  147.             IF (x < f.X1) & (f.X <= x+w) & (y < f.Y1) & (f.Y <= y+h) THEN
  148.                 IF M.col = Display.black THEN col := obj.col ELSE col := M.col END ;
  149.                 WITH obj: Spline DO
  150.                     IF M.mode = 0 THEN
  151.                         IF obj.selected THEN mark(f, Display.white, x, y, obj) END ;
  152.                         CompSpline(f, col, x, y, obj); markOrg(f, Display.white, x, y, obj)
  153.                     ELSIF M.mode = 1 THEN mark(f, Display.white, x, y, obj)
  154.                     ELSIF M.mode = 2 THEN mark(f, f.col, x, y, obj); markOrg(f, Display.white, x, y, obj)
  155.                     ELSE mark(f, f.col, x, y, obj);
  156.                         CompSpline(f, f.col, x, y, obj); markOrg(f, f.col, x, y, obj)
  157.                     END
  158.                 END
  159.             END
  160.         END
  161.     END Draw;
  162.     PROCEDURE Selectable(obj: Graphics.Object; x, y: INTEGER): BOOLEAN;
  163.         VAR x0, y0: INTEGER;
  164.     BEGIN x0 := obj.x + obj(Spline).u[0]; y0 := obj.y + obj(Spline).v[0];
  165.         RETURN (x0 - 4 <= x) & (x <= x0 + 4) & (y0 - 4 <= y) & (y <= y0 + 4)
  166.     END Selectable;
  167.     PROCEDURE Handle(obj: Graphics.Object; VAR M: Graphics.Msg);
  168.     BEGIN
  169.         IF M IS Graphics.ColorMsg THEN obj.col := M(Graphics.ColorMsg).col END
  170.     END Handle;
  171.     PROCEDURE Read(obj: Graphics.Object; VAR R: Files.Rider; VAR C: Graphics.Context);
  172.         VAR i, j, len: INTEGER; s: SHORTINT;
  173.     BEGIN i := 0; j := 0; Files.ReadInt(R, len);
  174.         WITH obj: Spline DO
  175.             obj.n := (len-1) DIV 4; Files.Read(R, s); obj.open := s=1;
  176.             WHILE i < obj.n DO Files.ReadInt(R, obj.u[i]); INC(i) END;
  177.             WHILE j < obj.n DO Files.ReadInt(R, obj.v[j]); INC(j) END
  178.         END
  179.     END Read;
  180.     PROCEDURE Write(obj: Graphics.Object; cno: SHORTINT; VAR W: Files.Rider; VAR C: Graphics.Context);
  181.         VAR i, j: INTEGER;
  182.     BEGIN i := 0; j := 0;
  183.         WITH obj: Spline DO
  184.             Graphics.WriteObj(W, cno, obj); Files.WriteInt(W, obj.n * 4 + 1);
  185.             IF obj.open THEN Files.Write(W, 1) ELSE Files.Write(W, 0) END ;
  186.             WHILE i < obj.n DO Files.WriteInt(W, obj.u[i]); INC(i) END;
  187.             WHILE j < obj.n DO Files.WriteInt(W, obj.v[j]); INC(j) END
  188.         END
  189.     END Write;
  190.     PROCEDURE Print(obj: Graphics.Object; x, y: INTEGER);
  191.         VAR i, j, n, open: INTEGER;
  192.             u, v: ARRAY N OF INTEGER;
  193.     BEGIN
  194.         WITH obj: Spline DO
  195.             IF obj.open THEN open := 1 ELSE open := 0 END ;
  196.             n := obj.n; i := 0;
  197.             WHILE i < n DO u[i] := obj.u[i]*4; v[i] := obj.v[i]*4; INC(i) END ;
  198.             Printer.Spline(obj.x*4 + x, obj.y*4 + y, n, open, u, v)
  199.         END
  200.     END Print;
  201.     PROCEDURE MakeSpline(open: BOOLEAN);
  202.         VAR x0, x1, x2, y0, y1, y2, i, n: INTEGER;
  203.             spl: Spline;
  204.             G: GraphicFrames.Frame;
  205.             L: GraphicFrames.Location;
  206.     BEGIN G := GraphicFrames.Focus();
  207.         IF (G # NIL) & (G.mark.next # NIL) THEN
  208.             GraphicFrames.Deselect(G);
  209.             NEW(spl); x0 := G.mark.x; y0 := G.mark.y; x1 := x0; y1 := y0;
  210.             spl.u[0] := x0; spl.v[0] := y0; L := G.mark.next; i := 0; n := 1;
  211.             WHILE (L # NIL) & (n < N-1) DO
  212.                 x2 := L.x; spl.u[n] := x2; y2 := L.y; spl.v[n] := y2;
  213.                 IF x2 < x0 THEN x0 := x2 END ;
  214.                 IF x1 < x2 THEN x1 := x2 END ;
  215.                 IF y2 < y0 THEN y0 := y2 END ;
  216.                 IF y1 < y2 THEN y1 := y2 END ;
  217.                 INC(n); L := L.next
  218.             END ;
  219.             WHILE i < n DO DEC(spl.u[i], x0); DEC(spl.v[i], y0); INC(i) END ;
  220.             IF ~open THEN spl.u[n] := spl.u[0]; spl.v[n] := spl.v[0]; INC(n) END ;
  221.             spl.x := x0 - G.x; spl.y :=  y0 - G.y; spl.w := x1 - x0 + 1; spl.h := y1 - y0 + 1;
  222.             spl.open := open; spl.n := n; spl.col := Oberon.CurCol; spl.do := method;
  223.             Graphics.Add(G.graph, spl);
  224.             GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, spl)
  225.         END
  226.     END MakeSpline;
  227.     PROCEDURE MakeOpen*;
  228.     BEGIN MakeSpline(TRUE)
  229.     END MakeOpen;
  230.     PROCEDURE MakeClosed*;
  231.     BEGIN MakeSpline(FALSE)
  232.     END MakeClosed;
  233. BEGIN NEW(method); method.module := "Splines"; method.allocator := "New";
  234.     method.new := New; method.copy := Copy; method.draw := Draw;
  235.     method.selectable := Selectable; method.handle := Handle;
  236.     method.read := Read; method.write := Write; method.print := Print
  237. END Splines.
  238.