TBGL Whatsit

[dcromley]

This came about while working with TBGL rotations. I wish I could say what it represents, but I don't know. But I was impressed:

o) It is beautiful.
o) It shows how motion can make a bunch of 2D points become 3D.
o) It shows "rotation from keyboard" routines.
o) It shows the speed of TB/TBGL.

As the caption says, use
o) Arrow keys, PgUp, PgDn to rotate.
o) A, Z to move the slider.
o) G to switch grid.
o) ESC to exit.

Enjoy



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 kThing as single: kThing = .4
global hWnd as long, gc(1000) as integer
global gh(1000), gi(1000), gj(1000), gk(1000), gg(1000) as single
global gw(1000), gx(1000), gy(1000), gz(1000), gv(1000) as single
'----TBGL loop
hWnd = TBGL_CREATEWINDOWEX( _
"Arrow keys, PgUp, PgDn to rotate; A, Z for slider; G for grid; ESC to quit", _
1024, 738, 32, %TBGL_WS_WINDOWED or %TBGL_WS_CLOSEBOX)
local hFont AS DWORD = TBGL_FontHandle("Courier New", 9)
TBGL_BuildFont(hFont) ' for print
TBGL_ShowWindow
TBGL_ResetKeyState()
Populate1() ' get random points
'----This is it
TBGL_BindPeriodicFunction( hWnd, "TBGLLoop", 33)
TBGL_ProcessPeriodicFunction(hWnd)
'----End TBGL loop
TBGL_DestroyWindow
Printl "End": beep
waitkey

sub TBGLLoop()
if not TBGL_IsWindow(hWnd) then exit sub' ---------------------------loop
tbgl_ClearFrame
TBGL_Camera 0,0,15, 0,0,0
PreRotation() ' fixed items
DoRotation() ' do the rotation
PostRotation() ' rotating items
tbgl_DrawFrame
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then TBGL_UnBindPeriodicFunction( hWnd )
End Sub

Sub PreRotation()
PlotSlider1() '
End Sub

Sub DoRotation() ' using quaternions
Static Sw1 as integer, QMain, QRotX, QRotY, QRotZ as Quat
local Cosa, Sina, Ang as single
local dx, dy, dz as integer ' rotation deltas
IF TBGL_GetWindowKeyState( hWnd, %VK_Down) Then dx = +1 ' sign only
IF TBGL_GetWindowKeyState( hWnd, %VK_Up) Then dx = -1
IF TBGL_GetWindowKeyState( hWnd, %VK_Right) Then dy = +1
IF TBGL_GetWindowKeyState( hWnd, %VK_Left) Then dy = -1
IF TBGL_GetWindowKeyState( hWnd, %VK_PgUp) Then dz = +1
IF TBGL_GetWindowKeyState( hWnd, %VK_PgDn) Then dz = -1
if Sw1 = 0 then ' set up static variables
Sw1 = 1
Cosa = cos(pi/360.): Sina = sin(pi/360.) '
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 dx <> 0 then QMain = QMult(QRotX, QMain, dx)
if dy <> 0 then QMain = QMult(QRotY, QMain, dy)
if dz <> 0 then QMain = QMult(QRotZ, QMain, dz)
Ang = atan2(sqr(1.-QMain.W^2), QMain.W) * 2
TBGL_Rotate Ang, QMain.X, QMain.Y, QMain.Z
End Sub

Sub PostRotation()
static gridsw as integer
local i1000 as integer
IF TBGL_GetWindowKeyOnce(hWnd, %VK_g) Then gridsw = 1-gridsw
if gridsw then PlotGridXZ(0, -2, 6, 8, -2, 6, 8): PlotGridY(-4,4,8)
for i1000 = 1 to 1000
if gc(i1000) then
TBGL_Color 255,000,000
else
TBGL_Color 000,255,000
end if
PlotPoint(gx(i1000), gw(i1000), gz(i1000))
next i
end Sub

Sub PlotGridXZ(y0 as single, xlo as single, xhi as single, xn as integer, zlo as single, zhi as single, zn as integer)
local i as integer, x, y, z as single
for i = 0 to xn
x = LinInterp(xlo, xhi, i, 0, xn)
if abs(x) < .0001 then
TBGL_Color 128,000,128 ' x-axis magenta
else
TBGL_Color 064,064,064
end if
Plotline(x, y0, zlo, x, y0, zhi)
next i
for i = 0 to zn
z = LinInterp(zlo, zhi, i, 0, zn)
if abs(z) < .0001 then
TBGL_Color 000,128,128 ' z-axis magenta
else
TBGL_Color 064,064,064
end if
Plotline(xlo, y0, z, xhi, y0, z)
next i
End Sub

