Visual Basic Game Programming for Teens/VBGPFT.cdr/sources/chapter16/CelticCrusader1/Characters.bas

BASIC Source File | 2004-10-24 | 7.9 KB | 275 lines

Attribute VB_Name = "Characters"
'---------------------------------------------------------------
' Visual Basic Game Programming for Teens
' Characters.bas File
'---------------------------------------------------------------

Option Explicit
Option Base 0

'main character class data type
Public Type TCHARACTER
    name As String * 20
    classtype As String * 20
    experience As Integer
    level As Integer
    strength As Integer
    dexterity As Integer
    intellect  As Integer
    charisma As Integer
    stamina As Integer
    fillerstr As String * 80
    fillerint(10) As Integer
End Type

'keeps track of NPC state
Public Enum NPCSTATES
    NPC_STOPPED = 0
    NPC_WALKING = 1
End Enum

'keeps track of each character
Public Type TNPC
    name As String
    state As NPCSTATES
    startpos As point
    curpos As point
    destpos As point
    classindex As Integer
    SpeedDelay As Integer
    SpeedCount As Integer
    Facing As Integer
End Type

'generic data for the character classes
'images and data are shared by the NPCs
Const NUMCHARS As Long = 1
Dim charImages(NUMCHARS) As Direct3DTexture8
Dim charClasses(NUMCHARS) As TCHARACTER

'unique data for each individual NPC
Const NUMNPCS As Long = 10
Dim charStates(NUMNPCS) As TNPC
Dim charSprites(NUMNPCS) As TSPRITE

'main player character
Public Player As TCHARACTER


Public Sub InitCharacters()
    Dim p As point
    Dim n As Long

    'set up all the base character classes, sprites, and images
    'so far we're only using a single type of character--Viking Warrior
    charClasses(0) = LoadCharacterBinaryFile(App.Path & "\warrior.dat")
    Set charImages(0) = LoadTexture(d3ddev, App.Path & "\viking_walking.bmp")

    'now create the individual characters used in the game
    'all of these will share the base data above
    For n = 0 To NUMNPCS - 1

        'initialize sprite data
        InitSprite d3ddev, charSprites(n)
        With charSprites(n)
            .FramesPerRow = 8
            .FrameCount = 8
            .AnimDelay = 2
            .width = 96
            .height = 96
        End With

        'start NPCs at the player's location
        '(to test NPC movement at this stage)
        p.x = PLAYERSTARTX * TILEWIDTH
        p.y = PLAYERSTARTY * TILEHEIGHT

        'customize the Viking character
        With charStates(n)

            'this is the key! points to the base image/sprite/data
            .classindex = 0

            .name = "Viking"
            .startpos = p
            .curpos = p
            .SpeedDelay = 1
            .SpeedCount = 0
            .state = NPC_WALKING
            SetRandomDestination n

        End With
    Next n

End Sub

Public Sub SetRandomDestination(ByVal num As Long)
    With charStates(num)

        'set random X near the starting position
        '(the NPC will never wander away from his "home")
        .destpos.x = .startpos.x + Random(600)
        If .destpos.x > GAMEWORLDWIDTH Then
            .destpos.x = GAMEWORLDWIDTH - 1
        End If

        'set random Y near the starting position
        .destpos.y = .startpos.y + Random(600)
        If .destpos.y > GAMEWORLDHEIGHT Then
            .destpos.y = GAMEWORLDHEIGHT - 1
        End If
    End With
End Sub

