--***********************************************************************
--									*
--									*
--   This software was written by Bevin Brett, of Digital Equipment	*
--   Corporation.							*
--									*
--   Digital assumes no responsibility AT ALL for the use or reliability*
--   of this software.							*
--									*
--   Redistribution and use in source and binary forms are permitted	*
--   provided that the above copyright notice and this paragraph are	*
--   duplicated in all such forms and that any documentation,		*
--   advertising materials, and other materials related to such		*
--   distribution and use acknowledge that the software was developed	*
--   by Digital Equipment Corporation. The name of Digital Equipment	*
--   Corporation may not be used to endorse or promote products derived	*
--   from this software without specific prior written permission.	*
--									*
--   THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR	*
--   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED	*
--   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.*
--									*
--***********************************************************************

-- modified for use with Adabindx 10.8.1997
-- Hans-Frieder Vogt (vogt@ilaws6.luftfahrt.uni-stuttgart.de)

with Ada.Numerics.Elementary_Functions,
     COLORS,UNITS,PLACES,SHAPES,RUBIKS_CUBE,DRAW_SHAPE;
use  COLORS,UNITS,PLACES,SHAPES,RUBIKS_CUBE;
with UNCHECKED_DEALLOCATION;
procedure DRAW_RUBIKS_CUBE(R : RUBIKS_CUBE_TYPE;
    A : AXIS_TYPE  := AXIS_TYPE'first;
    L : LEVEL_TYPE := LEVEL_TYPE'first;
    T : RADIANS    := 0.0;
    WHOLE_SPIN : RADIANS := 0.0)
