source: tags/1.2.0/GameServer.pas

Last change on this file was 235, checked in by chronos, 4 years ago
  • Fixed: Build under Lazarus 1.8.x.
File size: 154.6 KB
Line 
1{$INCLUDE Switches.inc}
2// {$DEFINE TEXTLOG}
3// {$DEFINE LOADPERF}
4unit GameServer;
5
6interface
7
8uses
9 Protocol, Database, dynlibs, Platform, dateutils, fgl, LazFileUtils, Graphics;
10
11const
12 Version = $010200;
13 FirstAICompatibleVersion = $000D00;
14 FirstBookCompatibleVersion = $010103;
15
16 // notifications
17 ntCreateWorld = 0;
18 ntInitModule = $100;
19 ntInitLocalHuman = $1FF;
20 ntDLLError = $200;
21 ntAIError = $2FF;
22 ntClientError = $300;
23 ntInitPlayers = $400;
24 ntDeactivationMissing = $410;
25 ntSetAIName = $420;
26 ntException = $500;
27 ntLoadBegin = $600;
28 ntLoadState = $601;
29 ntEndInfo = $6FC;
30 ntBackOn = $6FD;
31 ntBackOff = $6FE;
32 ntLoadError = $6FF;
33 ntStartDone = $700;
34 ntStartGo = $701;
35 ntStartGoRefresh = $702;
36 ntStartGoRefreshMaps = $703;
37 ntChangeClient = $800;
38 ntNextPlayer = $810;
39 ntDeinitModule = $900;
40
41 // module flags
42 fMultiple = $10000000;
43 fDotNet = $20000000;
44 fUsed = $40000000;
45
46 // save map tile flags
47 smOwned = $20;
48 smUnit = $40;
49 smCity = $80;
50
51 maxBrain = 255;
52
53type
54 TNotifyFunction = procedure(ID: integer);
55
56 TBrainType = (btNoTerm, btSuperVirtual, btTerm, btRandom, btAI);
57
58 { TBrain }
59
60 TBrain = class
61 FileName: string;
62 DLLName: string;
63 Name: string;
64 Credits: string; { filename and full name }
65 hm: TLibHandle; { module handle }
66 Flags: Integer;
67 ServerVersion: Integer;
68 DataVersion: Integer;
69 DataSize: Integer;
70 Client: TClientCall; { client function address }
71 Initialized: Boolean;
72 Kind: TBrainType;
73 Picture: TBitmap;
74 procedure LoadFromFile(AIFileName: string);
75 constructor Create;
76 destructor Destroy; override;
77 end;
78
79 { TBrains }
80
81 TBrains = class(TFPGObjectList<TBrain>)
82 function AddNew: TBrain;
83 function GetKindCount(Kind: TBrainType): Integer;
84 procedure GetByKind(Kind: TBrainType; Brains: TBrains);
85 end;
86
87var
88 // PARAMETERS
89 PlayersBrain: TBrains; { brain of the players }
90 Difficulty: array [0 .. nPl - 1] of integer absolute Database.Difficulty;
91 { difficulty }
92
93 // READ ONLY
94 DotNetClient: TClientCall;
95 Brains: TBrains; // { available brains }
96 NotifyMessage: string;
97
98 BrainNoTerm: TBrain;
99 BrainSuperVirtual: TBrain;
100 BrainTerm: TBrain;
101 BrainRandom: TBrain;
102 BrainBeginner: TBrain; // AI to use for beginner level
103
104procedure Init(NotifyFunction: TNotifyFunction);
105procedure Done;
106
107procedure StartNewGame(const Path, FileName, Map: string;
108 Newlx, Newly, NewLandMass, NewMaxTurn: integer);
109function LoadGame(const Path, FileName: string; Turn: integer;
110 MovieMode: boolean): boolean;
111procedure EditMap(const Map: string; Newlx, Newly, NewLandMass: integer);
112procedure DirectHelp(Command: integer);
113
114procedure ChangeClient;
115procedure NextPlayer;
116function PreviewMap(lm: integer): pointer;
117
118
119implementation
120
121uses
122 Directories, CityProcessing, UnitProcessing, CmdList, LCLIntf, LCLType,
123 LMessages, Classes, SysUtils;
124
125resourcestring
126 SNoAiFound = 'No AI libraries found in directory %s';
127
128var
129 MaxTurn: Integer;
130 LoadTurn: Integer; { turn where to stop loading }
131 nLogOpened: Integer; { nLog of opened book }
132{$IFOPT O-}nHandoverStack, {$ENDIF}
133 LastEndClientCommand: Integer;
134 pContacted: Integer; // player contacted for negotiation
135 pDipActive: Integer; // player who's to speak in a negotiation
136 pTurn: Integer; { player who's turn it is }
137 GWinner: Integer;
138 GColdWarStart: Integer;
139 GStealFrom: Integer;
140 SpyMission: Integer;
141 ZOCTile: Integer;
142 CCCommand: Integer;
143 CCPlayer: Integer;
144 DebugMap: array [0 .. nPl - 1] of Pointer;
145 ExeInfo: TSearchRec;
146 Stat: array [0 .. nStat - 1, 0 .. nPl - 1] of ^TChart;
147 AutoSaveState: TCmdListState;
148 MapField: ^Cardinal; // predefined map
149 LastOffer: TOffer;
150 CCData: array [0 .. 14] of integer;
151 bix: TBrains; { brain of the players }
152 DevModelTurn, { turn of last call to sResetModel }
153 OriginalDataVersion: array [0 .. nPl - 1] of integer;
154 SavedTiles { , SavedResourceWeights } : array [0 .. ncmax - 1] of Cardinal;
155 SavedData: array [0 .. nPl - 1] of pointer;
156 LogFileName: string;
157 SavePath: string; { name of file for saving the current game }
158 MapFileName: string; // name of map to use, empty for random
159 AICredits: string;
160 AIInfo: array [0 .. nPl - 1] of string;
161 Notify: TNotifyFunction;
162 LastClientTime: TDateTime;
163{$IFOPT O-}HandoverStack: array [0 .. 31] of Cardinal; {$ENDIF}
164 AutoSaveExists: Boolean;
165 LoadOK: Boolean;
166 WinOnAlone: Boolean;
167 PreviewElevation: Boolean;
168 MovieStopped: Boolean;
169
170const
171 PreviewRND = 41601260; { randseed for preview map }
172
173function Server(Command, Player, Subject: integer; var Data): integer;
174 stdcall; forward;
175
176procedure CallPlayer(Command, p: integer; var Data);
177begin
178 if ((Mode <> moMovie) or (p = 0)) then
179 begin
180{$IFOPT O-}
181 HandoverStack[nHandoverStack] := p;
182 HandoverStack[nHandoverStack + 1] := Command;
183 inc(nHandoverStack, 2);
184 bix[p].Client(Command, p, Data);
185 dec(nHandoverStack, 2);
186{$ELSE}
187 try
188 Brain[bix[p]].Client(Command, p, Data);
189 except
190 Notify(ntException + bix[p]);
191 end;
192{$ENDIF}
193 end
194end;
195
196procedure CallClient(bix, Command: integer; var Data);
197begin
198 if ((Mode <> moMovie) or (bix = Brains.IndexOf(GameServer.bix[0]))) then
199 begin
200{$IFOPT O-}
201 HandoverStack[nHandoverStack] := bix;
202 HandoverStack[nHandoverStack + 1] := Command;
203 inc(nHandoverStack, 2);
204 Brains[bix].Client(Command, -1, Data);
205 dec(nHandoverStack, 2);
206{$ELSE}
207 try
208 Brain[bix].Client(Command, -1, Data);
209 except
210 Notify(ntException + bix);
211 end;
212{$ENDIF}
213 end
214end;
215
216procedure Init(NotifyFunction: TNotifyFunction);
217var
218 f: TSearchRec;
219 BasePath: string;
220 NewBrain: TBrain;
221 I: Integer;
222begin
223 Notify := NotifyFunction;
224 PreviewElevation := false;
225 PlayersBrain := TBrains.Create(False);
226 PlayersBrain.Count := nPl;
227 for I := 0 to nPl - 1 do
228 PlayersBrain[I] := nil;
229
230 bix := TBrains.Create(False);
231 bix.Count := nPl;
232 for I := 0 to nPl - 1 do
233 bix[I] := nil;
234
235 { get available brains }
236 Brains := TBrains.Create;
237 BrainNoTerm := Brains.AddNew;
238 BrainNoTerm.FileName := ':AIT';
239 BrainNoTerm.Flags := 0;
240 BrainNoTerm.Initialized := false;
241 BrainNoTerm.Kind := btNoTerm;
242 BrainSuperVirtual := Brains.AddNew;
243 BrainSuperVirtual.FileName := ':Supervisor';
244 BrainSuperVirtual.Flags := 0;
245 BrainSuperVirtual.Initialized := false;
246 BrainSuperVirtual.Kind := btSuperVirtual;
247 BrainTerm := Brains.AddNew;
248 BrainTerm.FileName := ':StdIntf';
249 BrainTerm.Flags := fMultiple;
250 BrainTerm.Initialized := false;
251 BrainTerm.ServerVersion := Version;
252 BrainTerm.Kind := btTerm;
253 BrainRandom := Brains.AddNew;
254 BrainRandom.FileName := ':Random';
255 BrainRandom.Flags := fMultiple;
256 BrainRandom.Initialized := false;
257 BrainRandom.Kind := btRandom;
258
259 BrainBeginner := nil;
260
261 if FindFirst(GetAiDir + DirectorySeparator + '*', faDirectory or faArchive or faReadOnly, f) = 0 then
262 repeat
263 BasePath := GetAiDir + DirectorySeparator + f.Name;
264 if (f.Name <> '.') and (f.Name <> '..') and DirectoryExists(BasePath) then begin
265 NewBrain := Brains.AddNew;
266 NewBrain.Kind := btAI;
267 NewBrain.LoadFromFile(BasePath + DirectorySeparator + F.Name + '.ai.txt');
268 if (NewBrain.ServerVersion >= FirstAICompatibleVersion) and
269 (NewBrain.ServerVersion <= Version) and
270 ((NewBrain.Flags and fDotNet = 0) or (@DotNetClient <> nil)) then begin
271 end else Brains.Delete(Brains.Count - 1);
272 end;
273 until FindNext(f) <> 0;
274 FindClose(F);
275
276 if Brains.GetKindCount(btAI) = 0 then
277 raise Exception.Create(Format(SNoAiFound, [GetAiDir]));
278end;
279
280procedure Done;
281var
282 I: Integer;
283begin
284 for I := 0 to Brains.Count - 1 do
285 with Brains[I] do
286 if Initialized then begin
287 CallClient(I, cReleaseModule, nil^);
288 if (Kind = btAI) and ((Flags and fDotNet) = 0) then
289 FreeLibrary(hm);
290 end;
291 PlayersBrain.Free;
292 bix.Free;
293 Brains.Free;
294end;
295
296function PreviewMap(lm: integer): pointer;
297begin
298 lx := lxmax;
299 ly := lymax;
300 MapSize := lx * ly;
301 LandMass := lm;
302 DelphiRandSeed := PreviewRND;
303 if not PreviewElevation then
304 begin
305 CreateElevation;
306 PreviewElevation := true;
307 end;
308 CreateMap(true);
309 Result := @RealMap;
310end;
311
312procedure ChangeClientWhenDone(Command, Player: integer; var Data;
313 DataSize: integer);
314begin
315 CCCommand := Command;
316 CCPlayer := Player;
317 if DataSize > 0 then
318 move(Data, CCData, DataSize);
319 Notify(ntChangeClient);
320end;
321
322procedure PutMessage(Level: integer; Text: string);
323begin
324 bix[0].Client(cDebugMessage, Level, pchar(Text)^);
325end;
326
327procedure ForceClientDeactivation;
328var
329 NullOffer: TOffer;
330begin
331 if pDipActive < 0 then
332 Server(sTurn, pTurn, 0, nil^) // no nego mode
333 else
334 case LastEndClientCommand of // nego mode
335 scContact:
336 Server(scReject, pDipActive, 0, nil^);
337 scDipCancelTreaty, scDipBreak:
338 Server(scDipNotice, pDipActive, 0, nil^);
339 else
340 begin // make null offer
341 NullOffer.nDeliver := 0;
342 NullOffer.nCost := 0;
343 Server(scDipOffer, pDipActive, 0, NullOffer);
344 end
345 end
346end;
347
348procedure ChangeClient;
349// hand over control to other client (as specified by CC...)
350var
351 p: integer;
352 T: TDateTime;
353begin
354 T := NowPrecise;
355 PutMessage(1 shl 16 + 2, Format('CLIENT: took %.1f ms',
356 [(T - LastClientTime) / OneMillisecond]));
357 LastClientTime := T;
358 PutMessage(1 shl 16 + 2, Format('CLIENT: calling %d (%s)',
359 [CCPlayer, bix[CCPlayer].Name]));
360 if CCCommand = cTurn then
361 for p := 0 to nPl - 1 do
362 if (p <> CCPlayer) and (1 shl p and GWatching <> 0) then
363 CallPlayer(cShowTurnChange, p, CCPlayer);
364
365 p := CCPlayer;
366 CCPlayer := -1;
367 CallPlayer(CCCommand, p, CCData);
368 if (Mode = moPlaying) and (bix[p].Flags and aiThreaded = 0) and
369 (CCPlayer < 0) then
370 begin
371 Notify(ntDeactivationMissing + p);
372 ForceClientDeactivation;
373 end
374end;
375
376procedure Inform(p: integer);
377var
378 i, p1: integer;
379begin
380 RW[p].Turn := GTurn;
381 if (GTurn = MaxTurn) and (p = pTurn) and (p = 0) then
382 RW[p].Happened := RW[p].Happened or phTimeUp;
383 if (GWinner > 0) and (p = pTurn) and (p = 0) then
384 RW[p].Happened := RW[p].Happened or phShipComplete;
385 RW[p].Alive := GAlive;
386 move(GWonder, RW[p].Wonder, SizeOf(GWonder));
387 move(GShip, RW[p].Ship, SizeOf(GShip));
388 for p1 := 0 to nPl - 1 do
389 if (p1 <> p) and Assigned(bix[p1]) and (Difficulty[p1] > 0) then
390 RW[p].EnemyReport[p1].Credibility := RW[p1].Credibility;
391 for p1 := 0 to nPl - 1 do
392 if (p1 <> p) and (1 shl p1 and GAlive <> 0) then
393 begin
394 if (GTestFlags and tfUncover <> 0) or (Difficulty[p] = 0) or
395 (RW[p].Treaty[p1] >= trFriendlyContact) then
396 GiveCivilReport(p, p1);
397 if (GTestFlags and tfUncover <> 0) or (Difficulty[p] = 0) or
398 (RW[p].Treaty[p1] = trAlliance) then
399 GiveMilReport(p, p1)
400 end;
401 for i := 0 to RW[p].nEnemyModel - 1 do
402 with RW[p].EnemyModel[i] do
403 Lost := Destroyed[p, Owner, mix];
404end;
405
406procedure LogChanges;
407var
408 p, ix: integer;
409begin
410 for p := 0 to nPl - 1 do
411 if (1 shl p and GWatching <> 0) and ProcessClientData[p] then
412 begin
413 // log unit status changes
414 for ix := 0 to RW[p].nUn - 1 do
415 with RW[p].Un[ix] do
416 if (Loc >= 0) and (SavedStatus <> Status) then
417 begin
418 CL.Put(sIntSetUnitStatus, p, ix, @Status);
419 SavedStatus := Status
420 end;
421 // log city status changes
422 for ix := 0 to RW[p].nCity - 1 do
423 with RW[p].City[ix] do
424 if (Loc >= 0) and (SavedStatus <> Status) then
425 begin
426 CL.Put(sIntSetCityStatus, p, ix, @Status);
427 SavedStatus := Status
428 end;
429 // log model status changes
430 for ix := 0 to RW[p].nModel - 1 do
431 with RW[p].Model[ix] do
432 if SavedStatus <> Status then
433 begin
434 CL.Put(sIntSetModelStatus, p, ix, @Status);
435 SavedStatus := Status
436 end;
437 // log enemy city status changes
438 for ix := 0 to RW[p].nEnemyCity - 1 do
439 with RW[p].EnemyCity[ix] do
440 if (Loc >= 0) and (SavedStatus <> Status) then
441 begin
442 CL.Put(sIntSetECityStatus, p, ix, @Status);
443 SavedStatus := Status
444 end;
445 // log data changes
446 if bix[p].DataSize > 0 then
447 begin
448 CL.PutDataChanges(sIntDataChange, p, SavedData[p], RW[p].Data,
449 bix[p].DataSize);
450 move(RW[p].Data^, SavedData[p]^, bix[p].DataSize * 4);
451 end
452 end;
453end;
454
455procedure NoLogChanges;
456var
457 p, ix: integer;
458begin
459 for p := 0 to nPl - 1 do
460 if (1 shl p and GWatching <> 0) and ProcessClientData[p] then
461 begin
462 for ix := 0 to RW[p].nUn - 1 do
463 with RW[p].Un[ix] do
464 SavedStatus := Status;
465 for ix := 0 to RW[p].nCity - 1 do
466 with RW[p].City[ix] do
467 SavedStatus := Status;
468 for ix := 0 to RW[p].nModel - 1 do
469 with RW[p].Model[ix] do
470 SavedStatus := Status;
471 for ix := 0 to RW[p].nEnemyCity - 1 do
472 with RW[p].EnemyCity[ix] do
473 SavedStatus := Status;
474 if bix[p].DataSize > 0 then
475 move(RW[p].Data^, SavedData[p]^, bix[p].DataSize * 4);
476 end;
477end;
478
479function HasChanges(p: integer): boolean;
480type
481 TDWordList = array [0 .. INFIN] of Cardinal;
482 PDWortList = ^TDWordList;
483var
484 ix: integer;
485begin
486 result := false;
487 for ix := 0 to RW[p].nUn - 1 do
488 with RW[p].Un[ix] do
489 if (Loc >= 0) and (SavedStatus <> Status) then
490 result := true;
491 for ix := 0 to RW[p].nCity - 1 do
492 with RW[p].City[ix] do
493 if (Loc >= 0) and (SavedStatus <> Status) then
494 result := true;
495 for ix := 0 to RW[p].nModel - 1 do
496 with RW[p].Model[ix] do
497 if SavedStatus <> Status then
498 result := true;
499 for ix := 0 to RW[p].nEnemyCity - 1 do
500 with RW[p].EnemyCity[ix] do
501 if (Loc >= 0) and (SavedStatus <> Status) then
502 result := true;
503 if RW[p].Data <> nil then
504 for ix := 0 to bix[p].DataSize - 1 do
505 if PDWortList(SavedData[p])[ix] <> PDWortList(RW[p].Data)[ix] then
506 result := true
507end;
508
509procedure InitBrain(bix: TBrain);
510var
511 InitModuleData: TInitModuleData;
512begin
513 assert(bix.Kind <> btSuperVirtual);
514 with bix do begin
515 if Initialized then
516 exit;
517 if Kind = btAI then
518 begin { get client function }
519 Notify(ntInitModule + Brains.IndexOf(bix));
520 if Flags and fDotNet > 0 then
521 Client := DotNetClient
522 else
523 begin
524 hm := LoadLibrary(pchar(DLLName));
525 if hm = 0 then
526 begin
527 Client := nil;
528 Notify(ntDLLError + Brains.IndexOf(bix));
529 end
530 else
531 begin
532 Client := GetProcAddress(hm, 'client');
533 if @Client = nil then
534 Notify(ntClientError + Brains.IndexOf(bix));
535 end
536 end
537 end;
538 if @Client <> nil then
539 begin
540 Initialized := true;
541 InitModuleData.Server := @Server;
542 InitModuleData.DataVersion := 0;
543 InitModuleData.DataSize := 0;
544 InitModuleData.Flags := 0;
545 CallClient(Brains.IndexOf(bix), cInitModule, InitModuleData);
546 DataVersion := InitModuleData.DataVersion;
547 DataSize := (InitModuleData.DataSize + 3) div 4;
548 if DataSize > MaxDataSize then
549 DataSize := 0;
550 Flags := Flags or InitModuleData.Flags;
551 end
552 end
553end;
554
555procedure SaveMap(FileName: string);
556var
557 i: integer;
558 MapFile: TFileStream;
559 s: string[255];
560begin
561 MapFile := TFileStream.Create(GetMapsDir + DirectorySeparator + FileName,
562 fmCreate or fmShareExclusive);
563 MapFile.Position := 0;
564 s := 'cEvoMap'#0;
565 MapFile.write(s[1], 8); { file id }
566 i := 0;
567 MapFile.write(i, 4); { format id }
568 MapFile.write(MaxTurn, 4);
569 MapFile.write(lx, 4);
570 MapFile.write(ly, 4);
571 MapFile.write(RealMap, MapSize * 4);
572 MapFile.Free;
573end;
574
575function LoadMap(FileName: string): boolean;
576var
577 i, Loc1: integer;
578 MapFile: TFileStream;
579 s: string[255];
580begin
581 result := false;
582 MapFile := nil;
583 try
584 MapFile := TFileStream.Create(GetMapsDir + DirectorySeparator + FileName,
585 fmOpenRead or fmShareExclusive);
586 MapFile.Position := 0;
587 MapFile.read(s[1], 8); { file id }
588 MapFile.read(i, 4); { format id }
589 if i = 0 then
590 begin
591 MapFile.read(i, 4); // MaxTurn
592 MapFile.read(lx, 4);
593 MapFile.read(ly, 4);
594 ly := ly and not 1;
595 if lx > lxmax then
596 lx := lxmax;
597 if ly > lymax then
598 ly := lymax;
599 MapSize := lx * ly;
600 MapFile.read(RealMap, MapSize * 4);
601 for Loc1 := 0 to MapSize - 1 do
602 begin
603 RealMap[Loc1] := RealMap[Loc1] and
604 ($7F01FFFF or fPrefStartPos or fStartPos) or ($F shl 27);
605 if RealMap[Loc1] and (fTerrain or fSpecial) = fSwamp or fSpecial2 then
606 RealMap[Loc1] := RealMap[Loc1] and not(fTerrain or fSpecial) or
607 (fSwamp or fSpecial1);
608 if (RealMap[Loc1] and fDeadLands <> 0) and
609 (RealMap[Loc1] and fTerrain <> fArctic) then
610 RealMap[Loc1] := RealMap[Loc1] and not(fTerrain or fSpecial)
611 or fDesert;
612 end;
613 result := true;
614 end;
615 MapFile.Free;
616 except
617 if MapFile <> nil then
618 MapFile.Free;
619 end;
620end;
621
622procedure SaveGame(FileName: string; auto: boolean);
623var
624 x, y, i, zero, Tile, nLocal: integer;
625 LogFile: TFileStream;
626 s: string[255];
627 SaveMap: array [0 .. lxmax * lymax - 1] of Byte;
628begin
629 nLocal := 0;
630 for i := 0 to nPl - 1 do
631 if Assigned(bix[i]) and (bix[i].Kind = btTerm) then
632 inc(nLocal);
633 if Difficulty[0] = 0 then
634 nLocal := 0;
635 if nLocal <= 1 then
636 for y := 0 to ly - 1 do
637 for x := 0 to lx - 1 do
638 begin
639 Tile := RW[0].Map[(x + SaveMapCenterLoc + lx shr 1) mod lx + lx * y];
640 SaveMap[x + lx * y] := Tile and fTerrain + Tile and
641 (fCity or fUnit or fOwned) shr 16;
642 end;
643
644 if auto and AutoSaveExists then // append to existing file
645 LogFile := TFileStream.Create(SavePath + FileName, fmOpenReadWrite or
646 fmShareExclusive)
647 else // create new file
648 LogFile := TFileStream.Create(SavePath + FileName,
649 fmCreate or fmShareExclusive);
650
651 zero := 0;
652 LogFile.Position := 0;
653 s := 'cEvoBook';
654 LogFile.write(s[1], 8); { file id }
655 i := Version;
656 LogFile.write(i, 4); { c-evo version }
657 LogFile.write(ExeInfo.Time, 4);
658 LogFile.write(lx, 4);
659 LogFile.write(ly, 4);
660 LogFile.write(LandMass, 4);
661 if LandMass = 0 then
662 LogFile.write(MapField^, MapSize * 4);
663
664 LogFile.write(MaxTurn, 4);
665 LogFile.write(RND, 4);
666 LogFile.write(GTurn, 4);
667 if nLocal > 1 then // multiplayer game -- no quick view
668 begin
669 i := $80;
670 LogFile.write(i, 4);
671 end
672 else
673 LogFile.write(SaveMap, ((MapSize - 1) div 4 + 1) * 4);
674 for i := 0 to nPl - 1 do
675 if not Assigned(bix[i]) then
676 LogFile.write(zero, 4)
677 else
678 begin
679 if PlayersBrain[i].Kind in [btRandom, btAI] then
680 s := bix[i].FileName
681 else
682 s := PlayersBrain[i].FileName;
683 move(zero, s[Length(s) + 1], 4);
684 LogFile.write(s, (Length(s) div 4 + 1) * 4);
685 LogFile.write(OriginalDataVersion[i], 4);
686 s := ''; { behavior }
687 move(zero, s[Length(s) + 1], 4);
688 LogFile.write(s, (Length(s) div 4 + 1) * 4);
689 LogFile.write(Difficulty[i], 4);
690 end;
691
692 if auto and AutoSaveExists then
693 CL.AppendToFile(LogFile, AutoSaveState)
694 else
695 CL.SaveToFile(LogFile);
696 LogFile.Free;
697 if auto then
698 begin
699 AutoSaveState := CL.State;
700 AutoSaveExists := true
701 end
702end;
703
704procedure StartGame;
705var
706 i, p, p1, Human, nAlive, bixUni: integer;
707 Game: TNewGameData;
708 // GameEx: TNewGameExData;
709 Path: shortstring;
710 BrainUsed: Set of 0 .. 254; { used brains }
711 AIBrains: TBrains;
712begin
713 for p1 := 0 to nPl - 1 do begin
714 if Assigned(PlayersBrain[p1]) and (PlayersBrain[p1].Kind = btSuperVirtual) then
715 bix[p1] := BrainTerm // supervisor and local human use same module
716 else if Assigned(PlayersBrain[p1]) and (PlayersBrain[p1].Kind = btRandom) then
717 if Brains.GetKindCount(btAI) = 0 then
718 bix[p1] := nil
719 else begin
720 AIBrains := TBrains.Create(False);
721 Brains.GetByKind(btAI, AIBrains);
722 bix[p1] := AIBrains[DelphiRandom(AIBrains.Count)];
723 AIBrains.Free;
724 end
725 else
726 bix[p1] := PlayersBrain[p1];
727 if not Assigned(PlayersBrain[p1]) then
728 Difficulty[p1] := -1;
729 end;
730
731 if bix[0].Kind <> btNoTerm then
732 Notify(ntInitLocalHuman);
733 BrainUsed := [];
734 for p := 0 to nPl - 1 do
735 if Assigned(bix[p]) and ((Mode <> moMovie) or (p = 0)) then
736 begin { initiate selected control module }
737 AIInfo[p] := bix[p].Name + #0;
738 InitBrain(bix[p]);
739 if Mode = moPlaying then
740 begin // new game, this data version is original
741 OriginalDataVersion[p] := bix[p].DataVersion;
742 ProcessClientData[p] := true;
743 end
744 else // loading game, compare with data version read from file
745 ProcessClientData[p] := ProcessClientData[p] and
746 (OriginalDataVersion[p] = bix[p].DataVersion);
747 if @bix[p].Client = nil then // client function not found
748 if bix[0].Kind = btNoTerm then
749 bix[p] := nil
750 else
751 begin
752 bix[p] := BrainTerm;
753 OriginalDataVersion[p] := -1;
754 ProcessClientData[p] := false;
755 end;
756 if Assigned(bix[p]) then
757 include(BrainUsed, Brains.IndexOf(bix[p]));
758 end;
759
760 Notify(ntCreateWorld);
761 nAlive := 0;
762 GAlive := 0;
763 if Mode = moMovie then
764 GWatching := 1
765 else
766 GWatching := 0;
767 GAI := 0;
768 for p1 := 0 to nPl - 1 do
769 if Assigned(bix[p1]) then
770 begin
771 if Mode <> moMovie then
772 inc(GWatching, 1 shl p1);
773 if bix[p1].Kind = btAI then
774 inc(GAI, 1 shl p1);
775 if Difficulty[p1] > 0 then
776 begin
777 inc(GAlive, 1 shl p1);
778 inc(nAlive);
779 end;
780 ServerVersion[p1] := bix[p1].ServerVersion;
781 end;
782 WinOnAlone := (bix[0].Kind = btNoTerm) and (nAlive > 1);
783 GWinner := 0;
784 GColdWarStart := -ColdWarTurns - 1;
785 uixSelectedTransport := -1;
786 SpyMission := smSabotageProd;
787 for p1 := 0 to nPl - 1 do
788 DebugMap[p1] := nil;
789
790 GTurn := 0;
791 for i := 0 to 27 do
792 with GWonder[i] do
793 begin
794 CityID := -1;
795 EffectiveOwner := -1
796 end;
797 FillChar(GShip, SizeOf(GShip), 0);
798
799 for p := 0 to nPl - 1 do
800 if 1 shl p and (GAlive or GWatching) <> 0 then
801 with RW[p] do
802 begin
803 Government := gDespotism;
804 Money := StartMoney;
805 TaxRate := 30;
806 LuxRate := 0;
807 Research := 0;
808 ResearchTech := -2;
809 AnarchyStart := -AnarchyTurns - 1;
810 Happened := 0;
811 LastValidStat[p] := -1;
812 Worked[p] := 0;
813 Founded[p] := 0;
814 DevModelTurn[p] := -1;
815 OracleIncome := 0;
816
817 if bix[p].DataSize > 0 then
818 begin
819 GetMem(SavedData[p], bix[p].DataSize * 4);
820 GetMem(Data, bix[p].DataSize * 4);
821 FillChar(SavedData[p]^, bix[p].DataSize * 4, 0);
822 FillChar(Data^, bix[p].DataSize * 4, 0);
823 end
824 else
825 begin
826 Data := nil;
827 SavedData[p] := nil
828 end;
829 nBattleHistory := 0;
830 BattleHistory := nil;
831 { if bix[p]=bixTerm then
832 begin
833 GetMem(BorderHelper,MapSize);
834 FillChar(BorderHelper^,MapSize,0);
835 end
836 else } BorderHelper := nil;
837 for i := 0 to nStat - 1 do
838 GetMem(Stat[i, p], 4 * (MaxTurn + 1));
839 if bix[p].Flags and fDotNet <> 0 then
840 begin
841 GetMem(RW[p].DefaultDebugMap, MapSize * 4);
842 FillChar(RW[p].DefaultDebugMap^, MapSize * 4, 0);
843 DebugMap[p] := RW[p].DefaultDebugMap;
844 end
845 else
846 RW[p].DefaultDebugMap := nil;
847
848 { !!!for i:=0 to nShipPart-1 do GShip[p].Parts[i]:=Delphirandom((3-i)*2);{ }
849 end;
850
851 if LandMass > 0 then
852 begin // random map
853 InitRandomGame;
854 PreviewElevation := false;
855 MapField := nil;
856 end
857 else
858 begin // predefined map
859 if Mode = moPlaying then
860 LoadMap(MapFileName); // new game -- load map from file
861 GetMem(MapField, MapSize * 4);
862 move(RealMap, MapField^, MapSize * 4);
863 Human := 0;
864 for p1 := 0 to nPl - 1 do
865 if bix[p1].Kind = btTerm then
866 inc(Human, 1 shl p1);
867 InitMapGame(Human);
868 end;
869 CityProcessing.InitGame;
870 UnitProcessing.InitGame;
871 for p := 0 to nPl - 1 do
872 if 1 shl p and (GAlive or GWatching) <> 0 then
873 Inform(p);
874
875 pTurn := -1;
876 if bix[0].Kind <> btNoTerm then
877 Notify(ntInitLocalHuman);
878 Game.lx := lx;
879 Game.ly := ly;
880 Game.LandMass := LandMass;
881 Game.MaxTurn := MaxTurn;
882 move(Difficulty, Game.Difficulty, SizeOf(Difficulty));
883 // GameEx.lx:=lx; GameEx.ly:=ly; GameEx.LandMass:=LandMass;
884 // GameEx.MaxTurn:=MaxTurn; GameEx.RND:=RND;
885 // move(Difficulty,GameEx.Difficulty,SizeOf(Difficulty));
886 AICredits := '';
887 for i := 0 to Brains.Count - 1 do
888 with Brains[I] do begin
889 if Initialized then
890 if i in BrainUsed then
891 begin
892 if Kind = btAI then
893 Notify(ntInitPlayers);
894 for p := 0 to nPl - 1 do
895 begin
896 if Brains.IndexOf(bix[p]) = i then
897 Game.RO[p] := @RW[p]
898 else
899 Game.RO[p] := nil;
900 if (Kind = btTerm) and (Difficulty[0] = 0) and Assigned(bix[p]) then
901 Game.SuperVisorRO[p] := @RW[p]
902 else
903 Game.SuperVisorRO[p] := nil;
904 end;
905 if Flags and fDotNet > 0 then
906 begin
907 Path := DLLName;
908 move(Path[1], Game.AssemblyPath, Length(Path));
909 Game.AssemblyPath[Length(Path)] := #0;
910 end
911 else
912 Game.AssemblyPath[0] := #0;
913 case Mode of
914 moLoading, moLoading_Fast:
915 CallClient(i, cLoadGame, Game);
916 moMovie:
917 CallClient(i, cMovie, Game);
918 moPlaying:
919 CallClient(i, cNewGame, Game);
920 end;
921 if (Kind = btAI) and (Credits <> '') then
922 if AICredits = '' then
923 AICredits := Credits
924 else
925 AICredits := AICredits + '\' + Credits;
926 end
927 else
928 begin { module no longer used -- unload }
929 CallClient(i, cReleaseModule, nil^);
930 if Kind = btAI then
931 begin
932 if Flags and fDotNet = 0 then
933 FreeLibrary(hm);
934 Client := nil;
935 end;
936 Initialized := false;
937 end;
938 end;
939 AICredits := AICredits + #0;
940
941 if bix[0].Kind <> btNoTerm then
942 begin
943 // uni ai?
944 bixUni := -1;
945 for p1 := 0 to nPl - 1 do
946 if Assigned(bix[p1]) and (bix[p1].Kind = btAI) then
947 if bixUni = -1 then
948 bixUni := Brains.IndexOf(bix[p1])
949 else if bixUni <> Brains.IndexOf(bix[p1]) then
950 bixUni := -2;
951 for p1 := 0 to nPl - 1 do
952 if Assigned(bix[p1]) and (bix[p1].Kind = btAI) then
953 begin
954 if bixUni = -2 then
955 NotifyMessage := bix[p1].FileName
956 else
957 NotifyMessage := '';
958 Notify(ntSetAIName + p1);
959 end
960 end;
961
962 CheckBorders(-1);
963{$IFOPT O-}InvalidTreatyMap := 0; {$ENDIF}
964 AutoSaveExists := false;
965 pDipActive := -1;
966 pTurn := 0;
967
968 if Mode >= moMovie then
969 Notify(ntEndInfo);
970end; { StartGame }
971
972procedure EndGame;
973var
974 i, p1: integer;
975begin
976 if LandMass = 0 then
977 FreeMem(MapField);
978 for p1 := 0 to nPl - 1 do
979 if Assigned(bix[p1]) then
980 begin
981 for i := 0 to nStat - 1 do
982 FreeMem(Stat[i, p1]);
983 if RW[p1].BattleHistory <> nil then
984 FreeMem(RW[p1].BattleHistory);
985 { if RW[p1].BorderHelper<>nil then FreeMem(RW[p1].BorderHelper); }
986 FreeMem(RW[p1].Data);
987 FreeMem(SavedData[p1]);
988 if RW[p1].DefaultDebugMap <> nil then
989 FreeMem(RW[p1].DefaultDebugMap);
990 end;
991 UnitProcessing.ReleaseGame;
992 CityProcessing.ReleaseGame;
993 Database.ReleaseGame;
994 CL.Free;
995end;
996
997procedure GenerateStat(p: integer);
998var
999 cix, uix: integer;
1000begin
1001 if Difficulty[p] > 0 then
1002 with RW[p] do
1003 begin
1004 Stat[stPop, p, GTurn] := 0;
1005 for cix := 0 to nCity - 1 do
1006 if City[cix].Loc >= 0 then
1007 inc(Stat[stPop, p, GTurn], City[cix].Size);
1008 Stat[stScience, p, GTurn] := Researched[p] * 50;
1009 if (RW[p].ResearchTech >= 0) and (RW[p].ResearchTech <> adMilitary) then
1010 inc(Stat[stScience, p, GTurn], Research * 100 div TechBaseCost(nTech[p],
1011 Difficulty[p]));
1012 Stat[stMil, p, GTurn] := 0;
1013 for uix := 0 to nUn - 1 do
1014 if Un[uix].Loc >= 0 then
1015 with Model[Un[uix].mix] do
1016 begin
1017 if (Kind <= mkEnemyDeveloped) and (Un[uix].mix <> 1) then
1018 inc(Stat[stMil, p, GTurn], Weight * MStrength *
1019 Un[uix].Health div 100)
1020 else if Domain = dGround then
1021 inc(Stat[stMil, p, GTurn], (Attack + 2 * Defense) *
1022 Un[uix].Health div 100)
1023 else
1024 inc(Stat[stMil, p, GTurn], (Attack + Defense) *
1025 Un[uix].Health div 100);
1026 case Kind of
1027 mkSlaves:
1028 inc(Stat[stPop, p, GTurn]);
1029 mkSettler:
1030 inc(Stat[stPop, p, GTurn], 2);
1031 end;
1032 end;
1033 Stat[stMil, p, GTurn] := Stat[stMil, p, GTurn] div 16;
1034 Stat[stExplore, p, GTurn] := Discovered[p];
1035 Stat[stTerritory, p, GTurn] := TerritoryCount[p];
1036 Stat[stWork, p, GTurn] := Worked[p];
1037 LastValidStat[p] := GTurn;
1038 end;
1039end;
1040
1041procedure LogCityTileChanges;
1042var
1043 cix: integer;
1044begin
1045 for cix := 0 to RW[pTurn].nCity - 1 do
1046 with RW[pTurn].City[cix] do
1047 if Loc >= 0 then
1048 begin
1049 { if SavedResourceWeights[cix]<>ResourceWeights then
1050 begin // log city resource weight changes
1051 CL.Put(sSetCityResourceWeights, pTurn, cix, @ResourceWeights);
1052 SavedResourceWeights[cix]:=ResourceWeights;
1053 end; }
1054 if SavedTiles[cix] <> Tiles then
1055 begin // log city tile changes
1056 CL.Put(sSetCityTiles, pTurn, cix, @Tiles);
1057 SavedTiles[cix] := Tiles;
1058 end;
1059 end;
1060end;
1061
1062procedure NoLogCityTileChanges;
1063var
1064 cix: integer;
1065begin
1066 for cix := 0 to RW[pTurn].nCity - 1 do
1067 with RW[pTurn].City[cix] do
1068 if Loc >= 0 then
1069 begin
1070 // SavedResourceWeights[cix]:=ResourceWeights;
1071 SavedTiles[cix] := Tiles;
1072 end;
1073end;
1074
1075function HasCityTileChanges: boolean;
1076var
1077 cix: integer;
1078begin
1079 result := false;
1080 for cix := 0 to RW[pTurn].nCity - 1 do
1081 with RW[pTurn].City[cix] do
1082 if Loc >= 0 then
1083 begin
1084 // if SavedResourceWeights[cix]<>ResourceWeights then result:=true;
1085 if SavedTiles[cix] <> Tiles then
1086 result := true;
1087 end;
1088end;
1089
1090procedure BeforeTurn0;
1091var
1092 p1, uix: integer;
1093begin
1094 for uix := 0 to RW[pTurn].nUn - 1 do { init movement points for first turn }
1095 with RW[pTurn].Un[uix] do
1096 Movement := RW[pTurn].Model[mix].Speed;
1097
1098 if Difficulty[pTurn] > 0 then
1099 DiscoverViewAreas(pTurn)
1100 else { supervisor }
1101 begin
1102 DiscoverAll(pTurn, lObserveSuper);
1103 for p1 := 1 to nPl - 1 do
1104 if 1 shl p1 and GAlive <> 0 then
1105 begin
1106 GiveCivilReport(pTurn, p1);
1107 GiveMilReport(pTurn, p1)
1108 end;
1109 end;
1110 // CheckContact;
1111end;
1112
1113function LoadGame(const Path, FileName: string; Turn: integer;
1114 MovieMode: boolean): boolean;
1115var
1116 J: TBrain;
1117 i, ix, d, p1, Command, Subject: integer;
1118 K: Integer;
1119{$IFDEF TEXTLOG}LoadPos0: integer; {$ENDIF}
1120 Data: pointer;
1121 LogFile: TFileStream;
1122 FormerCLState: TCmdListState;
1123 s: string[255];
1124 SaveMap: array [0 .. lxmax * lymax - 1] of Byte;
1125 Started, StatRequest: boolean;
1126begin
1127 SavePath := Path;
1128 LogFileName := FileName;
1129 LoadTurn := Turn;
1130 LogFile := TFileStream.Create(SavePath + LogFileName, fmOpenRead or
1131 fmShareExclusive);
1132 LogFile.Position := 0;
1133 LogFile.Read(s[1], 8); { file id }
1134 LogFile.Read(i, 4); { c-evo version }
1135 LogFile.Read(J, 4); { exe time }
1136
1137 if (i >= FirstBookCompatibleVersion) and (i <= Version) then
1138 begin
1139 result := true;
1140 LogFile.Read(lx, 4);
1141 LogFile.Read(ly, 4);
1142 MapSize := lx * ly;
1143 LogFile.Read(LandMass, 4);
1144 if LandMass = 0 then
1145 LogFile.Read(RealMap, MapSize * 4); // use predefined map
1146 LogFile.Read(MaxTurn, 4);
1147 LogFile.Read(RND, 4);
1148 LogFile.Read(GTurn, 4);
1149 LogFile.Read(SaveMap, 4);
1150 if SaveMap[0] <> $80 then
1151 LogFile.read(SaveMap[4], ((MapSize - 1) div 4 + 1) * 4 - 4);
1152 for p1 := 0 to nPl - 1 do
1153 begin
1154 LogFile.Read(s[0], 4);
1155 if s[0] = #0 then
1156 PlayersBrain[p1] := nil
1157 else
1158 begin
1159 LogFile.Read(s[4], Byte(s[0]) div 4 * 4);
1160 LogFile.Read(OriginalDataVersion[p1], 4);
1161 LogFile.Read(d, 4); { behavior }
1162 LogFile.Read(Difficulty[p1], 4);
1163 J := Brains.Last;
1164 while Assigned(J) and (AnsiCompareFileName(J.FileName, s) <> 0) do begin
1165 K := Brains.IndexOf(J) - 1;
1166 if K >= 0 then J := Brains[K]
1167 else J := nil;
1168 end;
1169 if not Assigned(J) then
1170 begin // ai not found -- replace by local player
1171 ProcessClientData[p1] := false;
1172 NotifyMessage := s;
1173 Notify(ntAIError);
1174 J := BrainTerm;
1175 end
1176 else
1177 ProcessClientData[p1] := true;
1178 if j.Kind = btNoTerm then
1179 j := BrainSuperVirtual;
1180 // crashed tournament -- load as supervisor
1181 PlayersBrain[p1] := j;
1182 end;
1183 end;
1184 end
1185 else
1186 Result := false;
1187
1188 if Result then begin
1189 CL := TCmdList.Create;
1190 CL.LoadFromFile(LogFile);
1191 end;
1192 LogFile.Free;
1193 if not result then
1194 Exit;
1195
1196 Notify(ntStartDone);
1197 if LoadTurn < 0 then
1198 LoadTurn := GTurn;
1199 if MovieMode then
1200 Mode := moMovie
1201 else if LoadTurn = 0 then
1202 Mode := moLoading
1203 else
1204 Mode := moLoading_Fast;
1205{$IFDEF TEXTLOG}AssignFile(TextLog, SavePath + LogFileName + '.txt');
1206 Rewrite(TextLog); {$ENDIF}
1207 LoadOK := true;
1208 StartGame;
1209 if MovieMode then
1210 begin
1211 bix[0].Client(cShowGame, 0, nil^);
1212 Notify(ntBackOff);
1213 end
1214 else
1215 Notify(ntLoadBegin);
1216
1217 started := false;
1218 StatRequest := false;
1219 MovieStopped := false;
1220{$IFDEF LOADPERF}QueryPerformanceCounter(time_total0);
1221 time_a := 0;
1222 time_b := 0;
1223 time_c := 0; {$ENDIF}
1224 while not MovieStopped and (CL.Progress < 1000) do
1225 begin
1226 FormerCLState := CL.State;
1227 CL.Get(Command, p1, Subject, Data);
1228 if p1 < 0 then
1229 p1 := pTurn;
1230 if StatRequest and (Command and (sctMask or sExecute) <> sctInternal or
1231 sExecute) then
1232 begin
1233 GenerateStat(pTurn);
1234 StatRequest := false
1235 end;
1236 // complete all internal commands following an sTurn before generating statistics
1237 if (Command = sTurn) and not started then
1238 begin
1239{$IFDEF TEXTLOG}WriteLn(TextLog, '---Turn 0 P0---'); {$ENDIF}
1240 for p1 := 0 to nPl - 1 do
1241 if Assigned(bix[p1]) and ((Mode <> moMovie) or (p1 = 0)) then
1242 CallPlayer(cReplay, p1, nil^);
1243 BeforeTurn0;
1244 if MovieMode then
1245 begin
1246 Inform(pTurn);
1247 CallPlayer(cMovieTurn, 0, nil^);
1248 end;
1249 StatRequest := true;
1250 started := true;
1251 end
1252 else if (Command = sTurn) and (pTurn = 0) and (GTurn = LoadTurn) then
1253 begin
1254 assert(CL.State.LoadPos = FormerCLState.LoadPos + 4); // size of sTurn
1255 CL.State := FormerCLState;
1256 CL.Cut;
1257 Break;
1258 end
1259 else if Command = sIntDataChange then
1260 begin
1261{$IFDEF TEXTLOG}LoadPos0 := CL.State.LoadPos; {$ENDIF}
1262 if ProcessClientData[p1] then
1263 CL.GetDataChanges(RW[p1].Data, bix[p1].DataSize)
1264 else
1265 CL.GetDataChanges(nil, 0);
1266{$IFDEF TEXTLOG}WriteLn(TextLog, Format('Data Changes P%d (%d Bytes)', [p1, CL.State.LoadPos - LoadPos0])); {$ENDIF}
1267 end
1268 else
1269 begin
1270{$IFDEF TEXTLOG}CmdInfo := Format('Command %x', [Command]); {$ENDIF}
1271 if Command and (sctMask or sExecute) = sctInternal or sExecute then
1272 IntServer(Command, p1, Subject, Data^) // internal command
1273 else
1274 begin
1275 StatRequest := Command = sTurn;
1276 Server(Command, p1, Subject, Data^);
1277 end;
1278{$IFDEF TEXTLOG}WriteLn(TextLog, CmdInfo); {$ENDIF}
1279 end;
1280 if not MovieMode then
1281 Notify(ntLoadState + CL.Progress * 128 div 1000);
1282 end;
1283
1284 if MovieMode then
1285 begin
1286 Notify(ntBackOn);
1287 bix[0].Client(cBreakGame, -1, nil^);
1288 EndGame;
1289 Notify(ntStartGo);
1290 result := false;
1291 exit;
1292 end;
1293
1294 if StatRequest then
1295 GenerateStat(pTurn);
1296 assert(started);
1297{$IFDEF TEXTLOG}CloseFile(TextLog); {$ENDIF}
1298{$IFDEF LOADPERF}QueryPerformanceCounter(time_total); { time in s is: (time_total-time_total0)/PerfFreq }{$ENDIF}
1299 NoLogChanges;
1300 NoLogCityTileChanges;
1301 if LogFileName[1] = '~' then
1302 begin
1303 Delete(LogFileName, 1, 1);
1304 nLogOpened := -1
1305 end
1306 else
1307 nLogOpened := CL.State.nLog;
1308
1309 Mode := moPlaying;
1310 LastEndClientCommand := -1;
1311 if (GTestFlags and tfUncover <> 0) or (Difficulty[pTurn] = 0) then
1312 DiscoverAll(pTurn, lObserveSuper) { supervisor - all tiles visible }
1313 else
1314 DiscoverViewAreas(pTurn);
1315
1316 for p1 := 0 to nPl - 1 do
1317 if 1 shl p1 and (GAlive or GWatching) <> 0 then
1318 begin
1319 RecalcPeaceMap(p1);
1320 for ix := 0 to RW[p1].nEnemyUn - 1 do
1321 with RW[p1].EnemyUn[ix] do
1322 emix := RWemix[p1, Owner, mix];
1323 Inform(p1);
1324 end;
1325{$IFOPT O-}CheckBorders(-2); {$ENDIF} // for testing only
1326 Notify(ntEndInfo);
1327 if not LoadOK then
1328 begin
1329 NotifyMessage := SavePath + LogFileName;
1330 Notify(ntLoadError);
1331 end;
1332 bix[0].Client(cShowGame, 0, nil^);
1333 Notify(ntBackOff);
1334 Inform(pTurn);
1335 ChangeClientWhenDone(cResume, 0, nil^, 0);
1336end; // LoadGame
1337
1338procedure InsertTerritoryUpdateCommands;
1339var
1340 p1, Command, Subject: integer;
1341 Data: pointer;
1342 FormerCLState: TCmdListState;
1343begin
1344 while CL.Progress < 1000 do
1345 begin
1346 FormerCLState := CL.State;
1347 CL.Get(Command, p1, Subject, Data);
1348 if (Command = sIntExpandTerritory) and (p1 = pTurn) then
1349 begin
1350 IntServer(Command, p1, Subject, Data^);
1351{$IFDEF TEXTLOG}WriteLn(TextLog, 'AfterTurn - ExpandTerritory'); {$ENDIF}
1352 end
1353 else
1354 begin
1355 CL.State := FormerCLState;
1356 Break
1357 end
1358 end;
1359{$IFOPT O-}InvalidTreatyMap := 0; {$ENDIF}
1360end;
1361
1362procedure StartNewGame(const Path, FileName, Map: string;
1363 Newlx, Newly, NewLandMass, NewMaxTurn: integer);
1364var
1365 p: integer;
1366begin
1367 Notify(ntStartDone);
1368 SavePath := Path;
1369 LogFileName := FileName;
1370 MapFileName := Map;
1371 {$IFDEF FastContact}
1372 lx := 24;
1373 ly := 42;
1374 {$ELSE}
1375 lx := Newlx;
1376 ly := Newly;
1377 {$ENDIF}
1378 MapSize := lx * ly;
1379 if MapFileName <> '' then
1380 LandMass := 0
1381 else
1382 LandMass := NewLandMass;
1383 MaxTurn := NewMaxTurn;
1384 DelphiRandomize;
1385 RND := DelphiRandSeed;
1386 Mode := moPlaying;
1387 CL := TCmdList.Create;
1388 StartGame;
1389 NoLogChanges;
1390 for p := 0 to nPl - 1 do
1391 if Assigned(bix[p]) then
1392 CallPlayer(cGetReady, p, nil^);
1393 LogChanges;
1394 CL.Put(sTurn, 0, 0, nil);
1395 BeforeTurn0;
1396 NoLogCityTileChanges;
1397 GenerateStat(pTurn);
1398 nLogOpened := -1;
1399 LastEndClientCommand := -1;
1400 bix[0].Client(cShowGame, 0, nil^);
1401 Notify(ntBackOff);
1402 Inform(pTurn);
1403 ChangeClientWhenDone(cTurn, 0, nil^, 0)
1404end;
1405
1406procedure DirectHelp(Command: integer);
1407begin
1408 InitBrain(BrainTerm);
1409 BrainTerm.Client(Command, -1, nil^);
1410 AICredits := #0;
1411end;
1412
1413procedure EditMap(const Map: string; Newlx, Newly, NewLandMass: integer);
1414var
1415 p1, Loc1: integer;
1416 Game: TNewGameData;
1417begin
1418 Notify(ntStartDone);
1419 Notify(ntInitLocalHuman);
1420 MapFileName := Map;
1421 lx := Newlx;
1422 ly := Newly;
1423 MapSize := lx * ly;
1424 LandMass := NewLandMass;
1425 bix[0] := BrainTerm;
1426 Difficulty[0] := 0;
1427 InitBrain(BrainTerm);
1428
1429 DelphiRandomize;
1430 GAlive := 0;
1431 GWatching := 1;
1432 if not LoadMap(MapFileName) then
1433 for Loc1 := 0 to MapSize - 1 do
1434 RealMap[Loc1] := fOcean or ($F shl 27);
1435 CL := nil;
1436 InitMapEditor;
1437 RW[0].Data := nil;
1438 RW[0].BorderHelper := nil;
1439 RW[0].Alive := 0;
1440 Game.lx := lx;
1441 Game.ly := ly;
1442 Game.RO[0] := @RW[0];
1443 Game.Difficulty[0] := 0;
1444 for p1 := 1 to nPl - 1 do
1445 begin
1446 Game.RO[p1] := nil;
1447 Game.Difficulty[p1] := -1
1448 end;
1449 BrainTerm.Client(cNewMap, -1, Game);
1450
1451 DiscoverAll(0, lObserveSuper);
1452 Notify(ntEndInfo);
1453 bix[0].Client(cShowGame, 0, nil^);
1454 Notify(ntBackOff);
1455 ChangeClientWhenDone(cEditMap, 0, nil^, 0)
1456end;
1457
1458procedure DestroySpacePort_TellPlayers(p, pCapturer: integer);
1459var
1460 cix, i, p1: integer;
1461 ShowShipChange: TShowShipChange;
1462begin
1463 // stop ship part production
1464 for cix := 0 to RW[p].nCity - 1 do
1465 with RW[p].City[cix] do
1466 if (Loc >= 0) and (Project and cpImp <> 0) and
1467 ((Project and cpIndex = woMIR) or
1468 (Imp[Project and cpIndex].Kind = ikShipPart)) then
1469 begin
1470 inc(RW[p].Money, Prod0);
1471 Prod := 0;
1472 Prod0 := 0;
1473 Project := cpImp + imTrGoods;
1474 Project0 := cpImp + imTrGoods
1475 end;
1476
1477 // destroy ship
1478 with GShip[p] do
1479 if Parts[0] + Parts[1] + Parts[2] > 0 then
1480 begin
1481 for i := 0 to nShipPart - 1 do
1482 begin
1483 ShowShipChange.Ship1Change[i] := -Parts[i];
1484 if pCapturer >= 0 then
1485 begin
1486 ShowShipChange.Ship2Change[i] := Parts[i];
1487 inc(GShip[pCapturer].Parts[i], Parts[i]);
1488 end;
1489 Parts[i] := 0;
1490 end;
1491 if Mode >= moMovie then
1492 begin
1493 if pCapturer >= 0 then
1494 ShowShipChange.Reason := scrCapture
1495 else
1496 ShowShipChange.Reason := scrDestruction;
1497 ShowShipChange.Ship1Owner := p;
1498 ShowShipChange.Ship2Owner := pCapturer;
1499 for p1 := 0 to nPl - 1 do
1500 if 1 shl p1 and (GAlive or GWatching) <> 0 then
1501 begin
1502 move(GShip, RW[p1].Ship, SizeOf(GShip));
1503 if 1 shl p1 and GWatching <> 0 then
1504 CallPlayer(cShowShipChange, p1, ShowShipChange);
1505 end;
1506 end
1507 end
1508end;
1509
1510procedure DestroyCity_TellPlayers(p, cix: integer; SaveUnits: boolean);
1511begin
1512 if RW[p].City[cix].built[imSpacePort] > 0 then
1513 DestroySpacePort_TellPlayers(p, -1);
1514 DestroyCity(p, cix, SaveUnits);
1515end;
1516
1517procedure ChangeCityOwner_TellPlayers(pOld, cixOld, pNew: integer);
1518begin
1519 if RW[pOld].City[cixOld].built[imSpacePort] > 0 then
1520 if RW[pNew].NatBuilt[imSpacePort] > 0 then
1521 DestroySpacePort_TellPlayers(pOld, pNew)
1522 else
1523 DestroySpacePort_TellPlayers(pOld, -1);
1524 ChangeCityOwner(pOld, cixOld, pNew);
1525end;
1526
1527procedure CheckWin(p: integer);
1528var
1529 i: integer;
1530 ShipComplete: boolean;
1531begin
1532 ShipComplete := true;
1533 for i := 0 to nShipPart - 1 do
1534 if GShip[p].Parts[i] < ShipNeed[i] then
1535 ShipComplete := false;
1536 if ShipComplete then
1537 GWinner := GWinner or 1 shl p; // game won!
1538end;
1539
1540procedure BeforeTurn;
1541var
1542 i, p1, uix, cix, V21, Loc1, Cost, Job0, nAlive, nAppliers, ad, OldLoc,
1543 SiegedTiles, nUpdateLoc: integer;
1544 UpdateLoc: array [0 .. numax - 1] of integer;
1545 Radius: TVicinity21Loc;
1546 ShowShipChange: TShowShipChange;
1547 TribeExtinct, JobDone, MirBuilt: boolean;
1548begin
1549{$IFOPT O-}assert(1 shl pTurn and InvalidTreatyMap = 0); {$ENDIF}
1550 assert(1 shl pTurn and (GAlive or GWatching) <> 0);
1551 if (1 shl pTurn and GAlive = 0) and (Difficulty[pTurn] > 0) then
1552 exit;
1553
1554 if (GWonder[woGrLibrary].EffectiveOwner = pTurn) and (GWinner = 0) then
1555 begin // check great library effect
1556 nAlive := 0;
1557 for p1 := 0 to nPl - 1 do
1558 if 1 shl p1 and GAlive <> 0 then
1559 inc(nAlive);
1560 ad := 0;
1561 while ad <= (nAdv - 5) do begin
1562 if RW[pTurn].Tech[ad] < tsSeen then
1563 begin
1564 nAppliers := 0;
1565 for p1 := 0 to nPl - 1 do
1566 if (p1 <> pTurn) and (1 shl p1 and GAlive <> 0) and
1567 (RW[p1].Tech[ad] >= tsApplicable) then
1568 inc(nAppliers);
1569 if nAppliers * 2 > nAlive then
1570 begin
1571 SeeTech(pTurn, ad);
1572 inc(nTech[pTurn]);
1573 if Mode >= moMovie then
1574 CallPlayer(cShowGreatLibTech, pTurn, ad);
1575 // do not call CallPlayer(pTurn) while map is invalid
1576 end;
1577 end;
1578 Inc(ad);
1579 end;
1580 end;
1581
1582 MaskD(ObserveLevel, MapSize, not Cardinal(3 shl (2 * pTurn)));
1583 if Mode > moLoading_Fast then
1584 MaskD(RW[pTurn].Map^, MapSize, Cardinal(not Cardinal(fUnit or fHiddenUnit or
1585 fStealthUnit or fObserved or fSpiedOut or fOwned or fOwnZoCUnit or
1586 fInEnemyZoC)));
1587 RW[pTurn].nEnemyUn := 0;
1588
1589 MirBuilt := false;
1590 if (Difficulty[pTurn] > 0) and (GWinner = 0) then
1591 with RW[pTurn] do
1592 begin
1593 if nCity > 0 then
1594 for p1 := 0 to nPl - 1 do
1595 if GTurn = EvaStart[p1] + PeaceEvaTurns then
1596 begin // peace contract -- remove all units from p1's territory
1597 Loc1 := City[0].Loc; // search destination for homeless units
1598 for cix := 1 to nCity - 1 do
1599 if (City[cix].Loc >= 0) and
1600 ((Loc1 < 0) or (City[cix].built[imPalace] > 0)) then
1601 Loc1 := City[cix].Loc;
1602 for uix := 0 to nUn - 1 do
1603 with Un[uix] do
1604 if (Loc >= 0) and (Model[mix].Kind <> mkDiplomat) and
1605 ((Home >= 0) or (Loc1 >= 0)) and
1606 (RealMap[Loc] shr 27 = Cardinal(p1)) then
1607 begin
1608 OldLoc := Loc;
1609 if Master >= 0 then
1610 begin // transport unload
1611 if Model[mix].Domain = dAir then
1612 dec(Un[Master].AirLoad)
1613 else
1614 dec(Un[Master].TroopLoad);
1615 Master := -1;
1616 end
1617 else
1618 FreeUnit(pTurn, uix);
1619
1620 if Home >= 0 then
1621 Loc := City[Home].Loc
1622 else
1623 Loc := Loc1;
1624 PlaceUnit(pTurn, uix);
1625 UpdateUnitMap(OldLoc);
1626 UpdateUnitMap(Loc);
1627 Flags := Flags or unWithdrawn;
1628 Happened := Happened or phPeaceEvacuation;
1629 end
1630 end;
1631
1632 if Mode >= moMovie then
1633 FillChar(ShowShipChange, SizeOf(ShowShipChange), 0);
1634 TribeExtinct := true;
1635 nUpdateLoc := 0;
1636 for cix := 0 to nCity - 1 do
1637 with City[cix] do
1638 if Loc >= 0 then
1639 begin { next turn for all cities - city loop 1 }
1640 // if ServerVersion[pTurn]>=$000EF0 then
1641 // Flags:=Flags and (chFounded or chCaptured or chProductionSabotaged or chDisorder)
1642 // else Flags:=Flags and (chCaptured or chProductionSabotaged or chDisorder);
1643 // check for siege
1644 SiegedTiles := 0;
1645 V21_to_Loc(Loc, Radius);
1646 for V21 := 1 to 26 do
1647 if Tiles and (1 shl V21) and not(1 shl CityOwnTile) <> 0 then
1648 begin
1649 Loc1 := Radius[V21];
1650 assert((Loc1 >= 0) and (Loc1 < MapSize) and
1651 (UsedByCity[Loc1] = Loc));
1652 p1 := RealMap[Loc1] shr 27;
1653 if (RealMap[Loc1] and fCity <> 0) or (p1 < nPl) and
1654 (p1 <> pTurn) and (RW[pTurn].Treaty[p1] >= trPeace) or
1655 (ZoCMap[Loc1] > 0) and (Occupant[Loc1] <> pTurn) and
1656 (Treaty[Occupant[Loc1]] < trPeace) then
1657 begin
1658 Tiles := Tiles and not(1 shl V21);
1659 UsedByCity[Loc1] := -1;
1660 Flags := Flags or chSiege;
1661 inc(SiegedTiles);
1662 end;
1663 end;
1664 while SiegedTiles > 0 do // replace sieged tiles
1665 begin
1666 if not AddBestCityTile(pTurn, cix) then
1667 Break;
1668 dec(SiegedTiles);
1669 end;
1670
1671 if Flags and chFounded = 0 then
1672 begin
1673 // CollectCityResources(pTurn,cix); // old style
1674
1675 if CityTurn(pTurn, cix) then
1676 TribeExtinct := false
1677 else
1678 begin // city is erased
1679 RemoveDomainUnits(dSea, pTurn, Loc);
1680 RemoveDomainUnits(dAir, pTurn, Loc);
1681 Map[Loc] := Map[Loc] and not fCity; // !!! do this in inner core
1682 UpdateLoc[nUpdateLoc] := Loc;
1683 inc(nUpdateLoc);
1684 DestroyCity_TellPlayers(pTurn, cix, true);
1685 end;
1686
1687 if (Flags and chProduction <> 0) and (Project0 and cpImp <> 0)
1688 then
1689 begin
1690 if Project0 and cpIndex = woMIR then // MIR completed
1691 MirBuilt := true
1692 else if Project0 and cpIndex = woManhattan then
1693 GColdWarStart := GTurn
1694 else if Imp[Project0 and cpIndex].Kind = ikShipPart
1695 then { ship parts produced }
1696 inc(ShowShipChange.Ship1Change[Project0 and cpIndex -
1697 imShipComp]);
1698 end
1699 end
1700 end; { city loop 1 }
1701 if nUpdateLoc > 0 then
1702 begin
1703 CheckBorders(-1, pTurn);
1704 for i := 0 to nUpdateLoc - 1 do
1705 UpdateUnitMap(UpdateLoc[i], true);
1706 if Mode >= moMovie then
1707 for p1 := 0 to nPl - 1 do
1708 if (1 shl p1 and GWatching <> 0) and (p1 <> pTurn) then
1709 for i := 0 to nUpdateLoc - 1 do
1710 if ObserveLevel[UpdateLoc[i]] shr (2 * p1) and 3 >= lObserveUnhidden
1711 then
1712 CallPlayer(cShowCityChanged, p1, UpdateLoc[i]);
1713 end;
1714
1715 for uix := 0 to nUn - 1 do
1716 with Un[uix] do
1717 if Loc >= 0 then
1718 begin // unit loop 2
1719 if Health < 100 then
1720 Recover(pTurn, uix);
1721
1722 if Flags and unMountainDelay <> 0 then
1723 begin
1724 Movement := 0;
1725 Flags := Flags and not unMountainDelay
1726 end
1727 else
1728 Movement := UnitSpeed(pTurn, mix, Health); { refresh movement }
1729
1730 assert(Loc >= 0);
1731 if Model[mix].Kind <> mkDiplomat then
1732 begin // check treaty violation
1733 p1 := RealMap[Loc] shr 27;
1734 if (p1 < nPl) and (p1 <> pTurn) and (Treaty[p1] >= trPeace) then
1735 begin
1736 if (Job in [jCity, jPillage, jClear, jAfforest, jTrans]) or
1737 (Job in [jIrr, jMine, jFort, jBase]) and
1738 (RealMap[Loc] and fTerImp <> 0) then
1739 Job := jNone;
1740 if (GTurn > EvaStart[p1] + PeaceEvaTurns) and
1741 (Treaty[p1] <> trAlliance) then
1742 begin
1743 EvaStart[p1] := GTurn;
1744 Happened := Happened or phPeaceViolation;
1745 if Mode >= moMovie then
1746 CallPlayer(cShowPeaceViolation, p1, pTurn);
1747 end;
1748 end;
1749 end;
1750
1751 if ServerVersion[pTurn] >= $000EF0 then
1752 begin
1753 if (Health <= 0) or TribeExtinct then
1754 RemoveUnit_UpdateMap(pTurn, uix);
1755 end
1756 end;
1757
1758 if ServerVersion[pTurn] < $000EF0 then
1759 for uix := 0 to nUn - 1 do
1760 with Un[uix] do
1761 if Loc >= 0 then
1762 begin // unit loop 3
1763 Loc1 := Loc;
1764 Job0 := Job;
1765 if Job <> jNone then
1766 JobDone := Work(pTurn, uix);
1767 { settlers do terrain improvement jobs }
1768 if (Health <= 0) or TribeExtinct then
1769 RemoveUnit_UpdateMap(pTurn, uix);
1770
1771 if (Job0 = jCity) and JobDone then // new city
1772 begin
1773 AddBestCityTile(pTurn, RW[pTurn].nCity - 1);
1774 UpdateUnitMap(Loc1, true);
1775 if Mode >= moMovie then // tell enemies
1776 for p1 := 0 to nPl - 1 do
1777 if (1 shl p1 and GWatching <> 0) and (p1 <> pTurn) and
1778 (ObserveLevel[Loc1] and (3 shl (2 * p1)) > 0) then
1779 CallPlayer(cShowCityChanged, p1, Loc1);
1780 end
1781 end;
1782
1783 { pollution - city loop 3 }
1784 for cix := 0 to nCity - 1 do
1785 with City[cix] do
1786 if (Loc >= 0) and (Pollution >= MaxPollution) then
1787 Pollute(pTurn, cix);
1788
1789 CompactLists(pTurn);
1790 if (nUn = 0) and (nCity = 0) then
1791 begin // nation made extinct
1792 Happened := Happened or phExtinct;
1793 GAlive := GAlive and not(1 shl pTurn);
1794 Stat[stPop, pTurn, GTurn] := 0;
1795 Stat[stMil, pTurn, GTurn] := 0;
1796 Stat[stScience, pTurn, GTurn] := 0;
1797 Stat[stExplore, pTurn, GTurn] := 0;
1798 Stat[stTerritory, pTurn, GTurn] := 0;
1799 Stat[stWork, pTurn, GTurn] := 0;
1800 for p1 := 0 to nPl - 1 do
1801 if 1 shl p1 and (GAlive or GWatching) <> 0 then
1802 begin
1803 if p1 <> pTurn then
1804 begin
1805 GiveCivilReport(p1, pTurn);
1806 if (GTestFlags and tfUncover <> 0) or (Difficulty[p1] = 0) or
1807 (RW[p1].Treaty[pTurn] = trAlliance) then
1808 GiveMilReport(p1, pTurn);
1809 end;
1810 with RW[p1] do
1811 begin
1812 Alive := GAlive;
1813 for Loc1 := 0 to MapSize - 1 do
1814 if Territory[Loc1] = pTurn then
1815 // remove territory of extinct nation from player maps
1816 begin
1817 Territory[Loc1] := -1;
1818 Map[Loc1] := Map[Loc1] and not fPeace
1819 end
1820 end;
1821 end;
1822 exit
1823 end;
1824
1825 // check research
1826 Cost := TechCost(pTurn);
1827 if GTestFlags and tfImmAdvance <> 0 then
1828 Research := Cost;
1829 if (Happened and phTech = 0) and (Research >= Cost) then
1830 begin
1831 if ResearchTech = adMilitary then
1832 EnableDevModel(pTurn) { new Unit class initiated }
1833 else if ResearchTech >= 0 then
1834 DiscoverTech(pTurn, ResearchTech);
1835
1836 dec(Research, Cost);
1837 Happened := Happened or phTech;
1838 ResearchTech := -1
1839 end
1840 else if (ResearchTech = -2) and (nCity > 0) then
1841 begin
1842 Happened := Happened or phTech;
1843 ResearchTech := -1
1844 end;
1845
1846 if Credibility < MaxCredibility then
1847 for p1 := 0 to nPl - 1 do
1848 if (p1 <> pTurn) and (1 shl p1 and GAlive <> 0) and
1849 (Treaty[p1] >= trPeace) then
1850 begin
1851 inc(Credibility);
1852 Break
1853 end;
1854
1855 if GWinner = 0 then
1856 CheckWin(pTurn);
1857 if (Mode >= moMovie) and (GWinner = 0) and
1858 ((ShowShipChange.Ship1Change[0] > 0) or
1859 (ShowShipChange.Ship1Change[1] > 0) or
1860 (ShowShipChange.Ship1Change[2] > 0)) then
1861 begin
1862 ShowShipChange.Reason := scrProduction;
1863 ShowShipChange.Ship1Owner := pTurn;
1864 ShowShipChange.Ship2Owner := -1;
1865 for p1 := 0 to nPl - 1 do
1866 if (p1 <> pTurn) and (1 shl p1 and (GAlive or GWatching) <> 0) then
1867 begin
1868 move(GShip, RW[p1].Ship, SizeOf(GShip));
1869 if 1 shl p1 and GWatching <> 0 then
1870 CallPlayer(cShowShipChange, p1, ShowShipChange);
1871 end
1872 end;
1873 if WinOnAlone and (GAlive and not(1 shl pTurn or 1) = 0) then
1874 GWinner := 1 shl pTurn; // break if only one nation left
1875
1876 if GTurn = AnarchyStart + AnarchyTurns then
1877 begin
1878 AnarchyStart := -AnarchyTurns - 1;
1879 Government := gDespotism;
1880 for p1 := 0 to nPl - 1 do
1881 if (p1 <> pTurn) and ((GAlive or GWatching) and (1 shl p1) <> 0) then
1882 RW[p1].EnemyReport[pTurn].Government := gDespotism;
1883 inc(Happened, phChangeGov)
1884 end;
1885 end; // if Difficulty[pTurn]>0
1886
1887 if (pTurn = 0) and (GWinner > 0) then
1888 begin // game over, give world map and all reports to player 0
1889 DiscoverAll(pTurn, lObserveSuper);
1890 for p1 := 1 to nPl - 1 do
1891 if 1 shl p1 and GAlive <> 0 then
1892 begin
1893 if RW[pTurn].Treaty[p1] < trNone then
1894 begin
1895 RW[pTurn].Treaty[p1] := trNone;
1896 RW[p1].Treaty[pTurn] := trNone;
1897 end;
1898 GiveCivilReport(pTurn, p1);
1899 GiveMilReport(pTurn, p1);
1900 end;
1901 end
1902 else
1903 begin
1904 // show observed areas
1905 if (GTestFlags and tfUncover <> 0) or (Difficulty[pTurn] = 0)
1906 then { supervisor - all tiles visible }
1907 begin
1908 if (bix[pTurn].Kind <> btNoTerm) and
1909 ((Difficulty[pTurn] > 0) or (Mode > moLoading_Fast)) then
1910 DiscoverAll(pTurn, lObserveSuper)
1911 end
1912 else
1913 begin
1914 DiscoverViewAreas(pTurn);
1915 if MirBuilt then
1916 DiscoverAll(pTurn, lObserveUnhidden)
1917 end
1918 end;
1919 // CheckContact;
1920end; { BeforeTurn }
1921
1922procedure AfterTurn;
1923var
1924 cix, uix, p1, Loc1, Job0: integer;
1925 JobDone: boolean;
1926begin
1927 with RW[pTurn] do
1928 begin
1929 for cix := 0 to nCity - 1 do
1930 if City[cix].Loc >= 0 then
1931 begin
1932 // City[cix].Flags:=City[cix].Flags and not chProductionSabotaged;
1933 City[cix].Flags := City[cix].Flags and (chCaptured or chDisorder);
1934 CollectCityResources(pTurn, cix); // new style
1935 end;
1936
1937 inc(Money, OracleIncome);
1938 OracleIncome := 0;
1939 if GWonder[woOracle].EffectiveOwner = pTurn then
1940 begin
1941 for p1 := 0 to nPl - 1 do
1942 if (1 shl p1 and GAlive <> 0) and
1943 ((p1 = pTurn) or (RW[pTurn].Treaty[p1] > trNoContact)) then
1944 for cix := 0 to RW[p1].nCity - 1 do
1945 if (RW[p1].City[cix].Loc >= 0) and
1946 (RW[p1].City[cix].built[imTemple] > 0) then
1947 inc(OracleIncome);
1948 end;
1949
1950 if (GTestFlags and tfImmImprove = 0) and (Government <> gAnarchy) then
1951 for cix := 0 to nCity - 1 do
1952 if (City[cix].Loc >= 0) and (City[cix].Flags and chCaptured = 0) then
1953 PayCityMaintenance(pTurn, cix);
1954
1955 if ServerVersion[pTurn] >= $000EF0 then
1956 begin // let settlers work
1957 for cix := 0 to nCity - 1 do
1958 City[cix].Flags := City[cix].Flags and not chFounded;
1959 for uix := 0 to nUn - 1 do
1960 with Un[uix] do
1961 if Loc >= 0 then
1962 begin
1963 Loc1 := Loc;
1964 Job0 := Job;
1965 if Job <> jNone then
1966 JobDone := Work(pTurn, uix);
1967 { settlers do terrain improvement jobs }
1968 if Health <= 0 then
1969 RemoveUnit_UpdateMap(pTurn, uix);
1970
1971 if (Job0 = jCity) and JobDone then // new city
1972 begin
1973 AddBestCityTile(pTurn, RW[pTurn].nCity - 1);
1974 UpdateUnitMap(Loc1, true);
1975 if Mode >= moMovie then // tell enemies
1976 for p1 := 0 to nPl - 1 do
1977 if (1 shl p1 and GWatching <> 0) and (p1 <> pTurn) and
1978 (ObserveLevel[Loc1] and (3 shl (2 * p1)) > 0) then
1979 CallPlayer(cShowCityChanged, p1, Loc1);
1980 end
1981 end;
1982 end;
1983
1984 for uix := 0 to nUn - 1 do
1985 with Un[uix] do
1986 if Loc >= 0 then
1987 begin { next turn for all units }
1988 if Model[mix].Domain = dAir then
1989 if (Master >= 0) or (RealMap[Loc] and fCity <> 0) or
1990 (RealMap[Loc] and fTerImp = tiBase) then
1991 begin
1992 Fuel := Model[mix].Cap[mcFuel];
1993 Flags := Flags or unBombsLoaded
1994 end
1995 else if Model[mix].Kind = mkSpecial_Glider then { glider }
1996 begin
1997 if RealMap[Loc] and fTerrain < fGrass then
1998 begin
1999 RemoveUnit_UpdateMap(pTurn, uix); // unit lost
2000 Happened := Happened or phGliderLost
2001 end
2002 end
2003 else
2004 begin
2005 dec(Fuel);
2006 if Fuel < 0 then
2007 begin
2008 RemoveUnit_UpdateMap(pTurn, uix); // unit lost
2009 Happened := Happened or phPlaneLost
2010 end
2011 end
2012 else if (Master < 0) and (Movement > 0) then // check HostileDamage
2013 begin
2014 Health := Health - HostileDamage(pTurn, mix, Loc, Movement);
2015 if Health < 0 then
2016 RemoveUnit_UpdateMap(pTurn, uix);
2017 end
2018 end; { unit loop 1 }
2019
2020 for uix := 0 to nUn - 1 do
2021 with Un[uix] do
2022 begin
2023 Flags := Flags and not unWithdrawn;
2024 if (Loc >= 0) and (Model[mix].Domain = dGround) and (Master < 0) and
2025 ((integer(Movement) = Model[mix].Speed) or
2026 (Model[mix].Cap[mcAcademy] > 0) and (Movement * 2 >= Model[mix].Speed))
2027 then
2028 Flags := Flags or unFortified; // fortify unmoved units
2029 end;
2030
2031 if (GTestFlags and tfUncover = 0) and (Difficulty[pTurn] > 0) then
2032 begin // restrict view area to current positions
2033 MaskD(ObserveLevel, MapSize, not Cardinal(3 shl (2 * pTurn)));
2034 if Mode > moLoading_Fast then
2035 MaskD(RW[pTurn].Map^, MapSize, Cardinal(not Cardinal(fUnit or fHiddenUnit or
2036 fStealthUnit or fObserved or fSpiedOut or fOwned or fOwnZoCUnit or
2037 fInEnemyZoC)));
2038 RW[pTurn].nEnemyUn := 0;
2039 DiscoverViewAreas(pTurn);
2040 end;
2041
2042 if GWinner = 0 then
2043 for p1 := 0 to nPl - 1 do
2044 if 1 shl p1 and GAlive <> 0 then
2045 CheckWin(p1);
2046 end;
2047end; // Afterturn
2048
2049procedure NextPlayer;
2050begin
2051 if GTurn = 0 then
2052 BeforeTurn0
2053 else
2054 BeforeTurn;
2055 NoLogCityTileChanges;
2056 GenerateStat(pTurn);
2057 Inform(pTurn);
2058 ChangeClient;
2059end;
2060
2061function ExecuteMove(p, uix, ToLoc: integer; var MoveInfo: TMoveInfo;
2062 ShowMove: TShowMove): integer;
2063var
2064 i, p1, FromLoc, uix1, nUpdateLoc: integer;
2065 MinLevel, MissionResult: Cardinal;
2066 PModel: ^TModel;
2067 UpdateLoc: array [0 .. numax - 1] of integer;
2068 SeeFrom, SeeTo, ExtDiscover: boolean;
2069begin
2070 result := 0;
2071 with RW[p], Un[uix] do
2072 begin
2073 PModel := @Model[mix];
2074 FromLoc := Loc;
2075
2076 if Master < 0 then
2077 FreeUnit(p, uix);
2078 if (MoveInfo.MoveType in [mtMove, mtCapture]) and MoveInfo.MountainDelay
2079 then
2080 begin
2081 Flags := Flags or unMountainDelay;
2082 end;
2083 Loc := -2;
2084 if TroopLoad + AirLoad > 0 then
2085 for i := 0 to nUn - 1 do
2086 if (Un[i].Loc >= 0) and (Un[i].Master = uix) then
2087 Un[i].Loc := -2;
2088 UpdateUnitMap(FromLoc);
2089
2090 if Mode >= moMovie then { show move in interface modules }
2091 begin
2092 ShowMove.EndHealth := MoveInfo.EndHealth;
2093 ShowMove.EndHealthDef := -1;
2094 if Master >= 0 then
2095 if Model[Un[Master].mix].Domain = dAir then
2096 ShowMove.Flags := ShowMove.Flags or umPlaneUnloading
2097 else
2098 ShowMove.Flags := ShowMove.Flags or umShipUnloading;
2099 if MoveInfo.ToMaster >= 0 then
2100 if Model[Un[MoveInfo.ToMaster].mix].Domain = dAir then
2101 ShowMove.Flags := ShowMove.Flags or umPlaneLoading
2102 else
2103 ShowMove.Flags := ShowMove.Flags or umShipLoading;
2104 for p1 := 0 to nPl - 1 do
2105 if (1 shl p1 and GWatching <> 0) and ((p1 <> p) or (bix[p1].Kind = btTerm))
2106 then
2107 begin
2108 if PModel.Cap[mcStealth] > 0 then
2109 MinLevel := lObserveSuper
2110 else if PModel.Cap[mcSub] > 0 then
2111 MinLevel := lObserveAll
2112 else
2113 MinLevel := lObserveUnhidden;
2114 SeeFrom := (p1 = p) or (ObserveLevel[FromLoc] shr (2 * p1) and
2115 3 >= MinLevel);
2116 SeeTo := (p1 = p) or (ObserveLevel[ToLoc] shr (2 * p1) and
2117 3 >= MinLevel);
2118 if SeeFrom and SeeTo then
2119 begin
2120 TellAboutModel(p1, p, mix);
2121 if p1 = p then
2122 ShowMove.emix := -1
2123 else
2124 ShowMove.emix := emixSafe(p1, p, mix);
2125 if MoveInfo.MoveType = mtCapture then
2126 CallPlayer(cShowCapturing, p1, ShowMove)
2127 else
2128 CallPlayer(cShowMoving, p1, ShowMove);
2129 end
2130 else if SeeFrom then
2131 CallPlayer(cShowUnitChanged, p1, FromLoc);
2132 end;
2133 end;
2134
2135 if MoveInfo.MoveType <> mtSpyMission then
2136 Loc := ToLoc;
2137 if TroopLoad + AirLoad > 0 then
2138 for i := 0 to nUn - 1 do
2139 if Un[i].Loc = -2 then
2140 Un[i].Loc := ToLoc;
2141
2142 ExtDiscover := false;
2143 nUpdateLoc := 0;
2144 if MoveInfo.MoveType = mtCapture then
2145 begin
2146 assert(Occupant[ToLoc] < 0);
2147 for uix1 := 0 to RW[MoveInfo.Defender].nUn - 1 do
2148 with RW[MoveInfo.Defender].Un[uix1] do
2149 if (Loc >= 0) and (Home = MoveInfo.Dcix) then
2150 begin
2151 UpdateLoc[nUpdateLoc] := Loc;
2152 inc(nUpdateLoc)
2153 end;
2154 // unit will be removed -- remember position and update for all players
2155
2156 if (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size > 2) and (nCity < ncmax)
2157 then
2158 begin // city captured
2159 ChangeCityOwner_TellPlayers(MoveInfo.Defender, MoveInfo.Dcix, p);
2160 City[nCity - 1].Flags := CaptureTurns shl 16;
2161 CityShrink(p, nCity - 1);
2162 if Mode = moPlaying then
2163 with RW[p].City[nCity - 1] do
2164 begin
2165 // SavedResourceWeights[nCity-1]:=ResourceWeights;
2166 SavedTiles[nCity - 1] := Tiles;
2167 end;
2168 ExtDiscover := true;
2169
2170 // Temple of Zeus effect
2171 if GWonder[woZeus].EffectiveOwner = p then
2172 begin
2173 GiveCivilReport(p, MoveInfo.Defender);
2174 for i := 0 to nAdv - 1 do
2175 if not(i in FutureTech) and (RW[p].Tech[i] < tsSeen) and
2176 (RW[MoveInfo.Defender].Tech[i] >= tsApplicable) then
2177 begin
2178 Happened := Happened or phStealTech;
2179 GStealFrom := MoveInfo.Defender;
2180 Break
2181 end
2182 end;
2183 if Mode = moPlaying then
2184 LogCheckBorders(p, nCity - 1, MoveInfo.Defender);
2185{$IFOPT O-} if Mode < moPlaying then
2186 InvalidTreatyMap := not(1 shl p); {$ENDIF}
2187 // territory should not be considered for the rest of the command
2188 // execution, because during loading a game it's incorrect before
2189 // subsequent sIntExpandTerritory is processed
2190 end
2191 else // city destroyed
2192 begin
2193 DestroyCity_TellPlayers(MoveInfo.Defender, MoveInfo.Dcix, false);
2194 CheckBorders(ToLoc, MoveInfo.Defender);
2195 end;
2196 RecalcPeaceMap(p);
2197 if Mode >= moMovie then
2198 move(GWonder, Wonder, SizeOf(GWonder));
2199 end; { if MoveInfo.MoveType=mtCapture }
2200
2201 if MoveInfo.MoveType = mtSpyMission then
2202 begin
2203 MissionResult := DoSpyMission(p, MoveInfo.Defender, MoveInfo.Dcix,
2204 SpyMission);
2205 if (Mode = moPlaying) and (SpyMission = smStealForeignReports) then
2206 CallPlayer(cShowMissionResult, p, MissionResult);
2207 end;
2208
2209 Health := MoveInfo.EndHealth;
2210 dec(Movement, MoveInfo.Cost);
2211 // transport unload
2212 if Master >= 0 then
2213 begin
2214 if PModel.Domain = dAir then
2215 dec(Un[Master].AirLoad)
2216 else
2217 begin
2218 dec(Un[Master].TroopLoad);
2219 assert(Movement <= 0);
2220 end;
2221 Master := -1;
2222 end;
2223
2224 if (Health <= 0) or (MoveInfo.MoveType = mtSpyMission) then
2225 RemoveUnit(p, uix) // spy mission or victim of HostileDamage
2226 else
2227 begin // transport load
2228 Master := MoveInfo.ToMaster;
2229 if MoveInfo.ToMaster >= 0 then
2230 begin
2231 if PModel.Domain = dAir then
2232 inc(Un[MoveInfo.ToMaster].AirLoad)
2233 else
2234 inc(Un[MoveInfo.ToMaster].TroopLoad);
2235 end
2236 else
2237 PlaceUnit(p, uix);
2238 end;
2239
2240 if (MoveInfo.MoveType = mtCapture) and (nUpdateLoc > 0) then
2241 RecalcMapZoC(p);
2242 UpdateUnitMap(ToLoc, MoveInfo.MoveType = mtCapture);
2243 for i := 0 to nUpdateLoc - 1 do
2244 UpdateUnitMap(UpdateLoc[i]);
2245 // tell about lost units of defender
2246
2247 if (MoveInfo.MoveType <> mtSpyMission) and (Master < 0) then
2248 begin
2249 if (PModel.Kind = mkDiplomat) or (PModel.Domain = dAir) or
2250 (PModel.Cap[mcRadar] + PModel.Cap[mcCarrier] + PModel.Cap[mcAcademy] >
2251 0) or (RealMap[ToLoc] and fTerrain = fMountains) or
2252 (RealMap[ToLoc] and fTerImp = tiFort) or
2253 (RealMap[ToLoc] and fTerImp = tiBase) then
2254 ExtDiscover := true;
2255 if (PModel.Kind = mkDiplomat) or (PModel.Cap[mcSpy] > 0) then
2256 i := lObserveSuper
2257 else if (PModel.Domain = dAir) or
2258 (PModel.Cap[mcRadar] + PModel.Cap[mcCarrier] > 0) then
2259 i := lObserveAll
2260 else
2261 i := lObserveUnhidden;
2262 if ExtDiscover then
2263 begin
2264 if Discover21(ToLoc, p, i, true, PModel.Domain = dGround) then
2265 result := result or rEnemySpotted;
2266 end
2267 else
2268 begin
2269 if Discover9(ToLoc, p, i, true, PModel.Domain = dGround) then
2270 result := result or rEnemySpotted;
2271 end;
2272 end;
2273
2274 if Mode >= moMovie then { show after-move in interface modules }
2275 for p1 := 0 to nPl - 1 do
2276 if (1 shl p1 and GWatching <> 0) and ((p1 <> p) or (bix[p1].Kind = btTerm))
2277 then
2278 begin
2279 if PModel.Cap[mcStealth] > 0 then
2280 MinLevel := lObserveSuper
2281 else if PModel.Cap[mcSub] > 0 then
2282 MinLevel := lObserveAll
2283 else
2284 MinLevel := lObserveUnhidden;
2285 SeeFrom := (p1 = p) or (ObserveLevel[FromLoc] shr (2 * p1) and
2286 3 >= MinLevel);
2287 SeeTo := (p1 = p) or (ObserveLevel[ToLoc] shr (2 * p1) and
2288 3 >= MinLevel);
2289 if SeeTo and (MoveInfo.MoveType = mtCapture) then
2290 CallPlayer(cShowCityChanged, p1, ToLoc);
2291 if SeeFrom and SeeTo then
2292 CallPlayer(cShowAfterMove, p1, ToLoc)
2293 else if (MoveInfo.MoveType <> mtSpyMission) and SeeTo then
2294 CallPlayer(cShowUnitChanged, p1, ToLoc);
2295 for i := 0 to nUpdateLoc - 1 do
2296 if ObserveLevel[UpdateLoc[i]] shr (2 * p1) and 3 >= lObserveUnhidden
2297 then
2298 CallPlayer(cShowUnitChanged, p1, UpdateLoc[i]);
2299 end;
2300 end;
2301end; // ExecuteMove
2302
2303function ExecuteAttack(p, uix, ToLoc: integer; var MoveInfo: TMoveInfo;
2304 ShowMove: TShowMove): integer;
2305
2306 procedure WriteBattleHistory(ToLoc, FromLoc, Attacker, Defender, mixAttacker,
2307 mixDefender: integer; AttackerLost, DefenderLost: boolean);
2308 var
2309 AttackerBattle, DefenderBattle: ^TBattle;
2310 begin
2311 with RW[Attacker] do
2312 begin
2313 if nBattleHistory = 0 then
2314 ReallocMem(BattleHistory, 16 * SizeOf(TBattle))
2315 else if (nBattleHistory >= 16) and
2316 (nBattleHistory and (nBattleHistory - 1) = 0) then
2317 ReallocMem(BattleHistory, nBattleHistory * (2 * SizeOf(TBattle)));
2318 AttackerBattle := @BattleHistory[nBattleHistory];
2319 inc(nBattleHistory);
2320 end;
2321 with RW[Defender] do
2322 begin
2323 if nBattleHistory = 0 then
2324 ReallocMem(BattleHistory, 16 * SizeOf(TBattle))
2325 else if (nBattleHistory >= 16) and
2326 (nBattleHistory and (nBattleHistory - 1) = 0) then
2327 ReallocMem(BattleHistory, nBattleHistory * (2 * SizeOf(TBattle)));
2328 DefenderBattle := @BattleHistory[nBattleHistory];
2329 inc(nBattleHistory);
2330 end;
2331 AttackerBattle.Enemy := Defender;
2332 AttackerBattle.Flags := 0;
2333 AttackerBattle.Turn := GTurn;
2334 AttackerBattle.mix := mixAttacker;
2335 AttackerBattle.mixEnemy := mixDefender;
2336 AttackerBattle.ToLoc := ToLoc;
2337 AttackerBattle.FromLoc := FromLoc;
2338 DefenderBattle.Enemy := Attacker;
2339 DefenderBattle.Flags := bhEnemyAttack;
2340 DefenderBattle.Turn := GTurn;
2341 DefenderBattle.mix := mixDefender;
2342 DefenderBattle.mixEnemy := mixAttacker;
2343 DefenderBattle.ToLoc := ToLoc;
2344 DefenderBattle.FromLoc := FromLoc;
2345 if AttackerLost then
2346 begin
2347 AttackerBattle.Flags := AttackerBattle.Flags or bhMyUnitLost;
2348 DefenderBattle.Flags := DefenderBattle.Flags or bhEnemyUnitLost;
2349 end;
2350 if DefenderLost then
2351 begin
2352 AttackerBattle.Flags := AttackerBattle.Flags or bhEnemyUnitLost;
2353 DefenderBattle.Flags := DefenderBattle.Flags or bhMyUnitLost;
2354 end;
2355 end;
2356
2357var
2358 i, p1, FromLoc, uix1, nUpdateLoc, ExpGain, ExpelToLoc, cix1: integer;
2359 PModel: ^TModel;
2360 UpdateLoc: array [0 .. numax - 1] of integer;
2361 LoseCityPop, CityDestroyed, SeeFrom, SeeTo, ZoCDefenderDestroyed: boolean;
2362begin
2363 result := 0;
2364 with RW[p].Un[uix] do
2365 begin
2366 PModel := @RW[p].Model[mix];
2367 FromLoc := Loc;
2368
2369 ShowMove.EndHealth := MoveInfo.EndHealth;
2370 ShowMove.EndHealthDef := MoveInfo.EndHealthDef;
2371 if MoveInfo.MoveType = mtAttack then
2372 WriteBattleHistory(ToLoc, FromLoc, p, MoveInfo.Defender, mix,
2373 RW[MoveInfo.Defender].Un[MoveInfo.Duix].mix, MoveInfo.EndHealth <= 0,
2374 MoveInfo.EndHealthDef <= 0);
2375
2376 { if RW[p].Treaty[MoveInfo.Defender]=trCeaseFire then
2377 begin
2378 if Mode>=moMovie then
2379 CallPlayer(cShowCancelTreaty,MoveInfo.Defender,p);
2380 CancelTreaty(p,MoveInfo.Defender)
2381 end; }
2382 if Mode >= moMovie then { show attack in interface modules }
2383 for p1 := 0 to nPl - 1 do
2384 if (1 shl p1 and GWatching <> 0) and ((p1 <> p) or (bix[p1].Kind = btTerm))
2385 then
2386 begin
2387 SeeFrom := ObserveLevel[FromLoc] shr (2 * p1) and
2388 3 >= lObserveUnhidden;
2389 SeeTo := ObserveLevel[ToLoc] shr (2 * p1) and 3 >= lObserveUnhidden;
2390 if SeeFrom and SeeTo then
2391 begin
2392 TellAboutModel(p1, p, mix);
2393 if p1 = p then
2394 ShowMove.emix := -1
2395 else
2396 ShowMove.emix := emixSafe(p1, p, mix);
2397 CallPlayer(cShowAttacking, p1, ShowMove);
2398 end;
2399 end;
2400
2401 LoseCityPop := false;
2402 if (RealMap[ToLoc] and fCity <> 0) and
2403 ((MoveInfo.MoveType = mtAttack) and (MoveInfo.EndHealthDef <= 0) or
2404 (MoveInfo.MoveType = mtBombard) and (BombardmentDestroysCity or
2405 (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size > 2))) then
2406 case PModel.Domain of
2407 dGround:
2408 LoseCityPop := (PModel.Cap[mcArtillery] > 0) or
2409 (RW[MoveInfo.Defender].City[MoveInfo.Dcix].built[imWalls] = 0) and
2410 (Continent[ToLoc] <> GrWallContinent[MoveInfo.Defender]);
2411 dSea:
2412 LoseCityPop := RW[MoveInfo.Defender].City[MoveInfo.Dcix].built
2413 [imCoastalFort] = 0;
2414 dAir:
2415 LoseCityPop := RW[MoveInfo.Defender].City[MoveInfo.Dcix].built
2416 [imMissileBat] = 0;
2417 end;
2418 CityDestroyed := LoseCityPop and
2419 (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size <= 2);
2420
2421 if MoveInfo.MoveType = mtBombard then
2422 begin
2423 assert(Movement >= 100);
2424 if PModel.Attack = 0 then
2425 Flags := Flags and not unBombsLoaded;
2426 dec(Movement, 100)
2427 end
2428 else if MoveInfo.MoveType = mtExpel then
2429 begin
2430 assert(Movement >= 100);
2431 Job := jNone;
2432 Flags := Flags and not unFortified;
2433 dec(Movement, 100)
2434 end
2435 else
2436 begin
2437 assert(MoveInfo.MoveType = mtAttack);
2438 if MoveInfo.EndHealth = 0 then
2439 RemoveUnit(p, uix, MoveInfo.Defender) // destroy attacker
2440 else
2441 begin // update attacker
2442 ExpGain := (Health - MoveInfo.EndHealth + 1) shr 1;
2443 if Exp + ExpGain > (nExp - 1) * ExpCost then
2444 Exp := (nExp - 1) * ExpCost
2445 else
2446 inc(Exp, ExpGain);
2447 Health := MoveInfo.EndHealth;
2448 Job := jNone;
2449 if RW[MoveInfo.Defender].Model[RW[MoveInfo.Defender].Un[MoveInfo.Duix]
2450 .mix].Domain < dAir then
2451 Flags := Flags and not unBombsLoaded;
2452 Flags := Flags and not unFortified;
2453 if Movement > 100 then
2454 dec(Movement, 100)
2455 else
2456 Movement := 0;
2457 end;
2458 end;
2459
2460 ZoCDefenderDestroyed := false;
2461 nUpdateLoc := 0;
2462 if MoveInfo.MoveType = mtExpel then
2463 with RW[MoveInfo.Defender], Un[MoveInfo.Duix] do
2464 begin // expel friendly unit
2465 if Home >= 0 then
2466 ExpelToLoc := City[Home].Loc
2467 else
2468 begin
2469 ExpelToLoc := City[0].Loc; // search destination for homeless units
2470 for cix1 := 1 to nCity - 1 do
2471 if (City[cix1].Loc >= 0) and
2472 ((ExpelToLoc < 0) or (City[cix1].built[imPalace] > 0)) then
2473 ExpelToLoc := City[cix1].Loc;
2474 end;
2475 if ExpelToLoc >= 0 then
2476 begin
2477 FreeUnit(MoveInfo.Defender, MoveInfo.Duix);
2478 Loc := ExpelToLoc;
2479 PlaceUnit(MoveInfo.Defender, MoveInfo.Duix);
2480 UpdateLoc[nUpdateLoc] := Loc;
2481 inc(nUpdateLoc);
2482 Flags := Flags or unWithdrawn;
2483 end
2484 end
2485 else if (MoveInfo.MoveType = mtAttack) and (MoveInfo.EndHealthDef > 0) then
2486 with RW[MoveInfo.Defender].Un[MoveInfo.Duix] do
2487 begin // update defender
2488 ExpGain := (Health - MoveInfo.EndHealthDef + 1) shr 1;
2489 if Exp + ExpGain > (nExp - 1) * ExpCost then
2490 Exp := (nExp - 1) * ExpCost
2491 else
2492 inc(Exp, ExpGain);
2493 Health := MoveInfo.EndHealthDef;
2494 end
2495 else
2496 begin // destroy defenders
2497 if MoveInfo.MoveType <> mtBombard then
2498 begin
2499 ZoCDefenderDestroyed := RW[MoveInfo.Defender].Model
2500 [RW[MoveInfo.Defender].Un[MoveInfo.Duix].mix].Flags and mdZOC <> 0;
2501 if ((RealMap[ToLoc] and fCity = 0) and
2502 (RealMap[ToLoc] and fTerImp <> tiBase) and
2503 (RealMap[ToLoc] and fTerImp <> tiFort)) or LoseCityPop and
2504 (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size = 2) then
2505 RemoveAllUnits(MoveInfo.Defender, ToLoc, p)
2506 { no city, base or fortress }
2507 else
2508 RemoveUnit(MoveInfo.Defender, MoveInfo.Duix, p);
2509 end;
2510
2511 if LoseCityPop then // city defender defeated -- shrink city
2512 if not CityDestroyed then
2513 CityShrink(MoveInfo.Defender, MoveInfo.Dcix)
2514 else
2515 begin
2516 for uix1 := 0 to RW[MoveInfo.Defender].nUn - 1 do
2517 with RW[MoveInfo.Defender].Un[uix1] do
2518 if (Loc >= 0) and (Home = MoveInfo.Dcix) then
2519 begin
2520 UpdateLoc[nUpdateLoc] := Loc;
2521 inc(nUpdateLoc)
2522 end;
2523 // unit will be removed -- remember position and update for all players
2524 DestroyCity_TellPlayers(MoveInfo.Defender, MoveInfo.Dcix, false);
2525 CheckBorders(ToLoc, MoveInfo.Defender);
2526 RecalcPeaceMap(p);
2527 end;
2528 end;
2529
2530 if CityDestroyed and (nUpdateLoc > 0) then
2531 RecalcMapZoC(p)
2532 else if ZoCDefenderDestroyed then
2533 RecalcV8ZoC(p, ToLoc);
2534 UpdateUnitMap(FromLoc);
2535 UpdateUnitMap(ToLoc, LoseCityPop);
2536 for i := 0 to nUpdateLoc - 1 do
2537 UpdateUnitMap(UpdateLoc[i]);
2538 // tell about lost units of defender
2539
2540 if Mode >= moMovie then
2541 begin
2542 for i := 0 to RW[p].nEnemyModel - 1 do
2543 with RW[p].EnemyModel[i] do
2544 Lost := Destroyed[p, Owner, mix];
2545 for p1 := 0 to nPl - 1 do { show after-attack in interface modules }
2546 if (1 shl p1 and GWatching <> 0) and ((p1 <> p) or (bix[p1].Kind = btTerm))
2547 then
2548 begin
2549 SeeFrom := ObserveLevel[FromLoc] shr (2 * p1) and
2550 3 >= lObserveUnhidden;
2551 SeeTo := ObserveLevel[ToLoc] shr (2 * p1) and 3 >= lObserveUnhidden;
2552 if SeeTo and CityDestroyed then
2553 CallPlayer(cShowCityChanged, p1, ToLoc); // city was destroyed
2554 if SeeFrom and SeeTo then
2555 begin
2556 CallPlayer(cShowAfterAttack, p1, ToLoc);
2557 CallPlayer(cShowAfterAttack, p1, FromLoc);
2558 end
2559 else
2560 begin
2561 if SeeTo then
2562 CallPlayer(cShowUnitChanged, p1, ToLoc);
2563 if SeeFrom then
2564 CallPlayer(cShowUnitChanged, p1, FromLoc);
2565 end;
2566 if SeeTo and (MoveInfo.MoveType = mtExpel) and (ExpelToLoc >= 0) then
2567 CallPlayer(cShowUnitChanged, p1, ExpelToLoc);
2568 end;
2569 end
2570 end
2571end; // ExecuteAttack
2572
2573function MoveUnit(p, uix, dx, dy: integer; TestOnly: boolean): integer;
2574var
2575 ToLoc: integer;
2576 MoveInfo: TMoveInfo;
2577 ShowMove: TShowMove;
2578begin
2579{$IFOPT O-}assert(1 shl p and InvalidTreatyMap = 0); {$ENDIF}
2580 with RW[p].Un[uix] do
2581 begin
2582 ToLoc := dLoc(Loc, dx, dy);
2583 if (ToLoc < 0) or (ToLoc >= MapSize) then
2584 begin
2585 result := eInvalid;
2586 exit
2587 end;
2588 result := CalculateMove(p, uix, ToLoc, 3 - dy and 1, TestOnly, MoveInfo);
2589 if result = eZOC_EnemySpotted then
2590 ZOCTile := ToLoc;
2591 if (result >= rExecuted) and not TestOnly then
2592 begin
2593 ShowMove.dx := dx;
2594 ShowMove.dy := dy;
2595 ShowMove.FromLoc := Loc;
2596 ShowMove.mix := mix;
2597 ShowMove.Health := Health;
2598 ShowMove.Fuel := Fuel;
2599 ShowMove.Exp := Exp;
2600 ShowMove.Load := TroopLoad + AirLoad;
2601 ShowMove.Owner := p;
2602 if (TroopLoad > 0) or (AirLoad > 0) then
2603 ShowMove.Flags := unMulti
2604 else
2605 ShowMove.Flags := 0;
2606 case MoveInfo.MoveType of
2607 mtCapture:
2608 ShowMove.Flags := ShowMove.Flags or umCapturing;
2609 mtSpyMission:
2610 ShowMove.Flags := ShowMove.Flags or umSpyMission;
2611 mtBombard:
2612 ShowMove.Flags := ShowMove.Flags or umBombarding;
2613 mtExpel:
2614 ShowMove.Flags := ShowMove.Flags or umExpelling;
2615 end;
2616 case MoveInfo.MoveType of
2617 mtMove, mtCapture, mtSpyMission:
2618 result := ExecuteMove(p, uix, ToLoc, MoveInfo, ShowMove) or result;
2619 mtAttack, mtBombard, mtExpel:
2620 result := ExecuteAttack(p, uix, ToLoc, MoveInfo, ShowMove) or result
2621 end;
2622 end
2623 end; // with
2624end; { MoveUnit }
2625
2626function Server(Command, Player, Subject: integer; var Data): integer; stdcall;
2627
2628 function CountPrice(const Offer: TOffer; PriceType: integer): integer;
2629 var
2630 i: integer;
2631 begin
2632 result := 0;
2633 for i := 0 to Offer.nDeliver + Offer.nCost - 1 do
2634 if Offer.Price[i] and $FFFF0000 = Cardinal(PriceType) then
2635 inc(result);
2636 end;
2637
2638{ procedure UpdateBorderHelper;
2639 var
2640 x, y, Loc, Loc1, dx, dy, ObserveMask: integer;
2641 begin
2642 ObserveMask:=3 shl (2*pTurn);
2643 for x:=0 to lx-1 do for y:=0 to ly shr 1-1 do
2644 begin
2645 Loc:=lx*(y*2)+x;
2646 if ObserveLevel[Loc] and ObserveMask<>0 then
2647 begin
2648 for dy:=0 to 1 do for dx:=0 to 1 do
2649 begin
2650 Loc1:=(Loc+dx-1+lx) mod lx +lx*((y+dy)*2-1);
2651 if (Loc1>=0) and (Loc1<MapSize)
2652 and (ObserveLevel[Loc1] and ObserveMask<>0) then
2653 if RealMap[Loc1] and $78000000=RealMap[Loc] and $78000000 then
2654 begin
2655 RW[pTurn].BorderHelper[Loc]:=RW[pTurn].BorderHelper[Loc] and not (1 shl (dy*2+dx));
2656 RW[pTurn].BorderHelper[Loc1]:=RW[pTurn].BorderHelper[Loc1] and not (8 shr (dy*2+dx))
2657 end
2658 else
2659 begin
2660 RW[pTurn].BorderHelper[Loc]:=RW[pTurn].BorderHelper[Loc] or (1 shl (dy*2+dx));
2661 RW[pTurn].BorderHelper[Loc1]:=RW[pTurn].BorderHelper[Loc1] or (8 shr (dy*2+dx));
2662 end
2663 end
2664 end
2665 end
2666 end; }
2667
2668const
2669 ptSelect = 0;
2670 ptTrGoods = 1;
2671 ptUn = 2;
2672 ptCaravan = 3;
2673 ptImp = 4;
2674 ptWonder = 6;
2675 ptShip = 7;
2676 ptInvalid = 8;
2677
2678 function ProjectType(Project: integer): integer;
2679 begin
2680 if Project and cpCompleted <> 0 then
2681 result := ptSelect
2682 else if Project and (cpImp + cpIndex) = cpImp + imTrGoods then
2683 result := ptTrGoods
2684 else if Project and cpImp = 0 then
2685 if RW[Player].Model[Project and cpIndex].Kind = mkCaravan then
2686 result := ptCaravan
2687 else
2688 result := ptUn
2689 else if Project and cpIndex >= nImp then
2690 result := ptInvalid
2691 else if Imp[Project and cpIndex].Kind = ikWonder then
2692 result := ptWonder
2693 else if Imp[Project and cpIndex].Kind = ikShipPart then
2694 result := ptShip
2695 else
2696 result := ptImp
2697 end;
2698
2699var
2700 d, i, j, p1, p2, pt0, pt1, uix1, cix1, Loc0, Loc1, dx, dy, NewCap, MinCap,
2701 MaxCap, CapWeight, Cost, NextProd, Preq, TotalFood, TotalProd, CheckSum,
2702 StopTurn, FutureMCost, NewProject, OldImp, mix, V8, V21, AStr, DStr,
2703 ABaseDamage, DBaseDamage: integer;
2704 CityReport: TCityReport;
2705 FormerCLState: TCmdListState;
2706 Adjacent: TVicinity8Loc;
2707 Radius: TVicinity21Loc;
2708 ShowShipChange: TShowShipChange;
2709 ShowNegoData: TShowNegoData;
2710 logged, ok, HasShipChanged, AllHumansDead, OfferFullySupported: boolean;
2711
2712begin { >>>server }
2713 if Command = sTurn then
2714 begin
2715 p2 := -1;
2716 for p1 := 0 to nPl - 1 do
2717 if (p1 <> Player) and (1 shl p1 and GWatching <> 0) then
2718 CallPlayer(cShowTurnChange, p1, p2);
2719 end;
2720
2721 assert(MapSize = lx * ly);
2722 assert(Command and (sctMask or sExecute) <> sctInternal or sExecute);
2723 // not for internal commands
2724 if (Command < 0) or (Command >= $10000) then
2725 begin
2726 result := eUnknown;
2727 exit
2728 end;
2729
2730 if (Player < 0) or (Player >= nPl) or
2731 ((Command and (sctMask or sExecute) <> sctInfo) and
2732 ((Subject < 0) or (Subject >= $1000))) then
2733 begin
2734 result := eInvalid;
2735 exit
2736 end;
2737
2738 if (1 shl Player and (GAlive or GWatching) = 0) and
2739 not((Command = sTurn) or (Command = sBreak) or (Command = sResign) or
2740 (Command = sGetAIInfo) or (Command = sGetAICredits) or
2741 (Command = sGetVersion) or (Command and $FF0F = sGetChart)) then
2742 begin
2743 PutMessage(1 shl 16 + 1, Format('NOT Alive: %d', [Player]));
2744 result := eNoTurn;
2745 exit
2746 end;
2747
2748 result := eOK;
2749
2750 // check if command allowed now
2751 if (Mode = moPlaying) and not((Command >= cClientEx) or (Command = sMessage)
2752 or (Command = sSetDebugMap) or (Command = sGetDebugMap) or
2753 (Command = sGetAIInfo) or (Command = sGetAICredits) or
2754 (Command = sGetVersion) or (Command = sGetTechCost) or
2755 (Command = sGetDefender) or (Command = sGetUnitReport) or
2756 (Command = sGetCityReport) or (Command = sGetCityTileInfo) or
2757 (Command = sGetCity) or (Command = sGetEnemyCityReport) or
2758 (Command = sGetEnemyCityAreaInfo) or (Command = sGetCityReportNew) or
2759 (Command and $FF0F = sGetChart) or (Command and $FF0F = sSetAttitude))
2760 // commands always allowed
2761 and not((Player = pTurn) and (Command < $1000))
2762 // info request always allowed for pTurn
2763 and ((pDipActive < 0) and (Player <> pTurn) // not his turn
2764 or (pDipActive >= 0) and (Player <> pDipActive)
2765 // not active in negotiation mode
2766 or (pDipActive >= 0) and (Command and sctMask <> sctEndClient)) then
2767 // no nego command
2768 begin
2769 PutMessage(1 shl 16 + 1, Format('No Turn: %d calls %x',
2770 [Player, Command shr 4]));
2771 result := eNoTurn;
2772 exit
2773 end;
2774
2775 // do not use EXIT hereafter!
2776
2777{$IFOPT O-}
2778 HandoverStack[nHandoverStack] := Player + $1000;
2779 HandoverStack[nHandoverStack + 1] := Command;
2780 inc(nHandoverStack, 2);
2781
2782 InvalidTreatyMap := 0;
2783 // new command, sIntExpandTerritory of previous command was processed
2784{$ENDIF}
2785 if (Mode = moPlaying) and (Command >= sExecute) and
2786 ((Command and sctMask <> sctEndClient) or (Command = sTurn)) and
2787 (Command and sctMask <> sctModel) and (Command <> sCancelTreaty) and
2788 (Command <> sSetCityTiles) and (Command <> sBuyCityProject) and
2789 ((Command < cClientEx) or ProcessClientData[Player]) then
2790 begin { log command }
2791 FormerCLState := CL.State;
2792 CL.Put(Command, Player, Subject, @Data);
2793 logged := true;
2794 end
2795 else
2796 logged := false;
2797
2798 case Command of
2799
2800 {
2801 Info Request Commands
2802 ____________________________________________________________________
2803 }
2804 sMessage:
2805 bix[0].Client(cDebugMessage, Subject, Data);
2806
2807 sSetDebugMap:
2808 DebugMap[Player] := @Data;
2809
2810 sGetDebugMap:
2811 pointer(Data) := DebugMap[Subject];
2812
2813 { sChangeSuperView:
2814 if Difficulty[Player]=0 then
2815 begin
2816 for i:=0 to nBrain-1 do if Brain[i].Initialized then
2817 CallClient(i, cShowSuperView, Subject)
2818 end
2819 else result:=eInvalid; }
2820
2821 sRefreshDebugMap:
2822 bix[0].Client(cRefreshDebugMap, -1, Player);
2823
2824 sGetChart .. sGetChart + (nStat - 1) shl 4:
2825 if (Subject >= 0) and (Subject < nPl) and Assigned(bix[Subject]) then
2826 begin
2827 StopTurn := 0;
2828 if (Difficulty[Player] = 0) or (GTestFlags and tfUncover <> 0)
2829 // supervisor
2830 or (Subject = Player) // own chart
2831 or (GWinner > 0) // game end chart
2832 or (1 shl Subject and GAlive = 0) then // chart of extinct nation
2833 if Subject > Player then
2834 StopTurn := GTurn
2835 else
2836 StopTurn := GTurn + 1
2837 else if RW[Player].Treaty[Subject] > trNoContact then
2838 if Command shr 4 and $F = stMil then
2839 StopTurn := RW[Player].EnemyReport[Subject].TurnOfMilReport + 1
2840 else
2841 StopTurn := RW[Player].EnemyReport[Subject].TurnOfCivilReport + 1;
2842 move(Stat[Command shr 4 and $F, Subject]^, Data,
2843 StopTurn * SizeOf(integer));
2844 FillChar(TChart(Data)[StopTurn], (GTurn - StopTurn) *
2845 SizeOf(integer), 0);
2846 end
2847 else
2848 result := eInvalid;
2849
2850 sGetTechCost:
2851 integer(Data) := TechCost(Player);
2852
2853 sGetAIInfo:
2854 if AIInfo[Subject] = '' then
2855 pchar(Data) := nil
2856 else
2857 pchar(Data) := @AIInfo[Subject][1];
2858
2859 sGetAICredits:
2860 if AICredits = '' then
2861 pchar(Data) := nil
2862 else
2863 pchar(Data) := @AICredits[1];
2864
2865 sGetVersion:
2866 integer(Data) := Version;
2867
2868 sGetGameChanged:
2869 if Player <> 0 then
2870 result := eInvalid
2871 else if (CL <> nil) and (CL.State.nLog = nLogOpened) and
2872 (CL.State.MoveCode = 0) and not HasCityTileChanges and
2873 not HasChanges(Player) then
2874 result := eNotChanged;
2875
2876 sGetTileInfo:
2877 if (Subject >= 0) and (Subject < MapSize) then
2878 result := GetTileInfo(Player, -2, Subject, TTileInfo(Data))
2879 else
2880 result := eInvalid;
2881
2882 sGetCityTileInfo:
2883 if (Subject >= 0) and (Subject < MapSize) then
2884 result := GetTileInfo(Player, -1, Subject, TTileInfo(Data))
2885 else
2886 result := eInvalid;
2887
2888 sGetHypoCityTileInfo:
2889 if (Subject >= 0) and (Subject < MapSize) then
2890 begin
2891 if (TTileInfo(Data).ExplCity < 0) or
2892 (TTileInfo(Data).ExplCity >= RW[Player].nCity) then
2893 result := eInvalid
2894 else if ObserveLevel[Subject] shr (Player * 2) and 3 = 0 then
2895 result := eNoPreq
2896 else
2897 result := GetTileInfo(Player, TTileInfo(Data).ExplCity, Subject,
2898 TTileInfo(Data))
2899 end
2900 else
2901 result := eInvalid;
2902
2903 sGetJobProgress:
2904 if (Subject >= 0) and (Subject < MapSize) then
2905 begin
2906 if ObserveLevel[Subject] shr (Player * 2) and 3 = 0 then
2907 result := eNoPreq
2908 else
2909 result := GetJobProgress(Player, Subject, TJobProgressData(Data))
2910 end
2911 else
2912 result := eInvalid;
2913
2914 sGetModels:
2915 if (GTestFlags and tfUncover <> 0) or (Difficulty[Player] = 0)
2916 then { supervisor only command }
2917 begin
2918 for p1 := 0 to nPl - 1 do
2919 if (p1 <> Player) and (1 shl p1 and GAlive <> 0) then
2920 for mix := 0 to RW[p1].nModel - 1 do
2921 TellAboutModel(Player, p1, mix);
2922 end
2923 else
2924 result := eInvalid;
2925
2926 sGetUnits:
2927 if (Subject >= 0) and (Subject < MapSize) and
2928 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) then
2929 integer(Data) := GetUnitStack(Player, Subject)
2930 else
2931 result := eNoPreq;
2932
2933 sGetDefender:
2934 if (Subject >= 0) and (Subject < MapSize) and (Occupant[Subject] = Player)
2935 then
2936 Strongest(Subject, integer(Data), d, i, j)
2937 else
2938 result := eInvalid;
2939
2940 sGetBattleForecast, sGetBattleForecastEx:
2941 if (Subject >= 0) and (Subject < MapSize) and
2942 (ObserveLevel[Subject] and (3 shl (Player * 2)) > 0) then
2943 with TBattleForecast(Data) do
2944 if (1 shl pAtt and GAlive <> 0) and (mixAtt >= 0) and
2945 (mixAtt < RW[pAtt].nModel) and
2946 ((pAtt = Player) or (RWemix[Player, pAtt, mixAtt] >= 0)) then
2947 begin
2948 result := GetBattleForecast(Subject, TBattleForecast(Data), uix1,
2949 cix1, AStr, DStr, ABaseDamage, DBaseDamage);
2950 if Command = sGetBattleForecastEx then
2951 begin
2952 TBattleForecastEx(Data).AStr := (AStr + 200) div 400;
2953 TBattleForecastEx(Data).DStr := (DStr + 200) div 400;
2954 TBattleForecastEx(Data).ABaseDamage := ABaseDamage;
2955 TBattleForecastEx(Data).DBaseDamage := DBaseDamage;
2956 end;
2957 if result = eOK then
2958 result := eInvalid // no enemy unit there!
2959 end
2960 else
2961 result := eInvalid
2962 else
2963 result := eInvalid;
2964
2965 sGetUnitReport:
2966 if (Subject < 0) or (Subject >= RW[Player].nUn) or
2967 (RW[Player].Un[Subject].Loc < 0) then
2968 result := eInvalid
2969 else
2970 GetUnitReport(Player, Subject, TUnitReport(Data));
2971
2972 sGetMoveAdvice:
2973 if (Subject < 0) or (Subject >= RW[Player].nUn) or
2974 (RW[Player].Un[Subject].Loc < 0) then
2975 result := eInvalid
2976 else
2977 result := GetMoveAdvice(Player, Subject, TMoveAdviceData(Data));
2978
2979 sGetPlaneReturn:
2980 if (Subject < 0) or (Subject >= RW[Player].nUn) or
2981 (RW[Player].Un[Subject].Loc < 0) or
2982 (RW[Player].Model[RW[Player].Un[Subject].mix].Domain <> dAir) then
2983 result := eInvalid
2984 else
2985 begin
2986 if CanPlaneReturn(Player, Subject, TPlaneReturnData(Data)) then
2987 result := eOK
2988 else
2989 result := eNoWay
2990 end;
2991
2992 sGetCity:
2993 if (Subject >= 0) and (Subject < MapSize) and
2994 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) and
2995 (RealMap[Subject] and fCity <> 0) then
2996 with TGetCityData(Data) do
2997 begin
2998 Owner := Player;
2999 SearchCity(Subject, Owner, cix1);
3000 c := RW[Owner].City[cix1];
3001 if (Owner <> Player) and (c.Project and cpImp = 0) then
3002 TellAboutModel(Player, Owner, c.Project and cpIndex);
3003 end
3004 else
3005 result := eInvalid;
3006
3007 sGetCityReport:
3008 if (Subject < 0) or (Subject >= RW[Player].nCity) or
3009 (RW[Player].City[Subject].Loc < 0) then
3010 result := eInvalid
3011 else
3012 result := GetCityReport(Player, Subject, TCityReport(Data));
3013
3014 sGetCityReportNew:
3015 if (Subject < 0) or (Subject >= RW[Player].nCity) or
3016 (RW[Player].City[Subject].Loc < 0) then
3017 result := eInvalid
3018 else
3019 GetCityReportNew(Player, Subject, TCityReportNew(Data));
3020
3021 sGetCityAreaInfo:
3022 if (Subject < 0) or (Subject >= RW[Player].nCity) or
3023 (RW[Player].City[Subject].Loc < 0) then
3024 result := eInvalid
3025 else
3026 GetCityAreaInfo(Player, RW[Player].City[Subject].Loc,
3027 TCityAreaInfo(Data));
3028
3029 sGetEnemyCityReport:
3030 if (Subject >= 0) and (Subject < MapSize) and
3031 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) and
3032 (RealMap[Subject] and fCity <> 0) then
3033 begin
3034 p1 := Occupant[Subject];
3035 if p1 < 0 then
3036 p1 := 1;
3037 SearchCity(Subject, p1, cix1);
3038 TCityReport(Data).HypoTiles := -1;
3039 TCityReport(Data).HypoTax := -1;
3040 TCityReport(Data).HypoLux := -1;
3041 GetCityReport(p1, cix1, TCityReport(Data))
3042 end
3043 else
3044 result := eInvalid;
3045
3046 sGetEnemyCityReportNew:
3047 if (Subject >= 0) and (Subject < MapSize) and
3048 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) and
3049 (RealMap[Subject] and fCity <> 0) then
3050 begin
3051 p1 := Occupant[Subject];
3052 if p1 < 0 then
3053 p1 := 1;
3054 SearchCity(Subject, p1, cix1);
3055 TCityReport(Data).HypoTiles := -1;
3056 TCityReport(Data).HypoTax := -1;
3057 TCityReport(Data).HypoLux := -1;
3058 GetCityReportNew(p1, cix1, TCityReportNew(Data));
3059 end
3060 else
3061 result := eInvalid;
3062
3063 sGetEnemyCityAreaInfo:
3064 if (Subject >= 0) and (Subject < MapSize) and
3065 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) and
3066 (RealMap[Subject] and fCity <> 0) then
3067 begin
3068 p1 := Occupant[Subject];
3069 if p1 < 0 then
3070 p1 := 1;
3071 SearchCity(Subject, p1, cix1);
3072 GetCityAreaInfo(p1, Subject, TCityAreaInfo(Data))
3073 end
3074 else
3075 result := eInvalid;
3076
3077 sGetCityTileAdvice:
3078 if (Subject < 0) or (Subject >= RW[Player].nCity) or
3079 (RW[Player].City[Subject].Loc < 0) then
3080 result := eInvalid
3081 else
3082 GetCityTileAdvice(Player, Subject, TCityTileAdviceData(Data));
3083
3084 {
3085 Map Editor Commands
3086 ____________________________________________________________________
3087 }
3088 sEditTile:
3089 if Player = 0 then
3090 with TEditTileData(Data) do
3091 EditTile(Loc, NewTile)
3092 else
3093 result := eInvalid;
3094
3095 sRandomMap:
3096 if (Player = 0) and MapGeneratorAvailable then
3097 begin
3098 CreateElevation;
3099 PreviewElevation := false;
3100 CreateMap(false);
3101 FillChar(ObserveLevel, MapSize * 4, 0);
3102 DiscoverAll(Player, lObserveSuper);
3103 end
3104 else
3105 result := eInvalid;
3106
3107 sMapGeneratorRequest:
3108 if not MapGeneratorAvailable then
3109 result := eInvalid;
3110
3111 {
3112 Client Deactivation Commands
3113 ____________________________________________________________________
3114 }
3115 sTurn, sTurn - sExecute:
3116 begin
3117 AllHumansDead := true;
3118 for p1 := 0 to nPl - 1 do
3119 if (1 shl p1 and GAlive <> 0) and (bix[p1].Kind = btTerm) then
3120 AllHumansDead := false;
3121 if (pDipActive >= 0) // still in negotiation mode
3122 or (pTurn = 0) and ((GWinner > 0) or (GTurn = MaxTurn) or
3123 (Difficulty[0] > 0) and AllHumansDead) then // game end reached
3124 result := eViolation
3125 else if Command >= sExecute then
3126 begin
3127 if Mode = moPlaying then
3128 begin
3129 CL.State := FormerCLState;
3130 LogCityTileChanges;
3131{$IFNDEF SCR}
3132 if pTurn = 0 then
3133 begin
3134 LogChanges;
3135 SaveGame('~' + LogFileName, true);
3136 end
3137{$ENDIF}
3138 end
3139 else if (Mode = moMovie) and (pTurn = 0) then
3140 CallPlayer(cMovieEndTurn, 0, nil^);
3141 GWatching := GWatching and GAlive or 1;
3142 RW[pTurn].Happened := 0;
3143 uixSelectedTransport := -1;
3144 SpyMission := smSabotageProd;
3145 if 1 shl pTurn and GAlive <> 0 then
3146 begin
3147 // calculate checksum
3148 TotalFood := 0;
3149 TotalProd := 0;
3150 for i := 0 to RW[pTurn].nCity - 1 do
3151 if RW[pTurn].City[i].Loc >= 0 then
3152 begin
3153 inc(TotalFood, RW[pTurn].City[i].Food);
3154 inc(TotalProd, RW[pTurn].City[i].Prod);
3155 end;
3156 CheckSum := TotalFood and 7 + TotalProd and 7 shl 3 +
3157 RW[pTurn].Money and 7 shl 6 + Worked[pTurn] div 100 and 7 shl 9;
3158 end
3159 else
3160 CheckSum := 0;
3161
3162 if Mode < moPlaying then // check checksum
3163 begin
3164 if CheckSum <> Subject then
3165 LoadOK := false
3166 end
3167 else // save checksum
3168 CL.Put(Command, Player, CheckSum, @Data);
3169{$IFDEF TEXTLOG}
3170 CmdInfo := '';
3171 if CheckSum and 7 <> Subject and 7 then
3172 CmdInfo := Format('***ERROR (Food %d) ',
3173 [(CheckSum and 7 - Subject and 7 + 12) mod 8 - 4]) + CmdInfo;
3174 if CheckSum shr 3 and 7 <> Subject shr 3 and 7 then
3175 CmdInfo := '***ERROR (Prod) ' + CmdInfo;
3176 if CheckSum shr 6 and 7 <> Subject shr 6 and 7 then
3177 CmdInfo := '***ERROR (Research) ' + CmdInfo;
3178 if CheckSum shr 9 and 7 <> Subject shr 9 and 7 then
3179 CmdInfo := '***ERROR (Work) ' + CmdInfo;
3180{$ENDIF}
3181 if 1 shl pTurn and GAlive <> 0 then
3182 begin
3183 AfterTurn;
3184 if Mode < moPlaying then
3185 InsertTerritoryUpdateCommands;
3186 // if bix[pTurn]=bixTerm then UpdateBorderHelper;
3187 end;
3188
3189 repeat
3190 pTurn := (pTurn + 1) mod nPl;
3191 if pTurn = 0 then
3192 inc(GTurn);
3193 if Assigned(bix[pTurn]) and ((1 shl pTurn) and GAlive = 0) then
3194 begin // already made extinct -- continue statistics
3195 Stat[stExplore, pTurn, GTurn] := 0;
3196 Stat[stPop, pTurn, GTurn] := 0;
3197 Stat[stTerritory, pTurn, GTurn] := 0;
3198 Stat[stScience, pTurn, GTurn] := 0;
3199 Stat[stWork, pTurn, GTurn] := 0;
3200 Stat[stMil, pTurn, GTurn] := 0;
3201 end;
3202 until (pTurn = 0) or ((1 shl pTurn and (GAlive or GWatching) <> 0) and
3203 (GWinner = 0));
3204 if (Mode = moLoading_Fast) and
3205 ((GTurn = LoadTurn) or (GTurn = LoadTurn - 1) and (pTurn > 0)) then
3206 Mode := moLoading;
3207 if Mode = moPlaying then
3208 begin
3209 CCCommand := cTurn;
3210 CCPlayer := pTurn;
3211 Notify(ntNextPlayer)
3212 end
3213 else
3214 begin
3215 if GTurn = 0 then
3216 BeforeTurn0
3217 else
3218 BeforeTurn;
3219 if (Mode = moMovie) and (pTurn = 0) then
3220 begin
3221 Inform(pTurn);
3222 CallPlayer(cMovieTurn, 0, nil^);
3223 end;
3224 end;
3225{$IFDEF TEXTLOG}CmdInfo := CmdInfo + Format('---Turn %d P%d---', [GTurn, pTurn]); {$ENDIF}
3226 end;
3227 end; // sTurn
3228
3229 sBreak, sResign, sNextRound, sReload:
3230 if Mode = moMovie then
3231 MovieStopped := true
3232 else
3233 begin
3234 if Command = sReload then
3235 begin
3236 ok := (Difficulty[0] = 0) and (bix[0].Kind <> btNoTerm) and
3237 (integer(Data) >= 0) and (integer(Data) < GTurn);
3238 for p1 := 1 to nPl - 1 do
3239 if bix[p1].Kind = btTerm then
3240 ok := false;
3241 // allow reload in AI-only games only
3242 end
3243 else
3244 ok := Player = 0;
3245 if ok then
3246 begin
3247 if (Command = sBreak) or (Command = sResign) then
3248 Notify(ntBackOn);
3249 for i := 0 to Brains.Count - 1 do
3250 if Brains[i].Initialized then
3251 begin
3252 if Brains[i].Kind = btAI then
3253 Notify(ntDeinitModule + i);
3254 CallClient(i, cBreakGame, nil^);
3255 end;
3256 Notify(ntEndInfo);
3257 if (Command = sBreak) or (Command = sReload) then
3258 begin
3259 LogCityTileChanges;
3260 LogChanges;
3261 SaveGame(LogFileName, false);
3262 end;
3263 DeleteFile(SavePath + '~' + LogFileName);
3264 EndGame;
3265 case Command of
3266 sBreak:
3267 Notify(ntStartGoRefresh);
3268 sResign:
3269 Notify(ntStartGo);
3270 sNextRound:
3271 StartNewGame(SavePath, LogFileName, MapFileName, lx, ly,
3272 LandMass, MaxTurn);
3273 sReload:
3274 LoadGame(SavePath, LogFileName, integer(Data), false);
3275 end
3276 end
3277 else
3278 result := eInvalid;
3279 end;
3280
3281 sAbandonMap, sSaveMap:
3282 if Player = 0 then
3283 begin
3284 if Command = sSaveMap then
3285 SaveMap(MapFileName);
3286 Notify(ntBackOn);
3287 BrainTerm.Client(cBreakGame, -1, nil^);
3288 ReleaseMapEditor;
3289 if Command = sSaveMap then
3290 Notify(ntStartGoRefreshMaps)
3291 else
3292 Notify(ntStartGo)
3293 end
3294 else
3295 result := eInvalid;
3296
3297 scContact .. scContact + (nPl - 1) shl 4, scContact - sExecute .. scContact
3298 - sExecute + (nPl - 1) shl 4:
3299 if (pDipActive >= 0) or (1 shl (Command shr 4 and $F) and GAlive = 0) then
3300 result := eInvalid
3301 else if GWinner > 0 then
3302 result := eViolation // game end reached
3303 else if RW[Player].Treaty[Command shr 4 and $F] = trNoContact then
3304 result := eNoPreq
3305 else if GTurn < GColdWarStart + ColdWarTurns then
3306 result := eColdWar
3307 else if RW[Player].Government = gAnarchy then
3308 result := eAnarchy
3309 else if RW[Command shr 4 and $F].Government = gAnarchy then
3310 begin
3311 result := eAnarchy;
3312 LastEndClientCommand := scReject; // enable cancel treaty
3313 pContacted := Command shr 4 and $F;
3314 end
3315 else if Command >= sExecute then
3316 begin // contact request
3317 pContacted := Command shr 4 and $F;
3318 pDipActive := pContacted;
3319 assert(Mode = moPlaying);
3320 Inform(pDipActive);
3321 ChangeClientWhenDone(scContact, pDipActive, pTurn, 4);
3322 end;
3323
3324 scReject, scReject - sExecute:
3325 if LastEndClientCommand and $FF0F = scContact then
3326 begin
3327 if Command >= sExecute then
3328 begin // contact requested and not accepted yet
3329 pDipActive := -1;
3330 assert(Mode = moPlaying);
3331 ChangeClientWhenDone(cContinue, pTurn, nil^, 0);
3332 end
3333 end
3334 else
3335 result := eInvalid;
3336
3337 scDipStart, scDipStart - sExecute:
3338 if LastEndClientCommand and $FF0F = scContact then
3339 begin
3340 if Command >= sExecute then
3341 begin // accept contact
3342 pContacted := pDipActive;
3343 RW[pContacted].EnemyReport[pTurn].Credibility :=
3344 RW[pTurn].Credibility;
3345 pDipActive := pTurn;
3346 assert(Mode = moPlaying);
3347 IntServer(sIntHaveContact, pTurn, pContacted, nil^);
3348 ChangeClientWhenDone(scDipStart, pDipActive, nil^, 0);
3349 end
3350 end
3351 else
3352 result := eInvalid;
3353
3354 scDipNotice, scDipAccept, scDipCancelTreaty, scDipBreak,
3355 scDipNotice - sExecute, scDipAccept - sExecute,
3356 scDipCancelTreaty - sExecute, scDipBreak - sExecute:
3357 if pDipActive >= 0 then
3358 begin
3359 assert(Mode = moPlaying);
3360 if pDipActive = pTurn then
3361 p1 := pContacted
3362 else
3363 p1 := pTurn;
3364 if (Command and not sExecute = scDipBreak and not sExecute) and
3365 (LastEndClientCommand <> scDipBreak) then // ok
3366 else if (Command and not sExecute = scDipNotice and not sExecute) and
3367 ((LastEndClientCommand = scDipCancelTreaty) or
3368 (LastEndClientCommand = scDipBreak)) then // ok
3369 else if (Command and not sExecute = scDipAccept and not sExecute) and
3370 (LastEndClientCommand = scDipOffer) then
3371 with LastOffer do
3372 begin
3373 // check if offer can be accepted
3374 if nDeliver + nCost = 0 then
3375 result := eOfferNotAcceptable;
3376 for i := 0 to nDeliver + nCost - 1 do
3377 if Price[i] = opChoose then
3378 result := eOfferNotAcceptable;
3379 for i := 0 to nCost - 1 do
3380 if not PayPrice(pDipActive, p1, Price[nDeliver + i], false) then
3381 result := eOfferNotAcceptable;
3382 if (Command >= sExecute) and (result >= rExecuted) then
3383 begin
3384 IntServer(sIntPayPrices + nDeliver + nCost, p1, pDipActive,
3385 LastOffer);
3386 // CheckContact;
3387
3388 // tell other players about ship part trades
3389 HasShipChanged := false;
3390 FillChar(ShowShipChange, SizeOf(ShowShipChange), 0);
3391 for i := 0 to nDeliver + nCost - 1 do
3392 if Price[i] and opMask = opShipParts then
3393 begin
3394 HasShipChanged := true;
3395 if i >= nDeliver then
3396 begin // p1 has demanded from pDipActive
3397 ShowShipChange.Ship1Change[Price[i] shr 16 and 3] :=
3398 +integer(Price[i] and $FFFF);
3399 ShowShipChange.Ship2Change[Price[i] shr 16 and 3] :=
3400 -integer(Price[i] and $FFFF);
3401 end
3402 else
3403 begin // p1 has delivered to pDipActive
3404 ShowShipChange.Ship1Change[Price[i] shr 16 and 3] :=
3405 -integer(Price[i] and $FFFF);
3406 ShowShipChange.Ship2Change[Price[i] shr 16 and 3] :=
3407 +integer(Price[i] and $FFFF);
3408 end
3409 end;
3410 if HasShipChanged then
3411 begin
3412 ShowShipChange.Reason := scrTrade;
3413 ShowShipChange.Ship1Owner := p1;
3414 ShowShipChange.Ship2Owner := pDipActive;
3415 for p2 := 0 to nPl - 1 do
3416 if (p2 <> p1) and (p2 <> pDipActive) and
3417 (1 shl p2 and (GAlive or GWatching) <> 0) then
3418 begin
3419 move(GShip, RW[p2].Ship, SizeOf(GShip));
3420 if 1 shl p2 and GWatching <> 0 then
3421 CallPlayer(cShowShipChange, p2, ShowShipChange);
3422 end
3423 end
3424 end;
3425 end
3426 else if (Command and not sExecute = scDipCancelTreaty and not sExecute)
3427 and (RW[pDipActive].Treaty[p1] >= trPeace) then
3428 begin
3429 if (ServerVersion[pDipActive] >= $010100) and
3430 (GTurn < RW[pDipActive].LastCancelTreaty[p1] + CancelTreatyTurns)
3431 then
3432 result := eCancelTreatyRush
3433 else if Command >= sExecute then
3434 begin
3435 IntServer(sIntCancelTreaty, pDipActive, p1, nil^);
3436 for p2 := 0 to nPl - 1 do
3437 if (p2 <> p1) and (1 shl p2 and PeaceEnded <> 0) then
3438 begin
3439 i := p1 shl 4 + pDipActive;
3440 CallPlayer(cShowSupportAllianceAgainst, p2, i);
3441 end;
3442 for p2 := 0 to nPl - 1 do
3443 if (p2 <> p1) and (1 shl p2 and PeaceEnded <> 0) then
3444 begin
3445 i := p2;
3446 CallPlayer(cShowCancelTreatyByAlliance, pDipActive, i);
3447 end;
3448 end
3449 end
3450 else
3451 result := eInvalid;
3452 if (Command >= sExecute) and (result >= rExecuted) then
3453 if LastEndClientCommand = scDipBreak then
3454 begin // break negotiation
3455 pDipActive := -1;
3456 CallPlayer(cShowEndContact, pContacted, nil^);
3457 ChangeClientWhenDone(cContinue, pTurn, nil^, 0);
3458 end
3459 else
3460 begin
3461 if (GTestFlags and tfUncover <> 0) or (Difficulty[0] = 0) then
3462 with ShowNegoData do
3463 begin // display negotiation in log window
3464 pSender := pDipActive;
3465 pTarget := p1;
3466 Action := Command;
3467 bix[0].Client(cShowNego, 1 shl 16 + 3, ShowNegoData);
3468 end;
3469 pDipActive := p1;
3470 ChangeClientWhenDone(Command, pDipActive, nil^, 0);
3471 end
3472 end
3473 else
3474 result := eInvalid;
3475
3476 scDipOffer, scDipOffer - sExecute:
3477 if (pDipActive >= 0) and (LastEndClientCommand <> scDipCancelTreaty) and
3478 (LastEndClientCommand <> scDipBreak) then
3479 if (LastEndClientCommand = scDipOffer) and
3480 (LastOffer.nDeliver + LastOffer.nCost + TOffer(Data).nDeliver +
3481 TOffer(Data).nCost = 0) then
3482 begin
3483 if Command >= sExecute then
3484 begin // agreed discussion end
3485 pDipActive := -1;
3486 CallPlayer(cShowEndContact, pContacted, nil^);
3487 assert(Mode = moPlaying);
3488 ChangeClientWhenDone(cContinue, pTurn, nil^, 0);
3489 end
3490 end
3491 else
3492 begin
3493 // check if offer can be made
3494 if pDipActive = pTurn then
3495 p1 := pContacted
3496 else
3497 p1 := pTurn;
3498 if RW[pDipActive].Treaty[p1] < trPeace then
3499 begin // no tribute allowed!
3500 for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost - 1 do
3501 if (TOffer(Data).Price[i] and opMask = opTribute) then
3502 result := eInvalidOffer;
3503 for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost - 1 do
3504 if (TOffer(Data).Price[i] = opTreaty + trPeace) then
3505 result := eOK;
3506 end;
3507 for i := 0 to TOffer(Data).nDeliver - 1 do
3508 if (TOffer(Data).Price[i] <> opChoose) and
3509 not PayPrice(pDipActive, p1, TOffer(Data).Price[i], false) then
3510 result := eInvalidOffer;
3511 if CountPrice(TOffer(Data), opTreaty) > 1 then
3512 result := eInvalidOffer;
3513 for i := 0 to nShipPart - 1 do
3514 if CountPrice(TOffer(Data), opShipParts + i shl 16) > 1 then
3515 result := eInvalidOffer;
3516 if CountPrice(TOffer(Data), opMoney) > 1 then
3517 result := eInvalidOffer;
3518 if CountPrice(TOffer(Data), opTribute) > 1 then
3519 result := eInvalidOffer;
3520 case CountPrice(TOffer(Data), opChoose) of
3521 0:
3522 ;
3523 1:
3524 if (TOffer(Data).nCost = 0) or (TOffer(Data).nDeliver = 0) then
3525 result := eInvalidOffer;
3526 else
3527 result := eInvalidOffer;
3528 end;
3529
3530 // !!! check here if cost can be demanded
3531
3532 if (Command >= sExecute) and (result >= rExecuted) then
3533 begin
3534 OfferFullySupported := (TOffer(Data).nDeliver <= 2) and
3535 (TOffer(Data).nCost <= 2); // >2 no more allowed
3536 for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost - 1 do
3537 begin
3538 if TOffer(Data).Price[i] and opMask = opTribute then
3539 OfferFullySupported := false;
3540 // tribute no more part of the game
3541 if (TOffer(Data).Price[i] and opMask = opTreaty) and
3542 (TOffer(Data).Price[i] - opTreaty <= RW[pDipActive].Treaty[p1])
3543 then
3544 OfferFullySupported := false;
3545 // agreed treaty end no more part of the game
3546 if TOffer(Data).Price[i] = opTreaty + trCeaseFire then
3547 OfferFullySupported := false;
3548 // ceasefire no more part of the game
3549 end;
3550 if not OfferFullySupported then
3551 begin
3552 // some elements have been removed from the game -
3553 // automatically respond will null-offer
3554 LastOffer.nDeliver := 0;
3555 LastOffer.nCost := 0;
3556 ChangeClientWhenDone(scDipOffer, pDipActive, LastOffer,
3557 SizeOf(LastOffer));
3558 end
3559 else
3560 begin
3561 if (GTestFlags and tfUncover <> 0) or (Difficulty[0] = 0) then
3562 with ShowNegoData do
3563 begin // display negotiation in log window
3564 pSender := pDipActive;
3565 pTarget := p1;
3566 Action := Command;
3567 Offer := TOffer(Data);
3568 bix[0].Client(cShowNego, 1 shl 16 + 3, ShowNegoData);
3569 end;
3570 LastOffer := TOffer(Data);
3571 // show offered things to receiver
3572 for i := 0 to LastOffer.nDeliver - 1 do
3573 ShowPrice(pDipActive, p1, LastOffer.Price[i]);
3574 pDipActive := p1;
3575 assert(Mode = moPlaying);
3576 ChangeClientWhenDone(scDipOffer, pDipActive, LastOffer,
3577 SizeOf(LastOffer));
3578 end
3579 end
3580 end
3581 else
3582 result := eInvalid;
3583
3584 {
3585 General Commands
3586 ____________________________________________________________________
3587 }
3588 sClearTestFlag:
3589 if Player = 0 then
3590 begin
3591{$IFDEF TEXTLOG}CmdInfo := Format('ClearTestFlag %x', [Subject]); {$ENDIF}
3592 ClearTestFlags(Subject);
3593 end
3594 else
3595 result := eInvalid;
3596
3597 sSetTestFlag:
3598 if Player = 0 then
3599 begin
3600{$IFDEF TEXTLOG}CmdInfo := Format('SetTestFlag %x', [Subject]); {$ENDIF}
3601 SetTestFlags(Player, Subject);
3602 // CheckContact;
3603 end
3604 else
3605 result := eInvalid;
3606
3607 sSetGovernment, sSetGovernment - sExecute:
3608 begin
3609{$IFDEF TEXTLOG}CmdInfo := Format('SetGovernment P%d: %d', [Player, Subject]); {$ENDIF}
3610 if RW[Player].Happened and phChangeGov = 0 then
3611 result := eViolation
3612 else if RW[Player].Government = Subject then
3613 result := eNotChanged
3614 else if (Subject >= nGov) then
3615 result := eInvalid
3616 else if (Subject >= gMonarchy) and
3617 (RW[Player].Tech[GovPreq[Subject]] < tsApplicable) then
3618 result := eNoPreq
3619 else if Command >= sExecute then
3620 begin
3621 RW[Player].Government := Subject;
3622 for p1 := 0 to nPl - 1 do
3623 if (p1 <> Player) and ((GAlive or GWatching) and (1 shl p1) <> 0)
3624 then
3625 RW[p1].EnemyReport[Player].Government := Subject;
3626 end
3627 end;
3628
3629 sSetRates, sSetRates - sExecute:
3630 begin
3631{$IFDEF TEXTLOG}CmdInfo := Format('SetRates P%d: %d/%d', [Player, Subject and $F * 10, Subject shr 4 * 10]); {$ENDIF}
3632 if Subject and $F + Subject shr 4 > 10 then
3633 result := eInvalid
3634 else if (RW[Player].TaxRate = Subject and $F * 10) and
3635 (RW[Player].LuxRate = Subject shr 4 * 10) then
3636 result := eNotChanged
3637 else if Command >= sExecute then
3638 begin
3639 RW[Player].TaxRate := Subject and $F * 10;
3640 RW[Player].LuxRate := Subject shr 4 * 10;
3641 end
3642 end;
3643
3644 sRevolution:
3645 begin
3646{$IFDEF TEXTLOG}CmdInfo := Format('Revolution P%d', [Player]); {$ENDIF}
3647 if RW[Player].Government = gAnarchy then
3648 result := eInvalid
3649 else
3650 begin
3651 RW[Player].Government := gAnarchy;
3652 for p1 := 0 to nPl - 1 do
3653 if (p1 <> Player) and ((GAlive or GWatching) and (1 shl p1) <> 0)
3654 then
3655 RW[p1].EnemyReport[Player].Government := gAnarchy;
3656 RW[Player].AnarchyStart := GTurn;
3657 end;
3658 end;
3659
3660 sSetResearch, sSetResearch - sExecute:
3661 with RW[Player] do
3662 begin
3663{$IFDEF TEXTLOG}CmdInfo := Format('SetResearch P%d: %d', [Player, Subject]);
3664 {$ENDIF}
3665 if (Happened and phTech <> 0) and
3666 ((Subject < nAdv) or (Subject = adMilitary)) then
3667 begin
3668 if (Mode = moPlaying) and (Subject = adMilitary) and
3669 (DevModelTurn[Player] <> GTurn) then
3670 result := eNoModel
3671 else if Subject <> adMilitary then
3672 begin
3673 if Subject = futComputingTechnology then
3674 begin
3675 if Tech[Subject] >= MaxFutureTech_Computing then
3676 result := eInvalid
3677 end
3678 else if Subject in FutureTech then
3679 begin
3680 if Tech[Subject] >= MaxFutureTech then
3681 result := eInvalid
3682 end
3683 else if Tech[Subject] >= tsApplicable then
3684 result := eInvalid; // already discovered
3685 if Tech[Subject] <> tsSeen then // look if preqs met
3686 if AdvPreq[Subject, 2] <> preNone then
3687 begin // 2 of 3 required
3688 i := 0;
3689 for j := 0 to 2 do
3690 if Tech[AdvPreq[Subject, j]] >= tsApplicable then
3691 inc(i);
3692 if i < 2 then
3693 result := eNoPreq
3694 end
3695 else if (AdvPreq[Subject, 0] <> preNone) and
3696 (Tech[AdvPreq[Subject, 0]] < tsApplicable) or
3697 (AdvPreq[Subject, 1] <> preNone) and
3698 (Tech[AdvPreq[Subject, 1]] < tsApplicable) then
3699 result := eNoPreq
3700 end;
3701 if (result = eOK) and (Command >= sExecute) then
3702 begin
3703 if (Mode = moPlaying) and (Subject = adMilitary) then
3704 IntServer(sIntSetDevModel, Player, 0, DevModel.Kind);
3705 // save DevModel, because sctModel commands are not logged
3706 ResearchTech := Subject;
3707 end
3708 end
3709 else
3710 result := eViolation;
3711 end;
3712
3713 sStealTech, sStealTech - sExecute:
3714 begin
3715{$IFDEF TEXTLOG}CmdInfo := Format('StealTech P%d: %d', [Player, Subject]);
3716 {$ENDIF}
3717 if RW[Player].Happened and phStealTech = 0 then
3718 result := eInvalid
3719 else if (Subject >= nAdv) or (Subject in FutureTech) or
3720 (RW[Player].Tech[Subject] >= tsSeen) or
3721 (RW[GStealFrom].Tech[Subject] < tsApplicable) then
3722 result := eInvalid
3723 else if Command >= sExecute then
3724 begin
3725 SeeTech(Player, Subject);
3726 dec(RW[Player].Happened, phStealTech);
3727 end
3728 end;
3729
3730 sSetAttitude .. sSetAttitude + (nPl - 1) shl 4,
3731 sSetAttitude - sExecute .. sSetAttitude - sExecute + (nPl - 1) shl 4:
3732 begin
3733 p1 := Command shr 4 and $F;
3734{$IFDEF TEXTLOG}CmdInfo := Format('SetAttitude P%d to P%d: %d', [Player, p1, Subject]); {$ENDIF}
3735 if (Subject >= nAttitude) or (p1 >= nPl) or
3736 (RW[Player].EnemyReport[p1] = nil) then
3737 result := eInvalid
3738 else if RW[Player].Treaty[p1] = trNoContact then
3739 result := eNoPreq
3740 else if RW[Player].Attitude[p1] = Subject then
3741 result := eNotChanged
3742 else if Command >= sExecute then
3743 begin
3744 RW[Player].Attitude[p1] := Subject;
3745 RW[p1].EnemyReport[Player].Attitude := Subject;
3746 end
3747 end;
3748
3749 sCancelTreaty, sCancelTreaty - sExecute:
3750 if (LastEndClientCommand <> scReject) or
3751 (RW[Player].Treaty[pContacted] < trPeace) then
3752 result := eInvalid
3753 else if (ServerVersion[Player] >= $010100) and
3754 (GTurn < RW[Player].LastCancelTreaty[pContacted] + CancelTreatyTurns)
3755 then
3756 result := eCancelTreatyRush
3757 else if Command >= sExecute then
3758 begin
3759 CallPlayer(cShowCancelTreaty, pContacted, Player);
3760 IntServer(sIntCancelTreaty, Player, pContacted, nil^);
3761 for p2 := 0 to nPl - 1 do
3762 if (p2 <> pContacted) and (1 shl p2 and PeaceEnded <> 0) then
3763 begin
3764 i := pContacted shl 4 + Player;
3765 CallPlayer(cShowSupportAllianceAgainst, p2, i);
3766 end;
3767 for p2 := 0 to nPl - 1 do
3768 if (p2 <> pContacted) and (1 shl p2 and PeaceEnded <> 0) then
3769 begin
3770 i := p2;
3771 CallPlayer(cShowCancelTreatyByAlliance, Player, i);
3772 end;
3773 LastEndClientCommand := sTurn;
3774 end;
3775
3776 {
3777 Model Related Commands
3778 ____________________________________________________________________
3779 }
3780 sCreateDevModel, sCreateDevModel - sExecute:
3781 begin
3782{$IFDEF TEXTLOG}CmdInfo := Format('CreateDevModel P%d', [Player]); {$ENDIF}
3783 if Subject >= 4 then
3784 result := eInvalid
3785 else if (upgrade[Subject, 0].Preq <> preNone) and
3786 (RW[Player].Tech[upgrade[Subject, 0].Preq] < tsApplicable) then
3787 result := eNoPreq
3788 else if Command >= sExecute then
3789 begin
3790 with RW[Player].DevModel do
3791 begin
3792 Domain := Subject;
3793 MStrength := 0;
3794 MTrans := 0;
3795 MCost := 0;
3796 Upgrades := 0;
3797 FutureMCost := 0;
3798 for i := 0 to nUpgrade - 1 do
3799 with upgrade[Domain, i] do
3800 if (Preq = preNone) or (Preq >= 0) and
3801 ((RW[Player].Tech[Preq] >= tsApplicable) or
3802 (Preq in FutureTech) and (RW[Player].Tech[Preq] >= 0)) then
3803 begin
3804 if Preq in FutureTech then
3805 begin
3806 j := RW[Player].Tech[Preq];
3807 inc(FutureMCost, j * Cost);
3808 end
3809 else
3810 begin
3811 j := 1;
3812 if Cost > MCost then
3813 MCost := Cost;
3814 end;
3815 inc(Upgrades, 1 shl i);
3816 inc(MStrength, j * Strength);
3817 inc(MTrans, j * Trans);
3818 end;
3819 inc(MCost, FutureMCost);
3820 FillChar(Cap, SizeOf(Cap), 0);
3821 Cap[mcOffense] := 2;
3822 Cap[mcDefense] := 1;
3823 for i := 0 to nFeature - 1 do
3824 with Feature[i] do
3825 if (1 shl Domain and Domains <> 0) and
3826 ((Preq = preNone) or (Preq = preSun) and
3827 (GWonder[woSun].EffectiveOwner = Player) or (Preq >= 0) and
3828 (RW[Player].Tech[Preq] >= tsApplicable)) and (i in AutoFeature)
3829 then
3830 Cap[i] := 1;
3831 MaxWeight := 5;
3832 if (WeightPreq7[Domain] <> preNA) and
3833 (RW[Player].Tech[WeightPreq7[Domain]] >= tsApplicable) then
3834 MaxWeight := 7;
3835 if (WeightPreq10[Domain] <> preNA) and
3836 (RW[Player].Tech[WeightPreq10[Domain]] >= tsApplicable) then
3837 if Domain = dSea then
3838 MaxWeight := 9
3839 else
3840 MaxWeight := 10;
3841 end;
3842 CalculateModel(RW[Player].DevModel);
3843 DevModelTurn[Player] := GTurn;
3844 end
3845 end;
3846
3847 sSetDevModelCap .. sSetDevModelCap + $3F0,
3848 sSetDevModelCap - sExecute .. sSetDevModelCap - sExecute + $3F0:
3849 begin
3850{$IFDEF TEXTLOG}CmdInfo := Format('SetDevModelCap P%d', [Player]); {$ENDIF}
3851 if Subject >= nFeature then
3852 result := eInvalid
3853 else if DevModelTurn[Player] = GTurn then
3854 begin
3855 NewCap := Command shr 4 and $3F; { new value }
3856 with RW[Player].DevModel do
3857 if 1 shl Domain and Feature[Subject].Domains = 0 then
3858 result := eDomainMismatch
3859 else if not((Feature[Subject].Preq = preNone) or
3860 (Feature[Subject].Preq = preSun) and
3861 (GWonder[woSun].EffectiveOwner = Player) or
3862 (Feature[Subject].Preq >= 0) and
3863 (RW[Player].Tech[Feature[Subject].Preq] >= tsApplicable)) then
3864 result := eNoPreq
3865 else
3866 begin
3867 if (Subject in AutoFeature) or (Subject = mcDefense) then
3868 MinCap := 1
3869 else
3870 MinCap := 0; { MinCap - minimum use of feature }
3871 if Subject >= mcFirstNonCap then
3872 MaxCap := 1
3873 else if Subject = mcDefense then
3874 begin
3875 if Domain = dGround then
3876 MaxCap := 2
3877 else
3878 MaxCap := 3;
3879 if RW[Player].Tech[adSteel] >= tsApplicable then
3880 inc(MaxCap)
3881 end
3882 else
3883 MaxCap := 8; { MaxCap - maximum use of this feature }
3884 if (Domain = dGround) and (Subject = mcDefense) then
3885 CapWeight := 2
3886 else
3887 CapWeight := Feature[Subject].Weight;
3888 if (NewCap < MinCap) or (NewCap > MaxCap) or
3889 (Weight + (NewCap - Cap[Subject]) * CapWeight > MaxWeight) then
3890 result := eViolation
3891 else if Command >= sExecute then
3892 begin
3893 Cap[Subject] := NewCap;
3894
3895 // mutual feature exclusion
3896 case Subject of
3897 mcSub:
3898 begin
3899 if ServerVersion[Player] >= $010103 then
3900 Cap[mcSeaTrans] := 0;
3901 Cap[mcArtillery] := 0;
3902 Cap[mcCarrier] := 0;
3903 if Cap[mcDefense] > 2 then
3904 Cap[mcDefense] := 2
3905 end;
3906 mcSeaTrans:
3907 begin
3908 if ServerVersion[Player] >= $010103 then
3909 Cap[mcSub] := 0;
3910 end;
3911 mcCarrier:
3912 Cap[mcSub] := 0;
3913 mcArtillery:
3914 Cap[mcSub] := 0;
3915 mcAlpine:
3916 begin
3917 Cap[mcOver] := 0;
3918 Cap[mcMob] := 0;
3919 end;
3920 mcOver:
3921 Cap[mcAlpine] := 0;
3922 mcMob:
3923 begin
3924 Cap[mcAlpine] := 0;
3925 end;
3926 end;
3927
3928 CalculateModel(RW[Player].DevModel);
3929 end
3930 end;
3931 end
3932 else
3933 result := eNoModel;
3934 end;
3935
3936 {
3937 Unit Related Commands
3938 ____________________________________________________________________
3939 }
3940 sRemoveUnit, sRemoveUnit - sExecute:
3941 begin
3942{$IFDEF TEXTLOG}CmdInfo := Format('RemoveUnit P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF}
3943 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
3944 result := eInvalid
3945 else
3946 begin
3947 result := eRemoved;
3948 Loc0 := RW[Player].Un[Subject].Loc;
3949 if RealMap[Loc0] and fCity <> 0 then { check utilize }
3950 begin
3951 SearchCity(Loc0, Player, cix1);
3952 with RW[Player].City[cix1] do
3953 begin
3954 if (RW[Player].Model[RW[Player].Un[Subject].mix].Kind = mkCaravan)
3955 and ((Project and cpImp = 0) or
3956 (Imp[Project and cpIndex].Kind <> ikShipPart)) or
3957 (Project and cpImp = 0) and
3958 (RW[Player].Model[Project and cpIndex].Kind <> mkCaravan) then
3959 result := eUtilized;
3960 if Command >= sExecute then
3961 begin
3962 if result = eUtilized then
3963 begin
3964 with RW[Player].Un[Subject] do
3965 begin
3966 Cost := integer(RW[Player].Model[mix].Cost) * Health *
3967 BuildCostMod[Difficulty[Player]] div 1200;
3968 if RW[Player].Model[mix].Cap[mcLine] > 0 then
3969 Cost := Cost div 2;
3970 end;
3971 if Project and (cpImp + cpIndex) = cpImp + imTrGoods then
3972 inc(RW[Player].Money, Cost)
3973 else
3974 begin
3975 inc(Prod, Cost * 2 div 3);
3976 Project0 := Project0 and not cpCompleted;
3977 if Project0 and not cpAuto <> Project and not cpAuto then
3978 Project0 := Project;
3979 Prod0 := Prod;
3980 end
3981 end;
3982 RemoveUnit_UpdateMap(Player, Subject);
3983 end;
3984 end;
3985 end
3986 else if Command >= sExecute then
3987 RemoveUnit_UpdateMap(Player, Subject);
3988 end
3989 end;
3990
3991 sSetUnitHome, sSetUnitHome - sExecute:
3992 begin
3993{$IFDEF TEXTLOG}CmdInfo := Format('SetUnitHome P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF}
3994 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
3995 result := eInvalid
3996 else
3997 begin
3998 Loc0 := RW[Player].Un[Subject].Loc;
3999 if RealMap[Loc0] and fCity = 0 then
4000 result := eInvalid
4001 else
4002 begin
4003 SearchCity(Loc0, Player, cix1);
4004 if RW[Player].City[cix1].Flags and chCaptured <> 0 then
4005 result := eViolation
4006 else if Command >= sExecute then
4007 RW[Player].Un[Subject].Home := cix1
4008 end
4009 end
4010 end;
4011
4012 sSetSpyMission .. sSetSpyMission + (nSpyMission - 1) shl 4,
4013 sSetSpyMission - sExecute .. sSetSpyMission - sExecute +
4014 (nSpyMission - 1) shl 4:
4015 if Command >= sExecute then
4016 SpyMission := Command shr 4 and $F;
4017
4018 sLoadUnit, sLoadUnit - sExecute:
4019 begin
4020{$IFDEF TEXTLOG}CmdInfo := Format('LoadUnit P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF}
4021 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
4022 result := eInvalid
4023 else
4024 result := LoadUnit(Player, Subject, Command < sExecute);
4025 end;
4026
4027 sUnloadUnit, sUnloadUnit - sExecute:
4028 begin
4029{$IFDEF TEXTLOG}CmdInfo := Format('UnloadUnit P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF}
4030 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
4031 result := eInvalid
4032 else
4033 result := UnloadUnit(Player, Subject, Command < sExecute)
4034 end;
4035
4036 sSelectTransport, sSelectTransport - sExecute:
4037 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
4038 result := eInvalid
4039 else
4040 with RW[Player].Model[RW[Player].Un[Subject].mix] do
4041 begin
4042 if Cap[mcSeaTrans] + Cap[mcAirTrans] + Cap[mcCarrier] = 0 then
4043 result := eInvalid
4044 else if Command >= sExecute then
4045 uixSelectedTransport := Subject;
4046 end;
4047
4048 sCreateUnit .. sCreateUnit + (nPl - 1) shl 4,
4049 sCreateUnit - sExecute .. sCreateUnit - sExecute + (nPl - 1) shl 4:
4050 if (GTestFlags and tfUncover <> 0) or (Difficulty[Player] = 0)
4051 then { supervisor only command }
4052 begin
4053 p1 := Command shr 4 and $F;
4054 Loc1 := integer(Data);
4055 if (Occupant[Loc1] >= 0) and (p1 <> Occupant[Loc1]) or
4056 (RealMap[Loc1] and fCity <> 0) and
4057 (RealMap[Loc1] shr 27 <> Cardinal(p1)) or
4058 (RW[p1].Model[Subject].Domain < dAir) and
4059 ((RW[p1].Model[Subject].Domain = dSea) <> (RealMap[integer(Data)] and
4060 fTerrain < fGrass)) then
4061 result := eViolation
4062 else if Command >= sExecute then
4063 begin
4064 CreateUnit(p1, Subject);
4065 RW[p1].Un[RW[p1].nUn - 1].Loc := integer(Data);
4066 PlaceUnit(p1, RW[p1].nUn - 1);
4067 UpdateUnitMap(integer(Data));
4068 end
4069 end
4070 else
4071 result := eInvalid;
4072
4073 sMoveUnit + (0 + 6 * 8) * 16, sMoveUnit + (1 + 7 * 8) * 16,
4074 sMoveUnit + (2 + 0 * 8) * 16, sMoveUnit + (1 + 1 * 8) * 16,
4075 sMoveUnit + (0 + 2 * 8) * 16, sMoveUnit + (7 + 1 * 8) * 16,
4076 sMoveUnit + (6 + 0 * 8) * 16, sMoveUnit + (7 + 7 * 8) * 16,
4077 sMoveUnit - sExecute + (0 + 6 * 8) * 16, sMoveUnit - sExecute +
4078 (1 + 7 * 8) * 16, sMoveUnit - sExecute + (2 + 0 * 8) * 16,
4079 sMoveUnit - sExecute + (1 + 1 * 8) * 16, sMoveUnit - sExecute +
4080 (0 + 2 * 8) * 16, sMoveUnit - sExecute + (7 + 1 * 8) * 16,
4081 sMoveUnit - sExecute + (6 + 0 * 8) * 16, sMoveUnit - sExecute +
4082 (7 + 7 * 8) * 16:
4083 begin
4084 dx := (Command shr 4 + 4) and 7 - 4;
4085 dy := (Command shr 7 + 4) and 7 - 4;
4086{$IFDEF TEXTLOG}CmdInfo := Format('MoveUnit P%d I%d Mod%d Loc%d (%d,%d)', [Player, Subject, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc, dx, dy]); {$ENDIF}
4087 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
4088 result := eInvalid
4089 else
4090 result := MoveUnit(Player, Subject, dx, dy, Command < sExecute);
4091 end;
4092
4093 {
4094 Settlers Related Commands
4095 ____________________________________________________________________
4096 }
4097 sAddToCity, sAddToCity - sExecute:
4098 begin
4099{$IFDEF TEXTLOG}CmdInfo := Format('AddToCity P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF}
4100 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then
4101 result := eInvalid
4102 else if not(RW[Player].Model[RW[Player].Un[Subject].mix].Kind
4103 in [mkSettler, mkSlaves]) and
4104 (RW[Player].Un[Subject].Flags and unConscripts = 0) then
4105 result := eViolation
4106 else
4107 begin
4108 Loc0 := RW[Player].Un[Subject].Loc;
4109 if RealMap[Loc0] and fCity = 0 then
4110 result := eInvalid
4111 else
4112 begin
4113 SearchCity(Loc0, Player, cix1);
4114 with RW[Player].City[cix1] do
4115 if not CanCityGrow(Player, cix1) then
4116 result := eMaxSize
4117 else if Command >= sExecute then
4118 begin { add to city }
4119 if Mode = moPlaying then
4120 SavedTiles[cix1] := 0; // save in every case
4121 if CanCityGrow(Player, cix1) then
4122 CityGrowth(Player, cix1);
4123 if (RW[Player].Model[RW[Player].Un[Subject].mix]
4124 .Kind = mkSettler) and CanCityGrow(Player, cix1) then
4125 CityGrowth(Player, cix1);
4126 RemoveUnit_UpdateMap(Player, Subject);
4127 end
4128 end
4129 end
4130 end;
4131
4132 sStartJob .. sStartJob + $3F0, sStartJob - sExecute .. sStartJob + $3F0
4133 - sExecute:
4134 begin
4135 Loc0 := RW[Player].Un[Subject].Loc;
4136 i := Command shr 4 and $3F; // new job
4137{$IFDEF TEXTLOG}CmdInfo := Format('StartJob P%d Mod%d Loc%d: %d', [Player, RW[Player].Un[Subject].mix, Loc0, i]); {$ENDIF}
4138 if (Subject >= RW[Player].nUn) or (Loc0 < 0) then
4139 result := eInvalid
4140 else if i >= nJob then
4141 result := eInvalid
4142 else
4143 begin
4144 result := StartJob(Player, Subject, i, Command < sExecute);
4145 if result = eCity then
4146 begin // new city
4147 cix1 := RW[Player].nCity - 1;
4148 AddBestCityTile(Player, cix1);
4149 if Mode = moPlaying then
4150 with RW[Player].City[cix1] do
4151 begin
4152 // SavedResourceWeights[cix1]:=ResourceWeights;
4153 SavedTiles[cix1] := 0; // save in every case
4154 end;
4155 if Mode >= moMovie then { show new city in interface modules }
4156 for p1 := 0 to nPl - 1 do
4157 if (1 shl p1 and GWatching <> 0) and (p1 <> Player) and
4158 (ObserveLevel[Loc0] and (3 shl (2 * p1)) > 0) then
4159 CallPlayer(cShowCityChanged, p1, Loc0);
4160 end
4161 end;
4162 end;
4163
4164 {
4165 City Related Commands
4166 ____________________________________________________________________
4167 }
4168 sSetCityProject, sSetCityProject - sExecute:
4169 begin
4170 NewProject := integer(Data) and not cpAuto;
4171{$IFDEF TEXTLOG}CmdInfo := Format('SetCityProject P%d Loc%d: %d', [Player, RW[Player].City[Subject].Loc, NewProject]); {$ENDIF}
4172 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0)
4173 then
4174 result := eInvalid
4175 else
4176 with RW[Player].City[Subject] do
4177 begin
4178 if NewProject = Project then
4179 result := eNotChanged
4180 else
4181 begin
4182 pt0 := ProjectType(Project0);
4183 pt1 := ProjectType(NewProject);
4184 if NewProject and cpImp = 0 then
4185 begin
4186 if NewProject and cpIndex >= RW[Player].nModel then
4187 result := eInvalid
4188 else if (NewProject and cpConscripts <> 0) and
4189 not((RW[Player].Tech[adConscription] >= tsApplicable) and
4190 (RW[Player].Model[NewProject and cpIndex].Domain = dGround)
4191 and (RW[Player].Model[NewProject and cpIndex].Kind < mkScout))
4192 then
4193 result := eViolation
4194 // else if (RW[Player].Model[NewProject and cpIndex].Kind=mkSlaves)
4195 // and (GWonder[woPyramids].EffectiveOwner<>Player) then
4196 // result:=eNoPreq
4197 end
4198 else if NewProject and cpIndex >= nImp then
4199 result := eInvalid
4200 else
4201 begin
4202 Preq := Imp[NewProject and cpIndex].Preq;
4203 for i := 0 to nImpReplacement - 1 do
4204 if (ImpReplacement[i].OldImp = NewProject and cpIndex) and
4205 (built[ImpReplacement[i].NewImp] > 0) then
4206 result := eObsolete;
4207 if result = eObsolete then
4208 else if Preq = preNA then
4209 result := eInvalid
4210 else if (Preq >= 0) and (RW[Player].Tech[Preq] < tsApplicable)
4211 then
4212 result := eNoPreq
4213 else if built[NewProject and cpIndex] > 0 then
4214 result := eInvalid
4215 else if (NewProject and cpIndex < 28) and
4216 (GWonder[NewProject and cpIndex].CityID <> -1) then
4217 result := eViolation // wonder already exists
4218 else if (NewProject and cpIndex = imSpacePort) and
4219 (RW[Player].NatBuilt[imSpacePort] > 0) then
4220 result := eViolation // space port already exists
4221 else if (NewProject = cpImp + imBank) and (built[imMarket] = 0)
4222 or (NewProject = cpImp + imUniversity) and
4223 (built[imLibrary] = 0) or (NewProject = cpImp + imResLab) and
4224 (built[imUniversity] = 0) or (NewProject = cpImp + imMfgPlant)
4225 and (built[imFactory] = 0) then
4226 result := eNoPreq;
4227 case NewProject - cpImp of
4228 woLighthouse, woMagellan, imCoastalFort, imHarbor, imPlatform:
4229 begin { city at ocean? }
4230 Preq := 0;
4231 V8_to_Loc(Loc, Adjacent);
4232 for V8 := 0 to 7 do
4233 begin
4234 Loc1 := Adjacent[V8];
4235 if (Loc1 >= 0) and (Loc1 < MapSize) and
4236 (RealMap[Loc1] and fTerrain = fShore) then
4237 inc(Preq);
4238 end;
4239 if Preq = 0 then
4240 result := eNoPreq;
4241 end;
4242 woHoover, imHydro:
4243 begin { city at river or mountains? }
4244 Preq := 0;
4245 V8_to_Loc(Loc, Adjacent);
4246 for V8 := 0 to 7 do
4247 begin
4248 Loc1 := Adjacent[V8];
4249 if (Loc1 >= 0) and (Loc1 < MapSize) and
4250 ((RealMap[Loc1] and fTerrain = fMountains) or
4251 (RealMap[Loc1] and fRiver <> 0)) then
4252 inc(Preq);
4253 end;
4254 if Preq = 0 then
4255 result := eNoPreq;
4256 end;
4257 woMIR, imShipComp, imShipPow, imShipHab:
4258 if RW[Player].NatBuilt[imSpacePort] = 0 then
4259 result := eNoPreq;
4260 end;
4261 if (GTestFlags and tfNoRareNeed = 0) and
4262 (Imp[NewProject and cpIndex].Kind = ikShipPart) then
4263 if RW[Player].Tech[adMassProduction] < tsApplicable then
4264 result := eNoPreq
4265 else
4266 begin // check for rare resources
4267 if NewProject and cpIndex = imShipComp then
4268 j := 1
4269 else if NewProject and cpIndex = imShipPow then
4270 j := 2
4271 else { if NewProject and cpIndex=imShipHab then }
4272 j := 3;
4273 // j = rare resource required
4274 Preq := 0;
4275 V21_to_Loc(Loc, Radius);
4276 for V21 := 1 to 26 do
4277 begin
4278 Loc1 := Radius[V21];
4279 if (Loc1 >= 0) and (Loc1 < MapSize) and
4280 (RealMap[Loc1] shr 25 and 3 = Cardinal(j)) then
4281 inc(Preq);
4282 end;
4283 if Preq = 0 then
4284 result := eNoPreq;
4285 end
4286 end;
4287
4288 if (Command >= sExecute) and (result >= rExecuted) then
4289 begin
4290 if pt0 <> ptSelect then
4291 if NewProject and (cpImp or cpIndex) = Project0 and
4292 (cpImp or cpIndex) then
4293 Prod := Prod0
4294 else if (pt1 = ptTrGoods) or (pt1 = ptShip) or (pt1 <> pt0)
4295 and (pt0 <> ptCaravan) then
4296 begin
4297 inc(RW[Player].Money, Prod0);
4298 Prod := 0;
4299 Prod0 := 0;
4300 Project0 := cpImp + imTrGoods
4301 end
4302 else
4303 Prod := Prod0 * 2 div 3;
4304 Project := NewProject
4305 end
4306 end
4307 end
4308 end;
4309
4310 sBuyCityProject, sBuyCityProject - sExecute:
4311 begin
4312{$IFDEF TEXTLOG}CmdInfo := Format('BuyCityProject P%d Loc%d', [Player, RW[Player].City[Subject].Loc]); {$ENDIF}
4313 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0)
4314 then
4315 result := eInvalid
4316 else
4317 with RW[Player].City[Subject] do
4318 if (RW[Player].Government = gAnarchy) or (Flags and chCaptured <> 0)
4319 then
4320 result := eOutOfControl
4321 else if (Project and cpImp <> 0) and
4322 ((Project and cpIndex = imTrGoods) or
4323 (Imp[Project and cpIndex].Kind = ikShipPart)) then
4324 result := eInvalid // don't buy colony ship
4325 else
4326 begin
4327 CityReport.HypoTiles := -1;
4328 CityReport.HypoTax := -1;
4329 CityReport.HypoLux := -1;
4330 GetCityReport(Player, Subject, CityReport);
4331 Cost := CityReport.ProdCost;
4332 NextProd := CityReport.ProdRep - CityReport.Support;
4333 if (CityReport.Working - CityReport.Happy > Size shr 1) or
4334 (NextProd < 0) then // !!! change to new style disorder
4335 NextProd := 0;
4336 Cost := Cost - Prod - NextProd;
4337 if (GWonder[woMich].EffectiveOwner = Player) and
4338 (Project and cpImp <> 0) then
4339 Cost := Cost * 2
4340 else
4341 Cost := Cost * 4;
4342 if Cost <= 0 then
4343 result := eNotChanged
4344 else if Cost > RW[Player].Money then
4345 result := eViolation
4346 else if Command >= sExecute then
4347 IntServer(sIntBuyMaterial, Player, Subject, Cost);
4348 // need to save material/cost because city tiles are not correct
4349 // when loading
4350 end;
4351 end;
4352
4353 sSellCityProject, sSellCityProject - sExecute:
4354 begin
4355{$IFDEF TEXTLOG}CmdInfo := Format('SellCityProject P%d Loc%d', [Player, RW[Player].City[Subject].Loc]); {$ENDIF}
4356 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0)
4357 then
4358 result := eInvalid
4359 else if Command >= sExecute then
4360 with RW[Player].City[Subject] do
4361 begin
4362 inc(RW[Player].Money, Prod0);
4363 Prod := 0;
4364 Prod0 := 0;
4365 end;
4366 end;
4367
4368 sSellCityImprovement, sSellCityImprovement - sExecute:
4369 begin
4370{$IFDEF TEXTLOG}CmdInfo := Format('SellCityImprovement P%d Loc%d: %d', [Player, RW[Player].City[Subject].Loc, integer(Data)]); {$ENDIF}
4371 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0)
4372 then
4373 result := eInvalid
4374 else
4375 with RW[Player].City[Subject] do
4376 if built[integer(Data)] = 0 then
4377 result := eInvalid
4378 else if (RW[Player].Government = gAnarchy) or
4379 (Flags and chCaptured <> 0) then
4380 result := eOutOfControl
4381 else if Flags and chImprovementSold <> 0 then
4382 result := eOnlyOnce
4383 else if Command >= sExecute then
4384 begin
4385 inc(RW[Player].Money, Imp[integer(Data)].Cost * BuildCostMod
4386 [Difficulty[Player]] div 12);
4387 built[integer(Data)] := 0;
4388 if Imp[integer(Data)].Kind in [ikNatLocal, ikNatGlobal] then
4389 begin
4390 RW[Player].NatBuilt[integer(Data)] := 0;
4391 case integer(Data) of
4392 imGrWall:
4393 GrWallContinent[Player] := -1;
4394 imSpacePort:
4395 DestroySpacePort_TellPlayers(Player, -1);
4396 end
4397 end;
4398 inc(Flags, chImprovementSold);
4399 end
4400 end;
4401
4402 sRebuildCityImprovement, sRebuildCityImprovement - sExecute:
4403 begin
4404 OldImp := integer(Data);
4405{$IFDEF TEXTLOG}CmdInfo := Format('RebuildCityImprovement P%d Loc%d: %d', [Player, RW[Player].City[Subject].Loc, OldImp]); {$ENDIF}
4406 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0)
4407 then
4408 result := eInvalid
4409 else
4410 begin
4411 if (OldImp < 0) or (OldImp >= nImp) or
4412 not(Imp[OldImp].Kind in [ikCommon, ikNatLocal, ikNatGlobal]) then
4413 result := eInvalid
4414 else
4415 with RW[Player].City[Subject] do
4416 if (built[OldImp] = 0) or (Project and cpImp = 0) or
4417 not(Imp[Project and cpIndex].Kind in [ikCommon, ikNatLocal,
4418 ikNatGlobal]) then
4419 result := eInvalid
4420 else if (RW[Player].Government = gAnarchy) or
4421 (Flags and chCaptured <> 0) then
4422 result := eOutOfControl
4423 else if Flags and chImprovementSold <> 0 then
4424 result := eOnlyOnce
4425 else if Command >= sExecute then
4426 begin
4427 inc(Prod, Imp[OldImp].Cost * BuildCostMod[Difficulty[Player]]
4428 div 12 * 2 div 3);
4429 Project0 := Project0 and not cpCompleted;
4430 if Project0 and not cpAuto <> Project and not cpAuto then
4431 Project0 := Project;
4432 Prod0 := Prod;
4433 built[OldImp] := 0;
4434 if Imp[OldImp].Kind in [ikNatLocal, ikNatGlobal] then
4435 begin // nat. project lost
4436 RW[Player].NatBuilt[OldImp] := 0;
4437 case OldImp of
4438 imGrWall:
4439 GrWallContinent[Player] := -1;
4440 imSpacePort:
4441 DestroySpacePort_TellPlayers(Player, -1);
4442 end
4443 end;
4444 inc(Flags, chImprovementSold);
4445 end
4446 end
4447 end;
4448
4449 sSetCityTiles, sSetCityTiles - sExecute:
4450 begin
4451{$IFDEF TEXTLOG}CmdInfo := Format('SetCityTiles P%d Loc%d: %x', [Player, RW[Player].City[Subject].Loc, integer(Data)]); {$ENDIF}
4452 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0)
4453 then
4454 result := eInvalid
4455 else
4456 result := SetCityTiles(Player, Subject, integer(Data),
4457 Command < sExecute);
4458 end;
4459
4460 {
4461 Client Exclusive Commands
4462 ____________________________________________________________________
4463 }
4464 else
4465 if Command >= cClientEx then
4466 begin
4467{$IFDEF TEXTLOG}CmdInfo := Format('ClientEx%x P%d', [Command, Player]);
4468 {$ENDIF}
4469 if ProcessClientData[Player] or (Mode = moPlaying) then
4470 CallPlayer(Command, Player, Data)
4471 end
4472 else
4473 result := eUnknown;
4474 end; { case command }
4475
4476 // do not log invalid and non-relevant commands
4477 if result = eZOC_EnemySpotted then
4478 begin
4479 assert(Mode = moPlaying);
4480 CL.State := FormerCLState;
4481 IntServer(sIntDiscoverZOC, Player, 0, ZOCTile);
4482 end
4483 else if result and rEffective = 0 then
4484 if Mode < moPlaying then
4485 begin
4486{$IFDEF TEXTLOG}CmdInfo := Format('***ERROR (%x) ', [result]) + CmdInfo;
4487 {$ENDIF}
4488 LoadOK := false;
4489 end
4490 else
4491 begin
4492 if logged then
4493 CL.State := FormerCLState;
4494 if (result < rExecuted) and (Command >= sExecute) then
4495 PutMessage(1 shl 16 + 1, Format('INVALID: %d calls %x (%d)',
4496 [Player, Command, Subject]));
4497 end;
4498
4499 if (Command and (cClientEx or sExecute or sctMask) = sExecute or sctEndClient)
4500 and (result >= rExecuted) then
4501 LastEndClientCommand := Command;
4502{$IFOPT O-}dec(nHandoverStack, 2); {$ENDIF}
4503end; { <<<server }
4504
4505function ExtractFileNameWithoutExt(const Filename: string): string;
4506var
4507 P: Integer;
4508begin
4509 Result := Filename;
4510 P := Length(Result);
4511 while P > 0 do begin
4512 case Result[P] of
4513 PathDelim: Exit;
4514 {$ifdef windows}
4515 '/': if ('/' in AllowDirectorySeparators) then Exit;
4516 {$endif}
4517 '.': Exit(Copy(Result, 1, P - 1));
4518 end;
4519 Dec(P);
4520 end;
4521end;
4522
4523{ TBrain }
4524
4525procedure TBrain.LoadFromFile(AIFileName: string);
4526var
4527 T: Text;
4528 Key: string;
4529 Value: string;
4530 S: string;
4531 BasePath: string;
4532 I: Integer;
4533begin
4534 BasePath := ExtractFileDir(AIFileName);
4535 FileName := ExtractFileName(ExtractFileNameWithoutExt(ExtractFileNameWithoutExt(AIFileName)));
4536 Name := FileName;
4537 DLLName := BasePath + DirectorySeparator + Name + '.dll';
4538 Credits := '';
4539 Flags := fMultiple;
4540 Client := nil;
4541 Initialized := false;
4542 ServerVersion := 0;
4543 if not FileExists(AIFileName) then
4544 raise Exception.Create(Format('AI specification file %s not found', [AIFileName]));
4545 AssignFile(T, AIFileName);
4546 Reset(T);
4547 while not EOF(T) do
4548 begin
4549 ReadLn(T, s);
4550 s := trim(s);
4551 if Pos(' ', S) > 0 then begin
4552 Key := Copy(S, 1, Pos(' ', S) - 1);
4553 Value := Trim(Copy(S, Pos(' ', S) + 1, Length(S)));
4554 end else begin
4555 Key := S;
4556 Value := '';
4557 end;
4558 if Key = '#NAME' then
4559 Name := Value
4560 else if Key = '#.NET' then
4561 Flags := Flags or fDotNet
4562 else if Key = '#BEGINNER' then
4563 BrainBeginner := Self
4564 else if Key = '#PATH' then
4565 DLLName := BasePath + DirectorySeparator + Value
4566 {$IFDEF WINDOWS}{$IFDEF CPU32}
4567 else if Key = '#PATH_WIN32' then
4568 DLLName := BasePath + DirectorySeparator + Value
4569 {$ENDIF}{$ENDIF}
4570 {$IFDEF WINDOWS}{$IFDEF CPU64}
4571 else if Key = '#PATH_WIN64' then
4572 DLLName := BasePath + DirectorySeparator + Value
4573 {$ENDIF}{$ENDIF}
4574 {$IFDEF LINUX}{$IFDEF CPU32}
4575 else if Key = '#PATH_LINUX32' then
4576 DLLName := BasePath + DirectorySeparator + Value
4577 {$ENDIF}{$ENDIF}
4578 {$IFDEF LINUX}{$IFDEF CPU64}
4579 else if Key = '#PATH_LINUX64' then
4580 DLLName := BasePath + DirectorySeparator + Value
4581 {$ENDIF}{$ENDIF}
4582 else if Key = '#GAMEVERSION' then
4583 for i := 1 to Length(Value) do
4584 case Value[i] of
4585 '0' .. '9':
4586 ServerVersion := ServerVersion and $FFFF00 + ServerVersion and
4587 $FF * 10 + ord(Value[i]) - 48;
4588 '.':
4589 ServerVersion := ServerVersion shl 8;
4590 end
4591 else if Key = '#CREDITS' then
4592 Credits := Value;
4593 end;
4594 CloseFile(T);
4595end;
4596
4597constructor TBrain.Create;
4598begin
4599 Picture := TBitmap.Create;
4600 Picture.SetSize(64, 64);
4601end;
4602
4603destructor TBrain.Destroy;
4604begin
4605 FreeAndNil(Picture);
4606 inherited Destroy;
4607end;
4608
4609{ TBrains }
4610
4611function TBrains.AddNew: TBrain;
4612begin
4613 Result := TBrain.Create;
4614 Add(Result);
4615end;
4616
4617function TBrains.GetKindCount(Kind: TBrainType): Integer;
4618var
4619 I: Integer;
4620begin
4621 Result := 0;
4622 for I := 0 to Count - 1 do
4623 if Items[I].Kind = Kind then Inc(Result);
4624end;
4625
4626procedure TBrains.GetByKind(Kind: TBrainType; Brains: TBrains);
4627var
4628 I: Integer;
4629begin
4630 Brains.Clear;
4631 for I := 0 to Count - 1 do
4632 if Items[I].Kind = Kind then Brains.Add(Items[I]);
4633end;
4634
4635initialization
4636
4637FindFirst(ParamStr(0), $21, ExeInfo);
4638FindClose(ExeInfo);
4639
4640{$IFOPT O-}nHandoverStack := 0; {$ENDIF}
4641
4642end.
Note: See TracBrowser for help on using the repository browser.