Material das Aulas – UFS

Nesta aula foi explicado como fazemos para armazenar dados no disco utilizando o Pascal. Segue abaixo um material de Regis Pires que apresenta o assunto. Apesar de existirem 3 tipos de variável que mapeiam um disco, só utilizaremos uma, a FILE. Segue abaixo o material.

Em sala também fizemos um exemplo para contextualizar o assunto exposto.

O primeiro programa faz a seguinte função, após ler as informações de 3 alunos o programa persiste esta informação em um arquivo.

program GravaArquivo;
 uses  crt;
 const qtdAluno = 3;
       qtdNotas = 2;
 type discente = record
                   nome : string;
                   nota : array[1..qtdNotas] of real;
                   media : real;
                  end;
 var  alunos : array[1..qtdAluno] of discente;
      cont,i : integer;
      soma : real;
      arquivo : file of discente;

begin
     assign(arquivo,'d:\x.dat');
     {$I-}
     reset(arquivo);
     {$I+}
     if (IORESULT <> 0) then
        rewrite(arquivo);
     for cont:=1 to qtdAluno do
     begin
           writeln('Digite o nome do aluno');
           readln( alunos[cont].nome);
           soma:=0;
           for i := 1 to qtdNotas do
           begin
                writeln('Digite a nota ', i);
                readln(alunos[cont].nota[i]);
                soma := soma + alunos[cont].nota[i];
           end;
           alunos[cont].media := soma/qtdNotas;
     end;

     for cont:=1 to qtdAluno do
     begin
          Writeln('O nome do aluno: ', alunos[cont].nome);
           Writeln('A media do aluno: ', alunos[cont].media);
     end;
     for cont:= 1 to qtdAluno do
     begin
       write(arquivo, alunos[cont]);
     end;
     close(arquivo);
   readkey;
end.

Já o segundo ler este arquivo e exibe as informações na tela.

program ExibeArquivo;
 uses  crt;
 const qtdNotas = 2;
 type discente = record
                   nome : string;
                   nota : array[1..qtdNotas] of real;
                   media : real;
                  end;
 var  aluno : discente;
      arquivo : file of discente;
begin
     assign(arquivo,'d:\x.dat');
     {$I-}
     reset(arquivo);
     {$I+}
     if (IORESULT <> 0) then
        rewrite(arquivo);
     while not EOF(arquivo) do
     begin
          read(Arquivo,Aluno);
          Writeln('O nome do aluno: ', aluno.nome);
           Writeln('A media do aluno: ', aluno.media);
     end;
     close(arquivo);
   readkey;
end.

Na nossa aula 33, nos dedicamos a rever alguns conceitos da disciplina e debater sobre os temas dos projetos para implementação. Foi dada sugestões de temas, e alguns grupos já definiram os seus projetos.

Olá pessoal,

A aula 32, realizada no dia 14/05, foi dedicada a apresentação da resolução do programa da senha. Por utilizar vários conceitos, também serviu para que revessemos alguns conceitos da disciplina.

Até mais!

Olá pessoal,

Segue abaixo o algoritmo que passado a posição do termo da sequência o exibe.

program Fibonacci;
 uses crt;
 var p : integer;
 function fibonacci(n : integer) : integer;
 begin
      if(n = 1) then
        fibonacci := 0
      else if (n = 2) then
        fibonacci := 1
      else
        fibonacci := fibonacci(n - 1) + fibonacci(n - 2);
 end;

begin
 writeln('Digite uma posicao da sequencia de fibonacci');
 readln(p);
 write(fibonacci(p));
 readkey;
end.

Olá pessoal

Segue abaixo o código do jogo senha!

program mastermind;
 uses crt;
 type senha = array[1..4] of integer;
      tentativa = record
                    teste : senha;
                    acertos : integer;
                    parcial : integer
                  end;
 var codigo, avaliacao : senha;
     jogadas : array[1..100] of tentativa;
     cont, x, turnos : integer;

{----------------------------------}
{Procedimento para mostrar mensagem}
{----------------------------------}

 Procedure Msg(x:string);
 Begin
  gotoxy(2,22);
  clreol;
  textcolor(lightred);
  writeln('Msg ¯ ');
  gotoxy(8,22);
  textcolor(lightgreen);
  writeln(x);
  gotoxy(80,22);
  textcolor(15);
  writeln('º');
 End;

{--------------------------------}
{Fun‡Æo para centralizar o t¡tulo}
{--------------------------------}

  Function Meio(titulo:string):integer;
   var a:integer;
  Begin
   a:=80-length(titulo);
   a:= trunc(a div 2);
   meio:=a;

  End;

