Visual Basic Game Programming for Teens/VBGPFT.cdr/sources/chapter18/CelticCrusader3/Characters.bas

BASIC Source File | 2004-11-03 | 14.2 KB | 489 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
    NPC_DYING = 4   'added in chapter 18
    NPC_KILLED = 5
    NPC_ATTACKING = 6
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
    health As Integer 'added in chapter 18
    dying As Integer
End Type

'generic data for the character classes
'images and data are shared by the NPCs
Public Const NUMCHARS As Long = 2
Public charWalk(NUMCHARS) As Direct3DTexture8
Public charAttack(NUMCHARS) As Direct3DTexture8
Public charClasses(NUMCHARS) As TCHARACTER

'unique data for each individual NPC
Public Const NUMNPCS As Long = 10
Public charStates(NUMNPCS) As TNPC
Public charWalkSpr(NUMNPCS) As TSPRITE
Public charAttackSpr(NUMNPCS) As TSPRITE


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

    'load the base character classes
    charClasses(0) = LoadCharacterBinaryFile(App.Path & "\warrior.dat")
    charClasses(1) = LoadCharacterBinaryFile(App.Path & "\knight.dat")

    'load up the viking warrior
    Set charWalk(0) = LoadTexture(d3ddev, App.Path & "\viking_axe_walking.bmp")
    Set charAttack(0) = LoadTexture(d3ddev, App.Path & "\viking_axe_attacking.bmp")

    'load up the skeleton sword guy
    Set charWalk(1) = LoadTexture(d3ddev, App.Path & "\skeleton_sword_walking.bmp")
    Set charAttack(1) = LoadTexture(d3ddev, App.Path & "\skeleton_sword_attacking.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 walking sprite data
        InitSprite d3ddev, charWalkSpr(n)
        With charWalkSpr(n)
            .FramesPerRow = 8
            .FrameCount = 8
            .AnimDelay = 1
            .width = 96
            .height = 96
        End With

        'initialize attacking sprite data
        InitSprite d3ddev, charAttackSpr(n)
        With charAttackSpr(n)
            .FramesPerRow = 10
            .FrameCount = 10
            .AnimDelay = 1
            .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 = Random(2)

            .name = "Viking"
            .startpos = p
            .curpos = p
            .SpeedDelay = 1
            .SpeedCount = 0
            .health = 60    'added in chapter 18
            .state = NPC_WALKING
            SetRandomDestination charStates(n)

        End With
    Next n

End Sub

'modified in chapter 18
Public Sub SetRandomDestination(ByRef dude As TNPC)
    With dude

        '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)

        If .health < 0 Then .state = NPC_DYING

        If .state = NPC_DYING Or .state = NPC_KILLED Then Exit Sub

        '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, ByVal color 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 + charWalkSpr(num).width
    r.bottom = r.Top + charWalkSpr(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

        Select Case charStates(num).state
            Case NPC_ATTACKING
                AnimateSprite charAttackSpr(num)
                charAttackSpr(num).x = charStates(num).curpos.x - ScrollX
                charAttackSpr(num).y = charStates(num).curpos.y - ScrollY
                charAttackSpr(num).AnimSeq = charStates(num).facing
                DrawSprite charAttack(classindex), charAttackSpr(num), color

            Case Else
                'update animation frame if walking
                AnimateSprite charWalkSpr(num)

                'draw the sprite--remember, it's using the shared image (texture)
                charWalkSpr(num).x = charStates(num).curpos.x - ScrollX
                charWalkSpr(num).y = charStates(num).curpos.y - ScrollY
                charWalkSpr(num).AnimSeq = charStates(num).facing
                DrawSprite charWalk(classindex), charWalkSpr(num), color
        End Select

    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_ATTACKING
                'stop attacking if the player leaves or if I'm dead..
                If charStates(n).health < 0 Then charStates(n).state = NPC_STOPPED

                If Not Collision(charWalkSpr(n), heroSprWalk) Then
                    charStates(n).state = NPC_STOPPED
                End If

            Case NPC_TALKING
                FacePlayer n

            Case NPC_PAUSED
                SetRandomDestination charStates(n)

            Case NPC_WALKING
                MoveNPC n

            Case NPC_STOPPED
                SetRandomDestination charStates(n)

            Case NPC_DYING
                charStates(n).destpos = charStates(n).curpos
                charStates(n).health = charStates(n).health - 1
                If charStates(n).health < -100 Then
                    charStates(n).state = NPC_KILLED
                End If

            Case NPC_KILLED
                KillNPC charStates(n)

        End Select
    Next n
End Sub

Public Sub KillNPC(ByRef dude As TNPC)
    Dim p As point

    p.x = PLAYERSTARTX * TILEWIDTH + Random(1000)
    p.y = PLAYERSTARTY * TILEHEIGHT + Random(1000)

    With dude
        .startpos = p
        .curpos = p
        .SpeedDelay = 1
        .SpeedCount = 0
        .health = 20    'added in chapter 18
        .state = NPC_WALKING
        SetRandomDestination dude
    End With

End Sub

Public Sub CheckNPCCollisions()
    Dim n As Long

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

        With charStates(n)
        If Collision(charWalkSpr(n), heroSprWalk) Then
            If .state <> NPC_DYING And _
                .state <> NPC_KILLED And _
                .state <> NPC_ATTACKING Then

                .state = NPC_TALKING
            End If
        End If
        End With
    Next n

End Sub

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

    x = charWalkSpr(num).x + charWalkSpr(num).width / 4
    y = charWalkSpr(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 = heroSprWalk.x + heroSprWalk.width / 2
    a.y = heroSprWalk.y + heroSprWalk.height / 2

    b.x = charWalkSpr(num).x + charWalkSpr(num).width / 2
    b.y = charWalkSpr(num).y + charWalkSpr(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_ATTACKING
                DrawNPC n, C_RED
                charStates(n).state = NPC_WALKING

            Case NPC_TALKING
                DrawNPC n, C_WHITE
                charStates(n).state = NPC_WALKING

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

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

            Case NPC_WALKING
                DrawNPC n, C_WHITE

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

            Case NPC_DYING
                DrawNPC n, &H99FFFFFF

        End Select

    Next n
End Sub

Public Sub AttackNPC(ByRef target As TNPC, ByVal attack As Long)

    'fight back!
    target.state = NPC_ATTACKING

    'decrease health
    target.health = target.health - attack
    If target.health < 1 Then
        target.state = NPC_DYING
    End If

    'display a message to indicate the NPC was hit!
    PrintText fontImg, fontSpr, _
        heroSprAttack.x, heroSprAttack.y, C_WHITE, _
        "Take that! (" & attack & " pts)"

    'make the target respond to the hit
    Dim p As point
    p.x = target.curpos.x - ScrollX
    p.y = target.curpos.y - ScrollY
    PrintText fontImg, fontSpr, _
        p.x, p.y, C_WHITE, _
        "Argh, I've been hit! (" & target.health & ")"

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