Syntax10.Scn.Fnt
MODULE Kepler9;
(* Semesterarbeit Wintersemester 91/92 von Samuel Urech
	Erweiterung des Graphikeditors Kepler um Objektklassen f
r geometrische Zeichnungen.
	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: 8.1.92			Stand: 15.1.92 *)
	IMPORT Math, Files, KeplerFrames, KeplerGraphs;
	TYPE
		Parallel* = POINTER TO ParallelDesc;
		ParallelDesc* = RECORD
			( KeplerGraphs.PlanetDesc )
		END;
		RightAngle* = POINTER TO RightAngleDesc;
		RightAngleDesc* = RECORD
			( KeplerGraphs.PlanetDesc )
		END;
		Intersection* = POINTER TO IntersectionDesc;
		IntersectionDesc* = RECORD
			( KeplerGraphs.PlanetDesc )
		END;
		Extension* = POINTER TO ExtensionDesc;
		ExtensionDesc* = RECORD
			( KeplerGraphs.PlanetDesc )
		END;
		Tangent* = POINTER TO TangentDesc;
		TangentDesc* = RECORD
			( KeplerGraphs.PlanetDesc )
			sign* : SHORTINT;	(* -1 oder 1 f
r den einen oder anderen Punkt *)
		END;
		CircleInter* = POINTER TO CircleIntersection;	(* by jt and ww *)
		CircleIntersection* = RECORD
			(KeplerGraphs.PlanetDesc)
			sign*: SHORTINT
		END;
		CircleLineInter* = POINTER TO CircleLineIntersection;	(* by jt and ww *)
		CircleLineIntersection* = RECORD
			(KeplerGraphs.PlanetDesc)
			sign*: SHORTINT
		END;
(* ---------------------------------------  Parallel  ---------------------------------------- *)
	PROCEDURE ( self : Parallel ) Calc*;
	BEGIN (* Calc *)
		self.x := self.c.p[ 2 ].x + self.c.p[ 1 ].x - self.c.p[ 0 ].x;
		self.y := self.c.p[ 2 ].y + self.c.p[ 1 ].y - self.c.p[ 0 ].y;
	END Calc;
	PROCEDURE NewParallel*;
		VAR new : Parallel;
	BEGIN (* NewParallel *)
		IF KeplerFrames.nofpts >= 3 THEN
			NEW( new );
			NEW( new.c );
			new.c.nofpts := 3;
			KeplerFrames.ConsumePoint( new.c.p[ 0 ] );
			KeplerFrames.ConsumePoint( new.c.p[ 1 ] );
			KeplerFrames.ConsumePoint( new.c.p[ 2 ] );
			new.Calc;
			KeplerFrames.Focus.Append( new );
			KeplerFrames.Focus.FlipSelection( new );
		END; (* IF *)
	END NewParallel;
(* ---------------------------------------  Right Angle  ---------------------------------------- *)
	PROCEDURE ( self : RightAngle ) Calc*;
		VAR x0, y0, x1, y1, x2, y2 : LONGINT;
				f : REAL;
	BEGIN (* Calc *)
		x0 := self.c.p[ 0 ].x;
		y0 := self.c.p[ 0 ].y;
		x1 := self.c.p[ 1 ].x;
		y1 := self.c.p[ 1 ].y;
		x2 := self.c.p[ 2 ].x;
		y2 := self.c.p[ 2 ].y;
		f := ( ( x1 - x0 ) * ( x2 - x0 ) + ( y1 - y0 ) * ( y2 - y0 ) ) / ( ( x1 - x0 ) * ( x1 - x0 ) + ( y1 - y0 ) * ( y1 - y0 ) );
		self.x := SHORT( ENTIER( x0 + ( x1 - x0 ) * f ) );
		self.y := SHORT( ENTIER( y0 + ( y1 - y0 ) * f ) );
	END Calc;
	PROCEDURE NewRightAngle*;
		VAR new : RightAngle;
	BEGIN (* NewRightAngle *)
		IF KeplerFrames.nofpts >= 3 THEN
			NEW( new );
			NEW( new.c );
			new.c.nofpts := 3;
			KeplerFrames.ConsumePoint( new.c.p[ 0 ] );
			KeplerFrames.ConsumePoint( new.c.p[ 1 ] );
			KeplerFrames.ConsumePoint( new.c.p[ 2 ] );
			new.Calc;
			KeplerFrames.Focus.Append( new );
			KeplerFrames.Focus.FlipSelection( new );
		END; (* IF *)
	END NewRightAngle;
