--***********************************************************************
--									*
--									*
--   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)

package body RUBIKS_CUBE is

    type IJK_TYPE is record I,J,K : LEVEL_TYPE; end record;

    function TO_FACE(I,J,K : LEVEL_TYPE) return FACE_TYPE is
	function F(B : FACE_TYPE; V : LEVEL_TYPE) return FACE_TYPE is
	begin
	    if V = 0 then
		return 0;
	    else
		return B+FACE_TYPE((INTEGER(V)+1)/2);
	    end if;
	end;
    begin
	if (BOOLEAN'pos(I=0) + BOOLEAN'pos(J=0) + BOOLEAN'pos(K=0)) /= 2 then
	    raise CONSTRAINT_ERROR;
        end if;
	return F(0,I)+F(2,J)+F(4,K);
    end;

    function TO_FACE(IJK : IJK_TYPE) return FACE_TYPE is
    begin
	return TO_FACE(IJK.I, IJK.J, IJK.K);
    end;

    function TO_IJK(F : FACE_TYPE) return IJK_TYPE is
	function G(B : FACE_TYPE) return LEVEL_TYPE is
	begin
	    if F in B..B+1 then
		return LEVEL_TYPE(INTEGER(F-B)*2-1);
	    else
		return 0;
	    end if;
	end;
    begin
	return IJK_TYPE'(G(0),G(2),G(4));
    end;

    function ROTATE(
	IJK : IJK_TYPE;
	A : AXIS_TYPE;
	T : TURN_TYPE) return IJK_TYPE is
	NIJK : IJK_TYPE := IJK;
	procedure ROTATE(X,Y : in out LEVEL_TYPE) is
	    NX : LEVEL_TYPE := -Y;
	    NY : LEVEL_TYPE :=  X;
	begin
	    if T=ANTICLOCKWISE then NX:=-NX; NY := -NY; end if;
	    X := NX;
	    Y := NY;
	end;
    begin
	case A is
	    when I => ROTATE(NIJK.J,NIJK.K);
	    when J => ROTATE(NIJK.I,NIJK.K);
	    when K => ROTATE(NIJK.I,NIJK.J);
	end case;
	return NIJK;
    end;

    function ROTATE(
	F : FACE_TYPE;
	A : AXIS_TYPE;
	T : TURN_TYPE) return FACE_TYPE is
    begin
	return TO_FACE(ROTATE(TO_IJK(F), A, T));
    end;

    function ROTATE(
	C : CUBE_TYPE;
	A : AXIS_TYPE;
	T : TURN_TYPE) return CUBE_TYPE is
	NC : CUBE_TYPE;
    begin
	for F in FACE_TYPE loop NC(ROTATE(F,A,T)) := C(F); end loop;
	return NC;
    end;

    function TO_IJK(CP : CUBE_POSITION_TYPE) return IJK_TYPE is
	function F(B : NATURAL) return LEVEL_TYPE is
	begin
	    return LEVEL_TYPE(((INTEGER(CP)/(3**B)) rem 3)-1);
	end;
    begin
	return IJK_TYPE'(F(0),F(1),F(2)); 
    end;

    function TO_CUBE_POSITION(I,J,K : LEVEL_TYPE) return CUBE_POSITION_TYPE is
	function F(V : LEVEL_TYPE; B : NATURAL) return CUBE_POSITION_TYPE is
	begin
	    return CUBE_POSITION_TYPE((3**B)*(INTEGER(V)+1));
	end;
    begin
	return F(I,0)+F(J,1)+F(K,2);
    end;

    function TO_CUBE_POSITION(IJK : IJK_TYPE) return CUBE_POSITION_TYPE is
    begin
	return TO_CUBE_POSITION(IJK.I, IJK.J, IJK.K);
    end;

    function ROTATE(
	CP : CUBE_POSITION_TYPE;
	A : AXIS_TYPE;
	T : TURN_TYPE) return CUBE_POSITION_TYPE is
    begin
	return TO_CUBE_POSITION(ROTATE(TO_IJK(CP), A, T));
    end;


    function ROTATE(
	R : RUBIKS_CUBE_TYPE;
	A : AXIS_TYPE;
	L : LEVEL_TYPE;
	T : TURN_TYPE) return RUBIKS_CUBE_TYPE is

	NR : RUBIKS_CUBE_TYPE := R;

	procedure MOVE(I,J,K : LEVEL_TYPE) is
	    CP : CUBE_POSITION_TYPE := TO_CUBE_POSITION(I,J,K);
	begin
	    NR(ROTATE(CP,A,T)) := ROTATE(R(CP),A,T);
	end;

    begin
	for X in LEVEL_TYPE loop
	    for Y in LEVEL_TYPE loop
		case A is
		    when I => MOVE(L,X,Y);
		    when J => MOVE(X,L,Y);
		    when K => MOVE(X,Y,L);
		end case;
	    end loop;
	end loop;

	return NR;
    end;

end;