Author Topic: Free 3D-Fractal Tree Program  (Read 1198 times)

0 Members and 1 Guest are viewing this topic.

Offline ScottyBrosious

  • C= 64
  • **
  • Posts: 25
  • Karma: 3
    • View Profile
Free 3D-Fractal Tree Program
« on: June 28, 2007 »
Here it is!
I fixed the problem.

It's kinda sloppy right now
but it works!

Code: [Select]

'$include: 'GL/gl.bi'
'$include: 'GL/glu.bi'

'' Setup our booleans
const FALSE = 0
const TRUE  = not FALSE

#include once "bmpload.bi"

declare function LoadGLTextures() as integer


dim shared texture(9) as GLuint               '' Storage For One Texture ( NEW )

dim xrot as single                            '' X Rotation ( NEW )
dim yrot as single                            '' Y Rotation ( NEW )
dim zrot as single                            '' Z Rotation ( NEW )

''$include: 'windows.bi'

option explicit

TYPE vector
x AS DOUBLE
y AS DOUBLE
z AS DOUBLE
END TYPE

declare sub drawblob(byval p as vector, byval colour as uinteger)
declare sub readinput()

dim camang as single
dim screenwidth as uinteger
dim screenheight as uinteger
dim shared init as integer
dim shared ox as integer
dim shared oy as integer

DIM shared O AS vector
DIM shared P as vector

DIM X as vector
dim Y as vector
dim Y2 as vector
dim Z as vector

dim matrix(16) as GLfloat
dim d as single

dim shared sphere as GLUQuadricObj ptr

dim radius as GLdouble
dim length as GLdouble
dim segments as GLint
dim stacks as GLint
dim cylinder as GLUQuadricObj ptr

screenwidth = 640
screenheight = 480
init = 0


SCREEN 18,32,,2

glMatrixMode(GL_PROJECTION)
glLoadIdentity()
gluPerspective(60,cast(single, screenwidth)/screenheight,1,1024)

glEnable(GL_DEPTH_TEST)
glDepthFunc(GL_LEQUAL)
glClearDepth(1)

'glEnable(GL_TEXTURE_2D)

glClearColor(0,1,0,1)

sphere = gluNewQuadric()
'---------------------------------------------------------------------------------------
' cylinder params
'---------------------------------------------------------------------------------------
cylinder = gluNewQuadric()
gluQuadricNormals(cylinder, GLU_SMOOTH)
gluQuadricTexture(cylinder, GL_TRUE)

radius = 10
segments = 9
stacks = 2
         
dim nopts = 2046

dim which(nopts)

dim bt#(nopts)

dim xtemp(nopts)
dim ytemp(nopts)

dim ztemp(nopts)

dim xtemp2(nopts)
dim ytemp2(nopts)

dim mag#(nopts)

dim size#(nopts)

dim ang#(nopts)

dim perb#(nopts)

dim angle = 0

dim mult = 1
dim add  = 1

dim yr#

dim i,j,k
dim a,b,c
dim mult1,mult2

dim pi#

dim x1,y1,z1

dim lenght2

dim a1#
dim count#

dim count2#

dim l#,l2#
dim s#
dim s1#,s2#

dim x3d1,y3d1,z3d1

dim rand1

dim x3,y3,z3
dim e

Dim As Single LightPos(3) => {-100,100, 1024, 0 }
Dim As Single Ambient(3) => { .7, .7, .7, 1}

glEnable(GL_LIGHTING)  ' Turn on OpenGL Lighting
glEnable(GL_LIGHT0)  ' Light Source 0 (0-7)
glLightfv(GL_LIGHT0,GL_POSITION,@LightPos(0))  ' Light Position
glLightfv(GL_LIGHT0,GL_AMBIENT,@Ambient(0))  ' Ambient Light Source (Overall Scene)

'glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
'glEnable (GL_BLEND)

'' Jump To Texture Loading Routine
if (not LoadGLTextures()) then
      end 1                                        '' If Texture Didn't Load Quit
end if

glEnable(GL_DEPTH_TEST)
glDepthFunc(GL_LEQUAL)
glClearDepth(1)

glEnable(GL_TEXTURE_2D)

'glEnable(GL_CULL_FACE)

glClearColor(0,0,1,1)


do

glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT)

glMatrixMode(GL_MODELVIEW)
glLoadIdentity()

glRotatef(-camang, 0, 0, 1)
glTranslatef(0,-256,-1024)