is

    procedure DEALLOCATE is new UNCHECKED_DEALLOCATION(FACE, ACCESS_FACE);

    S : SHAPE(NUMBER_OF_FACES =>
		 3*3*4  -- internal faces
		+3*3*6  -- external faces
		);

    PREROTATE_DONE : BOOLEAN := FALSE;
    SI, CO : FLOAT;

    procedure PREROTATE is
       use Ada.Numerics.Elementary_Functions;
    begin
	if not PREROTATE_DONE then
	    PREROTATE_DONE := TRUE;
	    SI := Sin (FLOAT(T));
	    CO := Cos (FLOAT(T));
	end if;
    end;

    procedure ROTATE(X, Y : in out COORDINATE) is
	NX, NY : COORDINATE;
    begin
	NX := COORDINATE(FLOAT(X)*CO-FLOAT(Y)*SI);
	NY := COORDINATE(FLOAT(X)*SI+FLOAT(Y)*CO);
	X := NX; Y := NY;
    end;

    procedure DO_CURRENT_TWIST(CI,CJ,CK : LEVEL_TYPE;F : in out SHAPES.FACE) is
	-- if this cube is affected by the current twist, move it
    begin
	if T = 0.0 then return; end if;
	case A is
	    when I =>
		if CI=L then
		    PREROTATE;
		    for C in F.CORNERS'range loop
			ROTATE(F.CORNERS(C).J, F.CORNERS(C).K);
		    end loop;
		    ROTATE(F.NORMAL.J, F.NORMAL.K);
		end if;
	    when J =>
		if CJ=L then
		    PREROTATE;
		    for C in F.CORNERS'range loop
			ROTATE(F.CORNERS(C).I, F.CORNERS(C).K);
		    end loop;
		    ROTATE(F.NORMAL.I, F.NORMAL.K);
		end if;
	    when K =>
		if CK=L then
		    PREROTATE;
		    for C in F.CORNERS'range loop
			ROTATE(F.CORNERS(C).I, F.CORNERS(C).J);
		    end loop;
		    ROTATE(F.NORMAL.I, F.NORMAL.J);
		end if;
	end case;
    end;

    procedure FILL_IN_FACE(
	CI,CJ,CK : LEVEL_TYPE;
	FI,FJ,FK : LEVEL_TYPE;
	F	 : in out SHAPES.FACE)
    is
	N  : VECTOR := (COORDINATE(FI),COORDINATE(FJ),COORDINATE(FK));
	D1 : VECTOR := (- N.K, - N.I, - N.J);
	D2 : VECTOR := ( D1.K,	D1.I,  D1.J);
	B  : COORDINATE := COORDINATE(BOOLEAN'pos(FI+FJ+FK>0))-0.5;

   begin					    
	F.COLOR := R(TO_CUBE_POSITION(CI,CJ,CK))(TO_FACE(FI,FJ,FK));
	F.CORNERS(1) := (COORDINATE(CI)+B,COORDINATE(CJ)+B,COORDINATE(CK)+B);
	F.CORNERS(2) := F.CORNERS(1) + D1;
	F.CORNERS(3) := F.CORNERS(2) + D2;
	F.CORNERS(4) := F.CORNERS(1) + D2;
	F.NORMAL := N;

	DO_CURRENT_TWIST(CI,CJ,CK, F);

    end;

begin
    -- fill in the faces
    declare
	FIRST_FACE : BOOLEAN := TRUE;
	F : POSITIVE range S.FACES'range;

        function NEXT_F return POSITIVE is
	begin
	    if FIRST_FACE then
		FIRST_FACE := FALSE;
		F := S.FACES'first;
	    else
		F := F+1;
	    end if;
	    return F;
	end;
 
    begin
	-- the large internal faces in the axis of rotation
	for IX in LEVEL_TYPE loop
	    for IY in LEVEL_TYPE loop
		declare
		    INTERNAL_LEVELS : constant array(1..4) of LEVEL_TYPE := (-1,0,0,1);
		    INTERNAL_SIDE  : constant array(1..4) of LEVEL_TYPE := (1,-1,1,-1);
	
		    procedure DO_INTERNAL_FACE(
			F : in out SHAPES.FACE; L : LEVEL_TYPE; S : LEVEL_TYPE) is
	
			CI,CJ,CK : LEVEL_TYPE;
			N : VECTOR := (COORDINATE(S), 0.0, 0.0);
	
			X_TO_J	: constant array(1..4) of COORDINATE
				:= (-0.5, 0.5, 0.5, -0.5);
			X_TO_K	: constant array(1..4) of COORDINATE
				:= (-0.5, -0.5, 0.5, 0.5);
	
			procedure I_TO_J_TO_K_TO_I(X : in out VECTOR) is
			    T : COORDINATE := X.I;
			begin
			    X.I := X.K; X.K := X.J; X.J := T;
			end;
	
			procedure CORRECT(X : in out VECTOR) is
			begin
			    if A /= I then
				I_TO_J_TO_K_TO_I(X);
				if A /= J then
				    I_TO_J_TO_K_TO_I(X);
				end if;
			    end if;
			end;
	
		    begin
			CORRECT(N);
			F.COLOR := COLORS.Color_Interior;
			F.NORMAL := N;
	
			for X in F.CORNERS'range loop
			    F.CORNERS(X).I :=
			       COORDINATE(L)-0.5+COORDINATE(BOOLEAN'pos(S>=0));
			    F.CORNERS(X).J := COORDINATE(IX)+X_TO_J(X);
			    F.CORNERS(X).K := COORDINATE(IY)+X_TO_K(X);
			    CORRECT(F.CORNERS(X));
			end loop;
	
			case A is
			    when I => CI := L; CJ := 0; CK := 0;
			    when J => CI := 0; CJ := L; CK := 0;
			    when K => CI := 0; CJ := 0; CK := L;
			end case;
	
			DO_CURRENT_TWIST(CI,CJ,CK, F);
		    end;
		begin
		    for X in 1..4 loop
			S.FACES(NEXT_F) := new FACE(4);
			DO_INTERNAL_FACE(S.FACES(F).all,
			    INTERNAL_LEVELS(X),
			    INTERNAL_SIDE  (X));
		    end loop;
		end;
	    end loop;
	end loop;

	-- the small faces
	for CI in LEVEL_TYPE loop
	    for CJ in LEVEL_TYPE loop
		for CK in LEVEL_TYPE loop
		    if (abs CI + abs CJ + abs CK) /= 0 then
			for FI in LEVEL_TYPE loop
			    for FJ in LEVEL_TYPE loop
				for FK in LEVEL_TYPE loop
				    if (BOOLEAN'pos(FI=0) + BOOLEAN'pos(FJ=0) + BOOLEAN'pos(FK=0)) = 2 then
					-- for each face (FI,FJ,FK) of each cube (CI,CJ,CK)
					if (CI=FI and CI/=0)
					or (CJ=FJ and CJ/=0)
					or (CK=FK and CK/=0) then
					    -- if visible...
					    S.FACES(NEXT_F) := new FACE(4);
					    FILL_IN_FACE(CI,CJ,CK,FI,FJ,FK,
						S.FACES(F).all);
					end if;
				    end if;
				end loop;
			    end loop;
			end loop;
		    end if;
		end loop;
	    end loop;
	end loop;
	
        -- draw the whole shape
        DRAW_SHAPE(S,
	    WHOLE_SPIN+0.7,
	    (8.0,0.0,3.0));

	-- free up the allocated storage
	if not FIRST_FACE then
	    for I in S.FACES'first..F loop
		DEALLOCATE(S.FACES(I));
	    end loop;
	end if;

   end;

end;