Tunnel: Visual Basic Version
'*****************************************************************************
' *
' Tunnel.frm *
' *
' This program draws a Gouraud-shaded tunnel and allows the viewer to move *
' through the tunnel using keyboard controls. *
' *
'*****************************************************************************
Const vbWidth = 640
Const vbHeight = 480
Private Type Point3D
X As Double
Y As Double
Z As Double
End Type
Dim hPal As Long
Dim hVB As Long
Dim cxClient As Long, cyClient As Long
Dim hZB As Long
Dim AppIsRunning As Boolean
Dim Redraw As Boolean
Option Base 1
' four sides of a 20x40x100 tunnel, defined in 3D world coordinates
Dim Faces(4, 4) As Point3D
' RGB color values at each vertex of each side
Dim FacesRGB(12, 4) As Byte
Private Sub Form_Activate()
Call fg_realize(hPal)
Refresh
End Sub
Private Sub Form_Load()
Dim vbDepth As Long
ScaleMode = 3
Call fg_setdc(hDC)
hPal = fg_defpal()
Call fg_realize(hPal)
Call fg_vbinit
vbDepth = fg_colors()
If vbDepth < 16 Then vbDepth = 16
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)
Call fg_setcolor(-1)
Call fg_fillpage
Call fg_3Dviewport(0, vbWidth - 1, 0, vbHeight - 1, 1#)
Call fg_3Drenderstate(FG_ZBUFFER + FG_ZCLIP)
Call fg_3Dlookat(0#, 10#, 50#, 0#, 10#, 100#)
Redraw = True
Call InitGlobals
Visible = True
AppIsRunning = True
While AppIsRunning
Call CheckForMovement
DoEvents
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_zbfree(hZB)
Call fg_vbfree(hVB)
Call fg_vbfin
End Sub
'*****************************************************************************
' *
' CheckForMovement() *
' *
' The CheckForMovement() function checks for key presses that control the *
' user's movement, and if required redraws the tunnel viewed from the new *
' camera position. It is called from the WinMain() message loop when there *
' are no messages waiting. *
' *
'*****************************************************************************
Private Sub CheckForMovement()
' up arrow moves viewer forward
If fg_kbtest(72) = 1 Then
Call fg_3Dmoveforward(2#)
Redraw = True
' down arrow moves viewer backward
ElseIf fg_kbtest(80) = 1 Then
Call fg_3Dmoveforward(-2#)
Redraw = True
' right arrow turns viewer to the right
ElseIf fg_kbtest(77) = 1 Then
Call fg_3Drotateright(6 * 10)
Redraw = True
' left arrow turns viewer to the left
ElseIf fg_kbtest(75) = 1 Then
Call fg_3Drotateright(-6 * 10)
Redraw = True
End If
' if the viewer's position or orientation changed, redraw the tunnel
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
' draw the cube
Call DrawTunnel
' 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
'*****************************************************************************
' *
' DrawTunnel() *
' *
' Draws each of the tunnel's four sides in 3D world space. *
' *
'*****************************************************************************
Private Sub DrawTunnel()
Dim I As Long
For I = 1 To 4
Call fg_3Dshade(Faces(1, I).X, FacesRGB(1, I), 4)
Next
End Sub
'*****************************************************************************
' *
' InitGlobals() *
' *
' Initialize global variables and arrays. Called from Form_Load(). *
' *
'*****************************************************************************
Private Sub InitGlobals()
' Floor
Faces(1, 1).X = -10#: Faces(1, 1).Y = 0#: Faces(1, 1).Z = 100#
Faces(2, 1).X = -10#: Faces(2, 1).Y = 0#: Faces(2, 1).Z = 200#
Faces(3, 1).X = 10#: Faces(3, 1).Y = 0#: Faces(3, 1).Z = 200#
Faces(4, 1).X = 10#: Faces(4, 1).Y = 0#: Faces(4, 1).Z = 100#
' West Side
Faces(1, 2).X = -10#: Faces(1, 2).Y = 0#: Faces(1, 2).Z = 100#
Faces(2, 2).X = -10#: Faces(2, 2).Y = 40#: Faces(2, 2).Z = 100#
Faces(3, 2).X = -10#: Faces(3, 2).Y = 40#: Faces(3, 2).Z = 200#
Faces(4, 2).X = -10#: Faces(4, 2).Y = 0#: Faces(4, 2).Z = 200#
' East Side
Faces(1, 3).X = 10#: Faces(1, 3).Y = 0#: Faces(1, 3).Z = 100#
Faces(2, 3).X = 10#: Faces(2, 3).Y = 0#: Faces(2, 3).Z = 200#
Faces(3, 3).X = 10#: Faces(3, 3).Y = 40#: Faces(3, 3).Z = 200#
Faces(4, 3).X = 10#: Faces(4, 3).Y = 40#: Faces(4, 3).Z = 100#
' Ceiling
Faces(1, 4).X = -10#: Faces(1, 4).Y = 40#: Faces(1, 4).Z = 100#
Faces(2, 4).X = 10#: Faces(2, 4).Y = 40#: Faces(2, 4).Z = 100#
Faces(3, 4).X = 10#: Faces(3, 4).Y = 40#: Faces(3, 4).Z = 200#
Faces(4, 4).X = -10#: Faces(4, 4).Y = 40#: Faces(4, 4).Z = 200#
' Floor RGB
FacesRGB(1, 1) = 192: FacesRGB(2, 1) = 192: FacesRGB(3, 1) = 192
FacesRGB(4, 1) = 64: FacesRGB(5, 1) = 64: FacesRGB(6, 1) = 64
FacesRGB(7, 1) = 64: FacesRGB(8, 1) = 64: FacesRGB(9, 1) = 64
FacesRGB(10, 1) = 192: FacesRGB(11, 1) = 192: FacesRGB(12, 1) = 192
' West Side RGB
FacesRGB(1, 2) = 32: FacesRGB(2, 2) = 32: FacesRGB(3, 2) = 255
FacesRGB(4, 2) = 32: FacesRGB(5, 2) = 32: FacesRGB(6, 2) = 255
FacesRGB(7, 2) = 32: FacesRGB(8, 2) = 32: FacesRGB(9, 2) = 96
FacesRGB(10, 2) = 32: FacesRGB(11, 2) = 32: FacesRGB(12, 2) = 96
' East Side RGB
FacesRGB(1, 3) = 32: FacesRGB(2, 3) = 32: FacesRGB(3, 3) = 255
FacesRGB(4, 3) = 32: FacesRGB(5, 3) = 32: FacesRGB(6, 3) = 96
FacesRGB(7, 3) = 32: FacesRGB(8, 3) = 32: FacesRGB(9, 3) = 96
FacesRGB(10, 3) = 32: FacesRGB(11, 3) = 32: FacesRGB(12, 3) = 255
' Ceiling RGB
FacesRGB(1, 4) = 192: FacesRGB(2, 4) = 192: FacesRGB(3, 4) = 192
FacesRGB(4, 4) = 192: FacesRGB(5, 4) = 192: FacesRGB(6, 4) = 192
FacesRGB(7, 4) = 64: FacesRGB(8, 4) = 64: FacesRGB(9, 4) = 64
FacesRGB(10, 4) = 64: FacesRGB(11, 4) = 64: FacesRGB(12, 4) = 64
End Sub
|