source: branches/AlphaChannel/Database.pas

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