Mastermind

Versão simplificada

Program Mastermind;
Uses crt;
Var A, B: array [1..4] of integer;
    i, tentativa, certos:integer;
Begin
     clrscr;
     randomize;
     for i:=1 to 4 do
         A[i]:=random(3)+1;
     writeln ('Tem 10 tentativas para acertar os 4 digitos');
     writeln ('gerados aleatoriamente e que so podem ser 1,2,3');
     writeln;
     tentativa:=0;
     repeat
           tentativa:=tentativa+1;
           for i:=1 to 4 do
           begin
                repeat
                      Write ('Escreva o ', i,'§ digito: ');
                      readln(B[i]);
                until B[i] in [1..3]
           end;
           certos:=0;
           for i:=1 to 4 do
               if A[i]=B[i] then
                  certos:=certos + 1;
           writeln;
           writeln (certos, ' Certos');
           writeln;
     until (certos=4) or (tentativa=10);
     If certos=4 then
        Writeln ('Acertou em ', tentativa,' tentativas')
     else
         writeln ('Nao conseguiu acertar');
     writeln;
     writeln ('Os digitos escondidos eram: ');
     for i:=1 to 4 do
         writeln (a[i]);
     readkey;
end.

Versão completa

program mastermind2;  (* MASTERMIND P@P v2.0 *)

const MaxTent = 10;               // Número máximo de tentativas
      NDigs = 4;                  // Número de dígitos da sequência a adivinhar
      StrEmpty : string = '';
      ExisteEPosCorrecta = #219;
      ExisteEPosIncorrecta = #177;
      NaoExiste = #32;

type StrTent = string[NDigs];

var sequencia : StrTent;    // Sequência gerada aleatoriamente
    tentativa : StrTent;    // Tentativa do utilizador
    correccao : StrTent;    // Indicação dos dígitos correctos
    t : byte = 1;               // Nº tentativa
    certo : boolean;        // Sequência está 100% correcta?

function Int2Str(i : integer) : string;
(* Converte Integer para String *)
begin
    Str(i, Int2Str);
end;

function Ordena(s : StrTent) : StrTent;
(* Ordena uma string que contém os caracteres da correcção *)
var j, l : integer;  // contadores gerais
    aux : char;      // auxiliar para efectuar a troca
begin
    for j := 1 to NDigs do
        for l := j to NDigs do
            if ((s[j] in [ExisteEPosIncorrecta, NaoExiste]) and (s[l] = ExisteEPosCorrecta))
              or ((s[j] = NaoExiste) and (s[l] = ExisteEPosIncorrecta))
            then begin
                aux := s[j];
                s[j] := s[l];
                s[l] := aux;
                continue;
            end;
    Ordena := s;
end;

procedure CriarSequencia(var seq : StrTent);
(* Gera sequência de forma aleatória *)
var j : byte;
begin
    randomize;
    for j := 1 to NDigs do
        seq := seq + Int2Str(random(10));
end;

procedure Correcto(const seq, tent : StrTent; var transmissor : boolean; var corr : StrTent);
(* Compara "tent" com "seq", indica se é igual com "transmissor" e indica correcção por "corr" *)
var j : byte;

    function Contem(const dig : char; const seq : StrTent) : boolean;
    (* "seq" contém o caracter "dig"? *)
    var j : byte;
    begin
        Contem := false;
        for j := 1 to NDigs do
            if seq[j] = dig then begin
                Contem := true;
                break;
            end;
    end;

begin
    transmissor := true;
    corr := StrEmpty;
    for j := 1 to NDigs do
        if seq[j] = tent[j] then  // número está na posição correcta
            corr := corr + ExisteEPosCorrecta
        else begin
            if seq[j] <> tent[j] then begin
                transmissor := false;
                if Contem(tent[j], seq) then  // número existe mas está noutra posição
                    corr := corr + ExisteEPosIncorrecta
                else corr := corr + NaoExiste;  // número não existe
            end;
        end;
end;

begin (* BLOCO PRINCIPAL *)
    CriarSequencia(sequencia);
    correccao := StrEmpty;

    repeat
        write('Tentativa ', t, ': ');
        readln(tentativa);
        Correcto(sequencia, tentativa, certo, correccao);
        writeln('Resultado: ', #179, Ordena(correccao), #179);
        inc(t);
    until (t >= MaxTent) or certo;

    if certo then writeln('Acertou!')
             else writeln('Passou as ', MaxTent, ' tentativas...');

    readln; // pausa
end.

Tópico de discussão no fórum: [Snippet] Mastermind