Jump to content

Carnaval! (snippet)


thoga31
 Share

Recommended Posts

Isto está feito há séculos, mas não estive cá pelo Carnaval e só agora me lembrei de colocar cá este snippet. 😄

Divirtam-se com a consola cheia de confettis e foguetes comemorativos... algo simples, mas a intenção está lá. 🙂

Espero que se tenham divertido neste Carnaval com (in)tolerância de ponto. :drunk:

{$mode delphi}
PROGRAM Carnaval;
USES crt, sysutils;

TYPE TPonto = record    (* ponto na consola *)
            X : 1..80;  // Colunas
            Y : 1..25;  // Linhas
     end;


PROCEDURE RecarregarGUI;
(* RECARREGA AS LETRAS E FRASES DA CONSOLA *)
begin
     TextColor(15);  // Branco
     GotoXY(30,3);
     Write('!!! CARNAVAL !!!');
     TextColor(7);   // Predefinição
end;

var PontosConfetti : array [1..40] of TPonto;  // 40 confettis da janela

PROCEDURE Confetti;
(* LIMPA CONFETTIS ANTERIORES E COLOCA-OS EM POSIÇÕES NOVAS ALEATÓRIAS *)
var i, j : integer;  // contadores gerais
begin
     for i:=1 to 40 do begin  // Limpa confettis actuais
         with PontosConfetti[i] do begin
              GotoXY(X, Y);
              Write(' ');
         end;
     end;

     Randomize;
     for i:=1 to 40 do begin  // Cria e posiciona novos confettis aleatoriamente
         with PontosConfetti[i] do begin
              repeat  // Coluna
                    j := Round(Random(80));
              until (j in [1..80]);
              X := j;
              repeat  // Linha
                    j := Round(Random(25));
              until (j in [1..25]);
              Y := j;
              GotoXY(X, Y);
              TextColor(Round(Random(9)));  // Cor aleatória
              Write('+');  // confetti da posição definida
         end;
     end;

 // Deve recarregar letras caso algum confetti tenha parado em cima delas
     RecarregarGUI;
end;

// Como durante o foguete os confettis são reposicionados, a cor do foguete deve ser memorizada
var Cor : 0..15;

PROCEDURE Foguete;
(* LANÇA UM FOGUETE DESDE O FUNDO DA CONSOLA A PARTIR DE UMA POSIÇÃO ALEATÓRIA, E LIMPA-O *)
var i, j : Integer;  // contagores gerais
    PontoInicial : TPonto;  // Ponto de onde sai foguete
    PontoAleatorio : array [1..20] of TPonto;  // Pontos da explosão
begin
     Randomize;
     PontoInicial.X := Round(Random(80));  // Posição aleatória
     PontoInicial.Y := 25;  // Fundo da consola
     Cor := Round(Random(7)) + 9;  // cor do foguete aleatória

     TextColor(Cor);
     GotoXY(PontoInicial.X, PontoInicial.Y);
     Write(char(254));  // caracter do foguete - ASCII 254
     for i:=24 downto 15 do begin  // faz subir o foguete
         TextColor(Cor);
         GotoXY(PontoInicial.X, i + 1);
         Write(' ');
         GotoXY(PontoInicial.X, i);
         Write(char(254));
         if (i mod 2 = 0) then Confetti;  // altera os confettis após 400ms
         GotoXY(80,25);
         delay(200);
     end;

     Randomize;
     for i:=1 to 20 do begin  // explode o foguete em volta do ponto de explosão
         with PontoAleatorio[i] do begin
              repeat
                    j := PontoInicial.X - 7 + Round(Random(15));  // 7 colunas de cada lado do ponto de explosão
              until (j in [1..80]);
              X := j;
              repeat
                    j := 10 + Round(Random(10));  // 5 linhas de cada base do ponto de explosão
              until (j in [1..25]);
              Y := j;
              GotoXY(X, Y); TextColor(Cor);  // posicionamento e coloração
         Write(char(254));
         end;
         GotoXY(80,25);
         delay(10);  // explosão rápida - 10ms para cada um dos 20 pontos de explosão
     end;

     Confetti;  // Muda os confettis - já passarm cerca de 400ms

     delay(50);

     for i:=1 to 20 do begin  // desvanece o foguete
         with PontoAleatorio[i] do begin
              GotoXY(X, Y);
              Write(' ');
         end;
         if (i mod 8 = 0) then Confetti;  // 20*8=400ms - actualiza confetti
         GotoXY(80,25);
         delay(50);
     end;

     GotoXY(PontoInicial.X, 15);  // Limpa ponto de explosão
     Write(' ');
