Uses "Console", "TBGL", "Math"
Type Quat ' Quaternion
t As String*4 ' "Quat" typecheck
W As Double ' cos of Angle/2
X As Double ' x
Y As Double ' y
Z As Double ' z
End Type
Global hWnd As Long
Global gdx, gdy, gdz As Single ' rotation deltas (2 routines)
'TBGLMain()
'PrintL "End": Beep
'WaitKey
'End
'Sub TBGLMain()
hWnd = TBGL_CreateWindowEx( _
"Arrow keys, PgUp, PgDn to rotate; Numpad 246789 to move camera; ESC to quit", _
800, 400, 32, %TBGL_WS_WINDOWED Or %TBGL_WS_CLOSEBOX)
Local hFont As Long = TBGL_FontHandle("Courier New", 9)
TBGL_BuildFont(hFont) ' for print
TBGL_ShowWindow
TBGL_ResetKeyState()
'----This does the loop
TBGL_BindPeriodicFunction( hWnd, "TBGLLoop", 10 )
TBGL_ProcessPeriodicFunction(hWnd)
'----End TBGL loop
TBGL_DestroyWindow
'End Sub
Sub TBGLLoop()
Static Sw1, cx, cy, cz As Single ' camera pos
If Sw1 = 0 Then ' set static vars
Sw1 = 1
cx = 0: cy = 0: cz = 6 ' camera pos
End If
TBGL_ClearFrame
' camera can be moved
If TBGL_GetWindowKeyState( hWnd, %VK_NUMPAD6) Then cx += .05
If TBGL_GetWindowKeyState( hWnd, %VK_NUMPAD4) Then cx -= .05
If TBGL_GetWindowKeyState( hWnd, %VK_Numpad8) Then cy += .05
If TBGL_GetWindowKeyState( hWnd, %VK_NUMPAD2) Then cy -= .05
If TBGL_GetWindowKeyState( hWnd, %VK_NUMPAD9) Then cz += .05
If TBGL_GetWindowKeyState( hWnd, %VK_NUMPAD7) Then cz -= .05
TBGL_Camera cx, cy, cz, cx, cy, 0 ' look in -z direction
' these value are used in both routines, so gdxyz have to be global
gdx = 0: gdy = 0: gdz = 0
If TBGL_GetWindowKeyState( hWnd, %VK_DOWN) Then gdx = +1
If TBGL_GetWindowKeyState( hWnd, %VK_UP) Then gdx = -1
If TBGL_GetWindowKeyState( hWnd, %VK_RIGHT) Then gdy = +1
If TBGL_GetWindowKeyState( hWnd, %VK_LEFT) Then gdy = -1
If TBGL_GetWindowKeyState( hWnd, %VK_PGUP) Then gdz = +1
If TBGL_GetWindowKeyState( hWnd, %VK_PGDN) Then gdz = -1
TBGL_PushMatrix
TBGL_Translate -2,0,0 ' left side - simple x, y, z rotation
TBGL_Rotate 18.435,0,1,0 ' face camera
PreRotation() ' fixed items
DoRotationLeft() ' do the rotation
PostRotation() ' rotating items
TBGL_PopMatrix
TBGL_PushMatrix
TBGL_Translate +2,0,0 ' right side - quaternion rotation
TBGL_Rotate -18.435,0,1,0 ' face camera
PreRotation() ' fixed items
DoRotationRight() ' do the rotation
PostRotation() ' rotating items
TBGL_PopMatrix
TBGL_DrawFrame
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then TBGL_UnBindPeriodicFunction( hWnd )
End Sub
Sub PreRotation() ' plot the fixed axes
TBGL_Color 255,160,255 ' x-axis cyan
PlotLine(0,0,0, 1.25,0,0)
PlotCylinder(1.25,0,0, 1,0,0, .05,.01,.5)
TBGL_Color 255,255,160 ' y-axis yellow
PlotLine(0,0,0, 0,1.25,0)
PlotCylinder(0,1.25,0, 0,1,0, .05,.01,.5)
TBGL_Color 160,255,255 ' z-axis magenta
PlotLine(0,0,0, 0,0,1.25)
PlotCylinder(0,0,1.25, 0,0,1, .05,.01,.5)
End Sub
Sub PostRotation() ' plot the rotating axes
TBGL_Color 255,0,255 ' x-axis cyan
PlotCylinder(-1,0,0, 1,0,0, .05,.01,2.)
TBGL_Color 255,255,0 ' y-axis yellow
PlotCylinder(0,-1,0, 0,1,0, .05,.01,2.)
TBGL_Color 0,255,255 ' z-axis magenta
PlotCylinder(0,0,-1, 0,0,1, .05,.01,2.)
End Sub
Sub DoRotationLeft() ' simple rotation in x, y, z
Static AngleX, AngleY, AngleZ As Integer
AngleX = Mod(AngleX + gdx + 360, 360) ' change angles
AngleY = Mod(AngleY + gdy + 360, 360)
AngleZ = Mod(AngleZ + gdz + 360, 360)
TBGL_Rotate AngleX, 1, 0, 0
TBGL_Rotate AngleY, 0, 1, 0
TBGL_Rotate AngleZ, 0, 0, 1
End Sub
Sub DoRotationRight() ' better? using quaternions
Static Sw1 As Integer, QMain, QRotX, QRotY, QRotZ As Quat
Local Cosa, Sina, Ang As Double
If Sw1 = 0 Then ' set up static variables
Sw1 = 1
Cosa = Cos(Pi/360.): Sina = Sin(Pi/360.) ' half-angles
QMain = QLoadWXYZ(1, 0, 0, 0)
QRotX = QLoadWXYZ(Cosa, Sina, 0, 0)
QRotY = QLoadWXYZ(Cosa, 0, Sina, 0)
QRotZ = QLoadWXYZ(Cosa, 0, 0, Sina)
End If
If gdx <> 0 Then QMain = QMult(QRotX, QMain, gdx) ' sign only
If gdy <> 0 Then QMain = QMult(QRotY, QMain, gdy)
If gdz <> 0 Then QMain = QMult(QRotZ, QMain, gdz)
Ang = ATAN2(Sqr(1.-QMain.W^2), QMain.W) * 2
TBGL_Rotate Ang, QMain.X, QMain.Y, QMain.Z
End Sub
Function QLoadWXYZ(qW As Double, qX As Double, qY As Double, qZ As Double) As String
Local q As Quat
q.t = "Quat" ' for typecheck
q.W = qW: q.X = qX: q.Y = qY: q.Z = qZ
Function = q
End Function
Function QMult(sq1 As String, sq2 As String, iSign As Integer) As String ' quaternion multiplication
' q1 and q2 had better be type "Quat"s
Local q, q1, q2 As Quat
q.t = "Quat": q1 = sq1: q2 = sq2
If q1.t <> "Quat" Then MsgBox 0, "TypeErr QM1": Stop
If q2.t <> "Quat" Then MsgBox 0, "TypeErr QM2": Stop
q.W = q1.W*q2.W - (q1.X*q2.X + q1.Y*q2.Y + q1.Z*q2.Z) * iSign
q.X = q1.W*q2.X + (q1.X*q2.W + q1.Y*q2.Z - q1.Z*q2.Y) * iSign
q.Y = q1.W*q2.Y + (q1.Y*q2.W + q1.Z*q2.X - q1.X*q2.Z) * iSign
q.Z = q1.W*q2.Z + (q1.Z*q2.W + q1.X*q2.Y - q1.Y*q2.X) * iSign
Function = q
End Function
Sub PlotLine(x1 As Single, y1 As Single, z1 As Single, _
Optional x2 As Single = -999, y2 As Single, z2 As Single)
Static x3, y3, z3 As Single
TBGL_BeginPoly %GL_LINES
If x2 = -999 Then
TBGL_Vertex x3, y3, z3
TBGL_Vertex x1, y1, z1
x3 = x1: y3 = y1: z3 = z1
Else
TBGL_Vertex x1, y1, z1
TBGL_Vertex x2, y2, z2
x3 = x2: y3 = y2: z3 = z2
End If
TBGL_EndPoly
End Sub
Sub PlotCylinder(x As Double, y As Double, z As Double, _
vx As Double, vy As Double, vz As Double, _
r1 As Double, r2 As Double, h As Double)
' x, y, z is bottom of cyl
' vx, vy, vz is direction of cyl
' r1 is bottom radius, r2 is top
' h is height
Local Ang As Double
TBGL_PushMatrix
TBGL_Translate x, y, z ' to bottom
Ang = ATAN2(vx, vz) ' rotate (y) into yz plane
TBGL_Rotate Ang, 0, 1, 0
Ang = ATAN2(Sqr(vx^2+vz^2), vy)
TBGL_Rotate Ang, 1, 0, 0 ' rotate (x) into z axis
TBGL_Cylinder r1, r2, h
TBGL_PopMatrix
End Sub
Bookmarks