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

Pascal/Delphi Source File | 1991-03-17 | 14.8 KB | 612 lines

unit Globals;


interface


const
    Black_S     =   8 ; {Black square color (grey)}
    White_S     =   3 ; {White square color (cyan)}
    Black_P     =   0 ; {Black piece color (black)}
    White_P     =  15 ; {White piece color {white)}


type
   Piece_Type = (nopiece, pawn, rook, knight, bishop, queen, king);
   Side_Type = (noside, white, black);
   Mode_Type = (expert, novice, replaying);
   Flag_Type = (allowed, denied);
    Move_Kind_Type = (KSC,QSC,Capture,EPCapture,Normal,Check,Mate,
                     ShowLegal, Checkall);
   Move_Type = record
      From_F  : char;
      From_R  : integer;
      To_F    : char;
      To_R    : integer;
      Piece_Side: Side_Type;
      Move_Piece: Piece_Type;
      Take_Piece: Piece_Type;
      Move_Kind:  Move_Kind_Type;

      Move_Desc:  string[21];
   end;
   Position_Type = record
      Side:  Side_Type;
      Piece: Piece_Type;
   end;
   Move_History_Type = array[1..300] of Move_Type;
   Coord_Type = record
      XFile: char;
      Rank: integer;
   end;
   Coord_List_Type = array[1..27] of Coord_Type;
   Game_State_Type = record
      Side_to_Move:  Side_Type;
      Move_Number:   1..300;
      Mode:  Mode_Type;
      Game_Started:  boolean;
      WKSC_flag,
      BKSC_flag,
      WQSC_flag,
      BQSC_flag:  Flag_Type;
      WEP_flag,
      BEP_flag:   array['a'..'h'] of Flag_Type;
      FileName,
      Comment:  string;
      board:    array['a'..'h',1..8] of Position_Type;
   end;
   GRecord = record
      Game_State:  Game_State_Type;
      Move_History: Move_History_Type;
   end;
   GFile = file of GRecord;
   FArray = array[1..50] of string;


var
   Game_State:  Game_State_Type;
   Curr_Move:   Move_Type;
   Move_History: Move_History_Type;
   Coord_List:   Coord_List_Type;
   Game_File:    GFile;
   G:            GRecord;


Procedure   Border_Square( row, col: integer; scolor : word);

Procedure   HiLite_List(List : Coord_List_Type; Count : integer);

Procedure    InitScrn ;

Procedure    EndPrompt ;

Procedure   Beep;

Procedure   Prompt(PLine : String);

Procedure   Query(PLine : String; var Reply : String);

Procedure   Error_Display(Err : String);

Procedure   InitGame (var Game_State:Game_State_Type) ;

Function    Convert_Row(Row : char ) : integer;

Function    Convert_Col(Col : integer) : integer;

Function    Convert_File (xFile : char   ) : integer;

Function    Convert_Rank (Rank  : integer) : integer;

Procedure   Show_Text(var GS : Game_State_Type; var MH : Move_History_Type);

implementation

Uses
    Crt,Graph ;

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


procedure Border_Square( row, col: integer; scolor : word);

var
  c, r : integer;
begin
   SetColor(sColor);
   SetLineStyle(0,0,1);
   Line(Col, Row, Col+ 34, Row);
   Line(Col, Row+30, Col+34, Row+30);
   Line(Col, Row, Col, Row+30);
   Line(Col+34, Row, Col+34, Row+30);
end;


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


procedure HiLite_List(List : Coord_List_Type; Count : integer);

  { HiLite_List           Author: Pete Davis
    Hilight all squares from the legal moves list.
  }

var
  Index : integer;
begin
  for Index := 1 to Count do
    Border_Square(Convert_File(List[index].XFile), Convert_Rank(List[index].Rank), 15);

  while not keypressed do begin end;

  for Index := 1 to Count do
    Border_Square(Convert_File(List[index].XFile), Convert_Rank(List[index].Rank), Brown);
end;



procedure EgaVga; external;

{ EGAVGA           Author: Pete Davis  (Actually, Borland wrote it.)
  Import EGAVGA support into the program }
{$L EGAVGA.OBJ }

procedure Goth; external;

{ Same as above, except it imports that eye-catching gothic
  character set.
}
{$L GOTH.OBJ }

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

procedure InitScrn;

{ InitScrn                    Author: Pete Davis
  Set the screen up in EGA mode and set-up the gothic character set.
  }
var
  driver,
  mode,
  result : integer;

begin
  If RegisterBGIdriver(@EgaVga) < 0 then
    begin
      writeln('Graphics driver could not be loaded. You MUST');
      writeln('be using a VGA or EGA screen to run this program!');
      halt(1);
    end;

  result := RegisterBGIfont(@Goth);

  driver := EGA;
  mode := EgaHi;
  DirectVideo := false ;
  InitGraph(driver, mode, '');
end;

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

Procedure EndPrompt;
begin;
    SetTextStyle(DefaultFont,0,1);
    OutTextXY(205,295,'Press <ENTER> to exit');
    Readln;
    Closegraph;
   TextMode(C80);
   gotoxy(2,2);
    Writeln('Thank you for using Chess-Ter (copyright 1990) The Pascal Team') ;
