Syntax10.Scn.Fnt
MODULE Kepler8;
(* Semesterarbeit Wintersemester 91/92 von Samuel Urech
	Erweiterung des Graphikeditors Kepler um Objektklassen f
r das Zeichnen von technischen Graphen.
	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: 13.12.91			Stand: 12.2.92
	J. Templ, 18.06.92, NewEllipIntersect renamed to NewEllipseIntersect
	J. Templ, 01.07.93 expressions simplified
	IMPORT Display, Math, Files, KeplerPorts, KeplerGraphs, KeplerFrames, In;
	CONST
		EPS = 0.001;
		fg = Display.white;
	TYPE RectIntersect* = POINTER TO RectIntersectDesc;
			RectIntersectDesc* = RECORD
				( KeplerGraphs.PlanetDesc )
			END; (* RectIntersect *)
			CircleIntersect* = POINTER TO CircleIntersectDesc;
			CircleIntersectDesc* = RECORD
				( KeplerGraphs.PlanetDesc )
			END; (* CircleIntersect *)
			EllipIntersect* = POINTER TO EllipIntersectDesc;
			EllipIntersectDesc* = RECORD
				( KeplerGraphs.PlanetDesc )
			END; (* EllipIntersect *)
			AttrRect* = POINTER TO AttrRectDesc;
			AttrRectDesc* = RECORD
				( KeplerGraphs.ConsDesc )
				texture* : INTEGER;	(* Textur des Inneren des Rechtecks *)
				lineWidth* : INTEGER;	(* Liniendicke *)
				shadow* : INTEGER;	(* Textur des Schattens; <= 0: kein Schatten *)
				shadowWidth* : INTEGER; (* Breite des Schattens; <= 0: kein Schatten *)
				corner* : INTEGER;	(* Radius der Ecken; <= 1: keine Abrundungen *)
			END; (* AttrRect *)
			FilledCircle* = POINTER TO FilledCircleDesc;
			FilledCircleDesc* = RECORD
				( KeplerGraphs.ConsDesc )
				texture* : INTEGER;	(* Textur des Inneren des Kreises *)
			END; (* FilledCircle *)
(* ----------------------------------------  Hilfsprozeduren  ---------------------------------------- *)
	PROCEDURE MinMax( a, b : INTEGER; VAR min, max: INTEGER );
	BEGIN
		IF a < b THEN min := a; max := b ELSE min := b; max := a END
	END MinMax;
(* -----------------------------------------  RectIntersect  ----------------------------------------- *)
	PROCEDURE ( self : RectIntersect ) Calc*;
		VAR mx, my, x1, y1, x2, y2 : INTEGER;
				slope : REAL;
	BEGIN (* Calc *)
		mx := ( self.c.p[ 0 ].x + self.c.p[ 1 ].x ) DIV 2;
		my := ( self.c.p[ 0 ].y + self.c.p[ 1 ].y ) DIV 2;
		IF ( mx = self.c.p[ 2 ].x ) & ( my = self.c.p[ 2 ].y ) THEN
			self.x := mx;
			self.y := self.c.p[ 1 ].y;
		ELSE
			IF self.c.p[ 2 ].x - mx # 0 THEN
				slope := ( self.c.p[ 2 ].y - my ) / ( self.c.p[ 2 ].x - mx );
				IF ( self.c.p[ 1 ].x # mx ) & ( ABS( slope ) > ABS( ( self.c.p[ 1 ].y - my ) / ( self.c.p[ 1 ].x - mx ) ) ) THEN
					(* Gerade schneidet auf waagrechter Linie *)
					IF ( ( self.c.p[ 2 ].y < my ) & ( self.c.p[ 0 ].y < my ) ) OR ( ( self.c.p[ 2 ].y > my ) & ( self.c.p[ 0 ].y > my ) ) THEN
						self.y := self.c.p[ 0 ].y;
						self.x := mx + SHORT( ENTIER( ( self.c.p[ 0 ].y - my ) / slope ) );
					ELSE
						self.y := self.c.p[ 1 ].y;
						self.x := mx + SHORT( ENTIER( ( self.c.p[ 1 ].y - my ) / slope ) );
					END; (* IF *)
				ELSE (* Gerade schneidet auf senkrechter Linie *)
					IF self.c.p[ 2 ].y - my # 0 THEN
						IF ( ( self.c.p[ 2 ].x < mx ) & ( self.c.p[ 0 ].x < mx ) ) OR ( ( self.c.p[ 2 ].x > mx ) & ( self.c.p[ 0 ].x > mx ) ) THEN
							self.x := self.c.p[ 0 ].x;
							self.y := my + SHORT( ENTIER( ( self.c.p[ 0 ].x - mx ) * slope ) );
						ELSE
							self.x := self.c.p[ 1 ].x;
							self.y := my + SHORT( ENTIER( ( self.c.p[ 1 ].x - mx ) * slope ) );
						END; (* IF *)
					ELSE (* Gerade ist parallel zur Horizontalen *)
						self.y := my;
						IF ( ( self.c.p[ 2 ].x < mx ) & ( self.c.p[ 0 ].x < mx ) ) OR ( ( self.c.p[ 2 ].x > mx ) & ( self.c.p[ 0 ].x > mx ) ) THEN
							self.x := self.c.p[ 0 ].x;
						ELSE
							self.x := self.c.p[ 1 ].x;
						END; (* IF *)
					END; (* IF *)
				END; (* IF *)
			ELSE (* Gerade ist parallel zur Vertikalen *)
				self.x := mx;
				IF ( ( self.c.p[ 2 ].y < my ) & ( self.c.p[ 0 ].y < my ) ) OR ( ( self.c.p[ 2 ].y > my ) & ( self.c.p[ 0 ].y > my ) ) THEN
					self.y := self.c.p[ 0 ].y;
				ELSE
					self.y := self.c.p[ 1 ].y;
				END; (* IF *)
			END; (* IF *)
		END; (* IF *)
	END Calc;
	PROCEDURE NewRectIntersect*;
	(* Liest drei Fokuspunkte ein und bestimmt einen Planeten am Schnittpunkt zwischen dem Rechteck, das durch die
		ersten beiden Punkte bestimmt wird und der Gerade durch den Mittelpunkt des Rechtecks und den dritten Punkt. *)
		VAR new : RectIntersect;
	BEGIN (* NewRectIntersect *)
		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 NewRectIntersect;
(* --------------------------------------------  CircleIntersect  -------------------------------------- *)
	PROCEDURE ( self : CircleIntersect ) Calc*;
		VAR factor : REAL;
				x0, y0, x1, y1, x2, y2 : 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;
		IF ( x0 = x2 ) & ( y0 = y2 ) THEN
			self.x := SHORT( x1 );
			self.y := SHORT( y1 );
		ELSE
			factor := Math.sqrt( ( ( ( x1 - x0 ) * ( x1 - x0 ) ) + ( ( y1 - y0 ) * ( y1 - y0 ) ) ) /
											 ( ( ( x2 - x0 ) * ( x2 - x0 ) ) + ( ( y2 - y0 ) * ( y2 - y0 ) ) ) );
			self.x := SHORT( x0 ) + SHORT( ENTIER( factor * ( x2 - x0 ) ) );
			self.y := SHORT( y0 ) + SHORT( ENTIER( factor * ( y2 - y0 ) ) );
		END; (* IF *)
	END Calc;
	PROCEDURE NewCircleIntersect*;
	(* Liest drei Fokuspunkte ein und bestimmt einen Planeten am Schnittpunkt zwischen dem Kreis, dessen Mittelpunkt
		durch den ersten Punkt und dessen Radius durch den zweiten Punkt gegeben ist sowie der Gerade zwischen dem
		Mittelpunkt des Kreises und dem dritten Punkt. *)
		VAR new : CircleIntersect;
	BEGIN (* NewCircleIntersect *)
		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 NewCircleIntersect;
(* --------------------------------------------  EllipIntersect  -------------------------------------- *)
	PROCEDURE ( self : EllipIntersect ) Calc*;
		VAR a2, b2 : LONGINT;
				slope2, temp : REAL;
				xsign, ysign, t : INTEGER;
	BEGIN (* Calc *)
		IF self.c.p[ 3 ].x > self.c.p[ 0 ].x THEN
			xsign := 1;
		ELSE
			xsign := -1;
		END; (* IF *)
		IF self.c.p[ 3 ].y > self.c.p[ 0 ].y THEN
			ysign := 1;
		ELSE
			ysign := -1;
		END; (* IF *)
		IF self.c.p[ 3 ].x # self.c.p[ 0 ].x THEN
			IF self.c.p[ 3 ].y # self.c.p[ 0 ].y THEN
				a2 := self.c.p[ 1 ].x - self.c.p[ 0 ].x;
				a2 := a2 * a2;
				b2 := self.c.p[ 2 ].y - self.c.p[ 0 ].y;
				b2 := b2 * b2;
				t := self.c.p[ 3 ].y - self.c.p[ 0 ].y; slope2 := ( t ) / ( self.c.p[ 3 ].x - self.c.p[ 0 ].x );
				slope2 := slope2 * slope2;
				temp := a2 / ( b2 + a2*slope2 ) * b2;
				self.x := xsign * SHORT( ENTIER( Math.sqrt( temp ) ) ) + self.c.p[ 0 ].x;
				self.y := ysign * SHORT( ENTIER( Math.sqrt( slope2 * temp ) ) ) + self.c.p[ 0 ].y;
			ELSE (* Gerade ist horizontal *)
				t := self.c.p[ 1 ].x - self.c.p[ 0 ].x; self.x := self.c.p[ 0 ].x + xsign * ( t );
				self.y := self.c.p[ 0 ].y;
			END; (* IF *)
		ELSE (* Gerade ist vertikal *)
			self.x := self.c.p[ 0 ].x;
			t := self.c.p[ 2 ].y - self.c.p[ 0 ].y; self.y := self.c.p[ 0 ].y + ysign * ( t );
		END; (* IF *)
	END Calc;
	PROCEDURE NewEllipseIntersect*;
	(* Liest vier Fokuspunkte ein und bestimmt einen Planeten am Schnittpunkt zwischen der Ellipse, die durch die
		ersten drei Punkte gegeben ist, sowie der Gerade zwischen dem Mittelpunkt der Ellipse und dem vierten Punkt. *)
		VAR new : EllipIntersect;
	BEGIN (* NewEllipIntersect *)
		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 NewEllipseIntersect;
(* --------------------------------------------  AttrRect  -------------------------------------- *)
	PROCEDURE ( self : AttrRect ) Read*( VAR r : Files.Rider );
	BEGIN (* Read *)
		Files.ReadInt( r, self.texture );
		Files.ReadInt( r, self.lineWidth );
		Files.ReadInt( r, self.shadow );
		Files.ReadInt( r, self.shadowWidth );
		Files.ReadInt( r, self.corner );
		self.Read^( r );
	END Read;
	PROCEDURE ( self : AttrRect ) Write*( VAR r : Files.Rider );
	BEGIN (* Write *)
		Files.WriteInt( r, self.texture );
		Files.WriteInt( r, self.lineWidth );
		Files.WriteInt( r, self.shadow );
		Files.WriteInt( r, self.shadowWidth );
		Files.WriteInt( r, self.corner );
		self.Write^( r );
	END Write;
	PROCEDURE ( self : AttrRect ) Draw*( f : KeplerPorts.Port );
		VAR x1, y1, x2, y2 : INTEGER;
	BEGIN
		MinMax( self.p[ 0 ].x, self.p[ 1 ].x, x1, x2 );
		MinMax( self.p[ 0 ].y, self.p[ 1 ].y, y1, y2 );
		IF self.corner > 1 THEN	(* rounded edges *)
			IF ( self.shadow > 0 ) & ( self.shadowWidth > 0 ) THEN (* draw shadow *)
				f.FillCircle( x2 + self.shadowWidth - self.corner, y2 - self.shadowWidth - self.corner, self.corner, fg, self.shadow,
									Display.replace );
				f.FillCircle( x1 + self.shadowWidth + self.corner, y1 - self.shadowWidth + self.corner, self.corner, fg, self.shadow,
									Display.replace );
				f.FillCircle( x2 + self.shadowWidth - self.corner, y1 - self.shadowWidth + self.corner, self.corner, fg, self.shadow,
									Display.replace );
				IF self.shadowWidth > self.corner THEN
					f.FillRect( x2, y2 - self.shadowWidth - self.corner, self.shadowWidth - self.corner, self.corner + f.scale, fg, self.shadow,
									Display.replace );
					f.FillRect( x1 + self.shadowWidth, y1 - self.shadowWidth + self.corner, self.corner, self.shadowWidth - self.corner, fg,
									self.shadow, Display.replace );
					f.FillRect( x2 - self.corner + f.scale, y1 - f.scale, self.corner, self.corner, fg, self.shadow, Display.replace );
				END;
				f.FillRect( x2 + f.scale, y1 - self.shadowWidth + self.corner, self.shadowWidth, y2 - y1 - 2 * self.corner, fg, self.shadow,
								Display.replace );
				f.FillRect( x1 + self.shadowWidth + self.corner, y1 - self.shadowWidth - f.scale, x2 - x1 - 2 * self.corner,
								self.shadowWidth, fg, self.shadow, Display.replace );
			END;
			f.FillCircle( x1 + self.corner, y1 + self.corner, self.corner, fg, 5, Display.replace );
			f.FillCircle( x2 - self.corner, y1 + self.corner, self.corner, fg, 5, Display.replace );
			f.FillCircle( x2 - self.corner, y2 - self.corner, self.corner, fg, 5, Display.replace );
			f.FillCircle( x1 + self.corner, y2 - self.corner, self.corner, fg, 5, Display.replace );
			IF self.corner > self.lineWidth THEN
				f.FillCircle( x1 + self.corner, y1 + self.corner, self.corner - self.lineWidth, fg, self.texture, Display.replace );
				f.FillCircle( x2 - self.corner, y1 + self.corner, self.corner - self.lineWidth, fg, self.texture, Display.replace );
				f.FillCircle( x2 - self.corner, y2 - self.corner, self.corner - self.lineWidth, fg, self.texture, Display.replace );
				f.FillCircle( x1 + self.corner, y2 - self.corner, self.corner - self.lineWidth, fg, self.texture, Display.replace )
			END;
			f.FillRect( x1 + self.lineWidth - f.scale, y1 + self.corner, x2 - x1 - 2 * self.lineWidth + 2 * f.scale,
							y2 - y1 - 2 * self.corner, fg, self.texture, Display.replace );
			f.FillRect( x1 + self.corner, y1 + self.lineWidth - f.scale, x2 - x1 - 2 * self.corner,
							y2 - y1 - 2 * self.lineWidth + 2 * f.scale, fg, self.texture, Display.replace );
			f.FillRect( x1 + self.corner, y1 - f.scale, x2 - x1 - 2 * self.corner, self.lineWidth + f.scale - 1, fg, 5, Display.replace );
			f.FillRect( x1 + self.corner, y2 - self.lineWidth + f.scale, x2 - x1 - 2 * self.corner, self.lineWidth + f.scale - 1, fg, 5,
							Display.replace );
			f.FillRect( x1 - f.scale, y1 + self.corner, self.lineWidth + f.scale - 1, y2 - y1 - 2 * self.corner, fg, 5, Display.replace );
			f.FillRect( x2 - self.lineWidth + f.scale, y1 + self.corner, self.lineWidth + f.scale - 1, y2 - y1 - 2 * self.corner, fg, 5,
							Display.replace );
		ELSE (* sharp edges *)
			f.FillRect( x2, y1 - self.shadowWidth, self.shadowWidth, y2 - y1, fg, self.shadow, Display.replace );
			f.FillRect( x1 + self.shadowWidth, y1 - self.shadowWidth, x2 -x1, self.shadowWidth, fg, self.shadow, Display.replace );
			f.FillRect( x1 + self.lineWidth, y1 + self.lineWidth, x2 - x1 - 2 * self.lineWidth, y2 - y1 - 2 * self.lineWidth,
							fg, self.texture, Display.replace );
			f.FillRect( x1, y1, x2 - x1, self.lineWidth, fg, 5, Display.replace );
			f.FillRect( x1, y2 - self.lineWidth, x2 - x1, self.lineWidth, fg, 5, Display.replace );
			f.FillRect( x1, y1, self.lineWidth, y2 - y1, fg, 5, Display.replace );
			f.FillRect( x2 - self.lineWidth, y1, self.lineWidth, y2 - y1, fg, 5, Display.replace )
		END
	END Draw;
	PROCEDURE NewAttrRect*;
		VAR new : AttrRect;
				texture, lineWidth, shadow, shadowWidth, corner : INTEGER;
	BEGIN (* NewAttrRect *)
		IF KeplerFrames.nofpts >= 2 THEN
			NEW( new );
			new.nofpts := 2;
			In.Open; In.Int( texture );
			IF texture < 0 THEN new.texture := 0; ELSE new.texture := texture END;
			In.Int( lineWidth );
			IF lineWidth < 0 THEN new.lineWidth := 0; ELSE new.lineWidth := lineWidth END;
			In.Int( shadow );
			IF shadow < 0 THEN new.shadow := 0; ELSE new.shadow := shadow END;
			In.Int( shadowWidth );
			IF shadowWidth < 0 THEN new.shadowWidth := 0; ELSE new.shadowWidth := shadowWidth END;
			In.Int( corner ); 
			IF corner <= 1 THEN new.corner := 0; ELSE new.corner := corner END;
			IF In.Done THEN
				KeplerFrames.ConsumePoint( new.p[ 0 ] );
				KeplerFrames.ConsumePoint( new.p[ 1 ] );
				KeplerFrames.Focus.Append( new );
			END; (* IF *)
		END; (* IF *)
	END NewAttrRect;
(* --------------------------------------------  FilledCircle  -------------------------------------- *)
	PROCEDURE ( self : FilledCircle ) Read*( VAR r : Files.Rider );
	BEGIN (* Read *)
		Files.ReadInt( r, self.texture );
		self.Read^( r );
	END Read;
	PROCEDURE ( self : FilledCircle ) Write*( VAR r : Files.Rider );
	BEGIN (* Write *)
		Files.WriteInt( r, self.texture );
		self.Write^( r );
	END Write;
	PROCEDURE ( self : FilledCircle ) Draw*( f : KeplerPorts.Port );
		VAR rx, ry : LONGINT;
				r : INTEGER;
	BEGIN (* Draw *)
		rx := self.p[ 1 ].x - self.p[ 0 ].x;
		ry := self.p[ 1 ].y - self.p[ 0 ].y;
		r := SHORT( ENTIER( Math.sqrt( rx * rx + ry * ry ) ) );
		f.FillCircle( self.p[ 0 ].x, self.p[ 0 ].y, r, fg, self.texture, Display.replace );
	END Draw;
	PROCEDURE NewFilledCircle*;
		VAR new: FilledCircle; texture: INTEGER;
	BEGIN
		IF KeplerFrames.nofpts >= 2 THEN
			NEW( new );
			new.nofpts := 2;
			In.Open; In.Int( texture );
			IF texture < 0 THEN new.texture := 0; ELSE new.texture := texture; END;
			IF In.Done THEN
				KeplerFrames.ConsumePoint( new.p[ 0 ] );
				KeplerFrames.ConsumePoint( new.p[ 1 ] );
				KeplerFrames.Focus.Append( new );
			END
		END
	END NewFilledCircle;
END Kepler8.