Changeset 6 for trunk/Database.pas
- Timestamp:
- Jan 7, 2017, 11:32:14 AM (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Database.pas
r2 r6 1 1 {$INCLUDE switches} 2 // {$DEFINE TEXTLOG}3 // {$DEFINE LOADPERF}2 // {$DEFINE TEXTLOG} 3 // {$DEFINE LOADPERF} 4 4 unit Database; 5 5 … … 7 7 8 8 uses 9 Protocol,CmdList;9 Protocol, CmdList; 10 10 11 11 const 12 // additional test flags 13 FastContact=false; {extra small world with railroad everywhere} 14 15 neumax=4096; 16 necmax=1024; 17 nemmax=1024; 18 19 lNoObserve=0; lObserveUnhidden=1; lObserveAll=2; lObserveSuper=3; //observe levels 20 21 TerrType_Canalable=[fGrass,fDesert,fPrairie,fTundra,fSwamp,fForest,fHills]; 22 23 nStartUn=1; 24 StartUn: array[0..nStartUn-1] of integer=(0); //mix of start units 25 26 CityOwnTile=13; 27 28 var 29 GAlive, {players alive; bitset of 1 shl p} 30 GWatching, 31 GInitialized, 32 GAI, 33 RND, {world map randseed} 34 lx,ly, 35 MapSize, // = lx*ly 36 LandMass, 37 {$IFOPT O-}InvalidTreatyMap,{$ENDIF} 38 SaveMapCenterLoc, 39 PeaceEnded, 40 GTurn, {current turn} 41 GTestFlags: integer; 42 Mode: (moLoading_Fast, moLoading, moMovie, moPlaying); 43 GWonder: array[0..27] of TWonderInfo; 44 ServerVersion: array[0..nPl-1] of integer; 45 ProcessClientData: array[0..nPl-1] of boolean; 46 CL: TCmdList; 47 {$IFDEF TEXTLOG}CmdInfo: string; TextLog: TextFile;{$ENDIF} 48 {$IFDEF LOADPERF}time_total,time_total0,time_x0,time_x1,time_a,time_b,time_c: int64;{$ENDIF} 49 50 // map data 51 RealMap: array[0..lxmax*lymax-1] of Cardinal; 52 Continent:array[0..lxmax*lymax-1] of integer; {continent id for each tile} 53 Occupant:array[0..lxmax*lymax-1] of ShortInt; {occupying player for each tile} 54 ZoCMap:array[0..lxmax*lymax-1] of ShortInt; 55 ObserveLevel:array[0..lxmax*lymax-1] of Cardinal; 56 {Observe Level of player p in bits 2*p and 2*p+1} 57 UsedByCity:array[0..lxmax*lymax-1] of integer; {location of exploiting city for 58 each tile, =-1 if not exploited} 59 60 // player data 61 RW: array[0..nPl-1] of TPlayerContext;{player data} 62 Difficulty: array[0..nPl-1] of integer; 63 GShip: array[0..nPl-1] of TShipInfo; 64 ResourceMask: array[0..nPl-1] of Cardinal; 65 Founded: array[0..nPl-1] of integer; {number of cities founded} 66 TerritoryCount: array[0..nPl] of integer; 67 LastValidStat, 68 Researched, 69 Discovered, // number of tiles discovered 70 GrWallContinent: array[0..nPl-1] of integer; 71 RWemix: array[0..nPl-1, 0..nPl-1, 0..nmmax-1] of SmallInt; 12 // additional test flags 13 FastContact = false; { 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 var 33 GAlive, { players alive; bitset of 1 shl p } 34 GWatching, GInitialized, GAI, RND, { world map randseed } 35 lx, ly, MapSize, // = lx*ly 36 LandMass, 37 {$IFOPT O-}InvalidTreatyMap, {$ENDIF} 38 SaveMapCenterLoc, PeaceEnded, GTurn, { current turn } 39 GTestFlags: integer; 40 Mode: (moLoading_Fast, moLoading, moMovie, moPlaying); 41 GWonder: array [0 .. 27] of TWonderInfo; 42 ServerVersion: array [0 .. nPl - 1] of integer; 43 ProcessClientData: array [0 .. nPl - 1] of boolean; 44 CL: TCmdList; 45 {$IFDEF TEXTLOG}CmdInfo: string; 46 TextLog: TextFile; {$ENDIF} 47 {$IFDEF LOADPERF}time_total, time_total0, time_x0, time_x1, time_a, time_b, time_c: int64; {$ENDIF} 48 // map data 49 RealMap: array [0 .. lxmax * lymax - 1] of Cardinal; 50 Continent: array [0 .. lxmax * lymax - 1] of integer; 51 { continent id for each tile } 52 Occupant: array [0 .. lxmax * lymax - 1] of ShortInt; 53 { occupying player for each tile } 54 ZoCMap: array [0 .. lxmax * lymax - 1] of ShortInt; 55 ObserveLevel: array [0 .. lxmax * lymax - 1] of Cardinal; 56 { Observe Level of player p in bits 2*p and 2*p+1 } 57 UsedByCity: array [0 .. lxmax * lymax - 1] of integer; 58 { location of exploiting city for 59 each tile, =-1 if not exploited } 60 61 // player data 62 RW: array [0 .. nPl - 1] of TPlayerContext; { player data } 63 Difficulty: array [0 .. nPl - 1] of integer; 64 GShip: array [0 .. nPl - 1] of TShipInfo; 65 ResourceMask: array [0 .. nPl - 1] of Cardinal; 66 Founded: array [0 .. nPl - 1] of integer; { number of cities founded } 67 TerritoryCount: array [0 .. nPl] of integer; 68 LastValidStat, Researched, Discovered, // number of tiles discovered 69 GrWallContinent: array [0 .. nPl - 1] of integer; 70 RWemix: array [0 .. nPl - 1, 0 .. nPl - 1, 0 .. nmmax - 1] of SmallInt; 72 71 // [p1,p2,mix] -> index of p2's model mix in p1's enemy model list 73 Destroyed: array[0..nPl-1, 0..nPl-1, 0..nmmax-1] of SmallInt;72 Destroyed: array [0 .. nPl - 1, 0 .. nPl - 1, 0 .. nmmax - 1] of SmallInt; 74 73 // [p1,p2,mix] -> number of p2's units with model mix that p1 has destroyed 75 nTech: array[0..nPl-1] of integer; {number of known techs}76 //NewContact: array[0..nPl-1,0..nPl-1] of boolean;74 nTech: array [0 .. nPl - 1] of integer; { number of known techs } 75 // NewContact: array[0..nPl-1,0..nPl-1] of boolean; 77 76 78 77 type 79 TVicinity8Loc=array[0..7] of integer;80 TVicinity21Loc=array[0..27] of integer;78 TVicinity8Loc = array [0 .. 7] of integer; 79 TVicinity21Loc = array [0 .. 27] of integer; 81 80 82 81 procedure MaskD(var x; Count, Mask: Cardinal); 83 procedure IntServer(Command, Player,Subject:integer;var Data);82 procedure IntServer(Command, Player, Subject: integer; var Data); 84 83 procedure CompactLists(p: integer); 85 84 procedure ClearTestFlags(ClearFlags: integer); 86 procedure SetTestFlags(p, SetFlags: integer);85 procedure SetTestFlags(p, SetFlags: integer); 87 86 88 87 // Tech Related Functions 89 function TechBaseCost(nTech, diff: integer): integer;88 function TechBaseCost(nTech, diff: integer): integer; 90 89 function TechCost(p: integer): integer; 91 90 procedure CalculateModel(var m: TModel); 92 procedure CheckSpecialModels(p, pre: integer);91 procedure CheckSpecialModels(p, pre: integer); 93 92 procedure EnableDevModel(p: integer); 94 procedure SeeTech(p, ad: integer);95 procedure DiscoverTech(p, ad: integer);93 procedure SeeTech(p, ad: integer); 94 procedure DiscoverTech(p, ad: integer); 96 95 procedure CheckExpiration(Wonder: integer); 97 96 98 97 // Location Navigation 99 function dLoc(Loc, dx,dy: integer): integer;100 procedure dxdy(Loc0, Loc1: integer; var dx,dy: integer);101 function Distance(Loc0, Loc1: integer): integer;98 function dLoc(Loc, dx, dy: integer): integer; 99 procedure dxdy(Loc0, Loc1: integer; var dx, dy: integer); 100 function Distance(Loc0, Loc1: integer): integer; 102 101 procedure V8_to_Loc(Loc0: integer; var VicinityLoc: TVicinity8Loc); 103 102 procedure V21_to_Loc(Loc0: integer; var VicinityLoc: TVicinity21Loc); … … 118 117 // Map Revealing 119 118 function GetTileInfo(p, cix, Loc: integer; var Info: TTileInfo): integer; 120 procedure Strongest(Loc: integer;var uix,Strength,Bonus,Cnt:integer);119 procedure Strongest(Loc: integer; var uix, Strength, Bonus, Cnt: integer); 121 120 function UnitSpeed(p, mix, Health: integer): integer; 122 procedure GetUnitReport(p,uix: integer; var UnitReport: TUnitReport); 123 procedure SearchCity(Loc: integer; var p,cix: integer); 124 procedure TellAboutModel(p,taOwner,tamix: integer); 125 function emixSafe(p,taOwner,tamix: integer): integer; 126 function Discover9(Loc,p,Level: integer; TellAllied, EnableContact: boolean): boolean; 127 function Discover21(Loc,p,AdjacentLevel: integer; TellAllied, EnableContact: boolean): boolean; 121 procedure GetUnitReport(p, uix: integer; var UnitReport: TUnitReport); 122 procedure SearchCity(Loc: integer; var p, cix: integer); 123 procedure TellAboutModel(p, taOwner, tamix: integer); 124 function emixSafe(p, taOwner, tamix: integer): integer; 125 function Discover9(Loc, p, Level: integer; 126 TellAllied, EnableContact: boolean): boolean; 127 function Discover21(Loc, p, AdjacentLevel: integer; 128 TellAllied, EnableContact: boolean): boolean; 128 129 procedure DiscoverAll(p, Level: integer); 129 130 procedure DiscoverViewAreas(p: integer); 130 function GetUnitStack(p, Loc: integer): integer;131 function GetUnitStack(p, Loc: integer): integer; 131 132 procedure UpdateUnitMap(Loc: integer; CityChange: boolean = false); 132 procedure RecalcV8ZoC(p, Loc: integer);133 procedure RecalcV8ZoC(p, Loc: integer); 133 134 procedure RecalcMapZoC(p: integer); 134 135 procedure RecalcPeaceMap(p: integer); … … 136 137 // Territory Calculation 137 138 procedure CheckBorders(OriginLoc: integer; PlayerLosingCity: integer = -1); 138 procedure LogCheckBorders(p, cix: integer; PlayerLosingCity: integer = -1);139 procedure LogCheckBorders(p, cix: integer; PlayerLosingCity: integer = -1); 139 140 140 141 // Map Processing 141 procedure CreateUnit(p, mix: integer);142 procedure FreeUnit(p, uix: integer);143 procedure PlaceUnit(p, uix: integer);144 procedure RemoveUnit(p, uix: integer; Enemy: integer = -1);145 procedure RemoveUnit_UpdateMap(p, uix: integer);146 procedure RemoveAllUnits(p, Loc: integer; Enemy: integer = -1);147 procedure RemoveDomainUnits(d, p,Loc: integer);148 procedure FoundCity(p, FoundLoc: integer);149 procedure DestroyCity(p, cix: integer; SaveUnits: boolean);150 procedure ChangeCityOwner(pOld, cixOld,pNew: integer);151 procedure CompleteJob(p, Loc,Job: integer);142 procedure CreateUnit(p, mix: integer); 143 procedure FreeUnit(p, uix: integer); 144 procedure PlaceUnit(p, uix: integer); 145 procedure RemoveUnit(p, uix: integer; Enemy: integer = -1); 146 procedure RemoveUnit_UpdateMap(p, uix: integer); 147 procedure RemoveAllUnits(p, Loc: integer; Enemy: integer = -1); 148 procedure RemoveDomainUnits(d, p, Loc: integer); 149 procedure FoundCity(p, FoundLoc: integer); 150 procedure DestroyCity(p, cix: integer; SaveUnits: boolean); 151 procedure ChangeCityOwner(pOld, cixOld, pNew: integer); 152 procedure CompleteJob(p, Loc, Job: integer); 152 153 153 154 // Diplomacy 154 procedure IntroduceEnemy(p1, p2: integer);155 procedure IntroduceEnemy(p1, p2: integer); 155 156 procedure GiveCivilReport(p, pAbout: integer); 156 157 procedure GiveMilReport(p, pAbout: integer); … … 158 159 function PayPrice(pSender, pTarget, Price: integer; execute: boolean): boolean; 159 160 procedure CancelTreaty(p, pWith: integer; DecreaseCredibility: boolean = true); 160 function DoSpyMission(p,pCity,cix,Mission: integer): Cardinal; 161 161 function DoSpyMission(p, pCity, cix, Mission: integer): Cardinal; 162 162 163 163 implementation 164 164 165 165 uses 166 {$IFDEF LOADPERF}SysUtils, Windows,{$ENDIF} 167 {$IFDEF TEXTLOG}SysUtils,{$ENDIF} 168 IPQ; 169 170 var 171 UnBuilt: array[0..nPl-1] of integer; {number of units built} 172 166 {$IFDEF LOADPERF}SysUtils, Windows, {$ENDIF} 167 {$IFDEF TEXTLOG}SysUtils, {$ENDIF} 168 IPQ; 169 170 var 171 UnBuilt: array [0 .. nPl - 1] of integer; { number of units built } 173 172 174 173 procedure MaskD(var x; Count, Mask: Cardinal); Register; 175 174 asm 176 sub eax,4175 sub eax,4 177 176 @r: and [eax+edx*4],ecx 178 179 177 dec edx 178 jnz @r 180 179 end; 181 180 182 181 procedure CompactLists(p: integer); 183 182 var 184 uix,uix1,cix: integer; 185 {$IFOPT O-}V21: integer; Radius: TVicinity21Loc;{$ENDIF} 186 begin 187 with RW[p] do 188 begin 189 // compact unit list 190 uix:=0; 191 while uix<nUn do 192 if Un[uix].Loc<0 then 193 begin 194 dec(nUn); 195 Un[uix]:=Un[nUn]; {replace removed unit by last} 196 if (Un[uix].TroopLoad>0) or (Un[uix].AirLoad>0) then 197 for uix1:=0 to nUn-1 do 198 if Un[uix1].Master=nUn then Un[uix1].Master:=uix; 199 // index of last unit changes 183 uix, uix1, cix: integer; 184 {$IFOPT O-}V21: integer; 185 Radius: TVicinity21Loc; {$ENDIF} 186 begin 187 with RW[p] do 188 begin 189 // compact unit list 190 uix := 0; 191 while uix < nUn do 192 if Un[uix].Loc < 0 then 193 begin 194 dec(nUn); 195 Un[uix] := Un[nUn]; { replace removed unit by last } 196 if (Un[uix].TroopLoad > 0) or (Un[uix].AirLoad > 0) then 197 for uix1 := 0 to nUn - 1 do 198 if Un[uix1].Master = nUn then 199 Un[uix1].Master := uix; 200 // index of last unit changes 200 201 end 201 else inc(uix); 202 203 // compact city list 204 cix:=0; 205 while cix<nCity do 206 if City[cix].Loc<0 then 207 begin 208 dec(nCity); 209 City[cix]:=City[nCity]; {replace city by last} 210 for uix1:=0 to nUn-1 do 211 if Un[uix1].Home=nCity then Un[uix1].Home:=cix; 212 {index of last city changes} 202 else 203 inc(uix); 204 205 // compact city list 206 cix := 0; 207 while cix < nCity do 208 if City[cix].Loc < 0 then 209 begin 210 dec(nCity); 211 City[cix] := City[nCity]; { replace city by last } 212 for uix1 := 0 to nUn - 1 do 213 if Un[uix1].Home = nCity then 214 Un[uix1].Home := cix; 215 { index of last city changes } 213 216 end 214 else inc(cix); 215 216 // compact enemy city list 217 cix:=0; 218 while cix<nEnemyCity do 219 if EnemyCity[cix].Loc<0 then 220 begin 221 dec(nEnemyCity); 222 EnemyCity[cix]:=EnemyCity[nEnemyCity]; {replace city by last} 217 else 218 inc(cix); 219 220 // compact enemy city list 221 cix := 0; 222 while cix < nEnemyCity do 223 if EnemyCity[cix].Loc < 0 then 224 begin 225 dec(nEnemyCity); 226 EnemyCity[cix] := EnemyCity[nEnemyCity]; { replace city by last } 223 227 end 224 else inc(cix); 228 else 229 inc(cix); 225 230 226 231 {$IFOPT O-} 227 for cix:=0 to nCity-1 do with City[cix] do 228 begin 229 V21_to_Loc(Loc,Radius); 230 for V21:=1 to 26 do if Tiles and (1 shl V21)<>0 then 231 assert(UsedByCity[Radius[V21]]=Loc); 232 for cix := 0 to nCity - 1 do 233 with City[cix] do 234 begin 235 V21_to_Loc(Loc, Radius); 236 for V21 := 1 to 26 do 237 if Tiles and (1 shl V21) <> 0 then 238 assert(UsedByCity[Radius[V21]] = Loc); 239 end 240 {$ENDIF} 241 end; 242 end; // CompactLists 243 244 { 245 Tech Related Functions 246 ____________________________________________________________________ 247 } 248 function TechBaseCost(nTech, diff: integer): integer; 249 var 250 c0: single; 251 begin 252 c0 := TechFormula_M[diff] * (nTech + 4) * 253 exp((nTech + 4) / TechFormula_D[diff]); 254 if c0 >= $10000000 then 255 result := $10000000 256 else 257 result := trunc(c0) 258 end; 259 260 function TechCost(p: integer): integer; 261 begin 262 with RW[p] do 263 begin 264 result := TechBaseCost(nTech[p], Difficulty[p]); 265 if ResearchTech >= 0 then 266 if (ResearchTech = adMilitary) or (Tech[ResearchTech] = tsSeen) then 267 result := result shr 1 268 else if ResearchTech in FutureTech then 269 if Government = gFuture then 270 result := result * 2 271 else 272 result := result * 4; 273 end 274 end; 275 276 procedure SetModelFlags(var m: TModel); 277 begin 278 m.Flags := 0; 279 if (m.Domain = dGround) and (m.Kind <> mkDiplomat) then 280 m.Flags := m.Flags or mdZOC; 281 if (m.Kind = mkDiplomat) or (m.Attack + m.Cap[mcBombs] = 0) then 282 m.Flags := m.Flags or mdCivil; 283 if (m.Cap[mcOver] > 0) or (m.Domain = dSea) and (m.Weight >= 6) then 284 m.Flags := m.Flags or mdDoubleSupport; 285 end; 286 287 procedure CalculateModel(var m: TModel); 288 { calculate attack, defense, cost... of a model by features } 289 var 290 i: integer; 291 begin 292 with m do 293 begin 294 Attack := (Cap[mcOffense] + Cap[mcOver]) * MStrength; 295 Defense := (Cap[mcDefense] + Cap[mcOver]) * MStrength; 296 case Domain of 297 dGround: 298 Speed := 150 + Cap[mcMob] * 50; 299 dSea: 300 begin 301 Speed := 350 + 200 * Cap[mcNP] + 200 * Cap[mcTurbines]; 302 if Cap[mcNP] = 0 then 303 inc(Speed, 100 * Cap[mcSE]); 304 end; 305 dAir: 306 Speed := 850 + 400 * Cap[mcJet]; 307 end; 308 Cost := 0; 309 for i := 0 to nFeature - 1 do 310 if 1 shl Domain and Feature[i].Domains <> 0 then 311 inc(Cost, Cap[i] * Feature[i].Cost); 312 Cost := Cost * MCost; 313 Weight := 0; 314 for i := 0 to nFeature - 1 do 315 if 1 shl Domain and Feature[i].Domains <> 0 then 316 if (Domain = dGround) and (i = mcDefense) then 317 inc(Weight, Cap[i] * 2) 318 else 319 inc(Weight, Cap[i] * Feature[i].Weight); 320 end; 321 SetModelFlags(m); 322 end; 323 324 procedure CheckSpecialModels(p, pre: integer); 325 var 326 i, mix1: integer; 327 HasAlready: boolean; 328 begin 329 for i := 0 to nSpecialModel - 330 1 do { check whether new special model available } 331 if (SpecialModelPreq[i] = pre) and (RW[p].nModel < nmmax) then 332 begin 333 HasAlready := false; 334 for mix1 := 0 to RW[p].nModel - 1 do 335 if (RW[p].Model[mix1].Kind = SpecialModel[i].Kind) and 336 (RW[p].Model[mix1].Attack = SpecialModel[i].Attack) and 337 (RW[p].Model[mix1].Speed = SpecialModel[i].Speed) then 338 HasAlready := true; 339 if not HasAlready then 340 begin 341 RW[p].Model[RW[p].nModel] := SpecialModel[i]; 342 SetModelFlags(RW[p].Model[RW[p].nModel]); 343 with RW[p].Model[RW[p].nModel] do 344 begin 345 Status := 0; 346 SavedStatus := 0; 347 IntroTurn := GTurn; 348 Built := 0; 349 Lost := 0; 350 ID := p shl 12 + RW[p].nModel; 351 if (Kind = mkSpecial_Boat) and (ServerVersion[p] < $000EF0) then 352 Speed := 350; // old longboat 353 end; 354 inc(RW[p].nModel); 355 end 356 end; 357 end; 358 359 procedure EnableDevModel(p: integer); 360 begin 361 with RW[p] do 362 if nModel < nmmax then 363 begin 364 Model[nModel] := DevModel; 365 with Model[nModel] do 366 begin 367 Status := 0; 368 SavedStatus := 0; 369 IntroTurn := GTurn; 370 Built := 0; 371 Lost := 0; 372 ID := p shl 12 + nModel 373 end; 374 inc(nModel); 375 inc(Researched[p]) 232 376 end 233 {$ENDIF} 234 end; 235 end; // CompactLists 236 237 { 238 Tech Related Functions 239 ____________________________________________________________________ 240 } 241 function TechBaseCost(nTech,diff: integer): integer; 242 var 243 c0: single; 244 begin 245 c0:=TechFormula_M[diff]*(nTech+4)*exp((nTech+4)/TechFormula_D[diff]); 246 if c0>=$10000000 then result:=$10000000 247 else result:=trunc(c0) 248 end; 249 250 function TechCost(p: integer): integer; 251 begin 252 with RW[p] do 253 begin 254 result:=TechBaseCost(nTech[p],Difficulty[p]); 255 if ResearchTech>=0 then 256 if (ResearchTech=adMilitary) or (Tech[ResearchTech]=tsSeen) then 257 result:=result shr 1 258 else if ResearchTech in FutureTech then 259 if Government=gFuture then 260 result:=result*2 261 else result:=result*4; 377 end; 378 379 procedure SeeTech(p, ad: integer); 380 begin 381 {$IFDEF TEXTLOG}CmdInfo := CmdInfo + Format(' P%d:A%d', [p, ad]); {$ENDIF} 382 RW[p].Tech[ad] := tsSeen; 383 // inc(nTech[p]); 384 inc(Researched[p]) 385 end; 386 387 procedure FreeSlaves; 388 var 389 p1, uix: integer; 390 begin 391 for p1 := 0 to nPl - 1 do 392 if (GAlive and (1 shl p1) <> 0) then 393 for uix := 0 to RW[p1].nUn - 1 do 394 if RW[p1].Model[RW[p1].Un[uix].mix].Kind = mkSlaves then 395 RW[p1].Un[uix].Job := jNone 396 end; 397 398 procedure DiscoverTech(p, ad: integer); 399 400 procedure TellAboutKeyTech(p, Source: integer); 401 var 402 i, p1: integer; 403 begin 404 for i := 1 to 3 do 405 if ad = AgePreq[i] then 406 for p1 := 0 to nPl - 1 do 407 if (p1 <> p) and ((GAlive or GWatching) and (1 shl p1) <> 0) then 408 RW[p1].EnemyReport[p].Tech[ad] := Source; 409 end; 410 411 var 412 i: integer; 413 begin 414 if ad in FutureTech then 415 begin 416 if RW[p].Tech[ad] < tsApplicable then 417 RW[p].Tech[ad] := 1 418 else 419 inc(RW[p].Tech[ad]); 420 if ad <> futResearchTechnology then 421 inc(nTech[p], 2); 422 inc(Researched[p], 8); 423 exit; 424 end; 425 426 if RW[p].Tech[ad] = tsSeen then 427 begin 428 inc(nTech[p]); 429 inc(Researched[p]); 262 430 end 263 end; 264 265 procedure SetModelFlags(var m: TModel); 266 begin 267 m.Flags:=0; 268 if (m.Domain=dGround) and (m.Kind<>mkDiplomat) then 269 m.Flags:=m.Flags or mdZOC; 270 if (m.Kind=mkDiplomat) or (m.Attack+m.Cap[mcBombs]=0) then 271 m.Flags:=m.Flags or mdCivil; 272 if (m.Cap[mcOver]>0) or (m.Domain=dSea) and (m.Weight>=6) then 273 m.Flags:=m.Flags or mdDoubleSupport; 274 end; 275 276 procedure CalculateModel(var m: TModel); 277 {calculate attack, defense, cost... of a model by features} 278 var 279 i: integer; 280 begin 281 with m do 282 begin 283 Attack:=(Cap[mcOffense]+Cap[mcOver])*MStrength; 284 Defense:=(Cap[mcDefense]+Cap[mcOver])*MStrength; 285 case Domain of 286 dGround: Speed:=150+Cap[mcMob]*50; 287 dSea: 288 begin 289 Speed:=350+200*Cap[mcNP]+200*Cap[mcTurbines]; 290 if Cap[mcNP]=0 then 291 inc(Speed,100*Cap[mcSE]); 292 end; 293 dAir: Speed:=850+400*Cap[mcJet]; 294 end; 295 Cost:=0; 296 for i:=0 to nFeature-1 do 297 if 1 shl Domain and Feature[i].Domains<>0 then 298 inc(Cost,Cap[i]*Feature[i].Cost); 299 Cost:=Cost*MCost; 300 Weight:=0; 301 for i:=0 to nFeature-1 do 302 if 1 shl Domain and Feature[i].Domains<>0 then 303 if (Domain=dGround) and (i=mcDefense) then inc(Weight,Cap[i]*2) 304 else inc(Weight,Cap[i]*Feature[i].Weight); 305 end; 306 SetModelFlags(m); 307 end; 308 309 procedure CheckSpecialModels(p,pre: integer); 310 var 311 i,mix1: integer; 312 HasAlready: boolean; 313 begin 314 for i:=0 to nSpecialModel-1 do {check whether new special model available} 315 if (SpecialModelPreq[i]=pre) and (RW[p].nModel<nmmax) then 316 begin 317 HasAlready:=false; 318 for mix1:=0 to RW[p].nModel-1 do 319 if (RW[p].Model[mix1].Kind=SpecialModel[i].Kind) 320 and (RW[p].Model[mix1].Attack=SpecialModel[i].Attack) 321 and (RW[p].Model[mix1].Speed=SpecialModel[i].Speed) then 322 HasAlready:=true; 323 if not HasAlready then 324 begin 325 RW[p].Model[RW[p].nModel]:=SpecialModel[i]; 326 SetModelFlags(RW[p].Model[RW[p].nModel]); 327 with RW[p].Model[RW[p].nModel] do 328 begin 329 Status:=0; 330 SavedStatus:=0; 331 IntroTurn:=GTurn; 332 Built:=0; 333 Lost:=0; 334 ID:=p shl 12+RW[p].nModel; 335 if (Kind=mkSpecial_Boat) and (ServerVersion[p]<$000EF0) then 336 Speed:=350; // old longboat 337 end; 338 inc(RW[p].nModel); 339 end 340 end; 341 end; 342 343 procedure EnableDevModel(p: integer); 344 begin 345 with RW[p] do if nModel<nmmax then 346 begin 347 Model[nModel]:=DevModel; 348 with Model[nModel] do 349 begin 350 Status:=0; 351 SavedStatus:=0; 352 IntroTurn:=GTurn; 353 Built:=0; 354 Lost:=0; 355 ID:=p shl 12+nModel 356 end; 357 inc(nModel); 358 inc(Researched[p]) 359 end 360 end; 361 362 procedure SeeTech(p,ad: integer); 363 begin 364 {$IFDEF TEXTLOG}CmdInfo:=CmdInfo+Format(' P%d:A%d', [p,ad]);{$ENDIF} 365 RW[p].Tech[ad]:=tsSeen; 366 //inc(nTech[p]); 367 inc(Researched[p]) 368 end; 369 370 procedure FreeSlaves; 371 var 372 p1,uix: integer; 373 begin 374 for p1:=0 to nPl-1 do if (GAlive and (1 shl p1)<>0) then 375 for uix:=0 to RW[p1].nUn-1 do 376 if RW[p1].Model[RW[p1].Un[uix].mix].Kind=mkSlaves then 377 RW[p1].Un[uix].Job:=jNone 378 end; 379 380 procedure DiscoverTech(p,ad: integer); 381 382 procedure TellAboutKeyTech(p,Source: integer); 383 var 384 i,p1: integer; 385 begin 386 for i:=1 to 3 do if ad=AgePreq[i] then 387 for p1:=0 to nPl-1 do if (p1<>p) and ((GAlive or GWatching) and (1 shl p1)<>0) then 388 RW[p1].EnemyReport[p].Tech[ad]:=Source; 389 end; 390 391 var 392 i: integer; 393 begin 394 if ad in FutureTech then 395 begin 396 if RW[p].Tech[ad]<tsApplicable then RW[p].Tech[ad]:=1 397 else inc(RW[p].Tech[ad]); 398 if ad<>futResearchTechnology then inc(nTech[p],2); 399 inc(Researched[p],8); 400 exit; 401 end; 402 403 if RW[p].Tech[ad]=tsSeen then 404 begin inc(nTech[p]); inc(Researched[p]); end 405 else begin inc(nTech[p],2); inc(Researched[p],2); end; 406 RW[p].Tech[ad]:=tsResearched; 407 TellAboutKeyTech(p,tsResearched); 408 CheckSpecialModels(p,ad); 409 if ad=adScience then 410 ResourceMask[p]:=ResourceMask[p] or fSpecial2; 411 if ad=adMassProduction then 412 ResourceMask[p]:=ResourceMask[p] or fModern; 413 414 for i:=0 to 27 do {check whether wonders expired} 415 if (GWonder[i].EffectiveOwner<>GWonder[woEiffel].EffectiveOwner) 416 and (Imp[i].Expiration=ad) then 417 begin 418 GWonder[i].EffectiveOwner:=-1; 419 if i=woPyramids then FreeSlaves; 431 else 432 begin 433 inc(nTech[p], 2); 434 inc(Researched[p], 2); 435 end; 436 RW[p].Tech[ad] := tsResearched; 437 TellAboutKeyTech(p, tsResearched); 438 CheckSpecialModels(p, ad); 439 if ad = adScience then 440 ResourceMask[p] := ResourceMask[p] or fSpecial2; 441 if ad = adMassProduction then 442 ResourceMask[p] := ResourceMask[p] or fModern; 443 444 for i := 0 to 27 do { check whether wonders expired } 445 if (GWonder[i].EffectiveOwner <> GWonder[woEiffel].EffectiveOwner) and 446 (Imp[i].Expiration = ad) then 447 begin 448 GWonder[i].EffectiveOwner := -1; 449 if i = woPyramids then 450 FreeSlaves; 420 451 end; 421 452 end; … … 424 455 // GWonder[Wonder].EffectiveOwner must be set before! 425 456 var 426 p: integer; 427 begin 428 if (Imp[Wonder].Expiration>=0) 429 and (GWonder[woEiffel].EffectiveOwner<>GWonder[Wonder].EffectiveOwner) then 430 for p:=0 to nPl-1 do // check if already expired 431 if (1 shl p and GAlive<>0) and (RW[p].Tech[Imp[Wonder].Expiration]>=tsApplicable) then 432 begin 433 GWonder[Wonder].EffectiveOwner:=-1; 434 if Wonder=woPyramids then FreeSlaves 457 p: integer; 458 begin 459 if (Imp[Wonder].Expiration >= 0) and 460 (GWonder[woEiffel].EffectiveOwner <> GWonder[Wonder].EffectiveOwner) then 461 for p := 0 to nPl - 1 do // check if already expired 462 if (1 shl p and GAlive <> 0) and 463 (RW[p].Tech[Imp[Wonder].Expiration] >= tsApplicable) then 464 begin 465 GWonder[Wonder].EffectiveOwner := -1; 466 if Wonder = woPyramids then 467 FreeSlaves 435 468 end 436 469 end; 437 470 438 471 { 439 440 ____________________________________________________________________472 Location Navigation 473 ____________________________________________________________________ 441 474 } 442 function dLoc(Loc,dx,dy: integer): integer; 443 {relative location, dx in hor and dy in ver direction from Loc} 444 var 445 y0: integer; 446 begin 447 assert((Loc>=0) and (Loc<MapSize) and (dx+lx>=0)); 448 y0:=Loc div lx; 449 result:=(Loc+(dx+y0 and 1+lx+lx) shr 1) mod lx +lx*(y0+dy); 450 if (result<0) or (result>=MapSize) then result:=-1; 451 end; 452 453 procedure dxdy(Loc0,Loc1: integer; var dx,dy: integer); 454 begin 455 dx:=((Loc1 mod lx *2 +Loc1 div lx and 1) 456 -(Loc0 mod lx *2 +Loc0 div lx and 1)+3*lx) mod (2*lx) -lx; 457 dy:=Loc1 div lx-Loc0 div lx; 458 end; 459 460 function Distance(Loc0,Loc1: integer): integer; 461 var 462 dx,dy: integer; 463 begin 464 dxdy(Loc0,Loc1,dx,dy); 465 dx:=abs(dx); 466 dy:=abs(dy); 467 result:=dx+dy+abs(dx-dy) shr 1; 475 function dLoc(Loc, dx, dy: integer): integer; 476 { relative location, dx in hor and dy in ver direction from Loc } 477 var 478 y0: integer; 479 begin 480 assert((Loc >= 0) and (Loc < MapSize) and (dx + lx >= 0)); 481 y0 := Loc div lx; 482 result := (Loc + (dx + y0 and 1 + lx + lx) shr 1) mod lx + lx * (y0 + dy); 483 if (result < 0) or (result >= MapSize) then 484 result := -1; 485 end; 486 487 procedure dxdy(Loc0, Loc1: integer; var dx, dy: integer); 488 begin 489 dx := ((Loc1 mod lx * 2 + Loc1 div lx and 1) - 490 (Loc0 mod lx * 2 + Loc0 div lx and 1) + 3 * lx) mod (2 * lx) - lx; 491 dy := Loc1 div lx - Loc0 div lx; 492 end; 493 494 function Distance(Loc0, Loc1: integer): integer; 495 var 496 dx, dy: integer; 497 begin 498 dxdy(Loc0, Loc1, dx, dy); 499 dx := abs(dx); 500 dy := abs(dy); 501 result := dx + dy + abs(dx - dy) shr 1; 468 502 end; 469 503 470 504 procedure V8_to_Loc(Loc0: integer; var VicinityLoc: TVicinity8Loc); 471 505 var 472 x0,y0,lx0: integer;473 begin 474 lx0:=lx; // put in register!475 y0:=Loc0 div lx0;476 x0:=Loc0-y0*lx0; // Loc0 mod lx;477 y0:=y0 and 1;478 VicinityLoc[1]:=Loc0+lx0*2;479 VicinityLoc[3]:=Loc0-1;480 VicinityLoc[5]:=Loc0-lx0*2;481 VicinityLoc[7]:=Loc0+1;482 inc(Loc0,y0);483 VicinityLoc[0]:=Loc0+lx0;484 VicinityLoc[2]:=Loc0+lx0-1;485 VicinityLoc[4]:=Loc0-lx0-1;486 VicinityLoc[6]:=Loc0-lx0;487 488 // world is round!489 if x0<lx0-1 then490 begin 491 if x0=0 then492 begin 493 inc(VicinityLoc[3],lx0);494 if y0=0 then495 begin 496 inc(VicinityLoc[2],lx0);497 inc(VicinityLoc[4],lx0);506 x0, y0, lx0: integer; 507 begin 508 lx0 := lx; // put in register! 509 y0 := Loc0 div lx0; 510 x0 := Loc0 - y0 * lx0; // Loc0 mod lx; 511 y0 := y0 and 1; 512 VicinityLoc[1] := Loc0 + lx0 * 2; 513 VicinityLoc[3] := Loc0 - 1; 514 VicinityLoc[5] := Loc0 - lx0 * 2; 515 VicinityLoc[7] := Loc0 + 1; 516 inc(Loc0, y0); 517 VicinityLoc[0] := Loc0 + lx0; 518 VicinityLoc[2] := Loc0 + lx0 - 1; 519 VicinityLoc[4] := Loc0 - lx0 - 1; 520 VicinityLoc[6] := Loc0 - lx0; 521 522 // world is round! 523 if x0 < lx0 - 1 then 524 begin 525 if x0 = 0 then 526 begin 527 inc(VicinityLoc[3], lx0); 528 if y0 = 0 then 529 begin 530 inc(VicinityLoc[2], lx0); 531 inc(VicinityLoc[4], lx0); 498 532 end 499 533 end 500 534 end 501 else502 begin 503 dec(VicinityLoc[7],lx0);504 if y0=1 then505 begin 506 dec(VicinityLoc[0],lx0);507 dec(VicinityLoc[6],lx0);535 else 536 begin 537 dec(VicinityLoc[7], lx0); 538 if y0 = 1 then 539 begin 540 dec(VicinityLoc[0], lx0); 541 dec(VicinityLoc[6], lx0); 508 542 end 509 543 end; … … 512 546 procedure V21_to_Loc(Loc0: integer; var VicinityLoc: TVicinity21Loc); 513 547 var 514 dx,dy,bit,y0,xComp,yComp,xComp0,xCompSwitch: integer; 515 dst: ^integer; 516 begin 517 y0:=Loc0 div lx; 518 xComp0:=Loc0-y0*lx-1; // Loc0 mod lx -1 519 xCompSwitch:=xComp0-1+y0 and 1; 520 if xComp0<0 then inc(xComp0,lx); 521 if xCompSwitch<0 then inc(xCompSwitch,lx); 522 xCompSwitch:=xCompSwitch xor xComp0; 523 yComp:=lx*(y0-3); 524 dst:=@VicinityLoc; 525 bit:=1; 526 for dy:=0 to 6 do 527 begin 528 xComp0:=xComp0 xor xCompSwitch; 529 xComp:=xComp0; 530 for dx:=0 to 3 do 531 begin 532 if bit and $67F7F76<>0 then dst^:=xComp+yComp 533 else dst^:=-1; 534 inc(xComp); 535 if xComp>=lx then dec(xComp, lx); 536 inc(dst); 537 bit:=bit shl 1; 538 end; 539 inc(yComp,lx); 540 end; 541 end; 542 548 dx, dy, bit, y0, xComp, yComp, xComp0, xCompSwitch: integer; 549 dst: ^integer; 550 begin 551 y0 := Loc0 div lx; 552 xComp0 := Loc0 - y0 * lx - 1; // Loc0 mod lx -1 553 xCompSwitch := xComp0 - 1 + y0 and 1; 554 if xComp0 < 0 then 555 inc(xComp0, lx); 556 if xCompSwitch < 0 then 557 inc(xCompSwitch, lx); 558 xCompSwitch := xCompSwitch xor xComp0; 559 yComp := lx * (y0 - 3); 560 dst := @VicinityLoc; 561 bit := 1; 562 for dy := 0 to 6 do 563 begin 564 xComp0 := xComp0 xor xCompSwitch; 565 xComp := xComp0; 566 for dx := 0 to 3 do 567 begin 568 if bit and $67F7F76 <> 0 then 569 dst^ := xComp + yComp 570 else 571 dst^ := -1; 572 inc(xComp); 573 if xComp >= lx then 574 dec(xComp, lx); 575 inc(dst); 576 bit := bit shl 1; 577 end; 578 inc(yComp, lx); 579 end; 580 end; 543 581 544 582 { 545 546 ____________________________________________________________________583 Map Creation 584 ____________________________________________________________________ 547 585 } 548 586 var 549 primitive: integer;550 StartLoc, StartLoc2: array[0..nPl-1] of integer; {starting coordinates}551 Elevation: array[0..lxmax*lymax-1] of Byte; {map elevation}552 ElCount: array[Byte] of integer; {count of elevation occurance}587 primitive: integer; 588 StartLoc, StartLoc2: array [0 .. nPl - 1] of integer; { starting coordinates } 589 Elevation: array [0 .. lxmax * lymax - 1] of Byte; { map elevation } 590 ElCount: array [Byte] of integer; { count of elevation occurance } 553 591 554 592 procedure CalculatePrimitive; 555 593 var 556 i,j: integer; 557 begin 558 primitive:=1; 559 i:=2; 560 while i*i<=MapSize+1 do // test whether prime 561 begin if (MapSize+1) mod i=0 then primitive:=0; inc(i) end; 562 563 if primitive>0 then 564 repeat 565 inc(primitive); 566 i:=1; 567 j:=0; 568 repeat inc(j); i:=i*primitive mod (MapSize+1) until (i=1) or (j=MapSize+1); 569 until j=MapSize; 594 i, j: integer; 595 begin 596 primitive := 1; 597 i := 2; 598 while i * i <= MapSize + 1 do // test whether prime 599 begin 600 if (MapSize + 1) mod i = 0 then 601 primitive := 0; 602 inc(i) 603 end; 604 605 if primitive > 0 then 606 repeat 607 inc(primitive); 608 i := 1; 609 j := 0; 610 repeat 611 inc(j); 612 i := i * primitive mod (MapSize + 1) 613 until (i = 1) or (j = MapSize + 1); 614 until j = MapSize; 570 615 end; 571 616 572 617 function MapGeneratorAvailable: boolean; 573 618 begin 574 result:=(primitive>0) and (lx>=20) and (ly>=40)619 result := (primitive > 0) and (lx >= 20) and (ly >= 40) 575 620 end; 576 621 577 622 procedure CreateElevation; 578 623 const 579 d=64;580 Smooth=0.049;{causes low amplitude of short waves}581 Detail=0.095;{causes short period of short waves}582 Merge=5;{elevation merging range at the connection line of the583 round world,in relation to lx}584 585 var 586 sa,ca,f1,f2:array[1..d] of single;587 imerge,x,y:integer;588 v,maxv:single;589 590 function Value(x, y:integer):single;{elevation formula}624 d = 64; 625 Smooth = 0.049; { causes low amplitude of short waves } 626 Detail = 0.095; { causes short period of short waves } 627 Merge = 5; { elevation merging range at the connection line of the 628 round world,in relation to lx } 629 630 var 631 sa, ca, f1, f2: array [1 .. d] of single; 632 imerge, x, y: integer; 633 v, maxv: single; 634 635 function Value(x, y: integer): single; { elevation formula } 591 636 var 592 i:integer; 593 begin 594 result:=0; 595 for i:=1 to d do result:=result+sin(f1[i]*((x*2+y and 1)*sa[i]+y*1.5*ca[i])) 596 *f2[i]; 597 {x values effectively multiplied with 2 to get 2 horizantal periods 598 of the prime waves} 599 end; 600 601 begin 602 for x:=1 to d do {prepare formula parameters} 603 begin 604 {$IFNDEF SCR}if x=1 then v:=pi/2 {first wave goes horizontal} 605 else{$ENDIF} v:=Random*2*pi; 606 sa[x]:=sin(v)/lx; 607 ca[x]:=cos(v)/ly; 608 f1[x]:=2*pi*Exp(Detail*(x-1)); 609 f2[x]:=Exp(-x*Smooth) 610 end; 611 612 imerge:=2*lx div Merge; 613 FillChar(ElCount,SizeOf(ElCount),0); 614 maxv:=0; 615 for x:=0 to lx-1 do for y:=0 to ly-1 do 616 begin 617 v:=Value(x,y); 618 if x*2<imerge then v:=(x*2*v+(imerge-x*2)*Value(x+lx,y))/imerge; 619 v:=v-sqr(sqr(2*y/ly-1));{soft cut at poles} 620 if v>maxv then maxv:=v; 621 622 if v<-4 then Elevation[x+lx*y]:=0 623 else if v>8.75 then Elevation[x+lx*y]:=255 624 else Elevation[x+lx*y]:=Round((v+4)*20); 625 inc(ElCount[Elevation[x+lx*y]]) 626 end; 637 i: integer; 638 begin 639 result := 0; 640 for i := 1 to d do 641 result := result + sin(f1[i] * ((x * 2 + y and 1) * sa[i] + y * 1.5 * 642 ca[i])) * f2[i]; 643 { x values effectively multiplied with 2 to get 2 horizantal periods 644 of the prime waves } 645 end; 646 647 begin 648 for x := 1 to d do { prepare formula parameters } 649 begin 650 {$IFNDEF SCR} if x = 1 then 651 v := pi / 2 { first wave goes horizontal } 652 else {$ENDIF} v := Random * 2 * pi; 653 sa[x] := sin(v) / lx; 654 ca[x] := cos(v) / ly; 655 f1[x] := 2 * pi * exp(Detail * (x - 1)); 656 f2[x] := exp(-x * Smooth) 657 end; 658 659 imerge := 2 * lx div Merge; 660 FillChar(ElCount, SizeOf(ElCount), 0); 661 maxv := 0; 662 for x := 0 to lx - 1 do 663 for y := 0 to ly - 1 do 664 begin 665 v := Value(x, y); 666 if x * 2 < imerge then 667 v := (x * 2 * v + (imerge - x * 2) * Value(x + lx, y)) / imerge; 668 v := v - sqr(sqr(2 * y / ly - 1)); { soft cut at poles } 669 if v > maxv then 670 maxv := v; 671 672 if v < -4 then 673 Elevation[x + lx * y] := 0 674 else if v > 8.75 then 675 Elevation[x + lx * y] := 255 676 else 677 Elevation[x + lx * y] := Round((v + 4) * 20); 678 inc(ElCount[Elevation[x + lx * y]]) 679 end; 627 680 end; 628 681 629 682 procedure FindContinents; 630 683 631 procedure ReplaceCont(a, b,Stop:integer);632 { replace continent name a by b}684 procedure ReplaceCont(a, b, Stop: integer); 685 { replace continent name a by b } 633 686 // make sure always continent[loc]<=loc 634 687 var 635 i: integer; 636 begin 637 if a<b then begin i:=a; a:=b; b:=i end; 638 if a>b then 639 for i:=a to Stop do if Continent[i]=a then Continent[i]:=b 640 end; 641 642 var 643 x,y,Loc,Wrong:integer; 644 begin 645 for y:=1 to ly-2 do for x:=0 to lx-1 do 646 begin 647 Loc:=x+lx*y; 648 Continent[Loc]:=-1; 649 if RealMap[Loc] and fTerrain>=fGrass then 650 begin 651 if (y-2>=1) and (RealMap[Loc-2*lx] and fTerrain>=fGrass) then 652 Continent[Loc]:=Continent[Loc-2*lx]; 653 if (x-1+y and 1>=0) and (y-1>=1) 654 and (RealMap[Loc-1+y and 1-lx] and fTerrain>=fGrass) then 655 Continent[Loc]:=Continent[Loc-1+y and 1-lx]; 656 if (x+y and 1<lx) and (y-1>=1) 657 and (RealMap[Loc+y and 1-lx] and fTerrain>=fGrass) then 658 Continent[Loc]:=Continent[Loc+y and 1-lx]; 659 if (x-1>=0) and (RealMap[Loc-1] and fTerrain>=fGrass) then 660 if Continent[Loc]=-1 then Continent[Loc]:=Continent[Loc-1] 661 else ReplaceCont(Continent[Loc-1],Continent[Loc],Loc); 662 if Continent[Loc]=-1 then Continent[Loc]:=Loc 663 end 664 end; 665 666 {connect continents due to round earth} 667 for y:=1 to ly-2 do if RealMap[lx*y] and fTerrain>=fGrass then 668 begin 669 Wrong:=-1; 670 if RealMap[lx-1+lx*y] and fTerrain>=fGrass then Wrong:=Continent[lx-1+lx*y]; 671 if (y and 1=0) and (y-1>=1) and (RealMap[lx-1+lx*(y-1)] and fTerrain>=fGrass) then 672 Wrong:=Continent[lx-1+lx*(y-1)]; 673 if (y and 1=0) and (y+1<ly-1) 674 and (RealMap[lx-1+lx*(y+1)] and fTerrain>=fGrass) then 675 Wrong:=Continent[lx-1+lx*(y+1)]; 676 if Wrong>=0 then ReplaceCont(Wrong,Continent[lx*y],MapSize-1) 677 end; 688 i: integer; 689 begin 690 if a < b then 691 begin 692 i := a; 693 a := b; 694 b := i 695 end; 696 if a > b then 697 for i := a to Stop do 698 if Continent[i] = a then 699 Continent[i] := b 700 end; 701 702 var 703 x, y, Loc, Wrong: integer; 704 begin 705 for y := 1 to ly - 2 do 706 for x := 0 to lx - 1 do 707 begin 708 Loc := x + lx * y; 709 Continent[Loc] := -1; 710 if RealMap[Loc] and fTerrain >= fGrass then 711 begin 712 if (y - 2 >= 1) and (RealMap[Loc - 2 * lx] and fTerrain >= fGrass) then 713 Continent[Loc] := Continent[Loc - 2 * lx]; 714 if (x - 1 + y and 1 >= 0) and (y - 1 >= 1) and 715 (RealMap[Loc - 1 + y and 1 - lx] and fTerrain >= fGrass) then 716 Continent[Loc] := Continent[Loc - 1 + y and 1 - lx]; 717 if (x + y and 1 < lx) and (y - 1 >= 1) and 718 (RealMap[Loc + y and 1 - lx] and fTerrain >= fGrass) then 719 Continent[Loc] := Continent[Loc + y and 1 - lx]; 720 if (x - 1 >= 0) and (RealMap[Loc - 1] and fTerrain >= fGrass) then 721 if Continent[Loc] = -1 then 722 Continent[Loc] := Continent[Loc - 1] 723 else 724 ReplaceCont(Continent[Loc - 1], Continent[Loc], Loc); 725 if Continent[Loc] = -1 then 726 Continent[Loc] := Loc 727 end 728 end; 729 730 { connect continents due to round earth } 731 for y := 1 to ly - 2 do 732 if RealMap[lx * y] and fTerrain >= fGrass then 733 begin 734 Wrong := -1; 735 if RealMap[lx - 1 + lx * y] and fTerrain >= fGrass then 736 Wrong := Continent[lx - 1 + lx * y]; 737 if (y and 1 = 0) and (y - 1 >= 1) and 738 (RealMap[lx - 1 + lx * (y - 1)] and fTerrain >= fGrass) then 739 Wrong := Continent[lx - 1 + lx * (y - 1)]; 740 if (y and 1 = 0) and (y + 1 < ly - 1) and 741 (RealMap[lx - 1 + lx * (y + 1)] and fTerrain >= fGrass) then 742 Wrong := Continent[lx - 1 + lx * (y + 1)]; 743 if Wrong >= 0 then 744 ReplaceCont(Wrong, Continent[lx * y], MapSize - 1) 745 end; 678 746 end; 679 747 … … 682 750 // must be done after FindContinents 683 751 var 684 i,j,Cnt,x,y,dx,dy,Loc0,Loc1,xworst,yworst,totalrare,RareMaxWater,RareType, 685 iBest,jbest,MinDist,xBlock,yBlock,V8: integer; 686 AreaCount, RareByArea, RareAdjacent: array[0..7,0..4] of integer; 687 RareLoc: array[0..11] of integer; 688 Dist: array[0..11,0..11] of integer; 689 Adjacent: TVicinity8Loc; 690 begin 691 RareMaxWater:=0; 692 repeat 693 FillChar(AreaCount, SizeOf(AreaCount), 0); 694 for y:=1 to ly-2 do 695 begin 696 yBlock:=y*5 div ly; 697 if yBlock=(y+1)*5 div ly then for x:=0 to lx-1 do 698 begin 699 xBlock:=x*8 div lx; 700 if xBlock=(x+1)*8 div lx then 701 begin 702 Loc0:=x+lx*y; 703 if RealMap[Loc0] and fTerrain>=fGrass then 752 i, j, Cnt, x, y, dx, dy, Loc0, Loc1, xworst, yworst, totalrare, RareMaxWater, 753 RareType, iBest, jbest, MinDist, xBlock, yBlock, V8: integer; 754 AreaCount, RareByArea, RareAdjacent: array [0 .. 7, 0 .. 4] of integer; 755 RareLoc: array [0 .. 11] of integer; 756 Dist: array [0 .. 11, 0 .. 11] of integer; 757 Adjacent: TVicinity8Loc; 758 begin 759 RareMaxWater := 0; 760 repeat 761 FillChar(AreaCount, SizeOf(AreaCount), 0); 762 for y := 1 to ly - 2 do 763 begin 764 yBlock := y * 5 div ly; 765 if yBlock = (y + 1) * 5 div ly then 766 for x := 0 to lx - 1 do 767 begin 768 xBlock := x * 8 div lx; 769 if xBlock = (x + 1) * 8 div lx then 704 770 begin 705 Cnt:=0; 706 V8_to_Loc(Loc0,Adjacent); 707 for V8:=0 to 7 do 771 Loc0 := x + lx * y; 772 if RealMap[Loc0] and fTerrain >= fGrass then 708 773 begin 709 Loc1:=Adjacent[V8]; 710 if (Loc1>=0) and (Loc1<MapSize) 711 and (RealMap[Loc1] and fTerrain<fGrass) then 712 inc(Cnt); // count adjacent water 774 Cnt := 0; 775 V8_to_Loc(Loc0, Adjacent); 776 for V8 := 0 to 7 do 777 begin 778 Loc1 := Adjacent[V8]; 779 if (Loc1 >= 0) and (Loc1 < MapSize) and 780 (RealMap[Loc1] and fTerrain < fGrass) then 781 inc(Cnt); // count adjacent water 782 end; 783 if Cnt <= RareMaxWater then // inner land 784 begin 785 inc(AreaCount[xBlock, yBlock]); 786 if Random(AreaCount[xBlock, yBlock]) = 0 then 787 RareByArea[xBlock, yBlock] := Loc0 788 end 713 789 end; 714 if Cnt<=RareMaxWater then // inner land 790 end; 791 end 792 end; 793 totalrare := 0; 794 for x := 0 to 7 do 795 for y := 0 to 4 do 796 if AreaCount[x, y] > 0 then 797 inc(totalrare); 798 inc(RareMaxWater); 799 until totalrare >= 12; 800 801 while totalrare > 12 do 802 begin // remove rarebyarea resources too close to each other 803 FillChar(RareAdjacent, SizeOf(RareAdjacent), 0); 804 for x := 0 to 7 do 805 for y := 0 to 4 do 806 if AreaCount[x, y] > 0 then 807 begin 808 if (AreaCount[(x + 1) mod 8, y] > 0) and 809 (Continent[RareByArea[x, y]] = Continent 810 [RareByArea[(x + 1) mod 8, y]]) then 811 begin 812 inc(RareAdjacent[x, y]); 813 inc(RareAdjacent[(x + 1) mod 8, y]); 814 end; 815 if y < 4 then 816 begin 817 if (AreaCount[x, y + 1] > 0) and 818 (Continent[RareByArea[x, y]] = Continent[RareByArea[x, y + 1]]) 819 then 715 820 begin 716 inc(AreaCount[xBlock,yBlock]); 717 if Random(AreaCount[xBlock,yBlock])=0 then 718 RareByArea[xBlock,yBlock]:=Loc0 821 inc(RareAdjacent[x, y]); 822 inc(RareAdjacent[x, y + 1]); 823 end; 824 if (AreaCount[(x + 1) mod 8, y + 1] > 0) and 825 (Continent[RareByArea[x, y]] = Continent[RareByArea[(x + 1) mod 8, 826 y + 1]]) then 827 begin 828 inc(RareAdjacent[x, y]); 829 inc(RareAdjacent[(x + 1) mod 8, y + 1]); 830 end; 831 if (AreaCount[(x + 7) mod 8, y + 1] > 0) and 832 (Continent[RareByArea[x, y]] = Continent[RareByArea[(x + 7) mod 8, 833 y + 1]]) then 834 begin 835 inc(RareAdjacent[x, y]); 836 inc(RareAdjacent[(x + 7) mod 8, y + 1]); 837 end; 838 end 839 end; 840 xworst := 0; 841 yworst := 0; 842 Cnt := 0; 843 for x := 0 to 7 do 844 for y := 0 to 4 do 845 if AreaCount[x, y] > 0 then 846 begin 847 if (Cnt = 0) or (RareAdjacent[x, y] > RareAdjacent[xworst, yworst]) 848 then 849 begin 850 xworst := x; 851 yworst := y; 852 Cnt := 1 853 end 854 else if (RareAdjacent[x, y] = RareAdjacent[xworst, yworst]) then 855 begin 856 inc(Cnt); 857 if Random(Cnt) = 0 then 858 begin 859 xworst := x; 860 yworst := y; 719 861 end 720 862 end; 721 863 end; 722 end 723 end; 724 totalrare:=0; 725 for x:=0 to 7 do for y:=0 to 4 do if AreaCount[x,y]>0 then 726 inc(totalrare); 727 inc(RareMaxWater); 728 until totalrare>=12; 729 730 while totalrare>12 do 731 begin // remove rarebyarea resources too close to each other 732 FillChar(RareAdjacent,SizeOf(RareAdjacent),0); 733 for x:=0 to 7 do for y:=0 to 4 do if AreaCount[x,y]>0 then 734 begin 735 if (AreaCount[(x+1) mod 8,y]>0) 736 and (Continent[RareByArea[x,y]]=Continent[RareByArea[(x+1) mod 8,y]]) then 737 begin 738 inc(RareAdjacent[x,y]); 739 inc(RareAdjacent[(x+1) mod 8,y]); 740 end; 741 if y<4 then 742 begin 743 if (AreaCount[x,y+1]>0) 744 and (Continent[RareByArea[x,y]]=Continent[RareByArea[x,y+1]]) then 745 begin 746 inc(RareAdjacent[x,y]); 747 inc(RareAdjacent[x,y+1]); 748 end; 749 if (AreaCount[(x+1) mod 8,y+1]>0) 750 and (Continent[RareByArea[x,y]]=Continent[RareByArea[(x+1) mod 8,y+1]]) then 751 begin 752 inc(RareAdjacent[x,y]); 753 inc(RareAdjacent[(x+1) mod 8,y+1]); 754 end; 755 if (AreaCount[(x+7) mod 8,y+1]>0) 756 and (Continent[RareByArea[x,y]]=Continent[RareByArea[(x+7) mod 8,y+1]]) then 757 begin 758 inc(RareAdjacent[x,y]); 759 inc(RareAdjacent[(x+7) mod 8,y+1]); 760 end; 761 end 762 end; 763 xworst:=0; yworst:=0; 764 Cnt:=0; 765 for x:=0 to 7 do for y:=0 to 4 do if AreaCount[x,y]>0 then 766 begin 767 if (Cnt=0) or (RareAdjacent[x,y]>RareAdjacent[xworst,yworst]) then 768 begin xworst:=x; yworst:=y; Cnt:=1 end 769 else if (RareAdjacent[x,y]=RareAdjacent[xworst,yworst]) then 770 begin 771 inc(Cnt); 772 if Random(Cnt)=0 then begin xworst:=x; yworst:=y; end 773 end; 774 end; 775 AreaCount[xworst,yworst]:=0; 776 dec(totalrare) 777 end; 778 779 Cnt:=0; 780 for x:=0 to 7 do for y:=0 to 4 do if AreaCount[x,y]>0 then 781 begin RareLoc[Cnt]:=RareByArea[x,y]; inc(Cnt) end; 782 for i:=0 to 11 do 783 begin 784 RealMap[RareLoc[i]]:=RealMap[RareLoc[i]] 785 and not (fTerrain or fSpecial) or (fDesert or fDeadLands); 786 for dy:=-1 to 1 do for dx:=-1 to 1 do if (dx+dy) and 1=0 then 787 begin 788 Loc1:=dLoc(RareLoc[i],dx,dy); 789 if (Loc1>=0) and (RealMap[Loc1] and fTerrain=fMountains) then 790 RealMap[Loc1]:=RealMap[Loc1] and not fTerrain or fHills; 791 end 792 end; 793 for i:=0 to 11 do for j:=0 to 11 do 794 Dist[i,j]:=Distance(RareLoc[i],RareLoc[j]); 795 796 MinDist:=Distance(0,MapSize-lx shr 1) shr 1; 797 for RareType:=1 to 3 do 798 begin 799 Cnt:=0; 800 for i:=0 to 11 do if RareLoc[i]>=0 then 801 for j:=0 to 11 do if RareLoc[j]>=0 then 802 if (Cnt>0) and (Dist[iBest,jbest]>=MinDist) then 803 begin 804 if Dist[i,j]>=MinDist then 805 begin 806 inc(Cnt); 807 if Random(Cnt)=0 then 808 begin iBest:=i; jbest:=j end 809 end 864 AreaCount[xworst, yworst] := 0; 865 dec(totalrare) 866 end; 867 868 Cnt := 0; 869 for x := 0 to 7 do 870 for y := 0 to 4 do 871 if AreaCount[x, y] > 0 then 872 begin 873 RareLoc[Cnt] := RareByArea[x, y]; 874 inc(Cnt) 875 end; 876 for i := 0 to 11 do 877 begin 878 RealMap[RareLoc[i]] := RealMap[RareLoc[i]] and not(fTerrain or fSpecial) or 879 (fDesert or fDeadLands); 880 for dy := -1 to 1 do 881 for dx := -1 to 1 do 882 if (dx + dy) and 1 = 0 then 883 begin 884 Loc1 := dLoc(RareLoc[i], dx, dy); 885 if (Loc1 >= 0) and (RealMap[Loc1] and fTerrain = fMountains) then 886 RealMap[Loc1] := RealMap[Loc1] and not fTerrain or fHills; 810 887 end 811 else if (Cnt=0) or (Dist[i,j]>Dist[iBest,jbest]) then 812 begin iBest:=i; jbest:=j; Cnt:=1; end; 813 RealMap[RareLoc[iBest]]:=RealMap[RareLoc[iBest]] or Cardinal(RareType) shl 25; 814 RealMap[RareLoc[jbest]]:=RealMap[RareLoc[jbest]] or Cardinal(RareType) shl 25; 815 RareLoc[iBest]:=-1; 816 RareLoc[jbest]:=-1; 888 end; 889 for i := 0 to 11 do 890 for j := 0 to 11 do 891 Dist[i, j] := Distance(RareLoc[i], RareLoc[j]); 892 893 MinDist := Distance(0, MapSize - lx shr 1) shr 1; 894 for RareType := 1 to 3 do 895 begin 896 Cnt := 0; 897 for i := 0 to 11 do 898 if RareLoc[i] >= 0 then 899 for j := 0 to 11 do 900 if RareLoc[j] >= 0 then 901 if (Cnt > 0) and (Dist[iBest, jbest] >= MinDist) then 902 begin 903 if Dist[i, j] >= MinDist then 904 begin 905 inc(Cnt); 906 if Random(Cnt) = 0 then 907 begin 908 iBest := i; 909 jbest := j 910 end 911 end 912 end 913 else if (Cnt = 0) or (Dist[i, j] > Dist[iBest, jbest]) then 914 begin 915 iBest := i; 916 jbest := j; 917 Cnt := 1; 918 end; 919 RealMap[RareLoc[iBest]] := RealMap[RareLoc[iBest]] or 920 Cardinal(RareType) shl 25; 921 RealMap[RareLoc[jbest]] := RealMap[RareLoc[jbest]] or 922 Cardinal(RareType) shl 25; 923 RareLoc[iBest] := -1; 924 RareLoc[jbest] := -1; 817 925 end; 818 926 end; // RarePositions … … 820 928 function CheckShore(Loc: integer): boolean; 821 929 var 822 Loc1,OldTile,V21: integer;823 Radius: TVicinity21Loc;824 begin 825 result:=false;826 OldTile:=RealMap[Loc];827 if OldTile and fTerrain<fGrass then828 begin 829 RealMap[Loc]:=RealMap[Loc] and not fTerrain or fOcean;830 V21_to_Loc(Loc,Radius);831 for V21:=1 to 26 do832 begin 833 Loc1:=Radius[V21];834 if (Loc1>=0) and (Loc1<MapSize)835 and (RealMap[Loc1] and fTerrain>=fGrass)836 and (RealMap[Loc1] and fTerrain<>fArctic) then837 RealMap[Loc]:=RealMap[Loc] and not fTerrain or fShore;838 end; 839 if (RealMap[Loc] xor Cardinal(OldTile)) and fTerrain<>0 then840 result:=true930 Loc1, OldTile, V21: integer; 931 Radius: TVicinity21Loc; 932 begin 933 result := false; 934 OldTile := RealMap[Loc]; 935 if OldTile and fTerrain < fGrass then 936 begin 937 RealMap[Loc] := RealMap[Loc] and not fTerrain or fOcean; 938 V21_to_Loc(Loc, Radius); 939 for V21 := 1 to 26 do 940 begin 941 Loc1 := Radius[V21]; 942 if (Loc1 >= 0) and (Loc1 < MapSize) and 943 (RealMap[Loc1] and fTerrain >= fGrass) and 944 (RealMap[Loc1] and fTerrain <> fArctic) then 945 RealMap[Loc] := RealMap[Loc] and not fTerrain or fShore; 946 end; 947 if (RealMap[Loc] xor Cardinal(OldTile)) and fTerrain <> 0 then 948 result := true 841 949 end; 842 950 end; … … 844 952 function ActualSpecialTile(Loc: integer): Cardinal; 845 953 begin 846 result:=SpecialTile(Loc, RealMap[Loc] and fTerrain, lx);954 result := SpecialTile(Loc, RealMap[Loc] and fTerrain, lx); 847 955 end; 848 956 849 957 procedure CreateMap(preview: boolean); 850 958 const 851 ShHiHills=6; {of land} 852 ShMountains=6; {of land} 853 ShRandHills=12; {of land} 854 ShTestRiver=40; 855 ShSwamp=25; {of grassland} 856 MinRivLen=3; 857 unification=70; 858 hotunification=50; // min. 25 859 860 Zone:array[0..3,2..9] of single= {terrain distribution} 861 ((0.25,0, 0, 0.4 ,0,0,0,0.35), 862 (0.55,0, 0.1 ,0, 0,0,0,0.35), 863 (0.4, 0, 0.35,0, 0,0,0,0.25), 864 (0, 0.7, 0, 0, 0,0,0,0.3)); 865 {Grs Dst Pra Tun - - - For} 866 867 function RndLow(y:integer):Cardinal; 868 {random lowland appropriate to climate} 959 ShHiHills = 6; { of land } 960 ShMountains = 6; { of land } 961 ShRandHills = 12; { of land } 962 ShTestRiver = 40; 963 ShSwamp = 25; { of grassland } 964 MinRivLen = 3; 965 unification = 70; 966 hotunification = 50; // min. 25 967 968 Zone: array [0 .. 3, 2 .. 9] of single = { terrain distribution } 969 ((0.25, 0, 0, 0.4, 0, 0, 0, 0.35), (0.55, 0, 0.1, 0, 0, 0, 0, 0.35), 970 (0.4, 0, 0.35, 0, 0, 0, 0, 0.25), (0, 0.7, 0, 0, 0, 0, 0, 0.3)); 971 { Grs Dst Pra Tun - - - For } 972 973 function RndLow(y: integer): Cardinal; 974 { random lowland appropriate to climate } 869 975 var 870 z0,i:integer; 871 p,p0,ZPlus:single; 872 begin 873 if ly-1-y>y then begin z0:=6*y div ly;ZPlus:=6*y/ly -z0 end 874 else begin z0:=6*(ly-1-y) div ly;ZPlus:=6*(ly-1-y)/ly -z0 end; 875 p0:=1; 876 for i:=2 to 9 do 877 begin 878 p:=Zone[z0,i]*(1-ZPlus)+Zone[z0+1,i]*ZPlus; 879 {weight between zones z0 and z0+1} 880 if Random*p0<p then begin RndLow:=i;Break end; 881 p0:=p0-p 976 z0, i: integer; 977 p, p0, ZPlus: single; 978 begin 979 if ly - 1 - y > y then 980 begin 981 z0 := 6 * y div ly; 982 ZPlus := 6 * y / ly - z0 983 end 984 else 985 begin 986 z0 := 6 * (ly - 1 - y) div ly; 987 ZPlus := 6 * (ly - 1 - y) / ly - z0 988 end; 989 p0 := 1; 990 for i := 2 to 9 do 991 begin 992 p := Zone[z0, i] * (1 - ZPlus) + Zone[z0 + 1, i] * ZPlus; 993 { weight between zones z0 and z0+1 } 994 if Random * p0 < p then 995 begin 996 RndLow := i; 997 Break 998 end; 999 p0 := p0 - p 882 1000 end; 883 1001 end; 884 1002 885 1003 function RunRiver(Loc0: integer): integer; 886 { runs river from start point Loc0; return value: length}1004 { runs river from start point Loc0; return value: length } 887 1005 var 888 Dir,T,Loc,Loc1,Cost: integer;889 Q: TIPQ;890 From: array[0..lxmax*lymax-1] of integer;891 Time: array[0..lxmax*lymax-1] of integer;892 OneTileLake: boolean;893 begin 894 FillChar(Time,SizeOf(Time),255); {-1}895 Q:=TIPQ.Create(MapSize);896 Q.Put(Loc0,0);897 while Q.Get(Loc,T) and (RealMap[Loc] and fRiver=0) do898 begin 899 if (RealMap[Loc] and fTerrain<fGrass) then900 begin 901 OneTileLake:=true;902 for Dir:=0 to 3 do903 begin 904 Loc1:=dLoc(Loc,Dir and 1 *2 -1,Dir shr 1 *2 -1);905 if (Loc1>=0) and (RealMap[Loc1] and fTerrain<fGrass) then906 OneTileLake:=false;1006 Dir, T, Loc, Loc1, Cost: integer; 1007 Q: TIPQ; 1008 From: array [0 .. lxmax * lymax - 1] of integer; 1009 Time: array [0 .. lxmax * lymax - 1] of integer; 1010 OneTileLake: boolean; 1011 begin 1012 FillChar(Time, SizeOf(Time), 255); { -1 } 1013 Q := TIPQ.Create(MapSize); 1014 Q.Put(Loc0, 0); 1015 while Q.Get(Loc, T) and (RealMap[Loc] and fRiver = 0) do 1016 begin 1017 if (RealMap[Loc] and fTerrain < fGrass) then 1018 begin 1019 OneTileLake := true; 1020 for Dir := 0 to 3 do 1021 begin 1022 Loc1 := dLoc(Loc, Dir and 1 * 2 - 1, Dir shr 1 * 2 - 1); 1023 if (Loc1 >= 0) and (RealMap[Loc1] and fTerrain < fGrass) then 1024 OneTileLake := false; 907 1025 end; 908 if not OneTileLake then Break; 909 end; 910 Time[Loc]:=T; 911 for Dir:=0 to 3 do 912 begin 913 Loc1:=dLoc(Loc,Dir and 1 *2 -1,Dir shr 1 *2 -1); 914 if (Loc1>=lx) and (Loc1<lx*(ly-1)) and (Time[Loc1]<0) then 915 begin 916 if RealMap[Loc1] and fRiver=0 then 1026 if not OneTileLake then 1027 Break; 1028 end; 1029 Time[Loc] := T; 1030 for Dir := 0 to 3 do 1031 begin 1032 Loc1 := dLoc(Loc, Dir and 1 * 2 - 1, Dir shr 1 * 2 - 1); 1033 if (Loc1 >= lx) and (Loc1 < lx * (ly - 1)) and (Time[Loc1] < 0) then 1034 begin 1035 if RealMap[Loc1] and fRiver = 0 then 917 1036 begin 918 Cost:=Elevation[Loc1]-Elevation[Loc]; 919 if Cost<0 then Cost:=0; 1037 Cost := Elevation[Loc1] - Elevation[Loc]; 1038 if Cost < 0 then 1039 Cost := 0; 920 1040 end 921 else Cost:=0; 922 if Q.Put(Loc1,T+Cost shl 8+1) then From[Loc1]:=Loc 1041 else 1042 Cost := 0; 1043 if Q.Put(Loc1, T + Cost shl 8 + 1) then 1044 From[Loc1] := Loc 923 1045 end 924 1046 end 925 1047 end; 926 Loc1:=Loc; 927 result:=0; 928 while Loc<>Loc0 do begin Loc:=From[Loc]; inc(result); end; 929 if (result>1) and ((result>=MinRivLen) or (RealMap[Loc1] and fTerrain>=fGrass)) then 930 begin 931 Loc:=Loc1; 932 while Loc<>Loc0 do 933 begin 934 Loc:=From[Loc]; 935 if RealMap[Loc] and fTerrain in [fHills,fMountains] then 936 RealMap[Loc]:=fGrass or fRiver 937 else if RealMap[Loc] and fTerrain>=fGrass then 938 RealMap[Loc]:=RealMap[Loc] or fRiver; 1048 Loc1 := Loc; 1049 result := 0; 1050 while Loc <> Loc0 do 1051 begin 1052 Loc := From[Loc]; 1053 inc(result); 1054 end; 1055 if (result > 1) and ((result >= MinRivLen) or 1056 (RealMap[Loc1] and fTerrain >= fGrass)) then 1057 begin 1058 Loc := Loc1; 1059 while Loc <> Loc0 do 1060 begin 1061 Loc := From[Loc]; 1062 if RealMap[Loc] and fTerrain in [fHills, fMountains] then 1063 RealMap[Loc] := fGrass or fRiver 1064 else if RealMap[Loc] and fTerrain >= fGrass then 1065 RealMap[Loc] := RealMap[Loc] or fRiver; 939 1066 end 940 1067 end 941 else result:=0; 942 Q.Free 943 end; 944 945 var 946 x,y,n,Dir,plus,Count,Loc0,Loc1,bLand,bHills,bMountains,V8: integer; 947 CopyFrom: array[0..lxmax*lymax-1] of integer; 948 Adjacent: TVicinity8Loc; 949 950 begin 951 FillChar(RealMap,MapSize*4,0); 952 plus:=0; 953 bMountains:=256; 954 while plus<MapSize*LandMass*ShMountains div 10000 do 955 begin dec(bMountains);inc(plus,ElCount[bMountains]) end; 956 Count:=plus; 957 plus:=0; 958 bHills:=bMountains; 959 while plus<MapSize*LandMass*ShHiHills div 10000 do 960 begin dec(bHills);inc(plus,ElCount[bHills]) end; 961 inc(Count,plus); 962 bLand:=bHills; 963 while Count<MapSize*LandMass div 100 do 964 begin dec(bLand);inc(Count,ElCount[bLand]) end; 965 966 for Loc0:=lx to lx*(ly-1)-1 do 967 if Elevation[Loc0]>=bMountains then RealMap[Loc0]:=fMountains 968 else if Elevation[Loc0]>=bHills then RealMap[Loc0]:=fHills 969 else if Elevation[Loc0]>=bLand then RealMap[Loc0]:=fGrass; 970 971 // remove one-tile islands 972 for Loc0:=0 to MapSize-1 do 973 if RealMap[Loc0]>=fGrass then 974 begin 975 Count:=0; 976 V8_to_Loc(Loc0,Adjacent); 977 for V8:=0 to 7 do 978 begin 979 Loc1:=Adjacent[V8]; 980 if (Loc1<0) or (Loc1>=MapSize) 981 or (RealMap[Loc1] and fTerrain<fGrass) 982 or (RealMap[Loc1] and fTerrain=fArctic) then 983 inc(Count); // count adjacent water 984 end; 985 if Count=8 then RealMap[Loc0]:=fOcean 986 end; 987 988 if not preview then 989 begin 990 plus:=36*56*20*ShTestRiver div (LandMass*100); 991 if plus>MapSize then plus:=MapSize; 992 Loc0:=Random(MapSize); 993 for n:=0 to plus-1 do 994 begin 995 if (RealMap[Loc0] and fTerrain>=fGrass) and (Loc0>=lx) and (Loc0<MapSize-lx) then 996 RunRiver(Loc0); 997 Loc0:=(Loc0+1)*primitive mod (MapSize+1) -1; 998 end; 999 end; 1000 1001 for Loc0:=0 to MapSize-1 do 1002 if (RealMap[Loc0]=fGrass) and (Random(100)<ShRandHills) then 1003 RealMap[Loc0]:=RealMap[Loc0] or fHills; 1004 1005 // make terrain types coherent 1006 for Loc0:=0 to MapSize-1 do CopyFrom[Loc0]:=Loc0; 1007 1008 for n:=0 to unification*MapSize div 100 do 1009 begin 1010 y:=Random(ly); 1011 if abs(y-(ly shr 1))>ly div 4+Random(ly*hotunification div 100) then 1012 if y<ly shr 1 then y:=ly shr 1-y 1013 else y:=3*ly shr 1-y; 1014 Loc0:=lx*y+Random(lx); 1015 if RealMap[Loc0] and fTerrain=fGrass then 1016 begin 1017 Dir:=Random(4); 1018 Loc1:=dLoc(Loc0,Dir and 1 *2 -1,Dir shr 1 *2 -1); 1019 if (Loc1>=0) and (RealMap[Loc1] and fTerrain=fGrass) then 1020 begin 1021 while CopyFrom[Loc0]<>Loc0 do Loc0:=CopyFrom[Loc0]; 1022 while CopyFrom[Loc1]<>Loc1 do Loc1:=CopyFrom[Loc1]; 1023 if Loc1<Loc0 then CopyFrom[Loc0]:=Loc1 1024 else CopyFrom[Loc1]:=Loc0; 1025 end; 1026 end; 1027 end; 1028 1029 for Loc0:=0 to MapSize-1 do 1030 if (RealMap[Loc0] and fTerrain=fGrass) and (CopyFrom[Loc0]=Loc0) then 1031 RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or RndLow(Loc0 div lx); 1032 1033 for Loc0:=0 to MapSize-1 do 1034 if RealMap[Loc0] and fTerrain=fGrass then 1035 begin 1036 Loc1:=Loc0; 1037 while CopyFrom[Loc1]<>Loc1 do Loc1:=CopyFrom[Loc1]; 1038 RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or RealMap[Loc1] and fTerrain 1039 end; 1040 1041 for Loc0:=0 to MapSize-1 do 1042 if RealMap[Loc0] and fTerrain=fGrass then 1068 else 1069 result := 0; 1070 Q.Free 1071 end; 1072 1073 var 1074 x, y, n, Dir, plus, Count, Loc0, Loc1, bLand, bHills, bMountains, V8: integer; 1075 CopyFrom: array [0 .. lxmax * lymax - 1] of integer; 1076 Adjacent: TVicinity8Loc; 1077 1078 begin 1079 FillChar(RealMap, MapSize * 4, 0); 1080 plus := 0; 1081 bMountains := 256; 1082 while plus < MapSize * LandMass * ShMountains div 10000 do 1083 begin 1084 dec(bMountains); 1085 inc(plus, ElCount[bMountains]) 1086 end; 1087 Count := plus; 1088 plus := 0; 1089 bHills := bMountains; 1090 while plus < MapSize * LandMass * ShHiHills div 10000 do 1091 begin 1092 dec(bHills); 1093 inc(plus, ElCount[bHills]) 1094 end; 1095 inc(Count, plus); 1096 bLand := bHills; 1097 while Count < MapSize * LandMass div 100 do 1098 begin 1099 dec(bLand); 1100 inc(Count, ElCount[bLand]) 1101 end; 1102 1103 for Loc0 := lx to lx * (ly - 1) - 1 do 1104 if Elevation[Loc0] >= bMountains then 1105 RealMap[Loc0] := fMountains 1106 else if Elevation[Loc0] >= bHills then 1107 RealMap[Loc0] := fHills 1108 else if Elevation[Loc0] >= bLand then 1109 RealMap[Loc0] := fGrass; 1110 1111 // remove one-tile islands 1112 for Loc0 := 0 to MapSize - 1 do 1113 if RealMap[Loc0] >= fGrass then 1114 begin 1115 Count := 0; 1116 V8_to_Loc(Loc0, Adjacent); 1117 for V8 := 0 to 7 do 1118 begin 1119 Loc1 := Adjacent[V8]; 1120 if (Loc1 < 0) or (Loc1 >= MapSize) or 1121 (RealMap[Loc1] and fTerrain < fGrass) or 1122 (RealMap[Loc1] and fTerrain = fArctic) then 1123 inc(Count); // count adjacent water 1124 end; 1125 if Count = 8 then 1126 RealMap[Loc0] := fOcean 1127 end; 1128 1129 if not preview then 1130 begin 1131 plus := 36 * 56 * 20 * ShTestRiver div (LandMass * 100); 1132 if plus > MapSize then 1133 plus := MapSize; 1134 Loc0 := Random(MapSize); 1135 for n := 0 to plus - 1 do 1136 begin 1137 if (RealMap[Loc0] and fTerrain >= fGrass) and (Loc0 >= lx) and 1138 (Loc0 < MapSize - lx) then 1139 RunRiver(Loc0); 1140 Loc0 := (Loc0 + 1) * primitive mod (MapSize + 1) - 1; 1141 end; 1142 end; 1143 1144 for Loc0 := 0 to MapSize - 1 do 1145 if (RealMap[Loc0] = fGrass) and (Random(100) < ShRandHills) then 1146 RealMap[Loc0] := RealMap[Loc0] or fHills; 1147 1148 // make terrain types coherent 1149 for Loc0 := 0 to MapSize - 1 do 1150 CopyFrom[Loc0] := Loc0; 1151 1152 for n := 0 to unification * MapSize div 100 do 1153 begin 1154 y := Random(ly); 1155 if abs(y - (ly shr 1)) > ly div 4 + Random(ly * hotunification div 100) then 1156 if y < ly shr 1 then 1157 y := ly shr 1 - y 1158 else 1159 y := 3 * ly shr 1 - y; 1160 Loc0 := lx * y + Random(lx); 1161 if RealMap[Loc0] and fTerrain = fGrass then 1162 begin 1163 Dir := Random(4); 1164 Loc1 := dLoc(Loc0, Dir and 1 * 2 - 1, Dir shr 1 * 2 - 1); 1165 if (Loc1 >= 0) and (RealMap[Loc1] and fTerrain = fGrass) then 1166 begin 1167 while CopyFrom[Loc0] <> Loc0 do 1168 Loc0 := CopyFrom[Loc0]; 1169 while CopyFrom[Loc1] <> Loc1 do 1170 Loc1 := CopyFrom[Loc1]; 1171 if Loc1 < Loc0 then 1172 CopyFrom[Loc0] := Loc1 1173 else 1174 CopyFrom[Loc1] := Loc0; 1175 end; 1176 end; 1177 end; 1178 1179 for Loc0 := 0 to MapSize - 1 do 1180 if (RealMap[Loc0] and fTerrain = fGrass) and (CopyFrom[Loc0] = Loc0) then 1181 RealMap[Loc0] := RealMap[Loc0] and not fTerrain or RndLow(Loc0 div lx); 1182 1183 for Loc0 := 0 to MapSize - 1 do 1184 if RealMap[Loc0] and fTerrain = fGrass then 1185 begin 1186 Loc1 := Loc0; 1187 while CopyFrom[Loc1] <> Loc1 do 1188 Loc1 := CopyFrom[Loc1]; 1189 RealMap[Loc0] := RealMap[Loc0] and not fTerrain or 1190 RealMap[Loc1] and fTerrain 1191 end; 1192 1193 for Loc0 := 0 to MapSize - 1 do 1194 if RealMap[Loc0] and fTerrain = fGrass then 1043 1195 begin // change grassland to swamp 1044 if Random(100)<ShSwamp then 1045 RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or fSwamp; 1046 end; 1047 1048 for Loc0:=0 to MapSize-1 do // change desert to prairie 1 1049 if RealMap[Loc0] and fTerrain=fDesert then 1050 begin 1051 if RealMap[Loc0] and fRiver<>0 then Count:=5 1052 else 1053 begin 1054 Count:=0; 1055 for Dir:=0 to 3 do 1056 begin 1057 Loc1:=dLoc(Loc0,Dir and 1 *2 -1,Dir shr 1 *2 -1); 1058 if Loc1>=0 then 1059 if RealMap[Loc1] and fTerrain<fGrass then inc(Count,2) 1196 if Random(100) < ShSwamp then 1197 RealMap[Loc0] := RealMap[Loc0] and not fTerrain or fSwamp; 1198 end; 1199 1200 for Loc0 := 0 to MapSize - 1 do // change desert to prairie 1 1201 if RealMap[Loc0] and fTerrain = fDesert then 1202 begin 1203 if RealMap[Loc0] and fRiver <> 0 then 1204 Count := 5 1205 else 1206 begin 1207 Count := 0; 1208 for Dir := 0 to 3 do 1209 begin 1210 Loc1 := dLoc(Loc0, Dir and 1 * 2 - 1, Dir shr 1 * 2 - 1); 1211 if Loc1 >= 0 then 1212 if RealMap[Loc1] and fTerrain < fGrass then 1213 inc(Count, 2) 1060 1214 end; 1061 1215 end; 1062 if Count>=4 then RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or fPrairie 1063 end; 1064 1065 for Loc0:=0 to MapSize-1 do // change desert to prairie 2 1066 if RealMap[Loc0] and fTerrain=fDesert then 1067 begin 1068 Count:=0; 1069 for Dir:=0 to 3 do 1070 begin 1071 Loc1:=dLoc(Loc0,Dir and 1 *2 -1,Dir shr 1 *2 -1); 1072 if Loc1>=0 then 1073 if RealMap[Loc1] and fTerrain<>fDesert then inc(Count) 1074 end; 1075 if Count>=4 then RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or fPrairie 1076 end; 1077 1078 for Loc0:=0 to MapSize-1 do CheckShore(Loc0); // change ocean to shore 1079 for x:=0 to lx-1 do 1080 begin 1081 RealMap[x+lx*0]:=fArctic; 1082 if RealMap[x+lx*1]>=fGrass then 1083 RealMap[x+lx*1]:=RealMap[x+lx*1] and not fTerrain or fTundra; 1084 if RealMap[x+lx*(ly-2)]>=fGrass then 1085 RealMap[x+lx*(ly-2)]:=RealMap[x+lx*(ly-2)] and not fTerrain or fTundra; 1086 RealMap[x+lx*(ly-1)]:=fArctic 1087 end; 1088 1089 for Loc0:=0 to MapSize-1 do //define special terrain tiles 1090 RealMap[Loc0]:=RealMap[Loc0] or ActualSpecialTile(Loc0) shl 5 or ($F shl 27); 1091 1092 if not preview then 1093 begin FindContinents; RarePositions; end; 1216 if Count >= 4 then 1217 RealMap[Loc0] := RealMap[Loc0] and not fTerrain or fPrairie 1218 end; 1219 1220 for Loc0 := 0 to MapSize - 1 do // change desert to prairie 2 1221 if RealMap[Loc0] and fTerrain = fDesert then 1222 begin 1223 Count := 0; 1224 for Dir := 0 to 3 do 1225 begin 1226 Loc1 := dLoc(Loc0, Dir and 1 * 2 - 1, Dir shr 1 * 2 - 1); 1227 if Loc1 >= 0 then 1228 if RealMap[Loc1] and fTerrain <> fDesert then 1229 inc(Count) 1230 end; 1231 if Count >= 4 then 1232 RealMap[Loc0] := RealMap[Loc0] and not fTerrain or fPrairie 1233 end; 1234 1235 for Loc0 := 0 to MapSize - 1 do 1236 CheckShore(Loc0); // change ocean to shore 1237 for x := 0 to lx - 1 do 1238 begin 1239 RealMap[x + lx * 0] := fArctic; 1240 if RealMap[x + lx * 1] >= fGrass then 1241 RealMap[x + lx * 1] := RealMap[x + lx * 1] and not fTerrain or fTundra; 1242 if RealMap[x + lx * (ly - 2)] >= fGrass then 1243 RealMap[x + lx * (ly - 2)] := RealMap[x + lx * (ly - 2)] and 1244 not fTerrain or fTundra; 1245 RealMap[x + lx * (ly - 1)] := fArctic 1246 end; 1247 1248 for Loc0 := 0 to MapSize - 1 do // define special terrain tiles 1249 RealMap[Loc0] := RealMap[Loc0] or ActualSpecialTile(Loc0) shl 5 or 1250 ($F shl 27); 1251 1252 if not preview then 1253 begin 1254 FindContinents; 1255 RarePositions; 1256 end; 1094 1257 end; 1095 1258 … … 1099 1262 1100 1263 var 1101 CountGood:(cgBest,cgFlat,cgLand);1264 CountGood: (cgBest, cgFlat, cgLand); 1102 1265 1103 1266 function IsGoodTile(Loc: integer): boolean; 1104 1267 var 1105 xLoc,yLoc: integer; 1106 begin 1107 xLoc:=Loc mod lx; yLoc:=Loc div lx; 1108 if RealMap[Loc] and fDeadLands<>0 then result:=false 1109 else 1110 case CountGood of 1111 cgBest: 1112 result:=(RealMap[Loc] and fTerrain in [fGrass,fPrairie,fTundra,fSwamp,fForest]) 1113 and Odd((lymax+xLoc-yLoc shr 1) shr 1+xLoc+(yLoc+1) shr 1); 1114 cgFlat: 1115 result:=(RealMap[Loc] and fTerrain in [fGrass,fPrairie,fTundra,fSwamp,fForest]); 1116 cgLand: 1117 result:= RealMap[Loc] and fTerrain>=fGrass; 1268 xLoc, yLoc: integer; 1269 begin 1270 xLoc := Loc mod lx; 1271 yLoc := Loc div lx; 1272 if RealMap[Loc] and fDeadLands <> 0 then 1273 result := false 1274 else 1275 case CountGood of 1276 cgBest: 1277 result := (RealMap[Loc] and fTerrain in [fGrass, fPrairie, fTundra, 1278 fSwamp, fForest]) and Odd((lymax + xLoc - yLoc shr 1) shr 1 + xLoc + 1279 (yLoc + 1) shr 1); 1280 cgFlat: 1281 result := (RealMap[Loc] and fTerrain in [fGrass, fPrairie, fTundra, 1282 fSwamp, fForest]); 1283 cgLand: 1284 result := RealMap[Loc] and fTerrain >= fGrass; 1118 1285 end; 1119 1286 end; 1120 1287 1121 1288 const 1122 MaxCityLoc=64; 1123 1124 var 1125 p1,p2,nAlive,c,Loc,Loc1,CntGood,CntGoodGrass,MinDist,Tries,i,j,n,nsc,TestLoc, 1126 V21,V8,BestDist,TestDist,MinGood,nIrrLoc,xLoc,yLoc,qx,qy,FineDistSQR, 1127 nRest:integer; 1128 ccount:array[0..lxmax*lymax-1] of word; 1129 sc,StartLoc0,sccount: array[1..nPl] of integer; 1130 TestStartLoc: array[0..nPl-1] of integer; 1131 CityLoc: array[1..nPl,0..MaxCityLoc-1] of integer; 1132 nCityLoc: array[1..nPl] of integer; 1133 RestLoc: array[0..MaxCityLoc-1] of integer; 1134 IrrLoc: array[0..20] of integer; 1135 Radius: TVicinity21Loc; 1136 Adjacent: TVicinity8Loc; 1137 ok: boolean; 1138 1139 begin 1140 nAlive:=0; 1141 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then inc(nAlive); 1142 if nAlive=0 then exit; 1143 1144 {count good tiles} 1145 FillChar(ccount,MapSize*2,0); 1146 for Loc:=0 to MapSize-1 do 1147 if RealMap[Loc] and fTerrain=fGrass then 1148 if ActualSpecialTile(Loc)=1 then inc(ccount[Continent[Loc]],3) 1149 else inc(ccount[Continent[Loc]],2) 1150 else if RealMap[Loc] and fTerrain in [fPrairie,fSwamp,fForest,fHills] then 1151 inc(ccount[Continent[Loc]]); 1152 1153 Loc:=0;while ccount[Loc]>0 do inc(Loc); 1154 for i:=1 to nAlive do begin sc[i]:=Loc; sccount[i]:=1 end; 1155 {init with zero size start continents, then search bigger ones} 1156 for Loc:=0 to MapSize-1 do if ccount[Loc]>0 then 1157 begin // search biggest continents 1158 p1:=nAlive+1; 1159 while (p1>1) and (ccount[Loc]>ccount[sc[p1-1]]) do 1160 begin if p1<nAlive+1 then sc[p1]:=sc[p1-1]; dec(p1) end; 1161 if p1<nAlive+1 then sc[p1]:=Loc; 1162 end; 1163 nsc:=nAlive; 1164 repeat 1165 c:=1; // search least crowded continent after smallest 1166 for i:=2 to nsc-1 do 1167 if ccount[sc[i]]*(2*sccount[c]+1)>ccount[sc[c]]*(2*sccount[i]+1) then 1168 c:=i; 1169 if ccount[sc[nsc]]*(2*sccount[c]+1)>ccount[sc[c]] then 1170 Break; // even least crowded continent is more crowded than smallest 1171 inc(sccount[c]); 1172 dec(nsc) 1173 until sccount[nsc]>1; 1174 1175 MinGood:=7; 1176 CountGood:=cgBest; 1177 repeat 1178 dec(MinGood); 1179 if (MinGood=3) and (CountGood<cgLand) then // too demanding! 1180 begin inc(CountGood); MinGood:=6 end; 1181 FillChar(nCityLoc,SizeOf(nCityLoc),0); 1182 Loc:=Random(MapSize); 1183 for i:=0 to MapSize-1 do 1184 begin 1185 if ((Loc>=4*lx) and (Loc<MapSize-4*lx) or (CountGood>=cgLand)) 1186 and IsGoodTile(Loc) then 1187 begin 1188 c:=nsc; 1189 while (c>0) and (Continent[Loc]<>sc[c]) do dec(c); 1190 if (c>0) and (nCityLoc[c]<MaxCityLoc) then 1191 begin 1192 CntGood:=1; 1193 V21_to_Loc(Loc,Radius); 1194 for V21:=1 to 26 do if V21<>CityOwnTile then 1289 MaxCityLoc = 64; 1290 1291 var 1292 p1, p2, nAlive, c, Loc, Loc1, CntGood, CntGoodGrass, MinDist, Tries, i, j, n, 1293 nsc, TestLoc, V21, V8, BestDist, TestDist, MinGood, nIrrLoc, xLoc, yLoc, qx, 1294 qy, FineDistSQR, nRest: integer; 1295 ccount: array [0 .. lxmax * lymax - 1] of word; 1296 sc, StartLoc0, sccount: array [1 .. nPl] of integer; 1297 TestStartLoc: array [0 .. nPl - 1] of integer; 1298 CityLoc: array [1 .. nPl, 0 .. MaxCityLoc - 1] of integer; 1299 nCityLoc: array [1 .. nPl] of integer; 1300 RestLoc: array [0 .. MaxCityLoc - 1] of integer; 1301 IrrLoc: array [0 .. 20] of integer; 1302 Radius: TVicinity21Loc; 1303 Adjacent: TVicinity8Loc; 1304 ok: boolean; 1305 1306 begin 1307 nAlive := 0; 1308 for p1 := 0 to nPl - 1 do 1309 if 1 shl p1 and GAlive <> 0 then 1310 inc(nAlive); 1311 if nAlive = 0 then 1312 exit; 1313 1314 { count good tiles } 1315 FillChar(ccount, MapSize * 2, 0); 1316 for Loc := 0 to MapSize - 1 do 1317 if RealMap[Loc] and fTerrain = fGrass then 1318 if ActualSpecialTile(Loc) = 1 then 1319 inc(ccount[Continent[Loc]], 3) 1320 else 1321 inc(ccount[Continent[Loc]], 2) 1322 else if RealMap[Loc] and fTerrain in [fPrairie, fSwamp, fForest, fHills] 1323 then 1324 inc(ccount[Continent[Loc]]); 1325 1326 Loc := 0; 1327 while ccount[Loc] > 0 do 1328 inc(Loc); 1329 for i := 1 to nAlive do 1330 begin 1331 sc[i] := Loc; 1332 sccount[i] := 1 1333 end; 1334 { init with zero size start continents, then search bigger ones } 1335 for Loc := 0 to MapSize - 1 do 1336 if ccount[Loc] > 0 then 1337 begin // search biggest continents 1338 p1 := nAlive + 1; 1339 while (p1 > 1) and (ccount[Loc] > ccount[sc[p1 - 1]]) do 1340 begin 1341 if p1 < nAlive + 1 then 1342 sc[p1] := sc[p1 - 1]; 1343 dec(p1) 1344 end; 1345 if p1 < nAlive + 1 then 1346 sc[p1] := Loc; 1347 end; 1348 nsc := nAlive; 1349 repeat 1350 c := 1; // search least crowded continent after smallest 1351 for i := 2 to nsc - 1 do 1352 if ccount[sc[i]] * (2 * sccount[c] + 1) > ccount[sc[c]] * 1353 (2 * sccount[i] + 1) then 1354 c := i; 1355 if ccount[sc[nsc]] * (2 * sccount[c] + 1) > ccount[sc[c]] then 1356 Break; // even least crowded continent is more crowded than smallest 1357 inc(sccount[c]); 1358 dec(nsc) 1359 until sccount[nsc] > 1; 1360 1361 MinGood := 7; 1362 CountGood := cgBest; 1363 repeat 1364 dec(MinGood); 1365 if (MinGood = 3) and (CountGood < cgLand) then // too demanding! 1366 begin 1367 inc(CountGood); 1368 MinGood := 6 1369 end; 1370 FillChar(nCityLoc, SizeOf(nCityLoc), 0); 1371 Loc := Random(MapSize); 1372 for i := 0 to MapSize - 1 do 1373 begin 1374 if ((Loc >= 4 * lx) and (Loc < MapSize - 4 * lx) or (CountGood >= cgLand)) 1375 and IsGoodTile(Loc) then 1376 begin 1377 c := nsc; 1378 while (c > 0) and (Continent[Loc] <> sc[c]) do 1379 dec(c); 1380 if (c > 0) and (nCityLoc[c] < MaxCityLoc) then 1381 begin 1382 CntGood := 1; 1383 V21_to_Loc(Loc, Radius); 1384 for V21 := 1 to 26 do 1385 if V21 <> CityOwnTile then 1386 begin 1387 Loc1 := Radius[V21]; 1388 if (Loc1 >= 0) and (Loc1 < MapSize) and IsGoodTile(Loc1) then 1389 inc(CntGood) 1390 end; 1391 if CntGood >= MinGood then 1195 1392 begin 1196 Loc1:=Radius[V21]; 1197 if (Loc1>=0) and (Loc1<MapSize) and IsGoodTile(Loc1) then 1198 inc(CntGood) 1199 end; 1200 if CntGood>=MinGood then 1201 begin 1202 CityLoc[c,nCityLoc[c]]:=Loc; 1203 inc(nCityLoc[c]) 1393 CityLoc[c, nCityLoc[c]] := Loc; 1394 inc(nCityLoc[c]) 1204 1395 end 1205 1396 end 1206 1397 end; 1207 Loc:=(Loc+1)*primitive mod (MapSize+1) -1; 1208 end; 1209 1210 ok:=true; 1211 for c:=1 to nsc do 1212 if nCityLoc[c]<sccount[c]*(8-MinGood) div (7-MinGood) then ok:=false; 1213 until ok; 1214 1215 FineDistSQR:=MapSize*LandMass*9 div (nAlive*100); 1216 p1:=1; 1217 for c:=1 to nsc do 1398 Loc := (Loc + 1) * primitive mod (MapSize + 1) - 1; 1399 end; 1400 1401 ok := true; 1402 for c := 1 to nsc do 1403 if nCityLoc[c] < sccount[c] * (8 - MinGood) div (7 - MinGood) then 1404 ok := false; 1405 until ok; 1406 1407 FineDistSQR := MapSize * LandMass * 9 div (nAlive * 100); 1408 p1 := 1; 1409 for c := 1 to nsc do 1218 1410 begin // for all start continents 1219 if sccount[c]=1 then StartLoc0[p1]:=CityLoc[c,Random(nCityLoc[c])] 1220 else 1221 begin 1222 BestDist:=0; 1223 n:=1 shl sccount[c] *32; // number of tries to find good distribution 1224 if n>1 shl 12 then n:=1 shl 12; 1225 while (n>0) and (BestDist*BestDist<FineDistSQR) do 1226 begin 1227 MinDist:=MaxInt; 1228 nRest:=nCityLoc[c]; 1229 for i:=0 to nRest-1 do RestLoc[i]:=CityLoc[c,i]; 1230 for i:=0 to sccount[c]-1 do 1231 begin 1232 if nRest=0 then break; 1233 j:=Random(nRest); 1234 TestStartLoc[i]:=RestLoc[j]; 1235 RestLoc[j]:=RestLoc[nRest-1]; 1236 dec(nRest); 1237 for j:=0 to i-1 do 1411 if sccount[c] = 1 then 1412 StartLoc0[p1] := CityLoc[c, Random(nCityLoc[c])] 1413 else 1414 begin 1415 BestDist := 0; 1416 n := 1 shl sccount[c] * 32; // number of tries to find good distribution 1417 if n > 1 shl 12 then 1418 n := 1 shl 12; 1419 while (n > 0) and (BestDist * BestDist < FineDistSQR) do 1420 begin 1421 MinDist := MaxInt; 1422 nRest := nCityLoc[c]; 1423 for i := 0 to nRest - 1 do 1424 RestLoc[i] := CityLoc[c, i]; 1425 for i := 0 to sccount[c] - 1 do 1426 begin 1427 if nRest = 0 then 1428 Break; 1429 j := Random(nRest); 1430 TestStartLoc[i] := RestLoc[j]; 1431 RestLoc[j] := RestLoc[nRest - 1]; 1432 dec(nRest); 1433 for j := 0 to i - 1 do 1238 1434 begin 1239 TestDist:=Distance(TestStartLoc[i],TestStartLoc[j]); 1240 if TestDist<MinDist then MinDist:=TestDist 1435 TestDist := Distance(TestStartLoc[i], TestStartLoc[j]); 1436 if TestDist < MinDist then 1437 MinDist := TestDist 1241 1438 end; 1242 if i=sccount[c]-1 then1439 if i = sccount[c] - 1 then 1243 1440 begin 1244 assert(MinDist>BestDist); 1245 BestDist:=MinDist; 1246 for j:=0 to sccount[c]-1 do StartLoc0[p1+j]:=TestStartLoc[j]; 1441 assert(MinDist > BestDist); 1442 BestDist := MinDist; 1443 for j := 0 to sccount[c] - 1 do 1444 StartLoc0[p1 + j] := TestStartLoc[j]; 1247 1445 end 1248 else if BestDist>0 then1446 else if BestDist > 0 then 1249 1447 begin 1250 j:=0;1251 while j<nRest do1448 j := 0; 1449 while j < nRest do 1252 1450 begin // remove all locs from rest which have too little distance to this one 1253 TestDist:=Distance(TestStartLoc[i],RestLoc[j]); 1254 if TestDist<=BestDist then 1255 begin RestLoc[j]:=RestLoc[nRest-1]; dec(nRest); end 1256 else inc(j); 1451 TestDist := Distance(TestStartLoc[i], RestLoc[j]); 1452 if TestDist <= BestDist then 1453 begin 1454 RestLoc[j] := RestLoc[nRest - 1]; 1455 dec(nRest); 1456 end 1457 else 1458 inc(j); 1257 1459 end; 1258 1460 end; 1259 1461 end; 1260 dec(n) 1261 end; 1262 end; 1263 p1:=p1+sccount[c] 1264 end; 1265 1266 // make start locs fertile 1267 for p1:=1 to nAlive do 1268 begin 1269 RealMap[StartLoc0[p1]]:=RealMap[StartLoc0[p1]] and not (fTerrain or fSpecial) 1270 or fGrass or fSpecial1; 1271 CntGood:=1; 1272 CntGoodGrass:=1; 1273 V21_to_Loc(StartLoc0[p1],Radius); 1274 for V21:=1 to 26 do if V21<>CityOwnTile then 1275 begin 1276 Loc1:=Radius[V21]; 1277 if (Loc1>=0) and (Loc1<MapSize) and IsGoodTile(Loc1) then 1278 if RealMap[Loc1] and fTerrain=fGrass then inc(CntGoodGrass) 1279 else inc(CntGood); 1280 end; 1281 for V21:=1 to 26 do if V21<>CityOwnTile then 1282 begin 1283 Loc1:=Radius[V21]; 1284 if (Loc1>=0) and (Loc1<MapSize) and (RealMap[Loc1] and fDeadLands=0) then 1285 if IsGoodTile(Loc1) and (random(CntGood)<MinGood-CntGoodGrass+1) then 1286 begin 1287 RealMap[Loc1]:=RealMap[Loc1] and not (fTerrain or fSpecial) or fGrass; 1288 RealMap[Loc1]:=RealMap[Loc1] or ActualSpecialTile(Loc1) shl 5; 1462 dec(n) 1463 end; 1464 end; 1465 p1 := p1 + sccount[c] 1466 end; 1467 1468 // make start locs fertile 1469 for p1 := 1 to nAlive do 1470 begin 1471 RealMap[StartLoc0[p1]] := RealMap[StartLoc0[p1]] and 1472 not(fTerrain or fSpecial) or fGrass or fSpecial1; 1473 CntGood := 1; 1474 CntGoodGrass := 1; 1475 V21_to_Loc(StartLoc0[p1], Radius); 1476 for V21 := 1 to 26 do 1477 if V21 <> CityOwnTile then 1478 begin 1479 Loc1 := Radius[V21]; 1480 if (Loc1 >= 0) and (Loc1 < MapSize) and IsGoodTile(Loc1) then 1481 if RealMap[Loc1] and fTerrain = fGrass then 1482 inc(CntGoodGrass) 1483 else 1484 inc(CntGood); 1485 end; 1486 for V21 := 1 to 26 do 1487 if V21 <> CityOwnTile then 1488 begin 1489 Loc1 := Radius[V21]; 1490 if (Loc1 >= 0) and (Loc1 < MapSize) and 1491 (RealMap[Loc1] and fDeadLands = 0) then 1492 if IsGoodTile(Loc1) and (Random(CntGood) < MinGood - CntGoodGrass + 1) 1493 then 1494 begin 1495 RealMap[Loc1] := RealMap[Loc1] and not(fTerrain or fSpecial) 1496 or fGrass; 1497 RealMap[Loc1] := RealMap[Loc1] or ActualSpecialTile(Loc1) shl 5; 1498 end 1499 else if RealMap[Loc1] and fTerrain = fDesert then 1500 RealMap[Loc1] := RealMap[Loc1] and not fTerrain or fPrairie 1501 else if (RealMap[Loc1] and fTerrain in [fPrairie, fTundra, fSwamp]) 1502 and (Random(2) = 0) then 1503 RealMap[Loc1] := RealMap[Loc1] and not fTerrain or fForest; 1504 end; 1505 1506 // first irrigation 1507 nIrrLoc := 0; 1508 for V21 := 1 to 26 do 1509 if V21 <> CityOwnTile then 1510 begin 1511 Loc1 := Radius[V21]; 1512 if (Loc1 >= 0) and (Loc1 < MapSize) and 1513 (RealMap[Loc1] and (fTerrain or fSpecial) = fGrass or fSpecial1) then 1514 begin 1515 IrrLoc[nIrrLoc] := Loc1; 1516 inc(nIrrLoc); 1517 end; 1518 end; 1519 i := 2; 1520 if i > nIrrLoc then 1521 i := nIrrLoc; 1522 while i > 0 do 1523 begin 1524 j := Random(nIrrLoc); 1525 RealMap[IrrLoc[j]] := RealMap[IrrLoc[j]] or tiIrrigation; 1526 IrrLoc[j] := IrrLoc[nIrrLoc - 1]; 1527 dec(nIrrLoc); 1528 dec(i) 1529 end; 1530 end; 1531 1532 StartLoc[0] := 0; 1533 for p1 := 0 to nPl - 1 do 1534 if 1 shl p1 and GAlive <> 0 then 1535 begin 1536 repeat 1537 i := Random(nAlive) + 1 1538 until StartLoc0[i] >= 0; 1539 StartLoc[p1] := StartLoc0[i]; 1540 StartLoc0[i] := -1 1541 end; 1542 SaveMapCenterLoc := StartLoc[0]; 1543 1544 // second unit starting position 1545 for p1 := 0 to nPl - 1 do 1546 if 1 shl p1 and GAlive <> 0 then 1547 begin 1548 StartLoc2[p1] := StartLoc[p1]; 1549 V8_to_Loc(StartLoc[p1], Adjacent); 1550 for V8 := 0 to 7 do 1551 begin 1552 Loc1 := Adjacent[V8]; 1553 for p2 := 0 to nPl - 1 do 1554 if (1 shl p2 and GAlive <> 0) and (StartLoc[p2] = Loc1) then 1555 Loc1 := -1; 1556 for p2 := 0 to p1 - 1 do 1557 if (1 shl p2 and GAlive <> 0) and (StartLoc2[p2] = Loc1) then 1558 Loc1 := -1; 1559 if (Loc1 < 0) or (Loc1 >= MapSize) or 1560 (RealMap[Loc1] and fTerrain in [fOcean, fShore, fDesert, fArctic, 1561 fMountains]) or (RealMap[Loc1] and fDeadLands <> 0) then 1562 TestDist := -1 1563 else if RealMap[Loc1] and fTerrain = fGrass then 1564 TestDist := 2 1565 else if Terrain[RealMap[Loc1] and fTerrain].IrrEff > 0 then 1566 TestDist := 1 1567 else 1568 TestDist := 0; 1569 if (StartLoc2[p1] = StartLoc[p1]) or (TestDist > BestDist) then 1570 begin 1571 StartLoc2[p1] := Loc1; 1572 BestDist := TestDist; 1573 n := 1; 1289 1574 end 1290 else if RealMap[Loc1] and fTerrain=fDesert then 1291 RealMap[Loc1]:=RealMap[Loc1] and not fTerrain or fPrairie 1292 else if (RealMap[Loc1] and fTerrain in [fPrairie,fTundra,fSwamp]) 1293 and (random(2)=0) then 1294 RealMap[Loc1]:=RealMap[Loc1] and not fTerrain or fForest; 1295 end; 1296 1297 // first irrigation 1298 nIrrLoc:=0; 1299 for V21:=1 to 26 do if V21<>CityOwnTile then 1300 begin 1301 Loc1:=Radius[V21]; 1302 if (Loc1>=0) and (Loc1<MapSize) 1303 and (RealMap[Loc1] and (fTerrain or fSpecial)=fGrass or fSpecial1) then 1304 begin 1305 IrrLoc[nIrrLoc]:=Loc1; 1306 inc(nIrrLoc); 1307 end; 1308 end; 1309 i:=2; 1310 if i>nIrrLoc then i:=nIrrLoc; 1311 while i>0 do 1312 begin 1313 j:=random(nIrrLoc); 1314 RealMap[IrrLoc[j]]:=RealMap[IrrLoc[j]] or tiIrrigation; 1315 IrrLoc[j]:=IrrLoc[nIrrLoc-1]; 1316 dec(nIrrLoc); 1317 dec(i) 1318 end; 1319 end; 1320 1321 StartLoc[0]:=0; 1322 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then 1323 begin 1324 repeat i:=Random(nAlive)+1 until StartLoc0[i]>=0; 1325 StartLoc[p1]:=StartLoc0[i]; 1326 StartLoc0[i]:=-1 1327 end; 1328 SaveMapCenterLoc:=StartLoc[0]; 1329 1330 // second unit starting position 1331 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then 1332 begin 1333 StartLoc2[p1]:=StartLoc[p1]; 1334 V8_to_Loc(StartLoc[p1],Adjacent); 1335 for V8:=0 to 7 do 1336 begin 1337 Loc1:=Adjacent[V8]; 1338 for p2:=0 to nPl-1 do 1339 if (1 shl p2 and GAlive<>0) and (StartLoc[p2]=Loc1) then Loc1:=-1; 1340 for p2:=0 to p1-1 do 1341 if (1 shl p2 and GAlive<>0) and (StartLoc2[p2]=Loc1) then Loc1:=-1; 1342 if (Loc1<0) or (Loc1>=MapSize) 1343 or (RealMap[Loc1] and fTerrain in [fOcean, fShore, fDesert, fArctic, fMountains]) 1344 or (RealMap[Loc1] and fDeadLands<>0) then 1345 TestDist:=-1 1346 else if RealMap[Loc1] and fTerrain=fGrass then TestDist:=2 1347 else if Terrain[RealMap[Loc1] and fTerrain].IrrEff>0 then TestDist:=1 1348 else TestDist:=0; 1349 if (StartLoc2[p1]=StartLoc[p1]) or (TestDist>BestDist) then 1350 begin StartLoc2[p1]:=Loc1; BestDist:=TestDist; n:=1; end 1351 else if TestDist=BestDist then 1352 begin inc(n); if random(n)=0 then StartLoc2[p1]:=Loc1; end; 1353 end 1354 end; 1355 end; {StartPositions} 1575 else if TestDist = BestDist then 1576 begin 1577 inc(n); 1578 if Random(n) = 0 then 1579 StartLoc2[p1] := Loc1; 1580 end; 1581 end 1582 end; 1583 end; { StartPositions } 1356 1584 1357 1585 procedure PredefinedStartPositions(Human: integer); 1358 1586 // use predefined nation start positions 1359 1587 var 1360 i,p1,Loc1,nAlive,nStartLoc0,nPrefStartLoc0,imax: integer; 1361 StartLoc0: array[0..lxmax*lymax-1] of integer; 1362 ishuman: boolean; 1363 begin 1364 nAlive:=0; 1365 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then inc(nAlive); 1366 if nAlive=0 then exit; 1367 1368 // calculate starting positions 1369 nStartLoc0:=0; 1370 nPrefStartLoc0:=0; 1371 for Loc1:=0 to MapSize-1 do 1372 if RealMap[Loc1] and fPrefStartPos<>0 then 1373 begin 1374 StartLoc0[nStartLoc0]:=StartLoc0[nPrefStartLoc0]; 1375 StartLoc0[nPrefStartLoc0]:=Loc1; 1376 inc(nPrefStartLoc0); 1377 inc(nStartLoc0); 1378 RealMap[Loc1]:=RealMap[Loc1] and not fPrefStartPos; 1588 i, p1, Loc1, nAlive, nStartLoc0, nPrefStartLoc0, imax: integer; 1589 StartLoc0: array [0 .. lxmax * lymax - 1] of integer; 1590 ishuman: boolean; 1591 begin 1592 nAlive := 0; 1593 for p1 := 0 to nPl - 1 do 1594 if 1 shl p1 and GAlive <> 0 then 1595 inc(nAlive); 1596 if nAlive = 0 then 1597 exit; 1598 1599 // calculate starting positions 1600 nStartLoc0 := 0; 1601 nPrefStartLoc0 := 0; 1602 for Loc1 := 0 to MapSize - 1 do 1603 if RealMap[Loc1] and fPrefStartPos <> 0 then 1604 begin 1605 StartLoc0[nStartLoc0] := StartLoc0[nPrefStartLoc0]; 1606 StartLoc0[nPrefStartLoc0] := Loc1; 1607 inc(nPrefStartLoc0); 1608 inc(nStartLoc0); 1609 RealMap[Loc1] := RealMap[Loc1] and not fPrefStartPos; 1379 1610 end 1380 else if RealMap[Loc1] and fStartPos<>0 then 1381 begin 1382 StartLoc0[nStartLoc0]:=Loc1; 1383 inc(nStartLoc0); 1384 RealMap[Loc1]:=RealMap[Loc1] and not fStartPos; 1385 end; 1386 assert(nStartLoc0>=nAlive); 1387 1388 StartLoc[0]:=0; 1389 for ishuman:=true downto false do for p1:=0 to nPl-1 do 1390 if (1 shl p1 and GAlive<>0) and ((1 shl p1 and Human<>0)=ishuman) then 1391 begin 1392 dec(nStartLoc0); 1393 imax:=nStartLoc0; 1394 if nPrefStartLoc0>0 then 1395 begin 1396 dec(nPrefStartLoc0); 1397 imax:=nPrefStartLoc0; 1398 end; 1399 i:=Random(imax+1); 1400 StartLoc[p1]:=StartLoc0[i]; 1401 StartLoc2[p1]:=StartLoc0[i]; 1402 StartLoc0[i]:=StartLoc0[imax]; 1403 StartLoc0[imax]:=StartLoc0[nStartLoc0]; 1404 end; 1405 SaveMapCenterLoc:=StartLoc[0]; 1406 end; {PredefinedStartPositions} 1611 else if RealMap[Loc1] and fStartPos <> 0 then 1612 begin 1613 StartLoc0[nStartLoc0] := Loc1; 1614 inc(nStartLoc0); 1615 RealMap[Loc1] := RealMap[Loc1] and not fStartPos; 1616 end; 1617 assert(nStartLoc0 >= nAlive); 1618 1619 StartLoc[0] := 0; 1620 for ishuman := true downto false do 1621 for p1 := 0 to nPl - 1 do 1622 if (1 shl p1 and GAlive <> 0) and ((1 shl p1 and Human <> 0) = ishuman) 1623 then 1624 begin 1625 dec(nStartLoc0); 1626 imax := nStartLoc0; 1627 if nPrefStartLoc0 > 0 then 1628 begin 1629 dec(nPrefStartLoc0); 1630 imax := nPrefStartLoc0; 1631 end; 1632 i := Random(imax + 1); 1633 StartLoc[p1] := StartLoc0[i]; 1634 StartLoc2[p1] := StartLoc0[i]; 1635 StartLoc0[i] := StartLoc0[imax]; 1636 StartLoc0[imax] := StartLoc0[nStartLoc0]; 1637 end; 1638 SaveMapCenterLoc := StartLoc[0]; 1639 end; { PredefinedStartPositions } 1407 1640 1408 1641 procedure InitGame; 1409 1642 var 1410 i, p, p1, uix, Loc1: integer; 1411 begin 1412 if FastContact then {Railroad everywhere} 1413 for Loc1:=0 to MapSize-1 do 1414 if RealMap[Loc1] and fTerrain>=fGrass then RealMap[Loc1]:=RealMap[Loc1] or fRR; 1415 1416 {!!!for Loc1:=0 to MapSize-1 do 1417 if RealMap[Loc1] and fterrain>=fGrass then 1643 i, p, p1, uix, Loc1: integer; 1644 begin 1645 if FastContact then { Railroad everywhere } 1646 for Loc1 := 0 to MapSize - 1 do 1647 if RealMap[Loc1] and fTerrain >= fGrass then 1648 RealMap[Loc1] := RealMap[Loc1] or fRR; 1649 1650 { !!!for Loc1:=0 to MapSize-1 do 1651 if RealMap[Loc1] and fterrain>=fGrass then 1418 1652 if random(3)=0 then RealMap[Loc1]:=RealMap[Loc1] or fRoad 1419 1653 else if random(3)=0 then RealMap[Loc1]:=RealMap[Loc1] or fRR; 1420 {random Road and Railroad} 1421 {!!!for Loc1:=0 to MapSize-1 do 1422 if (RealMap[Loc1] and fterrain>=fGrass) and (random(20)=0) then 1423 RealMap[Loc1]:=RealMap[Loc1] or fPoll;} 1424 1425 FillChar(Occupant,MapSize,-1); 1426 FillChar(ZoCMap,MapSize,0); 1427 FillChar(ObserveLevel,MapSize*4,0); 1428 FillChar(UsedByCity,MapSize*4,-1); 1429 GTestFlags:=0; 1430 GInitialized:=GAlive or GWatching; 1431 for p:=0 to nPl-1 do if 1 shl p and GInitialized<>0 then with RW[p] do 1432 begin 1433 Researched[p]:=0; 1434 Discovered[p]:=0; 1435 TerritoryCount[p]:=0; 1436 nTech[p]:=0; 1437 if Difficulty[p]=0 then ResourceMask[p]:=$FFFFFFFF 1438 else ResourceMask[p]:=$FFFFFFFF and not (fSpecial2 or fModern); 1439 GrWallContinent[p]:=-1; 1440 1441 GetMem(Map,4*MapSize); 1442 GetMem(MapObservedLast,2*MapSize); 1443 FillChar(MapObservedLast^,2*MapSize,-1); 1444 GetMem(Territory,MapSize); 1445 FillChar(Territory^,MapSize,$FF); 1446 GetMem(Un,numax*SizeOf(TUn)); 1447 GetMem(Model,(nmmax+1)*SizeOf(TModel)); // draft needs one model behind last 1448 GetMem(City,ncmax*SizeOf(TCity)); 1449 GetMem(EnemyUn,neumax*SizeOf(TUnitInfo)); 1450 GetMem(EnemyCity,necmax*SizeOf(TCityInfo)); 1451 GetMem(EnemyModel,nemmax*SizeOf(TModelInfo)); 1452 for p1:=0 to nPl-1 do 1453 begin 1454 if 1 shl p1 and GInitialized<>0 then 1455 begin 1456 FillChar(RWemix[p,p1],SizeOf(RWemix[p,p1]),255); {-1} 1457 FillChar(Destroyed[p,p1],SizeOf(Destroyed[p,p1]),0); 1458 end; 1459 Attitude[p1]:=atNeutral; 1460 Treaty[p1]:=trNoContact; 1461 LastCancelTreaty[p1]:=-CancelTreatyTurns-1; 1462 EvaStart[p1]:=-PeaceEvaTurns-1; 1463 Tribute[p1]:=0; 1464 TributePaid[p1]:=0; 1465 if (p1<>p) and (1 shl p1 and GAlive<>0) then 1466 begin // initialize enemy report 1467 GetMem(EnemyReport[p1],SizeOf(TEnemyReport)-2*(INFIN+1-nmmax)); 1468 FillChar(EnemyReport[p1].Tech,nAdv,tsNA); 1469 EnemyReport[p1].TurnOfContact:=-1; 1470 EnemyReport[p1].TurnOfCivilReport:=-1; 1471 EnemyReport[p1].TurnOfMilReport:=-1; 1472 EnemyReport[p1].Attitude:=atNeutral; 1473 EnemyReport[p1].Government:=gDespotism; 1474 if 1 shl p and GAlive=0 then Treaty[p1]:=trNone // supervisor 1475 end 1476 else EnemyReport[p1]:=nil; 1477 end; 1478 TestFlags:=GTestFlags; 1479 Credibility:=InitialCredibility; 1480 MaxCredibility:=100; 1481 nUn:=0; 1482 nModel:=0; 1483 nCity:=0; 1484 nEnemyUn:=0; 1485 nEnemyCity:=0; 1486 nEnemyModel:=0; 1487 for Loc1:=0 to MapSize-1 do Map[Loc1]:=fUNKNOWN; 1488 FillChar(Tech,nAdv,tsNA); 1489 FillChar(NatBuilt,SizeOf(NatBuilt),0); 1490 end; 1491 1492 // create initial models and units 1493 for p:=0 to nPl-1 do if (1 shl p and GAlive<>0) then with RW[p] do 1494 begin 1495 nModel:=0; 1496 for i:=0 to nSpecialModel-1 do if SpecialModelPreq[i]=preNone then 1497 begin 1498 Model[nModel]:=SpecialModel[i]; 1499 Model[nModel].Status:=0; 1500 Model[nModel].IntroTurn:=0; 1501 Model[nModel].Built:=0; 1502 Model[nModel].Lost:=0; 1503 Model[nModel].ID:=p shl 12+nModel; 1504 SetModelFlags(Model[nModel]); 1505 inc(nModel) 1506 end; 1507 nUn:=0; 1508 UnBuilt[p]:=0; 1509 for uix:=0 to nStartUn-1 do 1510 begin 1511 CreateUnit(p, StartUn[uix]); 1512 dec(Model[StartUn[uix]].Built); 1513 Un[uix].Loc:=StartLoc2[p]; 1514 PlaceUnit(p,uix); 1515 end; 1516 FoundCity(p,StartLoc[p]); // capital 1517 Founded[p]:=1; 1518 with City[0] do 1519 begin 1520 ID:=p shl 12; 1521 Flags:=chFounded; 1522 end; 1523 end; 1524 1525 TerritoryCount[nPl]:=MapSize; 1526 //fillchar(NewContact, sizeof(NewContact), false); 1654 {random Road and Railroad } 1655 { !!!for Loc1:=0 to MapSize-1 do 1656 if (RealMap[Loc1] and fterrain>=fGrass) and (random(20)=0) then 1657 RealMap[Loc1]:=RealMap[Loc1] or fPoll; } 1658 1659 FillChar(Occupant, MapSize, -1); 1660 FillChar(ZoCMap, MapSize, 0); 1661 FillChar(ObserveLevel, MapSize * 4, 0); 1662 FillChar(UsedByCity, MapSize * 4, -1); 1663 GTestFlags := 0; 1664 GInitialized := GAlive or GWatching; 1665 for p := 0 to nPl - 1 do 1666 if 1 shl p and GInitialized <> 0 then 1667 with RW[p] do 1668 begin 1669 Researched[p] := 0; 1670 Discovered[p] := 0; 1671 TerritoryCount[p] := 0; 1672 nTech[p] := 0; 1673 if Difficulty[p] = 0 then 1674 ResourceMask[p] := $FFFFFFFF 1675 else 1676 ResourceMask[p] := $FFFFFFFF and not(fSpecial2 or fModern); 1677 GrWallContinent[p] := -1; 1678 1679 GetMem(Map, 4 * MapSize); 1680 GetMem(MapObservedLast, 2 * MapSize); 1681 FillChar(MapObservedLast^, 2 * MapSize, -1); 1682 GetMem(Territory, MapSize); 1683 FillChar(Territory^, MapSize, $FF); 1684 GetMem(Un, numax * SizeOf(TUn)); 1685 GetMem(Model, (nmmax + 1) * SizeOf(TModel)); 1686 // draft needs one model behind last 1687 GetMem(City, ncmax * SizeOf(TCity)); 1688 GetMem(EnemyUn, neumax * SizeOf(TUnitInfo)); 1689 GetMem(EnemyCity, necmax * SizeOf(TCityInfo)); 1690 GetMem(EnemyModel, nemmax * SizeOf(TModelInfo)); 1691 for p1 := 0 to nPl - 1 do 1692 begin 1693 if 1 shl p1 and GInitialized <> 0 then 1694 begin 1695 FillChar(RWemix[p, p1], SizeOf(RWemix[p, p1]), 255); { -1 } 1696 FillChar(Destroyed[p, p1], SizeOf(Destroyed[p, p1]), 0); 1697 end; 1698 Attitude[p1] := atNeutral; 1699 Treaty[p1] := trNoContact; 1700 LastCancelTreaty[p1] := -CancelTreatyTurns - 1; 1701 EvaStart[p1] := -PeaceEvaTurns - 1; 1702 Tribute[p1] := 0; 1703 TributePaid[p1] := 0; 1704 if (p1 <> p) and (1 shl p1 and GAlive <> 0) then 1705 begin // initialize enemy report 1706 GetMem(EnemyReport[p1], SizeOf(TEnemyReport) - 2 * 1707 (INFIN + 1 - nmmax)); 1708 FillChar(EnemyReport[p1].Tech, nAdv, tsNA); 1709 EnemyReport[p1].TurnOfContact := -1; 1710 EnemyReport[p1].TurnOfCivilReport := -1; 1711 EnemyReport[p1].TurnOfMilReport := -1; 1712 EnemyReport[p1].Attitude := atNeutral; 1713 EnemyReport[p1].Government := gDespotism; 1714 if 1 shl p and GAlive = 0 then 1715 Treaty[p1] := trNone // supervisor 1716 end 1717 else 1718 EnemyReport[p1] := nil; 1719 end; 1720 TestFlags := GTestFlags; 1721 Credibility := InitialCredibility; 1722 MaxCredibility := 100; 1723 nUn := 0; 1724 nModel := 0; 1725 nCity := 0; 1726 nEnemyUn := 0; 1727 nEnemyCity := 0; 1728 nEnemyModel := 0; 1729 for Loc1 := 0 to MapSize - 1 do 1730 Map[Loc1] := fUNKNOWN; 1731 FillChar(Tech, nAdv, tsNA); 1732 FillChar(NatBuilt, SizeOf(NatBuilt), 0); 1733 end; 1734 1735 // create initial models and units 1736 for p := 0 to nPl - 1 do 1737 if (1 shl p and GAlive <> 0) then 1738 with RW[p] do 1739 begin 1740 nModel := 0; 1741 for i := 0 to nSpecialModel - 1 do 1742 if SpecialModelPreq[i] = preNone then 1743 begin 1744 Model[nModel] := SpecialModel[i]; 1745 Model[nModel].Status := 0; 1746 Model[nModel].IntroTurn := 0; 1747 Model[nModel].Built := 0; 1748 Model[nModel].Lost := 0; 1749 Model[nModel].ID := p shl 12 + nModel; 1750 SetModelFlags(Model[nModel]); 1751 inc(nModel) 1752 end; 1753 nUn := 0; 1754 UnBuilt[p] := 0; 1755 for uix := 0 to nStartUn - 1 do 1756 begin 1757 CreateUnit(p, StartUn[uix]); 1758 dec(Model[StartUn[uix]].Built); 1759 Un[uix].Loc := StartLoc2[p]; 1760 PlaceUnit(p, uix); 1761 end; 1762 FoundCity(p, StartLoc[p]); // capital 1763 Founded[p] := 1; 1764 with City[0] do 1765 begin 1766 ID := p shl 12; 1767 Flags := chFounded; 1768 end; 1769 end; 1770 1771 TerritoryCount[nPl] := MapSize; 1772 // fillchar(NewContact, sizeof(NewContact), false); 1527 1773 end; // InitGame 1528 1774 1529 1775 procedure InitRandomGame; 1530 1776 begin 1531 RandSeed:=RND;1532 CalculatePrimitive;1533 CreateElevation;1534 CreateMap(false);1535 StartPositions;1536 InitGame;1537 end; { InitRandomGame}1777 RandSeed := RND; 1778 CalculatePrimitive; 1779 CreateElevation; 1780 CreateMap(false); 1781 StartPositions; 1782 InitGame; 1783 end; { InitRandomGame } 1538 1784 1539 1785 procedure InitMapGame(Human: integer); 1540 1786 begin 1541 RandSeed:=RND;1542 FindContinents;1543 PredefinedStartPositions(Human);1544 InitGame;1545 end; { InitMapGame}1787 RandSeed := RND; 1788 FindContinents; 1789 PredefinedStartPositions(Human); 1790 InitGame; 1791 end; { InitMapGame } 1546 1792 1547 1793 procedure ReleaseGame; 1548 1794 var 1549 p1,p2: integer; 1550 begin 1551 for p1:=0 to nPl-1 do if 1 shl p1 and GInitialized<>0 then 1552 begin 1553 for p2:=0 to nPl-1 do 1554 if RW[p1].EnemyReport[p2]<>nil then 1555 FreeMem(RW[p1].EnemyReport[p2]); 1556 FreeMem(RW[p1].EnemyUn); 1557 FreeMem(RW[p1].EnemyCity); 1558 FreeMem(RW[p1].EnemyModel); 1559 FreeMem(RW[p1].Un); 1560 FreeMem(RW[p1].City); 1561 FreeMem(RW[p1].Model); 1562 FreeMem(RW[p1].Territory); 1563 FreeMem(RW[p1].MapObservedLast); 1564 FreeMem(RW[p1].Map); 1565 end 1795 p1, p2: integer; 1796 begin 1797 for p1 := 0 to nPl - 1 do 1798 if 1 shl p1 and GInitialized <> 0 then 1799 begin 1800 for p2 := 0 to nPl - 1 do 1801 if RW[p1].EnemyReport[p2] <> nil then 1802 FreeMem(RW[p1].EnemyReport[p2]); 1803 FreeMem(RW[p1].EnemyUn); 1804 FreeMem(RW[p1].EnemyCity); 1805 FreeMem(RW[p1].EnemyModel); 1806 FreeMem(RW[p1].Un); 1807 FreeMem(RW[p1].City); 1808 FreeMem(RW[p1].Model); 1809 FreeMem(RW[p1].Territory); 1810 FreeMem(RW[p1].MapObservedLast); 1811 FreeMem(RW[p1].Map); 1812 end 1566 1813 end; 1567 1814 1568 1815 procedure InitMapEditor; 1569 1816 var 1570 p1: integer; 1571 begin 1572 CalculatePrimitive; 1573 FillChar(Occupant,MapSize,-1); 1574 FillChar(ObserveLevel,MapSize*4,0); 1575 with RW[0] do 1576 begin 1577 ResourceMask[0]:=$FFFFFFFF; 1578 GetMem(Map,4*MapSize); 1579 GetMem(MapObservedLast,2*MapSize); 1580 FillChar(MapObservedLast^,2*MapSize,-1); 1581 GetMem(Territory,MapSize); 1582 FillChar(Territory^,MapSize,$FF); 1583 Un:=nil; 1584 Model:=nil; 1585 City:=nil; 1586 EnemyUn:=nil; 1587 EnemyCity:=nil; 1588 EnemyModel:=nil; 1589 for p1:=0 to nPl-1 do EnemyReport[p1]:=nil; 1590 nUn:=0; 1591 nModel:=0; 1592 nCity:=0; 1593 nEnemyUn:=0; 1594 nEnemyCity:=0; 1595 nEnemyModel:=0; 1817 p1: integer; 1818 begin 1819 CalculatePrimitive; 1820 FillChar(Occupant, MapSize, -1); 1821 FillChar(ObserveLevel, MapSize * 4, 0); 1822 with RW[0] do 1823 begin 1824 ResourceMask[0] := $FFFFFFFF; 1825 GetMem(Map, 4 * MapSize); 1826 GetMem(MapObservedLast, 2 * MapSize); 1827 FillChar(MapObservedLast^, 2 * MapSize, -1); 1828 GetMem(Territory, MapSize); 1829 FillChar(Territory^, MapSize, $FF); 1830 Un := nil; 1831 Model := nil; 1832 City := nil; 1833 EnemyUn := nil; 1834 EnemyCity := nil; 1835 EnemyModel := nil; 1836 for p1 := 0 to nPl - 1 do 1837 EnemyReport[p1] := nil; 1838 nUn := 0; 1839 nModel := 0; 1840 nCity := 0; 1841 nEnemyUn := 0; 1842 nEnemyCity := 0; 1843 nEnemyModel := 0; 1596 1844 end; 1597 1845 end; … … 1599 1847 procedure ReleaseMapEditor; 1600 1848 begin 1601 FreeMem(RW[0].Territory);1602 FreeMem(RW[0].MapObservedLast);1603 FreeMem(RW[0].Map);1849 FreeMem(RW[0].Territory); 1850 FreeMem(RW[0].MapObservedLast); 1851 FreeMem(RW[0].Map); 1604 1852 end; 1605 1853 1606 1854 procedure EditTile(Loc, NewTile: integer); 1607 1855 var 1608 Loc1,V21: integer; 1609 Radius: TVicinity21Loc; 1610 begin 1611 if NewTile and fDeadLands<>0 then 1612 NewTile:=NewTile and (fDeadLands or fModern or fRiver) or fDesert; 1613 case NewTile and fTerrain of 1614 fOcean, fShore: NewTile:=NewTile and (fTerrain or fSpecial); 1615 fMountains,fArctic: NewTile:=NewTile and not fRiver; 1616 end; 1617 with Terrain[NewTile and fTerrain] do 1618 if (ClearTerrain>=0) or (AfforestTerrain>=0) or (TransTerrain>=0) then 1619 NewTile:=NewTile or fSpecial; // only automatic special resources for transformable tiles 1620 if NewTile and fRR<>0 then NewTile:=NewTile and not fRoad; 1621 if not ((NewTile and fTerrain) in TerrType_Canalable) then 1622 NewTile:=NewTile and not fCanal; 1623 if Terrain[NewTile and fTerrain].IrrEff=0 then 1624 begin 1625 NewTile:=NewTile and not (fPrefStartPos or fStartPos); 1626 if (NewTile and fTerImp=tiIrrigation) or (NewTile and fTerImp=tiFarm) then 1627 NewTile:=NewTile and not fTerImp 1628 end; 1629 if (Terrain[NewTile and fTerrain].MineEff=0) 1630 and (NewTile and fTerImp=tiMine) then 1631 NewTile:=NewTile and not fTerImp; 1632 1633 RealMap[Loc]:=NewTile; 1634 if NewTile and fSpecial=fSpecial then // standard special resource distribution 1635 RealMap[Loc]:=RealMap[Loc] and not fSpecial or ActualSpecialTile(Loc) shl 5; 1636 1637 // automatic shore tiles 1638 V21_to_Loc(Loc,Radius); 1639 for V21:=1 to 26 do 1640 begin 1641 Loc1:=Radius[V21]; 1642 if (Loc1>=0) and (Loc1<MapSize) then 1643 begin 1644 if CheckShore(Loc1) then 1645 RealMap[Loc1]:=RealMap[Loc1] and not fSpecial or ActualSpecialTile(Loc1) shl 5; 1646 RealMap[Loc1]:=RealMap[Loc1] or ($F shl 27); 1647 RW[0].Map[Loc1]:=RealMap[Loc1] and $07FFFFFF or fObserved; 1856 Loc1, V21: integer; 1857 Radius: TVicinity21Loc; 1858 begin 1859 if NewTile and fDeadLands <> 0 then 1860 NewTile := NewTile and (fDeadLands or fModern or fRiver) or fDesert; 1861 case NewTile and fTerrain of 1862 fOcean, fShore: 1863 NewTile := NewTile and (fTerrain or fSpecial); 1864 fMountains, fArctic: 1865 NewTile := NewTile and not fRiver; 1866 end; 1867 with Terrain[NewTile and fTerrain] do 1868 if (ClearTerrain >= 0) or (AfforestTerrain >= 0) or (TransTerrain >= 0) then 1869 NewTile := NewTile or fSpecial; 1870 // only automatic special resources for transformable tiles 1871 if NewTile and fRR <> 0 then 1872 NewTile := NewTile and not fRoad; 1873 if not((NewTile and fTerrain) in TerrType_Canalable) then 1874 NewTile := NewTile and not fCanal; 1875 if Terrain[NewTile and fTerrain].IrrEff = 0 then 1876 begin 1877 NewTile := NewTile and not(fPrefStartPos or fStartPos); 1878 if (NewTile and fTerImp = tiIrrigation) or (NewTile and fTerImp = tiFarm) 1879 then 1880 NewTile := NewTile and not fTerImp 1881 end; 1882 if (Terrain[NewTile and fTerrain].MineEff = 0) and 1883 (NewTile and fTerImp = tiMine) then 1884 NewTile := NewTile and not fTerImp; 1885 1886 RealMap[Loc] := NewTile; 1887 if NewTile and fSpecial = fSpecial then 1888 // standard special resource distribution 1889 RealMap[Loc] := RealMap[Loc] and not fSpecial or 1890 ActualSpecialTile(Loc) shl 5; 1891 1892 // automatic shore tiles 1893 V21_to_Loc(Loc, Radius); 1894 for V21 := 1 to 26 do 1895 begin 1896 Loc1 := Radius[V21]; 1897 if (Loc1 >= 0) and (Loc1 < MapSize) then 1898 begin 1899 if CheckShore(Loc1) then 1900 RealMap[Loc1] := RealMap[Loc1] and not fSpecial or 1901 ActualSpecialTile(Loc1) shl 5; 1902 RealMap[Loc1] := RealMap[Loc1] or ($F shl 27); 1903 RW[0].Map[Loc1] := RealMap[Loc1] and $07FFFFFF or fObserved; 1648 1904 end 1649 1905 end; 1650 //RealMap[Loc]:=RealMap[Loc] and not fSpecial;1651 //RW[0].Map[Loc]:=RealMap[Loc] or fObserved;1906 // RealMap[Loc]:=RealMap[Loc] and not fSpecial; 1907 // RW[0].Map[Loc]:=RealMap[Loc] or fObserved; 1652 1908 end; 1653 1909 1654 1910 { 1655 1656 ____________________________________________________________________1911 Map Revealing 1912 ____________________________________________________________________ 1657 1913 } 1658 1914 function GetTileInfo(p, cix, Loc: integer; var Info: TTileInfo): integer; … … 1661 1917 // cix=-2 - don't search city, don't calculate city benefits, just government of player p 1662 1918 var 1663 p0,Tile,special: integer; 1664 begin 1665 with Info do 1666 begin 1667 p0:=p; 1668 if cix>=0 then Tile:=RealMap[Loc] 1669 else 1670 begin 1671 Tile:=RW[p].Map[Loc]; 1672 if Tile and fTerrain=fUNKNOWN then begin result:=eNoPreq; exit end; 1673 end; 1674 1675 if (cix=-1) and (UsedByCity[Loc]>=0) then 1919 p0, Tile, special: integer; 1920 begin 1921 with Info do 1922 begin 1923 p0 := p; 1924 if cix >= 0 then 1925 Tile := RealMap[Loc] 1926 else 1927 begin 1928 Tile := RW[p].Map[Loc]; 1929 if Tile and fTerrain = fUNKNOWN then 1930 begin 1931 result := eNoPreq; 1932 exit 1933 end; 1934 end; 1935 1936 if (cix = -1) and (UsedByCity[Loc] >= 0) then 1676 1937 begin // search exploiting player and city 1677 SearchCity(UsedByCity[Loc],p,cix); 1678 if not ((p=p0) or (ObserveLevel[UsedByCity[Loc]] shr (2*p0) and 3=lObserveSuper)) then 1679 cix:=-1 1680 end; 1681 if cix=-1 then begin result:=eInvalid; exit end; // no city found here 1682 1683 special:=Tile and fSpecial and ResourceMask[p] shr 5; 1684 with Terrain[Tile and fTerrain] do 1685 begin 1686 Food:=FoodRes[special]; 1687 Prod:=ProdRes[special]; 1688 Trade:=TradeRes[special]; 1689 if (special>0) and (Tile and fTerrain<>fGrass) 1690 and (RW[p].NatBuilt[imSpacePort]>0) then 1938 SearchCity(UsedByCity[Loc], p, cix); 1939 if not((p = p0) or (ObserveLevel[UsedByCity[Loc]] shr (2 * p0) and 1940 3 = lObserveSuper)) then 1941 cix := -1 1942 end; 1943 if cix = -1 then 1944 begin 1945 result := eInvalid; 1946 exit 1947 end; // no city found here 1948 1949 special := Tile and fSpecial and ResourceMask[p] shr 5; 1950 with Terrain[Tile and fTerrain] do 1951 begin 1952 Food := FoodRes[special]; 1953 Prod := ProdRes[special]; 1954 Trade := TradeRes[special]; 1955 if (special > 0) and (Tile and fTerrain <> fGrass) and 1956 (RW[p].NatBuilt[imSpacePort] > 0) then 1691 1957 begin // GeoSat effect 1692 Food:=2*Food-FoodRes[0]; 1693 Prod:=2*Prod-ProdRes[0]; 1694 Trade:=2*Trade-TradeRes[0]; 1695 end; 1696 1697 if (Tile and fTerImp=tiIrrigation) or (Tile and fTerImp=tiFarm) 1698 or (Tile and fCity<>0) then 1699 inc(Food,IrrEff); {irrigation effect} 1700 if Tile and fTerImp=tiMine then inc(Prod,MineEff); {mining effect} 1701 if (Tile and fRiver<>0) and (RW[p].Tech[adMapMaking]>=tsApplicable) then 1702 inc(Trade); {river effect} 1703 if (Tile and (fRoad or fRR)<>0) and (MoveCost=1) 1704 and (RW[p].Tech[adWheel]>=tsApplicable) then 1705 inc(Trade); {road effect} 1706 if (Tile and (fRR or fCity)<>0) and (RW[p].Tech[adRailroad]>=tsApplicable) then 1707 inc(Prod,Prod shr 1); {railroad effect} 1708 1709 ExplCity:=-1; 1710 if (cix>=0) and (p=p0) then ExplCity:=cix; 1711 if cix>=0 then 1712 if Tile and fTerrain>=fGrass then 1713 begin 1714 if ((Tile and fTerImp=tiFarm) or (Tile and fCity<>0)) 1715 and (RW[p].City[cix].Built[imSupermarket]>0) then 1716 inc(Food,Food shr 1); {farmland effect} 1717 if (Tile and (fRoad or fRR)<>0) and (MoveCost=1) 1718 and (RW[p].City[cix].Built[imHighways]>0) then 1719 inc(Trade,1); {superhighway effect} 1958 Food := 2 * Food - FoodRes[0]; 1959 Prod := 2 * Prod - ProdRes[0]; 1960 Trade := 2 * Trade - TradeRes[0]; 1961 end; 1962 1963 if (Tile and fTerImp = tiIrrigation) or (Tile and fTerImp = tiFarm) or 1964 (Tile and fCity <> 0) then 1965 inc(Food, IrrEff); { irrigation effect } 1966 if Tile and fTerImp = tiMine then 1967 inc(Prod, MineEff); { mining effect } 1968 if (Tile and fRiver <> 0) and (RW[p].Tech[adMapMaking] >= tsApplicable) 1969 then 1970 inc(Trade); { river effect } 1971 if (Tile and (fRoad or fRR) <> 0) and (MoveCost = 1) and 1972 (RW[p].Tech[adWheel] >= tsApplicable) then 1973 inc(Trade); { road effect } 1974 if (Tile and (fRR or fCity) <> 0) and 1975 (RW[p].Tech[adRailroad] >= tsApplicable) then 1976 inc(Prod, Prod shr 1); { railroad effect } 1977 1978 ExplCity := -1; 1979 if (cix >= 0) and (p = p0) then 1980 ExplCity := cix; 1981 if cix >= 0 then 1982 if Tile and fTerrain >= fGrass then 1983 begin 1984 if ((Tile and fTerImp = tiFarm) or (Tile and fCity <> 0)) and 1985 (RW[p].City[cix].Built[imSupermarket] > 0) then 1986 inc(Food, Food shr 1); { farmland effect } 1987 if (Tile and (fRoad or fRR) <> 0) and (MoveCost = 1) and 1988 (RW[p].City[cix].Built[imHighways] > 0) then 1989 inc(Trade, 1); { superhighway effect } 1720 1990 end 1721 else 1722 begin 1723 if RW[p].City[cix].Built[imHarbor]>0 then inc(Food); {harbour effect} 1724 if RW[p].City[cix].Built[imPlatform]>0 then inc(Prod); {oil platform effect} 1725 if GWonder[woLighthouse].EffectiveOwner=p then inc(Prod); 1991 else 1992 begin 1993 if RW[p].City[cix].Built[imHarbor] > 0 then 1994 inc(Food); { harbour effect } 1995 if RW[p].City[cix].Built[imPlatform] > 0 then 1996 inc(Prod); { oil platform effect } 1997 if GWonder[woLighthouse].EffectiveOwner = p then 1998 inc(Prod); 1726 1999 end; 1727 2000 end; 1728 2001 1729 {good government influence} 1730 if (RW[p].Government in [gRepublic,gDemocracy,gFuture]) and (Trade>0) then 1731 inc(Trade); 1732 if (RW[p].Government=gCommunism) and (Prod>1) then 1733 inc(Prod); 1734 1735 if RW[p].Government in [gAnarchy,gDespotism] then 1736 begin {bad government influence} 1737 if Food>3 then Food:=3; 1738 if Prod>2 then Prod:=2; 1739 if Trade>2 then Trade:=2; 1740 end; 1741 1742 if Tile and (fTerrain or fPoll)>fPoll then 1743 begin {pollution - decrease ressources} 1744 dec(Food,Food shr 1); 1745 dec(Prod,Prod shr 1); 1746 dec(Trade,Trade shr 1); 1747 end; 1748 1749 if Tile and fCity<>0 then Trade:=0 1750 else if (cix>=0) 1751 and (RW[p].City[cix].Built[imCourt]+RW[p].City[cix].Built[imPalace]=0) then 1752 if RW[p].City[cix].Built[imTownHall]=0 then Trade:=0 1753 else if Trade>3 then Trade:=3; 1754 end; 1755 result:=eOK; 1756 end; {GetTileInfo} 1757 1758 procedure Strongest(Loc:integer;var uix,Strength,Bonus,Cnt:integer); 1759 {find strongest defender at Loc} 1760 var 1761 Defender,uix1,Det,Cost,TestStrength,TestBonus,TestDet,TestCost,Domain: integer; 1762 PUn: ^TUn; 1763 PModel: ^TModel; 1764 begin 1765 Defender:=Occupant[Loc]; 1766 Cnt:=0; 1767 Det:=-1; 1768 for uix1:=0 to RW[Defender].nUn-1 do 1769 begin 1770 PUn:=@RW[Defender].Un[uix1]; 1771 PModel:=@RW[Defender].Model[PUn.mix]; 1772 if PModel.Kind=mkSpecial_Glider then Domain:=dGround 1773 else Domain:=PModel.Domain; 1774 if PUn.Loc=Loc then 1775 begin 1776 inc(Cnt); 1777 if PUn.Master<0 then 1778 begin 1779 if Domain<dSea then 1780 begin 1781 TestBonus:=Terrain[RealMap[Loc] and fTerrain].Defense; 1782 if RealMap[Loc] and fTerImp=tiFort then inc(TestBonus,4); 1783 if PUn.Flags and unFortified<>0 then inc(TestBonus,2); 1784 if (PModel.Kind=mkSpecial_TownGuard) and (RealMap[Loc] and fCity<>0) then 1785 inc(TestBonus,4); 2002 { good government influence } 2003 if (RW[p].Government in [gRepublic, gDemocracy, gFuture]) and (Trade > 0) 2004 then 2005 inc(Trade); 2006 if (RW[p].Government = gCommunism) and (Prod > 1) then 2007 inc(Prod); 2008 2009 if RW[p].Government in [gAnarchy, gDespotism] then 2010 begin { bad government influence } 2011 if Food > 3 then 2012 Food := 3; 2013 if Prod > 2 then 2014 Prod := 2; 2015 if Trade > 2 then 2016 Trade := 2; 2017 end; 2018 2019 if Tile and (fTerrain or fPoll) > fPoll then 2020 begin { pollution - decrease ressources } 2021 dec(Food, Food shr 1); 2022 dec(Prod, Prod shr 1); 2023 dec(Trade, Trade shr 1); 2024 end; 2025 2026 if Tile and fCity <> 0 then 2027 Trade := 0 2028 else if (cix >= 0) and (RW[p].City[cix].Built[imCourt] + RW[p].City[cix] 2029 .Built[imPalace] = 0) then 2030 if RW[p].City[cix].Built[imTownHall] = 0 then 2031 Trade := 0 2032 else if Trade > 3 then 2033 Trade := 3; 2034 end; 2035 result := eOK; 2036 end; { GetTileInfo } 2037 2038 procedure Strongest(Loc: integer; var uix, Strength, Bonus, Cnt: integer); 2039 { find strongest defender at Loc } 2040 var 2041 Defender, uix1, Det, Cost, TestStrength, TestBonus, TestDet, TestCost, 2042 Domain: integer; 2043 PUn: ^TUn; 2044 PModel: ^TModel; 2045 begin 2046 Defender := Occupant[Loc]; 2047 Cnt := 0; 2048 Det := -1; 2049 for uix1 := 0 to RW[Defender].nUn - 1 do 2050 begin 2051 PUn := @RW[Defender].Un[uix1]; 2052 PModel := @RW[Defender].Model[PUn.mix]; 2053 if PModel.Kind = mkSpecial_Glider then 2054 Domain := dGround 2055 else 2056 Domain := PModel.Domain; 2057 if PUn.Loc = Loc then 2058 begin 2059 inc(Cnt); 2060 if PUn.Master < 0 then 2061 begin 2062 if Domain < dSea then 2063 begin 2064 TestBonus := Terrain[RealMap[Loc] and fTerrain].Defense; 2065 if RealMap[Loc] and fTerImp = tiFort then 2066 inc(TestBonus, 4); 2067 if PUn.Flags and unFortified <> 0 then 2068 inc(TestBonus, 2); 2069 if (PModel.Kind = mkSpecial_TownGuard) and 2070 (RealMap[Loc] and fCity <> 0) then 2071 inc(TestBonus, 4); 1786 2072 end 1787 else TestBonus:=4; 1788 inc(TestBonus,PUn.Exp div ExpCost); 1789 TestStrength:=PModel.Defense*TestBonus*PUn.Health; 1790 if (Domain=dAir) and ((RealMap[Loc] and fCity<>0) 1791 or (RealMap[Loc] and fTerImp=tiBase)) then 1792 TestStrength:=0; 1793 if (Domain=dSea) and (RealMap[Loc] and fTerrain>=fGrass) then 1794 TestStrength:=TestStrength shr 1; 1795 TestDet:=TestStrength; 1796 if PModel.Cap[mcStealth]>0 then 1797 else if PModel.Cap[mcSub]>0 then inc(TestDet,1 shl 28) 1798 else if (Domain=dGround) and (PModel.Cap[mcFanatic]>0) 1799 and not (RW[Defender].Government in [gRepublic,gDemocracy,gFuture]) then 1800 inc(TestDet,4 shl 28) // fanatic ground units always defend 1801 else if PModel.Flags and mdZOC<>0 then 1802 inc(TestDet,3 shl 28) 1803 else inc(TestDet,2 shl 28); 1804 TestCost:=RW[Defender].Model[PUn.mix].Cost; 1805 if (TestDet>Det) or (TestDet=Det) and (TestCost<Cost) then 1806 begin 1807 uix:=uix1; 1808 Strength:=TestStrength; 1809 Bonus:=TestBonus; 1810 Det:=TestDet; 1811 Cost:=TestCost; 2073 else 2074 TestBonus := 4; 2075 inc(TestBonus, PUn.exp div ExpCost); 2076 TestStrength := PModel.Defense * TestBonus * PUn.Health; 2077 if (Domain = dAir) and ((RealMap[Loc] and fCity <> 0) or 2078 (RealMap[Loc] and fTerImp = tiBase)) then 2079 TestStrength := 0; 2080 if (Domain = dSea) and (RealMap[Loc] and fTerrain >= fGrass) then 2081 TestStrength := TestStrength shr 1; 2082 TestDet := TestStrength; 2083 if PModel.Cap[mcStealth] > 0 then 2084 else if PModel.Cap[mcSub] > 0 then 2085 inc(TestDet, 1 shl 28) 2086 else if (Domain = dGround) and (PModel.Cap[mcFanatic] > 0) and 2087 not(RW[Defender].Government in [gRepublic, gDemocracy, gFuture]) then 2088 inc(TestDet, 4 shl 28) // fanatic ground units always defend 2089 else if PModel.Flags and mdZOC <> 0 then 2090 inc(TestDet, 3 shl 28) 2091 else 2092 inc(TestDet, 2 shl 28); 2093 TestCost := RW[Defender].Model[PUn.mix].Cost; 2094 if (TestDet > Det) or (TestDet = Det) and (TestCost < Cost) then 2095 begin 2096 uix := uix1; 2097 Strength := TestStrength; 2098 Bonus := TestBonus; 2099 Det := TestDet; 2100 Cost := TestCost; 1812 2101 end 1813 2102 end … … 1818 2107 function UnitSpeed(p, mix, Health: integer): integer; 1819 2108 begin 1820 with RW[p].Model[mix] do 1821 begin 1822 result:=Speed; 1823 if Domain=dSea then 1824 begin 1825 if GWonder[woMagellan].EffectiveOwner=p then inc(result,200); 1826 if Health<100 then 1827 result:=((result-250)*Health div 5000)*50+250; 2109 with RW[p].Model[mix] do 2110 begin 2111 result := Speed; 2112 if Domain = dSea then 2113 begin 2114 if GWonder[woMagellan].EffectiveOwner = p then 2115 inc(result, 200); 2116 if Health < 100 then 2117 result := ((result - 250) * Health div 5000) * 50 + 250; 1828 2118 end 1829 2119 end 1830 2120 end; 1831 2121 1832 procedure GetUnitReport(p,uix: integer; var UnitReport: TUnitReport); 1833 var 1834 TerrOwner: integer; 1835 PModel: ^TModel; 1836 begin 1837 UnitReport.FoodSupport:=0; 1838 UnitReport.ProdSupport:=0; 1839 UnitReport.ReportFlags:=0; 1840 if RW[p].Government<>gAnarchy then with RW[p].Un[uix] do 1841 begin 1842 PModel:=@RW[p].Model[mix]; 1843 if (PModel.Kind=mkSettler) {and (GWonder[woFreeSettlers].EffectiveOwner<>p)} then 1844 UnitReport.FoodSupport:=SettlerFood[RW[p].Government] 1845 else if Flags and unConscripts<>0 then UnitReport.FoodSupport:=1; 1846 1847 if RW[p].Government<>gFundamentalism then 1848 begin 1849 if GTestFlags and tfImmImprove=0 then 1850 begin 1851 if PModel.Flags and mdDoubleSupport<>0 then 1852 UnitReport.ProdSupport:=2 1853 else UnitReport.ProdSupport:=1; 1854 if PModel.Kind=mkSpecial_TownGuard then 1855 UnitReport.ReportFlags:=UnitReport.ReportFlags or urfAlwaysSupport; 1856 end; 1857 if PModel.Flags and mdCivil=0 then 1858 begin 1859 TerrOwner:=RealMap[Loc] shr 27; 1860 case RW[p].Government of 1861 gRepublic, gFuture: 1862 if (TerrOwner<>p) and (TerrOwner<nPl) 1863 and (RW[p].Treaty[TerrOwner]<trAlliance) then 1864 UnitReport.ReportFlags:=UnitReport.ReportFlags or urfDeployed; 1865 gDemocracy: 1866 if (TerrOwner>=nPl) or (TerrOwner<>p) 1867 and (RW[p].Treaty[TerrOwner]<trAlliance) then 1868 UnitReport.ReportFlags:=UnitReport.ReportFlags or urfDeployed; 2122 procedure GetUnitReport(p, uix: integer; var UnitReport: TUnitReport); 2123 var 2124 TerrOwner: integer; 2125 PModel: ^TModel; 2126 begin 2127 UnitReport.FoodSupport := 0; 2128 UnitReport.ProdSupport := 0; 2129 UnitReport.ReportFlags := 0; 2130 if RW[p].Government <> gAnarchy then 2131 with RW[p].Un[uix] do 2132 begin 2133 PModel := @RW[p].Model[mix]; 2134 if (PModel.Kind = mkSettler) 2135 { and (GWonder[woFreeSettlers].EffectiveOwner<>p) } then 2136 UnitReport.FoodSupport := SettlerFood[RW[p].Government] 2137 else if Flags and unConscripts <> 0 then 2138 UnitReport.FoodSupport := 1; 2139 2140 if RW[p].Government <> gFundamentalism then 2141 begin 2142 if GTestFlags and tfImmImprove = 0 then 2143 begin 2144 if PModel.Flags and mdDoubleSupport <> 0 then 2145 UnitReport.ProdSupport := 2 2146 else 2147 UnitReport.ProdSupport := 1; 2148 if PModel.Kind = mkSpecial_TownGuard then 2149 UnitReport.ReportFlags := UnitReport.ReportFlags or 2150 urfAlwaysSupport; 1869 2151 end; 1870 end 1871 end; 1872 end; 1873 end; 1874 1875 procedure SearchCity(Loc: integer; var p,cix: integer); 2152 if PModel.Flags and mdCivil = 0 then 2153 begin 2154 TerrOwner := RealMap[Loc] shr 27; 2155 case RW[p].Government of 2156 gRepublic, gFuture: 2157 if (TerrOwner <> p) and (TerrOwner < nPl) and 2158 (RW[p].Treaty[TerrOwner] < trAlliance) then 2159 UnitReport.ReportFlags := UnitReport.ReportFlags or urfDeployed; 2160 gDemocracy: 2161 if (TerrOwner >= nPl) or (TerrOwner <> p) and 2162 (RW[p].Treaty[TerrOwner] < trAlliance) then 2163 UnitReport.ReportFlags := UnitReport.ReportFlags or urfDeployed; 2164 end; 2165 end 2166 end; 2167 end; 2168 end; 2169 2170 procedure SearchCity(Loc: integer; var p, cix: integer); 1876 2171 // set p to supposed owner before call 1877 2172 var 1878 i: integer; 1879 begin 1880 if RealMap[Loc]<nPl shl 27 then p:=RealMap[Loc] shr 27; 1881 for i:=0 to nPl-1 do 1882 begin 1883 if 1 shl p and GAlive<>0 then with RW[p] do 1884 begin 1885 cix:=nCity-1; 1886 while (cix>=0) and (City[cix].Loc<>Loc) do dec(cix); 1887 if cix>=0 then exit; 1888 end; 1889 assert(i<nPl-1); 1890 p:=(p+1) mod nPl; 2173 i: integer; 2174 begin 2175 if RealMap[Loc] < nPl shl 27 then 2176 p := RealMap[Loc] shr 27; 2177 for i := 0 to nPl - 1 do 2178 begin 2179 if 1 shl p and GAlive <> 0 then 2180 with RW[p] do 2181 begin 2182 cix := nCity - 1; 2183 while (cix >= 0) and (City[cix].Loc <> Loc) do 2184 dec(cix); 2185 if cix >= 0 then 2186 exit; 2187 end; 2188 assert(i < nPl - 1); 2189 p := (p + 1) mod nPl; 1891 2190 end; 1892 2191 end; … … 1894 2193 procedure MakeCityInfo(p, cix: integer; var ci: TCityInfo); 1895 2194 begin 1896 assert((p>=0) and (p<nPl)); 1897 assert((cix>=0) and (cix<RW[p].nCity)); 1898 with RW[p].City[cix] do 1899 begin 1900 ci.Loc:=Loc; 1901 ci.ID:=ID; 1902 ci.Owner:=p; 1903 ci.Size:=Size; 1904 ci.Flags:=0; 1905 if Built[imPalace]>0 then inc(ci.Flags,ciCapital); 1906 if (Built[imWalls]>0) or (Continent[Loc]=GrWallContinent[p]) then 1907 inc(ci.Flags,ciWalled); 1908 if Built[imCoastalFort]>0 then inc(ci.Flags,ciCoastalFort); 1909 if Built[imMissileBat]>0 then inc(ci.Flags,ciMissileBat); 1910 if Built[imBunker]>0 then inc(ci.Flags,ciBunker); 1911 if Built[imSpacePort]>0 then inc(ci.Flags,ciSpacePort); 1912 end; 1913 end; 1914 1915 procedure TellAboutModel(p,taOwner,tamix: integer); 1916 var 1917 i: integer; 1918 begin 1919 if (p=taOwner) or (Mode<moPlaying) then exit; 1920 i:=0; 1921 while (i<RW[p].nEnemyModel) 1922 and ((RW[p].EnemyModel[i].Owner<>taOwner) 1923 or (RW[p].EnemyModel[i].mix<>tamix)) do inc(i); 1924 if i=RW[p].nEnemyModel then 1925 IntServer(sIntTellAboutModel+p shl 4,taOwner,tamix,nil^); 1926 end; 1927 1928 function emixSafe(p,taOwner,tamix: integer): integer; 1929 begin 1930 result:=RWemix[p,taOwner,tamix]; 1931 if result<0 then 2195 assert((p >= 0) and (p < nPl)); 2196 assert((cix >= 0) and (cix < RW[p].nCity)); 2197 with RW[p].City[cix] do 2198 begin 2199 ci.Loc := Loc; 2200 ci.ID := ID; 2201 ci.Owner := p; 2202 ci.Size := Size; 2203 ci.Flags := 0; 2204 if Built[imPalace] > 0 then 2205 inc(ci.Flags, ciCapital); 2206 if (Built[imWalls] > 0) or (Continent[Loc] = GrWallContinent[p]) then 2207 inc(ci.Flags, ciWalled); 2208 if Built[imCoastalFort] > 0 then 2209 inc(ci.Flags, ciCoastalFort); 2210 if Built[imMissileBat] > 0 then 2211 inc(ci.Flags, ciMissileBat); 2212 if Built[imBunker] > 0 then 2213 inc(ci.Flags, ciBunker); 2214 if Built[imSpacePort] > 0 then 2215 inc(ci.Flags, ciSpacePort); 2216 end; 2217 end; 2218 2219 procedure TellAboutModel(p, taOwner, tamix: integer); 2220 var 2221 i: integer; 2222 begin 2223 if (p = taOwner) or (Mode < moPlaying) then 2224 exit; 2225 i := 0; 2226 while (i < RW[p].nEnemyModel) and ((RW[p].EnemyModel[i].Owner <> taOwner) or 2227 (RW[p].EnemyModel[i].mix <> tamix)) do 2228 inc(i); 2229 if i = RW[p].nEnemyModel then 2230 IntServer(sIntTellAboutModel + p shl 4, taOwner, tamix, nil^); 2231 end; 2232 2233 function emixSafe(p, taOwner, tamix: integer): integer; 2234 begin 2235 result := RWemix[p, taOwner, tamix]; 2236 if result < 0 then 1932 2237 begin // sIntTellAboutModel comes too late 1933 assert(Mode=moMovie);1934 result:=$FFFF;1935 end; 1936 end; 1937 1938 procedure IntroduceEnemy(p1, p2: integer);1939 begin 1940 RW[p1].Treaty[p2]:=trNone;1941 RW[p2].Treaty[p1]:=trNone;1942 end; 1943 1944 function DiscoverTile(Loc, p, pTell, Level: integer; 1945 EnableContact: boolean;euix: integer = -2): boolean;2238 assert(Mode = moMovie); 2239 result := $FFFF; 2240 end; 2241 end; 2242 2243 procedure IntroduceEnemy(p1, p2: integer); 2244 begin 2245 RW[p1].Treaty[p2] := trNone; 2246 RW[p2].Treaty[p1] := trNone; 2247 end; 2248 2249 function DiscoverTile(Loc, p, pTell, Level: integer; EnableContact: boolean; 2250 euix: integer = -2): boolean; 1946 2251 // euix = -2: full discover 1947 2252 // euix = -1: unit and city only, append units in EnemyUn 1948 2253 // euix >= 0: unit and city only, replace EnemyUn[euix] 1949 2254 1950 procedure SetContact(p1,p2: integer); 1951 begin 1952 if (Mode<moPlaying) or (p1=p2) or (RW[p1].Treaty[p2]>trNoContact) then exit; 1953 IntServer(sIntTellAboutNation,p1,p2,nil^); 1954 // NewContact[p1,p2]:=true 1955 end; 1956 1957 var 1958 i,uix,cix,TerrOwner,TerrOwnerTreaty,Strength,Bonus,Cnt,pFoundCity, 1959 cixFoundCity,MinLevel,Loc1,V8: integer; 1960 Tile,AddFlags: Cardinal; 1961 Adjacent: TVicinity8Loc; 1962 unx: ^TUn; 1963 mox: ^TModel; 1964 begin 1965 result:=false; 1966 with RW[pTell] do 1967 begin 1968 Tile:=RealMap[Loc] and ResourceMask[pTell]; 1969 if Mode=moLoading_Fast then AddFlags:=0 // don't discover units 1970 else 1971 begin 1972 AddFlags:=Map[Loc] and fInEnemyZoC // always preserve this flag! 1973 or fObserved; 1974 if Level=lObserveSuper then 1975 AddFlags:=AddFlags or fSpiedOut; 1976 if (GrWallContinent[pTell]>=0) and (Continent[Loc]=GrWallContinent[pTell]) then 1977 AddFlags:=AddFlags or fGrWall; 1978 if (Mode=moPlaying) and ((Tile and (nPl shl 27)<>nPl shl 27) and (pTell=p)) then 2255 procedure SetContact(p1, p2: integer); 2256 begin 2257 if (Mode < moPlaying) or (p1 = p2) or (RW[p1].Treaty[p2] > trNoContact) then 2258 exit; 2259 IntServer(sIntTellAboutNation, p1, p2, nil^); 2260 // NewContact[p1,p2]:=true 2261 end; 2262 2263 var 2264 i, uix, cix, TerrOwner, TerrOwnerTreaty, Strength, Bonus, Cnt, pFoundCity, 2265 cixFoundCity, MinLevel, Loc1, V8: integer; 2266 Tile, AddFlags: Cardinal; 2267 Adjacent: TVicinity8Loc; 2268 unx: ^TUn; 2269 mox: ^TModel; 2270 begin 2271 result := false; 2272 with RW[pTell] do 2273 begin 2274 Tile := RealMap[Loc] and ResourceMask[pTell]; 2275 if Mode = moLoading_Fast then 2276 AddFlags := 0 // don't discover units 2277 else 2278 begin 2279 AddFlags := Map[Loc] and fInEnemyZoC // always preserve this flag! 2280 or fObserved; 2281 if Level = lObserveSuper then 2282 AddFlags := AddFlags or fSpiedOut; 2283 if (GrWallContinent[pTell] >= 0) and 2284 (Continent[Loc] = GrWallContinent[pTell]) then 2285 AddFlags := AddFlags or fGrWall; 2286 if (Mode = moPlaying) and ((Tile and (nPl shl 27) <> nPl shl 27) and 2287 (pTell = p)) then 1979 2288 begin // set fPeace flag? 1980 TerrOwner:=Tile shr 27;1981 if TerrOwner<>pTell then1982 begin 1983 TerrOwnerTreaty:=RW[pTell].Treaty[TerrOwner];1984 if 1 shl TerrOwnerTreaty1985 and (1 shl trPeace or 1 shl TrFriendlyContact)<>0 then1986 AddFlags:=AddFlags or fPeace;2289 TerrOwner := Tile shr 27; 2290 if TerrOwner <> pTell then 2291 begin 2292 TerrOwnerTreaty := RW[pTell].Treaty[TerrOwner]; 2293 if 1 shl TerrOwnerTreaty and 2294 (1 shl trPeace or 1 shl TrFriendlyContact) <> 0 then 2295 AddFlags := AddFlags or fPeace; 1987 2296 end 1988 2297 end; 1989 2298 1990 if Occupant[Loc]>=0 then 1991 if Occupant[Loc]=pTell then 1992 begin 1993 AddFlags:=AddFlags or (fOwned or fUnit); 1994 if ZoCMap[Loc]>0 then AddFlags:=AddFlags or fOwnZoCUnit; 1995 // Level:=lObserveSuper // always see own units 2299 if Occupant[Loc] >= 0 then 2300 if Occupant[Loc] = pTell then 2301 begin 2302 AddFlags := AddFlags or (fOwned or fUnit); 2303 if ZoCMap[Loc] > 0 then 2304 AddFlags := AddFlags or fOwnZoCUnit; 2305 // Level:=lObserveSuper // always see own units 1996 2306 end 1997 else if Map[Loc] and fUnit<>0 then 1998 AddFlags:=AddFlags or fUnit 1999 else 2000 begin 2001 Strongest(Loc,uix,Strength,Bonus,Cnt); 2002 unx:=@RW[Occupant[Loc]].Un[uix]; 2003 mox:=@RW[Occupant[Loc]].Model[unx.mix]; 2004 assert((ZoCMap[Loc]<>0)=(mox.Flags and mdZOC<>0)); 2005 if (mox.Cap[mcStealth]>0) and (Tile and fCity=0) 2006 and (Tile and fTerImp<>tiBase) then 2007 MinLevel:=lObserveSuper 2008 else if (mox.Cap[mcSub]>0) and (Tile and fTerrain<fGrass) then 2009 MinLevel:=lObserveAll 2010 else MinLevel:=lObserveUnhidden; 2011 if Level>=MinLevel then 2307 else if Map[Loc] and fUnit <> 0 then 2308 AddFlags := AddFlags or fUnit 2309 else 2310 begin 2311 Strongest(Loc, uix, Strength, Bonus, Cnt); 2312 unx := @RW[Occupant[Loc]].Un[uix]; 2313 mox := @RW[Occupant[Loc]].Model[unx.mix]; 2314 assert((ZoCMap[Loc] <> 0) = (mox.Flags and mdZOC <> 0)); 2315 if (mox.Cap[mcStealth] > 0) and (Tile and fCity = 0) and 2316 (Tile and fTerImp <> tiBase) then 2317 MinLevel := lObserveSuper 2318 else if (mox.Cap[mcSub] > 0) and (Tile and fTerrain < fGrass) then 2319 MinLevel := lObserveAll 2320 else 2321 MinLevel := lObserveUnhidden; 2322 if Level >= MinLevel then 2012 2323 begin 2013 AddFlags:=AddFlags or fUnit; 2014 if euix>=0 then uix:=euix 2015 else 2324 AddFlags := AddFlags or fUnit; 2325 if euix >= 0 then 2326 uix := euix 2327 else 2016 2328 begin 2017 uix:=nEnemyUn;2018 inc(nEnemyUn);2019 assert(nEnemyUn<neumax);2329 uix := nEnemyUn; 2330 inc(nEnemyUn); 2331 assert(nEnemyUn < neumax); 2020 2332 end; 2021 MakeUnitInfo(Occupant[Loc],unx^,EnemyUn[uix]);2022 if Cnt>1 then2023 EnemyUn[uix].Flags:=EnemyUn[uix].Flags or unMulti;2024 if (mox.Flags and mdZOC<>0) and (pTell=p)2025 and (Treaty[Occupant[Loc]]<trAlliance) then2333 MakeUnitInfo(Occupant[Loc], unx^, EnemyUn[uix]); 2334 if Cnt > 1 then 2335 EnemyUn[uix].Flags := EnemyUn[uix].Flags or unMulti; 2336 if (mox.Flags and mdZOC <> 0) and (pTell = p) and 2337 (Treaty[Occupant[Loc]] < trAlliance) then 2026 2338 begin // set fInEnemyZoC flags of surrounding tiles 2027 V8_to_Loc(Loc,Adjacent);2028 for V8:=0 to 7 do2339 V8_to_Loc(Loc, Adjacent); 2340 for V8 := 0 to 7 do 2029 2341 begin 2030 Loc1:=Adjacent[V8];2031 if (Loc1>=0) and (Loc1<MapSize) then2032 Map[Loc1]:=Map[Loc1] or fInEnemyZoC2342 Loc1 := Adjacent[V8]; 2343 if (Loc1 >= 0) and (Loc1 < MapSize) then 2344 Map[Loc1] := Map[Loc1] or fInEnemyZoC 2033 2345 end 2034 2346 end; 2035 if EnableContact and (mox.Domain=dGround) then2036 SetContact(pTell,Occupant[Loc]);2037 if Mode>=moMovie then2347 if EnableContact and (mox.Domain = dGround) then 2348 SetContact(pTell, Occupant[Loc]); 2349 if Mode >= moMovie then 2038 2350 begin 2039 TellAboutModel(pTell,Occupant[Loc],unx.mix);2040 EnemyUn[uix].emix:=emixSafe(pTell,Occupant[Loc],unx.mix);2351 TellAboutModel(pTell, Occupant[Loc], unx.mix); 2352 EnemyUn[uix].emix := emixSafe(pTell, Occupant[Loc], unx.mix); 2041 2353 end; 2042 //Level:=lObserveSuper; // don't discover unit twice2043 if (pTell=p)2044 and ((Tile and fCity=0) or (1 shl pTell and GAI<>0)) then2045 result:=true;2354 // Level:=lObserveSuper; // don't discover unit twice 2355 if (pTell = p) and 2356 ((Tile and fCity = 0) or (1 shl pTell and GAI <> 0)) then 2357 result := true; 2046 2358 end 2047 else AddFlags:=AddFlags or Map[Loc] and (fStealthUnit or fHiddenUnit) 2359 else 2360 AddFlags := AddFlags or Map[Loc] and (fStealthUnit or fHiddenUnit) 2048 2361 end 2049 2362 end; // if Mode>moLoading_Fast 2050 2363 2051 if Tile and fCity<>0 then 2052 if ObserveLevel[Loc] shr (2*pTell) and 3>0 then 2053 AddFlags:=AddFlags or Map[Loc] and fOwned 2054 else 2055 begin 2056 pFoundCity:=Tile shr 27; 2057 if pFoundCity=pTell then AddFlags:=AddFlags or fOwned 2364 if Tile and fCity <> 0 then 2365 if ObserveLevel[Loc] shr (2 * pTell) and 3 > 0 then 2366 AddFlags := AddFlags or Map[Loc] and fOwned 2058 2367 else 2059 begin 2060 if EnableContact then SetContact(pTell,pFoundCity); 2061 cixFoundCity:=RW[pFoundCity].nCity-1; 2062 while (cixFoundCity>=0) 2063 and (RW[pFoundCity].City[cixFoundCity].Loc<>Loc) do 2064 dec(cixFoundCity); 2065 assert(cixFoundCity>=0); 2066 i:=0; 2067 while (i<nEnemyCity) and (EnemyCity[i].Loc<>Loc) do 2068 inc(i); 2069 if i=nEnemyCity then 2368 begin 2369 pFoundCity := Tile shr 27; 2370 if pFoundCity = pTell then 2371 AddFlags := AddFlags or fOwned 2372 else 2373 begin 2374 if EnableContact then 2375 SetContact(pTell, pFoundCity); 2376 cixFoundCity := RW[pFoundCity].nCity - 1; 2377 while (cixFoundCity >= 0) and 2378 (RW[pFoundCity].City[cixFoundCity].Loc <> Loc) do 2379 dec(cixFoundCity); 2380 assert(cixFoundCity >= 0); 2381 i := 0; 2382 while (i < nEnemyCity) and (EnemyCity[i].Loc <> Loc) do 2383 inc(i); 2384 if i = nEnemyCity then 2070 2385 begin 2071 inc(nEnemyCity); 2072 assert(nEnemyCity<necmax); 2073 EnemyCity[i].Status:=0; 2074 EnemyCity[i].SavedStatus:=0; 2075 if pTell=p then result:=true; 2386 inc(nEnemyCity); 2387 assert(nEnemyCity < necmax); 2388 EnemyCity[i].Status := 0; 2389 EnemyCity[i].SavedStatus := 0; 2390 if pTell = p then 2391 result := true; 2076 2392 end; 2077 MakeCityInfo(pFoundCity,cixFoundCity,EnemyCity[i]);2393 MakeCityInfo(pFoundCity, cixFoundCity, EnemyCity[i]); 2078 2394 end; 2079 2395 end 2080 else if Map[Loc] and fCity<>0 then // remove enemycity 2081 for cix:=0 to nEnemyCity-1 do 2082 if EnemyCity[cix].Loc=Loc then 2083 EnemyCity[cix].Loc:=-1; 2084 2085 if Map[Loc] and fTerrain=fUNKNOWN then inc(Discovered[pTell]); 2086 if euix>=-1 then 2087 Map[Loc]:=Map[Loc] and not (fUnit or fCity or fOwned or fOwnZoCUnit) 2088 or (Tile and $07FFFFFF or AddFlags) and (fUnit or fCity or fOwned or fOwnZoCUnit) 2089 else 2090 begin 2091 Map[Loc]:=Tile and $07FFFFFF or AddFlags; 2092 if Tile and $78000000=$78000000 then Territory[Loc]:=-1 2093 else Territory[Loc]:=Tile shr 27; 2094 MapObservedLast[Loc]:=GTurn 2095 end; 2096 ObserveLevel[Loc]:=ObserveLevel[Loc] and not (3 shl (2*pTell)) 2097 or Cardinal(Level) shl (2*pTell); 2396 else if Map[Loc] and fCity <> 0 then // remove enemycity 2397 for cix := 0 to nEnemyCity - 1 do 2398 if EnemyCity[cix].Loc = Loc then 2399 EnemyCity[cix].Loc := -1; 2400 2401 if Map[Loc] and fTerrain = fUNKNOWN then 2402 inc(Discovered[pTell]); 2403 if euix >= -1 then 2404 Map[Loc] := Map[Loc] and not(fUnit or fCity or fOwned or fOwnZoCUnit) or 2405 (Tile and $07FFFFFF or AddFlags) and 2406 (fUnit or fCity or fOwned or fOwnZoCUnit) 2407 else 2408 begin 2409 Map[Loc] := Tile and $07FFFFFF or AddFlags; 2410 if Tile and $78000000 = $78000000 then 2411 Territory[Loc] := -1 2412 else 2413 Territory[Loc] := Tile shr 27; 2414 MapObservedLast[Loc] := GTurn 2415 end; 2416 ObserveLevel[Loc] := ObserveLevel[Loc] and not(3 shl (2 * pTell)) or 2417 Cardinal(Level) shl (2 * pTell); 2098 2418 end 2099 2419 end; // DiscoverTile 2100 2420 2101 function Discover9(Loc,p,Level: integer; TellAllied, EnableContact: boolean): boolean; 2102 var 2103 V9,Loc1,pTell,OldLevel: integer; 2104 Radius: TVicinity8Loc; 2105 begin 2106 assert((Mode>moLoading_Fast) or (RW[p].nEnemyUn=0)); 2107 result:=false; 2108 V8_to_Loc(Loc,Radius); 2109 for V9:=0 to 8 do 2110 begin 2111 if V9=8 then Loc1:=Loc 2112 else Loc1:=Radius[V9]; 2113 if (Loc1>=0) and (Loc1<MapSize) then 2114 if TellAllied then 2115 begin 2116 for pTell:=0 to nPl-1 do 2117 if (pTell=p) or (1 shl pTell and GAlive<>0) 2118 and (RW[p].Treaty[pTell]=trAlliance) then 2421 function Discover9(Loc, p, Level: integer; 2422 TellAllied, EnableContact: boolean): boolean; 2423 var 2424 V9, Loc1, pTell, OldLevel: integer; 2425 Radius: TVicinity8Loc; 2426 begin 2427 assert((Mode > moLoading_Fast) or (RW[p].nEnemyUn = 0)); 2428 result := false; 2429 V8_to_Loc(Loc, Radius); 2430 for V9 := 0 to 8 do 2431 begin 2432 if V9 = 8 then 2433 Loc1 := Loc 2434 else 2435 Loc1 := Radius[V9]; 2436 if (Loc1 >= 0) and (Loc1 < MapSize) then 2437 if TellAllied then 2438 begin 2439 for pTell := 0 to nPl - 1 do 2440 if (pTell = p) or (1 shl pTell and GAlive <> 0) and 2441 (RW[p].Treaty[pTell] = trAlliance) then 2119 2442 begin 2120 OldLevel:=ObserveLevel[Loc1] shr (2*pTell) and 3; 2121 if Level>OldLevel then 2122 result:=DiscoverTile(Loc1,p,pTell,Level,EnableContact) or result; 2443 OldLevel := ObserveLevel[Loc1] shr (2 * pTell) and 3; 2444 if Level > OldLevel then 2445 result := DiscoverTile(Loc1, p, pTell, Level, EnableContact) 2446 or result; 2123 2447 end 2124 2448 end 2125 else2126 begin 2127 OldLevel:=ObserveLevel[Loc1] shr (2*p) and 3;2128 if Level>OldLevel then2129 result:=DiscoverTile(Loc1,p,p,Level,EnableContact) or result;2449 else 2450 begin 2451 OldLevel := ObserveLevel[Loc1] shr (2 * p) and 3; 2452 if Level > OldLevel then 2453 result := DiscoverTile(Loc1, p, p, Level, EnableContact) or result; 2130 2454 end 2131 2455 end; 2132 2456 end; 2133 2457 2134 function Discover21(Loc,p,AdjacentLevel: integer; TellAllied, EnableContact: boolean): boolean; 2135 var 2136 V21,Loc1,pTell,Level,OldLevel,AdjacentFlags: integer; 2137 Radius: TVicinity21Loc; 2138 begin 2139 assert((Mode>moLoading_Fast) or (RW[p].nEnemyUn=0)); 2140 result:=false; 2141 AdjacentFlags:=$00267620 shr 1; 2142 V21_to_Loc(Loc,Radius); 2143 for V21:=1 to 26 do 2144 begin 2145 Loc1:=Radius[V21]; 2146 if (Loc1>=0) and (Loc1<MapSize) then 2147 begin 2148 if AdjacentFlags and 1<>0 then Level:=AdjacentLevel 2149 else Level:=lObserveUnhidden; 2150 if TellAllied then 2151 begin 2152 for pTell:=0 to nPl-1 do 2153 if (pTell=p) or (1 shl pTell and GAlive<>0) 2154 and (RW[p].Treaty[pTell]=trAlliance) then 2458 function Discover21(Loc, p, AdjacentLevel: integer; 2459 TellAllied, EnableContact: boolean): boolean; 2460 var 2461 V21, Loc1, pTell, Level, OldLevel, AdjacentFlags: integer; 2462 Radius: TVicinity21Loc; 2463 begin 2464 assert((Mode > moLoading_Fast) or (RW[p].nEnemyUn = 0)); 2465 result := false; 2466 AdjacentFlags := $00267620 shr 1; 2467 V21_to_Loc(Loc, Radius); 2468 for V21 := 1 to 26 do 2469 begin 2470 Loc1 := Radius[V21]; 2471 if (Loc1 >= 0) and (Loc1 < MapSize) then 2472 begin 2473 if AdjacentFlags and 1 <> 0 then 2474 Level := AdjacentLevel 2475 else 2476 Level := lObserveUnhidden; 2477 if TellAllied then 2478 begin 2479 for pTell := 0 to nPl - 1 do 2480 if (pTell = p) or (1 shl pTell and GAlive <> 0) and 2481 (RW[p].Treaty[pTell] = trAlliance) then 2155 2482 begin 2156 OldLevel:=ObserveLevel[Loc1] shr (2*pTell) and 3; 2157 if Level>OldLevel then 2158 result:=DiscoverTile(Loc1,p,pTell,Level,EnableContact) or result; 2483 OldLevel := ObserveLevel[Loc1] shr (2 * pTell) and 3; 2484 if Level > OldLevel then 2485 result := DiscoverTile(Loc1, p, pTell, Level, EnableContact) 2486 or result; 2159 2487 end 2160 2488 end 2161 else2162 begin 2163 OldLevel:=ObserveLevel[Loc1] shr (2*p) and 3;2164 if Level>OldLevel then2165 result:=DiscoverTile(Loc1,p,p,Level,EnableContact) or result;2489 else 2490 begin 2491 OldLevel := ObserveLevel[Loc1] shr (2 * p) and 3; 2492 if Level > OldLevel then 2493 result := DiscoverTile(Loc1, p, p, Level, EnableContact) or result; 2166 2494 end 2167 2495 end; 2168 AdjacentFlags:=AdjacentFlags shr 1;2496 AdjacentFlags := AdjacentFlags shr 1; 2169 2497 end; 2170 2498 end; 2171 2499 2172 2500 procedure DiscoverAll(p, Level: integer); 2173 { player p discovers complete playground (for supervisor)}2174 var 2175 Loc, OldLevel: integer;2176 begin 2177 assert((Mode>moLoading_Fast) or (RW[p].nEnemyUn=0));2178 for Loc:=0 to MapSize-1 do2179 begin 2180 OldLevel:=ObserveLevel[Loc] shr (2*p) and 3;2181 if Level>OldLevel then2182 DiscoverTile(Loc,p,p,Level,false);2501 { player p discovers complete playground (for supervisor) } 2502 var 2503 Loc, OldLevel: integer; 2504 begin 2505 assert((Mode > moLoading_Fast) or (RW[p].nEnemyUn = 0)); 2506 for Loc := 0 to MapSize - 1 do 2507 begin 2508 OldLevel := ObserveLevel[Loc] shr (2 * p) and 3; 2509 if Level > OldLevel then 2510 DiscoverTile(Loc, p, p, Level, false); 2183 2511 end; 2184 2512 end; … … 2186 2514 procedure DiscoverViewAreas(p: integer); 2187 2515 var 2188 pTell, uix, cix, ecix, Loc, RealOwner: integer;2189 PModel: ^TModel;2516 pTell, uix, cix, ecix, Loc, RealOwner: integer; 2517 PModel: ^TModel; 2190 2518 begin // discover unit and city view areas 2191 for pTell:=0 to nPl-1 do 2192 if (pTell=p) or (RW[p].Treaty[pTell]=trAlliance) then 2193 begin 2194 for uix:=0 to RW[pTell].nUn-1 do with RW[pTell].Un[uix] do 2195 if (Loc>=0) and (master<0) and (RealMap[Loc] and fCity=0) then 2196 begin 2197 PModel:=@RW[pTell].Model[mix]; 2198 if (PModel.Kind=mkDiplomat) or (PModel.Cap[mcSpy]>0) then 2199 Discover21(Loc,p,lObserveSuper,false,true) 2200 else if (PModel.Cap[mcRadar]+PModel.Cap[mcCarrier]>0) 2201 or (PModel.Domain=dAir) then 2202 Discover21(Loc,p,lObserveAll,false,false) 2203 else if (RealMap[Loc] and fTerrain=fMountains) 2204 or (RealMap[Loc] and fTerImp=tiFort) 2205 or (RealMap[Loc] and fTerImp=tiBase) 2206 or (PModel.Cap[mcAcademy]>0) then 2207 Discover21(Loc,p,lObserveUnhidden,false,PModel.Domain=dGround) 2208 else Discover9(Loc,p,lObserveUnhidden,false,PModel.Domain=dGround); 2209 end; 2210 for cix:=0 to RW[pTell].nCity-1 do if RW[pTell].City[cix].Loc>=0 then 2211 Discover21(RW[pTell].City[cix].Loc,p,lObserveUnhidden,false,true); 2212 for ecix:=0 to RW[pTell].nEnemyCity-1 do 2519 for pTell := 0 to nPl - 1 do 2520 if (pTell = p) or (RW[p].Treaty[pTell] = trAlliance) then 2521 begin 2522 for uix := 0 to RW[pTell].nUn - 1 do 2523 with RW[pTell].Un[uix] do 2524 if (Loc >= 0) and (Master < 0) and (RealMap[Loc] and fCity = 0) then 2525 begin 2526 PModel := @RW[pTell].Model[mix]; 2527 if (PModel.Kind = mkDiplomat) or (PModel.Cap[mcSpy] > 0) then 2528 Discover21(Loc, p, lObserveSuper, false, true) 2529 else if (PModel.Cap[mcRadar] + PModel.Cap[mcCarrier] > 0) or 2530 (PModel.Domain = dAir) then 2531 Discover21(Loc, p, lObserveAll, false, false) 2532 else if (RealMap[Loc] and fTerrain = fMountains) or 2533 (RealMap[Loc] and fTerImp = tiFort) or 2534 (RealMap[Loc] and fTerImp = tiBase) or (PModel.Cap[mcAcademy] > 0) 2535 then 2536 Discover21(Loc, p, lObserveUnhidden, false, 2537 PModel.Domain = dGround) 2538 else 2539 Discover9(Loc, p, lObserveUnhidden, false, 2540 PModel.Domain = dGround); 2541 end; 2542 for cix := 0 to RW[pTell].nCity - 1 do 2543 if RW[pTell].City[cix].Loc >= 0 then 2544 Discover21(RW[pTell].City[cix].Loc, p, lObserveUnhidden, false, true); 2545 for ecix := 0 to RW[pTell].nEnemyCity - 1 do 2213 2546 begin // players know territory, so no use in hiding city owner 2214 Loc:=RW[pTell].EnemyCity[ecix].Loc;2215 if Loc>=0 then2216 begin 2217 RealOwner:=(RealMap[Loc] shr 27) and $F;2218 if RealOwner<nPl then2219 RW[pTell].EnemyCity[ecix].owner:=RealOwner2220 else2547 Loc := RW[pTell].EnemyCity[ecix].Loc; 2548 if Loc >= 0 then 2549 begin 2550 RealOwner := (RealMap[Loc] shr 27) and $F; 2551 if RealOwner < nPl then 2552 RW[pTell].EnemyCity[ecix].Owner := RealOwner 2553 else 2221 2554 begin 2222 RW[pTell].EnemyCity[ecix].Loc:=-1;2223 RW[pTell].Map[Loc]:=RW[pTell].Map[Loc] and not fCity2555 RW[pTell].EnemyCity[ecix].Loc := -1; 2556 RW[pTell].Map[Loc] := RW[pTell].Map[Loc] and not fCity 2224 2557 end 2225 2558 end … … 2228 2561 end; 2229 2562 2230 function GetUnitStack(p,Loc: integer): integer; 2231 var 2232 uix: integer; 2233 unx: ^TUn; 2234 begin 2235 result:=0; 2236 if Occupant[Loc]<0 then exit; 2237 for uix:=0 to RW[Occupant[Loc]].nUn-1 do 2238 begin 2239 unx:=@RW[Occupant[Loc]].Un[uix]; 2240 if unx.Loc=Loc then 2241 begin 2242 MakeUnitInfo(Occupant[Loc],unx^,RW[p].EnemyUn[RW[p].nEnemyUn+result]); 2243 TellAboutModel(p,Occupant[Loc],unx.mix); 2244 RW[p].EnemyUn[RW[p].nEnemyUn+result].emix:=RWemix[p,Occupant[Loc],unx.mix]; 2245 inc(result); 2563 function GetUnitStack(p, Loc: integer): integer; 2564 var 2565 uix: integer; 2566 unx: ^TUn; 2567 begin 2568 result := 0; 2569 if Occupant[Loc] < 0 then 2570 exit; 2571 for uix := 0 to RW[Occupant[Loc]].nUn - 1 do 2572 begin 2573 unx := @RW[Occupant[Loc]].Un[uix]; 2574 if unx.Loc = Loc then 2575 begin 2576 MakeUnitInfo(Occupant[Loc], unx^, RW[p].EnemyUn[RW[p].nEnemyUn + result]); 2577 TellAboutModel(p, Occupant[Loc], unx.mix); 2578 RW[p].EnemyUn[RW[p].nEnemyUn + result].emix := 2579 RWemix[p, Occupant[Loc], unx.mix]; 2580 inc(result); 2246 2581 end 2247 2582 end … … 2251 2586 // update maps and enemy units of all players after unit change 2252 2587 var 2253 p, euix, OldLevel: integer; 2254 AddFlags, ClearFlags: Cardinal; 2255 begin 2256 if (Mode=moLoading_Fast) and not CityChange then exit; 2257 for p:=0 to nPl-1 do if 1 shl p and (GAlive or GWatching)<>0 then 2258 begin 2259 OldLevel:=ObserveLevel[Loc] shr (2*p) and 3; 2260 if OldLevel>lNoObserve then 2261 begin 2262 if RW[p].Map[Loc] and (fUnit or fOwned)=fUnit then 2263 begin 2264 // replace unit located here in EnemyUn 2265 // do not just set loc:=-1 because total number would be unlimited 2266 euix:=RW[p].nEnemyUn-1; 2267 while euix>=0 do 2268 begin 2269 if RW[p].EnemyUn[euix].Loc=Loc then 2270 begin RW[p].EnemyUn[euix].Loc:=-1; Break; end; 2271 dec(euix); 2588 p, euix, OldLevel: integer; 2589 AddFlags, ClearFlags: Cardinal; 2590 begin 2591 if (Mode = moLoading_Fast) and not CityChange then 2592 exit; 2593 for p := 0 to nPl - 1 do 2594 if 1 shl p and (GAlive or GWatching) <> 0 then 2595 begin 2596 OldLevel := ObserveLevel[Loc] shr (2 * p) and 3; 2597 if OldLevel > lNoObserve then 2598 begin 2599 if RW[p].Map[Loc] and (fUnit or fOwned) = fUnit then 2600 begin 2601 // replace unit located here in EnemyUn 2602 // do not just set loc:=-1 because total number would be unlimited 2603 euix := RW[p].nEnemyUn - 1; 2604 while euix >= 0 do 2605 begin 2606 if RW[p].EnemyUn[euix].Loc = Loc then 2607 begin 2608 RW[p].EnemyUn[euix].Loc := -1; 2609 Break; 2610 end; 2611 dec(euix); 2612 end; 2613 RW[p].Map[Loc] := RW[p].Map[Loc] and not fUnit 2614 end 2615 else 2616 begin // look for empty slot in EnemyUn 2617 euix := RW[p].nEnemyUn - 1; 2618 while (euix >= 0) and (RW[p].EnemyUn[euix].Loc >= 0) do 2619 dec(euix); 2272 2620 end; 2273 RW[p].Map[Loc]:=RW[p].Map[Loc] and not fUnit 2274 end 2275 else 2276 begin // look for empty slot in EnemyUn 2277 euix:=RW[p].nEnemyUn-1; 2278 while (euix>=0) and (RW[p].EnemyUn[euix].Loc>=0) do dec(euix); 2279 end; 2280 if (Occupant[Loc]<0) and not CityChange then 2281 begin // calling DiscoverTile not necessary, only clear map flags 2282 ClearFlags:=fUnit or fHiddenUnit or fStealthUnit or fOwnZoCUnit; 2283 if RealMap[Loc] and fCity=0 then 2284 ClearFlags:=ClearFlags or fOwned; 2285 RW[p].Map[Loc]:=RW[p].Map[Loc] and not ClearFlags; 2286 end 2287 else if (Occupant[Loc]<>p) or CityChange then 2288 begin // city or enemy unit update necessary, call DiscoverTile 2289 ObserveLevel[Loc]:=ObserveLevel[Loc] and not (3 shl (2*p)); 2290 DiscoverTile(Loc, p, p, OldLevel, false, euix); 2291 end 2292 else {if (Occupant[Loc]=p) and not CityChange then} 2293 begin // calling DiscoverTile not necessary, only set map flags 2294 ClearFlags:=0; 2295 AddFlags:=fUnit or fOwned; 2296 if ZoCMap[Loc]>0 then AddFlags:=AddFlags or fOwnZoCUnit 2297 else ClearFlags:=ClearFlags or fOwnZoCUnit; 2298 RW[p].Map[Loc]:=RW[p].Map[Loc] and not ClearFlags or AddFlags; 2299 end 2300 end 2301 end 2302 end; 2303 2304 procedure RecalcV8ZoC(p,Loc: integer); 2305 // recalculate fInEnemyZoC flags around single tile 2306 var 2307 v8,V8V8,Loc1,Loc2,p1,ObserveMask: integer; 2308 Tile1: ^Cardinal; 2309 Adjacent,AdjacentAdjacent: TVicinity8Loc; 2310 begin 2311 if Mode=moLoading_Fast then exit; 2312 ObserveMask:=3 shl (2*p); 2313 V8_to_Loc(Loc,Adjacent); 2314 for V8:=0 to 7 do 2315 begin 2316 Loc1:=Adjacent[V8]; 2317 if (Loc1>=0) and (Loc1<MapSize) then 2318 begin 2319 Tile1:=@RW[p].Map[Loc1]; 2320 Tile1^:=Tile1^ and not fInEnemyZoC; 2321 V8_to_Loc(Loc1,AdjacentAdjacent); 2322 for V8V8:=0 to 7 do 2323 begin 2324 Loc2:=AdjacentAdjacent[V8V8]; 2325 if (Loc2>=0) and (Loc2<MapSize) and (ZoCMap[Loc2]>0) 2326 and (ObserveLevel[Loc2] and ObserveMask<>0) then 2327 begin 2328 p1:=Occupant[Loc2]; 2329 assert(p1<>nPl); 2330 if (p1<>p) and (RW[p].Treaty[p1]<trAlliance) then 2331 begin Tile1^:=Tile1^ or fInEnemyZoC; break end 2621 if (Occupant[Loc] < 0) and not CityChange then 2622 begin // calling DiscoverTile not necessary, only clear map flags 2623 ClearFlags := fUnit or fHiddenUnit or fStealthUnit or fOwnZoCUnit; 2624 if RealMap[Loc] and fCity = 0 then 2625 ClearFlags := ClearFlags or fOwned; 2626 RW[p].Map[Loc] := RW[p].Map[Loc] and not ClearFlags; 2332 2627 end 2333 end; 2334 end 2335 end 2336 end; 2337 2338 procedure RecalcMapZoC(p: integer); 2339 // recalculate fInEnemyZoC flags for the whole map 2340 var 2341 Loc,Loc1,V8,p1,ObserveMask: integer; 2342 Adjacent: TVicinity8Loc; 2343 begin 2344 if Mode=moLoading_Fast then exit; 2345 MaskD(RW[p].Map^,MapSize,not Cardinal(fInEnemyZoC)); 2346 ObserveMask:=3 shl (2*p); 2347 for Loc:=0 to MapSize-1 do 2348 if (ZoCMap[Loc]>0) and (ObserveLevel[Loc] and ObserveMask<>0) then 2349 begin 2350 p1:=Occupant[Loc]; 2351 assert(p1<>nPl); 2352 if (p1<>p) and (RW[p].Treaty[p1]<trAlliance) then 2353 begin // this non-allied enemy ZoC unit is known to this player -- set flags! 2354 V8_to_Loc(Loc,Adjacent); 2355 for V8:=0 to 7 do 2356 begin 2357 Loc1:=Adjacent[V8]; 2358 if (Loc1>=0) and (Loc1<MapSize) then 2359 RW[p].Map[Loc1]:=RW[p].Map[Loc1] or fInEnemyZoC 2628 else if (Occupant[Loc] <> p) or CityChange then 2629 begin // city or enemy unit update necessary, call DiscoverTile 2630 ObserveLevel[Loc] := ObserveLevel[Loc] and not(3 shl (2 * p)); 2631 DiscoverTile(Loc, p, p, OldLevel, false, euix); 2632 end 2633 else { if (Occupant[Loc]=p) and not CityChange then } 2634 begin // calling DiscoverTile not necessary, only set map flags 2635 ClearFlags := 0; 2636 AddFlags := fUnit or fOwned; 2637 if ZoCMap[Loc] > 0 then 2638 AddFlags := AddFlags or fOwnZoCUnit 2639 else 2640 ClearFlags := ClearFlags or fOwnZoCUnit; 2641 RW[p].Map[Loc] := RW[p].Map[Loc] and not ClearFlags or AddFlags; 2360 2642 end 2361 2643 end … … 2363 2645 end; 2364 2646 2647 procedure RecalcV8ZoC(p, Loc: integer); 2648 // recalculate fInEnemyZoC flags around single tile 2649 var 2650 V8, V8V8, Loc1, Loc2, p1, ObserveMask: integer; 2651 Tile1: ^Cardinal; 2652 Adjacent, AdjacentAdjacent: TVicinity8Loc; 2653 begin 2654 if Mode = moLoading_Fast then 2655 exit; 2656 ObserveMask := 3 shl (2 * p); 2657 V8_to_Loc(Loc, Adjacent); 2658 for V8 := 0 to 7 do 2659 begin 2660 Loc1 := Adjacent[V8]; 2661 if (Loc1 >= 0) and (Loc1 < MapSize) then 2662 begin 2663 Tile1 := @RW[p].Map[Loc1]; 2664 Tile1^ := Tile1^ and not fInEnemyZoC; 2665 V8_to_Loc(Loc1, AdjacentAdjacent); 2666 for V8V8 := 0 to 7 do 2667 begin 2668 Loc2 := AdjacentAdjacent[V8V8]; 2669 if (Loc2 >= 0) and (Loc2 < MapSize) and (ZoCMap[Loc2] > 0) and 2670 (ObserveLevel[Loc2] and ObserveMask <> 0) then 2671 begin 2672 p1 := Occupant[Loc2]; 2673 assert(p1 <> nPl); 2674 if (p1 <> p) and (RW[p].Treaty[p1] < trAlliance) then 2675 begin 2676 Tile1^ := Tile1^ or fInEnemyZoC; 2677 Break 2678 end 2679 end 2680 end; 2681 end 2682 end 2683 end; 2684 2685 procedure RecalcMapZoC(p: integer); 2686 // recalculate fInEnemyZoC flags for the whole map 2687 var 2688 Loc, Loc1, V8, p1, ObserveMask: integer; 2689 Adjacent: TVicinity8Loc; 2690 begin 2691 if Mode = moLoading_Fast then 2692 exit; 2693 MaskD(RW[p].Map^, MapSize, not Cardinal(fInEnemyZoC)); 2694 ObserveMask := 3 shl (2 * p); 2695 for Loc := 0 to MapSize - 1 do 2696 if (ZoCMap[Loc] > 0) and (ObserveLevel[Loc] and ObserveMask <> 0) then 2697 begin 2698 p1 := Occupant[Loc]; 2699 assert(p1 <> nPl); 2700 if (p1 <> p) and (RW[p].Treaty[p1] < trAlliance) then 2701 begin // this non-allied enemy ZoC unit is known to this player -- set flags! 2702 V8_to_Loc(Loc, Adjacent); 2703 for V8 := 0 to 7 do 2704 begin 2705 Loc1 := Adjacent[V8]; 2706 if (Loc1 >= 0) and (Loc1 < MapSize) then 2707 RW[p].Map[Loc1] := RW[p].Map[Loc1] or fInEnemyZoC 2708 end 2709 end 2710 end 2711 end; 2712 2365 2713 procedure RecalcPeaceMap(p: integer); 2366 2714 // recalculate fPeace flags for the whole map 2367 2715 var 2368 Loc,p1: integer;2369 PeacePlayer: array[-1..nPl-1] of boolean;2370 begin 2371 if Mode<>moPlaying then exit; 2372 MaskD(RW[p].Map^,MapSize,not Cardinal(fPeace));2373 for p1:=-1 to nPl-1 do 2374 PeacePlayer[p1]:= (p1>=0) and (p1<>p) and (1 shl p1 and GAlive<>0)2375 and (RW[p].Treaty[p1] in [trPeace,trFriendlyContact]);2376 for Loc:=0 to MapSize-1 do 2377 if PeacePlayer[RW[p].Territory[Loc]] then2378 RW[p].Map[Loc]:=RW[p].Map[Loc] or fPeace2379 end; 2380 2716 Loc, p1: integer; 2717 PeacePlayer: array [-1 .. nPl - 1] of boolean; 2718 begin 2719 if Mode <> moPlaying then 2720 exit; 2721 MaskD(RW[p].Map^, MapSize, not Cardinal(fPeace)); 2722 for p1 := -1 to nPl - 1 do 2723 PeacePlayer[p1] := (p1 >= 0) and (p1 <> p) and (1 shl p1 and GAlive <> 0) 2724 and (RW[p].Treaty[p1] in [trPeace, TrFriendlyContact]); 2725 for Loc := 0 to MapSize - 1 do 2726 if PeacePlayer[RW[p].Territory[Loc]] then 2727 RW[p].Map[Loc] := RW[p].Map[Loc] or fPeace 2728 end; 2381 2729 2382 2730 { 2383 2384 ____________________________________________________________________2731 Territory Calculation 2732 ____________________________________________________________________ 2385 2733 } 2386 2734 var 2387 BorderChanges: array[0..sIntExpandTerritory and $F-1] of Cardinal;2735 BorderChanges: array [0 .. sIntExpandTerritory and $F - 1] of Cardinal; 2388 2736 2389 2737 procedure ChangeTerritory(Loc, p: integer); 2390 2738 var 2391 p1: integer; 2392 begin 2393 assert(p>=0); // no player's territory indicated by p=nPl 2394 dec(TerritoryCount[RealMap[Loc] shr 27]); 2395 inc(TerritoryCount[p]); 2396 RealMap[Loc]:=RealMap[Loc] and not ($F shl 27) or Cardinal(p) shl 27; 2397 if p=$F then p:=-1; 2398 for p1:=0 to nPl-1 do if 1 shl p1 and (GAlive or GWatching)<>0 then 2399 if RW[p1].Map[Loc] and fTerrain<>fUNKNOWN then 2400 begin 2401 RW[p1].Territory[Loc]:=p; 2402 if (p<nPl) and (p<>p1) and (1 shl p and GAlive<>0) 2403 and (RW[p1].Treaty[p] in [trPeace,trFriendlyContact]) then 2404 RW[p1].Map[Loc]:=RW[p1].Map[Loc] or fPeace 2405 else RW[p1].Map[Loc]:=RW[p1].Map[Loc] and not fPeace; 2406 end 2739 p1: integer; 2740 begin 2741 assert(p >= 0); // no player's territory indicated by p=nPl 2742 dec(TerritoryCount[RealMap[Loc] shr 27]); 2743 inc(TerritoryCount[p]); 2744 RealMap[Loc] := RealMap[Loc] and not($F shl 27) or Cardinal(p) shl 27; 2745 if p = $F then 2746 p := -1; 2747 for p1 := 0 to nPl - 1 do 2748 if 1 shl p1 and (GAlive or GWatching) <> 0 then 2749 if RW[p1].Map[Loc] and fTerrain <> fUNKNOWN then 2750 begin 2751 RW[p1].Territory[Loc] := p; 2752 if (p < nPl) and (p <> p1) and (1 shl p and GAlive <> 0) and 2753 (RW[p1].Treaty[p] in [trPeace, TrFriendlyContact]) then 2754 RW[p1].Map[Loc] := RW[p1].Map[Loc] or fPeace 2755 else 2756 RW[p1].Map[Loc] := RW[p1].Map[Loc] and not fPeace; 2757 end 2407 2758 end; 2408 2759 2409 2760 procedure ExpandTerritory(OriginLoc: integer); 2410 2761 var 2411 i,dx,dy,dxMax,dyMax,Loc,NewOwner: integer; 2412 begin 2413 i:=0; 2414 dyMax:=0; 2415 while (dyMax+1)+(dyMax+1) shr 1<=CountryRadius do 2416 inc(dyMax); 2417 for dy:=-dyMax to dyMax do 2418 begin 2419 dxMax:=dy and 1; 2420 while abs(dy)+(dxMax+2)+abs(abs(dy)-(dxMax+2)) shr 1<=CountryRadius do 2421 inc(dxMax,2); 2422 for dx:=-dxMax to dxMax do if (dy+dx) and 1=0 then 2423 begin 2424 NewOwner:=BorderChanges[i div 8] shr (i mod 8 *4) and $F; 2425 Loc:=dLoc(OriginLoc,dx,dy); 2426 if (Loc>=0) and (Cardinal(NewOwner)<>RealMap[Loc] shr 27) then 2427 ChangeTerritory(Loc,NewOwner); 2428 inc(i); 2429 end 2762 i, dx, dy, dxMax, dyMax, Loc, NewOwner: integer; 2763 begin 2764 i := 0; 2765 dyMax := 0; 2766 while (dyMax + 1) + (dyMax + 1) shr 1 <= CountryRadius do 2767 inc(dyMax); 2768 for dy := -dyMax to dyMax do 2769 begin 2770 dxMax := dy and 1; 2771 while abs(dy) + (dxMax + 2) + abs(abs(dy) - (dxMax + 2)) shr 1 <= 2772 CountryRadius do 2773 inc(dxMax, 2); 2774 for dx := -dxMax to dxMax do 2775 if (dy + dx) and 1 = 0 then 2776 begin 2777 NewOwner := BorderChanges[i div 8] shr (i mod 8 * 4) and $F; 2778 Loc := dLoc(OriginLoc, dx, dy); 2779 if (Loc >= 0) and (Cardinal(NewOwner) <> RealMap[Loc] shr 27) then 2780 ChangeTerritory(Loc, NewOwner); 2781 inc(i); 2782 end 2430 2783 end 2431 2784 end; … … 2433 2786 procedure CheckBorders(OriginLoc, PlayerLosingCity: integer); 2434 2787 // OriginLoc: only changes in CountryRadius around this location possible, 2435 // 2788 // -1 for complete map, -2 for double-check (no more changes allowed) 2436 2789 // PlayerLosingCity: do nothing but remove tiles no longer in reach from this 2437 // player's territory, -1 for full border recalculation 2438 var 2439 i,r,Loc,Loc1,dx,dy,p1,p2,cix,NewDist,dxMax,dyMax,OldOwner,V8, 2440 NewOwner: integer; 2441 Adjacent: TVicinity8Loc; 2442 AtPeace: array[0..nPl,0..nPl] of boolean; 2443 Country, FormerCountry, {to who's country a tile belongs} 2444 Dist, FormerDist, StolenDist: array[0..lxmax*lymax-1] of ShortInt; 2445 begin 2446 if PlayerLosingCity>=0 then 2447 begin 2448 for Loc:=0 to MapSize-1 do StolenDist[Loc]:=CountryRadius+1; 2449 for cix:=0 to RW[PlayerLosingCity].nCity-1 do 2450 if RW[PlayerLosingCity].City[cix].Loc>=0 then 2451 StolenDist[RW[PlayerLosingCity].City[cix].Loc]:=0; 2452 2453 for r:=1 to CountryRadius shr 1 do 2454 begin 2455 move(StolenDist,FormerDist,MapSize); 2456 for Loc:=0 to MapSize-1 do 2457 if (FormerDist[Loc]<=CountryRadius-2) // use same conditions as below! 2458 and ((1 shl (RealMap[Loc] and fTerrain)) 2459 and (1 shl fShore+1 shl fMountains+1 shl fArctic)=0) then 2460 begin 2461 V8_to_Loc(Loc,Adjacent); 2462 for V8:=0 to 7 do 2790 // player's territory, -1 for full border recalculation 2791 var 2792 i, r, Loc, Loc1, dx, dy, p1, p2, cix, NewDist, dxMax, dyMax, OldOwner, V8, 2793 NewOwner: integer; 2794 Adjacent: TVicinity8Loc; 2795 AtPeace: array [0 .. nPl, 0 .. nPl] of boolean; 2796 Country, FormerCountry, { to who's country a tile belongs } 2797 Dist, FormerDist, StolenDist: array [0 .. lxmax * lymax - 1] of ShortInt; 2798 begin 2799 if PlayerLosingCity >= 0 then 2800 begin 2801 for Loc := 0 to MapSize - 1 do 2802 StolenDist[Loc] := CountryRadius + 1; 2803 for cix := 0 to RW[PlayerLosingCity].nCity - 1 do 2804 if RW[PlayerLosingCity].City[cix].Loc >= 0 then 2805 StolenDist[RW[PlayerLosingCity].City[cix].Loc] := 0; 2806 2807 for r := 1 to CountryRadius shr 1 do 2808 begin 2809 move(StolenDist, FormerDist, MapSize); 2810 for Loc := 0 to MapSize - 1 do 2811 if (FormerDist[Loc] <= CountryRadius - 2) 2812 // use same conditions as below! 2813 and ((1 shl (RealMap[Loc] and fTerrain)) and 2814 (1 shl fShore + 1 shl fMountains + 1 shl fArctic) = 0) then 2815 begin 2816 V8_to_Loc(Loc, Adjacent); 2817 for V8 := 0 to 7 do 2463 2818 begin 2464 Loc1:=Adjacent[V8]; 2465 NewDist:=FormerDist[Loc]+2+V8 and 1; 2466 if (Loc1>=0) and (Loc1<MapSize) and (NewDist<StolenDist[Loc1]) then 2467 StolenDist[Loc1]:=NewDist; 2819 Loc1 := Adjacent[V8]; 2820 NewDist := FormerDist[Loc] + 2 + V8 and 1; 2821 if (Loc1 >= 0) and (Loc1 < MapSize) and (NewDist < StolenDist[Loc1]) 2822 then 2823 StolenDist[Loc1] := NewDist; 2468 2824 end 2469 2825 end … … 2471 2827 end; 2472 2828 2473 FillChar(Country,MapSize,-1); 2474 for Loc:=0 to MapSize-1 do Dist[Loc]:=CountryRadius+1; 2475 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then 2476 for cix:=0 to RW[p1].nCity-1 do if RW[p1].City[cix].Loc>=0 then 2477 begin 2478 Country[RW[p1].City[cix].Loc]:=p1; 2479 Dist[RW[p1].City[cix].Loc]:=0; 2480 end; 2481 2482 for r:=1 to CountryRadius shr 1 do 2483 begin 2484 move(Country,FormerCountry,MapSize); 2485 move(Dist,FormerDist,MapSize); 2486 for Loc:=0 to MapSize-1 do 2487 if (FormerDist[Loc]<=CountryRadius-2) // use same conditions as above! 2488 and ((1 shl (RealMap[Loc] and fTerrain)) 2489 and (1 shl fShore+1 shl fMountains+1 shl fArctic)=0) then 2490 begin 2491 assert(FormerCountry[Loc]>=0); 2492 V8_to_Loc(Loc,Adjacent); 2493 for V8:=0 to 7 do 2494 begin 2495 Loc1:=Adjacent[V8]; 2496 NewDist:=FormerDist[Loc]+2+V8 and 1; 2497 if (Loc1>=0) and (Loc1<MapSize) and (NewDist<Dist[Loc1]) then 2829 FillChar(Country, MapSize, -1); 2830 for Loc := 0 to MapSize - 1 do 2831 Dist[Loc] := CountryRadius + 1; 2832 for p1 := 0 to nPl - 1 do 2833 if 1 shl p1 and GAlive <> 0 then 2834 for cix := 0 to RW[p1].nCity - 1 do 2835 if RW[p1].City[cix].Loc >= 0 then 2836 begin 2837 Country[RW[p1].City[cix].Loc] := p1; 2838 Dist[RW[p1].City[cix].Loc] := 0; 2839 end; 2840 2841 for r := 1 to CountryRadius shr 1 do 2842 begin 2843 move(Country, FormerCountry, MapSize); 2844 move(Dist, FormerDist, MapSize); 2845 for Loc := 0 to MapSize - 1 do 2846 if (FormerDist[Loc] <= CountryRadius - 2) // use same conditions as above! 2847 and ((1 shl (RealMap[Loc] and fTerrain)) and 2848 (1 shl fShore + 1 shl fMountains + 1 shl fArctic) = 0) then 2849 begin 2850 assert(FormerCountry[Loc] >= 0); 2851 V8_to_Loc(Loc, Adjacent); 2852 for V8 := 0 to 7 do 2853 begin 2854 Loc1 := Adjacent[V8]; 2855 NewDist := FormerDist[Loc] + 2 + V8 and 1; 2856 if (Loc1 >= 0) and (Loc1 < MapSize) and (NewDist < Dist[Loc1]) then 2498 2857 begin 2499 Country[Loc1]:=FormerCountry[Loc];2500 Dist[Loc1]:=NewDist;2858 Country[Loc1] := FormerCountry[Loc]; 2859 Dist[Loc1] := NewDist; 2501 2860 end 2502 2861 end … … 2504 2863 end; 2505 2864 2506 FillChar(AtPeace, sizeof(AtPeace), false); 2507 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then 2508 for p2:=0 to nPl-1 do 2509 if (p2<>p1) and (1 shl p2 and GAlive<>0) and (RW[p1].Treaty[p2]>=trPeace) then 2510 AtPeace[p1,p2]:=true; 2511 2512 if OriginLoc>=0 then 2865 FillChar(AtPeace, SizeOf(AtPeace), false); 2866 for p1 := 0 to nPl - 1 do 2867 if 1 shl p1 and GAlive <> 0 then 2868 for p2 := 0 to nPl - 1 do 2869 if (p2 <> p1) and (1 shl p2 and GAlive <> 0) and 2870 (RW[p1].Treaty[p2] >= trPeace) then 2871 AtPeace[p1, p2] := true; 2872 2873 if OriginLoc >= 0 then 2513 2874 begin // update area only 2514 i:=0; 2515 fillchar(BorderChanges, sizeof(BorderChanges), 0); 2516 dyMax:=0; 2517 while (dyMax+1)+(dyMax+1) shr 1<=CountryRadius do 2518 inc(dyMax); 2519 for dy:=-dyMax to dyMax do 2520 begin 2521 dxMax:=dy and 1; 2522 while abs(dy)+(dxMax+2)+abs(abs(dy)-(dxMax+2)) shr 1<=CountryRadius do 2523 inc(dxMax,2); 2524 for dx:=-dxMax to dxMax do if (dy+dx) and 1=0 then 2525 begin 2526 Loc:=dLoc(OriginLoc,dx,dy); 2527 if Loc>=0 then 2528 begin 2529 OldOwner:=RealMap[Loc] shr 27; 2530 NewOwner:=Country[Loc] and $f; 2531 if NewOwner<>OldOwner then 2532 if AtPeace[NewOwner,OldOwner] 2533 and not ((OldOwner=PlayerLosingCity) and (StolenDist[Loc]>CountryRadius)) then 2534 NewOwner:=OldOwner // peace fixes borders 2535 else ChangeTerritory(Loc,NewOwner); 2536 inc(BorderChanges[i div 8],NewOwner shl (i mod 8 *4)); 2537 end; 2538 inc(i); 2539 end 2875 i := 0; 2876 FillChar(BorderChanges, SizeOf(BorderChanges), 0); 2877 dyMax := 0; 2878 while (dyMax + 1) + (dyMax + 1) shr 1 <= CountryRadius do 2879 inc(dyMax); 2880 for dy := -dyMax to dyMax do 2881 begin 2882 dxMax := dy and 1; 2883 while abs(dy) + (dxMax + 2) + abs(abs(dy) - (dxMax + 2)) shr 1 <= 2884 CountryRadius do 2885 inc(dxMax, 2); 2886 for dx := -dxMax to dxMax do 2887 if (dy + dx) and 1 = 0 then 2888 begin 2889 Loc := dLoc(OriginLoc, dx, dy); 2890 if Loc >= 0 then 2891 begin 2892 OldOwner := RealMap[Loc] shr 27; 2893 NewOwner := Country[Loc] and $F; 2894 if NewOwner <> OldOwner then 2895 if AtPeace[NewOwner, OldOwner] and 2896 not((OldOwner = PlayerLosingCity) and 2897 (StolenDist[Loc] > CountryRadius)) then 2898 NewOwner := OldOwner // peace fixes borders 2899 else 2900 ChangeTerritory(Loc, NewOwner); 2901 inc(BorderChanges[i div 8], NewOwner shl (i mod 8 * 4)); 2902 end; 2903 inc(i); 2904 end 2540 2905 end 2541 2906 end 2542 else for Loc:=0 to MapSize-1 do // update complete map 2543 begin 2544 OldOwner:=RealMap[Loc] shr 27; 2545 NewOwner:=Country[Loc] and $f; 2546 if (NewOwner<>OldOwner) 2547 and (not AtPeace[NewOwner,OldOwner] 2548 or ((OldOwner=PlayerLosingCity) and (StolenDist[Loc]>CountryRadius))) then 2549 begin 2550 assert(OriginLoc<>-2); // test if border saving works 2551 ChangeTerritory(Loc,NewOwner); 2552 end; 2553 end; 2554 2555 {$IFOPT O-}if OriginLoc<>-2 then CheckBorders(-2);{$ENDIF} //check: single pass should do! 2556 end; //CheckBorders 2557 2558 procedure LogCheckBorders(p,cix,PlayerLosingCity: integer); 2559 begin 2560 CheckBorders(RW[p].City[cix].Loc,PlayerLosingCity); 2561 IntServer(sIntExpandTerritory,p,cix,BorderChanges); 2907 else 2908 for Loc := 0 to MapSize - 1 do // update complete map 2909 begin 2910 OldOwner := RealMap[Loc] shr 27; 2911 NewOwner := Country[Loc] and $F; 2912 if (NewOwner <> OldOwner) and (not AtPeace[NewOwner, OldOwner] or 2913 ((OldOwner = PlayerLosingCity) and (StolenDist[Loc] > CountryRadius))) 2914 then 2915 begin 2916 assert(OriginLoc <> -2); // test if border saving works 2917 ChangeTerritory(Loc, NewOwner); 2918 end; 2919 end; 2920 2921 {$IFOPT O-} if OriginLoc <> -2 then 2922 CheckBorders(-2); {$ENDIF} // check: single pass should do! 2923 end; // CheckBorders 2924 2925 procedure LogCheckBorders(p, cix, PlayerLosingCity: integer); 2926 begin 2927 CheckBorders(RW[p].City[cix].Loc, PlayerLosingCity); 2928 IntServer(sIntExpandTerritory, p, cix, BorderChanges); 2562 2929 end; 2563 2930 2564 2931 { 2565 2566 ____________________________________________________________________2932 Map Processing 2933 ____________________________________________________________________ 2567 2934 } 2568 2935 2569 procedure CreateUnit(p,mix: integer); 2570 begin 2571 with RW[p] do 2572 begin 2573 Un[nUn].mix:=mix; 2574 with Un[nUn] do 2575 begin 2576 ID:=UnBuilt[p]; 2577 inc(UnBuilt[p]); 2578 Status:=0; 2579 SavedStatus:=0; 2580 inc(Model[mix].Built); 2581 Home:=-1; 2582 Health:=100; 2583 Flags:=0; 2584 Movement:=0; 2585 if Model[mix].Domain=dAir then 2586 begin 2587 Fuel:=Model[mix].Cap[mcFuel]; 2588 Flags:=Flags or unBombsLoaded 2589 end; 2590 Job:=jNone; 2591 Exp:=ExpCost shr 1; 2592 TroopLoad:=0; AirLoad:=0; Master:=-1; 2593 end; 2594 inc(nUn); 2936 procedure CreateUnit(p, mix: integer); 2937 begin 2938 with RW[p] do 2939 begin 2940 Un[nUn].mix := mix; 2941 with Un[nUn] do 2942 begin 2943 ID := UnBuilt[p]; 2944 inc(UnBuilt[p]); 2945 Status := 0; 2946 SavedStatus := 0; 2947 inc(Model[mix].Built); 2948 Home := -1; 2949 Health := 100; 2950 Flags := 0; 2951 Movement := 0; 2952 if Model[mix].Domain = dAir then 2953 begin 2954 Fuel := Model[mix].Cap[mcFuel]; 2955 Flags := Flags or unBombsLoaded 2956 end; 2957 Job := jNone; 2958 exp := ExpCost shr 1; 2959 TroopLoad := 0; 2960 AirLoad := 0; 2961 Master := -1; 2962 end; 2963 inc(nUn); 2595 2964 end 2596 2965 end; 2597 2966 2598 procedure FreeUnit(p, uix: integer);2967 procedure FreeUnit(p, uix: integer); 2599 2968 // loc or master should be set after call 2600 2969 // implementation is critical for loading performance, change carefully 2601 2970 var 2602 Loc0, uix1: integer; 2603 Occ, ZoC: boolean; 2604 begin 2605 with RW[p].Un[uix] do 2606 begin 2607 Job:=jNone; 2608 Flags:=Flags and not (unFortified or unMountainDelay); 2609 Loc0:=Loc 2610 end; 2611 if Occupant[Loc0]>=0 then 2612 begin 2613 assert(Occupant[Loc0]=p); 2614 Occ:=false; 2615 ZoC:=false; 2616 for uix1:=0 to RW[p].nUn-1 do with RW[p].Un[uix1] do 2617 if (Loc=Loc0) and (Master<0) and (uix1<>uix) then 2618 begin 2619 Occ:=true; 2620 if RW[p].Model[mix].Flags and mdZOC<>0 then 2621 begin ZoC:=true; Break end 2622 end; 2623 if not Occ then Occupant[Loc0]:=-1; 2624 if not ZoC then ZoCMap[Loc0]:=0; 2625 end; 2626 end; 2627 2628 procedure PlaceUnit(p,uix: integer); 2629 begin 2630 with RW[p].Un[uix] do 2631 begin 2632 Occupant[Loc]:=p; 2633 if RW[p].Model[mix].Flags and mdZOC<>0 then ZoCMap[Loc]:=1; 2971 Loc0, uix1: integer; 2972 Occ, ZoC: boolean; 2973 begin 2974 with RW[p].Un[uix] do 2975 begin 2976 Job := jNone; 2977 Flags := Flags and not(unFortified or unMountainDelay); 2978 Loc0 := Loc 2979 end; 2980 if Occupant[Loc0] >= 0 then 2981 begin 2982 assert(Occupant[Loc0] = p); 2983 Occ := false; 2984 ZoC := false; 2985 for uix1 := 0 to RW[p].nUn - 1 do 2986 with RW[p].Un[uix1] do 2987 if (Loc = Loc0) and (Master < 0) and (uix1 <> uix) then 2988 begin 2989 Occ := true; 2990 if RW[p].Model[mix].Flags and mdZOC <> 0 then 2991 begin 2992 ZoC := true; 2993 Break 2994 end 2995 end; 2996 if not Occ then 2997 Occupant[Loc0] := -1; 2998 if not ZoC then 2999 ZoCMap[Loc0] := 0; 3000 end; 3001 end; 3002 3003 procedure PlaceUnit(p, uix: integer); 3004 begin 3005 with RW[p].Un[uix] do 3006 begin 3007 Occupant[Loc] := p; 3008 if RW[p].Model[mix].Flags and mdZOC <> 0 then 3009 ZoCMap[Loc] := 1; 2634 3010 end 2635 3011 end; … … 2637 3013 procedure CountLost(p, mix, Enemy: integer); 2638 3014 begin 2639 inc(RW[p].Model[mix].Lost);2640 TellAboutModel(Enemy,p,mix);2641 inc(Destroyed[Enemy,p,mix]);2642 end; 2643 2644 procedure RemoveUnit(p, uix: integer; Enemy: integer = -1);3015 inc(RW[p].Model[mix].Lost); 3016 TellAboutModel(Enemy, p, mix); 3017 inc(Destroyed[Enemy, p, mix]); 3018 end; 3019 3020 procedure RemoveUnit(p, uix: integer; Enemy: integer = -1); 2645 3021 // use enemy only from inside sMoveUnit if attack 2646 3022 var 2647 uix1: integer; 2648 begin 2649 with RW[p].Un[uix] do 2650 begin 2651 assert((Loc>=0) or (RW[p].Model[mix].Kind=mkDiplomat)); // already freed when spy mission 2652 if Loc>=0 then 2653 FreeUnit(p,uix); 2654 if Master>=0 then 2655 if RW[p].Model[mix].Domain=dAir then dec(RW[p].Un[Master].AirLoad) 2656 else dec(RW[p].Un[Master].TroopLoad); 2657 if (TroopLoad>0) or (AirLoad>0) then 2658 for uix1:=0 to RW[p].nUn-1 do 2659 if (RW[p].Un[uix1].Loc>=0) and (RW[p].Un[uix1].Master=uix) then 2660 {unit mastered by removed unit -- remove too} 2661 begin 2662 RW[p].Un[uix1].Loc:=-1; 2663 if Enemy>=0 then CountLost(p,RW[p].Un[uix1].mix,Enemy); 3023 uix1: integer; 3024 begin 3025 with RW[p].Un[uix] do 3026 begin 3027 assert((Loc >= 0) or (RW[p].Model[mix].Kind = mkDiplomat)); 3028 // already freed when spy mission 3029 if Loc >= 0 then 3030 FreeUnit(p, uix); 3031 if Master >= 0 then 3032 if RW[p].Model[mix].Domain = dAir then 3033 dec(RW[p].Un[Master].AirLoad) 3034 else 3035 dec(RW[p].Un[Master].TroopLoad); 3036 if (TroopLoad > 0) or (AirLoad > 0) then 3037 for uix1 := 0 to RW[p].nUn - 1 do 3038 if (RW[p].Un[uix1].Loc >= 0) and (RW[p].Un[uix1].Master = uix) then 3039 { unit mastered by removed unit -- remove too } 3040 begin 3041 RW[p].Un[uix1].Loc := -1; 3042 if Enemy >= 0 then 3043 CountLost(p, RW[p].Un[uix1].mix, Enemy); 2664 3044 end; 2665 Loc:=-1; 2666 if Enemy>=0 then CountLost(p,mix,Enemy); 3045 Loc := -1; 3046 if Enemy >= 0 then 3047 CountLost(p, mix, Enemy); 2667 3048 end 2668 end;{RemoveUnit} 2669 2670 procedure RemoveUnit_UpdateMap(p,uix: integer); 2671 var 2672 Loc0: integer; 2673 begin 2674 Loc0:=RW[p].Un[uix].Loc; 2675 RemoveUnit(p,uix); 2676 if Mode>moLoading_Fast then UpdateUnitMap(Loc0); 2677 end; 2678 2679 procedure RemoveAllUnits(p,Loc: integer; Enemy: integer = -1); 2680 var 2681 uix: integer; 2682 begin 2683 for uix:=0 to RW[p].nUn-1 do 2684 if RW[p].Un[uix].Loc=Loc then 2685 begin 2686 if Enemy>=0 then CountLost(p,RW[p].Un[uix].mix,Enemy); 2687 RW[p].Un[uix].Loc:=-1 2688 end; 2689 Occupant[Loc]:=-1; 2690 ZoCMap[Loc]:=0; 2691 end; 2692 2693 procedure RemoveDomainUnits(d,p,Loc: integer); 2694 var 2695 uix: integer; 2696 begin 2697 for uix:=0 to RW[p].nUn-1 do 2698 if (RW[p].Model[RW[p].Un[uix].mix].Domain=d) and (RW[p].Un[uix].Loc=Loc) then 2699 RemoveUnit(p,uix); 2700 end; 2701 2702 procedure FoundCity(p,FoundLoc: integer); 2703 var 2704 p1,cix1,V21,dx,dy: integer; 2705 begin 2706 if RW[p].nCity=ncmax then exit; 2707 inc(RW[p].nCity); 2708 with RW[p].City[RW[p].nCity-1] do 2709 begin 2710 Size:=2; 2711 Status:=0; 2712 SavedStatus:=0; 2713 FillChar(Built,SizeOf(Built),0); 2714 Food:=0; 2715 Project:=cpImp+imTrGoods; 2716 Prod:=0; 2717 Project0:=Project; 2718 Prod0:=0; 2719 Pollution:=0; 2720 N1:=0; 2721 Loc:=FoundLoc; 2722 if UsedByCity[FoundLoc]>=0 then 2723 begin {central tile is exploited - toggle in exploiting city} 2724 p1:=p; 2725 SearchCity(UsedByCity[FoundLoc],p1,cix1); 2726 dxdy(UsedByCity[FoundLoc],FoundLoc,dx,dy); 2727 V21:=(dy+3) shl 2+(dx+3) shr 1; 2728 RW[p1].City[cix1].Tiles:=RW[p1].City[cix1].Tiles and not (1 shl V21); 2729 end; 2730 Tiles:=1 shl 13; {exploit central tile} 2731 UsedByCity[FoundLoc]:=FoundLoc; 2732 RealMap[FoundLoc]:=RealMap[FoundLoc] 2733 and (fTerrain or fSpecial or fRiver or nPl shl 27) or fCity; 2734 2735 ChangeTerritory(Loc,p) 2736 end; 2737 end; {FoundCity} 2738 2739 procedure StealCity(p,cix: integer; SaveUnits: boolean); 2740 var 2741 i,j,uix1,cix1,nearest: integer; 2742 begin 2743 for i:=0 to 27 do 2744 if RW[p].City[cix].Built[i]=1 then 2745 begin 2746 GWonder[i].EffectiveOwner:=-1; 2747 if i=woPyramids then FreeSlaves; 2748 if i=woEiffel then // deactivate expired wonders 2749 for j:=0 to 27 do if GWonder[j].EffectiveOwner=p then 2750 CheckExpiration(j); 2751 end; 2752 for i:=28 to nImp-1 do 2753 if (Imp[i].Kind<>ikCommon) and (RW[p].City[cix].Built[i]>0) then 2754 begin {destroy national projects} 2755 RW[p].NatBuilt[i]:=0; 2756 if i=imGrWall then GrWallContinent[p]:=-1; 2757 end; 2758 2759 for uix1:=0 to RW[p].nUn-1 do with RW[p].Un[uix1] do 2760 if (Loc>=0) and (Home=cix) then 2761 if SaveUnits then 2762 begin // support units by nearest other city 2763 nearest:=-1; 2764 for cix1:=0 to RW[p].nCity-1 do 2765 if (cix1<>cix) and (RW[p].City[cix1].Loc>=0) 2766 and ((nearest<0) or (Distance(RW[p].City[cix1].Loc,Loc) 2767 <Distance(RW[p].City[nearest].Loc,Loc))) then 2768 nearest:=cix1; 2769 Home:=nearest 3049 end; { RemoveUnit } 3050 3051 procedure RemoveUnit_UpdateMap(p, uix: integer); 3052 var 3053 Loc0: integer; 3054 begin 3055 Loc0 := RW[p].Un[uix].Loc; 3056 RemoveUnit(p, uix); 3057 if Mode > moLoading_Fast then 3058 UpdateUnitMap(Loc0); 3059 end; 3060 3061 procedure RemoveAllUnits(p, Loc: integer; Enemy: integer = -1); 3062 var 3063 uix: integer; 3064 begin 3065 for uix := 0 to RW[p].nUn - 1 do 3066 if RW[p].Un[uix].Loc = Loc then 3067 begin 3068 if Enemy >= 0 then 3069 CountLost(p, RW[p].Un[uix].mix, Enemy); 3070 RW[p].Un[uix].Loc := -1 3071 end; 3072 Occupant[Loc] := -1; 3073 ZoCMap[Loc] := 0; 3074 end; 3075 3076 procedure RemoveDomainUnits(d, p, Loc: integer); 3077 var 3078 uix: integer; 3079 begin 3080 for uix := 0 to RW[p].nUn - 1 do 3081 if (RW[p].Model[RW[p].Un[uix].mix].Domain = d) and (RW[p].Un[uix].Loc = Loc) 3082 then 3083 RemoveUnit(p, uix); 3084 end; 3085 3086 procedure FoundCity(p, FoundLoc: integer); 3087 var 3088 p1, cix1, V21, dx, dy: integer; 3089 begin 3090 if RW[p].nCity = ncmax then 3091 exit; 3092 inc(RW[p].nCity); 3093 with RW[p].City[RW[p].nCity - 1] do 3094 begin 3095 Size := 2; 3096 Status := 0; 3097 SavedStatus := 0; 3098 FillChar(Built, SizeOf(Built), 0); 3099 Food := 0; 3100 Project := cpImp + imTrGoods; 3101 Prod := 0; 3102 Project0 := Project; 3103 Prod0 := 0; 3104 Pollution := 0; 3105 N1 := 0; 3106 Loc := FoundLoc; 3107 if UsedByCity[FoundLoc] >= 0 then 3108 begin { central tile is exploited - toggle in exploiting city } 3109 p1 := p; 3110 SearchCity(UsedByCity[FoundLoc], p1, cix1); 3111 dxdy(UsedByCity[FoundLoc], FoundLoc, dx, dy); 3112 V21 := (dy + 3) shl 2 + (dx + 3) shr 1; 3113 RW[p1].City[cix1].Tiles := RW[p1].City[cix1].Tiles and not(1 shl V21); 3114 end; 3115 Tiles := 1 shl 13; { exploit central tile } 3116 UsedByCity[FoundLoc] := FoundLoc; 3117 RealMap[FoundLoc] := RealMap[FoundLoc] and 3118 (fTerrain or fSpecial or fRiver or nPl shl 27) or fCity; 3119 3120 ChangeTerritory(Loc, p) 3121 end; 3122 end; { FoundCity } 3123 3124 procedure StealCity(p, cix: integer; SaveUnits: boolean); 3125 var 3126 i, j, uix1, cix1, nearest: integer; 3127 begin 3128 for i := 0 to 27 do 3129 if RW[p].City[cix].Built[i] = 1 then 3130 begin 3131 GWonder[i].EffectiveOwner := -1; 3132 if i = woPyramids then 3133 FreeSlaves; 3134 if i = woEiffel then // deactivate expired wonders 3135 for j := 0 to 27 do 3136 if GWonder[j].EffectiveOwner = p then 3137 CheckExpiration(j); 3138 end; 3139 for i := 28 to nImp - 1 do 3140 if (Imp[i].Kind <> ikCommon) and (RW[p].City[cix].Built[i] > 0) then 3141 begin { destroy national projects } 3142 RW[p].NatBuilt[i] := 0; 3143 if i = imGrWall then 3144 GrWallContinent[p] := -1; 3145 end; 3146 3147 for uix1 := 0 to RW[p].nUn - 1 do 3148 with RW[p].Un[uix1] do 3149 if (Loc >= 0) and (Home = cix) then 3150 if SaveUnits then 3151 begin // support units by nearest other city 3152 nearest := -1; 3153 for cix1 := 0 to RW[p].nCity - 1 do 3154 if (cix1 <> cix) and (RW[p].City[cix1].Loc >= 0) and 3155 ((nearest < 0) or (Distance(RW[p].City[cix1].Loc, Loc) < 3156 Distance(RW[p].City[nearest].Loc, Loc))) then 3157 nearest := cix1; 3158 Home := nearest 3159 end 3160 else 3161 RemoveUnit(p, uix1); // destroy supported units 3162 end; // StealCity 3163 3164 procedure DestroyCity(p, cix: integer; SaveUnits: boolean); 3165 var 3166 i, V21: integer; 3167 Radius: TVicinity21Loc; 3168 begin 3169 StealCity(p, cix, SaveUnits); 3170 with RW[p].City[cix] do 3171 begin 3172 for i := 0 to 27 do 3173 if Built[i] > 0 then 3174 GWonder[i].CityID := -2; // wonder destroyed 3175 V21_to_Loc(Loc, Radius); 3176 for V21 := 1 to 26 do 3177 if 1 shl V21 and Tiles <> 0 then 3178 UsedByCity[Radius[V21]] := -1; 3179 RealMap[Loc] := RealMap[Loc] and not fCity; 3180 Loc := -1 3181 end 3182 end; // DestroyCity 3183 3184 procedure ChangeCityOwner(pOld, cixOld, pNew: integer); 3185 var 3186 i, j, cix1, Loc1, V21: integer; 3187 Radius: TVicinity21Loc; 3188 begin 3189 inc(RW[pNew].nCity); 3190 RW[pNew].City[RW[pNew].nCity - 1] := RW[pOld].City[cixOld]; 3191 StealCity(pOld, cixOld, false); 3192 RW[pOld].City[cixOld].Loc := -1; 3193 with RW[pNew].City[(RW[pNew].nCity - 1)] do 3194 begin 3195 Food := 0; 3196 Project := cpImp + imTrGoods; 3197 Prod := 0; 3198 Project0 := Project; 3199 Prod0 := 0; 3200 Status := 0; 3201 SavedStatus := 0; 3202 N1 := 0; 3203 3204 // check for siege 3205 V21_to_Loc(Loc, Radius); 3206 for V21 := 1 to 26 do 3207 if Tiles and (1 shl V21) and not(1 shl CityOwnTile) <> 0 then 3208 begin 3209 Loc1 := Radius[V21]; 3210 assert((Loc1 >= 0) and (Loc1 < MapSize) and (UsedByCity[Loc1] = Loc)); 3211 if (ZoCMap[Loc1] > 0) and (Occupant[Loc1] <> pNew) and 3212 (RW[pNew].Treaty[Occupant[Loc1]] < trAlliance) then 3213 begin // tile can't remain exploited 3214 Tiles := Tiles and not(1 shl V21); 3215 UsedByCity[Loc1] := -1; 3216 end; 3217 // don't check for siege by peace territory here, because territory 3218 // might not be up to date -- done in turn beginning anyway 3219 end; 3220 Built[imTownHall] := 0; 3221 Built[imCourt] := 0; 3222 for i := 28 to nImp - 1 do 3223 if Imp[i].Kind <> ikCommon then 3224 Built[i] := 0; { destroy national projects } 3225 for i := 0 to 27 do 3226 if Built[i] = 1 then 3227 begin // new wonder owner! 3228 GWonder[i].EffectiveOwner := pNew; 3229 if i = woEiffel then // reactivate expired wonders 3230 begin 3231 for j := 0 to 27 do 3232 if Imp[j].Expiration >= 0 then 3233 for cix1 := 0 to (RW[pNew].nCity - 1) do 3234 if RW[pNew].City[cix1].Built[j] = 1 then 3235 GWonder[j].EffectiveOwner := pNew 3236 end 3237 else 3238 CheckExpiration(i); 3239 case i of 3240 woLighthouse: 3241 CheckSpecialModels(pNew, preLighthouse); 3242 woLeo: 3243 CheckSpecialModels(pNew, preLeo); 3244 woPyramids: 3245 CheckSpecialModels(pNew, preBuilder); 3246 end; 3247 end; 3248 3249 // remove city from enemy cities 3250 // not done by Discover, because fCity still set! 3251 cix1 := RW[pNew].nEnemyCity - 1; 3252 while (cix1 >= 0) and (RW[pNew].EnemyCity[cix1].Loc <> Loc) do 3253 dec(cix1); 3254 assert(cix1 >= 0); 3255 RW[pNew].EnemyCity[cix1].Loc := -1; 3256 3257 ChangeTerritory(Loc, pNew); 3258 end; 3259 end; // ChangeCityOwner 3260 3261 procedure CompleteJob(p, Loc, Job: integer); 3262 var 3263 ChangedTerrain, p1: integer; 3264 begin 3265 assert(Job <> jCity); 3266 ChangedTerrain := -1; 3267 case Job of 3268 jRoad: 3269 RealMap[Loc] := RealMap[Loc] or fRoad; 3270 jRR: 3271 RealMap[Loc] := RealMap[Loc] and not fRoad or fRR; 3272 jClear: 3273 begin 3274 ChangedTerrain := Terrain[RealMap[Loc] and fTerrain].ClearTerrain; 3275 RealMap[Loc] := RealMap[Loc] and not fTerrain or 3276 Cardinal(ChangedTerrain); 3277 RealMap[Loc] := RealMap[Loc] and not(3 shl 5) or 3278 ActualSpecialTile(Loc) shl 5; 3279 end; 3280 jIrr: 3281 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiIrrigation; 3282 jFarm: 3283 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiFarm; 3284 jAfforest: 3285 begin 3286 ChangedTerrain := Terrain[RealMap[Loc] and fTerrain].AfforestTerrain; 3287 RealMap[Loc] := RealMap[Loc] and not fTerrain or 3288 Cardinal(ChangedTerrain); 3289 RealMap[Loc] := RealMap[Loc] and not(3 shl 5) or 3290 ActualSpecialTile(Loc) shl 5; 3291 end; 3292 jMine: 3293 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiMine; 3294 jFort: 3295 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiFort; 3296 jCanal: 3297 RealMap[Loc] := RealMap[Loc] or fCanal; 3298 jTrans: 3299 begin 3300 ChangedTerrain := Terrain[RealMap[Loc] and fTerrain].TransTerrain; 3301 RealMap[Loc] := RealMap[Loc] and not fTerrain or 3302 Cardinal(ChangedTerrain); 3303 RealMap[Loc] := RealMap[Loc] and not(3 shl 5) or 3304 ActualSpecialTile(Loc) shl 5; 3305 if not(RealMap[Loc] and fTerrain in TerrType_Canalable) then 3306 begin 3307 RemoveDomainUnits(dSea, p, Loc); 3308 RealMap[Loc] := RealMap[Loc] and not fCanal; 3309 end; 3310 end; 3311 jPoll: 3312 RealMap[Loc] := RealMap[Loc] and not fPoll; 3313 jBase: 3314 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiBase; 3315 jPillage: 3316 if RealMap[Loc] and fTerImp <> 0 then 3317 begin 3318 if RealMap[Loc] and fTerImp = tiBase then 3319 RemoveDomainUnits(dAir, p, Loc); 3320 RealMap[Loc] := RealMap[Loc] and not fTerImp 2770 3321 end 2771 else RemoveUnit(p,uix1); // destroy supported units 2772 end; //StealCity 2773 2774 procedure DestroyCity(p,cix: integer; SaveUnits: boolean); 2775 var 2776 i,V21: integer; 2777 Radius: TVicinity21Loc; 2778 begin 2779 StealCity(p,cix,SaveUnits); 2780 with RW[p].City[cix] do 2781 begin 2782 for i:=0 to 27 do 2783 if Built[i]>0 then GWonder[i].CityID:=-2; // wonder destroyed 2784 V21_to_Loc(Loc,Radius); 2785 for V21:=1 to 26 do if 1 shl V21 and Tiles<>0 then 2786 UsedByCity[Radius[V21]]:=-1; 2787 RealMap[Loc]:=RealMap[Loc] and not fCity; 2788 Loc:=-1 2789 end 2790 end; //DestroyCity 2791 2792 procedure ChangeCityOwner(pOld,cixOld,pNew: integer); 2793 var 2794 i,j,cix1,Loc1,V21: integer; 2795 Radius: TVicinity21Loc; 2796 begin 2797 inc(RW[pNew].nCity); 2798 RW[pNew].City[RW[pNew].nCity-1]:=RW[pOld].City[cixOld]; 2799 StealCity(pOld,cixOld,false); 2800 RW[pOld].City[cixOld].Loc:=-1; 2801 with RW[pNew].City[(RW[pNew].nCity-1)] do 2802 begin 2803 Food:=0; 2804 Project:=cpImp+imTrGoods; 2805 Prod:=0; 2806 Project0:=Project; 2807 Prod0:=0; 2808 Status:=0; 2809 SavedStatus:=0; 2810 N1:=0; 2811 2812 // check for siege 2813 V21_to_Loc(Loc,Radius); 2814 for V21:=1 to 26 do if Tiles and (1 shl V21) and not (1 shl CityOwnTile)<>0 then 2815 begin 2816 Loc1:=Radius[V21]; 2817 assert((Loc1>=0) and (Loc1<MapSize) and (UsedByCity[Loc1]=Loc)); 2818 if (ZoCMap[Loc1]>0) and (Occupant[Loc1]<>pNew) 2819 and (RW[pNew].Treaty[Occupant[Loc1]]<trAlliance) then 2820 begin // tile can't remain exploited 2821 Tiles:=Tiles and not (1 shl V21); 2822 UsedByCity[Loc1]:=-1; 2823 end; 2824 // don't check for siege by peace territory here, because territory 2825 // might not be up to date -- done in turn beginning anyway 2826 end; 2827 Built[imTownHall]:=0; 2828 Built[imCourt]:=0; 2829 for i:=28 to nImp-1 do if Imp[i].Kind<>ikCommon then 2830 Built[i]:=0; {destroy national projects} 2831 for i:=0 to 27 do 2832 if Built[i]=1 then 2833 begin // new wonder owner! 2834 GWonder[i].EffectiveOwner:=pNew; 2835 if i=woEiffel then // reactivate expired wonders 2836 begin 2837 for j:=0 to 27 do if Imp[j].Expiration>=0 then 2838 for cix1:=0 to (RW[pNew].nCity-1) do 2839 if RW[pNew].City[cix1].Built[j]=1 then 2840 GWonder[j].EffectiveOwner:=pNew 2841 end 2842 else CheckExpiration(i); 2843 case i of 2844 woLighthouse: CheckSpecialModels(pNew,preLighthouse); 2845 woLeo: CheckSpecialModels(pNew,preLeo); 2846 woPyramids: CheckSpecialModels(pNew,preBuilder); 2847 end; 2848 end; 2849 2850 // remove city from enemy cities 2851 // not done by Discover, because fCity still set! 2852 cix1:=RW[pNew].nEnemyCity-1; 2853 while (cix1>=0) and (RW[pNew].EnemyCity[cix1].Loc<>Loc) do dec(cix1); 2854 assert(cix1>=0); 2855 RW[pNew].EnemyCity[cix1].Loc:=-1; 2856 2857 ChangeTerritory(Loc,pNew); 2858 end; 2859 end; //ChangeCityOwner 2860 2861 procedure CompleteJob(p,Loc,Job: integer); 2862 var 2863 ChangedTerrain,p1: integer; 2864 begin 2865 assert(Job<>jCity); 2866 ChangedTerrain:=-1; 2867 case Job of 2868 jRoad: 2869 RealMap[Loc]:=RealMap[Loc] or fRoad; 2870 jRR: 2871 RealMap[Loc]:=RealMap[Loc] and not fRoad or fRR; 2872 jClear: 2873 begin 2874 ChangedTerrain:=Terrain[RealMap[Loc] and fTerrain].ClearTerrain; 2875 RealMap[Loc]:=RealMap[Loc] and not fTerrain or Cardinal(ChangedTerrain); 2876 RealMap[Loc]:=RealMap[Loc] and not (3 shl 5) or ActualSpecialTile(Loc) shl 5; 2877 end; 2878 jIrr: 2879 RealMap[Loc]:=RealMap[Loc] and not fTerImp or tiIrrigation; 2880 jFarm: 2881 RealMap[Loc]:=RealMap[Loc] and not fTerImp or tiFarm; 2882 jAfforest: 2883 begin 2884 ChangedTerrain:=Terrain[RealMap[Loc] and fTerrain].AfforestTerrain; 2885 RealMap[Loc]:=RealMap[Loc] and not fTerrain or Cardinal(ChangedTerrain); 2886 RealMap[Loc]:=RealMap[Loc] and not (3 shl 5) or ActualSpecialTile(Loc) shl 5; 2887 end; 2888 jMine: 2889 RealMap[Loc]:=RealMap[Loc] and not fTerImp or tiMine; 2890 jFort: 2891 RealMap[Loc]:=RealMap[Loc] and not fTerImp or tiFort; 2892 jCanal: 2893 RealMap[Loc]:=RealMap[Loc] or fCanal; 2894 jTrans: 2895 begin 2896 ChangedTerrain:=Terrain[RealMap[Loc] and fTerrain].TransTerrain; 2897 RealMap[Loc]:=RealMap[Loc] and not fTerrain or Cardinal(ChangedTerrain); 2898 RealMap[Loc]:=RealMap[Loc] and not (3 shl 5) or ActualSpecialTile(Loc) shl 5; 2899 if not (RealMap[Loc] and fTerrain in TerrType_Canalable) then 2900 begin 2901 RemoveDomainUnits(dSea,p,Loc); 2902 RealMap[Loc]:=RealMap[Loc] and not fCanal; 2903 end; 2904 end; 2905 jPoll: 2906 RealMap[Loc]:=RealMap[Loc] and not fPoll; 2907 jBase: 2908 RealMap[Loc]:=RealMap[Loc] and not fTerImp or tiBase; 2909 jPillage: 2910 if RealMap[Loc] and fTerImp<>0 then 2911 begin 2912 if RealMap[Loc] and fTerImp=tiBase then 2913 RemoveDomainUnits(dAir,p,Loc); 2914 RealMap[Loc]:=RealMap[Loc] and not fTerImp 3322 else if RealMap[Loc] and fCanal <> 0 then 3323 begin 3324 RemoveDomainUnits(dSea, p, Loc); 3325 RealMap[Loc] := RealMap[Loc] and not fCanal 2915 3326 end 2916 else if RealMap[Loc] and fCanal<>0 then 2917 begin 2918 RemoveDomainUnits(dSea,p,Loc); 2919 RealMap[Loc]:=RealMap[Loc] and not fCanal 2920 end 2921 else if RealMap[Loc] and fRR<>0 then 2922 RealMap[Loc]:=RealMap[Loc] and not fRR or fRoad 2923 else if RealMap[Loc] and fRoad<>0 then 2924 RealMap[Loc]:=RealMap[Loc] and not fRoad; 2925 end; 2926 if ChangedTerrain>=0 then 3327 else if RealMap[Loc] and fRR <> 0 then 3328 RealMap[Loc] := RealMap[Loc] and not fRR or fRoad 3329 else if RealMap[Loc] and fRoad <> 0 then 3330 RealMap[Loc] := RealMap[Loc] and not fRoad; 3331 end; 3332 if ChangedTerrain >= 0 then 2927 3333 begin // remove terrain improvements if not possible on new terrain 2928 if ((RealMap[Loc] and fTerImp=tiIrrigation) 2929 or (RealMap[Loc] and fTerImp=tiFarm)) 2930 and ((Terrain[ChangedTerrain].IrrClearWork=0) 2931 or (Terrain[ChangedTerrain].ClearTerrain>=0)) then 2932 RealMap[Loc]:=RealMap[Loc] and not fTerImp; 2933 if (RealMap[Loc] and fTerImp=tiMine) 2934 and ((Terrain[ChangedTerrain].MineAfforestWork=0) 2935 or (Terrain[ChangedTerrain].AfforestTerrain>=0)) then 2936 RealMap[Loc]:=RealMap[Loc] and not fTerImp; 2937 end; 2938 2939 // update map of all observing players 2940 if Mode>moLoading_Fast then 2941 for p1:=0 to nPl-1 do 2942 if (1 shl p1 and (GAlive or GWatching)<>0) 2943 and (ObserveLevel[Loc] shr (2*p1) and 3>lNoObserve) then 2944 RW[p1].Map[Loc]:=RW[p1].Map[Loc] 2945 and not (fTerrain or fSpecial or fTerImp or fRoad or fRR or fCanal or fPoll) 2946 or RealMap[Loc] and (fTerrain or fSpecial or fTerImp or fRoad or fRR or fCanal or fPoll); 2947 end; //CompleteJob 3334 if ((RealMap[Loc] and fTerImp = tiIrrigation) or 3335 (RealMap[Loc] and fTerImp = tiFarm)) and 3336 ((Terrain[ChangedTerrain].IrrClearWork = 0) or 3337 (Terrain[ChangedTerrain].ClearTerrain >= 0)) then 3338 RealMap[Loc] := RealMap[Loc] and not fTerImp; 3339 if (RealMap[Loc] and fTerImp = tiMine) and 3340 ((Terrain[ChangedTerrain].MineAfforestWork = 0) or 3341 (Terrain[ChangedTerrain].AfforestTerrain >= 0)) then 3342 RealMap[Loc] := RealMap[Loc] and not fTerImp; 3343 end; 3344 3345 // update map of all observing players 3346 if Mode > moLoading_Fast then 3347 for p1 := 0 to nPl - 1 do 3348 if (1 shl p1 and (GAlive or GWatching) <> 0) and 3349 (ObserveLevel[Loc] shr (2 * p1) and 3 > lNoObserve) then 3350 RW[p1].Map[Loc] := RW[p1].Map[Loc] and 3351 not(fTerrain or fSpecial or fTerImp or fRoad or fRR or fCanal or 3352 fPoll) or RealMap[Loc] and (fTerrain or fSpecial or fTerImp or 3353 fRoad or fRR or fCanal or fPoll); 3354 end; // CompleteJob 2948 3355 2949 3356 { 2950 2951 ____________________________________________________________________3357 Diplomacy 3358 ____________________________________________________________________ 2952 3359 } 2953 3360 procedure GiveCivilReport(p, pAbout: integer); 2954 3361 begin 2955 with RW[p].EnemyReport[pAbout]^ do2956 begin 2957 // general info2958 TurnOfCivilReport:=LastValidStat[pAbout];2959 move(RW[pAbout].Treaty, Treaty, SizeOf(Treaty));2960 Government:=RW[pAbout].Government;2961 Money:=RW[pAbout].Money;2962 2963 // tech info2964 ResearchTech:=RW[pAbout].ResearchTech;2965 ResearchDone:=RW[pAbout].Research*100 div TechCost(pAbout);2966 if ResearchDone>100 then2967 ResearchDone:=100;2968 move(RW[pAbout].Tech, Tech, nAdv);3362 with RW[p].EnemyReport[pAbout]^ do 3363 begin 3364 // general info 3365 TurnOfCivilReport := LastValidStat[pAbout]; 3366 move(RW[pAbout].Treaty, Treaty, SizeOf(Treaty)); 3367 Government := RW[pAbout].Government; 3368 Money := RW[pAbout].Money; 3369 3370 // tech info 3371 ResearchTech := RW[pAbout].ResearchTech; 3372 ResearchDone := RW[pAbout].Research * 100 div TechCost(pAbout); 3373 if ResearchDone > 100 then 3374 ResearchDone := 100; 3375 move(RW[pAbout].Tech, Tech, nAdv); 2969 3376 end; 2970 3377 end; … … 2972 3379 procedure GiveMilReport(p, pAbout: integer); 2973 3380 var 2974 uix,mix: integer; 2975 begin 2976 with RW[p].EnemyReport[pAbout]^ do 2977 begin 2978 TurnOfMilReport:=LastValidStat[pAbout]; 2979 nModelCounted:=RW[pAbout].nModel; 2980 for mix:=0 to RW[pAbout].nModel-1 do 2981 begin TellAboutModel(p,pAbout,mix); UnCount[mix]:=0 end; 2982 for uix:=0 to RW[pAbout].nUn-1 do 2983 if RW[pAbout].Un[uix].Loc>=0 then inc(UnCount[RW[pAbout].Un[uix].mix]); 3381 uix, mix: integer; 3382 begin 3383 with RW[p].EnemyReport[pAbout]^ do 3384 begin 3385 TurnOfMilReport := LastValidStat[pAbout]; 3386 nModelCounted := RW[pAbout].nModel; 3387 for mix := 0 to RW[pAbout].nModel - 1 do 3388 begin 3389 TellAboutModel(p, pAbout, mix); 3390 UnCount[mix] := 0 3391 end; 3392 for uix := 0 to RW[pAbout].nUn - 1 do 3393 if RW[pAbout].Un[uix].Loc >= 0 then 3394 inc(UnCount[RW[pAbout].Un[uix].mix]); 2984 3395 end 2985 3396 end; … … 2987 3398 procedure ShowPrice(pSender, pTarget, Price: integer); 2988 3399 begin 2989 case Price and opMask of2990 opTech: // + advance2991 with RW[pTarget].EnemyReport[pSender]^ do2992 if Tech[Price-opTech]<tsApplicable then2993 Tech[Price-opTech]:=tsApplicable;2994 opModel: // + model index2995 TellAboutModel(pTarget,pSender,Price-opModel);2996 {opCity: // + city ID2997 begin2998 end;}3400 case Price and opMask of 3401 opTech: // + advance 3402 with RW[pTarget].EnemyReport[pSender]^ do 3403 if Tech[Price - opTech] < tsApplicable then 3404 Tech[Price - opTech] := tsApplicable; 3405 opModel: // + model index 3406 TellAboutModel(pTarget, pSender, Price - opModel); 3407 { opCity: // + city ID 3408 begin 3409 end; } 2999 3410 end 3000 3411 end; … … 3002 3413 function CopyCivilReport(pSender, pTarget, pAbout: integer): boolean; 3003 3414 var 3004 i: integer;3005 rSender, rTarget: ^TEnemyReport;3415 i: integer; 3416 rSender, rTarget: ^TEnemyReport; 3006 3417 begin // copy third nation civil report 3007 result:=false;3008 if RW[pTarget].Treaty[pAbout]=trNoContact then3009 IntroduceEnemy(pTarget, pAbout);3010 rSender:=pointer(RW[pSender].EnemyReport[pAbout]);3011 rTarget:=pointer(RW[pTarget].EnemyReport[pAbout]);3012 if rSender.TurnOfCivilReport>rTarget.TurnOfCivilReport then3418 result := false; 3419 if RW[pTarget].Treaty[pAbout] = trNoContact then 3420 IntroduceEnemy(pTarget, pAbout); 3421 rSender := pointer(RW[pSender].EnemyReport[pAbout]); 3422 rTarget := pointer(RW[pTarget].EnemyReport[pAbout]); 3423 if rSender.TurnOfCivilReport > rTarget.TurnOfCivilReport then 3013 3424 begin // only if newer than current information 3014 rTarget.TurnOfCivilReport:=rSender.TurnOfCivilReport;3015 rTarget.Treaty:=rSender.Treaty;3016 rTarget.Government:=rSender.Government;3017 rTarget.Money:=rSender.Money;3018 rTarget.ResearchTech:=rSender.ResearchTech;3019 rTarget.ResearchDone:=rSender.ResearchDone;3020 result:=true3021 end; 3022 for i:=0 to nAdv-1 do3023 if rTarget.Tech[i]<rSender.Tech[i] then3024 begin 3025 rTarget.Tech[i]:=rSender.Tech[i];3026 result:=true3425 rTarget.TurnOfCivilReport := rSender.TurnOfCivilReport; 3426 rTarget.Treaty := rSender.Treaty; 3427 rTarget.Government := rSender.Government; 3428 rTarget.Money := rSender.Money; 3429 rTarget.ResearchTech := rSender.ResearchTech; 3430 rTarget.ResearchDone := rSender.ResearchDone; 3431 result := true 3432 end; 3433 for i := 0 to nAdv - 1 do 3434 if rTarget.Tech[i] < rSender.Tech[i] then 3435 begin 3436 rTarget.Tech[i] := rSender.Tech[i]; 3437 result := true 3027 3438 end 3028 3439 end; … … 3030 3441 function CopyMilReport(pSender, pTarget, pAbout: integer): boolean; 3031 3442 var 3032 mix: integer;3033 rSender, rTarget: ^TEnemyReport;3443 mix: integer; 3444 rSender, rTarget: ^TEnemyReport; 3034 3445 begin // copy third nation military report 3035 result:=false;3036 if RW[pTarget].Treaty[pAbout]=trNoContact then3037 IntroduceEnemy(pTarget, pAbout);3038 rSender:=pointer(RW[pSender].EnemyReport[pAbout]);3039 rTarget:=pointer(RW[pTarget].EnemyReport[pAbout]);3040 if rSender.TurnOfMilReport>rTarget.TurnOfMilReport then3446 result := false; 3447 if RW[pTarget].Treaty[pAbout] = trNoContact then 3448 IntroduceEnemy(pTarget, pAbout); 3449 rSender := pointer(RW[pSender].EnemyReport[pAbout]); 3450 rTarget := pointer(RW[pTarget].EnemyReport[pAbout]); 3451 if rSender.TurnOfMilReport > rTarget.TurnOfMilReport then 3041 3452 begin // only if newer than current information 3042 rTarget.TurnOfMilReport:=rSender.TurnOfMilReport;3043 rTarget.nModelCounted:=rSender.nModelCounted;3044 move(rSender.UnCount, rTarget.UnCount, 2*rSender.nModelCounted);3045 for mix:=0 to rTarget.nModelCounted-1 do3046 TellAboutModel(pTarget,pAbout,mix);3047 result:=true3453 rTarget.TurnOfMilReport := rSender.TurnOfMilReport; 3454 rTarget.nModelCounted := rSender.nModelCounted; 3455 move(rSender.UnCount, rTarget.UnCount, 2 * rSender.nModelCounted); 3456 for mix := 0 to rTarget.nModelCounted - 1 do 3457 TellAboutModel(pTarget, pAbout, mix); 3458 result := true 3048 3459 end 3049 3460 end; 3050 3461 3051 procedure CopyModel(pSender,pTarget,mix: integer); 3052 var 3053 i: integer; 3054 miSender, miTarget: TModelInfo; 3055 ok: boolean; 3056 begin 3057 // only if target doesn't already have a model like this 3058 ok:= RW[pTarget].nModel<nmmax; 3059 MakeModelInfo(pSender,mix,RW[pSender].Model[mix],miSender); 3060 for i:=0 to RW[pTarget].nModel-1 do 3061 begin 3062 MakeModelInfo(pTarget,i,RW[pTarget].Model[i],miTarget); 3063 if IsSameModel(miSender,miTarget) then ok:=false 3064 end; 3065 if ok then 3066 begin 3067 RW[pTarget].Model[RW[pTarget].nModel]:=RW[pSender].Model[mix]; 3068 with RW[pTarget].Model[RW[pTarget].nModel] do 3069 begin 3070 IntroTurn:=GTurn; 3071 if Kind=mkSelfDeveloped then Kind:=mkEnemyDeveloped; 3072 Status:=0; 3073 SavedStatus:=0; 3074 Built:=0; 3075 Lost:=0; 3076 end; 3077 inc(RW[pTarget].nModel); 3078 inc(Researched[pTarget]); 3079 TellAboutModel(pSender,pTarget,RW[pTarget].nModel-1); 3462 procedure CopyModel(pSender, pTarget, mix: integer); 3463 var 3464 i: integer; 3465 miSender, miTarget: TModelInfo; 3466 ok: boolean; 3467 begin 3468 // only if target doesn't already have a model like this 3469 ok := RW[pTarget].nModel < nmmax; 3470 MakeModelInfo(pSender, mix, RW[pSender].Model[mix], miSender); 3471 for i := 0 to RW[pTarget].nModel - 1 do 3472 begin 3473 MakeModelInfo(pTarget, i, RW[pTarget].Model[i], miTarget); 3474 if IsSameModel(miSender, miTarget) then 3475 ok := false 3476 end; 3477 if ok then 3478 begin 3479 RW[pTarget].Model[RW[pTarget].nModel] := RW[pSender].Model[mix]; 3480 with RW[pTarget].Model[RW[pTarget].nModel] do 3481 begin 3482 IntroTurn := GTurn; 3483 if Kind = mkSelfDeveloped then 3484 Kind := mkEnemyDeveloped; 3485 Status := 0; 3486 SavedStatus := 0; 3487 Built := 0; 3488 Lost := 0; 3489 end; 3490 inc(RW[pTarget].nModel); 3491 inc(Researched[pTarget]); 3492 TellAboutModel(pSender, pTarget, RW[pTarget].nModel - 1); 3080 3493 end 3081 3494 end; … … 3083 3496 procedure CopyMap(pSender, pTarget: integer); 3084 3497 var 3085 Loc,i,cix:integer; 3086 Tile: Cardinal; 3087 begin 3088 for Loc:=0 to MapSize-1 do 3089 if (RW[pSender].MapObservedLast[Loc]>RW[pTarget].MapObservedLast[Loc]) then 3090 begin 3091 Tile:=RW[pSender].Map[Loc]; 3092 if Tile and fCity<>0 then 3093 begin 3094 i:=0; 3095 while (i<RW[pTarget].nEnemyCity) and (RW[pTarget].EnemyCity[i].Loc<>Loc) do 3096 inc(i); 3097 if i=RW[pTarget].nEnemyCity then 3098 begin 3099 inc(RW[pTarget].nEnemyCity); 3100 assert(RW[pTarget].nEnemyCity<necmax); 3101 RW[pTarget].EnemyCity[i].Status:=0; 3102 RW[pTarget].EnemyCity[i].SavedStatus:=0; 3498 Loc, i, cix: integer; 3499 Tile: Cardinal; 3500 begin 3501 for Loc := 0 to MapSize - 1 do 3502 if (RW[pSender].MapObservedLast[Loc] > RW[pTarget].MapObservedLast[Loc]) 3503 then 3504 begin 3505 Tile := RW[pSender].Map[Loc]; 3506 if Tile and fCity <> 0 then 3507 begin 3508 i := 0; 3509 while (i < RW[pTarget].nEnemyCity) and 3510 (RW[pTarget].EnemyCity[i].Loc <> Loc) do 3511 inc(i); 3512 if i = RW[pTarget].nEnemyCity then 3513 begin 3514 inc(RW[pTarget].nEnemyCity); 3515 assert(RW[pTarget].nEnemyCity < necmax); 3516 RW[pTarget].EnemyCity[i].Status := 0; 3517 RW[pTarget].EnemyCity[i].SavedStatus := 0; 3103 3518 end; 3104 if Tile and fOwned<>0 then3519 if Tile and fOwned <> 0 then 3105 3520 begin // city owned by sender -- create new info 3106 cix:=RW[pSender].nCity-1; 3107 while (cix>=0) and (RW[pSender].City[cix].Loc<>Loc) do dec(cix); 3108 MakeCityInfo(pSender, cix, RW[pTarget].EnemyCity[i]); 3521 cix := RW[pSender].nCity - 1; 3522 while (cix >= 0) and (RW[pSender].City[cix].Loc <> Loc) do 3523 dec(cix); 3524 MakeCityInfo(pSender, cix, RW[pTarget].EnemyCity[i]); 3109 3525 end 3110 else // city not owned by sender -- copy old info 3111 begin 3112 cix:=RW[pSender].nEnemyCity-1; 3113 while (cix>=0) and (RW[pSender].EnemyCity[cix].Loc<>Loc) do dec(cix); 3114 RW[pTarget].EnemyCity[i]:=RW[pSender].EnemyCity[cix]; 3526 else // city not owned by sender -- copy old info 3527 begin 3528 cix := RW[pSender].nEnemyCity - 1; 3529 while (cix >= 0) and (RW[pSender].EnemyCity[cix].Loc <> Loc) do 3530 dec(cix); 3531 RW[pTarget].EnemyCity[i] := RW[pSender].EnemyCity[cix]; 3115 3532 end; 3116 3533 end 3117 else if RW[pTarget].Map[Loc] and fCity<>0 then // remove enemycity 3118 for cix:=0 to RW[pTarget].nEnemyCity-1 do 3119 if RW[pTarget].EnemyCity[cix].Loc=Loc then 3120 RW[pTarget].EnemyCity[cix].Loc:=-1; 3121 3122 Tile:=Tile and (not (fSpecial or fModern) or ResourceMask[pTarget]); 3123 Tile:=Tile or (RW[pTarget].Map[Loc] and fModern); 3124 if (Tile and fTerrain=RW[pTarget].Map[Loc] and fTerrain) then 3125 Tile:=Tile or (RW[pTarget].Map[Loc] and fSpecial); 3126 3127 if RW[pTarget].Map[Loc] and fTerrain=fUNKNOWN then inc(Discovered[pTarget]); 3128 RW[pTarget].Map[Loc]:=RW[pTarget].Map[Loc] and fInEnemyZoC // always preserve this flag! 3129 or Tile and not (fUnit or fHiddenUnit or fStealthUnit 3130 or fObserved or fSpiedOut or fOwned or fInEnemyZoC or fOwnZoCUnit 3131 or fPeace or fGrWall); 3132 if RW[pSender].Territory[Loc]<>RW[pTarget].Territory[Loc] then 3133 begin 3134 RW[pTarget].Territory[Loc]:=RW[pSender].Territory[Loc]; 3135 {if RW[pTarget].BorderHelper<>nil then 3136 RW[pTarget].BorderHelper[Loc]:=0;} 3137 end; 3138 RW[pTarget].Territory[Loc]:=RW[pSender].Territory[Loc]; 3139 RW[pTarget].MapObservedLast[Loc]:=RW[pSender].MapObservedLast[Loc]; 3534 else if RW[pTarget].Map[Loc] and fCity <> 0 then // remove enemycity 3535 for cix := 0 to RW[pTarget].nEnemyCity - 1 do 3536 if RW[pTarget].EnemyCity[cix].Loc = Loc then 3537 RW[pTarget].EnemyCity[cix].Loc := -1; 3538 3539 Tile := Tile and (not(fSpecial or fModern) or ResourceMask[pTarget]); 3540 Tile := Tile or (RW[pTarget].Map[Loc] and fModern); 3541 if (Tile and fTerrain = RW[pTarget].Map[Loc] and fTerrain) then 3542 Tile := Tile or (RW[pTarget].Map[Loc] and fSpecial); 3543 3544 if RW[pTarget].Map[Loc] and fTerrain = fUNKNOWN then 3545 inc(Discovered[pTarget]); 3546 RW[pTarget].Map[Loc] := RW[pTarget].Map[Loc] and fInEnemyZoC 3547 // always preserve this flag! 3548 or Tile and not(fUnit or fHiddenUnit or fStealthUnit or fObserved or 3549 fSpiedOut or fOwned or fInEnemyZoC or fOwnZoCUnit or fPeace or fGrWall); 3550 if RW[pSender].Territory[Loc] <> RW[pTarget].Territory[Loc] then 3551 begin 3552 RW[pTarget].Territory[Loc] := RW[pSender].Territory[Loc]; 3553 { if RW[pTarget].BorderHelper<>nil then 3554 RW[pTarget].BorderHelper[Loc]:=0; } 3555 end; 3556 RW[pTarget].Territory[Loc] := RW[pSender].Territory[Loc]; 3557 RW[pTarget].MapObservedLast[Loc] := RW[pSender].MapObservedLast[Loc]; 3140 3558 end; 3141 3559 end; … … 3143 3561 function PayPrice(pSender, pTarget, Price: integer; execute: boolean): boolean; 3144 3562 var 3145 pSubject,i,n,NewTreaty: integer; 3146 begin 3147 result:=true; 3148 case Price and opMask of 3149 opCivilReport: // + turn + concerned player shl 16 3150 begin 3151 pSubject:=Price shr 16 and $f; 3152 if pTarget=pSubject then result:=false 3153 else if pSender=pSubject then 3154 begin 3155 if execute then GiveCivilReport(pTarget,pSender) 3156 end 3157 else if RW[pSender].EnemyReport[pSubject].TurnOfCivilReport<0 then 3158 result:=false 3159 else if execute then CopyCivilReport(pSender, pTarget, pSubject); 3160 end; 3161 opMilReport: // + turn + concerned player shl 16 3162 begin 3163 pSubject:=Price shr 16 and $f; 3164 if pTarget=pSubject then result:=false 3165 else if pSender=pSubject then 3166 begin 3167 if execute then GiveMilReport(pTarget,pSender) 3168 end 3169 else if RW[pSender].EnemyReport[pSubject].TurnOfMilReport<0 then 3170 result:=false 3171 else if execute then CopyMilReport(pSender, pTarget, pSubject) 3172 end; 3173 opMap: 3174 if execute then 3175 begin 3176 CopyMap(pSender, pTarget); 3177 RecalcPeaceMap(pTarget); 3178 end; 3179 opTreaty..opTreaty+trAlliance: // + nation treaty 3180 begin 3181 if Price-opTreaty=RW[pSender].Treaty[pTarget]-1 then 3182 begin // agreed treaty end 3183 if execute then CancelTreaty(pSender,pTarget,false) 3184 end 3185 else 3186 begin 3187 NewTreaty:=-1; 3188 if Price-opTreaty=RW[pSender].Treaty[pTarget]+1 then 3189 NewTreaty:=Price-opTreaty 3190 else if (RW[pSender].Treaty[pTarget]=trNone) and (Price-opTreaty=trPeace) then 3191 NewTreaty:=trPeace; 3192 if NewTreaty<0 then result:=false 3193 else if execute then 3194 begin 3195 assert(NewTreaty>RW[pSender].Treaty[pTarget]); 3196 RW[pSender].Treaty[pTarget]:=NewTreaty; 3197 RW[pTarget].Treaty[pSender]:=NewTreaty; 3198 if NewTreaty>=trFriendlyContact then 3563 pSubject, i, n, NewTreaty: integer; 3564 begin 3565 result := true; 3566 case Price and opMask of 3567 opCivilReport: // + turn + concerned player shl 16 3568 begin 3569 pSubject := Price shr 16 and $F; 3570 if pTarget = pSubject then 3571 result := false 3572 else if pSender = pSubject then 3573 begin 3574 if execute then 3575 GiveCivilReport(pTarget, pSender) 3576 end 3577 else if RW[pSender].EnemyReport[pSubject].TurnOfCivilReport < 0 then 3578 result := false 3579 else if execute then 3580 CopyCivilReport(pSender, pTarget, pSubject); 3581 end; 3582 opMilReport: // + turn + concerned player shl 16 3583 begin 3584 pSubject := Price shr 16 and $F; 3585 if pTarget = pSubject then 3586 result := false 3587 else if pSender = pSubject then 3588 begin 3589 if execute then 3590 GiveMilReport(pTarget, pSender) 3591 end 3592 else if RW[pSender].EnemyReport[pSubject].TurnOfMilReport < 0 then 3593 result := false 3594 else if execute then 3595 CopyMilReport(pSender, pTarget, pSubject) 3596 end; 3597 opMap: 3598 if execute then 3599 begin 3600 CopyMap(pSender, pTarget); 3601 RecalcPeaceMap(pTarget); 3602 end; 3603 opTreaty .. opTreaty + trAlliance: // + nation treaty 3604 begin 3605 if Price - opTreaty = RW[pSender].Treaty[pTarget] - 1 then 3606 begin // agreed treaty end 3607 if execute then 3608 CancelTreaty(pSender, pTarget, false) 3609 end 3610 else 3611 begin 3612 NewTreaty := -1; 3613 if Price - opTreaty = RW[pSender].Treaty[pTarget] + 1 then 3614 NewTreaty := Price - opTreaty 3615 else if (RW[pSender].Treaty[pTarget] = trNone) and 3616 (Price - opTreaty = trPeace) then 3617 NewTreaty := trPeace; 3618 if NewTreaty < 0 then 3619 result := false 3620 else if execute then 3199 3621 begin 3200 GiveCivilReport(pTarget, pSender); 3201 GiveCivilReport(pSender, pTarget); 3202 end; 3203 if NewTreaty=trAlliance then 3622 assert(NewTreaty > RW[pSender].Treaty[pTarget]); 3623 RW[pSender].Treaty[pTarget] := NewTreaty; 3624 RW[pTarget].Treaty[pSender] := NewTreaty; 3625 if NewTreaty >= TrFriendlyContact then 3626 begin 3627 GiveCivilReport(pTarget, pSender); 3628 GiveCivilReport(pSender, pTarget); 3629 end; 3630 if NewTreaty = trAlliance then 3631 begin 3632 GiveMilReport(pTarget, pSender); 3633 GiveMilReport(pSender, pTarget); 3634 CopyMap(pSender, pTarget); 3635 CopyMap(pTarget, pSender); 3636 RecalcMapZoC(pSender); 3637 RecalcMapZoC(pTarget); 3638 end; 3639 if not(NewTreaty in [trPeace, TrFriendlyContact]) then 3640 begin 3641 RW[pSender].EvaStart[pTarget] := -PeaceEvaTurns - 1; 3642 RW[pTarget].EvaStart[pSender] := -PeaceEvaTurns - 1; 3643 end; 3644 RecalcPeaceMap(pSender); 3645 RecalcPeaceMap(pTarget); 3646 end 3647 end 3648 end; 3649 opShipParts: // + number + part type shl 16 3650 begin 3651 n := Price and $FFFF; // number 3652 i := Price shr 16 and $F; // type 3653 if (i < nShipPart) and (GShip[pSender].Parts[i] >= n) then 3654 begin 3655 if execute then 3204 3656 begin 3205 GiveMilReport(pTarget, pSender); 3206 GiveMilReport(pSender, pTarget); 3207 CopyMap(pSender, pTarget); 3208 CopyMap(pTarget, pSender); 3209 RecalcMapZoC(pSender); 3210 RecalcMapZoC(pTarget); 3211 end; 3212 if not (NewTreaty in [trPeace,trFriendlyContact]) then 3213 begin 3214 RW[pSender].EvaStart[pTarget]:=-PeaceEvaTurns-1; 3215 RW[pTarget].EvaStart[pSender]:=-PeaceEvaTurns-1; 3216 end; 3217 RecalcPeaceMap(pSender); 3218 RecalcPeaceMap(pTarget); 3657 dec(GShip[pSender].Parts[i], n); 3658 RW[pSender].Ship[pSender].Parts[i] := GShip[pSender].Parts[i]; 3659 RW[pTarget].Ship[pSender].Parts[i] := GShip[pSender].Parts[i]; 3660 if RW[pTarget].NatBuilt[imSpacePort] > 0 then 3661 begin // space ship control requires space port 3662 inc(GShip[pTarget].Parts[i], n); 3663 RW[pSender].Ship[pTarget].Parts[i] := GShip[pTarget].Parts[i]; 3664 RW[pTarget].Ship[pTarget].Parts[i] := GShip[pTarget].Parts[i]; 3665 end 3666 end 3667 end 3668 else 3669 result := false; 3670 end; 3671 opMoney: // + value 3672 if (Price - opMoney <= MaxMoneyPrice) and 3673 (RW[pSender].Money >= Price - opMoney) then 3674 begin 3675 if execute then 3676 begin 3677 dec(RW[pSender].Money, Price - opMoney); 3678 inc(RW[pTarget].Money, Price - opMoney); 3219 3679 end 3220 3680 end 3221 end; 3222 opShipParts: // + number + part type shl 16 3223 begin 3224 n:=Price and $FFFF; // number 3225 i:=Price shr 16 and $f; // type 3226 if (i<nShipPart) and (GShip[pSender].Parts[i]>=n) then 3227 begin 3681 else 3682 result := false; 3683 opTribute: // + value 3228 3684 if execute then 3229 begin 3230 dec(GShip[pSender].Parts[i],n); 3231 RW[pSender].Ship[pSender].Parts[i]:=GShip[pSender].Parts[i]; 3232 RW[pTarget].Ship[pSender].Parts[i]:=GShip[pSender].Parts[i]; 3233 if RW[pTarget].NatBuilt[imSpacePort]>0 then 3234 begin // space ship control requires space port 3235 inc(GShip[pTarget].Parts[i],n); 3236 RW[pSender].Ship[pTarget].Parts[i]:=GShip[pTarget].Parts[i]; 3237 RW[pTarget].Ship[pTarget].Parts[i]:=GShip[pTarget].Parts[i]; 3238 end 3685 begin 3686 end; 3687 opTech: // + advance 3688 if RW[pSender].Tech[Price - opTech] >= tsApplicable then 3689 begin 3690 if execute and (RW[pTarget].Tech[Price - opTech] = tsNA) then 3691 begin 3692 SeeTech(pTarget, Price - opTech); 3693 RW[pSender].EnemyReport[pTarget].Tech[Price - opTech] := tsSeen; 3239 3694 end 3240 3695 end 3241 else result:=false; 3242 end; 3243 opMoney: // + value 3244 if (Price-opMoney<=MaxMoneyPrice) and (RW[pSender].Money>=Price-opMoney) then 3245 begin 3696 else 3697 result := false; 3698 opAllTech: 3246 3699 if execute then 3247 begin 3248 dec(RW[pSender].Money,Price-opMoney); 3249 inc(RW[pTarget].Money,Price-opMoney); 3700 for i := 0 to nAdv - 1 do 3701 if (RW[pSender].Tech[i] >= tsApplicable) and 3702 (RW[pTarget].Tech[i] = tsNA) then 3703 begin 3704 SeeTech(pTarget, i); 3705 RW[pSender].EnemyReport[pTarget].Tech[i] := tsSeen; 3706 RW[pTarget].EnemyReport[pSender].Tech[i] := tsApplicable; 3707 end; 3708 opModel: // + model index 3709 if Price - opModel < RW[pSender].nModel then 3710 begin 3711 if execute then 3712 CopyModel(pSender, pTarget, Price - opModel) 3713 end 3714 else 3715 result := false; 3716 opAllModel: 3717 if execute then 3718 for i := 0 to RW[pSender].nModel - 1 do 3719 begin 3720 TellAboutModel(pTarget, pSender, i); 3721 CopyModel(pSender, pTarget, i); 3722 end; 3723 { opCity: // + city ID 3724 begin 3725 result:=false 3726 end; } 3727 end 3728 end; 3729 3730 procedure CancelTreaty(p, pWith: integer; DecreaseCredibility: boolean); 3731 // side effect: PeaceEnded := bitarray of players with which peace treaty was canceled 3732 var 3733 p1, OldTreaty: integer; 3734 begin 3735 OldTreaty := RW[p].Treaty[pWith]; 3736 PeaceEnded := 0; 3737 if OldTreaty >= trPeace then 3738 RW[p].LastCancelTreaty[pWith] := GTurn; 3739 if DecreaseCredibility then 3740 begin 3741 case OldTreaty of 3742 trPeace: 3743 begin 3744 RW[p].Credibility := RW[p].Credibility shr 1; 3745 if RW[p].MaxCredibility > 0 then 3746 dec(RW[p].MaxCredibility, 10); 3747 if RW[p].Credibility > RW[p].MaxCredibility then 3748 RW[p].Credibility := RW[p].MaxCredibility; 3749 end; 3750 trAlliance: 3751 RW[p].Credibility := RW[p].Credibility * 3 div 4; 3752 end; 3753 RW[pWith].EnemyReport[p].Credibility := RW[p].Credibility; 3754 end; 3755 3756 if OldTreaty = trPeace then 3757 begin 3758 for p1 := 0 to nPl - 1 do 3759 if (p1 = pWith) or DecreaseCredibility and (p1 <> p) and 3760 (RW[pWith].Treaty[p1] = trAlliance) and (RW[p].Treaty[p1] >= trPeace) 3761 then 3762 begin 3763 RW[p].Treaty[p1] := trNone; 3764 RW[p1].Treaty[p] := trNone; 3765 RW[p].EvaStart[p1] := -PeaceEvaTurns - 1; 3766 RW[p1].EvaStart[p] := -PeaceEvaTurns - 1; 3767 inc(PeaceEnded, 1 shl p1); 3768 end; 3769 CheckBorders(-1); 3770 if (Mode > moLoading_Fast) and (PeaceEnded > 0) then 3771 RecalcMapZoC(p); 3772 end 3773 else 3774 begin 3775 RW[p].Treaty[pWith] := OldTreaty - 1; 3776 RW[pWith].Treaty[p] := OldTreaty - 1; 3777 if OldTreaty = TrFriendlyContact then 3778 begin // necessary for loading 3779 GiveCivilReport(p, pWith); 3780 GiveCivilReport(pWith, p); 3781 end 3782 else if OldTreaty = trAlliance then 3783 begin // necessary for loading 3784 GiveMilReport(p, pWith); 3785 GiveMilReport(pWith, p); 3786 end; 3787 if (Mode > moLoading_Fast) and (OldTreaty = trAlliance) then 3788 begin 3789 RecalcMapZoC(p); 3790 RecalcMapZoC(pWith); 3791 end 3792 end; 3793 if OldTreaty in [trPeace, trAlliance] then 3794 begin 3795 RecalcPeaceMap(p); 3796 RecalcPeaceMap(pWith); 3797 end 3798 end; 3799 3800 function DoSpyMission(p, pCity, cix, Mission: integer): Cardinal; 3801 var 3802 p1: integer; 3803 begin 3804 result := 0; 3805 case Mission of 3806 smSabotageProd: 3807 RW[pCity].City[cix].Flags := RW[pCity].City[cix].Flags or 3808 chProductionSabotaged; 3809 smStealMap: 3810 begin 3811 CopyMap(pCity, p); 3812 RecalcPeaceMap(p); 3813 end; 3814 smStealCivilReport: 3815 begin 3816 if RW[p].Treaty[pCity] = trNoContact then 3817 IntroduceEnemy(p, pCity); 3818 GiveCivilReport(p, pCity); 3819 end; 3820 smStealMilReport: 3821 begin 3822 if RW[p].Treaty[pCity] = trNoContact then 3823 IntroduceEnemy(p, pCity); 3824 GiveMilReport(p, pCity); 3825 end; 3826 smStealForeignReports: 3827 begin 3828 for p1 := 0 to nPl - 1 do 3829 if (p1 <> p) and (p1 <> pCity) and (RW[pCity].EnemyReport[p1] <> nil) 3830 then 3831 begin 3832 if RW[pCity].EnemyReport[p1].TurnOfCivilReport >= 0 then 3833 if CopyCivilReport(pCity, p, p1) then 3834 result := result or (1 shl (2 * p1)); 3835 if RW[pCity].EnemyReport[p1].TurnOfMilReport >= 0 then 3836 if CopyMilReport(pCity, p, p1) then 3837 result := result or (2 shl (2 * p1)); 3838 end 3839 end; 3840 end; 3841 end; 3842 3843 { 3844 Test Flags 3845 ____________________________________________________________________ 3846 } 3847 procedure ClearTestFlags(ClearFlags: integer); 3848 var 3849 p1: integer; 3850 begin 3851 GTestFlags := GTestFlags and (not ClearFlags or tfTested or tfAllTechs or 3852 tfAllContact); 3853 for p1 := 0 to nPl - 1 do 3854 if 1 shl p1 and (GAlive or GWatching) <> 0 then 3855 RW[p1].TestFlags := GTestFlags; 3856 end; 3857 3858 procedure SetTestFlags(p, SetFlags: integer); 3859 var 3860 i, p1, p2, MoreFlags: integer; 3861 begin 3862 MoreFlags := SetFlags and not GTestFlags; 3863 GTestFlags := GTestFlags or (SetFlags and $7FF); 3864 for p1 := 0 to nPl - 1 do 3865 if 1 shl p1 and (GAlive or GWatching) <> 0 then 3866 RW[p1].TestFlags := GTestFlags; 3867 3868 if MoreFlags and (tfUncover or tfAllContact) <> 0 then 3869 for p1 := 0 to nPl - 2 do 3870 if 1 shl p1 and GAlive <> 0 then 3871 for p2 := p1 + 1 to nPl - 1 do 3872 if 1 shl p2 and GAlive <> 0 then 3873 begin // make p1 and p2 know each other 3874 if RW[p1].Treaty[p2] = trNoContact then 3875 IntroduceEnemy(p1, p2) 3876 end; 3877 3878 if MoreFlags and tfAllTechs <> 0 then 3879 for p1 := 0 to nPl - 1 do 3880 begin 3881 ResourceMask[p1] := $FFFFFFFF; 3882 if 1 shl p1 and GAlive <> 0 then 3883 begin 3884 for i := 0 to nAdv - 1 do // give all techs to player p1 3885 if not(i in FutureTech) and (RW[p1].Tech[i] < tsApplicable) then 3886 begin 3887 RW[p1].Tech[i] := tsCheat; 3888 CheckSpecialModels(p1, i); 3889 end; 3890 for p2 := 0 to nPl - 1 do 3891 if (p2 <> p1) and (1 shl p2 and (GAlive or GWatching) <> 0) then 3892 for i := 1 to 3 do 3893 if RW[p2].EnemyReport[p1].Tech[AgePreq[i]] < tsApplicable then 3894 RW[p2].EnemyReport[p1].Tech[AgePreq[i]] := tsCheat; 3895 end 3896 end; 3897 3898 if MoreFlags and tfUncover <> 0 then 3899 begin 3900 DiscoverAll(p, lObserveSuper); 3901 for p1 := 0 to nPl - 1 do 3902 if 1 shl p1 and GAlive <> 0 then 3903 begin 3904 ResourceMask[p1] := $FFFFFFFF; 3905 if p1 <> p then 3906 begin 3907 GiveCivilReport(p, p1); 3908 GiveMilReport(p, p1); 3250 3909 end 3251 3910 end 3252 else result:=false;3253 opTribute: // + value3254 if execute then3255 begin3256 end;3257 opTech: // + advance3258 if RW[pSender].Tech[Price-opTech]>=tsApplicable then3259 begin3260 if execute and (RW[pTarget].Tech[Price-opTech]=tsNA) then3261 begin3262 SeeTech(pTarget,Price-opTech);3263 RW[pSender].EnemyReport[pTarget].Tech[Price-opTech]:=tsSeen;3264 end3265 end3266 else result:=false;3267 opAllTech:3268 if execute then for i:=0 to nAdv-1 do3269 if (RW[pSender].Tech[i]>=tsApplicable) and (RW[pTarget].Tech[i]=tsNA) then3270 begin3271 SeeTech(pTarget,i);3272 RW[pSender].EnemyReport[pTarget].Tech[i]:=tsSeen;3273 RW[pTarget].EnemyReport[pSender].Tech[i]:=tsApplicable;3274 end;3275 opModel: // + model index3276 if Price-opModel<RW[pSender].nModel then3277 begin3278 if execute then CopyModel(pSender,pTarget,Price-opModel)3279 end3280 else result:=false;3281 opAllModel:3282 if execute then for i:=0 to RW[pSender].nModel-1 do3283 begin3284 TellAboutModel(pTarget,pSender,i);3285 CopyModel(pSender,pTarget,i);3286 end;3287 { opCity: // + city ID3288 begin3289 result:=false3290 end;}3291 end3292 end;3293 3294 procedure CancelTreaty(p, pWith: integer; DecreaseCredibility: boolean);3295 // side effect: PeaceEnded := bitarray of players with which peace treaty was canceled3296 var3297 p1,OldTreaty: integer;3298 begin3299 OldTreaty:=RW[p].Treaty[pWith];3300 PeaceEnded:=0;3301 if OldTreaty>=trPeace then3302 RW[p].LastCancelTreaty[pWith]:=GTurn;3303 if DecreaseCredibility then3304 begin3305 case OldTreaty of3306 trPeace:3307 begin3308 RW[p].Credibility:=RW[p].Credibility shr 1;3309 if RW[p].MaxCredibility>0 then3310 dec(RW[p].MaxCredibility,10);3311 if RW[p].Credibility>RW[p].MaxCredibility then3312 RW[p].Credibility:=RW[p].MaxCredibility;3313 end;3314 trAlliance:3315 RW[p].Credibility:=RW[p].Credibility*3 div 4;3316 end;3317 RW[pWith].EnemyReport[p].Credibility:=RW[p].Credibility;3318 end;3319 3320 if OldTreaty=trPeace then3321 begin3322 for p1:=0 to nPl-1 do3323 if (p1=pWith)3324 or DecreaseCredibility and (p1<>p)3325 and (RW[pWith].Treaty[p1]=trAlliance)3326 and (RW[p].Treaty[p1]>=trPeace) then3327 begin3328 RW[p].Treaty[p1]:=trNone;3329 RW[p1].Treaty[p]:=trNone;3330 RW[p].EvaStart[p1]:=-PeaceEvaTurns-1;3331 RW[p1].EvaStart[p]:=-PeaceEvaTurns-1;3332 inc(PeaceEnded,1 shl p1);3333 end;3334 CheckBorders(-1);3335 if (Mode>moLoading_Fast) and (PeaceEnded>0) then3336 RecalcMapZoC(p);3337 end3338 else3339 begin3340 RW[p].Treaty[pWith]:=OldTreaty-1;3341 RW[pWith].Treaty[p]:=OldTreaty-1;3342 if OldTreaty=trFriendlyContact then3343 begin // necessary for loading3344 GiveCivilReport(p, pWith);3345 GiveCivilReport(pWith, p);3346 end3347 else if OldTreaty=trAlliance then3348 begin // necessary for loading3349 GiveMilReport(p, pWith);3350 GiveMilReport(pWith, p);3351 end;3352 if (Mode>moLoading_Fast) and (OldTreaty=trAlliance) then3353 begin3354 RecalcMapZoC(p);3355 RecalcMapZoC(pWith);3356 end3357 end;3358 if OldTreaty in [trPeace,trAlliance] then3359 begin3360 RecalcPeaceMap(p);3361 RecalcPeaceMap(pWith);3362 end3363 end;3364 3365 function DoSpyMission(p,pCity,cix,Mission: integer): Cardinal;3366 var3367 p1: integer;3368 begin3369 result:=0;3370 case Mission of3371 smSabotageProd: RW[pCity].City[cix].Flags:=3372 RW[pCity].City[cix].Flags or chProductionSabotaged;3373 smStealMap:3374 begin3375 CopyMap(pCity,p);3376 RecalcPeaceMap(p);3377 end;3378 smStealCivilReport:3379 begin3380 if RW[p].Treaty[pCity]=trNoContact then IntroduceEnemy(p,pCity);3381 GiveCivilReport(p,pCity);3382 end;3383 smStealMilReport:3384 begin3385 if RW[p].Treaty[pCity]=trNoContact then IntroduceEnemy(p,pCity);3386 GiveMilReport(p,pCity);3387 end;3388 smStealForeignReports:3389 begin3390 for p1:=0 to nPl-1 do if (p1<>p) and (p1<>pCity)3391 and (RW[pCity].EnemyReport[p1]<>nil) then3392 begin3393 if RW[pCity].EnemyReport[p1].TurnOfCivilReport>=0 then3394 if CopyCivilReport(pCity,p,p1) then3395 result:=result or (1 shl (2*p1));3396 if RW[pCity].EnemyReport[p1].TurnOfMilReport>=0 then3397 if CopyMilReport(pCity,p,p1) then3398 result:=result or (2 shl (2*p1));3399 end3400 end;3401 3911 end; 3402 3912 end; 3403 3913 3404 3914 { 3405 Test Flags3406 ____________________________________________________________________3915 Internal Command Processing 3916 ____________________________________________________________________ 3407 3917 } 3408 procedure ClearTestFlags(ClearFlags: integer); 3409 var 3410 p1: integer; 3411 begin 3412 GTestFlags:=GTestFlags and (not ClearFlags or tfTested or tfAllTechs or tfAllContact); 3413 for p1:=0 to nPl-1 do if 1 shl p1 and (GAlive or GWatching)<>0 then 3414 RW[p1].TestFlags:=GTestFlags; 3415 end; 3416 3417 procedure SetTestFlags(p,SetFlags: integer); 3418 var 3419 i,p1,p2,MoreFlags: integer; 3420 begin 3421 MoreFlags:=SetFlags and not GTestFlags; 3422 GTestFlags:=GTestFlags or (SetFlags and $7FF); 3423 for p1:=0 to nPl-1 do if 1 shl p1 and (GAlive or GWatching)<>0 then 3424 RW[p1].TestFlags:=GTestFlags; 3425 3426 if MoreFlags and (tfUncover or tfAllContact)<>0 then 3427 for p1:=0 to nPl-2 do 3428 if 1 shl p1 and GAlive<>0 then 3429 for p2:=p1+1 to nPl-1 do if 1 shl p2 and GAlive<>0 then 3430 begin // make p1 and p2 know each other 3431 if RW[p1].Treaty[p2]=trNoContact then 3432 IntroduceEnemy(p1,p2) 3433 end; 3434 3435 if MoreFlags and tfAllTechs<>0 then 3436 for p1:=0 to nPl-1 do 3437 begin 3438 ResourceMask[p1]:=$FFFFFFFF; 3439 if 1 shl p1 and GAlive<>0 then 3440 begin 3441 for i:=0 to nAdv-1 do // give all techs to player p1 3442 if not (i in FutureTech) and (RW[p1].Tech[i]<tsApplicable) then 3443 begin 3444 RW[p1].Tech[i]:=tsCheat; 3445 CheckSpecialModels(p1,i); 3446 end; 3447 for p2:=0 to nPl-1 do if (p2<>p1) and (1 shl p2 and (GAlive or GWatching)<>0) then 3448 for i:=1 to 3 do 3449 if RW[p2].EnemyReport[p1].Tech[AgePreq[i]]<tsApplicable then 3450 RW[p2].EnemyReport[p1].Tech[AgePreq[i]]:=tsCheat; 3451 end 3452 end; 3453 3454 if MoreFlags and tfUncover<>0 then 3455 begin 3456 DiscoverAll(p,lObserveSuper); 3457 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then 3458 begin 3459 ResourceMask[p1]:=$FFFFFFFF; 3460 if p1<>p then 3461 begin 3462 GiveCivilReport(p, p1); 3463 GiveMilReport(p, p1); 3464 end 3465 end 3466 end; 3467 end; 3468 3469 { 3470 Internal Command Processing 3471 ____________________________________________________________________ 3472 } 3473 procedure IntServer(Command,Player,Subject:integer;var Data); 3474 var 3475 i,p1: integer; 3476 3477 begin 3478 if Mode=moPlaying then 3479 CL.Put(Command, Player, Subject, @Data); 3480 3481 case Command of 3482 3483 sIntTellAboutNation: 3484 begin 3485 {$IFDEF TEXTLOG}CmdInfo:=Format('IntTellAboutNation P%d+P%d', [Player,Subject]);{$ENDIF} 3486 assert((Player>=0) and (Player<nPl) and (Subject>=0) and (Subject<nPl)); 3487 IntroduceEnemy(Player,Subject); 3488 end; 3489 3490 sIntHaveContact: 3491 begin 3492 {$IFDEF TEXTLOG}CmdInfo:=Format('IntHaveContact P%d+P%d', [Player,Subject]);{$ENDIF} 3493 assert(RW[Player].Treaty[Subject]>trNoContact); 3494 RW[Player].EnemyReport[Subject].TurnOfContact:=GTurn; 3495 RW[Subject].EnemyReport[Player].TurnOfContact:=GTurn; 3496 end; 3497 3498 sIntCancelTreaty: 3499 begin 3500 {$IFDEF TEXTLOG}CmdInfo:=Format('IntCancelTreaty P%d with P%d', [Player,Subject]);{$ENDIF} 3501 CancelTreaty(Player,Subject); 3502 end; 3503 3504 (* sIntChoosePeace: 3505 begin 3506 {$IFDEF TEXTLOG}CmdInfo:=Format('IntChoosePeace P%d+P%d', [Player,Subject]);{$ENDIF} 3507 RW[Player].Treaty[Subject]:=trPeace; 3508 RW[Subject].Treaty[Player]:=trPeace; 3509 end;*) 3510 3511 sIntTellAboutModel..sIntTellAboutModel+(nPl-1) shl 4: 3512 begin 3513 p1:=(Command-sIntTellAboutModel) shr 4; // told player 3514 {$IFDEF TEXTLOG}CmdInfo:=Format('IntTellAboutModel P%d about P%d Mod%d', [p1,Player,Subject]);{$ENDIF} 3515 assert((Player>=0) and (Player<nPl)); 3516 assert((Subject>=0) and (Subject<RW[Player].nModel)); 3517 MakeModelInfo(Player,Subject,RW[Player].Model[Subject], 3518 RW[p1].EnemyModel[RW[p1].nEnemyModel]); 3519 RWemix[p1,Player,Subject]:=RW[p1].nEnemyModel; 3520 inc(RW[p1].nEnemyModel); 3521 assert(RW[p1].nEnemyModel<nemmax); 3522 end; 3523 3524 sIntDiscoverZOC: 3525 begin 3526 {$IFDEF TEXTLOG}CmdInfo:=Format('IntDiscoverZOC P%d Loc%d', [Player,integer(data)]);{$ENDIF} 3527 Discover9(integer(Data),Player,lObserveUnhidden,true,false); 3528 end; 3529 3530 sIntExpandTerritory: 3531 if Mode<moPlaying then 3532 begin 3533 {$IFDEF TEXTLOG}CmdInfo:=Format('IntExpandTerritory P%d Loc%d', [Player,RW[Player].City[Subject].Loc]);{$ENDIF} 3534 move(Data,BorderChanges,sizeof(BorderChanges)); 3535 ExpandTerritory(RW[Player].City[Subject].Loc); 3536 end; 3537 3538 sIntBuyMaterial: 3539 with RW[Player].City[Subject] do 3540 begin 3541 {$IFDEF TEXTLOG}CmdInfo:=Format('IntBuyMaterial P%d Loc%d Cost%d', [Player,Loc,integer(Data)]);{$ENDIF} 3542 dec(RW[Player].Money,integer(Data)); 3543 if (GWonder[woMich].EffectiveOwner=Player) and (Project and cpImp<>0) then 3544 inc(Prod,integer(Data) div 2) 3545 else inc(Prod,integer(Data) div 4); 3546 if Project0 and not cpAuto<>Project and not cpAuto then 3547 Project0:=Project; 3548 Prod0:=Prod; 3549 end; 3550 3551 sIntPayPrices..sIntPayPrices+12: 3552 begin 3553 {$IFDEF TEXTLOG}CmdInfo:=Format('IntPayPrices P%d+P%d', [Player,Subject]);{$ENDIF} 3554 for i:=0 to TOffer(Data).nDeliver-1 do 3555 PayPrice(Player,Subject,TOffer(Data).Price[i],true); 3556 for i:=0 to TOffer(Data).nCost-1 do 3557 PayPrice(Subject,Player,TOffer(Data).Price[TOffer(Data).nDeliver+i],true); 3558 for i:=0 to TOffer(Data).nDeliver+TOffer(Data).nCost-1 do 3559 if TOffer(Data).Price[i]=opTreaty+trAlliance then 3560 begin // add view area of allied player 3561 DiscoverViewAreas(Player); 3562 DiscoverViewAreas(Subject); 3563 break 3564 end 3565 end; 3566 3567 sIntSetDevModel: 3568 if Mode<moPlaying then 3569 move(Data, RW[Player].DevModel.Kind, sIntSetDevModel and $F *4); 3570 3571 sIntSetModelStatus: if ProcessClientData[Player] then 3572 begin 3573 {$IFDEF TEXTLOG}CmdInfo:=Format('IntSetModelStatus P%d', [Player]);{$ENDIF} 3574 RW[Player].Model[Subject].Status:=integer(Data); 3575 end; 3576 3577 sIntSetUnitStatus: if ProcessClientData[Player] then 3578 begin 3579 {$IFDEF TEXTLOG}CmdInfo:=Format('IntSetUnitStatus P%d', [Player]);{$ENDIF} 3580 RW[Player].Un[Subject].Status:=integer(Data); 3581 end; 3582 3583 sIntSetCityStatus: if ProcessClientData[Player] then 3584 begin 3585 {$IFDEF TEXTLOG}CmdInfo:=Format('IntSetCityStatus P%d', [Player]);{$ENDIF} 3586 RW[Player].City[Subject].Status:=integer(Data); 3587 end; 3588 3589 sIntSetECityStatus: if ProcessClientData[Player] then 3590 begin 3591 {$IFDEF TEXTLOG}CmdInfo:=Format('IntSetECityStatus P%d', [Player]);{$ENDIF} 3592 RW[Player].EnemyCity[Subject].Status:=integer(Data); 3593 end; 3594 3595 end;{case command} 3596 end;{IntServer} 3918 procedure IntServer(Command, Player, Subject: integer; var Data); 3919 var 3920 i, p1: integer; 3921 3922 begin 3923 if Mode = moPlaying then 3924 CL.Put(Command, Player, Subject, @Data); 3925 3926 case Command of 3927 3928 sIntTellAboutNation: 3929 begin 3930 {$IFDEF TEXTLOG}CmdInfo := Format('IntTellAboutNation P%d+P%d', [Player, Subject]); {$ENDIF} 3931 assert((Player >= 0) and (Player < nPl) and (Subject >= 0) and 3932 (Subject < nPl)); 3933 IntroduceEnemy(Player, Subject); 3934 end; 3935 3936 sIntHaveContact: 3937 begin 3938 {$IFDEF TEXTLOG}CmdInfo := Format('IntHaveContact P%d+P%d', [Player, Subject]); {$ENDIF} 3939 assert(RW[Player].Treaty[Subject] > trNoContact); 3940 RW[Player].EnemyReport[Subject].TurnOfContact := GTurn; 3941 RW[Subject].EnemyReport[Player].TurnOfContact := GTurn; 3942 end; 3943 3944 sIntCancelTreaty: 3945 begin 3946 {$IFDEF TEXTLOG}CmdInfo := Format('IntCancelTreaty P%d with P%d', [Player, Subject]); {$ENDIF} 3947 CancelTreaty(Player, Subject); 3948 end; 3949 3950 (* sIntChoosePeace: 3951 begin 3952 {$IFDEF TEXTLOG}CmdInfo:=Format('IntChoosePeace P%d+P%d', [Player,Subject]);{$ENDIF} 3953 RW[Player].Treaty[Subject]:=trPeace; 3954 RW[Subject].Treaty[Player]:=trPeace; 3955 end; *) 3956 3957 sIntTellAboutModel .. sIntTellAboutModel + (nPl - 1) shl 4: 3958 begin 3959 p1 := (Command - sIntTellAboutModel) shr 4; // told player 3960 {$IFDEF TEXTLOG}CmdInfo := Format('IntTellAboutModel P%d about P%d Mod%d', [p1, Player, Subject]); {$ENDIF} 3961 assert((Player >= 0) and (Player < nPl)); 3962 assert((Subject >= 0) and (Subject < RW[Player].nModel)); 3963 MakeModelInfo(Player, Subject, RW[Player].Model[Subject], 3964 RW[p1].EnemyModel[RW[p1].nEnemyModel]); 3965 RWemix[p1, Player, Subject] := RW[p1].nEnemyModel; 3966 inc(RW[p1].nEnemyModel); 3967 assert(RW[p1].nEnemyModel < nemmax); 3968 end; 3969 3970 sIntDiscoverZOC: 3971 begin 3972 {$IFDEF TEXTLOG}CmdInfo := Format('IntDiscoverZOC P%d Loc%d', [Player, integer(Data)]); {$ENDIF} 3973 Discover9(integer(Data), Player, lObserveUnhidden, true, false); 3974 end; 3975 3976 sIntExpandTerritory: 3977 if Mode < moPlaying then 3978 begin 3979 {$IFDEF TEXTLOG}CmdInfo := Format('IntExpandTerritory P%d Loc%d', [Player, RW[Player].City[Subject].Loc]); {$ENDIF} 3980 move(Data, BorderChanges, SizeOf(BorderChanges)); 3981 ExpandTerritory(RW[Player].City[Subject].Loc); 3982 end; 3983 3984 sIntBuyMaterial: 3985 with RW[Player].City[Subject] do 3986 begin 3987 {$IFDEF TEXTLOG}CmdInfo := Format('IntBuyMaterial P%d Loc%d Cost%d', [Player, Loc, integer(Data)]); {$ENDIF} 3988 dec(RW[Player].Money, integer(Data)); 3989 if (GWonder[woMich].EffectiveOwner = Player) and (Project and cpImp <> 0) 3990 then 3991 inc(Prod, integer(Data) div 2) 3992 else 3993 inc(Prod, integer(Data) div 4); 3994 if Project0 and not cpAuto <> Project and not cpAuto then 3995 Project0 := Project; 3996 Prod0 := Prod; 3997 end; 3998 3999 sIntPayPrices .. sIntPayPrices + 12: 4000 begin 4001 {$IFDEF TEXTLOG}CmdInfo := Format('IntPayPrices P%d+P%d', [Player, Subject]); {$ENDIF} 4002 for i := 0 to TOffer(Data).nDeliver - 1 do 4003 PayPrice(Player, Subject, TOffer(Data).Price[i], true); 4004 for i := 0 to TOffer(Data).nCost - 1 do 4005 PayPrice(Subject, Player, TOffer(Data).Price[TOffer(Data).nDeliver 4006 + i], true); 4007 for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost - 1 do 4008 if TOffer(Data).Price[i] = opTreaty + trAlliance then 4009 begin // add view area of allied player 4010 DiscoverViewAreas(Player); 4011 DiscoverViewAreas(Subject); 4012 Break 4013 end 4014 end; 4015 4016 sIntSetDevModel: 4017 if Mode < moPlaying then 4018 move(Data, RW[Player].DevModel.Kind, sIntSetDevModel and $F * 4); 4019 4020 sIntSetModelStatus: 4021 if ProcessClientData[Player] then 4022 begin 4023 {$IFDEF TEXTLOG}CmdInfo := Format('IntSetModelStatus P%d', [Player]); 4024 {$ENDIF} 4025 RW[Player].Model[Subject].Status := integer(Data); 4026 end; 4027 4028 sIntSetUnitStatus: 4029 if ProcessClientData[Player] then 4030 begin 4031 {$IFDEF TEXTLOG}CmdInfo := Format('IntSetUnitStatus P%d', [Player]); 4032 {$ENDIF} 4033 RW[Player].Un[Subject].Status := integer(Data); 4034 end; 4035 4036 sIntSetCityStatus: 4037 if ProcessClientData[Player] then 4038 begin 4039 {$IFDEF TEXTLOG}CmdInfo := Format('IntSetCityStatus P%d', [Player]); 4040 {$ENDIF} 4041 RW[Player].City[Subject].Status := integer(Data); 4042 end; 4043 4044 sIntSetECityStatus: 4045 if ProcessClientData[Player] then 4046 begin 4047 {$IFDEF TEXTLOG}CmdInfo := Format('IntSetECityStatus P%d', [Player]); 4048 {$ENDIF} 4049 RW[Player].EnemyCity[Subject].Status := integer(Data); 4050 end; 4051 4052 end; { case command } 4053 end; { IntServer } 3597 4054 3598 4055 end. 3599
Note:
See TracChangeset
for help on using the changeset viewer.