source: tags/1.3.0/Database.pas

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