1  {$INCLUDE Switches.inc}


2  // {$DEFINE TEXTLOG}


3  // {$DEFINE LOADPERF}


4  unit Database;


5 


6  interface


7 


8  uses


9  SysUtils, Protocol, CmdList;


10 


11  const


12  // additional test flags


13  //{$DEFINE FastContact} { extra small world with railroad everywhere }


14 


15  neumax = 4096;


16  necmax = 1024;


17  nemmax = 1024;


18 


19  lNoObserve = 0;


20  lObserveUnhidden = 1;


21  lObserveAll = 2;


22  lObserveSuper = 3; // observe levels


23 


24  TerrType_Canalable = [fGrass, fDesert, fPrairie, fTundra, fSwamp,


25  fForest, fHills];


26 


27  nStartUn = 1;


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


29 


30  CityOwnTile = 13;


31 


32  type


33  TGameMode = (moLoading_Fast, moLoading, moMovie, moPlaying);


34 


35  var


36  GAlive: Integer; { players alive; bitset of 1 shl p }


37  GWatching: Integer;


38  GInitialized: Integer;


39  GAI: Integer;


40  RND: Integer; { world map randseed }


41  lx: Integer;


42  ly: Integer;


43  MapSize: Integer; // = lx*ly


44  LandMass: Integer;


45  {$IFOPT O}InvalidTreatyMap, {$ENDIF}


46  SaveMapCenterLoc: Integer;


47  PeaceEnded: Integer;


48  GTurn: Integer; { current turn }


49  GTestFlags: Integer;


50  Mode: TGameMode;


51  GWonder: array [0 .. nWonder  1] of TWonderInfo;


52  ServerVersion: array [0 .. nPl  1] of integer;


53  ProcessClientData: array [0 .. nPl  1] of boolean;


54  CL: TCmdList;


55  {$IFDEF TEXTLOG}CmdInfo: string;


56  TextLog: TextFile; {$ENDIF}


57  {$IFDEF LOADPERF}time_total, time_total0, time_x0, time_x1, time_a, time_b, time_c: int64; {$ENDIF}


58  // map data


59  RealMap: array [0 .. lxmax * lymax  1] of Cardinal;


60  Continent: array [0 .. lxmax * lymax  1] of integer;


61  { continent id for each tile }


62  Occupant: array [0 .. lxmax * lymax  1] of ShortInt;


63  { occupying player for each tile }


64  ZoCMap: array [0 .. lxmax * lymax  1] of ShortInt;


65  ObserveLevel: array [0 .. lxmax * lymax  1] of Cardinal;


66  { Observe Level of player p in bits 2*p and 2*p+1 }


67  UsedByCity: array [0 .. lxmax * lymax  1] of integer;


68  { location of exploiting city for


69  each tile, =1 if not exploited }


70 


71  // player data


72  RW: array [0 .. nPl  1] of TPlayerContext; { player data }


73  Difficulty: array [0 .. nPl  1] of integer;


74  GShip: array [0 .. nPl  1] of TShipInfo;


75  ResourceMask: array [0 .. nPl  1] of Cardinal;


76  Founded: array [0 .. nPl  1] of integer; { number of cities founded }


77  TerritoryCount: array [0 .. nPl] of integer;


78  LastValidStat, Researched, Discovered, // number of tiles discovered


79  GrWallContinent: array [0 .. nPl  1] of integer;


80  RWemix: array [0 .. nPl  1, 0 .. nPl  1, 0 .. nmmax  1] of SmallInt;


81  // [p1,p2,mix] > index of p2's model mix in p1's enemy model list


82  Destroyed: array [0 .. nPl  1, 0 .. nPl  1, 0 .. nmmax  1] of SmallInt;


83  // [p1,p2,mix] > number of p2's units with model mix that p1 has destroyed


84  nTech: array [0 .. nPl  1] of integer; { number of known techs }


85  // NewContact: array[0..nPl1,0..nPl1] of boolean;


86 


87  type


88  TVicinity8Loc = array [0 .. 7] of integer;


89  TVicinity21Loc = array [0 .. 27] of integer;


90 


91  procedure MaskD(var x: array of Cardinal; Count, Mask: Cardinal);


92  procedure IntServer(Command, Player, Subject: integer; var Data);


93  procedure CompactLists(p: integer);


94  procedure ClearTestFlags(ClearFlags: integer);


95  procedure SetTestFlags(p, SetFlags: integer);


96 


97  // Tech Related Functions


98  function TechBaseCost(nTech, diff: integer): integer;


99  function TechCost(p: integer): integer;


100  procedure CalculateModel(var m: TModel);


101  procedure CheckSpecialModels(p, pre: integer);


102  procedure EnableDevModel(p: integer);


103  procedure SeeTech(p, ad: integer);


104  procedure DiscoverTech(p, ad: integer);


105  procedure CheckExpiration(Wonder: integer);


106 


107  // Location Navigation


108  function dLoc(Loc, dx, dy: integer): integer;


109  procedure dxdy(Loc0, Loc1: integer; var dx, dy: integer);


110  function Distance(Loc0, Loc1: integer): integer;


111  procedure V8_to_Loc(Loc0: integer; var VicinityLoc: TVicinity8Loc);


112  procedure V21_to_Loc(Loc0: integer; var VicinityLoc: TVicinity21Loc);


113 


114  // Game Initialization


115  procedure InitRandomGame;


116  procedure InitMapGame(Human: integer);


117  procedure ReleaseGame;


118 


119  // Map Editor


120  function MapGeneratorAvailable: boolean;


121  procedure CreateElevation;


122  procedure CreateMap(preview: boolean);


123  procedure InitMapEditor;


124  procedure ReleaseMapEditor;


125  procedure EditTile(Loc, NewTile: integer);


126 


127  // Map Revealing


128  function GetTileInfo(p, cix, Loc: integer; var Info: TTileInfo): integer;


129  procedure Strongest(Loc: integer; var uix, Strength, Bonus, Cnt: integer);


130  function UnitSpeed(p, mix, Health: integer): integer;


131  procedure GetUnitReport(p, uix: integer; var UnitReport: TUnitReport);


132  procedure SearchCity(Loc: integer; var p, cix: integer);


133  procedure TellAboutModel(p, taOwner, tamix: integer);


134  function emixSafe(p, taOwner, tamix: integer): integer;


135  function Discover9(Loc, p, Level: integer;


136  TellAllied, EnableContact: boolean): boolean;


137  function Discover21(Loc, p, AdjacentLevel: integer;


138  TellAllied, EnableContact: boolean): boolean;


139  procedure DiscoverAll(p, Level: integer);


140  procedure DiscoverViewAreas(p: integer);


141  function GetUnitStack(p, Loc: integer): integer;


142  procedure UpdateUnitMap(Loc: integer; CityChange: boolean = false);


143  procedure RecalcV8ZoC(p, Loc: integer);


144  procedure RecalcMapZoC(p: integer);


145  procedure RecalcPeaceMap(p: integer);


146 


147  // Territory Calculation


148  procedure CheckBorders(OriginLoc: integer; PlayerLosingCity: integer = 1);


149  procedure LogCheckBorders(p, cix: integer; PlayerLosingCity: integer = 1);


150 


151  // Map Processing


152  procedure CreateUnit(p, mix: integer);


153  procedure FreeUnit(p, uix: integer);


154  procedure PlaceUnit(p, uix: integer);


155  procedure RemoveUnit(p, uix: integer; Enemy: integer = 1);


156  procedure RemoveUnit_UpdateMap(p, uix: integer);


157  procedure RemoveAllUnits(p, Loc: integer; Enemy: integer = 1);


158  procedure RemoveDomainUnits(d, p, Loc: integer);


159  procedure FoundCity(p, FoundLoc: integer);


160  procedure DestroyCity(p, cix: integer; SaveUnits: boolean);


161  procedure ChangeCityOwner(pOld, cixOld, pNew: integer);


162  procedure CompleteJob(p, Loc, Job: integer);


163 


164  // Diplomacy


165  procedure IntroduceEnemy(p1, p2: integer);


166  procedure GiveCivilReport(p, pAbout: integer);


167  procedure GiveMilReport(p, pAbout: integer);


168  procedure ShowPrice(pSender, pTarget, Price: integer);


169  function PayPrice(pSender, pTarget, Price: integer; execute: boolean): boolean;


170  procedure CancelTreaty(p, pWith: integer; DecreaseCredibility: boolean = true);


171  function DoSpyMission(p, pCity, cix, Mission: integer): Cardinal;


172 


173  implementation


174 


175  uses


176  {$IFDEF LOADPERF}SysUtils, Windows, {$ENDIF}


177  {$IFDEF TEXTLOG}SysUtils, {$ENDIF}


178  IPQ;


179 


180  var


181  UnBuilt: array [0 .. nPl  1] of integer; { number of units built }


182 


183  procedure MaskD(var x: array of Cardinal; Count, Mask: Cardinal);


184  var


185  I: Integer;


186  begin


187  for I := 0 to Count  1 do


188  x[I] := x[I] and Mask;


189  end;


190 


191  procedure CompactLists(p: integer);


192  var


193  uix, uix1, cix: integer;


194  {$IFOPT O}V21: integer;


195  Radius: TVicinity21Loc; {$ENDIF}


196  begin


197  with RW[p] do


198  begin


199  // compact unit list


200  uix := 0;


201  while uix < nUn do


202  if Un[uix].Loc < 0 then


203  begin


204  dec(nUn);


205  Un[uix] := Un[nUn]; { replace removed unit by last }


206  if (Un[uix].TroopLoad > 0) or (Un[uix].AirLoad > 0) then


207  for uix1 := 0 to nUn  1 do


208  if Un[uix1].Master = nUn then


209  Un[uix1].Master := uix;


210  // index of last unit changes


211  end


212  else


213  inc(uix);


214 


215  // compact city list


216  cix := 0;


217  while cix < nCity do


218  if City[cix].Loc < 0 then


219  begin


220  dec(nCity);


221  City[cix] := City[nCity]; { replace city by last }


222  for uix1 := 0 to nUn  1 do


223  if Un[uix1].Home = nCity then


224  Un[uix1].Home := cix;


225  { index of last city changes }


226  end


227  else


228  inc(cix);


229 


230  // compact enemy city list


231  cix := 0;


232  while cix < nEnemyCity do


233  if EnemyCity[cix].Loc < 0 then


234  begin


235  dec(nEnemyCity);


236  EnemyCity[cix] := EnemyCity[nEnemyCity]; { replace city by last }


237  end


238  else


239  inc(cix);


240 


241  {$IFOPT O}


242  for cix := 0 to nCity  1 do


243  with City[cix] do


244  begin


245  V21_to_Loc(Loc, Radius);


246  for V21 := 1 to 26 do


247  if Tiles and (1 shl V21) <> 0 then


248  assert(UsedByCity[Radius[V21]] = Loc);


249  end


250  {$ENDIF}


251  end;


252  end; // CompactLists


253 


254  {


255  Tech Related Functions


256  ____________________________________________________________________


257  }


258  function TechBaseCost(nTech, diff: integer): integer;


259  var


260  c0: single;


261  begin


262  c0 := TechFormula_M[diff] * (nTech + 4) *


263  exp((nTech + 4) / TechFormula_D[diff]);


264  if c0 >= $10000000 then


265  result := $10000000


266  else


267  result := trunc(c0)


268  end;


269 


270  function TechCost(p: integer): integer;


271  begin


272  with RW[p] do


273  begin


274  result := TechBaseCost(nTech[p], Difficulty[p]);


275  if ResearchTech >= 0 then


276  if (ResearchTech = adMilitary) or (Tech[ResearchTech] = tsSeen) then


277  result := result shr 1


278  else if ResearchTech in FutureTech then


279  if Government = gFuture then


280  result := result * 2


281  else


282  result := result * 4;


283  end


284  end;


285 


286  procedure SetModelFlags(var m: TModel);


287  begin


288  m.Flags := 0;


289  if (m.Domain = dGround) and (m.Kind <> mkDiplomat) then


290  m.Flags := m.Flags or mdZOC;


291  if (m.Kind = mkDiplomat) or (m.Attack + m.Cap[mcBombs] = 0) then


292  m.Flags := m.Flags or mdCivil;


293  if (m.Cap[mcOver] > 0) or (m.Domain = dSea) and (m.Weight >= 6) then


294  m.Flags := m.Flags or mdDoubleSupport;


295  end;


296 


297  procedure CalculateModel(var m: TModel);


298  { calculate attack, defense, cost... of a model by features }


299  var


300  i: integer;


301  begin


302  with m do


303  begin


304  Attack := (Cap[mcOffense] + Cap[mcOver]) * MStrength;


305  Defense := (Cap[mcDefense] + Cap[mcOver]) * MStrength;


306  case Domain of


307  dGround:


308  Speed := 150 + Cap[mcMob] * 50;


309  dSea:


310  begin


311  Speed := 350 + 200 * Cap[mcNP] + 200 * Cap[mcTurbines];


312  if Cap[mcNP] = 0 then


313  inc(Speed, 100 * Cap[mcSE]);


314  end;


315  dAir:


316  Speed := 850 + 400 * Cap[mcJet];


317  end;


318  Cost := 0;


319  for i := 0 to nFeature  1 do


320  if 1 shl Domain and Feature[i].Domains <> 0 then


321  inc(Cost, Cap[i] * Feature[i].Cost);


322  Cost := Cost * MCost;


323  Weight := 0;


324  for i := 0 to nFeature  1 do


325  if 1 shl Domain and Feature[i].Domains <> 0 then


326  if (Domain = dGround) and (i = mcDefense) then


327  inc(Weight, Cap[i] * 2)


328  else


329  inc(Weight, Cap[i] * Feature[i].Weight);


330  end;


331  SetModelFlags(m);


332  end;


333 


334  procedure CheckSpecialModels(p, pre: integer);


335  var


336  i, mix1: integer;


337  HasAlready: boolean;


338  begin


339  for i := 0 to nSpecialModel 


340  1 do { check whether new special model available }


341  if (SpecialModelPreq[i] = pre) and (RW[p].nModel < nmmax) then


342  begin


343  HasAlready := false;


344  for mix1 := 0 to RW[p].nModel  1 do


345  if (RW[p].Model[mix1].Kind = SpecialModel[i].Kind) and


346  (RW[p].Model[mix1].Attack = SpecialModel[i].Attack) and


347  (RW[p].Model[mix1].Speed = SpecialModel[i].Speed) then


348  HasAlready := true;


349  if not HasAlready then


350  begin


351  RW[p].Model[RW[p].nModel] := SpecialModel[i];


352  SetModelFlags(RW[p].Model[RW[p].nModel]);


353  with RW[p].Model[RW[p].nModel] do


354  begin


355  Status := 0;


356  SavedStatus := 0;


357  IntroTurn := GTurn;


358  Built := 0;


359  Lost := 0;


360  ID := p shl 12 + RW[p].nModel;


361  if (Kind = mkSpecial_Boat) and (ServerVersion[p] < $000EF0) then


362  Speed := 350; // old longboat


363  end;


364  inc(RW[p].nModel);


365  end


366  end;


367  end;


368 


369  procedure EnableDevModel(p: integer);


370  begin


371  with RW[p] do


372  if nModel < nmmax then


373  begin


374  Model[nModel] := DevModel;


375  with Model[nModel] do


376  begin


377  Status := 0;


378  SavedStatus := 0;


379  IntroTurn := GTurn;


380  Built := 0;


381  Lost := 0;


382  ID := p shl 12 + nModel


383  end;


384  inc(nModel);


385  inc(Researched[p])


386  end


387  end;


388 


389  procedure SeeTech(p, ad: integer);


390  begin


391  {$IFDEF TEXTLOG}CmdInfo := CmdInfo + Format(' P%d:A%d', [p, ad]); {$ENDIF}


392  RW[p].Tech[ad] := tsSeen;


393  // inc(nTech[p]);


394  inc(Researched[p])


395  end;


396 


397  procedure FreeSlaves;


398  var


399  p1, uix: integer;


400  begin


401  for p1 := 0 to nPl  1 do


402  if (GAlive and (1 shl p1) <> 0) then


403  for uix := 0 to RW[p1].nUn  1 do


404  if RW[p1].Model[RW[p1].Un[uix].mix].Kind = mkSlaves then


405  RW[p1].Un[uix].Job := jNone


406  end;


407 


408  procedure DiscoverTech(p, ad: integer);


409 


410  procedure TellAboutKeyTech(p, Source: integer);


411  var


412  i, p1: integer;


413  begin


414  for i := 1 to 3 do


415  if ad = AgePreq[i] then


416  for p1 := 0 to nPl  1 do


417  if (p1 <> p) and ((GAlive or GWatching) and (1 shl p1) <> 0) then


418  RW[p1].EnemyReport[p].Tech[ad] := Source;


419  end;


420 


421  var


422  i: integer;


423  begin


424  if ad in FutureTech then


425  begin


426  if RW[p].Tech[ad] < tsApplicable then


427  RW[p].Tech[ad] := 1


428  else


429  inc(RW[p].Tech[ad]);


430  if ad <> futResearchTechnology then


431  inc(nTech[p], 2);


432  inc(Researched[p], 8);


433  exit;


434  end;


435 


436  if RW[p].Tech[ad] = tsSeen then


437  begin


438  inc(nTech[p]);


439  inc(Researched[p]);


440  end


441  else


442  begin


443  inc(nTech[p], 2);


444  inc(Researched[p], 2);


445  end;


446  RW[p].Tech[ad] := tsResearched;


447  TellAboutKeyTech(p, tsResearched);


448  CheckSpecialModels(p, ad);


449  if ad = adScience then


450  ResourceMask[p] := ResourceMask[p] or fSpecial2;


451  if ad = adMassProduction then


452  ResourceMask[p] := ResourceMask[p] or fModern;


453 


454  for i := 0 to nWonder  1 do { check whether wonders expired }


455  if (GWonder[i].EffectiveOwner <> GWonder[woEiffel].EffectiveOwner) and


456  (Imp[i].Expiration = ad) then


457  begin


458  GWonder[i].EffectiveOwner := 1;


459  if i = woPyramids then


460  FreeSlaves;


461  end;


462  end;


463 


464  procedure CheckExpiration(Wonder: integer);


465  // GWonder[Wonder].EffectiveOwner must be set before!


466  var


467  p: integer;


468  begin


469  if (Imp[Wonder].Expiration >= 0) and


470  (GWonder[woEiffel].EffectiveOwner <> GWonder[Wonder].EffectiveOwner) then


471  for p := 0 to nPl  1 do // check if already expired


472  if (1 shl p and GAlive <> 0) and


473  (RW[p].Tech[Imp[Wonder].Expiration] >= tsApplicable) then


474  begin


475  GWonder[Wonder].EffectiveOwner := 1;


476  if Wonder = woPyramids then


477  FreeSlaves


478  end


479  end;


480 


481  {


482  Location Navigation


483  ____________________________________________________________________


484  }


485  function dLoc(Loc, dx, dy: integer): integer;


486  { relative location, dx in hor and dy in ver direction from Loc }


487  var


488  y0: integer;


489  begin


490  if not (Loc >= 0) and (Loc < MapSize) and (dx + lx >= 0) then


491  raise Exception.Create('Relative location error');


492  assert((Loc >= 0) and (Loc < MapSize) and (dx + lx >= 0));


493  y0 := Loc div lx;


494  result := (Loc + (dx + y0 and 1 + lx + lx) shr 1) mod lx + lx * (y0 + dy);


495  if (result < 0) or (result >= MapSize) then


496  result := 1;


497  end;


498 


499  procedure dxdy(Loc0, Loc1: integer; var dx, dy: integer);


500  begin


501  dx := ((Loc1 mod lx * 2 + Loc1 div lx and 1) 


502  (Loc0 mod lx * 2 + Loc0 div lx and 1) + 3 * lx) mod (2 * lx)  lx;


503  dy := Loc1 div lx  Loc0 div lx;


504  end;


505 


506  function Distance(Loc0, Loc1: integer): integer;


507  var


508  dx, dy: integer;


509  begin


510  dxdy(Loc0, Loc1, dx, dy);


511  dx := abs(dx);


512  dy := abs(dy);


513  result := dx + dy + abs(dx  dy) shr 1;


514  end;


515 


516  procedure V8_to_Loc(Loc0: integer; var VicinityLoc: TVicinity8Loc);


517  var


518  x0, y0, lx0: integer;


519  begin


520  lx0 := lx; // put in register!


521  y0 := Loc0 div lx0;


522  x0 := Loc0  y0 * lx0; // Loc0 mod lx;


523  y0 := y0 and 1;


524  VicinityLoc[1] := Loc0 + lx0 * 2;


525  VicinityLoc[3] := Loc0  1;


526  VicinityLoc[5] := Loc0  lx0 * 2;


527  VicinityLoc[7] := Loc0 + 1;


528  inc(Loc0, y0);


529  VicinityLoc[0] := Loc0 + lx0;


530  VicinityLoc[2] := Loc0 + lx0  1;


531  VicinityLoc[4] := Loc0  lx0  1;


532  VicinityLoc[6] := Loc0  lx0;


533 


