thoga31 Posted June 1, 2013 at 03:31 AM Report #510389 Posted June 1, 2013 at 03:31 AM (edited) 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 😄 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: 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 😄 Sei lá, façam divergir três ramos, ângulos aleatórios, whatever! Inventem, e mostrem! 😉 Cumprimentos Edited June 1, 2013 at 03:33 AM by thoga31 2 Report Knowledge is free!
thoga31 Posted June 1, 2013 at 05:34 PM Author Report #510450 Posted June 1, 2013 at 05:34 PM Por sugestão do @nunopicado... 😉 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 2 Report Knowledge is free!
thoga31 Posted June 2, 2013 at 02:00 PM Author Report #510551 Posted June 2, 2013 at 02:00 PM Mas por onde andam os meus colegas pascalianos? 😕 Knowledge is free!
nunopicado Posted June 5, 2013 at 04:23 PM Report #511194 Posted June 5, 2013 at 04:23 PM 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.
Suelen Passos Posted November 9, 2013 at 12:24 AM Report #532607 Posted November 9, 2013 at 12:24 AM Que lindoo!!
Virneto Posted November 9, 2013 at 12:53 AM Report #532611 Posted November 9, 2013 at 12:53 AM @thoga[picasso]31...em grande!! muito fixe!! 👍 "Que inquieto desejo vos tortura, Seres elementares, força obscura? Em volta de que ideia gravitais?" >> Anthero de Quental - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Linuxando.com | ...
thoga31 Posted November 9, 2013 at 12:58 AM Author Report #532612 Posted November 9, 2013 at 12:58 AM Thank you, my children... thank you 😄 2 Report Knowledge is free!
Recommended Posts
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 accountSign in
Already have an account? Sign in here.
Sign In Now