home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Game Programming for Teens / VBGPFT.cdr / sources / chapter16 / CelticCrusader1 / Game.bas < prev    next >
Encoding:
BASIC Source File  |  2004-10-24  |  8.3 KB  |  320 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. Dim heroSpr As TSPRITE
  19. Dim 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.     
  138.         'set the screen refresh to about 50 fps
  139.         If GetTickCount - start > 20 Then
  140.         
  141.             'start rendering
  142.             d3ddev.BeginScene
  143.             
  144.             DrawNPCs
  145.             
  146.             'animate the dragon
  147.             If heroSpr.Animating Then
  148.                 AnimateSprite heroSpr
  149.             End If
  150.             
  151.             'draw the hero sprite
  152.             DrawSprite heroImg, heroSpr, &HFFFFFFFF
  153.  
  154.             ShowScrollData
  155.  
  156.             'stop rendering
  157.             d3ddev.EndScene
  158.         
  159.             d3ddev.Present ByVal 0, ByVal 0, 0, ByVal 0
  160.             start = GetTickCount
  161.             DoEvents
  162.         End If
  163.     Loop
  164. End Sub
  165.  
  166. Public Sub BuildTileCollisionList()
  167.     ReDim badtiles(5)
  168.     badtiles(0) = 2
  169.     badtiles(1) = 34
  170.     badtiles(2) = 44
  171.     badtiles(3) = 54
  172.     badtiles(4) = 79
  173.    
  174. End Sub
  175.  
  176. Public Function IsBadTile(ByVal tilenum As Long) As Boolean
  177.     Dim n As Long
  178.     
  179.     For n = 0 To 4
  180.         If badtiles(n) - 1 = tilenum Then
  181.             IsBadTile = True
  182.             Exit Function
  183.         End If
  184.     Next n
  185.     
  186.     IsBadTile = False
  187.  
  188. End Function
  189.  
  190. Public Sub CheckTileCollisions()
  191.     Dim tilenum As Long
  192.     
  193.     tilenum = CurrentTile()
  194.     If IsBadTile(tilenum) Then
  195.         Scroll 0, 0
  196.         
  197.         Select Case heroSpr.AnimSeq
  198.             Case 0
  199.                 ScrollY = ScrollY + WALKSPEED
  200.                 
  201.             Case 1
  202.                 ScrollY = ScrollY + WALKSPEED
  203.                 ScrollX = ScrollX - WALKSPEED
  204.             Case 2
  205.                 ScrollX = ScrollX - WALKSPEED
  206.             Case 3
  207.                 ScrollX = ScrollX - WALKSPEED
  208.                 ScrollY = ScrollY - WALKSPEED
  209.             Case 4
  210.                 ScrollY = ScrollY - WALKSPEED
  211.             Case 5
  212.                 ScrollX = ScrollX + WALKSPEED
  213.                 ScrollY = ScrollY - WALKSPEED
  214.             Case 6
  215.                 ScrollX = ScrollX + WALKSPEED
  216.             Case 7
  217.                 ScrollX = ScrollX + WALKSPEED
  218.                 ScrollY = ScrollY + WALKSPEED
  219.         End Select
  220.         
  221.     End If
  222.     
  223. End Sub
  224.  
  225. Public Function TileAt(ByVal x As Long, ByVal y As Long) As Long
  226.     Dim tile As point
  227.     tile.x = x \ TILEWIDTH
  228.     tile.y = y \ TILEHEIGHT
  229.     TileAt = mapdata(tile.y * MAPWIDTH + tile.x)
  230. End Function
  231.  
  232. Public Function CurrentTile() As Long
  233.     CurrentTile = TileAt(PlayerPos.x, PlayerPos.y)
  234. End Function
  235.  
  236. Public Function PlayerPos() As point
  237.     'get tile pos at center of screen
  238.     PlayerPos.x = ScrollX + SCREENWIDTH / 2
  239.     PlayerPos.y = ScrollY + SCREENHEIGHT / 2
  240. End Function
  241.  
  242. Public Sub ShowScrollData()
  243.     Dim tile As point
  244.     
  245.     tile.x = PlayerPos.x \ TILEWIDTH
  246.     tile.y = PlayerPos.y \ TILEHEIGHT
  247.     
  248.     PrintText fontImg, fontSpr, 5, 452, C_WHITE, "Scroll=(" & PlayerPos.x & "," & PlayerPos.y & ") "
  249.     PrintText fontImg, fontSpr, 5, 466, C_WHITE, "Tile(" & tile.x & "," & tile.y & ")=" & CurrentTile()
  250. End Sub
  251.  
  252. 'This is called from DirectInput.bas on keypress events
  253. Public Sub KeyPressed(ByVal key As Long)
  254.     Select Case key
  255.         Case KEY_UP, KEY_NUMPAD8
  256.             heroSpr.AnimSeq = 0
  257.             heroSpr.Animating = True
  258.             Scroll 0, -WALKSPEED
  259.             
  260.         Case KEY_NUMPAD9
  261.             heroSpr.AnimSeq = 1
  262.             heroSpr.Animating = True
  263.             Scroll WALKSPEED, -WALKSPEED
  264.         
  265.         Case KEY_RIGHT, KEY_NUMPAD6
  266.             heroSpr.AnimSeq = 2
  267.             heroSpr.Animating = True
  268.             Scroll WALKSPEED, 0
  269.             
  270.         Case KEY_NUMPAD3
  271.             heroSpr.AnimSeq = 3
  272.             heroSpr.Animating = True
  273.             Scroll WALKSPEED, WALKSPEED
  274.         
  275.         Case KEY_DOWN, KEY_NUMPAD2
  276.             heroSpr.AnimSeq = 4
  277.             heroSpr.Animating = True
  278.             Scroll 0, WALKSPEED
  279.             
  280.         Case KEY_NUMPAD1
  281.             heroSpr.AnimSeq = 5
  282.             heroSpr.Animating = True
  283.             Scroll -WALKSPEED, WALKSPEED
  284.         
  285.         Case KEY_LEFT, KEY_NUMPAD4
  286.             heroSpr.AnimSeq = 6
  287.             heroSpr.Animating = True
  288.             Scroll -WALKSPEED, 0
  289.             
  290.         Case KEY_NUMPAD7
  291.             heroSpr.AnimSeq = 7
  292.             heroSpr.Animating = True
  293.             Scroll -WALKSPEED, -WALKSPEED
  294.             
  295.         Case KEY_LSHIFT, KEY_RSHIFT
  296.             SuperHero = True
  297.         
  298.         Case KEY_ESC
  299.             Shutdown
  300.     
  301.     End Select
  302.     
  303.     'uncomment this when you want to find new key codes
  304.     'Debug.Print "Key = " & key
  305.     
  306. End Sub
  307.  
  308.  
  309. Public Sub Scroll(ByVal horiz As Long, ByVal vert As Long)
  310.     SpeedX = horiz
  311.     SpeedY = vert
  312.     
  313.     If SuperHero Then
  314.         SpeedX = SpeedX * 4
  315.         SpeedY = SpeedY * 4
  316.     End If
  317. End Sub
  318.  
  319.  
  320.