Uses "TBGL"
'Uses "math"
Type Point3D
x As Single
y As Single
z As Single
End Type
Type Colr
r As Byte
g As Byte
b As Byte
End Type
Function TBMain()
Local hWnd As DWord
Local FrameRate As Double
Local i as long
' -- Create and show window
hWnd = TBGL_CreateWindowEx("Plotting 3D Data in an array using GBuffers- Calculate with freebasic..Esc to quit", 600, 600, 32, %TBGL_WS_WINDOWED Or %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow
TBGL_BackColor 255,255,255
'TBGL_SetDrawDistance 250
' -- Create 3D points buffer
DWord gbPoints = TBGL_GBufferCreate(%TBGL_POINTS, %TBGL_3D)
Global Nb As DWord = 150
' -- Define data for it
dim VertexA(Nb^3) As Point3D ' single
dim ColorA(Nb^3) As Colr ' Byte
'dim VertexA(Nb) As TBGL_TVECTOR3F
'dim ColorA(Nb) As TBGL_TRGB
'call freeBasic to fill the arrays with data
FB_Array_Of_Point3D(VertexA(1), ColorA(1))
' -- Create buffer dynamically linked to the arrays above
TBGL_GBufferDefineFromArray(gbPoints, %TBGL_DYNAMIC, CountOf(VertexA), VertexA(1), ColorA(1))
' -- Resets status of all keys
TBGL_ResetKeyState()
TBGL_PointSize 2
' -- Main loop
While TBGL_IsWindow(hWnd)
'init
FrameRate = TBGL_GetFrameRate
TBGL_ClearFrame
TBGL_Camera(0, 5, 10, 0, 0, 0)
' -- Turn triangle
TBGL_Rotate GetTickCount/50, 0, 1, 0
'TBGL_Scale 0.6, 0.6, 0.6
' -- Render it
TBGL_GBufferRender(gbPoints)
TBGL_DrawFrame
' -- ESCAPE key to exit application
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then Exit While
Wend
' -- Destroying the buffer is not necessary,
' -- the garbage collector will take care of it
' -- Destroy window
TBGL_DestroyWindow
End Function
#compiled "===Passing array of UDT==="
Type Point3D
x As Single
y As Single
z As Single
End Type
Type Colr
r As Byte
g As Byte
b As Byte
End Type
function FB_Array_Of_Point3D Cdecl (byref pPoint3D as Point3D, byref pColr as Colr) As long Export
' passing a Double ByRef means passing a pointer to the memory location where the first Double is allocated
'----------------------------------------------------------------------------
Dim pArray As Point3D Ptr
Dim pArrayColor As Colr Ptr
dim N as Long
'"We are now inside FreeBasic function"
'---Get pointer to the first element of the array
pArray = @pPoint3D
pArrayColor = @pColr
dim as single x, y, z, k, t, Pi, xMin, yMin, zMin, xMax, yMax, zMax, range, step1
dim as byte rd, gr, bl
dim as long a, b, c
Pi = 3.141592
xMin = -2 : yMin = -2: zMin = -2 : xMax = 2: yMax = 2 : zMax = 2
'xMin = -3 : yMin = -3: zMin = -3 : xMax = 3: yMax = 3 : zMax = 3
'xMin = -5 : yMin = -5: zMin = -5 : xMax = 5: yMax = 5 : zMax = 5
'xMin = -1.5 : yMin = -1.5: zMin = -1.5 : xMax = 1.5: yMax = 1.5 : zMax = 1.5
'xMin = -1.0 : yMin = -1.0: zMin = -1.0 : xMax = 1.0: yMax = 1.0 : zMax = 1.0
range = xMax - xMin
step1 = range /150
x = xMin: z = zMin : y = yMin
For c = 0 To 150
rd = rnd*255: gr = rnd*255: bl = rnd*255
For b=0 To 150
For a=0 To 150
'k = 320*(((x*x + (9*y*y)/4 +z*z -1)^3) - x*x*z*z*z - (9*y*y*z*z*z)/80) 'Heart
k = x^4 + y^4 + z^4 - (x*x + y*y + z*z)^2 + 3 * (x*x + y*y + z*z)
'k = Sin(x*y)+Sin(y*z)+Sin(z*x)
'k = x^2 + y^2 - z^2 -1
'k = -y +0.7/Log(x^2+z^2)+.6 'dome
'k = x^6 - 5* x^4* y* z + 3* x^4* y^2 + 10* x^2* y^3* z + 3* x^2* y^4 - y^5* z + y^6 + z^6 - 1
'k = x^6 - 5* x^4* y* z + 3* x^4* y^2 + 10* x^2* y^3* z + 3* x^2* y^4 - y^5* z + y^6 + z^6 - 1
'k = 4* z^4 + 9*(x^2 + y^2 - 4*z^2)-1 'Eight Solid
'k = x^2 + y^2 +z^2 'sphere
'If k <= 0.05 And k >= -0.05 Then
'If k <= 0.01 And k >= -0.01 Then
'If k <= 0.1 And k >= -0.1 Then
'If k <= 0.2 And k >= -0.2 Then
If k <= 1 And k >= -1 Then
N = N + 1
*(pArray + N).x = x
*(pArray + N).y = y
*(pArray + N).z = z
*(pArrayColor + N).r = rd
*(pArrayColor + N).g = gr
*(pArrayColor + N).b = bl
End If
x = x + step1
Next a
x = xMin
z = z + step1
Next b
x = xMin
z = zMin
y = y + step1
Next c
return 0
end Function
#endcompiled
Bookmarks