source: tags/1.3.1/Database.pas

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