Syntax10.Scn.Fnt
MODULE Kepler6;
(* Semesterarbeit Wintersemester 91/92 von Samuel Urech
	Erweiterung des Graphikeditors Kepler um Splines
	Programmiersprache: Oberon-2 auf Ceres-1
	Autor: Samuel Urech, Tannenrauchstrasse 35/107, 8038 Z
				Tel. 01 481 92 92	Stud.Nr. 87-906-434
	Datum: 4.11.91			Stand: 6.2.92
	J. Templ, 18.06.92, NewClosedBezier intriduced, NewOpenCRSpline renamed to NewCRSpline
	J. Templ, 01.07.93 expressions simplified
	IMPORT KeplerPorts, KeplerGraphs, KeplerFrames, Display, Math;
	CONST Eps = 1.0E-6;
	TYPE
		CRSpline* = POINTER TO CRSplineDesc;
		CRSplineDesc* = RECORD
			( KeplerGraphs.ConsDesc )
		END;
		Bezier* = POINTER TO BezierDesc;
		BezierDesc* = RECORD
			( KeplerGraphs.ConsDesc )
		END;
	PROCEDURE Min( a, b : INTEGER ) : INTEGER;
	BEGIN (* Min *)
		IF a < b THEN RETURN a
		ELSE RETURN b
		END;
	END Min;
	PROCEDURE Max( a, b : INTEGER ) : INTEGER;
	BEGIN (* Max *)
		IF a < b THEN RETURN b
		ELSE RETURN a
		END;
	END Max;
	PROCEDURE GetBoundingBox( a3, a2, a1, a0, b3, b2, b1, b0 : REAL;
														x1, y1, x2, y2 : INTEGER;
														VAR x, y, w, h : INTEGER );
	(* Berechnet ein Rechteck, in dem sich das zu zeichnende Kurvenst
ck vollst
ndig befindet.
		a3, a2, a1, a0, b3, b2, b1, b0 sind die Koeffizienten der Kurve,
		x1, y1, x2, y2 sind die Randpunkte. *)
		VAR t, rt, temp : REAL;
				x3, x4, y3, y4 : INTEGER;
	BEGIN (* GetBoundingBox *)
		IF ABS( a3 ) < Eps THEN
			IF ABS( a2 ) < Eps THEN
				x := Min( x1, x2 );
				w := ABS( x2 - x1 );
			ELSE
				t := 0.5 * a1 / a2;
				temp := t * ( a2 + t * a3 );
				x3 := SHORT( ENTIER( a0 + t * ( a1 + temp ) ) );
				x := Min( x1, Min( x2, x3 - 1 ) );
				w := Max( x1, Max( x2, x3 + 1 ) ) - x;
			END; (* IF *)
		ELSE
			rt := a2 * a2 - 3.0 * a1 * a3;
			IF rt < 0 THEN
				x := Min( x1, x2 );
				w := ABS( x2 - x1 );
			ELSE
				rt := Math.sqrt( rt );
				t := ( -a2 - rt ) / 3 / a3;
				IF ( t > 0 ) & ( t < 1 ) THEN
					temp := t * ( a2 + t * a3 );
					x3 := SHORT( ENTIER( a0 + t * ( a1 + temp ) ) );
				ELSE
					x3 := x1;
				END;
				t := ( -a2 + rt ) / 3 / a3;
				IF ( t > 0 ) & ( t < 1 ) THEN
					temp := t * ( a2 + t * a3 );
					x4 := SHORT( ENTIER( a0 + t * ( a1 + temp ) ) );
				ELSE
					x4 := x1;
				END; (* IF *)
				x := Min( x1, Min( x2, Min( x3, x4 ) - 1 ) );
				w := Max( x1, Max( x2, Max( x3, x4 ) + 1 ) ) - x;
			END; (* IF *)
		END; (* IF *)
		IF ABS( b3 ) < Eps THEN
			IF ABS( b2 ) < Eps THEN
				y := Min( y1, y2 );
				h := ABS( y2 - y1 );
			ELSE
				t := 0.5 * b1 / b2;
				temp := t * ( b2 + t * b3 );
				y3 := SHORT( ENTIER( b0 + t * ( b1 + temp ) ) );
				y := Min( y1, Min( y2, x3 - 1 ) );
				h := Max( y1, Max( y2, y3 + 1 ) ) - y;
			END; (* IF *)
		ELSE
			rt := b2 * b2 - 3.0 * b1 * b3;
			IF rt < 0 THEN
				y := Min( y1, y2 );
				h := ABS( y2 - y1 );
			ELSE
				rt := Math.sqrt( rt );
				t := ( -b2 - rt ) / 3 / b3;
				IF ( t > 0 ) & ( t < 1 ) THEN
					temp := t * ( b2 + t * b3 );
					y3 := SHORT( ENTIER( b0 + t * ( b1 + temp ) ) );
				ELSE
					y3 := y1;
				END;
				t := ( -b2 + rt ) / 3 / b3;
				IF ( t > 0 ) & ( t < 1 ) THEN
					temp := t * ( b2 + t * b3 );
					y4 := SHORT( ENTIER( b0 + t * ( b1 + temp ) ) );
				ELSE
					y4 := y1;
				END; (* IF *)
				y := Min( y1, Min( y2, Min( y3, y4 ) - 1 ) );
				h := Max( y1, Max( y2, Max( y3, y4 ) + 1 ) ) - y;
			END; (* IF *)
		END; (* IF *)
		DEC( x, 2 ); DEC( y, 2 ); INC( w, 4 ); INC( h, 4 );
	END GetBoundingBox;
	PROCEDURE Intersect( f : KeplerPorts.Port; x, y, w, h : INTEGER ) : BOOLEAN;
	(* Pr
ft, ob sich der Frame f mit dem Rechteck ( x, y, w, h ) 
berschneidet. *)
		VAR t : INTEGER;
	BEGIN (* Intersect *)
		x := f.CX( x ); y := f.CY( y ); w := w DIV f.scale; h := h DIV f.scale;
		t := x + w;
		IF f.X > x THEN x := f.X END;
		IF f.X + f.W < t THEN
			w := f.X + f.W - x;
		ELSE
			w := t - x;
		END;
		IF w <= 0 THEN RETURN FALSE END;
		t := y + h;
		IF f.Y > y THEN y := f.Y END;
		IF f.Y + f.H < t THEN
			h := f.Y + f.H - y;
		ELSE
			h := t - y;
		END;
		RETURN h > 0
	END Intersect;
	PROCEDURE DrawCurve( f : KeplerPorts.Port; a3, a2, a1, a0, b3, b2, b1, b0 : REAL );
	(* Zeichnet die Kurve mit den Koeffizienten a3, a2, a1, a0, b3, b2, b1, b0 in den Frame f. *)
		PROCEDURE DrawRec( lo, hi : REAL );
		(* Zeichnet rekursiv den Spline im Bereich lo, hi. *)
			VAR xlo, xhi, ylo, yhi : INTEGER;
					med : REAL;
		BEGIN (* DrawRec *)
			xlo := SHORT( ENTIER( a0 + lo * ( a1 + lo * ( a2 + lo * a3 ) ) ) );
			xhi := SHORT( ENTIER( a0 + hi * ( a1 + hi * ( a2 + hi * a3 ) ) ) );
			ylo := SHORT( ENTIER( b0 + lo * ( b1 + lo * ( b2 + lo * b3 ) ) ) );
			yhi := SHORT( ENTIER( b0 + hi * ( b1 + hi * ( b2 + hi * b3 ) ) ) );
			IF ABS( xhi - xlo ) + ABS( yhi - ylo ) <= 2 * f.scale THEN
				f.DrawLine( xlo, ylo, xhi, yhi, Display.white, Display.replace );
			ELSE
				med := ( lo + hi ) / 2;
				DrawRec( lo, med );
				DrawRec( med, hi );
			END; (* IF *)
		END DrawRec;
	BEGIN (* DrawCurve *)
		DrawRec( 0, 1 );
	END DrawCurve;
(* ------------------------------  Catmull-Rom Spline  ----------------------------------- *)
	PROCEDURE ( s : CRSpline ) Draw*( f : KeplerPorts.Port );
	(* druckt ein Catmull-Rom Spline auf den Bildschirm *)
		VAR a3, a2, a1, a0, b3, b2, b1, b0 : REAL;
				x, y, w, h, t : INTEGER;
	BEGIN (* Draw *)
		t := s.p[ 3 ].x - 3 * s.p[ 2 ].x; a3 := ( t + 3 * s.p[ 1 ].x - s.p[ 0 ].x ) / 2;
		t := -s.p[ 3 ].x + 4 * s.p[ 2 ].x; a2 := ( t - 5 * s.p[ 1 ].x + 2 * s.p[ 0 ].x ) / 2;
		a1 := ( s.p[ 2 ].x - s.p[ 0 ].x ) / 2;
		a0 := s.p[ 1 ].x;
		t := s.p[ 3 ].y - 3 * s.p[ 2 ].y; b3 := ( t + 3 * s.p[ 1 ].y - s.p[ 0 ].y ) / 2;
		t := -s.p[ 3 ].y + 4 * s.p[ 2 ].y; b2 := ( t - 5 * s.p[ 1 ].y + 2 * s.p[ 0 ].y ) / 2;
		b1 := ( s.p[ 2 ].y - s.p[ 0 ].y ) / 2;
		b0 := s.p[ 1 ].y;
		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 );
		IF f IS KeplerPorts.BalloonPort THEN
			f.DrawRect( x, y, w, h, 0, 0 );
		ELSIF Intersect( f, x, y, w, h ) THEN
			DrawCurve( f, a3, a2, a1, a0, b3, b2, b1, b0 );
		END;
	END Draw;
	PROCEDURE NewCRSpline*;
	(* Liest alle Fokuspunkte ein und legt ein Catmull-Rom Spline durch sie hindurch. *)
		VAR s, s1 : CRSpline;
	BEGIN (* NewOpenCRSpline *)
		IF KeplerFrames.nofpts >= 4 THEN
			NEW( s );
			s.nofpts := 4;
			KeplerFrames.ConsumePoint( s.p[ 0 ] );
			KeplerFrames.ConsumePoint( s.p[ 1 ] );
			KeplerFrames.ConsumePoint( s.p[ 2 ] );
			KeplerFrames.ConsumePoint( s.p[ 3 ] );
			KeplerFrames.Focus.Append( s );
			WHILE KeplerFrames.nofpts > 0 DO
				NEW( s1 );
				s1.nofpts := 4;
				s1.p[ 0 ] := s.p[ 1 ]; INC( s1.p[ 0 ].refcnt );
				s1.p[ 1 ] := s.p[ 2 ]; INC( s1.p[ 1 ].refcnt );
				s1.p[ 2 ] := s.p[ 3 ]; INC( s1.p[ 2 ].refcnt );
				KeplerFrames.ConsumePoint( s1.p[ 3 ] );
				s := s1;
				KeplerFrames.Focus.Append( s );
			END; (* WHILE *)
		END; (* IF *)
	END NewCRSpline;
	PROCEDURE NewClosedCRSpline*;
	(* Liest alle Fokuspunkte ein und legt ein geschlossenes Catmull-Rom Spline durch sie hindurch. *)
		VAR s, s1 : CRSpline;
				point : ARRAY 3 OF KeplerGraphs.Star;
				i : INTEGER;
	BEGIN (* NewClosedCRSpline *)
		IF KeplerFrames.nofpts >= 4 THEN
			NEW( s );
			s.nofpts := 4;
			KeplerFrames.ConsumePoint( s.p[ 0 ] ); point[ 0 ] := s.p[ 0 ];
			KeplerFrames.ConsumePoint( s.p[ 1 ] ); point[ 1 ] := s.p[ 1 ];
			KeplerFrames.ConsumePoint( s.p[ 2 ] ); point[ 2 ] := s.p[ 2 ];
			KeplerFrames.ConsumePoint( s.p[ 3 ] );
			KeplerFrames.Focus.Append( s );
			WHILE KeplerFrames.nofpts > 0 DO
				NEW( s1 );
				s1.nofpts := 4;
				s1.p[ 0 ] := s.p[ 1 ]; INC( s1.p[ 0 ].refcnt );
				s1.p[ 1 ] := s.p[ 2 ]; INC( s1.p[ 1 ].refcnt );
				s1.p[ 2 ] := s.p[ 3 ]; INC( s1.p[ 2 ].refcnt );
				KeplerFrames.ConsumePoint( s1.p[ 3 ] );
				s := s1;
				KeplerFrames.Focus.Append( s );
			END; (* WHILE *)
			FOR i := 0 TO 2 DO
				NEW( s1 );
				s1.nofpts := 4;
				s1.p[ 0 ] := s.p[ 1 ]; INC( s1.p[ 0 ].refcnt );
				s1.p[ 1 ] := s.p[ 2 ]; INC( s1.p[ 1 ].refcnt );
				s1.p[ 2 ] := s.p[ 3 ]; INC( s1.p[ 2 ].refcnt );
				s1.p[ 3 ] := point[ i ]; INC( s1.p[ 3 ].refcnt );
				s := s1;
				KeplerFrames.Focus.Append( s );
			END; (* FOR *)
		END; (* IF *)
	END NewClosedCRSpline;
