Syntax10.Scn.Fnt
MODULE Kepler1;	(* J. Templ, 5.11.90/27.09.93 *)
	IMPORT
		KeplerGraphs, KeplerFrames, KeplerPorts, Math, Oberon, Texts, Files, Fonts, Display, In;
	CONST
		ArrLen = 44; ArrAngle = Math.pi / 6;	(*30 DEG*)
		fg = Display.white;
	TYPE
		Rectangle* = POINTER TO RectangleDesc;
		RectangleDesc* = RECORD
			(KeplerGraphs.ConsDesc)
		END ;
		Texture* = POINTER TO TextureDesc;
		TextureDesc* = RECORD
			(KeplerGraphs.ConsDesc)
			pat*: INTEGER;
		END ;
		Line* = POINTER TO LineDesc;
		LineDesc* = RECORD
			(KeplerGraphs.ConsDesc)
		END ;
		Circle* = POINTER TO CircleDesc;
		CircleDesc* = RECORD
			(KeplerGraphs.ConsDesc)
		END ;
		Ellipse* = POINTER TO EllipseDesc;
		EllipseDesc* = RECORD
			(KeplerGraphs.ConsDesc)
		END ;
		String* = POINTER TO StringDesc;	(*for backward compatibility only*)
		StringDesc* = RECORD
			(KeplerFrames.CaptionDesc)
		END ;
		HShape* = POINTER TO HShapeDesc;
		HShapeDesc* = RECORD
			(KeplerGraphs.ConsDesc)
		END ;
		H90Shape* = POINTER TO H90ShapeDesc;
		H90ShapeDesc* = RECORD
			(KeplerGraphs.ConsDesc)
		END ;
		AttrLine* = POINTER TO AttrDesc;
		AttrDesc* = RECORD
			(KeplerGraphs.ConsDesc)
			width*, a1*, a2*: INTEGER; (* line width, arrow kind, 0= no arrow, 1 = norm arrow *)
		END ;
		Triangle* = POINTER TO TriangleDesc;
		TriangleDesc* = RECORD
			(KeplerGraphs.ConsDesc)
			pat*: INTEGER
		END ;
(* ------------------------------- Rectangle ------------------------------- *)
	PROCEDURE MinMax(x, y: INTEGER; VAR min, max: INTEGER);
	BEGIN IF x < y THEN min := x; max := y ELSE min := y; max := x END
	END MinMax;
	PROCEDURE (R: Rectangle) Draw* (F: KeplerPorts.Port);
		VAR minx, maxx, miny, maxy: INTEGER;
	BEGIN
		MinMax(R.p[0].x, R.p[1].x, minx, maxx);
		MinMax(R.p[0].y, R.p[1].y, miny, maxy);
		F.DrawRect(minx, miny, maxx-minx, maxy-miny, Display.white, Display.replace)
	END Draw;
	PROCEDURE NewRectangle*;
		VAR o: Rectangle;
	BEGIN
		IF KeplerFrames.nofpts >= 2 THEN
			NEW(o); o.nofpts := 2;
			KeplerFrames.ConsumePoint(o.p[0]);
			KeplerFrames.ConsumePoint(o.p[1]);
			KeplerFrames.Focus.Append(o);
		END
	END NewRectangle;
(* ------------------------------- Texture ------------------------------- *)
	PROCEDURE (T: Texture) Draw* (F: KeplerPorts.Port);
		VAR minx, maxx, miny, maxy: INTEGER;
	BEGIN
		MinMax(T.p[0].x, T.p[1].x, minx, maxx);
		MinMax(T.p[0].y, T.p[1].y, miny, maxy);
		F.FillRect(minx, miny, maxx-minx, maxy-miny, Display.white, T.pat, Display.replace)
	END Draw;
	PROCEDURE (T: Texture) Write* (VAR R: Files.Rider);
	BEGIN Files.WriteNum(R, T.pat); T.Write^(R)
	END Write;
	PROCEDURE (T: Texture) Read* (VAR R: Files.Rider);
		VAR i: LONGINT;
	BEGIN Files.ReadNum(R, i); T.pat := SHORT (i); T.Read^(R)
	END Read;
	PROCEDURE NewTexture*;
		VAR o: Texture; i: INTEGER;
	BEGIN
		IF KeplerFrames.nofpts >= 2 THEN
			In.Open; In.Int(i);
			IF In.Done THEN NEW(o); o.nofpts := 2; o.pat := i;
				KeplerFrames.ConsumePoint(o.p[0]);
				KeplerFrames.ConsumePoint(o.p[1]);
				KeplerFrames.Focus.Append(o)
			END
		END
	END NewTexture;
