the code are explained, and some of the commented lines are alternatives.

Code: Select all
;the function RandF is from kenmo from:
;http://www.purebasic.fr/english/viewtopic.php?f=13&t=45652
;example Debug StrF(RandF(-2.0, 2.0))
Procedure.f RandF(Min.f, Max.f, Resolution.i = 10000)
ProcedureReturn (Min + (Max - Min) * Random(Resolution) / Resolution)
EndProcedure
Structure Vector3
x.f
y.f
z.f
EndStructure
Define.Vector3 v1, v2, v3
Global indx
Global mAngle.f = Cos(-0.05)
Global pAngle.f = Sin(0.05)
Global x.f = 0
Global y.f = 10
Global z.f = -30
Global Dim MeshData.PB_MeshVertex(0)
Enumeration
#mesh
#mat_plane
#plane
#entity
#LIGHT
#mainwin
#camera
EndEnumeration
Declare UpdateMatrix()
Declare CreateMatrix()
Declare DrawMatrix()
Global Quit.b = #False
ExamineDesktops()
If OpenWindow(#mainwin, 0, 0, DesktopWidth(0), DesktopHeight(0), "points in a cone ... twister / tornado", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
;Initialize environment
InitEngine3D()
InitSprite()
InitKeyboard()
OpenWindowedScreen(WindowID(#mainwin), 0, 0, DesktopWidth(0), DesktopHeight(0)-10, 0, 0, 0)
EnableWorldPhysics(#True)
EnableWorldCollisions(#True)
SetFrameRate(60)
Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Textures", #PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Models", #PB_3DArchive_FileSystem)
CreateMaterial(#mat_plane, LoadTexture(#mat_plane, "wood.jpg"))
;CreatePlane(#Mesh, TileSizeX, TileSizeZ, TileCountX, TileCountZ, TextureRepeatCountX, TextureRepeatCountZ)
CreatePlane(#plane, 20, 20, 1, 1, 1, 1)
CreateEntity (#plane, MeshID(#plane), MaterialID(#mat_plane))
MoveEntity(#plane,0,-22,-60)
CreateLight(0, RGB(255,255,255), 0, 0, 10)
CreateCamera(#camera, 0, 0, 100, 100)
MoveCamera(#camera, 0, 0, 10,#PB_Absolute)
;CameraFOV(#camera, 70)
;CameraLookAt(#camera, 0, 0, 0)
EndIf
CreateMatrix()
;Main loop
Repeat
Event = WindowEvent()
;RotateEntity(0, 0, 1, 0, #PB_Relative)
UpdateMatrix() ; procedure to move / extract/ rotate some points
RenderWorld()
FlipBuffers()
ExamineKeyboard()
If KeyboardReleased(#PB_Key_Escape)
Quit = #True
EndIf
Until Quit = #True Or Event = #PB_Event_CloseWindow
Procedure DrawMatrix()
For i=0 To 1000000
;throw points in a rectangular space
x.f = RandF(-50, 50): y.f = RandF(-50, 50): z.f = RandF(-50, 50)
;then we imagine a cone inside this space
;check if the point inside a specific horizontal cone cross section (circle at specific y position)
; the radius of the cone at the height y : radius = ConeBaseRadius * y/h
;radius = ConeBaseRadius * y/h
radius.f = 25 * y / 100 ; the radius of the cone cross secion at the height y
pointPos.f = Pow((Pow(x,2) + Pow(z,2)), 0.5)
If pointPos <= radius And pointPos >= radius-10 And y >= 48 ; just to color the cone base with Red
indx + 1
MeshVertexPosition(x, y, z)
MeshVertexColor(RGBA(255,0,0,255)) ; color as Red point
ElseIf pointPos < radius
indx + 1
r=0:g=255:b=0
MeshVertexPosition(x, y, z)
MeshVertexColor(RGBA(r,g,b,100))
EndIf
Next
Debug "number of points in the mesh = " + Str(indx)
EndProcedure
Procedure CreateMatrix()
CreateMaterial(0, LoadTexture(0, "White.jpg"))
DisableMaterialLighting(0, #True)
;MaterialCullingMode(0, #PB_Material_NoCulling)
CreateMesh(0, #PB_Mesh_PointList, #True)
DrawMatrix()
FinishMesh(#True)
SetMeshMaterial(0, MaterialID(0))
CreateEntity(0, MeshID(0), #PB_Material_None)
;ScaleEntity(0, 2, 2, 2)
MoveEntity(0, 0, -30, -60,#PB_Absolute)
GetMeshData(0,0, MeshData(), #PB_Mesh_Vertex ,0, MeshVertexCount(0)-1)
For c=0 To indx-1
x.f = MeshData(c)\x
z.f = MeshData(c)\z
pointPos.f = Pow((Pow(x,2) + Pow(z,2)), 0.5)
If pointPos <= 3
;collapse the points at the cone center to a one line
;MeshData(c)\x = 0 ; uncomment this and the collapse will be to one point
MeshData(c)\z = 0
MeshData(c)\y = 10
EndIf
Next
SetMeshData(#Mesh, 0, MeshData(), #PB_Mesh_Vertex, 0, MeshVertexCount(#Mesh)-1)
;ArrSize = ArraySize(MeshData())
;Debug ArrSize
;SortStructuredArray(MeshData(), #PB_Sort_Ascending , OffsetOf(PB_MeshVertex\y), TypeOf(PB_MeshVertex\y))
;SetMeshData(#mesh,0, MeshData(), #PB_Mesh_Vertex, 0, MeshVertexCount(#mesh,0)-1)
EndProcedure
Procedure UpdateMatrix()
angle.f = 0.05
For i=0 To indx-1
;x.f = MeshData(i)\x
;z.f = MeshData(i)\z
;MeshData(i)\x = mAngle * x - pAngle * z
;MeshData(i)\z = mAngle * z + pAngle * x
nx.f = Cos(-angle)*MeshData(i)\x - Sin(angle)*MeshData(i)\z
nz.f = Cos(-angle)*MeshData(i)\z + Sin(angle)*MeshData(i)\x
MeshData(i)\x = nx
MeshData(i)\z = nz
Next
SetMeshData(0,0, MeshData(), #PB_Mesh_Vertex, 0, MeshVertexCount(0)-1)
EndProcedure
