```program Puzzle;
{ -- Project Name: Puzzle.Pas
-- Author:       Douglas E. Woolley
-- Date Started: 8/15/88
-- Last Update:  9/27/88

-- This program will accept the appearance of the Rubik's Cube as input,
-- and output a step-by-step text/graphical solution to restore the puzzle.
}

type
String1  = String;    { -- Stores Side to be moved, eg. F, R, B }
String3  = String;    { -- Stores 1 move of solution 'F+ ' }
String30 = String;   { -- Stores Title for Border }
String60 = String;   { -- Stores Set of Moves (at most 20) }
Array6 = Array [1..6] of Integer;
MenuType = Array [1..6] of String;

const
RowForSide: Array6 = (3, 10, 10, 10, 10, 17);
ColForSide: Array6 = (3,  3, 12, 21, 30,  3);
MenuOption: MenuType = ( { -- 1 } 'Graphic Solution',
{ -- 2 } 'Text Solution',
{ -- 3 } 'Instructions',
{ -- 4 } 'Set Valid Colors',
{ -- 5 } 'Test Program',
{ -- 6 } 'Exit');
LastOption = 6;

var
A:            Array [1..54] of Char;  { -- Has current color of square. }
AInit:        Array [1..54] of Char;  { -- Has initial color of square. }
Option:       Integer;
ValidColor:   Array [1..6] of Char;
CorrectInput: Boolean;
Solution:     Array [1..200] of String3;    { -- Has all moves to make. }
LastSolIndex: Integer;                      { -- Has last index of Sol. }
MoveError:    Boolean;   { -- Detects if an error occurs during moves. }

{ --INCLUDE DISPLAYS.INC: DisplayBorder, DisplayTitlePage, DisplayMenu, Beep }
{\$I DISPLAYS.INC}

{ -- DISPLAYS.INC }
procedure DisplayBorder ({using} Title: String30; TM: Integer);
{ -- This procedure will display special characters around the perimeter
-- and centers the Title on the top line; TM=0 is width 80, = 1 width 40. }

const
TopLtCor = 201;
TopRtCor = 187;
BotLtCor = 200;
BotRtCor = 188;
Down     = 186;
Across   = 205;

var
I: Integer;

begin
if TM = 0 then        { -- Width is 80 }
TextMode (C80)
else TextMode (C40);  { -- Width is 40 }
TextBackground (Blue);  TextColor (LightGreen);  ClrScr;

Write (Chr(TopLtCor));
for I := 2 to 79-TM*40 do Write (Chr(Across));
Write (Chr(TopRtCor));

for I := 2 to 23 do begin
GotoXY (1, I);  Write (Chr(Down));
GotoXY( 80-TM*40, I); Write (Chr(Down));
end;

GotoXY (1, 24);
Write (Chr(BotLtCor));
for I := 2 to 79-TM*40 do Write (Chr(Across));
Write (Chr(BotRtCor));

{ -- Center title on 1st line. }
TextColor (White);
GotoXY (39 -TM*20 - (Length(Title) div 2), 1);  Write (' ', Title, ' ');
end;

procedure DisplayTitlePage;
{ -- This procedure will display program name, author, date, etc. }

var
Ch: Char;

begin
DisplayBorder ('COMPUTER ORIENTED SOLUTIONS', 0);
TextColor (White);
GotoXY (39, 2);  Write ('TO');
GotoXY (32, 3);  Write ('THE RUBIK''S CUBE');

TextColor (LightCyan);
GotoXY (33, 6);  Write ('IBM Version 1.0');

TextColor (White);
GotoXY (31, 12);  Write ('Douglas E. Woolley');
TextColor (Yellow);
GotoXY (26, 13);  Write ('University of South Florida');

TextColor (LightRed);
GotoXY (34, 20);  Write ('September 1988');

TextColor (LightBlue);
GotoXY (34, 23);  Write ('Press any key');

end;

procedure DisplayMenu ({giving} var Option: Integer);
{ -- This procedure will display Menu and accept valid option. }

var
I:  Integer;
Ch: Char;

begin
DisplayBorder ('COMPUTER ORIENTED SOLUTIONS', 0);
TextColor (White);
GotoXY (39, 2);  Write ('TO');
GotoXY (32, 3);  Write ('THE RUBIK''S CUBE');

for I := 1 to LastOption do begin
TextColor (White);
GotoXY (30, 4 + I*2);  Write (I, '. ');
TextColor (Yellow);
end;

GotoXY (30, 4 + (LastOption+1)*2);
Write ('Choose:');

repeat
Option := Ord(Ch) - Ord('0');
until Option in [1 .. LastOption];
end;

procedure Beep;
{ -- This procedure makes a beep for errors. }
begin
Sound (440);
Delay (150);
NoSound;
end;


{ -- INCLUDE VALIDCOL.INC: InitValidColors,  GetValidColors }
{\$I VALIDCOL.INC}

procedure InitValidColors;
{ -- This procedure will assign 6 common colors on the Rubik's Cube
-- to the captial global variable ValidColor. }

begin
ValidColor := 'B';
ValidColor := 'G';
ValidColor := 'O';
ValidColor := 'R';
ValidColor := 'W';
ValidColor := 'Y';
end;

procedure GetValidColors;
{ -- This procedure will accept 6 valid colors to use for the cube. }

var
Side, I:  Integer;
Ch:       Char;
Valid:    Boolean;

begin

{ -- Display Instructions on entering colors. }
TextColor (LightGreen);
GotoXY (3, 5);
Write('Enter 6 unique color symbols used on');
GotoXY (3, 6);
Write ('your puzzle (');
TextColor (Yellow);      Write ('Enter');
TextColor (LightGreen);  Write (' key for default):');

{ -- Display default values. }
for Side := 1 to 6 do begin
TextColor (Yellow);
GotoXY (15, 7+Side);  Write ('Color ', Side, ': ');
TextColor (LightGray);
Write (ValidColor[Side]);
end;

{ -- Get 6 uniuqe color values; (If Enter is pressed, then default) }
for Side := 1 to 6 do begin
GotoXY (15+9, 7+Side);
TextColor (White);
repeat
Ch := UpCase(Ch);
if (Ch in ['A' .. 'Z']) or (Ord(Ch) in ) then { -- maybe valid }
begin
Valid := True;
If Ord(Ch) = 13 then  { -- Enter was pressed }
Ch := ValidColor[Side];
{ -- Check if symbol entered is a duplicate. }
for I := 1 to Side-1 do
if ValidColor[I] = Ch then
Valid := False;
end
else  { -- Character was not a letter or an Enter key. }
Valid := False;
until Valid;

ValidColor[Side] := Ch;
Write (ValidColor[Side]);
end;  { -- for Side }

GotoXY (14, 25);  TextColor (Yellow);
Write ('Press any key');
end;

procedure InitArrayOfColors;  { -- output is global array of colors. }
{ -- This procedure will set all array items to spaces for color. }

var
I: Integer;

begin
for I := 1 to 54 do begin
AInit[I] := ' ';  A[I] := ' ';
end;
end;

procedure DisplayBox ({using} Side: Integer);
{ -- This procedure displays a box for corresponding side at row,col. }

const
TopLtCor = 218;
TopRtCor = 191;
BotLtCor = 192;
BotRtCor = 217;
Down     = 179;
Across   = 196;

var
I, InitCol, InitRow:  Integer;

begin
InitCol := ColForSide[Side];
InitRow := RowForSide[Side];
GotoXY (InitCol, InitRow);  TextColor (Yellow);

{ -- Display Top line }
Write (Chr(TopLtCor));
for I := 1 to 7 do Write (Chr(Across));
Write (Chr(TopRtCor));

{ -- Display vertical lines }
for I := 1 to 5 do begin
GotoXY (InitCol,   InitRow+I);  Write (Chr(Down), ' ');
GotoXY (InitCol+8, InitRow+I);  Write (Chr(Down));
end;

{ -- Display bottom line }
GotoXY (InitCol, InitRow+6);
Write (Chr(BotLtCor));
for I := 1 to 7 do Write (Chr(Across));
Write (Chr(BotRtCor));
end;

procedure DisplayColors ({using} Side: Integer);
{ -- This procedure displays the color contents of squares on the Side. }

var
Col, Row, InitCol, InitRow, Index:  Integer;

begin
InitCol := ColForSide[Side];
InitRow := RowForSide[Side];

for Row := 1 to 3 do
for Col := 1 to 3 do begin
TextColor (White);
TextBackground (Black);
GotoXY (InitCol + Col*2, InitRow + Row*2 -1);
Index := (Side-1)*9 + (Row-1)*3 + Col;
Write (A[Index]);
end;
TextBackground (Blue);  TextColor (Yellow);
end;

procedure DisplayTextInstr;
{ -- This procedure will display commands needed for displaying the solution.}

const
RtArrow = 26;
LtArrow = 27;

begin
{ -- First command }
TextColor (Green);
GotoXY (14, 4);  Write ('Press: ');
TextColor (Yellow);
Write ('Space, ', Chr(RtArrow), ', ');
TextColor (Green);  Write ('or ');
TextColor (Yellow); Write ('Enter');

{ -- 2nd line/ 1st command. }
GotoXY (14, 5);  TextColor (LightGreen);
Write ('and perform move shown');

{ -- 3rd line/ 1st command. }
GotoXY (14, 6);
Write ('below then compare sides;');

{ -- Fourth line/ 2nd command }
TextColor (Green);
GotoXY (14, 7);  Write ('or ');
TextColor (Yellow);
Write (Chr(LtArrow));
TextColor (Green);
Write (' for previous move;');

{ -- Fifth line/ 3rd command }
GotoXY (14, 8);  Write ('or ');
TextColor (Yellow);
Write ('ESC ');
TextColor (Green);
Write ('to quit.');

end;

procedure DisplayInputInstr;
{ -- This procedure will display commands needed for inputting colors. }

const
RtArrow = 26;
LtArrow = 27;

var
I: Integer;

begin
{ -- First command }
TextColor (Green);
GotoXY (14, 4);  Write ('Press: ');
TextColor (Yellow);
for I:= 1 to 5 do
Write (ValidColor[I], ', ');
Write (ValidColor);

{ -- Second command }
TextColor (Green);
GotoXY (14, 5);  Write ('or ');
TextColor (Yellow);
Write ('Space');
TextColor (Green);
Write (' to remove entry');

{ -- Third command }
TextColor (Green);
GotoXY (14, 6);  Write ('or ');
TextColor (Yellow);
Write (Chr(RtArrow));
TextColor (Green);
Write (' for next square');

{ -- Fourth command }
GotoXY (14, 7);  Write ('or ');
TextColor (Yellow);
Write (Chr(LtArrow));
TextColor (Green);
Write (' for previous square');

{ -- Fifth command }
GotoXY (14, 8);  Write ('or ');
TextColor (Yellow);
Write ('ESC ');
TextColor (Green);
Write ('when finished.');
end;

procedure DisplayBoxes;
{ -- This procedure will display the 6 sides of the cube. }

var
Side: Integer;

begin
for Side := 1 to 6 do begin
DisplayBox (Side);
DisplayColors (Side);
end;

TextColor (LightRed);
GotoXY (2, 5);  Write ('T');
GotoXY (2, 6);  Write ('o');
GotoXY (2, 7);  Write ('p');

GotoXY (2, 11);  Write ('F');
GotoXY (2, 12);  Write ('r');
GotoXY (2, 13);  Write ('o');
GotoXY (2, 14);  Write ('n');
GotoXY (2, 15);  Write ('t');

GotoXY (2, 18);  Write ('B');
GotoXY (2, 19);  Write ('o');
GotoXY (2, 20);  Write ('t');
GotoXY (2, 21);  Write ('t');
GotoXY (2, 22);  Write ('o');
GotoXY (2, 23);  Write ('m');

GotoXY (13, 17);  Write (' Right   ', ' Back    ', ' Left');
end;

{ -- INCLUDE GETINPUT.INC  Match, InputCorrect, GetColors, GetRCInput }
{\$I GETINPUT.INC}

{ -- GETINPUT.INC }
function Match({using} Cor: String3;  A1, A2, A3: Char): {giving} Boolean;
{ -- This function returns True if Cor matches a permutation of A1,A2,A3. }

begin
if (A1+A2+A3 = Cor) or (A1+A3+A2 = Cor) or (A2+A1+A3 = Cor) or
(A2+A3+A1 = Cor) or (A3+A1+A2 = Cor) or (A3+A2+A1 = Cor) then
Match := True
else
Match := False;
end;

function InputCorrect: {giving} Boolean;
{ -- This function will output True if 12 unique edges and 8 unique corners
-- are entered with 6 unique middle squares on the 6 sides. }

var
Side, I, J: Integer;
Colr:       Array[1..6]  of Char;
Edge:       Array[1..12] of String;
Corn:       Array[1..8]  of String3;
EdgeHere:   Array[1..12] of Boolean;
CornHere:   Array[1..8]  of Boolean;

begin
InputCorrect := True;
for Side := 1 to 6 do
Colr[Side] := A[Side*9-4];

for I := 1 to 5 do
for J := I+1 to 6 do
if Colr[I] = Colr[J] then begin
InputCorrect := False;
Exit;
end;

{ -- All the possible Edge combinations with the unique mid squares. }
Edge := Colr + Colr;  Edge := Colr + Colr;
Edge := Colr + Colr;  Edge := Colr + Colr;
Edge := Colr + Colr;  Edge := Colr + Colr;
Edge := Colr + Colr;  Edge := Colr + Colr;
Edge := Colr + Colr;  Edge:= Colr + Colr;
Edge:= Colr + Colr;  Edge:= Colr + Colr;

{ -- All the possible Corner combinations with the unique mid squares. }
Corn := Colr + Colr + Colr;
Corn := Colr + Colr + Colr;
Corn := Colr + Colr + Colr;
Corn := Colr + Colr + Colr;
Corn := Colr + Colr + Colr;
Corn := Colr + Colr + Colr;
Corn := Colr + Colr + Colr;
Corn := Colr + Colr + Colr;

{ -- Check if any valid edge pieces are missing or duplicated. }
for I := 1 to 12 do begin
EdgeHere[I] := False;
if (A+A = Edge[I]) or (A+A = Edge[I]) then
if EdgeHere[I] then begin InputCorrect := False;  Exit;  end
else EdgeHere[I] := True;

if (A+A = Edge[I]) or (A+A = Edge[I]) then
if EdgeHere[I] then begin InputCorrect := False;  Exit;  end
else EdgeHere[I] := True;

if (A+A = Edge[I]) or (A+A = Edge[I]) then
If EdgeHere[I] then begin InputCorrect := False;  Exit;  end
else EdgeHere[I] := True;

if (A+A = Edge[I]) or (A+A = Edge[I]) then
If EdgeHere[I] then begin InputCorrect := False;  Exit;  end
else EdgeHere[I] := True;

if (A+A = Edge[I]) or (A+A = Edge[I]) then
If EdgeHere[I] then begin InputCorrect := False;  Exit;  end
else EdgeHere[I] := True;

if (A+A = Edge[I]) or (A+A = Edge[I]) then
If EdgeHere[I] then begin InputCorrect := False;  Exit;  end
else EdgeHere[I] := True;

if (A+A = Edge[I]) or (A+A = Edge[I]) then
If EdgeHere[I] then begin InputCorrect := False;  Exit;  end
else EdgeHere[I] := True;

if (A+A = Edge[I]) or (A+A = Edge[I]) then
If EdgeHere[I] then begin InputCorrect := False;  Exit;  end
else EdgeHere[I] := True;

if (A+A = Edge[I]) or (A+A = Edge[I]) then
If EdgeHere[I] then begin InputCorrect := False;  Exit;  end
else EdgeHere[I] := True;

if (A+A = Edge[I]) or (A+A = Edge[I]) then
If EdgeHere[I] then begin InputCorrect := False;  Exit;  end
else EdgeHere[I] := True;

if (A+A = Edge[I]) or (A+A = Edge[I]) then
If EdgeHere[I] then begin InputCorrect := False;  Exit;  end
else EdgeHere[I] := True;

if (A+A = Edge[I]) or (A+A = Edge[I]) then
If EdgeHere[I] then begin InputCorrect := False;  Exit;  end
else EdgeHere[I] := True;

If not EdgeHere[I] then  { -- This Edge[I] does not exist. }
begin InputCorrect := False;  Exit;  end
end; { -- for I }

{ -- Check if any valid corner pieces are missing or duplicated. }
for I := 1 to 8 do begin
CornHere[I] := False;
if Match(Corn[I], A, A, A) then
if CornHere[I] then begin InputCorrect := False;  Exit;  end
else CornHere[I] := True;

if Match(Corn[I], A, A, A) then
if CornHere[I] then begin InputCorrect := False;  Exit;  end
else CornHere[I] := True;

if Match(Corn[I], A, A, A) then
if CornHere[I] then begin InputCorrect := False;  Exit;  end
else CornHere[I] := True;

if Match(Corn[I], A, A, A) then
if CornHere[I] then begin InputCorrect := False;  Exit;  end
else CornHere[I] := True;

if Match(Corn[I], A, A, A) then
if CornHere[I] then begin InputCorrect := False;  Exit;  end
else CornHere[I] := True;

if Match(Corn[I], A, A, A) then
if CornHere[I] then begin InputCorrect := False;  Exit;  end
else CornHere[I] := True;

if Match(Corn[I], A, A, A) then
if CornHere[I] then begin InputCorrect := False;  Exit;  end
else CornHere[I] := True;

if Match(Corn[I], A, A, A) then
if CornHere[I] then begin InputCorrect := False;  Exit;  end
else CornHere[I] := True;

If not CornHere[I] then  { -- This Corn[I] does not exist. }
InputCorrect := False;

end; { -- for I }
end;

procedure GetColors;
{ -- This procedure gets the color of squares on each Side.
-- Output: AInit[1..54] are assigned;  InputCorrect is True or False. }

const
ESC     = 27;
LtArr   = 75;
RtArr   = 77;
LtArrSh = 52;  { -- Shifted left arrow }
RtArrSh = 54;  { -- Shifted right arrow }
Space   = 32;

var
Col, Row, InitCol,
InitRow, Index, Side, I:  Integer;
ColorIndex, Col2Index:    Integer;
TotalNumOfCol:            Integer;
Ch:                       Char;
ValidColr, ValidCommand:  Boolean;
NumOfEachColor:           Array [1..6] of Integer;
ColorSymbols:             String;
ESCPressed:               Boolean;
RightInput:               Boolean;

begin
{ -- Initialize variables }
Side := 1;  Row := 1;  Col := 1; ColorSymbols := '';
for I := 1 to 6 do begin
NumOfEachColor[I] := 0;
ColorSymbols := ColorSymbols + ValidColor[I];
end;

repeat
InitCol := ColForSide[Side];
InitRow := RowForSide[Side];

TextColor (White);
TextBackground (Black);
GotoXY (InitCol + Col*2, InitRow + Row*2 -1);

{ -- Get valid command: Color, Space, ESC, Left Arrow, or Right Arrow. }
repeat
Ch := UpCase(Ch);
ValidColr := False;  { -- Initially not a Color symbol }
if keypressed then
else begin
ColorIndex := Pos(Ch, ColorSymbols);
if ColorIndex > 0 then
if NumOfEachColor[ColorIndex] + 1 <= 9 then
{ -- No more than 9 squares for a unique color. }
ValidColr := True;
end;

ValidCommand:=(Ord(Ch) in [ESC, LtArr, RtArr, LtArrSh, RtArrSh, Space]);
if not (ValidColr or ValidCommand) then beep; { -- Make beep for error}
until ValidColr or ValidCommand;

If ValidColr or (Ord(Ch) = Space) then  { -- Store Character color symbol}
begin
Index := (Side-1)*9 + (Row-1)*3 + Col;
Col2Index := Pos (AInit[Index], ColorSymbols);
if Col2Index > 0 then  { -- Remove old color and replace with new }
NumOfEachColor[Col2Index] := NumOfEachColor[Col2Index] - 1;
AInit[Index] := Ch;  A[Index] := Ch;
Write (AInit[Index]);
if ValidColr then
NumOfEachColor[ColorIndex] := NumOfEachColor[ColorIndex] + 1;
end
else if Ord(Ch) in [LtArr, LtArrSh] then  { -- Move to previous space }
begin
Col := Col - 1;
If Col < 1 then begin
Col := 3;
Row := Row - 1;
if Row < 1 then begin
Row := 3;
Side := Side - 1;
if Side < 1 then Side := 6;
end;
end;
end;

{ -- Increment pointer to next square on cube. }
if ValidColr or (Ord(Ch) in [RtArr, RtArrSh, Space]) then begin
Col := Col + 1;
If Col > 3 then begin
Col := 1;
Row := Row + 1;
if Row > 3 then begin
Row := 1;
Side := Side + 1;
if Side > 6 then Side := 1;
end;
end;
end;

ESCPressed := Ord(Ch) = ESC;
if ESCPressed then begin  { -- Quit if input correct, else re-try? }
TextBackground (Blue);  TextColor (Yellow);
TotalNumOfCol := 0;
for I := 1 to 6 do
TotalNumOfCol := TotalNumOfCol + NumOfEachColor[I];

RightInput := InputCorrect;  { -- Function checks for each edge/corn. }
if (TotalNumOfCol <> 6*9)    { -- 54 colors were not entered. }
or not RightInput then begin
Beep;
GotoXY (2, 25);
if (TotalNumOfCol <> 6*9) then  { -- not all colors entered. }
Write ('Input is incomplete. Try again? (Y/N)')
else  { -- A corner or edge was missing or duplicated. }
Write ('A side is incorrect. Try again? (Y/N)');
repeat
Read (Kbd, Ch);  Ch := UpCase (Ch);
until Ch in ['Y', 'N'];
if Ch = 'N' then
CorrectInput := False
else begin
GotoXY (2,25);
for I := 1 to 38 do Write (' ');
end;
end;
end;
until ESCPressed and (Ch <> 'Y');
end;

procedure GetRCInput;
{ -- This procedure will assign colors to array variables for Rubik's Cube. }

var
I: Integer;

begin
DisplayBorder ('Input Colors on Rubik''s Cube', 1);
InitArrayOfColors;
DisplayBoxes;
DisplayInputInstr;
CorrectInput := True;  { -- Assume that colors gotten in input will be good}
GetColors;  { -- CorrectInput will be False if colors were not input right.}
if CorrectInput then  { -- Duplicate initial colors to current color array.}
for I := 1 to 54 do
A[I] := AInit[I];
end;

{ -- ************  Computer Coded Solution  **************** }

procedure MoveSide ({given} SideToMove: String1;  NumOfRot: Integer);
{ -- This procedure will turn Side a total of NumOfRot rotations clockwise. }

var
Side, RotNum:  Integer;
I, X, Y:       Integer;
Temp:          Char;

begin
Side := Pos(SideToMove, 'TFRPLB');

for RotNum := 1 to NumOfRot do begin
I := (Side - 1) * 9;
Temp := A[I+7];  A[I+7] := A[I+9];  A[I+9] := A[I+3];
A[I+3] := A[I+1];  A[I+1] := Temp;
Temp := A[I+4];  A[I+4] := A[I+8];  A[I+8] := A[I+6];
A[I+6] := A[I+2];  A[I+2] := Temp;
end;

case SideToMove of
'T':  for RotNum := 1 to NumOfRot do
for I := 0 to 2 do begin
Temp := A[30-I];  A[30-I] := A[39-I];  A[39-I] := A[12-I];
A[12-I] := A[21-I];  A[21-I] := Temp;
end;

'F':  for RotNum := 1 to NumOfRot do begin
X := 0;  Y := 0;
for I := 7 to 9 do begin
Temp := A[I];  A[I] := A[45-Y];  A[45-Y] := A[48-X];
A[48-X] := A[19+Y];  A[19+Y] := Temp;
X := X+1;  Y := Y+3;
end;
end;

'R':  for RotNum := 1 to NumOfRot do begin
X := 0;
for I := 0 to 2 do begin
X := X+3;  Y := X-3;
Temp := A[X];  A[X] := A[12+Y];  A[12+Y] := A[48+Y];
A[48+Y] := A[34-Y];  A[34-Y] := Temp;
end;
end;

'L':  for RotNum := 1 to NumOfRot do begin
X := 1;  Y := 0;
for I := 0 to 2 do begin
Temp := A[X];  A[X] := A[36-Y];  A[36-Y] := A[46+Y];
A[46+Y] := A[10+Y];  A[10+Y] := Temp;
X := X+3;  Y := Y+3;
end;
end;

'B':  for RotNum := 1 to NumOfRot do
for I := 0 to 2 do begin
Temp := A[16+I];  A[16+I] := A[43+I];  A[43+I] := A[34+I];
A[34+I] := A[25+I];  A[25+I] := Temp;
end;

end; { -- case }
end;

procedure MakeMove ({using} NextMove: String3);
{ -- This procedure will process one move by swapping the A array
-- corresponding to the Side being moved. }

var
SideToMove:        String1;
Rotation:          String1;
MoveIsNotRC:       Boolean;
NumOfRot, RotNum:  Integer;
I, X, Y:           Integer;
Temp:              Char;
Side:              Integer;
Ch:                Char;

begin
SideToMove  := Copy(NextMove, 1, 1);
Rotation    := Copy(NextMove, 2, 1);
MoveIsNotRC := True;
if Rotation  = 'C' then begin  { -- Move is TurnCube + Rotation }
MoveIsNotRC := False;
Rotation := Copy (NextMove, 3, 1);
end;
NumOfRot := Pos(Rotation, '+2-');  { -- Rotation symbol translated to 1,2,3}

if MoveIsNotRC then  { -- Move is T, F, R, L, or B followed by a +, 2, - }
MoveSide (SideToMove, NumOfRot)
else  { -- Rotate Cube clockwise with respect to Top for each NumOfRot. }
begin
MoveSide ('T', NumOfRot);    { -- Rotate Top Layer of Cube. }
MoveSide ('B', 4-NumOfRot);  { -- Rotate Bottom Layer of Cube. }
{ -- Rotate middle layer of cube. }
for RotNum := 1 to NumOfRot do
for I := 0 to 2 do begin
Temp := A[13+I];  A[13+I] := A[22+I];  A[22+I] := A[31+I];
A[31+I] := A[40+I];  A[40+I] := Temp;
end;
end;

{ -- Display next move and display colors ONLY DURING DEBUGGING. }
{ TextColor (Yellow);  GotoXY (30,20);  Write (NextMove);
for Side := 1 to 6 do
DisplayColors (Side);
Read (Kbd, Ch); }
end;

procedure Combine ({using} FirstMove: String3);
{ -- This procedure will add the first move to the Solution array, compacting}

var
LastMove:             String3;
SideToMove:           String1;
Rotation:             String1;
MoveIsNotRC:          Boolean;
SideToMove2:          String1;
Rotation2:            String1;
Move2IsNotRC:         Boolean;
NumOfRot, NumOfRot2:  Integer;
RotNum, I:            Integer;

begin
SideToMove  := Copy(FirstMove, 1, 1);
Rotation    := Copy(FirstMove, 2, 1);
MoveIsNotRC := True;
if Rotation  = 'C' then begin  { -- Move is TurnCube + Rotation }
MoveIsNotRC := False;
Rotation := Copy (FirstMove, 3, 1);
end;
NumOfRot := Pos(Rotation, '+2-');  { -- Rotation symbol translated 1,2,3}

LastMove    := Solution[LastSolIndex];
SideToMove2 := Copy(LastMove, 1, 1);
Rotation2   := Copy(LastMove, 2, 1);
Move2IsNotRC:= True;
if Rotation2 = 'C' then begin  { -- Move is TurnCube + Rotation }
Move2IsNotRC := False;
Rotation2 := Copy (LastMove, 3, 1);
end;
NumOfRot2 := Pos(Rotation2, '+2-');  {-- Rotation symbol becomes 1,2,3}

if (SideToMove = SideToMove2) and (MoveIsNotRC = Move2IsNotRC) then
{ -- Since last move = this move, combine rotations into 1 rotation. }
begin
RotNum := (NumOfRot + NumOfRot2) mod 4;
if RotNum = 0 then  { -- 2 rotations combined is = no turn.}
LastSolIndex := LastSolIndex - 1
else begin  { -- Change the rotation }
if MoveIsNotRC then I := 2
else I := 3;
Solution[LastSolIndex] := Copy(Solution[LastSolIndex], 1, I-1) +
Copy('+2-', RotNum, 1) + ' ';
end;  { -- if RotNum else }
end  { -- if SideToMove }

else begin  { -- store unique next move. }
LastSolIndex := LastSolIndex + 1;
Solution[LastSolIndex] := FirstMove;
end;  { -- else SideToMove }

end;

procedure AddToSolution ({using} SetOfMoves: String60);
{ -- This procedure will first internally move the cube as directed, then
-- Add the set of moves to the entire Solution array, with compacting. }

var
StartOfMove:          Integer;
FirstMove, NextMove:  String3;

begin
{ -- Get First move and process it. }
FirstMove := Copy(SetOfMoves, 1, 3);
MakeMove (FirstMove);

{ -- Add First move to Solution array:  Combine if same as previous move. }
if LastSolIndex > 0 then  { -- Check if last move = this move, and combine.}
Combine (FirstMove)
else begin         { -- LastSolIndex = 0 so automatically store next move. }
LastSolIndex := LastSolIndex + 1;
Solution[LastSolIndex] := FirstMove;
end;  { -- if else LastSolIndex > 0}

{ -- Partition and process each move in SetOfMoves after the first. }
StartOfMove := 4;
while StartOfMove < Length(SetOfMoves) do begin
NextMove := Copy(SetOfMoves, StartOfMove, 3);
LastSolIndex := LastSolIndex + 1;
Solution[LastSolIndex] := NextMove;
MakeMove (NextMove);
StartOfMove := StartOfMove + 3;  { -- Starting position of next move. }
end;

end;

procedure ErrorInMoves;
{ -- This procedure will display an error message about the solution. }

var
Ch: Char;

begin
TextColor (LightGray);  Beep;
GotoXY (13, 19);  Write ('An error has been detected.');
GotoXY (13, 20);  Write ('Possibly, you have an im-');
GotoXY (13, 21);  Write ('possible cube.');
TextColor (Yellow);
GotoXY (13, 22);  Write ('      Press any key');
Window (13, 19, 39, 23);  ClrScr;
Window (1, 1, 80, 25);
end;

{ -- INCLUDE SOLUTION.INC SolveTopEdges, SolveTopCorners, SolveVerticalEdges,
SolveBottomCorners, SolveBottomEdges }
{\$I SOLUTION.INC}

{ -- SOLUTION.INC}
procedure SolveTopEdges ({giving} var MoveError: Boolean);
{ -- This procedure will store the moves in Solution to restore top edges. }
{ -- Strategy: Work on front-top edge then rotate cube to next face. }

var
Face:        Integer;
Tmid, Fmid:  Char;

begin
for Face := 1 to 4 do begin
Tmid := A;   { -- Has Color symbol of Top middle square. }
Fmid := A;  { -- Has color symbol of Front middle square. }

if (A = Fmid) and (A = Tmid) then  { -- Orient FT }
AddToSolution ('F+ T- R+ T+ ')

else if (A = Fmid) and (A = Tmid) then  { -- Move RT to FT }
AddToSolution ('R- F- ')
else if (A = Tmid) and (A = Fmid) then  { -- Move RT to FT }
AddToSolution ('R- T- R+ T+ ')

else if (A = Fmid) and (A = Tmid) then  { -- Move PT to FT }
AddToSolution ('T+ R- T- F- ')
else if (A = Tmid) and (A = Fmid) then  { -- Move PT to FT }
AddToSolution ('T+ R2 T- B- F2 ')

else if (A = Fmid) and (A = Tmid) then  { -- Move LT to FT }
AddToSolution ('L+ F+ ')
else if (A = Tmid) and (A = Fmid) then  { -- Move LT to FT }
AddToSolution ('L2 B+ F2 ')

else if (A = Fmid) and (A = Tmid) then  { -- Move FR to FT }
else if (A = Tmid) and (A = Fmid) then  { -- Move FR to FT }
AddToSolution ('R- B- R+ F2 ')

else if (A = Fmid) and (A = Tmid) then  { -- Move PR to FT }
AddToSolution ('R+ B- R- F2 ')
else if (A = Tmid) and (A = Fmid) then  { -- Move PR to FT }
AddToSolution ('R2 F- R2 ')

else if (A = Fmid) and (A = Tmid) then  { -- Move LP to FT }
AddToSolution ('L2 F+ L2 ')
else if (A = Tmid) and (A = Fmid) then  { -- Move LP to FT }
AddToSolution ('L- B+ L+ F2 ')

else if (A = Fmid) and (A = Tmid) then  { -- Move FL to FT }
else if (A = Tmid) and (A = Fmid) then  { -- Move FL to FT }
AddToSolution ('T+ L- T- ')

else if (A = Fmid) and (A = Tmid) then  { -- Move BF to FT }
else if (A = Tmid) and (A = Fmid) then  { -- Move BF to FT }
AddToSolution ('F+ T+ L- T- ')

else if (A = Fmid) and (A = Tmid) then  { -- Move BR to FT }
AddToSolution ('B- F2 ')
else if (A = Tmid) and (A = Fmid) then  { -- Move BR to FT }
AddToSolution ('R+ F- R- ')

else if (A = Fmid) and (A = Tmid) then  { -- Move BP to FT }
AddToSolution ('B2 F2 ')
else if (A = Tmid) and (A = Fmid) then  { -- Move BP to FT }
AddToSolution ('B+ L- F+ L+ ')

else if (A = Fmid) and (A = Tmid) then  { -- Move BL to FT }
AddToSolution ('B+ F2 ')
else if (A = Tmid) and (A = Fmid) then  { -- Move BL to FT }
AddToSolution ('L- F+ L+ ');

if (A = Tmid) and (A = Fmid) and (Face < 4) then  { --Rotate Cube }
else If (A<>Tmid) or (A<>Fmid) then begin  { -- Fatal error }
ErrorInMoves;  MoveError := True;  Exit;  end;
end;  { -- for Face }
end;

procedure SolveTopCorners ({giving} var MoveError: Boolean);
{ -- This procedure will store the moves in Solution to restore top corners. }
{ -- Strategy: Work on front-right-top corner then rotate cube to next face. }

var
Face:        Integer;
Tmid, Fmid:  Char;

begin
for Face := 1 to 4 do begin
Tmid := A;   { -- Has Color symbol of Top middle square. }
Fmid := A;  { -- Has color symbol of Front middle square. }

if (A = Fmid) and (A = Tmid) then        { -- Orient FRT }
AddToSolution ('R- B2 R+ F+ B2 F- ')
else if (A = Tmid) and (A = Fmid) then  { -- Orient FRT }
AddToSolution ('F+ B2 F- R- B2 R+ ')

else if (A = Tmid) and (A = Fmid) then   { -- Move PRT to FRT }
AddToSolution ('R+ B+ R- F+ B2 F- ')
else if (A = Fmid) and (A = Tmid) then   { -- Move PRT to FRT }
AddToSolution ('R+ B- R- F+ B- F- ')
else if (A = Tmid) and (A = Fmid) then  { -- Move PRT to FRT }
AddToSolution ('R+ B2 R2 B+ R+ ')

else if (A = Tmid) and (A = Fmid) then   { -- Move PLT to FRT }
AddToSolution ('L- B2 L+ B- R- B+ R+ ')
else if (A = Tmid) and (A = Fmid) then  { -- Move PLT to FRT }
AddToSolution ('L- B+ L+ R- B2 R+ ')
else if (A = Fmid) and (A = Tmid) then   { -- Move PLT to FRT }
AddToSolution ('L- B- L+ F+ B- F- ')

else if (A = Tmid) and (A = Fmid) then   { -- Move FLT to FRT }
AddToSolution ('L+ B2 L- F+ B- F- ')
else if (A = Fmid) and (A = Tmid) then  { -- Move FLT to FRT }
AddToSolution ('L+ R- B+ L- R+ ')
else if (A = Fmid) and (A = Tmid) then   { -- Move FLT to FRT }
AddToSolution ('F- B2 F2 B- F- ')

else if (A = Tmid) and (A = Fmid) then  { -- Move FRB to FRT }
AddToSolution ('F+ B+ F- ')
else if (A = Fmid) and (A = Tmid) then  { -- Move FRB to FRT }
AddToSolution ('R- B+ R+ F+ B2 F- ')
else if (A = Fmid) and (A = Tmid) then  { -- Move FRB to FRT }
AddToSolution ('R- B- R+ ')

else if (A = Fmid) and (A = Tmid) then  { -- Move PRB to FRT }
AddToSolution ('F+ B- F- ')
else if (A = Tmid) and (A = Fmid) then  { -- Move PRB to FRT }
AddToSolution ('B2 R- B+ R+ ')
else if (A = Fmid) and (A = Tmid) then  { -- Move PRB to FRT }
AddToSolution ('B- R- B+ R+ F+ B2 F- ')

else if (A = Tmid) and (A = Fmid) then  { -- Move PLB to FRT }
AddToSolution ('R- B2 R+ ')
else if (A = Fmid) and (A = Tmid) then  { -- Move PLB to FRT }
AddToSolution ('F+ B2 F- ')
else if (A = Fmid) and (A = Tmid) then  { -- Move PLB to FRT }
AddToSolution ('B2 R- B+ R+ F+ B2 F- ')

else if (A = Tmid) and (A = Fmid) then  { -- Move FLB to FRT }
AddToSolution ('R- B+ R+ ')
else if (A = Tmid) and (A = Fmid) then  { -- Move FLB to FRT }
AddToSolution ('B2 F+ B- F- ')
else if (A = Fmid) and (A = Tmid) then  { -- Move FLB to FRT }
AddToSolution ('B+ R- B+ R+ F+ B2 F- ');

if (A = Tmid) and (A = Fmid) and (Face < 4) then { --Rotate Cube }
else if (A<>Tmid) or (A<>Fmid) then begin  { -- Fatal error }
ErrorInMoves;  MoveError := True;  Exit;  end;
end;  { -- for Face }
end;

procedure SolveVerticalEdges ({giving} var MoveError: Boolean);
{ -- This procedure will store the moves in Solution to restore vert. edges. }
{ -- Strategy: Work on front-right edge then rotate cube to next face. }

var
Face:        Integer;
Fmid, Rmid:  Char;

begin
for Face := 1 to 4 do begin
Fmid := A;  { -- Has color symbol of Front middle square. }
Rmid := A;  { -- Has color symbol of Right middle square. }

if (A = Rmid) and (A = Fmid) then        { -- Orient FR }
AddToSolution ('R- B+ R+ B+ F+ B- F- B+ R- B+ R+ B+ F+ B- F- ')

else if (A = Fmid) and (A = Rmid) then  { -- Move PR to FR }
AddToSolution ('RC+R- B+ R+ B+ F+ B- F- RC-B- F+ B- F- B- R- B+ R+ ')
else if (A = Rmid) and (A = Fmid) then  { -- Move PR to FR }
AddToSolution ('RC+R- B+ R+ B+ F+ B- F- RC-R- B+ R+ B+ F+ B- F- ')

else if (A = Fmid) and (A = Rmid) then  { -- Move PL to FR }
AddToSolution ('RC2R- B+ R+ B+ F+ B- F- RC2B2 F+ B- F- B- R- B+ R+ ')
else if (A = Rmid) and (A = Fmid) then  { -- Move PL to FR }
AddToSolution ('RC2R- B+ R+ B+ F+ B- F- RC2B- R- B+ R+ B+ F+ B- F- ')

else if (A = Fmid) and (A = Rmid) then  { -- Move FL to FR }
AddToSolution ('RC-R- B+ R+ B+ F+ B- F- RC+B2 R- B+ R+ B+ F+ B- F- ')
else if (A = Rmid) and (A = Fmid) then  { -- Move FL to FR }
AddToSolution ('RC-R- B+ R+ B+ F+ B- F- RC+B+ F+ B- F- B- R- B+ R+ ')

else if (A = Fmid) and (A = Rmid) then  { -- Move FB to FR }
AddToSolution ('B- R- B+ R+ B+ F+ B- F- ')
else if (A = Rmid) and (A = Fmid) then  { -- Move FB to FR }
AddToSolution ('B2 F+ B- F- B- R- B+ R+ ')

else if (A = Rmid) and (A = Fmid) then  { -- Move RB to FR }
AddToSolution ('B+ F+ B- F- B- R- B+ R+ ')
else if (A = Fmid) and (A = Rmid) then  { -- Move RB to FR }
AddToSolution ('B2 R- B+ R+ B+ F+ B- F- ')

else if (A = Fmid) and (A = Rmid) then  { -- Move PB to FR }
AddToSolution ('B+ R- B+ R+ B+ F+ B- F- ')
else if (A = Rmid) and (A = Fmid) then  { -- Move PB to FR }
AddToSolution ('F+ B- F- B- R- B+ R+ ')

else if (A = Fmid) and (A = Rmid) then  { -- Move LB to FR }
AddToSolution ('R- B+ R+ B+ F+ B- F- ')
else if (A = Rmid) and (A = Fmid) then  { -- Move LB to FR }
AddToSolution ('B- F+ B- F- B- R- B+ R+ ');

if (A = Fmid) and (A = Rmid) and (Face < 4) then { --Rotate Cube }
else if (A<>Fmid) or (A<>Rmid) then begin  { -- Fatal error }
ErrorInMoves;  MoveError := True;  Exit;  end;
end;

end;

procedure SolveBottomCorners ({giving} var MoveError: Boolean);
{ -- This procedure will store the moves in Solution to restore bot corners. }
{ -- Strategy: First "position" all 4 corners, then "orient" 4 corners. }

var
Face:                         Integer;
Fmid, Rmid, Pmid, Lmid, Bmid: Char;
BFL,  BFR,  BPR,  BLP:        Boolean;  { -- True if this corner exists. }
All4Positioned, All4Oriented: Boolean;

begin
{ -- ******************    Position all 4 corners    *************** }
Face := 1;
repeat
If Face > 4 then begin  { -- Fatal error }
ErrorInMoves;  MoveError := True;  Exit;  end;
Fmid := A;  Rmid := A;  Pmid := A;  Lmid := A;

{ -- Determine which of the 4 Bottom corners exist (= True). }
BFL := ((A = Fmid) and (A = Lmid)) or
((A = Lmid) and (A = Fmid)) or
((A = Fmid) and (A = Lmid));
BFR := ((A = Fmid) and (A = Rmid)) or
((A = Rmid) and (A = Fmid)) or
((A = Fmid) and (A = Rmid));
BPR := ((A = Rmid) and (A = Pmid)) or
((A = Rmid) and (A = Pmid)) or
((A = Pmid) and (A = Rmid));
BLP := ((A = Pmid) and (A = Lmid)) or
((A = Lmid) and (A = Pmid)) or
((A = Pmid) and (A = Lmid));

All4Positioned := True;  { -- Will be after this set, unless no matches. }
if (BFL and BFR) or (BFR and BPR) or (BPR and BLP) or (BLP and BFL) then
{ -- Either all 4 match, or only 2 corners match. }
if not (BFL and BFR and BPR and BLP) then  { -- only 2 corners match }
begin
if (BFL and BFR) then
else if (BFR and BPR) then
else if (BLP and BFL) then
{ -- Exchange adjacent sides BFL and BFR, which are out of place. }
AddToSolution ('R- B- R+ F+ B+ F- R- B+ R+ B2 ');
end
else  { -- null else- since all 4 match, skip to next section. }

else if (BFL and BPR) or (BFR and BLP) then  {--Pair of diagonals match. }
begin
{ -- Exchange diagonals BFL and BPL}
AddToSolution ('F- B- R- B+ R+ F+ ');
{ -- Turn Bottom one rotation left or right to match all 4 corners. }
if (BFL and BPR) then
else
end

else  { -- No matches found with current Bottom rotation, try another. }
begin
AddToSolution ('B+ ');  All4Positioned := False;
end;

Face := Face + 1;
until All4Positioned;

{ -- ******************  Orient 4 corners  ****************** }
{ -- Rotate Cube until 1 of 7 patterns appear, or all 4 are oriented. }
{ -- Perform set of moves.  If pattern is BC1 or BC2, cube is oriented. }

All4Oriented := False;  Face := 1;
repeat
If Face > 4 then begin { -- Fatal error, Pattern not found after 4 turns.}
ErrorInMoves;  MoveError := True;  Exit;  end;

Bmid := A;
if (A = Bmid) and (A = Bmid) and (A = Bmid) and (A = Bmid)
then All4Oriented := True
else
if (A = Bmid) and (A = Bmid) and (A = Bmid) and (A = Bmid)
then begin  { -- BC2 pattern }
AddToSolution ('B2 R- B2 R+ B+ R- B+ R+ ');  Face := 1;
end
else  { -- 6 other patterns possible if the cube is at proper rotation. }
if (A = Bmid) and (A = Bmid) and (A = Bmid) and (A = Bmid)
or (A = Bmid) and (A = Bmid) and (A = Bmid) and (A = Bmid)
or (A = Bmid) and (A = Bmid) and (A = Bmid) and (A = Bmid)
or (A = Bmid) and (A = Bmid) and (A = Bmid) and (A = Bmid)
or (A = Bmid) and (A = Bmid) and (A = Bmid) and (A = Bmid)
or (A = Bmid) and (A = Bmid) and (A = Bmid) and (A = Bmid)
then begin  { -- BC1 or BC3 or BC4 or BC5 or BC6 or BC7 pattern. }
AddToSolution ('R- B- R+ B- R- B2 R+ B2 ');  Face := 1;
end
else begin  { -- Cube is not yet at proper rotation to match a pattern. }
AddToSolution ('RC+');  Face := Face + 1;
end;
until All4Oriented;
end;

procedure SolveBottomEdges ({giving} var MoveError: Boolean);
{ -- This procedure will store the moves in Solution to restore bot edges. }
{ -- Strategy: First "position" all 4 edges, then "orient" the 4 edges. }

var
Face:                         Integer;
Fmid, Rmid, Pmid, Lmid, Bmid: Char;
BF,   BR,   BP,   BL:         Boolean;  { -- True if this corner exists. }
All4Positioned, All4Oriented: Boolean;
Pattern1, Pattern2, Pattern3: Boolean;

begin
{ -- ******************    Position all 4 edges    *************** }

All4Positioned := False;  Face := 1;
repeat
If Face > 4 then begin  { -- Fatal error }
ErrorInMoves;  MoveError := True;  Exit;  end;
Fmid := A;  Rmid := A;  Pmid := A;  Lmid := A;

{ -- Determine which of the 4 Bottom edges are positioned (= True). }
BF := (A = Fmid) or (A = Fmid);
BR := (A = Rmid) or (A = Rmid);
BP := (A = Pmid) or (A = Pmid);
BL := (A = Lmid) or (A = Lmid);

if BF and BR and BP and BL then  { -- All 4 edges are positioned. }
All4Positioned := True
else  { -- 0 or 1 egde is positioned.  There are 2 ways to position them.}
begin
if BR then AddToSolution ('RC+')
else if BP then AddToSolution ('RC2')
else if BL then AddToSolution ('RC-');
{ -- if 1 edge correctly positioned then it is in the BF position. }

Lmid := A;  { -- Cube may have rotated and changed colors. }
if (BF or BR or BP or BL) and ((A = Lmid) or (A = Lmid)) then
{ -- Permute 3 bottom edges:  BR -> BL -> BP -> BR }
AddToSolution ('L- R+ F- L+ R- B2 L- R+ F- L+ R- ')

else  { -- Either 0 edges positioned, or 3 non-positioned need this. }
{ -- Permute 3 bottom edges:  BR -> BP -> BL -> BR }
AddToSolution ('L- R+ F+ L+ R- B2 L- R+ F+ L+ R- ');
end;
Face := Face + 1;
until All4Positioned;

{ -- ******************  Orient 4 edges  ****************** }
{ -- Rotate Cube until 1 of 7 patterns appear, or all 4 are oriented. }
{ -- Perform set of moves.  If pattern is BC1 or BC2, cube is oriented. }

Bmid := A;
{ -- Check if all edges are oriented. }
All4Oriented := (A + A + A + A) = (Bmid+ Bmid+ Bmid+ Bmid);

if not All4Oriented then begin  { -- Edges will be in 1 of 3 patterns. }
Pattern1 := (A <> Bmid) and (A <> Bmid) and
(A <> Bmid) and (A <> Bmid);
Pattern2 := (A =  Bmid) and (A = Bmid)  or
(A =  Bmid) and (A = Bmid);
Pattern3 := (A =  Bmid) and (A = Bmid)  or
(A =  Bmid) and (A = Bmid)  or
(A =  Bmid) and (A = Bmid)  or
(A =  Bmid) and (A = Bmid);

if Pattern1 then  { -- Permute each edge (swap the colors on each) }
AddToSolution('L- R+ F2 L+ R- B2 L- R+ F+ L+ R- B2 L- R+ F2 L+ R- B- ')

else if Pattern2 then begin  { -- Permute edges across from each other. }
if (A =  Bmid) and (A = Bmid) then  { -- Rotate Cube }
AddToSolution('L- R+ F+ L+ R- B+ L- R+ F+ L+ R- B+ L- R+ F2 L+ R- B+ ');
AddToSolution('L- R+ F+ L+ R- B+ L- R+ F+ L+ R- B2 ');
end

else if Pattern3 then begin  { -- 4 possible orientations, Rotate cube. }
if (A =  Bmid) and (A = Bmid) then
else if (A =  Bmid) and (A = Bmid) then
else if (A =  Bmid) and (A = Bmid) then
{ -- Rotate BP -> BF -> BL -> BP, then orient 3 edges. }
AddToSolution ('L- R+ F+ L+ R- B- L- R+ F- L+ R- B- L- R+ F2 L+ R- ');
AddToSolution ('RC+L- R+ F+ L+ R- B2 L- R+ F+ L+ R- ');
end

else begin  { -- Fatal error, none of the patterns were detected. }
ErrorInMoves;  MoveError := True;  Exit;  end;
end; { -- If not All4Oriented }
end;

function CubeIsSolved: Boolean;
{ -- This function returns True if each side has 9 squares of the same color.}

var
Side, I: Integer;

begin
CubeIsSolved := True;
for Side := 1 to 6 do
for I := 1 to 8 do
if A[(Side-1)*9 + I] <> A[(Side-1)*9 + I+1] then
CubeIsSolved := False;
end;

procedure GetRCSolution ({using/giving} var MoveError: Boolean);
{ -- This procedure will store all the moves to restore the puzzle in the
-- array Solution[1..200] of string, with Solution[LastSolIndex]
-- having the last move of the solution. }

var
I:          Integer;
Ch:         Char;

begin
LastSolIndex := 0;    { -- No solution has been stored yet. }
MoveError := False;   { -- No errors in moves. }
SolveTopEdges (MoveError);
if MoveError then Exit;
SolveTopCorners (MoveError);
if MoveError then Exit;
SolveVerticalEdges (MoveError);
if MoveError then Exit;
SolveBottomCorners (MoveError);
if MoveError then Exit;
SolveBottomEdges (MoveError);
if MoveError then Exit;

if CubeIsSolved then
if Copy(Solution[LastSolIndex], 1, 2) = 'RC' then
{ -- Don't rotate cube. }
LastSolIndex := LastSolIndex - 1
else { -- null }
else  { -- Do not display solution. }
begin  { -- Fatal error, Program could not solve cube. }
ErrorInMoves;  MoveError := True;  Exit;  end;
end;

procedure DisplayTextSolution ({using} Option1or2: Integer);
{ -- This procedure will display step-by-step the moves to restore the puzzle
-- in the array Solution[1..200] of string, with Solution[LastSolIndex]
-- having the last move of the solution.
-- If Option1or2 = 2 then display is text. }

const
Space   = 32;
Enter   = 13;
RtArr   = 77;
LtArr   = 75;
RtArrSh = 54;
LtArrSh = 52;
ESC     = 27;

var
I, Index, Side, RotPos:  Integer;
Ch, RotCh:               Char;
Rotation:                String1;

begin
DisplayBoxes;

for I := 1 to 54 do  { -- Initialize A array with Initial input colors. }
A[I] := AInit[I];
for Side := 1 to 6 do  { -- Display initial input colors }
DisplayColors (Side);
if LastSolIndex > 0 then
DisplayTextInstr;

Index := 0;
while Index < LastSolIndex do begin
{ -- Get valid command.  }
repeat
if Keypressed then Read (Kbd, Ch);
until (Ord(Ch) in [Space, Enter, RtArr, RtArrSh, ESC]) or
((Ord(Ch) in [LtArr, LtArrSh]) and (Index > 1));

if Index = 0 then begin  { -- Display only the first time through. }
{ -- Display move, colors on sides, and number of moves. }
TextColor (LightGreen);
GotoXY (15,20);  Write ('-->      <--');
GotoXY (20,22);
Write ('    move  out of ');  TextColor (LightCyan);
Write (LastSolIndex);
end;

if Ord(Ch) in [Space, Enter, RtArr, RtArrSh] then  { -- Do next move. }
begin
Index := Index + 1;
MakeMove (Solution[Index]);
end
else if Ord(Ch) in [ESC] then  { -- Quit and return to main menu. }
Exit
else if Ord(Ch) in [LtArr, LtArrSh] then  { -- Do reverse move. }
begin
RotCh := Copy(Solution[Index], 2, 1);
if (RotCh in ['+', '2', '-']) then
RotPos := 2
else RotPos := 3;  { -- Assume RC+, RC2, or RC- }
Rotation := Copy (Solution[Index], RotPos, 1);
if Rotation = '+' then
Rotation := '-'
else if Rotation = '-' then
Rotation := '+';
MakeMove (Copy(Solution[Index], 1, RotPos-1) + Rotation + ' ');
Index := Index - 1;
end;  { -- if Ord (Ch) in LtArr }

{ -- Display move, colors on sides, and number of moves. }
TextColor (Yellow);
GotoXY (20, 20);  Write (Solution[Index]);  { -- 1 move of solution. }
TextColor (LightCyan);
GotoXY (20, 22);  Write (Index:3);          { -- Number of moves done. }
TextColor (LightGreen);
if Index = 1 then Write (' move ')
else Write (' moves');
for Side := 1 to 6 do
DisplayColors (Side);
GotoXY (20, 21);
end;  { -- while }

{ -- ********   Cube is solved   ******** }
{ -- Clear Top Instructions.}
Window (14, 3, 39, 8);  ClrScr;  Window (1, 1, 80, 25);
Delay (3000);  { -- Wait 3 seconds for suspense }
if Keypressed then Read (Kbd, Ch);  { -- Get impatient response. }

TextColor (Yellow);  GotoXY (3, 25);
Write ('Congratulations!!!  Press any key.');
Sound (500);  Delay (500);
Sound (700);  Delay (500);
Sound (900);  Delay (500);
Sound (700);  Delay (500);
Sound (500);  Delay (500);
NoSound;
end;

{ -- INCLUDE MagnifyLetter (L, M, X, Y, Co) }
{\$I MAGNIFY.INC}

{ -- MAGNIFY.INC }
procedure MagnifyLetter (L: Char; {by} M: Integer; {at} X, Y: Integer;
{using}  Co: Integer);
{ -- This procedure will magnify the letter L by M times at position X, Y.
-- If the character L is not available (such as a space), then no display. }

var
I, J, K: Integer;
Let:     Array [1..7] of String;

begin
Case L of

{ -- Letter A }
'A': begin
Let  := '00100';
Let  := '01010';
Let  := '10001';
Let  := '10001';
Let  := '11111';
Let  := '10001';
Let  := '10001';
end;

{ -- Letter B }
'B': begin
Let  := '11110';
Let  := '10001';
Let  := '10001';
Let  := '11110';
Let  := '10001';
Let  := '10001';
Let  := '11110';
end;

{ -- Letter C }
'C': begin
Let  := '01110';
Let  := '10001';
Let  := '10000';
Let  := '10000';
Let  := '10000';
Let  := '10001';
Let  := '01110';
end;

{ -- Letter D }
'D': begin
Let  := '11100';
Let  := '10010';
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '10010';
Let  := '11100';
end;

{ -- Letter E }
'E': begin
Let  := '11111';
Let  := '10000';
Let  := '10000';
Let  := '11110';
Let  := '10000';
Let  := '10000';
Let  := '11111';
end;

{ -- Letter F }
'F': begin
Let  := '11111';
Let  := '10000';
Let  := '10000';
Let  := '11110';
Let  := '10000';
Let  := '10000';
Let  := '10000';
end;

{ -- Letter G }
'G': begin
Let  := '01110';
Let  := '10001';
Let  := '10000';
Let  := '10111';
Let  := '10001';
Let  := '10001';
Let  := '01110';
end;

{ -- Letter H }
'H': begin
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '11111';
Let  := '10001';
Let  := '10001';
Let  := '10001';
end;

{ -- Letter I }
'I': begin
Let  := '01110';
Let  := '00100';
Let  := '00100';
Let  := '00100';
Let  := '00100';
Let  := '00100';
Let  := '01110';
end;

{ -- Letter J }
'J': begin
Let  := '00111';
Let  := '00010';
Let  := '00010';
Let  := '00010';
Let  := '10010';
Let  := '10010';
Let  := '01100';
end;

{ -- Letter K }
'K': begin
Let  := '10001';
Let  := '10010';
Let  := '10100';
Let  := '11000';
Let  := '10100';
Let  := '10010';
Let  := '10001';
end;

{ -- Letter L }
'L': begin
Let  := '10000';
Let  := '10000';
Let  := '10000';
Let  := '10000';
Let  := '10000';
Let  := '10000';
Let  := '11111';
end;

{ -- Letter M }
'M': begin
Let  := '10001';
Let  := '11011';
Let  := '11111';
Let  := '10101';
Let  := '10001';
Let  := '10001';
Let  := '10001';
end;

{ -- Letter N }
'N': begin
Let  := '11001';
Let  := '11001';
Let  := '11101';
Let  := '10101';
Let  := '10111';
Let  := '10011';
Let  := '10011';
end;

{ -- Letter O }
'O': begin
Let  := '01110';
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '01110';
end;

{ -- Letter P }
'P': begin
Let  := '11110';
Let  := '10001';
Let  := '10001';
Let  := '11110';
Let  := '10000';
Let  := '10000';
Let  := '10000';
end;

{ -- Letter Q }
'Q': begin
Let  := '01110';
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '10101';
Let  := '10010';
Let  := '01101';
end;

{ -- Letter R }
'R': begin
Let  := '11110';
Let  := '10001';
Let  := '10001';
Let  := '11110';
Let  := '10100';
Let  := '10010';
Let  := '10001';
end;

{ -- Letter S }
'S': begin
Let  := '01111';
Let  := '10000';
Let  := '10000';
Let  := '01110';
Let  := '00001';
Let  := '00001';
Let  := '11110';
end;

{ -- Letter T }
'T': begin
Let  := '11111';
Let  := '00100';
Let  := '00100';
Let  := '00100';
Let  := '00100';
Let  := '00100';
Let  := '00100';
end;

{ -- Letter U }
'U': begin
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '01110';
end;

{ -- Letter V }
'V': begin
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '01010';
Let  := '00100';
end;

{ -- Letter W }
'W': begin
Let  := '10001';
Let  := '10001';
Let  := '10001';
Let  := '10101';
Let  := '11111';
Let  := '11011';
Let  := '10001';
end;

{ -- Letter X }
'X': begin
Let  := '10001';
Let  := '10001';
Let  := '01010';
Let  := '00100';
Let  := '01010';
Let  := '10001';
Let  := '10001';
end;

{ -- Letter Y }
'Y': begin
Let  := '10001';
Let  := '10001';
Let  := '01010';
Let  := '00100';
Let  := '00100';
Let  := '00100';
Let  := '00100';
end;

{ -- Letter Z }
'Z': begin
Let  := '11111';
Let  := '00001';
Let  := '00010';
Let  := '00100';
Let  := '01000';
Let  := '10000';
Let  := '11111';
end;

{ -- Symbol + }
'+': begin
Let  := '00000';
Let  := '00100';
Let  := '00100';
Let  := '11111';
Let  := '00100';
Let  := '00100';
Let  := '00000';
end;

{ -- Symbol 2 }
'2': begin
Let  := '01110';
Let  := '10001';
Let  := '00001';
Let  := '00110';
Let  := '00100';
Let  := '01000';
Let  := '11111';
end;

{ -- Symbol - }
'-': begin
Let  := '00000';
Let  := '00000';
Let  := '00000';
Let  := '11111';
Let  := '00000';
Let  := '00000';
Let  := '00000';
end;

else Exit;  { -- if symbol is not available. }
end;  { -- case }

{ -- Draw Enlarged Pixels of Letter in Color Co. }
for I := 0 to 6 do
for J := 0 to 4 do
If Copy (Let[I+1], J+1, 1) = '1' then
for K := 0 to M-1 do
Draw (X +J*M,Y + I*M+K, X +J*M+M-1,Y +I*M+K, Co);

end;  { procedure }

{ -- INCLUDE INSTR.INC  DisplayInstr }
{\$I INSTR.INC}

{ -- INSTR.INC }
procedure DisplayInstr;
{ -- This procedure will display a brief description of each menu option. }

const
ESC = 27;
var
Ch: Char;
Co, J: Integer;
Side:  Integer;

begin
{ -- First Screen }
ClrScr;  Window (10,1, 79,25);  TextColor (Yellow); ClrScr;
Writeln ('INSTRUCTIONS');  TextColor (White);
Writeln;  Writeln;
Writeln ('In order to obtain a solution (Graphical or Text), the user');
Writeln ('must describe the appearance of the puzzle to the computer.');
Writeln;
Writeln ('To begin, look at the six middle squares on each side.');
Writeln ('There should be six unique colors on these squares.');
Writeln ('If the colors are different from the following six colors,');
Writeln ('then you must first choose option 4 from the main menu to');
Writeln ('"set valid colors" for the cube:  (B)lue, (G)reen, (O)range,');
Writeln ('(R)ed, (W)hite, and (Y)ellow.');
Writeln;
Writeln ('Before describing the different menu options, let''s take a');
Writeln ('look at the six different sides of the Rubik''s Cube.');
GotoXY (1, 24);  TextColor (Yellow);
Write ('Press ESC to quit, any other key to continue.');
Read (Kbd, Ch);  if Ch = Chr(ESC) then Exit;

{ -- Second Screen }
GraphColorMode;
GraphBackGround (Blue);  Window (1,1, 80, 25);
Palette (3); { -- 4 colors available (Graphics and Text):
0 = Background, 1 = LightCyan, 2 = LightMagenta, 3 = White. }
Side := 1;
repeat
{ -- Display Title }
Co := 3;  { Color = White }
TextColor (Co);  GotoXY (15, 1);  Writeln ('View 6 Sides');
if Side > 1 then  { -- Clear cube picture and Side symbol. }
for J := 1 to 15 do
Writeln (' ': 28);

{ -- Draw Cube }
Draw (40,10, 100,10, Co);  Draw (100,10, 70,40, Co);
Draw (70,40, 10,40, Co);   Draw (10,40, 40,10, Co);

Draw (40,70, 100,70, Co);    Draw (100,70, 70,100, Co);
Draw (70,100, 10,100, CO);   Draw (10,100, 40,70, Co);

Draw (40,10, 40,70, Co);    Draw (100,10, 100,70, Co);
Draw (70,40, 70,100, Co);   Draw (10,40, 10,100, Co);

{ -- Draw line above instructions area. }
Draw (0,165, 315, 165, 3);  TextColor (1);
GotoXY (1,22);
Write ('Press ESC to quit;');
GotoXY (1, 23);  Write ('Press M for menu options;');
GotoXY (1, 24);  Write ('Press any other key to continue.');
GotoXY (20, 15);

{ -- Fill in sides }
Case Side of
1: begin  { -- Top Side }
for J := 40 to 100 do
Draw (J,10, J-30,40, Co);
MagnifyLetter ('T', 5, 124, 84, 3);
Write ('op      ');
end;

2: begin  { -- Front Side }
for J := 40 to 100 do
Draw (10,J, 70,J, Co);
MagnifyLetter ('F', 5, 124, 84, 3);
Write ('ront    ');
end;

3: begin  { -- Right Side }
for J := 40 to 100 do
Draw (70,J, 100,J-30, Co);
MagnifyLetter ('R', 5, 124, 84, 3);
Write ('ight    ');
end;

4: begin  { -- Back Side }
for J := 40 to 100 do
Draw (J,10, J,70, Co);
MagnifyLetter ('P', 5, 124, 84, 3);
Write ('osterior');
end;

5: begin  { -- Left Side }
for J := 10 to 70 do
Draw (40,J, 10,J+30, Co);
MagnifyLetter ('L', 5, 124, 84, 3);
Write ('eft     ');
end;

6: begin  { -- Bottom Side }
for J := 40 to 100 do
Draw (J,70, J-30,100, Co);
MagnifyLetter ('B', 5, 124, 84, 3);
Write ('ottom   ');
end;

end; { -- case }
if Ch = Chr(ESC) then begin
TextMode; Exit; end;
Side := Side + 1;
until (Side > 6) or (Ch in ['m', 'M']); { -- for Side }

{ -- Third Screen }
TextMode; ClrScr;  TextColor (Yellow);  TextBackGround(Blue);  ClrScr;
Window(10,1, 79,25);  ClrScr;
Writeln ('Option 1. Graphical Solution');  TextColor (White);
Writeln;
Writeln ('In order to obtain the graphical solution, you must first');
Writeln ('enter the colors on the 54 squares into the computer.');
Writeln ('Choosing option 1 will allow you to enter the colors on the');
Writeln ('six sides of the cube:  (T)op, (F)ront, (R)ight, (P)osterior,');
Writeln ('(L)eft, and (B)ottom.');
Writeln;
Writeln ('The colors on each side are to be input from top to bottom,');
Writeln ('left to right by pressing the valid color symbol associated');
Writeln ('with each square.  If you make a mistake, press the left arrow');
Writeln ('and then press the correct color symbol.');
Writeln;
Writeln ('After entering the colors for the top, front, right, back, and');
Writeln ('left sides, then place the cube so that the front is facing');
Writeln ('you and the top side is facing up.  To enter the color symbols');
Writeln ('on the bottom, tilt the cube so that the front becomes the top');
Writeln ('and the bottom becomes the front, temporarily.  Now, enter the');
Writeln ('colors from top to bottom, left to right as you see them on the');
Writeln ('front.  After doing so, tilt the cube back.');
Writeln;  TextColor (Yellow);  GotoXY (1, 24);
Write ('Press ESC to quit, any other key to continue.');
Read (Kbd, Ch);  if Ch = Chr(ESC) then Exit;

{ -- fourth screen }
ClrScr;  TextColor (Yellow);
Writeln ('Option 1. Graphical Solution (cont.)');  TextColor (White);
Writeln;
Writeln ('After finishing the input routine, the computer will display');
Writeln ('a step-by-step solution to solve the puzzle.  Read the');
Writeln ('instructions given on the screen and press the appropriate key');
Writeln ('to see the first move.  The first move will appear in large');
Writeln ('symbols, underneath the phrase, "Do the move:".');
Writeln;
Writeln ('Each move will either:  1) turn one side independently of the');
Writeln ('others, or 2) rotate the entire cube so that a new side');
Writeln ('becomes the front.');
Writeln;
Writeln ('First, most moves will consist of a sides'' symbol (T, F, R,');
Writeln ('L, or B) and a rotation (+, 2, or -).  This move means to turn');
Writeln ('the corresponding side clockwise (if a + follows), or counter-');
Writeln ('clockwise (if a - follows), or 2 times either way (if a 2');
Writeln ('follows).  Each move is made as if you are viewing it face to');
Writeln ('face.  For example, F+ means "turn the Front side clockwise."');
Writeln ('Second, a move might include RC (Rotate Cube) and a rotation.');
Writeln ('Thus, RC- means to rotate the cube clockwise as if you were');
Writeln ('looking at the top.  After making the moves, check the cubes.');
Writeln;  TextColor (Yellow);  GotoXY (1, 24);
Write ('Press ESC to quit, any other key to continue.');
Read (Kbd, Ch);  if Ch = Chr(ESC) then Exit;

{ -- Fifth Screen }
ClrScr;  TextColor (Yellow);
Writeln ('Option 2. Text Solution');  TextColor (White);
Writeln;
Writeln ('In order to obtain the text solution, you must first');
Writeln ('enter the colors on the 54 squares into the computer.');
Writeln ('Choosing option 2 will allow you to enter the colors on the');
Writeln ('six sides of the cube.  This input routine is the same as the');
Writeln ('one used for the Graphical Solution.');
Writeln;
Writeln ('The colors on each side are to be input from top to bottom,');
Writeln ('left to right by pressing the valid color symbol associated');
Writeln ('with each square.  If you make a mistake, press the left arrow');
Writeln ('and then press the correct color symbol.');
Writeln;
Writeln ('After finishing the input routine, the computer will display');
Writeln ('a step-by-step solution to solve the puzzle.  Read the');
Writeln ('instructions given on the screen and press the appropriate key');
Writeln ('to see the first move.  The first move will appear between the');
Writeln ('two arrows on the bottom part of the screen.');
Writeln;
Writeln ('Each move will either:  1) turn one side independently of the');
Writeln ('others, or 2) rotate the entire cube so that a new side');
Writeln ('becomes the front.  Moves are made as discussed before.');
Writeln;  TextColor (Yellow);  GotoXY (1, 24);
Write ('Press ESC to quit, any other key to continue.');
Read (Kbd, Ch);  if Ch = Chr(ESC) then Exit;

{ -- Sixth Screen }
ClrScr;  TextColor (Yellow);
Writeln ('Option 3. Instructions');  TextColor (White);
Writeln;
Writeln ('Choosing option 3 allows you to view a brief description');
Writeln ('of each of the menu options, as you are doing now.  It');
Writeln ('will also emphasize that the first option that should be');
Writeln ('chosen (after reading the instructions) is number 4, to');
Writeln ('"Set Valid Colors".');
Writeln;
Writeln;
Writeln ('Since these instructions only briefly describe the program');
Writeln ('contents, you may want to read the User''s Guide.  The manual');
Writeln ('gives an indepth description of each menu option and includes');
Writeln ('research about the Rubik''s Cube as well as strategies to solve');
Writeln ('the puzzle.  In addition, a partial Pascal program listing is');
Writeln ('included.  If you would like to have this, please write to: ');
Writeln;  TextColor (Yellow);
Writeln ('       Doug Woolley');
Writeln ('       c/o Florida Center for Instructional Computing');
Writeln ('       University of South Florida - EDU 123H');
Writeln ('       Tampa, Fl 33620');
Writeln;  TextColor (Yellow);  GotoXY (1, 24);
Write ('Press ESC to quit, any other key to continue.');
Read (Kbd, Ch);  if Ch = Chr(ESC) then Exit;

{ -- Seventh Screen }
ClrScr;  TextColor (Yellow);
Writeln ('Option 4. Set Valid Colors');  TextColor (White);
Writeln;
Writeln ('The cube has six sides, each with a unique color in its');
Writeln ('original state.  However, not all versions of the cube');
Writeln ('puzzle have the same six unique colors.  If the colors');
Writeln ('are other than blue, green, orange, red, white, and yellow,');
Writeln ('then you must select option 4 to assign the valid colors on');
Writeln;
Writeln ('Instead of entering the actual name of the color, the');
Writeln ('computer will accept a one letter color symbol, such as the');
Writeln ('first letter in the name of the color.  Six unique color');
Writeln ('symbols must be entered before a solution can be obtained.');
Writeln;
Writeln ('You may press a one letter color symbol to replace the default');
Writeln ('values that are shown that differ.  If some of the color');
Writeln ('symbols match, then press the Enter key to select the default');
Writeln ('value shown.');

Writeln;  TextColor (Yellow);  GotoXY (1, 24);
Write ('Press ESC to quit, any other key to continue.');
Read (Kbd, Ch);  if Ch = Chr(ESC) then Exit;

{ -- Eighth Screen }
ClrScr;  TextColor (Yellow);
Writeln ('Option 5. Test Program');  TextColor (White);
Writeln;
Writeln ('Choosing option 5 allows you to "test" the program in');
Writeln ('particular features.  The option provides statistical');
Writeln ('facts pertaining to the computer oriented solution.');
Writeln;
Writeln ('First, you must enter the number of imaginary cubes that');
Writeln ('you want the computer to solve.  Next, you must enter the');
Writeln ('number of random turns to make to each of these solved');
Writeln ('imaginary cubes.  The program will then attempt to solve');
Writeln ('each of these cubes and will display certain statistics.');
Writeln;
Writeln ('The program will display the number of moves it took to solve');
Writeln ('each puzzle, followed by the "Average # of moves" the program');
Writeln ('took to solve each of the puzzles.  In addition, the "Most');
Writeln ('moves" required to solve one of these puzzles is displayed,');
Writeln ('along with the "Least moves" required to solve one of them.');
Writeln;
Writeln ('On the average, the program will usually require 140 moves');
Writeln ('(this is including about 15 rotational moves) to obtain a');
Writeln ('solution.');

Writeln;  TextColor (Yellow);  GotoXY (1, 24);
Write ('Press ESC to quit, any other key to continue.');
Read (Kbd, Ch);  if Ch = Chr(ESC) then Exit;

{ -- Ninth Screen }
ClrScr;  TextColor (Yellow);
Writeln ('Option 6. Exit');  TextColor (White);
Writeln;
Writeln ('Choosing option 6 will place the computer in DOS, the Disk');
Writeln ('Operating System.');

Writeln;  TextColor (Yellow);  GotoXY (1, 24);
Read (Kbd, Ch);  if Ch = Chr(ESC) then Exit;

end;

procedure DisplayGraphicsInstr;
{ -- This procedure will display commands needed for displaying the solution.}
{ -- 4 colors available (Graphics and Text):
0 = Background, 1 = LightCyan, 2 = LightMagenta, 3 = White. }

const
RtArrow = 26;
LtArrow = 27;

begin
{ -- First command }
TextColor (3);
GotoXY (1, 22);  Write ('Press: ');
TextColor (2);
Write ('Space, ', Chr(RtArrow), ', ');
TextColor (3);  Write ('or ');
TextColor (2);  Write ('Enter');
TextColor (1);
Write (' and perform');

{ -- 2nd line/ 1st command. }
GotoXY (1, 23);
Write ('move shown above, then compare side(s);');

{ -- Third line/ 2nd command. }
GotoXY (1, 24);
TextColor (3);  Write ('or ');
TextColor (2);
Write ('(T, F, R, P, L, B)');
TextColor (1);
Write (' to view sides;');

{ -- Fourth line/ 3rd command }
TextColor (3);
GotoXY (1, 25);  Write ('or ');
TextColor (2);
Write (Chr(LtArrow));
TextColor (1);
Write (' for previous move;');

{ -- Fifth line/ 3rd command }
TextColor (3);
Write (' or ');
TextColor (2);
Write ('ESC ');
TextColor (1);
Write ('to quit.');
end;

procedure DisplayGraphics;
{ -- This procedure will display the Graphical cube. }

var
Co: Integer;

begin
GraphColorMode;
GraphBackGround (Blue);
Palette (3); { -- 4 colors available (Graphics and Text):
0 = Background, 1 = LightCyan, 2 = LightMagenta, 3 = White. }

{ -- Display Title }
Co := 3;  { -- Color = White }
TextColor (Co);  GotoXY (1,1);
Write ('Graphical Solution');

{ -- Draw Cube }
Co := 1;  { -- Color = Cyan }
{ -- Draw Large Square for perimeter of Front side of Cube. }
Draw (130,20, 250,20, Co);    Draw (250,20, 250,140, Co);
Draw (250,140, 130,140, Co);  Draw (130,140, 130,20, Co);

{ -- Draw little squares on Front side. }
Draw (130,60, 250,60, Co);    Draw (130,100, 250,100, Co);
Draw (170,20, 170,140, CO);   Draw (210,20, 210,140, Co);

{ -- Draw perimeter of Right Side. }
Draw (250,20, 310,0, Co);    Draw (250,140, 310,120, Co);
Draw (310,120, 310,0, Co);

{ -- Draw perimeter of Top Side. }
Draw (130,20, 190,0, Co);    Draw (190,0, 310,0, Co);

{ -- Draw little squares on Top and Right sides. }
Draw (250,60, 310,40, Co);  Draw (250,100, 310,80, Co);
Draw (170,20, 230,0, Co);   Draw (210,20, 270,0, Co);

Draw (270,133, 270,13, Co); Draw (270,13, 150,13, Co);
Draw (290, 126, 290,6, Co); Draw (290,6, 170,6, Co);

{ -- Draw line above instructions area in white. }
Draw (0,165, 315, 165, 3);
end;

procedure DisplayGraphicsColors ({using} Side, Co: Integer);
{ -- This procedure displays the color contents of squares on the Side
if Co is 1, 2, or 3.  If Co = 0 then the previous colors are erased. }

var
Row, Col, X, Y, InitX, InitY, Index:  Integer;

begin
InitX := 142;  { -- Top Left square starts at 142, 29 for display }
InitY := 29;   { -- with the next squares 40 units apart. }

for Row := 1 to 3 do
for Col := 1 to 3 do begin
X := InitX + (Col-1)*40;  Y := InitY + (Row-1)*40;
Index := (Side-1)*9 + (Row-1)*3 + Col;
MagnifyLetter (A[Index], 3, X, Y, Co);
end;
end;

procedure DisplayGraphicalSolution;
{ -- This procedure will display step-by-step the moves to restore the puzzle
-- in the array Solution[1..200] of string, with Solution[LastSolIndex]
-- having the last move of the solution.  One side of a graphical cube is
-- displayed. }

const
Space   = 32;
Enter   = 13;
RtArr   = 77;
LtArr   = 75;
RtArrSh = 54;
LtArrSh = 52;
ESC     = 27;
Sides   = 'TFRPLB';

var
I, Index, Side,
LastSide, RotPos:   Integer;
Ch, RotCh:          Char;
Rotation:           String1;
Co:                 Integer;
ChangeSide:         Boolean;

begin
for I := 1 to 54 do  { -- Initialize A array with Initial input colors. }
A[I] := AInit[I];

DisplayGraphics;
Palette (3); { -- 4 colors available (Graphics and Text):
0 = Background, 1 = LightCyan, 2 = LightMagenta, 3 = White. }
Side := 2;  Co := 3;  { -- Display initial input colors for Front Side }
DisplayGraphicsColors (Side, Co);
MagnifyLetter (Copy(Sides,Side,1), 4, 98, 131, 3);  { -- put new one. }
TextColor (1);
GotoXY (16, 20);
Write ('ront side    ');
if LastSolIndex > 0 then  { -- Display instructions only if moves are made.}
DisplayGraphicsInstr;

Index := 0;  LastSide := Side;
while Index < LastSolIndex do begin
{ -- Get valid command.  }
repeat
if Keypressed then Read (Kbd, Ch);
Ch := UpCase(Ch);
if Index > 0 then
ChangeSide := (Ch in ['T', 'F', 'R', 'P', 'L', 'B']) and
(Ch <> Copy(Sides, Side, 1))
else ChangeSide := False;
until (Ord(Ch) in [Space, Enter, RtArr, RtArrSh, ESC]) or
((Ord(Ch) in [LtArr, LtArrSh]) and (Index > 1)) or ChangeSide;

if Ord(Ch) in [ESC] then  { -- Quit and return to main menu. }
begin  TextMode;  Exit;  End;

if not ChangeSide then  { -- New move is needed, so erase old move. }
if Index > 0 then begin  { -- Erase previous move. }
Co := 0;               { -- Color is the Background. }
for I := 0 to 2 do
MagnifyLetter (Copy(Solution[Index], I+1, 1), 7, 45*I, 39, Co);
end;

{ -- Erase Previous colors on the displayed side. }
Co := 0;               { -- Color is the Background. }
DisplayGraphicsColors (Side, Co);

if Index = 0 then begin  { -- Display only the first time through. }
{ -- Display 'Do move', number of moves, and underline for move. }
TextColor (2);
GotoXY (1,3);  Write ('Do the move:');

GotoXY (1, 14);  Write ('   ');          { -- Number of moves done. }
TextColor (1);
Write (' move ');
GotoXY (1, 15);
Write ('out of ');
TextColor (3);  Write (LastSolIndex);

{ -- Underline the enlarged move. }
Draw (0, 90, 82,90, 2);
end;

if Ord(Ch) in [Space, Enter, RtArr, RtArrSh] then  { -- Do next move. }
begin
Index := Index + 1;
MakeMove (Solution[Index]);
LastSide := Side;
Side := 2;  { -- Display Front. }
end
else if Ord(Ch) in [LtArr, LtArrSh] then  { -- Do reverse move. }
begin
RotCh := Copy(Solution[Index], 2, 1);
if (RotCh in ['+', '2', '-']) then
RotPos := 2
else RotPos := 3;  { -- Assume RC+, RC2, or RC- }
Rotation := Copy (Solution[Index], RotPos, 1);
if Rotation = '+' then
Rotation := '-'
else if Rotation = '-' then
Rotation := '+';
MakeMove (Copy(Solution[Index], 1, RotPos-1) + Rotation + ' ');
Index := Index - 1;
LastSide := Side;
Side := 2;  { -- Display front. }
end  { -- if Ord (Ch) in LtArr }
else if ChangeSide then { -- Display new side}
begin
{ -- Remember the side currently displayed and change sides. }
LastSide := Side;
Side := Pos (Ch, Sides);
end;

if Side <> LastSide then begin  { -- Erase Side symbol and put new one. }
{ -- Erase old Side symbol if there is one. }
MagnifyLetter (Copy(Sides,LastSide,1), 4, 98, 131, 0);
MagnifyLetter (Copy(Sides,Side,1), 4, 98, 131, 3);  { -- put new one. }
TextColor (1);
GotoXY (16, 20);
Case side of
1:  Write ('op side      ');
2:  Write ('ront side    ');
3:  Write ('ight side    ');
4:  Write ('osterior side');
5:  Write ('eft side     ');
6:  Write ('ottom side   ');
end;
end;  { -- if Side }

{ -- Display move, colors on sides, and number of moves. }
Co := 3;  { -- Color is White. }
for I := 0 to 2 do
MagnifyLetter (Copy(Solution[Index], I+1, 1), 7, 45*I, 39, Co);

Co := 3;  { -- Color of letters will be White. }
DisplayGraphicsColors (Side, Co);

TextColor (3);
GotoXY (1, 14);  Write (Index:3);          { -- Number of moves done. }
TextColor (1);
if Index = 1 then Write (' move ')
else Write (' moves');
end;  { -- while }

{ -- ********   Cube is solved   ******** }
{ -- Clear Bottom Instructions.}
GotoXY (1, 22);  for I := 1 to 39 do Write (' ');
GotoXY (1, 23);  for I := 1 to 39 do Write (' ');
GotoXY (1, 24);  for I := 1 to 39 do Write (' ');
GotoXY (1, 25);  for I := 1 to 39 do Write (' ');

Delay (3000);  { -- Wait 3 seconds for suspense }
if Keypressed then Read (Kbd, Ch);  { -- Get impatient response. }

TextColor (3);  GotoXY (3, 25);
Write ('Congratulations!!!  Press any key.');
Sound (500);  Delay (500);
Sound (700);  Delay (500);
Sound (900);  Delay (500);
Sound (700);  Delay (500);
Sound (500);  Delay (500);
NoSound;
TextMode;
end;

{ -- ****************    Test Program  routine   **************** }

procedure PutColorsOnCube;  { -- output is global array of colors. }
{ -- This procedure will set all array items to Valid colors for a cube. }

var
Side, I, Index: Integer;

begin
for Side := 1 to 6 do
for I := 1 to 9 do begin
Index := (Side-1)*9 + I;
A[Index] := ValidColor[Side];  AInit[Index] := ValidColor[Side];
end;
end;

procedure GetNumber ({using} Col, Row: Integer; {giving} var Number: Integer);
{ -- This procedure will accept as input a 2 digit number. }

var
Ch:  Char;

begin
TextColor (White);
GotoXY (Col, Row);  Write ('--');
GotoXY (Col, Row);
repeat
Number := Ord(Ch) - Ord('0')
until Number in [0..9];
TextColor (White);
Write (Ch);

repeat
until (Ch in ['0' .. '9']) or (Ord(Ch) = 13);

if Ch in ['0' .. '9'] then
begin
Write (Ch);
Number := Number * 10 + (Ord(Ch) - Ord('0'));
repeat
until Ord(Ch) = 13;
end
else Write (' ');
end;

procedure TestProgram ({using} TestOption: Integer);
{ -- This procedure will display statistics for solving random cubes. }

const  { -- 5 sides x 3 = 15  +  3 rotations  =  18 moves total }
Moves = 'T+ T2 T- F+ F2 F- R+ R2 R- L+ L2 L- B+ B2 B- RC+RC2RC-';

var
NumOfCubes, CubeNum, I:    Integer;
NumOfRndMoves, TotalMoves: Integer;
NumOfMoves:                Array [1..99] of Integer;
MoveToMake:                String3;
ArrayOfMoves:              Array [1..30] of String3;
Ch:                        Char;
MostMoves, LeastMoves:     Integer;

begin
MostMoves := 0;  LeastMoves := 200;
repeat
GotoXY (3, 3);  TextColor (Yellow);
Write ('Enter # of cubes to solve (1-14): ');
GetNumber (37, 3, NumOfCubes);
until NumOfCubes < 15;
if NumOfCubes = 0 then Exit;

repeat
GotoXY (3, 4);  TextColor (Yellow);
Write ('Enter # of random turns (1-30): ');
GetNumber (35, 4, NumOfRndMoves);
until NumOfRndMoves < 31;
if NumOfRndMoves = 0 then Exit;

TextColor (LightCyan);
GotoXY (6, 6);  Write ('# of moves');
TotalMoves := 0;
for CubeNum := 1 to NumOfCubes do begin
{ -- Let computer make random cube to solve. }
PutColorsOnCube;
Randomize;
for I := 1 to NumOfRndMoves do begin
MoveToMake := Copy (Moves, Random(18)*3 +1, 3);
MakeMove (MoveToMake);
ArrayOfMoves[I] := MoveToMake;
end;

{ -- Have computer solve random cube and display # of moves done in. }
GetRCSolution (MoveError);
GotoXY (3, 6+CubeNum);      TextColor (LightMagenta);
Write (CubeNum:2, ':   ');  TextColor (White);
Write (LastSolIndex);
if MoveError then begin
Write ('  Error:  ', LastSolIndex, ' moves done.');
{ -- The following is for debugging purposes ONLY. }
{ for I := 1 to NumOfRndMoves do Write (ArrayOfMoves[I]); }
end;

{ -- Compute statistics:  Total Moves, Most moves, Least moves. }
NumOfMoves[CubeNum] := LastSolIndex;
TotalMoves := TotalMoves + LastSolIndex;
if NumOfMoves[CubeNum] > MostMoves  then  { -- A new Least moves amount. }
MostMoves := NumOfMoves[CubeNum];
if NumOfMoves[CubeNum] < LeastMoves then  { -- A new Most moves amount. }
LeastMoves:= NumOfMoves[CubeNum];
end;

{ -- Display Average number of moves, Most moves, Least Moves. }
TextColor (White);
GotoXY (3, 8+NumOfCubes);
TextColor (LightCyan);
Write ('Average # of moves: ');  TextColor (White);
Write (TotalMoves div CubeNum);

GotoXY (3, 9+NumOfCubes);  TextColor (LightCyan);
Write ('Most moves: ');    TextColor (White);
Write (MostMoves);

GotoXY (23, 9+NumOfCubes);  TextColor (LightCyan);
Write ('Least moves: ');    TextColor (White);
Write (LeastMoves);

TextColor (Yellow);
GotoXY (14, 25);
Write ('Press any key');
end;

{ -- ***********   Main Flow of Program   ************* }
begin
DisplayTitlePage;
InitValidColors;
repeat
case Option of
1, 2: begin
GetRCInput;
if CorrectInput then begin
GetRCSolution (MoveError);
if not MoveError then
if Option = 1 then  { -- Graphical Solution }
DisplayGraphicalSolution
else  { -- Option = 2  Text Solution }
DisplayTextSolution (Option)
end;
end;

3: DisplayInstr;

4: GetValidColors;

5: TestProgram (Option);
end;
until Option = LastOption;

ClrScr;
end.
```