source: branches/highdpi/Database.pas@ 210

Last change on this file since 210 was 210, checked in by chronos, 19 months ago
  • Modified: Improved HighDPI branch. Imported new changes from trunk branch.
File size: 121.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 //{$DEFINE FastContact} { extra small world with railroad everywhere }
14
15 neumax = 4096;
16 necmax = 1024;
17 nemmax = 1024;
18
19 lNoObserve = 0;
20 lObserveUnhidden = 1;
21 lObserveAll = 2;
22 lObserveSuper = 3; // observe levels
23
24 TerrType_Canalable = [fGrass, fDesert, fPrairie, fTundra, fSwamp,
25 fForest, fHills];
26
27 nStartUn = 1;
28 StartUn: array [0 .. nStartUn - 1] of integer = (0); // mix of start units
29
30 CityOwnTile = 13;
31
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 {$IFDEF FastContact}
1660 { Railroad everywhere }
1661 for Loc1 := 0 to MapSize - 1 do
1662 if RealMap[Loc1] and fTerrain >= fGrass then
1663 RealMap[Loc1] := RealMap[Loc1] or fRR;
1664 {$ENDIF}
1665
1666 { !!!for Loc1:=0 to MapSize-1 do
1667 if RealMap[Loc1] and fterrain>=fGrass then
1668 if Delphirandom(3)=0 then RealMap[Loc1]:=RealMap[Loc1] or fRoad
1669 else if Delphirandom(3)=0 then RealMap[Loc1]:=RealMap[Loc1] or fRR;
1670 {random Road and Railroad }
1671 { !!!for Loc1:=0 to MapSize-1 do
1672 if (RealMap[Loc1] and fterrain>=fGrass) and (Delphirandom(20)=0) then
1673 RealMap[Loc1]:=RealMap[Loc1] or fPoll; }
1674
1675 FillChar(Occupant, MapSize, Byte(-1));
1676 FillChar(ZoCMap, MapSize, 0);
1677 FillChar(ObserveLevel, MapSize * 4, 0);
1678 FillChar(UsedByCity, MapSize * 4, Byte(-1));
1679 GTestFlags := 0;
1680 GInitialized := GAlive or GWatching;
1681 for p := 0 to nPl - 1 do
1682 if 1 shl p and GInitialized <> 0 then
1683 with RW[p] do
1684 begin
1685 Researched[p] := 0;
1686 Discovered[p] := 0;
1687 TerritoryCount[p] := 0;
1688 nTech[p] := 0;
1689 if Difficulty[p] = 0 then
1690 ResourceMask[p] := $FFFFFFFF
1691 else
1692 ResourceMask[p] := $FFFFFFFF and not(fSpecial2 or fModern);
1693 GrWallContinent[p] := -1;
1694
1695 GetMem(Map, 4 * MapSize);
1696 GetMem(MapObservedLast, 2 * MapSize);
1697 FillChar(MapObservedLast^, 2 * MapSize, Byte(-1));
1698 GetMem(Territory, MapSize);
1699 FillChar(Territory^, MapSize, $FF);
1700 GetMem(Un, numax * SizeOf(TUn));
1701 GetMem(Model, (nmmax + 1) * SizeOf(TModel));
1702 // draft needs one model behind last
1703 GetMem(City, ncmax * SizeOf(TCity));
1704 GetMem(EnemyUn, neumax * SizeOf(TUnitInfo));
1705 GetMem(EnemyCity, necmax * SizeOf(TCityInfo));
1706 GetMem(EnemyModel, nemmax * SizeOf(TModelInfo));
1707 for p1 := 0 to nPl - 1 do
1708 begin
1709 if 1 shl p1 and GInitialized <> 0 then
1710 begin
1711 FillChar(RWemix[p, p1], SizeOf(RWemix[p, p1]), 255); { -1 }
1712 FillChar(Destroyed[p, p1], SizeOf(Destroyed[p, p1]), 0);
1713 end;
1714 Attitude[p1] := atNeutral;
1715 Treaty[p1] := trNoContact;
1716 LastCancelTreaty[p1] := -CancelTreatyTurns - 1;
1717 EvaStart[p1] := -PeaceEvaTurns - 1;
1718 Tribute[p1] := 0;
1719 TributePaid[p1] := 0;
1720 if (p1 <> p) and (1 shl p1 and GAlive <> 0) then
1721 begin // initialize enemy report
1722 GetMem(EnemyReport[p1], SizeOf(TEnemyReport) - 2 *
1723 (INFIN + 1 - nmmax));
1724 FillChar(EnemyReport[p1].Tech, nAdv, Byte(tsNA));
1725 EnemyReport[p1].TurnOfContact := -1;
1726 EnemyReport[p1].TurnOfCivilReport := -1;
1727 EnemyReport[p1].TurnOfMilReport := -1;
1728 EnemyReport[p1].Attitude := atNeutral;
1729 EnemyReport[p1].Government := gDespotism;
1730 if 1 shl p and GAlive = 0 then
1731 Treaty[p1] := trNone // supervisor
1732 end
1733 else
1734 EnemyReport[p1] := nil;
1735 end;
1736 TestFlags := GTestFlags;
1737 Credibility := InitialCredibility;
1738 MaxCredibility := 100;
1739 nUn := 0;
1740 nModel := 0;
1741 nCity := 0;
1742 nEnemyUn := 0;
1743 nEnemyCity := 0;
1744 nEnemyModel := 0;
1745 for Loc1 := 0 to MapSize - 1 do
1746 Map[Loc1] := fUNKNOWN;
1747 FillChar(Tech, nAdv, Byte(tsNA));
1748 FillChar(NatBuilt, SizeOf(NatBuilt), 0);
1749 end;
1750
1751 // create initial models and units
1752 for p := 0 to nPl - 1 do
1753 if (1 shl p and GAlive <> 0) then
1754 with RW[p] do
1755 begin
1756 nModel := 0;
1757 for i := 0 to nSpecialModel - 1 do
1758 if SpecialModelPreq[i] = preNone then
1759 begin
1760 Model[nModel] := SpecialModel[i];
1761 Model[nModel].Status := 0;
1762 Model[nModel].IntroTurn := 0;
1763 Model[nModel].Built := 0;
1764 Model[nModel].Lost := 0;
1765 Model[nModel].ID := p shl 12 + nModel;
1766 SetModelFlags(Model[nModel]);
1767 inc(nModel)
1768 end;
1769 nUn := 0;
1770 UnBuilt[p] := 0;
1771 for uix := 0 to nStartUn - 1 do
1772 begin
1773 CreateUnit(p, StartUn[uix]);
1774 dec(Model[StartUn[uix]].Built);
1775 Un[uix].Loc := StartLoc2[p];
1776 PlaceUnit(p, uix);
1777 end;
1778 FoundCity(p, StartLoc[p]); // capital
1779 Founded[p] := 1;
1780 with City[0] do
1781 begin
1782 ID := p shl 12;
1783 Flags := chFounded;
1784 end;
1785 end;
1786
1787 TerritoryCount[nPl] := MapSize;
1788 // fillchar(NewContact, sizeof(NewContact), false);
1789end; // InitGame
1790
1791procedure InitRandomGame;
1792begin
1793 DelphiRandSeed := RND;
1794 CalculatePrimitive;
1795 CreateElevation;
1796 CreateMap(false);
1797 StartPositions;
1798 InitGame;
1799end;
1800
1801procedure InitMapGame(Human: integer);
1802begin
1803 DelphiRandSeed := RND;
1804 FindContinents;
1805 PredefinedStartPositions(Human);
1806 InitGame;
1807end;
1808
1809procedure ReleaseGame;
1810var
1811 p1, p2: integer;
1812begin
1813 for p1 := 0 to nPl - 1 do
1814 if 1 shl p1 and GInitialized <> 0 then
1815 begin
1816 for p2 := 0 to nPl - 1 do
1817 if RW[p1].EnemyReport[p2] <> nil then
1818 FreeMem(RW[p1].EnemyReport[p2]);
1819 FreeMem(RW[p1].EnemyUn);
1820 FreeMem(RW[p1].EnemyCity);
1821 FreeMem(RW[p1].EnemyModel);
1822 FreeMem(RW[p1].Un);
1823 FreeMem(RW[p1].City);
1824 FreeMem(RW[p1].Model);
1825 FreeMem(RW[p1].Territory);
1826 FreeMem(RW[p1].MapObservedLast);
1827 FreeMem(RW[p1].Map);
1828 end;
1829end;
1830
1831procedure InitMapEditor;
1832var
1833 p1: integer;
1834begin
1835 CalculatePrimitive;
1836 FillChar(Occupant, MapSize, Byte(-1));
1837 FillChar(ObserveLevel, MapSize * 4, 0);
1838 with RW[0] do
1839 begin
1840 ResourceMask[0] := $FFFFFFFF;
1841 GetMem(Map, 4 * MapSize);
1842 GetMem(MapObservedLast, 2 * MapSize);
1843 FillChar(MapObservedLast^, 2 * MapSize, Byte(-1));
1844 GetMem(Territory, MapSize);
1845 FillChar(Territory^, MapSize, $FF);
1846 Un := nil;
1847 Model := nil;
1848 City := nil;
1849 EnemyUn := nil;
1850 EnemyCity := nil;
1851 EnemyModel := nil;
1852 for p1 := 0 to nPl - 1 do
1853 EnemyReport[p1] := nil;
1854 nUn := 0;
1855 nModel := 0;
1856 nCity := 0;
1857 nEnemyUn := 0;
1858 nEnemyCity := 0;
1859 nEnemyModel := 0;
1860 end;
1861end;
1862
1863procedure ReleaseMapEditor;
1864begin
1865 FreeMem(RW[0].Territory);
1866 FreeMem(RW[0].MapObservedLast);
1867 FreeMem(RW[0].Map);
1868end;
1869
1870procedure EditTile(Loc, NewTile: integer);
1871var
1872 Loc1, V21: integer;
1873 Radius: TVicinity21Loc;
1874begin
1875 if NewTile and fDeadLands <> 0 then
1876 NewTile := NewTile and (fDeadLands or fModern or fRiver) or fDesert;
1877 case NewTile and fTerrain of
1878 fOcean, fShore:
1879 NewTile := NewTile and (fTerrain or fSpecial);
1880 fMountains, fArctic:
1881 NewTile := NewTile and not fRiver;
1882 end;
1883 with Terrain[NewTile and fTerrain] do
1884 if (ClearTerrain >= 0) or (AfforestTerrain >= 0) or (TransTerrain >= 0) then
1885 NewTile := NewTile or fSpecial;
1886 // only automatic special resources for transformable tiles
1887 if NewTile and fRR <> 0 then
1888 NewTile := NewTile and not fRoad;
1889 if not((NewTile and fTerrain) in TerrType_Canalable) then
1890 NewTile := NewTile and not fCanal;
1891 if Terrain[NewTile and fTerrain].IrrEff = 0 then
1892 begin
1893 NewTile := NewTile and not(fPrefStartPos or fStartPos);
1894 if (NewTile and fTerImp = tiIrrigation) or (NewTile and fTerImp = tiFarm)
1895 then
1896 NewTile := NewTile and not fTerImp
1897 end;
1898 if (Terrain[NewTile and fTerrain].MineEff = 0) and
1899 (NewTile and fTerImp = tiMine) then
1900 NewTile := NewTile and not fTerImp;
1901
1902 RealMap[Loc] := NewTile;
1903 if NewTile and fSpecial = fSpecial then
1904 // standard special resource distribution
1905 RealMap[Loc] := RealMap[Loc] and not fSpecial or
1906 ActualSpecialTile(Loc) shl 5;
1907
1908 // automatic shore tiles
1909 V21_to_Loc(Loc, Radius);
1910 for V21 := 1 to 26 do
1911 begin
1912 Loc1 := Radius[V21];
1913 if (Loc1 >= 0) and (Loc1 < MapSize) then
1914 begin
1915 if CheckShore(Loc1) then
1916 RealMap[Loc1] := RealMap[Loc1] and not fSpecial or
1917 ActualSpecialTile(Loc1) shl 5;
1918 RealMap[Loc1] := RealMap[Loc1] or ($F shl 27);
1919 RW[0].Map[Loc1] := RealMap[Loc1] and $07FFFFFF or fObserved;
1920 end
1921 end;
1922 // RealMap[Loc]:=RealMap[Loc] and not fSpecial;
1923 // RW[0].Map[Loc]:=RealMap[Loc] or fObserved;
1924end;
1925
1926{
1927 Map Revealing
1928 ____________________________________________________________________
1929}
1930function GetTileInfo(p, cix, Loc: integer; var Info: TTileInfo): integer;
1931// cix>=0 - known city index of player p -- only core internal!
1932// cix=-1 - search city, player unknown, only if permission for p
1933// cix=-2 - don't search city, don't calculate city benefits, just government of player p
1934var
1935 p0, Tile, special: integer;
1936begin
1937 with Info do
1938 begin
1939 p0 := p;
1940 if cix >= 0 then
1941 Tile := RealMap[Loc]
1942 else
1943 begin
1944 Tile := RW[p].Map[Loc];
1945 if Tile and fTerrain = fUNKNOWN then
1946 begin
1947 result := eNoPreq;
1948 exit;
1949 end;
1950 end;
1951
1952 if (cix = -1) and (UsedByCity[Loc] >= 0) then
1953 begin // search exploiting player and city
1954 SearchCity(UsedByCity[Loc], p, cix);
1955 if not((p = p0) or (ObserveLevel[UsedByCity[Loc]] shr (2 * p0) and
1956 3 = lObserveSuper)) then
1957 cix := -1
1958 end;
1959 if cix = -1 then
1960 begin
1961 result := eInvalid;
1962 exit;
1963 end; // no city found here
1964
1965 special := Tile and fSpecial and ResourceMask[p] shr 5;
1966 with Terrain[Tile and fTerrain] do
1967 begin
1968 Food := FoodRes[special];
1969 Prod := ProdRes[special];
1970 Trade := TradeRes[special];
1971 if (special > 0) and (Tile and fTerrain <> fGrass) and
1972 (RW[p].NatBuilt[imSpacePort] > 0) then
1973 begin // GeoSat effect
1974 Food := 2 * Food - FoodRes[0];
1975 Prod := 2 * Prod - ProdRes[0];
1976 Trade := 2 * Trade - TradeRes[0];
1977 end;
1978
1979 if (Tile and fTerImp = tiIrrigation) or (Tile and fTerImp = tiFarm) or
1980 (Tile and fCity <> 0) then
1981 inc(Food, IrrEff); { irrigation effect }
1982 if Tile and fTerImp = tiMine then
1983 inc(Prod, MineEff); { mining effect }
1984 if (Tile and fRiver <> 0) and (RW[p].Tech[adMapMaking] >= tsApplicable)
1985 then
1986 inc(Trade); { river effect }
1987 if (Tile and (fRoad or fRR) <> 0) and (MoveCost = 1) and
1988 (RW[p].Tech[adWheel] >= tsApplicable) then
1989 inc(Trade); { road effect }
1990 if (Tile and (fRR or fCity) <> 0) and
1991 (RW[p].Tech[adRailroad] >= tsApplicable) then
1992 inc(Prod, Prod shr 1); { railroad effect }
1993
1994 ExplCity := -1;
1995 if (cix >= 0) and (p = p0) then
1996 ExplCity := cix;
1997 if cix >= 0 then
1998 if Tile and fTerrain >= fGrass then
1999 begin
2000 if ((Tile and fTerImp = tiFarm) or (Tile and fCity <> 0)) and
2001 (RW[p].City[cix].Built[imSupermarket] > 0) then
2002 inc(Food, Food shr 1); { farmland effect }
2003 if (Tile and (fRoad or fRR) <> 0) and (MoveCost = 1) and
2004 (RW[p].City[cix].Built[imHighways] > 0) then
2005 inc(Trade, 1); { superhighway effect }
2006 end
2007 else
2008 begin
2009 if RW[p].City[cix].Built[imHarbor] > 0 then
2010 inc(Food); { harbour effect }
2011 if RW[p].City[cix].Built[imPlatform] > 0 then
2012 inc(Prod); { oil platform effect }
2013 if GWonder[woLighthouse].EffectiveOwner = p then
2014 inc(Prod);
2015 end;
2016 end;
2017
2018 { good government influence }
2019 if (RW[p].Government in [gRepublic, gDemocracy, gFuture]) and (Trade > 0)
2020 then
2021 inc(Trade);
2022 if (RW[p].Government = gCommunism) and (Prod > 1) then
2023 inc(Prod);
2024
2025 if RW[p].Government in [gAnarchy, gDespotism] then
2026 begin { bad government influence }
2027 if Food > 3 then
2028 Food := 3;
2029 if Prod > 2 then
2030 Prod := 2;
2031 if Trade > 2 then
2032 Trade := 2;
2033 end;
2034
2035 if Tile and (fTerrain or fPoll) > fPoll then
2036 begin { pollution - decrease ressources }
2037 dec(Food, Food shr 1);
2038 dec(Prod, Prod shr 1);
2039 dec(Trade, Trade shr 1);
2040 end;
2041
2042 if Tile and fCity <> 0 then
2043 Trade := 0
2044 else if (cix >= 0) and (RW[p].City[cix].Built[imCourt] + RW[p].City[cix]
2045 .Built[imPalace] = 0) then
2046 if RW[p].City[cix].Built[imTownHall] = 0 then
2047 Trade := 0
2048 else if Trade > 3 then
2049 Trade := 3;
2050 end;
2051 result := eOK;
2052end; { GetTileInfo }
2053
2054procedure Strongest(Loc: integer; var uix, Strength, Bonus, Cnt: integer);
2055{ find strongest defender at Loc }
2056var
2057 Defender, uix1, Det, Cost, TestStrength, TestBonus, TestDet, TestCost,
2058 Domain: integer;
2059 PUn: ^TUn;
2060 PModel: ^TModel;
2061begin
2062 Defender := Occupant[Loc];
2063 Cost := 0;
2064 Cnt := 0;
2065 Det := -1;
2066 for uix1 := 0 to RW[Defender].nUn - 1 do
2067 begin
2068 PUn := @RW[Defender].Un[uix1];
2069 PModel := @RW[Defender].Model[PUn.mix];
2070 if PModel.Kind = mkSpecial_Glider then
2071 Domain := dGround
2072 else
2073 Domain := PModel.Domain;
2074 if PUn.Loc = Loc then
2075 begin
2076 inc(Cnt);
2077 if PUn.Master < 0 then
2078 begin
2079 if Domain < dSea then
2080 begin
2081 TestBonus := Terrain[RealMap[Loc] and fTerrain].Defense;
2082 if RealMap[Loc] and fTerImp = tiFort then
2083 inc(TestBonus, 4);
2084 if PUn.Flags and unFortified <> 0 then
2085 inc(TestBonus, 2);
2086 if (PModel.Kind = mkSpecial_TownGuard) and
2087 (RealMap[Loc] and fCity <> 0) then
2088 inc(TestBonus, 4);
2089 end
2090 else
2091 TestBonus := 4;
2092 inc(TestBonus, PUn.exp div ExpCost);
2093 TestStrength := PModel.Defense * TestBonus * PUn.Health;
2094 if (Domain = dAir) and ((RealMap[Loc] and fCity <> 0) or
2095 (RealMap[Loc] and fTerImp = tiBase)) then
2096 TestStrength := 0;
2097 if (Domain = dSea) and (RealMap[Loc] and fTerrain >= fGrass) then
2098 TestStrength := TestStrength shr 1;
2099 TestDet := TestStrength;
2100 if PModel.Cap[mcStealth] > 0 then
2101 else if PModel.Cap[mcSub] > 0 then
2102 inc(TestDet, 1 shl 28)
2103 else if (Domain = dGround) and (PModel.Cap[mcFanatic] > 0) and
2104 not(RW[Defender].Government in [gRepublic, gDemocracy, gFuture]) then
2105 inc(TestDet, 4 shl 28) // fanatic ground units always defend
2106 else if PModel.Flags and mdZOC <> 0 then
2107 inc(TestDet, 3 shl 28)
2108 else
2109 inc(TestDet, 2 shl 28);
2110 TestCost := RW[Defender].Model[PUn.mix].Cost;
2111 if (TestDet > Det) or (TestDet = Det) and (TestCost < Cost) then
2112 begin
2113 uix := uix1;
2114 Strength := TestStrength;
2115 Bonus := TestBonus;
2116 Det := TestDet;
2117 Cost := TestCost;
2118 end;
2119 end;
2120 end;
2121 end;
2122end;
2123
2124function UnitSpeed(p, mix, Health: integer): integer;
2125begin
2126 with RW[p].Model[mix] do
2127 begin
2128 result := Speed;
2129 if Domain = dSea then
2130 begin
2131 if GWonder[woMagellan].EffectiveOwner = p then
2132 inc(result, 200);
2133 if Health < 100 then
2134 result := ((result - 250) * Health div 5000) * 50 + 250;
2135 end
2136 end
2137end;
2138
2139procedure GetUnitReport(p, uix: integer; var UnitReport: TUnitReport);
2140var
2141 TerrOwner: integer;
2142 PModel: ^TModel;
2143begin
2144 UnitReport.FoodSupport := 0;
2145 UnitReport.ProdSupport := 0;
2146 UnitReport.ReportFlags := 0;
2147 if RW[p].Government <> gAnarchy then
2148 with RW[p].Un[uix] do
2149 begin
2150 PModel := @RW[p].Model[mix];
2151 if (PModel.Kind = mkSettler)
2152 { and (GWonder[woFreeSettlers].EffectiveOwner<>p) } then
2153 UnitReport.FoodSupport := SettlerFood[RW[p].Government]
2154 else if Flags and unConscripts <> 0 then
2155 UnitReport.FoodSupport := 1;
2156
2157 if RW[p].Government <> gFundamentalism then
2158 begin
2159 if GTestFlags and tfImmImprove = 0 then
2160 begin
2161 if PModel.Flags and mdDoubleSupport <> 0 then
2162 UnitReport.ProdSupport := 2
2163 else
2164 UnitReport.ProdSupport := 1;
2165 if PModel.Kind = mkSpecial_TownGuard then
2166 UnitReport.ReportFlags := UnitReport.ReportFlags or
2167 urfAlwaysSupport;
2168 end;
2169 if PModel.Flags and mdCivil = 0 then
2170 begin
2171 TerrOwner := RealMap[Loc] shr 27;
2172 case RW[p].Government of
2173 gRepublic, gFuture:
2174 if (TerrOwner <> p) and (TerrOwner < nPl) and
2175 (RW[p].Treaty[TerrOwner] < trAlliance) then
2176 UnitReport.ReportFlags := UnitReport.ReportFlags or urfDeployed;
2177 gDemocracy:
2178 if (TerrOwner >= nPl) or (TerrOwner <> p) and
2179 (RW[p].Treaty[TerrOwner] < trAlliance) then
2180 UnitReport.ReportFlags := UnitReport.ReportFlags or urfDeployed;
2181 end;
2182 end;
2183 end;
2184 end;
2185end;
2186
2187procedure SearchCity(Loc: integer; var p, cix: integer);
2188// set p to supposed owner before call
2189var
2190 i: integer;
2191begin
2192 if RealMap[Loc] < nPl shl 27 then
2193 p := RealMap[Loc] shr 27;
2194 for i := 0 to nPl - 1 do
2195 begin
2196 if 1 shl p and GAlive <> 0 then
2197 with RW[p] do
2198 begin
2199 cix := nCity - 1;
2200 while (cix >= 0) and (City[cix].Loc <> Loc) do
2201 dec(cix);
2202 if cix >= 0 then
2203 exit;
2204 end;
2205 assert(i < nPl - 1);
2206 p := (p + 1) mod nPl;
2207 end;
2208end;
2209
2210procedure MakeCityInfo(p, cix: integer; var ci: TCityInfo);
2211begin
2212 assert((p >= 0) and (p < nPl));
2213 assert((cix >= 0) and (cix < RW[p].nCity));
2214 with RW[p].City[cix] do
2215 begin
2216 ci.Loc := Loc;
2217 ci.ID := ID;
2218 ci.Owner := p;
2219 ci.Size := Size;
2220 ci.Flags := 0;
2221 if Built[imPalace] > 0 then
2222 inc(ci.Flags, ciCapital);
2223 if (Built[imWalls] > 0) or (Continent[Loc] = GrWallContinent[p]) then
2224 inc(ci.Flags, ciWalled);
2225 if Built[imCoastalFort] > 0 then
2226 inc(ci.Flags, ciCoastalFort);
2227 if Built[imMissileBat] > 0 then
2228 inc(ci.Flags, ciMissileBat);
2229 if Built[imBunker] > 0 then
2230 inc(ci.Flags, ciBunker);
2231 if Built[imSpacePort] > 0 then
2232 inc(ci.Flags, ciSpacePort);
2233 end;
2234end;
2235
2236procedure TellAboutModel(p, taOwner, tamix: integer);
2237var
2238 i: integer;
2239begin
2240 if (p = taOwner) or (Mode < moPlaying) then
2241 exit;
2242 i := 0;
2243 while (i < RW[p].nEnemyModel) and ((RW[p].EnemyModel[i].Owner <> taOwner) or
2244 (RW[p].EnemyModel[i].mix <> tamix)) do
2245 inc(i);
2246 if i = RW[p].nEnemyModel then
2247 IntServer(sIntTellAboutModel + p shl 4, taOwner, tamix, nil^);
2248end;
2249
2250function emixSafe(p, taOwner, tamix: integer): integer;
2251begin
2252 result := RWemix[p, taOwner, tamix];
2253 if result < 0 then
2254 begin // sIntTellAboutModel comes too late
2255 assert(Mode = moMovie);
2256 result := $FFFF;
2257 end;
2258end;
2259
2260procedure IntroduceEnemy(p1, p2: integer);
2261begin
2262 RW[p1].Treaty[p2] := trNone;
2263 RW[p2].Treaty[p1] := trNone;
2264end;
2265
2266function DiscoverTile(Loc, p, pTell, Level: integer; EnableContact: boolean;
2267 euix: integer = -2): boolean;
2268// euix = -2: full discover
2269// euix = -1: unit and city only, append units in EnemyUn
2270// euix >= 0: unit and city only, replace EnemyUn[euix]
2271
2272 procedure SetContact(p1, p2: integer);
2273 begin
2274 if (Mode < moPlaying) or (p1 = p2) or (RW[p1].Treaty[p2] > trNoContact) then
2275 exit;
2276 IntServer(sIntTellAboutNation, p1, p2, nil^);
2277 // NewContact[p1,p2]:=true
2278 end;
2279
2280var
2281 i, uix, cix, TerrOwner, TerrOwnerTreaty, Strength, Bonus, Cnt, pFoundCity,
2282 cixFoundCity, MinLevel, Loc1, V8: integer;
2283 Tile, AddFlags: Cardinal;
2284 Adjacent: TVicinity8Loc;
2285 unx: ^TUn;
2286 mox: ^TModel;
2287begin
2288 result := false;
2289 with RW[pTell] do
2290 begin
2291 Tile := RealMap[Loc] and ResourceMask[pTell];
2292 if Mode = moLoading_Fast then
2293 AddFlags := 0 // don't discover units
2294 else
2295 begin
2296 AddFlags := Map[Loc] and fInEnemyZoC // always preserve this flag!
2297 or fObserved;
2298 if Level = lObserveSuper then
2299 AddFlags := AddFlags or fSpiedOut;
2300 if (GrWallContinent[pTell] >= 0) and
2301 (Continent[Loc] = GrWallContinent[pTell]) then
2302 AddFlags := AddFlags or fGrWall;
2303 if (Mode = moPlaying) and ((Tile and (nPl shl 27) <> nPl shl 27) and
2304 (pTell = p)) then
2305 begin // set fPeace flag?
2306 TerrOwner := Tile shr 27;
2307 if TerrOwner <> pTell then
2308 begin
2309 TerrOwnerTreaty := RW[pTell].Treaty[TerrOwner];
2310 if 1 shl TerrOwnerTreaty and
2311 (1 shl trPeace or 1 shl TrFriendlyContact) <> 0 then
2312 AddFlags := AddFlags or fPeace;
2313 end
2314 end;
2315
2316 if Occupant[Loc] >= 0 then
2317 if Occupant[Loc] = pTell then
2318 begin
2319 AddFlags := AddFlags or (fOwned or fUnit);
2320 if ZoCMap[Loc] > 0 then
2321 AddFlags := AddFlags or fOwnZoCUnit;
2322 // Level:=lObserveSuper // always see own units
2323 end
2324 else if Map[Loc] and fUnit <> 0 then
2325 AddFlags := AddFlags or fUnit
2326 else
2327 begin
2328 Strongest(Loc, uix, Strength, Bonus, Cnt);
2329 unx := @RW[Occupant[Loc]].Un[uix];
2330 mox := @RW[Occupant[Loc]].Model[unx.mix];
2331 assert((ZoCMap[Loc] <> 0) = (mox.Flags and mdZOC <> 0));
2332 if (mox.Cap[mcStealth] > 0) and (Tile and fCity = 0) and
2333 (Tile and fTerImp <> tiBase) then
2334 MinLevel := lObserveSuper
2335 else if (mox.Cap[mcSub] > 0) and (Tile and fTerrain < fGrass) then
2336 MinLevel := lObserveAll
2337 else
2338 MinLevel := lObserveUnhidden;
2339 if Level >= MinLevel then
2340 begin
2341 AddFlags := AddFlags or fUnit;
2342 if euix >= 0 then
2343 uix := euix
2344 else
2345 begin
2346 uix := nEnemyUn;
2347 inc(nEnemyUn);
2348 assert(nEnemyUn < neumax);
2349 end;
2350 MakeUnitInfo(Occupant[Loc], unx^, EnemyUn[uix]);
2351 if Cnt > 1 then
2352 EnemyUn[uix].Flags := EnemyUn[uix].Flags or unMulti;
2353 if (mox.Flags and mdZOC <> 0) and (pTell = p) and
2354 (Treaty[Occupant[Loc]] < trAlliance) then
2355 begin // set fInEnemyZoC flags of surrounding tiles
2356 V8_to_Loc(Loc, Adjacent);
2357 for V8 := 0 to 7 do
2358 begin
2359 Loc1 := Adjacent[V8];
2360 if (Loc1 >= 0) and (Loc1 < MapSize) then
2361 Map[Loc1] := Map[Loc1] or fInEnemyZoC
2362 end
2363 end;
2364 if EnableContact and (mox.Domain = dGround) then
2365 SetContact(pTell, Occupant[Loc]);
2366 if Mode >= moMovie then
2367 begin
2368 TellAboutModel(pTell, Occupant[Loc], unx.mix);
2369 EnemyUn[uix].emix := emixSafe(pTell, Occupant[Loc], unx.mix);
2370 end;
2371 // Level:=lObserveSuper; // don't discover unit twice
2372 if (pTell = p) and
2373 ((Tile and fCity = 0) or (1 shl pTell and GAI <> 0)) then
2374 result := true;
2375 end
2376 else
2377 AddFlags := AddFlags or Map[Loc] and (fStealthUnit or fHiddenUnit);
2378 end;
2379 end; // if Mode>moLoading_Fast
2380
2381 if Tile and fCity <> 0 then
2382 if ObserveLevel[Loc] shr (2 * pTell) and 3 > 0 then
2383 AddFlags := AddFlags or Map[Loc] and fOwned
2384 else
2385 begin
2386 pFoundCity := Tile shr 27;
2387 if pFoundCity = pTell then
2388 AddFlags := AddFlags or fOwned
2389 else
2390 begin
2391 if EnableContact then
2392 SetContact(pTell, pFoundCity);
2393 cixFoundCity := RW[pFoundCity].nCity - 1;
2394 while (cixFoundCity >= 0) and
2395 (RW[pFoundCity].City[cixFoundCity].Loc <> Loc) do
2396 dec(cixFoundCity);
2397 assert(cixFoundCity >= 0);
2398 i := 0;
2399 while (i < nEnemyCity) and (EnemyCity[i].Loc <> Loc) do
2400 inc(i);
2401 if i = nEnemyCity then
2402 begin
2403 inc(nEnemyCity);
2404 assert(nEnemyCity < necmax);
2405 EnemyCity[i].Status := 0;
2406 EnemyCity[i].SavedStatus := 0;
2407 if pTell = p then
2408 result := true;
2409 end;
2410 MakeCityInfo(pFoundCity, cixFoundCity, EnemyCity[i]);
2411 end;
2412 end
2413 else if Map[Loc] and fCity <> 0 then // remove enemycity
2414 for cix := 0 to nEnemyCity - 1 do
2415 if EnemyCity[cix].Loc = Loc then
2416 EnemyCity[cix].Loc := -1;
2417
2418 if Map[Loc] and fTerrain = fUNKNOWN then
2419 inc(Discovered[pTell]);
2420 if euix >= -1 then
2421 Map[Loc] := Map[Loc] and not(fUnit or fCity or fOwned or fOwnZoCUnit) or
2422 (Tile and $07FFFFFF or AddFlags) and
2423 (fUnit or fCity or fOwned or fOwnZoCUnit)
2424 else
2425 begin
2426 Map[Loc] := Tile and $07FFFFFF or AddFlags;
2427 if Tile and $78000000 = $78000000 then
2428 Territory[Loc] := -1
2429 else
2430 Territory[Loc] := Tile shr 27;
2431 MapObservedLast[Loc] := GTurn
2432 end;
2433 ObserveLevel[Loc] := ObserveLevel[Loc] and not(3 shl (2 * pTell)) or
2434 Cardinal(Level) shl (2 * pTell);
2435 end;
2436end; // DiscoverTile
2437
2438function Discover9(Loc, p, Level: integer;
2439 TellAllied, EnableContact: boolean): boolean;
2440var
2441 V9, Loc1, pTell, OldLevel: integer;
2442 Radius: TVicinity8Loc;
2443begin
2444 assert((Mode > moLoading_Fast) or (RW[p].nEnemyUn = 0));
2445 result := false;
2446 V8_to_Loc(Loc, Radius);
2447 for V9 := 0 to 8 do
2448 begin
2449 if V9 = 8 then
2450 Loc1 := Loc
2451 else
2452 Loc1 := Radius[V9];
2453 if (Loc1 >= 0) and (Loc1 < MapSize) then
2454 if TellAllied then
2455 begin
2456 for pTell := 0 to nPl - 1 do
2457 if (pTell = p) or (1 shl pTell and GAlive <> 0) and
2458 (RW[p].Treaty[pTell] = trAlliance) then
2459 begin
2460 OldLevel := ObserveLevel[Loc1] shr (2 * pTell) and 3;
2461 if Level > OldLevel then
2462 result := DiscoverTile(Loc1, p, pTell, Level, EnableContact)
2463 or result;
2464 end;
2465 end
2466 else
2467 begin
2468 OldLevel := ObserveLevel[Loc1] shr (2 * p) and 3;
2469 if Level > OldLevel then
2470 result := DiscoverTile(Loc1, p, p, Level, EnableContact) or result;
2471 end;
2472 end;
2473end;
2474
2475function Discover21(Loc, p, AdjacentLevel: integer;
2476 TellAllied, EnableContact: boolean): boolean;
2477var
2478 V21, Loc1, pTell, Level, OldLevel, AdjacentFlags: integer;
2479 Radius: TVicinity21Loc;
2480begin
2481 assert((Mode > moLoading_Fast) or (RW[p].nEnemyUn = 0));
2482 result := false;
2483 AdjacentFlags := $00267620 shr 1;
2484 V21_to_Loc(Loc, Radius);
2485 for V21 := 1 to 26 do
2486 begin
2487 Loc1 := Radius[V21];
2488 if (Loc1 >= 0) and (Loc1 < MapSize) then
2489 begin
2490 if AdjacentFlags and 1 <> 0 then
2491 Level := AdjacentLevel
2492 else
2493 Level := lObserveUnhidden;
2494 if TellAllied then
2495 begin
2496 for pTell := 0 to nPl - 1 do
2497 if (pTell = p) or (1 shl pTell and GAlive <> 0) and
2498 (RW[p].Treaty[pTell] = trAlliance) then
2499 begin
2500 OldLevel := ObserveLevel[Loc1] shr (2 * pTell) and 3;
2501 if Level > OldLevel then
2502 result := DiscoverTile(Loc1, p, pTell, Level, EnableContact)
2503 or result;
2504 end;
2505 end
2506 else
2507 begin
2508 OldLevel := ObserveLevel[Loc1] shr (2 * p) and 3;
2509 if Level > OldLevel then
2510 result := DiscoverTile(Loc1, p, p, Level, EnableContact) or result;
2511 end;
2512 end;
2513 AdjacentFlags := AdjacentFlags shr 1;
2514 end;
2515end;
2516
2517procedure DiscoverAll(p, Level: integer);
2518{ player p discovers complete playground (for supervisor) }
2519var
2520 Loc, OldLevel: integer;
2521begin
2522 assert((Mode > moLoading_Fast) or (RW[p].nEnemyUn = 0));
2523 for Loc := 0 to MapSize - 1 do
2524 begin
2525 OldLevel := ObserveLevel[Loc] shr (2 * p) and 3;
2526 if Level > OldLevel then
2527 DiscoverTile(Loc, p, p, Level, false);
2528 end;
2529end;
2530
2531procedure DiscoverViewAreas(p: integer);
2532var
2533 pTell, uix, cix, ecix, Loc, RealOwner: integer;
2534 PModel: ^TModel;
2535begin // discover unit and city view areas
2536 for pTell := 0 to nPl - 1 do
2537 if (pTell = p) or (RW[p].Treaty[pTell] = trAlliance) then
2538 begin
2539 for uix := 0 to RW[pTell].nUn - 1 do
2540 with RW[pTell].Un[uix] do
2541 if (Loc >= 0) and (Master < 0) and (RealMap[Loc] and fCity = 0) then
2542 begin
2543 PModel := @RW[pTell].Model[mix];
2544 if (PModel.Kind = mkDiplomat) or (PModel.Cap[mcSpy] > 0) then
2545 Discover21(Loc, p, lObserveSuper, false, true)
2546 else if (PModel.Cap[mcRadar] + PModel.Cap[mcCarrier] > 0) or
2547 (PModel.Domain = dAir) then
2548 Discover21(Loc, p, lObserveAll, false, false)
2549 else if (RealMap[Loc] and fTerrain = fMountains) or
2550 (RealMap[Loc] and fTerImp = tiFort) or
2551 (RealMap[Loc] and fTerImp = tiBase) or (PModel.Cap[mcAcademy] > 0)
2552 then
2553 Discover21(Loc, p, lObserveUnhidden, false,
2554 PModel.Domain = dGround)
2555 else
2556 Discover9(Loc, p, lObserveUnhidden, false,
2557 PModel.Domain = dGround);
2558 end;
2559 for cix := 0 to RW[pTell].nCity - 1 do
2560 if RW[pTell].City[cix].Loc >= 0 then
2561 Discover21(RW[pTell].City[cix].Loc, p, lObserveUnhidden, false, true);
2562 for ecix := 0 to RW[pTell].nEnemyCity - 1 do
2563 begin // players know territory, so no use in hiding city owner
2564 Loc := RW[pTell].EnemyCity[ecix].Loc;
2565 if Loc >= 0 then
2566 begin
2567 RealOwner := (RealMap[Loc] shr 27) and $F;
2568 if RealOwner < nPl then
2569 RW[pTell].EnemyCity[ecix].Owner := RealOwner
2570 else
2571 begin
2572 RW[pTell].EnemyCity[ecix].Loc := -1;
2573 RW[pTell].Map[Loc] := RW[pTell].Map[Loc] and not fCity
2574 end;
2575 end;
2576 end;
2577 end;
2578end;
2579
2580function GetUnitStack(p, Loc: integer): integer;
2581var
2582 uix: integer;
2583 unx: ^TUn;
2584begin
2585 result := 0;
2586 if Occupant[Loc] < 0 then
2587 exit;
2588 for uix := 0 to RW[Occupant[Loc]].nUn - 1 do
2589 begin
2590 unx := @RW[Occupant[Loc]].Un[uix];
2591 if unx.Loc = Loc then
2592 begin
2593 MakeUnitInfo(Occupant[Loc], unx^, RW[p].EnemyUn[RW[p].nEnemyUn + result]);
2594 TellAboutModel(p, Occupant[Loc], unx.mix);
2595 RW[p].EnemyUn[RW[p].nEnemyUn + result].emix :=
2596 RWemix[p, Occupant[Loc], unx.mix];
2597 inc(result);
2598 end;
2599 end;
2600end;
2601
2602procedure UpdateUnitMap(Loc: integer; CityChange: boolean = false);
2603// update maps and enemy units of all players after unit change
2604var
2605 p, euix, OldLevel: integer;
2606 AddFlags, ClearFlags: Cardinal;
2607begin
2608 if (Mode = moLoading_Fast) and not CityChange then
2609 exit;
2610 for p := 0 to nPl - 1 do
2611 if 1 shl p and (GAlive or GWatching) <> 0 then
2612 begin
2613 OldLevel := ObserveLevel[Loc] shr (2 * p) and 3;
2614 if OldLevel > lNoObserve then
2615 begin
2616 if RW[p].Map[Loc] and (fUnit or fOwned) = fUnit then
2617 begin
2618 // replace unit located here in EnemyUn
2619 // do not just set loc:=-1 because total number would be unlimited
2620 euix := RW[p].nEnemyUn - 1;
2621 while euix >= 0 do
2622 begin
2623 if RW[p].EnemyUn[euix].Loc = Loc then
2624 begin
2625 RW[p].EnemyUn[euix].Loc := -1;
2626 Break;
2627 end;
2628 dec(euix);
2629 end;
2630 RW[p].Map[Loc] := RW[p].Map[Loc] and not fUnit
2631 end
2632 else
2633 begin // look for empty slot in EnemyUn
2634 euix := RW[p].nEnemyUn - 1;
2635 while (euix >= 0) and (RW[p].EnemyUn[euix].Loc >= 0) do
2636 dec(euix);
2637 end;
2638 if (Occupant[Loc] < 0) and not CityChange then
2639 begin // calling DiscoverTile not necessary, only clear map flags
2640 ClearFlags := fUnit or fHiddenUnit or fStealthUnit or fOwnZoCUnit;
2641 if RealMap[Loc] and fCity = 0 then
2642 ClearFlags := ClearFlags or fOwned;
2643 RW[p].Map[Loc] := RW[p].Map[Loc] and not ClearFlags;
2644 end
2645 else if (Occupant[Loc] <> p) or CityChange then
2646 begin // city or enemy unit update necessary, call DiscoverTile
2647 ObserveLevel[Loc] := ObserveLevel[Loc] and not(3 shl (2 * p));
2648 DiscoverTile(Loc, p, p, OldLevel, false, euix);
2649 end
2650 else { if (Occupant[Loc]=p) and not CityChange then }
2651 begin // calling DiscoverTile not necessary, only set map flags
2652 ClearFlags := 0;
2653 AddFlags := fUnit or fOwned;
2654 if ZoCMap[Loc] > 0 then
2655 AddFlags := AddFlags or fOwnZoCUnit
2656 else
2657 ClearFlags := ClearFlags or fOwnZoCUnit;
2658 RW[p].Map[Loc] := RW[p].Map[Loc] and not ClearFlags or AddFlags;
2659 end;
2660 end;
2661 end;
2662end;
2663
2664procedure RecalcV8ZoC(p, Loc: integer);
2665// recalculate fInEnemyZoC flags around single tile
2666var
2667 V8, V8V8, Loc1, Loc2, p1, ObserveMask: integer;
2668 Tile1: ^Cardinal;
2669 Adjacent, AdjacentAdjacent: TVicinity8Loc;
2670begin
2671 if Mode = moLoading_Fast then
2672 exit;
2673 ObserveMask := 3 shl (2 * p);
2674 V8_to_Loc(Loc, Adjacent);
2675 for V8 := 0 to 7 do
2676 begin
2677 Loc1 := Adjacent[V8];
2678 if (Loc1 >= 0) and (Loc1 < MapSize) then
2679 begin
2680 Tile1 := @RW[p].Map[Loc1];
2681 Tile1^ := Tile1^ and not fInEnemyZoC;
2682 V8_to_Loc(Loc1, AdjacentAdjacent);
2683 for V8V8 := 0 to 7 do
2684 begin
2685 Loc2 := AdjacentAdjacent[V8V8];
2686 if (Loc2 >= 0) and (Loc2 < MapSize) and (ZoCMap[Loc2] > 0) and
2687 (ObserveLevel[Loc2] and ObserveMask <> 0) then
2688 begin
2689 p1 := Occupant[Loc2];
2690 assert(p1 <> nPl);
2691 if (p1 <> p) and (RW[p].Treaty[p1] < trAlliance) then
2692 begin
2693 Tile1^ := Tile1^ or fInEnemyZoC;
2694 Break
2695 end;
2696 end;
2697 end;
2698 end;
2699 end;
2700end;
2701
2702procedure RecalcMapZoC(p: integer);
2703// recalculate fInEnemyZoC flags for the whole map
2704var
2705 Loc, Loc1, V8, p1, ObserveMask: integer;
2706 Adjacent: TVicinity8Loc;
2707begin
2708 if Mode = moLoading_Fast then
2709 exit;
2710 MaskD(RW[p].Map^, MapSize, Cardinal(not Cardinal(fInEnemyZoC)));
2711 ObserveMask := 3 shl (2 * p);
2712 for Loc := 0 to MapSize - 1 do
2713 if (ZoCMap[Loc] > 0) and (ObserveLevel[Loc] and ObserveMask <> 0) then
2714 begin
2715 p1 := Occupant[Loc];
2716 assert(p1 <> nPl);
2717 if (p1 <> p) and (RW[p].Treaty[p1] < trAlliance) then
2718 begin // this non-allied enemy ZoC unit is known to this player -- set flags!
2719 V8_to_Loc(Loc, Adjacent);
2720 for V8 := 0 to 7 do
2721 begin
2722 Loc1 := Adjacent[V8];
2723 if (Loc1 >= 0) and (Loc1 < MapSize) then
2724 RW[p].Map[Loc1] := RW[p].Map[Loc1] or fInEnemyZoC
2725 end;
2726 end;
2727 end;
2728end;
2729
2730procedure RecalcPeaceMap(p: integer);
2731// recalculate fPeace flags for the whole map
2732var
2733 Loc, p1: integer;
2734 PeacePlayer: array [-1 .. nPl - 1] of boolean;
2735begin
2736 if Mode <> moPlaying then
2737 exit;
2738 MaskD(RW[p].Map^, MapSize, Cardinal(not Cardinal(fPeace)));
2739 for p1 := -1 to nPl - 1 do
2740 PeacePlayer[p1] := (p1 >= 0) and (p1 <> p) and (1 shl p1 and GAlive <> 0)
2741 and (RW[p].Treaty[p1] in [trPeace, TrFriendlyContact]);
2742 for Loc := 0 to MapSize - 1 do
2743 if PeacePlayer[RW[p].Territory[Loc]] then
2744 RW[p].Map[Loc] := RW[p].Map[Loc] or fPeace;
2745end;
2746
2747{
2748 Territory Calculation
2749 ____________________________________________________________________
2750}
2751var
2752 BorderChanges: array [0 .. sIntExpandTerritory and $F - 1] of Cardinal;
2753
2754procedure ChangeTerritory(Loc, p: integer);
2755var
2756 p1: integer;
2757begin
2758 Assert(p >= 0); // no player's territory indicated by p=nPl
2759 Dec(TerritoryCount[RealMap[Loc] shr 27]);
2760 Inc(TerritoryCount[p]);
2761 RealMap[Loc] := RealMap[Loc] and not($F shl 27) or Cardinal(p) shl 27;
2762 if p = $F then
2763 p := -1;
2764 for p1 := 0 to nPl - 1 do
2765 if 1 shl p1 and (GAlive or GWatching) <> 0 then
2766 if RW[p1].Map[Loc] and fTerrain <> fUNKNOWN then
2767 begin
2768 RW[p1].Territory[Loc] := p;
2769 if (p < nPl) and (p <> p1) and (1 shl p and GAlive <> 0) and
2770 (RW[p1].Treaty[p] in [trPeace, TrFriendlyContact]) then
2771 RW[p1].Map[Loc] := RW[p1].Map[Loc] or fPeace
2772 else
2773 RW[p1].Map[Loc] := RW[p1].Map[Loc] and not fPeace;
2774 end;
2775end;
2776
2777procedure ExpandTerritory(OriginLoc: integer);
2778var
2779 i, dx, dy, dxMax, dyMax, Loc, NewOwner: integer;
2780begin
2781 if OriginLoc = -1 then
2782 raise Exception.Create('Location error');
2783 i := 0;
2784 dyMax := 0;
2785 while (dyMax + 1) + (dyMax + 1) shr 1 <= CountryRadius do
2786 inc(dyMax);
2787 for dy := -dyMax to dyMax do
2788 begin
2789 dxMax := dy and 1;
2790 while abs(dy) + (dxMax + 2) + abs(abs(dy) - (dxMax + 2)) shr 1 <=
2791 CountryRadius do
2792 inc(dxMax, 2);
2793 for dx := -dxMax to dxMax do
2794 if (dy + dx) and 1 = 0 then
2795 begin
2796 NewOwner := BorderChanges[i div 8] shr (i mod 8 * 4) and $F;
2797 Loc := dLoc(OriginLoc, dx, dy);
2798 if (Loc >= 0) and (Cardinal(NewOwner) <> RealMap[Loc] shr 27) then
2799 ChangeTerritory(Loc, NewOwner);
2800 inc(i);
2801 end;
2802 end;
2803end;
2804
2805procedure CheckBorders(OriginLoc, PlayerLosingCity: integer);
2806// OriginLoc: only changes in CountryRadius around this location possible,
2807// -1 for complete map, -2 for double-check (no more changes allowed)
2808// PlayerLosingCity: do nothing but remove tiles no longer in reach from this
2809// player's territory, -1 for full border recalculation
2810var
2811 i, r, Loc, Loc1, dx, dy, p1, p2, cix, NewDist, dxMax, dyMax, OldOwner, V8: Integer;
2812 NewOwner: Cardinal;
2813 Adjacent: TVicinity8Loc;
2814 AtPeace: array [0 .. nPl, 0 .. nPl] of boolean;
2815 Country, FormerCountry, { to who's country a tile belongs }
2816 Dist, FormerDist, StolenDist: array [0 .. lxmax * lymax - 1] of ShortInt;
2817begin
2818 if PlayerLosingCity >= 0 then
2819 begin
2820 for Loc := 0 to MapSize - 1 do
2821 StolenDist[Loc] := CountryRadius + 1;
2822 for cix := 0 to RW[PlayerLosingCity].nCity - 1 do
2823 if RW[PlayerLosingCity].City[cix].Loc >= 0 then
2824 StolenDist[RW[PlayerLosingCity].City[cix].Loc] := 0;
2825
2826 for r := 1 to CountryRadius shr 1 do
2827 begin
2828 move(StolenDist, FormerDist, MapSize);
2829 for Loc := 0 to MapSize - 1 do
2830 if (FormerDist[Loc] <= CountryRadius - 2)
2831 // use same conditions as below!
2832 and ((1 shl (RealMap[Loc] and fTerrain)) and
2833 (1 shl fShore + 1 shl fMountains + 1 shl fArctic) = 0) then
2834 begin
2835 V8_to_Loc(Loc, Adjacent);
2836 for V8 := 0 to 7 do
2837 begin
2838 Loc1 := Adjacent[V8];
2839 NewDist := FormerDist[Loc] + 2 + V8 and 1;
2840 if (Loc1 >= 0) and (Loc1 < MapSize) and (NewDist < StolenDist[Loc1])
2841 then
2842 StolenDist[Loc1] := NewDist;
2843 end;
2844 end;
2845 end;
2846 end;
2847
2848 FillChar(Country, MapSize, Byte(-1));
2849 for Loc := 0 to MapSize - 1 do
2850 Dist[Loc] := CountryRadius + 1;
2851 for p1 := 0 to nPl - 1 do
2852 if 1 shl p1 and GAlive <> 0 then
2853 for cix := 0 to RW[p1].nCity - 1 do
2854 if RW[p1].City[cix].Loc >= 0 then
2855 begin
2856 Country[RW[p1].City[cix].Loc] := p1;
2857 Dist[RW[p1].City[cix].Loc] := 0;
2858 end;
2859
2860 for r := 1 to CountryRadius shr 1 do
2861 begin
2862 move(Country, FormerCountry, MapSize);
2863 move(Dist, FormerDist, MapSize);
2864 for Loc := 0 to MapSize - 1 do
2865 if (FormerDist[Loc] <= CountryRadius - 2) // use same conditions as above!
2866 and ((1 shl (RealMap[Loc] and fTerrain)) and
2867 (1 shl fShore + 1 shl fMountains + 1 shl fArctic) = 0) then
2868 begin
2869 assert(FormerCountry[Loc] >= 0);
2870 V8_to_Loc(Loc, Adjacent);
2871 for V8 := 0 to 7 do
2872 begin
2873 Loc1 := Adjacent[V8];
2874 NewDist := FormerDist[Loc] + 2 + V8 and 1;
2875 if (Loc1 >= 0) and (Loc1 < MapSize) and (NewDist < Dist[Loc1]) then
2876 begin
2877 Country[Loc1] := FormerCountry[Loc];
2878 Dist[Loc1] := NewDist;
2879 end;
2880 end;
2881 end;
2882 end;
2883
2884 FillChar(AtPeace, SizeOf(AtPeace), false);
2885 for p1 := 0 to nPl - 1 do
2886 if 1 shl p1 and GAlive <> 0 then
2887 for p2 := 0 to nPl - 1 do
2888 if (p2 <> p1) and (1 shl p2 and GAlive <> 0) and
2889 (RW[p1].Treaty[p2] >= trPeace) then
2890 AtPeace[p1, p2] := true;
2891
2892 if OriginLoc >= 0 then
2893 begin // update area only
2894 i := 0;
2895 FillChar(BorderChanges, SizeOf(BorderChanges), 0);
2896 dyMax := 0;
2897 while (dyMax + 1) + (dyMax + 1) shr 1 <= CountryRadius do
2898 inc(dyMax);
2899 for dy := -dyMax to dyMax do
2900 begin
2901 dxMax := dy and 1;
2902 while abs(dy) + (dxMax + 2) + abs(abs(dy) - (dxMax + 2)) shr 1 <=
2903 CountryRadius do
2904 inc(dxMax, 2);
2905 for dx := -dxMax to dxMax do
2906 if (dy + dx) and 1 = 0 then
2907 begin
2908 Loc := dLoc(OriginLoc, dx, dy);
2909 if Loc >= 0 then
2910 begin
2911 OldOwner := RealMap[Loc] shr 27;
2912 NewOwner := Country[Loc] and $F;
2913 if NewOwner <> OldOwner then
2914 if AtPeace[NewOwner, OldOwner] and
2915 not((OldOwner = PlayerLosingCity) and
2916 (StolenDist[Loc] > CountryRadius)) then
2917 NewOwner := OldOwner // peace fixes borders
2918 else
2919 ChangeTerritory(Loc, NewOwner);
2920 BorderChanges[i shr 3] := BorderChanges[i shr 3] or
2921 ((NewOwner shl ((i and 7) * 4)) and $ffffffff);
2922 end;
2923 inc(i);
2924 end;
2925 end;
2926 end
2927 else
2928 for Loc := 0 to MapSize - 1 do // update complete map
2929 begin
2930 OldOwner := RealMap[Loc] shr 27;
2931 NewOwner := Country[Loc] and $F;
2932 if (NewOwner <> OldOwner) and (not AtPeace[NewOwner, OldOwner] or
2933 ((OldOwner = PlayerLosingCity) and (StolenDist[Loc] > CountryRadius)))
2934 then
2935 begin
2936 assert(OriginLoc <> -2); // test if border saving works
2937 ChangeTerritory(Loc, NewOwner);
2938 end;
2939 end;
2940
2941{$IFOPT O-} if OriginLoc <> -2 then
2942 CheckBorders(-2); {$ENDIF} // check: single pass should do!
2943end; // CheckBorders
2944
2945procedure LogCheckBorders(p, cix, PlayerLosingCity: integer);
2946begin
2947 CheckBorders(RW[p].City[cix].Loc, PlayerLosingCity);
2948 IntServer(sIntExpandTerritory, p, cix, BorderChanges);
2949end;
2950
2951{
2952 Map Processing
2953 ____________________________________________________________________
2954}
2955
2956procedure CreateUnit(p, mix: integer);
2957begin
2958 with RW[p] do
2959 begin
2960 Un[nUn].mix := mix;
2961 with Un[nUn] do
2962 begin
2963 ID := UnBuilt[p];
2964 inc(UnBuilt[p]);
2965 Status := 0;
2966 SavedStatus := 0;
2967 inc(Model[mix].Built);
2968 Home := -1;
2969 Health := 100;
2970 Flags := 0;
2971 Movement := 0;
2972 if Model[mix].Domain = dAir then
2973 begin
2974 Fuel := Model[mix].Cap[mcFuel];
2975 Flags := Flags or unBombsLoaded
2976 end;
2977 Job := jNone;
2978 exp := ExpCost shr 1;
2979 TroopLoad := 0;
2980 AirLoad := 0;
2981 Master := -1;
2982 end;
2983 inc(nUn);
2984 end
2985end;
2986
2987procedure FreeUnit(p, uix: integer);
2988// loc or master should be set after call
2989// implementation is critical for loading performance, change carefully
2990var
2991 Loc0, uix1: integer;
2992 Occ, ZoC: boolean;
2993begin
2994 with RW[p].Un[uix] do
2995 begin
2996 Job := jNone;
2997 Flags := Flags and not(unFortified or unMountainDelay);
2998 Loc0 := Loc
2999 end;
3000 if Occupant[Loc0] >= 0 then
3001 begin
3002 assert(Occupant[Loc0] = p);
3003 Occ := false;
3004 ZoC := false;
3005 for uix1 := 0 to RW[p].nUn - 1 do
3006 with RW[p].Un[uix1] do
3007 if (Loc = Loc0) and (Master < 0) and (uix1 <> uix) then
3008 begin
3009 Occ := true;
3010 if RW[p].Model[mix].Flags and mdZOC <> 0 then
3011 begin
3012 ZoC := true;
3013 Break
3014 end
3015 end;
3016 if not Occ then
3017 Occupant[Loc0] := -1;
3018 if not ZoC then
3019 ZoCMap[Loc0] := 0;
3020 end;
3021end;
3022
3023procedure PlaceUnit(p, uix: integer);
3024begin
3025 with RW[p].Un[uix] do
3026 begin
3027 Occupant[Loc] := p;
3028 if RW[p].Model[mix].Flags and mdZOC <> 0 then
3029 ZoCMap[Loc] := 1;
3030 end;
3031end;
3032
3033procedure CountLost(p, mix, Enemy: integer);
3034begin
3035 Inc(RW[p].Model[mix].Lost);
3036 TellAboutModel(Enemy, p, mix);
3037 Inc(Destroyed[Enemy, p, mix]);
3038end;
3039
3040procedure RemoveUnit(p, uix: integer; Enemy: integer = -1);
3041// use enemy only from inside sMoveUnit if attack
3042var
3043 uix1: integer;
3044begin
3045 with RW[p].Un[uix] do
3046 begin
3047 assert((Loc >= 0) or (RW[p].Model[mix].Kind = mkDiplomat));
3048 // already freed when spy mission
3049 if Loc >= 0 then
3050 FreeUnit(p, uix);
3051 if Master >= 0 then
3052 if RW[p].Model[mix].Domain = dAir then
3053 dec(RW[p].Un[Master].AirLoad)
3054 else
3055 dec(RW[p].Un[Master].TroopLoad);
3056 if (TroopLoad > 0) or (AirLoad > 0) then
3057 for uix1 := 0 to RW[p].nUn - 1 do
3058 if (RW[p].Un[uix1].Loc >= 0) and (RW[p].Un[uix1].Master = uix) then
3059 { unit mastered by removed unit -- remove too }
3060 begin
3061 RW[p].Un[uix1].Loc := -1;
3062 if Enemy >= 0 then
3063 CountLost(p, RW[p].Un[uix1].mix, Enemy);
3064 end;
3065 Loc := -1;
3066 if Enemy >= 0 then
3067 CountLost(p, mix, Enemy);
3068 end;
3069end;
3070
3071procedure RemoveUnit_UpdateMap(p, uix: integer);
3072var
3073 Loc0: Integer;
3074begin
3075 Loc0 := RW[p].Un[uix].Loc;
3076 RemoveUnit(p, uix);
3077 if Mode > moLoading_Fast then
3078 UpdateUnitMap(Loc0);
3079end;
3080
3081procedure RemoveAllUnits(p, Loc: integer; Enemy: integer = -1);
3082var
3083 uix: integer;
3084begin
3085 for uix := 0 to RW[p].nUn - 1 do
3086 if RW[p].Un[uix].Loc = Loc then
3087 begin
3088 if Enemy >= 0 then
3089 CountLost(p, RW[p].Un[uix].mix, Enemy);
3090 RW[p].Un[uix].Loc := -1
3091 end;
3092 Occupant[Loc] := -1;
3093 ZoCMap[Loc] := 0;
3094end;
3095
3096procedure RemoveDomainUnits(d, p, Loc: integer);
3097var
3098 uix: integer;
3099begin
3100 for uix := 0 to RW[p].nUn - 1 do
3101 if (RW[p].Model[RW[p].Un[uix].mix].Domain = d) and (RW[p].Un[uix].Loc = Loc)
3102 then
3103 RemoveUnit(p, uix);
3104end;
3105
3106procedure FoundCity(p, FoundLoc: integer);
3107var
3108 p1, cix1, V21, dx, dy: integer;
3109begin
3110 if RW[p].nCity = ncmax then
3111 exit;
3112 inc(RW[p].nCity);
3113 with RW[p].City[RW[p].nCity - 1] do
3114 begin
3115 Size := 2;
3116 Status := 0;
3117 SavedStatus := 0;
3118 FillChar(Built, SizeOf(Built), 0);
3119 Food := 0;
3120 Project := cpImp + imTrGoods;
3121 Prod := 0;
3122 Project0 := Project;
3123 Prod0 := 0;
3124 Pollution := 0;
3125 N1 := 0;
3126 Loc := FoundLoc;
3127 if UsedByCity[FoundLoc] >= 0 then
3128 begin { central tile is exploited - toggle in exploiting city }
3129 p1 := p;
3130 SearchCity(UsedByCity[FoundLoc], p1, cix1);
3131 dxdy(UsedByCity[FoundLoc], FoundLoc, dx, dy);
3132 V21 := (dy + 3) shl 2 + (dx + 3) shr 1;
3133 RW[p1].City[cix1].Tiles := RW[p1].City[cix1].Tiles and not(1 shl V21);
3134 end;
3135 Tiles := 1 shl 13; { exploit central tile }
3136 UsedByCity[FoundLoc] := FoundLoc;
3137 RealMap[FoundLoc] := RealMap[FoundLoc] and
3138 (fTerrain or fSpecial or fRiver or nPl shl 27) or fCity;
3139
3140 ChangeTerritory(Loc, p)
3141 end;
3142end;
3143
3144procedure StealCity(p, cix: integer; SaveUnits: boolean);
3145var
3146 i, j, uix1, cix1, nearest: integer;
3147begin
3148 for i := 0 to 27 do
3149 if RW[p].City[cix].Built[i] = 1 then
3150 begin
3151 GWonder[i].EffectiveOwner := -1;
3152 if i = woPyramids then
3153 FreeSlaves;
3154 if i = woEiffel then // deactivate expired wonders
3155 for j := 0 to 27 do
3156 if GWonder[j].EffectiveOwner = p then
3157 CheckExpiration(j);
3158 end;
3159 for i := 28 to nImp - 1 do
3160 if (Imp[i].Kind <> ikCommon) and (RW[p].City[cix].Built[i] > 0) then
3161 begin { destroy national projects }
3162 RW[p].NatBuilt[i] := 0;
3163 if i = imGrWall then
3164 GrWallContinent[p] := -1;
3165 end;
3166
3167 for uix1 := 0 to RW[p].nUn - 1 do
3168 with RW[p].Un[uix1] do
3169 if (Loc >= 0) and (Home = cix) then
3170 if SaveUnits then
3171 begin // support units by nearest other city
3172 nearest := -1;
3173 for cix1 := 0 to RW[p].nCity - 1 do
3174 if (cix1 <> cix) and (RW[p].City[cix1].Loc >= 0) and
3175 ((nearest < 0) or (Distance(RW[p].City[cix1].Loc, Loc) <
3176 Distance(RW[p].City[nearest].Loc, Loc))) then
3177 nearest := cix1;
3178 Home := nearest
3179 end
3180 else
3181 RemoveUnit(p, uix1); // destroy supported units
3182end;
3183
3184procedure DestroyCity(p, cix: integer; SaveUnits: boolean);
3185var
3186 i, V21: integer;
3187 Radius: TVicinity21Loc;
3188begin
3189 StealCity(p, cix, SaveUnits);
3190 with RW[p].City[cix] do
3191 begin
3192 for i := 0 to 27 do
3193 if Built[i] > 0 then
3194 GWonder[i].CityID := -2; // wonder destroyed
3195 V21_to_Loc(Loc, Radius);
3196 for V21 := 1 to 26 do
3197 if 1 shl V21 and Tiles <> 0 then
3198 UsedByCity[Radius[V21]] := -1;
3199 RealMap[Loc] := RealMap[Loc] and not fCity;
3200 Loc := -1
3201 end;
3202end;
3203
3204procedure ChangeCityOwner(pOld, cixOld, pNew: integer);
3205var
3206 i, j, cix1, Loc1, V21: integer;
3207 Radius: TVicinity21Loc;
3208begin
3209 inc(RW[pNew].nCity);
3210 RW[pNew].City[RW[pNew].nCity - 1] := RW[pOld].City[cixOld];
3211 StealCity(pOld, cixOld, false);
3212 RW[pOld].City[cixOld].Loc := -1;
3213 with RW[pNew].City[(RW[pNew].nCity - 1)] do
3214 begin
3215 Food := 0;
3216 Project := cpImp + imTrGoods;
3217 Prod := 0;
3218 Project0 := Project;
3219 Prod0 := 0;
3220 Status := 0;
3221 SavedStatus := 0;
3222 N1 := 0;
3223
3224 // check for siege
3225 V21_to_Loc(Loc, Radius);
3226 for V21 := 1 to 26 do
3227 if Tiles and (1 shl V21) and not(1 shl CityOwnTile) <> 0 then
3228 begin
3229 Loc1 := Radius[V21];
3230 assert((Loc1 >= 0) and (Loc1 < MapSize) and (UsedByCity[Loc1] = Loc));
3231 if (ZoCMap[Loc1] > 0) and (Occupant[Loc1] <> pNew) and
3232 (RW[pNew].Treaty[Occupant[Loc1]] < trAlliance) then
3233 begin // tile can't remain exploited
3234 Tiles := Tiles and not(1 shl V21);
3235 UsedByCity[Loc1] := -1;
3236 end;
3237 // don't check for siege by peace territory here, because territory
3238 // might not be up to date -- done in turn beginning anyway
3239 end;
3240 Built[imTownHall] := 0;
3241 Built[imCourt] := 0;
3242 for i := 28 to nImp - 1 do
3243 if Imp[i].Kind <> ikCommon then
3244 Built[i] := 0; { destroy national projects }
3245 for i := 0 to 27 do
3246 if Built[i] = 1 then
3247 begin // new wonder owner!
3248 GWonder[i].EffectiveOwner := pNew;
3249 if i = woEiffel then // reactivate expired wonders
3250 begin
3251 for j := 0 to 27 do
3252 if Imp[j].Expiration >= 0 then
3253 for cix1 := 0 to (RW[pNew].nCity - 1) do
3254 if RW[pNew].City[cix1].Built[j] = 1 then
3255 GWonder[j].EffectiveOwner := pNew
3256 end
3257 else
3258 CheckExpiration(i);
3259 case i of
3260 woLighthouse:
3261 CheckSpecialModels(pNew, preLighthouse);
3262 woLeo:
3263 CheckSpecialModels(pNew, preLeo);
3264 woPyramids:
3265 CheckSpecialModels(pNew, preBuilder);
3266 end;
3267 end;
3268
3269 // remove city from enemy cities
3270 // not done by Discover, because fCity still set!
3271 cix1 := RW[pNew].nEnemyCity - 1;
3272 while (cix1 >= 0) and (RW[pNew].EnemyCity[cix1].Loc <> Loc) do
3273 dec(cix1);
3274 assert(cix1 >= 0);
3275 RW[pNew].EnemyCity[cix1].Loc := -1;
3276
3277 ChangeTerritory(Loc, pNew);
3278 end;
3279end;
3280
3281procedure CompleteJob(p, Loc, Job: integer);
3282var
3283 ChangedTerrain, p1: integer;
3284begin
3285 assert(Job <> jCity);
3286 ChangedTerrain := -1;
3287 case Job of
3288 jRoad:
3289 RealMap[Loc] := RealMap[Loc] or fRoad;
3290 jRR:
3291 RealMap[Loc] := RealMap[Loc] and not fRoad or fRR;
3292 jClear:
3293 begin
3294 ChangedTerrain := Terrain[RealMap[Loc] and fTerrain].ClearTerrain;
3295 RealMap[Loc] := RealMap[Loc] and not fTerrain or
3296 Cardinal(ChangedTerrain);
3297 RealMap[Loc] := RealMap[Loc] and not(3 shl 5) or
3298 ActualSpecialTile(Loc) shl 5;
3299 end;
3300 jIrr:
3301 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiIrrigation;
3302 jFarm:
3303 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiFarm;
3304 jAfforest:
3305 begin
3306 ChangedTerrain := Terrain[RealMap[Loc] and fTerrain].AfforestTerrain;
3307 RealMap[Loc] := RealMap[Loc] and not fTerrain or
3308 Cardinal(ChangedTerrain);
3309 RealMap[Loc] := RealMap[Loc] and not(3 shl 5) or
3310 ActualSpecialTile(Loc) shl 5;
3311 end;
3312 jMine:
3313 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiMine;
3314 jFort:
3315 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiFort;
3316 jCanal:
3317 RealMap[Loc] := RealMap[Loc] or fCanal;
3318 jTrans:
3319 begin
3320 ChangedTerrain := Terrain[RealMap[Loc] and fTerrain].TransTerrain;
3321 RealMap[Loc] := RealMap[Loc] and not fTerrain or
3322 Cardinal(ChangedTerrain);
3323 RealMap[Loc] := RealMap[Loc] and not(3 shl 5) or
3324 ActualSpecialTile(Loc) shl 5;
3325 if not(RealMap[Loc] and fTerrain in TerrType_Canalable) then
3326 begin
3327 RemoveDomainUnits(dSea, p, Loc);
3328 RealMap[Loc] := RealMap[Loc] and not fCanal;
3329 end;
3330 end;
3331 jPoll:
3332 RealMap[Loc] := RealMap[Loc] and not fPoll;
3333 jBase:
3334 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiBase;
3335 jPillage:
3336 if RealMap[Loc] and fTerImp <> 0 then
3337 begin
3338 if RealMap[Loc] and fTerImp = tiBase then
3339 RemoveDomainUnits(dAir, p, Loc);
3340 RealMap[Loc] := RealMap[Loc] and not fTerImp
3341 end
3342 else if RealMap[Loc] and fCanal <> 0 then
3343 begin
3344 RemoveDomainUnits(dSea, p, Loc);
3345 RealMap[Loc] := RealMap[Loc] and not fCanal
3346 end
3347 else if RealMap[Loc] and fRR <> 0 then
3348 RealMap[Loc] := RealMap[Loc] and not fRR or fRoad
3349 else if RealMap[Loc] and fRoad <> 0 then
3350 RealMap[Loc] := RealMap[Loc] and not fRoad;
3351 end;
3352 if ChangedTerrain >= 0 then
3353 begin // remove terrain improvements if not possible on new terrain
3354 if ((RealMap[Loc] and fTerImp = tiIrrigation) or
3355 (RealMap[Loc] and fTerImp = tiFarm)) and
3356 ((Terrain[ChangedTerrain].IrrClearWork = 0) or
3357 (Terrain[ChangedTerrain].ClearTerrain >= 0)) then
3358 RealMap[Loc] := RealMap[Loc] and not fTerImp;
3359 if (RealMap[Loc] and fTerImp = tiMine) and
3360 ((Terrain[ChangedTerrain].MineAfforestWork = 0) or
3361 (Terrain[ChangedTerrain].AfforestTerrain >= 0)) then
3362 RealMap[Loc] := RealMap[Loc] and not fTerImp;
3363 end;
3364
3365 // update map of all observing players
3366 if Mode > moLoading_Fast then
3367 for p1 := 0 to nPl - 1 do
3368 if (1 shl p1 and (GAlive or GWatching) <> 0) and
3369 (ObserveLevel[Loc] shr (2 * p1) and 3 > lNoObserve) then
3370 RW[p1].Map[Loc] := RW[p1].Map[Loc] and
3371 not(fTerrain or fSpecial or fTerImp or fRoad or fRR or fCanal or
3372 fPoll) or RealMap[Loc] and (fTerrain or fSpecial or fTerImp or
3373 fRoad or fRR or fCanal or fPoll);
3374end; // CompleteJob
3375
3376{
3377 Diplomacy
3378 ____________________________________________________________________
3379}
3380procedure GiveCivilReport(p, pAbout: integer);
3381begin
3382 with RW[p].EnemyReport[pAbout]^ do
3383 begin
3384 // general info
3385 TurnOfCivilReport := LastValidStat[pAbout];
3386 move(RW[pAbout].Treaty, Treaty, SizeOf(Treaty));
3387 Government := RW[pAbout].Government;
3388 Money := RW[pAbout].Money;
3389
3390 // tech info
3391 ResearchTech := RW[pAbout].ResearchTech;
3392 ResearchDone := RW[pAbout].Research * 100 div TechCost(pAbout);
3393 if ResearchDone > 100 then
3394 ResearchDone := 100;
3395 move(RW[pAbout].Tech, Tech, nAdv);
3396 end;
3397end;
3398
3399procedure GiveMilReport(p, pAbout: integer);
3400var
3401 uix, mix: integer;
3402begin
3403 with RW[p].EnemyReport[pAbout]^ do
3404 begin
3405 TurnOfMilReport := LastValidStat[pAbout];
3406 nModelCounted := RW[pAbout].nModel;
3407 for mix := 0 to RW[pAbout].nModel - 1 do
3408 begin
3409 TellAboutModel(p, pAbout, mix);
3410 UnCount[mix] := 0
3411 end;
3412 for uix := 0 to RW[pAbout].nUn - 1 do
3413 if RW[pAbout].Un[uix].Loc >= 0 then
3414 inc(UnCount[RW[pAbout].Un[uix].mix]);
3415 end;
3416end;
3417
3418procedure ShowPrice(pSender, pTarget, Price: integer);
3419begin
3420 case Price and opMask of
3421 opTech: // + advance
3422 with RW[pTarget].EnemyReport[pSender]^ do
3423 if Tech[Price - opTech] < tsApplicable then
3424 Tech[Price - opTech] := tsApplicable;
3425 opModel: // + model index
3426 TellAboutModel(pTarget, pSender, Price - opModel);
3427 { opCity: // + city ID
3428 begin
3429 end; }
3430 end;
3431end;
3432
3433function CopyCivilReport(pSender, pTarget, pAbout: integer): boolean;
3434var
3435 i: integer;
3436 rSender, rTarget: ^TEnemyReport;
3437begin // copy third nation civil report
3438 result := false;
3439 if RW[pTarget].Treaty[pAbout] = trNoContact then
3440 IntroduceEnemy(pTarget, pAbout);
3441 rSender := pointer(RW[pSender].EnemyReport[pAbout]);
3442 rTarget := pointer(RW[pTarget].EnemyReport[pAbout]);
3443 if rSender.TurnOfCivilReport > rTarget.TurnOfCivilReport then
3444 begin // only if newer than current information
3445 rTarget.TurnOfCivilReport := rSender.TurnOfCivilReport;
3446 rTarget.Treaty := rSender.Treaty;
3447 rTarget.Government := rSender.Government;
3448 rTarget.Money := rSender.Money;
3449 rTarget.ResearchTech := rSender.ResearchTech;
3450 rTarget.ResearchDone := rSender.ResearchDone;
3451 result := true;
3452 end;
3453 for i := 0 to nAdv - 1 do
3454 if rTarget.Tech[i] < rSender.Tech[i] then
3455 begin
3456 rTarget.Tech[i] := rSender.Tech[i];
3457 result := true;
3458 end;
3459end;
3460
3461function CopyMilReport(pSender, pTarget, pAbout: integer): boolean;
3462var
3463 mix: integer;
3464 rSender, rTarget: ^TEnemyReport;
3465begin // copy third nation military report
3466 result := false;
3467 if RW[pTarget].Treaty[pAbout] = trNoContact then
3468 IntroduceEnemy(pTarget, pAbout);
3469 rSender := pointer(RW[pSender].EnemyReport[pAbout]);
3470 rTarget := pointer(RW[pTarget].EnemyReport[pAbout]);
3471 if rSender.TurnOfMilReport > rTarget.TurnOfMilReport then
3472 begin // only if newer than current information
3473 rTarget.TurnOfMilReport := rSender.TurnOfMilReport;
3474 rTarget.nModelCounted := rSender.nModelCounted;
3475 move(rSender.UnCount, rTarget.UnCount, 2 * rSender.nModelCounted);
3476 for mix := 0 to rTarget.nModelCounted - 1 do
3477 TellAboutModel(pTarget, pAbout, mix);
3478 result := true;
3479 end;
3480end;
3481
3482procedure CopyModel(pSender, pTarget, mix: integer);
3483var
3484 i: integer;
3485 miSender, miTarget: TModelInfo;
3486 ok: boolean;
3487begin
3488 // only if target doesn't already have a model like this
3489 ok := RW[pTarget].nModel < nmmax;
3490 MakeModelInfo(pSender, mix, RW[pSender].Model[mix], miSender);
3491 for i := 0 to RW[pTarget].nModel - 1 do
3492 begin
3493 MakeModelInfo(pTarget, i, RW[pTarget].Model[i], miTarget);
3494 if IsSameModel(miSender, miTarget) then
3495 ok := false;
3496 end;
3497 if ok then
3498 begin
3499 RW[pTarget].Model[RW[pTarget].nModel] := RW[pSender].Model[mix];
3500 with RW[pTarget].Model[RW[pTarget].nModel] do
3501 begin
3502 IntroTurn := GTurn;
3503 if Kind = mkSelfDeveloped then
3504 Kind := mkEnemyDeveloped;
3505 Status := 0;
3506 SavedStatus := 0;
3507 Built := 0;
3508 Lost := 0;
3509 end;
3510 inc(RW[pTarget].nModel);
3511 inc(Researched[pTarget]);
3512 TellAboutModel(pSender, pTarget, RW[pTarget].nModel - 1);
3513 end;
3514end;
3515
3516procedure CopyMap(pSender, pTarget: integer);
3517var
3518 Loc, i, cix: integer;
3519 Tile: Cardinal;
3520begin
3521 for Loc := 0 to MapSize - 1 do
3522 if (RW[pSender].MapObservedLast[Loc] > RW[pTarget].MapObservedLast[Loc])
3523 then
3524 begin
3525 Tile := RW[pSender].Map[Loc];
3526 if Tile and fCity <> 0 then
3527 begin
3528 i := 0;
3529 while (i < RW[pTarget].nEnemyCity) and
3530 (RW[pTarget].EnemyCity[i].Loc <> Loc) do
3531 inc(i);
3532 if i = RW[pTarget].nEnemyCity then
3533 begin
3534 inc(RW[pTarget].nEnemyCity);
3535 assert(RW[pTarget].nEnemyCity < necmax);
3536 RW[pTarget].EnemyCity[i].Status := 0;
3537 RW[pTarget].EnemyCity[i].SavedStatus := 0;
3538 end;
3539 if Tile and fOwned <> 0 then
3540 begin // city owned by sender -- create new info
3541 cix := RW[pSender].nCity - 1;
3542 while (cix >= 0) and (RW[pSender].City[cix].Loc <> Loc) do
3543 dec(cix);
3544 MakeCityInfo(pSender, cix, RW[pTarget].EnemyCity[i]);
3545 end
3546 else // city not owned by sender -- copy old info
3547 begin
3548 cix := RW[pSender].nEnemyCity - 1;
3549 while (cix >= 0) and (RW[pSender].EnemyCity[cix].Loc <> Loc) do
3550 dec(cix);
3551 RW[pTarget].EnemyCity[i] := RW[pSender].EnemyCity[cix];
3552 end;
3553 end
3554 else if RW[pTarget].Map[Loc] and fCity <> 0 then // remove enemycity
3555 for cix := 0 to RW[pTarget].nEnemyCity - 1 do
3556 if RW[pTarget].EnemyCity[cix].Loc = Loc then
3557 RW[pTarget].EnemyCity[cix].Loc := -1;
3558
3559 Tile := Tile and (not(fSpecial or fModern) or ResourceMask[pTarget]);
3560 Tile := Tile or (RW[pTarget].Map[Loc] and fModern);
3561 if (Tile and fTerrain = RW[pTarget].Map[Loc] and fTerrain) then
3562 Tile := Tile or (RW[pTarget].Map[Loc] and fSpecial);
3563
3564 if RW[pTarget].Map[Loc] and fTerrain = fUNKNOWN then
3565 inc(Discovered[pTarget]);
3566 RW[pTarget].Map[Loc] := RW[pTarget].Map[Loc] and fInEnemyZoC
3567 // always preserve this flag!
3568 or Tile and not(fUnit or fHiddenUnit or fStealthUnit or fObserved or
3569 fSpiedOut or fOwned or fInEnemyZoC or fOwnZoCUnit or fPeace or fGrWall);
3570 if RW[pSender].Territory[Loc] <> RW[pTarget].Territory[Loc] then
3571 begin
3572 RW[pTarget].Territory[Loc] := RW[pSender].Territory[Loc];
3573 { if RW[pTarget].BorderHelper<>nil then
3574 RW[pTarget].BorderHelper[Loc]:=0; }
3575 end;
3576 RW[pTarget].Territory[Loc] := RW[pSender].Territory[Loc];
3577 RW[pTarget].MapObservedLast[Loc] := RW[pSender].MapObservedLast[Loc];
3578 end;
3579end;
3580
3581function PayPrice(pSender, pTarget, Price: integer; execute: boolean): boolean;
3582var
3583 pSubject, i, n, NewTreaty: integer;
3584begin
3585 result := true;
3586 case Price and opMask of
3587 opCivilReport: // + turn + concerned player shl 16
3588 begin
3589 pSubject := Price shr 16 and $F;
3590 if pTarget = pSubject then
3591 result := false
3592 else if pSender = pSubject then
3593 begin
3594 if execute then
3595 GiveCivilReport(pTarget, pSender)
3596 end
3597 else if RW[pSender].EnemyReport[pSubject].TurnOfCivilReport < 0 then
3598 result := false
3599 else if execute then
3600 CopyCivilReport(pSender, pTarget, pSubject);
3601 end;
3602 opMilReport: // + turn + concerned player shl 16
3603 begin
3604 pSubject := Price shr 16 and $F;
3605 if pTarget = pSubject then
3606 result := false
3607 else if pSender = pSubject then
3608 begin
3609 if execute then
3610 GiveMilReport(pTarget, pSender)
3611 end
3612 else if RW[pSender].EnemyReport[pSubject].TurnOfMilReport < 0 then
3613 result := false
3614 else if execute then
3615 CopyMilReport(pSender, pTarget, pSubject)
3616 end;
3617 opMap:
3618 if execute then
3619 begin
3620 CopyMap(pSender, pTarget);
3621 RecalcPeaceMap(pTarget);
3622 end;
3623 opTreaty .. opTreaty + trAlliance: // + nation treaty
3624 begin
3625 if Price - opTreaty = RW[pSender].Treaty[pTarget] - 1 then
3626 begin // agreed treaty end
3627 if execute then
3628 CancelTreaty(pSender, pTarget, false)
3629 end
3630 else
3631 begin
3632 NewTreaty := -1;
3633 if Price - opTreaty = RW[pSender].Treaty[pTarget] + 1 then
3634 NewTreaty := Price - opTreaty
3635 else if (RW[pSender].Treaty[pTarget] = trNone) and
3636 (Price - opTreaty = trPeace) then
3637 NewTreaty := trPeace;
3638 if NewTreaty < 0 then
3639 result := false
3640 else if execute then
3641 begin
3642 assert(NewTreaty > RW[pSender].Treaty[pTarget]);
3643 RW[pSender].Treaty[pTarget] := NewTreaty;
3644 RW[pTarget].Treaty[pSender] := NewTreaty;
3645 if NewTreaty >= TrFriendlyContact then
3646 begin
3647 GiveCivilReport(pTarget, pSender);
3648 GiveCivilReport(pSender, pTarget);
3649 end;
3650 if NewTreaty = trAlliance then
3651 begin
3652 GiveMilReport(pTarget, pSender);
3653 GiveMilReport(pSender, pTarget);
3654 CopyMap(pSender, pTarget);
3655 CopyMap(pTarget, pSender);
3656 RecalcMapZoC(pSender);
3657 RecalcMapZoC(pTarget);
3658 end;
3659 if not(NewTreaty in [trPeace, TrFriendlyContact]) then
3660 begin
3661 RW[pSender].EvaStart[pTarget] := -PeaceEvaTurns - 1;
3662 RW[pTarget].EvaStart[pSender] := -PeaceEvaTurns - 1;
3663 end;
3664 RecalcPeaceMap(pSender);
3665 RecalcPeaceMap(pTarget);
3666 end;
3667 end;
3668 end;
3669 opShipParts: // + number + part type shl 16
3670 begin
3671 n := Price and $FFFF; // number
3672 i := Price shr 16 and $F; // type
3673 if (i < nShipPart) and (GShip[pSender].Parts[i] >= n) then
3674 begin
3675 if execute then
3676 begin
3677 dec(GShip[pSender].Parts[i], n);
3678 RW[pSender].Ship[pSender].Parts[i] := GShip[pSender].Parts[i];
3679 RW[pTarget].Ship[pSender].Parts[i] := GShip[pSender].Parts[i];
3680 if RW[pTarget].NatBuilt[imSpacePort] > 0 then
3681 begin // space ship control requires space port
3682 inc(GShip[pTarget].Parts[i], n);
3683 RW[pSender].Ship[pTarget].Parts[i] := GShip[pTarget].Parts[i];
3684 RW[pTarget].Ship[pTarget].Parts[i] := GShip[pTarget].Parts[i];
3685 end;
3686 end;
3687 end
3688 else
3689 result := false;
3690 end;
3691 opMoney: // + value
3692 if (Price - opMoney <= MaxMoneyPrice) and
3693 (RW[pSender].Money >= Price - opMoney) then
3694 begin
3695 if execute then
3696 begin
3697 dec(RW[pSender].Money, Price - opMoney);
3698 inc(RW[pTarget].Money, Price - opMoney);
3699 end;
3700 end
3701 else
3702 result := false;
3703 opTribute: // + value
3704 if execute then
3705 begin
3706 end;
3707 opTech: // + advance
3708 if RW[pSender].Tech[Price - opTech] >= tsApplicable then
3709 begin
3710 if execute and (RW[pTarget].Tech[Price - opTech] = tsNA) then
3711 begin
3712 SeeTech(pTarget, Price - opTech);
3713 RW[pSender].EnemyReport[pTarget].Tech[Price - opTech] := tsSeen;
3714 end;
3715 end
3716 else
3717 result := false;
3718 opAllTech:
3719 if execute then
3720 for i := 0 to nAdv - 1 do
3721 if (RW[pSender].Tech[i] >= tsApplicable) and
3722 (RW[pTarget].Tech[i] = tsNA) then
3723 begin
3724 SeeTech(pTarget, i);
3725 RW[pSender].EnemyReport[pTarget].Tech[i] := tsSeen;
3726 RW[pTarget].EnemyReport[pSender].Tech[i] := tsApplicable;
3727 end;
3728 opModel: // + model index
3729 if Price - opModel < RW[pSender].nModel then
3730 begin
3731 if execute then
3732 CopyModel(pSender, pTarget, Price - opModel)
3733 end
3734 else
3735 result := false;
3736 opAllModel:
3737 if execute then
3738 for i := 0 to RW[pSender].nModel - 1 do
3739 begin
3740 TellAboutModel(pTarget, pSender, i);
3741 CopyModel(pSender, pTarget, i);
3742 end;
3743 { opCity: // + city ID
3744 begin
3745 result:=false
3746 end; }
3747 end
3748end;
3749
3750procedure CancelTreaty(p, pWith: integer; DecreaseCredibility: boolean);
3751// side effect: PeaceEnded := bitarray of players with which peace treaty was canceled
3752var
3753 p1, OldTreaty: integer;
3754begin
3755 OldTreaty := RW[p].Treaty[pWith];
3756 PeaceEnded := 0;
3757 if OldTreaty >= trPeace then
3758 RW[p].LastCancelTreaty[pWith] := GTurn;
3759 if DecreaseCredibility then
3760 begin
3761 case OldTreaty of
3762 trPeace:
3763 begin
3764 RW[p].Credibility := RW[p].Credibility shr 1;
3765 if RW[p].MaxCredibility > 0 then
3766 dec(RW[p].MaxCredibility, 10);
3767 if RW[p].Credibility > RW[p].MaxCredibility then
3768 RW[p].Credibility := RW[p].MaxCredibility;
3769 end;
3770 trAlliance:
3771 RW[p].Credibility := RW[p].Credibility * 3 div 4;
3772 end;
3773 RW[pWith].EnemyReport[p].Credibility := RW[p].Credibility;
3774 end;
3775
3776 if OldTreaty = trPeace then
3777 begin
3778 for p1 := 0 to nPl - 1 do
3779 if (p1 = pWith) or DecreaseCredibility and (p1 <> p) and
3780 (RW[pWith].Treaty[p1] = trAlliance) and (RW[p].Treaty[p1] >= trPeace)
3781 then
3782 begin
3783 RW[p].Treaty[p1] := trNone;
3784 RW[p1].Treaty[p] := trNone;
3785 RW[p].EvaStart[p1] := -PeaceEvaTurns - 1;
3786 RW[p1].EvaStart[p] := -PeaceEvaTurns - 1;
3787 inc(PeaceEnded, 1 shl p1);
3788 end;
3789 CheckBorders(-1);
3790 if (Mode > moLoading_Fast) and (PeaceEnded > 0) then
3791 RecalcMapZoC(p);
3792 end
3793 else
3794 begin
3795 RW[p].Treaty[pWith] := OldTreaty - 1;
3796 RW[pWith].Treaty[p] := OldTreaty - 1;
3797 if OldTreaty = TrFriendlyContact then
3798 begin // necessary for loading
3799 GiveCivilReport(p, pWith);
3800 GiveCivilReport(pWith, p);
3801 end
3802 else if OldTreaty = trAlliance then
3803 begin // necessary for loading
3804 GiveMilReport(p, pWith);
3805 GiveMilReport(pWith, p);
3806 end;
3807 if (Mode > moLoading_Fast) and (OldTreaty = trAlliance) then
3808 begin
3809 RecalcMapZoC(p);
3810 RecalcMapZoC(pWith);
3811 end;
3812 end;
3813 if OldTreaty in [trPeace, trAlliance] then
3814 begin
3815 RecalcPeaceMap(p);
3816 RecalcPeaceMap(pWith);
3817 end;
3818end;
3819
3820function DoSpyMission(p, pCity, cix, Mission: integer): Cardinal;
3821var
3822 p1: integer;
3823begin
3824 result := 0;
3825 case Mission of
3826 smSabotageProd:
3827 RW[pCity].City[cix].Flags := RW[pCity].City[cix].Flags or
3828 chProductionSabotaged;
3829 smStealMap:
3830 begin
3831 CopyMap(pCity, p);
3832 RecalcPeaceMap(p);
3833 end;
3834 smStealCivilReport:
3835 begin
3836 if RW[p].Treaty[pCity] = trNoContact then
3837 IntroduceEnemy(p, pCity);
3838 GiveCivilReport(p, pCity);
3839 end;
3840 smStealMilReport:
3841 begin
3842 if RW[p].Treaty[pCity] = trNoContact then
3843 IntroduceEnemy(p, pCity);
3844 GiveMilReport(p, pCity);
3845 end;
3846 smStealForeignReports:
3847 begin
3848 for p1 := 0 to nPl - 1 do
3849 if (p1 <> p) and (p1 <> pCity) and (RW[pCity].EnemyReport[p1] <> nil)
3850 then
3851 begin
3852 if RW[pCity].EnemyReport[p1].TurnOfCivilReport >= 0 then
3853 if CopyCivilReport(pCity, p, p1) then
3854 result := result or (1 shl (2 * p1));
3855 if RW[pCity].EnemyReport[p1].TurnOfMilReport >= 0 then
3856 if CopyMilReport(pCity, p, p1) then
3857 result := result or (2 shl (2 * p1));
3858 end;
3859 end;
3860 end;
3861end;
3862
3863{
3864 Test Flags
3865 ____________________________________________________________________
3866}
3867procedure ClearTestFlags(ClearFlags: integer);
3868var
3869 p1: integer;
3870begin
3871 GTestFlags := GTestFlags and (not ClearFlags or tfTested or tfAllTechs or
3872 tfAllContact);
3873 for p1 := 0 to nPl - 1 do
3874 if 1 shl p1 and (GAlive or GWatching) <> 0 then
3875 RW[p1].TestFlags := GTestFlags;
3876end;
3877
3878procedure SetTestFlags(p, SetFlags: integer);
3879var
3880 i, p1, p2, MoreFlags: integer;
3881begin
3882 MoreFlags := SetFlags and not GTestFlags;
3883 GTestFlags := GTestFlags or (SetFlags and $7FF);
3884 for p1 := 0 to nPl - 1 do
3885 if 1 shl p1 and (GAlive or GWatching) <> 0 then
3886 RW[p1].TestFlags := GTestFlags;
3887
3888 if MoreFlags and (tfUncover or tfAllContact) <> 0 then
3889 for p1 := 0 to nPl - 2 do
3890 if 1 shl p1 and GAlive <> 0 then
3891 for p2 := p1 + 1 to nPl - 1 do
3892 if 1 shl p2 and GAlive <> 0 then
3893 begin // make p1 and p2 know each other
3894 if RW[p1].Treaty[p2] = trNoContact then
3895 IntroduceEnemy(p1, p2)
3896 end;
3897
3898 if MoreFlags and tfAllTechs <> 0 then
3899 for p1 := 0 to nPl - 1 do
3900 begin
3901 ResourceMask[p1] := $FFFFFFFF;
3902 if 1 shl p1 and GAlive <> 0 then
3903 begin
3904 for i := 0 to nAdv - 1 do // give all techs to player p1
3905 if not(i in FutureTech) and (RW[p1].Tech[i] < tsApplicable) then
3906 begin
3907 RW[p1].Tech[i] := tsCheat;
3908 CheckSpecialModels(p1, i);
3909 end;
3910 for p2 := 0 to nPl - 1 do
3911 if (p2 <> p1) and (1 shl p2 and (GAlive or GWatching) <> 0) then
3912 for i := 1 to 3 do
3913 if RW[p2].EnemyReport[p1].Tech[AgePreq[i]] < tsApplicable then
3914 RW[p2].EnemyReport[p1].Tech[AgePreq[i]] := tsCheat;
3915 end;
3916 end;
3917
3918 if MoreFlags and tfUncover <> 0 then
3919 begin
3920 DiscoverAll(p, lObserveSuper);
3921 for p1 := 0 to nPl - 1 do
3922 if 1 shl p1 and GAlive <> 0 then
3923 begin
3924 ResourceMask[p1] := $FFFFFFFF;
3925 if p1 <> p then
3926 begin
3927 GiveCivilReport(p, p1);
3928 GiveMilReport(p, p1);
3929 end;
3930 end;
3931 end;
3932end;
3933
3934{
3935 Internal Command Processing
3936 ____________________________________________________________________
3937}
3938procedure IntServer(Command, Player, Subject: integer; var Data);
3939var
3940 i, p1: integer;
3941
3942begin
3943 if Mode = moPlaying then
3944 CL.Put(Command, Player, Subject, @Data);
3945
3946 case Command of
3947
3948 sIntTellAboutNation:
3949 begin
3950{$IFDEF TEXTLOG}CmdInfo := Format('IntTellAboutNation P%d+P%d', [Player, Subject]); {$ENDIF}
3951 assert((Player >= 0) and (Player < nPl) and (Subject >= 0) and
3952 (Subject < nPl));
3953 IntroduceEnemy(Player, Subject);
3954 end;
3955
3956 sIntHaveContact:
3957 begin
3958{$IFDEF TEXTLOG}CmdInfo := Format('IntHaveContact P%d+P%d', [Player, Subject]); {$ENDIF}
3959 assert(RW[Player].Treaty[Subject] > trNoContact);
3960 RW[Player].EnemyReport[Subject].TurnOfContact := GTurn;
3961 RW[Subject].EnemyReport[Player].TurnOfContact := GTurn;
3962 end;
3963
3964 sIntCancelTreaty:
3965 begin
3966{$IFDEF TEXTLOG}CmdInfo := Format('IntCancelTreaty P%d with P%d', [Player, Subject]); {$ENDIF}
3967 CancelTreaty(Player, Subject);
3968 end;
3969
3970 (* sIntChoosePeace:
3971 begin
3972 {$IFDEF TEXTLOG}CmdInfo:=Format('IntChoosePeace P%d+P%d', [Player,Subject]);{$ENDIF}
3973 RW[Player].Treaty[Subject]:=trPeace;
3974 RW[Subject].Treaty[Player]:=trPeace;
3975 end; *)
3976
3977 sIntTellAboutModel .. sIntTellAboutModel + (nPl - 1) shl 4:
3978 begin
3979 p1 := (Command - sIntTellAboutModel) shr 4; // told player
3980{$IFDEF TEXTLOG}CmdInfo := Format('IntTellAboutModel P%d about P%d Mod%d', [p1, Player, Subject]); {$ENDIF}
3981 assert((Player >= 0) and (Player < nPl));
3982 assert((Subject >= 0) and (Subject < RW[Player].nModel));
3983 MakeModelInfo(Player, Subject, RW[Player].Model[Subject],
3984 RW[p1].EnemyModel[RW[p1].nEnemyModel]);
3985 RWemix[p1, Player, Subject] := RW[p1].nEnemyModel;
3986 inc(RW[p1].nEnemyModel);
3987 assert(RW[p1].nEnemyModel < nemmax);
3988 end;
3989
3990 sIntDiscoverZOC:
3991 begin
3992{$IFDEF TEXTLOG}CmdInfo := Format('IntDiscoverZOC P%d Loc%d', [Player, integer(Data)]); {$ENDIF}
3993 Discover9(integer(Data), Player, lObserveUnhidden, true, false);
3994 end;
3995
3996 sIntExpandTerritory:
3997 if Mode < moPlaying then
3998 begin
3999{$IFDEF TEXTLOG}CmdInfo := Format('IntExpandTerritory P%d Loc%d', [Player, RW[Player].City[Subject].Loc]); {$ENDIF}
4000 move(Data, BorderChanges, SizeOf(BorderChanges));
4001 ExpandTerritory(RW[Player].City[Subject].Loc);
4002 end;
4003
4004 sIntBuyMaterial:
4005 with RW[Player].City[Subject] do
4006 begin
4007{$IFDEF TEXTLOG}CmdInfo := Format('IntBuyMaterial P%d Loc%d Cost%d', [Player, Loc, integer(Data)]); {$ENDIF}
4008 dec(RW[Player].Money, integer(Data));
4009 if (GWonder[woMich].EffectiveOwner = Player) and (Project and cpImp <> 0)
4010 then
4011 inc(Prod, integer(Data) div 2)
4012 else
4013 inc(Prod, integer(Data) div 4);
4014 if Project0 and not cpAuto <> Project and not cpAuto then
4015 Project0 := Project;
4016 Prod0 := Prod;
4017 end;
4018
4019 sIntPayPrices .. sIntPayPrices + 12:
4020 begin
4021{$IFDEF TEXTLOG}CmdInfo := Format('IntPayPrices P%d+P%d', [Player, Subject]); {$ENDIF}
4022 for i := 0 to TOffer(Data).nDeliver - 1 do
4023 PayPrice(Player, Subject, TOffer(Data).Price[i], true);
4024 for i := 0 to TOffer(Data).nCost - 1 do
4025 PayPrice(Subject, Player, TOffer(Data).Price[TOffer(Data).nDeliver
4026 + i], true);
4027 for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost - 1 do
4028 if TOffer(Data).Price[i] = opTreaty + trAlliance then
4029 begin // add view area of allied player
4030 DiscoverViewAreas(Player);
4031 DiscoverViewAreas(Subject);
4032 Break
4033 end
4034 end;
4035
4036 sIntSetDevModel:
4037 if Mode < moPlaying then
4038 move(Data, RW[Player].DevModel.Kind, sIntSetDevModel and $F * 4);
4039
4040 sIntSetModelStatus:
4041 if ProcessClientData[Player] then
4042 begin
4043{$IFDEF TEXTLOG}CmdInfo := Format('IntSetModelStatus P%d', [Player]);
4044 {$ENDIF}
4045 RW[Player].Model[Subject].Status := integer(Data);
4046 end;
4047
4048 sIntSetUnitStatus:
4049 if ProcessClientData[Player] then
4050 begin
4051{$IFDEF TEXTLOG}CmdInfo := Format('IntSetUnitStatus P%d', [Player]);
4052 {$ENDIF}
4053 RW[Player].Un[Subject].Status := integer(Data);
4054 end;
4055
4056 sIntSetCityStatus:
4057 if ProcessClientData[Player] then
4058 begin
4059{$IFDEF TEXTLOG}CmdInfo := Format('IntSetCityStatus P%d', [Player]);
4060 {$ENDIF}
4061 RW[Player].City[Subject].Status := integer(Data);
4062 end;
4063
4064 sIntSetECityStatus:
4065 if ProcessClientData[Player] then
4066 begin
4067{$IFDEF TEXTLOG}CmdInfo := Format('IntSetECityStatus P%d', [Player]);
4068 {$ENDIF}
4069 RW[Player].EnemyCity[Subject].Status := integer(Data);
4070 end;
4071
4072 end; { case command }
4073end; { IntServer }
4074
4075end.
Note: See TracBrowser for help on using the repository browser.