Jump to content
thoga31

[Curiosidade | Desafio] Árvore fractal

Recommended Posts

thoga31

Antes de ir dormir, lembrei-me em ver uns desafios (o que me levou a publicar um há pouco e logo a seguir fazer a sua solução), e apanhei nas minhas pesquisas uma curiosidade: como construir uma árvore fractal.

O princípio é simples: desenha-se uma linha, a partir do ponto final desenham-se outras duas que divergem segundo um determinado ângulo, nos pontos finais dessas duas faz-se o mesmo, e como manda a geometria fractal, isto segue até ao infinito sempre desta forma...

Ora, como já não pegava no Pascal há uma temporada (tenho andado mais numa de usar os interpretadores de Haskell e Python), decidi desenferrujar o meu Free Pascal e metê-lo a desenhar duas árvores: uma simétrica e outra assimétrica (pensei em fazer divergir as linhas segundo ângulos diferentes).

O resultado é muito interessante. Com meia dúzia de linhas de Pascal tornei-me um verdadeiro Picassa digital :D

program fractaltree;
uses graph, math;

type TPoint = record
       x, y : smallint;
    end;

const //angulo_esq = 20;
     //angulo_dir = 20;
     //linha_passo = 55;
     //vezes = 10;
     ponto1 : TPoint = (x:300; y:500);
     ponto2 : TPoint = (x:900 ;y:500);

var driver, mode : smallint;
   i : integer;

procedure DesenharRamos(pi : TPoint; angulo : integer; passo : integer; const marcapasso : smallint ; const angulo_esq, angulo_dir : smallint);
var pf : TPoint;
begin
   if passo > 0 then begin
       pf.x := pi.x + trunc(cos(degtorad(angulo)) * passo);
       pf.y := pi.y + trunc(sin(degtorad(angulo)) * passo);

       Line(pi.x, pi.y, pf.x, pf.y);

       DesenharRamos(pf, angulo - angulo_esq, passo - marcapasso, marcapasso, angulo_esq, angulo_dir);
       DesenharRamos(pf, angulo + angulo_dir, passo - marcapasso, marcapasso, angulo_esq, angulo_dir);
   end;
end;

begin
   DetectGraph(driver, mode);
   InitGraph(driver, mode, '');

   SetLineStyle(SolidLn, 0, NormWidth);

   (* DesenharRamos(ponto, -90, linha_passo, linha_passo div vezes, angulo_esq, angulo_dir); *)

   // simetrica
   SetColor(green);
   DesenharRamos(ponto1, -90, 50, 50 div 10, 20, 20);

   //assimetrica
   SetColor(red);
   DesenharRamos(ponto2, -90, 50, 50 div 11, 25, 8);

   readln;
   CloseGraph;
end.

Para aumentar a "nitidez" da árvore, aumentem o denominador do operador "div" - basta passar de 11 para 15 para o PC disparar as fans ao máximo ;)

E uma imagem para os curiosos que não podem compilar:

fractal_tree.png

Quem pode compilar, eis o meu desafio: experimentem o código à vossa vontade, alterem-no como quiserem, e mostrem aqui os códigos alterados e os respectivos "produtos" para vermos um pouco de arte fractal feita com o velhinho Pascal :D

Sei lá, façam divergir três ramos, ângulos aleatórios, whatever! Inventem, e mostrem! ;)

Cumprimentos

Edited by thoga31
  • Vote 2

Knowledge is free!

Share this post


Link to post
Share on other sites
thoga31

Por sugestão do @nunopicado... ;)

fractal_tree_2.png

Bastou fazer a alteração para a simétrica, e depois expandi o fundo para abranger as duas árvores.

   // simetrica
   SetRGBPalette(50, 0, 82, 14);
   SetFillStyle(SolidFill, 50);
   Bar(50, 600, 950, 450);

   for i:=0 to (255-120) do begin
       SetRGBPalette(50, 45, 120+i, 255);
       SetFillStyle(SolidFill, 50);
       Bar(50, 450-(2*i-1), 950, 450-(2*i+1));
   end;

   SetLineStyle(SolidLn, 0, ThickWidth);
   SetColor(green);
   DesenharRamos(ponto1, -90, 50, 50 div 10, 20, 20);

Isto com constantes ficava mais-melhor, mas não tive paciência para isso xD

  • Vote 2

Knowledge is free!

Share this post


Link to post
Share on other sites
thoga31

Mas por onde andam os meus colegas pascalianos? :confused:


Knowledge is free!

Share this post


Link to post
Share on other sites
nunopicado

Estava a dormir... lol

Isto de implementar alterações da AT num software de facturação anda a revelar-se um trabalho a tempo inteiro... Não sabem dizer tudo de uma vez!

Adiante, sobre o resultado do teu desafio, como te disse por outro meio de comunicação:

Excelente... :)


"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.

Share this post


Link to post
Share on other sites
Virneto

@thoga[picasso]31...em grande!!

muito fixe!! :thumbsup:


"Que inquieto desejo vos tortura, Seres elementares, força obscura? Em volta de que ideia gravitais?" >> Anthero de Quental

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Linuxando.com | ...

Share this post


Link to post
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

×
×
  • 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.