## Some Variations of a Binary Fractal Tree

Bolee
Posts: 3
Joined: Jan 21, 2020 21:30

### Some Variations of a Binary Fractal Tree

My very first post.
I was playing around with some fractal tree code and made a few different variations to share.

Thank you Paul Doe for the image box suggestion. I have now edited the post to try to include some images.

Version 1:

A multicoloured fractal tree with decreasing circle sizes at node points. Code: Select all

` ' A multicoloured fractal treeConst Pi = 4 * Atn(1)Dim Shared As Double TwoPi = 8 * Atn(1)Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degreesDim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radiansscreenres 640,480,32color rgb(0,0,0),rgb(0,0,0):clsdim as single angle,x,yx = 30y = 40angle = atan2(y,x)*RtoDprint angle;90-angle'x = cos(angle*DtoR)*L'y = sin(angle*DtoR)*LSUB tree (x as integer, y as integer, a as single, L as single, depth as integer)    dim as single Oldx,Oldy,xx,yy,lastdepth     Oldx = x    Oldy = y              IF depth THEN               x = x + L * COS(a + DtoR*90)          'compute new x coordinate        y = y + L * SIN(a + DtoR*90)          'compute new y coordinate                      line (Oldx+320,480-Oldy)-(x+320,480-y),rgb(100 + 6*L,4*L,115)       if depth  > 3 and depth <> 9  then circle (Oldx+320,480-Oldy),2*depth -5,rgb(100 + 6*L,4*L,115),,,,f                      xx = x+320        yy = 480-y        'line (xx-L\4,yy-L\4)-(xx+L\4,yy+L\4),rgb(100 + 6*L,4*L,115)        'line (xx+L\4,yy-L\4)-(xx-L\4,yy+L\4),rgb(100 + 6*L,4*L,115)        'if depth > 6 then circle (xx+L\4,yy-L\4),depth -2,rgb(255,0,0),,,,f        'if depth > 6 then circle (xx-L\4,yy-L\4),depth -2,rgb(255,0,0),,,,f        Oldx = x        Oldy = y                        tree (x,y, a + 45*DtoR, L * .6, depth - 1)  'shorten the length of branch        tree (x,y, a - 45*DtoR, L * .6 , depth - 1)  'and reduce the depth value     END IF            return   END SUB'************** MAIN ROUTINE ****************'      x, y, angle, length, depthtree (0, 10,   0,    190,     9   )while inkey="":wend`

Version 2:

'A purple fractal tree with 3 extra diagonal lines at the node points. Code: Select all

`Const Pi = 4 * Atn(1)Dim Shared As Double TwoPi = 8 * Atn(1)Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degreesDim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radiansscreenres 640,480,32color rgb(0,0,0),rgb(0,0,0):clsdim as single angle,x,yx = 30y = 40angle = atan2(y,x)*RtoDprint angle;90-angle'x = cos(angle*DtoR)*L'y = sin(angle*DtoR)*LSUB tree (x as integer, y as integer, a as single, L as single, depth as integer)    dim as single Oldx,Oldy,xx,yy,lastdepth     Oldx = x    Oldy = y              IF depth THEN               x = x + L * COS(a + DtoR*90)          'compute new x coordinate        y = y + L * SIN(a + DtoR*90)          'compute new y coordinate                      line (Oldx+320,480-Oldy)-(x+320,480-y),rgb(255,0,255)               xx = x+320        yy = 480-y                IF depth <> 9 THEN            line (xx-L\4,yy-L\4)-(xx+L\4,yy+L\4),rgb(255,0,255)            line (xx+L\4,yy-L\4)-(xx-L\4,yy+L\4),rgb(255,0,255)        END IF        Oldx = x        Oldy = y                        tree (x,y, a + 45*DtoR, L * .6, depth - 1)  'shorten the length of branch        tree (x,y, a - 45*DtoR, L * .6 , depth - 1)  'and reduce the depth value     END IF            return   END SUB'************** MAIN ROUTINE ****************'      x, y, angle, length, depthtree (0, 10,   0,    190,     9   )while inkey="":wend `

Version 3:

A green Fractal Tree with 4 diagonal lines and four circles at the node points. Code: Select all