(* ------------------------------- Line ------------------------------- *)
	PROCEDURE (L: Line) Draw* (F: KeplerPorts.Port);
	BEGIN F.DrawLine(L.p[0].x, L.p[0].y, L.p[1].x, L.p[1].y, Display.white, Display.replace)
	END Draw;
	PROCEDURE NewLine*;
		VAR o: Line;
	BEGIN
		IF KeplerFrames.nofpts >= 2 THEN
			NEW(o); o.nofpts := 2;
			KeplerFrames.ConsumePoint(o.p[0]);
			KeplerFrames.ConsumePoint(o.p[1]);
			KeplerFrames.Focus.Append(o);
		END
	END NewLine;
(* ------------------------------- Circle ------------------------------- *)
	PROCEDURE (C: Circle) Draw* (F: KeplerPorts.Port);
		VAR a, b: LONGINT; r: INTEGER;
	BEGIN
		a := C.p[0].x - C.p[1].x; b := C.p[0].y - C.p[1].y;
		r := SHORT(ENTIER(Math.sqrt(a*a + b*b)));
		F.DrawCircle(C.p[0].x, C.p[0].y, r, Display.white, Display.replace)
	END Draw;
	PROCEDURE NewCircle*;
		VAR o: Circle;
	BEGIN
		IF KeplerFrames.nofpts >= 2 THEN
			NEW(o); o.nofpts := 2;
			KeplerFrames.ConsumePoint(o.p[0]);
			KeplerFrames.ConsumePoint(o.p[1]);
			KeplerFrames.Focus.Append(o);
		END
	END NewCircle;
(* ------------------------------- Ellipse ------------------------------- *)
	PROCEDURE (E: Ellipse) Draw* (F: KeplerPorts.Port);
		VAR a, b, tmpx, tmpy, temp : INTEGER; 
	BEGIN
		tmpx := E.p[1].x - E.p[0].x; tmpy := E.p[2].y - E.p[0].y;
		MinMax( tmpx, -tmpx, temp, a );
		MinMax( tmpy, -tmpy, temp, b );
		E.p[2].x := E.p[0].x;
		E.p[1].y := E.p[0].y;
		F.DrawEllipse(E.p[0].x, E.p[0].y, a, b, Display.white, Display.replace)
	END Draw;
	PROCEDURE NewEllipse*;
		VAR o: Ellipse;
	BEGIN
		IF KeplerFrames.nofpts >= 3 THEN
			NEW(o); o.nofpts := 3;
			KeplerFrames.ConsumePoint(o.p[0]);
			KeplerFrames.ConsumePoint(o.p[1]);
			KeplerFrames.ConsumePoint(o.p[2]);
			KeplerFrames.Focus.Append(o);
		END
	END NewEllipse;