534  // world is round!


535  if x0 < lx0  1 then


536  begin


537  if x0 = 0 then


538  begin


539  inc(VicinityLoc[3], lx0);


540  if y0 = 0 then


541  begin


542  inc(VicinityLoc[2], lx0);


543  inc(VicinityLoc[4], lx0);


544  end


545  end


546  end


547  else


548  begin


549  dec(VicinityLoc[7], lx0);


550  if y0 = 1 then


551  begin


552  dec(VicinityLoc[0], lx0);


553  dec(VicinityLoc[6], lx0);


554  end


555  end;


556  end;


557 


558  procedure V21_to_Loc(Loc0: integer; var VicinityLoc: TVicinity21Loc);


559  var


560  dx, dy, bit, y0, xComp, yComp, xComp0, xCompSwitch: integer;


561  dst: ^integer;


562  begin


563  y0 := Loc0 div lx;


564  xComp0 := Loc0  y0 * lx  1; // Loc0 mod lx 1


565  xCompSwitch := xComp0  1 + y0 and 1;


566  if xComp0 < 0 then


567  inc(xComp0, lx);


568  if xCompSwitch < 0 then


569  inc(xCompSwitch, lx);


570  xCompSwitch := xCompSwitch xor xComp0;


571  yComp := lx * (y0  3);


572  dst := @VicinityLoc;


573  bit := 1;


574  for dy := 0 to 6 do


575  begin


576  xComp0 := xComp0 xor xCompSwitch;


577  xComp := xComp0;


578  for dx := 0 to 3 do


579  begin


580  if bit and $67F7F76 <> 0 then


581  dst^ := xComp + yComp


582  else


583  dst^ := 1;


584  inc(xComp);


585  if xComp >= lx then


586  dec(xComp, lx);


587  inc(dst);


588  bit := bit shl 1;


589  end;


590  inc(yComp, lx);


591  end;


592  end;


593 


594  {


595  Map Creation


596  ____________________________________________________________________


597  }


598  var


599  primitive: integer;


600  StartLoc, StartLoc2: array [0 .. nPl  1] of integer; { starting coordinates }


601  Elevation: array [0 .. lxmax * lymax  1] of Byte; { map elevation }


602  ElCount: array [Byte] of integer; { count of elevation occurance }


603 


604  procedure CalculatePrimitive;


605  var


606  i, j: integer;


607  begin


608  primitive := 1;


609  i := 2;


610  while i * i <= MapSize + 1 do // test whether prime


611  begin


612  if (MapSize + 1) mod i = 0 then


613  primitive := 0;


614  inc(i)


615  end;


616 


617  if primitive > 0 then


618  repeat


619  inc(primitive);


620  i := 1;


621  j := 0;


622  repeat


623  inc(j);


624  i := i * primitive mod (MapSize + 1)


625  until (i = 1) or (j = MapSize + 1);


626  until j = MapSize;


627  end;


628 


629  function MapGeneratorAvailable: boolean;


630  begin


631  result := (primitive > 0) and (lx >= 20) and (ly >= 40)


632  end;


633 


634  procedure CreateElevation;


635  const


636  d = 64;


637  Smooth = 0.049; { causes low amplitude of short waves }


638  Detail = 0.095; { causes short period of short waves }


639  Merge = 5; { elevation merging range at the connection line of the


640  round world,in relation to lx }


641 


642  var


643  sa, ca, f1, f2: array [1 .. d] of single;


644  imerge, x, y: integer;


645  v, maxv: single;


646 


647  function Value(x, y: integer): single; { elevation formula }


648  var


649  i: integer;


650  begin


651  result := 0;


652  for i := 1 to d do


653  result := result + sin(f1[i] * ((x * 2 + y and 1) * sa[i] + y * 1.5 *


654  ca[i])) * f2[i];


655  { x values effectively multiplied with 2 to get 2 horizantal periods


656  of the prime waves }


657  end;


658 


659  begin


660  for x := 1 to d do { prepare formula parameters }


661  begin


662  {$IFNDEF SCR} if x = 1 then


663  v := pi / 2 { first wave goes horizontal }


664  else {$ENDIF} v := DelphiRandom * 2 * pi;


665  sa[x] := sin(v) / lx;


666  ca[x] := cos(v) / ly;


667  f1[x] := 2 * pi * exp(Detail * (x  1));


668  f2[x] := exp(x * Smooth)


669  end;


670 


671  imerge := 2 * lx div Merge;


672  FillChar(ElCount, SizeOf(ElCount), 0);


673  maxv := 0;


674  for x := 0 to lx  1 do


675  for y := 0 to ly  1 do


676  begin


677  v := Value(x, y);


678  if x * 2 < imerge then


679  v := (x * 2 * v + (imerge  x * 2) * Value(x + lx, y)) / imerge;


680  v := v  sqr(sqr(2 * y / ly  1)); { soft cut at poles }


681  if v > maxv then


682  maxv := v;


683 


684  if v < 4 then


685  Elevation[x + lx * y] := 0


686  else if v > 8.75 then


687  Elevation[x + lx * y] := 255


688  else


689  Elevation[x + lx * y] := Round((v + 4) * 20);


690  inc(ElCount[Elevation[x + lx * y]])


691  end;


692  end;


693 


694  procedure FindContinents;


695 


696  procedure ReplaceCont(a, b, Stop: integer);


697  { replace continent name a by b }


698  // make sure always continent[loc]<=loc


699  var


700  i: integer;


701  begin


702  if a < b then


703  begin


704  i := a;


705  a := b;


706  b := i


707  end;


708  if a > b then


709  for i := a to Stop do


710  if Continent[i] = a then


711  Continent[i] := b


712  end;


713 


714  var


715  x, y, Loc, Wrong: integer;


716  begin


717  for y := 1 to ly  2 do


718  for x := 0 to lx  1 do


719  begin


720  Loc := x + lx * y;


721  Continent[Loc] := 1;


722  if RealMap[Loc] and fTerrain >= fGrass then


723  begin


724  if (y  2 >= 1) and (RealMap[Loc  2 * lx] and fTerrain >= fGrass) then


725  Continent[Loc] := Continent[Loc  2 * lx];


726  if (x  1 + y and 1 >= 0) and (y  1 >= 1) and


727  (RealMap[Loc  1 + y and 1  lx] and fTerrain >= fGrass) then


728  Continent[Loc] := Continent[Loc  1 + y and 1  lx];


729  if (x + y and 1 < lx) and (y  1 >= 1) and


730  (RealMap[Loc + y and 1  lx] and fTerrain >= fGrass) then


731  Continent[Loc] := Continent[Loc + y and 1  lx];


732  if (x  1 >= 0) and (RealMap[Loc  1] and fTerrain >= fGrass) then


733  if Continent[Loc] = 1 then


734  Continent[Loc] := Continent[Loc  1]


735  else


736  ReplaceCont(Continent[Loc  1], Continent[Loc], Loc);


737  if Continent[Loc] = 1 then


738  Continent[Loc] := Loc


739  end


740  end;


741 


742  { connect continents due to round earth }


743  for y := 1 to ly  2 do


744  if RealMap[lx * y] and fTerrain >= fGrass then


745  begin


746  Wrong := 1;


747  if RealMap[lx  1 + lx * y] and fTerrain >= fGrass then


748  Wrong := Continent[lx  1 + lx * y];


749  if (y and 1 = 0) and (y  1 >= 1) and


750  (RealMap[lx  1 + lx * (y  1)] and fTerrain >= fGrass) then


751  Wrong := Continent[lx  1 + lx * (y  1)];


752  if (y and 1 = 0) and (y + 1 < ly  1) and


753  (RealMap[lx  1 + lx * (y + 1)] and fTerrain >= fGrass) then


754  Wrong := Continent[lx  1 + lx * (y + 1)];


755  if Wrong >= 0 then


756  ReplaceCont(Wrong, Continent[lx * y], MapSize  1)


757  end;


758  end;


759 


760  procedure RarePositions;


761  // distribute rare resources


762  // must be done after FindContinents


763  var


764  i, j, Cnt, x, y, dx, dy, Loc0, Loc1, xworst, yworst, totalrare, RareMaxWater,


765  RareType, iBest, jbest, MinDist, xBlock, yBlock, V8: integer;


766  AreaCount, RareByArea, RareAdjacent: array [0 .. 7, 0 .. 4] of integer;


767  RareLoc: array [0 .. 11] of integer;


768  Dist: array [0 .. 11, 0 .. 11] of integer;


769  Adjacent: TVicinity8Loc;


770  begin


771  RareMaxWater := 0;


772  repeat


773  FillChar(AreaCount, SizeOf(AreaCount), 0);


774  for y := 1 to ly  2 do


775  begin


776  yBlock := y * 5 div ly;


777  if yBlock = (y + 1) * 5 div ly then


778  for x := 0 to lx  1 do


779  begin


780  xBlock := x * 8 div lx;


781  if xBlock = (x + 1) * 8 div lx then


782  begin


783  Loc0 := x + lx * y;


784  if RealMap[Loc0] and fTerrain >= fGrass then


785  begin


786  Cnt := 0;


787  V8_to_Loc(Loc0, Adjacent);


788  for V8 := 0 to 7 do


789  begin


790  Loc1 := Adjacent[V8];


791  if (Loc1 >= 0) and (Loc1 < MapSize) and


792  (RealMap[Loc1] and fTerrain < fGrass) then


793  inc(Cnt); // count adjacent water


794  end;


795  if Cnt <= RareMaxWater then // inner land


796  begin


797  inc(AreaCount[xBlock, yBlock]);


798  if DelphiRandom(AreaCount[xBlock, yBlock]) = 0 then


799  RareByArea[xBlock, yBlock] := Loc0


800  end


801  end;


802  end;


803  end


804  end;


805  totalrare := 0;


806  for x := 0 to 7 do


807  for y := 0 to 4 do


808  if AreaCount[x, y] > 0 then


809  inc(totalrare);


810  inc(RareMaxWater);


811  until totalrare >= 12;


812 


813  while totalrare > 12 do


814  begin // remove rarebyarea resources too close to each other


815  FillChar(RareAdjacent, SizeOf(RareAdjacent), 0);


816  for x := 0 to 7 do


817  for y := 0 to 4 do


818  if AreaCount[x, y] > 0 then


819  begin


820  if (AreaCount[(x + 1) mod 8, y] > 0) and


821  (Continent[RareByArea[x, y]] = Continent


822  [RareByArea[(x + 1) mod 8, y]]) then


823  begin


824  inc(RareAdjacent[x, y]);


825  inc(RareAdjacent[(x + 1) mod 8, y]);


826  end;


827  if y < 4 then


828  begin


829  if (AreaCount[x, y + 1] > 0) and


830  (Continent[RareByArea[x, y]] = Continent[RareByArea[x, y + 1]])


831  then


832  begin


833  inc(RareAdjacent[x, y]);


834  inc(RareAdjacent[x, y + 1]);


835  end;


836  if (AreaCount[(x + 1) mod 8, y + 1] > 0) and


837  (Continent[RareByArea[x, y]] = Continent[RareByArea[(x + 1) mod 8,


838  y + 1]]) then


839  begin


840  inc(RareAdjacent[x, y]);


841  inc(RareAdjacent[(x + 1) mod 8, y + 1]);


842  end;


843  if (AreaCount[(x + 7) mod 8, y + 1] > 0) and


844  (Continent[RareByArea[x, y]] = Continent[RareByArea[(x + 7) mod 8,


845  y + 1]]) then


846  begin


847  inc(RareAdjacent[x, y]);


848  inc(RareAdjacent[(x + 7) mod 8, y + 1]);


849  end;


850  end


851  end;


852  xworst := 0;


853  yworst := 0;


854  Cnt := 0;


855  for x := 0 to 7 do


856  for y := 0 to 4 do


857  if AreaCount[x, y] > 0 then


858  begin


859  if (Cnt = 0) or (RareAdjacent[x, y] > RareAdjacent[xworst, yworst])


860  then


861  begin


862  xworst := x;


863  yworst := y;


864  Cnt := 1


865  end


866  else if (RareAdjacent[x, y] = RareAdjacent[xworst, yworst]) then


867  begin


868  inc(Cnt);


869  if DelphiRandom(Cnt) = 0 then


870  begin


871  xworst := x;


872  yworst := y;


873  end


874  end;


875  end;


876  AreaCount[xworst, yworst] := 0;


877  dec(totalrare)


878  end;


879 


880  Cnt := 0;


881  for x := 0 to 7 do


882  for y := 0 to 4 do


883  if AreaCount[x, y] > 0 then


884  begin


885  RareLoc[Cnt] := RareByArea[x, y];


886  inc(Cnt)


887  end;


888  for i := 0 to 11 do


889  begin


890  RealMap[RareLoc[i]] := RealMap[RareLoc[i]] and not(fTerrain or fSpecial) or


891  (fDesert or fDeadLands);


892  for dy := 1 to 1 do


893  for dx := 1 to 1 do


894  if (dx + dy) and 1 = 0 then


895  begin


896  Loc1 := dLoc(RareLoc[i], dx, dy);


897  if (Loc1 >= 0) and (RealMap[Loc1] and fTerrain = fMountains) then


898  RealMap[Loc1] := RealMap[Loc1] and not fTerrain or fHills;


899  end


900  end;


901  for i := 0 to 11 do


902  for j := 0 to 11 do


903  Dist[i, j] := Distance(RareLoc[i], RareLoc[j]);


904 


905  ibest := 0;


906  jbest := 0;


907  MinDist := Distance(0, MapSize  lx shr 1) shr 1;


908  for RareType := 1 to 3 do


909  begin


910  Cnt := 0;


911  for i := 0 to 11 do


912  if RareLoc[i] >= 0 then


913  for j := 0 to 11 do


914  if RareLoc[j] >= 0 then


915  if (Cnt > 0) and (Dist[iBest, jbest] >= MinDist) then


916  begin


917  if Dist[i, j] >= MinDist then


918  begin


919  inc(Cnt);


920  if DelphiRandom(Cnt) = 0 then


921  begin


922  iBest := i;


923  jbest := j


924  end


925  end


926  end


927  else if (Cnt = 0) or (Dist[i, j] > Dist[iBest, jbest]) then


928  begin


929  iBest := i;


930  jbest := j;


931  Cnt := 1;


932  end;


933  RealMap[RareLoc[iBest]] := RealMap[RareLoc[iBest]] or


934  Cardinal(RareType) shl 25;


935  RealMap[RareLoc[jbest]] := RealMap[RareLoc[jbest]] or


936  Cardinal(RareType) shl 25;


937  RareLoc[iBest] := 1;


938  RareLoc[jbest] := 1;


939  end;


940  end; // RarePositions


941 


942  function CheckShore(Loc: integer): boolean;


943  var


944  Loc1, OldTile, V21: integer;


945  Radius: TVicinity21Loc;


946  begin


947  result := false;


948  OldTile := RealMap[Loc];


949  if OldTile and fTerrain < fGrass then


950  begin


951  RealMap[Loc] := RealMap[Loc] and not fTerrain or fOcean;


952  V21_to_Loc(Loc, Radius);


953  for V21 := 1 to 26 do


954  begin


955  Loc1 := Radius[V21];


956  if (Loc1 >= 0) and (Loc1 < MapSize) and


957  (RealMap[Loc1] and fTerrain >= fGrass) and


958  (RealMap[Loc1] and fTerrain <> fArctic) then


959  RealMap[Loc] := RealMap[Loc] and not fTerrain or fShore;


960  end;


961  if (RealMap[Loc] xor Cardinal(OldTile)) and fTerrain <> 0 then


962  result := true;


963  end;


964  end;


965 


966  function ActualSpecialTile(Loc: integer): Cardinal;


967  begin


968  result := SpecialTile(Loc, RealMap[Loc] and fTerrain, lx);


969  end;


970 


971  procedure CreateMap(preview: boolean);


972  const


973  ShHiHills = 6; { of land }


974  ShMountains = 6; { of land }


975  ShRandHills = 12; { of land }


976  ShTestRiver = 40;


977  ShSwamp = 25; { of grassland }


978  MinRivLen = 3;


979  unification = 70;


980  hotunification = 50; // min. 25


981 


982  Zone: array [0 .. 3, 2 .. 9] of single = { terrain distribution }


983  ((0.25, 0, 0, 0.4, 0, 0, 0, 0.35), (0.55, 0, 0.1, 0, 0, 0, 0, 0.35),


984  (0.4, 0, 0.35, 0, 0, 0, 0, 0.25), (0, 0.7, 0, 0, 0, 0, 0, 0.3));


985  { Grs Dst Pra Tun    For }


986 


987  function RndLow(y: integer): Cardinal;


988  { random lowland appropriate to climate }


989  var


990  z0, i: integer;


991  p, p0, ZPlus: single;


992  begin


993  if ly  1  y > y then


994  begin


995  z0 := 6 * y div ly;


996  ZPlus := 6 * y / ly  z0;


997  end


998  else


999  begin


1000  z0 := 6 * (ly  1  y) div ly;


1001  ZPlus := 6 * (ly  1  y) / ly  z0;


1002  end;


1003  p0 := 1;


1004  for i := 2 to 9 do


1005  begin


1006  p := Zone[z0, i] * (1  ZPlus) + Zone[z0 + 1, i] * ZPlus;


1007  { weight between zones z0 and z0+1 }


1008  if DelphiRandom * p0 < p then


1009  begin


1010  RndLow := i;


1011  Break;


1012  end;


1013  p0 := p0  p;


1014  end;


1015  end;


1016 


1017  function RunRiver(Loc0: integer): integer;


1018  { runs river from start point Loc0; return value: length }


1019  var


1020  Dir, T, Loc, Loc1, Cost: integer;


1021  Q: TIPQ;


1022  From: array [0 .. lxmax * lymax  1] of integer;


1023  Time: array [0 .. lxmax * lymax  1] of integer;


1024  OneTileLake: boolean;


1025  begin


1026  FillChar(Time, SizeOf(Time), 255); { 1 }


1027  Q := TIPQ.Create(MapSize);


1028  Q.Put(Loc0, 0);


1029  while Q.Get(Loc, T) and (RealMap[Loc] and fRiver = 0) do


1030  begin


1031  if (RealMap[Loc] and fTerrain < fGrass) then


1032  begin


1033  OneTileLake := true;


1034  for Dir := 0 to 3 do


1035  begin


1036  Loc1 := dLoc(Loc, Dir and 1 * 2  1, Dir shr 1 * 2  1);


1037  if (Loc1 >= 0) and (RealMap[Loc1] and fTerrain < fGrass) then


1038  OneTileLake := false;


1039  end;


1040  if not OneTileLake then


1041  Break;


1042  end;


1043  Time[Loc] := T;


1044  for Dir := 0 to 3 do


1045  begin


1046  Loc1 := dLoc(Loc, Dir and 1 * 2  1, Dir shr 1 * 2  1);


1047  if (Loc1 >= lx) and (Loc1 < lx * (ly  1)) and (Time[Loc1] < 0) then


1048  begin


1049  if RealMap[Loc1] and fRiver = 0 then


1050  begin


1051  Cost := Elevation[Loc1]  Elevation[Loc];


1052  if Cost < 0 then


1053  Cost := 0;


1054  end


1055  else


1056  Cost := 0;


1057  if Q.Put(Loc1, T + Cost shl 8 + 1) then


1058  From[Loc1] := Loc;


1059  end;


1060  end;


1061  end;


1062  Loc1 := Loc;


1063  result := 0;


1064  while Loc <> Loc0 do


1065  begin


1066  Loc := From[Loc];


1067  inc(result);


1068  end;


1069  if (result > 1) and ((result >= MinRivLen) or


1070  (RealMap[Loc1] and fTerrain >= fGrass)) then


1071  begin


1072  Loc := Loc1;


1073  while Loc <> Loc0 do


1074  begin


1075  Loc := From[Loc];


1076  if RealMap[Loc] and fTerrain in [fHills, fMountains] then


1077  RealMap[Loc] := fGrass or fRiver


1078  else if RealMap[Loc] and fTerrain >= fGrass then


1079  RealMap[Loc] := RealMap[Loc] or fRiver;


1080  end;


1081  end


1082  else


1083  result := 0;


1084  FreeAndNil(Q);


1085  end;


1086 


1087  var


1088  x, y, n, Dir, plus, Count, Loc0, Loc1, bLand, bHills, bMountains, V8: integer;


1089  CopyFrom: array [0 .. lxmax * lymax  1] of integer;


1090  Adjacent: TVicinity8Loc;


1091 


1092  begin


1093  FillChar(RealMap, MapSize * SizeOf(Cardinal), 0);


1094  plus := 0;


1095  bMountains := 256;


1096  while plus < MapSize * LandMass * ShMountains div 10000 do


1097  begin


1098  dec(bMountains);


1099  inc(plus, ElCount[bMountains])


1100  end;


1101  Count := plus;


1102  plus := 0;


1103  bHills := bMountains;


1104  while plus < MapSize * LandMass * ShHiHills div 10000 do


1105  begin


1106  dec(bHills);


1107  inc(plus, ElCount[bHills])


1108  end;


1109  inc(Count, plus);


