map.bas

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

Attribute VB_Name = "Map"
Public Const SEASON_SUMMER = 1
Public Const MaxSeasons = 1
Public Type TerrainProfile
  GrassSprites As IndexGroup
  WaterSprites As IndexGroup
  RockObjects As IndexGroup
  TreeObjects As IndexGroup
  DebrisObject As IndexGroup
  WaterBorderSprite As String
End Type
Public SeasonProfiles(MaxSeasons) As TerrainProfile
Global Const MapBlockSize = 16
Global Const HalfMapBlockSize = MapBlockSize / 2
Global Const TERRAINTYPE_NOTHING = 0
Global Const TERRAINTYPE_GRASS = 1
Global Const TERRAINTYPE_WATER = 2
Private Type MAPtype
  Width As Integer
  RealWidth As Integer
  Height As Integer
  RealHeight As Integer
  MapName As String
  EpisodeNumber As Integer
  LevelNumber As Integer
End Type
Global BattleMap As MAPtype
Public Const MAXTERRAINOVERLAYS = 12
Private Type GroundBlock
  TerrainType As Integer
  Occupied As Boolean
  OccupyingObject As Integer
  DamageAmount As Integer
  SpriteNumbers(MAXTERRAINOVERLAYS) As Integer
  AnimFrames(MAXTERRAINOVERLAYS) As Integer
  TerrainOverlayAmount As Integer
  Height As Integer
  Friction As Integer
End Type
Global Const MaxMapX = 152
Global Const MaxMapY = 152
Global GroundBlocks(-2 To MaxMapX + 10, -2 To MaxMapY + 10) As GroundBlock
Public Sub ResetMap()
Dim BlankGroundBlock As GroundBlock, BlankBattleMap As MAPtype
For X = 0 To MaxMapX
  For Y = 0 To MaxMapY
    GroundBlocks(X, Y) = BlankGroundBlock
  Next Y
Next X
BattleMap = BlankBattleMap
End Sub
Public Sub LoadSeasonProfiles()
Call FileFunctions.OpenGameFile(File_TerrainProfiles, 1)
Do
  Line Input #1, a$
  If a$ = FILETAG_ENDFILE Then Exit Do
  If a$ = "[TERRAINPROFILEDEF]" Then
    Line Input #1, a$
    Select Case MiscFunctions.GetPropertyValue(a$)
    Case "Summer"
      Season = SEASON_SUMMER
    End Select
    SeasonProfiles(Season).GrassSprites.IndexesActive = 0
    SeasonProfiles(Season).DebrisObject.IndexesActive = 0
    SeasonProfiles(Season).RockObjects.IndexesActive = 0
    SeasonProfiles(Season).TreeObjects.IndexesActive = 0
    SeasonProfiles(Season).WaterSprites.IndexesActive = 0
    Do
      Line Input #1, a$
      If a$ = "[ENDTERRAINPROFILE]" Then
        Exit Do
      End If
      Select Case MiscFunctions.GetPropertyName(a$)
      Case "WaterBorder:"
        SeasonProfiles(Season).WaterBorderSprite = MiscFunctions.GetPropertyValue(a$)
      Case "GrassSprite:"
        SeasonProfiles(Season).GrassSprites.IndexesActive = SeasonProfiles(Season).GrassSprites.IndexesActive + 1
        SeasonProfiles(Season).GrassSprites.Indexes(SeasonProfiles(Season).GrassSprites.IndexesActive) = GetSpriteIndex(MiscFunctions.GetPropertyValue(a$))
      Case "WaterSprite:"
        SeasonProfiles(Season).WaterSprites.IndexesActive = SeasonProfiles(Season).WaterSprites.IndexesActive + 1
        SeasonProfiles(Season).WaterSprites.Indexes(SeasonProfiles(Season).WaterSprites.IndexesActive) = GetSpriteIndex(MiscFunctions.GetPropertyValue(a$))
      Case "RockObject:"
        SeasonProfiles(Season).RockObjects.IndexesActive = SeasonProfiles(Season).RockObjects.IndexesActive + 1
        SeasonProfiles(Season).RockObjects.Indexes(SeasonProfiles(Season).RockObjects.IndexesActive) = Entities.GetClassNum(MiscFunctions.GetPropertyValue(a$))
      Case "TreeObject:"
        SeasonProfiles(Season).TreeObjects.IndexesActive = SeasonProfiles(Season).TreeObjects.IndexesActive + 1
        SeasonProfiles(Season).TreeObjects.Indexes(SeasonProfiles(Season).TreeObjects.IndexesActive) = Entities.GetClassNum(MiscFunctions.GetPropertyValue(a$))
      Case "DebrisObject:"
        SeasonProfiles(Season).DebrisObject.IndexesActive = SeasonProfiles(Season).DebrisObject.IndexesActive + 1
        SeasonProfiles(Season).DebrisObject.Indexes(SeasonProfiles(Season).DebrisObject.IndexesActive) = Entities.GetClassNum(MiscFunctions.GetPropertyValue(a$))
      End Select
    Loop
  End If
