Obx/Mod/Cubes.odc

MODULE ObxCubes;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	references	= "Adopted from a program written in C in 1986 by Roland Karlsson,
		    Swedish Institute for Computer Science (SICS), roland@sics.se"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

	IMPORT Views, Ports, Properties, Services, Stores, Models, Math, Controllers, StdCmds, Containers, Dialog;

	CONST
		minVersion = 0; maxVersion = 1;
		pi2 = 255;
		invisible = Ports.white;

	TYPE
		Colors = ARRAY 6 OF Ports.Color;

		View = POINTER TO RECORD (Views.View)
			fi1, fi2: INTEGER;	(* rotation angles *)
			colors: Colors	(* colors of the six sides of the cube *)
		END;

		Action = POINTER TO RECORD (Services.Action) END;

		Msg = RECORD (Models.Message) 
			consumed: BOOLEAN
		END;

	VAR
		para*: RECORD
			colors*: Colors
		END;

		action: Action;
		actionIsAlive: BOOLEAN;
		actual: View;
		sinus: ARRAY 256 OF INTEGER;


	(* property dialog *)

	PROCEDURE Singleton (): View;
		VAR v: Views.View;
	BEGIN
		Controllers.SetCurrentPath(Controllers.targetPath);
		v := Containers.FocusSingleton();
		Controllers.ResetCurrentPath();
		IF (v # NIL) & (v IS View) THEN RETURN v(View) ELSE RETURN NIL END
	END Singleton;

	PROCEDURE Notify* (op, from, to: INTEGER);
		VAR v: View;
	BEGIN
		v := Singleton();
		IF v # NIL THEN v.colors := para.colors END
	END Notify;
	
	(* Action *)
	
	PROCEDURE (a: Action) Do;
		VAR msg: Msg; v: View;
	BEGIN
		msg.consumed := FALSE;
		Views.Omnicast(msg);
		IF msg.consumed THEN (* update Color Property Editor *)
			v := Singleton();
			IF (v # NIL) & (actual # v) THEN
				para.colors := v.colors; Dialog.Update(para);
				actual := v
			END;
			Services.DoLater(a, Services.Ticks() + Services.resolution DIV 10)
				(* i.e. perform a full rotation through all 256 states in 25.6 seconds *)
		ELSE
			actionIsAlive := FALSE
		END
	END Do;

	(* View *)

	PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
		VAR i: INTEGER;
	BEGIN
		wr.WriteVersion(maxVersion);
		wr.WriteInt(v.fi1); wr.WriteInt(v.fi2);
		FOR i := 0 TO 5 DO wr.WriteInt(v.colors[i]) END
	END Externalize;

	PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
		VAR version: INTEGER; i: INTEGER;
	BEGIN
		rd.ReadVersion(minVersion, maxVersion, version);
		IF ~rd.cancelled THEN
			rd.ReadInt(v.fi1); rd.ReadInt(v.fi2);
			IF version = maxVersion THEN
				FOR i := 0 TO 5 DO rd.ReadInt(v.colors[i]) END
			ELSE
				FOR i := 0 TO 5 DO v.colors[i] := invisible END
			END
		END
	END Internalize;

	PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
	BEGIN
		WITH source: View DO
			v.fi1 := source.fi1; v.fi2 := source.fi2; 
			v.colors := source.colors
		END
	END CopyFromSimpleView;

	PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
	BEGIN
		WITH msg: Properties.SizePref DO
			IF (msg.w > Views.undefined) & (msg.h > Views.undefined) THEN
				Properties.ProportionalConstraint(1, 1, msg.fixedW, msg.fixedH, msg.w, msg.h);
				IF msg.w < 10 * Ports.mm THEN
					msg.w := 10 * Ports.mm; msg.h := msg.w
				END
			ELSE
				msg.w := 40*Ports.mm; msg.h := msg.w;
			END
		| msg: Properties.FocusPref DO
			msg.hotFocus := TRUE
		ELSE
		END
	END HandlePropMsg;

	PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
																VAR focus: Views.View);
		VAR c: Containers.Controller;
	BEGIN
		WITH msg: Controllers.TrackMsg DO
			IF Controllers.modify IN msg.modifiers THEN
				c := Containers.Focus();
				IF c.opts # Containers.mask THEN
					para.colors := v.colors;
					StdCmds.OpenToolDialog('Obx/Rsrc/Cubes', 'Cube Colors');
					c.SetSingleton(v)
				END
			END
		ELSE
		END
	END HandleCtrlMsg;

	PROCEDURE (v: View) HandleModelMsg (VAR msg: Models.Message);
	BEGIN
		WITH msg: Msg DO
			v.fi1 := (v.fi1 + 7) MOD pi2;
			v.fi2 := (v.fi2 + 1) MOD pi2;
			msg.consumed := TRUE;
			Views.Update(v, Views.keepFrames)
		ELSE
		END
	END HandleModelMsg;

	PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
		VAR
			fi1, fi2, a, c: INTEGER;
			p0h, p0v, p1h, p1v, p2h, p2v, p3h, p3v: INTEGER;
			w, h: INTEGER;
			e01, e12, e23, e30,
			e45, e56, e67, e74,
			e04, e15, e26, e37: BOOLEAN;
			p: ARRAY 4 OF Ports.Point;

		PROCEDURE DrawSides(visible: BOOLEAN);
		BEGIN
			IF (e01 & e12 & e23 & e30 = visible) & (v.colors[0] # invisible) THEN
				p[0].x := (p0h - c) * w; p[0].y := p0v * w;
				p[1].x := (p1h - c) * w; p[1].y := p1v * w;
				p[2].x := (p2h - c) * w; p[2].y := p2v * w;
				p[3].x := (p3h - c) * w; p[3].y := p3v * w;
				f.DrawPath(p, 4, Ports.fill, v.colors[0], Ports.closedPoly)
			END;
			IF (e45 & e56 & e67 & e74 = visible) & (v.colors[1] # invisible)  THEN
				p[0].x := (p0h + c) * w; p[0].y := p0v * w;
				p[1].x := (p1h + c) * w; p[1].y := p1v * w;
				p[2].x := (p2h + c) * w; p[2].y := p2v * w;
				p[3].x := (p3h + c) * w; p[3].y := p3v * w;
				f.DrawPath(p, 4, Ports.fill, v.colors[1], Ports.closedPoly)
			END;
			IF (e01 & e15 & e45 & e04 = visible) & (v.colors[2] # invisible)  THEN
				p[0].x := (p0h - c) * w; p[0].y := p0v * w;
				p[1].x := (p1h - c) * w; p[1].y := p1v * w;
				p[2].x := (p1h + c) * w; p[2].y := p1v * w;
				p[3].x := (p0h + c) * w; p[3].y := p0v * w;
				f.DrawPath(p, 4, Ports.fill, v.colors[2], Ports.closedPoly)
			END;
			IF (e12 & e26 & e56 & e15 = visible) & (v.colors[3] # invisible)  THEN
				p[0].x := (p1h - c) * w; p[0].y := p1v * w;
				p[1].x := (p2h - c) * w; p[1].y := p2v * w;
				p[2].x := (p2h + c) * w; p[2].y := p2v * w;
				p[3].x := (p1h + c) * w; p[3].y := p1v * w;
				f.DrawPath(p, 4, Ports.fill, v.colors[3], Ports.closedPoly)
			END;
			IF (e23 & e37 & e67 & e26 = visible) & (v.colors[4] # invisible)  THEN
				p[0].x := (p2h - c) * w; p[0].y := p2v * w;
				p[1].x := (p3h - c) * w; p[1].y := p3v * w;
				p[2].x := (p3h + c) * w; p[2].y := p3v * w;
				p[3].x := (p2h + c) * w; p[3].y := p2v * w;
				f.DrawPath(p, 4, Ports.fill, v.colors[4], Ports.closedPoly)
			END;
			IF (e30 & e04 & e74 & e37 = visible) & (v.colors[5] # invisible)  THEN
				p[0].x := (p3h - c) * w; p[0].y := p3v * w;
				p[1].x := (p0h - c) * w; p[1].y := p0v * w;
				p[2].x := (p0h + c) * w; p[2].y := p0v * w;
				p[3].x := (p3h + c) * w; p[3].y := p3v * w;
				f.DrawPath(p, 4, Ports.fill, v.colors[5], Ports.closedPoly)
			END;
			IF e01 = visible THEN
				f.DrawLine((p0h - c) * w, p0v * w, (p1h - c) * w, p1v * w, 0, Ports.black)
			END;
			IF e12 = visible THEN
				f.DrawLine((p1h - c) * w, p1v * w, (p2h - c) * w, p2v * w, 0, Ports.black)
			END;
			IF e23 = visible THEN
				f.DrawLine((p2h - c) * w, p2v * w, (p3h - c) * w, p3v * w, 0, Ports.black)
			END;
			IF e30 = visible THEN
				f.DrawLine((p3h - c) * w, p3v * w, (p0h - c) * w, p0v * w, 0, Ports.black)
			END;
			IF e45 = visible THEN
				f.DrawLine((p0h + c) * w, p0v * w, (p1h + c) * w, p1v * w, 0, Ports.black)
			END;
			IF e56 = visible THEN
				f.DrawLine((p1h + c) * w, p1v * w, (p2h + c) * w, p2v * w, 0, Ports.black)
			END;
			IF e67 = visible THEN
				f.DrawLine((p2h + c) * w, p2v * w, (p3h + c) * w, p3v * w, 0, Ports.black)
			END;
			IF e74 = visible THEN
				f.DrawLine((p3h + c) * w, p3v * w, (p0h + c) * w, p0v * w, 0, Ports.black)
			END;
			IF e04 = visible THEN
				f.DrawLine((p0h + c) * w, p0v * w, (p0h - c) * w, p0v * w, 0, Ports.black)
			END;
			IF e15 = visible THEN
				f.DrawLine((p1h + c) * w, p1v * w, (p1h - c) * w, p1v * w, 0, Ports.black)
			END;
			IF e26 = visible THEN
				f.DrawLine((p2h + c) * w, p2v * w, (p2h - c) * w, p2v * w, 0, Ports.black)
			END;
			IF e37 = visible THEN
				f.DrawLine((p3h + c) * w, p3v * w, (p3h - c) * w, p3v * w, 0, Ports.black)
			END
		END DrawSides;

	BEGIN
		IF ~actionIsAlive THEN
			 actionIsAlive := TRUE; Services.DoLater(action, Services.now)
		END;

		v.context.GetSize(w, h); w := (w  DIV 170);

		fi1 := v.fi1;
		fi2 := v.fi2;

		a := sinus[fi2];
		c := (sinus[(64 - fi2) MOD pi2] * 91) DIV 128; (* 91/128 := sqrt(2)  *)

		p0v := 85 + sinus[fi1];
		p0h := 85 + (a * sinus[(64 - fi1) MOD pi2]) DIV 64;

		p1v := 85 + sinus[(64 + fi1) MOD pi2];
		p1h := 85 + (a * sinus[(-fi1) MOD pi2]) DIV 64;

		p2v := 85 + sinus[(128 + fi1) MOD pi2];
		p2h := 85 + (a * sinus[(-64 - fi1) MOD pi2]) DIV 64;

		p3v := 85 + sinus[(192 + fi1) MOD pi2];
		p3h := 85 + (a * sinus[(-128 - fi1) MOD pi2]) DIV 64;

		(* determine visibility of the twelve edges *)

		e01 :=  ~((((fi2 - 192) MOD pi2 < 64) & ((fi1 - 32) MOD pi2 < 128))
				OR (((fi2 - 128) MOD pi2 < 64) & ((fi1 - 160) MOD pi2 < 128)));
		e12 := ~((((fi2 - 192) MOD pi2 < 64) & ((fi1 - 224) MOD pi2 < 128))
				OR (((fi2 - 128) MOD pi2 < 64) & ((fi1 - 96) MOD pi2 < 128)));
		e23 := ~((((fi2 - 192) MOD pi2 < 64) & ((fi1 - 160) MOD pi2 < 128))
				OR (((fi2 - 128) MOD pi2 < 64) & ((fi1 - 32) MOD pi2 < 128)));
		e30 := ~((((fi2 - 192) MOD pi2 < 64) & ((fi1 - 96) MOD pi2 < 128))
				OR (((fi2 - 128) MOD pi2 < 64) & ((fi1 - 224) MOD pi2 < 128)));
		e45 := ~((((fi2) MOD pi2 < 64) & ((fi1 - 32) MOD pi2 < 128))
				OR (((fi2 - 64) MOD pi2 < 64) & ((fi1 - 160) MOD pi2 < 128)));
		e56 := ~((((fi2) MOD pi2 < 64) & ((fi1 - 224) MOD pi2 < 128))
				OR (((fi2 - 64) MOD pi2 < 64) & ((fi1 - 96) MOD pi2 < 128)));
		e67 := ~((((fi2) MOD pi2 < 64) & ((fi1 - 160) MOD pi2 < 128))
				OR (((fi2 - 64) MOD pi2 < 64) & ((fi1 - 32) MOD pi2 < 128)));
		e74 := ~((((fi2) MOD pi2 < 64) & ((fi1 - 96) MOD pi2 < 128))
				OR (((fi2 - 64) MOD pi2 < 64) & ((fi1 - 224) MOD pi2 < 128)));
		e04 := ~((((fi2 - 64) MOD pi2 < 128) & ((fi1 - 224) MOD pi2 < 64))
				OR (((fi2 - 192) MOD pi2 < 128) & ((fi1 - 96) MOD pi2 < 64)));
		e15 := ~((((fi2 - 64) MOD pi2 < 128) & ((fi1 - 160) MOD pi2 < 64))
				OR (((fi2 - 192) MOD pi2 < 128) & ((fi1 - 32) MOD pi2 < 64)));
		e26 := ~((((fi2 - 64) MOD pi2 < 128) & ((fi1 - 96) MOD pi2 < 64))
				OR (((fi2 - 192) MOD pi2 < 128) & ((fi1 - 224) MOD pi2 < 64)));
		e37 := ~((((fi2 - 64) MOD pi2 < 128) & ((fi1 - 32) MOD pi2 < 64))
				OR (((fi2 - 192) MOD pi2 < 128) & ((fi1 - 160) MOD pi2 < 64)));

		DrawSides(FALSE);	(* draw hidden sides and edges *)
		DrawSides(TRUE)	(* draw visible sides and edges *)
	END Restore;

	(* commands *)

	PROCEDURE New* (): View;
		VAR v: View;
	BEGIN
		NEW(v);
		v.fi1 := 0; v.fi2 := 0;
		v.colors := para.colors;
		RETURN v
	END New;

	PROCEDURE Deposit*;
	BEGIN
		Views.Deposit(New())
	END Deposit;

	PROCEDURE InitData;
		VAR i: INTEGER;
	BEGIN (* Pi = 128 *)
		FOR i := 0 TO 255 DO
			sinus[i] := SHORT(ENTIER(0.5 + 64 *  Math.Sin(i * 2 * Math.Pi() / 256)))
		END;
		para.colors[0] := Ports.green;
		para.colors[1] := Ports.blue;
		para.colors[2] := invisible;
		para.colors[3] := Ports.red;
		para.colors[4] := invisible;
		para.colors[5] := Ports.red + Ports.green	(* yellow *)
	END InitData;

BEGIN
	InitData; NEW(action); actionIsAlive := FALSE
CLOSE
	IF actionIsAlive THEN Services.RemoveAction(action) END
END ObxCubes.