Procedural tree generation

Blitz3D Forums/Blitz3D Programming/Procedural tree generation

MusicianKool (Posted 2010) [#1]

Need some help finding a tutorial on how to do this or guidance.

bye (Posted 2010) [#2]

http://lmgtfy.com/?q=Procedural+tree+generation+tutorial

Jiffy (Posted 2010) [#3]

Search L-System: http://bostandjiev.com/Graphics%20class%20final/index.html http://spanky.triumf.ca/www/fractint/lsys/plants.html

MusicianKool (Posted 2010) [#4]

Is there a way to get the vertex coordinates of a mesh after PositionEntity(), RotateEntity commands so that the entity's position is included to the vertex coordinates? hope that makes sense.

Stevie G (Posted 2010) [#5]

To get the position of each vertex in world coords, taking into consideration scaling, position and rotation use ... s = getsurface( mymesh, 1 ) for v = 0 to countvertices(s)-1 tformpoint vertexx(s,v), vertexy(s,v), vertexz(s,v), mymesh, 0 wx# = tformedx() wy# = tformedy() wz# = tformedz() next

MusicianKool (Posted 2010) [#6]

Oh nice! But I figured out another way. I just used the example from the code archives and made some changes so that it returns one tree mesh (no leaves, erm dead leafs). spacebar to generate a new random tree Graphics3D 800,600,32,2 SetBuffer BackBuffer() SeedRand MilliSecs() Camera = CreateCamera() PositionEntity camera,0,10,-20 WireFrame 0 Light = CreateLight() Tree = CreateRandomizedTree() AmbientLight 255,255,255 While Not KeyHit(1) Cls If KeyHit(57) Then FreeEntity tree Tree = CreateRandomizedTree() EndIf TurnEntity tree,0,1,0 RenderWorld Text 0,0,TrisRendered() Flip Wend End Function CreateRandomizedTree() Wiggle_Flag = Rand(1,2);1="on", 2="off". Specifies whether to 'wiggle' the branches as they are rotated. Branches_On_End_Flag = Rand(1,2); 1="on", 2="off". specifies growth on just the ends or evenly spaced along branch. LEAF_TYPE = 0;Rand(-1,5) ; Leaf type is: 0=Realistic, 1=Sphere Blobs ; 2=Strange, 3=Torus ; 4=Triangles, 5=Ultra-Triangles ; 6=Texture mapped (Maps a graphics on a flattened cube, supply your own graphic) ; -1=Default, just a sphere! Leaf_Mesh = 1;Rand(1,10); sets the maximum # of trianges for type 4/5 leaves Number_Of_Large_Branches = Rand(1,5) ;NUMBER OF Large/Medium/Small BRANCHES is in relation to each 'parent' branch. Number_Of_Medium_Branches = Rand(3,5) Number_Of_Small_Branches = Rand(5,7) Large_Branch_Minimum_Angle# = Rnd(1,20);Large/Medium/Small BRANCH MIN/MAX TILT ANGLE sets limits of random branch tilt. Medium_Branch_Minimum_Angle# = Rnd(1,30) Small_Branch_Minimum_Angle# = Rnd(1,50) Large_Branch_Maximum_Angle# = Rnd(20,50) Medium_Branch_Maximum_Angle# = Rnd(30,70) Small_Branch_Maximum_Angle# = Rnd(50,100) Tree_Trunk_Size# = Rnd(0,9) ;sets the height of the tree trunk. Large_Branch_Size_Min# = Rnd(.1,2);Large/Medium/Small BRANCH MIN/MAX SIZE sets length limits of the branches. Medium_Branch_Size_Min# = Rnd(.1,2) Small_Branch_Size_Min# = Rnd(.1,2) Large_Branch_Size_Max# = Rnd(3,4) Medium_Branch_Size_Max# = Rnd(2,3) Small_Branch_Size_Max# = Rnd(2,4) Trunk_seg = 4;(def = 4)This sets the number of faces in Each trunk And branch cylinder LBranch_seg = 4;(def = 4) MBranch_seg = 4;(def = 4) SBranch_seg = 4;(def = 4) Trunk_Big_Dia# = Rnd(.05,.3);(def = 1)These set the bottom diameter of the trunk/branches Trunk_Small_Dia# = Rnd(.05,Trunk_Big_Dia#);def = .8)These set the top diameter of the trunk/branches LBranch_Big_Dia# = (Trunk_Small_Dia#);(def = .6) LBranch_Small_Dia# = Rnd(.1,LBranch_Big_Dia#);(def = .4) MBranch_Big_Dia# = (LBranch_Small_Dia#);(def = .3) MBranch_Small_Dia# = Rnd(.1,MBranch_Small_Dia#);(def = .2) SBranch_Big_Dia# = (MBranch_Small_Dia#);(def = .1) SBranch_Small_Dia# =Rnd(.01,SBranch_Small_Dia#);(def = .05) Tree = CreateTree(Wiggle_Flag,Branches_On_End_Flag,Leaf_Type,Leaf_Mesh,Number_Of_Large_Branches,Number_Of_Medium_Branches,Number_Of_Small_Branches,Large_Branch_Minimum_Angle#,Medium_Branch_Minimum_Angle#,Small_Branch_Minimum_Angle#,Large_Branch_Maximum_Angle#,Medium_Branch_Maximum_Angle#,Small_Branch_Maximum_Angle#,Tree_Trunk_Size#,Large_Branch_Size_Min#,Medium_Branch_Size_Min#,Small_Branch_Size_Min#,Large_Branch_Size_Max#,Medium_Branch_Size_Max#,Small_Branch_Size_Max#,Trunk_seg,LBranch_seg,MBranch_seg,SBranch_seg,Trunk_Big_Dia#,Trunk_Small_Dia#,LBranch_Big_Dia#,LBranch_Small_Dia#,MBranch_Big_Dia#,MBranch_Small_Dia#,SBranch_Big_Dia#,SBranch_Small_Dia#) ;Tree = CombineToOneMesh(tree) EntityColor tree,128,64,0 Return tree End Function ;#Region; BB3D Tree, V1.1 by Martin A. Parrott (parrottm@...) ;#Region; Comments ; Oct. 28, 2001 - 1. Added ability to texture the tree components ; 2. Added another leaf type, type 6 ; ; This is a piece of code to create a 3D tree with a few predefined ; leaf types. Feel free to add your own leaf routines to the select/case area ; This code is based on code written in Lscript for Lightwave 3D by Newtek ; which was in turn based on an earlier BML script for Lightwave 3D ; and that was based on code ported from a POVRay macro, whew! ; Note: This code is not warranted in any way so use at your own risk ; And test it For usability in your own program ; ; This code is free to use, but if you modify it, please send the ; changes to the above email address so I can continue to release ; updates so others can benefit. ; ; This routine can make many different types of trees, bushes, etc. ; Just change the variables! There are a lot to allow flexibility, so go for it! ; ; Parameters are: ; Wiggle_Flag 1="on", 2="off". Specifies whether to 'wiggle' the branches as they are rotated. ; Branches_On_End_Flag 1="on", 2="off". specifies growth on just the ends or evenly spaced along branch. ; LEAF TYPE is: 0=Realistic, 1=Sphere Blobs ; 2=Strange, 3=Torus ; 4=Triangles, 5=Ultra-Triangles ; 6=Texture mapped (Maps a graphics on a flattened cube, supply your own graphic) ; -1=Default, just a sphere! ; Leaf_Mesh sets the maximum # of trianges for type 4/5 leaves ; Number_Of_Large_Branches NUMBER OF Large/Medium/Small BRANCHES is in relation to each 'parent' branch. ; Number_Of_Medium_Branches ; Number_Of_Small_Branches ; Large_Branch_Minimum_Angle# Large/Medium/Small BRANCH MIN/MAX TILT ANGLE sets limits of random branch tilt. ; Medium_Branch_Minimum_Angle# ; Small_Branch_Minimum_Angle# ; Large_Branch_Maximum_Angle# ; Medium_Branch_Maximum_Angle# ; Small_Branch_Maximum_Angle# ; Tree_Trunk_Size# sets the height of the tree trunk. ; Large_Branch_Size_Min# Large/Medium/Small BRANCH MIN/MAX SIZE sets length limits of the branches. ; Medium_Branch_Size_Min# ; Small_Branch_Size_Min# ; Large_Branch_Size_Max# ; Medium_Branch_Size_Max# ; Small_Branch_Size_Max# ; Trunk_seg This sets the number of faces in each trunk and branch cylinder ; LBranch_seg ; MBranch_seg ; SBranch_seg ; Trunk_Big_Dia# These set the bottom diameter of the trunk/branches ; Trunk_Small_Dia# These set the top diameter of the trunk/branches ; LBranch_Big_Dia# ; LBranch_Small_Dia# ; MBranch_Big_Dia# ; MBranch_Small_Dia# ; SBranch_Big_Dia# ; SBranch_Small_Dia# ; Texture section ; Uncomment the following and replace the image files with your own if you want ; textures on your trunk, branches and/or leaves ; Note: If you don't want these to be global variables, move them inside the ; function below ;Global Trunk_texture$="trunk.bmp" ;Global LargeBranch_texture$="largebranch.bmp" ;Global MediumBranch_texture$="medbranch.bmp" ;Global SmallBranch_texture$="smallbranch.bmp" ;Global Leaf_texture$="leaf.bmp" ;Include "../lib/cylindertaper.bb" ; Needed to create the trunk and limbs of our tree ;Include "../lib/torus.bb" ; Needed for one of our strange leaf types! ;#End Region Function CreateTree(Wiggle_Flag=2,Branches_On_End_Flag=2,Leaf_Type=-1,Leaf_Mesh=100,Number_Of_Large_Branches=5,Number_Of_Medium_Branches=3,Number_Of_Small_Branches=7,Large_Branch_Minimum_Angle#=20,Medium_Branch_Minimum_Angle#=20,Small_Branch_Minimum_Angle#=20,Large_Branch_Maximum_Angle#=40,Medium_Branch_Maximum_Angle#=40,Small_Branch_Maximum_Angle#=40,Tree_Trunk_Size#=9,Large_Branch_Size_Min#=2,Medium_Branch_Size_Min#=2,Small_Branch_Size_Min#=2,Large_Branch_Size_Max#=4,Medium_Branch_Size_Max#=3,Small_Branch_Size_Max#=4,Trunk_seg=15,LBranch_seg=4,MBranch_seg=4,SBranch_seg=4,Trunk_Big_Dia#=1,Trunk_Small_Dia#=.8,LBranch_Big_Dia#=.6,LBranch_Small_Dia#=.4,MBranch_Big_Dia#=.3,MBranch_Small_Dia#=.2,SBranch_Big_Dia#=.1,SBranch_Small_Dia#=.05) ; System calculated variables. Takes from defaults above or passed function parameters ;#Region SETUP L_Bmin#=Large_Branch_Minimum_Angle# L_Bmax#=Large_Branch_Maximum_Angle# - Large_Branch_Minimum_Angle# M_Bmin#=Medium_Branch_Minimum_Angle# M_Bmax#=Medium_Branch_Maximum_Angle# - Medium_Branch_Minimum_Angle# S_Bmin#=Small_Branch_Minimum_Angle# S_Bmax#=Small_Branch_Maximum_Angle# - Small_Branch_Minimum_Angle# Large_Branch_Size_Range#=Large_Branch_Size_Max# - Large_Branch_Size_Min# Medium_Branch_Size_Range#=Medium_Branch_Size_Max# - Medium_Branch_Size_Min# Small_Branch_Size_Range#=Small_Branch_Size_Max# - Small_Branch_Size_Min# If Trunk_texture$<>"" ; Get our Trunk texture if defined trunktex=LoadTexture(Trunk_texture$) Else trunktex=0 EndIf If LargeBranch_texture$<>"" ; Get our Large branch texture if defined lbranchtex=LoadTexture(LargeBranch_texture$) Else lbranchtex=0 EndIf If MediumBranch_texture$<>"" ; Get our Medium branch texture if defined mbranchtex=LoadTexture(MediumBranch_texture$) Else mbranchtex=0 EndIf If SmallBranch_texture$<>"" ; Get our Small branch texture if defined sbranchtex=LoadTexture(SmallBranch_texture$) Else sbranchtex=0 EndIf If Leaf_texture$<>"" ; Get our Leaf texture if defined leaftex=LoadTexture(Leaf_texture$,54) Else leaftex=0 EndIf ;#End Region ; Make the Tree Trunk ; Note: the Make_Branch function puts a sphere on the end of the branch to 'smooth' ; up the construction. If you want to save polys, change all calls of Make_Branch ; below to Make_Branch_Nosphere Trunk=Make_Branch(Tree_Trunk_Size#,Trunk_Big_Dia#,Trunk_Small_Dia#,Trunk_seg,trunktex) A=0 While A < Number_Of_Large_Branches ; Make one large branch. This_Large_Branch_Size#=( Rnd(0,1) * Large_Branch_Size_Range# ) + Large_Branch_Size_Min# LBranch=Make_Branch(This_Large_Branch_Size#,LBranch_Big_Dia#,LBranch_Small_Dia#,LBranch_seg,lbranchtex) If LargeBranch_texture$<>"" ; If the texture is defined, apply it EntityTexture LBranch,lbranchtex EndIf ;branch wiggle Wiggle=(Rnd(0,1)*20) - 10 If Wiggle_Flag=2 Wiggle=0 EndIf A2=( 360 / Number_Of_Large_Branches ) * A A2=A2 + Wiggle ;branch angle BranchAngle1#=(Rnd(0,1)*L_Bmax)+L_Bmin ;branch height TEMP_HEIGHT1#=Tree_Trunk_Size# If Branches_On_End_Flag=2 TEMP_HEIGHT1#=((Tree_Trunk_Size# / Rand(Number_Of_Large_Branches))); EndIf ; Loop To put medium branches on that large branch. B=0 While B < Number_Of_Medium_Branches This_Medium_Branch_Size#=( Rnd(0,1) * Medium_Branch_Size_Range# ) + Medium_Branch_Size_Min# MBranch=Make_Branch(This_Medium_Branch_Size#,MBranch_Big_Dia#,MBranch_Small_Dia#,MBranch_seg,mbranchtex) If MediumBranch_texture$<>"" ; If the texture is defined, apply it EntityTexture MBranch,mbranchtex EndIf ;Branch Wiggle Wiggle=(Rnd(0,1)*20) - 10 If ( Wiggle_Flag=2 ) Wiggle=0 EndIf B2=( 360 / Number_Of_Medium_Branches ) * B B2=B2 + Wiggle ;branch Angle BranchAngle2#=(Rnd(0,1)*M_Bmax)+M_Bmin ;branch Height TEMP_HEIGHT2#=This_Large_Branch_Size# If ( Branches_On_End_Flag=2 ) TEMP_HEIGHT2#=((This_Large_Branch_Size# / Rand(Number_Of_Medium_Branches))) EndIf ; Loop To put small branches on that medium branch. C=0 While C < Number_Of_Small_Branches This_Small_Branch_Size#=( Rnd(0,1) * Small_Branch_Size_Range# ) + Small_Branch_Size_Min# SBranch=Make_Branch_Nosphere(This_Small_Branch_Size#,SBranch_Big_Dia#,SBranch_Small_Dia#,SBranch_seg,sbranchtex) If SmallBranch_texture$<>"" ; If the texture is defined, apply it EntityTexture SBranch,sbranchtex EndIf ; The leaf at the End of the small branch. Temp_leaf=Make_Leaf(Leaf_Type,Leaf_Mesh,leaftex) PositionMesh Temp_leaf,0,This_Small_Branch_Size#,0 ;EntityParent Temp_leaf,SBranch AddMesh Temp_leaf,SBranch FreeEntity Temp_leaf ; First, spin the vertical branch To a random angle. ; The branch doesn't really change - this actually ; just spins the leaf around! SpinAngle=(Rnd(0,1)*360) RotateMesh SBranch,0,spinangle,0 If Leaf_texture$<>"" ; If the texture is defined, apply it EntityTexture Temp_leaf,leaftex EndIf ; Now, tilt it over a little. BranchAngle=(Rnd(0,1)*S_Bmax)+S_Bmin RotateMesh SBranch,0,0,BranchAngle ; Rotate it into place, with a little random wiggle. Wiggle=(Rnd(0,1)*20) - 10 If Wiggle_Flag=2 Wiggle=0 EndIf C2=( 360 / Number_Of_Small_Branches ) * C C2=C2 + Wiggle RotateMesh SBranch,0,C2,0 ; Move it up To the top of the Medium_Branch. ; If flag is "off", Then move To the Next spot on branch. TEMP_HEIGHT#=This_Medium_Branch_Size#; If ( Branches_On_End_Flag=2 ) TEMP_HEIGHT#=((This_Medium_Branch_Size# /Rand( Number_Of_Small_Branches)) ) EndIf PositionMesh SBranch,0,TEMP_HEIGHT#,0 ;EntityParent SBranch,MBranch AddMesh SBranch,MBranch FreeEntity sbranch C=C + 1 Wend RotateMesh MBranch,0,0,BranchAngle2# RotateMesh MBranch,0,B2,0 ; Move the Medium_Branch up To the top of the Large_Branch. ; If flag is "off", Then move To the Next spot on branch. PositionMesh MBranch,0,TEMP_HEIGHT2#,0 ;EntityParent MBranch,LBranch AddMesh MBranch,LBranch FreeEntity mbranch B=B + 1 Wend RotateMesh LBranch,0,0,BranchAngle1# RotateMesh LBranch,0,A2,0 ; Move the Large_Branch up To the top of the Tree_Trunk. ; If flag is "off", Then move To the Next spot on trunk. ; These are spaced differently than the other branches - they ; start about 3/4 of the way up the trunk. PositionMesh LBranch,0,TEMP_HEIGHT1#,0 A=A + 1 ;EntityParent LBranch,Trunk AddMesh LBranch,Trunk FreeEntity lbranch Wend Return Trunk End Function Function Make_Leaf(Leaf_Type,Leaf_Mesh,texture) Local x1#,x2#,x3#,y1#,y2#,y3#,z1#,z2#,z3# leafmesh=CreateMesh(parent) leafsurf=CreateSurface(leafmesh) A=1 While A<=Leaf_Mesh ; Calculate random location For First point. X1=( Rnd(0,1) * 2 ) - 1 Y1=( Rnd(0,1) * 2 ) - 1 Z1=( Rnd(0,1) * 2 ) - 1 ; Move a little way from *First* point. X2=X1 + ( Rnd(0,1) * 0.6 ) - 0.3 Y2=Y1 + ( Rnd(0,1) * 0.6 ) - 0.3 Z2=Z1 + ( Rnd(0,1) * 0.6 ) - 0.3 ; Move a little way from *First* point. X3=X1 + ( Rnd(0,1) * 0.6 ) - 0.3 Y3=Y1 + ( Rnd(0,1) * 0.6 ) - 0.3 Z3=Z1 + ( Rnd(0,1) * 0.6 ) - 0.3 pnt0=AddVertex(leafsurf,x1#,y1#,z1#) pnt1=AddVertex(leafsurf,x2#,y2#,z2#) pnt2=AddVertex(leafsurf,x3#,y3#,z3#) AddTriangle(leafsurf,pnt0,pnt1,pnt2) pnt1=AddVertex(leafsurf,0,0,0) pnt2=AddVertex(leafsurf,0,0,.1) AddTriangle(leafsurf,pnt0,pnt1,pnt2) pnt1=AddVertex(leafsurf,0,0,0) pnt2=AddVertex(leafsurf,.1,0,0) AddTriangle(leafsurf,pnt0,pnt1,pnt2) A=A + 1 Wend EntityColor leafmesh,0,150,0 Return leafmesh End Function Function Make_Branch(branch_size#,Big_Dia#,Small_Dia#,branch_seg,texture) ; Now create some branches. branch=createcylindertaper(branch_seg,0,0,0,0,0,Big_Dia#,Small_Dia#,branch_size#) ball=CreateSphere(branch_seg/2,branch) ScaleMesh ball,Small_Dia#,Small_Dia#,Small_Dia# PositionMesh ball,0,branch_size,0 AddMesh ball,branch FreeEntity ball Return branch End Function Function Make_Branch_Nosphere(branch_size#,Big_Dia#,Small_Dia#,SBranch_seg,texture) branch=createcylindertaper(SBranch_seg,0,0,0,0,0,Big_Dia#,Small_Dia#,branch_size#) If texture>0 ; If we have a texture, put it on EntityTexture branch,texture Else ; If we don't have a texture, color it EntityColor branch,90,45,0 ; Give us a dark brown color, change to whatever color your want! EndIf Return branch End Function ;#End Region ;#Region; Tapered Cylinder function ; Written by Martin Parrott ; V1.1 ; Oct. 28, 2001 - 1. Added ability to map texture on object ; 2. Changed triangle creation order, caused by 1. above ; 3. Cleaned up variable names ; ; This code is hiware. If you use it, please send me an email and say Hi! ; You are free to use, modify, etc. No warranty is written Or implied ; Use at your own risk ; This code is free to use, but if you modify it, please send the ; changes to the above email address so I can continue to release ; updates so others can benefit. Function CreateCylinderTaper(seg=8,parent=0,solid=True,xloc#=0,yloc#=0,zloc#=0,rad1#=1,rad2#=.75,height#=2) ; seg defines the number of segments/vertices in the cylinder cross-section ; parent is the parent enitity handle ; solid defines whether the cylinder ends are capped or open, true-they are closed, false-they are open ; xloc# is the final x axis location for the cylinder ; yloc# is the final y axis location for the cylinder ; zloc# is the final z axis location for the cylinder ; rad1# is the radius of the bottom of the cylinder ; rad2# is the radius of the top of the cylinder ; height# is the total height of the cylinder If seg<2 Then seg=8 ; make sure the number of segments is set to something sane If seg>32 Then seg=32 cylmesh=CreateMesh() cylsurf=CreateSurface(cylmesh) ;Create center vertex of bottom disc AddVertex cylsurf,0,0,0,1,1 angle#=0 ; Set our initial starting angle inc#=Float 360 / Float seg ; Setup increment for setting up vertices around our cylinder ends ; Do bottom end vertices While angle# < 360.01 x#=rad1#*Cos(angle#) z#=rad1#*Sin(angle#) u#=angle#/360 AddVertex (cylsurf,x#,0,z#,u#,1) angle#=angle#+inc# Wend ; If solid is set, then cap end. Do triangles If solid>0 For vert=1 To seg AddTriangle cylsurf,0,vert,vert+1 Next EndIf ;Create center vertex of top disc AddVertex cylsurf,0,height#,0,0,0 angle#=0 ; reset angle ; Do top end While angle# < 360.01 x#=rad2#*Cos(angle#) z#=rad2#*Sin(angle#) u#=angle#/360 AddVertex (cylsurf,x#,height#,z#,u#,0) angle#=angle#+inc# Wend ; If solid is set, then cap end. Do triangles If solid>0 For vert=seg+3 To (seg*2)+3 AddTriangle cylsurf,seg+2,vert+1,vert Next EndIf ; Do sides of cylinder For vert=1 To seg AddTriangle cylsurf,vert,vert+seg+2,vert+seg+3 AddTriangle cylsurf,vert,vert+seg+3,vert+1 Next UpdateNormals cylmesh ; fix our normals MoveEntity cylmesh,xloc#,yloc#,zloc# ; Put the cylinder in place If parent > 0 ; Assign our cylinder to a parent if one is passed to us EntityParent cylmesh,parent EndIf Return cylmesh End Function ;#End Region

MusicianKool (Posted 2010) [#7]

Another question. I'm trying to align the trees to stand up (or out) on the surface of a sphere. Im placing them directly on randomly picked vertices. now I can get them on the surface with the help of Stevie G's Tformed. But now I need to figure out the pitch and yaw to stand them up. As it is now they lay on the surface except to the north of the sphere.

Krischan (Posted 2010) [#8]

Use AlignToVector with the picked vertex normal below the tree, something like this: AlignToVector tree,NX,NY,NZ,2

MusicianKool (Posted 2010) [#9]

christain, I cant seem to get it working. I'm makeing tree tiles, for the tiled geosphere I've made. is there a simple formula for like: Pitch_from x,y,z to 0,0,0 is a Yaw_from x,y,z to 0,0,0 is b so that if you do , rotatemesh mesh,-a,-b,0 the top of the mesh would be facing x,y,z and the bottom of the mesh would be facing 0,0,0

GIB3D (Posted 2010) [#10]

Oh awesome, trees on a geosphere. Use some gravity and it would be awesome, jumpin around like a retard all over the planet.

Krischan (Posted 2010) [#11]

Here is an example, using my geosphere code from the codearchives. 1000 single surface trees aligned correct to land only vertices using AlignToVector command: The way to go: - choose a random vertex from the planet - place tree at this vertex position - get normal vectors of this vertex - use AlignToVector to align the tree according to the vertex normal To determine if a vertex is land or water I checked the distance between the vertex position and the center planet pivot: if the distance is 1.0 or greater it is land - so I repeated choosing random vertices until it is far away. ms=MilliSecs() SeedRnd ms Global initseed% = Rand(0,999999) ; planet seed Const maxoctaves% = 9 ; maximum octaves to generate Const range% = 63 ; leave untouched Const persist# = 0.66 ; noise persistance Const octaves% = 4 ; number of noise octaves Const shininess = 0.25 ; planet shininess Const size = 32 ; patch size Global min%=255,max%=0,maps%=0 Local patch[2] Dim s#(maxoctaves,2),r#(range,range,range) Dim Noisemap%(23,65536),VertexBuffer%(128,128),MeshPart%(23) Dim GradientR%(0),GradientG%(0),GradientB%(0),Percent#(0),Red%(0),Green%(0),Blue%(0) Restore ClassMT : CreateGradient(9,255) ; Class M temperate ;Restore ClassMD : CreateGradient(9,255) ; Class M dry ;Restore ClassMF : CreateGradient(9,255) ; Class M frozen ;Restore ClassMO : CreateGradient(9,255) ; Class M oceanic ;Restore Io : CreateGradient(9,255) ; Io ;Restore Mars : CreateGradient(9,255) ; Mars ;Restore Venus : CreateGradient(9,255) ; Venus ;Restore Starflight1 : CreateGradient(9,255) ; Starflight 1 nostalgic (dry) ;Restore Starflight2 : CreateGradient(9,255) ; Starflight 1 nostalgic (frozen) ;Restore Starflight3 : CreateGradient(9,255) ; Starflight 1 nostalgic (volcanic) ;Restore Starflight4 : CreateGradient(9,255) ; Starflight 1 nostalgic (earthlike) InitNoise(initseed,persist) Graphics3D 800,600,32,2 ; planet pivot pivot=CreatePivot() campivot=CreatePivot() cam=CreateCamera(campivot) PositionEntity cam,3,2,-5 CameraRange cam,0.1,120 CameraZoom cam,3 patch[0]=CreatePatch(size,1.0/(size)) : RotateMesh patch[0], 0,180, 0 : PositionMesh patch[0],0.5,0.5,-0.5 patch[1]=CreatePatch(size,1.0/(size)) : RotateMesh patch[1], 0,270, 0 : PositionMesh patch[1],0.5,0.5,-0.5 patch[2]=CreatePatch(size,1.0/(size)) : RotateMesh patch[2],270, 0, 0 : PositionMesh patch[2],0.5,0.5,-0.5 For i=0 To 7 For j=0 To 2 If counter<12 Then MeshPart(counter)=AddSpherePart(patch[j],pivot,shininess, 0, i*90,0) EntityPickMode MeshPart(counter),2 Else MeshPart(counter)=AddSpherePart(patch[j],pivot,shininess,180, i*90,0) EntityPickMode MeshPart(counter),2 EndIf counter=counter+1 Next Next FreeEntity patch[0] FreeEntity patch[1] FreeEntity patch[2] NormalizeNoise(0) AlignPatches() CalcSphereNormals() ; light source light=CreateLight(1) PositionEntity light,-1000,0,0 AmbientLight 1,2,4 ; single surface trees treemesh%=CreateMesh(pivot) EntityFX treemesh,2 tree=CreateTree(1.0,pivot) For i=1 To 1000 ; place trees on land only Repeat ; pick a random meshpart vertex of the spherized cube mesh=MeshPart(Rand(0,maps-1)) surf=GetSurface(mesh,1) vert=Rand(0,CountVertices(surf)) ; get its normal vectors nx#=VertexNX(surf,vert) ny#=VertexNY(surf,vert) nz#=VertexNZ(surf,vert) scale#=Rnd(0.25,0.5) ScaleEntity tree,scale,scale,scale ; position tree trunk at vertex position PositionEntity tree,VertexX(surf,vert),VertexY(surf,vert),VertexZ(surf,vert) Until EntityDistance(tree,pivot)>1.0 ; align tree to the vertex normal vector AlignToVector tree,nx,ny,nz,2,1 AddToMesh(tree,treemesh) Next ; delete single tree FreeEntity tree UpdateNormals treemesh MoveMouse 400,300 ende=MilliSecs()-ms While Not KeyHit(1) If KeyHit(57) Then wf=1-wf : WireFrame wf ; turn planet with mouse mxs#=MouseXSpeed() mys#=MouseYSpeed() TurnEntity pivot,0,mxs,0 TurnEntity campivot,mys,0,mys MoveEntity cam,(KeyDown(205)-KeyDown(203))*2.0/30,0,(KeyDown(200)-KeyDown(208))*1.0/30 PointEntity cam,pivot RenderWorld Text 0, 0,"Tris.......: "+TrisRendered() Text 0,15,"Planet Seed: "+initseed Text 0,30,"Calc time..: "+ende+"ms" Flip 0 Wend End Function CreateTree(scale#=1.0,pivot%=False) Local tree%=CreateMesh(pivot) EntityFX tree,2 ; create a tree trunk Local treetrunk%=CreateCube(pivot) ScaleEntity treetrunk,1.0/128*scale,1.0/8*scale,1.0/128*scale TranslateEntity treetrunk,0,1.0/8*scale,0 AddToMesh(treetrunk,tree,True,120,60,0,1) ; add a fir like treetop Local treetop%=CreateCone(16,1,treetrunk) TranslateEntity treetop,0,MeshHeight(treetrunk)/2.0,0 ScaleEntity treetop,MeshWidth(treetrunk)*4,1.0,MeshWidth(treetrunk)*4 AddToMesh(treetop,tree,True,0,150,0,1) ; delete unused dummys FreeEntity treetop FreeEntity treetrunk Return tree End Function Function AddToMesh(source%,target%,colorize=False,r%=255,g%=255,b%=255,a#=1) Local vert%[2] Local oldvert%,i1%,i2%,v1%,v2% Local surf%,surf1%=GetSurface(source,1),surf2% v1=CountVertices(surf1) For v2=1 To CountSurfaces(target) surf=GetSurface(target,v2) If CountVertices(surf)+v1<32000 Then surf2=surf : Goto skip Next surf2=CreateSurface(target) .skip For i1=0 To CountTriangles(surf1)-1 For i2=0 To 2 oldvert = TriangleVertex(surf1,i1,i2) TFormPoint VertexX(surf1,oldvert),VertexY(surf1,oldvert),VertexZ(surf1,oldvert),source,target vert[i2]=AddVertex(surf2,TFormedX(),TFormedY(),TFormedZ(),VertexU(surf1,oldvert),VertexV(surf1,oldvert)) If colorize Then VertexColor surf2,vert[i2],r,g,b,a Else VertexColor surf2,vert[i2],VertexRed(surf1,oldvert),VertexGreen(surf1,oldvert),VertexBlue(surf1,oldvert),VertexAlpha(surf1,oldvert) EndIf Next AddTriangle(surf2,vert[0],vert[1],vert[2]) Next End Function Function AddSpherePart(mesh%,pivot%,shininess#,rx#=0,ry#=0,rz#=0) Local m%=CopyMesh(mesh,pivot) Cube2Sphere(m) EntityFX m,2 EntityShininess m,shininess RotateMesh m,rx,ry,rz AddNoise(m) ;UpdateNormals m Return m End Function ; calculate spherical X Function SphericalX#(x#,y#,z#) Return x*Sqr(1.0-y*y*0.5-z*z*0.5+y*y*z*z*1.0/3) End Function ; calculate spherical Y Function SphericalY#(x#,y#,z#) Return y*Sqr(1.0-z*z*0.5-x*x*0.5+z*z*x*x*1.0/3) End Function ; calculate spherical Z Function SphericalZ#(x#,y#,z#) Return z*Sqr(1.0-x*x*0.5-y*y*0.5+x*x*y*y*1.0/3) End Function ; transform a cube patch to sphere patch Function Cube2Sphere(mesh%) Local s%,surf%,v% Local vx#,vy#,vz# For s=1 To CountSurfaces(mesh) surf=GetSurface(mesh,s) For v=0 To CountVertices(surf)-1 vx=VertexX(surf,v) vy=VertexY(surf,v) vz=VertexZ(surf,v) VertexCoords surf,v,SphericalX(vx,vy,vz),SphericalY(vx,vy,vz),SphericalZ(vx,vy,vz) Next Next End Function Function AlignPatches() AlignMeshVertices(MeshPart( 0),MeshPart( 1),size,1,3) AlignMeshVertices(MeshPart( 1),MeshPart( 2),size,0,3) AlignMeshVertices(MeshPart( 3),MeshPart( 4),size,1,3) AlignMeshVertices(MeshPart( 4),MeshPart( 5),size,0,3) AlignMeshVertices(MeshPart( 6),MeshPart( 7),size,1,3) AlignMeshVertices(MeshPart( 7),MeshPart( 8),size,0,3) AlignMeshVertices(MeshPart( 9),MeshPart(10),size,1,3) AlignMeshVertices(MeshPart(10),MeshPart(11),size,0,3) AlignMeshVertices(MeshPart(12),MeshPart(13),size,1,3) AlignMeshVertices(MeshPart(13),MeshPart(14),size,0,3) AlignMeshVertices(MeshPart(15),MeshPart(16),size,1,3) AlignMeshVertices(MeshPart(16),MeshPart(17),size,0,3) AlignMeshVertices(MeshPart(18),MeshPart(19),size,1,3) AlignMeshVertices(MeshPart(19),MeshPart(20),size,0,3) AlignMeshVertices(MeshPart(21),MeshPart(22),size,1,3) AlignMeshVertices(MeshPart(22),MeshPart(23),size,0,3) End Function Function NormalizeNoise(offset%=0) If offset>0 Then max=max+offset If offset<0 Then min=min+offset For i=0 To maps-1 surf=GetSurface(MeshPart(i),1) For v=0 To CountVertices(surf)-1 h=Norm(Noisemap(i,v),min,max,0,255) r1=GradientR(h) g1=GradientG(h) b1=GradientB(h) VertexColor surf,v,r1,g1,b1 If h<128 Then d#=Norm(Noisemap(i,v),min,max,0.1,-0.1) vx#=VertexX(surf,v) vy#=VertexY(surf,v) vz#=VertexZ(surf,v) TFormNormal vx,vy,vz, 0, 0 VertexNormal surf,v,TFormedX(), TFormedY(), TFormedZ() nx#=vx+(TFormedX()*d) ny#=vy+(TFormedY()*d) nz#=vz+(TFormedZ()*d) VertexCoords surf,v,nx,ny,nz EndIf Next Next End Function Function CalcSphereNormals() For i=0 To maps-1 surf=GetSurface(MeshPart(i),1) For v=0 To CountVertices(surf)-1 VX#=VertexX(surf,v) VY#=VertexY(surf,v) VZ#=VertexZ(surf,v) TFormNormal VX#, VY#, VZ#, 0, 0 VertexNormal surf,v, TFormedX(), TFormedY(), TFormedZ() Next Next End Function Function AlignMeshVertices(mesh1%,mesh2%,size%,side1%=0,side2%=0) Local surf1%=GetSurface(mesh1,1) Local surf2%=GetSurface(mesh2,1) Local i%,s%,t% Local x#,y#,z#,r1%,g1%,b1% For i=0 To size ; 0 = up ; 1 = left ; 2 = down ; 3 = right If side1=0 Then s=(size^2)+size+i If side1=1 Then s=(size*i)+i If side1=2 Then s=i If side1=3 Then s=(size*i)+size+i If side2=0 Then t=(size^2)+size+i If side2=1 Then t=(size*i)+i If side2=2 Then t=i If side2=3 Then t=(size*i)+size+i r1=VertexRed(surf1,s) g1=VertexGreen(surf1,s) b1=VertexBlue(surf1,s) x=VertexX(surf1,s) y=VertexY(surf1,s) z=VertexZ(surf1,s) VertexColor surf2,t,r1,g1,b1 VertexCoords surf2,t,x,y,z Next End Function ; adds noise to mesh vertices using a gradient Function AddNoise(mesh%) Local sc%,surf%,v% Local x#,y#,z#,h# For sc=1 To CountSurfaces(mesh) surf=GetSurface(mesh,sc) For v=0 To CountVertices(surf)-1 x=VertexX(surf,v)+1 y=VertexY(surf,v)+1 z=VertexZ(surf,v)+1 h=Int(Floor(Interpolate(x,y,z,octaves)*255)) If h<min Then min=h Else If h>max Then max=h Noisemap(maps,v)=h Next Next maps=maps+1 End Function ; normalize a value Function Norm#(v#=128.0,vmin#=0.0,vmax#=255.0,nmin#=0.0,nmax#=1.0) Return ((v-vmin)/(vmax-vmin))*(nmax-nmin)+nmin End Function ; interpolate 3D point Function Interpolate#(x#,y#,z#,octaves%) Local h#=0 Local oct% Local fre#,amp#,xx%,yy%,zz% Local xb#,yb#,zb#,xa#,ya#,za# Local v000#,v100#,v010#,v001#,v101#,v110#,v011#,v111# octaves=octaves-1 If octaves<=0 Then octaves=0 If octaves=>maxoctaves Then octaves=maxoctaves For oct=0 To octaves fre=s(oct,0) amp=s(oct,1) xx=DBInt(x*fre) yy=DBInt(y*fre) zz=DBInt(z*fre) xb=CosinusInterpolation((x*fre)-Float(xx)) yb=CosinusInterpolation((y*fre)-Float(yy)) zb=CosinusInterpolation((z*fre)-Float(zz)) xa=1-xb ya=1-yb za=1-zb v000=RandomPoint(xx,yy,zz)*xa*ya*za v100=RandomPoint(xx+1,yy,zz)*xb*ya*za v010=RandomPoint(xx,yy+1,zz)*xa*yb*za v001=RandomPoint(xx,yy,zz+1)*xa*ya*zb v101=RandomPoint(xx+1,yy,zz+1)*xb*ya*zb v110=RandomPoint(xx+1,yy+1,zz)*xb*yb*za v011=RandomPoint(xx,yy+1,zz+1)*xa*yb*zb v111=RandomPoint(xx+1,yy+1,zz+1)*xb*yb*zb h=h+(v000+v100+v010+v001+v101+v110+v011+v111)*amp Next h=h*s(octaves,2) Return h End Function ; get random point Function RandomPoint#(x,y,z) If x<0 Then x=x-(DBInt((x/64)-1)*64) Else x=x-(DBInt(x/64)*64) If y<0 Then y=y-(DBInt((y/64)-1)*64) Else y=y-(DBInt(y/64)*64) If z<0 Then z=z-(DBInt((z/64)-1)*64) Else z=z-(DBInt(z/64)*64) Return r(x,y,z) End Function ; cosinus interpolation Function CosinusInterpolation#(v#) Return (1-Cos(v*180))*0.5 End Function ; inits noise (positive values only!) Function InitNoise(seed%,persistance#) Local x%,y%,z%,i%,j% SeedRnd seed For x=0 To range For y=0 To range For z=0 To range r#(x,y,z)=Noise(x,y,z,seed) ;r#(x,y,z)=Rnd(1) Next Next Next For i=0 To maxoctaves s(i,0)=2^i s(i,1)=persistance^i s(i,2)=0.0 For j=0 To i s(i,2)=s(i,2)+s(j,1) Next s(i,2)=1.0/s(i,2) Next End Function ; the 3D perlin noise machine Function Noise#(x%,y%,z%,seed) Local n%=x+y*57+z*131+seed n=n Shl (13^n) Return (1.0-((n*(n*n*15731+789221)+1376312589) And $7fffffff)/1073741824.0) End Function ; "intelligent" INT Function DBInt(x#) If x>=0 Then Return Floor(x) Else Return Ceil(x) End Function ; creates a nice color gradient Function CreateGradient(colors%,steps%) Dim GradientR%(steps),GradientG%(steps),GradientB%(steps),Percent#(colors),Red%(colors),Green%(colors),Blue%(colors) Local i%,pos1%,pos2%,pdiff% Local rdiff%,gdiff%,bdiff% Local rstep#,gstep#,bstep# Local counter%=1 For i=1 To colors : Read Percent(i),Red(i),Green(i),Blue(i) : Next While counter<colors pos1=Percent(counter)*steps/100 pos2=Percent(counter+1)*steps/100 pdiff=pos2-pos1 rdiff%=Red(counter)-Red(counter+1) gdiff%=Green(counter)-Green(counter+1) bdiff%=Blue(counter)-Blue(counter+1) rstep#=rdiff*1.0/pdiff gstep#=gdiff*1.0/pdiff bstep#=bdiff*1.0/pdiff For i=0 To pdiff GradientR(pos1+i)=Int(Red(counter)-(rstep*i)) GradientG(pos1+i)=Int(Green(counter)-(gstep*i)) GradientB(pos1+i)=Int(Blue(counter)-(bstep*i)) Next counter=counter+1 Wend End Function Function CreatePatch(size%,scale#) Local x%,z%,v#,u#,v0%,v1%,v2%,v3% ; create mesh and surface Local mesh%=CreateMesh() Local surf%=CreateSurface(mesh) For z=0 To size For x=0 To size ; calculate uv coordinates that the texture fits to the tile u=x*1.0/size v=z*1.0/size*-1 ; set vertexposition VertexBuffer(x,z)=AddVertex (surf,-((size)/2.0)+x,-((size)/2.0)+z,size/2,u,v) VertexColor surf,VertexBuffer(x,z),255,255,255,1.0 Next Next ; set triangles For z=0 To size-1 For x=0 To size-1 v0=VertexBuffer(x,z) v1=VertexBuffer(x+1,z) v2=VertexBuffer(x+1,z+1) v3=VertexBuffer(x,z+1) AddTriangle (surf,v0,v2,v1) AddTriangle (surf,v0,v3,v2) Next Next ; position, scale and fx ScaleMesh mesh,scale,scale,scale FlipMesh mesh Return mesh End Function .ClassMT Data 0,255,255,255 Data 5,179,179,179 Data 10,153,143, 92 Data 25,115,128, 77 Data 45, 42,102, 41 Data 50, 69,108,118 Data 65, 17, 82,112 Data 75, 9, 62, 92 Data 100, 9, 62, 92 .ClassMD Data 0,255,255,255 Data 10,219,191,143 Data 15,214,153,103 Data 20,181,148,105 Data 30,158,128, 79 Data 48,128,106, 70 Data 50,108,138,141 Data 52, 90,125,144 Data 100, 45, 94,101 .ClassMF Data 0,238,255,255 Data 15,221,238,255 Data 25,187,221,238 Data 35,153,204,238 Data 45,153,187,221 Data 60,136,170,221 Data 75,119,153,204 Data 90,102,136,170 Data 100, 85,119,170 .ClassMO Data 0,153,143, 92 Data 2,115,128, 77 Data 8, 42,102, 41 Data 10, 69,108,118 Data 12, 17, 82,112 Data 70, 9, 62, 92 Data 98, 2, 43, 68 Data 99, 2, 43, 68 Data 100, 2, 43, 68 .Mars Data 0,235,221,131 Data 5,235,201,102 Data 10,222,159, 57 Data 15,211,137, 64 Data 25,200,121, 42 Data 45,162, 93, 31 Data 50,164, 77, 36 Data 70,134, 72, 43 Data 100, 98, 43, 24 .Venus Data 0,255,238,187 Data 10,255,221,170 Data 20,255,221,153 Data 30,255,204,136 Data 50,238,187,119 Data 70,255,204,136 Data 80,255,221,153 Data 90,255,221,170 Data 100,255,238,187 .Io Data 0,225,226,198 Data 5,244,238,147 Data 10,226,198, 28 Data 35,226,113, 0 Data 50,200, 67, 2 Data 60,170, 0, 0 Data 70,138, 56, 6 Data 80,118, 46, 3 Data 100, 92, 35, 1 .Starflight1 Data 0,255,255,255 Data 10,255,239,206 Data 15,239,170,115 Data 20,222,154, 66 Data 30,206,101, 16 Data 40,156, 85, 49 Data 50,115, 69, 66 Data 60, 0, 0,222 Data 100, 0, 0,222 .Starflight2 Data 0,255,255,255 Data 10,206,223,255 Data 15,156,186,239 Data 20, 99,154,222 Data 30, 66,187,189 Data 40, 33,101,156 Data 50, 0, 85,140 Data 60, 0, 0,222 Data 100, 0, 0,222 .Starflight3 Data 0,255,255,255 Data 10,255,239,140 Data 15,255,223, 49 Data 20,255, 85, 82 Data 30,222, 0, 0 Data 40,173, 0, 66 Data 50,140, 0, 99 Data 60, 66, 0, 82 Data 100, 66, 0, 82 .Starflight4 Data 0,255,255,255 Data 10,239,223,189 Data 15,239,207, 99 Data 20,222,186, 16 Data 30,156,170, 49 Data 40, 0,154, 0 Data 50, 0,117, 0 Data 60, 0, 0,222 Data 100, 0, 0,222

MusicianKool (Posted 2010) [#12]

oh nice, thanks, but... I'm making a tree tile, grouping tree's to a single mesh. so i have to rotate the mesh and position the mesh directly. Then add mesh to the tree tile. Havent tried it yet but i'm guessing i can use entitypitch yaw roll and store those after a aligntovector for use later to rotatemesh. Christian, should change this line: vert=Rand(0,CountVertices(surf)) to vert=Rand(0,CountVertices(surf)-1) I think.

MusicianKool (Posted 2010) [#13]

well got it to work kind of.... the trees are lining up to the right direction. just not on the surface of the geosphere, sometimes far above it, sometimes below it.. don't know why.

MusicianKool (Posted 2010) [#14]

well here is what i'm doing, each mesh tile is stored in planettiles(n,0) (n,1) (n,2)(n,3) is the middle vertex xyz axis, and (n,4) tree mesh tile. Now, the tree's are not lining up to the planet mesh Function AddTrees(Number_Of_Trees,Parent=0) For j = 0 To TotalTiles-1 Entity = PlanetTiles(j,0) PlanetTiles(j,4) = CreateMesh(Parent) surf = GetSurface(Entity,1) For i = 1 To Rand(0,Number_Of_Trees) vert = Rand(0,CountVertices(surf)-1) tree = CreateRandomizedTree() ; get its normal vectors nx#=VertexNX(surf,vert) ny#=VertexNY(surf,vert) nz#=VertexNZ(surf,vert) AlignToVector tree,nx,ny,nz,2,1 ScaleMesh tree,10,10,10 PositionEntity tree,VertexX(surf,vert),VertexY(surf,vert),VertexZ(surf,vert) AddToMesh (tree,PlanetTiles(j,4),True,128,64,0) FreeEntity tree Next ;HideEntity PlanetTiles(j,4) EntityColor PlanetTiles(j,4) ,128,64,0 Next End Function

MusicianKool (Posted 2010) [#15]

ahh got it to work just a few more things to add till i release the source

MusicianKool (Posted 2010) [#16]

ok, I need help figuring out how to put leaves on the trees, but here is the source for tiled planet with tree's(tree trunks I mean). It comes in 3 parts. example: ms = MilliSecs() Graphics3D 800,600,32,2 SetBuffer BackBuffer() SeedRnd ms Include "Planet Maker.bb" Include "Tree Lib.bb" Global Dynamic = 1, Static = 2 Collisions 1,2,2,2 Global TotalTriangles Global TotalTiles Global TilesRendered Global PlanetSize Global Multiplier# Global wf,VectorX#,VectorY#,VectorZ# MaxOctaves = 10 Tiles = 32 ;Tiles*Tiles per each face of the cube Segments = 8 ;Segments*Segments per each Tile of the cube ImageSize = 1024 ;Imagesize must be a power of 2 PlanetSize = 1000 ;Scale the planet n times bigger PlanetRenderRange = PlanetSize/3 ;The range at which the tile will be render seed = Rand(0,99999) ;Random seed (anything larger then this will produce bad perlin noise) Multiplier# = .3 ;Height multiplier (1=very tall, 0 = flat) Offset# = 0 ;color Offset (0 = normal, > 0 force higher, < 0 force lower) Scale# = (((((tiles*tiles*6)*(Segments*Segments))/Tiles ))/Segments)/2 ;Scale# of the randomness: ; (((((tiles*tiles*6)*(Segments*Segments))/Tiles )) = extreme Random) (0 = no random) SeedRnd seed Camera = CreateCamera():CameraRange camera,1,10000 Light = CreateLight() EntityType camera,Dynamic EntityRadius camera,5 PositionEntity Camera,0,0,-(PlanetSize+(500)),1 PositionEntity Light,0,0,-(PlanetSize*2) AmbientLight (255,255,255) Locate 0,0 Cls:Print "Creating HeightMap.":Flip PHM = CreateImage(ImageSize,Imagesize) Locate 0,0 Cls:Color 255,255,255:Print "Creating Tiled Segmented cube.":Flip Planet = CreatePivot() CreateSegCube(tiles,segments,Planet);Create a Segmented Cube Locate 0,0 Cls:Color 255,255,255:Print "Applying HeightMap to Tiled Segmented cube and making Geosphere.":Flip CreateGeodesicHeightmapedSphere(PHM,planetsize,scale#,Multiplier#,Offset,Seed,Planet) ;ScaleEntity Planet,PlanetSize,PlanetSize,PlanetSize SaveImage PHM,"PHM.BMP" PT = Create_Load_HeightMappedTexture(PHM) ;Calculate Normals, Define planet collision. For i = 0 To 6-1 For j = 1 To tiles*tiles ent = GetChild(Planet,j+i*(Tiles*Tiles)) CalcSphereNormals(ent) EntityPickMode ent,2,1 EntityType ent,Static Next Next InitStep1Trees() SetupTiles(2,planet) InitStep2Trees() Locate 0,0 Cls:Color 255,255,255:Print "Applying Texture and Detail to each tile.":Flip detail = LoadTexture( "detail.png") ApplyTexture(planet,tiles,PT,detail) final = MilliSecs()-ms PointEntity light,Planet ;point the light at the Mesh MoveMouse GraphicsWidth()/2,GraphicsHeight()/2 ;========================================================================== ;========================================================================== .Main ;====== RUN =============================================================== period=1000 / 30 tweentime = MilliSecs()-period While 1 ;====== CALCULATE TWEEN =================================================== Repeat elapsed = MilliSecs() - tweentime Until elapsed ticks = elapsed/period tween# = Float(elapsed Mod period) / Float(period) ;========================================================================== ;====== MAIN LOOP ========================================================= For k=1 To ticks tweentime = tweentime+period If k = ticks Then CaptureWorld If KeyDown(1) ClearWorld() DeletePlanet(planet) FreePerlin() End EndIf UpdateLogic(Camera,planet,planetrenderrange) UpdateWorld Next RenderWorld( tween# ) Draw2D(camera,planet,Final,PlanetRenderRange) Flip Wend ;=========================================================================== Function UpdateLogic(Camera,Planet,PlanetRenderRange);While Not KeyHit(1) Cls HideShowTiles(Camera,planet,PlanetRenderRange) ; show tiles within range. If KeyHit(57) Then wf=1-wf : WireFrame wf If KeyDown (17) Then MoveEntity camera,0,0,2 ;W If KeyDown (31) Then MoveEntity camera,0,0,-2 ;S If KeyDown (30) Then MoveEntity camera,-.3,0,0 ;A If KeyDown (32) Then MoveEntity camera,.3,0,0 ;D If KeyDown (16) Then TurnEntity camera,0,0,2 ;Q If KeyDown (18) Then TurnEntity camera,0,0,-2 ;E cx# =EntityX(Camera,1) cy# =EntityY(Camera,1) cz# =EntityZ(Camera,1) LinePick cx,cy,cz,0-cx,0-cy,0-cz AlignToVector Camera,PickedNX(),PickedNY(),PickedNZ(),2,.1 If ( EntityCollided( Camera, Static ) ) VectorX# = 0 VectorY# = 0 VectorZ# = 0 Else VectorX# = VectorX# - PickedNX() VectorY# = VectorY# - PickedNY() VectorZ# = VectorZ# - PickedNZ() TranslateEntity( Camera, VectorX#, VectorY#, VectorZ# ) EndIf TurnEntity camera,MouseYSpeed(),-MouseXSpeed(),0 MoveMouse GraphicsWidth()/2,GraphicsHeight()/2 End Function Function Draw2D(camera,planet,Final,PlanetRenderRange) Locate 0,0 Print "Triangles Rendered: " + TrisRendered() Print "Total Triangles: " + TotalTriangles Print "Tiles Rendered: " + TilesRendered Print "Total Tiles: " + TotalTiles Print "Inital render time: " + final Print "Distance to Planet Core: " + EntityDistance#(camera,planet) Print "Render Distance: " + PlanetRenderRange Print "Closest Tile: " + ClosestTile# Flip End Function;Wend 3D perlin noise engine/geosphere: Dim GradientR%(0),GradientG%(0),GradientB%(0),Percent#(0),Red%(0),Green%(0),Blue%(0) Dim PlanetTiles(0,5) Restore Planet Global ColorDEPTH = 768 Global ClosestTile# CreateGradient(11,ColorDEPTH) Global MaxOctaves = 9999 For i = 0 To ColorDEPTH Color GradientR(i),GradientG(i),GradientB(i) Line i,0,i,100 Next ;WaitKey() ;#Region GeoSphere & segmented cube ; transform a cube to sphere Using Heightmap Data Function CreateGeodesicHeightmapedSphere(SphereHeightMap,PlanetSize,Scale#,Multiplier#,Offset#,seed,Parent=0) IW = ImageWidth(SphereHeightMap) IH = ImageHeight(SphereHeightMap) Local s%,surf%,vc% Local vx#,vy#,vz#,v#,u#,tv#,tu# LockBuffer (ImageBuffer (SphereHeightMap)) For q = 1 To CountChildren(Parent) child = GetChild(Parent,q) For s=1 To CountSurfaces(child) surf=GetSurface(child,s) For vc=0 To CountVertices(surf)-1 vx#= VertexX#(surf,vc) vy#= VertexY#(surf,vc) vz#= VertexZ#(surf,vc) u# = Floor (VertexU(surf,vc)*(IW-1)) v# = Floor (VertexV(surf,vc)*(IH-1)) Spherical(vx#,vy#,vz#,Scale#) pn# = (Perlin3D#(Spherical_X(),Spherical_Y(),Spherical_Z(),IW,seed)) col = (pn#*(ColorDEPTH/2))+(ColorDEPTH/2) ;Convert Perlin noise to colorGradient If col < 0 Then col = 0 ;limit color If col > ColorDEPTH Then col = ColorDEPTH ;limit color If col > 255 And col > 511 Then r = 255:g = 255:b = col-512 ElseIf col > 255 Then r = 255:g = col - 256:b = 0 ElseIf col < 256 Then r = col:g = 0:b = 0 EndIf argb = Get_ARGB_From(r,g,b);Convert color to ARGB WritePixelFast u,v,argb,ImageBuffer (SphereHeightMap) ;Write pixel to Texture sx# = Spherical_X#(((1.0+Offset#) + (pn#*Multiplier#))*Planetsize) sy# = Spherical_Y#(((1.0+Offset#) + (pn#*Multiplier#))*Planetsize) sz# = Spherical_Z#(((1.0+Offset#) + (pn#*Multiplier#))*Planetsize) VertexCoords surf,vc,sx#,sy#,sz# Next Next Next UnlockBuffer (ImageBuffer (SphereHeightMap)) CubeHeightMapFix(SphereHeightMap) Return ParentPiv End Function Function LoadGeodesicHeightmapedSphere(SphereHeightMap,PlanetSize,Scale#,Multiplier#,Offset#,seed,Parent=0) IW = ImageWidth(SphereHeightMap) IH = ImageHeight(SphereHeightMap) Local s%,surf%,vc% Local vx#,vy#,vz#,v#,u#,tv#,tu# LockBuffer (ImageBuffer (SphereHeightMap)) For q = 1 To CountChildren(Parent) child = GetChild(Parent,q) For s=1 To CountSurfaces(child) surf=GetSurface(child,s) For vc=0 To CountVertices(surf)-1 vx#= VertexX#(surf,vc) vy#= VertexY#(surf,vc) vz#= VertexZ#(surf,vc) u# = Floor (VertexU(surf,vc)*(IW-1)) v# = Floor (VertexV(surf,vc)*(IH-1)) col = ReadPixelFast(u,v,ImageBuffer(SphereHeightMap)) If ColorDEPTH = 256 Then pn# = 1/ColorDEPTH * (Get_RED_From(col)) Else If ColorDEPTH = 512 Then pn# = 1/ColorDEPTH * (Get_RED_From(col)+Get_GREEN_From(col)) Else If ColorDEPTH = 768 Then pn# = 1/ColorDEPTH * (Get_RED_From(col)+Get_GREEN_From(col)+Get_BLUE_From(col)) EndIf Height#=((1.0+Offset#) + (pn#*Multiplier#))*PlanetSize Spherical(vx#,vy#,vz#,Height#) sx# = Spherical_X#() sy# = Spherical_Y#(((1.0+Offset#) + (pn#*Multiplier#))*Planetsize) sz# = Spherical_Z#(((1.0+Offset#) + (pn#*Multiplier#))*Planetsize) VertexCoords surf,vc,sx#,sy#,sz# Next Next Next UnlockBuffer (ImageBuffer (SphereHeightMap)) Return ParentPiv End Function ; creates a segmented cube Function CreateSegCube(Tiles = 1,segs=1,parent=0) Local side%,surf% Local a%,v#,b%,u# Local v0%,v1%,v2%,v3% Dim PlanetTiles((Tiles*Tiles)*6,5) ; sides For side=0 To 3 For t = 0 To tiles-1 For q = 0 To tiles-1 mesh%=CreateMesh( parent ) surf=CreateSurface( mesh ) PlanetTiles(TotalTiles,0) = mesh TotalTiles = TotalTiles+1 For a=0 To segs v#=((a+(t*segs))/Float(segs))/Tiles;y axis tv#=(Float 0.25)+(v#)*(Float 0.25);y axis For b=0 To segs u#=((b+(q*segs))/Float(segs))/Tiles ;x axis Select True Case side = 0 tu#=(Float 0.0)+(u#)*(Float .25) ;x axis Case side = 1 tu#=(Float .25)+(u#)*(Float .25) ;x axis Case side = 2 tu#=(Float 0.5)+(u#)*(Float .25) ;x axis Case side = 3 tu#=(Float .75)+(u#)*(Float .25) ;x axis End Select AddVertex(surf,u-.5,v-.5,0.5,tu#,tv#) Next Next For a=0 To segs-1 For b=0 To segs-1 v0=a*(segs+1)+b:v1=v0+1 v2=(a+1)*(segs+1)+b+1:v3=v2-1 AddTriangle( surf,v0,v1,v2 ) AddTriangle( surf,v0,v2,v3 ) TotalTriangles = TotalTriangles + 2 Next Next Select True Case side = 0 RotateMesh mesh,0,-90,0 Case side = 1 RotateMesh mesh,0,180,0 Case side = 2 RotateMesh mesh,0,90,0 Case side = 3 RotateMesh mesh,0,0,0 End Select Next Next Next ;top bottom For side=0 To 1 For t = 0 To tiles-1 For q = 0 To tiles-1 mesh%=CreateMesh( parent ) surf=CreateSurface( mesh ) PlanetTiles(TotalTiles,0) = mesh TotalTiles = TotalTiles+1 For a=0 To segs v#=(Float (a+(t*segs))/Float(segs))/Tiles;y axis If side = 0 Then tv#=(Float 0.0)+(v#)*(Float 0.25);y axis Else tv#=(Float 0.50)+(v#)*(Float 0.25);y axis EndIf For b=0 To segs u#=(Float (b+(q*segs))/Float(segs))/Tiles;x axis tu#=(Float .25)+(u#)*(Float .25) ;x axis AddVertex(surf,u-.5,v-.5,0.5,tu#,tv#) Next Next For a=0 To segs-1 For b=0 To segs-1 v0=a*(segs+1)+b:v1=v0+1 v2=(a+1)*(segs+1)+b+1:v3=v2-1 AddTriangle( surf,v0,v1,v2 ) AddTriangle( surf,v0,v2,v3 ) TotalTriangles = TotalTriangles + 2 Next Next Select True Case side = 0 RotateMesh mesh,90,-90,-90 Case side = 1 RotateMesh mesh,-90,-90,90 End Select Next Next Next RotateEntity parent,0,0,180 End Function Function ApplyTexture(Planet,tiles,PlanetTexture,Detail = 0) For i = 0 To 6-1 For j = 1 To tiles*tiles ent = GetChild(Planet,j+i*(tiles*tiles)) EntityTexture ent ,PlanetTexture If Detail <> 0 Then EntityTexture ent,Detail,0,2 ScaleTexture Detail,.1,.1 TextureBlend Detail,2 EndIf Next Next End Function Function CalcSphereNormals(Mesh) surf=GetSurface(Mesh,1) For v=0 To CountVertices(surf)-1 VX#=VertexX(surf,v) VY#=VertexY(surf,v) VZ#=VertexZ(surf,v) TFormNormal VX#, VY#, VZ#, 0, 0 VertexNormal surf,v, TFormedX(), TFormedY(), TFormedZ() Next End Function Function CubeHeightMapFix(HeightMap) HMB = ImageBuffer(HeightMap) IW = ImageWidth(HeightMap) LockBuffer HMB For x = 0 To IW/4 y = (iw/4) WritePixelFast x,y-1,ReadPixelFast(x,y,HMB),HMB WritePixelFast x+(IW/4)*2,y-1,ReadPixelFast(x+(IW/4)*2,y,HMB),HMB WritePixelFast x+(IW/4)*3,y-1,ReadPixelFast(x+(IW/4)*3,y,HMB),HMB WritePixelFast x,y*2,ReadPixelFast(x,y*2-1,HMB),HMB WritePixelFast x+(IW/4)*2,y*2,ReadPixelFast(x+(IW/4)*2,y*2-1,HMB),HMB WritePixelFast x+(IW/4)*3,y*2,ReadPixelFast(x+(IW/4)*3,y*2-1,HMB),HMB y = x x = (IW/4) WritePixelFast x-1,y,ReadPixelFast(x,y,HMB),HMB WritePixelFast x-1,y+(IW/4)*2,ReadPixelFast(x,y+(IW/4)*2,HMB),HMB WritePixelFast x*2,y,ReadPixelFast(x*2-1,y,HMB),HMB WritePixelFast x*2,y+(IW/4)*2,ReadPixelFast(x*2-1,y+(IW/4)*2,HMB),HMB Next UnlockBuffer HMB End Function ;#End Region ;#Region Cube Heightmap Grayscale to color Function Create_Load_HeightMappedTexture(HM) Local Texture% Texture = CreateImage(ImageWidth(HM),ImageHeight(HM)) Convert_Gray_Color(Texture,HM) SaveBuffer ImageBuffer(Texture),"tx"+(i)+".bmp" FreeImage Texture Texture = LoadTexture ("tx"+i+".bmp",1+16+32) Return Texture End Function Function Convert_Gray_Color(t,H) tw = ImageWidth( t) th = ImageHeight( t) LockBuffer ImageBuffer(t) LockBuffer ImageBuffer (H) For y = 0 To tH For x = 0 To tw cc = ReadPixelFast (x,y,ImageBuffer(H)) i = (Get_RED_From(cc)+Get_GREEN_From(cc) +Get_BLUE_From(cc)) r = GradientR(i) g = GradientG(i) b = GradientB(i) WritePixelFast x,y,Get_ARGB_From(r,g,b),ImageBuffer(t) Next Next UnlockBuffer ImageBuffer(t) UnlockBuffer ImageBuffer(H) End Function ;#End Region ;Color Gradient Function CreateGradient(colors%,steps%) Dim GradientR(steps),GradientG(steps),GradientB(steps),Percent(colors),Red(colors),Green(colors),Blue(colors) Local i%,pos1%,pos2%,pdiff% Local rdiff%,gdiff%,bdiff% Local rstep#,gstep#,bstep# Local counter%=1 ; read color codes For i=1 To colors : Read Percent(i),Red(i),Green(i),Blue(i) : Next ; calculate gradient While counter<colors ; transform percent value into step position pos1%=Percent(counter)*steps/100 pos2%=Percent(counter+1)*steps/100 ; calculate position difference pdiff%=pos2-pos1 ; calculate color difference rdiff%=Red(counter)-Red(counter+1) gdiff%=Green(counter)-Green(counter+1) bdiff%=Blue(counter)-Blue(counter+1) ; calculate color steps rstep#=rdiff*1.0/pdiff gstep#=gdiff*1.0/pdiff bstep#=bdiff*1.0/pdiff ; calculate "in-between" color codes For i=0 To pdiff GradientR(pos1+i)=Int(Red(counter)-(rstep*i)) GradientG(pos1+i)=Int(Green(counter)-(gstep*i)) GradientB(pos1+i)=Int(Blue(counter)-(bstep*i)) Next ; increment counter counter=counter+1 Wend End Function ;======================================== ; Color Functions ;#Region ;======================================== Function Get_ARGB_From(r,g,b): Return b Or(g Shl 8)Or(r Shl 16): End Function Function Get_ALPHA_From(ARGB): Return ARGB Shr 32 And %11111111 : End Function Function Get_RED_From(ARGB): Return ARGB Shr 16 And %11111111 : End Function Function Get_GREEN_From(ARGB): Return ARGB Shr 8 And %11111111 : End Function Function Get_BLUE_From(ARGB): Return ARGB And %11111111 : End Function ;#End Region ;#Region ;Spherical Vector Global SphericalBank = CreateBank(4*5) Function Spherical(x#,y#,z#,Vector#) RD# = Vector# zen# = ATan2(Sqr(x#*x#+y#*y#),z#) azi# = ATan2(y#,x#) PokeFloat (SphericalBank,0,Sin(Zen#)) PokeFloat (SphericalBank,4,Cos(Zen#)) PokeFloat (SphericalBank,8,Sin(Azi#)) PokeFloat (SphericalBank,12,Cos(Azi#)) PokeFloat (SphericalBank,16,RD#) End Function Function Spherical_X#(Vector#=0) If Not Vector# Then Return (PeekFloat(SphericalBank,16)*PeekFloat(SphericalBank,0)*PeekFloat(SphericalBank,12)) Else Return (Vector#*PeekFloat(SphericalBank,0)*PeekFloat(SphericalBank,12)) EndIf End Function Function Spherical_Y#(Vector#=0) If Not Vector# Then Return (PeekFloat(SphericalBank,16)*PeekFloat(SphericalBank,0)*PeekFloat(SphericalBank,8)) Else Return (Vector#*PeekFloat(SphericalBank,0)*PeekFloat(SphericalBank,8)) EndIf End Function Function Spherical_Z#(Vector#=0) If Not Vector# Then Return (PeekFloat(SphericalBank,16)*PeekFloat(SphericalBank,4)) Else Return (Vector#*PeekFloat(SphericalBank,4)) EndIf End Function Function VertexYaw#(X1#,Y1#,Z1#,X2# = 0,Y2# = 0,Z2# = 0) y# = ATan2( (x2-x1) , (Z2 - Z1)) If y# = NaN Then Return 0 Return -y# End Function Function VertexPitch#(X1#,Y1#,Z1#,X2# = 0,Y2# = 0,Z2# = 0) p# = ATan2( (z2-z1) , (Y2 - Y1)) If p# = NaN Then Return 0 Return p# End Function Function VertexRoll#(X1#,Y1#,Z1#,X2# = 0,Y2# = 0,Z2# = 0) Return ATan( (y2-y1) / (X2 - X1)) End Function ;#End Region Function HideShowTiles(Source,Parent,Distance#) TilesRendered = 0:ClosestTile# = 99999 For i = 0 To TotalTiles-1 ent = PlanetTiles(i,0) ex# = PlanetTiles(i,1):ey# = PlanetTiles(i,2):ez# = PlanetTiles(i,3) sX# = EntityX#(Source,1):sY# = EntityY#(Source,1):sZ# = EntityZ#(Source,1) Dist# = ((eX#--sX#)*(eX#--sX#) + (eY#--sY#)*(eY#--sY#) + (eZ#-sZ#)*(eZ#-sZ#)) Dist2# = ((eX#-sX#)*(eX#-sX#) + (eY#-sY#)*(eY#-sY#) + (eZ#-sZ#)*(eZ#-sZ#)) If Dist# < Distance#*Distance# Then di# = Sqr(dist#) If di# < ClosestTile# Then ClosestTile# = di# ShowEntity (ent) ShowEntity PlanetTiles(i,4) TilesRendered = TilesRendered + 1 Else HideEntity (ent) HideEntity PlanetTiles(i,4) EndIf Next End Function Function SetupTiles(Number_Of_Trees,Parent = 0) For i = 0 To TotalTiles - 1 ent = PlanetTiles(i,0) surf = GetSurface(ent,1) cv = CountVertices(surf)/2 PlanetTiles(i,1) = VertexX#(surf,cv) PlanetTiles(i,2) = VertexY#(surf,cv) PlanetTiles(i,3) = VertexZ#(surf,cv) AddTrees(Number_Of_Trees,Ent,i,Parent) HideEntity ent Next End Function Function DeletePlanet(Parent) For i = 1 To CountChildren(Parent) FreeEntity GetChild(Parent,i) Next End Function Function DISTANCE#(X1#,Y1#,Z1#,X2#=0,Y2#=0,Z2#=0) Return Sqr((X1#-X2#)*(X1#-X2#)+(Y1#-Y2#)*(Y1#-Y2#)+(Z1#-Z2#)*(Z1#-Z2#)) End Function ;======================================== ; Perlin Noise ;#Region;======================================== ;#Region ImprovedPerlin ;Define the Permutation and Gradient Lookup Bank Const PermutationLimit= 512 Global PermutationBank = CreateBank ((PermutationLimit*2)*4) Global GradientBank = CreateBank ((PermutationLimit*2)*4) ;#Region ;Create Permutations Dim perm ( PermutationLimit) For i = 0 To PermutationLimit-1 perm(i) = i Next For i = 0 To PermutationLimit-1 j = Rand(0,PermutationLimit-1) t = perm(j) perm(j) = perm(i) perm(i) = t Next ;Fill PermutationBank and GradientBank For i=0 To PermutationLimit -1 PokeInt PermutationBank,i*4,perm(i+1) PokeInt PermutationBank,(PermutationLimit+i)*4,perm(i+1) PokeFloat GradientBank,i*4,Rnd(-.7,.7) PokeFloat GradientBank,(PermutationLimit+i)*4,Rnd(-.7,.7) Next Dim perm(0) ;free this Dim ;#End Region Function Perlin2D( Image , ImageType , Seed , z# ) If ImageType = 0 Then IB = ImageBuffer(Image):size = ImageWidth(Image) If ImageType = 0 Then LockBuffer IB If ImageType = 1 Then IB = TextureBuffer(Image):size = TextureWidth(Image) If ImageType = 1 Then LockBuffer IB For x = 0 To size-1 For y = 0 To size-1 col# = ( Perlin3D#( Float x, Float y , Float z , size , Seed)) * (255/2) If col < 0 Then col = 0 If col > 255 Then col = 255 rgb = Get_ARGB_From(col,col,col) WritePixelFast x,y,rgb,IB Next Next UnlockBuffer IB End Function Function SmoothNoise#( x#, y#, z#,Seed = 0) x = x + Seed: y = y + Seed: z = z + Seed Local x1#,y1#,z1#,u#,v#,w#,a#,aa#,ab#,b#,ba#,bb# Local g1#,g2#,g3#,g4#,g5#,g6#,g7#,g8# Local l1#,l2#,l3#,l4#,l5#,l6#,l7# x1 = ( Floor(x) And (PermutationLimit-1) );, // FIND UNIT CUBE THAT y1 = ( Floor(y) And (PermutationLimit-1) );, // CONTAINS POINT. z1 = ( Floor(z) And (PermutationLimit-1) );, x = x - Floor( x ); // FIND RELATIVE X,Y,Z y = y - Floor( y ); // OF POINT IN CUBE. z = z - Floor( z ); u# = fade#(x);, // COMPUTE FADE CURVES v# = fade#(y);, // FOR EACH OF x,y,z. w# = fade#(z); a# = PeekInt(PermutationBank, x1*4) +y1 aa# = PeekInt(PermutationBank, a*4) +z1 ab# = PeekInt(PermutationBank, (a+1)*4) +z1;, // HASH COORDINATES OF b# = PeekInt(PermutationBank, (x1+1)*4)+y1 ba# = PeekInt(PermutationBank, b*4) +z1 bb# = PeekInt(PermutationBank, (b+1)*4) +z1; // THE 8 CUBE CORNERS, g1# = PeekFloat(GradientBank,(bb+1)*4) g2# = PeekFloat(GradientBank,(ab+1)*4) g3# = PeekFloat(GradientBank,(ba+1)*4) g4# = PeekFloat(GradientBank,(aa+1)*4) g5# = PeekFloat(GradientBank,(bb)*4) g6# = PeekFloat(GradientBank,(ab)*4) g7# = PeekFloat(GradientBank,(ba)*4) g8# = PeekFloat(GradientBank,(aa)*4) l1# = lerp#(u, g2#, g1#) l2# = lerp#(u, g4#, g3#) l3# = lerp#(v, l2#, l1#) l4# = lerp#(u, g6#, g5#) l5# = lerp#(u, g8#, g7#) l6# = lerp#(v, l5#, l4#) l7# = lerp#(w, l6#, l3#) Return l7# End Function Function fade#( t# ) ;s# = t * t * t * (t * (t * 6 - 15) + 10) s# = t * t * (3 - 2 * t) Return s# End Function Function lerp#( t#, a#, b#): z# = a + t * (b - a): Return z#:End Function Function Perlin3D#(x#,y#,z#,size#=64,seed% = 0) If seed = 0 Then seed = MilliSecs() x# = x# + seed y# = y# + seed z# = z# + seed ;//Set the initial value and initial size value# = 0.0: initialSize# = size#; ;//Add finer and finer hues of smoothed noise together While(size >= 1.0) If max = MaxOctaves Then Return value# / Float initialSize value# = value# + SmoothNoise#(x / size, y / size, z / size, seed) * size size = size / 2.0; max = max + 1 Wend ;//Return the result over the initial size Return (value# / Float initialSize); End Function Function FreePerlin() FreeBank PermutationBank FreeBank GradientBank End Function ;#End Region ;#End Region .Planet Data 0.0, 2, 43, 68 ; very dark blue: deep water Data 10.0, 9, 62, 92 ; dark blue: water Data 20.0, 17, 82,112 ; blue: shallow water Data 30.0, 69,108,118 ; light blue: shore Data 40.0,255,246,143 ; gold:Beach Data 50.0, 42,102, 41 ; green: grass Data 80.0,115,128, 77 ; light green: veld Data 96.0,153,143, 92 ; brown: tundra Data 98.0,179,179,179 ; grey: rocks Data 99.0,255,255,255 ; white: snow Data 100.0,255,255,255 ; white: snow Tree maker: Const MaxTreeVeriaties = 20 Dim TreeBuffer(MaxTreeVeriaties) Function InitStep1Trees() For i = 0 To MaxTreeVeriaties TreeBuffer(i) = CreateRandomizedTree() Next End Function Function InitStep2Trees() For i = 0 To MaxTreeVeriaties FreeEntity TreeBuffer(i) Next End Function Function CreateRandomizedTree(Parent=0) Wiggle_Flag = Rand(1,2);1="on", 2="off". Specifies whether to 'wiggle' the branches as they are rotated. Branches_On_End_Flag = Rand(1,2); 1="on", 2="off". specifies growth on just the ends or evenly spaced along branch. LEAF_TYPE = 0;Rand(-1,5) ; Leaf type is: 0=Realistic, 1=Sphere Blobs ; 2=Strange, 3=Torus ; 4=Triangles, 5=Ultra-Triangles ; 6=Texture mapped (Maps a graphics on a flattened cube, supply your own graphic) ; -1=Default, just a sphere! Leaf_Mesh = 1;Rand(1,10); sets the maximum # of trianges for type 4/5 leaves Number_Of_Large_Branches = Rand(1,5) ;NUMBER OF Large/Medium/Small BRANCHES is in relation to each 'parent' branch. Number_Of_Medium_Branches = Rand(3,5) Number_Of_Small_Branches = Rand(5,7) Large_Branch_Minimum_Angle# = Rnd(1,20);Large/Medium/Small BRANCH MIN/MAX TILT ANGLE sets limits of random branch tilt. Medium_Branch_Minimum_Angle# = Rnd(1,30) Small_Branch_Minimum_Angle# = Rnd(1,50) Large_Branch_Maximum_Angle# = Rnd(20,50) Medium_Branch_Maximum_Angle# = Rnd(30,70) Small_Branch_Maximum_Angle# = Rnd(50,100) Tree_Trunk_Size# = Rnd(0,9) ;sets the height of the tree trunk. Large_Branch_Size_Min# = Rnd(.1,2);Large/Medium/Small BRANCH MIN/MAX SIZE sets length limits of the branches. Medium_Branch_Size_Min# = Rnd(.1,2) Small_Branch_Size_Min# = Rnd(.1,2) Large_Branch_Size_Max# = Rnd(3,4) Medium_Branch_Size_Max# = Rnd(2,3) Small_Branch_Size_Max# = Rnd(2,4) Trunk_seg = 4;(def = 4)This sets the number of faces in Each trunk And branch cylinder LBranch_seg = 4;(def = 4) MBranch_seg = 4;(def = 4) SBranch_seg = 4;(def = 4) Trunk_Big_Dia# = Rnd(.05,.3);(def = 1)These set the bottom diameter of the trunk/branches Trunk_Small_Dia# = Rnd(.05,Trunk_Big_Dia#);def = .8)These set the top diameter of the trunk/branches LBranch_Big_Dia# = (Trunk_Small_Dia#);(def = .6) LBranch_Small_Dia# = Rnd(.1,LBranch_Big_Dia#);(def = .4) MBranch_Big_Dia# = (LBranch_Small_Dia#);(def = .3) MBranch_Small_Dia# = Rnd(.1,MBranch_Small_Dia#);(def = .2) SBranch_Big_Dia# = (MBranch_Small_Dia#);(def = .1) SBranch_Small_Dia# =Rnd(.01,SBranch_Small_Dia#);(def = .05) Tree = CreateTree(Wiggle_Flag,Branches_On_End_Flag,Leaf_Type,Leaf_Mesh,Number_Of_Large_Branches,Number_Of_Medium_Branches,Number_Of_Small_Branches,Large_Branch_Minimum_Angle#,Medium_Branch_Minimum_Angle#,Small_Branch_Minimum_Angle#,Large_Branch_Maximum_Angle#,Medium_Branch_Maximum_Angle#,Small_Branch_Maximum_Angle#,Tree_Trunk_Size#,Large_Branch_Size_Min#,Medium_Branch_Size_Min#,Small_Branch_Size_Min#,Large_Branch_Size_Max#,Medium_Branch_Size_Max#,Small_Branch_Size_Max#,Trunk_seg,LBranch_seg,MBranch_seg,SBranch_seg,Trunk_Big_Dia#,Trunk_Small_Dia#,LBranch_Big_Dia#,LBranch_Small_Dia#,MBranch_Big_Dia#,MBranch_Small_Dia#,SBranch_Big_Dia#,SBranch_Small_Dia#) ;EntityColor tree,128,64,0 EntityParent tree,Parent Return tree End Function ;#Region; BB3D Tree, V1.1 by Martin A. Parrott (parrottm@...) ;#Region; Comments ; Oct. 28, 2001 - 1. Added ability to texture the tree components ; 2. Added another leaf type, type 6 ; ; This is a piece of code to create a 3D tree with a few predefined ; leaf types. Feel free to add your own leaf routines to the select/case area ; This code is based on code written in Lscript for Lightwave 3D by Newtek ; which was in turn based on an earlier BML script for Lightwave 3D ; and that was based on code ported from a POVRay macro, whew! ; Note: This code is not warranted in any way so use at your own risk ; And test it For usability in your own program ; ; This code is free to use, but if you modify it, please send the ; changes to the above email address so I can continue to release ; updates so others can benefit. ; ; This routine can make many different types of trees, bushes, etc. ; Just change the variables! There are a lot to allow flexibility, so go for it! ; ; Parameters are: ; Wiggle_Flag 1="on", 2="off". Specifies whether to 'wiggle' the branches as they are rotated. ; Branches_On_End_Flag 1="on", 2="off". specifies growth on just the ends or evenly spaced along branch. ; LEAF TYPE is: 0=Realistic, 1=Sphere Blobs ; 2=Strange, 3=Torus ; 4=Triangles, 5=Ultra-Triangles ; 6=Texture mapped (Maps a graphics on a flattened cube, supply your own graphic) ; -1=Default, just a sphere! ; Leaf_Mesh sets the maximum # of trianges for type 4/5 leaves ; Number_Of_Large_Branches NUMBER OF Large/Medium/Small BRANCHES is in relation to each 'parent' branch. ; Number_Of_Medium_Branches ; Number_Of_Small_Branches ; Large_Branch_Minimum_Angle# Large/Medium/Small BRANCH MIN/MAX TILT ANGLE sets limits of random branch tilt. ; Medium_Branch_Minimum_Angle# ; Small_Branch_Minimum_Angle# ; Large_Branch_Maximum_Angle# ; Medium_Branch_Maximum_Angle# ; Small_Branch_Maximum_Angle# ; Tree_Trunk_Size# sets the height of the tree trunk. ; Large_Branch_Size_Min# Large/Medium/Small BRANCH MIN/MAX SIZE sets length limits of the branches. ; Medium_Branch_Size_Min# ; Small_Branch_Size_Min# ; Large_Branch_Size_Max# ; Medium_Branch_Size_Max# ; Small_Branch_Size_Max# ; Trunk_seg This sets the number of faces in each trunk and branch cylinder ; LBranch_seg ; MBranch_seg ; SBranch_seg ; Trunk_Big_Dia# These set the bottom diameter of the trunk/branches ; Trunk_Small_Dia# These set the top diameter of the trunk/branches ; LBranch_Big_Dia# ; LBranch_Small_Dia# ; MBranch_Big_Dia# ; MBranch_Small_Dia# ; SBranch_Big_Dia# ; SBranch_Small_Dia# ; Texture section ; Uncomment the following and replace the image files with your own if you want ; textures on your trunk, branches and/or leaves ; Note: If you don't want these to be global variables, move them inside the ; function below ;Global Trunk_texture$="trunk.bmp" ;Global LargeBranch_texture$="largebranch.bmp" ;Global MediumBranch_texture$="medbranch.bmp" ;Global SmallBranch_texture$="smallbranch.bmp" ;Global Leaf_texture$="leaf.bmp" ;Include "../lib/cylindertaper.bb" ; Needed to create the trunk and limbs of our tree ;Include "../lib/torus.bb" ; Needed for one of our strange leaf types! ;#End Region Function CreateTree(Wiggle_Flag=2,Branches_On_End_Flag=2,Leaf_Type=-1,Leaf_Mesh=100,Number_Of_Large_Branches=5,Number_Of_Medium_Branches=3,Number_Of_Small_Branches=7,Large_Branch_Minimum_Angle#=20,Medium_Branch_Minimum_Angle#=20,Small_Branch_Minimum_Angle#=20,Large_Branch_Maximum_Angle#=40,Medium_Branch_Maximum_Angle#=40,Small_Branch_Maximum_Angle#=40,Tree_Trunk_Size#=9,Large_Branch_Size_Min#=2,Medium_Branch_Size_Min#=2,Small_Branch_Size_Min#=2,Large_Branch_Size_Max#=4,Medium_Branch_Size_Max#=3,Small_Branch_Size_Max#=4,Trunk_seg=15,LBranch_seg=4,MBranch_seg=4,SBranch_seg=4,Trunk_Big_Dia#=1,Trunk_Small_Dia#=.8,LBranch_Big_Dia#=.6,LBranch_Small_Dia#=.4,MBranch_Big_Dia#=.3,MBranch_Small_Dia#=.2,SBranch_Big_Dia#=.1,SBranch_Small_Dia#=.05) ; System calculated variables. Takes from defaults above or passed function parameters ;#Region SETUP L_Bmin#=Large_Branch_Minimum_Angle# L_Bmax#=Large_Branch_Maximum_Angle# - Large_Branch_Minimum_Angle# M_Bmin#=Medium_Branch_Minimum_Angle# M_Bmax#=Medium_Branch_Maximum_Angle# - Medium_Branch_Minimum_Angle# S_Bmin#=Small_Branch_Minimum_Angle# S_Bmax#=Small_Branch_Maximum_Angle# - Small_Branch_Minimum_Angle# Large_Branch_Size_Range#=Large_Branch_Size_Max# - Large_Branch_Size_Min# Medium_Branch_Size_Range#=Medium_Branch_Size_Max# - Medium_Branch_Size_Min# Small_Branch_Size_Range#=Small_Branch_Size_Max# - Small_Branch_Size_Min# If Trunk_texture$<>"" ; Get our Trunk texture if defined trunktex=LoadTexture(Trunk_texture$) Else trunktex=0 EndIf If LargeBranch_texture$<>"" ; Get our Large branch texture if defined lbranchtex=LoadTexture(LargeBranch_texture$) Else lbranchtex=0 EndIf If MediumBranch_texture$<>"" ; Get our Medium branch texture if defined mbranchtex=LoadTexture(MediumBranch_texture$) Else mbranchtex=0 EndIf If SmallBranch_texture$<>"" ; Get our Small branch texture if defined sbranchtex=LoadTexture(SmallBranch_texture$) Else sbranchtex=0 EndIf If Leaf_texture$<>"" ; Get our Leaf texture if defined leaftex=LoadTexture(Leaf_texture$,54) Else leaftex=0 EndIf ;#End Region ; Make the Tree Trunk ; Note: the Make_Branch function puts a sphere on the end of the branch to 'smooth' ; up the construction. If you want to save polys, change all calls of Make_Branch ; below to Make_Branch_Nosphere Trunk=Make_Branch(Tree_Trunk_Size#,Trunk_Big_Dia#,Trunk_Small_Dia#,Trunk_seg,trunktex) A=0 While A < Number_Of_Large_Branches ; Make one large branch. This_Large_Branch_Size#=( Rnd(0,1) * Large_Branch_Size_Range# ) + Large_Branch_Size_Min# LBranch=Make_Branch(This_Large_Branch_Size#,LBranch_Big_Dia#,LBranch_Small_Dia#,LBranch_seg,lbranchtex) If LargeBranch_texture$<>"" ; If the texture is defined, apply it EntityTexture LBranch,lbranchtex EndIf ;branch wiggle Wiggle=(Rnd(0,1)*20) - 10 If Wiggle_Flag=2 Wiggle=0 EndIf A2=( 360 / Number_Of_Large_Branches ) * A A2=A2 + Wiggle ;branch angle BranchAngle1#=(Rnd(0,1)*L_Bmax)+L_Bmin ;branch height TEMP_HEIGHT1#=Tree_Trunk_Size# If Branches_On_End_Flag=2 TEMP_HEIGHT1#=((Tree_Trunk_Size# / Rand(Number_Of_Large_Branches))); EndIf ; Loop To put medium branches on that large branch. B=0 While B < Number_Of_Medium_Branches This_Medium_Branch_Size#=( Rnd(0,1) * Medium_Branch_Size_Range# ) + Medium_Branch_Size_Min# MBranch=Make_Branch(This_Medium_Branch_Size#,MBranch_Big_Dia#,MBranch_Small_Dia#,MBranch_seg,mbranchtex) If MediumBranch_texture$<>"" ; If the texture is defined, apply it EntityTexture MBranch,mbranchtex EndIf ;Branch Wiggle Wiggle=(Rnd(0,1)*20) - 10 If ( Wiggle_Flag=2 ) Wiggle=0 EndIf B2=( 360 / Number_Of_Medium_Branches ) * B B2=B2 + Wiggle ;branch Angle BranchAngle2#=(Rnd(0,1)*M_Bmax)+M_Bmin ;branch Height TEMP_HEIGHT2#=This_Large_Branch_Size# If ( Branches_On_End_Flag=2 ) TEMP_HEIGHT2#=((This_Large_Branch_Size# / Rand(Number_Of_Medium_Branches))) EndIf ; Loop To put small branches on that medium branch. C=0 While C < Number_Of_Small_Branches This_Small_Branch_Size#=( Rnd(0,1) * Small_Branch_Size_Range# ) + Small_Branch_Size_Min# SBranch=Make_Branch_Nosphere(This_Small_Branch_Size#,SBranch_Big_Dia#,SBranch_Small_Dia#,SBranch_seg,sbranchtex) If SmallBranch_texture$<>"" ; If the texture is defined, apply it EntityTexture SBranch,sbranchtex EndIf ; First, spin the vertical branch To a random angle. ; The branch doesn't really change - this actually ; just spins the leaf around! ;SpinAngle=(Rnd(0,1)*360) ;RotateMesh SBranch,0,spinangle,0 If Leaf_texture$<>"" ; If the texture is defined, apply it EntityTexture Temp_leaf,leaftex EndIf ; Now, tilt it over a little. BranchAngle=(Rnd(0,1)*S_Bmax)+S_Bmin RotateMesh SBranch,0,0,BranchAngle ; Rotate it into place, with a little random wiggle. Wiggle=(Rnd(0,1)*20) - 10 If Wiggle_Flag=2 Wiggle=0 EndIf C2=( 360 / Number_Of_Small_Branches ) * C C2=C2 + Wiggle RotateMesh SBranch,0,C2,0 ; Move it up To the top of the Medium_Branch. ; If flag is "off", Then move To the Next spot on branch. TEMP_HEIGHT#=This_Medium_Branch_Size#; If ( Branches_On_End_Flag=2 ) TEMP_HEIGHT#=((This_Medium_Branch_Size# /Rand( Number_Of_Small_Branches)) ) EndIf PositionMesh SBranch,0,TEMP_HEIGHT#,0 ;EntityParent SBranch,MBranch AddMesh SBranch,MBranch FreeEntity sbranch C=C + 1 Wend RotateMesh MBranch,0,0,BranchAngle2# RotateMesh MBranch,0,B2,0 ; Move the Medium_Branch up To the top of the Large_Branch. ; If flag is "off", Then move To the Next spot on branch. PositionMesh MBranch,0,TEMP_HEIGHT2#,0 ;EntityParent MBranch,LBranch AddMesh MBranch,LBranch FreeEntity mbranch B=B + 1 Wend RotateMesh LBranch,0,0,BranchAngle1# RotateMesh LBranch,0,A2,0 ; Move the Large_Branch up To the top of the Tree_Trunk. ; If flag is "off", Then move To the Next spot on trunk. ; These are spaced differently than the other branches - they ; start about 3/4 of the way up the trunk. PositionMesh LBranch,0,TEMP_HEIGHT1#,0 A=A + 1 ;EntityParent LBranch,Trunk AddMesh LBranch,Trunk FreeEntity lbranch Wend Return Trunk End Function Function Make_Leaf(Leaf_Type,Leaf_Mesh,texture) Local x1#,x2#,x3#,y1#,y2#,y3#,z1#,z2#,z3# leafmesh=CreateMesh(parent) leafsurf=CreateSurface(leafmesh) A=1 While A<=Leaf_Mesh ; Calculate random location For First point. X1=( Rnd(0,1) * 2 ) - 1 Y1=( Rnd(0,1) * 2 ) - 1 Z1=( Rnd(0,1) * 2 ) - 1 ; Move a little way from *First* point. X2=X1 + ( Rnd(0,1) * 0.6 ) - 0.3 Y2=Y1 + ( Rnd(0,1) * 0.6 ) - 0.3 Z2=Z1 + ( Rnd(0,1) * 0.6 ) - 0.3 ; Move a little way from *First* point. X3=X1 + ( Rnd(0,1) * 0.6 ) - 0.3 Y3=Y1 + ( Rnd(0,1) * 0.6 ) - 0.3 Z3=Z1 + ( Rnd(0,1) * 0.6 ) - 0.3 pnt0=AddVertex(leafsurf,x1#,y1#,z1#) pnt1=AddVertex(leafsurf,x2#,y2#,z2#) pnt2=AddVertex(leafsurf,x3#,y3#,z3#) AddTriangle(leafsurf,pnt0,pnt1,pnt2) pnt1=AddVertex(leafsurf,0,0,0) pnt2=AddVertex(leafsurf,0,0,.1) AddTriangle(leafsurf,pnt0,pnt1,pnt2) pnt1=AddVertex(leafsurf,0,0,0) pnt2=AddVertex(leafsurf,.1,0,0) AddTriangle(leafsurf,pnt0,pnt1,pnt2) A=A + 1 Wend EntityColor leafmesh,0,150,0 Return leafmesh End Function Function Make_Branch(branch_size#,Big_Dia#,Small_Dia#,branch_seg,texture) ; Now create some branches. branch=createcylindertaper(branch_seg,0,0,0,0,0,Big_Dia#,Small_Dia#,branch_size#) ball=CreateSphere(branch_seg/2,branch) ScaleMesh ball,Small_Dia#,Small_Dia#,Small_Dia# PositionMesh ball,0,branch_size,0 AddMesh ball,branch FreeEntity ball Return branch End Function Function Make_Branch_Nosphere(branch_size#,Big_Dia#,Small_Dia#,SBranch_seg,texture) branch=createcylindertaper(SBranch_seg,0,0,0,0,0,Big_Dia#,Small_Dia#,branch_size#) If texture>0 ; If we have a texture, put it on EntityTexture branch,texture Else ; If we don't have a texture, color it EntityColor branch,90,45,0 ; Give us a dark brown color, change to whatever color your want! EndIf Return branch End Function ;#End Region ;#Region; Tapered Cylinder function ; Written by Martin Parrott ; V1.1 ; Oct. 28, 2001 - 1. Added ability to map texture on object ; 2. Changed triangle creation order, caused by 1. above ; 3. Cleaned up variable names ; ; This code is hiware. If you use it, please send me an email and say Hi! ; You are free to use, modify, etc. No warranty is written Or implied ; Use at your own risk ; This code is free to use, but if you modify it, please send the ; changes to the above email address so I can continue to release ; updates so others can benefit. Function CreateCylinderTaper(seg=8,parent=0,solid=True,xloc#=0,yloc#=0,zloc#=0,rad1#=1,rad2#=.75,height#=2) ; seg defines the number of segments/vertices in the cylinder cross-section ; parent is the parent enitity handle ; solid defines whether the cylinder ends are capped or open, true-they are closed, false-they are open ; xloc# is the final x axis location for the cylinder ; yloc# is the final y axis location for the cylinder ; zloc# is the final z axis location for the cylinder ; rad1# is the radius of the bottom of the cylinder ; rad2# is the radius of the top of the cylinder ; height# is the total height of the cylinder If seg<2 Then seg=8 ; make sure the number of segments is set to something sane If seg>32 Then seg=32 cylmesh=CreateMesh() cylsurf=CreateSurface(cylmesh) ;Create center vertex of bottom disc AddVertex cylsurf,0,0,0,1,1 angle#=0 ; Set our initial starting angle inc#=Float 360 / Float seg ; Setup increment for setting up vertices around our cylinder ends ; Do bottom end vertices While angle# < 360.01 x#=rad1#*Cos(angle#) z#=rad1#*Sin(angle#) u#=angle#/360 AddVertex (cylsurf,x#,0,z#,u#,1) angle#=angle#+inc# Wend ; If solid is set, then cap end. Do triangles If solid>0 For vert=1 To seg AddTriangle cylsurf,0,vert,vert+1 Next EndIf ;Create center vertex of top disc AddVertex cylsurf,0,height#,0,0,0 angle#=0 ; reset angle ; Do top end While angle# < 360.01 x#=rad2#*Cos(angle#) z#=rad2#*Sin(angle#) u#=angle#/360 AddVertex (cylsurf,x#,height#,z#,u#,0) angle#=angle#+inc# Wend ; If solid is set, then cap end. Do triangles If solid>0 For vert=seg+3 To (seg*2)+3 AddTriangle cylsurf,seg+2,vert+1,vert Next EndIf ; Do sides of cylinder For vert=1 To seg AddTriangle cylsurf,vert,vert+seg+2,vert+seg+3 AddTriangle cylsurf,vert,vert+seg+3,vert+1 Next UpdateNormals cylmesh ; fix our normals MoveEntity cylmesh,xloc#,yloc#,zloc# ; Put the cylinder in place If parent > 0 ; Assign our cylinder to a parent if one is passed to us EntityParent cylmesh,parent EndIf Return cylmesh End Function ;#End Region Function AddTrees(Number_Of_Trees,Entity,j,Parent=0) PlanetTiles(j,4) = CreateMesh(Parent) surf = GetSurface(Entity,1) For i = 1 To Rand(0,Number_Of_Trees) vert = Rand(0,CountVertices(surf)-1) vx# = VertexX(surf,vert) vy# = VertexY(surf,vert) vz# = VertexZ(surf,vert) d# = DISTANCE(vx,vy,vz) If d > PlanetSize And d < planetsize+(planetsize*multiplier)Then tree = CopyMesh (TreeBuffer(Rand(0,MaxTreeVeriaties))) ; get its normal vectors nx#=VertexNX(surf,vert) ny#=VertexNY(surf,vert) nz#=VertexNZ(surf,vert) AlignToVector tree,nx,ny,nz,2,1 tp# = EntityPitch(tree,1) ty# = EntityYaw(tree,1) tr# = EntityRoll(tree,1) RotateMesh tree,tp,ty,tr ScaleMesh tree,5,5,5 PositionMesh tree,vx,vy,vz AddMesh (tree,PlanetTiles(j,4));,True,128,64,0) FreeEntity tree EndIf Next HideEntity PlanetTiles(j,4) EntityColor PlanetTiles(j,4) ,128,64,0 EntityType PlanetTiles(j,4),Static End Function