innercore.pas

类似文明的游戏源代码。

        RealMap[Loc]:=RealMap[Loc] or fRiver;
      end
    end
  else result:=0;
  Q.Free
  end;

var
x,y,n,Dir,plus,Count,Loc0,Loc1,dy,dx,bLand,bHills,bMountains: integer;
CopyFrom: array[0..lxmax*lymax-1] of integer;

begin
FillChar(RealMap,MapSize*4,0);
plus:=0;
bMountains:=256;
while plus<MapSize*LandMass*ShMountains div 10000 do
  begin dec(bMountains);inc(plus,ElCount[bMountains]) end;
Count:=plus;
plus:=0;
bHills:=bMountains;
while plus<MapSize*LandMass*ShHiHills div 10000 do
  begin dec(bHills);inc(plus,ElCount[bHills]) end;
inc(Count,plus);
bLand:=bHills;
while Count<MapSize*LandMass div 100 do
  begin dec(bLand);inc(Count,ElCount[bLand]) end;

for Loc0:=lx to lx*(ly-1)-1 do
  if Elevation[Loc0]>=bMountains then RealMap[Loc0]:=fMountains
  else if Elevation[Loc0]>=bHills then RealMap[Loc0]:=fHills
  else if Elevation[Loc0]>=bLand then RealMap[Loc0]:=fGrass;

// remove one-tile islands
for Loc0:=0 to MapSize-1 do
  if RealMap[Loc0]>=fGrass then
    begin
    Count:=0;
    for dy:=-2 to 2 do for dx:=-2 to 2 do
      if abs(dx)+abs(dy)=2 then
        begin
        Loc1:=dLoc(Loc0,dx,dy);
        if (Loc1<0) or (RealMap[Loc1] and fTerrain<fGrass)
          or (RealMap[Loc1] and fTerrain=fArctic) then
          inc(Count); // count adjacent water
        end;
    if Count=8 then RealMap[Loc0]:=fOcean
    end;

if not preview then
  begin
  plus:=36*56*20*ShTestRiver div (LandMass*100);
  if plus>MapSize then plus:=MapSize;
  Loc0:=Random(MapSize);
  for n:=0 to plus-1 do
    begin
    if (RealMap[Loc0] and fTerrain>=fGrass) and (Loc0>=lx) and (Loc0<MapSize-lx) then
      RunRiver(Loc0);
    Loc0:=(Loc0+1)*primitive mod (MapSize+1) -1;
    end;
  end;

for Loc0:=0 to MapSize-1 do
  if (RealMap[Loc0]=fGrass) and (Random(100)<ShRandHills) then
    RealMap[Loc0]:=RealMap[Loc0] or fHills;

// make terrain types coherent
for Loc0:=0 to MapSize-1 do CopyFrom[Loc0]:=Loc0;

for n:=0 to unification*MapSize div 100 do
  begin
  y:=Random(ly);
  if abs(y-(ly shr 1))>ly div 4+Random(ly*hotunification div 100) then
    if y<ly shr 1 then y:=ly shr 1-y
    else y:=3*ly shr 1-y;
  Loc0:=lx*y+Random(lx);
  if RealMap[Loc0] and fTerrain=fGrass then
    begin
    Dir:=Random(4);
    Loc1:=dLoc(Loc0,Dir and 1 *2 -1,Dir shr 1 *2 -1);
    if (Loc1>=0) and (RealMap[Loc1] and fTerrain=fGrass) then
      begin
      while CopyFrom[Loc0]<>Loc0 do Loc0:=CopyFrom[Loc0];
      while CopyFrom[Loc1]<>Loc1 do Loc1:=CopyFrom[Loc1];
      if Loc1<Loc0 then CopyFrom[Loc0]:=Loc1
      else CopyFrom[Loc1]:=Loc0;
      end;
    end;
  end;

for Loc0:=0 to MapSize-1 do
  if (RealMap[Loc0] and fTerrain=fGrass) and (CopyFrom[Loc0]=Loc0) then
    RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or RndLow(Loc0 div lx);

for Loc0:=0 to MapSize-1 do
  if RealMap[Loc0] and fTerrain=fGrass then
    begin
    Loc1:=Loc0;
    while CopyFrom[Loc1]<>Loc1 do Loc1:=CopyFrom[Loc1];
    RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or RealMap[Loc1] and fTerrain
    end;

for Loc0:=0 to MapSize-1 do
  if RealMap[Loc0] and fTerrain=fGrass then
    begin // change grassland to swamp
    if Random(100)<ShSwamp then
      RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or fSwamp;
    end;

