{--------------------------------------------------------}
{
{    NIMVOX - Jogo dos Palitinhos
{
{    Autores: Fabio David e Andrea Rodrigues
{
{    Em junho de 1994
{
{--------------------------------------------------------}

{$M 16536,8192}
program NIMVOX;
uses
    dvCrt, dvWin;

const
   COMPUTADOR = 1;
   MAXLINHAS = 20;

var
   totlinhas: integer;
   linha, ordem : array [1..MAXLINHAS] of byte;
   i : byte;
   vez, pauzinhos, lin, quantos : byte;
   partidas, vitorias, derrotas : integer;
   st : char;

procedure finaliza; forward;

{--------------------------------------------------------}

procedure msg (m : string);
begin
    if m = 'nim_quem' then      write ('Deseja comecar? (s/n): ')
    else
    if m = 'nim_mal' then       writeln ('Esta ficando dificil...')
    else
    if m = 'nim_inv' then       writeln ('Resposta invalida')
    else
    if m = 'nim_vici' then      writeln ('Uau! Venci novamente...')
    else
    if m = 'nim_apla' then      begin end
    else
    if m = 'nim_mifu' then      writeln ('Nao e possivel! Eu perdi!??!')
    else
    if m = 'nim_situ' then      writeln ('Situacao atual:')
    else
    if m = 'nim_lin1' then      write ('1: ')          { linha 1 }
    else
    if m = 'nim_lin2' then      write ('2: ')          { linha 2 }
    else
    if m = 'nim_lin3' then      write ('3: ')          { linha 3 }
    else
    if m = 'nim_lin4' then      write ('4: ')          { linha 4 }
    else
    if m = 'nim_lin5' then      write ('5: ')          { linha 5 }
    else
    if m = 'nim_lin6' then      write ('6: ')          { linha 6 }
    else
    if m = 'nim_lin7' then      write ('7: ')          { linha 7 }
    else
    if m = 'nim_lin8' then      write ('8: ')          { linha 8 }
    else
    if m = 'nim_lin9' then      write ('9: ')          { linha 9 }
    else
    if m = 'nim_qtd0' then      writeln ('')           { nada }
    else
    if m = 'nim_qtd1' then      writeln ('I')          { 1 }
    else
    if m = 'nim_qtd2' then      writeln ('I I')        { 2 }
    else
    if m = 'nim_qtd3' then      writeln ('I I I')      { 3 }
    else
    if m = 'nim_qtd4' then      writeln ('I I I I')    { 4 }
    else
    if m = 'nim_qtd5' then      writeln ('I I I I I')   { 5 }
    else
    if m = 'nim_qtd6' then      writeln ('I I I I I I')   { 6 }
    else
    if m = 'nim_qtd7' then      writeln ('I I I I I I I')   { 7 }
    else
    if m = 'nim_qtd8' then      writeln ('I I I I I I I I')   { 8 }
    else
    if m = 'nim_qtd9' then      writeln ('I I I I I I I I I')   { 9 }
    else
    if m = 'nim_dnov' then      write ('Deseja jogar de novo? (s/n): ')
    else
    if m = 'nim_aprs' then
        begin
            textBackground (BLUE);
            write ('NIMVOX II - O jogo dos palitinhos');
            textBackground (BLACK);
            writeln;
            writeln;
        end
    else
    if m = 'nim_mlin' then      write ('Quantas linhas (de 3 a 9): ')
    else
    if m = 'nim_qpln' then      write ('Quantos por linha (de 3 a 9): ')
    else
    if m = 'nim_mvez' then      write ('Minha jogada -> linha ')
    else
    if m = 'nim_qlin' then      write ('Qual a linha? ')
    else
    if m = 'nim_qqtd' then      write ('Quantos? ')
    else
    if m = 'nim_linv' then      writeln ('Linha invalida ou inexistente. Tente novamente !')
    else
    if m = 'nim_lvaz' then      writeln ('Esta linha esta vazia!')
    else
    if m = 'nim_qbig' then      write ('Esta linha tem somente ')
    else
    if m = 'nim_qpeq' then      write ('Puxa vida, blefar nao vale !')
    else
    if m = 'nim_svez' then      write ('Sua jogada -> linha ')
    else
    if m = 'nim_retr' then      write (' retirando ')
    else
    if m = 'nim_inst' then      write ('Deseja instrucoes (s/n) ? ')
    else
    if m = 'nim_bye' then       writeln ('Bye bye !')
    else
    if m = 'nim_nstr' then
        begin
        writeln;
        writeln ('Eu apresento para voce varias linhas contendo palitinhos.');
        writeln ('Eu e voce podemos tirar de uma linha quantos palitinhos quisermos.');
        writeln ('Quem tirar o ultimo palitinho perde...');
        writeln;
        end
    else
        writeln (chr(7)+chr(7)+chr(7)+'Erro: '+m);

    sintSom (m);
end;

{--------------------------------------------------------}

procedure le (var r: char);
begin
   while keypressed do r := readkey;
   r := readkey;
   writeln (r);
   sintCarac (r);
   r := upcase (r);

   if r = #$1b then finaliza;
end;

{--------------------------------------------------------}

procedure instrucoes;
begin
    msg ('nim_nstr');
end;

{--------------------------------------------------------}

function sim_ou_nao (m : string) : char;
var c : char;
begin
   c := ' ';
   repeat
       msg (m);
       le (c);
       if not (c in [#$1b, 'S','N']) then msg ('nim_inv');
   until (c in ['S','N', #$1b]);
   sim_ou_nao := c;
end;

{--------------------------------------------------------}

procedure finaliza;
begin
    msg ('nim_bye');
    delay (2000);
    sintFim;
    doneWinCrt;
end;

{--------------------------------------------------------}

procedure inicializa;
var
    diret: string;
begin
    sintinic (0, sintAmbiente ('NIMVOX', 'DIRNIMVOX'));

    randomize;
    partidas := 0;
    vitorias := 0;
    derrotas := 0;

    sintSom ('chaaaaan');
    clrscr;
    msg ('nim_aprs');
    case upcase (sim_ou_nao ('nim_inst')) of
       'S': instrucoes;
      #$1b: finaliza;
    end;
end;

{--------------------------------------------------------}

procedure reordena;
var i, j, x, temp: byte;
begin
    for i:=1 to totlinhas do
        ordem[i] := 0;

    for i:=1 to totlinhas do
       begin
       repeat
          x := random(totlinhas) + 1;
       until ordem[x] = 0;
       ordem [x] := i;
       end;

    for i:=1 to totlinhas-1 do
      for j := i to totlinhas do
       if linha [i] < linha [j] then
           begin
               temp := linha [i];
               linha [i] := linha [j];
               linha [j] := temp;
           end;
end;

{--------------------------------------------------------}

procedure mostra_situacao;
var p : byte;
    c: char;
begin
   writeln;
   msg ('nim_situ');
   for i:=1 to totlinhas do
      begin
          msg ('nim_lin'+chr(i+$30));
          msg ('nim_qtd'+chr(linha[i]+$30));
          if keypressed then
              begin
                  c := readkey;
                  exit;
              end;
      end;
end;

{--------------------------------------------------------}

procedure jogo_novo;
var c: char;
    maxporlin, aux : integer;
begin
    inc (partidas);
    pauzinhos := 0;
    repeat
        msg ('nim_mlin');
        le (c);
        totlinhas := ord (c) - ord ('0');
    until totlinhas in [3..9];

    repeat
        msg ('nim_qpln');
        le (c);
        maxporlin := ord (c) - ord ('0');
        writeln;
    until maxporlin in [3..9];

    for i:=1 to totlinhas do
       begin
       aux := random(maxporlin)+ 1;
       linha [i] := aux;
       inc (pauzinhos, aux);
       end;

    reordena;
    mostra_situacao;

    vez := 0;
    while (vez = 0) do
       if sim_ou_nao ('nim_quem') = 'S' then
           vez := byte (not (COMPUTADOR))
       else
           vez := COMPUTADOR;
    sintSom ('plin');
end;

{--------------------------------------------------------}

procedure ta_mal;
begin
    reordena;
    for i:=1 to totlinhas do
        if linha[ordem[i]] > 0 then
            begin
            lin := ordem[i];
            quantos := random(linha[lin]) + 1;
            end;
    msg ('nim_mal');
end;

{--------------------------------------------------------}

procedure minha_vez;
var
    linhas_com_um, linhas_com_mais_de_um, mask, n, l : byte;
    achei_jogada : boolean;
begin
    linhas_com_um := 0;
    linhas_com_mais_de_um := 0;
    mask := 0;
    for i:=1 to totlinhas do
        begin
        mask := mask XOR linha[i];
        if linha[i] = 1 then
            inc (linhas_com_um)
        else
        if linha[i] > 1 then
            begin
            inc (linhas_com_mais_de_um);
            l := i;
            end;
        end;

    if (linhas_com_mais_de_um = 1) then
        begin
        lin := l;
        quantos := linha[lin] - ((linhas_com_um AND 1) XOR 1);
        end
    else
        if (mask = 0)  then
            ta_mal
        else
            begin
            achei_jogada := false;
            i := 0;
            while not (achei_jogada) do
                begin
                inc (i);
                n := linha[ordem[i]];
                l := ((n and not mask) or (not n and mask));
                achei_jogada := l <= n;
                end;
            lin := ordem[i];
            quantos := linha[lin] - l;
            end;
end;

{--------------------------------------------------------}

procedure jogada_humana;
var jogada_valida : boolean;
begin
    jogada_valida := false;
    while not jogada_valida do
        begin

        repeat
            sintSom ('tingting');
            msg ('nim_qlin');
            le (st);
            if st = #$1b then
                finaliza;

            if not (st in ['1'..'9']) then
                 mostra_situacao;
        until st in ['1'..'9'];

        lin := ord (st) - $30;
        if (lin < 1) or (lin > totlinhas) then
           msg ('nim_linv')
        else
        if (linha[lin] = 0) then
           msg ('nim_lvaz')
        else
           begin
           msg ('nim_qqtd');
           le (st);
           quantos := ord (st) - $30;
           if (quantos < 1) then
               msg ('nim_qpeq')
           else
           if (quantos > linha[lin]) then
               begin
               msg ('nim_qbig');
               msg ('nim_qtd'+chr(linha[lin]+$30));
               end
           else
               jogada_valida := true;
           end;
        end;
end;

{--------------------------------------------------------}

procedure vitoria;
begin
    inc (vitorias);
    sintSom ('tingting');
    msg ('nim_vici');
end;

{--------------------------------------------------------}

procedure derrota;
begin
    inc (derrotas);
    msg ('nim_apla');
    msg ('nim_mifu');
    sintSom ('chaaaaan');
end;

{--------------------------------------------------------}

begin
    inicializa;
    repeat
        begin
        jogo_novo;
        writeln;

        while (pauzinhos > 1) do
           begin
           delay (1000);
           if (vez = COMPUTADOR) then
               begin
               minha_vez;
               textBackground (BLUE);
               msg ('nim_mvez');
               end
           else
               begin
               jogada_humana;
               textBackground (BLUE);
               msg ('nim_svez');
               end;

           msg ('nim_lin'+chr(lin+$30));
           textBackground (BLACK);
           msg ('nim_retr');
           msg ('nim_qtd'+chr(quantos+$30));

           dec (linha[lin], quantos);
           dec (pauzinhos, quantos);
           vez := not(vez);
           end;

       if (vez = COMPUTADOR) then
           derrota
       else
           vitoria;
       end
   until (sim_ou_nao ('nim_dnov') = 'N');

   finaliza;
end.