1110  bLand := bHills;


1111  while Count < MapSize * LandMass div 100 do


1112  begin


1113  dec(bLand);


1114  inc(Count, ElCount[bLand])


1115  end;


1116 


1117  for Loc0 := lx to lx * (ly  1)  1 do


1118  if Elevation[Loc0] >= bMountains then


1119  RealMap[Loc0] := fMountains


1120  else if Elevation[Loc0] >= bHills then


1121  RealMap[Loc0] := fHills


1122  else if Elevation[Loc0] >= bLand then


1123  RealMap[Loc0] := fGrass;


1124 


1125  // remove onetile islands


1126  for Loc0 := 0 to MapSize  1 do


1127  if RealMap[Loc0] >= fGrass then


1128  begin


1129  Count := 0;


1130  V8_to_Loc(Loc0, Adjacent);


1131  for V8 := 0 to 7 do


1132  begin


1133  Loc1 := Adjacent[V8];


1134  if (Loc1 < 0) or (Loc1 >= MapSize) or


1135  (RealMap[Loc1] and fTerrain < fGrass) or


1136  (RealMap[Loc1] and fTerrain = fArctic) then


1137  inc(Count); // count adjacent water


1138  end;


1139  if Count = 8 then


1140  RealMap[Loc0] := fOcean


1141  end;


1142 


1143  if not preview then


1144  begin


1145  plus := 36 * 56 * 20 * ShTestRiver div (LandMass * 100);


1146  if plus > MapSize then


1147  plus := MapSize;


1148  Loc0 := DelphiRandom(MapSize);


1149  for n := 0 to plus  1 do


1150  begin


1151  if (RealMap[Loc0] and fTerrain >= fGrass) and (Loc0 >= lx) and


1152  (Loc0 < MapSize  lx) then


1153  RunRiver(Loc0);


1154  Loc0 := (Loc0 + 1) * primitive mod (MapSize + 1)  1;


1155  end;


1156  end;


1157 


1158  for Loc0 := 0 to MapSize  1 do


1159  if (RealMap[Loc0] = fGrass) and (DelphiRandom(100) < ShRandHills) then


1160  RealMap[Loc0] := RealMap[Loc0] or fHills;


1161 


1162  // make terrain types coherent


1163  for Loc0 := 0 to MapSize  1 do


1164  CopyFrom[Loc0] := Loc0;


1165 


1166  for n := 0 to unification * MapSize div 100 do


1167  begin


1168  y := DelphiRandom(ly);


1169  if abs(y  (ly shr 1)) > ly div 4 + DelphiRandom(ly * hotunification div 100) then


1170  if y < ly shr 1 then


1171  y := ly shr 1  y


1172  else


1173  y := 3 * ly shr 1  y;


1174  Loc0 := lx * y + DelphiRandom(lx);


1175  if RealMap[Loc0] and fTerrain = fGrass then


1176  begin


1177  Dir := DelphiRandom(4);


1178  Loc1 := dLoc(Loc0, Dir and 1 * 2  1, Dir shr 1 * 2  1);


1179  if (Loc1 >= 0) and (RealMap[Loc1] and fTerrain = fGrass) then


1180  begin


1181  while CopyFrom[Loc0] <> Loc0 do


1182  Loc0 := CopyFrom[Loc0];


1183  while CopyFrom[Loc1] <> Loc1 do


1184  Loc1 := CopyFrom[Loc1];


1185  if Loc1 < Loc0 then


1186  CopyFrom[Loc0] := Loc1


1187  else


1188  CopyFrom[Loc1] := Loc0;


1189  end;


1190  end;


1191  end;


1192 


1193  for Loc0 := 0 to MapSize  1 do


1194  if (RealMap[Loc0] and fTerrain = fGrass) and (CopyFrom[Loc0] = Loc0) then


1195  RealMap[Loc0] := RealMap[Loc0] and not fTerrain or RndLow(Loc0 div lx);


1196 


1197  for Loc0 := 0 to MapSize  1 do


1198  if RealMap[Loc0] and fTerrain = fGrass then


1199  begin


1200  Loc1 := Loc0;


1201  while CopyFrom[Loc1] <> Loc1 do


1202  Loc1 := CopyFrom[Loc1];


1203  RealMap[Loc0] := RealMap[Loc0] and not fTerrain or


1204  RealMap[Loc1] and fTerrain


1205  end;


1206 


1207  for Loc0 := 0 to MapSize  1 do


1208  if RealMap[Loc0] and fTerrain = fGrass then


1209  begin // change grassland to swamp


1210  if DelphiRandom(100) < ShSwamp then


1211  RealMap[Loc0] := RealMap[Loc0] and not fTerrain or fSwamp;


1212  end;


1213 


1214  for Loc0 := 0 to MapSize  1 do // change desert to prairie 1


1215  if RealMap[Loc0] and fTerrain = fDesert then


1216  begin


1217  if RealMap[Loc0] and fRiver <> 0 then


1218  Count := 5


1219  else


1220  begin


1221  Count := 0;


1222  for Dir := 0 to 3 do


1223  begin


1224  Loc1 := dLoc(Loc0, Dir and 1 * 2  1, Dir shr 1 * 2  1);


1225  if Loc1 >= 0 then


1226  if RealMap[Loc1] and fTerrain < fGrass then


1227  inc(Count, 2)


1228  end;


1229  end;


1230  if Count >= 4 then


1231  RealMap[Loc0] := RealMap[Loc0] and not fTerrain or fPrairie


1232  end;


1233 


1234  for Loc0 := 0 to MapSize  1 do // change desert to prairie 2


1235  if RealMap[Loc0] and fTerrain = fDesert then


1236  begin


1237  Count := 0;


1238  for Dir := 0 to 3 do


1239  begin


1240  Loc1 := dLoc(Loc0, Dir and 1 * 2  1, Dir shr 1 * 2  1);


1241  if Loc1 >= 0 then


1242  if RealMap[Loc1] and fTerrain <> fDesert then


1243  inc(Count)


1244  end;


1245  if Count >= 4 then


1246  RealMap[Loc0] := RealMap[Loc0] and not fTerrain or fPrairie


1247  end;


1248 


1249  for Loc0 := 0 to MapSize  1 do


1250  CheckShore(Loc0); // change ocean to shore


1251  for x := 0 to lx  1 do


1252  begin


1253  RealMap[x + lx * 0] := fArctic;


1254  if RealMap[x + lx * 1] >= fGrass then


1255  RealMap[x + lx * 1] := RealMap[x + lx * 1] and not fTerrain or fTundra;


1256  if RealMap[x + lx * (ly  2)] >= fGrass then


1257  RealMap[x + lx * (ly  2)] := RealMap[x + lx * (ly  2)] and


1258  not fTerrain or fTundra;


1259  RealMap[x + lx * (ly  1)] := fArctic


1260  end;


1261 


1262  for Loc0 := 0 to MapSize  1 do // define special terrain tiles


1263  RealMap[Loc0] := RealMap[Loc0] or ActualSpecialTile(Loc0) shl 5 or


1264  ($F shl 27);


1265 


1266  if not preview then


1267  begin


1268  FindContinents;


1269  RarePositions;


1270  end;


1271  end;


1272 


1273  procedure StartPositions;


1274  // define nation start positions


1275  // must be done after FindContinents


1276 


1277  var


1278  CountGood: (cgBest, cgFlat, cgLand);


1279 


1280  function IsGoodTile(Loc: integer): boolean;


1281  var


1282  xLoc, yLoc: integer;


1283  begin


1284  xLoc := Loc mod lx;


1285  yLoc := Loc div lx;


1286  if RealMap[Loc] and fDeadLands <> 0 then


1287  result := false


1288  else


1289  case CountGood of


1290  cgBest:


1291  result := (RealMap[Loc] and fTerrain in [fGrass, fPrairie, fTundra,


1292  fSwamp, fForest]) and Odd((lymax + xLoc  yLoc shr 1) shr 1 + xLoc +


1293  (yLoc + 1) shr 1);


1294  cgFlat:


1295  result := (RealMap[Loc] and fTerrain in [fGrass, fPrairie, fTundra,


1296  fSwamp, fForest]);


1297  cgLand:


1298  result := RealMap[Loc] and fTerrain >= fGrass;


1299  end;


1300  end;


1301 


1302  const


1303  MaxCityLoc = 64;


1304 


1305  var


1306  p1, p2, nAlive, c, Loc, Loc1, CntGood, CntGoodGrass, MinDist, i, j, n,


1307  nsc, V21, V8, BestDist, TestDist, MinGood, nIrrLoc,


1308  FineDistSQR, nRest: integer;


1309  ccount: array [0 .. lxmax * lymax  1] of word;


1310  sc, StartLoc0, sccount: array [1 .. nPl] of integer;


1311  TestStartLoc: array [0 .. nPl  1] of integer;


1312  CityLoc: array [1 .. nPl, 0 .. MaxCityLoc  1] of integer;


1313  nCityLoc: array [1 .. nPl] of integer;


1314  RestLoc: array [0 .. MaxCityLoc  1] of integer;


1315  IrrLoc: array [0 .. 20] of integer;


1316  Radius: TVicinity21Loc;


1317  Adjacent: TVicinity8Loc;


1318  ok: boolean;


1319 


1320  begin


1321  nAlive := 0;


1322  for p1 := 0 to nPl  1 do


1323  if 1 shl p1 and GAlive <> 0 then


1324  inc(nAlive);


1325  if nAlive = 0 then


1326  exit;


1327 


1328  { count good tiles }


1329  FillChar(ccount, MapSize * 2, 0);


1330  for Loc := 0 to MapSize  1 do


1331  if RealMap[Loc] and fTerrain = fGrass then


1332  if ActualSpecialTile(Loc) = 1 then


1333  inc(ccount[Continent[Loc]], 3)


1334  else


1335  inc(ccount[Continent[Loc]], 2)


1336  else if RealMap[Loc] and fTerrain in [fPrairie, fSwamp, fForest, fHills]


1337  then


1338  inc(ccount[Continent[Loc]]);


1339 


1340  Loc := 0;


1341  while ccount[Loc] > 0 do


1342  inc(Loc);


1343  for i := 1 to nAlive do


1344  begin


1345  sc[i] := Loc;


1346  sccount[i] := 1


1347  end;


1348  { init with zero size start continents, then search bigger ones }


1349  for Loc := 0 to MapSize  1 do


1350  if ccount[Loc] > 0 then


1351  begin // search biggest continents


1352  p1 := nAlive + 1;


1353  while (p1 > 1) and (ccount[Loc] > ccount[sc[p1  1]]) do


1354  begin


1355  if p1 < nAlive + 1 then


1356  sc[p1] := sc[p1  1];


1357  dec(p1)


1358  end;


1359  if p1 < nAlive + 1 then


1360  sc[p1] := Loc;


1361  end;


1362  nsc := nAlive;


1363  repeat


1364  c := 1; // search least crowded continent after smallest


1365  for i := 2 to nsc  1 do


1366  if ccount[sc[i]] * (2 * sccount[c] + 1) > ccount[sc[c]] *


1367  (2 * sccount[i] + 1) then


1368  c := i;


1369  if ccount[sc[nsc]] * (2 * sccount[c] + 1) > ccount[sc[c]] then


1370  Break; // even least crowded continent is more crowded than smallest


1371  inc(sccount[c]);


1372  dec(nsc)


1373  until sccount[nsc] > 1;


1374 


1375  MinGood := 7;


1376  CountGood := cgBest;


1377  repeat


1378  dec(MinGood);


1379  if (MinGood = 3) and (CountGood < cgLand) then // too demanding!


1380  begin


1381  inc(CountGood);


1382  MinGood := 6


1383  end;


1384  FillChar(nCityLoc, SizeOf(nCityLoc), 0);


1385  Loc := DelphiRandom(MapSize);


1386  for i := 0 to MapSize  1 do


1387  begin


1388  if ((Loc >= 4 * lx) and (Loc < MapSize  4 * lx) or (CountGood >= cgLand))


1389  and IsGoodTile(Loc) then


1390  begin


1391  c := nsc;


1392  while (c > 0) and (Continent[Loc] <> sc[c]) do


1393  dec(c);


1394  if (c > 0) and (nCityLoc[c] < MaxCityLoc) then


1395  begin


1396  CntGood := 1;


1397  V21_to_Loc(Loc, Radius);


1398  for V21 := 1 to 26 do


1399  if V21 <> CityOwnTile then


1400  begin


1401  Loc1 := Radius[V21];


1402  if (Loc1 >= 0) and (Loc1 < MapSize) and IsGoodTile(Loc1) then


1403  inc(CntGood)


1404  end;


1405  if CntGood >= MinGood then


1406  begin


1407  CityLoc[c, nCityLoc[c]] := Loc;


1408  inc(nCityLoc[c])


1409  end;


1410  end;


1411  end;


1412  Loc := (Loc + 1) * primitive mod (MapSize + 1)  1;


1413  end;


1414 


1415  ok := true;


1416  for c := 1 to nsc do


1417  if nCityLoc[c] < sccount[c] * (8  MinGood) div (7  MinGood) then


1418  ok := false;


1419  until ok;


1420 


1421  FineDistSQR := MapSize * LandMass * 9 div (nAlive * 100);


1422  p1 := 1;


1423  for c := 1 to nsc do


1424  begin // for all start continents


1425  if sccount[c] = 1 then


1426  StartLoc0[p1] := CityLoc[c, DelphiRandom(nCityLoc[c])]


1427  else


1428  begin


1429  BestDist := 0;


1430  n := 1 shl sccount[c] * 32; // number of tries to find good distribution


1431  if n > 1 shl 12 then


1432  n := 1 shl 12;


1433  while (n > 0) and (BestDist * BestDist < FineDistSQR) do


1434  begin


1435  MinDist := MaxInt;


1436  nRest := nCityLoc[c];


1437  for i := 0 to nRest  1 do


1438  RestLoc[i] := CityLoc[c, i];


1439  for i := 0 to sccount[c]  1 do


1440  begin


1441  if nRest = 0 then


1442  Break;


1443  j := DelphiRandom(nRest);


1444  TestStartLoc[i] := RestLoc[j];


1445  RestLoc[j] := RestLoc[nRest  1];


1446  dec(nRest);


1447  for j := 0 to i  1 do


1448  begin


1449  TestDist := Distance(TestStartLoc[i], TestStartLoc[j]);


1450  if TestDist < MinDist then


1451  MinDist := TestDist


1452  end;


1453  if i = sccount[c]  1 then


1454  begin


1455  assert(MinDist > BestDist);


1456  BestDist := MinDist;


1457  for j := 0 to sccount[c]  1 do


1458  StartLoc0[p1 + j] := TestStartLoc[j];


1459  end


1460  else if BestDist > 0 then


1461  begin


1462  j := 0;


1463  while j < nRest do


1464  begin // remove all locs from rest which have too little distance to this one


1465  TestDist := Distance(TestStartLoc[i], RestLoc[j]);


1466  if TestDist <= BestDist then


1467  begin


1468  RestLoc[j] := RestLoc[nRest  1];


1469  dec(nRest);


1470  end


1471  else


1472  inc(j);


1473  end;


1474  end;


1475  end;


1476  dec(n)


1477  end;


1478  end;


1479  p1 := p1 + sccount[c]


1480  end;


1481 


1482  // make start locs fertile


1483  for p1 := 1 to nAlive do


1484  begin


1485  RealMap[StartLoc0[p1]] := RealMap[StartLoc0[p1]] and


1486  not(fTerrain or fSpecial) or fGrass or fSpecial1;


1487  CntGood := 1;


1488  CntGoodGrass := 1;


1489  V21_to_Loc(StartLoc0[p1], Radius);


1490  for V21 := 1 to 26 do


1491  if V21 <> CityOwnTile then


1492  begin


1493  Loc1 := Radius[V21];


1494  if (Loc1 >= 0) and (Loc1 < MapSize) and IsGoodTile(Loc1) then


1495  if RealMap[Loc1] and fTerrain = fGrass then


1496  inc(CntGoodGrass)


1497  else


1498  inc(CntGood);


1499  end;


1500  for V21 := 1 to 26 do


1501  if V21 <> CityOwnTile then


1502  begin


1503  Loc1 := Radius[V21];


1504  if (Loc1 >= 0) and (Loc1 < MapSize) and


1505  (RealMap[Loc1] and fDeadLands = 0) then


1506  if IsGoodTile(Loc1) and (DelphiRandom(CntGood) < MinGood  CntGoodGrass + 1)


1507  then


1508  begin


1509  RealMap[Loc1] := RealMap[Loc1] and not(fTerrain or fSpecial)


1510  or fGrass;


1511  RealMap[Loc1] := RealMap[Loc1] or ActualSpecialTile(Loc1) shl 5;


1512  end


1513  else if RealMap[Loc1] and fTerrain = fDesert then


1514  RealMap[Loc1] := RealMap[Loc1] and not fTerrain or fPrairie


1515  else if (RealMap[Loc1] and fTerrain in [fPrairie, fTundra, fSwamp])


1516  and (DelphiRandom(2) = 0) then


1517  RealMap[Loc1] := RealMap[Loc1] and not fTerrain or fForest;


1518  end;


1519 


1520  // first irrigation


1521  nIrrLoc := 0;


1522  for V21 := 1 to 26 do


1523  if V21 <> CityOwnTile then


1524  begin


1525  Loc1 := Radius[V21];


1526  if (Loc1 >= 0) and (Loc1 < MapSize) and


1527  (RealMap[Loc1] and (fTerrain or fSpecial) = fGrass or fSpecial1) then


1528  begin


1529  IrrLoc[nIrrLoc] := Loc1;


1530  inc(nIrrLoc);


1531  end;


1532  end;


1533  i := 2;


1534  if i > nIrrLoc then


1535  i := nIrrLoc;


1536  while i > 0 do


1537  begin


1538  j := DelphiRandom(nIrrLoc);


1539  RealMap[IrrLoc[j]] := RealMap[IrrLoc[j]] or tiIrrigation;


1540  IrrLoc[j] := IrrLoc[nIrrLoc  1];


1541  dec(nIrrLoc);


1542  dec(i);


1543  end;


1544  end;


1545 


1546  StartLoc[0] := 0;


1547  for p1 := 0 to nPl  1 do


1548  if 1 shl p1 and GAlive <> 0 then


1549  begin


1550  repeat


1551  i := DelphiRandom(nAlive) + 1


1552  until StartLoc0[i] >= 0;


1553  StartLoc[p1] := StartLoc0[i];


1554  StartLoc0[i] := 1


1555  end;


1556  SaveMapCenterLoc := StartLoc[0];


1557 


1558  // second unit starting position


1559  for p1 := 0 to nPl  1 do


1560  if 1 shl p1 and GAlive <> 0 then


1561  begin


1562  StartLoc2[p1] := StartLoc[p1];


1563  V8_to_Loc(StartLoc[p1], Adjacent);


1564  for V8 := 0 to 7 do


1565  begin


1566  Loc1 := Adjacent[V8];


1567  for p2 := 0 to nPl  1 do


1568  if (1 shl p2 and GAlive <> 0) and (StartLoc[p2] = Loc1) then


1569  Loc1 := 1;


1570  for p2 := 0 to p1  1 do


1571  if (1 shl p2 and GAlive <> 0) and (StartLoc2[p2] = Loc1) then


1572  Loc1 := 1;


1573  if (Loc1 < 0) or (Loc1 >= MapSize) or


1574  (RealMap[Loc1] and fTerrain in [fOcean, fShore, fDesert, fArctic,


1575  fMountains]) or (RealMap[Loc1] and fDeadLands <> 0) then


1576  TestDist := 1


1577  else if RealMap[Loc1] and fTerrain = fGrass then


1578  TestDist := 2


1579  else if Terrain[RealMap[Loc1] and fTerrain].IrrEff > 0 then


1580  TestDist := 1


1581  else


1582  TestDist := 0;


1583  if (StartLoc2[p1] = StartLoc[p1]) or (TestDist > BestDist) then


1584  begin


1585  StartLoc2[p1] := Loc1;


1586  BestDist := TestDist;


1587  n := 1;


1588  end


1589  else if TestDist = BestDist then


1590  begin


1591  inc(n);


1592  if DelphiRandom(n) = 0 then


1593  StartLoc2[p1] := Loc1;


1594  end;


1595  end;


1596  end;


1597  end; { StartPositions }


1598 


1599  procedure PredefinedStartPositions(Human: integer);


1600  // use predefined nation start positions


1601  var


1602  i, p1, Loc1, nAlive, nStartLoc0, nPrefStartLoc0, imax: integer;


1603  StartLoc0: array [0 .. lxmax * lymax  1] of integer;


1604  ishuman: boolean;


1605  begin


1606  nAlive := 0;


1607  for p1 := 0 to nPl  1 do


1608  if 1 shl p1 and GAlive <> 0 then


1609  inc(nAlive);


1610  if nAlive = 0 then


1611  exit;


1612 


1613  for I := 0 to Length(StartLoc0)  1 do


1614  StartLoc0[I] := 0;


1615 


1616  // calculate starting positions


1617  nStartLoc0 := 0;


1618  nPrefStartLoc0 := 0;