Loop
Close #1
End Sub
Sub ChangeBattleMapSize(Width, Height)
BattleMap.Width = Width
BattleMap.Height = Height
BattleMap.RealWidth = Width * MapBlockSize
BattleMap.RealHeight = Height * MapBlockSize
Call GameEngine.Initialize_BattleView
End Sub
Sub GenerateRandomMap(Width, Height, Season, TerrainRandomness, ForestNumber, ForestSize, RandomTreeAmount, LakeNumber, LakeSizes, Rivers, Streams, BoulderAreaNumber, BouldersPerArea, RandomBoulderAmount, DebrisPiles, DebrisPileSize, RandomDebrisAmount, DirtPathAmount, ClearingAmounts, ClearingSize)
Dim TempPos As Point3D, NewPos As Point3D
LevelSettings.AirFriction = 0.01
LevelSettings.GravityAmount = 1
Call ChangeBattleMapSize(Width, Height)
Select Case Season
Case SEASON_SUMMER
  For X = 0 To Width
    For Y = 0 To Height
      GroundBlocks(X, Y).Friction = 1
      GroundBlocks(X, Y).TerrainType = TERRAINTYPE_GRASS
      GroundBlocks(X, Y).Height = Int(5 * Rnd)
    Next Y
  Next X
  For I = 1 To LakeNumber
    LakeX = Int(Width * Rnd)
    LakeY = Int(Height * Rnd)
    LakeSize = LakeSizes + Int((TerrainRandomness * Rnd) - (TerrainRandomness / 2))
    TempPos.X = LakeX
    TempPos.Y = LakeY
    If TempPos.X < 0 Then TempPos.X = 0
    If TempPos.Y < 0 Then TempPos.Y = 0
    If TempPos.X > BattleMap.Width Then TempPos.X = BattleMap.Width
    If TempPos.Y > BattleMap.Height Then TempPos.Y = BattleMap.Height
    
    For LakeDrawYaw = 1 To 360
      LakeSize = LakeSize + Int(3 * Rnd) - 1
      For RadiusLength = 1 To LakeSize
        NewPos = Math.GetPropelCoordinates(TempPos, LakeDrawYaw, 0, RadiusLength)
        If NewPos.X < 0 Then NewPos.X = 0
        If NewPos.Y < 0 Then NewPos.Y = 0
        If NewPos.X > BattleMap.Width Then NewPos.X = BattleMap.Width
        If NewPos.Y > BattleMap.Height Then NewPos.Y = BattleMap.Height
        GroundBlocks(Int(NewPos.X), Int(NewPos.Y)).TerrainType = TERRAINTYPE_WATER
      Next RadiusLength
    Next LakeDrawYaw
  Next I
  
  For I = 1 To RandomTreeAmount
    ForestX = Int(Width * Rnd)
    ForestY = Int(Height * Rnd)
    TempPos.X = ForestX
    TempPos.Y = ForestY
    If TempPos.X < 0 Then TempPos.X = 0
    If TempPos.Y < 0 Then TempPos.Y = 0
    If TempPos.X > BattleMap.Width Then TempPos.X = BattleMap.Width
    If TempPos.Y > BattleMap.Height Then TempPos.Y = BattleMap.Height
    If GroundBlocks(Int(TempPos.X), Int(TempPos.Y)).Occupied = False Then
      If GroundBlocks(Int(TempPos.X), Int(TempPos.Y)).TerrainType = TERRAINTYPE_GRASS Then
        Call SpawnObject(SeasonProfiles(SEASON_SUMMER).TreeObjects.Indexes(1), SIDE_SCENERY, TempPos.X, TempPos.Y, TempPos.Z, 0, 0)
      End If
    End If
  Next I

  For I = 1 To RandomBoulderAmount
    BoulderX = Int(Width * Rnd)
    BoulderY = Int(Height * Rnd)
    TempPos.X = BoulderX
    TempPos.Y = BoulderY
    If TempPos.X < 0 Then TempPos.X = 0
    If TempPos.Y < 0 Then TempPos.Y = 0
    If TempPos.X > BattleMap.Width Then TempPos.X = BattleMap.Width
    If TempPos.Y > BattleMap.Height Then TempPos.Y = BattleMap.Height
    If GroundBlocks(Int(TempPos.X), Int(TempPos.Y)).Occupied = False Then
      If GroundBlocks(Int(TempPos.X), Int(TempPos.Y)).TerrainType = TERRAINTYPE_GRASS Then
        Call SpawnObject(SeasonProfiles(SEASON_SUMMER).RockObjects.Indexes(1), SIDE_SCENERY, TempPos.X, TempPos.Y, TempPos.Z, 0, 0)
      End If
    End If
  Next I

End Select
Call AddTerrainSprites(Season)
End Sub
Sub AddTerrainSprites(Season)
For X = 0 To MaxMapX
  For Y = 0 To MaxMapY
    GroundBlocks(X, Y).AnimFrames(1) = 1
    GroundBlocks(X, Y).TerrainOverlayAmount = 1
    'Actual Terrain
    Select Case GroundBlocks(X, Y).TerrainType
    Case TERRAINTYPE_GRASS
      GroundBlocks(X, Y).SpriteNumbers(1) = SeasonProfiles(Season).GrassSprites.Indexes(Int(SeasonProfiles(Season).GrassSprites.IndexesActive * Rnd) + 1)
      GroundBlocks(X, Y).AnimFrames(1) = Int((Sprites(GroundBlocks(X, Y).SpriteNumbers(1)).SpriteGroups(1).FrameMax) * Rnd) + 1
    Case TERRAINTYPE_WATER
      GroundBlocks(X, Y).SpriteNumbers(1) = SeasonProfiles(Season).WaterSprites.Indexes(Int(SeasonProfiles(Season).GrassSprites.IndexesActive * Rnd) + 1)
      GroundBlocks(X, Y).AnimFrames(1) = Int(Sprites(SeasonProfiles(Season).WaterSprites.Indexes(Int(SeasonProfiles(Season).GrassSprites.IndexesActive * Rnd) + 1)).SpriteGroups(SPRITEGROUP_NORMAL).FrameMax * Rnd) + 1
    End Select
    'Overlay
    If GroundBlocks(X, Y).TerrainType = TERRAINTYPE_GRASS Then
      CurrentLayerNumber = 1
      If GroundBlocks(X - 1, Y).TerrainType = TERRAINTYPE_WATER Then
        CurrentLayerNumber = CurrentLayerNumber + 1
        GroundBlocks(X, Y).SpriteNumbers(CurrentLayerNumber) = SpriteStuff.GetSpriteIndex(SeasonProfiles(Season).WaterBorderSprite & "W")
        GroundBlocks(X, Y).AnimFrames(CurrentLayerNumber) = 1
      End If
      If GroundBlocks(X, Y - 1).TerrainType = TERRAINTYPE_WATER Then
        CurrentLayerNumber = CurrentLayerNumber + 1
        GroundBlocks(X, Y).SpriteNumbers(CurrentLayerNumber) = SpriteStuff.GetSpriteIndex(SeasonProfiles(Season).WaterBorderSprite & "N")
        GroundBlocks(X, Y).AnimFrames(CurrentLayerNumber) = 1
      End If
      If GroundBlocks(X + 1, Y).TerrainType = TERRAINTYPE_WATER Then
        CurrentLayerNumber = CurrentLayerNumber + 1
        GroundBlocks(X, Y).SpriteNumbers(CurrentLayerNumber) = SpriteStuff.GetSpriteIndex(SeasonProfiles(Season).WaterBorderSprite & "E")
        GroundBlocks(X, Y).AnimFrames(CurrentLayerNumber) = 1
      End If
      If GroundBlocks(X, Y + 1).TerrainType = TERRAINTYPE_WATER Then
        CurrentLayerNumber = CurrentLayerNumber + 1
        GroundBlocks(X, Y).SpriteNumbers(CurrentLayerNumber) = SpriteStuff.GetSpriteIndex(SeasonProfiles(Season).WaterBorderSprite & "S")
        GroundBlocks(X, Y).AnimFrames(CurrentLayerNumber) = 1
      End If
      If GroundBlocks(X - 1, Y - 1).TerrainType = TERRAINTYPE_WATER Then
        CurrentLayerNumber = CurrentLayerNumber + 1
        GroundBlocks(X, Y).SpriteNumbers(CurrentLayerNumber) = SpriteStuff.GetSpriteIndex(SeasonProfiles(Season).WaterBorderSprite & "NW")
        GroundBlocks(X, Y).AnimFrames(CurrentLayerNumber) = 1
      End If
      If GroundBlocks(X + 1, Y - 1).TerrainType = TERRAINTYPE_WATER Then
        CurrentLayerNumber = CurrentLayerNumber + 1
        GroundBlocks(X, Y).SpriteNumbers(CurrentLayerNumber) = SpriteStuff.GetSpriteIndex(SeasonProfiles(Season).WaterBorderSprite & "NE")
        GroundBlocks(X, Y).AnimFrames(CurrentLayerNumber) = 1
      End If
      If GroundBlocks(X + 1, Y + 1).TerrainType = TERRAINTYPE_WATER Then
        CurrentLayerNumber = CurrentLayerNumber + 1
        GroundBlocks(X, Y).SpriteNumbers(CurrentLayerNumber) = SpriteStuff.GetSpriteIndex(SeasonProfiles(Season).WaterBorderSprite & "SE")
        GroundBlocks(X, Y).AnimFrames(CurrentLayerNumber) = 1
      End If
      If GroundBlocks(X - 1, Y + 1).TerrainType = TERRAINTYPE_WATER Then
        CurrentLayerNumber = CurrentLayerNumber + 1
        GroundBlocks(X, Y).SpriteNumbers(CurrentLayerNumber) = SpriteStuff.GetSpriteIndex(SeasonProfiles(Season).WaterBorderSprite & "SW")
        GroundBlocks(X, Y).AnimFrames(CurrentLayerNumber) = 1
      End If
      
      GroundBlocks(X, Y).TerrainOverlayAmount = CurrentLayerNumber
    End If
  Next Y