end;

var cont : integer;  // contador geral

BEGIN  (* BLOCO PRINCIPAL *)
     try
        for cont:=1 to 40 do begin  // inicia o vector de Confettis
            with PontosConfetti[cont] do begin
                 X := 1;
                 Y := 1;
            end;
        end;

        while not KeyPressed do begin  // Numa tecla premida, termina a animação
              RecarregarGUI; // Actualiza, por segurança, as letras
              Confetti;      // Desenha os confettis
              Foguete;       // Lança foguete
        end;

     except
        on e:exception do begin
           clrscr;
           TextColor(12);
           Write('ERRO: ', e.message);  // mostra mensagem de erro
           readln; // pausa
        end;
     end;
END.

NOTA: este snippet pode gerar um erro qualquer que ainda não descobri. Num PC ocorre passados 2 minutos, num outro nunca me deu erro. Mas enfim, funciona o tempo suficiente para verem o efeito... 😄

Se descobrirem, apitem! Já coloquei o Try Except para ajudar na detecção. 🙂

Knowledge is free!

Link to comment
Share on other sites

No meu não falhou.

Mas experimenta correr o código seguinte. É o teu (não se nota, mas é) mas com ligeiras alterações...

{$mode delphi}
PROGRAM Carnaval;
USES crt, sysutils;

TYPE TPonto = record    (* ponto na consola *)
            X : 1..80;  // Colunas
            Y : 1..25;  // Linhas
     end;


PROCEDURE RecarregarGUI;
(* RECARREGA AS LETRAS E FRASES DA CONSOLA *)
begin
     try
       TextColor(15);  // Branco
       GotoXY(30,3);
       Write('!!! CARNAVAL !!!');
       TextColor(7);   // Predefinição
     except
        on e:exception do begin
           clrscr;
           TextColor(12);
           Write('ERRO (RecarregarGUI): ', e.message);  // mostra mensagem de erro
           readln; // pausa
        end;
     end;
end;

var PontosConfetti : array [1..40] of TPonto;  // 40 confettis da janela

PROCEDURE Confetti;
(* LIMPA CONFETTIS ANTERIORES E COLOCA-OS EM POSIÇÕES NOVAS ALEATÓRIAS *)
var i, j : integer;  // contadores gerais
begin
     try
       for i:=1 to 40 do begin  // Limpa confettis actuais
           with PontosConfetti[i] do begin
                GotoXY(X, Y);
                Write(' ');
           end;
       end;

       Randomize;
       for i:=1 to 40 do begin  // Cria e posiciona novos confettis aleatoriamente
           with PontosConfetti[i] do begin
                repeat  // Coluna
                      j := Round(Random(80));
                until (j in [1..80]);
                X := j;
                repeat  // Linha
                      j := Round(Random(25));
                until (j in [1..25]);
                Y := j;
                GotoXY(X, Y);
                TextColor(Round(Random(9)));  // Cor aleatória
                Write('+');  // confetti da posição definida
           end;
       end;

           // Deve recarregar letras caso algum confetti tenha parado em cima delas
       RecarregarGUI;
     except
        on e:exception do begin
           clrscr;
           TextColor(12);
           Write('ERRO (Confetti): ', e.message);  // mostra mensagem de erro
           readln; // pausa
        end;
     end;
end;

// Como durante o foguete os confettis são reposicionados, a cor do foguete deve ser memorizada
var Cor : 0..15;

PROCEDURE Foguete;
(* LANÇA UM FOGUETE DESDE O FUNDO DA CONSOLA A PARTIR DE UMA POSIÇÃO ALEATÓRIA, E LIMPA-O *)
var i, j : Integer;  // contagores gerais
    PontoInicial : TPonto;  // Ponto de onde sai foguete
    PontoAleatorio : array [1..20] of TPonto;  // Pontos da explosão