Sub PlotGridY(ylo as single, yhi as single, yn as integer)
local i as integer, x, y, z as single
TBGL_Color 128,128,000 ' y-axis yellow
PlotLine(0,ylo,0, 0,yhi,0)
TBGL_Pointsize 3
for i = 0 to yn
y = LinInterp(ylo, yhi, i, 0, yn)
PlotPoint(0,y,0)
next i
TBGL_Pointsize 1
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
if abs(iSign) <> 1 then msgbox 0, "iSign must be 1 or -1": 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 PlotPoint(x1 as single, y1 as single, z1 as single)
TBGL_BEGINPOLY %GL_points
TBGL_VERTEX x1, y1, z1
TBGL_ENDPOLY
End Sub

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 PlotSlider1()
local swDo as integer
' hard coded stuff
IF TBGL_GetWindowKeyState( hWnd, %VK_A) Then kThing += .01: swDo = 1
IF TBGL_GetWindowKeyState( hWnd, %VK_Z) Then kThing -= .01: swDo = 1
if kThing < -1 then kThing = -1
if kThing > 1 then kThing = 1
if swDo then Populate2()
TBGL_Color 255,255,255
PlotLine(-6.0,-3.0,0, -6.0,3.0,0)
TBGL_PointSize 5
PlotPoint(-6, LinInterp(-2.9,2.9, kThing,-1,1), 0)
TBGL_PointSize 1
End Sub

Function LinInterp(ylo as single, yhi as single, x as single, xlo as single, xhi as single) as single
Function = (ylo * (xhi - x) + yhi * (x - xlo)) / (xhi - xlo) ' what's a function for?
End Function

Sub Populate1() ' get the 4000 random numbers
local i1000 as integer
For i1000 = 1 To 1000
' get random points
gh(i1000) = -1 + 2 * Rnd
gi(i1000) = -1 + 2 * Rnd
gj(i1000) = -1 + 2 * Rnd
gk(i1000) = -1 + 2 * Rnd
next i1000
Populate2()
End Sub

Sub Populate2() ' process the 1000 points
local i1000 as integer
local w, x, y, z, v, d, a, b, c, kfac as single
local m11,m12,m13,m21,m22,m23,m31,m32,m33 as single
For i1000 = 1 To 1000
' make a quaternion
w = gh(i1000): x = gi(i1000): y = gj(i1000): z = gk(i1000)
v = sqr(w^2+x^2+y^2+z^2)
kfac = Sqr((1 - kThing ^ 2) / (w ^ 2 + x ^ 2 + z ^ 2))
w = w * kfac
x = x * kfac
y = kThing
z = z * kfac
' matrix from quaternion
m11 = w*w + x*x - y*y - z*z
m22 = w*w - x*x + y*y - z*z
m33 = w*w - x*x - y*y + z*z
m23 = 2*w*x + 2*y*z
m32 = -2*w*x + 2*y*z
m31 = 2*w*y + 2*z*x
m13 = -2*w*y + 2*z*x
m12 = 2*w*z + 2*x*y
m21 = -2*w*z + 2*x*y
' kquaternion from matrix
d = 1 - m11 - m22 - m33
c = m23 + m31 + m12
b = m32 + m13 + m21
a = b + c + d
w = c - b
x = a + 2*m11 - m23 - m32
y = a + 2*m22 - m31 - m13
z = a + 2*m33 - m12 - m21
v = sqr(w^2+x^2+y^2+z^2)
'-- it's the kquaternion we're looking at
gw(i1000) = w: gx(i1000) = x: gy(i1000) = y: gz(i1000) = z: gv(i1000) = v
gc(i1000) = iif(y < 0, 1, 0) ' color
' quaternion from kquaternion
' w /= v: x /= v: y /= v: z /= v
' v = sqr(w^2+x^2+y^2+z^2)
Next i1000
End Sub

[dcromley]

Darnit, got a mistake already :(

Change 6th line from bottom:


' change
gc(i1000) = iif(y < 0, 1, 0) ' color
' to
gc(i1000) = iif(y*kThing < 0, 1, 0) ' color

[ErosOlmi]

I know what it is: a black and white hole inflation/deflation :D

Very nice !

[Petr Schreiber]

Very nice,

reminds me of Death Star from Star Wars :)

One little hint:


-1 + 2 * Rnd


This is perfectly valid, but you can use alternative syntax:


RNDf(-1, 1)


It will generate random floating point numbers from -1 to 1. The "f" is here for "floating point".

For integer random numbers you can use:


RND(-1,1)


This would generate -1, 0 or 1.


Thanks,
Petr

[Lionheart008]

hi dcromley :)

very, very nice example, good work! Go on for further and more interesting tbgl stuff...
by the way: do you know perry rhodan ??? ;) the example remembers me to one of his old enemies (particle clouds or intelligence with psi power) I like it, thanks! ... :D

best wishes, Lionheart