(* ---------------------------------------  Line * Line Intersection  ---------------------------------------- *)
	PROCEDURE ( self : Intersection ) Calc*;
		VAR f, x0, y0, x1, y1, x2, y2, x3, y3 : LONGINT;
	BEGIN (* Calc *)
		x0 := self.c.p[ 0 ].x;
		y0 := self.c.p[ 0 ].y;
		x1 := self.c.p[ 1 ].x;
		y1 := self.c.p[ 1 ].y;
		x2 := self.c.p[ 2 ].x;
		y2 := self.c.p[ 2 ].y;
		x3 := self.c.p[ 3 ].x;
		y3 := self.c.p[ 3 ].y;
		f := ( x3 - x2 ) * ( y1 - y0 ) - ( x1 - x0 ) * ( y3 - y2 );
		IF f # 0 THEN (* sonst alte Werte beibehalten *)
			self.x := SHORT( ( ( x3 - x2 ) * ( x1 - x0 ) * ( y2 - y0 ) + ( x3 - x2 ) * ( y1 - y0 ) * x0 - ( x1 - x0 ) * ( y3 - y2 ) * x2 ) DIV f );
			self.y := SHORT( ( ( y3 - y2 ) * ( y1 - y0 ) * ( x2 - x0 ) + ( y3 - y2 ) * ( x1 - x0 ) * y0 - ( y1 - y0 ) * ( x3 - x2 ) * y2 ) DIV ( - f ) );
		END; (* IF *)
	END Calc;
	PROCEDURE NewLineIntersection*;
		VAR new : Intersection;
	BEGIN (* NewIntersection *)
		IF KeplerFrames.nofpts >= 4 THEN
			NEW( new );
			NEW( new.c );
			new.c.nofpts := 4;
			KeplerFrames.ConsumePoint( new.c.p[ 0 ] );
			KeplerFrames.ConsumePoint( new.c.p[ 1 ] );
			KeplerFrames.ConsumePoint( new.c.p[ 2 ] );
			KeplerFrames.ConsumePoint( new.c.p[ 3 ] );
			new.Calc;
			KeplerFrames.Focus.Append( new );
			KeplerFrames.Focus.FlipSelection( new );
		END; (* IF *)
	END NewLineIntersection;
(* ---------------------------------------  Circle * Circle Intersection  ---------------------------------------- *)
	PROCEDURE (self : CircleInter) Calc*;
		VAR M1x, M2x, M1y, M2y, R1x, R2x, R1y, R2y,
			mx, my, d, c, s, r1, r2, qx, qy, h: REAL;
	BEGIN
		M1x := self.c.p[0].x; M2x := self.c.p[2].x;
		M1y := self.c.p[0].y; M2y := self.c.p[2].y;
		R1x := self.c.p[1].x; R2x := self.c.p[3].x;
		R1y := self.c.p[1].y; R2y := self.c.p[3].y;
		mx := M2x - M1x; my := M2y - M1y; d := Math.sqrt(mx * mx + my * my);
		IF d # 0 THEN
			c := my / d; s := -mx / d;
			r1 := (M1x - R1x) * (M1x - R1x) + (M1y - R1y) * (M1y - R1y);
			r2 := (M2x - R2x) * (M2x - R2x) + (M2y - R2y) * (M2y - R2y);
			qy := (d + (r1 - r2) / d) / 2;
			h := r1 - qy * qy;
			IF h >= 0 THEN
				qx := self.sign * Math.sqrt(h);
				self.x := SHORT(ENTIER(c * qx - s * qy + M1x));
				self.y := SHORT(ENTIER(s * qx + c * qy + M1y))
			END
		END
	END Calc;
	PROCEDURE (self : CircleInter) Read*(VAR r : Files.Rider);
	BEGIN
		Files.Read(r, self.sign);
		self.Read^(r);
	END Read;
	PROCEDURE (self : CircleInter) Write*(VAR r : Files.Rider);
	BEGIN
		Files.Write(r, self.sign);
		self.Write^(r);
	END Write;
	PROCEDURE NewCircleIntersection*;
		VAR new1, new2 : CircleInter;
	BEGIN
		IF KeplerFrames.nofpts >= 4 THEN
			NEW(new1); new1.sign := 1; NEW(new1.c ); new1.c.nofpts := 4;
			NEW(new2); new2.sign := -1; NEW(new2.c ); new2.c.nofpts := 4;
			KeplerFrames.ConsumePoint(new1.c.p[0]); (* middle 1 *)
			KeplerFrames.ConsumePoint(new1.c.p[1]); (* periphery 1 *)
			KeplerFrames.ConsumePoint(new1.c.p[2]); (* middle 2 *)
			KeplerFrames.ConsumePoint(new1.c.p[3]); (* periphery 2 *)
			new2.c.p[0] := new1.c.p[0]; INC(new1.c.p[0].refcnt);
			new2.c.p[1] := new1.c.p[1]; INC(new1.c.p[1].refcnt);
			new2.c.p[2] := new1.c.p[2]; INC(new1.c.p[2].refcnt);
			new2.c.p[3] := new1.c.p[3]; INC(new1.c.p[3].refcnt);
			new1.Calc; new2.Calc;
			KeplerFrames.Focus.Append(new1); KeplerFrames.Focus.Append(new2);
			KeplerFrames.Focus.FlipSelection(new1); KeplerFrames.Focus.FlipSelection(new2)
		END
	END NewCircleIntersection;