(* ------------------------------- Captions ------------------------------- *)
	PROCEDURE NewString*;		(*for backward compatibility only*)
		VAR o: KeplerFrames.Caption;
			beg, end, time: LONGINT;
			R: Texts.Reader;
			T: Texts.Text;
			i: INTEGER;
			ch: CHAR;
	BEGIN
		IF KeplerFrames.nofpts >= 1 THEN
			Oberon.GetSelection(T, beg, end, time);
			IF time > 0 THEN 
				NEW(o); o.nofpts := 1;
				In.Open; In.Int(i);
				IF ~In.Done THEN o.align := 0 ELSE o.align := SHORT(i) END ;
				KeplerFrames.ConsumePoint(o.p[0]);
				Texts.OpenReader(R, T, beg); Texts.Read(R, ch);
				o.fnt := R.fnt; i := 0;
				WHILE (ch >= " ") & (i < 128) & (Texts.Pos(R) <= end)  DO
					o.s[i] := ch; INC(i);
					Texts.Read(R, ch)
				END ;
				o.s[i] := 0X;
				KeplerFrames.Focus.Append(o)
			END
		END
	END NewString;
	PROCEDURE ChangeFont*;
		VAR G: KeplerGraphs.Graph; c: KeplerGraphs.Constellation;
			fntname: ARRAY 32 OF CHAR;
			fnt: Fonts.Font;
			F: KeplerPorts.BalloonPort;
	BEGIN
		In.Open;
		In.Name(fntname);
		KeplerFrames.GetSelection(G);
		IF (G # NIL) & In.Done THEN 
			fnt := Fonts.This(fntname);
			IF fntname = fnt.name THEN
				NEW(F); KeplerPorts.InitBalloon(F);
				c := G.cons;
				WHILE c # NIL DO
					WITH c: KeplerFrames.Caption DO
						IF c.State() = 2 THEN c.Draw(F); c.fnt := fnt; c.Draw(F) END
					ELSE
					END ;
					c := c.next
				END ;
				G.notify(KeplerGraphs.restore, G, NIL, F)
			END 
		END
	END ChangeFont;
	PROCEDURE ChangeAlign*;
		VAR G: KeplerGraphs.Graph; c: KeplerGraphs.Constellation;
			align: INTEGER;
			F: KeplerPorts.BalloonPort;
	BEGIN
		In.Open; In.Int(align);
		KeplerFrames.GetSelection(G);
		IF (G # NIL) & In.Done THEN 
			IF (0 <= align) & (align <= 6) THEN
				NEW(F); KeplerPorts.InitBalloon(F);
				c := G.cons;
				WHILE c # NIL DO
					WITH c: KeplerFrames.Caption DO
						IF c.State() = 2 THEN c.Draw(F); c.align := SHORT(align); c.Draw(F) END
					ELSE
					END ;
					c := c.next
				END ;
				G.notify(KeplerGraphs.restore, G, NIL, F)
			END 
		END
	END ChangeAlign;
(* ------------------------------- HShape ------------------------------- *)
	PROCEDURE (self: HShape) Draw* (F: KeplerPorts.Port);
	BEGIN F.DrawLine(self.p[0].x, self.p[1].y, self.p[2].x, self.p[1].y, Display.white, Display.replace)
	END Draw;
	PROCEDURE NewHShape*;
		VAR h: HShape;
	BEGIN
		IF KeplerFrames.nofpts >= 3 THEN
			NEW(h); h.nofpts := 3;
			KeplerFrames.ConsumePoint(h.p[0]);
			KeplerFrames.ConsumePoint(h.p[1]);
			KeplerFrames.ConsumePoint(h.p[2]);
			KeplerFrames.Focus.Append(h)
		END
	END NewHShape;
(* ------------------------------- H90Shape ------------------------------- *)
	PROCEDURE (self: H90Shape) Draw* (F: KeplerPorts.Port);
	BEGIN F.DrawLine(self.p[1].x, self.p[0].y, self.p[1].x, self.p[2].y, Display.white, Display.replace)
	END Draw;
	PROCEDURE NewH90Shape*;
		VAR h: H90Shape;
	BEGIN
		IF KeplerFrames.nofpts >= 3 THEN
			NEW(h); h.nofpts := 3;
			KeplerFrames.ConsumePoint(h.p[0]);
			KeplerFrames.ConsumePoint(h.p[1]);
			KeplerFrames.ConsumePoint(h.p[2]);
			KeplerFrames.Focus.Append(h)
		END
	END NewH90Shape;
(* ------------------------------- AttrLine ------------------------------- *)
	PROCEDURE Sign ( x : LONGINT ) : INTEGER;
	BEGIN IF x < 0 THEN RETURN - 1 ELSE RETURN 1 END
	END Sign;
	PROCEDURE GetPoint2 ( x, y, dx, dy : LONGINT; angle : REAL; VAR aX, aY : INTEGER; ArrLen: INTEGER );
		VAR h, s : LONGINT; cos, t: REAL;
	BEGIN
		aX := SHORT(x - ENTIER (Math.cos ( angle ) * ArrLen + 0.5) * Sign ( dx ));
		aY := SHORT(y - ENTIER ( Math.sin ( angle ) * ArrLen + 0.5 ) * Sign ( dx ));
	END GetPoint2;
	PROCEDURE DrawArrow (F: KeplerPorts.Port; x1, y1, x2, y2 : LONGINT; ArrLen: INTEGER; ArrAngle: REAL);
		CONST MinLen = 40;
		VAR angle : REAL; dx, dy : LONGINT; ax1, ay1, ax2, ay2: INTEGER;
	BEGIN
		IF ArrLen < MinLen THEN ArrLen := MinLen END ;
		dx := x2 - x1; dy := y2 - y1;
		IF dx # 0 THEN angle := Math.arctan ( dy / dx ) ELSE angle := Sign ( dy ) * ( Math.pi / 2 ) END;
		GetPoint2 ( x2, y2, dx, dy, angle - ArrAngle / 2, ax1, ay1, ArrLen );
		GetPoint2 ( x2, y2, dx, dy, angle + ArrAngle / 2, ax2, ay2, ArrLen );
		F.FillQuad(ax1, ay1, SHORT(x2), SHORT(y2), ax2, ay2, ax2, ay2, fg, 5, Display.replace);
	END DrawArrow;
	PROCEDURE Round(x: REAL): INTEGER;
	BEGIN RETURN SHORT(ENTIER(x + 0.5))
	END Round;
	PROCEDURE (A: AttrLine) Draw* (F: KeplerPorts.Port);
		CONST ArrLen = 44;
		VAR a, b, h, v1, v2: REAL; x1, y1, x2, y2, ar, br: INTEGER;
	BEGIN
		x1 := A.p[0].x; y1 := A.p[0].y;
		x2 := A.p[1].x; y2 := A.p[1].y;
		a := x2 - x1; b := y2 - y1;
		h := Math.sqrt(a*a + b*b);
		IF h # 0 THEN
			v1 := ArrLen * A.width / (4*3*h);
			IF A.a1 = 1 THEN
				DrawArrow(F, A.p[0].x, A.p[0].y, A.p[1].x, A.p[1].y, ArrLen * A.width DIV 4, Math.pi / 6);
				x2 := x2 - Round(a * v1); y2 := y2 - Round(b * v1)
			ELSIF A.a1 = 2 THEN
				DrawArrow(F, A.p[0].x, A.p[0].y, A.p[1].x, A.p[1].y, ArrLen * A.width DIV 6, Math.pi / 4);
				x2 := x2 - Round(a * v1); y2 := y2 - Round(b * v1)
			END ;
			IF A.a2 = 1 THEN
				DrawArrow(F, A.p[1].x, A.p[1].y, A.p[0].x, A.p[0].y, ArrLen * A.width DIV 4, Math.pi / 6);
				x1 := x1 + Round(a * v1); y1 := y1 + Round(b * v1)
			END ;
			IF A.width <= F.scale THEN (* draw as hair line *)
				F.DrawLine(x1, y1, x2, y2, Display.white, Display.replace)
			ELSIF x1 = x2 THEN (* optimized drawing of vertical line *)
				IF y1 > y2 THEN F.FillRect(x1 - A.width DIV 2, y2, A.width, y1 - y2, fg, 5, Display.replace)
				ELSE F.FillRect(x1 - A.width DIV 2, y1, A.width, y2 - y1, fg, 5, Display.replace)
				END
			ELSIF y1 = y2 THEN (* optimized drawing of horizontal line *)
				IF x1 > x2 THEN F.FillRect(x2, y2 - A.width DIV 2, x1 - x2, A.width, fg, 5, Display.replace)
				ELSE F.FillRect(x1, y1 - A.width DIV 2, x2 - x1, A.width, fg, 5, Display.replace)
				END
			ELSE v2 := A.width / (2*h);
				ar := Round(a * v2); br := Round(b * v2);
				x1 := x1 DIV F.scale * F.scale; y1 := y1 DIV F.scale * F.scale;
				x2 := x2 DIV F.scale * F.scale; y2 := y2 DIV F.scale * F.scale;
				F.FillQuad(x1 - br, y1 + ar, x1 + br, y1 - ar, x2 - br, y2 + ar, x2 + br, y2 - ar, fg, 5, Display.replace)
			END
		END
	END Draw;
	PROCEDURE (A: AttrLine) Write* (VAR R: Files.Rider);
	BEGIN Files.WriteNum(R, A.width); Files.WriteNum(R, A.a1); Files.WriteNum(R, A.a2); A.Write^(R)
	END Write;
	PROCEDURE (A: AttrLine) Read* (VAR R: Files.Rider);
		VAR i: LONGINT;
	BEGIN
		Files.ReadNum(R, i); A.width := SHORT(i);
		Files.ReadNum(R, i); A.a1 := SHORT(i);
		Files.ReadNum(R, i); A.a2 := SHORT(i);
		A.Read^(R)
	END Read;
	PROCEDURE NewAttrLine*;
		VAR a: AttrLine; w, a1, a2: INTEGER;
	BEGIN
		IF KeplerFrames.nofpts >= 2 THEN
			NEW(a); a.nofpts := 2;
			In.Open; In.Int(w); In.Int(a1); In.Int(a2);
			IF In.Done THEN 
				a.width := w; a.a1 := a1; a.a2 := a2;
				KeplerFrames.ConsumePoint(a.p[0]);
				KeplerFrames.ConsumePoint(a.p[1]);
				KeplerFrames.Focus.Append(a)
			END
		END
	END NewAttrLine;
	PROCEDURE ChangeAttrLine*;
		VAR G: KeplerGraphs.Graph; c: KeplerGraphs.Constellation;
			w, a1, a2: INTEGER;
			F: KeplerPorts.BalloonPort;
	BEGIN
		In.Open;
		In.Int(w); In.Int(a1); In.Int(a2);
		KeplerFrames.GetSelection(G);
		IF (G # NIL ) & In.Done THEN 
			NEW(F); KeplerPorts.InitBalloon(F);
			c := G.cons;
			WHILE c # NIL DO
				WITH c: AttrLine DO
					IF c.State() = 2 THEN c.Draw(F); c.width := w; c.a1 := a1; c.a2 := a2 ; c.Draw(F) END
				ELSE
				END ;
				c := c.next
			END ;
			G.notify(KeplerGraphs.restore, G, NIL, F) 
		END
	END ChangeAttrLine;
(* ------------------------------- Triangle ------------------------------- *)
	PROCEDURE (T: Triangle) Draw* (F: KeplerPorts.Port);
		VAR p0, p1, p2: KeplerGraphs.Star;
	BEGIN p0 := T.p[0]; p1 := T.p[1]; p2 := T.p[2];
		F.FillQuad(p0.x, p0.y, p1.x, p1.y, p2.x, p2.y, p2.x, p2.y, fg, T.pat, Display.replace)
	END Draw;
	PROCEDURE (T: Triangle) Write* (VAR R: Files.Rider);
	BEGIN Files.WriteNum(R, T.pat); T.Write^(R)
	END Write;
	PROCEDURE (T: Triangle) Read* (VAR R: Files.Rider);
		VAR i: LONGINT;
	BEGIN Files.ReadNum(R, i); T.pat := SHORT (i); T.Read^(R)
	END Read;
	PROCEDURE NewTriangle*;
		VAR o: Triangle; pat: INTEGER;
	BEGIN
		In.Open; In.Int(pat);
		IF In.Done & (KeplerFrames.nofpts >= 3) THEN
			NEW(o); o.nofpts := 3; o.pat := pat;
			KeplerFrames.ConsumePoint(o.p[0]);
			KeplerFrames.ConsumePoint(o.p[1]);
			KeplerFrames.ConsumePoint(o.p[2]);
			KeplerFrames.Focus.Append(o);
		END
	END NewTriangle;
END Kepler1.