{-------------------------------}
{Procedimento que desenha a tela}
{-------------------------------}

  Procedure Tela(titulo:string;centro:integer);
   Var i:integer;
  Begin
   {Parte de Cima}
   for i:=1 to 80 do
   begin
    gotoxy(i,1);
    if (i <>1) and (i<> 80) then
    Begin
     writeln('Í'); {ALT + 205}
    End
    Else
    Begin
     if i=1 then
     Begin
      writeln('É'); {ALT + 201}
     End
     else
     Begin
      writeln('»'); {ALT + 187}
     End;
    End;
   End;
   {Lateral Esquerda}
   for i:=2 to 23 do
   begin
    gotoxy(1,i);
    if (i <>4) and (i<> 21) then
    Begin
     writeln('º'); {ALT +186}
    End
    Else
    Begin
     if i=4 then
     Begin
      writeln('Ì');  {ALT + 204}
     End
     else
     Begin
      writeln('Ì');  {ALT + 204}
     End;
    End;
   End;
   {Parte de Baixo}
   for i:=1 to 80 do
   begin
    gotoxy(i,23);
    if (i<>1) and (i<> 80) then
    Begin
     writeln('Í');{ALT + 205}
    End
    Else
    Begin
     if i=1 then
     Begin
      writeln('È'); {ALT + 200}
     End
     else
     Begin
      writeln('¼'); {ALT + 188}
     End;
    End;
   End;
   {Lateral Direito}
   for i:=2 to 22 do
   begin
    gotoxy(80,i);
    if (i <>4) and (i<> 21) then
    Begin
     writeln('º'); {ALT +186}
    End
    Else
    Begin
     if i=4 then
     Begin
      writeln('¹');  {ALT + 185}
     End
     else
     Begin
      writeln('¹');  {ALT + 185}
     End;
    End;
   End;
   {Parte do meio 1}
   for i:=2 to 79 do
   begin
    gotoxy(i,4);
    writeln('Í'); {ALT + 205}
   End;
   {Parte do meio 2}
   for i:=2 to 79 do
   begin
    gotoxy(i,21);
    writeln('Í'); {ALT + 205}
   End;
   gotoxy(centro,3);
   Textcolor(Lightgreen);
   Writeln(titulo);
    {¹ 185 º 186 » 187 ¼ 188 ¯ 175 ® 174 È 200 É 201 Ê 202 Ë 203 Ì 204 Í 205 Î 206 }
  End;
  {Preenche vetor inicial}
  function preencher(x : integer): senha;
    var saida : senha;
        cont : integer;
  begin
    cont := 0;
    repeat
       cont:=cont+1;
       saida[cont]:= x - trunc(x/10)*10;
       x := trunc(x/10);
     until (cont = 4);
     preencher := saida;
  end;

  {Preenche e testa jogada}
  function preencheCompara(x : integer; objetivo : senha) : tentativa;
   var saida : tentativa;
       aux : senha;
       cont, i, j, acerto, parcial : integer;
       encontrou : boolean;
  begin
    saida.teste := preencher(x);
    acerto := 0;
    parcial := 0;
    for i := 1 to 4 do
    begin
     aux[i] := 0;
    end;
    for i := 1 to 4 do
    begin
      if(objetivo[i] = saida.teste[i]) then
      begin
        inc(acerto);
        aux[i] := 1;
      end;
     end;
     saida.acertos := acerto;

     for i:= 1 to 4 do
     begin
       encontrou := false;
       j := 1;
       if (aux[i] <> 1) then
         while (not encontrou) and (j <> 5) do
         begin
            if (aux[j] <> 1) then
            begin
             if (saida.teste[j] = objetivo[i]) then
             begin
              inc(parcial);
              encontrou := true;
             end;
            end;
            inc(j);
         end;
     end;
     saida.parcial := parcial ;
     preencheCompara := saida;
  end;

  {Valida a jogada}
  function validar(x : integer):boolean;
    var aux, resto, cont : integer;
  begin
     validar := true;
     cont := 0;
     repeat
       resto := x - trunc(x/10)*10;
       if resto = 0 then
          validar := false;
       cont:=cont+1;
       x:= trunc(x/10);
     until (cont = 4);
     if (x <> 0) then
       validar := false;
  end;

  {Exibir}
  procedure exibir(x:tentativa);
    var j : integer;
  begin
    for j:=4 downto 1 do
    begin
     write(x.teste[j]);
    end;
     writeln('(',x.acertos,',',x.parcial,')');
  end;

{programa principal}
begin
  clrscr;
  textcolor(15);
  Tela('Jogo Senha',Meio('Jogo Senha'));
  msg('Insira a senha a ser descoberta');
  repeat
   textcolor(lightred);
   gotoxy(15,11);
   write('Digite a Senha:                    ');
   textcolor(lightgreen);
   gotoxy(31,11);
   readln(x);
   if not validar(x) then
     msg('Senha Invalida!');
  until validar(x);
  codigo := preencher(x);

  turnos := 0;
  repeat
   inc(turnos);
   clrscr;
   textcolor(15);
   Tela('Jogo Senha',Meio('Jogo Senha'));
   Msg('Inicio do Jogo');
   repeat
    textcolor(lightred);
    gotoxy(15,11);
    write('Digite a Tentativa:                    ');
    textcolor(lightgreen);
    gotoxy(35,11);
    readln(x);
    if not validar(x) then
      msg('Tentativa Invalida!');
   until validar(x);
   jogadas[turnos] := preencheCompara(x,codigo);
   for cont := 1 to turnos do
   begin
    gotoxy(60,4+cont);
    exibir(jogadas[cont]);
   end;
   readkey;
  until jogadas[turnos].acertos = 4;
 end.