TMcube: Visual Basic Version
'*****************************************************************************
' *
' TMcube.frm *
' *
' This program draws a texture-mapped cube in 3D world space and allows the *
' user to move and rotate the cube through keyboard controls. A different *
' texture is applied to each cube face. Supports linear or perspective *
' texture mapping, z-buffering, and 3D clipping through the RENDER_STATE *
' symbol. *
' *
'*****************************************************************************
Const RENDER_STATE = FG_PERSPECTIVE_TM + FG_ZBUFFER + FG_ZCLIP
Const vbWidth = 640
Const vbHeight = 480
Const vbDepth = 16
Const tmWidth = 64
Private Type Point3D
X As Double
Y As Double
Z As Double
End Type
Option Base 1
Dim hPal As Long
Dim hVB As Long
Dim cxClient As Long, cyClient As Long
Dim hZB As Long
Dim hTM(6) As Long
Dim AppIsRunning As Boolean
Dim Redraw As Boolean
Dim xAngle As Long, yAngle As Long, zAngle As Long
Dim xWorld As Double, yWorld As Double, zWorld As Double
' six faces of a 40x40x40 cube, defined in object coordinates
Dim Faces(4, 6) As Point3D
' texture map array
Dim Texture(tmWidth * tmWidth * (vbDepth / 8), 6) As Byte
' coordinates defining source polygon vertices within the texture map array
Dim tmSource(8) As Long
Private Sub Form_Activate()
Call fg_realize(hPal)
Refresh
End Sub
Private Sub Form_Load()
Dim I As Long
ScaleMode = 3
Call fg_setdc(hDC)
hPal = fg_defpal()
Call fg_realize(hPal)
Call fg_vbinit
Call fg_vbdepth(vbDepth)
hVB = fg_vballoc(vbWidth, vbHeight)
Call fg_vbopen(hVB)
Call fg_vbcolors
hZB = fg_zballoc(vbWidth, vbHeight)
Call fg_zbopen(hZB)
' define 3D viewport, clipping planes, and initial render state
Call fg_3Dviewport(0, vbWidth - 1, 0, vbHeight - 1, 0.5)
Call fg_3Dsetzclip(40#, 1000#)
Call fg_3Drenderstate(RENDER_STATE)
' obtain the six texture maps from the CUBE.PCX file
Call fg_tminit(6)
Call fg_showpcx(App.Path & "\CUBE.PCX", FG_AT_XY + FG_KEEPCOLORS)
Call fg_move(0, tmWidth - 1)
For I = 1 To 6
#If vbDepth = 8 Then
Call fg_getimage(Texture(1, I), tmWidth, tmWidth)
Call fg_invert(Texture(1, I), tmWidth, tmWidth)
#Else
Call fg_getdcb(Texture(1, I), tmWidth, tmWidth)
Call fg_invdcb(Texture(1, I), tmWidth, tmWidth)
#End If
hTM(I) = fg_tmdefine(Texture(1, I), tmWidth, tmWidth)
Call fg_moverel(tmWidth, 0)
Next
xAngle = 0
yAngle = 0
zAngle = 0
xWorld = 0#
yWorld = 0#
zWorld = 100#
Redraw = True
Call fg_setcolor(-1)
Call fg_fillpage
Call InitGlobals
Visible = True
AppIsRunning = True
While AppIsRunning
DoEvents
Call CheckForMovement
Wend
End Sub
Private Sub Form_Paint()
Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
End Sub
Private Sub Form_Resize()
cxClient = ScaleWidth
cyClient = ScaleHeight
Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
AppIsRunning = False
Call fg_vbclose
Call fg_tmfree(-1)
Call fg_zbfree(hZB)
Call fg_vbfree(hVB)
Call fg_vbfin
End Sub
'*****************************************************************************
' *
' CheckForMovement() *
' *
' The CheckForMovement() function checks for key presses that control the *
' cube's movement, and if required redraws the cube at its new position and *
' orientation. It is called from the message loop in Form_Load(). *
' *
'*****************************************************************************
Private Sub CheckForMovement()
Dim ShiftKey As Boolean
' check if either shift key is pressed
ShiftKey = (fg_kbtest(42) = 1) Or (fg_kbtest(54) = 1)
' + and - move cube along the z axis (+ is toward viewer, - is
' away from viewer), restricting movement beyond z=40
If fg_kbtest(74) = 1 Then
zWorld = zWorld + 3#
Redraw = True
ElseIf fg_kbtest(78) = 1 Then
zWorld = zWorld - 3#
Redraw = True
' left and right arrow keys move cube along x axis
ElseIf fg_kbtest(75) = 1 Then
xWorld = xWorld - 3#
Redraw = True
ElseIf fg_kbtest(77) = 1 Then
xWorld = xWorld + 3#
Redraw = True
' up and down arrow keys move cube along y axis
ElseIf fg_kbtest(72) = 1 Then
yWorld = yWorld + 3#
Redraw = True
ElseIf fg_kbtest(80) = 1 Then
yWorld = yWorld - 3#
Redraw = True
' x rotates counterclockwise around x axis, X rotates clockwise
ElseIf fg_kbtest(45) = 1 Then
If ShiftKey Then
xAngle = xAngle + 6
If xAngle >= 360 Then xAngle = xAngle - 360
Else
xAngle = xAngle - 6
If xAngle < 0 Then xAngle = xAngle + 360
End If
Redraw = True
' y rotates counterclockwise around y axis, Y rotates clockwise
ElseIf fg_kbtest(21) = 1 Then
If ShiftKey Then
yAngle = yAngle + 6
If yAngle >= 360 Then yAngle = yAngle - 360
Else
yAngle = yAngle - 6
If yAngle < 0 Then yAngle = yAngle + 360
End If
Redraw = True
' z rotates counterclockwise around z axis, Z rotates clockwise
ElseIf fg_kbtest(44) = 1 Then
If ShiftKey Then
zAngle = zAngle + 6
If zAngle >= 360 Then zAngle = zAngle - 360
Else
zAngle = zAngle - 6
If zAngle < 0 Then zAngle = zAngle + 360
End If
Redraw = True
End If
' if the cube's position or orientation changed, redraw the cube
If Redraw Then
' prepare the z-buffer for the next frame
Call fg_zbframe
' erase the previous frame from the virtual buffer
Call fg_setcolor(-1)
Call fg_fillpage
' define the cube's new position and rotation in 3D world space
Call fg_3Dsetobject(xWorld, yWorld, zWorld, xAngle * 10, yAngle * 10, zAngle * 10)
' draw the cube
Call DrawCube
' display what we just drew
Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
Redraw = False
End If
End Sub
'*****************************************************************************
' *
' DrawCube() *
' *
' Draws each of the six cube faces in 3D world space. *
' *
'*****************************************************************************
Private Sub DrawCube()
Dim I As Long
For I = 1 To 6
Call fg_tmselect(hTM(I))
Call fg_3Dtexturemapobject(Faces(1, I).X, tmSource(1), 4)
Next
End Sub
'*****************************************************************************
' *
' InitGlobals() *
' *
' Initialize global variables and arrays. Called from Form_Load(). *
' *
'*****************************************************************************
Private Sub InitGlobals()
Faces(1, 1).X = 20#: Faces(1, 1).Y = -20#: Faces(1, 1).Z = -20#
Faces(2, 1).X = -20#: Faces(2, 1).Y = -20#: Faces(2, 1).Z = -20#
Faces(3, 1).X = -20#: Faces(3, 1).Y = 20#: Faces(3, 1).Z = -20#
Faces(4, 1).X = 20#: Faces(4, 1).Y = 20#: Faces(4, 1).Z = -20#
Faces(1, 2).X = -20#: Faces(1, 2).Y = -20#: Faces(1, 2).Z = -20#
Faces(2, 2).X = -20#: Faces(2, 2).Y = -20#: Faces(2, 2).Z = 20#
Faces(3, 2).X = -20#: Faces(3, 2).Y = 20#: Faces(3, 2).Z = 20#
Faces(4, 2).X = -20#: Faces(4, 2).Y = 20#: Faces(4, 2).Z = -20#
Faces(1, 3).X = 20#: Faces(1, 3).Y = 20#: Faces(1, 3).Z = 20#
Faces(2, 3).X = -20#: Faces(2, 3).Y = 20#: Faces(2, 3).Z = 20#
Faces(3, 3).X = -20#: Faces(3, 3).Y = -20#: Faces(3, 3).Z = 20#
Faces(4, 3).X = 20#: Faces(4, 3).Y = -20#: Faces(4, 3).Z = 20#
Faces(1, 4).X = 20#: Faces(1, 4).Y = -20#: Faces(1, 4).Z = 20#
Faces(2, 4).X = 20#: Faces(2, 4).Y = -20#: Faces(2, 4).Z = -20#
Faces(3, 4).X = 20#: Faces(3, 4).Y = 20#: Faces(3, 4).Z = -20#
Faces(4, 4).X = 20#: Faces(4, 4).Y = 20#: Faces(4, 4).Z = 20#
Faces(1, 5).X = 20#: Faces(1, 5).Y = -20#: Faces(1, 5).Z = 20#
Faces(2, 5).X = -20#: Faces(2, 5).Y = -20#: Faces(2, 5).Z = 20#
Faces(3, 5).X = -20#: Faces(3, 5).Y = -20#: Faces(3, 5).Z = -20#
Faces(4, 5).X = 20#: Faces(4, 5).Y = -20#: Faces(4, 5).Z = -20#
Faces(1, 6).X = 20#: Faces(1, 6).Y = 20#: Faces(1, 6).Z = -20#
Faces(2, 6).X = -20#: Faces(2, 6).Y = 20#: Faces(2, 6).Z = -20#
Faces(3, 6).X = -20#: Faces(3, 6).Y = 20#: Faces(3, 6).Z = 20#
Faces(4, 6).X = 20#: Faces(4, 6).Y = 20#: Faces(4, 6).Z = 20#
tmSource(1) = tmWidth - 1: tmSource(2) = tmWidth - 1
tmSource(3) = 0: tmSource(4) = tmWidth - 1
tmSource(5) = 0: tmSource(6) = 0
tmSource(7) = tmWidth - 1: tmSource(8) = 0
End Sub
|