Beautiful Tree Generator

Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:

Beautiful Tree Generator

Whats the best way to make trees? Fractals of course! Heres a method where you'll need to modify some of the 36 parameters to get a different tree. This specific set generates a fairly pretty one.

Code: Select all

`#define SCRX 1280#define SCRY 1024CONST MaxTrees   AS INTEGER = 20CONST Iterations AS INTEGER = 800000Screenres SCRX, SCRY, 32,,1Dim as double A, B, C, D, E, F, x, y, ox, oy, colDim shared as double DTree(1 to 6, 1 to 6)Dim as integer r, i, hx, hy, p, cnthx = SCRX/2hy = SCRY - 10dim as double RX, RYDTree(1,1) =  0.0500: DTree(1,2) =  0.6000: DTree(1,3) =  0.0000: DTree(1,4) =  0.0000: DTree(1,5) =  0.0000: DTree(1,6) =  0.0000 DTree(2,1) =  0.0500: DTree(2,2) = -0.5000: DTree(2,3) =  0.0000: DTree(2,4) =  0.0000: DTree(2,5) =  0.0000: DTree(2,6) =  1.0000 DTree(3,1) =  0.6000: DTree(3,2) =  0.5000: DTree(3,3) =  0.6980: DTree(3,4) =  0.6980: DTree(3,5) =  0.0000: DTree(3,6) =  0.6000 DTree(4,1) =  0.5000: DTree(4,2) =  0.4500: DTree(4,3) =  0.3490: DTree(4,4) =  0.3492: DTree(4,5) =  0.0000: DTree(4,6) =  1.1000 DTree(5,1) =  0.5000: DTree(5,2) =  0.5500: DTree(5,3) = -0.5240: DTree(5,4) = -0.5240: DTree(5,5) =  0.0000: DTree(5,6) =  1.0000 DTree(6,1) =  0.6500: DTree(6,2) =  0.4000: DTree(6,3) = -0.6980: DTree(6,4) = -0.6980: DTree(6,5) =  0.0000: DTree(6,6) =  0.7000 Randomize Timer#define SplitR(col1) ((col1 Shr 16) and &HFF)#define SplitG(col1) ((col1 Shr 8) And &HFF)#define SplitB(col1) (col1 And &HFF)#define RGBF(RR,GG,BB) (((RR)Shl 16) Or ((GG)Shl 8) Or (BB)) #macro SATURATE()    If r > 255 Then         r = 255    elseif r < 0 then        r = 0    Endif    If g > 255 Then         g = 255    elseif g < 0 then        g = 0    Endif    If b > 255 Then         b = 255    elseif b < 0 Then        b = 0    endif#endmacroFunction AdditiveMix(colr1 As Integer, rr As Integer, gg As Integer, bb As Integer) As Integer    Dim As Integer r,g,b    r = (SplitR(colr1) + rr)    g = (SplitG(colr1) + gg)    b = (SplitB(colr1) + bb)    SATURATE()    Return RGBF(r,g,b)End FunctionType TreeType    as double  ox, oy, mul, px, py, Sets(1 to 6, 1 to 6)    as integer r,g,b, existEnd TypereDim shared as TreeType Trees(1 to MaxTrees)Sub AddTree(x as double, y as double, m as double, r as integer, g as integer, b as integer, offs as double)    Dim as integer i, xs, ys    For i = 1 to MaxTrees        If Trees(i).exist = 0 Then            Trees(i).exist = 1            Trees(i).px   = x            Trees(i).py   = y            Trees(i).mul  = m             For ys = 1 to 6                For xs = 1 to 6                    Trees(i).Sets(xs,ys) = DTree(xs,ys)+((rnd * offs)-offs/2)                Next xs            Next ys            Trees(i).r = r            Trees(i).g = g            Trees(i).b = b            Exit For        Endif    Next iEnd SubDOIf cnt = 6 Then    cls    cnt = 0EndifRedim as TreeType Trees(1 to MaxTrees)For i = 1 to int(rnd * 3)    AddTree rnd * SCRX, 500+ rnd * (SCRY-500), rnd * 300+100, 16+int(rnd * 16), 16+int(rnd * 16), 16, 0.05Next iFor i = 1 to Iterations    For p = 1 to MaxTrees        If Trees(p).exist = 1 Then            With Trees(p)                r = int(rnd * 6) + 1                A = .Sets(r,1): B = .Sets(r,2): C = .Sets(r,3)                D = .Sets(r,4): E = .Sets(r,5): F = .Sets(r,6)                x = (A*COS(C)*.ox)-(B*SIN(D)*.oy)+E                y = (A*SIN(C)*.ox)+(B*COS(D)*.oy)+F                .ox = x                .oy = y                 RX = .px-x*.mul                RY = .py-y*.mul                Pset (RX, RY), AdditiveMix(Point(RX,RY), .r,.g,.b)                If multikey(&h01) Then end            End With        Endif    Next pNext icnt += 1LOOP`
Last edited by Zamaster on Jul 02, 2007 3:52, edited 2 times in total.
VonGodric
Posts: 997
Joined: May 27, 2005 9:06
Location: London
Contact:
wow. that's cool.

nice
Pritchard
Posts: 5478
Joined: Sep 12, 2005 20:06
Location: Ohio, USA
Hah. Your ego's as big as mine is. I guess the only difference here is that you actually deserve to have one. :D
axipher
Posts: 891
Joined: Dec 27, 2005 16:37
Location: Sudbury,Ontario
Contact:
That is pretty sweet, good job.
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:
axipher wrote:That is pretty sweet, good job.

ditto....

And with so few lines of code too... schweeeet! in deed
D.J.Peters
Posts: 7432
Joined: May 28, 2005 3:28
here are the others
Written by Paul Bourke January 1999
http://local.wasp.uwa.edu.au/~pbourke/f ... fs_tree_b/

http://local.wasp.uwa.edu.au/~pbourke/fractals/
Basic Coder
Posts: 180
Joined: Aug 02, 2006 23:37
Location: Australia

Re: Beautiful Tree Generator

Zamaster wrote:Whats the best way to make trees? Fractals of course! Heres a method where you'll need to modify some of the 36 parameters to get a different tree. This specific set generates a fairly pretty one.

< code >

What would be even cooler would be an evolutionary version?

Can you evolve it into different types of trees?

I wonder if they have used genetics to trace back the evolution
of trees the way they have for animals?

Another method might be to have "cells" that duplicate and grow
into a tree (roots and all). I think they probably "flow" into place
as they duplicate?

--
Basic Coder
cha0s
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:
Looking good.
Deleter
Posts: 975
Joined: Jun 22, 2005 22:33
nice
counting_pine
Posts: 5954
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs
Another impressive-looking reminder that 1024*768 isn't as great as it used to be...
Posts: 469
Joined: Dec 17, 2006 23:37
Contact:
Awesome !
redcrab
Posts: 618
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:
very nice
I like the artistic style of the drawing (kind of fuzzy dust)

That's fun
tinram
Posts: 88
Joined: Nov 30, 2006 13:35
Location: UK
One of the best tree fractal implementations I've seen.
Especially like the way the 'trunks' overlap the 'foliage' - makes the tree look more natural.
TbbW
Posts: 348
Joined: Aug 19, 2005 10:08
Contact:
that whas realy nice!
Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:
jazzed up the demo, check it!