source: tags/1.3.6/Database.pas

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