Visual Basic Game Programming for Teens/VBGPFT.cdr/sources/chapter17/CelticCrusader2/Characters.bas

BASIC Source File | 2004-10-25 | 10.3 KB | 375 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
    NPC_PAUSED = 2
    NPC_TALKING = 3
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
            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
        AnimateSprite charSprites(num)

        '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

        Select Case charStates(n).state
            Case NPC_TALKING
                FacePlayer n

            Case NPC_PAUSED
                SetRandomDestination n

            Case NPC_WALKING
                MoveNPC n

            Case NPC_STOPPED
                SetRandomDestination n

        End Select
    Next n
End Sub

Public Sub CheckNPCCollisions()
    Dim n As Long

    'check all NPCs for collisions
    For n = 0 To NUMNPCS - 1

        If Collision(charSprites(n), heroSpr) Then
            charStates(n).state = NPC_TALKING
        End If

    Next n

End Sub

Public Sub TalkToPlayer(ByVal num As Long)
    Dim x As Long
    Dim y As Long

    x = charSprites(num).x + charSprites(num).width / 4
    y = charSprites(num).y
    PrintText fontImg, fontSpr, x, y, C_WHITE, "Hello"

End Sub

Public Sub FacePlayer(ByVal num As Long)
    Dim a As point
    Dim b As point

    a.x = heroSpr.x + heroSpr.width / 2
    a.y = heroSpr.y + heroSpr.height / 2

    b.x = charSprites(num).x + charSprites(num).width / 2
    b.y = charSprites(num).y + charSprites(num).height / 2

    With charStates(num)

        If b.x < a.x - 5 Then
            If b.y < a.y - 5 Then
                .Facing = 3
            ElseIf b.y > a.y + 5 Then
                .Facing = 1
            Else
                .Facing = 2
            End If

        ElseIf b.x > a.x + 5 Then
            If b.y < a.y - 5 Then
                .Facing = 5
            ElseIf b.y > a.y + 5 Then
                .Facing = 7
            Else
                .Facing = 6
            End If

        Else
            If b.y < a.y - 5 Then
                .Facing = 4
            ElseIf b.y > a.y + 5 Then
                .Facing = 0
            End If
        End If

    End With
End Sub

Public Sub DrawNPCs()
    Dim n As Long

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

        Select Case charStates(n).state
            Case NPC_TALKING
                DrawNPC n
                charStates(n).state = NPC_WALKING

                If diState.key(KEY_SPACE) > 0 Then
                    TalkToPlayer n
                End If

            Case NPC_PAUSED
                DrawNPC n
                charStates(n).state = NPC_WALKING

            Case NPC_WALKING
                DrawNPC n

            Case NPC_STOPPED
                DrawNPC n
                charStates(n).state = NPC_WALKING

        End Select

    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