` 'A green Fractal TreeConst Pi = 4 * Atn(1)Dim Shared As Double TwoPi = 8 * Atn(1)Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degreesDim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radiansscreenres 640,480,32color rgb(0,0,0),rgb(0,0,0):clsdim as single angle,x,yx = 30y = 40angle = atan2(y,x)*RtoDprint angle;90-angle'x = cos(angle*DtoR)*L'y = sin(angle*DtoR)*LSUB tree (x as integer, y as integer, a as single, L as single, depth as integer)    dim as single Oldx,Oldy,xx,yy,lastdepth     Oldx = x    Oldy = y              IF depth THEN               x = x + L * COS(a + DtoR*90)          'compute new x coordinate        y = y + L * SIN(a + DtoR*90)          'compute new y coordinate                      line (Oldx+320,480-Oldy)-(x+320,480-y),rgb(0,150,0)               xx = x+320        yy = 480-y                IF depth < 8 THEN            line (xx-L\4,yy-L\4)-(xx+L\4,yy+L\4),rgb(0,150,0)            line (xx+L\4,yy-L\4)-(xx-L\4,yy+L\4),rgb(0,150,0)        END IF       if depth < 8 then circle (xx+L\4,yy-L\4),depth -1.5,rgb(0,150,0),,,,f       if depth < 8 then circle (xx-L\4,yy-L\4),depth -1.5,rgb(0,150,0),,,,f       if depth < 8 then circle (xx+L\4,yy+L\4),depth -1.5,rgb(0,150,0),,,,f       if depth < 8 then circle (xx-L\4,yy+L\4),depth -1.5,rgb(0,150,0),,,,f        Oldx = x        Oldy = y                        tree (x,y, a + 45*DtoR, L * .6, depth - 1)  'shorten the length of branch        tree (x,y, a - 45*DtoR, L * .6 , depth - 1)  'and reduce the depth value     END IF            return   END SUB'************** MAIN ROUTINE ****************'      x, y, angle, length, depthtree (0, 10,   0,    190,     8   )while inkey="":wend `

Version 4:

A cactus like picture (actually a fractal tree with circles instead of lines for branches). Code: Select all

` ' a cactus like pictureConst Pi = 4 * Atn(1)Dim Shared As Double TwoPi = 8 * Atn(1)Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degreesDim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radiansscreenres 640,480,32color rgb(0,0,0),rgb(255,255,255):clsdim as single angle,x,yx = 20y = 40angle = atan2(y,x)*RtoD'x = cos(angle*DtoR)*L'y = sin(angle*DtoR)*LSUB cactus (x as integer, y as integer, a as single, L as single, depth as integer)    dim as single Oldx,Oldy,xx,yy    Oldx = x    Oldy = y           IF depth THEN               x = x + L * COS(a + DtoR*90)          'compute new x coordinate        y = y + L * SIN(a + DtoR*90)          'compute new y coordinate                      if depth < 4 then line (Oldx+320,480-Oldy)-(x+320,480-y),rgb(50,120,50)              if depth = 9 then circle (x+320,480-y+L\2.475),(L\3.375) - 2,rgb(0,120,0),,,,f               xx = x+320        yy = 480-y              if depth > 4  then circle (x+320,480-y),L\1.815,rgb(10-L,238+11.5*L,0),,,,f       if depth = 4  then circle (x+320,480-y),-1.5 + (L\1.815),rgb(60+5*L,10+L,0),,,,f        if depth = 1  then circle (x+320,480-y),2,rgb(230,10,0),,,,f               Oldx = x        Oldy = y                cactus (x,y, a + 45*DtoR, L * .6, depth - 1)  'shorten the length of branch        cactus (x,y, a - 45*DtoR, L * .6 , depth - 1)  'and reduce the depth value     END IF   END SUB'      x, y, angle, length, depthcactus (20, 40,   0,    170,     9   )while inkey="":wend `

I wonder how to make the branches like a trapezium in shape and how to distort them slightly to make the tree look bit more realistic.

I also thought about using Cairo to enhance the graphics.

I accidentally came across this forum a number of days ago and was really impressed by all the knowledge of it's members. I upload to PlanetVb but now I'n a big fan of FreeBasic. I have experimented with different Freebasic source code, and am finding it not to hard to use, except for the little errors that come up with win32 and win64 builds. A little bit frustrating but the great graphics is a real eye opener.

Thank you Paul Doe and Badidea for your fractal code additions and for making me welcome. I see that you are from the Netherlands and Argentina. I'm in Australia (which is being hit hard by fires, rain/hail and now wind). The weather has been really unusual and going from one extreme to the other.

See you for now.
Last edited by Bolee on Jan 22, 2020 3:47, edited 2 times in total.
paul doe
Posts: 1068
Joined: Jul 25, 2017 17:22
Location: Argentina

### Re: Some Variations of a Binary Fractal Tree

Bolee wrote:My very first post.
...

Welcome, then =D

Very nice! I love fractals (or anything procedural, for that matter). Since I'm working on the graphic backends on my framework, I'll share a little snippet with you:

Code: Select all

