Jogo da Velha - Pascal

     

Nome: Everaldo José de Souza

Professor: PROF. MSc. Ricardo da Rosa

Disciplina: Algoritmo e linguagem de programação

program velha;
uses
    crt; 
var
    i,jogada :integer;
    valeu,win:boolean;
    op,ganhador,vez :string;
    xy :array[1..9] of string;
    jogador:array[1..2] of string;
procedure tabuleiro;
begin
    clrscr ; 
    writeln('Jogo da Velha');
    writeln;
    writeln(' ',xy[1],' | ',xy[2],' | ',xy[3]);
    writeln('---+---+--- ');
    writeln(' ',xy[4],' | ',xy[5],' | ',xy[6]);
    writeln('---+---+--- ');
    writeln(' ',xy[7],' | ',xy[8],' | ',xy[9]);
    writeln;
    writeln;
end;
procedure teste;
begin

    //Testa se X ganhou

    if ( xy[1]+xy[2]+xy[3] = 'XXX' ) or ( xy[4]+xy[5]+xy[6] = 'XXX' ) or ( xy[7]+xy[8]+xy[9] = 'XXX' ) or ( xy[1]+xy[4]+xy[7] = 'XXX' ) or ( xy[2]+xy[5]+xy[8] = 'XXX' ) or ( xy[3]+xy[6]+xy[9] = 'XXX' ) or ( xy[7]+xy[5]+xy[3] = 'XXX' ) or ( xy[1]+xy[5]+xy[9] = 'XXX' ) then
    begin
        ganhador:= 'X';
    end;
    //Testa se X ganhou
   
    //Testa se O ganhou
   
    if ( xy[1]+xy[2]+xy[3] = 'OOO' ) or ( xy[4]+xy[5]+xy[6] = 'OOO' ) or ( xy[7]+xy[8]+xy[9] = 'OOO' ) or ( xy[1]+xy[4]+xy[7] = 'OOO' ) or ( xy[2]+xy[5]+xy[8] = 'OOO' ) or ( xy[3]+xy[6]+xy[9] = 'OOO' ) or ( xy[7]+xy[5]+xy[3] = 'OOO' ) or ( xy[1]+xy[5]+xy[9] = 'OOO' ) then
    begin
        ganhador:= 'O';
    end;
   
    //Testa se O ganhou
   
    //Imprime empate na tela
   
    if (i = 9) and (ganhador= ' ') then
    begin
        tabuleiro;
        writeln('Ninguem Venceu');
        win := true;
    end;
   
    //Imprime empate na tela
   
   
    //Imprime Vencedor na tela
   
    if ganhador<> ' ' then
    begin
        tabuleiro;
        if ( ganhador='X' ) then
          begin
              write('Parabéns ',jogador[1],' venceu');
          end
          else
          begin
              write('Parabéns ',jogador[2],' venceu');
          end;
        win := true;
    end;
   
    //Imprime Vencedor na tela
   
end;
Begin
   
    //Estrutura para capturar jogador
   
    for i := 1 to 2  do
    begin
        write( 'Nome do ',i,chr( 167 ),' jogador: ' ) ;
        readln( jogador[i] ) ;
        clrscr ;
    end;
   
    //Estrutura para capturar jogador
   
   repeat
     ganhador:= ' ';
    
     //Popula tabuleiro com string de 1~9 usando tabela asc 49=1 ...
    
     for i := 1 to 9 do
     begin
        xy[i]:=chr(i+48);
    end;
   
    //Popula tabuleiro com string de 1~9 usando tabela asc 49=1 ...
   
     win := false;
     vez := 'O';
    i := 0;
     while win <> true do
     begin
          inc(i);//incrementa o i = i:=i+1;
         
          //So serve pra colorir o tabuleiro
         
          textcolor( 14 ) ; textbackground( 3 ) ;
         
          //So serve pra colorir o tabuleiro
         
          //Controla Vez
         
          if vez = 'X' then
          begin
              vez := 'O'
         end
        else
        begin
              vez := 'X';
         end;
        
         //Controla Vez
        
        tabuleiro;
         jogada := 0;       
        while (jogada = 0) and (win <> true) do
        begin
            valeu:=false;
            repeat
           
                  //Controla Jogador
           
                if ( vez='X' ) then
                   begin
                    write(jogador[1],'  (',vez,'):')    
                   end
                else
                   begin
                       write(jogador[2],'  (',vez,'):');
                   end;
                  
                   //Controla Jogador
                  
                   readln( jogada ) ;
                  
                   //Testa se a joga pode ser realizada
                  
                if (  jogada >= 1) and (jogada <= 9 ) and (xy[jogada]=chr(jogada+48) ) then
                begin
                    valeu:=true;
                end
                else
                begin
                    clrscr ;
                    tabuleiro; //caso a joga nao possa ser realizada limpa tela e chama novamente o tabuleiro
                end;
            until(valeu=true);
           
                //Testa se a joga pode ser realizada
           
               if jogada = 0 then
               begin
                   win:=true;
               end;
              
              
               if (xy[jogada] = chr(jogada+48)) then
               begin              
                   xy[jogada] := vez
               end        
               else
               begin
                   jogada := 0;
               end;
          end;
         teste;
     end;
     writeln;
     writeln;
     writeln( 'Jogar novamente "S" ou  "N"' ) ;
    op:=readkey;
    op:=upcase(op);
   until ( op='N');
End.