(* ---------------------------------------  Circle * Line Intersection  ---------------------------------------- *)
	PROCEDURE (self : CircleLineInter) Calc*;
		VAR M1x, L1x, M1y, L1y, R1x, L2x, R1y, L2y, M2x, M2y,
			mx, my, d, c, s, r1, qy, h: REAL;
	BEGIN
		M1x := self.c.p[0].x; L1x := self.c.p[2].x;
		M1y := self.c.p[0].y; L1y := self.c.p[2].y;
		R1x := self.c.p[1].x; L2x := self.c.p[3].x;
		R1y := self.c.p[1].y; L2y := self.c.p[3].y;
		mx := L2x - L1x; my := L2y - L1y; d := Math.sqrt(mx * mx + my * my);
		IF d # 0 THEN
			c := my / d; s := -mx / d;
			r1 := (M1x - R1x) * (M1x - R1x) + (M1y - R1y) * (M1y - R1y);
			M1x := M1x - L2x; M1y := M1y - L2y;
			M2x := c * M1x + s * M1y; M2y := c * M1y - s * M1x;
			h := r1 - M2x * M2x;
			IF h >= 0 THEN
				qy := self.sign * Math.sqrt(h) + M2y;
				self.x := SHORT(ENTIER(-s * qy + L2x));
				self.y := SHORT(ENTIER(c * qy + L2y))
			END
		END
	END Calc;
	PROCEDURE (self : CircleLineInter) Read*(VAR r : Files.Rider);
	BEGIN
		Files.Read(r, self.sign);
		self.Read^(r);
	END Read;
	PROCEDURE (self : CircleLineInter) Write*(VAR r : Files.Rider);
	BEGIN
		Files.Write(r, self.sign);
		self.Write^(r);
	END Write;
	PROCEDURE NewCircleLineIntersect*;
		VAR new1, new2 : CircleLineInter;
	BEGIN
		IF KeplerFrames.nofpts >= 4 THEN
			NEW(new1); new1.sign := 1; NEW(new1.c ); new1.c.nofpts := 4;
			NEW(new2); new2.sign := -1; NEW(new2.c ); new2.c.nofpts := 4;
			KeplerFrames.ConsumePoint(new1.c.p[0]); (* middle 1 *)
			KeplerFrames.ConsumePoint(new1.c.p[1]); (* periphery 1 *)
			KeplerFrames.ConsumePoint(new1.c.p[2]); (* line start *)
			KeplerFrames.ConsumePoint(new1.c.p[3]); (* line end *)
			new2.c.p[0] := new1.c.p[0]; INC(new1.c.p[0].refcnt);
			new2.c.p[1] := new1.c.p[1]; INC(new1.c.p[1].refcnt);
			new2.c.p[2] := new1.c.p[2]; INC(new1.c.p[2].refcnt);
			new2.c.p[3] := new1.c.p[3]; INC(new1.c.p[3].refcnt);
			new1.Calc; new2.Calc;
			KeplerFrames.Focus.Append(new1); KeplerFrames.Focus.Append(new2);
			KeplerFrames.Focus.FlipSelection(new1); KeplerFrames.Focus.FlipSelection(new2)
		END
	END NewCircleLineIntersect;
