ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/PNL006.ZIP/KB1.PAS

Pascal/Delphi Source File | 1991-03-17 | 15.5 KB | 517 lines

Unit kb1 ;

interface

Uses
 Crt, Graph, Globals, Legal_U, Replay, LoadSave, Moves, TBMoves, Draw_Pcs;

procedure Get_Keyboard ( var Game_State : Game_State_Type ) ;

{ --------------------------------------------------------------- }

implementation

Type

    Piece_Select_Type = record
        Selected : boolean;
        Coords   : Coord_Type;
    end;


procedure  Arrow_Moves(var Cursor: Coord_Type; Piece_Select: Piece_Select_Type);

{   Author:  Jonathan Loux
    Purpose: To update cursor positions on the board.
    Pre:     Old Cursor coordinates.
    Post:    Updated Cursor coordinates and put to board.

}
var
   Choice : char;

begin
   Choice:= readkey;
   with Cursor do
   begin
      Border_Square(Convert_File(xFile), Convert_Rank(Rank),brown);
      case ord(Choice) of
            75      :  if Rank > 1 then dec(Rank)        {left}
                       else  beep;

                77      :  if Rank < 8 then inc(Rank)        {right}
                       else  beep;

            71      :  if (Rank > 1) and (xFile > 'a') then
                          begin
                             dec(Rank);
                             dec(xFile);                   {Home}
                          end
                       else
                             beep;

                72      :  if xFile > 'a' then dec(xFile)    {up}
                              else  beep;

            73      :  if (Rank < 8) and (xFile > 'a') then
                       begin
                          inc(Rank);                   {PgUp}
                          dec(xFile)
                       end
                       else beep;

            79      :  if (Rank > 1) and (xFile < 'h') then
                       begin
                          dec(Rank);                      {End}
                          inc(xFile)
                       end
                       else  beep;

                80      :  if xFile < 'h' then inc(xFile)    {down}
                              else  beep;

            81      :  if (Rank < 8) and (xFile < 'h') then
                       begin
                          inc(Rank);                     {PgDn}
                          inc(xFile)
                       end
                       else beep;
            117     :  begin
                          Rank:= 1;
                          xFile:= 'h'
                       end;
            118     :  begin
                          Rank:= 8;
                          xFile:= 'h'
                       end;
            119     :  begin
                          Rank:= 1;
                          xFile:= 'a'
                       end;
            132     :  begin
                          Rank:= 8;
                          xFile:= 'a';
                       end;
      end;  {case}
     Border_Square(Convert_File(xFile),Convert_Rank(Rank), yellow);
   end;  {with}
end;     {Arrow_Moves}

{-------------------------------------------------------------------------}


procedure Beep2;

begin
   sound(50);
   delay(200);
   nosound;
end;   {beep2}


{-------------------------------------------------------------------------}


procedure Beep4;

begin
   sound(50);
   delay(50);
end;


{-------------------------------------------------------------------------}


procedure Select_A_Piece(Square: Coord_Type; PColor: integer; A_Piece: Piece_Type);

begin
   with Square do
      case A_Piece of
         pawn    : Draw_Pawn(xFile,Rank,PColor);
         rook    : Draw_Rook(xFile,Rank,PColor);
         knight  : Draw_Knight(xFile,Rank,PColor);
         bishop  : Draw_Bishop(xFile,Rank,PColor);
         queen   : Draw_Queen(xFile,Rank,PColor);
         king    : Draw_King(xFile,Rank,PColor);
      end  {case}
end;   {S_A_P}

{-------------------------------------------------------------------------}


procedure Deselect(GS : Game_State_Type; var PS: Piece_Select_Type;
                   Curr_Move : Move_Type; Message: string);

begin
   with GS do  with PS do  with Curr_Move do
   begin
       Selected:= false;
       if Board[Coords.xFile,Coords.Rank].side = white then
          Select_A_Piece(Coords,15,Move_Piece)
       else
          Select_A_Piece(Coords,0,Move_Piece);
       Error_Display(Message);
   end
end;




{-------------------------------------------------------------------------}


procedure Check_Move_Piece(var Game_State: Game_State_Type;
                                    var Curr_Move: Move_Type;
                                    var Cursor : Coord_Type;
                                    var Piece_Select : Piece_Select_Type;
                           var Legal : Boolean);
{
  Author:  Jonathan Loux

  Purpose: Checks if a piece is selected or not.  If it isn't then it is
           selected to be moved.  Once one is selected, the procedure
           checks if the square to where the piece is to be moved is not
           the same as the piece.  If it is and the game mode is novice then
           the piece is unselected, otherwise it is not a valid key.

  Pre:     Old Game_State
           Curr_Move = Null or coordinates of piece to move
           Cursor = coordinates of the piece to move
           Piece_Select = true if selected, false if not

  Post:    Game_State is changed in Handle_Move_Request
           Curr_Move = coords of piece to move or destination
           Cursor = coordinates of the piece to move
           Piece_Select = true if selected and not moved yet, false if
                          deselected or moved.
}