begin
     try
       Randomize;
       PontoInicial.X := Round(Random(80));  // Posição aleatória
       PontoInicial.Y := 25;  // Fundo da consola
       Cor := Round(Random(7)) + 9;  // cor do foguete aleatória

       TextColor(Cor);
       GotoXY(PontoInicial.X, PontoInicial.Y);
       Write(char(254));  // caracter do foguete - ASCII 254
       for i:=24 downto 15 do begin  // faz subir o foguete
           TextColor(Cor);
           GotoXY(PontoInicial.X, i + 1);
           Write(' ');
           GotoXY(PontoInicial.X, i);
           Write(char(254));
           if (i mod 2 = 0) then Confetti;  // altera os confettis após 400ms
           GotoXY(80,25);
           delay(200);
       end;

       Randomize;
       for i:=1 to 20 do begin  // explode o foguete em volta do ponto de explosão
           with PontoAleatorio[i] do begin
                repeat
                      j := PontoInicial.X - 7 + Round(Random(15));  // 7 colunas de cada lado do ponto de explosão
                until (j in [1..80]);
                X := j;
                repeat
                      j := 10 + Round(Random(10));  // 5 linhas de cada base do ponto de explosão
                until (j in [1..25]);
                Y := j;
                GotoXY(X, Y); TextColor(Cor);  // posicionamento e coloração
           Write(char(254));
           end;
           GotoXY(80,25);
           delay(10);  // explosão rápida - 10ms para cada um dos 20 pontos de explosão
       end;

       Confetti;  // Muda os confettis - já passarm cerca de 400ms

       delay(50);

       for i:=1 to 20 do begin  // desvanece o foguete
           with PontoAleatorio[i] do begin
                GotoXY(X, Y);
                Write(' ');
           end;
           if (i mod 8 = 0) then Confetti;  // 20*8=400ms - actualiza confetti
           GotoXY(80,25);
           delay(50);
       end;

       GotoXY(PontoInicial.X, 15);  // Limpa ponto de explosão
       Write(' ');
     except
        on e:exception do begin
           clrscr;
           TextColor(12);
           Write('ERRO (Foguete): ', e.message);  // mostra mensagem de erro
           readln; // pausa
        end;
     end;
end;

var cont : integer;  // contador geral

BEGIN  (* BLOCO PRINCIPAL *)
     try
        for cont:=1 to 40 do begin  // inicia o vector de Confettis
            with PontosConfetti[cont] do begin
                 X := 1;
                 Y := 1;
            end;
        end;

        while not KeyPressed do begin  // Numa tecla premida, termina a animação
              RecarregarGUI; // Actualiza, por segurança, as letras
              Confetti;      // Desenha os confettis
              Foguete;       // Lança foguete
        end;

     except
        on e:exception do begin
           clrscr;
           TextColor(12);
           Write('ERRO (Main): ', e.message);  // mostra mensagem de erro
           readln; // pausa
        end;
     end;
END.

Vê qual é o erro e apita! 😄

"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Link to comment
Share on other sites

Este programa, embora engraçado, é uma brincadeira de crianças comparado ao que é possivel fazer em Pascal/Delphi. 😄

Experimenta correr a minha versão, e não a do Thoga. Provavelmente vai dar-te erro na mesma, mas já vai dizer onde. Depois mete naqui o erro, que como no meu não dá, não tenho por onde começar a corrigir!

PS: Já reparaste que o autor deste tópico é também o autor do tutorial que andas a ler? 🙂

"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Link to comment
Share on other sites

No meu não falhou.

Mas experimenta correr o código seguinte. É o teu (não se nota, mas é) mas com ligeiras alterações...

[...]

Vê qual é o erro e apita! 😄

O PC onde dava erro já não está na minha posse. Neste que agora utilizo não dá nenhum erro.

Bem Fixe  😄

Nao sabia que dava para se fazer coisas destas ..

Aqui deu um : ERRO: Range Check error

Como o @nunopicado disse, isto é só uma brincadeira de crianças. É uma simples mistura de lógica, tempo e do famosíssimo módulo CRT. Logo lá chegas, vais ver. 🙂

Quanto ao erro, faz como disse o @nunopicado: corre o código dele, que faz verificação de erros a cada procedimento individual. Assim detectamos a origem do insecto. 🙂

PS: Já reparaste que o autor deste tópico é também o autor do tutorial que andas a ler? 🙂

:bag:

Knowledge is free!

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.