Simple Recursive Tree Generator

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
UEZ
Posts: 328
Joined: May 05, 2017 19:59
Location: Germany

Simple Recursive Tree Generator

Postby UEZ » Apr 26, 2018 14:42

Here a simple Recursive Tree Generator. Should work as x86 and x64.

Image

Code: Select all

'coded by UEZ build 2018-04-27
'thanks to dodicat for the DrawThickLine function
'use 64-bit compilation for faster progress

#include "string.bi"
#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
   Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

#Define Min(a, b)   Iif(a < b, a, b)

Declare Sub DrawRecTree(x As Single, y As Single, length As Single, angle As Single, col As Ulong)
Declare Sub DrawThickLine(Byval x1 As Integer, Byval y1 As Integer, Byval x2 As Integer, Byval y2 As Integer, Byval size As Integer, Byval c As Uinteger)


Const As Ushort iW = 1200, iH = 800, iCenterX = iW \ 2, iCenterY = iH \ 2
Const As Single fD2R = Acos(-1) / 180, thresholdBloom = 0.03, treeSize = 0.275
Const As Ubyte maxLevel = 14, bloomLevel = Cubyte(maxLevel * 0.75), lineThickness = 10, maxBloomSize = 8
Const As Ulong bloomColor = &h910F66, colorTree = &h800

Screenres iW, iH, 32, , GFX_WINDOWED Or GFX_NO_SWITCH
Color 0, &hA0A0A0
Cls

'======================= maybe needed later
Dim Shared As Integer w, h, depth, bpp, bpsl
ScreenInfo w, h, depth, bpp, bpsl
Dim Shared As Any Ptr pScreen
pScreen = Screenptr()
'=======================

Windowtitle("Simple Recursive Tree Generator v0.90 / " & Format((3^maxLevel) Shr 1, "#,##") & " function calls")
Randomize

Dim Shared As Ulong level
level = 0

DrawRecTree(iCenterX, iH, 90, -90, colorTree)
Draw String(10, 10), "Press space / lmb to regenerate tree", &hFFFFFF

Dim As Single fTimer
Dim As Integer x, y, buttons

Do   
   Getmouse(x, y, , buttons)
   If Multikey(SC_SPACE) Or buttons = 1 Then
      fTimer = Timer()
      Cls
      Screenlock
      DrawRecTree(iCenterX, iH, 90, -90, colorTree)
      Screenunlock
      Draw String(10, iH - 10), Format((Timer() - fTimer) * 1000, "0.0000") & " ms", &hFFFFFF
   End If
    Sleep 50, 1
Loop Until Multikey(SC_ESCAPE)


Sub DrawRecTree(x As Single, y As Single, length As Single, angle As Single, col As Ulong)
   level += 1
   Dim As Single destX, destY, col2
   destX = x + length * Cos(angle * fD2R)
   destY = y + length * Sin(angle * fD2R)
   
   col += 256 * level

   If level > bloomLevel And Rnd() < thresholdBloom Then
      col = bloomColor 'this will overwrite the green color and will change the color of the branches, too.
      Circle (x, y), Min(maxBloomSize, (destX - x)), col, , , 1.25 + Rnd() / 4, F
   Else   
      DrawThickLine(x, y, destX, destY, 1 + lineThickness / level, col)
      'Line (x, y)-(destX, destY), col
   End If
   
   If level < maxLevel Then
       DrawRecTree(destX, destY, length * (1 + 3 * Rnd()) * treeSize, angle + 60 * (Rnd() - Rnd()), col)
       DrawRecTree(destX, destY, length * (1 + 3 * Rnd()) * treeSize, angle + 60 * (Rnd() - Rnd()), col)
       DrawRecTree(destX, destY, length * (1 + 3 * Rnd()) * treeSize, angle + 60 * (Rnd() - Rnd()), col)
   End If
   
   level -= 1
End Sub

