.pascal file extension for Pascal

lib/linguist/languages.yml

@@ -2770,6 +2770,7 @@ Pascal:
   - .dpr
   - .inc
   - .lpr
+  - .pascal
   - .pp
   ace_mode: pascal
 

samples/Pascal/bulls-and-cows.pascal

@@ -0,0 +1,188 @@
+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.