linguist/samples/Pascal/bulls-and-cows.pascal

Program BullCow;

{$mode objFPC}

uses Math, SysUtils;

type
   TFourDigit = array[1..4] of integer;

Procedure WriteFourDigit(fd: TFourDigit);
{ Write out a TFourDigit with no line break following. }
var
   i: integer;
begin
   for i := 1 to 4 do
   begin
      Write(fd[i]);
   end;
end;

Function WellFormed(Tentative: TFourDigit): Boolean;
{ Does the TFourDigit avoid repeating digits? }
var
   current, check: integer;
begin

   Result := True;

   for current := 1 to 4 do
   begin
      for check := current + 1 to 4 do
      begin
         if Tentative[check] = Tentative[current] then
         begin
            Result := False;
         end;
      end;
   end;

end;

Function MakeNumber(): TFourDigit;
{ Make a random TFourDigit, keeping trying until it is well-formed. }
var
   i: integer;
begin
   for i := 1 to 4 do
   begin
      Result[i] := RandomRange(1, 9);
   end;
   if not WellFormed(Result) then
   begin
      Result := MakeNumber();
   end;
end;

Function StrToFourDigit(s: string): TFourDigit;
{ Convert an (input) string to a TFourDigit. }
var
   i: integer;
begin
   for i := 1 to Length(s) do
   begin
      StrToFourDigit[i] := StrToInt(s[i]);
   end;
end;

Function Wins(Num, Guess: TFourDigit): Boolean;
{ Does the guess win? }
var
   i: integer;
begin
   Result := True;
   for i := 1 to 4 do
   begin
      if Num[i] <> Guess[i] then
      begin
         Result := False;
         Exit;
      end;
   end;
end;

Function GuessScore(Num, Guess: TFourDigit): string;
{ Represent the score of the current guess as a string. }
var
   i, j, bulls, cows: integer;
begin

   bulls := 0;
   cows := 0;

   { Count the cows and bulls. }
   for i := 1 to 4 do
   begin
      for j := 1 to 4 do
      begin
         if  (Num[i] = Guess[j]) then
         begin
            { If the indices are the same, that would be a bull. }
            if (i = j) then
            begin
               bulls := bulls + 1;
            end
            else
            begin
               cows := cows + 1;
            end;
         end;
      end;
   end;

   { Format the result as a sentence. }
   Result := IntToStr(bulls) + ' bulls, ' + IntToStr(cows) + ' cows.';

end;

Function GetGuess(): TFourDigit;
{ Get a well-formed user-supplied TFourDigit guess. }
var
   input: string;
begin

   WriteLn('Enter a guess:');
   ReadLn(input);

   { Must be 4 digits. }
   if Length(input) = 4 then
   begin

      Result := StrToFourDigit(input);

      if not WellFormed(Result) then
      begin
         WriteLn('Four unique digits, please.');
         Result := GetGuess();
      end;

   end
   else
   begin
      WriteLn('Please guess a four-digit number.');
      Result := GetGuess();
   end;

end;

var
   Num, Guess: TFourDigit;
   Turns: integer;
begin

   { Initialize the randymnity. }
   Randomize();

   { Make the secred number. }
   Num := MakeNumber();

   WriteLn('I have a secret number. Guess it!');

   Turns := 0;

   { Guess until the user gets it. }
   While True do
   begin

      Guess := GetGuess();

      { Count each guess as a turn. }
      Turns := Turns + 1;

      { If the user won, tell them and ditch. }
      if Wins(Num, Guess) then
      begin
         WriteLn('You won in ' + IntToStr(Turns) + ' tries.');
         Write('The number was ');
         WriteFourDigit(Num);
         WriteLn('!');
         Exit;
      end
      else { Otherwise, score it and get a new guess. }
      begin
         WriteLn(GuessScore(Num, Guess));
      end;

   end;

end.