(* -----------------------------------  Bezier-Kurve  ------------------------------- *)
	PROCEDURE ( s : Bezier ) Draw*( f : KeplerPorts.Port );
	(* Druckt eine Bezier-Kurve auf den Bildschirm *)
		VAR a3, a2, a1, a0, b3, b2, b1, b0 : INTEGER;
				x, y, w, h, t : INTEGER;
	BEGIN (* Draw *)
		t := 3 * s.p[ 3 ].x - 5 * s.p[ 2 ].x; a3 := t + 3 * s.p[ 1 ].x - s.p[ 0 ].x;
		t := -3 * s.p[ 3 ].x + 6 * s.p[ 2 ].x; a2 := t - 6 * s.p[ 1 ].x + 3 * s.p[ 0 ].x;
		a1 := ( s.p[ 1 ].x - s.p[ 0 ].x ) * 3;
		a0 := s.p[ 0 ].x;
		t := 3 * s.p[ 3 ].y - 5 * s.p[ 2 ].y; b3 := t + 3 * s.p[ 1 ].y - s.p[ 0 ].y;
		t := -3 * s.p[ 3 ].y + 6 * s.p[ 2 ].y; b2 := t - 6 * s.p[ 1 ].y + 3 * s.p[ 0 ].y;
		b1 := ( s.p[ 1 ].y - s.p[ 0 ].y ) * 3;
		b0 := s.p[ 0 ].y;
		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 );
		IF f IS KeplerPorts.BalloonPort THEN
			f.DrawRect( x, y, w, h, 0, 0 );
		ELSIF Intersect( f, x, y, w, h ) THEN
			DrawCurve( f, a3, a2, a1, a0, b3, b2, b1, b0 );
		END;
	END Draw;
	PROCEDURE NewBezier*;
	(* Liest eine gerade Anzahl Fokuspunkte ein und legt eine Bezier-Kurve durch sie hindurch. *)
		VAR s, s1 : Bezier;
	BEGIN
		IF KeplerFrames.nofpts >= 4 THEN
			NEW( s );
			s.nofpts := 4;
			KeplerFrames.ConsumePoint( s.p[ 0 ] );
			KeplerFrames.ConsumePoint( s.p[ 1 ] );
			KeplerFrames.ConsumePoint( s.p[ 2 ] );
			KeplerFrames.ConsumePoint( s.p[ 3 ] );
			KeplerFrames.Focus.Append( s );
			WHILE KeplerFrames.nofpts > 1 DO
				NEW( s1 );
				s1.nofpts := 4;
				s1.p[ 0 ] := s.p[ 2 ]; INC( s1.p[ 0 ].refcnt );
				s1.p[ 1 ] := s.p[ 3 ]; INC( s1.p[ 1 ].refcnt );
				KeplerFrames.ConsumePoint( s1.p[ 2 ] );
				KeplerFrames.ConsumePoint( s1.p[ 3 ] );
				s := s1;
				KeplerFrames.Focus.Append( s );
			END; (* WHILE *)
		END; (* IF *)
	END NewBezier;
	PROCEDURE NewClosedBezier*;
	(* Liest eine gerade Anzahl Fokuspunkte ein und legt eine Bezier-Kurve durch sie hindurch. *)
		VAR s, s1, s0 : Bezier;
	BEGIN
		IF KeplerFrames.nofpts >= 4 THEN
			NEW( s ); s0 := s; s1 := s;
			s.nofpts := 4;
			KeplerFrames.ConsumePoint( s.p[ 0 ] );
			KeplerFrames.ConsumePoint( s.p[ 1 ] );
			KeplerFrames.ConsumePoint( s.p[ 2 ] );
			KeplerFrames.ConsumePoint( s.p[ 3 ] );
			KeplerFrames.Focus.Append( s );
			WHILE KeplerFrames.nofpts > 1 DO
				NEW( s1 );
				s1.nofpts := 4;
				s1.p[ 0 ] := s.p[ 2 ]; INC( s1.p[ 0 ].refcnt );
				s1.p[ 1 ] := s.p[ 3 ]; INC( s1.p[ 1 ].refcnt );
				KeplerFrames.ConsumePoint( s1.p[ 2 ] );
				KeplerFrames.ConsumePoint( s1.p[ 3 ] );
				s := s1;
				KeplerFrames.Focus.Append( s )
			END ;
			NEW(s);
			s.nofpts := 4;
			s.p[ 0 ] := s1.p[ 2 ]; INC(s.p[ 0 ].refcnt);
			s.p[ 1 ] := s1.p[ 3 ]; INC(s.p[ 1 ].refcnt);
			s.p[ 2 ] := s0.p[ 0 ]; INC(s.p[ 2 ].refcnt);
			s.p[ 3 ] := s0.p[ 1 ]; INC(s.p[ 3 ].refcnt);
			KeplerFrames.Focus.Append( s )
		END
	END NewClosedBezier;
END Kepler6.