1619  for Loc1 := 0 to MapSize  1 do


1620  if RealMap[Loc1] and fPrefStartPos <> 0 then


1621  begin


1622  StartLoc0[nStartLoc0] := StartLoc0[nPrefStartLoc0];


1623  StartLoc0[nPrefStartLoc0] := Loc1;


1624  inc(nPrefStartLoc0);


1625  inc(nStartLoc0);


1626  RealMap[Loc1] := RealMap[Loc1] and not fPrefStartPos;


1627  end


1628  else if RealMap[Loc1] and fStartPos <> 0 then


1629  begin


1630  StartLoc0[nStartLoc0] := Loc1;


1631  inc(nStartLoc0);


1632  RealMap[Loc1] := RealMap[Loc1] and not fStartPos;


1633  end;


1634  assert(nStartLoc0 >= nAlive);


1635 


1636  StartLoc[0] := 0;


1637  for ishuman := true downto false do


1638  for p1 := 0 to nPl  1 do


1639  if (1 shl p1 and GAlive <> 0) and ((1 shl p1 and Human <> 0) = ishuman)


1640  then


1641  begin


1642  dec(nStartLoc0);


1643  imax := nStartLoc0;


1644  if nPrefStartLoc0 > 0 then


1645  begin


1646  dec(nPrefStartLoc0);


1647  imax := nPrefStartLoc0;


1648  end;


1649  i := DelphiRandom(imax + 1);


1650  StartLoc[p1] := StartLoc0[i];


1651  StartLoc2[p1] := StartLoc0[i];


1652  StartLoc0[i] := StartLoc0[imax];


1653  StartLoc0[imax] := StartLoc0[nStartLoc0];


1654  end;


1655  SaveMapCenterLoc := StartLoc[0];


1656  end; { PredefinedStartPositions }


1657 


1658  procedure InitGame;


1659  var


1660  i, p, p1, uix, Loc1: integer;


1661  begin


1662  {$IFDEF FastContact}


1663  { Railroad everywhere }


1664  for Loc1 := 0 to MapSize  1 do


1665  if RealMap[Loc1] and fTerrain >= fGrass then


1666  RealMap[Loc1] := RealMap[Loc1] or fRR;


1667  {$ENDIF}


1668 


