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[1];    { -- Stores Side to be moved, eg. F, R, B }
    String3  = String[3];    { -- Stores 1 move of solution 'F+ ' }
    String30 = String[30];   { -- Stores Title for Border }
    String60 = String[60];   { -- Stores Set of Moves (at most 20) }
    Array6 = Array [1..6] of Integer;
    MenuType = Array [1..6] of String[20];

  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');

  Read (Kbd, Ch);
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);
    Write (MenuOption[I]);
  end;

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

  repeat
    Read (Kbd, Ch);
    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[1] := 'B';
  ValidColor[2] := 'G';
  ValidColor[3] := 'O';
  ValidColor[4] := 'R';
  ValidColor[5] := 'W';
  ValidColor[6] := '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
  DisplayBorder (MenuOption[Option], 1);

  { -- 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
      Read (Kbd, Ch);
      Ch := UpCase(Ch);
      if (Ch in ['A' .. 'Z']) or (Ord(Ch) in [13]) 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');
  Read (Kbd, Ch);
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[6]);

  { -- 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[2];
    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[1] := Colr[1] + Colr[2];  Edge[2] := Colr[1] + Colr[3];
  Edge[3] := Colr[1] + Colr[4];  Edge[4] := Colr[1] + Colr[5];
  Edge[5] := Colr[2] + Colr[3];  Edge[6] := Colr[3] + Colr[4];
  Edge[7] := Colr[4] + Colr[5];  Edge[8] := Colr[5] + Colr[2];
  Edge[9] := Colr[2] + Colr[6];  Edge[10]:= Colr[3] + Colr[6];
  Edge[11]:= Colr[4] + Colr[6];  Edge[12]:= Colr[5] + Colr[6];

  { -- All the possible Corner combinations with the unique mid squares. }
  Corn[1] := Colr[1] + Colr[2] + Colr[3];
  Corn[2] := Colr[1] + Colr[3] + Colr[4];
  Corn[3] := Colr[1] + Colr[4] + Colr[5];
  Corn[4] := Colr[1] + Colr[5] + Colr[2];
  Corn[5] := Colr[6] + Colr[2] + Colr[3];
  Corn[6] := Colr[6] + Colr[3] + Colr[4];
  Corn[7] := Colr[6] + Colr[4] + Colr[5];
  Corn[8] := Colr[6] + Colr[5] + Colr[2];

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

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

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

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

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

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

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

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

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

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

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

    if (A[44]+A[49] = Edge[I]) or (A[49]+A[44] = 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[9], A[12], A[19]) then
      if CornHere[I] then begin InputCorrect := False;  Exit;  end
      else CornHere[I] := True;

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

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

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

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

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

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

    if Match(Corn[I], A[16], A[45], A[46]) 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[6];
    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
      Read (Kbd, Ch);
      Ch := UpCase(Ch);
      ValidColr := False;  { -- Initially not a Color symbol }
      if keypressed then
        Read (Kbd, Ch)
      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');
  Read (Kbd, Ch);
  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[5];   { -- Has Color symbol of Top middle square. }
    Fmid := A[14];  { -- Has color symbol of Front middle square. }

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

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

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

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

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

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

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

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

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

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

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

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

    if (A[8] = Tmid) and (A[11] = Fmid) and (Face < 4) then  { --Rotate Cube }
      AddToSolution ('RC+')
    else If (A[8]<>Tmid) or (A[11]<>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[5];   { -- Has Color symbol of Top middle square. }
    Fmid := A[14];  { -- Has color symbol of Front middle square. }

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

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

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

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

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

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

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

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

    if (A[9] = Tmid) and (A[12] = Fmid) and (Face < 4) then { --Rotate Cube }
      AddToSolution ('RC+')
    else if (A[9]<>Tmid) or (A[12]<>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[14];  { -- Has color symbol of Front middle square. }
    Rmid := A[23];  { -- Has color symbol of Right middle square. }

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

    else if (A[24] = Fmid) and (A[31] = 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[24] = Rmid) and (A[31] = 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[33] = Fmid) and (A[40] = 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[33] = Rmid) and (A[40] = 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[13] = Fmid) and (A[42] = 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[13] = Rmid) and (A[42] = 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[17] = Fmid) and (A[47] = Rmid) then  { -- Move FB to FR }
      AddToSolution ('B- R- B+ R+ B+ F+ B- F- ')
    else if (A[17] = Rmid) and (A[47] = Fmid) then  { -- Move FB to FR }
      AddToSolution ('B2 F+ B- F- B- R- B+ R+ ')

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

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

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

    if (A[15] = Fmid) and (A[22] = Rmid) and (Face < 4) then { --Rotate Cube }
      AddToSolution ('RC+')
    else if (A[15]<>Fmid) or (A[22]<>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[14];  Rmid := A[23];  Pmid := A[32];  Lmid := A[41];

    { -- Determine which of the 4 Bottom corners exist (= True). }
    BFL := ((A[16] = Fmid) and (A[45] = Lmid)) or
           ((A[16] = Lmid) and (A[46] = Fmid)) or
           ((A[45] = Fmid) and (A[46] = Lmid));
    BFR := ((A[18] = Fmid) and (A[25] = Rmid)) or
           ((A[18] = Rmid) and (A[48] = Fmid)) or
           ((A[25] = Fmid) and (A[48] = Rmid));
    BPR := ((A[27] = Rmid) and (A[34] = Pmid)) or
           ((A[34] = Rmid) and (A[54] = Pmid)) or
           ((A[27] = Pmid) and (A[54] = Rmid));
    BLP := ((A[36] = Pmid) and (A[43] = Lmid)) or
           ((A[36] = Lmid) and (A[52] = Pmid)) or
           ((A[43] = Pmid) and (A[52] = 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
            AddToSolution ('RC2')
          else if (BFR and BPR) then
            AddToSolution ('RC-')
          else if (BLP and BFL) then
            AddToSolution ('RC+');
          { -- 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
          AddToSolution ('B- ')
        else
          AddToSolution ('B+ ');
      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[50];
   if (A[46] = Bmid) and (A[48] = Bmid) and (A[52] = Bmid) and (A[54] = Bmid)
     then All4Oriented := True
   else
   if (A[46] = Bmid) and (A[43] = Bmid) and (A[34] = Bmid) and (A[25] = 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[46] = Bmid) and (A[36] = Bmid) and (A[27] = Bmid) and (A[18] = Bmid)
   or (A[45] = Bmid) and (A[36] = Bmid) and (A[34] = Bmid) and (A[25] = Bmid)
   or (A[16] = Bmid) and (A[36] = Bmid) and (A[54] = Bmid) and (A[48] = Bmid)
   or (A[16] = Bmid) and (A[52] = Bmid) and (A[54] = Bmid) and (A[18] = Bmid)
   or (A[16] = Bmid) and (A[52] = Bmid) and (A[27] = Bmid) and (A[48] = Bmid)
   or (A[45] = Bmid) and (A[43] = Bmid) and (A[27] = Bmid) and (A[25] = 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[14];  Rmid := A[23];  Pmid := A[32];  Lmid := A[41];

    { -- Determine which of the 4 Bottom edges are positioned (= True). }
    BF := (A[17] = Fmid) or (A[47] = Fmid);
    BR := (A[26] = Rmid) or (A[51] = Rmid);
    BP := (A[35] = Pmid) or (A[53] = Pmid);
    BL := (A[44] = Lmid) or (A[49] = 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[41];  { -- Cube may have rotated and changed colors. }
        if (BF or BR or BP or BL) and ((A[51] = Lmid) or (A[26] = 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[50];
  { -- Check if all edges are oriented. }
  All4Oriented := (A[47] + A[49] + A[51] + A[53]) = (Bmid+ Bmid+ Bmid+ Bmid);

  if not All4Oriented then begin  { -- Edges will be in 1 of 3 patterns. }
    Pattern1 := (A[47] <> Bmid) and (A[49] <> Bmid) and
                (A[51] <> Bmid) and (A[53] <> Bmid);
    Pattern2 := (A[47] =  Bmid) and (A[53] = Bmid)  or
                (A[49] =  Bmid) and (A[51] = Bmid);
    Pattern3 := (A[47] =  Bmid) and (A[49] = Bmid)  or
                (A[49] =  Bmid) and (A[53] = Bmid)  or
                (A[51] =  Bmid) and (A[53] = Bmid)  or
                (A[47] =  Bmid) and (A[51] = 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[47] =  Bmid) and (A[53] = Bmid) then  { -- Rotate Cube }
        AddToSolution ('RC+');
      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[47] =  Bmid) and (A[49] = Bmid) then
        AddToSolution ('RC-')
      else if (A[49] =  Bmid) and (A[53] = Bmid) then
        AddToSolution ('RC2')
      else if (A[51] =  Bmid) and (A[53] = Bmid) then
        AddToSolution ('RC+');
      { -- 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[3], 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[3], 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
  DisplayBorder (MenuOption[Option1or2], 1);
  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
      Read (Kbd, Ch);
      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;
  Read (Kbd, Ch);
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[5];

begin
  Case L of

  { -- Letter A }
  'A': begin
  Let [1] := '00100';
  Let [2] := '01010';
  Let [3] := '10001';
  Let [4] := '10001';
  Let [5] := '11111';
  Let [6] := '10001';
  Let [7] := '10001';
  end;

  { -- Letter B }
  'B': begin
  Let [1] := '11110';
  Let [2] := '10001';
  Let [3] := '10001';
  Let [4] := '11110';
  Let [5] := '10001';
  Let [6] := '10001';
  Let [7] := '11110';
  end;

  { -- Letter C }
  'C': begin
  Let [1] := '01110';
  Let [2] := '10001';
  Let [3] := '10000';
  Let [4] := '10000';
  Let [5] := '10000';
  Let [6] := '10001';
  Let [7] := '01110';
  end;

  { -- Letter D }
  'D': begin
  Let [1] := '11100';
  Let [2] := '10010';
  Let [3] := '10001';
  Let [4] := '10001';
  Let [5] := '10001';
  Let [6] := '10010';
  Let [7] := '11100';
  end;

  { -- Letter E }
  'E': begin
  Let [1] := '11111';
  Let [2] := '10000';
  Let [3] := '10000';
  Let [4] := '11110';
  Let [5] := '10000';
  Let [6] := '10000';
  Let [7] := '11111';
  end;

  { -- Letter F }
  'F': begin
  Let [1] := '11111';
  Let [2] := '10000';
  Let [3] := '10000';
  Let [4] := '11110';
  Let [5] := '10000';
  Let [6] := '10000';
  Let [7] := '10000';
  end;

  { -- Letter G }
  'G': begin
  Let [1] := '01110';
  Let [2] := '10001';
  Let [3] := '10000';
  Let [4] := '10111';
  Let [5] := '10001';
  Let [6] := '10001';
  Let [7] := '01110';
  end;

  { -- Letter H }
  'H': begin
  Let [1] := '10001';
  Let [2] := '10001';
  Let [3] := '10001';
  Let [4] := '11111';
  Let [5] := '10001';
  Let [6] := '10001';
  Let [7] := '10001';
  end;

  { -- Letter I }
  'I': begin
  Let [1] := '01110';
  Let [2] := '00100';
  Let [3] := '00100';
  Let [4] := '00100';
  Let [5] := '00100';
  Let [6] := '00100';
  Let [7] := '01110';
  end;

  { -- Letter J }
  'J': begin
  Let [1] := '00111';
  Let [2] := '00010';
  Let [3] := '00010';
  Let [4] := '00010';
  Let [5] := '10010';
  Let [6] := '10010';
  Let [7] := '01100';
  end;

  { -- Letter K }
  'K': begin
  Let [1] := '10001';
  Let [2] := '10010';
  Let [3] := '10100';
  Let [4] := '11000';
  Let [5] := '10100';
  Let [6] := '10010';
  Let [7] := '10001';
  end;

  { -- Letter L }
  'L': begin
  Let [1] := '10000';
  Let [2] := '10000';
  Let [3] := '10000';
  Let [4] := '10000';
  Let [5] := '10000';
  Let [6] := '10000';
  Let [7] := '11111';
  end;

  { -- Letter M }
  'M': begin
  Let [1] := '10001';
  Let [2] := '11011';
  Let [3] := '11111';
  Let [4] := '10101';
  Let [5] := '10001';
  Let [6] := '10001';
  Let [7] := '10001';
  end;

  { -- Letter N }
  'N': begin
  Let [1] := '11001';
  Let [2] := '11001';
  Let [3] := '11101';
  Let [4] := '10101';
  Let [5] := '10111';
  Let [6] := '10011';
  Let [7] := '10011';
  end;

  { -- Letter O }
  'O': begin
  Let [1] := '01110';
  Let [2] := '10001';
  Let [3] := '10001';
  Let [4] := '10001';
  Let [5] := '10001';
  Let [6] := '10001';
  Let [7] := '01110';
  end;

  { -- Letter P }
  'P': begin
  Let [1] := '11110';
  Let [2] := '10001';
  Let [3] := '10001';
  Let [4] := '11110';
  Let [5] := '10000';
  Let [6] := '10000';
  Let [7] := '10000';
  end;

  { -- Letter Q }
  'Q': begin
  Let [1] := '01110';
  Let [2] := '10001';
  Let [3] := '10001';
  Let [4] := '10001';
  Let [5] := '10101';
  Let [6] := '10010';
  Let [7] := '01101';
  end;

  { -- Letter R }
  'R': begin
  Let [1] := '11110';
  Let [2] := '10001';
  Let [3] := '10001';
  Let [4] := '11110';
  Let [5] := '10100';
  Let [6] := '10010';
  Let [7] := '10001';
  end;

  { -- Letter S }
  'S': begin
  Let [1] := '01111';
  Let [2] := '10000';
  Let [3] := '10000';
  Let [4] := '01110';
  Let [5] := '00001';
  Let [6] := '00001';
  Let [7] := '11110';
  end;

  { -- Letter T }
  'T': begin
  Let [1] := '11111';
  Let [2] := '00100';
  Let [3] := '00100';
  Let [4] := '00100';
  Let [5] := '00100';
  Let [6] := '00100';
  Let [7] := '00100';
  end;

  { -- Letter U }
  'U': begin
  Let [1] := '10001';
  Let [2] := '10001';
  Let [3] := '10001';
  Let [4] := '10001';
  Let [5] := '10001';
  Let [6] := '10001';
  Let [7] := '01110';
  end;

  { -- Letter V }
  'V': begin
  Let [1] := '10001';
  Let [2] := '10001';
  Let [3] := '10001';
  Let [4] := '10001';
  Let [5] := '10001';
  Let [6] := '01010';
  Let [7] := '00100';
  end;

  { -- Letter W }
  'W': begin
  Let [1] := '10001';
  Let [2] := '10001';
  Let [3] := '10001';
  Let [4] := '10101';
  Let [5] := '11111';
  Let [6] := '11011';
  Let [7] := '10001';
  end;

  { -- Letter X }
  'X': begin
  Let [1] := '10001';
  Let [2] := '10001';
  Let [3] := '01010';
  Let [4] := '00100';
  Let [5] := '01010';
  Let [6] := '10001';
  Let [7] := '10001';
  end;

  { -- Letter Y }
  'Y': begin
  Let [1] := '10001';
  Let [2] := '10001';
  Let [3] := '01010';
  Let [4] := '00100';
  Let [5] := '00100';
  Let [6] := '00100';
  Let [7] := '00100';
  end;

  { -- Letter Z }
  'Z': begin
  Let [1] := '11111';
  Let [2] := '00001';
  Let [3] := '00010';
  Let [4] := '00100';
  Let [5] := '01000';
  Let [6] := '10000';
  Let [7] := '11111';
  end;

  { -- Symbol + }
  '+': begin
  Let [1] := '00000';
  Let [2] := '00100';
  Let [3] := '00100';
  Let [4] := '11111';
  Let [5] := '00100';
  Let [6] := '00100';
  Let [7] := '00000';
  end;

  { -- Symbol 2 }
  '2': begin
  Let [1] := '01110';
  Let [2] := '10001';
  Let [3] := '00001';
  Let [4] := '00110';
  Let [5] := '00100';
  Let [6] := '01000';
  Let [7] := '11111';
  end;

  { -- Symbol - }
  '-': begin
  Let [1] := '00000';
  Let [2] := '00000';
  Let [3] := '00000';
  Let [4] := '11111';
  Let [5] := '00000';
  Let [6] := '00000';
  Let [7] := '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 }
    Read (Kbd, Ch);
    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 ('your cube.');
  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);
  Write ('Press any key to return to main menu.');
  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[3], 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
      Read (Kbd, Ch);
      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;
  Read (Kbd, Ch);
  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
    Read (Kbd, Ch);
    Number := Ord(Ch) - Ord('0')
  until Number in [0..9];
  TextColor (White);
  Write (Ch);

  repeat
    Read (Kbd, Ch);
  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
        Read (Kbd, Ch);
      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
  DisplayBorder (MenuOption[TestOption], 1);
  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');
  Read (Kbd, Ch);
end;

{ -- ***********   Main Flow of Program   ************* }
begin
  DisplayTitlePage;
  InitValidColors;
  repeat
    DisplayMenu (Option);
    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.

Return to About Doug