source: trunk/Database.pas@ 183

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