end;


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

procedure Beep;

begin
   sound(200);
   delay(150);
   nosound;
end;

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


procedure Prompt(PLine : String);

{ Prompt           Author: Pete Davis
  Put's a message on line 23 of the screen. Message is auto-centered.
}
begin
  gotoxy((40-(length(PLine) div 2)), 23);
  textcolor(yellow);
  write(PLine);
  gotoxy(1,23);
  while not keypressed do begin end;
  write('                                                                            ');
end;

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

procedure Query(PLine : String; var Reply : String);

{ Query          Author: Pete Davis
   Put's a message on line 23 of the screen. Message is auto-centered.
   The procedure returns a user-supplied reply to the calling procedure.
}
begin
  gotoxy((40-(length(PLine) div 2)), 23);
  textcolor(yellow);
  write(PLine+': ');
  readln(Reply);
end;

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

procedure Error_Display(Err : String);

{ Error_Display           Author: Pete Davis
  Used to display error-messages, mainly. Outputs a centered
  message on line 23 of the screen, in red and supplies a beep.
}
begin
  gotoxy((40-(length(Err) div 2)), 23);
  textcolor(12);
  write(err);
  beep;
  gotoxy(1,23);
  while not keypressed do begin end;
  write('                                                                            ');
end;


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

Procedure InitGame ( var Game_State:Game_State_Type) ;
var
   ch,
   F : char ;
   R : byte ;

begin
   window(1,1,80,25);
   textcolor(0);
   clrscr;
   textcolor(Yellow);
   SetFillStyle(8,Blue);
   FillEllipse(325,175,300,100);
   SetTextStyle(GothicFont, HorizDir, 12);
   SetColor(Yellow);
   OutTextXY(40,100,'Chess-Ter');
   SetTextStyle(DefaultFont, HorizDir, 1);
   OutTextXY(370,220,'(C) 1990 The Pascal Team');
   with Game_State do
   begin
      repeat
        Prompt('Default mode is Novice, do you want to play in Expert Mode ? (y/n)');
        ch:= readkey;
        if not (ch in['y','Y','n','N']) then   BEEP;
      until ch in['y','Y','n','N'];
      TextColor(0);
      clrscr;
      TextColor(15);
      Curr_Move.Move_Kind := Normal ;
      Side_to_move := white ;
      Move_number := 1 ;
      if    ch in ['y','Y'] then Mode:=  expert
      else  Mode:= novice;

      Game_Started := false ;
      WKSC_flag := allowed ;
      BKSC_flag := allowed ;
      WQSC_flag := allowed ;
      BQSC_flag := allowed ;

      for F := 'a' to 'h' do
      begin
             WEP_flag[F] := denied ;
             BEP_flag[F] := denied ;
      end;

      for F := 'a' to 'h' do
         for R := 1 to 8 do
         begin
            board[F,R].piece := nopiece ;

            If (R = 1) or (R = 2)
            then
               board[F,R].Side := white
            else
            If (R = 7) or (R = 8)
            then
               board[F,R].Side := black
            else
               board[F,R].Side := noside ;
            end;

            FileName := '' ;
            Comment  := '' ;

            {* White positions *}
               board['a',1].Piece := rook ;
               board['b',1].Piece := knight ;
               board['c',1].Piece := bishop ;
               board['d',1].Piece := queen ;
               board['e',1].Piece := king ;
               board['f',1].Piece := bishop ;
               board['g',1].Piece := knight ;
               board['h',1].Piece := rook ;
               for F := 'a' to 'h' do
                  board[F,2].Piece := pawn ;

            {* Black positions *}
               board['a',8].Piece := rook ;
               board['b',8].Piece := knight ;
               board['c',8].Piece := bishop ;
               board['d',8].Piece := queen ;
               board['e',8].Piece := king ;
               board['f',8].Piece := bishop ;
               board['g',8].Piece := knight ;
               board['h',8].Piece := rook ;

               for F := 'a' to 'h' do
                  board[F,7].Piece := pawn ;
          SetTextStyle(GothicFont, HorizDir, 4);
          SetColor(15);
          OutTextXY(210,10,'Chess-Ter 1.0');
        end ;
end;

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


Function  Convert_Row(Row : char ) : integer;
{
  Convert a letter coordinate to screen coordinate by finding
  value of row.
  NOTE : it is assumed that the board starts at
  180 (column)
  050 (row)
}

begin
  Convert_Row := ((ord(row)-65)*30 + 50) ;
end; {* Convert_Row *}

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

Function  Convert_Col(Col : integer) : integer;
{
  Convert a letter coordinate to screen coordinate by finding
  value of column.
  NOTE : it is assumed that the board starts at
  180 (column)
  050 (row)
}

begin
  Convert_Col := (Col-1)*35 + 166 ;
end; {* Convert_Col *}


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

