entities.bas

超级C&C有没有搞错,VB还能编出这种即时策略游戏来!没错,这就是我们的超级C&C!虽然游戏经常无故退出,但是原码仍有很多可圈可点的地方.祝你早日编出中国的超级RA,超级KKND,超级星际,超级家园

Global ObjectsActive As Integer
Global Const OBJCHECK_ALIVE = 1
Global Const OBJCHECK_CANBEDIRECTED = 2
Global Const OBJCHECK_CANBESELECTED = 3
Global Const OBJCHECK_CANATTACK = 4
Global Const OBJCHECK_CANMOVE = 5
Global Const OBJCHECK_OCCUPIESMAPSPACE = 6
Global Const OBJCHECK_SELECTABLE = 7
Global Const OBJCHECK_HITTABLE = 8
Global Const OBJCHECK_VISIBLE = 9

Global Const INSTRUCTION_FORCEATTACK = 1
Global Const INSTRUCTION_FORCEMOVE = 2

Global Const SPRITEGROUP_NORMAL = 1
Global Const SPRITEGROUP_SHOOTING = 2
Global Const SPRITEGROUP_BUILDING = 3
Public Function FindPath(ObjIndex, X, Y, UnpassableTerrain) As PathObj
'Pathfinding algorithm

'FindPath.Points = PathNodes(FoundIndex).Points
End Function
Public Sub Assign_DNA(ObjIndex)
For I = 1 To MAXGENETICS
  Objects(I).DNA.Genetics(I) = Int(GeneticRange * Rnd) - HalfGeneticRange
Next I
End Sub
Public Function CheckObject(ObjIndex, CheckType) As Boolean
With ObjModels(Objects(ObjIndex).ModelIndex)
    Select Case CheckType
    Case OBJCHECK_ALIVE
      If Objects(ObjIndex).Active = True Then
        CheckObject = True
      End If
    Case OBJCHECK_CANBEDIRECTED
      If .Abilities(ABILITY_MOVES) = True Then
        CheckObject = True
      End If
    Case OBJCHECK_CANBESELECTED
      If .Abilities(ABILITY_SELECTABLE) = True Then
        CheckObject = True
      End If
    Case OBJCHECK_CANATTACK
      If .Abilities(ABILITY_SHOOTS) = True Then
        CheckObject = True
      End If
    Case OBJCHECK_CANMOVE
      If .Abilities(ABILITY_MOVES) = True Then
        CheckObject = True
      End If
    Case OBJCHECK_OCCUPIESMAPSPACE
      If .Abilities(ABILITY_ISPHYSICAL) = True Then
        CheckObject = True
      End If
    Case OBJCHECK_SELECTABLE
      If .Abilities(ABILITY_SELECTABLE) = True Then
        If Objects(ObjIndex).Side = LocalPlayer.PlayerIndex Then
          CheckObject = True
        End If
      End If
    Case OBJCHECK_HITTABLE
      If .Abilities(ABILITY_HITTABLE) = True Then
        CheckObject = True
      End If
    Case OBJCHECK_VISIBLE
      If .Attributes(ATTRIBUTE_SPRITE) <> NOSPRITE Then
        CheckObject = True
      End If
    End Select
End With
End Function
Public Sub DirectUnit(ObjIndex, XPoint, YPoint, ManualInstruction)
Const DONOTEXECUTEGOAL = 999
'Figure out what the instruction is
X = Map.ProjectToMapX(XPoint)
Y = Map.ProjectToMapY(YPoint)
If X < 0 Then X = 0
If Y < 0 Then Y = 0
Call Map.SetGroundUnOccupiedByObject(ObjIndex)

