Uses
"UI"
,
"TBGL"
#Include "%app_includepath%\thinbasic_gl.inc"
#Include "%app_includepath%\thinbasic_glu.inc"
TBGL_BackColor
255,255,255
Type
Point3D
x
As
Single
y
As
Single
z
As
Single
red
As
Single
green
As
Single
blue
As
Single
End
Type
Global
indexSize
As
DWord
Dim
Nb
As
DWord
=100
Dim
Vertex(Nb,Nb)
As
Point3D
Dim
indices(2 * Nb * Nb * 2)
As
DWord
BuildScene()
Begin
ControlID
%lCanvas
%bClose
%myTimer
End
ControlID
Begin
Const
%MAIN_WIDTH = 640
%MAIN_HEIGHT = 480
%timeOut = 20
End
Const
Function
TBMain
()
Global
hDlg
As
DWord
Global
sheep
As
Long
Global
hCtrl
As
DWord
Global
x, y
As
DWord
Dialog
New
Pixels
, 0,
"Use arrow keys - Pg U/D - LORENZ PEARLS"
,-1,-1, %MAIN_WIDTH, %MAIN_HEIGHT, _
%
WS_POPUP
Or
%
WS_VISIBLE
Or
_
%
WS_CLIPCHILDREN
Or
%
WS_CAPTION
Or
_
%
WS_SYSMENU
Or
%
WS_MINIMIZEBOX
Or
%WS_MAXIMIZEBOX
Or
%WS_THICKFRAME, 0
To
hDlg
Control
Add
Label
, hDlg, %lCanvas,
""
, 5, 5, %MAIN_WIDTH-10, %MAIN_HEIGHT-40
Control
Set
Color
hDlg, %lCanvas, %BLACK, %BLACK
Control
Set
Resize
hDlg, %lCanvas, 1, 1, 1, 1
Control
Add
Button
, hDlg, %bClose,
"Close"
, %MAIN_WIDTH-105, %MAIN_HEIGHT-30, 100, 25
Control
Set
Resize
hDlg, %bClose, 0, 1, 0, 1
Dialog
Set
Minsize
hDlg, 320, 230
Dialog
Show
Modeless
hDlg,
Call
dlgCallback
Do
Dialog
DoEvents
Dialog
Get
Size hDlg
To
x, x
RenderMyImage(hCtrl)
Loop
While
x
End
Function
CallBack
Function
dlgCallback()
Select
Case
CBMSG
Case
%
WM_INITDIALOG
Dialog
Set
Timer
CBHNDL
, %myTimer, %timeOut, %
NULL
Control
Handle
CBHNDL
, %lCanvas
To
hCtrl
TBGL_BindCanvas
(hCtrl)
Case
%WM_SIZE, %WM_SIZING
Case
%WM_TIMER
Case
%
WM_CLOSE
TBGL_ReleaseCanvas(hCtrl)
Dialog
Kill
Timer
CBHNDL
, %myTimer
Case
%
WM_COMMAND
Select
Case
CBCTL
Case
%bClose
If
CBCTLMSG
= %
BN_CLICKED
Then
Dialog
End
CBHNDL
End
Select
End
Select
End
Function
Function
RenderMyImage( hCtrl
As
DWord
)
Static
FrameRate
As
Double
If
TBGL_CanvasBound
(hCtrl)
Then
FrameRate =
TBGL_GetFrameRate
TBGL_SetWindowTitle
(hDlg,
"fps = "
&
Format
$(
Round
(FrameRate,0),
"00000"
))
TBGL_ClearFrame
TBGL_Camera
(0, 2, 4, 0, 0, 0)
glMatrixMode(%GL_PROJECTION)
glLoadIdentity()
gluPerspective(65.0, 800/600, 1.0, 100.0)
glMatrixMode(%GL_MODELVIEW)
glShadeModel(%GL_SMOOTH)
glEnable(%GL_DEPTH_TEST)
TBGL_Rotate
GetTickCount
/30,0,1,0
glClear(%GL_COLOR_BUFFER_BIT
Or
%GL_DEPTH_BUFFER_BIT)
glClearColor(1, 1, 1, 1)
glEnableClientState(%GL_VERTEX_ARRAY )
glEnableClientState(%GL_COLOR_ARRAY)
glVertexPointer(3, %GL_FLOAT,
SizeOf
(Point3D),
VarPtr
(Vertex(1,1)))
glColorPointer(3, %GL_FLOAT,
SizeOf
(Point3D),
VarPtr
(Vertex(1,1).red))
glDrawElements(%GL_LINES , CountOf(indices), %GL_UNSIGNED_INT,
VarPtr
(indices(1)))
glDisableClientState(%GL_VERTEX_ARRAY)
glDisableClientState(%GL_COLOR_ARRAY)
TBGL_DrawFrame
End
If
End
Function
Sub
BuildScene()
Dim
a,b
As
DWord
Dim
xMin, yMin, zMin, xMax, yMax, zMax, range, step1, x, y, z
As
Single
xMin = -2 : yMin = -2: zMin = -2: xMax = 2: yMax = 2: zMax = 2
range = xMax - xMin
step1 = range / Nb
x = xMin: z = zMin : y = yMin
For
b=1
To
Nb
For
a=1
To
Nb
y =
Cos
(x*x+z*z)
Vertex(a,b).x = x
Vertex(a,b).y = y
Vertex(a,b).z = z
If
y>=0
Then
Vertex(a,b).red = 1.0 :Vertex(a,b).green = 0.0 :Vertex(a,b).blue = 0
Else
Vertex(a,b).red = 0.0 :Vertex(a,b).green = 0.5 :Vertex(a,b).blue = 0.2
EndIf
If
y>=0.8
Then
Vertex(a,b).red = 0.0 :Vertex(a,b).green = 0.0 :Vertex(a,b).blue = 1
EndIf
x = x + step1
Next
a
x = xMin
z = z + step1
Next
b
Dim
i
As
DWord
= 1
Dim
yy,xx
As
DWord
For
yy = 1
To
Nb
For
xx = 1
To
Nb-1
indices(i) = (yy-1) * Nb + xx -1
i+1
indices(i) = (yy-1) * Nb + xx
i+1
Next
Next
For
xx = 1
To
Nb
For
yy = 1
To
Nb-1
indices(i) = (yy-1) * Nb + xx -1
i=i+1
indices(i) = (yy) * Nb + xx -1
i+1
Next
Next
End
Sub
Bookmarks