Function     Convert_Rank
                (      rank    : integer    ) {* rank number *}
                                : integer    ; {* row coord   *}
    {
        Convert a rank designation [1..8] into the appropriate
        screen coordinate.  File is used in the standard chess
        terminology meaning row.  Because the board is rotated,
        each rank is a column.

        Starting column is assumed to be at 166, therefore, the
        leftmost    rank (1) is at 166, rank (2) is at 201, etc.
    }

begin {* Convert_Rank *}

    Convert_Rank := 166 + ((rank-1) * 35) ;

end;  {* Convert_Rank *}

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

Function  Convert_File
                (    xFile    : char        ) {* file letter *}
                                : integer    ; {* col coord   *}
    {
        Convert a file designation [a..h] into the appropriate
        screen coordinate.  Rank is used in the standard chess
        terminology meaning row.  Because the board is rotated,
        each file is a row.

        Starting row is assumed to be at 50, therefore file (A)
        is at 50, file (B) is at 80, etc.
    }

begin {* Convert_File *}

    Convert_File := 50 + ((ord(xFile) - 97) * 30) ;

end;  {* Convert_File *}

{ ------------------------------------------------------------- }
Procedure Display_Move_History(var GS : Game_State_Type;var MH : Move_History_Type);

{ Display_Move_History         Author: Pete Davis
  Displays the move history for both players on either side of the
  screen.
}
var
  Start,
  Count : integer;

begin
  {Clear old move history data}
  TextColor(0);
  window(1,4,20,22);
  clrscr;
  window(59,4,80,22);
  clrscr;
  window(1,1,80,25);
  directvideo:= false;
  textcolor(15);
  gotoxy(3,3);
  write('White Moves');
  gotoxy(61,3);
  write('Black Moves');
  Start := (GS.Move_Number-1) - 34;
  if Start < 1 then Start :=1;
  for Count := Start to (GS.Move_Number-1) do
    begin
      with MH[Count] do
        if odd(Count) then
          begin
            gotoxy(1,5+((count-start) div 2));
            write(Move_Desc);
          end
        else
          begin
            gotoxy(58,5+((count-start) div 2));
            write(Move_Desc);
            write;
          end
    end;
end;

procedure Show_Text(var GS : Game_State_Type; var MH : Move_History_Type);

{ Show_Text         Author: Pete Davis

  Displays and updates all necessary text on the screen. Uses
  var parameters to avoid stack overflow.
}

begin
  SetTextStyle(GothicFont, HorizDir, 4);
  SetColor(15);
  OutTextXY(210,10,'Chess-Ter 1.0');
  if GS.Mode = expert then
    begin
      DirectVideo := false;
      gotoxy(6,25);
      TextColor(12);
      write('L');
      TextColor(9);
      write('oad');
      gotoxy(19,25);
      TextColor(12);
      write('S');
      TextColor(9);
      write('ave');
      gotoxy(34,25);
      TextColor(12);
      write('R');
      TextColor(9);
      write('eplay');
      gotoxy(50,25);
      TextColor(12);
      write('N');
      TextColor(9);
      write('ew Game');
      gotoxy(68,25);
      TextColor(12);
      write('Q');
      TextColor(9);
      write('uit');
      textcolor(3);
      gotoxy(3,24);
      write('Filename: ');
      write(GS.FileName);
      gotoxy(60,24);
      textcolor(3);
      write('Expert');
      gotoxy(33,24);
      textcolor(15);
      case GS.Side_To_Move of
        white : write('White''s Move');
        black : write('Black''s Move');
      end;
    end;

  if GS.Mode = novice then
    begin
      DirectVideo := false;
      gotoxy(4,25);
      TextColor(12);
      write('L');
      TextColor(9);
      write('oad');
      gotoxy(11,25);
      TextColor(12);
      write('S');
      TextColor(9);
      write('ave');
      gotoxy(19,25);
      TextColor(12);
      write('R');
      TextColor(9);
      write('eplay');
      gotoxy(29,25);
      TextColor(12);
      write('T');
      TextColor(9);
      write('akeback');
      gotoxy(41,25);
      write('legal ');
      TextColor(12);
      write('M');
      TextColor(9);
      write('oves');
      gotoxy(56,25);
      TextColor(12);
      write('N');
      TextColor(9);
      write('ew Game');
      gotoxy(68,25);
      TextColor(12);
      write('Q');
      TextColor(9);
      write('uit');
      textcolor(3);
      gotoxy(3,24);
      write('Filename: ');
      write(GS.FileName);
      gotoxy(60,24);
      textcolor(3);
      write('Novice');
      gotoxy(33,24);
      textcolor(15);
      case GS.Side_To_Move of
        white : write('White''s Move');
        black : write('Black''s Move');
      end;
    end;

  if GS.Mode = Replaying then
    begin
      DirectVideo := false;
      gotoxy(1,25);
      TextColor(0);
      write('                                                                         ');
      textcolor(3);
      gotoxy(3,24);
      write('Filename: ');
      write(GS.FileName);
      gotoxy(33,24);
      textcolor(0);
      write('             ');
      gotoxy(60,24);
      textcolor(3);
      write('Replay');
    end;
  Display_Move_History(GS, MH);
end;


end.   {Globals}