for Loc0:=0 to MapSize-1 do // change desert to prairie 1
  if RealMap[Loc0] and fTerrain=fDesert then
    begin
    if RealMap[Loc0] and fRiver<>0 then Count:=5
    else
      begin
      Count:=0;
      for Dir:=0 to 3 do
        begin
        Loc1:=dLoc(Loc0,Dir and 1 *2 -1,Dir shr 1 *2 -1);
        if Loc1>=0 then
          if RealMap[Loc1] and fTerrain<fGrass then inc(Count,2)
        end;
      end;
    if Count>=4 then RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or fPrairie
    end;

for Loc0:=0 to MapSize-1 do // change desert to prairie 2
  if RealMap[Loc0] and fTerrain=fDesert then
    begin
    Count:=0;
    for Dir:=0 to 3 do
      begin
      Loc1:=dLoc(Loc0,Dir and 1 *2 -1,Dir shr 1 *2 -1);
      if Loc1>=0 then
        if RealMap[Loc1] and fTerrain<>fDesert then inc(Count)
      end;
    if Count>=4 then RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or fPrairie
    end;

for Loc0:=0 to MapSize-1 do CheckShore(Loc0); // change ocean to shore
for x:=0 to lx-1 do
  begin
  RealMap[x+lx*0]:=fArctic;
  if RealMap[x+lx*1]>=fGrass then
    RealMap[x+lx*1]:=RealMap[x+lx*1] and not fTerrain or fTundra;
  if RealMap[x+lx*(ly-2)]>=fGrass then
    RealMap[x+lx*(ly-2)]:=RealMap[x+lx*(ly-2)] and not fTerrain or fTundra;
  RealMap[x+lx*(ly-1)]:=fArctic
  end;

for Loc0:=0 to MapSize-1 do //define special terrain tiles
  RealMap[Loc0]:=RealMap[Loc0] or SpecialTile(Loc0) shl 5 or fTerritory;

if not preview then
  begin FindContinents; RarePositions; end;
end;

procedure StartPositions;
// define nation start positions
// must be done after FindContinents

var
CountGood:(cgBest,cgFlat,cgLand);

  function IsGoodTile(Loc: integer): boolean;
  var
  xLoc,yLoc: integer;
  begin
  xLoc:=Loc mod lx; yLoc:=Loc div lx;
  if RealMap[Loc] and fRare<>0 then result:=false
  else
    case CountGood of
      cgBest:
        result:=(RealMap[Loc] and fTerrain in [fGrass,fPrairie,fTundra,fSwamp,fForest])
          and Odd((lymax+xLoc-yLoc shr 1) shr 1+xLoc+(yLoc+1) shr 1);
      cgFlat:
        result:=(RealMap[Loc] and fTerrain in [fGrass,fPrairie,fTundra,fSwamp,fForest]);
      cgLand:
        result:= RealMap[Loc] and fTerrain>=fGrass;
      end;
  end;

const
MaxCityLoc=64;

var
p1,nAlive,c,Loc,Loc1,CntGood,CntGoodGrass,MinDist,Tries,i,j,n,nsc,TestLoc,dx,dy,
  BestDist,Dist,TestDist,MinGood,nIrrLoc,xLoc,yLoc,qx,qy:integer;
ccount:array[0..lxmax*lymax-1] of word;
sc,TestStartLoc,StartLoc0,sccount:array[1..nPl] of integer;
CityLoc: array[1..nPl,0..MaxCityLoc-1] of integer;
nCityLoc: array[1..nPl] of integer;
IrrLoc: array[0..20] of integer;
ok: boolean;

begin
nAlive:=0;
for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then inc(nAlive);
if nAlive=0 then exit;

{count good tiles}
FillChar(ccount,MapSize*2,0);
for Loc:=0 to MapSize-1 do
  if RealMap[Loc] and fTerrain=fGrass then
    if SpecialTile(Loc)=1 then inc(ccount[Continent[Loc]],3)
    else inc(ccount[Continent[Loc]],2)
  else if RealMap[Loc] and fTerrain in [fPrairie,fSwamp,fForest,fHills] then
    inc(ccount[Continent[Loc]]);

Loc:=0;while ccount[Loc]>0 do inc(Loc);
for i:=1 to nAlive do begin sc[i]:=Loc; sccount[i]:=1 end;
  {init with zero size start continents, then search bigger ones}
for Loc:=0 to MapSize-1 do if ccount[Loc]>0 then
  begin // search biggest continents
  p1:=nAlive+1;
  while (p1>1) and (ccount[Loc]>ccount[sc[p1-1]]) do
    begin if p1<nAlive+1 then sc[p1]:=sc[p1-1]; dec(p1) end;
  if p1<nAlive+1 then sc[p1]:=Loc;
  end;