var
  count : integer;
  A_Piece: Piece_Type;

begin
    with Game_State do
    begin
      if Piece_Select.Selected = false then
         {-------- Selecting a piece ---------------}
      begin
         if  board[Cursor.xFile,Cursor.Rank].Side = Side_to_move then
   {-- piece to be selected must be on the same side as Side to move --}
         begin
             Piece_Select.Selected:= true;
          A_Piece:= board[Cursor.xFile,Cursor.Rank].Piece;
             Piece_Select.Coords.Rank:= Cursor.Rank;
             Piece_Select.Coords.xFile:= Cursor.xFile;
          Select_A_Piece(Piece_Select.Coords,14,A_Piece);
             with Curr_Move do
             begin    {---- set up initial coords of piece--}
                 From_F:= Cursor.xFile;
                 From_R:= Cursor.Rank;
                 Piece_Side:= Side_to_move;
                 Move_Piece:= A_Piece;
             Move_Kind:= Checkall;
             end;    {with}
          Legal_Move(Game_State,Curr_Move,Legal,count);
          if count = 0 then
             Deselect(Game_State,Piece_Select,Curr_Move,
                       'There are no legal moves for this piece.')
          else
             Error_Display('Piece Selected');
         end        {if board}
         else
   {-- if not the same side as side to move or empty square selected--}

             Error_Display('ERROR: Not a piece to move')
      end   {if selected}

      else
     {---- A PIECE HAS BEEN SELECTED >> coords of Cursor are checked if
           not the same as the piece   ------------------------------------}
          if (Cursor.xFile <> Piece_Select.Coords.xFile) or
           (Cursor.Rank <> Piece_Select.Coords.Rank) then
              begin
                  with Curr_Move do
                  begin
               {----------entering destination coordinates------}

                      To_F:= Cursor.xFile;
                      To_R:= Cursor.Rank;
                      Move_Kind:= normal;

                   end; {with}

           {------ checks if the move is legal ------------}

              Legal_Move(Game_State, Curr_Move, Legal, count);

                  if Legal = true then

           {------ if so then move is made -----------------}

                  begin
                      Handle_Move_Request(Game_State, Curr_Move, Move_History);
                      Piece_Select.Selected:= false;
                 Show_Text(Game_State,Move_History);
                 if Side_to_move = white then
                    Cursor.Rank:=4
                 else
                    Cursor.Rank:=5;
                 Cursor.xFile:= 'd';
                 with Cursor do
                 Border_Square(Convert_File(xFile),Convert_Rank(Rank),yellow);
                 if Curr_Move.Move_Kind = Check then
                   begin
                     if Curr_Move.Piece_Side = Black then
                         Error_Display('White is in Check')
                       else
                         Error_Display('Black is in Check');
                   end
                 else
                   if Curr_Move.Move_Kind <> Mate then
                   Error_Display('Move Completed.');

                  end
                  else
                      Error_Display('ERROR: Not a legal move');
              end  {if ok to move}

          else

         {------- if piece selected is selected again and mode = novice
                  then the piece is deselected ---------------------------}

          begin
              if Mode = novice then
              Deselect(Game_State,Piece_Select,Curr_Move,'Piece Deselected')
              else
                  Error_Display('ERROR: Not a legal move')
          end;  {else}
    end;       {the withs}
end;          {Check_Move_Piece}



{--------------------------------------------------------------------------}



procedure Check_Legal_Piece(Game_State : Game_State_Type;
                                     var Curr_Move : Move_Type;
                                     Cursor : Coord_Type;
                            Piece_Select: Piece_Select_Type);

{
   Author:  Jonathan Loux

   Purpose: Checks if the square selected has a piece from the same side as
            the side to move and then calls Legal Moves Request

   Pre:     Old Game_State
            Curr_Move = Null
            Cursor = Coords of the piece to check legal moves

   Post:    Game_State is unchanged
            Curr_Move = Coords of piece to check and the piece
            Cursor is unchanged
}

var legal : boolean;
    c:      integer;

begin
    with Game_State do  with Curr_Move do
        if board[Cursor.xFile,Cursor.Rank].Side = Side_to_move then
        begin
            From_F:= Cursor.xFile;
            From_R:= Cursor.Rank;
            Piece_Side:= Side_to_move;
         Move_Kind:= ShowLegal;
            Move_Piece:= board[Cursor.xFile,Cursor.Rank].Piece;
            Legal_Move(Game_State, Curr_Move, Legal,c);
        end
      else
        if Piece_Select.Selected = true then
            Error_Display('Invalid Key')
        else
            Error_Display('ERROR: Not a piece to move');
end;   {Check_Legal_Piece}