With GroundBlocks(X, Y)
    Instruction = GOAL_NOTHING
    If IsMapBlockEmptyXY(X, Y) = True Then
      Instruction = GOAL_NOTHING
    Else
      If Objects(.OccupyingObject).Side <> LocalPlayer.PlayerIndex Then
        If Objects(.OccupyingObject).Side <> SIDE_SCENERY Then
          If CheckObject(.OccupyingObject, OBJCHECK_HITTABLE) = True Then
            Instruction = GOAL_ATTACK
          End If
        End If
      End If
    End If
    For I = 1 To ObjectsActive
      If CheckObject(I, OBJCHECK_ALIVE) = True Then
        If Objects(I).Side <> LocalPlayer.PlayerIndex = True Then
          If Objects(I).Side <> SIDE_SCENERY = True Then
            Dim Temppoint As Point3D
            Temppoint.X = XPoint
            Temppoint.Y = YPoint
            If CheckObject(I, OBJCHECK_HITTABLE) = True Then
              If CheckIfPointIsOnUnit(I, Temppoint) = True Then
                Instruction = DONOTEXECUTEGOAL
                Call ObjectCommand_AttackObject(ObjIndex, I, X, Y)
              End If
            End If
          End If
        End If
      End If
    Next I
    If Instruction = GOAL_NOTHING Then
      If ObjModels(Objects(ObjIndex).ModelIndex).Abilities(ABILITY_HARVESTS) Then
        If .TerrainType = TERRAINTYPE_GEMS Then
          Instruction = GOAL_HARVESTGEMS
        End If
      End If
    End If
    If Instruction = GOAL_NOTHING Then Instruction = GOAL_MOVESOMEWHERE
    
    If ManualInstruction = INSTRUCTION_FORCEATTACK Then
      Instruction = GOAL_ATTACK
    End If
    
    If ManualInstruction = INSTRUCTION_FORCEMOVE Then
      Instruction = GOAL_MOVESOMEWHERE
    End If
    
    'Carry out the instruction
    Select Case Instruction
    Case GOAL_MOVESOMEWHERE
      If CheckObject(ObjIndex, OBJCHECK_CANBEDIRECTED) = True Then
        Call ObjectCommand_MoveSomewhere(ObjIndex, X, Y)
      End If
    Case GOAL_ATTACK
      If CheckObject(ObjIndex, OBJCHECK_CANBEDIRECTED) = True Then
        If CheckObject(ObjIndex, OBJCHECK_CANATTACK) = True Then
          OccupyObj = .OccupyingObject
          If .Occupied = False Then OccupyObj = TARGETGROUND
          Call ObjectCommand_AttackObject(ObjIndex, OccupyObj, X, Y)
        End If
      End If
    End Select
    Call Map.SetGroundOccupiedByObject(ObjIndex)
End With
End Sub
Public Sub ObjectEmitSound(ObjIndex, SoundNumber)
Dim SoundNum As Integer
SoundNum = SoundNumber
Call Sound.Play_Sound(SoundNum, 0, 0)
End Sub
Public Sub ObjectCommand_MoveSomewhere(ObjIndex, X, Y)
Call ClearObjectStates(ObjIndex)
With Objects(ObjIndex)
  .Objective.Goal = GOAL_MOVESOMEWHERE
  .Objective.Speed = 0
  .States(STATE_MOVING) = False
End With
Call ChangeObjectDestination(ObjIndex, X, Y, 0)
End Sub
Public Sub ObjectCommand_AvoidCollision(ObjIndex, X, Y)
Dim TempPos As Point3D, TempVector As Vect3D
With Objects(ObjIndex)
  TempVector.Yaw = .Vector.Yaw + 22
  CheckVector TempVector
  .Vector.Yaw = TempVector.Yaw
  TempPos = Math.GetPropelCoordinates(.Position, .Vector.Yaw, 0, 70)
  If .Objective.Goal <> GOAL_GETOUTOFTHEWAY Then .Properties(PROPERTY_LASTCOMMAND) = .Objective.Goal
  .Objective.Goal = GOAL_GETOUTOFTHEWAY
  If .Objective.CurrentDestination.X < 0 Then .Objective.CurrentDestination.X = 0
  If .Objective.CurrentDestination.Y < 0 Then .Objective.CurrentDestination.Y = 0
  .Objective.CurrentDestination = Map.ProjectToMap3DPoint(TempPos)
End With
Call Entities.SetObjectDirection(ObjIndex, TempPos)
SetDisplayDirection ObjIndex
End Sub
Sub ClearObjectStates(ObjIndex)
For I = 1 To MAXSTATES
  Objects(ObjIndex).States(I) = False
