Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
MODULE Rott;	(* bh '90; V2.2 shml 22 Mar 93 *) 
	IMPORT Oberon, Display, Display1, Texts, MenuViewers, Viewers, TextFrames, Input, Math;
	CONST P = 4; Q = 1; G = 0.001; F = 0.00000001; invert = Display.invert; delay = 50; (* ms *)
	TYPE
		Frame = POINTER TO FrameDesc;
		FrameDesc = RECORD(Display.FrameDesc);
			a, b, da, db: REAL;
			n, t: LONGINT
		END;
		StepMsg = RECORD(Display.FrameMsg) END;
		W: Texts.Writer;
		T: Oberon.Task;
	PROCEDURE Line(F: Display.Frame; col, X0, Y0, X1, Y1, mode: INTEGER);
	(* Draws a line from (X0, Y0) to (X1, Y1) inclusive, clipped against F. For all line points (x, y) the following holds
		always: (min(X0, X1) <= x) & (x <= max(X0, X1) & (min(Y0, Y0) <= y) & (y <= max(Y0, Y1). *)
		VAR x, y, dx, dy, d, inc, L, B, R, T, Xmin, Xmax, Ymin, Ymax: INTEGER;
	BEGIN
		L := F.X; B := F.Y; R := F.X + F.W; T := F.Y + F.H;
		IF X0 < X1 THEN Xmin := X0; Xmax := X1 ELSE Xmin := X1; Xmax := X0 END;
		IF Y0 < Y1 THEN Ymin := Y0; Ymax := Y1 ELSE Ymin := Y1; Ymax := Y0 END;
		IF (L <= Xmax) & (Xmin < R) & (B <= Ymax) & (Ymin < T) THEN (* line may be visible *)
			IF Xmin = Xmax THEN Display.ReplConstC(F, col, Xmin, Ymin, 1, Ymax-Ymin+1, mode)
			ELSIF Ymin = Ymax THEN Display.ReplConstC(F, col, Xmin, Ymin, Xmax-Xmin+1, 1, mode)
			ELSE
				IF (Y1-Y0) < (X0-X1) THEN x := X0; X0 := X1; X1 := x; y := Y0; Y0 := Y1; Y1 := y END;
				dx := 2*(X1-X0); dy := 2*(Y1-Y0); x := X0; y := Y0; inc := 1;
				IF (L <= Xmin) & (Xmax < R) & (B <= Ymin) & (Ymax < T) THEN (* no clipping *)
					IF dy > dx THEN d := dy DIV 2;
						IF dx < 0 THEN inc := -1; dx := -dx END;
						WHILE y <= Y1 DO
							Display.Dot(col, x, y, mode);
							INC(y); DEC(d, dx);
							IF d < 0 THEN INC(d, dy); INC(x, inc) END
						END
					ELSE d := dx DIV 2;
						IF dy < 0 THEN inc := -1; dy := -dy END;
						WHILE x <= X1 DO
							Display.Dot(col, x, y, mode);
							INC(x); DEC(d, dy);
							IF d < 0 THEN INC(d, dx); INC(y, inc) END
						END
					END
				ELSE (* dot-wise clipping *)
					IF dy > dx THEN d := dy DIV 2;
						IF dx < 0 THEN inc := -1; dx := -dx END;
						WHILE y <= Y1 DO
							IF (L <= x) & (x < R) & (B <= y) & (y < T) THEN Display.Dot(col, x, y, mode) END;
							INC(y); DEC(d, dx);
							IF d < 0 THEN INC(d, dy); INC(x, inc) END
						END
					ELSE d := dx DIV 2;
						IF dy < 0 THEN inc := -1; dy := -dy END;
						WHILE x <= X1 DO
							IF (L <= x) & (x < R) & (B <= y) & (y < T) THEN Display.Dot(col, x, y, mode) END;
							INC(x); DEC(d, dy);
							IF d < 0 THEN INC(d, dx); INC(y, inc) END
						END
					END
				END
			END
		END
	END Line;
	PROCEDURE Circle(F: Display.Frame; col, X, Y, R, mode: INTEGER);
	(* Draws a circle with center (X, Y) and radius R, clipped against F. For all circle points (x, y)  the following holds always:
		(X-R <= x) & (x < X+R) & (Y-R <= y) & (y < Y+R). *)
		VAR x, y, dx, dy, d, L, B, Rt, T: INTEGER;
		PROCEDURE Dot4 (x1, x2, y1, y2: INTEGER);
		BEGIN
			Display.Dot(col, x1, y1, mode);
			Display.Dot(col, x1, y2, mode);
			Display.Dot(col, x2, y1, mode);
			Display.Dot(col, x2, y2, mode)
		END Dot4;
		PROCEDURE Dot4c (x1, x2, y1, y2: INTEGER);
		BEGIN
			IF (L <= x1) & (x1 < Rt) THEN
				IF (B <= y1) & (y1 < T) THEN Display.Dot(col, x1, y1, mode) END;
				IF (B <= y2) & (y2 < T) THEN Display.Dot(col, x1, y2, mode) END;
			END;
			IF (L <= x2) & (x2 < Rt) THEN
				IF (B <= y1) & (y1 < T) THEN Display.Dot(col, x2, y1, mode) END;
				IF (B <= y2) & (y2 < T) THEN Display.Dot(col, x2, y2, mode) END;
			END
		END Dot4c;
	BEGIN
		L := F.X; B := F.Y; Rt := F.X + F.W; T := F.Y + F.H;
		IF (L < X+R) & (X-R < Rt) & (B < Y+R) & (Y-R < T) THEN (* circle may be visible *)
			x := R-1; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 3 - 4*R;
			IF (L <= X-R) & (X+R <= Rt) & (B <= Y-R) & (Y+R <= T) THEN (* no clipping *)
				WHILE x > y DO
					Dot4(X-x-1, X+x, Y-y-1, Y+y);
					Dot4(X-y-1, X+y, Y-x-1, Y+x);
					INC(d, dy); INC(dy, 8); INC(y);
					IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
				END;
				IF x = y THEN Dot4(X-x-1, X+x, Y-y-1, Y+y) END
			ELSE (* dot-wise clipping *)
				WHILE x > y DO
					Dot4c(X-x-1, X+x, Y-y-1, Y+y);
					Dot4c(X-y-1, X+y, Y-x-1, Y+x);
					INC(d, dy); INC(dy, 8); INC(y);
					IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
				END;
				IF x = y THEN Dot4c(X-x-1, X+x, Y-y-1, Y+y) END
			END
		END
	END Circle;
	PROCEDURE Draw(F: Frame);
		CONST c1 = 1; c2 = 3; c3 = 15;
		VAR xla, yla, xha, yha, xhb, yhb, xda, yda, xdb, ydb, x0, y0: INTEGER;  l ,d, h, r: REAL;
	BEGIN
		x0 := F.X + F.W DIV 2; y0 := F.Y + F.H DIV 2;
		IF F.W > F.H THEN l := F.H ELSE l := F.W END;
		l := l / 6; h := 1.558 * l; d := l / 8;
		r := Math.cos(F.a);
		xla := SHORT(ENTIER(l * r + 0.5));
		xha := SHORT(ENTIER(h * r + 0.5));
		xda := SHORT(ENTIER(d * r + 0.5));
		r := Math.sin(F.a);
		yla := SHORT(ENTIER(l * r + 0.5));
		yha := SHORT(ENTIER(h * r + 0.5));
		yda := SHORT(ENTIER(d * r + 0.5));
		r := Math.cos(F.b);
		xhb := SHORT(ENTIER(h * r + 0.5));
		xdb := SHORT(ENTIER(d * r + 0.5));
		r := Math.sin(F.b);
		yhb := SHORT(ENTIER(h * r + 0.5));
		ydb := SHORT(ENTIER(d * r + 0.5));
		Display1.Line(F, c1, x0-xla-xda-yda, y0-yla-yda+xda, x0+xla+xda-yda, y0+yla+yda+xda, invert);
		Display1.Line(F, c1, x0-xla-xda+yda, y0-yla-yda-xda, x0+xla-xda+yda, y0+yla-yda-xda, invert);
		Display1.Line(F, c1, x0-xla-xda-yda, y0-yla-yda+xda, x0-xla-xda+yda, y0-yla-yda-xda, invert);
		Display1.Line(F, c1, x0+xla+xda-yda, y0+yla+yda+xda, x0+xla+xda+yha, y0+yla+yda-xha, invert);
		Display1.Line(F, c1, x0+xla-xda+yda, y0+yla-yda-xda, x0+xla-xda+yha, y0+yla-yda-xha, invert);
		Display1.Line(F, c1, x0+xla+xda+yha, y0+yla+yda-xha, x0+xla-xda+yha, y0+yla-yda-xha, invert);
		Display1.Line(F, c2, x0-xla+xdb-ydb, y0-yla+ydb+xdb, x0-xla+xdb+yhb, y0-yla+ydb-xhb, invert);
		Display1.Line(F, c2, x0-xla-xdb-ydb, y0-yla-ydb+xdb, x0-xla-xdb+yhb, y0-yla-ydb-xhb, invert);
		Display1.Line(F, c2, x0-xla+xdb-ydb, y0-yla+ydb+xdb, x0-xla-xdb-ydb, y0-yla-ydb+xdb, invert);
		Display1.Line(F, c2, x0-xla+xdb+yhb, y0-yla+ydb-xhb, x0-xla-xdb+yhb, y0-yla-ydb-xhb, invert);
		Display1.Circle(F, c3, x0-xla, y0-yla, SHORT(ENTIER(d)), invert);
		Display1.Circle(F, c3, x0, y0, SHORT(ENTIER(d)), invert);
	END Draw;
	PROCEDURE Der(a, b, da, db: REAL; VAR Da, Db, Dda, Ddb: REAL);
		VAR x, y, det, sind, cosd, f: REAL;
	BEGIN
		Da := da; Db := db;
		sind := Math.sin(a - b);
		cosd := Math.cos(a - b);
		x := G * Math.sin(a) - db * db * cosd;
		y := G * Math.sin(b) + da * da * cosd;
		det := P * Q - sind * sind;
		IF da > 10*F THEN f := F ELSIF da < -10*F THEN f := -F ELSE f := 0 END;
		Dda := (sind * y - Q * x) / det - f;
		IF db > 10*F THEN f := F ELSIF db < -10*F THEN f := -F ELSE f := 0 END;
		Ddb := (sind * x - P * y) / det - f
	END Der;
	PROCEDURE Step(F: Frame);
		VAR dda1, ddb1, dda2, ddb2, dda3, ddb3, dda4, ddb4, da1, db1, da2, db2, da3, db3, da4, db4: REAL;
	BEGIN
		Der(F.a, F.b, F.da, F.db, da1, db1, dda1, ddb1);
		Der(F.a+3*da1, F.b+3*db1, F.da+3*dda1, F.db+3*ddb1, da2, db2, dda2, ddb2);
		Der(F.a+3*da2, F.b+3*db2, F.da+3*dda2, F.db+3*ddb2, da3, db3, dda3, ddb3);
		Der(F.a+6*da3, F.b+6*db3, F.da+6*dda3, F.db+6*ddb3, da4, db4, dda4, ddb4);
		Draw(F);
		F.a := F.a + da1 + 2 * da2 + 2 * da3 + da4;
		F.b := F.b + db1 + 2 * db2 + 2 * db3 + db4;
		F.da := F.da + dda1 + 2 * dda2 + 2 * dda3 + dda4;
		F.db := F.db + ddb1 + 2 * ddb2 + 2 * ddb3 + ddb4;
		Draw(F);
		INC(F.n)
	END Step;
	PROCEDURE Edit(F: Frame; X, Y: INTEGER; Keys: SET);
		VAR x0, y0: INTEGER;
	BEGIN
		IF 2 IN Keys THEN
			F.da := 0; F.db := 0; x0 := X; y0 := Y;
			REPEAT
				Input.Mouse(Keys, X, Y);
				Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
				IF (X # x0) OR (Y # y0) THEN
					Draw(F);
					F.a := F.a + (Y - y0) / 100; F.b := F.b + (X - x0) / 100;
					Draw(F);
					x0 := X; y0 := Y
				END
			UNTIL Keys = {};
		ELSE
			REPEAT
				Input.Mouse(Keys, X, Y);
				Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
			UNTIL Keys = {}
		END
	END Edit;
	PROCEDURE* Handle(F: Display.Frame; VAR M: Display.FrameMsg);
		VAR F1: Frame;
	BEGIN
 		WITH F: Frame DO
			IF M IS Oberon.InputMsg THEN
				WITH M: Oberon.InputMsg DO
					IF M.id = Oberon.track THEN Edit(F, M.X, M.Y, M.keys) END
				END
			ELSIF M IS MenuViewers.ModifyMsg THEN
				WITH M: MenuViewers.ModifyMsg DO
					IF M.id = MenuViewers.extend THEN F.H := F.H + F.Y - M.Y + M.dY
					ELSIF M.id = MenuViewers.reduce THEN F.H := F.H + F.Y - M.Y - M.dY
					END;
					F.Y := M.Y;
					Display.ReplConst(0, F.X, F.Y, F.W, F.H, Display.replace);
					Draw(F)
				END
			ELSIF M IS Oberon.CopyMsg THEN NEW(F1); F1^ := F^; M(Oberon.CopyMsg).F := F1
			ELSIF M IS StepMsg THEN Step(F)
			END
		END
	END Handle;
	PROCEDURE Open*;
		VAR F: Frame; x, y: INTEGER; v: MenuViewers.Viewer;
	BEGIN
		NEW(F); F.a := Math.pi; F.b := 3.14; F.da := 0.0; F.db := 0.0; F.n := 0; F.t := 0; F.handle := Handle;
		Oberon.AllocateUserViewer(Oberon.Par.vwr.X, x, y);
		v := MenuViewers.New(
			TextFrames.NewMenu("Rott.Open ", " System.Close System.Copy System.Grow"),
			F, TextFrames.menuH, x, y)
	END Open;
	PROCEDURE Start*;
	BEGIN Oberon.Install(T)
	END Start;
	PROCEDURE Stop*;
	BEGIN Oberon.Remove(T);
	END Stop;
	PROCEDURE* Handler;
		VAR m: StepMsg;
	BEGIN Viewers.Broadcast(m); T.time := Input.Time() + Input.TimeUnit * delay DIV 1000
	END Handler;
BEGIN Texts.OpenWriter(W); NEW(T); T.handle := Handler; T.time := 0; Start
END Rott.
Rott.Open
Rott.Start
Rott.Stop