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

<< Prev

Next >>

Contents
Fastgraph Home Page

 

copyright 2001 Ted Gruber Software, Inc.