Public Sub MoveNPC(ByVal num As Long)
    'moves a single NPC
    With charStates(num)

        'update movement rate--exit if not there yet
        .SpeedCount = .SpeedCount + 1
        If .SpeedCount < .SpeedDelay Then Exit Sub

        'okay, time to move, reset move counter
        .SpeedCount = 0

        'check to see if destination reached
        If .curpos.x = .destpos.x And .curpos.y = .destpos.y Then
            'yes! set a new destination then exit
            .state = NPC_STOPPED
            SetRandomDestination num
            Exit Sub
        Else
            .state = NPC_WALKING
        End If

        'time to set the NPC's "facing" direction
        'and update the X,Y position
        If .curpos.x < .destpos.x Then

            'needs to walk westward
            .curpos.x = .curpos.x + 1

            If .curpos.y < .destpos.y Then
                'facing SE
                .curpos.y = .curpos.y + 1
                .Facing = 3
            ElseIf .curpos.y > .destpos.y Then
                'facing NE
                .curpos.y = .curpos.y - 1
                .Facing = 1
            Else
                'facing EAST
                .Facing = 2
            End If

        ElseIf .curpos.x > .destpos.x Then

            'needs to walk eastward
            .curpos.x = .curpos.x - 1

            If .curpos.y < .destpos.y Then
                'facing SW
                .curpos.y = .curpos.y + 1
                .Facing = 5
            ElseIf .curpos.y > .destpos.y Then
                'facing NW
                .curpos.y = .curpos.y - 1
                .Facing = 7
            Else
                'facing WEST
                .Facing = 6
            End If

        Else 'must be facing due NORTH or SOUTH

            If .curpos.y < .destpos.y Then
                'facing SOUTH
                .curpos.y = .curpos.y + 1
                .Facing = 4
            ElseIf .curpos.y > .destpos.y Then
                'facint NORTH
                .curpos.y = .curpos.y - 1
                .Facing = 0
            End If

        End If

    End With
End Sub

Public Sub DrawNPC(ByVal num As Long)
    Dim r As RECT
    Dim classindex As Long

    'grab a shortcut to these long variable names
    r.Left = charStates(num).curpos.x
    r.Top = charStates(num).curpos.y
    r.Right = r.Left + charSprites(num).width
    r.bottom = r.Top + charSprites(num).height

    'remember, images/data are referred to using the NPC's classindex!
    'the sprite and state arrays are for every single unique NPC,
    'but the bitmap image and class data are shared by all NPCs
    classindex = charStates(num).classindex

    'now check to see if the sprite is within the scrolling viewport
    'sprite's position is actually global, so this determines if it's visible
    If r.Left > ScrollX - 1 And r.Right < ScrollX + SCREENWIDTH + 1 And _
       r.Top > ScrollY - 1 And r.bottom < ScrollY + SCREENHEIGHT + 1 Then

        'update animation frame if walking
        If charStates(num).state = NPC_WALKING Then
            AnimateSprite charSprites(num)
        End If

        'draw the sprite--remember, it's using the shared image (texture)
        charSprites(num).x = charStates(num).curpos.x - ScrollX
        charSprites(num).y = charStates(num).curpos.y - ScrollY
        charSprites(num).AnimSeq = charStates(num).Facing
        DrawSprite charImages(classindex), charSprites(num), C_WHITE

    End If

End Sub

Public Sub MoveNPCs()
    Dim n As Long

    'loop through all of the NPCs and move them
    For n = 0 To NUMNPCS - 1
        MoveNPC n
    Next n
End Sub

Public Sub DrawNPCs()
    Dim n As Long

    'loop through all of the NPCs and draw them
    For n = 0 To NUMNPCS - 1
        DrawNPC n
    Next n
End Sub

Public Function LoadCharacterBinaryFile(ByVal filename As String) As TCHARACTER
    Dim filenum As Integer
    Dim dude As TCHARACTER

    filenum = FreeFile()
    Open filename For Binary As filenum Len = Len(dude)
    Get filenum, , dude
    Close filenum

    LoadCharacterBinaryFile = dude
End Function

Public Sub SaveCharacterBinaryFile(ByVal filename As String, ByRef dude As TCHARACTER)
    Dim filenum As Integer

    filenum = FreeFile()
    Open filename For Binary As filenum Len = Len(dude)
    Put filenum, , dude
    Close filenum
End Sub