`#include once "fbgfx.bi"#define ColorR( c ) _  ( culng( c ) shr 16 and 255 )#define ColorG( c ) _  ( culng( c ) shr 8 and 255 )#define ColorB( c ) _  ( culng( c ) and 255 )#define ColorA( c ) _  ( culng( c ) shr 24 )#define pitchInPixelsOf( buffer ) _  ( buffer->pitch \ sizeOf( ulong ) )#define pixelsOf( buffer ) _  ( cptr( _    ulong ptr, _    buffer ) + sizeOf( Fb.Image ) \ sizeOf( ulong ) )#define pixel( buffer, x, y, pitch ) _  buffer[ ( pitch ) * ( y ) + ( x ) ]#define colorMix( component, s, d, x ) _  ( ( component( d ) - component( s ) ) * ( x ) + component( s ) )function _  createBackground( _    byval c1 as ulong, _    byval c2 as ulong, _    byval w as integer, _    byval h as integer ) _  as Fb.Image ptr    dim as single _    centerX => w / 2, _    centerY => h / 2, _    maxValue => sqr( centerX ^ 2 + centerY ^ 2 )    dim as Fb.Image ptr _    s => imageCreate( w, h )    dim as integer _    pitch => pitchInPixelsOf( s )  dim as ulong ptr _    px => pixelsOf( s )    for _    y as integer => 0 _    to h - 1          for _       x as integer => 0 to _       w - 1                dim as single _          v => sqr( _            ( centerX - x ) * ( centerX - x ) + _            ( centerY - y ) * ( centerY - y ) ) _            / ( maxValue + 1 )                pixel( _          px, x, y, pitch ) => rgba( _            colorMix( ColorR, c1, c2, v ), _            colorMix( ColorG, c1, c2, v ), _            colorMix( ColorB, c1, c2, v ), _            colorMix( ColorA, c1, c2, v ) )     next  next    return( s )end function ' a cactus like pictureConst Pi = 4 * Atn(1)Dim Shared As Double TwoPi = 8 * Atn(1)Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degreesDim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radiansscreenres 640,480,32'color rgb(0,0,0),rgb(255,255,255):clsvar _  background => createBackground( _    rgba( 255, 0, 255, 255 ), _    rgba( 255, 0, 0, 255 ), _    640, 480 )put _  ( 0, 0 ), _  background, psetdim as single angle,x,yx = 20y = 40angle = atan2(y,x)*RtoD'x = cos(angle*DtoR)*L'y = sin(angle*DtoR)*LSUB cactus (x as integer, y as integer, a as single, L as single, depth as integer)    dim as single Oldx,Oldy,xx,yy    Oldx = x    Oldy = y          IF depth THEN               x = x + L * COS(a + DtoR*90)          'compute new x coordinate        y = y + L * SIN(a + DtoR*90)          'compute new y coordinate                     if depth < 4 then line (Oldx+320,480-Oldy)-(x+320,480-y),rgb(50,120,50)              if depth = 9 then circle (x+320,480-y+L\2.475),(L\3.375) - 2,rgb(0,120,0),,,,f               xx = x+320        yy = 480-y              if depth > 4  then circle (x+320,480-y),L\1.815,rgb(10-L,238+11.5*L,0),,,,f       if depth = 4  then circle (x+320,480-y),-1.5 + (L\1.815),rgb(60+5*L,10+L,0),,,,f       if depth = 1  then circle (x+320,480-y),2,rgb(230,10,0),,,,f               Oldx = x        Oldy = y               cactus (x,y, a + 45*DtoR, L * .6, depth - 1)  'shorten the length of branch        cactus (x,y, a - 45*DtoR, L * .6 , depth - 1)  'and reduce the depth value     END IF   END SUB'      x, y, angle, length, depthcactus (20, 40,   0,    170,     9   )while inkey="":wendimageDestroy( background )`

Which adds just the right amount of flair XD
Bolee wrote:...
I wanted to upload some screen captures but need to find a free site to host the images.
...

May I suggest ImgBox?
Posts: 1784
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: Some Variations of a Binary Fractal Tree

Nice, last holiday period I was also experimenting with 'fractal trees' (pasted before in Dry Christmas.)

Code: Select all