glTranslatef(0,0,512)
glRotatef(yr#,0,1,0)

randomize timer

gosub math

gosub rendertrunk

gosub renderbranches

flip

yr# = yr# + 1

loop until inkey$ = chr$(27)

end

math:

dim a#(nopts)

for i = 0 to nopts

xtemp(i) = 0
ytemp(i) = 0
ztemp(i) = 0

which(i) = 0

next i

a = 1
b = 2
c = 0
e = 0

mult1 = 2
mult2 = 4

pi# = 3.1415926

x1 = 0
y1 = 0

lenght2 = screenheight / 4

xtemp(0) = x1 '+ -cos(bt#(0) * pi# / 180) * lenght2
ytemp(0) = y1 + lenght2'+  sin(bt#(0) * pi# / 180) * lenght2

size#(0) = 12

'gosub trunk1

mag#(0) = lenght2 / 2

'glLineWidth(size#(0))

'y1 = size#(0)
Z1 = 0

gosub bulk

which(0) = 1

for j = 0 to 9
   
for i = a to b

if j > 0 and e = 0 then c = c + 1

'randomize timer

if e = 0 then a1# = rnd(1) * 1

if e = 0 then bt#(i) = bt#(c) + (45*a1#):a#(i) = a#(c) + (45*a1#)
if e = 1 then bt#(i) = bt#(i-1) - 45:a#(i) = a#(i-1) -45 

if e = 0 then count# = bt#(i) - bt#(c)
if e = 1 then count# = bt#(c) - bt#(i)

'if d = 0 then count2# = a#(c) - a#(i)
'if d = 1 then count2# = a#(c) + a#(i)

l# = 1 - (count# / 90)

mag#(i) = mag#(c) * l#

size#(i) = size#(c) * l#

if e = 0 then s1# = size#(i)
if e = 1 then s2# = size#(i)

xtemp(i) = xtemp(c) + bt#(i)

ytemp(i) = ytemp(c) + mag#(c)

'gosub trunk2

if e = 1 and which(c) = 1 and s1# >= s2# then which(i-1) = 1
if e = 1 and which(c) = 1 and s1# < s2# then which(i) = 1

e = e + 1
if e = 2 then e = 0

next i
 
if j > 0 then mult1 = mult1 * 2
if j > 0 then mult2 = mult2 * 2

a = a + mult1
b = b + mult2

next j

return

rendertrunk:

a = 1
b = 2
c = 0
e = 0

mult1 = 2
mult2 = 4

for j = 0 to 9
   
for i = a to b

if j > 0 and e = 0 then c = c + 1

if which(c) = 1 and which(i) = 1 then gosub trunk2

if which(c) > 1 then gosub more

e = e + 1
if e = 2 then e = 0

next i
 
if j > 0 then mult1 = mult1 * 2
if j > 0 then mult2 = mult2 * 2

a = a + mult1
b = b + mult2

next j

return

trunk1:

'glRotatef (-90, 1, 0, 0)

'gluCylinder(quadric1,size#(c),size#(c),lenght,16,16)

'glRotatef ( 90, 1, 0, 0)

return

trunk2:

'glLineWidth(size#(i))

'glBegin(GL_LINES)

'glColor3f(1,1,1)

'glVertex3f(xtemp(c),ytemp(c),0)
'glVertex3f(xtemp(i),ytemp(i),0)

gosub bulk2

'glEnd()

'glTranslatef(xtemp(c),ytemp(c),0)
'glRotatef (-90, 1, 0, 0)
'glRotatef ( a#(i), 0, 1 ,0)

'glColor3f(0,0,1)
'gluCylinder(quadric1,size#(c),size#(c),mag#(c),16,16)

'glRotatef (-a#(i), 0, 1, 0)
'glRotatef ( 90, 1, 0, 0)
'glTranslatef(-xtemp(c),-ytemp(c),0)

return

renderbranches:

for k = 0 to 1

a = 1
b = 2
c = 0
e = 0

mult1 = 2
mult2 = 4

for j = 0 to 9
   
for i = a to b

if j > 0 and e = 0 then c = c + 1

if which(c) = 1 and which(i) = 0 then gosub branches
'if which(c) = 2 and which(i) = 2 then gosub more

if which(c) > 1 then gosub more

'gosub branches

e = e + 1
if e = 2 then e = 0

next i

if j > 0 then mult1 = mult1 * 2
if j > 0 then mult2 = mult2 * 2

a = a + mult1
b = b + mult2

next j
next k

return

branches:

ang#(c) = rnd(1) * 360

x3d1 = xtemp(c) + cos(ang#(c) * pi# / 180) * mag#(c)
y3d1 = ytemp(i)
z3d1 = ztemp(c) + -sin(ang#(c) * pi# / 180) * mag#(c)

gosub bulk3

ang#(i) = ang#(c)

xtemp(i) = x3d1
ytemp(i) = y3d1
ztemp(i) = z3d1

which(i) = 2

return

more:

rand1 = int(rnd(1) * 2 ) + 1

if e = 0 and rand1 = 1 then ang#(i) = ang#(c) + a#(c)'(a#(c) / 2)
if e = 0 and rand1 = 2 then ang#(i) = ang#(c) - a#(c)'(a#(c) / 2)

if e = 1 and rand1 = 1 then ang#(i) = ang#(c) + a#(c)'(a#(c) / 2)
if e = 1 and rand1 = 2 then ang#(i) = ang#(c) - a#(c)'(a#(c) / 2)

x3d1 = xtemp(c) + cos(ang#(i) * pi# / 180) * mag#(c)
y3d1 = ytemp(i)
z3d1 = ztemp(c) + -sin(ang#(i) * pi# / 180) * mag#(c)

gosub bulk3

glLineWidth(size#(c))

glBegin(GL_LINES)

glColor3f(1,1,1)
'glVertex3f(xtemp(c),ytemp(c),ztemp(c))
'glVertex3f(x3d1,y3d1,z3d1)

glEnd()

'ba# = 0'rnd(1) * 360

'glTranslatef(xtemp(c),ytemp(c),ztemp(c))
'glRotatef ( ang#(i)+90, 0, 1 ,0)

'gluCylinder(quadric1,size#(i),size#(i),mag#(c),16,16)

'glRotatef ( -ang#(i)-90, 0, 1, 0)
'glTranslatef(-xtemp(c),-ytemp(c),-ztemp(c))

xtemp(i) = x3d1
ytemp(i) = y3d1
ztemp(i) = z3d1

which(i) = 2

return

bulk:

glBindTexture(GL_TEXTURE_2D, texture(0))

O.x = x1
O.y = y1
O.z = 0

P.x = xtemp(0)
P.y = ytemp(0)
P.z = 0

gosub cylinder

return

bulk2:

glBindTexture(GL_TEXTURE_2D, texture(0))

O.x = xtemp(c)
O.y = ytemp(c)
O.z = 0

P.x = xtemp(i)
P.y = ytemp(i)
P.z = 0

gosub cylinder

'p1.x = xtemp(c) + xscale
'p1.y = ytemp(c)
'p1.z = z - zscale

'p2.x = xtemp(i) + xscale
'p2.y = ytemp(i)
'p2.z = z - zscale

'p3.x = xtemp(i) + xscale
'p3.y = ytemp(i)
'p3.z = z + zscale

return

bulk3:

glBindTexture(GL_TEXTURE_2D, texture(0))

O.x = xtemp(c)
O.y = ytemp(c)
O.z = ztemp(c)

P.x = x3d1
P.y = y3d1
P.z = z3d1

gosub cylinder

'1.x = xtemp(c) + xscale
'p1.y = ytemp(c)
'p1.z = ztemp(c) - zscale

'p2.x = x3d1 + xscale
'p2.y = y3d1
'p2.z = z3d1 - zscale

'p3.x = x3d1 + xscale
'p3.y = y3d1
'p3.z = z3d1 + zscale


return

cylinder:

  glPushMatrix()

glTranslatef(O.x, O.y, O.z)
       
Z.x = P.x - O.x
Z.y = P.y - O.y
Z.z = P.z - O.z

'make it a unit
d = sqr(Z.x * Z.x + Z.y * Z.y + Z.z * Z.z)

'store the cylinder's length
length = d

Z.x = Z.x / d
Z.y = Z.y / d
Z.z = Z.z / d

Y.x = Z.y
Y.y = -Z.z
Y.z = 0

'make it a unit
d = sqr(Y.x * Y.x + Y.y * Y.y + Y.z * Y.z)

'check for special case
if d < 0.1 then
Y.x = -Z.z
Y.y = 0
Y.z = Z.x
d = sqr(Y.x * Y.x + Y.y * Y.y + Y.z * Y.z)
end if
Y.x = Y.x / d
Y.y = Y.y / d
Y.z = Y.z / d

'cross product
X.x = Y.y * Z.z - Y.z * Z.y
X.y = Y.z * Z.x - Y.x * Z.z
X.z = Y.x * Z.y - Y.y * Z.x

'make it a unit
d = sqr(X.x * X.x + X.y * X.y + X.z * X.z)
X.x = X.x / d
X.y = X.y / d
X.z = X.z / d

'cross product
Y2.x = X.y * Z.z - X.z * Z.y
Y2.y = X.z * Z.x - X.x * Z.z
Y2.z = X.x * Z.y - X.y * Z.x
Y2 = Y

matrix( 0)=X.x
matrix( 1)=X.y
matrix( 2)=X.z
matrix( 3)=0

matrix( 4)=Y2.x
matrix( 5)=Y2.y
matrix( 6)=Y2.z
matrix( 7)=0

matrix( 8)=Z.x
matrix( 9)=Z.y
matrix(10)=Z.z
matrix(11)=0

matrix(12)=0
matrix(13)=0
matrix(14)=0
matrix(15)=1

glMultMatrixf(@matrix(0))

glColor3f(1,1,1)
   
    gluCylinder(cylinder,size#(c), size#(c), length, segments, stacks)
                   
   glPopMatrix()
   
     
return   

'' Load Bitmaps And Convert To Textures
function LoadGLTextures() as integer
  dim Status as integer = FALSE                     '' Status Indicator
  dim TextureImage(9) as BITMAP_RGBImageRec ptr     '' Create Storage Space For The Texture

  ' Load The Bitmap, Check For Errors, If Bitmap's Not Found Quit
' TextureImage(0) = LoadBMP(exepath + "/textures/demon.bmp")
  TextureImage(0) = LoadBMP("c:\FBFiles\textures\bark03.bmp")
  TextureImage(1) = LoadBMP("c:\FBFiles\Maps\venus.bmp")
  TextureImage(2) = LoadBMP("c:\FBFiles\Maps\earth.bmp")
  'TextureImage(3) = LoadBMP("c:\FBFiles\Maps\moon24.bmp")
  'TextureImage(4) = LoadBMP("c:\FBFiles\Maps\earth.bmp")
  'TextureImage(5) = LoadBMP("c:\FBFiles\Maps\mars.bmp")
  'TextureImage(6) = LoadBMP("c:\FBFiles\Maps\jupiter.bmp") ' also jupiter2
  'TextureImage(7) = LoadBMP("c:\FBFiles\Maps\moon24.bmp")
  'TextureImage(8) = LoadBMP("c:\FBFiles\Maps\earth.bmp")
  TextureImage(9) = LoadBMP("c:\FBFiles\Maps\pluto.bmp")
  dim h
  for h = 0 to 9
  if TextureImage(h) then
    Status = TRUE                                   '' Set The Status To TRUE
    glGenTextures 1, @texture(h)                    '' Create The Texture
    ' Typical Texture Generation Using Data From The Bitmap
    glBindTexture GL_TEXTURE_2D, texture(h)
    glTexImage2D GL_TEXTURE_2D, 0, 3, TextureImage(h)->sizeX, TextureImage(h)->sizeY, 0, GL_RGB, GL_UNSIGNED_BYTE, TextureImage(h)->buffer
    glTexParameteri GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR
    glTexParameteri GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR
  end if

  if TextureImage(h) then                           '' If Texture Exists
    if TextureImage(h)->buffer then                 '' If Texture Image Exist
      deallocate(TextureImage(h)->buffer)           '' Free The Texture Image Memory
    end if
    deallocate(TextureImage(h))                     '' Free The Image Structure
  end if
  next
  return Status                                     '' Return The Status
end function


Now, Thanks Jim for the help with the glucylinders
It makes it so it's lit and textured.

Now, Not to be a newcince.
But what shall we do about leaves?
A tree needs leaves unless it's winter.

Any ideas?
Thanks

It also needs a little more randomness in the Y-Height factor.


Scotty B.
« Last Edit: June 28, 2007 by ScottyBrosious »

Offline Bolee

  • ZX 81
  • *
  • Posts: 1
  • Karma: 0
    • View Profile
Re: Free 3D-Fractal Tree Program
« Reply #1 on: February 17, 2021 »
Nice 3D tree.

I played around with a Pythagoras Tree in FreeBasic and VB6 (which I upload to Planetcode source, but it is gone now)