{------------------------------------------------------------------------}


procedure Handle_New_Game_Request(var Game_State: Game_State_Type);

var
   Choice : char;

begin
   InitGame(Game_State);
   Draw_Board(Game_State);
end;


{------------------------------------------------------------------------}


procedure Get_Keyboard (var Game_State: Game_State_Type);

{
   Author:  Jonathan Loux

   Purpose: Retrieves the information inputted from the keyboard.  The type
              of input is then processed and sent to the correct procedure.

   Pre:     Old Game_State

   Post:    End of game
}

var
   Legal    : Boolean;
   TempGS   : Game_State_Type;
   GameOver : boolean;
   AChoice,
    Choice: char;
    Cursor : Coord_Type;
    Piece_Select : Piece_Select_Type;

begin
   Legal := False;
   GameOver := False;
    Piece_Select.Selected:= false;
    with Game_State do
    begin
        Cursor.Rank:= 4;
        Cursor.xFile:= 'd';
      repeat
            Border_Square(Convert_File(Cursor.xFile),Convert_Rank(Cursor.rank), yellow);
            repeat
                Choice:= readkey;
                if not (ord(Choice) in [0,13,76..78,81..84,108..110,113..116])
            then  Error_Display('Invalid Key');
            until ord(Choice) in [0, 13, 76..78, 81..84, 108..110, 113..116];
            case ord(Choice) of
                 {----- Arrow  Keys ----------}

                0       :  Arrow_Moves(Cursor,Piece_Select);

                 {----- Move Request ---------}

                13      :  Check_Move_Piece(Game_State, Curr_Move, Cursor,
                                        Piece_Select, Legal);    {move request}

                 {----- Legal Move Request -------}

                77, 109 :  if Mode = novice then
                                    Check_Legal_Piece(Game_State, Curr_Move, Cursor,
                                              Piece_Select)
                              else
                           Error_Display('Invalid Key');    {legal moves}

                {-------- Load Request -------------}

                76, 108 :  if Piece_Select.Selected = false then
                                  Handle_Load_Request
                                  (Game_File, G, Game_State,Move_History)
                              else
                                  Error_Display('ERROR: Must finish move first');

                 {------ Save Request -----------------}

                83,115  :  if Piece_Select.Selected = false then
                                  Handle_Save_Request
                                   (Game_File, G, Game_State, Move_History)
                              else
                                  Error_Display('ERROR: Must finish move first');

                 {------ Replay Request -------------}

                82, 114 :  if Piece_Select.Selected = false
                              then  Handle_Replay_Request(Game_State)
                       else
                                  Error_Display('ERROR: Must finish move first');

                 {------ Take Back Request --------------}

                84, 116 :  if Mode = Novice  then
                              begin
                                 if Piece_Select.Selected = false
                                 then
                           begin
                             if Game_State.Move_Number > 1 then
                               Handle_Take_Back_Move_Request
                               (Game_State, Curr_Move, Move_History)
                             else
                               Error_Display('No moves to take back.')
                           end
                                 else
                                     Error_Display('ERROR: Must finish move first')
                              end   {if M = N }
                              else
                                  Error_Display('Invalid Key');

                {------- New Game Request ----------}

                78,110  : begin
                        AChoice := 'f';
                        while not (AChoice in ['y','Y','n','N']) do
                          begin
                            prompt('Save Game? (Y/N)');
                            AChoice := Readkey
                          end;
                        If AChoice in ['y','Y'] then
                           Handle_Save_Request(Game_File, G, Game_State, Move_History);

                        if Piece_Select.Selected = false then
                           Handle_New_Game_Request(Game_State)
                        else
                           Error_Display('ERROR: Must finish move first');
                      end;

                 {-------- Quit Game --------------}

            81,113  : begin
                        AChoice := 'f';
                        while not (AChoice in ['y','Y','n','N']) do
                          begin
                            prompt('Save Game? (Y/N)');
                            AChoice := Readkey
                          end;
                        If AChoice in ['y','Y'] then
                           Handle_Save_Request
                              (Game_File, G, Game_State, Move_History);
                      end
            end;  {case}
      GameOver := Curr_Move.Move_Kind=Mate;
      if GameOver then
        begin
          AChoice := 'f';
          while not (AChoice in ['Y','y','N','n']) do
            begin
              if Curr_Move.Piece_Side = white then
                prompt('Check Mate! White Wins! Play again? (Y/N)')
              else
                prompt('Check Mate! Black Wins! Play again? (Y/N)');
              AChoice := ReadKey;
              if AChoice in ['Y','y'] then
                begin
                  Handle_New_Game_Request(Game_State);
                  Show_Text(Game_State, Move_History);
                  GameOver := false;
                end;
            end;
        end;

        until (Choice in['Q', 'q']) or (GameOver);
    end;   {with}
end;   { Get_Keyboard}


end.   {KB1}