nsc:=nAlive;
repeat
  c:=1; // search least crowded continent after smallest
  for i:=2 to nsc-1 do
    if ccount[sc[i]]*(2*sccount[c]+1)>ccount[sc[c]]*(2*sccount[i]+1) then
      c:=i;
  if ccount[sc[nsc]]*(2*sccount[c]+1)>ccount[sc[c]] then
    Break; // even least crowded continent is more crowded than smallest
  inc(sccount[c]);
  dec(nsc)
until sccount[nsc]>1;

MinGood:=7;
CountGood:=cgBest;
repeat
  dec(MinGood);
  if (MinGood=3) and (CountGood<cgLand) then // too demanding!
    begin inc(CountGood); MinGood:=6 end;
  FillChar(nCityLoc,SizeOf(nCityLoc),0);
  Loc:=Random(MapSize);
  for i:=0 to MapSize-1 do
    begin
    if ((Loc>=4*lx) and (Loc<MapSize-4*lx) or (CountGood>=cgLand))
      and IsGoodTile(Loc) then
      begin
      c:=nsc;
      while (c>0) and (Continent[Loc]<>sc[c]) do dec(c);
      if (c>0) and (nCityLoc[c]<MaxCityLoc) then
        begin
        CntGood:=1;
        for dy:=-3 to 3 do for dx:=-3 to 3 do
          if ((dx+dy) and 1=0) and ((dx<>0) or (dy<>0))
            and ((dx<>3) and (dx<>-3) or (dy<>3) and (dy<>-3)) then
          begin
          Loc1:=dLoc(Loc,dx,dy);
          if (Loc1>=0) and IsGoodTile(Loc1) then inc(CntGood)
          end;
        if CntGood>=MinGood then
          begin
          CityLoc[c,nCityLoc[c]]:=Loc;
          inc(nCityLoc[c])
          end
        end
      end;
    Loc:=(Loc+1)*primitive mod (MapSize+1) -1;
    end;

  ok:=true;
  for c:=1 to nsc do
    if nCityLoc[c]<sccount[c]*(8-MinGood) div (7-MinGood) then ok:=false;
until ok;

p1:=1;
for c:=1 to nsc do
  begin // for all start continents
  Dist:=0;
  for n:=0 to 1 shl sccount[c] *32 do
    begin
    for i:=p1 to p1+sccount[c]-1 do
      TestStartLoc[i]:=CityLoc[c,Random(nCityLoc[c])];
    MinDist:=MaxInt;
    for i:=p1 to p1+sccount[c]-2 do for j:=i+1 to p1+sccount[c]-1 do
      begin
      TestDist:=Distance(TestStartLoc[i],TestStartLoc[j]);
      if TestDist<MinDist then MinDist:=TestDist;
      end;
    if MinDist>Dist then
      begin // choose start location set with max mutual distance
      for i:=p1 to p1+sccount[c]-1 do StartLoc0[i]:=TestStartLoc[i];
      Dist:=MinDist
      end
    end;
  p1:=p1+sccount[c]
  end;

