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