I have been working on getting a geosphere created in blitz.
A geosphere spreads it vertices evenly over the surface unlike the CreateSphere () command that tris get smaller the closer to the top/bottom.
I have got a geosphere of sorts going but I am have problems on how to texture it!
If any one has any ideas that would be great!
Has any one else worked on creating these?
GEOSPHERE (Work in Progress)
A geosphere spreads it vertices evenly over the surface unlike the CreateSphere () command that tris get smaller the closer to the top/bottom.
I have got a geosphere of sorts going but I am have problems on how to texture it!
If any one has any ideas that would be great!
Has any one else worked on creating these?
GEOSPHERE (Work in Progress)
Graphics3D 800,600 SetBuffer BackBuffer() Global title$="GeoSphere Test" AppTitle title$ SetFont LoadFont("Arial",12) Global gwm = GraphicsWidth()*.5,ghm = GraphicsHeight()*.5 Global you = CreatePivot() PositionEntity you,0,10,-90 Global camrange = 2000 Global cam=CreateCamera(you) PositionEntity cam,0,0,0 CameraRange cam,1,camrange CameraClsColor cam,50,0,0 light=CreateLight() PositionEntity light,200,200,200 LightRange light,10000 ;Create Test Texture skytex=CreateTexture(16,16,256) SetBuffer TextureBuffer(skytex) For count = 1 To 5 Color 55*(count-1),10*count,255-55*(count-1) Rect count,count,15-count*2,15-count*2,1 Next SetBuffer BackBuffer() ScaleTexture skytex,.25,.25 Dim MidVert(2) Dim TriVert(2) base=createBox() ScaleMesh base,50,50,50 EntityTexture base,skytex MoveMouse gwm,ghm MouseXSpeed MouseYSpeed start=MilliSecs() showtext = 1 FPS = 50 period=1000/FPS time=MilliSecs()-period While Not KeyHit(1) now = MilliSecs() - start move(you) If MouseHit(1) Then ;Subdivide mesh to make geosphere level = level + 1 base=chopmesh(base) EntityTexture base,skytex If ShowVertices Then ShowVert(base,2,.5,0) End If If MouseHit(2) Then ; show and number all Vertices for debuging If ShowVertices Then HideVert() Else ShowVert(base,2,.5,0) End If ShowVertices = Not ShowVertices End If If MouseHit(3) Then Wire = Not Wire WireFrame wire End If If KeyHit(57) Then showtext = Not showtext End If RenderWorld tween Color 125,125,120 If ShowVertices Then VertsShown=DisplayVertNums() Text 650,580,"VertsShown = "+ VertsShown End If If showtext Then Color 25,125,250 Text 10,580,"Level = "+ level +" Triangles Rendered = "+TrisRendered() Text 10,10," Arrow Keys/Mouse to Move" Text 10,30," Left Mouse Button to Subdivide and Spherize" Text 10,50," MIddle Mouse Button to Display in WireFrame Mode" Text 10,70," Right Mouse Button to Display and Number Vertices" Text 10,90," Space to Hide/Display this help" EndIf Flip Wend ;--end of main loop Global Speed#,SideSpeed#,EntPitch#,EntYaw# Function Move(Ent) ;Rotation EntPitch# = MouseYSpeed()*.1 + EntPitch# * .95 EntYaw# = -MouseXSpeed()*.1 + EntYaw# * .95 TurnEntity Ent,EntPitch#,EntYaw#,0 ; MoveMouse gwm,ghm ;Forward If KeyDown(200) Then Thrust# = .1 ElseIf KeyDown(208)Then ; Backwards Thrust# = -.1 Else Thrust# =0 End If ;Right If KeyDown(205) Then SideThrust# = .1 ElseIf KeyDown(203)Then ;Left SideThrust# = -.1 Else SideThrust# =0 End If Speed# = Thrust# + (Speed# * .95) SideSpeed# = SideThrust# + (SideSpeed# * .95) MoveEntity Ent,SideSpeed#,0,Speed# End Function Function createBox(parent=0) Local mesh=CreateMesh(parent) Local surf=CreateSurface(mesh) ;front AddVertex surf,-.5,-.5, .5, 1,1;0 AddVertex surf,-.5, .5, .5, 1,0;1 AddVertex surf, .5, .5, .5, 0,0;2 AddVertex surf, .5,-.5, .5, 0,1;3 ;back AddVertex surf,-.5,-.5,-.5, 0,1;4 AddVertex surf,-.5, .5,-.5, 0,0;5 AddVertex surf, .5, .5,-.5, 1,0;6 AddVertex surf, .5,-.5,-.5, 1,1;7 ;front AddTriangle (surf,2,1,0) AddTriangle (surf,3,2,0) ;back AddTriangle (surf,4,5,7) AddTriangle (surf,5,6,7) ;lside AddTriangle (surf,0,1,5) AddTriangle (surf,4,0,5) ;rside AddTriangle (surf,2,3,6) AddTriangle (surf,3,7,6) ;top AddTriangle (surf,1,2,5) AddTriangle (surf,2,6,5) ;bottom AddTriangle (surf,0,4,7) AddTriangle (surf,3,0,7) UpdateNormals mesh Return mesh End Function Type vect Field vertA,vertB ,MidVert Field MidX#,MidY#,MidZ# End Type Function ChopMesh(oldmesh) ; create new mesh with each triangle subdivided into 4 Local vc,nx#,ny#,nmz#,surf,trcount,tc,sc Local dx#,dy#,dz# mesh=CreateMesh() surfcount = CountSurfaces(oldmesh) For sc = 1 To surfcount surf=CreateSurface( mesh ) oldsurf=GetSurface(oldmesh,sc) EntBrush=GetEntityBrush(Mesh) PaintEntity Mesh,EntBrush EntityFX mesh,18 FindMeshCentre(oldMesh) dx#=VertexX(oldsurf,0)-MeshCentreX# dy#=VertexY(oldsurf,0)-MeshCentreY# dz#=VertexZ(oldsurf,0)-MeshCentreZ# Radius# = Sqr(dx#*dx#+dy#*dy#+dz#*dz#) ; Radius used to move vertices a equal distance from centre tricount = CountTriangles(oldsurf) Vertcount = CountVertices(oldsurf) Delete Each vect For vc = 0 To Vertcount -1 AddVertex surf,VertexX(oldsurf,vc),VertexY(oldsurf,vc),VertexZ(oldsurf,vc),VertexU(oldsurf,vc),VertexV(oldsurf,vc) VertexColor surf,vc,VertexRed(oldsurf,vc),VertexGreen(oldsurf,vc),VertexBlue(oldsurf,vc) Next For tc= 0 To tricount-1 For vectcount = 0 To 2 TriVert(vectcount)=TriangleVertex(oldsurf,tc,vectcount) If vectcount < 2 Then MidVert(vectcount)=HalfVect(oldsurf, TriVert(vectcount), TriangleVertex(oldsurf,tc,vectcount+1),surf,radius#) Else MidVert(vectcount)=HalfVect(oldsurf, TriangleVertex(oldsurf,tc,2), TriangleVertex(oldsurf,tc,0),surf,radius#) End If ; debuglog " tc= "+ tc + " vectcount = " +vectcount + " MidVert("+vectcount+") ="+ MidVert(vectcount) Next ; create new triangles AddTriangle surf,MidVert(0),MidVert(1),MidVert(2) AddTriangle surf,TriVert(0),MidVert(2),MidVert(0) AddTriangle surf,TriVert(1),MidVert(0),MidVert(1) AddTriangle surf,TriVert(2),MidVert(1),MidVert(2) If KeyHit(1) Then Exit ; debuglog "MidVert(0) = "+ MidVert(0)+" MidVert(1) = "+MidVert(1)+ " MidVert(2) = "+MidVert(2) Next ;--Redo texture coords For vc = 0 To CountVertices(surf) -1 vx#=VertexX(surf,vc) vy#=VertexY(surf,vc) vz#=VertexZ(surf,vc) vpitch#=VectorPitch# ( vx#,vy#,vz# ) vyaw#=VectorYaw# ( vx#,vy#,vz# ) ; if vyaw < 0 then vyaw = vyaw+360 ; if vpitch< 0 then vpitch = vpitch+360 NewU# = ((vpitch+180)/360.0);+.5 NewV# = ((vyaw+180)/360.0);+.5 DebugLog vx+","+ vy+","+ vz+" pitch = "+vpitch+ " yaw = "+vyaw+" u= "+NewU#+" v= "+NewV# VertexTexCoords surf,vc,NewU#,NewV# Next Next HideEntity oldmesh ; spherize(mesh,radius#) UpdateNormals mesh Return mesh End Function Function HalfVect(surf,VertA,VertB,newsurf,radius#) ; Create or find existing vertex halfway between two existing vertices ; note: modified to move vertex to specified radius from centre Local VectExists Local dx#,dy#,dz# Local Dist#,DistDiff# VectExists = False ;look for existing For searchV.vect = Each vect If (searchV\vertA = VertA) And (searchV\vertB = VertB) Then VectExists = True :Exit If (searchV\vertA = VertB) And (searchV\vertB = VertA) Then VectExists = True :Exit Next If VectExists = False Then ; create new as no old one was found nv.vect = New vect nv\vertA = VertA nv\vertB = VertB nv\Midx#=VertexX(Surf,nv\vertA)+(VertexX(Surf,nv\vertB)-VertexX(Surf,nv\vertA))*.5 nv\Midy#=VertexY(Surf,nv\vertA)+(VertexY(Surf,nv\vertB)-VertexY(Surf,nv\vertA))*.5 nv\Midz#=VertexZ(Surf,nv\vertA)+(VertexZ(Surf,nv\vertB)-VertexZ(Surf,nv\vertA))*.5 MidU# =VertexU(Surf,nv\vertA)+(VertexU(Surf,nv\vertB)-VertexU(Surf,nv\vertA))*.5 MidV# =VertexV(Surf,nv\vertA)+(VertexV(Surf,nv\vertB)-VertexV(Surf,nv\vertA))*.5 dx#=nv\Midx#-MeshCentreX# dy#=nv\Midy#-MeshCentreY# dz#=nv\Midz#-MeshCentreZ# Dist#=Sqr(dx#*dx#+dy#*dy#+dz#*dz#) DistDiff#=Radius#/Dist# nv\Midx#=(dx#*DistDiff#+MeshCentreX#) nv\Midy#=(dy#*DistDiff#+MeshCentreY#) nv\Midz#=(dz#*DistDiff#+MeshCentreZ#) nv\MidVert=AddVertex( newsurf, nv\Midx,nv\Midy,nv\Midz,MidU#,MidV#) Return nv\MidVert Else Return SearchV\Midvert End If DebugLog "Error: No Verts Found/Created for "+VertA+" and "+VertB +" they are not in same triangle" Return -1 End Function Global MeshCentreX#,MeshCentreY#,MeshCentreZ# Function FindMeshCentre(Mesh) Local vcount,totX#,totY#,totZ# Local surf,surfcount = CountSurfaces(Mesh) Local VertTot If surfcount > 0 Then For scount = 1 To surfcount surf=GetSurface(Mesh,scount) Vertcount = CountVertices(surf) VertTot = VertTot + Vertcount For vcount = 0 To Vertcount-1 totX# = totX# + VertexX(surf,vcount) totY# = totY# + VertexY(surf,vcount) totZ# = totZ# + VertexZ(surf,vcount) Next Next End If MeshCentreX# = totX# / VertTot MeshCentreY# = totY# / VertTot MeshCentreZ# = totZ# / VertTot End Function ;---Debug Functions Type vp Field ent,num End Type Function ShowVert(mesh,ssize=3,size#=.1,UseVertCol=False) Delete Each vp For sc = 1 To CountSurfaces(mesh) surf=GetSurface(mesh,sc) maxvert=CountVertices(surf) For vc = 0 To maxvert-1 dot.vp= New vp dot\num = vc dot\ent = CreateSphere(ssize,mesh); PositionEntity dot\ent,VertexX(surf,vc),VertexY(surf,vc),VertexZ(surf,vc) vr=VertexRed(surf,vc) vg=VertexGreen(surf,vc) vb=VertexBlue(surf,vc) c=EntityDistance(dot\ent,mesh)*100 Mod 255 If UseVertCol Then EntityColor dot\ent,vr,vg,vb Else EntityColor dot\ent,c,Sin(vc)*255,255-c End If ScaleEntity dot\ent,size,size,size If KeyHit(1) Then End Next Next End Function Function HideVert() For tvp.vp = Each vp HideEntity tvp\ent Next Delete Each vp End Function Function DisplayVertNums() Local vertc = 0 Color 200,200,200 For dot.vp = Each vp If EntityInView(dot\ent,cam) Then CameraProject(cam,EntityX(dot\ent),EntityY(dot\ent),EntityZ(dot\ent)) Text ProjectedX#(),ProjectedY#(),dot\num vertc = vertc +1 End If Next Return vertc End Function End
