home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Game Programming for Teens / VBGPFT.cdr / sources / chapter14 / CollisionTest / Game.bas < prev    next >
Encoding:
BASIC Source File  |  2004-11-11  |  8.5 KB  |  323 lines
  1. Attribute VB_Name = "Game"
  2. '---------------------------------------------------------------
  3. ' Visual Basic Game Programming for Teens
  4. ' Chapter 12 - WalkAbout program
  5. '
  6. ' Requires the following files:
  7. '   Direct3D.bas, DirectInput.bas, Globals.bas, TileScroller.bas,
  8. '   Sprite.bas, and an empty Form1.
  9. '---------------------------------------------------------------
  10.  
  11. Option Explicit
  12. Option Base 0
  13.  
  14. Const HEROSPEED As Integer = 4
  15. Dim heroSpr As TSPRITE
  16. Dim heroImg As Direct3DTexture8
  17. Dim SuperHero As Boolean
  18.  
  19. Dim fontImg As Direct3DTexture8
  20. Dim fontSpr As TSPRITE
  21.  
  22. Dim wood As Direct3DSurface8
  23.  
  24. Dim badtiles() As Integer
  25.  
  26.  
  27. Const C_PURPLE As Long = &HFFFF00FF
  28. Const C_RED As Long = &HFFFF0000
  29. Const C_GREEN As Long = &HFF00FF00
  30. Const C_BLUE As Long = &HFF0000FF
  31. Const C_WHITE As Long = &HFFFFFFFF
  32. Const C_BLACK As Long = &H0
  33. Const C_GRAY As Long = &HFFAAAAAA
  34.  
  35.  
  36. Dim frm As New Form1
  37.  
  38. Public Sub Main()
  39.     
  40.     'set up the main form
  41.     frm.Caption = "CollisionTest"
  42.     frm.AutoRedraw = False
  43.     frm.BorderStyle = 1
  44.     frm.ClipControls = False
  45.     frm.ScaleMode = 3
  46.     frm.width = Screen.TwipsPerPixelX * (SCREENWIDTH + 12)
  47.     frm.height = Screen.TwipsPerPixelY * (SCREENHEIGHT + 30)
  48.     frm.Show
  49.     
  50.     'initialize Direct3D
  51.     InitDirect3D frm.hwnd
  52.     
  53.     InitDirectInput
  54.     InitKeyboard frm.hwnd
  55.     
  56.     'get reference to the back buffer
  57.     Set backbuffer = d3ddev.GetBackBuffer(0, D3DBACKBUFFER_TYPE_MONO)
  58.     
  59.     'create the font
  60.     Set fontImg = LoadTexture(d3ddev, App.Path & "\font.bmp")
  61.     InitSprite d3ddev, fontSpr
  62.     fontSpr.FramesPerRow = 20
  63.     fontSpr.width = 8
  64.     fontSpr.height = 12
  65.     fontSpr.ScaleFactor = 1
  66.     
  67.     'clear the screen to black
  68.     d3ddev.Clear 0, ByVal 0, D3DCLEAR_TARGET, C_BLACK, 1, 0
  69.  
  70.     'display a startup message
  71.     d3ddev.BeginScene
  72.     PrintText fontImg, fontSpr, 10, 10, C_GREEN, "CollisionTest Program"
  73.     PrintText fontImg, fontSpr, 10, 40, C_GREEN, "PLEASE WAIT, LOADING MAP..."
  74.     d3ddev.EndScene
  75.     d3ddev.Present ByVal 0, ByVal 0, 0, ByVal 0
  76.     
  77.     
  78.     'load the bitmap file
  79.     Set tiles = LoadSurface(App.Path & "\ireland.bmp", 1024, 576)
  80.     
  81.     BuildTileCollisionList
  82.     
  83.     Set wood = LoadSurface(App.Path & "\bottom.bmp", 644, 32)
  84.     
  85.     'load the map data from the Mappy export file
  86.     LoadBinaryMap App.Path & "\ireland.mar", MAPWIDTH, MAPHEIGHT
  87.     
  88.     'load the dragon sprite
  89.     Set heroImg = LoadTexture(d3ddev, App.Path & "\hero_sword_walk.bmp")
  90.     
  91.     'initialize the dragon sprite
  92.     InitSprite d3ddev, heroSpr
  93.     With heroSpr
  94.         .FramesPerRow = 9
  95.         .FrameCount = 9
  96.         .CurrentFrame = 0
  97.         .AnimDelay = 1
  98.         .width = 96
  99.         .height = 96
  100.         .ScaleFactor = 1
  101.         .x = (SCREENWIDTH - .width) / 2
  102.         .y = (SCREENHEIGHT - .height) / 2
  103.     End With
  104.     
  105.     'create the small scroll buffer surface
  106.     Set scrollbuffer = d3ddev.CreateImageSurface( _
  107.         SCROLLBUFFERWIDTH, _
  108.         SCROLLBUFFERHEIGHT, _
  109.         dispmode.Format)
  110.         
  111.     'start player in the city of Dubh Linn
  112.     ScrollX = 1445 * TILEWIDTH
  113.     ScrollY = 1207 * TILEHEIGHT
  114.     
  115.     'this helps to keep a steady framerate
  116.     Dim start As Long
  117.     start = GetTickCount()
  118.  
  119.     'main loop
  120.     Do While (True)
  121.         'poll DirectInput for keyboard input
  122.         Check_Keyboard
  123.  
  124.         'update the scrolling window
  125.         UpdateScrollPosition
  126.         CheckTileCollisions
  127.        
  128.         DrawTiles
  129.         DrawScrollWindow
  130.         Scroll 0, 0
  131.         
  132.         'reset scroll speed
  133.         SuperHero = False
  134.         
  135.         'set the screen refresh to about 50 fps
  136.         If GetTickCount - start > 20 Then
  137.         
  138.             'start rendering
  139.             d3ddev.BeginScene
  140.             
  141.             'animate the dragon
  142.             If heroSpr.Animating Then
  143.                 AnimateSprite heroSpr, heroImg
  144.             End If
  145.         
  146.             'draw the hero sprite
  147.             DrawSprite heroImg, heroSpr, &HFFFFFFFF
  148.  
  149.             ShowScrollData
  150.  
  151.             'stop rendering
  152.             d3ddev.EndScene
  153.         
  154.             d3ddev.Present ByVal 0, ByVal 0, 0, ByVal 0
  155.             start = GetTickCount
  156.             DoEvents
  157.         End If
  158.     Loop
  159. End Sub
  160.  
  161. Public Sub BuildTileCollisionList()
  162.     ReDim badtiles(5)
  163.     badtiles(0) = 2
  164.     badtiles(1) = 34
  165.     badtiles(2) = 44
  166.     badtiles(3) = 54
  167.     badtiles(4) = 79
  168.    
  169. End Sub
  170.  
  171. Public Function IsBadTile(ByVal tilenum As Long) As Boolean
  172.     Dim n As Long
  173.     
  174.     For n = 0 To 4
  175.         If badtiles(n) - 1 = tilenum Then
  176.             IsBadTile = True
  177.             Exit Function
  178.         End If
  179.     Next n
  180.     
  181.     IsBadTile = False
  182.  
  183. End Function
  184.  
  185. Public Sub CheckTileCollisions()
  186.     Dim tilenum As Long
  187.     
  188.     tilenum = CurrentTile()
  189.     If IsBadTile(tilenum) Then
  190.         Scroll 0, 0
  191.         
  192.         Select Case heroSpr.AnimSeq
  193.             Case 0
  194.                 ScrollY = ScrollY + HEROSPEED
  195.             Case 1
  196.                 ScrollY = ScrollY + HEROSPEED
  197.                 ScrollX = ScrollX - HEROSPEED
  198.             Case 2
  199.                 ScrollX = ScrollX - HEROSPEED
  200.             Case 3
  201.                 ScrollX = ScrollX - HEROSPEED
  202.                 ScrollY = ScrollY - HEROSPEED
  203.             Case 4
  204.                 ScrollY = ScrollY - HEROSPEED
  205.             Case 5
  206.                 ScrollX = ScrollX + HEROSPEED
  207.                 ScrollY = ScrollY - HEROSPEED
  208.             Case 6
  209.                 ScrollX = ScrollX + HEROSPEED
  210.             Case 7
  211.                 ScrollX = ScrollX + HEROSPEED
  212.                 ScrollY = ScrollY + HEROSPEED
  213.         End Select
  214.         
  215.     End If
  216.     
  217. End Sub
  218.  
  219. Public Function TileAt(ByVal x As Long, ByVal y As Long) As Long
  220.     Dim tile As point
  221.     tile.x = x \ TILEWIDTH
  222.     tile.y = y \ TILEHEIGHT
  223.     TileAt = mapdata(tile.y * MAPWIDTH + tile.x)
  224. End Function
  225.  
  226. Public Function CurrentTile() As Long
  227.     CurrentTile = TileAt(PlayerPos.x, PlayerPos.y)
  228. End Function
  229.  
  230. Public Function PlayerPos() As point
  231.     'get tile pos at center of screen
  232.     PlayerPos.x = ScrollX + SCREENWIDTH / 2
  233.     PlayerPos.y = ScrollY + SCREENHEIGHT / 2
  234. End Function
  235.  
  236. Public Sub ShowScrollData()
  237.     Static old As point
  238.     Dim tile As point
  239.     
  240.     tile.x = PlayerPos.x \ TILEWIDTH
  241.     tile.y = PlayerPos.y \ TILEHEIGHT
  242.     
  243.     If (tile.x <> old.x) Or (tile.y <> old.y) Then
  244.         
  245.         'erase the background
  246.         DrawSurface wood, 0, 0, 639, 30, backbuffer, 0, 449
  247.         
  248.         old = tile
  249.         
  250.         PrintText fontImg, fontSpr, 5, 452, C_WHITE, "Scroll=(" & PlayerPos.x & "," & PlayerPos.y & ") "
  251.         PrintText fontImg, fontSpr, 5, 466, C_WHITE, "Tile(" & tile.x & "," & tile.y & ")=" & CurrentTile()
  252.     End If
  253. End Sub
  254.  
  255. 'This is called from DirectInput.bas on keypress events
  256. Public Sub KeyPressed(ByVal key As Long)
  257.     Select Case key
  258.         Case KEY_UP, KEY_NUMPAD8
  259.             heroSpr.AnimSeq = 0
  260.             heroSpr.Animating = True
  261.             Scroll 0, -HEROSPEED
  262.             
  263.         Case KEY_NUMPAD9
  264.             heroSpr.AnimSeq = 1
  265.             heroSpr.Animating = True
  266.             Scroll HEROSPEED, -HEROSPEED
  267.         
  268.         Case KEY_RIGHT, KEY_NUMPAD6
  269.             heroSpr.AnimSeq = 2
  270.             heroSpr.Animating = True
  271.             Scroll HEROSPEED, 0
  272.             
  273.         Case KEY_NUMPAD3
  274.             heroSpr.AnimSeq = 3
  275.             heroSpr.Animating = True
  276.             Scroll HEROSPEED, HEROSPEED
  277.         
  278.         Case KEY_DOWN, KEY_NUMPAD2
  279.             heroSpr.AnimSeq = 4
  280.             heroSpr.Animating = True
  281.             Scroll 0, HEROSPEED
  282.             
  283.         Case KEY_NUMPAD1
  284.             heroSpr.AnimSeq = 5
  285.             heroSpr.Animating = True
  286.             Scroll -HEROSPEED, HEROSPEED
  287.         
  288.         Case KEY_LEFT, KEY_NUMPAD4
  289.             heroSpr.AnimSeq = 6
  290.             heroSpr.Animating = True
  291.             Scroll -HEROSPEED, 0
  292.             
  293.         Case KEY_NUMPAD7
  294.             heroSpr.AnimSeq = 7
  295.             heroSpr.Animating = True
  296.             Scroll -HEROSPEED, -HEROSPEED
  297.             
  298.         Case KEY_LSHIFT, KEY_RSHIFT
  299.             SuperHero = True
  300.         
  301.         Case KEY_ESC
  302.             Shutdown
  303.     
  304.     End Select
  305.     
  306.     'uncomment this when you want to find new key codes
  307.     'Debug.Print "Key = " & key
  308.     
  309. End Sub
  310.  
  311.  
  312. Public Sub Scroll(ByVal horiz As Long, ByVal vert As Long)
  313.     SpeedX = horiz
  314.     SpeedY = vert
  315.     
  316.     If SuperHero Then
  317.         SpeedX = SpeedX * 4
  318.         SpeedY = SpeedY * 4
  319.     End If
  320. End Sub
  321.  
  322.  
  323.