Next I
End Sub
Public Sub ObjectCommand_BuildThis(ObjIndex, ClassToBuild)
Call ClearObjectStates(ObjIndex)
Objects(ObjIndex).States(STATE_BUILDING) = True
Objects(ObjIndex).Properties(PROPERTY_BUILDPROGRESS) = 0
Objects(ObjIndex).Properties(PROPERTY_CLASSTOBUILD) = ClassToBuild
Objects(ObjIndex).Sprite.SpriteGroupNumber = SPRITEGROUP_BUILDING
Objects(ObjIndex).Sprite.SpriteFrameNumber = 1
End Sub
Public Sub ObjectCommand_SitStillForTime(ObjIndex, TimeLength)
With Objects(ObjIndex)
  .Properties(PROPERTY_LASTCOMMAND) = .Objective.Goal
  .Properties(PROPERTY_TIMEREMAININGONSITSTILL) = TimeLength
  .Objective.Goal = GOAL_SITSTILL
  .States(STATE_MOVING) = False
  .Objective.Speed = 0
End With
End Sub
Public Sub ObjectCommand_AttackObject(ObjIndex, ObjectToAttack, X, Y)
Dim Temppoint As Point3D, TempVector As Vect3D, TargetPosition As Point3D
Call ClearObjectStates(ObjIndex)
With Objects(ObjIndex)
  .Objective.Goal = GOAL_ATTACK
  .Objective.Target = ObjectToAttack
  .Objective.TargetPosition.X = X
  .Objective.TargetPosition.Y = Y
  .Objective.Speed = 0
  TargetPosition = Map.UnProjectToMap3DPoint(.Objective.TargetPosition)
  TempVector.Yaw = Math.GetYawFromXY(TargetPosition.X, TargetPosition.Y, .Position.X, .Position.Y)
  Call CheckVector(TempVector)
  If .Objective.Target = TARGETGROUND Then
    DistOffsetVal = 0
  Else
    DistOffsetVal = ObjModels(Objects(.Objective.Target).ModelIndex).Attributes(ATTRIBUTE_SIZE) * MapBlockSize
  End If
  DistanceFromTarget = Math.GetDistance(Objects(ObjIndex).Position, Objects(ObjIndex).Objective.TargetPosition) - DistOffsetVal
  If DistanceFromTarget < ObjModels(.ModelIndex).Attributes(ATTRIBUTE_MINIMUMSHOOTRADIUS) Then
    Call ObjectCommand_GetFartherAwayFromTarget(ObjIndex, Map.ProjectToMap3DPoint(TargetPosition))
  Else
    If DistanceFromTarget > ObjModels(Objects(ObjIndex).ModelIndex).Attributes(ATTRIBUTE_SHOOTRADIUS) Then
      Temppoint = Map.ProjectToMap3DPoint(Math.GetPropelCoordinates(TargetPosition, TempVector.Yaw, 0, ((ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SHOOTRADIUS) - ObjModels(.ModelIndex).Attributes(ATTRIBUTE_MINIMUMSHOOTRADIUS)) / 2) + ObjModels(.ModelIndex).Attributes(ATTRIBUTE_MINIMUMSHOOTRADIUS) + DistOffsetVal))
      Call ChangeObjectDestination(ObjIndex, Temppoint.X, Temppoint.Y, 0)
    End If
  End If
End With
End Sub
Public Sub ObjectCommand_ContinueAttack(ObjIndex, ObjectToAttack, X, Y)
Dim Temppoint As Point3D, TempVector As Vect3D, TargetPosition As Point3D
With Objects(ObjIndex)
  .Objective.Goal = GOAL_ATTACK
  .Objective.Target = ObjectToAttack
  .Objective.TargetPosition.X = X
  .Objective.TargetPosition.Y = Y
  TargetPosition = Map.UnProjectToMap3DPoint(.Objective.TargetPosition)
  TempVector.Yaw = Math.GetYawFromXY(TargetPosition.X, TargetPosition.Y, .Position.X, .Position.Y)
  Call CheckVector(TempVector)
  Temppoint = Map.ProjectToMap3DPoint(Math.GetPropelCoordinates(TargetPosition, TempVector.Yaw, 0, ((ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SHOOTRADIUS) - ObjModels(.ModelIndex).Attributes(ATTRIBUTE_MINIMUMSHOOTRADIUS)) / 2) + ObjModels(.ModelIndex).Attributes(ATTRIBUTE_MINIMUMSHOOTRADIUS)))
