Ferramentas de Usuário

Ferramentas de Site


dev_geral:pascal:pronto-a-usar:arvore_fractal

Árvore fractal

Eis 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, aqui vamos desenhar duas árvores: uma simétrica e outra assimétrica (fazendo divergir as linhas segundo ângulos diferentes).

O resultado é muito interessante. Com meia dúzia de linhas de Pascal tornamo-nos verdadeiros Picassas digitais. :-D

program fractaltree;
uses graph, math;
 
type TPoint = record
        x, y : smallint;
     end;
 
const ponto1 : TPoint = (x:250; y:530);
      ponto2 : TPoint = (x:750 ;y:530);
 
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, '');
 
    // simétrica
    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);
 
    //assimétrica
    SetLineStyle(SolidLn, 0, NormWidth);
    SetColor(red);
    DesenharRamos(ponto2, -90, 50, 50 div 11, 25, 8);
 
    readln;
    CloseGraph;
end.

Ver tópico no fórum.

dev_geral/pascal/pronto-a-usar/arvore_fractal.txt · Última modificação em: 2018/05/14 21:37 (edição externa)