home *** CD-ROM | disk | FTP | other *** search
- Attribute VB_Name = "Game"
- '---------------------------------------------------------------
- ' Visual Basic Game Programming for Teens
- ' Chapter 12 - WalkAbout program
- '
- ' Requires the following files:
- ' Direct3D.bas, DirectInput.bas, Globals.bas, TileScroller.bas,
- ' Sprite.bas, and an empty Form1.
- '---------------------------------------------------------------
-
- Option Explicit
- Option Base 0
-
- Dim wood As Direct3DSurface8
-
- Dim badtiles() As Integer
-
- Public heroSprWalk As TSPRITE
- Public heroImgWalk As Direct3DTexture8
- Public heroSprAttack As TSPRITE
- Public heroImgAttack As Direct3DTexture8
- Public heroSprRun As TSPRITE
- Public heroImgRun As Direct3DTexture8
-
- Dim SuperHero As Boolean
-
- Dim frm As New Form1
-
-
- Public Function Random(ByVal lMax As Long)
- Random = Int(Rnd * lMax)
- End Function
-
-
- Public Sub Main()
-
- 'set random number seed
- Randomize GetTickCount
-
- 'set up the main form
- frm.Caption = "Celtic Crusader"
- frm.AutoRedraw = False
- frm.BorderStyle = 1
- frm.ClipControls = False
- frm.ScaleMode = 3
- frm.width = Screen.TwipsPerPixelX * (SCREENWIDTH + 12)
- frm.height = Screen.TwipsPerPixelY * (SCREENHEIGHT + 30)
- frm.Show
-
- 'initialize Direct3D
- InitDirect3D frm.hwnd
-
- 'initialize DirectInput
- InitDirectInput
- InitKeyboard frm.hwnd
-
- 'get reference to the back buffer
- Set backbuffer = d3ddev.GetBackBuffer(0, D3DBACKBUFFER_TYPE_MONO)
-
- 'create the font
- Set fontImg = LoadTexture(d3ddev, App.Path & "\font.bmp")
- InitSprite d3ddev, fontSpr
- fontSpr.FramesPerRow = 20
- fontSpr.width = 8
- fontSpr.height = 12
- fontSpr.ScaleFactor = 1
-
- 'clear the screen to black
- d3ddev.Clear 0, ByVal 0, D3DCLEAR_TARGET, C_BLACK, 1, 0
-
- 'display a startup message
- d3ddev.BeginScene
- PrintText fontImg, fontSpr, 10, 10, C_GREEN, "Celtic Crusader"
- PrintText fontImg, fontSpr, 10, 40, C_GREEN, "PLEASE WAIT, LOADING..."
- d3ddev.EndScene
- d3ddev.Present ByVal 0, ByVal 0, 0, ByVal 0
-
- 'load the bitmap file
- Set tiles = LoadSurface(App.Path & "\ireland.bmp", 1024, 576)
-
- 'fill the badtiles array
- BuildTileCollisionList
-
- 'load the bottom toolbar image
- Set wood = LoadSurface(App.Path & "\bottom.bmp", 644, 32)
-
- 'load the map data from the Mappy export file
- LoadBinaryMap App.Path & "\ireland.mar", MAPWIDTH, MAPHEIGHT
-
- 'create the small scroll buffer surface
- Set scrollbuffer = d3ddev.CreateImageSurface( _
- SCROLLBUFFERWIDTH, _
- SCROLLBUFFERHEIGHT, _
- dispmode.Format)
-
- 'initialize NPCs
- InitCharacters
-
- 'initialize the hero
- InitHero
-
- 'start player in the city of Dubh Linn
- ScrollX = PLAYERSTARTX * TILEWIDTH
- ScrollY = PLAYERSTARTY * TILEHEIGHT
-
- 'this helps to keep a steady framerate
- Dim start As Long
- start = GetTickCount()
-
- 'main loop
- Do While (True)
- 'erase the bottom toolbar
- DrawSurface wood, 0, 0, 639, 30, backbuffer, 0, 449
-
- 'poll DirectInput for keyboard input
- Check_Keyboard
-
- 'update the scrolling window
- UpdateScrollPosition
- CheckTileCollisions
- DrawTiles
- DrawScrollWindow
- Scroll 0, 0
-
- 'update NPCs
- MoveNPCs
- CheckNPCCollisions
-
- 'set the screen refresh to about 50 fps
- If GetTickCount - start > 20 Then
-
- 'start rendering
- d3ddev.BeginScene
-
- DrawNPCs
-
- 'update the hero
- UpdateHero
-
- ShowScrollData
-
- 'stop rendering
- d3ddev.EndScene
-
- d3ddev.Present ByVal 0, ByVal 0, 0, ByVal 0
- start = GetTickCount
- DoEvents
- End If
-
- Loop
- End Sub
-
-
- Public Sub BuildTileCollisionList()
- ReDim badtiles(5)
- badtiles(0) = 2
- badtiles(1) = 34
- badtiles(2) = 44
- badtiles(3) = 54
- badtiles(4) = 79
-
- End Sub
-
- Public Function IsBadTile(ByVal tilenum As Long) As Boolean
- Dim n As Long
-
- For n = 0 To 4
- If badtiles(n) - 1 = tilenum Then
- IsBadTile = True
- Exit Function
- End If
- Next n
-
- IsBadTile = False
-
- End Function
-
- Public Function TileAt(ByVal x As Long, ByVal y As Long) As Long
- Dim tile As point
- tile.x = x \ TILEWIDTH
- tile.y = y \ TILEHEIGHT
- TileAt = mapdata(tile.y * MAPWIDTH + tile.x)
- End Function
-
- Public Function CurrentTile() As Long
- CurrentTile = TileAt(PlayerPos.x, PlayerPos.y)
- End Function
-
- Public Sub ShowScrollData()
- Dim tile As point
-
- tile.x = PlayerPos.x \ TILEWIDTH
- tile.y = PlayerPos.y \ TILEHEIGHT
-
- PrintText fontImg, fontSpr, 5, 452, C_WHITE, "Scroll=(" & PlayerPos.x & "," & PlayerPos.y & ") "
- PrintText fontImg, fontSpr, 5, 466, C_WHITE, "Tile(" & tile.x & "," & tile.y & ")=" & CurrentTile()
- End Sub
-
- 'modified in chapter 18
- 'This is called from DirectInput.bas on keypress events
- Public Sub KeyPressed(ByVal key As Long)
-
- Select Case key
-
- Case KEY_UP, KEY_NUMPAD8
- heroSprWalk.AnimSeq = 0
- heroSprWalk.Animating = True
- Scroll 0, -WALKSPEED
- PlayerData.state = HERO_WALKING
-
- Case KEY_NUMPAD9
- heroSprWalk.AnimSeq = 1
- heroSprWalk.Animating = True
- Scroll WALKSPEED, -WALKSPEED
- PlayerData.state = HERO_WALKING
-
- Case KEY_RIGHT, KEY_NUMPAD6
- heroSprWalk.AnimSeq = 2
- heroSprWalk.Animating = True
- Scroll WALKSPEED, 0
- PlayerData.state = HERO_WALKING
-
- Case KEY_NUMPAD3
- heroSprWalk.AnimSeq = 3
- heroSprWalk.Animating = True
- Scroll WALKSPEED, WALKSPEED
- PlayerData.state = HERO_WALKING
-
- Case KEY_DOWN, KEY_NUMPAD2
- heroSprWalk.AnimSeq = 4
- heroSprWalk.Animating = True
- Scroll 0, WALKSPEED
- PlayerData.state = HERO_WALKING
-
- Case KEY_NUMPAD1
- heroSprWalk.AnimSeq = 5
- heroSprWalk.Animating = True
- Scroll -WALKSPEED, WALKSPEED
- PlayerData.state = HERO_WALKING
-
- Case KEY_LEFT, KEY_NUMPAD4
- heroSprWalk.AnimSeq = 6
- heroSprWalk.Animating = True
- Scroll -WALKSPEED, 0
- PlayerData.state = HERO_WALKING
-
- Case KEY_NUMPAD7
- heroSprWalk.AnimSeq = 7
- heroSprWalk.Animating = True
- Scroll -WALKSPEED, -WALKSPEED
- PlayerData.state = HERO_WALKING
-
- Case KEY_LCTRL
- 'point attack anim in same direction as walk
- heroSprAttack.AnimSeq = heroSprWalk.AnimSeq
- heroSprAttack.Animating = True
- PlayerData.state = HERO_ATTACKING
-
- Case KEY_ESC
- Shutdown
-
- End Select
-
- 'uncomment this when you want to find new key codes
- Debug.Print "Key = " & key
-
- End Sub
-
-
- Public Sub Scroll(ByVal horiz As Long, ByVal vert As Long)
- SpeedX = horiz
- SpeedY = vert
- End Sub
-
- Public Sub Shutdown()
- Dim n As Long
-
- Set wood = Nothing
- Set heroImgWalk = Nothing
- Set heroImgAttack = Nothing
- Set heroImgRun = Nothing
-
- For n = 0 To NUMCHARS - 1
- Set charWalk(n) = Nothing
- Next n
-
- Set scrollbuffer = Nothing
- Set tiles = Nothing
-
- Set d3ddev = Nothing
- Set d3d = Nothing
- Set d3dx = Nothing
- Set dx = Nothing
-
- End
- End Sub
-
-
-