End With
Call ChangeObjectDestination(ObjIndex, Temppoint.X, Temppoint.Y, 0)
End Sub
Public Sub ObjectCommand_CeaseAttack(ObjIndex)
With Objects(ObjIndex)
  .Objective.Goal = GOAL_NOTHING
  Call ClearObjectStates(ObjIndex)
  .Objective.Speed = 0
  .Objective.Target = NOTARGET
  .Objective.TargetPosition.X = .MapPosition.X
  .Objective.TargetPosition.Y = .MapPosition.Y
End With
End Sub

Public Sub ObjectCommand_Deploy(ObjIndex)
With Objects(ObjIndex)
  OBJDEPLOY = ObjModels(.ModelIndex).Attributes(ATTRIBUTE_DEPLOYOBJECT)
  Side = .Side
  X = .MapPosition.X
  Y = .MapPosition.Y
End With
Call DestroyObject(ObjIndex)
newobj = SpawnObject(OBJDEPLOY, Side, X, Y, 0, 0, 0)
End Sub
Public Sub RunObjectAnimation(ObjIndex)
With Objects(ObjIndex)
  If ObjModels(.ModelIndex).Abilities(ABILITY_BODYISBISECTED) = True Then
    .TopSprite.SpriteFrameTicks = .TopSprite.SpriteFrameTicks + 1
    If .TopSprite.SpriteFrameTicks > Sprites(ObjModels(.ModelIndex).Attributes(ATTRIBUTE_TOPSPRITE)).SpriteGroups(.TopSprite.SpriteFrameNumber).Frames(.TopSprite.SpriteFrameNumber).FrameDuration Then
      .TopSprite.SpriteFrameTicks = 1
      .TopSprite.SpriteFrameNumber = .TopSprite.SpriteFrameNumber + 1
      If .TopSprite.SpriteFrameNumber > Sprites(ObjModels(.ModelIndex).Attributes(ATTRIBUTE_TOPSPRITE)).SpriteGroups(.TopSprite.SpriteGroupNumber).FrameMax Then
        If Sprites(ObjModels(.ModelIndex).Attributes(ATTRIBUTE_TOPSPRITE)).SpriteGroups(.TopSprite.SpriteFrameNumber).RepeatSequence = True Then
          .TopSprite.SpriteFrameNumber = 1
        Else
          .TopSprite.SpriteFrameNumber = 1
          .TopSprite.SpriteGroupNumber = SPRITEGROUP_NORMAL
        End If
      End If
    End If
  Else
    .Sprite.SpriteFrameTicks = .Sprite.SpriteFrameTicks + 1
    If .Sprite.SpriteFrameTicks > Sprites(.Sprite.SpriteNumber).SpriteGroups(.Sprite.SpriteGroupNumber).Frames(.Sprite.SpriteFrameNumber).FrameDuration Then
      .Sprite.SpriteFrameTicks = 1
      .Sprite.SpriteFrameNumber = .Sprite.SpriteFrameNumber + 1
      If .Sprite.SpriteFrameNumber > Sprites(.Sprite.SpriteNumber).SpriteGroups(.Sprite.SpriteGroupNumber).FrameMax Then
        If Sprites(.Sprite.SpriteGroupNumber).SpriteGroups(.Sprite.SpriteGroupNumber).RepeatSequence = True Then
          .Sprite.SpriteFrameNumber = 1
        Else
          .Sprite.SpriteFrameNumber = 1
          .Sprite.SpriteGroupNumber = SPRITEGROUP_NORMAL
        End If
      End If
    End If
  End If
End With
End Sub
Public Sub ObjectCommand_Fire(ObjIndex, X, Y, Z, Target)
Dim Temppoint As Point3D, TempPosition As Point3D
Call Object_PlaySound(ObjIndex, SoundEvent_Fire)
With Temppoint
  .X = X
  .Y = Y
  .Z = Z
End With
With Objects(ObjIndex)
  If ObjModels(.ModelIndex).Abilities(ABILITY_FRAMES_SHOOTING) = True Then
    If ObjModels(.ModelIndex).Abilities(ABILITY_BODYISBISECTED) = True Then
      .TopSprite.SpriteGroupNumber = SPRITEGROUP_SHOOTING
      .TopSprite.SpriteFrameNumber = 1