`const as single M_PI = 3.141592654type sgl2d   as single x, y   declare constructor   declare constructor(x as single, y as single)end typeconstructor sgl2dend constructorconstructor sgl2d(x as single, y as single)   this.x = x : this.y = yend constructorconst SCR_W = 800, SCR_H = 600screenres SCR_W, SCR_H, 32function tline(startPos as sgl2d, length as single, angle as single, c as ulong) as sgl2d   dim as integer x1 = startPos.x   dim as integer y1 = startPos.y   dim as integer x2 = startPos.x + length * cos(angle)   dim as integer y2 = startPos.y + length * sin(angle)   line(x1, (SCR_H - 1) - y1)-(x2, (SCR_H - 1) - y2), c   return sgl2d(x2, y2)end functiontype tree_type   private:   dim as integer branchDepth = 0   dim as integer maxBranchDepth = 5   dim as single branchAngle = M_PI * 0.2   dim as single mainBranchFactor = 0.7   dim as single sideBranchFactor = 0.4   dim as ulong c = rgba(150, 75, 0, 255)   public:   declare sub setProperties(maxBranchDepth as integer, branchAngle as single, mainBranchFactor as single, sideBranchFactor as single, c as ulong)   declare sub drawBranch(startPos as sgl2d, length as single, angle as single)end typesub tree_type.setProperties(maxBranchDepth as integer, branchAngle as single, mainBranchFactor as single, sideBranchFactor as single, c as ulong)   this.maxBranchDepth = maxBranchDepth   this.branchAngle = branchAngle   this.mainBranchFactor = mainBranchFactor   this.sideBranchFactor = sideBranchFactor   this.c = cend subsub tree_type.drawBranch(startPos as sgl2d, length as single, angle as single)   branchDepth += 1   dim as sgl2d endPos = tline(startPos, length, angle, c)   if branchDepth < maxBranchDepth then      drawBranch(endPos, length * mainBranchFactor, angle)      drawBranch(endPos, length * sideBranchFactor, angle + branchAngle)      drawBranch(endPos, length * sideBranchFactor, angle - branchAngle)   end if   branchDepth -= 1end subdim as tree_type treedim as sgl2d startPosstartPos = sgl2d(SCR_W * 0.2, SCR_H * 0.1)tree.setProperties(8, M_PI * 0.1, 0.9, 0.5, rgba(150, 125, 0, 255))tree.drawBranch(startPos, 90, M_PI * 0.5)startPos = sgl2d(SCR_W * 0.4, SCR_H * 0.1)tree.setProperties(11, M_PI * 0.40, 0.9, 0.4, rgba(150, 175, 0, 255))tree.drawBranch(startPos, 60, M_PI * 0.5)startPos = sgl2d(SCR_W * 0.6, SCR_H * 0.1)tree.setProperties(10, M_PI * 0.2, 0.7, 0.4, rgba(150, 100, 0, 255))tree.drawBranch(startPos, 150, M_PI * 0.5)startPos = sgl2d(SCR_W * 0.8, SCR_H * 0.1)tree.setProperties(8, M_PI * 0.1, 0.2, 0.7, rgba(150, 150, 0, 255))tree.drawBranch(startPos, 100, M_PI * 0.5)sleep`
paul doe
Posts: 1068
Joined: Jul 25, 2017 17:22
Location: Argentina

### Re: Some Variations of a Binary Fractal Tree

Bolee wrote:...
Thank you Paul Doe and Badidea for your fractal code additions and for making me welcome. I see that you are from the Netherlands and Argentina. I'm in Australia (which is being hit hard by fires, rain/hail and now wind).
...