Sub DrawThickLine(Byval x1 As Integer, Byval y1 As Integer, Byval x2 As Integer, Byval y2 As Integer, Byval size As Integer, Byval c As Uinteger) 'by dodicat
   If x1 = x2 And y1 = y2 Then
      Circle (x1, y1), size, c, , , , f
   Elseif Abs(x2 - x1) >= Abs(y2 - y1) Then
      Dim K As Single = (y2 - y1) / (x2 - x1)
      For I As Integer = x1 To x2 Step Sgn(x2 - x1)
        Circle (I, K * (I - x1) + y1), size, c, , , , f
      Next I
   Else
      Dim L As Single = (x2 - x1) / (y2 - y1)
      For J As Integer = y1 To y2 Step Sgn(y2 - y1)
        Circle (L * (J - y1) + x1, J), size, c, , , , f
      Next J
   End If
End Sub


Press space to regenerate tree.


I'm thinking about to add a save function...

Update1: tidy up the code
Last edited by UEZ on Apr 27, 2018 11:51, edited 2 times in total.
lizard
Posts: 440
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Simple Recursive Tree Generator

Postby lizard » Apr 26, 2018 15:13

Produces pretty random trees here on Mint, but sometimes with gigantic red fuits like balloons.
UEZ
Posts: 328
Joined: May 05, 2017 19:59
Location: Germany

Re: Simple Recursive Tree Generator

Postby UEZ » Apr 26, 2018 16:27

lizard wrote:Produces pretty random trees here on Mint, but sometimes with gigantic red fuits like balloons.


Thanks for your feedback. I updated the code to limit the size of the "fruits" to 8px.
lizard
Posts: 440
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Simple Recursive Tree Generator

Postby lizard » Apr 26, 2018 17:57

Great, the balloons are gone. Faszinating that it is possible to generate complex trees with so short code. Maybe you know the program "Mandelbulber" which produces fractals.

BTW, i am a fan of Dali you have as Avatar in the german forum.
D.J.Peters
Posts: 7690
Joined: May 28, 2005 3:28

Re: Simple Recursive Tree Generator

Postby D.J.Peters » Apr 26, 2018 18:07

Nice and short :-)

Joshy
Roland Chastain
Posts: 851
Joined: Nov 24, 2011 19:49
Location: Dakar, Senegal
Contact:

Re: Simple Recursive Tree Generator

Postby Roland Chastain » Apr 26, 2018 18:20

Beautiful (picture and code). :)
dodicat
Posts: 5813
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Simple Recursive Tree Generator

Postby dodicat » Apr 26, 2018 20:57

Thanks UEZ.
Very subtle foliage shading.
And very seasonable after a long Winter.
BasicCoder2
Posts: 3350
Joined: Jan 01, 2009 7:03

Re: Simple Recursive Tree Generator

Postby BasicCoder2 » Apr 26, 2018 20:59

UEZ wrote:Here a simple Recursive Tree Generator.

Really nice tree. It looks 3d like?
Looking at all the different tree and plant species I often thought about how they must all have their own recursive rules. Evolution by a simple mutation of the rules as in Richard Dawkins biomorphs program.
UEZ
Posts: 328
Joined: May 05, 2017 19:59
Location: Germany

Re: Simple Recursive Tree Generator

Postby UEZ » Apr 26, 2018 22:26

Thanks all for your feedback. :-)

lizard wrote:Great, the balloons are gone. Faszinating that it is possible to generate complex trees with so short code. Maybe you know the program "Mandelbulber" which produces fractals.

BTW, i am a fan of Dali you have as Avatar in the german forum.


I saw some pictures generated by Mandelbulber - very impressive.

I like Dali, too. ;-)
tinram
Posts: 88
Joined: Nov 30, 2006 13:35
Location: UK

Re: Simple Recursive Tree Generator

Postby tinram » Apr 30, 2018 22:35

Nice generative tree generator - both code and result.
lizard
Posts: 440
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Simple Recursive Tree Generator

Postby lizard » Apr 30, 2018 23:40

UEZ wrote:I saw some pictures generated by Mandelbulber - very impressive.

Played some time with it and generated a lot of pics. It is in Ubuntu repository. Google shows many of the resulting pics:

https://de.images.search.yahoo.com/yhs/ ... uxmint_com

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests