innercore.pas

类似文明的游戏源代码。

{$INCLUDE switches}
//{$DEFINE TEXTLOG}
//{$DEFINE LOADPERF}

unit InnerCore;

interface

uses
Protocol,CmdList;

const
// additional test flags
FastContact=false; {extra small world with railroad everywhere}

numax=4096; {max units/player, max. 4096}
ncmax=1024; {max cities/player, max. 4096}
nmmax=256; {max models/player, max. 1024}
neumax=4096;
necmax=1024;
nemmax=1024;

lNoObserve=0; lObserveUnhidden=1; lObserveAll=2; lObserveSuper=3; //observe levels

FutureTech=[futResearchTechnology,futProductionTechnology,futArmorTechnology,
  futMissileTechnology];

TerrType_Canalable=[fGrass,fDesert,fPrairie,fTundra,fSwamp,fForest];

nStartUn=1;
StartUn: array[0..nStartUn-1] of integer=(0); //mix of start units

var
GAlive, {players alive; bitset of 1 shl p}
GWatching,
RND, {world map randseed}
lx,ly,
MapSize, // = lx*ly
LandMass,
SaveMapCenterLoc,
PeaceEnded,
GTurn, {current turn}
GTestFlags: integer;
Mode: (moLoading_Fast, moLoading, moPlaying);
GWonder: array[0..27] of TWonderInfo;
ProcessClientData: array[0..nPl-1] of boolean;
CL: TCmdList;
{$IFDEF TEXTLOG}CmdInfo: string; TextLog: TextFile;{$ENDIF}
{$IFDEF LOADPERF}time_total,time_total0,time_x0,time_x1,time_a,time_b,time_c: int64;{$ENDIF}

// map data
RealMap: array[0..lxmax*lymax-1] of Cardinal;
Continent:array[0..lxmax*lymax-1] of integer; {continent id for each tile}
Occupant:array[0..lxmax*lymax-1] of ShortInt; {occupying player for each tile}
ZoCMap:array[0..lxmax*lymax-1] of ShortInt;
ObserveLevel:array[0..lxmax*lymax-1] of Cardinal;
  {Observe Level of player p in bits 2*p and 2*p+1}
UsedByCity:array[0..lxmax*lymax-1] of integer; {location of exploiting city for
  each tile, =-1 if not exploited}

// player data
RW: array[0..nPl-1] of TPlayerContext;{player data}
Difficulty: array[0..nPl-1] of integer;
GShip: array[0..nPl-1] of TShipInfo;
ResourceMask: array[0..nPl-1] of Cardinal;
Founded: array[0..nPl-1] of integer; {number of cities founded}
Territory: array[0..nPl] of integer;
LastValidStat,
Researched,
Discovered, // number of tiles discovered
GrWallContinent: array[0..nPl-1] of integer;
RWemix: array[0..nPl-1, 0..nPl-1, 0..nmmax-1] of SmallInt;
  // [p1,p2,mix] -> index of p2's model mix in p1's enemy model list
Destroyed: array[0..nPl-1, 0..nPl-1, 0..nmmax-1] of SmallInt;
  // [p1,p2,mix] -> number of p2's units with model mix that p1 has destroyed
nTech: array[0..nPl-1] of integer; {number of known techs}

procedure IntServer(Command,Player,Subject:integer;var Data);
procedure CompactLists(p: integer);
procedure ClearTestFlags(ClearFlags: integer);
procedure SetTestFlags(p,SetFlags: integer);

// Tech Related Functions
function TechBaseCost(nTech,diff: integer): integer;
function TechCost(p: integer): integer;
procedure CalculateModel(var m: TModel);
procedure CheckSpecialModels(p,pre: integer);
procedure EnableDevModel(p: integer);
procedure SeeTech(p,ad: integer);
procedure DiscoverTech(p,ad: integer);

// Location Navigation
function dLoc(Loc,dx,dy: integer): integer;
procedure dxdy(Loc0,Loc1: integer; var dx,dy: integer);
function Distance(Loc0,Loc1: integer): integer;

// Game Initialization
procedure InitRandomGame;
procedure InitMapGame(Human: integer);
procedure ReleaseGame;

// Map Editor
function MapGeneratorAvailable: boolean;
procedure CreateElevation;
procedure CreateMap(preview: boolean);
procedure InitMapEditor;
procedure ReleaseMapEditor;
procedure EditTile(Loc, NewTile: integer);

// Map Revealing
procedure Strongest(Loc:integer;var uix,Strength,Bonus,Cnt:integer);
procedure SearchCity(Loc: integer; var p,cix: integer);
procedure TellAboutModel(p,taOwner,tamix: integer);
function Discover(Loc,p,r,AdjacentLevel: integer; TellAllied, EnableContact: boolean): boolean;
procedure DiscoverAll(p, Level: integer);
procedure DiscoverViewAreas(p: integer);
function GetUnitStack(p,Loc: integer): integer;
procedure UpdateUnitMap(Loc: integer; CityChange: boolean = false);

// Territory Calculation
procedure CheckBorders(OriginLoc: integer; PlayerLosingCity: integer = -1);
procedure LogCheckBorders(p,cix: integer; PlayerLosingCity: integer = -1);

// City Tiles
function GetTileInfo(p, cix, Loc: integer; var Info: TTileInfo): integer;
function NextBest(p,cix:integer):integer;
function NextWorst(p,cix:integer):integer;
function NextPoll(p,cix:integer):integer;
procedure AddCityTile(p,cix,fix: integer);
procedure RemoveCityTile(p,cix,fix: integer);

// Map Processing
procedure CreateUnit(p,mix: integer);
procedure CreateStartUnits;
procedure FreeUnit(p,uix: integer);
procedure PlaceUnit(p,uix: integer);
procedure RemoveUnit(p,uix: integer; Enemy: integer = -1);
procedure RemoveUnit_UpdateMap(p,uix: integer);
procedure RemoveAllUnits(p,Loc: integer; Enemy: integer = -1);
procedure RemoveDomainUnits(d,p,Loc: integer);
procedure CheckExpiration(Wonder: integer);
procedure FoundCity(p,FoundLoc: integer);
procedure DestroyCity(p,cix: integer; SaveUnits: boolean);
procedure ChangeCityOwner(pOld,cixOld,pNew: integer);
procedure CompleteJob(p,Loc,Job: integer);

// Diplomacy
procedure IntroduceEnemy(p1,p2: integer);
procedure GiveCivilReport(p, pAbout: integer);
procedure GiveMilReport(p, pAbout: integer);
procedure ShowPrice(pSender, pTarget, Price: integer);
function PayPrice(pSender, pTarget, Price: integer; execute: boolean): boolean;
procedure CancelTreaty(p, pWith: integer; DecreaseCredibility: boolean = true);
function DoSpyMission(p,pCity,cix,Mission: integer): Cardinal;


implementation

uses
{$IFDEF LOADPERF}SysUtils, Windows,{$ENDIF}
{$IFDEF TEXTLOG}SysUtils,{$ENDIF}
IPQ;

procedure CompactLists(p: integer);
var
uix,uix1,cix: integer;
{$IFOPT O-}Loc1,fix,dx,dy: integer;{$ENDIF}
begin
with RW[p] do
  begin
  // compact unit list
  uix:=0;
  while uix<nUn do
    if Un[uix].Loc<0 then
      begin
      dec(nUn);
      Un[uix]:=Un[nUn]; {replace removed unit by last}
      if (Un[uix].TroopLoad>0) or (Un[uix].AirLoad>0) then
        for uix1:=0 to nUn-1 do
          if Un[uix1].Master=nUn then Un[uix1].Master:=uix;
            // index of last unit changes
      end
    else inc(uix);

  // compact city list
  cix:=0;
  while cix<nCity do
    if City[cix].Loc<0 then
      begin
      dec(nCity);
      City[cix]:=City[nCity]; {replace city by last}
      for uix1:=0 to nUn-1 do
        if Un[uix1].Home=nCity then Un[uix1].Home:=cix;
          {index of last city changes}
      end
    else inc(cix);

  // compact enemy city list
  cix:=0;
  while cix<nEnemyCity do
    if EnemyCity[cix].Loc<0 then
      begin
      dec(nEnemyCity);
      EnemyCity[cix]:=EnemyCity[nEnemyCity]; {replace city by last}
      end
    else inc(cix);

{$IFOPT O-}
  for cix:=0 to nCity-1 do with City[cix] do
    for fix:=1 to 26 do if Tiles and (1 shl fix)<>0 then
      begin
      dy:=fix shr 2-3; dx:=fix and 3 shl 1 -3 + (dy+3) and 1;
      Loc1:=dLoc(Loc,dx,dy);
      assert(UsedByCity[Loc1]=Loc);
      end;
{$ENDIF}
  end;
end; // CompactLists

{
                         Tech Related Functions
 ____________________________________________________________________
}
function TechBaseCost(nTech,diff: integer): integer;
var
c0: single;
begin
c0:=TechFormula_M[diff]*(nTech+4)*exp((nTech+4)/TechFormula_D[diff]);
if c0>=$10000000 then result:=$10000000
else result:=trunc(c0)
end;

function TechCost(p: integer): integer;
begin
with RW[p] do
  begin
  result:=TechBaseCost(nTech[p],Difficulty[p]);
  if ResearchTech>=0 then
    if (ResearchTech=adMilitary) or (Tech[ResearchTech]=tsSeen) then
      result:=result shr 1
    else if ResearchTech in FutureTech then
      if RW[p].Government=gLybertarianism then
        result:=result*2
      else result:=result*4;
  end
end;

procedure SetModelFlags(var m: TModel);
begin
m.Flags:=0;
if (m.Domain=dGround) and (m.Kind<>mkDiplomat) then
  m.Flags:=m.Flags or mdZOC;
if m.Attack+m.Cap[mcBombs]=0 then
  m.Flags:=m.Flags or mdCivil;
if (m.Kind=mkCaravan) or (m.Cap[mcOver]>0)
  or (m.Domain=dSea) and (m.Weight>=6) then
  m.Flags:=m.Flags or mdDoubleSupport;
end;

procedure CalculateModel(var m: TModel);
{calculate attack, defense, cost... of a model by features}
var
i: integer;
begin
with m do
  begin
  Attack:=(Cap[mcOffense]+Cap[mcOver])*MStrength;
  Defense:=(Cap[mcDefense]+Cap[mcOver])*MStrength;
  case Domain of
    dGround: Speed:=150+Cap[mcMob]*50;
    dSea: Speed:=350+100*(Cap[mcSE]+Cap[mcNP])+200*Cap[mcTurbines];
    dAir: Speed:=850+400*Cap[mcJet];
    end;
  Cost:=0;
  for i:=0 to nFeature-1 do
    if 1 shl Domain and Feature[i].Domains<>0 then
      inc(Cost,Cap[i]*Feature[i].Cost);
  Cost:=Cost*MCost;
  Weight:=0;
  for i:=0 to nFeature-1 do
    if 1 shl Domain and Feature[i].Domains<>0 then
      if (Domain=dGround) and (i=mcDefense) then inc(Weight,Cap[i]*2)
      else inc(Weight,Cap[i]*Feature[i].Weight);
  end;
SetModelFlags(m);
end;

procedure CheckSpecialModels(p,pre: integer);
var
i,mix1: integer;
HasAlready: boolean;
begin
for i:=0 to nSpecialModel-1 do {check whether new special model available}
  if (SpecialModelPreq[i]=pre) and (RW[p].nModel<nmmax) then
    begin
    HasAlready:=false;
    for mix1:=0 to RW[p].nModel-1 do
      if (RW[p].Model[mix1].Kind=SpecialModel[i].Kind)
        and (RW[p].Model[mix1].Attack=SpecialModel[i].Attack)
        and (RW[p].Model[mix1].Speed=SpecialModel[i].Speed) then
        HasAlready:=true;
    if not HasAlready then
      begin
      RW[p].Model[RW[p].nModel]:=SpecialModel[i];
      SetModelFlags(RW[p].Model[RW[p].nModel]);
      with RW[p].Model[RW[p].nModel] do
        begin
        Status:=0;
        SavedStatus:=0;
        IntroTurn:=GTurn;
        Built:=0;
        Lost:=0;
        ID:=p shl 12+RW[p].nModel
        end;
      inc(RW[p].nModel);
      end
    end;
end;

procedure EnableDevModel(p: integer);
begin
with RW[p] do if nModel<nmmax then
  begin
  Model[nModel]:=DevModel;
  with Model[nModel] do
    begin
    Status:=0;
    SavedStatus:=0;
    IntroTurn:=GTurn;
    Built:=0;
    Lost:=0;
    ID:=p shl 12+nModel
    end;
  inc(nModel);
  inc(Researched[p])
  end
end;

procedure SeeTech(p,ad: integer);
begin
{$IFDEF TEXTLOG}CmdInfo:=CmdInfo+Format(' P%d:A%d', [p,ad]);{$ENDIF}
RW[p].Tech[ad]:=tsSeen;
inc(nTech[p]);
inc(Researched[p])
end;

procedure FreeSlaves;
var
p1,uix: integer;
begin
for p1:=0 to nPl-1 do if (GAlive and (1 shl p1)<>0) then
  for uix:=0 to RW[p1].nUn-1 do
    if RW[p1].Model[RW[p1].Un[uix].mix].Kind=mkSlaves then
      RW[p1].Un[uix].Job:=jNone
end;

procedure DiscoverTech(p,ad: integer);

  procedure TellAboutKeyTech(p,Source: integer);
  var
  i,p1: integer;
  begin
  for i:=1 to 3 do if ad=AgePreq[i] then
    for p1:=0 to nPl-1 do if RW[p].Treaty[p1]>trNoContact then
      RW[p1].EnemyReport[p].Tech[ad]:=Source;
  end;

var
i,p1,Owner,Cnt: integer;
begin
if ad in FutureTech then
  begin
  if RW[p].Tech[ad]<tsApplicable then RW[p].Tech[ad]:=1
  else inc(RW[p].Tech[ad]);
  if ad<>futResearchTechnology then inc(nTech[p],2);
  inc(Researched[p],8);
  exit;
  end;

if RW[p].Tech[ad]=tsSeen then
  begin inc(nTech[p]); inc(Researched[p]); end
else begin inc(nTech[p],2); inc(Researched[p],2); end;
RW[p].Tech[ad]:=tsResearched;
TellAboutKeyTech(p,tsResearched);
CheckSpecialModels(p,ad);
if ad=adScience then
  ResourceMask[p]:=ResourceMask[p] or fSpecial2;
if ad=adMassProduction then
  ResourceMask[p]:=ResourceMask[p] or (fRare1 or fRare2);

for i:=0 to 27 do {check whether wonders expired}
  if (GWonder[i].EffectiveOwner<>GWonder[woEiffel].EffectiveOwner)
    and (Imp[i].Expiration=ad) then
    begin
    GWonder[i].EffectiveOwner:=-1;
    if i=woPyramids then FreeSlaves;
    end;

// check great library effect
Owner:=GWonder[woGrLibrary].EffectiveOwner;
if (Owner>=0) and (Owner<>p) and (RW[Owner].Tech[ad]<tsApplicable) then
  begin
  Cnt:=0;
  for p1:=0 to nPl-1 do
    if (GAlive and (1 shl p1)<>0) and (RW[p1].Tech[ad]<>tsNA) then
     inc(Cnt);
  if Cnt>=2 then
    begin
    if RW[Owner].ResearchTech=ad then
      begin
      RW[Owner].Happened:=RW[Owner].Happened or phTech;
      RW[Owner].ResearchTech:=-1
      end;
    RW[Owner].Tech[ad]:=tsGrLibrary;
    inc(nTech[Owner],2);
    inc(Researched[Owner],2);
    TellAboutKeyTech(Owner,tsGrLibrary);
    CheckSpecialModels(Owner,ad);
    if ad=adScience then
      ResourceMask[Owner]:=ResourceMask[Owner] or fSpecial2;
    if ad=adMassProduction then
      ResourceMask[Owner]:=ResourceMask[Owner] or (fRare1 or fRare2);
    end