You're welcome. Yeah, my ex-wife and I (being both Greenpeace members) are following the whereabouts there very closely. Know that our hearths and minds are with you people, and your magical country, at all times. We really wish we could do more ='(
dodicat
Posts: 6163
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Some Variations of a Binary Fractal Tree

paul doe
. . . (being both Greenpeace members) . . .
my respect.

Here is my variation

Code: Select all

`screenres 900,700,32color ,rgb(150,150,150)clstype point    as long x,y    as ulong colend typetype angle    as single cosa,sina    declare sub set(as single)end typesub angle.set(a as single)    cosa=cos(a)    sina=sin(a)    end subconst pii=4*atn(1)dim shared as long min Function r2d (pivotx As Single,pivoty As Single,px As Single,py As Single,a As angle,scale As Single=1) As point    Return Type(scale*(a.Cosa*(px-pivotx)-a.Sina*(py-pivoty))+pivotx, _                scale*(a.Sina*(px-pivotx)+a.Cosa*(py-pivoty))+pivoty)    End Function    sub leaf(Xpos as long, Ypos as long,_Width as long, _Height as long,numpoints as long,arr() as point)  #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)  static as single a(1 to 4)={.85,-.15,.2,0}  static as single b(1 to 4)={.04,.28,-.26,0}  static as single c(1 to 4)={-.04,.26,.23,0}  static as single d(1 to 4)={.85,.24,.22,.16}  static as single e(1 to 4)={0,0,0,0},p(1 to 4)  static as single f(1 to 4)={1.6,.44,1.6,0}    Dim As single pt = 0, pi, x, y, newx, newy    dim as integer iFor i  = 1 To 4    select case as const i    case 1:pi=.85    case 2,3:pi=.07    case 4:pi=.01    end select    pt+=pi    p(i)=ptNext idim as long num=numpointsdim as long max=num+min,ctrredim preserve arr(0 to max)For n As long = min To max    ctr+=1    pi = Rnd    i = 0    Do:i+=1:Loop While pi > p(i)    newx = a(i)*x+b(i)*y+e(i)    newy = c(i)*x+d(i)*y+f(i)    x = newx    y = newy        var r=map(1,num,ctr,0,155)        arr(n)=type<point>(x*_Width+Xpos,y*_Height+Ypos,rgb(r,255-r,0))Next nmin=maxend sub Function Regulate(Byval MyFps As long,Byref fps As long) As long    Static As Double timervalue,lastsleeptime,t3,frames    Var t=Timer    frames+=1    If (t-t3)>=1 Then t3=t:fps=frames:frames=0    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000    If sleeptime<1 Then sleeptime=1    lastsleeptime=sleeptime    timervalue=T    Return sleeptimeEnd Functionredim as point f(0),s(0)min=0leaf(150,650,30,-50,50000,f())leaf(250,640,30,-60,50000,f())leaf(360,640,20,-50,50000,f())min=0leaf(150,650,20,-50,2000,s())leaf(150,640,20,-60,2000,s())leaf(150,640,10,-30,900,s())#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)dim as long i,fpsdim as angle aa.set(pii/2)do    i+=2    screenlock    cls    line(0,600)-(900,700),rgb(0,100,0),bf    draw string(10,10),str(fps),rgb(0,0,0)    for n as long=lbound(s) to ubound(s) 'shadow    var z=map(600,200,s(n).y,0,10)    var r=r2d(200,700,s(n).x,s(n).y,a)    circle(r.x-z*sin(i/40)-100,r.y),3,rgb(0,90,0),,,.5,fnext nfor n as long=lbound(f) to ubound(f)'tree    var z=map(600,200,f(n).y,0,20)    select case  n    case is < ubound(F)/3    pset(f(n).x+z*sin(i/50),f(n).y),f(n).colcase is >2*ubound(f)/3     pset(f(n).x-z*sin(i/60),f(n).y),f(n).colcase else    pset(f(n).x-z*sin(i/40),f(n).y),f(n).col    end selectnext nscreenunlocksleep regulate(45,fps)loop until len(inkey)sleep  `
Posts: 47
Joined: Apr 26, 2017 8:57
Contact:

### Re: Some Variations of a Binary Fractal Tree

@dodicat
That's very nice. Here is another fractal tree in fb

Code: Select all

`#define cdXSize         640#define cdYSize         400#define deg2rad         0.01745329251994329576923690768489#define c1              27#define c2              6#define c3              3' Variables globalesdim shared as ubyte mColores(0 to 19)dim shared as integer miColor(2 to 10)sub FractalTree (x as integer, y as integer, angulo as integer, lon as integer)  dim as integer x1, y1, i, p, a1, c  if lon >= 5 then    x1 = x + lon * cos(angulo*deg2rad)    y1 = y + lon * sin(angulo*deg2rad)    if lon > 95 then p = 95 else p = lon    i = mColores(p\5)    if int(rnd() * 2) = 0 Then      if i = mColores(0) Then         i = mColores(1)       elseif i = mColores(1) then         i = mColores(0)      End If    End If    c = miColor(i)    if i = mColores(0) Or i = mColores(1) then      for i = 0 to c3        Line (x + i - c3 \ 2, y)-(x1, y1), c      next i    else      for i = 0 to p\c2        Line (x + i - p \ (c2*2), y)-(x1, y1), c      next i    end if    for i = 0 to 3 - int(rnd()*3)      p = int(rnd()*(lon - lon\6)) + lon\6      a1 = angulo - int(rnd()*55)      x1 = x + p * cos(angulo*deg2rad) : y1 = y + p * sin(angulo*deg2rad)      if lon > 100 then        FractalTree (x1, y1, a1, 100-(int(rnd()*15))-c1+int(rnd()*c1))      else        FractalTree (x1, y1, a1, lon-(int(rnd()*15))-c1+int(rnd()*c1))      end if      p = int(rnd() * (lon-lon \ 6)) + lon \ 6      a1 = angulo + int(rnd() * 55)      x1 = x + p * cos(angulo*deg2rad) : y1 = y + p * sin(angulo*deg2rad)      if lon > 100 then        FractalTree (x1, y1, a1, 100-(int(rnd()*15))-c1+int(rnd()*c1))      else        FractalTree (x1, y1, a1, lon-(int(rnd()*15))-c1+int(rnd()*c1))      end if    next i  end ifend subsub Inicio()  dim as integer i  mColores(0) = 2   for i = 1 to 19   mColores(i) = 6   if i = 1 Or i = 2 then mColores(i) = 10   if i >= 3 And i <= 6 then mColores(i) = 8  next i  miColor(2) = 3190051 : miColor(6) = 4136203 : miColor(8) = 1144621 : miColor(10) = 10289032  FractalTree(cdXSize \ 2, cdYSize-1, 270, int(10*cdYSize\25))end subscreenres cdXSize, cdYSize, 32Inicio()while not inkey = chr(27) : wend`
Posts: 47
Joined: Apr 26, 2017 8:57
Contact:

### Re: Some Variations of a Binary Fractal Tree

Hello, the WinAPI version in 26Kb, previous in more than 100Kb. Smaller and faster if I could say. BresLine included that could be improved with Cohen-Sutherland clipping algorithm.

Code: Select all

`/' -----------------------------------------------------------------------------       Plantilla Programación Gráfica - SWGPTG -  FreeBasic                  ------                                                                     ------       AUTOR   : Alfonso Víctor Caballero Hurtado                            ------                                                                     ------       VERSION : 1.0                                                         ------                                                                     ------      (c) 2020. http://www.abreojosensamblador.net                           --                Small Windows Graphics Programming Tutorial With GDI         ----------------------------------------------------------------------------- '/#include "windows.bi"#define cdXPos          CW_USEDEFAULT#define cdYPos          CW_USEDEFAULT#define cdXSize         640#define cdYSize         400#define cdColFondo      0#define MAIN_ICON       100   ' //  IDI_APPLICATION#define cdVCursor       IDC_ARROW#define cdVBarTipo      0#define cdVBtnTipo      WS_OVERLAPPEDWINDOW#define cdIdTimer       1'#define DIB_RGB_COLORS  0#define deg2rad         0.01745329251994329576923690768489#define c1              27#define c2              6#define c3              3' Prototipos de funcionesDeclare Function WndProc (As HWND,As UINT,As WPARAM, As LPARAM) As LRESULT'// Variables globales'Dim Shared As Ulong Ptr             pMainDIB:  pMainDIB    =Allocate((cdXSize)*(cdYSize))Dim Shared As Ulong Ptr              pMainDIBDim Shared As Integer                vdxClient, vdyClientDim Shared As BITMAPINFOHEADER  bi = Type(Sizeof(BITMAPINFOHEADER),cdXSize,-cdYSize,1,32,0,0,0,0,0,0)dim shared as ubyte mColores(0 to 19)dim shared as Ulong miColor(2 to 10)Sub BresLine (x1 as integer, y1 as integer, x2 as integer, y2 as integer, c as Ulong)  dim as integer x, y, Dx, Dy, xincr, yincr, erreur, i  Dx = abs(x2-x1)  Dy = abs(y2-y1)  if (x1 < x2) then xincr = 1 else xincr = -1  if (y1 < y2) then yincr = 1 else yincr = -1  x = x1 : y = y1  If Dx > Dy Then    erreur = Dx Shr 1    for i = 0 To Dx-1      x += xincr      erreur += Dy      If erreur > Dx then        erreur -= Dx        y += yincr      End If      if x >= 0 And x < cdXSize And y >= 0 And y < cdYSize Then        *(pMainDIB + y*cdXSize+x) = c      End If    next i  Else    erreur = Dy Shr 1    for i = 0 To Dy-1      y += yincr      erreur += Dx      if erreur > Dy Then        erreur -= Dy        x += xincr      End If      if x >= 0 And x < cdXSize And y >= 0 And y < cdYSize Then        *(pMainDIB + y*cdXSize+x) = c      End If    Next i  End IfEnd Subsub FractalTree (x as integer, y as integer, angulo as integer, lon as integer)  dim as integer x1, y1, i, p, a1  dim as Ulong   c  if lon >= 5 then    x1 = x + lon * cos(angulo*deg2rad)    y1 = y + lon * sin(angulo*deg2rad)    if lon > 95 then p = 95 else p = lon    i = mColores(p\5)    if int(rnd() * 2) = 0 Then      if i = mColores(0) Then         i = mColores(1)       elseif i = mColores(1) then         i = mColores(0)      End If    End If    c = miColor(i)    if i = mColores(0) Or i = mColores(1) then      for i = 0 to c3        BresLine (x + i - c3 \ 2, y, x1, y1, c)      next i    else      for i = 0 to p\c2        BresLine (x + i - p \ (c2*2), y, x1, y1, c)      next i    end if    for i = 0 to 3 - int(rnd()*3)      p = int(rnd()*(lon - lon\6)) + lon\6      a1 = angulo - int(rnd()*55)      x1 = x + p * cos(angulo*deg2rad) : y1 = y + p * sin(angulo*deg2rad)      if lon > 100 then        FractalTree (x1, y1, a1, 100-(int(rnd()*15))-c1+int(rnd()*c1))      else        FractalTree (x1, y1, a1, lon-(int(rnd()*15))-c1+int(rnd()*c1))      end if      p = int(rnd() * (lon-lon \ 6)) + lon \ 6      a1 = angulo + int(rnd() * 55)      x1 = x + p * cos(angulo*deg2rad) : y1 = y + p * sin(angulo*deg2rad)      if lon > 100 then        FractalTree (x1, y1, a1, 100-(int(rnd()*15))-c1+int(rnd()*c1))      else        FractalTree (x1, y1, a1, lon-(int(rnd()*15))-c1+int(rnd()*c1))      end if    next i  end ifend subSub PintaObjeto () End SubSub Inicio ()   dim as integer i  Randomize  mColores(0) = 2   for i = 1 to 19   mColores(i) = 6   if i = 1 Or i = 2 then mColores(i) = 10   if i >= 3 And i <= 6 then mColores(i) = 8  next i  miColor(2) = 3190051 : miColor(6) = 4136203 : miColor(8) = 1144621 : miColor(10) = 10289032  FractalTree(cdXSize \ 2, cdYSize-1, 270, int(10*cdYSize\25))End SubFunction WndProc(hWnd As HWND, message As UINT, wParam As wPARAM,lParam As LPARAM) As LRESULT        Static As   HDC               bufDIBDC    Static As  HBITMAP           hMainDIB    Dim As      HDC               hdc     Dim As      PAINTSTRUCT       ps     Static As  HGDIOBJ           hOldDIB=0, hGDITmp    Dim As     Integer               bResult        Select Case message    Case WM_CHAR         If (wParam = VK_ESCAPE) Then          SendMessage hWnd, WM_CLOSE, 0, 0        End If         Return 0             Case WM_CREATE:        hdc = GetDC(hWnd)                '// Crea un búfer dib para PintaObjeto. pMainDIB es un puntero a él        bufDIBDC = CreateCompatibleDC (hdc)        hMainDIB = CreateDIBSection(hdc,Cast(Any Ptr, @bi), DIB_RGB_COLORS, @pMainDIB, NULL, 0)        hOldDIB  = SelectObject (bufDIBDC, hMainDIB)                ReleaseDC (hWnd, hdc)'   // Libera device context                Inicio ()        SetTimer (hWnd, cdIdTimer, 20, NULL)         Return 0         Case WM_TIMER :        PintaObjeto ()        InvalidateRect (hWnd, NULL, FALSE)         Return 0     Case WM_SIZE :        vdxClient = lParam And &hFFFF        vdyClient = lParam Shr &h10 '>>        Return 0     Case WM_PAINT :        hdc = BeginPaint(hWnd, @ps)        '//bResult = BitBlt(hdc, 0, 0, cdXSize, cdYSize, bufDIBDC, 0, 0, SRCCOPY)        bResult = StretchBlt (hdc, 0, 0, vdxClient, vdyClient, bufDIBDC, 0, 0, cdXSize, cdYSize, SRCCOPY)        EndPaint(hWnd, @ps)        Return 0     Case WM_DESTROY         KillTimer (hWnd, cdIdTimer)         hGDITmp = SelectObject (bufDIBDC, hOldDIB)        bResult = DeleteDC (bufDIBDC)        bResult = DeleteObject (hMainDIB)        PostQuitMessage (0)         Return 0     End Select    Return DefWindowProc (hWnd, message, wParam, lParam) End FunctionFunction  WinMain ( hInstance As HINSTANCE,  hPrevInstance As HINSTANCE, _    szCmdLine As pSTR, iCmdShow As Integer) As Integer    Dim As  RECT   WRect    Static As String szAppName:szAppName = "SWGPTG"     Dim As HWND         hWnd     Dim As MSG          msg     Dim As WNDCLASS     wndclass     wndclass.style         = CS_HREDRAW Or CS_VREDRAW     wndclass.lpfnWndProc   =  @WndProc    wndclass.cbClsExtra    = 0     wndclass.cbWndExtra    = 0     wndclass.hbrBackground = cdColFondo     wndclass.lpszMenuName  = NULL     wndclass.lpszClassName = Strptr(szAppname)     wndclass.hInstance     = GetModuleHandle (NULL)     wndclass.hIcon         = LoadIcon(hInstance, MAKEINTRESOURCE(MAIN_ICON))     wndclass.hCursor       = LoadCursor (NULL, IDC_ARROW)         If RegisterClass (@wndclass) =0 Then        MessageBox (NULL, "This program requires Windows NT!", _        "Error", MB_ICONERROR)         Return 0     End If            SetRect (@WRect, 0, 0, cdXSize, cdYSize)    AdjustWindowRectEx (@WRect, cdVBtnTipo, 0, cdVBarTipo)    WRect.bottom -= WRect.top    WRect.right  -= WRect.left    WRect.left    = (GetSystemMetrics (SM_CXSCREEN) - WRect.right)/2    WRect.top     = (GetSystemMetrics (SM_CYSCREEN) - WRect.bottom) / 3        hWnd = CreateWindowex(0,szAppname ,"Árbol Fractal - (c) abreojosensamblador.epizy.com", _    cdVBtnTipo , _    WRect.left,WRect.top,WRect.right,WRect.bottom, _    NULL, NULL, hInstance, NULL)         ShowWindow (hWnd, iCmdShow)     UpdateWindow (hWnd)         While (GetMessage (@msg, NULL, 0, 0))         TranslateMessage (@msg)         DispatchMessage (@msg)     Wend        Return msg.wParam End Functionwinmain(GetModuleHandle( null ), null, Command( ), SW_NORMAL)` Last edited by hurtado on Jan 25, 2020 15:23, edited 1 time in total.
BasicCoder2
Posts: 3433
Joined: Jan 01, 2009 7:03

### Re: Some Variations of a Binary Fractal Tree

Looks very much like a real tree. Are you able to add texture to the trunk? Placing Randomize at the start gave lots of better variations.
Posts: 47
Joined: Apr 26, 2017 8:57
Contact:

### Re: Some Variations of a Binary Fractal Tree

> Placing Randomize at the start gave lots of better variations
Thanks for the tip. I knew that, but I have been oxidizing some knowledge of qbasic. I usually do that with "srand(GetTickCount());"
dodicat
Posts: 6163
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Some Variations of a Binary Fractal Tree

Using 32 bit colour ulong (or double) will hold all values in fb 32 bit or fb 64 bit.
I avoid using Integer or uinteger for 32 bit colours.
basiccoder2
You can adjust the colour for the second BresLine, which seems mainly the trunk.
for example:
if i>2 then c=rgb(cast(ubyte ptr,@c)+rnd*10,cast(ubyte ptr,@c),cast(ubyte ptr,@c))
BresLine (x + i - p \ (c2*2), y, x1, y1, c)

but you should make all instances of colour ulong.
c in sub fractaltree
c in the last parameter of bresline
and the array miColor(2 to 10) should be ulong.

After all
pMainDIB is Ulong Ptr for the direct pixel plotting, so why use integer? Unless I am missing something.
Posts: 47
Joined: Apr 26, 2017 8:57
Contact:

### Re: Some Variations of a Binary Fractal Tree

In GDI RGBA has a maximum of 0xFFFFFF = 16,777,215, each main color goes from 0 to 255 = FF being A = 0. Even in the case of A = FF we'd have 0xFFFFFFFF = 4,294,967,295

Being 2^32 = 4,294,967,296

So, using uint is not only enough but the correct, even in the case of 64 bits, that RGBA still has a maximum of 0xFFFFFF = 16,777,215, 4,294,967,295 if you want that is 2^32, because each main color goes from 0 to FF

Maybe pMainDIB should be UInt Ptr instead of Ulong Ptr

Of course, we could access to two colors at the same time in 64 bits:

Code: Select all

`    cld    mov      rdi, [pMainDIB]               ; Points to DIB buffer    mov      rcx, cdXSize*cdYSize/2        ;DIB elements are dword    mov      rax, 0xFFBBCC00FFBBCC    rep      stosq`

If we point to qword instead dword, we could overlap the before color, but it if are drawing 0000color in little endian those zeros go at the right. If we move 1 dword we do it right always but at the end that we exced in 1 dword the buffer magnitude.

As I am writing this I look to my c code, pMainDIB is an int point. For paint pourposes uint and int is the same.

Reviewing fb types. ULong seems to be the correct. Is 32 bits long in 32 and 64 bits. Well, you were right
Last edited by hurtado on Jan 25, 2020 14:06, edited 1 time in total.
Posts: 47
Joined: Apr 26, 2017 8:57
Contact:

### Re: Some Variations of a Binary Fractal Tree

@BasicCoder, the tree is drawed using lines, to add a texture to any object of it, it would be needed to modify the program' structure. Instead of painting with lines, maybe we should calculate the border points, for example for the trunk, divide it in triangles and then using this triangles to add textures. This is an option, but could be others.
Last edited by hurtado on Jan 25, 2020 15:23, edited 1 time in total.
dodicat
Posts: 6163
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Some Variations of a Binary Fractal Tree

Yea hurtado, I know that integer plods through 0 to 255 in four loops for rgba(r,g,b,a) just as well as ulong.
But as you have seen integer is actually longint in 64 bits.
So, depending on how you use colours (via pointers e.t.c.), strange aberrations can occur flipping between the 64 and 32 bit compilers if you don't simply use ulong to represent 32 bit colours.
paul doe
Posts: 1068
Joined: Jul 25, 2017 17:22
Location: Argentina

### Re: Some Variations of a Binary Fractal Tree

@hurtado: You can alternatively request the correct size in FreeBasic like this:

Code: Select all

`'' 32-bit signeddim as integer<32> _  a'' 32-bit unsigneddim as uinteger<32> _  b`