
uses
  SysUtils, Classes, ChessTypes, Chessboard, FenFilter, MoveList, ChessUtils, ChessboardList, Fen;

procedure GenerateLegalMoves(const APos: {$IFDEF STRLIST}string{$ELSE}TPositionData{$ENDIF}; const AMoves: {$IFDEF STRLIST}TStringList{$ELSE}TMoveList{$ENDIF}; const AResultPos: {$IFDEF STRLIST}TStringList{$ELSE}TChessboardList{$ENDIF});
var
  LPos, LNext: TChessPosition;
  i: integer;
begin
  LPos := TChessPosition.Create(APos);
  LNext := TChessPosition.Create;
  LPos.SetVariables(FALSE);
  LPos.GenerateMoves1(LPos.Active);
  LPos.GenerateMoves2(LPos.Active);
  for i := 0 to Pred(LPos.List.Count) do
  begin
    LNext.Create(APos);
    LNext.DoMove({$IFDEF STRLIST}LPos.List[i]{$ELSE}LPos.List.GetMove(i){$ENDIF});
    LNext.Active := OtherColor(LNext.Active);
    LNext.SetVariables(TRUE);
    if not LNext.Check then
    begin
      AMoves.Append({$IFDEF STRLIST}LPos.List[i]{$ELSE}LPos.List.GetMove(i){$ENDIF});
      LNext.Active := OtherColor(LNext.Active);
      AResultPos.Append({$IFDEF STRLIST}LNext.FENRecord{$ELSE}LNext.Data{$ENDIF});
    end;
  end;
  LPos.Free;
  LNext.Free;
end;

procedure SearchLegalMoves(const AStartPos: string; const AFinalDepth: integer);

  function RecursiveSearch(const APos: {$IFDEF STRLIST}string{$ELSE}TPositionData{$ENDIF}; const ADepth: integer): integer;
  var
    LMoves: {$IFDEF STRLIST}TStringList{$ELSE}TMoveList{$ENDIF};
    LResultPos: {$IFDEF STRLIST}TStringList{$ELSE}TChessboardList{$ENDIF};
    i, n: integer;
  begin
    LMoves := {$IFDEF STRLIST}TStringList{$ELSE}TMoveList{$ENDIF}.Create;
    LResultPos := {$IFDEF STRLIST}TStringList{$ELSE}TChessboardList{$ENDIF}.Create;
    
    GenerateLegalMoves(APos, LMoves, LResultPos);
    
    if ADepth = 1 then
    begin
      result := LMoves.Count;
    end else
    begin
      result := 0;
      for i := 0 to Pred(LMoves.Count) do
      begin
        n := RecursiveSearch({$IFDEF STRLIST}LResultPos.Strings[i]{$ELSE}LResultPos.GetPositionData(i){$ENDIF}, Pred(ADepth));
        if ADepth = AFinalDepth then
          WriteLn({$IFDEF STRLIST}LMoves.Strings[i]{$ELSE}MoveToStr(LMoves.GetMove(i)){$ENDIF}, ' ', n);
        result := result + n;
      end;
    end;
    
    LMoves.Free;
    LResultPos.Free;
  end;

var
  LResult: integer;
begin
  WriteLn('Start position ', AStartPos);
  WriteLn('Search depth ', AFinalDepth);
  LResult := RecursiveSearch({$IFDEF STRLIST}AStartPos{$ELSE}EncodePositionData(AStartPos){$ENDIF}, AFinalDepth);
  WriteLn('Result ', LResult);
end;

const
  CDefaultPos = 'rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1';
  CBuild      = 'FPC ' + {$I %FPCVERSION%} + ' ' + {$I %DATE%} + ' ' + {$I %TIME%} + ' ' + {$I %FPCTARGETOS%} + '-' + {$I %FPCTARGETCPU%};
  
var
  LPos: string;
  LDepth: integer;
  LShowHelp: boolean;
  LTime: TTime;
  
begin
  WriteLn(
    StringOfChar('-', 72), LineEnding,
    '-- Pascal Chess Library', LineEnding,
    '-- Perft Demo', LineEnding,
    '-- Build ', CBuild, LineEnding,
    StringOfChar('-', 72)
  );
  
  LPos := CDefaultPos;
  LDepth := 0;
  LShowHelp := FALSE;
  
  if ParamCount = 0 then
    LShowHelp := TRUE
  else
  begin
    if TryStrToInt(ParamStr(1), LDepth) then
    begin
      if ParamCount > 1 then
      begin
        with TFenFilter.Create do
        try
          if IsFen(ParamStr(2)) then
            LPos := ParamStr(2)
          else
          begin
            WriteLn('Invalid value for parameter 2');
            LShowHelp := TRUE;
          end;
        finally
          Free;
        end;
      end;
    end else
    begin
      WriteLn('Invalid value for parameter 1');
      LShowHelp := TRUE;
    end;
  end;
  
  if LShowHelp then
    WriteLn(
      'Usage:', LineEnding,
      '  perft depth [position]'
    )
  else
  begin
    LTime := Time;
    SearchLegalMoves(LPos, LDepth);
    WriteLn('Time elapsed ', FormatDateTime('nn:ss,zzz', Time - LTime));
  end;
end.