1669  { !!!for Loc1:=0 to MapSize1 do


1670  if RealMap[Loc1] and fterrain>=fGrass then


1671  if Delphirandom(3)=0 then RealMap[Loc1]:=RealMap[Loc1] or fRoad


1672  else if Delphirandom(3)=0 then RealMap[Loc1]:=RealMap[Loc1] or fRR;


1673  {random Road and Railroad }


1674  { !!!for Loc1:=0 to MapSize1 do


1675  if (RealMap[Loc1] and fterrain>=fGrass) and (Delphirandom(20)=0) then


1676  RealMap[Loc1]:=RealMap[Loc1] or fPoll; }


1677 


1678  FillChar(Occupant, MapSize, Byte(1));


1679  FillChar(ZoCMap, MapSize, 0);


1680  FillChar(ObserveLevel, MapSize * 4, 0);


1681  FillChar(UsedByCity, MapSize * 4, Byte(1));


1682  GTestFlags := 0;


1683  GInitialized := GAlive or GWatching;


1684  for p := 0 to nPl  1 do


1685  if 1 shl p and GInitialized <> 0 then


1686  with RW[p] do


1687  begin


1688  Researched[p] := 0;


1689  Discovered[p] := 0;


1690  TerritoryCount[p] := 0;


1691  nTech[p] := 0;


1692  if Difficulty[p] = 0 then


1693  ResourceMask[p] := $FFFFFFFF


1694  else


1695  ResourceMask[p] := $FFFFFFFF and not(fSpecial2 or fModern);


1696  GrWallContinent[p] := 1;


1697 


1698  GetMem(Map, 4 * MapSize);


1699  GetMem(MapObservedLast, 2 * MapSize);


1700  FillChar(MapObservedLast^, 2 * MapSize, Byte(1));


1701  GetMem(Territory, MapSize);


1702  FillChar(Territory^, MapSize, $FF);


1703  GetMem(Un, numax * SizeOf(TUn));


1704  GetMem(Model, (nmmax + 1) * SizeOf(TModel));


1705  // draft needs one model behind last


1706  GetMem(City, ncmax * SizeOf(TCity));


1707  GetMem(EnemyUn, neumax * SizeOf(TUnitInfo));


1708  GetMem(EnemyCity, necmax * SizeOf(TCityInfo));


1709  GetMem(EnemyModel, nemmax * SizeOf(TModelInfo));


1710  for p1 := 0 to nPl  1 do


1711  begin


1712  if 1 shl p1 and GInitialized <> 0 then


1713  begin


1714  FillChar(RWemix[p, p1], SizeOf(RWemix[p, p1]), 255); { 1 }


1715  FillChar(Destroyed[p, p1], SizeOf(Destroyed[p, p1]), 0);


1716  end;


1717  Attitude[p1] := atNeutral;


1718  Treaty[p1] := trNoContact;


1719  LastCancelTreaty[p1] := CancelTreatyTurns  1;


1720  EvaStart[p1] := PeaceEvaTurns  1;


1721  Tribute[p1] := 0;


1722  TributePaid[p1] := 0;


1723  if (p1 <> p) and (1 shl p1 and GAlive <> 0) then


1724  begin // initialize enemy report


1725  GetMem(EnemyReport[p1], SizeOf(TEnemyReport)  2 *


1726  (INFIN + 1  nmmax));


1727  FillChar(EnemyReport[p1].Tech, nAdv, Byte(tsNA));


1728  EnemyReport[p1].TurnOfContact := 1;


1729  EnemyReport[p1].TurnOfCivilReport := 1;


1730  EnemyReport[p1].TurnOfMilReport := 1;


1731  EnemyReport[p1].Attitude := atNeutral;


1732  EnemyReport[p1].Government := gDespotism;


1733  if 1 shl p and GAlive = 0 then


1734  Treaty[p1] := trNone // supervisor


1735  end


1736  else


1737  EnemyReport[p1] := nil;


1738  end;


1739  TestFlags := GTestFlags;


1740  Credibility := InitialCredibility;


1741  MaxCredibility := 100;


1742  nUn := 0;


1743  nModel := 0;


1744  nCity := 0;


1745  nEnemyUn := 0;


1746  nEnemyCity := 0;


1747  nEnemyModel := 0;


1748  for Loc1 := 0 to MapSize  1 do


1749  Map[Loc1] := fUNKNOWN;


1750  FillChar(Tech, nAdv, Byte(tsNA));


1751  FillChar(NatBuilt, SizeOf(NatBuilt), 0);


1752  end;


1753 


1754  // create initial models and units


1755  for p := 0 to nPl  1 do


1756  if (1 shl p and GAlive <> 0) then


1757  with RW[p] do


1758  begin


1759  nModel := 0;


1760  for i := 0 to nSpecialModel  1 do


1761  if SpecialModelPreq[i] = preNone then


1762  begin


1763  Model[nModel] := SpecialModel[i];


1764  Model[nModel].Status := 0;


1765  Model[nModel].IntroTurn := 0;


1766  Model[nModel].Built := 0;


1767  Model[nModel].Lost := 0;


1768  Model[nModel].ID := p shl 12 + nModel;


1769  SetModelFlags(Model[nModel]);


1770  inc(nModel)


1771  end;


1772  nUn := 0;


1773  UnBuilt[p] := 0;


1774  for uix := 0 to nStartUn  1 do


1775  begin


1776  CreateUnit(p, StartUn[uix]);


1777  dec(Model[StartUn[uix]].Built);


1778  Un[uix].Loc := StartLoc2[p];


1779  PlaceUnit(p, uix);


1780  end;


1781  FoundCity(p, StartLoc[p]); // capital


1782  Founded[p] := 1;


1783  with City[0] do


1784  begin


1785  ID := p shl 12;


1786  Flags := chFounded;


1787  end;


1788  end;


1789 


1790  TerritoryCount[nPl] := MapSize;


1791  // fillchar(NewContact, sizeof(NewContact), false);


1792  end; // InitGame


1793 


1794  procedure InitRandomGame;


1795  begin


1796  DelphiRandSeed := RND;


1797  CalculatePrimitive;


1798  CreateElevation;


1799  CreateMap(false);


1800  StartPositions;


1801  InitGame;


1802  end;


1803 


1804  procedure InitMapGame(Human: integer);


1805  begin


1806  DelphiRandSeed := RND;


1807  FindContinents;


1808  PredefinedStartPositions(Human);


1809  InitGame;


1810  end;


1811 


1812  procedure ReleaseGame;


1813  var


1814  p1, p2: integer;


1815  begin


1816  for p1 := 0 to nPl  1 do


1817  if 1 shl p1 and GInitialized <> 0 then


1818  begin


1819  for p2 := 0 to nPl  1 do


1820  if RW[p1].EnemyReport[p2] <> nil then


1821  FreeMem(RW[p1].EnemyReport[p2]);


1822  FreeMem(RW[p1].EnemyUn);


1823  FreeMem(RW[p1].EnemyCity);


1824  FreeMem(RW[p1].EnemyModel);


1825  FreeMem(RW[p1].Un);


1826  FreeMem(RW[p1].City);


1827  FreeMem(RW[p1].Model);


1828  FreeMem(RW[p1].Territory);


1829  FreeMem(RW[p1].MapObservedLast);


1830  FreeMem(RW[p1].Map);


1831  end;


1832  end;


1833 


1834  procedure InitMapEditor;


1835  var


1836  p1: integer;


1837  begin


1838  CalculatePrimitive;


1839  FillChar(Occupant, MapSize, Byte(1));


1840  FillChar(ObserveLevel, MapSize * 4, 0);


1841  with RW[0] do


1842  begin


1843  ResourceMask[0] := $FFFFFFFF;


1844  GetMem(Map, 4 * MapSize);


1845  GetMem(MapObservedLast, 2 * MapSize);


1846  FillChar(MapObservedLast^, 2 * MapSize, Byte(1));


1847  GetMem(Territory, MapSize);


1848  FillChar(Territory^, MapSize, $FF);


1849  Un := nil;


1850  Model := nil;


1851  City := nil;


1852  EnemyUn := nil;


1853  EnemyCity := nil;


1854  EnemyModel := nil;


1855  for p1 := 0 to nPl  1 do


1856  EnemyReport[p1] := nil;


1857  nUn := 0;


1858  nModel := 0;


1859  nCity := 0;


1860  nEnemyUn := 0;


1861  nEnemyCity := 0;


1862  nEnemyModel := 0;


1863  end;


1864  end;


1865 


1866  procedure ReleaseMapEditor;


1867  begin


1868  FreeMem(RW[0].Territory);


1869  FreeMem(RW[0].MapObservedLast);


1870  FreeMem(RW[0].Map);


1871  end;


1872 


1873  procedure EditTile(Loc, NewTile: integer);


1874  var


1875  Loc1, V21: integer;


1876  Radius: TVicinity21Loc;


1877  begin


1878  if NewTile and fDeadLands <> 0 then


1879  NewTile := NewTile and (fDeadLands or fModern or fRiver) or fDesert;


1880  case NewTile and fTerrain of


1881  fOcean, fShore:


1882  NewTile := NewTile and (fTerrain or fSpecial);


1883  fMountains, fArctic:


1884  NewTile := NewTile and not fRiver;


1885  end;


1886  with Terrain[NewTile and fTerrain] do


1887  if (ClearTerrain >= 0) or (AfforestTerrain >= 0) or (TransTerrain >= 0) then


1888  NewTile := NewTile or fSpecial;


1889  // only automatic special resources for transformable tiles


1890  if NewTile and fRR <> 0 then


1891  NewTile := NewTile and not fRoad;


1892  if not((NewTile and fTerrain) in TerrType_Canalable) then


1893  NewTile := NewTile and not fCanal;


1894  if Terrain[NewTile and fTerrain].IrrEff = 0 then


1895  begin


1896  NewTile := NewTile and not(fPrefStartPos or fStartPos);


1897  if (NewTile and fTerImp = tiIrrigation) or (NewTile and fTerImp = tiFarm)


1898  then


1899  NewTile := NewTile and not fTerImp


1900  end;


1901  if (Terrain[NewTile and fTerrain].MineEff = 0) and


1902  (NewTile and fTerImp = tiMine) then


1903  NewTile := NewTile and not fTerImp;


1904 


1905  RealMap[Loc] := NewTile;


1906  if NewTile and fSpecial = fSpecial then


1907  // standard special resource distribution


1908  RealMap[Loc] := RealMap[Loc] and not fSpecial or


1909  ActualSpecialTile(Loc) shl 5;


1910 


1911  // automatic shore tiles


1912  V21_to_Loc(Loc, Radius);


1913  for V21 := 1 to 26 do


1914  begin


1915  Loc1 := Radius[V21];


1916  if (Loc1 >= 0) and (Loc1 < MapSize) then


1917  begin


1918  if CheckShore(Loc1) then


1919  RealMap[Loc1] := RealMap[Loc1] and not fSpecial or


1920  ActualSpecialTile(Loc1) shl 5;


1921  RealMap[Loc1] := RealMap[Loc1] or ($F shl 27);


1922  RW[0].Map[Loc1] := RealMap[Loc1] and $07FFFFFF or fObserved;


1923  end


1924  end;


1925  // RealMap[Loc]:=RealMap[Loc] and not fSpecial;


1926  // RW[0].Map[Loc]:=RealMap[Loc] or fObserved;


1927  end;


1928 


1929  {


1930  Map Revealing


1931  ____________________________________________________________________


1932  }


1933  function GetTileInfo(p, cix, Loc: integer; var Info: TTileInfo): integer;


1934  // cix>=0  known city index of player p  only core internal!


1935  // cix=1  search city, player unknown, only if permission for p


1936  // cix=2  don't search city, don't calculate city benefits, just government of player p


1937  var


1938  p0, Tile, special: integer;


1939  begin


1940  with Info do


1941  begin


1942  p0 := p;


1943  if cix >= 0 then


1944  Tile := RealMap[Loc]


1945  else


1946  begin


1947  Tile := RW[p].Map[Loc];


1948  if Tile and fTerrain = fUNKNOWN then


1949  begin


1950  result := eNoPreq;


1951  exit;


1952  end;


1953  end;


1954 


1955  if (cix = 1) and (UsedByCity[Loc] >= 0) then


1956  begin // search exploiting player and city


1957  SearchCity(UsedByCity[Loc], p, cix);


1958  if not((p = p0) or (ObserveLevel[UsedByCity[Loc]] shr (2 * p0) and


1959  3 = lObserveSuper)) then


1960  cix := 1


1961  end;


1962  if cix = 1 then


1963  begin


1964  result := eInvalid;


1965  exit;


1966  end; // no city found here


1967 


1968  special := Tile and fSpecial and ResourceMask[p] shr 5;


1969  with Terrain[Tile and fTerrain] do


1970  begin


1971  Food := FoodRes[special];


1972  Prod := ProdRes[special];


1973  Trade := TradeRes[special];


1974  if (special > 0) and (Tile and fTerrain <> fGrass) and


1975  (RW[p].NatBuilt[imSpacePort] > 0) then


1976  begin // GeoSat effect


1977  Food := 2 * Food  FoodRes[0];


1978  Prod := 2 * Prod  ProdRes[0];


1979  Trade := 2 * Trade  TradeRes[0];


1980  end;


1981 


1982  if (Tile and fTerImp = tiIrrigation) or (Tile and fTerImp = tiFarm) or


1983  (Tile and fCity <> 0) then


1984  inc(Food, IrrEff); { irrigation effect }


1985  if Tile and fTerImp = tiMine then


1986  inc(Prod, MineEff); { mining effect }


1987  if (Tile and fRiver <> 0) and (RW[p].Tech[adMapMaking] >= tsApplicable)


1988  then


1989  inc(Trade); { river effect }


1990  if (Tile and (fRoad or fRR) <> 0) and (MoveCost = 1) and


1991  (RW[p].Tech[adWheel] >= tsApplicable) then


1992  inc(Trade); { road effect }


1993  if (Tile and (fRR or fCity) <> 0) and


1994  (RW[p].Tech[adRailroad] >= tsApplicable) then


1995  inc(Prod, Prod shr 1); { railroad effect }


1996 


1997  ExplCity := 1;


1998  if (cix >= 0) and (p = p0) then


1999  ExplCity := cix;


2000  if cix >= 0 then


2001  if Tile and fTerrain >= fGrass then


2002  begin


2003  if ((Tile and fTerImp = tiFarm) or (Tile and fCity <> 0)) and


2004  (RW[p].City[cix].Built[imSupermarket] > 0) then


2005  inc(Food, Food shr 1); { farmland effect }


2006  if (Tile and (fRoad or fRR) <> 0) and (MoveCost = 1) and


2007  (RW[p].City[cix].Built[imHighways] > 0) then


2008  inc(Trade, 1); { superhighway effect }


2009  end


2010  else


2011  begin


2012  if RW[p].City[cix].Built[imHarbor] > 0 then


2013  inc(Food); { harbour effect }


2014  if RW[p].City[cix].Built[imPlatform] > 0 then


2015  inc(Prod); { oil platform effect }


2016  if GWonder[woLighthouse].EffectiveOwner = p then


2017  inc(Prod);


2018  end;


2019  end;


2020 


2021  { good government influence }


2022  if (RW[p].Government in [gRepublic, gDemocracy, gFuture]) and (Trade > 0)


2023  then


2024  inc(Trade);


2025  if (RW[p].Government = gCommunism) and (Prod > 1) then


2026  inc(Prod);


2027 


2028  if RW[p].Government in [gAnarchy, gDespotism] then


2029  begin { bad government influence }


2030  if Food > 3 then


2031  Food := 3;


2032  if Prod > 2 then


2033  Prod := 2;


2034  if Trade > 2 then


2035  Trade := 2;


2036  end;


2037 


2038  if Tile and (fTerrain or fPoll) > fPoll then


2039  begin { pollution  decrease ressources }


2040  dec(Food, Food shr 1);


2041  dec(Prod, Prod shr 1);


2042  dec(Trade, Trade shr 1);


2043  end;


2044 


2045  if Tile and fCity <> 0 then


2046  Trade := 0


2047  else if (cix >= 0) and (RW[p].City[cix].Built[imCourt] + RW[p].City[cix]


2048  .Built[imPalace] = 0) then


2049  if RW[p].City[cix].Built[imTownHall] = 0 then


2050  Trade := 0


2051  else if Trade > 3 then


2052  Trade := 3;


2053  end;


2054  result := eOK;


2055  end; { GetTileInfo }


2056 


2057  procedure Strongest(Loc: integer; var uix, Strength, Bonus, Cnt: integer);


2058  { find strongest defender at Loc }


2059  var


2060  Defender, uix1, Det, Cost, TestStrength, TestBonus, TestDet, TestCost,


2061  Domain: integer;


2062  PUn: ^TUn;


2063  PModel: ^TModel;


2064  begin


2065  Defender := Occupant[Loc];


2066  Cost := 0;


2067  Cnt := 0;


2068  Det := 1;


2069  for uix1 := 0 to RW[Defender].nUn  1 do


2070  begin


2071  PUn := @RW[Defender].Un[uix1];


2072  PModel := @RW[Defender].Model[PUn.mix];


2073  if PModel.Kind = mkSpecial_Glider then


2074  Domain := dGround


2075  else


2076  Domain := PModel.Domain;


2077  if PUn.Loc = Loc then


2078  begin


2079  inc(Cnt);


2080  if PUn.Master < 0 then


2081  begin


2082  if Domain < dSea then


2083  begin


2084  TestBonus := Terrain[RealMap[Loc] and fTerrain].Defense;


2085  if RealMap[Loc] and fTerImp = tiFort then


2086  inc(TestBonus, 4);


2087  if PUn.Flags and unFortified <> 0 then


2088  inc(TestBonus, 2);


2089  if (PModel.Kind = mkSpecial_TownGuard) and


2090  (RealMap[Loc] and fCity <> 0) then


2091  inc(TestBonus, 4);


2092  end


2093  else


2094  TestBonus := 4;


2095  inc(TestBonus, PUn.exp div ExpCost);


2096  TestStrength := PModel.Defense * TestBonus * PUn.Health;


2097  if (Domain = dAir) and ((RealMap[Loc] and fCity <> 0) or


2098  (RealMap[Loc] and fTerImp = tiBase)) then


2099  TestStrength := 0;


2100  if (Domain = dSea) and (RealMap[Loc] and fTerrain >= fGrass) then


2101  TestStrength := TestStrength shr 1;


2102  TestDet := TestStrength;


2103  if PModel.Cap[mcStealth] > 0 then


2104  else if PModel.Cap[mcSub] > 0 then


2105  inc(TestDet, 1 shl 28)


2106  else if (Domain = dGround) and (PModel.Cap[mcFanatic] > 0) and


2107  not(RW[Defender].Government in [gRepublic, gDemocracy, gFuture]) then


2108  inc(TestDet, 4 shl 28) // fanatic ground units always defend


2109  else if PModel.Flags and mdZOC <> 0 then


2110  inc(TestDet, 3 shl 28)


2111  else


2112  inc(TestDet, 2 shl 28);


2113  TestCost := RW[Defender].Model[PUn.mix].Cost;


2114  if (TestDet > Det) or (TestDet = Det) and (TestCost < Cost) then


2115  begin


2116  uix := uix1;


2117  Strength := TestStrength;


2118  Bonus := TestBonus;


2119  Det := TestDet;


2120  Cost := TestCost;


2121  end;


2122  end;


2123  end;


2124  end;


2125  end;


2126 


2127  function UnitSpeed(p, mix, Health: integer): integer;


2128  begin


2129  with RW[p].Model[mix] do


2130  begin


2131  result := Speed;


2132  if Domain = dSea then


2133  begin


2134  if GWonder[woMagellan].EffectiveOwner = p then


2135  inc(result, 200);


2136  if Health < 100 then


2137  result := ((result  250) * Health div 5000) * 50 + 250;


2138  end


2139  end


2140  end;


2141 


2142  procedure GetUnitReport(p, uix: integer; var UnitReport: TUnitReport);


2143  var


2144  TerrOwner: integer;


2145  PModel: ^TModel;


2146  begin


2147  UnitReport.FoodSupport := 0;


2148  UnitReport.ProdSupport := 0;


2149  UnitReport.ReportFlags := 0;


2150  if RW[p].Government <> gAnarchy then


2151  with RW[p].Un[uix] do


2152  begin


2153  PModel := @RW[p].Model[mix];


2154  if (PModel.Kind = mkSettler)


2155  { and (GWonder[woFreeSettlers].EffectiveOwner<>p) } then


2156  UnitReport.FoodSupport := SettlerFood[RW[p].Government]


2157  else if Flags and unConscripts <> 0 then


2158  UnitReport.FoodSupport := 1;


2159 


2160  if RW[p].Government <> gFundamentalism then


2161  begin


2162  if GTestFlags and tfImmImprove = 0 then


2163  begin


2164  if PModel.Flags and mdDoubleSupport <> 0 then


2165  UnitReport.ProdSupport := 2


2166  else


2167  UnitReport.ProdSupport := 1;


2168  if PModel.Kind = mkSpecial_TownGuard then


2169  UnitReport.ReportFlags := UnitReport.ReportFlags or


2170  urfAlwaysSupport;


2171  end;


2172  if PModel.Flags and mdCivil = 0 then


2173  begin


2174  TerrOwner := RealMap[Loc] shr 27;


2175  case RW[p].Government of


2176  gRepublic, gFuture:


2177  if (TerrOwner <> p) and (TerrOwner < nPl) and


2178  (RW[p].Treaty[TerrOwner] < trAlliance) then


2179  UnitReport.ReportFlags := UnitReport.ReportFlags or urfDeployed;


2180  gDemocracy:


2181  if (TerrOwner >= nPl) or (TerrOwner <> p) and


2182  (RW[p].Treaty[TerrOwner] < trAlliance) then


2183  UnitReport.ReportFlags := UnitReport.ReportFlags or urfDeployed;


2184  end;


2185  end;


2186  end;


2187  end;


2188  end;


2189 


2190  procedure SearchCity(Loc: integer; var p, cix: integer);


2191  // set p to supposed owner before call


2192  var


2193  i: integer;


2194  begin


2195  if RealMap[Loc] < nPl shl 27 then


2196  p := RealMap[Loc] shr 27;


2197  for i := 0 to nPl  1 do


2198  begin


2199  if 1 shl p and GAlive <> 0 then


2200  with RW[p] do


2201  begin


2202  cix := nCity  1;


2203  while (cix >= 0) and (City[cix].Loc <> Loc) do


2204  dec(cix);


2205  if cix >= 0 then


2206  exit;


2207  end;


2208  assert(i < nPl  1);


2209  p := (p + 1) mod nPl;


2210  end;


2211  end;


2212 


2213  procedure MakeCityInfo(p, cix: integer; var ci: TCityInfo);


2214  begin


2215  assert((p >= 0) and (p < nPl));


2216  assert((cix >= 0) and (cix < RW[p].nCity));


2217  with RW[p].City[cix] do


2218  begin


2219  ci.Loc := Loc;


2220  ci.ID := ID;


2221  ci.Owner := p;


2222  ci.Size := Size;


2223  ci.Flags := 0;


2224  if Built[imPalace] > 0 then


2225  inc(ci.Flags, ciCapital);


2226  if (Built[imWalls] > 0) or (Continent[Loc] = GrWallContinent[p]) then


2227  inc(ci.Flags, ciWalled);


2228  if Built[imCoastalFort] > 0 then


2229  inc(ci.Flags, ciCoastalFort);


2230  if Built[imMissileBat] > 0 then


2231  inc(ci.Flags, ciMissileBat);


2232  if Built[imBunker] > 0 then


2233  inc(ci.Flags, ciBunker);


2234  if Built[imSpacePort] > 0 then


2235  inc(ci.Flags, ciSpacePort);


2236  end;


2237  end;


2238 


2239  procedure TellAboutModel(p, taOwner, tamix: integer);


2240  var


2241  i: integer;


2242  begin


2243  if (p = taOwner) or (Mode < moPlaying) then


2244  exit;


2245  i := 0;


2246  while (i < RW[p].nEnemyModel) and ((RW[p].EnemyModel[i].Owner <> taOwner) or


2247  (RW[p].EnemyModel[i].mix <> tamix)) do


2248  inc(i);


2249  if i = RW[p].nEnemyModel then


2250  IntServer(sIntTellAboutModel + p shl 4, taOwner, tamix, nil^);


2251  end;


2252 


2253  function emixSafe(p, taOwner, tamix: integer): integer;


2254  begin


2255  result := RWemix[p, taOwner, tamix];


2256  if result < 0 then


2257  begin // sIntTellAboutModel comes too late


2258  assert(Mode = moMovie);


2259  result := $FFFF;


2260  end;


2261  end;


2262 


2263  procedure IntroduceEnemy(p1, p2: integer);


2264  begin


2265  RW[p1].Treaty[p2] := trNone;


2266  RW[p2].Treaty[p1] := trNone;


2267  end;


2268 


2269  function DiscoverTile(Loc, p, pTell, Level: integer; EnableContact: boolean;


2270  euix: integer = 2): boolean;


2271  // euix = 2: full discover


2272  // euix = 1: unit and city only, append units in EnemyUn


2273  // euix >= 0: unit and city only, replace EnemyUn[euix]


2274 


2275  procedure SetContact(p1, p2: integer);


2276  begin


2277  if (Mode < moPlaying) or (p1 = p2) or (RW[p1].Treaty[p2] > trNoContact) then


2278  exit;


2279  IntServer(sIntTellAboutNation, p1, p2, nil^);


2280  // NewContact[p1,p2]:=true


2281  end;


2282 


2283  var


2284  i, uix, cix, TerrOwner, TerrOwnerTreaty, Strength, Bonus, Cnt, pFoundCity,


2285  cixFoundCity, MinLevel, Loc1, V8: integer;


2286  Tile, AddFlags: Cardinal;


2287  Adjacent: TVicinity8Loc;


2288  unx: ^TUn;


2289  mox: ^TModel;


2290  begin


2291  result := false;


2292  with RW[pTell] do


2293  begin


2294  Tile := RealMap[Loc] and ResourceMask[pTell];


2295  if Mode = moLoading_Fast then


2296  AddFlags := 0 // don't discover units


2297  else


2298  begin


2299  AddFlags := Map[Loc] and fInEnemyZoC // always preserve this flag!


2300  or fObserved;


2301  if Level = lObserveSuper then


2302  AddFlags := AddFlags or fSpiedOut;


2303  if (GrWallContinent[pTell] >= 0) and


2304  (Continent[Loc] = GrWallContinent[pTell]) then


2305  AddFlags := AddFlags or fGrWall;


2306  if (Mode = moPlaying) and ((Tile and (nPl shl 27) <> nPl shl 27) and


2307  (pTell = p)) then


2308  begin // set fPeace flag?


2309  TerrOwner := Tile shr 27;


2310  if TerrOwner <> pTell then


2311  begin


2312  TerrOwnerTreaty := RW[pTell].Treaty[TerrOwner];


2313  if 1 shl TerrOwnerTreaty and


2314  (1 shl trPeace or 1 shl TrFriendlyContact) <> 0 then


2315  AddFlags := AddFlags or fPeace;


2316  end


2317  end;


2318 


2319  if Occupant[Loc] >= 0 then


2320  if Occupant[Loc] = pTell then


2321  begin


2322  AddFlags := AddFlags or (fOwned or fUnit);


2323  if ZoCMap[Loc] > 0 then


2324  AddFlags := AddFlags or fOwnZoCUnit;


2325  // Level:=lObserveSuper // always see own units


2326  end


2327  else if Map[Loc] and fUnit <> 0 then


2328  AddFlags := AddFlags or fUnit


2329  else


2330  begin


2331  Strongest(Loc, uix, Strength, Bonus, Cnt);


2332  unx := @RW[Occupant[Loc]].Un[uix];


2333  mox := @RW[Occupant[Loc]].Model[unx.mix];


2334  assert((ZoCMap[Loc] <> 0) = (mox.Flags and mdZOC <> 0));


2335  if (mox.Cap[mcStealth] > 0) and (Tile and fCity = 0) and


2336  (Tile and fTerImp <> tiBase) then


2337  MinLevel := lObserveSuper


2338  else if (mox.Cap[mcSub] > 0) and (Tile and fTerrain < fGrass) then


2339  MinLevel := lObserveAll


2340  else


2341  MinLevel := lObserveUnhidden;


2342  if Level >= MinLevel then


2343  begin


2344  AddFlags := AddFlags or fUnit;


2345  if euix >= 0 then


2346  uix := euix


2347  else


2348  begin


2349  uix := nEnemyUn;


2350  inc(nEnemyUn);


2351  assert(nEnemyUn < neumax);


2352  end;


2353  MakeUnitInfo(Occupant[Loc], unx^, EnemyUn[uix]);


2354  if Cnt > 1 then


2355  EnemyUn[uix].Flags := EnemyUn[uix].Flags or unMulti;


2356  if (mox.Flags and mdZOC <> 0) and (pTell = p) and


2357  (Treaty[Occupant[Loc]] < trAlliance) then


2358  begin // set fInEnemyZoC flags of surrounding tiles


2359  V8_to_Loc(Loc, Adjacent);


2360  for V8 := 0 to 7 do


2361  begin


2362  Loc1 := Adjacent[V8];


2363  if (Loc1 >= 0) and (Loc1 < MapSize) then


2364  Map[Loc1] := Map[Loc1] or fInEnemyZoC


2365  end


2366  end;


2367  if EnableContact and (mox.Domain = dGround) then


2368  SetContact(pTell, Occupant[Loc]);


2369  if Mode >= moMovie then


2370  begin


2371  TellAboutModel(pTell, Occupant[Loc], unx.mix);


2372  EnemyUn[uix].emix := emixSafe(pTell, Occupant[Loc], unx.mix);


2373  end;


2374  // Level:=lObserveSuper; // don't discover unit twice


2375  if (pTell = p) and


2376  ((Tile and fCity = 0) or (1 shl pTell and GAI <> 0)) then


2377  result := true;


2378  end


2379  else


2380  AddFlags := AddFlags or Map[Loc] and (fStealthUnit or fHiddenUnit);


2381  end;


2382  end; // if Mode>moLoading_Fast


2383 


2384  if Tile and fCity <> 0 then


2385  if ObserveLevel[Loc] shr (2 * pTell) and 3 > 0 then


2386  AddFlags := AddFlags or Map[Loc] and fOwned


2387  else


2388  begin


2389  pFoundCity := Tile shr 27;


2390  if pFoundCity = pTell then


2391  AddFlags := AddFlags or fOwned


2392  else


2393  begin


2394  if EnableContact then


2395  SetContact(pTell, pFoundCity);


2396  cixFoundCity := RW[pFoundCity].nCity  1;


2397  while (cixFoundCity >= 0) and


2398  (RW[pFoundCity].City[cixFoundCity].Loc <> Loc) do


2399  dec(cixFoundCity);


2400  assert(cixFoundCity >= 0);


2401  i := 0;


2402  while (i < nEnemyCity) and (EnemyCity[i].Loc <> Loc) do


2403  inc(i);


2404  if i = nEnemyCity then


2405  begin


2406  inc(nEnemyCity);


2407  assert(nEnemyCity < necmax);


2408  EnemyCity[i].Status := 0;


2409  EnemyCity[i].SavedStatus := 0;


2410  if pTell = p then


2411  result := true;


2412  end;


2413  MakeCityInfo(pFoundCity, cixFoundCity, EnemyCity[i]);


2414  end;


2415  end


2416  else if Map[Loc] and fCity <> 0 then // remove enemycity


2417  for cix := 0 to nEnemyCity  1 do


2418  if EnemyCity[cix].Loc = Loc then


2419  EnemyCity[cix].Loc := 1;


2420 


2421  if Map[Loc] and fTerrain = fUNKNOWN then


2422  inc(Discovered[pTell]);


2423  if euix >= 1 then


2424  Map[Loc] := Map[Loc] and not(fUnit or fCity or fOwned or fOwnZoCUnit) or


2425  (Tile and $07FFFFFF or AddFlags) and


2426  (fUnit or fCity or fOwned or fOwnZoCUnit)


2427  else


2428  begin


2429  Map[Loc] := Tile and $07FFFFFF or AddFlags;


2430  if Tile and $78000000 = $78000000 then


2431  Territory[Loc] := 1


2432  else


2433  Territory[Loc] := Tile shr 27;


2434  MapObservedLast[Loc] := GTurn


2435  end;


2436  ObserveLevel[Loc] := ObserveLevel[Loc] and not(3 shl (2 * pTell)) or


2437  Cardinal(Level) shl (2 * pTell);


2438  end;


2439  end; // DiscoverTile


2440 


2441  function Discover9(Loc, p, Level: integer;


2442  TellAllied, EnableContact: boolean): boolean;


2443  var


2444  V9, Loc1, pTell, OldLevel: integer;


2445  Radius: TVicinity8Loc;


2446  begin


2447  assert((Mode > moLoading_Fast) or (RW[p].nEnemyUn = 0));


2448  result := false;


2449  V8_to_Loc(Loc, Radius);


2450  for V9 := 0 to 8 do


2451  begin


2452  if V9 = 8 then


2453  Loc1 := Loc


2454  else


2455  Loc1 := Radius[V9];


2456  if (Loc1 >= 0) and (Loc1 < MapSize) then


2457  if TellAllied then


2458  begin


2459  for pTell := 0 to nPl  1 do


2460  if (pTell = p) or (1 shl pTell and GAlive <> 0) and


2461  (RW[p].Treaty[pTell] = trAlliance) then


2462  begin


2463  OldLevel := ObserveLevel[Loc1] shr (2 * pTell) and 3;


2464  if Level > OldLevel then


2465  result := DiscoverTile(Loc1, p, pTell, Level, EnableContact)


2466  or result;


2467  end;


2468  end


2469  else


2470  begin


2471  OldLevel := ObserveLevel[Loc1] shr (2 * p) and 3;


2472  if Level > OldLevel then


2473  result := DiscoverTile(Loc1, p, p, Level, EnableContact) or result;


2474  end;


2475  end;


2476  end;


2477 


2478  function Discover21(Loc, p, AdjacentLevel: integer;


2479  TellAllied, EnableContact: boolean): boolean;


2480  var


2481  V21, Loc1, pTell, Level, OldLevel, AdjacentFlags: integer;


2482  Radius: TVicinity21Loc;


2483  begin


2484  assert((Mode > moLoading_Fast) or (RW[p].nEnemyUn = 0));


2485  result := false;


2486  AdjacentFlags := $00267620 shr 1;


2487  V21_to_Loc(Loc, Radius);


2488  for V21 := 1 to 26 do


2489  begin


2490  Loc1 := Radius[V21];


2491  if (Loc1 >= 0) and (Loc1 < MapSize) then


2492  begin


2493  if AdjacentFlags and 1 <> 0 then


2494  Level := AdjacentLevel


2495  else


2496  Level := lObserveUnhidden;


2497  if TellAllied then


2498  begin


2499  for pTell := 0 to nPl  1 do


2500  if (pTell = p) or (1 shl pTell and GAlive <> 0) and


2501  (RW[p].Treaty[pTell] = trAlliance) then


2502  begin


2503  OldLevel := ObserveLevel[Loc1] shr (2 * pTell) and 3;


2504  if Level > OldLevel then


2505  result := DiscoverTile(Loc1, p, pTell, Level, EnableContact)


2506  or result;


2507  end;


2508  end


2509  else


2510  begin


2511  OldLevel := ObserveLevel[Loc1] shr (2 * p) and 3;


2512  if Level > OldLevel then


2513  result := DiscoverTile(Loc1, p, p, Level, EnableContact) or result;


2514  end;


2515  end;


2516  AdjacentFlags := AdjacentFlags shr 1;


2517  end;


2518  end;


2519 


2520  procedure DiscoverAll(p, Level: integer);


2521  { player p discovers complete playground (for supervisor) }


2522  var


2523  Loc, OldLevel: integer;


2524  begin


2525  assert((Mode > moLoading_Fast) or (RW[p].nEnemyUn = 0));


2526  for Loc := 0 to MapSize  1 do


2527  begin


2528  OldLevel := ObserveLevel[Loc] shr (2 * p) and 3;


2529  if Level > OldLevel then


2530  DiscoverTile(Loc, p, p, Level, false);


2531  end;


2532  end;


2533 


2534  procedure DiscoverViewAreas(p: integer);


2535  var


2536  pTell, uix, cix, ecix, Loc, RealOwner: integer;


2537  PModel: ^TModel;


2538  begin // discover unit and city view areas


2539  for pTell := 0 to nPl  1 do


2540  if (pTell = p) or (RW[p].Treaty[pTell] = trAlliance) then


2541  begin


2542  for uix := 0 to RW[pTell].nUn  1 do


2543  with RW[pTell].Un[uix] do


2544  if (Loc >= 0) and (Master < 0) and (RealMap[Loc] and fCity = 0) then


2545  begin


2546  PModel := @RW[pTell].Model[mix];


2547  if (PModel.Kind = mkDiplomat) or (PModel.Cap[mcSpy] > 0) then


2548  Discover21(Loc, p, lObserveSuper, false, true)


2549  else if (PModel.Cap[mcRadar] + PModel.Cap[mcCarrier] > 0) or


2550  (PModel.Domain = dAir) then


2551  Discover21(Loc, p, lObserveAll, false, false)


2552  else if (RealMap[Loc] and fTerrain = fMountains) or


2553  (RealMap[Loc] and fTerImp = tiFort) or


2554  (RealMap[Loc] and fTerImp = tiBase) or (PModel.Cap[mcAcademy] > 0)


2555  then


2556  Discover21(Loc, p, lObserveUnhidden, false,


2557  PModel.Domain = dGround)


2558  else


2559  Discover9(Loc, p, lObserveUnhidden, false,


2560  PModel.Domain = dGround);


2561  end;


2562  for cix := 0 to RW[pTell].nCity  1 do


2563  if RW[pTell].City[cix].Loc >= 0 then


2564  Discover21(RW[pTell].City[cix].Loc, p, lObserveUnhidden, false, true);


2565  for ecix := 0 to RW[pTell].nEnemyCity  1 do


2566  begin // players know territory, so no use in hiding city owner


2567  Loc := RW[pTell].EnemyCity[ecix].Loc;


2568  if Loc >= 0 then


2569  begin


2570  RealOwner := (RealMap[Loc] shr 27) and $F;


2571  if RealOwner < nPl then


2572  RW[pTell].EnemyCity[ecix].Owner := RealOwner


2573  else


2574  begin


2575  RW[pTell].EnemyCity[ecix].Loc := 1;


2576  RW[pTell].Map[Loc] := RW[pTell].Map[Loc] and not fCity


2577  end;


2578  end;


2579  end;


2580  end;


2581  end;


2582 


2583  function GetUnitStack(p, Loc: integer): integer;


2584  var


2585  uix: integer;


2586  unx: ^TUn;


2587  begin


2588  result := 0;


2589  if Occupant[Loc] < 0 then


2590  exit;


2591  for uix := 0 to RW[Occupant[Loc]].nUn  1 do


2592  begin


2593  unx := @RW[Occupant[Loc]].Un[uix];


2594  if unx.Loc = Loc then


2595  begin


2596  MakeUnitInfo(Occupant[Loc], unx^, RW[p].EnemyUn[RW[p].nEnemyUn + result]);


2597  TellAboutModel(p, Occupant[Loc], unx.mix);


2598  RW[p].EnemyUn[RW[p].nEnemyUn + result].emix :=


2599  RWemix[p, Occupant[Loc], unx.mix];


2600  inc(result);


2601  end;


2602  end;


2603  end;


2604 


2605  procedure UpdateUnitMap(Loc: integer; CityChange: boolean = false);


2606  // update maps and enemy units of all players after unit change


2607  var


2608  p, euix, OldLevel: integer;


2609  AddFlags, ClearFlags: Cardinal;


2610  begin


2611  if (Mode = moLoading_Fast) and not CityChange then


2612  exit;


2613  for p := 0 to nPl  1 do


2614  if 1 shl p and (GAlive or GWatching) <> 0 then


2615  begin


2616  OldLevel := ObserveLevel[Loc] shr (2 * p) and 3;


2617  if OldLevel > lNoObserve then


2618  begin


2619  if RW[p].Map[Loc] and (fUnit or fOwned) = fUnit then


2620  begin


2621  // replace unit located here in EnemyUn


2622  // do not just set loc:=1 because total number would be unlimited


2623  euix := RW[p].nEnemyUn  1;


2624  while euix >= 0 do


2625  begin


2626  if RW[p].EnemyUn[euix].Loc = Loc then


2627  begin


2628  RW[p].EnemyUn[euix].Loc := 1;


2629  Break;


2630  end;


2631  dec(euix);


2632  end;


2633  RW[p].Map[Loc] := RW[p].Map[Loc] and not fUnit


2634  end


2635  else


2636  begin // look for empty slot in EnemyUn


2637  euix := RW[p].nEnemyUn  1;


2638  while (euix >= 0) and (RW[p].EnemyUn[euix].Loc >= 0) do


2639  dec(euix);


2640  end;


2641  if (Occupant[Loc] < 0) and not CityChange then


2642  begin // calling DiscoverTile not necessary, only clear map flags


2643  ClearFlags := fUnit or fHiddenUnit or fStealthUnit or fOwnZoCUnit;


2644  if RealMap[Loc] and fCity = 0 then


2645  ClearFlags := ClearFlags or fOwned;


2646  RW[p].Map[Loc] := RW[p].Map[Loc] and not ClearFlags;


2647  end


2648  else if (Occupant[Loc] <> p) or CityChange then


2649  begin // city or enemy unit update necessary, call DiscoverTile


2650  ObserveLevel[Loc] := ObserveLevel[Loc] and not(3 shl (2 * p));


2651  DiscoverTile(Loc, p, p, OldLevel, false, euix);


2652  end


2653  else { if (Occupant[Loc]=p) and not CityChange then }


2654  begin // calling DiscoverTile not necessary, only set map flags


2655  ClearFlags := 0;


2656  AddFlags := fUnit or fOwned;


2657  if ZoCMap[Loc] > 0 then


2658  AddFlags := AddFlags or fOwnZoCUnit


2659  else


2660  ClearFlags := ClearFlags or fOwnZoCUnit;


2661  RW[p].Map[Loc] := RW[p].Map[Loc] and not ClearFlags or AddFlags;


2662  end;


2663  end;


2664  end;


2665  end;


2666 


2667  procedure RecalcV8ZoC(p, Loc: integer);


2668  // recalculate fInEnemyZoC flags around single tile


2669  var


2670  V8, V8V8, Loc1, Loc2, p1, ObserveMask: integer;


2671  Tile1: ^Cardinal;


2672  Adjacent, AdjacentAdjacent: TVicinity8Loc;


2673  begin


2674  if Mode = moLoading_Fast then


2675  exit;


2676  ObserveMask := 3 shl (2 * p);


2677  V8_to_Loc(Loc, Adjacent);


2678  for V8 := 0 to 7 do


2679  begin


2680  Loc1 := Adjacent[V8];


2681  if (Loc1 >= 0) and (Loc1 < MapSize) then


2682  begin


2683  Tile1 := @RW[p].Map[Loc1];


2684  Tile1^ := Tile1^ and not fInEnemyZoC;


2685  V8_to_Loc(Loc1, AdjacentAdjacent);


2686  for V8V8 := 0 to 7 do


2687  begin


2688  Loc2 := AdjacentAdjacent[V8V8];


2689  if (Loc2 >= 0) and (Loc2 < MapSize) and (ZoCMap[Loc2] > 0) and


2690  (ObserveLevel[Loc2] and ObserveMask <> 0) then


2691  begin


2692  p1 := Occupant[Loc2];


2693  assert(p1 <> nPl);


2694  if (p1 <> p) and (RW[p].Treaty[p1] < trAlliance) then


2695  begin


2696  Tile1^ := Tile1^ or fInEnemyZoC;


2697  Break


2698  end;


2699  end;


2700  end;


2701  end;


2702  end;


2703  end;


2704 


2705  procedure RecalcMapZoC(p: integer);


2706  // recalculate fInEnemyZoC flags for the whole map


2707  var


2708  Loc, Loc1, V8, p1, ObserveMask: integer;


2709  Adjacent: TVicinity8Loc;


2710  begin


2711  if Mode = moLoading_Fast then


2712  exit;


2713  MaskD(RW[p].Map^, MapSize, Cardinal(not Cardinal(fInEnemyZoC)));


2714  ObserveMask := 3 shl (2 * p);


2715  for Loc := 0 to MapSize  1 do


2716  if (ZoCMap[Loc] > 0) and (ObserveLevel[Loc] and ObserveMask <> 0) then


2717  begin


2718  p1 := Occupant[Loc];


2719  assert(p1 <> nPl);


2720  if (p1 <> p) and (RW[p].Treaty[p1] < trAlliance) then


2721  begin // this nonallied enemy ZoC unit is known to this player  set flags!


2722  V8_to_Loc(Loc, Adjacent);


2723  for V8 := 0 to 7 do


2724  begin


2725  Loc1 := Adjacent[V8];


2726  if (Loc1 >= 0) and (Loc1 < MapSize) then


2727  RW[p].Map[Loc1] := RW[p].Map[Loc1] or fInEnemyZoC


2728  end;


2729  end;


2730  end;


2731  end;


2732 


2733  procedure RecalcPeaceMap(p: integer);


2734  // recalculate fPeace flags for the whole map


2735  var


2736  Loc, p1: integer;


2737  PeacePlayer: array [1 .. nPl  1] of boolean;


2738  begin


2739  if Mode <> moPlaying then


2740  exit;


2741  MaskD(RW[p].Map^, MapSize, Cardinal(not Cardinal(fPeace)));


2742  for p1 := 1 to nPl  1 do


2743  PeacePlayer[p1] := (p1 >= 0) and (p1 <> p) and (1 shl p1 and GAlive <> 0)


2744  and (RW[p].Treaty[p1] in [trPeace, TrFriendlyContact]);


2745  for Loc := 0 to MapSize  1 do


2746  if PeacePlayer[RW[p].Territory[Loc]] then


2747  RW[p].Map[Loc] := RW[p].Map[Loc] or fPeace;


2748  end;


2749 


2750  {


2751  Territory Calculation


2752  ____________________________________________________________________


2753  }


2754  var


2755  BorderChanges: array [0 .. sIntExpandTerritory and $F  1] of Cardinal;


2756 


2757  procedure ChangeTerritory(Loc, p: integer);


2758  var


2759  p1: integer;


2760  begin


2761  Assert(p >= 0); // no player's territory indicated by p=nPl


2762  Dec(TerritoryCount[RealMap[Loc] shr 27]);


2763  Inc(TerritoryCount[p]);


2764  RealMap[Loc] := RealMap[Loc] and not($F shl 27) or Cardinal(p) shl 27;


2765  if p = $F then


2766  p := 1;


2767  for p1 := 0 to nPl  1 do


2768  if 1 shl p1 and (GAlive or GWatching) <> 0 then


2769  if RW[p1].Map[Loc] and fTerrain <> fUNKNOWN then


2770  begin


2771  RW[p1].Territory[Loc] := p;


2772  if (p < nPl) and (p <> p1) and (1 shl p and GAlive <> 0) and


2773  (RW[p1].Treaty[p] in [trPeace, TrFriendlyContact]) then


2774  RW[p1].Map[Loc] := RW[p1].Map[Loc] or fPeace


2775  else


2776  RW[p1].Map[Loc] := RW[p1].Map[Loc] and not fPeace;


2777  end;


2778  end;


2779 


2780  procedure ExpandTerritory(OriginLoc: integer);


2781  var


2782  i, dx, dy, dxMax, dyMax, Loc, NewOwner: integer;


2783  begin


2784  if OriginLoc = 1 then


2785  raise Exception.Create('Location error');


2786  i := 0;


2787  dyMax := 0;


2788  while (dyMax + 1) + (dyMax + 1) shr 1 <= CountryRadius do


2789  inc(dyMax);


2790  for dy := dyMax to dyMax do


2791  begin


2792  dxMax := dy and 1;


2793  while abs(dy) + (dxMax + 2) + abs(abs(dy)  (dxMax + 2)) shr 1 <=


2794  CountryRadius do


2795  inc(dxMax, 2);


2796  for dx := dxMax to dxMax do


2797  if (dy + dx) and 1 = 0 then


2798  begin


2799  NewOwner := BorderChanges[i div 8] shr (i mod 8 * 4) and $F;


2800  Loc := dLoc(OriginLoc, dx, dy);


2801  if (Loc >= 0) and (Cardinal(NewOwner) <> RealMap[Loc] shr 27) then


2802  ChangeTerritory(Loc, NewOwner);


2803  inc(i);


2804  end;


2805  end;


2806  end;


2807 


2808  procedure CheckBorders(OriginLoc, PlayerLosingCity: integer);


2809  // OriginLoc: only changes in CountryRadius around this location possible,


2810  // 1 for complete map, 2 for doublecheck (no more changes allowed)


2811  // PlayerLosingCity: do nothing but remove tiles no longer in reach from this


2812  // player's territory, 1 for full border recalculation


2813  var


2814  i, r, Loc, Loc1, dx, dy, p1, p2, cix, NewDist, dxMax, dyMax, OldOwner, V8: Integer;


2815  NewOwner: Cardinal;


2816  Adjacent: TVicinity8Loc;


2817  AtPeace: array [0 .. nPl, 0 .. nPl] of boolean;


2818  Country, FormerCountry, { to who's country a tile belongs }


2819  Dist, FormerDist, StolenDist: array [0 .. lxmax * lymax  1] of ShortInt;


2820  begin


2821  if PlayerLosingCity >= 0 then


2822  begin


2823  for Loc := 0 to MapSize  1 do


2824  StolenDist[Loc] := CountryRadius + 1;


2825  for cix := 0 to RW[PlayerLosingCity].nCity  1 do


2826  if RW[PlayerLosingCity].City[cix].Loc >= 0 then


2827  StolenDist[RW[PlayerLosingCity].City[cix].Loc] := 0;


2828 


2829  for r := 1 to CountryRadius shr 1 do


2830  begin


2831  move(StolenDist, FormerDist, MapSize);


2832  for Loc := 0 to MapSize  1 do


2833  if (FormerDist[Loc] <= CountryRadius  2)


2834  // use same conditions as below!


2835  and ((1 shl (RealMap[Loc] and fTerrain)) and


2836  (1 shl fShore + 1 shl fMountains + 1 shl fArctic) = 0) then


2837  begin


2838  V8_to_Loc(Loc, Adjacent);


2839  for V8 := 0 to 7 do


2840  begin


2841  Loc1 := Adjacent[V8];


2842  NewDist := FormerDist[Loc] + 2 + V8 and 1;


2843  if (Loc1 >= 0) and (Loc1 < MapSize) and (NewDist < StolenDist[Loc1])


2844  then


2845  StolenDist[Loc1] := NewDist;


2846  end;


2847  end;


2848  end;


2849  end;


2850 


2851  FillChar(Country, MapSize, Byte(1));


2852  for Loc := 0 to MapSize  1 do


2853  Dist[Loc] := CountryRadius + 1;


2854  for p1 := 0 to nPl  1 do


2855  if 1 shl p1 and GAlive <> 0 then


2856  for cix := 0 to RW[p1].nCity  1 do


2857  if RW[p1].City[cix].Loc >= 0 then


2858  begin


2859  Country[RW[p1].City[cix].Loc] := p1;


2860  Dist[RW[p1].City[cix].Loc] := 0;


2861  end;


2862 


2863  for r := 1 to CountryRadius shr 1 do


2864  begin


2865  move(Country, FormerCountry, MapSize);


2866  move(Dist, FormerDist, MapSize);


2867  for Loc := 0 to MapSize  1 do


2868  if (FormerDist[Loc] <= CountryRadius  2) // use same conditions as above!


2869  and ((1 shl (RealMap[Loc] and fTerrain)) and


2870  (1 shl fShore + 1 shl fMountains + 1 shl fArctic) = 0) then


2871  begin


2872  assert(FormerCountry[Loc] >= 0);


2873  V8_to_Loc(Loc, Adjacent);


2874  for V8 := 0 to 7 do


2875  begin


2876  Loc1 := Adjacent[V8];


2877  NewDist := FormerDist[Loc] + 2 + V8 and 1;


2878  if (Loc1 >= 0) and (Loc1 < MapSize) and (NewDist < Dist[Loc1]) then


2879  begin


2880  Country[Loc1] := FormerCountry[Loc];


2881  Dist[Loc1] := NewDist;


2882  end;


2883  end;


2884  end;


2885  end;


2886 


2887  FillChar(AtPeace, SizeOf(AtPeace), false);


2888  for p1 := 0 to nPl  1 do


2889  if 1 shl p1 and GAlive <> 0 then


2890  for p2 := 0 to nPl  1 do


2891  if (p2 <> p1) and (1 shl p2 and GAlive <> 0) and


2892  (RW[p1].Treaty[p2] >= trPeace) then


2893  AtPeace[p1, p2] := true;


2894 


2895  if OriginLoc >= 0 then


2896  begin // update area only


2897  i := 0;


2898  FillChar(BorderChanges, SizeOf(BorderChanges), 0);


2899  dyMax := 0;


2900  while (dyMax + 1) + (dyMax + 1) shr 1 <= CountryRadius do


2901  inc(dyMax);


2902  for dy := dyMax to dyMax do


2903  begin


2904  dxMax := dy and 1;


2905  while abs(dy) + (dxMax + 2) + abs(abs(dy)  (dxMax + 2)) shr 1 <=


2906  CountryRadius do


2907  inc(dxMax, 2);


2908  for dx := dxMax to dxMax do


2909  if (dy + dx) and 1 = 0 then


2910  begin


2911  Loc := dLoc(OriginLoc, dx, dy);


2912  if Loc >= 0 then


2913  begin


2914  OldOwner := RealMap[Loc] shr 27;


2915  NewOwner := Country[Loc] and $F;


2916  if NewOwner <> OldOwner then


2917  if AtPeace[NewOwner, OldOwner] and


2918  not((OldOwner = PlayerLosingCity) and


2919  (StolenDist[Loc] > CountryRadius)) then


2920  NewOwner := OldOwner // peace fixes borders


2921  else


2922  ChangeTerritory(Loc, NewOwner);


2923  BorderChanges[i shr 3] := BorderChanges[i shr 3] or


2924  ((NewOwner shl ((i and 7) * 4)) and $ffffffff);


2925  end;


2926  inc(i);


2927  end;


2928  end;


2929  end


2930  else


2931  for Loc := 0 to MapSize  1 do // update complete map


2932  begin


2933  OldOwner := RealMap[Loc] shr 27;


2934  NewOwner := Country[Loc] and $F;


2935  if (NewOwner <> OldOwner) and (not AtPeace[NewOwner, OldOwner] or


2936  ((OldOwner = PlayerLosingCity) and (StolenDist[Loc] > CountryRadius)))


2937  then


2938  begin


2939  assert(OriginLoc <> 2); // test if border saving works


2940  ChangeTerritory(Loc, NewOwner);


2941  end;


2942  end;


2943 


2944  {$IFOPT O} if OriginLoc <> 2 then


2945  CheckBorders(2); {$ENDIF} // check: single pass should do!


2946  end; // CheckBorders


2947 


2948  procedure LogCheckBorders(p, cix, PlayerLosingCity: integer);


2949  begin


2950  CheckBorders(RW[p].City[cix].Loc, PlayerLosingCity);


2951  IntServer(sIntExpandTerritory, p, cix, BorderChanges);


2952  end;


2953 


2954  {


2955  Map Processing


2956  ____________________________________________________________________


2957  }


2958 


2959  procedure CreateUnit(p, mix: integer);


2960  begin


2961  with RW[p] do


2962  begin


2963  Un[nUn].mix := mix;


2964  with Un[nUn] do


2965  begin


2966  ID := UnBuilt[p];


2967  inc(UnBuilt[p]);


2968  Status := 0;


2969  SavedStatus := 0;


2970  inc(Model[mix].Built);


2971  Home := 1;


2972  Health := 100;


2973  Flags := 0;


2974  Movement := 0;


2975  if Model[mix].Domain = dAir then


2976  begin


2977  Fuel := Model[mix].Cap[mcFuel];


2978  Flags := Flags or unBombsLoaded


2979  end;


2980  Job := jNone;


2981  exp := ExpCost shr 1;


2982  TroopLoad := 0;


2983  AirLoad := 0;


2984  Master := 1;


2985  end;


2986  inc(nUn);


2987  end


2988  end;


2989 


2990  procedure FreeUnit(p, uix: integer);


2991  // loc or master should be set after call


2992  // implementation is critical for loading performance, change carefully


2993  var


2994  Loc0, uix1: integer;


2995  Occ, ZoC: boolean;


2996  begin


2997  with RW[p].Un[uix] do


2998  begin


2999  Job := jNone;


3000  Flags := Flags and not(unFortified or unMountainDelay);


3001  Loc0 := Loc


3002  end;


3003  if Occupant[Loc0] >= 0 then


3004  begin


3005  assert(Occupant[Loc0] = p);


3006  Occ := false;


3007  ZoC := false;


3008  for uix1 := 0 to RW[p].nUn  1 do


3009  with RW[p].Un[uix1] do


3010  if (Loc = Loc0) and (Master < 0) and (uix1 <> uix) then


3011  begin


3012  Occ := true;


3013  if RW[p].Model[mix].Flags and mdZOC <> 0 then


3014  begin


3015  ZoC := true;


3016  Break


3017  end


3018  end;


3019  if not Occ then


3020  Occupant[Loc0] := 1;


3021  if not ZoC then


3022  ZoCMap[Loc0] := 0;


3023  end;


3024  end;


3025 


3026  procedure PlaceUnit(p, uix: integer);


3027  begin


3028  with RW[p].Un[uix] do


3029  begin


3030  Occupant[Loc] := p;


3031  if RW[p].Model[mix].Flags and mdZOC <> 0 then


3032  ZoCMap[Loc] := 1;


3033  end;


3034  end;


3035 


3036  procedure CountLost(p, mix, Enemy: integer);


3037  begin


3038  Inc(RW[p].Model[mix].Lost);


3039  TellAboutModel(Enemy, p, mix);


3040  Inc(Destroyed[Enemy, p, mix]);


3041  end;


3042 


3043  procedure RemoveUnit(p, uix: integer; Enemy: integer = 1);


3044  // use enemy only from inside sMoveUnit if attack


3045  var


3046  uix1: integer;


3047  begin


3048  with RW[p].Un[uix] do


3049  begin


3050  assert((Loc >= 0) or (RW[p].Model[mix].Kind = mkDiplomat));


3051  // already freed when spy mission


3052  if Loc >= 0 then


3053  FreeUnit(p, uix);


3054  if Master >= 0 then


3055  if RW[p].Model[mix].Domain = dAir then


3056  dec(RW[p].Un[Master].AirLoad)


3057  else


3058  dec(RW[p].Un[Master].TroopLoad);


3059  if (TroopLoad > 0) or (AirLoad > 0) then


3060  for uix1 := 0 to RW[p].nUn  1 do


3061  if (RW[p].Un[uix1].Loc >= 0) and (RW[p].Un[uix1].Master = uix) then


3062  { unit mastered by removed unit  remove too }


3063  begin


3064  RW[p].Un[uix1].Loc := 1;


3065  if Enemy >= 0 then


3066  CountLost(p, RW[p].Un[uix1].mix, Enemy);


3067  end;


3068  Loc := 1;


3069  if Enemy >= 0 then


3070  CountLost(p, mix, Enemy);


3071  end;


3072  end;


3073 


3074  procedure RemoveUnit_UpdateMap(p, uix: integer);


3075  var


3076  Loc0: Integer;


3077  begin


3078  Loc0 := RW[p].Un[uix].Loc;


3079  RemoveUnit(p, uix);


3080  if Mode > moLoading_Fast then


3081  UpdateUnitMap(Loc0);


3082  end;


3083 


3084  procedure RemoveAllUnits(p, Loc: integer; Enemy: integer = 1);


3085  var


3086  uix: integer;


3087  begin


3088  for uix := 0 to RW[p].nUn  1 do


3089  if RW[p].Un[uix].Loc = Loc then


3090  begin


3091  if Enemy >= 0 then


3092  CountLost(p, RW[p].Un[uix].mix, Enemy);


3093  RW[p].Un[uix].Loc := 1


3094  end;


3095  Occupant[Loc] := 1;


3096  ZoCMap[Loc] := 0;


3097  end;


3098 


3099  procedure RemoveDomainUnits(d, p, Loc: integer);


3100  var


3101  uix: integer;


3102  begin


3103  for uix := 0 to RW[p].nUn  1 do


3104  if (RW[p].Model[RW[p].Un[uix].mix].Domain = d) and (RW[p].Un[uix].Loc = Loc)


3105  then


3106  RemoveUnit(p, uix);


3107  end;


3108 


3109  procedure FoundCity(p, FoundLoc: integer);


3110  var


3111  p1, cix1, V21, dx, dy: integer;


3112  begin


3113  if RW[p].nCity = ncmax then


3114  exit;


3115  inc(RW[p].nCity);


3116  with RW[p].City[RW[p].nCity  1] do


3117  begin


3118  Size := 2;


3119  Status := 0;


3120  SavedStatus := 0;


3121  FillChar(Built, SizeOf(Built), 0);


3122  Food := 0;


3123  Project := cpImp + imTrGoods;


3124  Prod := 0;


3125  Project0 := Project;


3126  Prod0 := 0;


3127  Pollution := 0;


3128  N1 := 0;


3129  Loc := FoundLoc;


3130  if UsedByCity[FoundLoc] >= 0 then


3131  begin { central tile is exploited  toggle in exploiting city }


3132  p1 := p;


3133  SearchCity(UsedByCity[FoundLoc], p1, cix1);


3134  dxdy(UsedByCity[FoundLoc], FoundLoc, dx, dy);


3135  V21 := (dy + 3) shl 2 + (dx + 3) shr 1;


3136  RW[p1].City[cix1].Tiles := RW[p1].City[cix1].Tiles and not(1 shl V21);


3137  end;


3138  Tiles := 1 shl 13; { exploit central tile }


3139  UsedByCity[FoundLoc] := FoundLoc;


3140  RealMap[FoundLoc] := RealMap[FoundLoc] and


3141  (fTerrain or fSpecial or fRiver or nPl shl 27) or fCity;


3142 


3143  ChangeTerritory(Loc, p)


3144  end;


3145  end;


3146 


3147  procedure StealCity(p, cix: integer; SaveUnits: boolean);


3148  var


3149  i, j, uix1, cix1, nearest: integer;


3150  begin


3151  for i := 0 to nWonder  1 do


3152  if RW[p].City[cix].Built[i] = 1 then


3153  begin


3154  GWonder[i].EffectiveOwner := 1;


3155  if i = woPyramids then


3156  FreeSlaves;


3157  if i = woEiffel then // deactivate expired wonders


3158  for j := 0 to nWonder  1 do


3159  if GWonder[j].EffectiveOwner = p then


3160  CheckExpiration(j);


3161  end;


3162  for i := nWonder to nImp  1 do


3163  if (Imp[i].Kind <> ikCommon) and (RW[p].City[cix].Built[i] > 0) then


3164  begin { destroy national projects }


3165  RW[p].NatBuilt[i] := 0;


3166  if i = imGrWall then


3167  GrWallContinent[p] := 1;


3168  end;


3169 


3170  for uix1 := 0 to RW[p].nUn  1 do


3171  with RW[p].Un[uix1] do


3172  if (Loc >= 0) and (Home = cix) then


3173  if SaveUnits then


3174  begin // support units by nearest other city


3175  nearest := 1;


3176  for cix1 := 0 to RW[p].nCity  1 do


3177  if (cix1 <> cix) and (RW[p].City[cix1].Loc >= 0) and


3178  ((nearest < 0) or (Distance(RW[p].City[cix1].Loc, Loc) <


3179  Distance(RW[p].City[nearest].Loc, Loc))) then


3180  nearest := cix1;


3181  Home := nearest


3182  end


3183  else


3184  RemoveUnit(p, uix1); // destroy supported units


3185  end;


3186 


3187  procedure DestroyCity(p, cix: integer; SaveUnits: boolean);


3188  var


3189  i, V21: integer;


3190  Radius: TVicinity21Loc;


3191  begin


3192  StealCity(p, cix, SaveUnits);


3193  with RW[p].City[cix] do begin


3194  for i := 0 to nWonder  1 do


3195  if Built[i] > 0 then


3196  GWonder[i].CityID := WonderDestroyed;


3197  V21_to_Loc(Loc, Radius);


3198  for V21 := 1 to 26 do


3199  if 1 shl V21 and Tiles <> 0 then


3200  UsedByCity[Radius[V21]] := 1;


3201  RealMap[Loc] := RealMap[Loc] and not fCity;


3202  Loc := 1


3203  end;


3204  end;


3205 


3206  procedure ChangeCityOwner(pOld, cixOld, pNew: integer);


3207  var


3208  i, j, cix1, Loc1, V21: integer;


3209  Radius: TVicinity21Loc;


3210  begin


3211  inc(RW[pNew].nCity);


3212  RW[pNew].City[RW[pNew].nCity  1] := RW[pOld].City[cixOld];


3213  StealCity(pOld, cixOld, false);


3214  RW[pOld].City[cixOld].Loc := 1;


3215  with RW[pNew].City[(RW[pNew].nCity  1)] do


3216  begin


3217  Food := 0;


3218  Project := cpImp + imTrGoods;


3219  Prod := 0;


3220  Project0 := Project;


3221  Prod0 := 0;


3222  Status := 0;


3223  SavedStatus := 0;


3224  N1 := 0;


3225 


3226  // check for siege


3227  V21_to_Loc(Loc, Radius);


3228  for V21 := 1 to 26 do


3229  if Tiles and (1 shl V21) and not(1 shl CityOwnTile) <> 0 then


3230  begin


3231  Loc1 := Radius[V21];


3232  assert((Loc1 >= 0) and (Loc1 < MapSize) and (UsedByCity[Loc1] = Loc));


3233  if (ZoCMap[Loc1] > 0) and (Occupant[Loc1] <> pNew) and


3234  (RW[pNew].Treaty[Occupant[Loc1]] < trAlliance) then


3235  begin // tile can't remain exploited


3236  Tiles := Tiles and not(1 shl V21);


3237  UsedByCity[Loc1] := 1;


3238  end;


3239  // don't check for siege by peace territory here, because territory


3240  // might not be up to date  done in turn beginning anyway


3241  end;


3242  Built[imTownHall] := 0;


3243  Built[imCourt] := 0;


3244  for i := nWonder to nImp  1 do


3245  if Imp[i].Kind <> ikCommon then


3246  Built[i] := 0; { destroy national projects }


3247  for i := 0 to nWonder  1 do


3248  if Built[i] = 1 then


3249  begin // new wonder owner!


3250  GWonder[i].EffectiveOwner := pNew;


3251  if i = woEiffel then // reactivate expired wonders


3252  begin


3253  for j := 0 to nWonder  1 do


3254  if Imp[j].Expiration >= 0 then


3255  for cix1 := 0 to (RW[pNew].nCity  1) do


3256  if RW[pNew].City[cix1].Built[j] = 1 then


3257  GWonder[j].EffectiveOwner := pNew;


3258  end


3259  else


3260  CheckExpiration(i);


3261  case i of


3262  woLighthouse:


3263  CheckSpecialModels(pNew, preLighthouse);


3264  woLeo:


3265  CheckSpecialModels(pNew, preLeo);


3266  woPyramids:


3267  CheckSpecialModels(pNew, preBuilder);


3268  end;


3269  end;


3270 


3271  // remove city from enemy cities


3272  // not done by Discover, because fCity still set!


3273  cix1 := RW[pNew].nEnemyCity  1;


3274  while (cix1 >= 0) and (RW[pNew].EnemyCity[cix1].Loc <> Loc) do


3275  dec(cix1);


3276  assert(cix1 >= 0);


3277  RW[pNew].EnemyCity[cix1].Loc := 1;


3278 


3279  ChangeTerritory(Loc, pNew);


3280  end;


3281  end;


3282 


3283  procedure CompleteJob(p, Loc, Job: integer);


3284  var


3285  ChangedTerrain, p1: integer;


3286  begin


3287  assert(Job <> jCity);


3288  ChangedTerrain := 1;


3289  case Job of


3290  jRoad:


3291  RealMap[Loc] := RealMap[Loc] or fRoad;


3292  jRR:


3293  RealMap[Loc] := RealMap[Loc] and not fRoad or fRR;


3294  jClear:


3295  begin


3296  ChangedTerrain := Terrain[RealMap[Loc] and fTerrain].ClearTerrain;


3297  RealMap[Loc] := RealMap[Loc] and not fTerrain or


3298  Cardinal(ChangedTerrain);


3299  RealMap[Loc] := RealMap[Loc] and not(3 shl 5) or


3300  ActualSpecialTile(Loc) shl 5;


3301  end;


3302  jIrr:


3303  RealMap[Loc] := RealMap[Loc] and not fTerImp or tiIrrigation;


3304  jFarm:


3305  RealMap[Loc] := RealMap[Loc] and not fTerImp or tiFarm;


3306  jAfforest:


3307  begin


3308  ChangedTerrain := Terrain[RealMap[Loc] and fTerrain].AfforestTerrain;


3309  RealMap[Loc] := RealMap[Loc] and not fTerrain or


3310  Cardinal(ChangedTerrain);


3311  RealMap[Loc] := RealMap[Loc] and not(3 shl 5) or


3312  ActualSpecialTile(Loc) shl 5;


3313  end;


3314  jMine:


3315  RealMap[Loc] := RealMap[Loc] and not fTerImp or tiMine;


3316  jFort:


3317  RealMap[Loc] := RealMap[Loc] and not fTerImp or tiFort;


3318  jCanal:


3319  RealMap[Loc] := RealMap[Loc] or fCanal;


3320  jTrans:


3321  begin


3322  ChangedTerrain := Terrain[RealMap[Loc] and fTerrain].TransTerrain;


3323  RealMap[Loc] := RealMap[Loc] and not fTerrain or


3324  Cardinal(ChangedTerrain);


3325  RealMap[Loc] := RealMap[Loc] and not(3 shl 5) or


3326  ActualSpecialTile(Loc) shl 5;


3327  if not(RealMap[Loc] and fTerrain in TerrType_Canalable) then


3328  begin


3329  RemoveDomainUnits(dSea, p, Loc);


3330  RealMap[Loc] := RealMap[Loc] and not fCanal;


3331  end;


3332  end;


3333  jPoll:


3334  RealMap[Loc] := RealMap[Loc] and not fPoll;


3335  jBase:


3336  RealMap[Loc] := RealMap[Loc] and not fTerImp or tiBase;


3337  jPillage:


3338  if RealMap[Loc] and fTerImp <> 0 then


3339  begin


3340  if RealMap[Loc] and fTerImp = tiBase then


3341  RemoveDomainUnits(dAir, p, Loc);


3342  RealMap[Loc] := RealMap[Loc] and not fTerImp


3343  end


3344  else if RealMap[Loc] and fCanal <> 0 then


3345  begin


3346  RemoveDomainUnits(dSea, p, Loc);


3347  RealMap[Loc] := RealMap[Loc] and not fCanal


3348  end


3349  else if RealMap[Loc] and fRR <> 0 then


3350  RealMap[Loc] := RealMap[Loc] and not fRR or fRoad


3351  else if RealMap[Loc] and fRoad <> 0 then


3352  RealMap[Loc] := RealMap[Loc] and not fRoad;


3353  end;


3354  if ChangedTerrain >= 0 then


3355  begin // remove terrain improvements if not possible on new terrain


3356  if ((RealMap[Loc] and fTerImp = tiIrrigation) or


3357  (RealMap[Loc] and fTerImp = tiFarm)) and


3358  ((Terrain[ChangedTerrain].IrrClearWork = 0) or


3359  (Terrain[ChangedTerrain].ClearTerrain >= 0)) then


3360  RealMap[Loc] := RealMap[Loc] and not fTerImp;


3361  if (RealMap[Loc] and fTerImp = tiMine) and


3362  ((Terrain[ChangedTerrain].MineAfforestWork = 0) or


3363  (Terrain[ChangedTerrain].AfforestTerrain >= 0)) then


3364  RealMap[Loc] := RealMap[Loc] and not fTerImp;


3365  end;


3366 


3367  // update map of all observing players


3368  if Mode > moLoading_Fast then


3369  for p1 := 0 to nPl  1 do


3370  if (1 shl p1 and (GAlive or GWatching) <> 0) and


3371  (ObserveLevel[Loc] shr (2 * p1) and 3 > lNoObserve) then


3372  RW[p1].Map[Loc] := RW[p1].Map[Loc] and


3373  not(fTerrain or fSpecial or fTerImp or fRoad or fRR or fCanal or


3374  fPoll) or RealMap[Loc] and (fTerrain or fSpecial or fTerImp or


3375  fRoad or fRR or fCanal or fPoll);


3376  end; // CompleteJob


3377 


3378  {


3379  Diplomacy


3380  ____________________________________________________________________


3381  }


3382  procedure GiveCivilReport(p, pAbout: integer);


3383  begin


3384  with RW[p].EnemyReport[pAbout]^ do


3385  begin


3386  // general info


3387  TurnOfCivilReport := LastValidStat[pAbout];


3388  move(RW[pAbout].Treaty, Treaty, SizeOf(Treaty));


3389  Government := RW[pAbout].Government;


3390  Money := RW[pAbout].Money;


3391 


3392  // tech info


3393  ResearchTech := RW[pAbout].ResearchTech;


3394  ResearchDone := RW[pAbout].Research * 100 div TechCost(pAbout);


3395  if ResearchDone > 100 then


3396  ResearchDone := 100;


3397  move(RW[pAbout].Tech, Tech, nAdv);


3398  end;


3399  end;


3400 


3401  procedure GiveMilReport(p, pAbout: integer);


3402  var


3403  uix, mix: integer;


3404  begin


3405  with RW[p].EnemyReport[pAbout]^ do


3406  begin


3407  TurnOfMilReport := LastValidStat[pAbout];


3408  nModelCounted := RW[pAbout].nModel;


3409  for mix := 0 to RW[pAbout].nModel  1 do


3410  begin


3411  TellAboutModel(p, pAbout, mix);


3412  UnCount[mix] := 0


3413  end;


3414  for uix := 0 to RW[pAbout].nUn  1 do


3415  if RW[pAbout].Un[uix].Loc >= 0 then


3416  inc(UnCount[RW[pAbout].Un[uix].mix]);


3417  end;


3418  end;


3419 


3420  procedure ShowPrice(pSender, pTarget, Price: integer);


3421  begin


3422  case Price and opMask of


3423  opTech: // + advance


3424  with RW[pTarget].EnemyReport[pSender]^ do


3425  if Tech[Price  opTech] < tsApplicable then


3426  Tech[Price  opTech] := tsApplicable;


3427  opModel: // + model index


3428  TellAboutModel(pTarget, pSender, Price  opModel);


3429  { opCity: // + city ID


3430  begin


3431  end; }


3432  end;


3433  end;


3434 


3435  function CopyCivilReport(pSender, pTarget, pAbout: integer): boolean;


3436  var


3437  i: integer;


3438  rSender, rTarget: ^TEnemyReport;


3439  begin // copy third nation civil report


3440  result := false;


3441  if RW[pTarget].Treaty[pAbout] = trNoContact then


3442  IntroduceEnemy(pTarget, pAbout);


3443  rSender := pointer(RW[pSender].EnemyReport[pAbout]);


3444  rTarget := pointer(RW[pTarget].EnemyReport[pAbout]);


3445  if rSender.TurnOfCivilReport > rTarget.TurnOfCivilReport then


3446  begin // only if newer than current information


3447  rTarget.TurnOfCivilReport := rSender.TurnOfCivilReport;


3448  rTarget.Treaty := rSender.Treaty;


3449  rTarget.Government := rSender.Government;


3450  rTarget.Money := rSender.Money;


3451  rTarget.ResearchTech := rSender.ResearchTech;


3452  rTarget.ResearchDone := rSender.ResearchDone;


3453  result := true;


3454  end;


3455  for i := 0 to nAdv  1 do


3456  if rTarget.Tech[i] < rSender.Tech[i] then


3457  begin


3458  rTarget.Tech[i] := rSender.Tech[i];


3459  result := true;


3460  end;


3461  end;


3462 


3463  function CopyMilReport(pSender, pTarget, pAbout: integer): boolean;


3464  var


3465  mix: integer;


3466  rSender, rTarget: ^TEnemyReport;


3467  begin // copy third nation military report


3468  result := false;


3469  if RW[pTarget].Treaty[pAbout] = trNoContact then


3470  IntroduceEnemy(pTarget, pAbout);


3471  rSender := pointer(RW[pSender].EnemyReport[pAbout]);


3472  rTarget := pointer(RW[pTarget].EnemyReport[pAbout]);


3473  if rSender.TurnOfMilReport > rTarget.TurnOfMilReport then


3474  begin // only if newer than current information


3475  rTarget.TurnOfMilReport := rSender.TurnOfMilReport;


3476  rTarget.nModelCounted := rSender.nModelCounted;


3477  move(rSender.UnCount, rTarget.UnCount, 2 * rSender.nModelCounted);


3478  for mix := 0 to rTarget.nModelCounted  1 do


3479  TellAboutModel(pTarget, pAbout, mix);


3480  result := true;


3481  end;


3482  end;


3483 


3484  procedure CopyModel(pSender, pTarget, mix: integer);


3485  var


3486  i: integer;


3487  miSender, miTarget: TModelInfo;


3488  ok: boolean;


3489  begin


3490  // only if target doesn't already have a model like this


3491  ok := RW[pTarget].nModel < nmmax;


3492  MakeModelInfo(pSender, mix, RW[pSender].Model[mix], miSender);


3493  for i := 0 to RW[pTarget].nModel  1 do


3494  begin


3495  MakeModelInfo(pTarget, i, RW[pTarget].Model[i], miTarget);


3496  if IsSameModel(miSender, miTarget) then


3497  ok := false;


3498  end;


3499  if ok then


3500  begin


3501  RW[pTarget].Model[RW[pTarget].nModel] := RW[pSender].Model[mix];


3502  with RW[pTarget].Model[RW[pTarget].nModel] do


3503  begin


3504  IntroTurn := GTurn;


3505  if Kind = mkSelfDeveloped then


3506  Kind := mkEnemyDeveloped;


3507  Status := 0;


3508  SavedStatus := 0;


3509  Built := 0;


3510  Lost := 0;


3511  end;


3512  inc(RW[pTarget].nModel);


3513  inc(Researched[pTarget]);


3514  TellAboutModel(pSender, pTarget, RW[pTarget].nModel  1);


3515  end;


3516  end;


3517 


3518  procedure CopyMap(pSender, pTarget: integer);


3519  var


3520  Loc, i, cix: integer;


3521  Tile: Cardinal;


3522  begin


3523  for Loc := 0 to MapSize  1 do


3524  if (RW[pSender].MapObservedLast[Loc] > RW[pTarget].MapObservedLast[Loc])


3525  then


3526  begin


3527  Tile := RW[pSender].Map[Loc];


3528  if Tile and fCity <> 0 then


3529  begin


3530  i := 0;


3531  while (i < RW[pTarget].nEnemyCity) and


3532  (RW[pTarget].EnemyCity[i].Loc <> Loc) do


3533  inc(i);


3534  if i = RW[pTarget].nEnemyCity then


3535  begin


3536  inc(RW[pTarget].nEnemyCity);


3537  assert(RW[pTarget].nEnemyCity < necmax);


3538  RW[pTarget].EnemyCity[i].Status := 0;


3539  RW[pTarget].EnemyCity[i].SavedStatus := 0;


3540  end;


3541  if Tile and fOwned <> 0 then


3542  begin // city owned by sender  create new info


3543  cix := RW[pSender].nCity  1;


3544  while (cix >= 0) and (RW[pSender].City[cix].Loc <> Loc) do


3545  dec(cix);


3546  MakeCityInfo(pSender, cix, RW[pTarget].EnemyCity[i]);


3547  end


3548  else // city not owned by sender  copy old info


3549  begin


3550  cix := RW[pSender].nEnemyCity  1;


3551  while (cix >= 0) and (RW[pSender].EnemyCity[cix].Loc <> Loc) do


3552  dec(cix);


3553  RW[pTarget].EnemyCity[i] := RW[pSender].EnemyCity[cix];


3554  end;


3555  end


3556  else if RW[pTarget].Map[Loc] and fCity <> 0 then // remove enemycity


3557  for cix := 0 to RW[pTarget].nEnemyCity  1 do


3558  if RW[pTarget].EnemyCity[cix].Loc = Loc then


3559  RW[pTarget].EnemyCity[cix].Loc := 1;


3560 


3561  Tile := Tile and (not(fSpecial or fModern) or ResourceMask[pTarget]);


3562  Tile := Tile or (RW[pTarget].Map[Loc] and fModern);


3563  if (Tile and fTerrain = RW[pTarget].Map[Loc] and fTerrain) then


3564  Tile := Tile or (RW[pTarget].Map[Loc] and fSpecial);


3565 


3566  if RW[pTarget].Map[Loc] and fTerrain = fUNKNOWN then


3567  inc(Discovered[pTarget]);


3568  RW[pTarget].Map[Loc] := RW[pTarget].Map[Loc] and fInEnemyZoC


3569  // always preserve this flag!


3570  or Tile and not(fUnit or fHiddenUnit or fStealthUnit or fObserved or


3571  fSpiedOut or fOwned or fInEnemyZoC or fOwnZoCUnit or fPeace or fGrWall);


3572  if RW[pSender].Territory[Loc] <> RW[pTarget].Territory[Loc] then


3573  begin


3574  RW[pTarget].Territory[Loc] := RW[pSender].Territory[Loc];


3575  { if RW[pTarget].BorderHelper<>nil then


3576  RW[pTarget].BorderHelper[Loc]:=0; }


3577  end;


3578  RW[pTarget].Territory[Loc] := RW[pSender].Territory[Loc];


3579  RW[pTarget].MapObservedLast[Loc] := RW[pSender].MapObservedLast[Loc];


3580  end;


3581  end;


3582 


3583  function PayPrice(pSender, pTarget, Price: integer; execute: boolean): boolean;


3584  var


3585  pSubject, i, n, NewTreaty: integer;


3586  begin


3587  result := true;


3588  case Price and opMask of


3589  opCivilReport: // + turn + concerned player shl 16


3590  begin


3591  pSubject := Price shr 16 and $F;


3592  if pTarget = pSubject then


3593  result := false


3594  else if pSender = pSubject then


3595  begin


3596  if execute then


3597  GiveCivilReport(pTarget, pSender)


3598  end


3599  else if RW[pSender].EnemyReport[pSubject].TurnOfCivilReport < 0 then


3600  result := false


3601  else if execute then


3602  CopyCivilReport(pSender, pTarget, pSubject);


3603  end;


3604  opMilReport: // + turn + concerned player shl 16


3605  begin


3606  pSubject := Price shr 16 and $F;


3607  if pTarget = pSubject then


3608  result := false


3609  else if pSender = pSubject then


3610  begin


3611  if execute then


3612  GiveMilReport(pTarget, pSender)


3613  end


3614  else if RW[pSender].EnemyReport[pSubject].TurnOfMilReport < 0 then


3615  result := false


3616  else if execute then


3617  CopyMilReport(pSender, pTarget, pSubject)


3618  end;


3619  opMap:


3620  if execute then


3621  begin


3622  CopyMap(pSender, pTarget);


3623  RecalcPeaceMap(pTarget);


3624  end;


3625  opTreaty .. opTreaty + trAlliance: // + nation treaty


3626  begin


3627  if Price  opTreaty = RW[pSender].Treaty[pTarget]  1 then


3628  begin // agreed treaty end


3629  if execute then


3630  CancelTreaty(pSender, pTarget, false)


3631  end


3632  else


3633  begin


3634  NewTreaty := 1;


3635  if Price  opTreaty = RW[pSender].Treaty[pTarget] + 1 then


3636  NewTreaty := Price  opTreaty


3637  else if (RW[pSender].Treaty[pTarget] = trNone) and


3638  (Price  opTreaty = trPeace) then


3639  NewTreaty := trPeace;


3640  if NewTreaty < 0 then


3641  result := false


3642  else if execute then


3643  begin


3644  assert(NewTreaty > RW[pSender].Treaty[pTarget]);


3645  RW[pSender].Treaty[pTarget] := NewTreaty;


3646  RW[pTarget].Treaty[pSender] := NewTreaty;


3647  if NewTreaty >= TrFriendlyContact then


3648  begin


3649  GiveCivilReport(pTarget, pSender);


3650  GiveCivilReport(pSender, pTarget);


3651  end;


3652  if NewTreaty = trAlliance then


3653  begin


3654  GiveMilReport(pTarget, pSender);


3655  GiveMilReport(pSender, pTarget);


3656  CopyMap(pSender, pTarget);


3657  CopyMap(pTarget, pSender);


3658  RecalcMapZoC(pSender);


3659  RecalcMapZoC(pTarget);


3660  end;


3661  if not(NewTreaty in [trPeace, TrFriendlyContact]) then


3662  begin


3663  RW[pSender].EvaStart[pTarget] := PeaceEvaTurns  1;


3664  RW[pTarget].EvaStart[pSender] := PeaceEvaTurns  1;


3665  end;


3666  RecalcPeaceMap(pSender);


3667  RecalcPeaceMap(pTarget);


3668  end;


3669  end;


3670  end;


3671  opShipParts: // + number + part type shl 16


3672  begin


3673  n := Price and $FFFF; // number


3674  i := Price shr 16 and $F; // type


3675  if (i < nShipPart) and (GShip[pSender].Parts[i] >= n) then


3676  begin


3677  if execute then


3678  begin


3679  dec(GShip[pSender].Parts[i], n);


3680  RW[pSender].Ship[pSender].Parts[i] := GShip[pSender].Parts[i];


3681  RW[pTarget].Ship[pSender].Parts[i] := GShip[pSender].Parts[i];


3682  if RW[pTarget].NatBuilt[imSpacePort] > 0 then


3683  begin // space ship control requires space port


3684  inc(GShip[pTarget].Parts[i], n);


3685  RW[pSender].Ship[pTarget].Parts[i] := GShip[pTarget].Parts[i];


3686  RW[pTarget].Ship[pTarget].Parts[i] := GShip[pTarget].Parts[i];


3687  end;


3688  end;


3689  end


3690  else


3691  result := false;


3692  end;


3693  opMoney: // + value


3694  if (Price  opMoney <= MaxMoneyPrice) and


3695  (RW[pSender].Money >= Price  opMoney) then


3696  begin


3697  if execute then


3698  begin


3699  dec(RW[pSender].Money, Price  opMoney);


3700  inc(RW[pTarget].Money, Price  opMoney);


3701  end;


3702  end


3703  else


3704  result := false;


3705  opTribute: // + value


3706  if execute then


3707  begin


3708  end;


3709  opTech: // + advance


3710  if RW[pSender].Tech[Price  opTech] >= tsApplicable then


3711  begin


3712  if execute and (RW[pTarget].Tech[Price  opTech] = tsNA) then


3713  begin


3714  SeeTech(pTarget, Price  opTech);


3715  RW[pSender].EnemyReport[pTarget].Tech[Price  opTech] := tsSeen;


3716  end;


3717  end


3718  else


3719  result := false;


3720  opAllTech:


3721  if execute then


3722  for i := 0 to nAdv  1 do


3723  if (RW[pSender].Tech[i] >= tsApplicable) and


3724  (RW[pTarget].Tech[i] = tsNA) then


3725  begin


3726  SeeTech(pTarget, i);


3727  RW[pSender].EnemyReport[pTarget].Tech[i] := tsSeen;


3728  RW[pTarget].EnemyReport[pSender].Tech[i] := tsApplicable;


3729  end;


3730  opModel: // + model index


3731  if Price  opModel < RW[pSender].nModel then


3732  begin


3733  if execute then


3734  CopyModel(pSender, pTarget, Price  opModel)


3735  end


3736  else


3737  result := false;


3738  opAllModel:


3739  if execute then


3740  for i := 0 to RW[pSender].nModel  1 do


3741  begin


3742  TellAboutModel(pTarget, pSender, i);


3743  CopyModel(pSender, pTarget, i);


3744  end;


3745  { opCity: // + city ID


3746  begin


3747  result:=false


3748  end; }


3749  end


3750  end;


3751 


3752  procedure CancelTreaty(p, pWith: integer; DecreaseCredibility: boolean);


3753  // side effect: PeaceEnded := bitarray of players with which peace treaty was canceled


3754  var


3755  p1, OldTreaty: integer;


3756  begin


3757  OldTreaty := RW[p].Treaty[pWith];


3758  PeaceEnded := 0;


3759  if OldTreaty >= trPeace then


3760  RW[p].LastCancelTreaty[pWith] := GTurn;


3761  if DecreaseCredibility then


3762  begin


3763  case OldTreaty of


3764  trPeace:


3765  begin


3766  RW[p].Credibility := RW[p].Credibility shr 1;


3767  if RW[p].MaxCredibility > 0 then


3768  dec(RW[p].MaxCredibility, 10);


3769  if RW[p].Credibility > RW[p].MaxCredibility then


3770  RW[p].Credibility := RW[p].MaxCredibility;


3771  end;


3772  trAlliance:


3773  RW[p].Credibility := RW[p].Credibility * 3 div 4;


3774  end;


3775  RW[pWith].EnemyReport[p].Credibility := RW[p].Credibility;


3776  end;


3777 


3778  if OldTreaty = trPeace then


3779  begin


3780  for p1 := 0 to nPl  1 do


3781  if (p1 = pWith) or DecreaseCredibility and (p1 <> p) and


3782  (RW[pWith].Treaty[p1] = trAlliance) and (RW[p].Treaty[p1] >= trPeace)


3783  then


3784  begin


3785  RW[p].Treaty[p1] := trNone;


3786  RW[p1].Treaty[p] := trNone;


3787  RW[p].EvaStart[p1] := PeaceEvaTurns  1;


3788  RW[p1].EvaStart[p] := PeaceEvaTurns  1;


3789  inc(PeaceEnded, 1 shl p1);


3790  end;


3791  CheckBorders(1);


3792  if (Mode > moLoading_Fast) and (PeaceEnded > 0) then


3793  RecalcMapZoC(p);


3794  end


3795  else


3796  begin


3797  RW[p].Treaty[pWith] := OldTreaty  1;


3798  RW[pWith].Treaty[p] := OldTreaty  1;


3799  if OldTreaty = TrFriendlyContact then


3800  begin // necessary for loading


3801  GiveCivilReport(p, pWith);


3802  GiveCivilReport(pWith, p);


3803  end


3804  else if OldTreaty = trAlliance then


3805  begin // necessary for loading


3806  GiveMilReport(p, pWith);


3807  GiveMilReport(pWith, p);


3808  end;


3809  if (Mode > moLoading_Fast) and (OldTreaty = trAlliance) then


3810  begin


3811  RecalcMapZoC(p);


3812  RecalcMapZoC(pWith);


3813  end;


3814  end;


3815  if OldTreaty in [trPeace, trAlliance] then


3816  begin


3817  RecalcPeaceMap(p);


3818  RecalcPeaceMap(pWith);


3819  end;


3820  end;


3821 


3822  function DoSpyMission(p, pCity, cix, Mission: integer): Cardinal;


3823  var


3824  p1: integer;


3825  begin


3826  result := 0;


3827  case Mission of


3828  smSabotageProd:


3829  RW[pCity].City[cix].Flags := RW[pCity].City[cix].Flags or


3830  chProductionSabotaged;


3831  smStealMap:


3832  begin


3833  CopyMap(pCity, p);


3834  RecalcPeaceMap(p);


3835  end;


3836  smStealCivilReport:


3837  begin


3838  if RW[p].Treaty[pCity] = trNoContact then


3839  IntroduceEnemy(p, pCity);


3840  GiveCivilReport(p, pCity);


3841  end;


3842  smStealMilReport:


3843  begin


3844  if RW[p].Treaty[pCity] = trNoContact then


3845  IntroduceEnemy(p, pCity);


3846  GiveMilReport(p, pCity);


3847  end;


3848  smStealForeignReports:


3849  begin


3850  for p1 := 0 to nPl  1 do


3851  if (p1 <> p) and (p1 <> pCity) and (RW[pCity].EnemyReport[p1] <> nil)


3852  then


3853  begin


3854  if RW[pCity].EnemyReport[p1].TurnOfCivilReport >= 0 then


3855  if CopyCivilReport(pCity, p, p1) then


3856  result := result or (1 shl (2 * p1));


3857  if RW[pCity].EnemyReport[p1].TurnOfMilReport >= 0 then


3858  if CopyMilReport(pCity, p, p1) then


3859  result := result or (2 shl (2 * p1));


3860  end;


3861  end;


3862  end;


3863  end;


3864 


3865  {


3866  Test Flags


3867  ____________________________________________________________________


3868  }


3869  procedure ClearTestFlags(ClearFlags: integer);


3870  var


3871  p1: integer;


3872  begin


3873  GTestFlags := GTestFlags and (not ClearFlags or tfTested or tfAllTechs or


3874  tfAllContact);


3875  for p1 := 0 to nPl  1 do


3876  if 1 shl p1 and (GAlive or GWatching) <> 0 then


3877  RW[p1].TestFlags := GTestFlags;


3878  end;


3879 


3880  procedure SetTestFlags(p, SetFlags: integer);


3881  var


3882  i, p1, p2, MoreFlags: integer;


3883  begin


3884  MoreFlags := SetFlags and not GTestFlags;


3885  GTestFlags := GTestFlags or (SetFlags and $7FF);


3886  for p1 := 0 to nPl  1 do


3887  if 1 shl p1 and (GAlive or GWatching) <> 0 then


3888  RW[p1].TestFlags := GTestFlags;


3889 


3890  if MoreFlags and (tfUncover or tfAllContact) <> 0 then


3891  for p1 := 0 to nPl  2 do


3892  if 1 shl p1 and GAlive <> 0 then


3893  for p2 := p1 + 1 to nPl  1 do


3894  if 1 shl p2 and GAlive <> 0 then


3895  begin // make p1 and p2 know each other


3896  if RW[p1].Treaty[p2] = trNoContact then


3897  IntroduceEnemy(p1, p2)


3898  end;


3899 


3900  if MoreFlags and tfAllTechs <> 0 then


3901  for p1 := 0 to nPl  1 do


3902  begin


3903  ResourceMask[p1] := $FFFFFFFF;


3904  if 1 shl p1 and GAlive <> 0 then


3905  begin


3906  for i := 0 to nAdv  1 do // give all techs to player p1


3907  if not(i in FutureTech) and (RW[p1].Tech[i] < tsApplicable) then


3908  begin


3909  RW[p1].Tech[i] := tsCheat;


3910  CheckSpecialModels(p1, i);


3911  end;


3912  for p2 := 0 to nPl  1 do


3913  if (p2 <> p1) and (1 shl p2 and (GAlive or GWatching) <> 0) then


3914  for i := 1 to 3 do


3915  if RW[p2].EnemyReport[p1].Tech[AgePreq[i]] < tsApplicable then


3916  RW[p2].EnemyReport[p1].Tech[AgePreq[i]] := tsCheat;


3917  end;


3918  end;


3919 


3920  if MoreFlags and tfUncover <> 0 then


3921  begin


3922  DiscoverAll(p, lObserveSuper);


3923  for p1 := 0 to nPl  1 do


3924  if 1 shl p1 and GAlive <> 0 then


3925  begin


3926  ResourceMask[p1] := $FFFFFFFF;


3927  if p1 <> p then


3928  begin


3929  GiveCivilReport(p, p1);


3930  GiveMilReport(p, p1);


3931  end;


3932  end;


3933  end;


3934  end;


3935 


3936  {


3937  Internal Command Processing


3938  ____________________________________________________________________


3939  }


3940  procedure IntServer(Command, Player, Subject: integer; var Data);


3941  var


3942  i, p1: integer;


3943 


3944  begin


3945  if Mode = moPlaying then


3946  CL.Put(Command, Player, Subject, @Data);


3947 


3948  case Command of


3949 


3950  sIntTellAboutNation:


3951  begin


3952  {$IFDEF TEXTLOG}CmdInfo := Format('IntTellAboutNation P%d+P%d', [Player, Subject]); {$ENDIF}


3953  assert((Player >= 0) and (Player < nPl) and (Subject >= 0) and


3954  (Subject < nPl));


3955  IntroduceEnemy(Player, Subject);


3956  end;


3957 


3958  sIntHaveContact:


3959  begin


3960  {$IFDEF TEXTLOG}CmdInfo := Format('IntHaveContact P%d+P%d', [Player, Subject]); {$ENDIF}


3961  assert(RW[Player].Treaty[Subject] > trNoContact);


3962  RW[Player].EnemyReport[Subject].TurnOfContact := GTurn;


3963  RW[Subject].EnemyReport[Player].TurnOfContact := GTurn;


3964  end;


3965 


3966  sIntCancelTreaty:


3967  begin


3968  {$IFDEF TEXTLOG}CmdInfo := Format('IntCancelTreaty P%d with P%d', [Player, Subject]); {$ENDIF}


3969  CancelTreaty(Player, Subject);


3970  end;


3971 


3972  (* sIntChoosePeace:


3973  begin


3974  {$IFDEF TEXTLOG}CmdInfo:=Format('IntChoosePeace P%d+P%d', [Player,Subject]);{$ENDIF}


3975  RW[Player].Treaty[Subject]:=trPeace;


3976  RW[Subject].Treaty[Player]:=trPeace;


3977  end; *)


3978 


3979  sIntTellAboutModel .. sIntTellAboutModel + (nPl  1) shl 4:


3980  begin


3981  p1 := (Command  sIntTellAboutModel) shr 4; // told player


3982  {$IFDEF TEXTLOG}CmdInfo := Format('IntTellAboutModel P%d about P%d Mod%d', [p1, Player, Subject]); {$ENDIF}


3983  assert((Player >= 0) and (Player < nPl));


3984  assert((Subject >= 0) and (Subject < RW[Player].nModel));


3985  MakeModelInfo(Player, Subject, RW[Player].Model[Subject],


3986  RW[p1].EnemyModel[RW[p1].nEnemyModel]);


3987  RWemix[p1, Player, Subject] := RW[p1].nEnemyModel;


3988  inc(RW[p1].nEnemyModel);


3989  assert(RW[p1].nEnemyModel < nemmax);


3990  end;


3991 


3992  sIntDiscoverZOC:


3993  begin


3994  {$IFDEF TEXTLOG}CmdInfo := Format('IntDiscoverZOC P%d Loc%d', [Player, integer(Data)]); {$ENDIF}


3995  Discover9(integer(Data), Player, lObserveUnhidden, true, false);


3996  end;


3997 


3998  sIntExpandTerritory:


3999  if Mode < moPlaying then


4000  begin


4001  {$IFDEF TEXTLOG}CmdInfo := Format('IntExpandTerritory P%d Loc%d', [Player, RW[Player].City[Subject].Loc]); {$ENDIF}


4002  move(Data, BorderChanges, SizeOf(BorderChanges));


4003  ExpandTerritory(RW[Player].City[Subject].Loc);


4004  end;


4005 


4006  sIntBuyMaterial:


4007  with RW[Player].City[Subject] do


4008  begin


4009  {$IFDEF TEXTLOG}CmdInfo := Format('IntBuyMaterial P%d Loc%d Cost%d', [Player, Loc, integer(Data)]); {$ENDIF}


4010  dec(RW[Player].Money, integer(Data));


4011  if (GWonder[woMich].EffectiveOwner = Player) and (Project and cpImp <> 0)


4012  then


4013  inc(Prod, integer(Data) div 2)


4014  else


4015  inc(Prod, integer(Data) div 4);


4016  if Project0 and not cpAuto <> Project and not cpAuto then


4017  Project0 := Project;


4018  Prod0 := Prod;


4019  end;


4020 


4021  sIntPayPrices .. sIntPayPrices + 12:


4022  begin


4023  {$IFDEF TEXTLOG}CmdInfo := Format('IntPayPrices P%d+P%d', [Player, Subject]); {$ENDIF}


4024  for i := 0 to TOffer(Data).nDeliver  1 do


4025  PayPrice(Player, Subject, TOffer(Data).Price[i], true);


4026  for i := 0 to TOffer(Data).nCost  1 do


4027  PayPrice(Subject, Player, TOffer(Data).Price[TOffer(Data).nDeliver


4028  + i], true);


4029  for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost  1 do


4030  if TOffer(Data).Price[i] = opTreaty + trAlliance then


4031  begin // add view area of allied player


4032  DiscoverViewAreas(Player);


4033  DiscoverViewAreas(Subject);


4034  Break


4035  end


4036  end;


4037 


4038  sIntSetDevModel:


4039  if Mode < moPlaying then


4040  move(Data, RW[Player].DevModel.Kind, sIntSetDevModel and $F * 4);


4041 


4042  sIntSetModelStatus:


4043  if ProcessClientData[Player] then


4044  begin


4045  {$IFDEF TEXTLOG}CmdInfo := Format('IntSetModelStatus P%d', [Player]);


4046  {$ENDIF}


4047  RW[Player].Model[Subject].Status := integer(Data);


4048  end;


4049 


4050  sIntSetUnitStatus:


4051  if ProcessClientData[Player] then


4052  begin


4053  {$IFDEF TEXTLOG}CmdInfo := Format('IntSetUnitStatus P%d', [Player]);


4054  {$ENDIF}


4055  RW[Player].Un[Subject].Status := integer(Data);


4056  end;


4057 


4058  sIntSetCityStatus:


4059  if ProcessClientData[Player] then


4060  begin


4061  {$IFDEF TEXTLOG}CmdInfo := Format('IntSetCityStatus P%d', [Player]);


4062  {$ENDIF}


4063  RW[Player].City[Subject].Status := integer(Data);


4064  end;


4065 


4066  sIntSetECityStatus:


4067  if ProcessClientData[Player] then


4068  begin


4069  {$IFDEF TEXTLOG}CmdInfo := Format('IntSetECityStatus P%d', [Player]);


4070  {$ENDIF}


4071  RW[Player].EnemyCity[Subject].Status := integer(Data);


4072  end;


4073 


4074  end; { case command }


4075  end; { IntServer }


4076 


4077  end.

