'---Script created on 12-20-2019 14:23:57 by
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 ' number of vertexes at each Horzontal line and Vertical line
Dim Vertex(Nb,Nb) As Point3D
Dim indices(2 * Nb * Nb * 2) As DWord ' Can be also specified as UInt32
' fill the arrays with data
BuildScene()
' -- ID numbers of controls
Begin ControlID
%lCanvas
%bClose
%myTimer
End ControlID
Begin Const
%MAIN_WIDTH = 640
%MAIN_HEIGHT = 480
%timeOut = 20 ' -- Determines graphics refresh rate in milliseconds
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
' -- Place controls here
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
Dialog Set Timer CBHNDL, %myTimer, %timeOut, %NULL
Control Handle CBHNDL, %lCanvas To hCtrl
' Control Handle CBHNDL, %lCanvas To htest
' -- Init OpenGL
TBGL_BindCanvas(hCtrl)
Case %WM_SIZE, %WM_SIZING
'TBGL_UpdateCanvasProportions(hCtrl)
'RenderMyImage(hCtrl)
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
'TBGL_BackColor 255,255,255
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)
' -- Turn triangle
glMatrixMode(%GL_PROJECTION)
glLoadIdentity()
gluPerspective(65.0, 800/600, 1.0, 100.0)
glMatrixMode(%GL_MODELVIEW)
'glTranslatef(0, 1, -10)
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_POINTS, CountOf(indices), %GL_UNSIGNED_INT, VarPtr(indices(1)))
glDrawElements(%GL_LINES , CountOf(indices), %GL_UNSIGNED_INT, VarPtr(indices(1)))
glDisableClientState(%GL_VERTEX_ARRAY)
glDisableClientState(%GL_COLOR_ARRAY)
' -- ESCAPE key to exit application
'If TBGL_GetWindowKeyState(hDlg, %VK_ESCAPE) Then Exit While
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
'xMin = -0.5 : zMin = -0.5 : xMax = 0.5: zMax = 0.5
range = xMax - xMin
step1 = range / Nb
x = xMin: z = zMin : y = yMin
For b=1 To Nb
For a=1 To Nb
'y = Sin(10*(x^2+z^2))/10
y = Cos(x*x+z*z)
'y = 0
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
'Grid Horizontal lines
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
'Grid vertical lines
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
Reply With Quote
Originally Posted by primo
TBGL_GetFrameRate moving average
Bookmarks