Beautiful Tree Generator

Source-code only - please, don't post questions here.
Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:

Beautiful Tree Generator

Postby Zamaster » Jun 27, 2007 17:42

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 1024

CONST MaxTrees   AS INTEGER = 20
CONST Iterations AS INTEGER = 800000

Screenres SCRX, SCRY, 32,,1

Dim as double A, B, C, D, E, F, x, y, ox, oy, col
Dim shared as double DTree(1 to 6, 1 to 6)
Dim as integer r, i, hx, hy, p, cnt
hx = SCRX/2
hy = SCRY - 10

dim as double RX, RY

DTree(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
#endmacro

Function 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 Function

Type TreeType
    as double  ox, oy, mul, px, py, Sets(1 to 6, 1 to 6)
    as integer r,g,b, exist
End Type

reDim 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 i
End Sub

DO
If cnt = 6 Then
    cls
    cnt = 0
Endif
Redim 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.05
Next i


For 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 p
Next i

cnt += 1
LOOP

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:

Postby VonGodric » Jun 27, 2007 18:01

wow. that's cool.

nice
Pritchard
Posts: 5425
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Jun 27, 2007 18:08

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:

Postby axipher » Jun 27, 2007 18:25

That is pretty sweet, good job.
maddogg6
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:

Postby maddogg6 » Jun 27, 2007 19:26

axipher wrote:That is pretty sweet, good job.


ditto....

And with so few lines of code too... schweeeet! in deed
D.J.Peters
Posts: 7191
Joined: May 28, 2005 3:28

Postby D.J.Peters » Jun 27, 2007 20:31

nice your ifs tree setup
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

Postby Basic Coder » Jun 27, 2007 22:40

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
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby cha0s » Jun 27, 2007 22:47

Looking good.
Deleter
Posts: 975
Joined: Jun 22, 2005 22:33

Postby Deleter » Jun 27, 2007 22:58

nice
counting_pine
Site Admin
Posts: 5826
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Postby counting_pine » Jun 28, 2007 0:05

Another impressive-looking reminder that 1024*768 isn't as great as it used to be...
Hezad
Posts: 469
Joined: Dec 17, 2006 23:37
Contact:

Postby Hezad » Jun 28, 2007 19:35

Awesome !
redcrab
Posts: 618
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:

Postby redcrab » Jun 29, 2007 10:30

very nice
I like the artistic style of the drawing (kind of fuzzy dust)

That's fun
tinram
Posts: 86
Joined: Nov 30, 2006 13:35
Location: UK

Postby tinram » Jun 30, 2007 17:42

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:

Postby TbbW » Jul 01, 2007 15:36

that whas realy nice!
Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:

Postby Zamaster » Jul 01, 2007 20:33

jazzed up the demo, check it!

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 0 guests