(* ---------------------------------------  Extension  ---------------------------------------- *)
	PROCEDURE ( self : Extension ) Calc*;
	BEGIN (* Calc *)
		self.x := 2 * self.c.p[ 1 ].x - self.c.p[ 0 ].x;
		self.y := 2 * self.c.p[ 1 ].y - self.c.p[ 0 ].y;
	END Calc;
	PROCEDURE NewExtension*;
		VAR new : Extension;
	BEGIN (* NewExtension *)
		IF KeplerFrames.nofpts >= 2 THEN
			NEW( new );
			NEW( new.c );
			new.c.nofpts := 2;
			KeplerFrames.ConsumePoint( new.c.p[ 0 ] );
			KeplerFrames.ConsumePoint( new.c.p[ 1 ] );
			new.Calc;
			KeplerFrames.Focus.Append( new );
			KeplerFrames.Focus.FlipSelection( new );
		END; (* IF *)
	END NewExtension;
(* ---------------------------------------  Tangent  ---------------------------------------- *)
	PROCEDURE ( self : Tangent ) Calc*;
		VAR x0, x1, x2, y0, y1, y2 : LONGINT;
				r2, d2, x3, y3, faktor : REAL;
	BEGIN (* Calc *)
		x0 := self.c.p[ 0 ].x;
		x1 := self.c.p[ 1 ].x;
		x2 := self.c.p[ 2 ].x;
		y0 := self.c.p[ 0 ].y;
		y1 := self.c.p[ 1 ].y;
		y2 := self.c.p[ 2 ].y;
		r2 := ( x1 - x0 ) * ( x1 - x0 ) + ( y1 - y0 ) * ( y1 - y0 );
		d2 := ( x2 - x0 ) * ( x2 - x0 ) + ( y2 - y0 ) * ( y2 - y0 );
		IF r2 < d2 THEN (* Punkt liegt ausserhalb des Kreises *)
			x3 := x0 + ( x2 - x0 ) * r2 / d2;
			y3 := y0 + ( y2 - y0 ) * r2 / d2;
			faktor := Math.sqrt( r2 / d2 - r2 * r2 / d2 / d2 );
			self.x := SHORT( ENTIER( x3 + self.sign * faktor * ( y2 - y0 ) ) );
			self.y := SHORT( ENTIER( y3 + self.sign * faktor * ( x0 - x2 ) ) );
		END; (* IF *)
	END Calc;
	PROCEDURE ( self : Tangent ) Read*( VAR r : Files.Rider );
	BEGIN
		Files.Read( r, self.sign );
		self.Read^( r );
	END Read;
	PROCEDURE ( self : Tangent ) Write*( VAR r : Files.Rider );
	BEGIN
		Files.Write( r, self.sign );
		self.Write^( r );
	END Write;
	PROCEDURE NewTangent*;
		VAR new : Tangent;
			p0, p1, p2 : KeplerGraphs.Star;
			i : SHORTINT;
	BEGIN
		IF KeplerFrames.nofpts >= 3 THEN
			KeplerFrames.ConsumePoint( p0 ); INC( p0.refcnt );
			KeplerFrames.ConsumePoint( p1 ); INC( p1.refcnt );
			KeplerFrames.ConsumePoint( p2 ); INC( p2.refcnt );
			FOR i := 0 TO 1 DO
				NEW( new );
				new.sign := 2 * i - 1;
				NEW( new.c );
				new.c.nofpts := 3;
				new.c.p[ 0 ] := p0;
				new.c.p[ 1 ] := p1;
				new.c.p[ 2 ] := p2;
				new.Calc;
				KeplerFrames.Focus.Append( new );
				KeplerFrames.Focus.FlipSelection( new );
			END
		END
	END NewTangent;
END Kepler9.