// make start locs fertile
for p1:=1 to nAlive do
  begin
  RealMap[StartLoc0[p1]]:=RealMap[StartLoc0[p1]] and not (fTerrain or fSpecial)
    or fGrass or fSpecial1;
  CntGood:=1;
  CntGoodGrass:=1;
  for dy:=-3 to 3 do for dx:=-3 to 3 do
    if ((dx+dy) and 1=0) and ((dx<>0) or (dy<>0))
      and ((dx<>3) and (dx<>-3) or (dy<>3) and (dy<>-3)) then
    begin
    Loc1:=dLoc(StartLoc0[p1],dx,dy);
    if (Loc1>=0) and IsGoodTile(Loc1) then
      if RealMap[Loc1] and fTerrain=fGrass then inc(CntGoodGrass)
      else inc(CntGood);
    end;
  for dy:=-3 to 3 do for dx:=-3 to 3 do
    if ((dx+dy) and 1=0) and ((dx<>0) or (dy<>0))
      and ((dx<>3) and (dx<>-3) or (dy<>3) and (dy<>-3)) then
    begin
    Loc1:=dLoc(StartLoc0[p1],dx,dy);
    if Loc1>=0 then
      if IsGoodTile(Loc1) and (random(CntGood)<MinGood-CntGoodGrass+1) then
        begin
        RealMap[Loc1]:=RealMap[Loc1] and not (fTerrain or fSpecial) or fGrass;
        RealMap[Loc1]:=RealMap[Loc1] or SpecialTile(Loc1) shl 5;
        end
      else if RealMap[Loc1] and fTerrain=fDesert then
        RealMap[Loc1]:=RealMap[Loc1] and not fTerrain or fPrairie
      else if (RealMap[Loc1] and fTerrain in [fPrairie,fTundra,fSwamp])
        and (random(2)=0) then
        RealMap[Loc1]:=RealMap[Loc1] and not fTerrain or fForest;
    end;

  // first irrigation
  nIrrLoc:=0;
  for dy:=-3 to 3 do for dx:=-3 to 3 do
    if ((dx+dy) and 1=0) and ((dx<>0) or (dy<>0))
      and ((dx<>3) and (dx<>-3) or (dy<>3) and (dy<>-3)) then
    begin
    Loc1:=dLoc(StartLoc0[p1],dx,dy);
    if (Loc1>=0)
      and (RealMap[Loc1] and (fTerrain or fSpecial)=fGrass or fSpecial1) then
      begin
      IrrLoc[nIrrLoc]:=Loc1;
      inc(nIrrLoc);
      end;
    end;
  i:=2;
  if i>nIrrLoc then i:=nIrrLoc;
  while i>0 do
    begin
    j:=random(nIrrLoc);
    RealMap[IrrLoc[j]]:=RealMap[IrrLoc[j]] or tiIrrigation;
    IrrLoc[j]:=IrrLoc[nIrrLoc-1];
    dec(nIrrLoc);
    dec(i)
    end;
  end;

StartLoc[0]:=0;
for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then
  begin
  repeat i:=Random(nAlive)+1 until StartLoc0[i]>=0;
  StartLoc[p1]:=StartLoc0[i];
  StartLoc0[i]:=-1
  end;
SaveMapCenterLoc:=StartLoc[0];

// second unit starting position
// !!!todo: avoid conflicts
for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then
  begin
  StartLoc2[p1]:=StartLoc[p1];
  for dy:=-2 to 2 do for dx:=-2 to 2 do if abs(dx)+abs(dy)=2 then
    begin
    Loc1:=dLoc(StartLoc[p1],dx,dy);
    if (Loc1<0)
      or (RealMap[Loc1] and fTerrain in [fOcean, fShore, fDesert, fArctic, fMountains])
      or (RealMap[Loc1] and fRare<>0) then
      TestDist:=-1
    else if RealMap[Loc1] and fTerrain=fGrass then TestDist:=2
    else if Terrain[RealMap[Loc1] and fTerrain].IrrEff>0 then TestDist:=1
    else TestDist:=0;
    if (StartLoc2[p1]=StartLoc[p1]) or (TestDist>BestDist) then
      begin StartLoc2[p1]:=Loc1; BestDist:=TestDist; n:=1; end
    else if TestDist=BestDist then
      begin inc(n); if random(n)=0 then StartLoc2[p1]:=Loc1; end;
    end
  end;
end; {StartPositions}

procedure PredefinedStartPositions(Human: integer);
// use predefined nation start positions
var
i,p1,Loc1,nAlive,nStartLoc0,nPrefStartLoc0,imax: integer;
StartLoc0: array[0..lxmax*lymax-1] of integer;
ishuman: boolean;
begin
nAlive:=0;
for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then inc(nAlive);
if nAlive=0 then exit;

// calculate starting positions
nStartLoc0:=0;
nPrefStartLoc0:=0;
for Loc1:=0 to MapSize-1 do
  if RealMap[Loc1] and fPrefStartPos<>0 then
    begin
    StartLoc0[nStartLoc0]:=StartLoc0[nPrefStartLoc0];
    StartLoc0[nPrefStartLoc0]:=Loc1;
    inc(nPrefStartLoc0);
    inc(nStartLoc0);
    RealMap[Loc1]:=RealMap[Loc1] and not fPrefStartPos;
    end
  else if RealMap[Loc1] and fStartPos<>0 then
    begin
    StartLoc0[nStartLoc0]:=Loc1;
    inc(nStartLoc0);
    RealMap[Loc1]:=RealMap[Loc1] and not fStartPos;
    end;
assert(nStartLoc0>=nAlive);

StartLoc[0]:=0;
for ishuman:=true downto false do for p1:=0 to nPl-1 do
  if (1 shl p1 and GAlive<>0) and ((1 shl p1 and Human<>0)=ishuman) then
    begin
    dec(nStartLoc0);
    imax:=nStartLoc0;
    if nPrefStartLoc0>0 then