home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 10.ddi / CHESS.ZIP / CHESSINF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  25.2 KB  |  915 lines

  1. {************************************************}
  2. {                                                }
  3. {   Chess - Shared DLL Example                   }
  4. {   CHESS.DLL Implementation file.               }
  5. {   Copyright (c) 1992 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit ChessInf;
  10.  
  11. {$R-,Q-,S-,W-}
  12.  
  13. interface
  14.  
  15. type
  16.   TPiece = (pEmpty, pKing, pQueen, pRook, pBishop, pKnight, pPawn);
  17.   TColor = (cWhite, cBlack);
  18.   TKind  = (kNormal, kEnPassant, kCastling, kPawnPromote);
  19.   HChess = Word;
  20.  
  21. type
  22.   TSquare = record
  23.     Piece: TPiece;
  24.     Color: TColor;
  25.   end;
  26.   TBoard = array[1..8,1..8] of TSquare;
  27.  
  28.   TLocation = record
  29.     X: 0..8;            { 0 is off-board or empty }
  30.     Y: 0..8;            { 0 is off-board or empty }
  31.   end;
  32.  
  33.   PChange = ^TChange;
  34.   TChange = record
  35.     Piece: TPiece;
  36.     Source: TLocation;
  37.     Dest: TLocation;
  38.   end;
  39.  
  40.   PMove = ^TMove;
  41.   TMove = record
  42.     Change: TChange;
  43.     Capture: Boolean;
  44.     Contents: TPiece;
  45.     case Kind: TKind of
  46.       kEnPassant: (EPCapture: TLocation);
  47.       kCastling: (RookSource, RookDest: TLocation);
  48.   end;
  49.  
  50. type
  51.   TSearchStatus = (
  52.     ssComplete,                 { Completed last opperation }
  53.     ssMoveSearch,               { Searching for a move for the current
  54.                                   player }
  55.     ssThinkAhead,               { Thinking ahead while waiting for a
  56.                                   SubmitMove }
  57.     ssGameOver                  { Game is complete }
  58.   );
  59.  
  60.   TChessStatus = (
  61.     csNormal,                   { Nothing is special about the current state }
  62.     csCheck,                    { The current player is in check }
  63.     csCheckMate,                { The current player is in checkmate }
  64.     csStaleMate,                { The game is a stalemate }
  65.     csResigns,                  { The opponent is so far ahead there is no
  66.                                   point in playing the game further }
  67.     csMateFound,                { Checkmate will happen in a maximum of
  68.                                   Count moves (Count is a parameter of
  69.                                   GetChessStatus) }
  70.     csFiftyMoveRule,            { The game violates the 50 move rule
  71.                                   (stalemate) }
  72.     csRepetitionRule);          { The game violates the 3 repetition rule
  73.                                   (stalemate) }
  74.  
  75. type
  76.   TChessError = (
  77.                                 { General results }
  78.     ceOK,                       { Request sucessful }
  79.     ceInvalidHandle,            { Handle passed is not valid }
  80.     ceIllegalState,             { Call not legal in current state }
  81.  
  82.                                 { NewGame results }
  83.     ceOutOfMemory,              { Not enough memory to allocate game context }
  84.     ceTooManyGames,             { Not enough game handles for new game }
  85.  
  86.                                 { SubmitMove/VarifyMove/ParseMove results }
  87.     ceInvalidMove,              { Cannot move specified piece there }
  88.     ceIllegalMove,              { Move into or does not prevent check or
  89.                                   castling through check }
  90.  
  91.                                 { VerifyMove results }
  92.     ceInvalidSyntax,            { Move syntax cannot be determined }
  93.     ceAmbiguousMove,            { More then one piece fits move (i.e. if you
  94.                                   pass in NF3 and two Knights can be there) }
  95.  
  96.                                 { RetractMove results }
  97.     ceNoMovesLeft);             { No moves left to retract }
  98.  
  99. { Game handle management }
  100.  
  101. { Allocates a game handle }
  102. function NewGame(var GameHandle: HChess): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  103.  
  104. { Frees the game handle }
  105. function DisposeGame(CH: HChess): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  106.  
  107.  
  108. { Move management }
  109.  
  110. { Parses the given Move into a change record. The syntax is as follows:
  111.  
  112.      <Location> | <Piece name><Location> | <Location><Location>
  113.  
  114.   where <Location> is in the form A3 or F5 and <Piece letter> is one of:
  115.  
  116.     P = Pawn, R = Rook, N = Knight, B = Biship, Q = Queen, K = King
  117.  
  118.   If only a Location is given and the move is ambigious it is assumed the
  119.   piece being moved is a pawn }
  120.  
  121. function ParseMove(Move: PChar; var Change: TChange): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  122.  
  123. { Retracts the last move.  NOTE: Retract move should not be called
  124.   during a search! }
  125. function RetractMove(CH: HChess; const Move: TMove): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  126.  
  127. { Submits a move for the current player.  Both the "Piece" field and
  128.   the "From" field can be empty if the move is unambigious.  This is
  129.   only legal to call while idle or during a "think ahead" }
  130. function SubmitMove(CH: HChess; const Change: TChange): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  131.  
  132. { Verify the legality of the given change but do not perform the
  133.   change.  The "Source" and "Piece" fields can be empty if move is
  134.   unambigious. This is only legal to call while complete or during a
  135.   "think ahead" }
  136. function VerifyMove(CH: HChess; const Change: TChange): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  137.  
  138.  
  139. { Search management }
  140.  
  141. { Starts a move search.  It will always return immediately.  You need
  142.   to call Think to perform the actual search. TimeLimit is in 1/18ths
  143.   of a second. }
  144. function ComputerMove(CH: HChess; TimeLimit: LongInt): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  145.  
  146. { Force the computer to make a move with the information it has now.
  147.   The move will be completed with the next call to Think. This is only
  148.   legal while performing a move search }
  149. function ForceMove(CH: HChess): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  150.  
  151. { Start using the Think time to begin a search assuming the opponent is
  152.   going to follow the main line.  If the opponent does, the next search
  153.   will start at the think-ahead point, otherwise a new search is started.
  154.   This is only legal to call while idle }
  155. function ThinkAhead(CH: HChess): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  156.  
  157.  
  158. { Aborts the current search being performed whether started with ThinkAhead
  159.   or ComputerMove.  The move under consideration is not performed and the
  160.   player is unchanged.  This call is ignored if no search is active }
  161. function AbortSearch(CH: HChess): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  162.  
  163. { Chess process management }
  164.  
  165. { Gives TimeLimit ticks to the computer to think (1/18'ths of a second).
  166.   This call performs the move search.  Think should be called whenever
  167.   the chess program is idle, even while waiting for the opponent.
  168.   The engine utilizes the opponents idle time to "look ahead" to
  169.   improve the results of the next move. The number given in TimeLimit
  170.   should be small (below 10 when searching for a computer move, below
  171.   5 when waiting for the opponent) to allow the rest of the app to be
  172.   responsive.  This is especially important in Windows.  }
  173. function Think(CH: HChess; TimeLimit: LongInt;
  174.   var Status: TSearchStatus): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  175.  
  176.  
  177. { Board editing }
  178.  
  179. { !!! NOTE: Board editing routines are not valid during a search }
  180.  
  181. { Replace the current board with the given board }
  182. function SetBoard(CH: HChess; const ABoard: TBoard): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  183.  
  184. { Set the current player to Player }
  185. function SetPlayer(CH: HChess; APlayer: TColor): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  186.  
  187. { Make the following modification to the board.  If the "Source" Location
  188.   is blank the piece is new, if the "Dest" Location is blank the piece is
  189.   taken from the board. If neither are blank the piece is moved.  If the
  190.   piece type does not match the piece in the Source location, the piece
  191.   is changed to be the given type }
  192. function MakeChange(CH: HChess; Color: TColor;
  193.   const Change: TChange): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  194.  
  195.  
  196. { Status interface }
  197.  
  198. { Returns the status of the move search }
  199. function GetSearchStatus(CH: HChess): TSearchStatus; {$IFDEF WINDOWS} export; {$ENDIF}
  200.  
  201. { Returns the current status of the game }
  202. function GetChessStatus(CH: HChess; var Count: Integer): TChessStatus; {$IFDEF WINDOWS} export; {$ENDIF}
  203.  
  204. { Format the move as a text string }
  205. function MoveToStr(const Move: TMove; var Str: array of Char): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  206.  
  207. { !!! NOTE: These functions are not valid to call during a search. }
  208.  
  209. { Returns the last move }
  210. function GetLastMove(CH: HChess; var Move: TMove): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  211.  
  212. { Returns the hint move }
  213. function GetHintMove(CH: HChess; var Move: TMove): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  214.  
  215. { Returns the current state of the board.  If a search is being performed
  216.   it is the state of the board that is being searched. }
  217. function GetBoard(CH: HChess; var ABoard: TBoard): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  218.  
  219. { Return the whose turn it is }
  220. function GetPlayer(CH: HChess): TColor; {$IFDEF WINDOWS} export; {$ENDIF}
  221.  
  222. { Returns a list of the valid given Change.  Empty fields in the change
  223.   record are used as wildcards in the search.  For example, if you
  224.   want all the legal pawn moves only fill in the Piece field leaving
  225.   the Location fields blank.  If you want all the legal moves for the
  226.   piece on A4, fill in Source with A4 and leave Piece and Dest blank.
  227.   Leaving all fields of Change blank will return all legal moves }
  228. function GetValidMoves(CH: HChess; Change: TChange;
  229.   var Moves: array of TMove): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  230.  
  231. { !!! NOTE: This function are only meaningful during a search }
  232.  
  233. { Returns the current move being searched by the computer }
  234. function GetCurrentMove(CH: HChess; var Move: TMove): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  235.  
  236. { Returns the current priciple line being used by the computer. }
  237. function GetMainLine(CH: HChess; var Value: Integer;
  238.   var Line: array of TMove): TChessError; {$IFDEF WINDOWS} export; {$ENDIF}
  239.  
  240. { Returns the number of nodes processed during the last (or current)
  241.   search }
  242. function GetNodes(CH: HChess): LongInt; {$IFDEF WINDOWS} export; {$ENDIF}
  243.  
  244. implementation
  245.  
  246. uses GameRec, LBoard, LMoveGen, LOpenLib, LMoves, Strings, TaskMgr,
  247.   LEval, GameTask;
  248.  
  249.  
  250. const
  251.   PieceLetter: array[TPiece] of Char =
  252.     (' ', 'K', 'Q', 'R', 'B', 'N', 'P');
  253.  
  254.  
  255. { Internal verification routines }
  256.  
  257. function LoadGameHandle(CH: HChess): Boolean;
  258. begin
  259.   if (CH >= 1) and (CH <= MaxGames) and
  260.     (GameList[CH].Magic = gmGameMagic) then
  261.   begin
  262.     LoadGameHandle := True;
  263.     CCHandle := CH;
  264.     CC := GameList[CCHandle];
  265.   end
  266.   else
  267.     LoadGameHandle := False;
  268. end;
  269.  
  270. procedure StoreGameHandle;
  271. begin
  272.   GameList[CCHandle] := CC;
  273. end;
  274.  
  275. { Utility functions }
  276.  
  277. function OppColor(Color: TColor): TColor;
  278. begin
  279.   if Color = cWhite then OppColor := cBlack else OppColor := cWhite;
  280. end;
  281.  
  282. { Internal vs. External representation conversion }
  283.  
  284. procedure ICoordToECoord(ICoord: Byte; var Location: TLocation);
  285. begin
  286.   if ICoord and $88 <> 0 then
  287.   begin
  288.     Location.X := 0;
  289.     Location.Y := 0;
  290.   end
  291.   else
  292.   begin
  293.     Location.X := ICoord and $F + 1;
  294.     Location.Y := ICoord shr 4  + 1;
  295.   end;
  296. end;
  297.  
  298. function ECoordToICoord(const Location: TLocation): Byte;
  299. begin
  300.   ECoordToICoord := (Location.X - 1) or (Location.Y - 1) shl 4;
  301. end;
  302.  
  303. { Convert an TChange into a MoveType.  Fills in just the partial
  304.   information enough for MoveCheck to fill in the rest }
  305. procedure ChangeToMoveType(const Change: TChange; var IMove: MoveType);
  306. begin
  307.   with Change, IMove do
  308.   begin
  309.     if Source.X <> 0 then
  310.       Old := ECoordToICoord(Change.Source)
  311.     else
  312.       Old := $08;
  313.     if Dest.X <> 0 then
  314.       New1 := ECoordToICoord(Dest)
  315.     else
  316.       New1 := $08;
  317.     MovPiece := PieceType(Piece);
  318.     Spe := False;
  319.     Content := Empty;
  320.   end;
  321. end;
  322.  
  323. procedure MoveTypeToTMove(const IMove: MoveType; var EMove: TMove);
  324.  
  325.   { Calculates the Locations for the Rook Move in a castling }
  326.   procedure GenCastLocation(New1 : SquareType; var CastLocation,
  327.     CornerLocation : SquareType);
  328.   begin
  329.     if (New1 and 7) >= 4 then
  330.     begin
  331.       CastLocation := New1 - 1;
  332.       CornerLocation := New1 + 1;
  333.     end
  334.     else
  335.     begin
  336.       CastLocation := New1 + 1;
  337.       CornerLocation := New1 - 2;
  338.     end;
  339.   end; { GenCastLocation }
  340.  
  341. var
  342.   EpLocation: SquareType;
  343.   CastLocation, CornerLocation: SquareType;
  344. begin
  345.   with IMove, EMove do
  346.   begin
  347.     Change.Piece := TPiece(MovPiece);
  348.     ICoordToECoord(Old, Change.Source);
  349.     ICoordToECoord(New1, Change.Dest);
  350.  
  351.     { Capture moves }
  352.     Contents := TPiece(Content);
  353.     Capture := Content <> Empty;
  354.  
  355.     { Process special moves }
  356.     if not Spe then
  357.       Kind := kNormal
  358.     else
  359.       if MovPiece = King then
  360.       begin
  361.  
  362.         { Castling Move }
  363.         Kind := kCastling;
  364.         GenCastLocation(New1, CastLocation, CornerLocation);
  365.         ICoordToECoord(CornerLocation, RookSource);
  366.         ICoordToECoord(CastLocation, RookDest);
  367.       end
  368.       else
  369.         if MovPiece = Pawn then
  370.         begin
  371.  
  372.           { E.P. capture }
  373.           Capture := True;
  374.           Kind := kEnPassant;
  375.  
  376.           EpLocation := (New1 and 7) + (Old and $70);
  377.           ICoordToECoord(EpLocation, EPCapture);
  378.         end
  379.         else
  380.  
  381.           { Pawn-promotion }
  382.           Kind := kPawnPromote;
  383.   end;
  384. end;
  385.  
  386.  
  387. { Interface implementation }
  388.  
  389. function NewGame(var GameHandle: HChess): TChessError;
  390. var
  391.   X: Integer;
  392. begin
  393.   NewGame := ceOK;
  394.   GameHandle := 0;
  395.   X := 0;
  396.   repeat
  397.     Inc(X);
  398.   until (X > MaxGames) or (GameList[X].Magic <> gmGameMagic);
  399.   if X > MaxGames then
  400.   begin
  401.     NewGame := ceTooManyGames;
  402.     Exit;
  403.   end;
  404.  
  405.   CCHandle := X;
  406.   GameHandle := X;
  407.   CC := GameList[CCHandle];
  408.  
  409.   { Initiallize everything to zero }
  410.   FillChar(CC, SizeOf(TGameData), 0);
  411.  
  412.   with CC do
  413.   begin
  414.     Magic := gmGameMagic;
  415.     Level := Normal;                   { set Level }
  416.     AverageTime := 15000;
  417.     MaxLevel := MaxPly;
  418.     InitBoard;
  419.     Player := White;
  420.     Opponent := Black;
  421.     ProgramColor := White;
  422.     ResetMoves;
  423.     UseLib := 200;
  424.     MovTab[-1].Content := King;
  425.     InitChessTime;
  426.     MoveNo := 0;
  427.     ClearHint;
  428.     PlayerMove := ZeroMove;
  429.     Nodes := 0;
  430.     Clock.Init;
  431.     Clock.Reset;
  432.     Clock.SetLimit(180);   { max 10 seconds per turn }
  433.  
  434.     State := [];
  435.     AllocateTask(20000);
  436.  
  437.     Spawn(DoGameTask);    { Assumes it will immediatly block on a message }
  438.   end;
  439.   StoreGameHandle;
  440. end;
  441.  
  442. function DisposeGame(CH: HChess): TChessError;
  443. begin
  444.   DisposeGame := ceInvalidHandle;
  445.   if LoadGameHandle(CH) then
  446.   begin
  447.     DisposeGame := ceOK;
  448.     DisposeTask;
  449.     GameList[CCHandle].Magic := 0;
  450.     CCHandle := 0;
  451.   end;
  452. end;
  453.  
  454.  
  455. { Converts the Location indicator from its input form to a form that the
  456.   Analysis part of the program understands }
  457. procedure CalcLocation(X, Y: Char; var Location: TLocation);
  458. begin
  459.   if (X in ['A'..'H']) and (Y in ['1'..'8']) then
  460.   begin
  461.     Location.X := ord(X) - ord('A') + 1;
  462.     Location.Y := ord(Y) - ord('1') + 1;
  463.   end
  464.   else
  465.   begin
  466.     Location.X := 0;
  467.     Location.Y := 0;
  468.   end;
  469. end;
  470.  
  471. function ParseMove(Move: PChar; var Change: TChange): TChessError;
  472. var
  473.   APiece: TPiece;
  474. begin
  475.    ParseMove := ceInvalidSyntax;
  476.    with Change do
  477.    begin
  478.      Source.X := 0;
  479.      Dest.X := 0;
  480.      Piece := pEmpty;
  481.  
  482.      case StrLen(Move) of
  483.        4: { Two Locations (e2e4) }
  484.          begin
  485.            CalcLocation(UpCase(Move[0]),Move[1], Change.Source);
  486.            if Source.X = 0 then Exit;
  487.            CalcLocation(UpCase(Move[2]),Move[3], Change.Dest);
  488.          end;
  489.        3: { Piece and Location (Pe4) }
  490.          begin
  491.            CalcLocation(UpCase(Move[1]),Move[2], Change.Dest);
  492.            for APiece := Low(TPiece) to High(TPiece) do
  493.              if UpCase(Move[0]) = PieceLetter[APiece] then
  494.              begin
  495.                Piece := APiece;
  496.                Break;
  497.              end;
  498.            if Piece = pEmpty then Exit;
  499.          end;
  500.        2: { Location only (e4) }
  501.          CalcLocation(UpCase(Move[0]), Move[1], Change.Dest);
  502.      end;
  503.  
  504.      if Dest.X = 0 then Exit;
  505.    end;
  506.    ParseMove := ceOk;
  507. end;
  508.  
  509. function RetractMove(CH: HChess; const Move: TMove): TChessError;
  510. begin
  511.   RetractMove := ceInvalidHandle;
  512.   if not LoadGameHandle(CH) then Exit;
  513.  
  514.   with CC do
  515.     TakeBackMove(MovTab[Depth]);
  516.  
  517.   RetractMove := ceOk;
  518.  
  519.   StoreGameHandle;
  520. end;
  521.  
  522. function SubmitMove(CH: HChess; const Change: TChange): TChessError;
  523. var
  524.   Move: MoveType;
  525.   Result: TChessError;
  526. begin
  527.   SubmitMove := ceInvalidHandle;
  528.   if not LoadGameHandle(CH) then Exit;
  529.  
  530.   ChangeToMoveType(Change, Move);
  531.   Result := MoveCheck(Move); { Move now in CC^.KeyMove }
  532.  
  533.   if Result = ceOK then
  534.     Message(tmEnterMove);
  535.  
  536.   SubmitMove := Result;
  537.   StoreGameHandle;
  538. end;
  539.  
  540.  
  541. function VerifyMove(CH: HChess; const Change: TChange): TChessError;
  542. var
  543.   Move: MoveType;
  544. begin
  545.   VerifyMove := ceInvalidHandle;
  546.   if not LoadGameHandle(CH) then Exit;
  547.  
  548.   ChangeToMoveType(Change, Move);
  549.  
  550.   VerifyMove := MoveCheck(Move);
  551. end;
  552.  
  553. function ComputerMove(CH: HChess; TimeLimit: LongInt): TChessError;
  554. begin
  555.   ComputerMove := ceInvalidHandle;
  556.   if not LoadGameHandle(CH) then Exit;
  557.  
  558.   with CC do
  559.   begin
  560.     Clock.SetLimit(TimeLimit);
  561.     Clock.Reset;
  562.     Message(tmFindMove);
  563.   end;
  564.  
  565.   ComputerMove := ceOk;
  566.   StoreGameHandle;
  567. end;
  568.  
  569. function ForceMove(CH: HChess): TChessError;
  570. begin
  571.   ForceMove := ceInvalidHandle;
  572.   if not LoadGameHandle(CH) then Exit;
  573.  
  574.   CC.Clock.SetLimit(0);
  575.  
  576.   ForceMove := ceOk;
  577.  
  578.   StoreGameHandle;
  579. end;
  580.  
  581. function ThinkAhead(CH: HChess): TChessError;
  582. begin
  583.   ThinkAhead := ceInvalidHandle;
  584.   if not LoadGameHandle(CH) then Exit;
  585.  
  586.   Message(tmThinkAhead);
  587.  
  588.   ThinkAhead := ceOk;
  589.  
  590.   StoreGameHandle;
  591. end;
  592.  
  593. function AbortSearch(CH: HChess): TChessError;
  594. begin
  595.   AbortSearch := ceInvalidHandle;
  596.   if not LoadGameHandle(CH) then Exit;
  597.  
  598.   Message(tmAbort);
  599.  
  600.   AbortSearch := ceOk;
  601.  
  602.   StoreGameHandle;
  603. end;
  604.  
  605. function CalcSearchStatus: TSearchStatus;
  606. begin
  607.   with CC do
  608.   begin
  609.     if GameOver in State then CalcSearchStatus := ssGameOver
  610.     else if Analysis in State then CalcSearchStatus := ssMoveSearch
  611.     else if OppAnalysis in State then CalcSearchStatus := ssThinkAhead
  612.     else CalcSearchStatus := ssComplete;
  613.   end;
  614. end;
  615.  
  616. function Think(CH: HChess; TimeLimit: LongInt; var Status: TSearchStatus): TChessError;
  617. begin
  618.   Think := ceInvalidHandle;
  619.   if not LoadGameHandle(CH) then Exit;
  620.  
  621.   with CC do
  622.   begin
  623.     { Give more time to the task }
  624.     TaskTimer.SetLimit(TimeLimit);
  625.     TaskTimer.Reset;
  626.     TaskTimer.Start;
  627.  
  628.     Message(tmResume);
  629.  
  630.     Status := CalcSearchStatus;
  631.   end;
  632.  
  633.   Think := ceOk;
  634.  
  635.   StoreGameHandle;
  636. end;
  637.  
  638. function SetBoard(CH: HChess; const ABoard: TBoard): TChessError;
  639. begin
  640.   SetBoard := ceInvalidHandle;
  641.   if not LoadGameHandle(CH) then Exit;
  642.  
  643.   { Not implemented yet }
  644.  
  645.   SetBoard := ceOk;
  646.  
  647.   StoreGameHandle;
  648. end;
  649.  
  650. function SetPlayer(CH: HChess; APlayer: TColor): TChessError;
  651. begin
  652.   SetPlayer := ceInvalidHandle;
  653.   if not LoadGameHandle(CH) then Exit;
  654.  
  655.   with CC do
  656.   begin
  657.     Player := ColorType(APlayer);
  658.     Opponent := ColorType(Byte(APlayer) xor 1);
  659.   end;
  660.  
  661.   SetPlayer := ceOk;
  662.  
  663.   StoreGameHandle;
  664. end;
  665.  
  666. function MakeChange(CH: HChess; Color: TColor;
  667.   const Change: TChange): TChessError;
  668. begin
  669.   MakeChange := ceInvalidHandle;
  670.   if not LoadGameHandle(CH) then Exit;
  671.  
  672.   { Not implemented yet }
  673.  
  674.   MakeChange := ceOk;
  675. end;
  676.  
  677. function GetChessStatus(CH: HChess; var Count: Integer): TChessStatus;
  678. var
  679.   Check,PossibleMove,CheckMate : boolean;
  680.   NumMoves : integer;
  681. begin
  682.   GetChessStatus := csNormal;
  683.   if not LoadGameHandle(CH) then Exit;
  684.  
  685.   with CC do
  686.   begin
  687.     CheckMate := False;
  688.     Inc(Depth);               { Test if there is a Possible Move }
  689.     PossibleMove := False;
  690.     InitMovGen;
  691.     repeat
  692.        MovGen;
  693.        if NextMove.MovPiece <> Empty then
  694.           if not IllegalMove(NextMove) then
  695.              PossibleMove := true;
  696.     until (NextMove.MovPiece = Empty) or PossibleMove;
  697.     Dec(Depth);
  698.     Check := Attacks(Opponent, PieceTab[Player,0].ISquare); { Calculate Check }
  699.  
  700.     { No Possible Move means Checkmate or Stalemate }
  701.     if not PossibleMove then
  702.     begin
  703.        if Check then
  704.          GetChessStatus := csCheckMate
  705.        else
  706.          GetChessStatus := csStaleMate;
  707.     end
  708.     else if Check then
  709.       GetChessStatus := csCheck
  710.     else if FiftyMoveCnt >= 100 then
  711.       GetChessStatus := csFiftyMoveRule
  712.     else if Repetition(False) >= 3 then
  713.       GetChessStatus := csRepetitionRule
  714.     else if HintEvalu >= MateValue - DepthFactor * 16 then
  715.     begin
  716.       GetChessStatus := csMateFound;
  717.       Count := (MateValue - HintEvalu + $40) div (DepthFactor * 2);
  718.     end
  719.     else if (-25500 < HintEvalu) and (HintEvalu <- $880) then
  720.       GetChessStatus := csResigns;
  721.   end;
  722. end;
  723.  
  724. function GetSearchStatus(CH: HChess): TSearchStatus;
  725. begin
  726.   GetSearchStatus := ssComplete;
  727.   if not LoadGameHandle(CH) then Exit;
  728.  
  729.   GetSearchStatus := CalcSearchStatus;
  730. end;
  731.  
  732. function GetLastMove(CH: HChess; var Move: TMove): TChessError;
  733. begin
  734.   GetLastMove := ceInvalidHandle;
  735.   if not LoadGameHandle(CH) then Exit;
  736.  
  737.   with CC do
  738.     MoveTypeToTMove(MovTab[Depth], Move);
  739.  
  740.   GetLastMove := ceOk;
  741. end;
  742.  
  743. function GetHintMove(CH: HChess; var Move: TMove): TChessError;
  744. begin
  745.   GetHintMove := ceInvalidHandle;
  746.   if not LoadGameHandle(CH) then Exit;
  747.  
  748.   with CC do
  749.     MoveTypeToTMove(HintLine[0], Move);
  750.  
  751.   GetHintMove := ceOk;
  752. end;
  753.  
  754.  
  755. function MoveToStr(const Move: TMove; var Str: array of Char): TChessError;
  756. begin
  757.   MoveToStr := ceOk;
  758.  
  759.   Str[0] := #0;
  760.   if (High(Str) >= 6) and (Move.Change.Piece <> pEmpty) then
  761.     with Move do
  762.       case Kind of
  763.         kCastling:
  764.           begin
  765.             if Change.Source.X > Change.Dest.X then
  766.               StrCopy(PChar(@Str), 'O-O-O')
  767.             else
  768.               StrCopy(PChar(@Str), 'O-O');
  769.           end;
  770.  
  771.         kNormal, kPawnPromote, kEnPassant:
  772.           begin
  773.             { Normal moves }
  774.             Str[0] := PieceLetter[Change.Piece];
  775.             Str[1] := Chr(ord('a') + Change.Source.X - 1);
  776.             Str[2] := Chr(ord('1') + Change.Source.Y - 1);
  777.             if Capture then
  778.               Str[3] :='x'
  779.             else
  780.               Str[3] :='-';
  781.             Str[4] := Chr(ord('a') + Change.Dest.X - 1);
  782.             Str[5] := Chr(ord('1') + Change.Dest.Y - 1);
  783.  
  784.             Str[6] := #0;
  785.           end;
  786.       end
  787.   else
  788.     MoveToStr := ceOutOfMemory;
  789. end;
  790.  
  791. function GetBoard(CH: HChess; var ABoard: TBoard): TChessError;
  792. var
  793.   I, J: Integer;
  794.   Index: Word;
  795. begin
  796.   GetBoard := ceInvalidHandle;
  797.   if not LoadGameHandle(CH) then Exit;
  798.  
  799.   with CC do
  800.     for I := Low(ABoard) to High(ABoard) do
  801.       for J := Low(ABoard[I]) to High(ABoard[I]) do
  802.         with ABoard[J, I] do
  803.         begin
  804.           Index := (I - Low(ABoard)) shl 4 or (J - Low(ABoard[I]));
  805.           Piece := TPiece(Board[Index].Piece);
  806.           Color := TColor(Board[Index].Color);
  807.         end;
  808.  
  809.   GetBoard := ceOk;
  810. end;
  811.  
  812. function GetPlayer(CH: HChess): TColor;
  813. begin
  814.   GetPlayer := cWhite;
  815.   if not LoadGameHandle(CH) then Exit;
  816.  
  817.   GetPlayer := TColor(CC.Player);
  818. end;
  819.  
  820. function GetCurrentMove(CH: HChess; var Move: TMove): TChessError;
  821. begin
  822.   GetCurrentMove := ceInvalidHandle;
  823.   if not LoadGameHandle(CH) then Exit;
  824.  
  825.   { Not implemented yet }
  826.  
  827.   GetCurrentMove := ceOk;
  828. end;
  829.  
  830. function GetMainLine(CH: HChess; var Value: Integer;
  831.   var Line: array of TMove): TChessError;
  832. var
  833.   I: Integer;
  834. begin
  835.   GetMainLine := ceInvalidHandle;
  836.   if not LoadGameHandle(CH) then Exit;
  837.  
  838.   I := 0;
  839.   with CC do
  840.   begin
  841.     while (I < High(Line)) and (MainLine[I].MovPiece <> Empty) do
  842.     begin
  843.       MoveTypeToTMove(MainLine[I], Line[I]);
  844.       Inc(I);
  845.     end;
  846.     Value := MainEvalu;
  847.   end;
  848.  
  849.   FillChar(Line[I], SizeOf(Line[I]), 0);
  850.  
  851.   GetMainLine := ceOk;
  852. end;
  853.  
  854. function GetValidMoves(CH: HChess; Change: TChange;
  855.   var Moves: array of TMove): TChessError;
  856. var
  857.   I, J, K: Integer;
  858.   Move: MoveType;
  859. begin
  860.   GetValidMoves := ceInvalidHandle;
  861.   if not LoadGameHandle(CH) then Exit;
  862.  
  863.   ChangeToMoveType(Change, Move);
  864.  
  865.   I := 0;
  866.   with CC do
  867.   begin
  868.     Inc(Depth);
  869.  
  870.     KeyMove := ZeroMove;
  871.     InitMovGen;
  872.     repeat
  873.        MovGen;
  874.        if (NextMove.MovPiece <> Empty) and
  875.           ((NextMove.MovPiece = Move.MovPiece) or (Move.MovPiece = Empty)) and
  876.           ((NextMove.New1 = Move.New1) or (Move.New1 and $88 <> 0)) and
  877.           ((NextMove.Old = Move.Old) or (Move.Old and $88 <> 0)) and
  878.           not IllegalMove(NextMove) then
  879.        begin
  880.          MoveTypeToTMove(NextMove, Moves[I]);
  881.          Inc(I);
  882.        end;
  883.     until (NextMove.MovPiece = Empty) or (I > High(Moves));
  884.  
  885.     if I > High(Moves) then
  886.     begin
  887.       Dec(I);
  888.       GetValidMoves := ceOutOfMemory;
  889.     end
  890.     else
  891.       GetValidMoves := ceOK;
  892.  
  893.     FillChar(Moves[I], SizeOf(Moves[I]), 0);
  894.  
  895.     Dec(Depth);
  896.   end;
  897. end;
  898.  
  899. function GetNodes(CH: HChess): LongInt;
  900. begin
  901.   if not LoadGameHandle(CH) then Exit;
  902.   GetNodes := CC.Nodes;
  903. end;
  904.  
  905. begin
  906.   { Global initialization section }
  907.   FillChar(GameList, SizeOf(GameList), 0);
  908.   CCHandle := 0;
  909.  
  910.   { Init attack tables, shared by all game instances }
  911.   CalcAttackTab;
  912.   InitPawnStrTables;
  913. end.
  914.  
  915.