home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / kepler6.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  11KB  |  323 lines
  1. Syntax10.Scn.Fnt
  2. MODULE Kepler6;
  3. (* Semesterarbeit Wintersemester 91/92 von Samuel Urech
  4.     Erweiterung des Graphikeditors Kepler um Splines
  5.     Programmiersprache: Oberon-2 auf Ceres-1
  6.     Autor: Samuel Urech, Tannenrauchstrasse 35/107, 8038 Z
  7.                 Tel. 01 481 92 92    Stud.Nr. 87-906-434
  8.     Datum: 4.11.91            Stand: 6.2.92
  9.     J. Templ, 18.06.92, NewClosedBezier intriduced, NewOpenCRSpline renamed to NewCRSpline
  10.     J. Templ, 01.07.93 expressions simplified
  11.     IMPORT KeplerPorts, KeplerGraphs, KeplerFrames, Display, Math;
  12.     CONST Eps = 1.0E-6;
  13.     TYPE
  14.         CRSpline* = POINTER TO CRSplineDesc;
  15.         CRSplineDesc* = RECORD
  16.             ( KeplerGraphs.ConsDesc )
  17.         END;
  18.         Bezier* = POINTER TO BezierDesc;
  19.         BezierDesc* = RECORD
  20.             ( KeplerGraphs.ConsDesc )
  21.         END;
  22.     PROCEDURE Min( a, b : INTEGER ) : INTEGER;
  23.     BEGIN (* Min *)
  24.         IF a < b THEN RETURN a
  25.         ELSE RETURN b
  26.         END;
  27.     END Min;
  28.     PROCEDURE Max( a, b : INTEGER ) : INTEGER;
  29.     BEGIN (* Max *)
  30.         IF a < b THEN RETURN b
  31.         ELSE RETURN a
  32.         END;
  33.     END Max;
  34.     PROCEDURE GetBoundingBox( a3, a2, a1, a0, b3, b2, b1, b0 : REAL;
  35.                                                         x1, y1, x2, y2 : INTEGER;
  36.                                                         VAR x, y, w, h : INTEGER );
  37.     (* Berechnet ein Rechteck, in dem sich das zu zeichnende Kurvenst
  38. ck vollst
  39. ndig befindet.
  40.         a3, a2, a1, a0, b3, b2, b1, b0 sind die Koeffizienten der Kurve,
  41.         x1, y1, x2, y2 sind die Randpunkte. *)
  42.         VAR t, rt, temp : REAL;
  43.                 x3, x4, y3, y4 : INTEGER;
  44.     BEGIN (* GetBoundingBox *)
  45.         IF ABS( a3 ) < Eps THEN
  46.             IF ABS( a2 ) < Eps THEN
  47.                 x := Min( x1, x2 );
  48.                 w := ABS( x2 - x1 );
  49.             ELSE
  50.                 t := 0.5 * a1 / a2;
  51.                 temp := t * ( a2 + t * a3 );
  52.                 x3 := SHORT( ENTIER( a0 + t * ( a1 + temp ) ) );
  53.                 x := Min( x1, Min( x2, x3 - 1 ) );
  54.                 w := Max( x1, Max( x2, x3 + 1 ) ) - x;
  55.             END; (* IF *)
  56.         ELSE
  57.             rt := a2 * a2 - 3.0 * a1 * a3;
  58.             IF rt < 0 THEN
  59.                 x := Min( x1, x2 );
  60.                 w := ABS( x2 - x1 );
  61.             ELSE
  62.                 rt := Math.sqrt( rt );
  63.                 t := ( -a2 - rt ) / 3 / a3;
  64.                 IF ( t > 0 ) & ( t < 1 ) THEN
  65.                     temp := t * ( a2 + t * a3 );
  66.                     x3 := SHORT( ENTIER( a0 + t * ( a1 + temp ) ) );
  67.                 ELSE
  68.                     x3 := x1;
  69.                 END;
  70.                 t := ( -a2 + rt ) / 3 / a3;
  71.                 IF ( t > 0 ) & ( t < 1 ) THEN
  72.                     temp := t * ( a2 + t * a3 );
  73.                     x4 := SHORT( ENTIER( a0 + t * ( a1 + temp ) ) );
  74.                 ELSE
  75.                     x4 := x1;
  76.                 END; (* IF *)
  77.                 x := Min( x1, Min( x2, Min( x3, x4 ) - 1 ) );
  78.                 w := Max( x1, Max( x2, Max( x3, x4 ) + 1 ) ) - x;
  79.             END; (* IF *)
  80.         END; (* IF *)
  81.         IF ABS( b3 ) < Eps THEN
  82.             IF ABS( b2 ) < Eps THEN
  83.                 y := Min( y1, y2 );
  84.                 h := ABS( y2 - y1 );
  85.             ELSE
  86.                 t := 0.5 * b1 / b2;
  87.                 temp := t * ( b2 + t * b3 );
  88.                 y3 := SHORT( ENTIER( b0 + t * ( b1 + temp ) ) );
  89.                 y := Min( y1, Min( y2, x3 - 1 ) );
  90.                 h := Max( y1, Max( y2, y3 + 1 ) ) - y;
  91.             END; (* IF *)
  92.         ELSE
  93.             rt := b2 * b2 - 3.0 * b1 * b3;
  94.             IF rt < 0 THEN
  95.                 y := Min( y1, y2 );
  96.                 h := ABS( y2 - y1 );
  97.             ELSE
  98.                 rt := Math.sqrt( rt );
  99.                 t := ( -b2 - rt ) / 3 / b3;
  100.                 IF ( t > 0 ) & ( t < 1 ) THEN
  101.                     temp := t * ( b2 + t * b3 );
  102.                     y3 := SHORT( ENTIER( b0 + t * ( b1 + temp ) ) );
  103.                 ELSE
  104.                     y3 := y1;
  105.                 END;
  106.                 t := ( -b2 + rt ) / 3 / b3;
  107.                 IF ( t > 0 ) & ( t < 1 ) THEN
  108.                     temp := t * ( b2 + t * b3 );
  109.                     y4 := SHORT( ENTIER( b0 + t * ( b1 + temp ) ) );
  110.                 ELSE
  111.                     y4 := y1;
  112.                 END; (* IF *)
  113.                 y := Min( y1, Min( y2, Min( y3, y4 ) - 1 ) );
  114.                 h := Max( y1, Max( y2, Max( y3, y4 ) + 1 ) ) - y;
  115.             END; (* IF *)
  116.         END; (* IF *)
  117.         DEC( x, 2 ); DEC( y, 2 ); INC( w, 4 ); INC( h, 4 );
  118.     END GetBoundingBox;
  119.     PROCEDURE Intersect( f : KeplerPorts.Port; x, y, w, h : INTEGER ) : BOOLEAN;
  120.     (* Pr
  121. ft, ob sich der Frame f mit dem Rechteck ( x, y, w, h ) 
  122. berschneidet. *)
  123.         VAR t : INTEGER;
  124.     BEGIN (* Intersect *)
  125.         x := f.CX( x ); y := f.CY( y ); w := w DIV f.scale; h := h DIV f.scale;
  126.         t := x + w;
  127.         IF f.X > x THEN x := f.X END;
  128.         IF f.X + f.W < t THEN
  129.             w := f.X + f.W - x;
  130.         ELSE
  131.             w := t - x;
  132.         END;
  133.         IF w <= 0 THEN RETURN FALSE END;
  134.         t := y + h;
  135.         IF f.Y > y THEN y := f.Y END;
  136.         IF f.Y + f.H < t THEN
  137.             h := f.Y + f.H - y;
  138.         ELSE
  139.             h := t - y;
  140.         END;
  141.         RETURN h > 0
  142.     END Intersect;
  143.     PROCEDURE DrawCurve( f : KeplerPorts.Port; a3, a2, a1, a0, b3, b2, b1, b0 : REAL );
  144.     (* Zeichnet die Kurve mit den Koeffizienten a3, a2, a1, a0, b3, b2, b1, b0 in den Frame f. *)
  145.         PROCEDURE DrawRec( lo, hi : REAL );
  146.         (* Zeichnet rekursiv den Spline im Bereich lo, hi. *)
  147.             VAR xlo, xhi, ylo, yhi : INTEGER;
  148.                     med : REAL;
  149.         BEGIN (* DrawRec *)
  150.             xlo := SHORT( ENTIER( a0 + lo * ( a1 + lo * ( a2 + lo * a3 ) ) ) );
  151.             xhi := SHORT( ENTIER( a0 + hi * ( a1 + hi * ( a2 + hi * a3 ) ) ) );
  152.             ylo := SHORT( ENTIER( b0 + lo * ( b1 + lo * ( b2 + lo * b3 ) ) ) );
  153.             yhi := SHORT( ENTIER( b0 + hi * ( b1 + hi * ( b2 + hi * b3 ) ) ) );
  154.             IF ABS( xhi - xlo ) + ABS( yhi - ylo ) <= 2 * f.scale THEN
  155.                 f.DrawLine( xlo, ylo, xhi, yhi, Display.white, Display.replace );
  156.             ELSE
  157.                 med := ( lo + hi ) / 2;
  158.                 DrawRec( lo, med );
  159.                 DrawRec( med, hi );
  160.             END; (* IF *)
  161.         END DrawRec;
  162.     BEGIN (* DrawCurve *)
  163.         DrawRec( 0, 1 );
  164.     END DrawCurve;
  165. (* ------------------------------  Catmull-Rom Spline  ----------------------------------- *)
  166.     PROCEDURE ( s : CRSpline ) Draw*( f : KeplerPorts.Port );
  167.     (* druckt ein Catmull-Rom Spline auf den Bildschirm *)
  168.         VAR a3, a2, a1, a0, b3, b2, b1, b0 : REAL;
  169.                 x, y, w, h, t : INTEGER;
  170.     BEGIN (* Draw *)
  171.         t := s.p[ 3 ].x - 3 * s.p[ 2 ].x; a3 := ( t + 3 * s.p[ 1 ].x - s.p[ 0 ].x ) / 2;
  172.         t := -s.p[ 3 ].x + 4 * s.p[ 2 ].x; a2 := ( t - 5 * s.p[ 1 ].x + 2 * s.p[ 0 ].x ) / 2;
  173.         a1 := ( s.p[ 2 ].x - s.p[ 0 ].x ) / 2;
  174.         a0 := s.p[ 1 ].x;
  175.         t := s.p[ 3 ].y - 3 * s.p[ 2 ].y; b3 := ( t + 3 * s.p[ 1 ].y - s.p[ 0 ].y ) / 2;
  176.         t := -s.p[ 3 ].y + 4 * s.p[ 2 ].y; b2 := ( t - 5 * s.p[ 1 ].y + 2 * s.p[ 0 ].y ) / 2;
  177.         b1 := ( s.p[ 2 ].y - s.p[ 0 ].y ) / 2;
  178.         b0 := s.p[ 1 ].y;
  179.         GetBoundingBox( a3, a2, a1, a0, b3, b2, b1, b0, s.p[ 1 ].x, s.p[ 1 ].y, s.p[ 2 ].x, s.p[ 2 ].y, x, y, w, h );
  180.         IF f IS KeplerPorts.BalloonPort THEN
  181.             f.DrawRect( x, y, w, h, 0, 0 );
  182.         ELSIF Intersect( f, x, y, w, h ) THEN
  183.             DrawCurve( f, a3, a2, a1, a0, b3, b2, b1, b0 );
  184.         END;
  185.     END Draw;
  186.     PROCEDURE NewCRSpline*;
  187.     (* Liest alle Fokuspunkte ein und legt ein Catmull-Rom Spline durch sie hindurch. *)
  188.         VAR s, s1 : CRSpline;
  189.     BEGIN (* NewOpenCRSpline *)
  190.         IF KeplerFrames.nofpts >= 4 THEN
  191.             NEW( s );
  192.             s.nofpts := 4;
  193.             KeplerFrames.ConsumePoint( s.p[ 0 ] );
  194.             KeplerFrames.ConsumePoint( s.p[ 1 ] );
  195.             KeplerFrames.ConsumePoint( s.p[ 2 ] );
  196.             KeplerFrames.ConsumePoint( s.p[ 3 ] );
  197.             KeplerFrames.Focus.Append( s );
  198.             WHILE KeplerFrames.nofpts > 0 DO
  199.                 NEW( s1 );
  200.                 s1.nofpts := 4;
  201.                 s1.p[ 0 ] := s.p[ 1 ]; INC( s1.p[ 0 ].refcnt );
  202.                 s1.p[ 1 ] := s.p[ 2 ]; INC( s1.p[ 1 ].refcnt );
  203.                 s1.p[ 2 ] := s.p[ 3 ]; INC( s1.p[ 2 ].refcnt );
  204.                 KeplerFrames.ConsumePoint( s1.p[ 3 ] );
  205.                 s := s1;
  206.                 KeplerFrames.Focus.Append( s );
  207.             END; (* WHILE *)
  208.         END; (* IF *)
  209.     END NewCRSpline;
  210.     PROCEDURE NewClosedCRSpline*;
  211.     (* Liest alle Fokuspunkte ein und legt ein geschlossenes Catmull-Rom Spline durch sie hindurch. *)
  212.         VAR s, s1 : CRSpline;
  213.                 point : ARRAY 3 OF KeplerGraphs.Star;
  214.                 i : INTEGER;
  215.     BEGIN (* NewClosedCRSpline *)
  216.         IF KeplerFrames.nofpts >= 4 THEN
  217.             NEW( s );
  218.             s.nofpts := 4;
  219.             KeplerFrames.ConsumePoint( s.p[ 0 ] ); point[ 0 ] := s.p[ 0 ];
  220.             KeplerFrames.ConsumePoint( s.p[ 1 ] ); point[ 1 ] := s.p[ 1 ];
  221.             KeplerFrames.ConsumePoint( s.p[ 2 ] ); point[ 2 ] := s.p[ 2 ];
  222.             KeplerFrames.ConsumePoint( s.p[ 3 ] );
  223.             KeplerFrames.Focus.Append( s );
  224.             WHILE KeplerFrames.nofpts > 0 DO
  225.                 NEW( s1 );
  226.                 s1.nofpts := 4;
  227.                 s1.p[ 0 ] := s.p[ 1 ]; INC( s1.p[ 0 ].refcnt );
  228.                 s1.p[ 1 ] := s.p[ 2 ]; INC( s1.p[ 1 ].refcnt );
  229.                 s1.p[ 2 ] := s.p[ 3 ]; INC( s1.p[ 2 ].refcnt );
  230.                 KeplerFrames.ConsumePoint( s1.p[ 3 ] );
  231.                 s := s1;
  232.                 KeplerFrames.Focus.Append( s );
  233.             END; (* WHILE *)
  234.             FOR i := 0 TO 2 DO
  235.                 NEW( s1 );
  236.                 s1.nofpts := 4;
  237.                 s1.p[ 0 ] := s.p[ 1 ]; INC( s1.p[ 0 ].refcnt );
  238.                 s1.p[ 1 ] := s.p[ 2 ]; INC( s1.p[ 1 ].refcnt );
  239.                 s1.p[ 2 ] := s.p[ 3 ]; INC( s1.p[ 2 ].refcnt );
  240.                 s1.p[ 3 ] := point[ i ]; INC( s1.p[ 3 ].refcnt );
  241.                 s := s1;
  242.                 KeplerFrames.Focus.Append( s );
  243.             END; (* FOR *)
  244.         END; (* IF *)
  245.     END NewClosedCRSpline;
  246. (* -----------------------------------  Bezier-Kurve  ------------------------------- *)
  247.     PROCEDURE ( s : Bezier ) Draw*( f : KeplerPorts.Port );
  248.     (* Druckt eine Bezier-Kurve auf den Bildschirm *)
  249.         VAR a3, a2, a1, a0, b3, b2, b1, b0 : INTEGER;
  250.                 x, y, w, h, t : INTEGER;
  251.     BEGIN (* Draw *)
  252.         t := 3 * s.p[ 3 ].x - 5 * s.p[ 2 ].x; a3 := t + 3 * s.p[ 1 ].x - s.p[ 0 ].x;
  253.         t := -3 * s.p[ 3 ].x + 6 * s.p[ 2 ].x; a2 := t - 6 * s.p[ 1 ].x + 3 * s.p[ 0 ].x;
  254.         a1 := ( s.p[ 1 ].x - s.p[ 0 ].x ) * 3;
  255.         a0 := s.p[ 0 ].x;
  256.         t := 3 * s.p[ 3 ].y - 5 * s.p[ 2 ].y; b3 := t + 3 * s.p[ 1 ].y - s.p[ 0 ].y;
  257.         t := -3 * s.p[ 3 ].y + 6 * s.p[ 2 ].y; b2 := t - 6 * s.p[ 1 ].y + 3 * s.p[ 0 ].y;
  258.         b1 := ( s.p[ 1 ].y - s.p[ 0 ].y ) * 3;
  259.         b0 := s.p[ 0 ].y;
  260.         GetBoundingBox( a3, a2, a1, a0, b3, b2, b1, b0, s.p[ 0 ].x, s.p[ 0 ].y, a3 + a2 + a1 + a0, b3 + b2 + b1 + b0, x, y, w, h );
  261.         IF f IS KeplerPorts.BalloonPort THEN
  262.             f.DrawRect( x, y, w, h, 0, 0 );
  263.         ELSIF Intersect( f, x, y, w, h ) THEN
  264.             DrawCurve( f, a3, a2, a1, a0, b3, b2, b1, b0 );
  265.         END;
  266.     END Draw;
  267.     PROCEDURE NewBezier*;
  268.     (* Liest eine gerade Anzahl Fokuspunkte ein und legt eine Bezier-Kurve durch sie hindurch. *)
  269.         VAR s, s1 : Bezier;
  270.     BEGIN
  271.         IF KeplerFrames.nofpts >= 4 THEN
  272.             NEW( s );
  273.             s.nofpts := 4;
  274.             KeplerFrames.ConsumePoint( s.p[ 0 ] );
  275.             KeplerFrames.ConsumePoint( s.p[ 1 ] );
  276.             KeplerFrames.ConsumePoint( s.p[ 2 ] );
  277.             KeplerFrames.ConsumePoint( s.p[ 3 ] );
  278.             KeplerFrames.Focus.Append( s );
  279.             WHILE KeplerFrames.nofpts > 1 DO
  280.                 NEW( s1 );
  281.                 s1.nofpts := 4;
  282.                 s1.p[ 0 ] := s.p[ 2 ]; INC( s1.p[ 0 ].refcnt );
  283.                 s1.p[ 1 ] := s.p[ 3 ]; INC( s1.p[ 1 ].refcnt );
  284.                 KeplerFrames.ConsumePoint( s1.p[ 2 ] );
  285.                 KeplerFrames.ConsumePoint( s1.p[ 3 ] );
  286.                 s := s1;
  287.                 KeplerFrames.Focus.Append( s );
  288.             END; (* WHILE *)
  289.         END; (* IF *)
  290.     END NewBezier;
  291.     PROCEDURE NewClosedBezier*;
  292.     (* Liest eine gerade Anzahl Fokuspunkte ein und legt eine Bezier-Kurve durch sie hindurch. *)
  293.         VAR s, s1, s0 : Bezier;
  294.     BEGIN
  295.         IF KeplerFrames.nofpts >= 4 THEN
  296.             NEW( s ); s0 := s; s1 := s;
  297.             s.nofpts := 4;
  298.             KeplerFrames.ConsumePoint( s.p[ 0 ] );
  299.             KeplerFrames.ConsumePoint( s.p[ 1 ] );
  300.             KeplerFrames.ConsumePoint( s.p[ 2 ] );
  301.             KeplerFrames.ConsumePoint( s.p[ 3 ] );
  302.             KeplerFrames.Focus.Append( s );
  303.             WHILE KeplerFrames.nofpts > 1 DO
  304.                 NEW( s1 );
  305.                 s1.nofpts := 4;
  306.                 s1.p[ 0 ] := s.p[ 2 ]; INC( s1.p[ 0 ].refcnt );
  307.                 s1.p[ 1 ] := s.p[ 3 ]; INC( s1.p[ 1 ].refcnt );
  308.                 KeplerFrames.ConsumePoint( s1.p[ 2 ] );
  309.                 KeplerFrames.ConsumePoint( s1.p[ 3 ] );
  310.                 s := s1;
  311.                 KeplerFrames.Focus.Append( s )
  312.             END ;
  313.             NEW(s);
  314.             s.nofpts := 4;
  315.             s.p[ 0 ] := s1.p[ 2 ]; INC(s.p[ 0 ].refcnt);
  316.             s.p[ 1 ] := s1.p[ 3 ]; INC(s.p[ 1 ].refcnt);
  317.             s.p[ 2 ] := s0.p[ 0 ]; INC(s.p[ 2 ].refcnt);
  318.             s.p[ 3 ] := s0.p[ 1 ]; INC(s.p[ 3 ].refcnt);
  319.             KeplerFrames.Focus.Append( s )
  320.         END
  321.     END NewClosedBezier;
  322. END Kepler6.
  323.