source: trunk/LocalPlayer/Term.pas@ 13

Last change on this file since 13 was 12, checked in by chronos, 9 years ago
  • Fixed: Various memory leaks.
  • Fixed: Exceptions during browsing in help.
File size: 279.9 KB
Line 
1{$INCLUDE switches.pas}
2unit Term;
3
4interface
5
6uses
7 Windows, Protocol, Tribes, PVSB, ClientTools, ScreenTools, BaseWin, Messg, ButtonBase,
8
9 LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus,
10 ExtCtrls,
11 ButtonA, ButtonB, ButtonC, EOTButton, Area;
12
13const
14 WM_EOT = WM_USER;
15
16 pltsNormal = 0;
17 pltsBlink = 1;
18
19type
20 TMainScreen = class(TDrawDlg)
21 Timer1: TTimer;
22 GamePopup: TPopupMenu;
23 UnitPopup: TPopupMenu;
24 mIrrigation: TMenuItem;
25 mCity: TMenuItem;
26 mRoad: TMenuItem;
27 mMine: TMenuItem;
28 mPollution: TMenuItem;
29 mHome: TMenuItem;
30 mStay: TMenuItem;
31 mDisband: TMenuItem;
32 mWait: TMenuItem;
33 mNoOrders: TMenuItem;
34 MTrans: TMenuItem;
35 UnitBtn: TButtonB;
36 mResign: TMenuItem;
37 mOptions: TMenuItem;
38 mEnMoves: TMenuItem;
39 mWaitTurn: TMenuItem;
40 mRep: TMenuItem;
41 mFort: TMenuItem;
42 mCentre: TMenuItem;
43 N1: TMenuItem;
44 mAirBase: TMenuItem;
45 N5: TMenuItem;
46 mCityTypes: TMenuItem;
47 mHelp: TMenuItem;
48 mCanal: TMenuItem;
49 mTest: TMenuItem;
50 mLocCodes: TMenuItem;
51 mLoad: TMenuItem;
52 StatPopup: TPopupMenu;
53 mCityStat: TMenuItem;
54 mUnitStat: TMenuItem;
55 mWonders: TMenuItem;
56 mScienceStat: TMenuItem;
57 mRR: TMenuItem;
58 mClear: TMenuItem;
59 mFarm: TMenuItem;
60 mAfforest: TMenuItem;
61 mRep0: TMenuItem;
62 mRep1: TMenuItem;
63 mRep2: TMenuItem;
64 mRep3: TMenuItem;
65 mRep4: TMenuItem;
66 mRep5: TMenuItem;
67 mRep7: TMenuItem;
68 mRep8: TMenuItem;
69 mRep9: TMenuItem;
70 mRep15: TMenuItem;
71 mCancel: TMenuItem;
72 mLog: TMenuItem;
73 mEUnitStat: TMenuItem;
74 mRep10: TMenuItem;
75 mEnAttacks: TMenuItem;
76 mEnNoMoves: TMenuItem;
77 mDiagram: TMenuItem;
78 mJump: TMenuItem;
79 mNations: TMenuItem;
80 mManip: TMenuItem;
81 mManip0: TMenuItem;
82 mManip1: TMenuItem;
83 mManip2: TMenuItem;
84 mManip3: TMenuItem;
85 mManip4: TMenuItem;
86 mManip5: TMenuItem;
87 mEnhanceDef: TMenuItem;
88 mEnhance: TMenuItem;
89 mShips: TMenuItem;
90 mMacro: TMenuItem;
91 mRun: TMenuItem;
92 N10: TMenuItem;
93 mRepList: TMenuItem;
94 mRepScreens: TMenuItem;
95 mRep11: TMenuItem;
96 mNames: TMenuItem;
97 mManip6: TMenuItem;
98 mRep12: TMenuItem;
99 mRandomMap: TMenuItem;
100 mUnload: TMenuItem;
101 mRecover: TMenuItem;
102 MapBtn0: TButtonC;
103 MapBtn1: TButtonC;
104 MapBtn4: TButtonC;
105 MapBtn5: TButtonC;
106 EditPopup: TPopupMenu;
107 mCreateUnit: TMenuItem;
108 MapBtn6: TButtonC;
109 mDebugMap: TMenuItem;
110 mUtilize: TMenuItem;
111 mRep6: TMenuItem;
112 mEnemyMovement: TMenuItem;
113 mEnFastMoves: TMenuItem;
114 mOwnMovement: TMenuItem;
115 mSlowMoves: TMenuItem;
116 mFastMoves: TMenuItem;
117 mVeryFastMoves: TMenuItem;
118 mGoOn: TMenuItem;
119 mSound: TMenuItem;
120 mSoundOn: TMenuItem;
121 mSoundOnAlt: TMenuItem;
122 mSoundOff: TMenuItem;
123 N6: TMenuItem;
124 TerrainBtn: TButtonB;
125 TerrainPopup: TPopupMenu;
126 mScrolling: TMenuItem;
127 mScrollSlow: TMenuItem;
128 mScrollFast: TMenuItem;
129 mScrollOff: TMenuItem;
130 mPillage: TMenuItem;
131 mSelectTransport: TMenuItem;
132 mEmpire: TMenuItem;
133 N4: TMenuItem;
134 N2: TMenuItem;
135 mWebsite: TMenuItem;
136 N3: TMenuItem;
137 mRevolution: TMenuItem;
138 mRep13: TMenuItem;
139 UnitInfoBtn: TButtonB;
140 EOT: TEOTButton;
141 mAllyMovement: TMenuItem;
142 mAlSlowMoves: TMenuItem;
143 mAlFastMoves: TMenuItem;
144 N7: TMenuItem;
145 mEffectiveMovesOnly: TMenuItem;
146 N8: TMenuItem;
147 mAlEffectiveMovesOnly: TMenuItem;
148 mAlNoMoves: TMenuItem;
149 N9: TMenuItem;
150 mViewpoint: TMenuItem;
151 mTileSize: TMenuItem;
152 mNormalTiles: TMenuItem;
153 mSmallTiles: TMenuItem;
154 N11: TMenuItem;
155 MenuArea: TArea;
156 TreasuryArea: TArea;
157 ResearchArea: TArea;
158 ManagementArea: TArea;
159 mTechTree: TMenuItem;
160 MovieSpeed1Btn: TButtonB;
161 MovieSpeed2Btn: TButtonB;
162 MovieSpeed3Btn: TButtonB;
163 MovieSpeed4Btn: TButtonB;
164 N12: TMenuItem;
165 mRep14: TMenuItem;
166 procedure FormCreate(Sender: TObject);
167 procedure FormDestroy(Sender: TObject);
168 procedure Timer1Timer(Sender: TObject);
169 procedure MapBoxMouseDown(Sender: TObject; Button: TMouseButton;
170 Shift: TShiftState; x, y: integer);
171 procedure EOTClick(Sender: TObject);
172 procedure PanelBoxMouseDown(Sender: TObject; Button: TMouseButton;
173 Shift: TShiftState; x, y: integer);
174 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
175 procedure MenuClick(Sender: TObject);
176 procedure FormResize(Sender: TObject);
177 procedure PanelBtnClick(Sender: TObject);
178 procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
179 procedure Toggle(Sender: TObject);
180 procedure PanelBoxMouseMove(Sender: TObject; Shift: TShiftState;
181 x, y: integer);
182 procedure PanelBoxMouseUp(Sender: TObject; Button: TMouseButton;
183 Shift: TShiftState; x, y: integer);
184 procedure MapBoxMouseMove(Sender: TObject; Shift: TShiftState;
185 x, y: integer);
186 procedure mShowClick(Sender: TObject);
187 procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
188 Shift: TShiftState; x, y: integer);
189 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, y: integer);
190 procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
191 Shift: TShiftState; x, y: integer);
192 procedure FormPaint(Sender: TObject);
193 procedure mRepClicked(Sender: TObject);
194 procedure mLogClick(Sender: TObject);
195 procedure FormClose(Sender: TObject; var Action: TCloseAction);
196 procedure FormShow(Sender: TObject);
197 procedure Radio(Sender: TObject);
198 procedure mManipClick(Sender: TObject);
199 procedure mNamesClick(Sender: TObject);
200 procedure MapBtnClick(Sender: TObject);
201 procedure FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
202 procedure CreateUnitClick(Sender: TObject);
203 procedure mSoundOffClick(Sender: TObject);
204 procedure mSoundOnClick(Sender: TObject);
205 procedure mSoundOnAltClick(Sender: TObject);
206 procedure UnitInfoBtnClick(Sender: TObject);
207 procedure ViewpointClick(Sender: TObject);
208 procedure DebugMapClick(Sender: TObject);
209 procedure mSmallTilesClick(Sender: TObject);
210 procedure mNormalTilesClick(Sender: TObject);
211 procedure GrWallBtnDownChanged(Sender: TObject);
212 procedure BareBtnDownChanged(Sender: TObject);
213 procedure MovieSpeedBtnClick(Sender: TObject);
214
215 public
216 procedure CreateParams(var p: TCreateParams); override;
217 procedure Client(Command, NewPlayer: integer; var Data);
218 procedure SetAIName(p: integer; Name: string);
219 function ZoomToCity(Loc: integer; NextUnitOnClose: boolean = false;
220 ShowEvent: integer = 0): boolean;
221 procedure CityClosed(Activateuix: integer; StepFocus: boolean = false;
222 SelectFocus: boolean = false);
223 function DipCall(Command: integer): integer;
224 function OfferCall(var Offer: TOffer): integer;
225 procedure UpdateViews(UpdateCityScreen: boolean = false);
226 function ContactRefused(p: integer; Item: String): boolean;
227
228 private
229 xw, yw, xwd, ywd, xwMini, ywMini, xMidPanel, xRightPanel, xTroop, xTerrain,
230 xMini, yMini, ywmax, ywcenter, TroopLoc, TrCnt, TrRow, TrPitch, MapWidth,
231 MapOffset, MapHeight, BlinkTime, BrushLoc, EditLoc, xMouse,
232 yMouse: integer;
233 BrushType: Cardinal;
234 trix: array [0 .. 63] of integer;
235 AILogo: array [0 .. nPl - 1] of TBitmap;
236 Mini, Panel, TopBar: TBitmap;
237 sb: TPVScrollbar;
238 Closable, RepaintOnResize, Tracking, TurnComplete, Edited, GoOnPhase,
239 HaveStrategyAdvice, FirstMovieTurn: boolean;
240 procedure ArrangeMidPanel;
241 procedure MainOffscreenPaint;
242 procedure MiniPaint;
243 procedure PaintAll;
244 procedure PaintAllMaps;
245 procedure CopyMiniToPanel;
246 procedure PanelPaint;
247 procedure NextUnit(NearLoc: integer; AutoTurn: boolean);
248 procedure Scroll(dx, dy: integer);
249 procedure Centre(Loc: integer);
250 procedure SetTroopLoc(Loc: integer);
251 procedure ProcessRect(x0, y0, nx, ny, Options: integer);
252 procedure PaintLoc(Loc: integer; Radius: integer = 0);
253 procedure PaintLoc_BeforeMove(FromLoc: integer);
254 procedure PaintLocTemp(Loc: integer; Style: integer = pltsNormal);
255 procedure PaintBufferToScreen(xMap, yMap, width, height: integer);
256 procedure PaintDestination;
257 procedure SetUnFocus(uix: integer);
258 function MoveUnit(dx, dy: integer; Options: integer = 0): integer;
259 procedure MoveToLoc(Loc: integer; CheckSuicide: boolean);
260 procedure MoveOnScreen(ShowMove: TShowMove; Step0, Step1, nStep: integer;
261 Restore: boolean = true);
262 procedure FocusOnLoc(Loc: integer; Options: integer = 0);
263 function EndTurn(WasSkipped: boolean = false): boolean;
264 procedure EndNego;
265 function IsPanelPixel(x, y: integer): boolean;
266 procedure InitPopup(Popup: TPopupMenu);
267 procedure SetMapOptions;
268 procedure CheckMovieSpeedBtnState;
269 procedure CheckTerrainBtnVisible;
270 procedure RememberPeaceViolation;
271 procedure SetDebugMap(p: integer);
272 procedure SetViewpoint(p: integer);
273 function LocationOfScreenPixel(x, y: integer): integer;
274 procedure SetTileSize(x, y: integer);
275 procedure RectInvalidate(Left, Top, Rigth, Bottom: integer);
276 procedure SmartRectInvalidate(Left, Top, Rigth, Bottom: integer);
277 procedure SaveSettings;
278 procedure OnScroll(var m: TMessage); message WM_VSCROLL;
279 procedure OnEOT(var Msg: TMessage); message WM_EOT;
280 end;
281
282var
283 MainScreen: TMainScreen;
284
285type
286 TTribeInfo = record
287 trix: integer;
288 FileName: ShortString;
289 end;
290
291 TCityNameInfo = record
292 ID: integer;
293 NewName: ShortString end;
294 TModelNameInfo = record mix: integer;
295 NewName: ShortString end;
296 TPriceSet = Set of $00 .. $FF;
297
298 const
299 crImpDrag = 2;
300 crFlatHand = 3;
301
302 xxu = 32;
303 yyu = 24; // half of unit slot size x/y
304 yyu_anchor = 32;
305 xxc = 32;
306 yyc = 16; // 1/2 of city slot size in x, 1/2 of ground tile size in y (=1/3 of slot)
307
308 // layout
309 TopBarHeight = 41;
310 PanelHeight = 168;
311 MidPanelHeight = 120;
312 // TopBarHeight+MidPanelHeight should be same as BaseWin.yUnused
313 MapCenterUp = (MidPanelHeight - TopBarHeight) div 2;
314
315 nCityType = 4;
316
317 { client exclusive commands: }
318 cSetTribe = $9000;
319 cSetNewModelPicture = $9100;
320 cSetModelName = $9110;
321 cSetModelPicture = $9120;
322 cSetSlaveIndex = $9131;
323 cSetCityName = $9200;
324
325 // city status flags
326 csTypeMask = $0007;
327 csToldDelay = $0008;
328 csResourceWeightsMask = $00F0;
329 csToldBombard = $0100;
330
331 { unit status flags }
332 usStay = $01;
333 usWaiting = $02;
334 usGoto = $04;
335 usEnhance = $08;
336 usRecover = $10;
337 usToldNoReturn = $100;
338 usPersistent = usStay or usGoto or usEnhance or usRecover or
339 integer($FFFF0000);
340
341 { model status flags }
342 msObsolete = $1;
343 msAllowConscripts = $2;
344
345 { additional city happened flags }
346 chTypeDel = $8000;
347 chAllImpsMade = $4000;
348
349 adNone = $801;
350 adFar = $802;
351 adNexus = $803;
352
353 SpecialModelPictureCode: array [0 .. nSpecialModel - 1] of integer = (10,
354 11, 40, 41, 21, 30, { 50,51, } 64, 74, { 71, } 73);
355
356 pixSlaves = 0;
357 pixNoSlaves = 1; // index of slaves in StdUnits
358
359 // icons.bmp properties
360 xSizeSmall = 36;
361 ySizeSmall = 20;
362 SystemIconLines = 2;
363 // lines of system icons in icons.bmp before improvements
364
365 // save options apart from what's defined by SaveOption
366 soTellAI = 30;
367 soExtraMask = $40000000;
368
369 nCityEventPriority = 16;
370 CityEventPriority: array [0 .. nCityEventPriority - 1] of integer =
371 (chDisorder, chImprovementLost, chUnitLost, chAllImpsMade, chProduction,
372 chOldWonder, chNoSettlerProd, chPopDecrease, chProductionSabotaged,
373 chNoGrowthWarning, chPollution, chTypeDel, chFounded, chSiege,
374 chAfterCapture, chPopIncrease);
375
376 CityEventSoundItem: array [0 .. 15] of string = ('CITY_DISORDER', '',
377 'CITY_POPPLUS', 'CITY_POPMINUS', 'CITY_UNITLOST', 'CITY_IMPLOST',
378 'CITY_SABOTAGE', 'CITY_GROWTHNEEDSIMP', 'CITY_POLLUTION', 'CITY_SIEGE',
379 'CITY_WONDEREX', 'CITY_EMDELAY', 'CITY_FOUNDED', 'CITY_FOUNDED', '',
380 'CITY_INVALIDTYPE');
381
382 type
383 TPersistentData = record
384 FarTech, ToldAge, ToldModels, ToldAlive, ToldContact, ToldOwnCredibility,
385 ColdWarStart, PeaceEvaHappened: integer;
386 EnhancementJobs: TEnhancementJobs;
387 ImpOrder: array [0 .. nCityType - 1] of TImpOrder;
388 ToldWonders: array [0 .. 27] of TWonderInfo;
389 ToldTech: array [0 .. nAdv - 1] of ShortInt;
390 end;
391
392 var
393 MyData: ^TPersistentData;
394 AdvIcon: array [0 .. nAdv - 1] of integer;
395 { icons displayed with the technologies }
396 xxt, yyt, // half of tile size x/y
397 GameMode, ClientMode, Age, UnFocus, OptionChecked, MapOptionChecked,
398 nLostArmy, ScienceSum, TaxSum, SoundPreloadDone, MarkCityLoc, HGrTerrain,
399 HGrCities, MovieSpeed: integer;
400 CityRepMask: Cardinal;
401 ReceivedOffer: TOffer;
402 Buffer, SmallImp: TBitmap;
403 BlinkON, DestinationMarkON, StartRunning, StayOnTop_Ensured,
404 supervising: boolean;
405 UnusedTribeFiles, TribeNames: tstringlist;
406 TribeOriginal: array [0 .. nPl - 1] of boolean;
407 LostArmy: array [0 .. nPl * nMmax - 1] of integer;
408 DipMem: array [0 .. nPl - 1] of record pContact, SentCommand,
409 FormerTreaty: integer;
410 SentOffer: TOffer;
411 DeliveredPrices, ReceivedPrices: TPriceSet;
412 end;
413
414function CityEventName(i: integer): string;
415function RoughCredibility(Credibility: integer): integer;
416
417function InitEnemyModel(emix: integer): boolean;
418procedure InitAllEnemyModels;
419procedure InitMyModel(mix: integer; final: boolean);
420
421procedure ImpImage(ca: TCanvas; x, y, iix: integer; Government: integer = -1;
422 IsControl: boolean = false);
423procedure HelpOnTerrain(Loc, NewMode: integer);
424
425implementation
426
427uses
428 Directories, IsoEngine, CityScreen, Draft, MessgEx, Select, CityType, Help,
429 UnitStat, Diplomacy, Inp, Log, Diagram, NatStat, Wonders, Enhance, Nego,
430 Battle, Rates,
431 TechTree,
432
433 Registry;
434
435{$R *.lfm}
436// TODO {$R Res1.res}
437
438const
439 lxmax_xxx = 130;
440 LeftPanelWidth = 70;
441 LeftPanelWidth_Editor = 46;
442 overlap = PanelHeight - MidPanelHeight;
443 yTroop = PanelHeight - 83;
444 xPalace = 66;
445 yPalace = 24; // 120;
446 xAdvisor = 108;
447 yAdvisor = 48;
448 xUnitText = 80;
449 PaperShade = 3;
450 BlinkOnTime = 12;
451 BlinkOffTime = 6;
452 MoveTime = 300; // {time for moving a unit in ms}
453 WaitAfterShowMove = 32;
454 FastScrolling = false; // causes problems with overlapping windows
455
456 nBrushTypes = 26;
457 BrushTypes: array [0 .. nBrushTypes - 1] of Cardinal = (fPrefStartPos,
458 fStartPos, fShore, fGrass, fTundra, fPrairie, fDesert, fSwamp, fForest,
459 fHills, fMountains, fArctic, fDeadLands, fDeadLands or fCobalt,
460 fDeadLands or fUranium, fDeadLands or fMercury, fRiver, fRoad, fRR, fCanal,
461 tiIrrigation, tiFarm, tiMine, fPoll, tiFort, tiBase);
462
463 // MoveUnit options:
464 muAutoNoWait = $0001;
465 muAutoNext = $0002;
466 muNoSuicideCheck = $0004;
467
468 // ProcessRect options:
469 prPaint = $0001;
470 prAutoBounds = $0002;
471 prInvalidate = $0004;
472
473 // FocusOnLoc options:
474 flRepaintPanel = $0001;
475 flImmUpdate = $0002;
476
477 nSaveOption = 22;
478
479var
480 Jump: array [0 .. nPl - 1] of integer;
481 pTurn, pLogo, UnStartLoc, ToldSlavery: integer;
482 PerfFreq: int64;
483 SmallScreen, GameOK, MapValid, skipped, idle: boolean;
484
485 SaveOption: array [0 .. nSaveOption - 1] of integer;
486 MiniColors: array [0 .. 11, 0 .. 1] of TColor;
487 MainMap: TIsoMap;
488 CurrentMoveInfo: record AfterMovePaintRadius, AfterAttackExpeller: integer;
489 DoShow, IsAlly: boolean;
490end;
491
492function CityEventName(i: integer): string;
493begin
494 if i = 14 then // chAllImpsMade
495 if not Phrases2FallenBackToEnglish then
496 result := Phrases2.Lookup('CITYEVENT_ALLIMPSMADE')
497 else
498 result := Phrases.Lookup('CITYEVENTS', 1)
499 else
500 result := Phrases.Lookup('CITYEVENTS', i);
501end;
502
503procedure InitSmallImp;
504const
505 cut = 4;
506 Sharpen = 80;
507type
508 TLine = array [0 .. 99999, 0 .. 2] of Byte;
509 TBuffer = array [0 .. 99999, 0 .. 2] of integer;
510var
511 sum, Cnt, dx, dy, nx, ny, ix, iy, ir, x, y, c, ch, xdivider,
512 ydivider: integer;
513 resampled: ^TBuffer;
514 line: ^TLine;
515begin
516 nx := BigImp.width div xSizeBig * xSizeSmall;
517 ny := BigImp.height div ySizeBig * ySizeSmall;
518
519 // resample icons
520 GetMem(resampled, nx * ny * 12);
521 FillChar(resampled^, nx * ny * 12, 0);
522 for ix := 0 to BigImp.width div xSizeBig - 1 do
523 for iy := 0 to BigImp.height div ySizeBig - 1 do
524 for y := 0 to ySizeBig - 2 * cut - 1 do
525 begin
526 ydivider := (y * ySizeSmall div (ySizeBig - 2 * cut) + 1) *
527 (ySizeBig - 2 * cut) - y * ySizeSmall;
528 if ydivider > ySizeSmall then
529 ydivider := ySizeSmall;
530 line := BigImp.ScanLine[cut + iy * ySizeBig + y];
531 for x := 0 to xSizeBig - 1 do
532 begin
533 ir := ix * xSizeSmall + iy * nx * ySizeSmall + x *
534 xSizeSmall div xSizeBig + y *
535 ySizeSmall div (ySizeBig - 2 * cut) * nx;
536 xdivider := (x * xSizeSmall div xSizeBig + 1) * xSizeBig - x *
537 xSizeSmall;
538 if xdivider > xSizeSmall then
539 xdivider := xSizeSmall;
540 for ch := 0 to 2 do
541 begin
542 c := line[ix * xSizeBig + x, ch];
543 inc(resampled[ir, ch], c * xdivider * ydivider);
544 if xdivider < xSizeSmall then
545 inc(resampled[ir + 1, ch], c * (xSizeSmall - xdivider) *
546 ydivider);
547 if ydivider < ySizeSmall then
548 inc(resampled[ir + nx, ch],
549 c * xdivider * (ySizeSmall - ydivider));
550 if (xdivider < xSizeSmall) and (ydivider < ySizeSmall) then
551 inc(resampled[ir + nx + 1, ch], c * (xSizeSmall - xdivider) *
552 (ySizeSmall - ydivider));
553 end
554 end
555 end;
556
557 // sharpen resampled icons
558 SmallImp.width := nx;
559 SmallImp.height := ny;
560 for y := 0 to ny - 1 do
561 begin
562 line := SmallImp.ScanLine[y];
563 for x := 0 to nx - 1 do
564 for ch := 0 to 2 do
565 begin
566 sum := 0;
567 Cnt := 0;
568 for dy := -1 to 1 do
569 if ((dy >= 0) or (y mod ySizeSmall > 0)) and
570 ((dy <= 0) or (y mod ySizeSmall < ySizeSmall - 1)) then
571 for dx := -1 to 1 do
572 if ((dx >= 0) or (x mod xSizeSmall > 0)) and
573 ((dx <= 0) or (x mod xSizeSmall < xSizeSmall - 1)) then
574 begin
575 inc(sum, resampled[x + dx + nx * (y + dy), ch]);
576 inc(Cnt);
577 end;
578 sum := ((Cnt * Sharpen + 800) * resampled[x + nx * y, ch] - sum *
579 Sharpen) div (800 * xSizeBig * (ySizeBig - 2 * cut));
580 if sum < 0 then
581 sum := 0;
582 if sum > 255 then
583 sum := 255;
584 line[x][ch] := sum;
585 end;
586 end;
587 FreeMem(resampled);
588 // smallimp.savetofile(homedir+'smallimp.bmp'); //!!!
589end;
590
591procedure ImpImage(ca: TCanvas; x, y, iix: integer; Government: integer;
592 IsControl: boolean);
593begin
594 if Government < 0 then
595 Government := MyRO.Government;
596 if (iix = imPalace) and (Government <> gAnarchy) then
597 iix := Government - 8;
598 FrameImage(ca, BigImp, x, y, xSizeBig, ySizeBig, (iix + SystemIconLines * 7)
599 mod 7 * xSizeBig, (iix + SystemIconLines * 7) div 7 * ySizeBig, IsControl);
600end;
601
602procedure HelpOnTerrain(Loc, NewMode: integer);
603begin
604 if MyMap[Loc] and fDeadLands <> 0 then
605 HelpDlg.ShowNewContent(NewMode, hkTer, 3 * 12)
606 else if (MyMap[Loc] and fTerrain = fForest) and IsJungle(Loc div G.lx) then
607 HelpDlg.ShowNewContent(NewMode, hkTer,
608 fJungle + (MyMap[Loc] shr 5 and 3) * 12)
609 else
610 HelpDlg.ShowNewContent(NewMode, hkTer, MyMap[Loc] and fTerrain +
611 (MyMap[Loc] shr 5 and 3) * 12);
612end;
613
614{ *** tribe management procedures *** }
615
616function RoughCredibility(Credibility: integer): integer;
617begin
618 case Credibility of
619 0 .. 69:
620 result := 0;
621 70 .. 89:
622 result := 1;
623 90 .. 99:
624 result := 2;
625 100:
626 result := 3
627 end;
628end;
629
630procedure ChooseModelPicture(p, mix, code, Hash, Turn: integer;
631 ForceNew, final: boolean);
632var
633 i: integer;
634 Picture: TModelPictureInfo;
635 IsNew: boolean;
636begin
637 Picture.trix := p;
638 Picture.mix := mix;
639 if code = 74 then
640 begin // use correct pictures for slaves
641 if Tribe[p].mixSlaves < 0 then
642 if not TribeOriginal[p] then
643 Tribe[p].mixSlaves := mix
644 else
645 begin
646 i := mix + p shl 16;
647 Server(cSetSlaveIndex, 0, 0, i);
648 end;
649 if ToldSlavery = 1 then
650 Picture.pix := pixSlaves
651 else
652 Picture.pix := pixNoSlaves;
653 Picture.Hash := 0;
654 Picture.GrName := 'StdUnits';
655 IsNew := true;
656 end
657 else
658 begin
659 Picture.Hash := Hash;
660 IsNew := Tribe[p].ChooseModelPicture(Picture, code, Turn, ForceNew);
661 end;
662 if final then
663 if not TribeOriginal[p] then
664 Tribe[p].SetModelPicture(Picture, IsNew)
665 else if IsNew then
666 Server(cSetNewModelPicture + (Length(Picture.GrName) + 1 + 16 + 3) div 4,
667 0, 0, Picture)
668 else
669 Server(cSetModelPicture + (Length(Picture.GrName) + 1 + 16 + 3) div 4, 0,
670 0, Picture)
671 else
672 with Tribe[p].ModelPicture[mix] do
673 begin
674 HGr := LoadGraphicSet(Picture.GrName);
675 pix := Picture.pix;
676 end;
677end;
678
679function InitEnemyModel(emix: integer): boolean;
680begin
681 if GameMode = cMovie then
682 begin
683 result := false;
684 exit
685 end;
686 with MyRO.EnemyModel[emix] do
687 ChooseModelPicture(Owner, mix, ModelCode(MyRO.EnemyModel[emix]),
688 ModelHash(MyRO.EnemyModel[emix]), MyRO.Turn, false, true);
689 result := true
690end;
691
692procedure InitAllEnemyModels;
693var
694 emix: integer;
695begin
696 for emix := 0 to MyRO.nEnemyModel - 1 do
697 with MyRO.EnemyModel[emix] do
698 if Tribe[Owner].ModelPicture[mix].HGr = 0 then
699 InitEnemyModel(emix);
700end;
701
702procedure InitMyModel(mix: integer; final: boolean);
703var
704 mi: TModelInfo;
705begin
706 if (GameMode = cMovie) and (MyModel[mix].Kind < $08) then
707 exit;
708 // don't exit for special units because cSetModelPicture comes after TellNewModels
709 MakeModelInfo(me, mix, MyModel[mix], mi);
710 ChooseModelPicture(me, mix, ModelCode(mi), ModelHash(mi), MyRO.Turn,
711 false, final);
712end;
713
714function AttackSound(code: integer): string;
715begin
716 result := 'ATTACK_' + char(48 + code div 100 mod 10) +
717 char(48 + code div 10 mod 10) + char(48 + code mod 10);
718end;
719
720procedure CheckToldNoReturn(uix: integer);
721// check whether aircraft survived low-fuel warning
722begin
723 assert(not supervising);
724 with MyUn[uix] do
725 if (Status and usToldNoReturn <> 0) and
726 ((MyMap[Loc] and fCity <> 0) or (MyMap[Loc] and fTerImp = tiBase) or
727 (Master >= 0)) then
728 Status := Status and not usToldNoReturn;
729end;
730
731function CreateTribe(p: integer; FileName: string; Original: boolean): boolean;
732begin
733 if not FileExists(LocalizedFilePath('Tribes\' + FileName + '.tribe.txt')) then
734 begin
735 result := false;
736 exit
737 end;
738
739 TribeOriginal[p] := Original;
740 Tribe[p] := TTribe.Create(FileName);
741 with Tribe[p] do
742 begin
743 if (GameMode = cNewGame) or not Original then
744 begin
745 Term.ChooseModelPicture(p, 0, 010, 1, 0, true, true);
746 Term.ChooseModelPicture(p, 1, 040, 1, 0, true, true);
747 Term.ChooseModelPicture(p, 2, 041, 1, 0, true, true);
748 Term.ChooseModelPicture(p, -1, 017, 1, 0, true, true);
749 end;
750 DipMem[p].pContact := -1;
751 end;
752 result := true;
753end;
754
755procedure TellNewContacts;
756var
757 p1: integer;
758begin
759 if not supervising then
760 for p1 := 0 to nPl - 1 do
761 if (p1 <> me) and (1 shl p1 and MyData.ToldContact = 0) and
762 (1 shl p1 and MyRO.Alive <> 0) and (MyRO.Treaty[p1] > trNoContact) then
763 begin
764 TribeMessage(p1, Tribe[p1].TPhrase('FRNEWNATION'), '');
765 MyData.ToldContact := MyData.ToldContact or (1 shl p1);
766 end
767end;
768
769procedure TellNewModels;
770var
771 mix: integer;
772 ModelNameInfo: TModelNameInfo;
773begin
774 if supervising then
775 exit;
776 with Tribe[me] do
777 while MyData.ToldModels < MyRO.nModel do
778 begin { new Unit class available }
779 if (ModelPicture[MyData.ToldModels].HGr > 0) and
780 (MyModel[MyData.ToldModels].Kind <> mkSelfDeveloped) then
781 begin // save picture of DevModel
782 ModelPicture[MyData.ToldModels + 1] := ModelPicture[MyData.ToldModels];
783 ModelName[MyData.ToldModels + 1] := ModelName[MyData.ToldModels];
784 ModelPicture[MyData.ToldModels].HGr := 0
785 end;
786 if ModelPicture[MyData.ToldModels].HGr = 0 then
787 InitMyModel(MyData.ToldModels, true);
788 { only run if no researched model }
789 with MessgExDlg do
790 begin
791 { MakeModelInfo(me,MyData.ToldModels,MyModel[MyData.ToldModels],mi);
792 if mi.Attack=0 then OpenSound:='MSG_DEFAULT'
793 else OpenSound:=AttackSound(ModelCode(mi)); }
794 if MyModel[MyData.ToldModels].Kind = mkSelfDeveloped then
795 OpenSound := 'NEWMODEL_' + char(48 + Age);
796 MessgText := Phrases.Lookup('MODELAVAILABLE');
797 if GameMode = cMovie then
798 begin
799 Kind := mkOkHelp; // doesn't matter
800 MessgText := MessgText + '\' + ModelName[MyData.ToldModels];
801 end
802 else
803 begin
804 Kind := mkModel;
805 EInput.Text := ModelName[MyData.ToldModels];
806 end;
807 IconKind := mikModel;
808 IconIndex := MyData.ToldModels;
809 ShowModal;
810 if (EInput.Text <> '') and (EInput.Text <> ModelName[MyData.ToldModels])
811 then
812 begin // user renamed model
813 ModelNameInfo.mix := MyData.ToldModels;
814 ModelNameInfo.NewName := EInput.Text;
815 Server(cSetModelName + (Length(ModelNameInfo.NewName) + 1 + 4 + 3)
816 div 4, me, 0, ModelNameInfo);
817 end
818 end;
819 if MyModel[MyData.ToldModels].Kind = mkSettler then
820 begin // engineers make settlers obsolete
821 for mix := 0 to MyData.ToldModels - 1 do
822 if MyModel[mix].Kind = mkSettler then
823 MyModel[mix].Status := MyModel[mix].Status or msObsolete;
824 end;
825 inc(MyData.ToldModels)
826 end;
827end;
828
829procedure PaintZoomedTile(dst: TBitmap; x, y, Loc: integer);
830
831 procedure TSprite(xDst, yDst, xSrc, ySrc: integer);
832 begin
833 Sprite(dst, HGrTerrain, x + xDst, y + yDst, xxt * 2, yyt * 3,
834 1 + xSrc * (xxt * 2 + 1), 1 + ySrc * (yyt * 3 + 1));
835 end;
836
837 procedure TSprite4(xSrc, ySrc: integer);
838 begin
839 Sprite(dst, HGrTerrain, x + xxt, y + yyt + 2, xxt * 2, yyt * 2 - 2,
840 1 + xSrc * (xxt * 2 + 1), 3 + yyt + ySrc * (yyt * 3 + 1));
841 Sprite(dst, HGrTerrain, x + 4, y + 2 * yyt, xxt * 2 - 4, yyt * 2,
842 5 + xSrc * (xxt * 2 + 1), 1 + yyt + ySrc * (yyt * 3 + 1));
843 Sprite(dst, HGrTerrain, x + xxt * 2, y + 2 * yyt, xxt * 2 - 4, yyt * 2,
844 1 + xSrc * (xxt * 2 + 1), 1 + yyt + ySrc * (yyt * 3 + 1));
845 Sprite(dst, HGrTerrain, x + xxt, y + yyt * 3, xxt * 2, yyt * 2 - 2,
846 1 + xSrc * (xxt * 2 + 1), 1 + yyt + ySrc * (yyt * 3 + 1));
847 end;
848
849var
850 cix, ySrc, Tile: integer;
851begin
852 Tile := MyMap[Loc];
853 if Tile and fCity <> 0 then
854 begin
855 if MyRO.Tech[adRailroad] >= tsApplicable then
856 Tile := Tile or fRR
857 else
858 Tile := Tile or fRoad;
859 if Tile and fOwned <> 0 then
860 begin
861 cix := MyRO.nCity - 1;
862 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do
863 dec(cix);
864 assert(cix >= 0);
865 if MyCity[cix].Built[imSupermarket] > 0 then
866 Tile := Tile or tiFarm
867 else
868 Tile := Tile or tiIrrigation;
869 end
870 else
871 Tile := Tile or tiIrrigation;
872 end;
873
874 if Tile and fTerrain >= fForest then
875 TSprite4(2, 2)
876 else
877 TSprite4(Tile and fTerrain, 0);
878 if Tile and fTerrain >= fForest then
879 begin
880 if (Tile and fTerrain = fForest) and IsJungle(Loc div G.lx) then
881 ySrc := 18
882 else
883 ySrc := 3 + 2 * (Tile and fTerrain - fForest);
884 TSprite(xxt, 0, 6, ySrc);
885 TSprite(0, yyt, 3, ySrc);
886 TSprite((xxt * 2), yyt, 4, ySrc + 1);
887 TSprite(xxt, (yyt * 2), 1, ySrc + 1);
888 end;
889
890 // irrigation
891 case Tile and fTerImp of
892 tiIrrigation:
893 begin
894 TSprite(xxt, 0, 0, 12);
895 TSprite(xxt * 2, yyt, 0, 12);
896 end;
897 tiFarm:
898 begin
899 TSprite(xxt, 0, 1, 12);
900 TSprite(xxt * 2, yyt, 1, 12);
901 end
902 end;
903
904 // river/canal/road/railroad
905 if Tile and fRiver <> 0 then
906 begin
907 TSprite(0, yyt, 2, 14);
908 TSprite(xxt, (yyt * 2), 2, 14);
909 end;
910 if Tile and fCanal <> 0 then
911 begin
912 TSprite(xxt, 0, 7, 11);
913 TSprite(xxt, 0, 3, 11);
914 TSprite(xxt * 2, yyt, 7, 11);
915 TSprite(xxt * 2, yyt, 3, 11);
916 end;
917 if Tile and fRR <> 0 then
918 begin
919 TSprite((xxt * 2), yyt, 1, 10);
920 TSprite((xxt * 2), yyt, 5, 10);
921 TSprite(xxt, (yyt * 2), 1, 10);
922 TSprite(xxt, (yyt * 2), 5, 10);
923 end
924 else if Tile and fRoad <> 0 then
925 begin
926 TSprite((xxt * 2), yyt, 8, 9);
927 TSprite((xxt * 2), yyt, 5, 9);
928 TSprite(xxt, (yyt * 2), 1, 9);
929 TSprite(xxt, (yyt * 2), 5, 9);
930 end;
931
932 if Tile and fPoll <> 0 then
933 TSprite(xxt, (yyt * 2), 6, 12);
934
935 // special
936 if Tile and (fTerrain or fSpecial) = fGrass or fSpecial1 then
937 TSprite4(2, 1)
938 else if Tile and fSpecial <> 0 then
939 if Tile and fTerrain < fForest then
940 TSprite(0, yyt, Tile and fTerrain, Tile and fSpecial shr 5)
941 else if (Tile and fTerrain = fForest) and IsJungle(Loc div G.lx) then
942 TSprite(0, yyt, 8, 17 + Tile and fSpecial shr 5)
943 else
944 TSprite(0, yyt, 8, 2 + (Tile and fTerrain - fForest) * 2 + Tile and
945 fSpecial shr 5)
946 else if Tile and fDeadLands <> 0 then
947 begin
948 TSprite4(6, 2);
949 TSprite(xxt, yyt, 8, 12 + Tile shr 25 and 3);
950 end;
951
952 // other improvements
953 case Tile and fTerImp of
954 tiMine:
955 TSprite(xxt, 0, 2, 12);
956 tiFort:
957 begin
958 TSprite(xxt, 0, 7, 12);
959 TSprite(xxt, 0, 3, 12);
960 end;
961 tiBase:
962 TSprite(xxt, 0, 4, 12);
963 end;
964end;
965
966function ChooseResearch: boolean;
967var
968 ChosenResearch: integer;
969begin
970 if (MyData.FarTech <> adNone) and (MyRO.Tech[MyData.FarTech] >= tsApplicable)
971 then
972 MyData.FarTech := adNone;
973 repeat
974 { research complete -- select new }
975 repeat
976 ModalSelectDlg.ShowNewContent(wmModal, kAdvance);
977 if ModalSelectDlg.result < 0 then
978 begin
979 result := false;
980 exit
981 end;
982 ChosenResearch := ModalSelectDlg.result;
983 if ChosenResearch = adMilitary then
984 begin
985 DraftDlg.ShowNewContent(wmModal);
986 if DraftDlg.ModalResult <> mrOK then
987 Tribe[me].ModelPicture[MyRO.nModel].HGr := 0
988 end
989 until (ChosenResearch <> adMilitary) or (DraftDlg.ModalResult = mrOK);
990
991 if ChosenResearch = adMilitary then
992 InitMyModel(MyRO.nModel, true)
993 else if ChosenResearch = adFar then
994 begin
995 ModalSelectDlg.ShowNewContent(wmModal, kFarAdvance);
996 if ModalSelectDlg.result >= 0 then
997 if (ModalSelectDlg.result = adNone) or
998 (Server(sSetResearch - sExecute, me, ModalSelectDlg.result, nil^) <
999 rExecuted) then
1000 MyData.FarTech := ModalSelectDlg.result
1001 else
1002 begin
1003 ChosenResearch := ModalSelectDlg.result;
1004 // can be researched immediately
1005 MyData.FarTech := adNone
1006 end
1007 end;
1008 until ChosenResearch <> adFar;
1009 if ChosenResearch = adNexus then
1010 MyData.FarTech := adNexus
1011 else
1012 Server(sSetResearch, me, ChosenResearch, nil^);
1013 ListDlg.TechChange;
1014 result := true;
1015 end;
1016
1017 (* ** client function handling ** *)
1018
1019 function TMainScreen.DipCall(Command: integer): integer;
1020 var
1021 i: integer;
1022 IsTreatyDeal: boolean;
1023 begin
1024 result := Server(Command, me, 0, nil^);
1025 if result >= rExecuted then
1026 begin
1027 if Command and $FF0F = scContact then
1028 begin
1029 DipMem[me].pContact := Command shr 4 and $F;
1030 NegoDlg.Initiate;
1031 DipMem[me].DeliveredPrices := [];
1032 DipMem[me].ReceivedPrices := [];
1033 end;
1034
1035 DipMem[me].SentCommand := Command;
1036 DipMem[me].FormerTreaty := MyRO.Treaty[DipMem[me].pContact];
1037 if Command = scDipCancelTreaty then
1038 Play('CANCELTREATY')
1039 else if Command = scDipAccept then
1040 begin // remember delivered and received prices
1041 for i := 0 to ReceivedOffer.nDeliver - 1 do
1042 include(DipMem[me].ReceivedPrices, ReceivedOffer.Price[i] shr 24);
1043 for i := 0 to ReceivedOffer.nCost - 1 do
1044 include(DipMem[me].DeliveredPrices,
1045 ReceivedOffer.Price[ReceivedOffer.nDeliver + i] shr 24);
1046 IsTreatyDeal := false;
1047 for i := 0 to ReceivedOffer.nDeliver + ReceivedOffer.nCost - 1 do
1048 if ReceivedOffer.Price[i] and opMask = opTreaty then
1049 IsTreatyDeal := true;
1050 if IsTreatyDeal then
1051 Play('NEWTREATY')
1052 else
1053 Play('ACCEPTOFFER');
1054 end;
1055 CityDlg.CloseAction := None;
1056 if G.RO[DipMem[me].pContact] <> nil then
1057 begin // close windows for next player
1058 for i := 0 to Screen.FormCount - 1 do
1059 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)
1060 then
1061 Screen.Forms[i].Close;
1062 end
1063 else
1064 begin
1065 if CityDlg.Visible then
1066 CityDlg.Close;
1067 if UnitStatDlg.Visible then
1068 UnitStatDlg.Close;
1069 end
1070 end
1071 end;
1072
1073 function TMainScreen.OfferCall(var Offer: TOffer): integer;
1074 var
1075 i: integer;
1076 begin
1077 result := Server(scDipOffer, me, 0, Offer);
1078 if result >= rExecuted then
1079 begin
1080 DipMem[me].SentCommand := scDipOffer;
1081 DipMem[me].FormerTreaty := MyRO.Treaty[DipMem[me].pContact];
1082 DipMem[me].SentOffer := Offer;
1083 CityDlg.CloseAction := None;
1084 if G.RO[DipMem[me].pContact] <> nil then
1085 begin // close windows for next player
1086 for i := 0 to Screen.FormCount - 1 do
1087 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)
1088 then
1089 Screen.Forms[i].Close;
1090 end
1091 else
1092 begin
1093 if CityDlg.Visible then
1094 CityDlg.Close;
1095 if UnitStatDlg.Visible then
1096 UnitStatDlg.Close;
1097 end
1098 end
1099 end;
1100
1101 procedure TMainScreen.SetUnFocus(uix: integer);
1102 var
1103 Loc0: integer;
1104 begin
1105 assert(not((uix >= 0) and supervising));
1106 if uix <> UnFocus then
1107 begin
1108 DestinationMarkON := false;
1109 PaintDestination;
1110 if uix >= 0 then
1111 UnStartLoc := MyUn[uix].Loc;
1112 BlinkON := false;
1113 BlinkTime := -1;
1114 if UnFocus >= 0 then
1115 begin
1116 Loc0 := MyUn[UnFocus].Loc;
1117 if (uix < 0) or (Loc0 <> MyUn[uix].Loc) then
1118 begin
1119 UnFocus := -1;
1120 PaintLoc(Loc0);
1121 end
1122 end;
1123 UnFocus := uix;
1124 end;
1125 UnitInfoBtn.Visible := UnFocus >= 0;
1126 UnitBtn.Visible := UnFocus >= 0;
1127 CheckTerrainBtnVisible;
1128 end;
1129
1130 procedure TMainScreen.CheckTerrainBtnVisible;
1131 var
1132 Tile: integer;
1133 mox: ^TModel;
1134 begin
1135 if UnFocus >= 0 then
1136 begin
1137 mox := @MyModel[MyUn[UnFocus].mix];
1138 Tile := MyMap[MyUn[UnFocus].Loc];
1139 TerrainBtn.Visible := (Tile and fCity = 0) and (MyUn[UnFocus].Master < 0)
1140 and ((mox.Kind = mkSettler) or (mox.Kind = mkSlaves) and
1141 (MyRO.Wonder[woPyramids].EffectiveOwner >= 0));
1142 end
1143 else
1144 TerrainBtn.Visible := false;
1145 end;
1146
1147 procedure TMainScreen.CheckMovieSpeedBtnState;
1148 begin
1149 if GameMode = cMovie then
1150 begin
1151 MovieSpeed1Btn.Down := MovieSpeed = 1;
1152 MovieSpeed1Btn.Visible := true;
1153 MovieSpeed2Btn.Down := MovieSpeed = 2;
1154 MovieSpeed2Btn.Visible := true;
1155 MovieSpeed3Btn.Down := MovieSpeed = 3;
1156 MovieSpeed3Btn.Visible := true;
1157 MovieSpeed4Btn.Down := MovieSpeed = 4;
1158 MovieSpeed4Btn.Visible := true;
1159 end
1160 else
1161 begin
1162 MovieSpeed1Btn.Visible := false;
1163 MovieSpeed2Btn.Visible := false;
1164 MovieSpeed3Btn.Visible := false;
1165 MovieSpeed4Btn.Visible := false;
1166 end
1167 end;
1168
1169 procedure TMainScreen.SetMapOptions;
1170 begin
1171 IsoEngine.Options := MapOptionChecked;
1172 if ClientMode = cEditMap then
1173 IsoEngine.Options := IsoEngine.Options or (1 shl moEditMode);
1174 if mLocCodes.Checked then
1175 IsoEngine.Options := IsoEngine.Options or (1 shl moLocCodes);
1176 end;
1177
1178 procedure TMainScreen.UpdateViews(UpdateCityScreen: boolean);
1179 begin
1180 SumCities(TaxSum, ScienceSum);
1181 PanelPaint; // TopBar was enough!!!
1182 ListDlg.EcoChange;
1183 NatStatDlg.EcoChange;
1184 if UpdateCityScreen then
1185 CityDlg.SmartUpdateContent;
1186 end;
1187
1188 procedure TMainScreen.SetAIName(p: integer; Name: string);
1189 begin
1190 if Name = '' then
1191 begin
1192 if AILogo[p] <> nil then
1193 begin
1194 AILogo[p].free;
1195 AILogo[p] := nil
1196 end
1197 end
1198 else
1199 begin
1200 if AILogo[p] = nil then
1201 AILogo[p] := TBitmap.Create;
1202 if not LoadGraphicFile(AILogo[p], HomeDir + Name, gfNoError) then
1203 begin
1204 AILogo[p].free;
1205 AILogo[p] := nil
1206 end
1207 end
1208 end;
1209
1210 function TMainScreen.ContactRefused(p: integer; Item: String): boolean;
1211 // return whether treaty was cancelled
1212 var
1213 s: string;
1214 begin
1215 assert(MyRO.Treaty[p] >= trPeace);
1216 s := Tribe[p].TPhrase(Item);
1217 if MyRO.Turn < MyRO.LastCancelTreaty[p] + CancelTreatyTurns then
1218 begin
1219 SimpleMessage(s);
1220 result := false;
1221 end
1222 else
1223 begin
1224 case MyRO.Treaty[p] of
1225 trPeace:
1226 s := s + ' ' + Phrases.Lookup('FRCANCELQUERY_PEACE');
1227 trFriendlyContact:
1228 s := s + ' ' + Phrases.Lookup('FRCANCELQUERY_FRIENDLY');
1229 trAlliance:
1230 s := s + ' ' + Phrases.Lookup('FRCANCELQUERY_ALLIANCE');
1231 end;
1232 result := SimpleQuery(mkYesNo, s, 'NEGO_REJECTED') = mrOK;
1233 if result then
1234 begin
1235 Play('CANCELTREATY');
1236 Server(sCancelTreaty, me, 0, nil^);
1237 if MyRO.Treaty[p] = trNone then
1238 CityOptimizer_BeginOfTurn;
1239 // peace treaty was cancelled -- use formerly forbidden tiles
1240 MapValid := false;
1241 PaintAllMaps;
1242 end
1243 end
1244 end;
1245
1246 procedure TMainScreen.RememberPeaceViolation;
1247 var
1248 uix, p1: integer;
1249 begin
1250 MyData.PeaceEvaHappened := 0;
1251 for uix := 0 to MyRO.nUn - 1 do
1252 with MyUn[uix] do
1253 if Loc >= 0 then
1254 begin
1255 p1 := MyRO.Territory[Loc];
1256 if (p1 <> me) and (p1 >= 0) and
1257 (MyRO.Turn = MyRO.EvaStart[p1] + (PeaceEvaTurns - 1)) then
1258 MyData.PeaceEvaHappened := MyData.PeaceEvaHappened or (1 shl p1);
1259 end;
1260 end;
1261
1262 procedure TMainScreen.Client(Command, NewPlayer: integer; var Data);
1263
1264 procedure GetTribeList;
1265 var
1266 SearchRec: TSearchRec;
1267 Color: TColor;
1268 Name: string;
1269 ok: boolean;
1270 begin
1271 UnusedTribeFiles.Clear;
1272 ok := FindFirst(DataDir + 'Localization\' + 'Tribes\*.tribe.txt',
1273 faArchive + faReadOnly, SearchRec) = 0;
1274 if not ok then
1275 begin
1276 FindClose(SearchRec);
1277 ok := FindFirst(HomeDir + 'Tribes\*.tribe.txt', faArchive + faReadOnly,
1278 SearchRec) = 0;
1279 end;
1280 if ok then
1281 repeat
1282 SearchRec.Name := Copy(SearchRec.Name, 1,
1283 Length(SearchRec.Name) - 10);
1284 if GetTribeInfo(SearchRec.Name, Name, Color) then
1285 UnusedTribeFiles.AddObject(SearchRec.Name, TObject(Color));
1286 until FindNext(SearchRec) <> 0;
1287 FindClose(SearchRec);
1288 end;
1289
1290 function ChooseUnusedTribe: integer;
1291 var
1292 i, j, ColorDistance, BestColorDistance, TestColorDistance,
1293 CountBest: integer;
1294 begin
1295 assert(UnusedTribeFiles.Count > 0);
1296 result := -1;
1297 BestColorDistance := -1;
1298 for j := 0 to UnusedTribeFiles.Count - 1 do
1299 begin
1300 ColorDistance := 250; // consider differences more than this infinite
1301 for i := 0 to nPl - 1 do
1302 if Tribe[i] <> nil then
1303 begin
1304 TestColorDistance :=
1305 abs(integer(UnusedTribeFiles.Objects[j]) shr 16 and
1306 $FF - Tribe[i].Color shr 16 and $FF) +
1307 abs(integer(UnusedTribeFiles.Objects[j]) shr 8 and
1308 $FF - Tribe[i].Color shr 8 and $FF) * 3 +
1309 abs(integer(UnusedTribeFiles.Objects[j]) and
1310 $FF - Tribe[i].Color and $FF) * 2;
1311 if TestColorDistance < ColorDistance then
1312 ColorDistance := TestColorDistance
1313 end;
1314 if ColorDistance > BestColorDistance then
1315 begin
1316 CountBest := 0;
1317 BestColorDistance := ColorDistance
1318 end;
1319 if ColorDistance = BestColorDistance then
1320 begin
1321 inc(CountBest);
1322 if random(CountBest) = 0 then
1323 result := j
1324 end
1325 end;
1326 end;
1327
1328 procedure ShowEnemyShipChange(ShowShipChange: TShowShipChange);
1329 var
1330 i, TestCost, MostCost: integer;
1331 Ship1Plus, Ship2Plus: boolean;
1332 begin
1333 with ShowShipChange, MessgExDlg do
1334 begin
1335 case Reason of
1336 scrProduction:
1337 begin
1338 OpenSound := 'SHIP_BUILT';
1339 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBUILT');
1340 IconKind := mikShip;
1341 IconIndex := Ship1Owner;
1342 end;
1343
1344 scrDestruction:
1345 begin
1346 OpenSound := 'SHIP_DESTROYED';
1347 MessgText := Tribe[Ship1Owner].TPhrase('SHIPDESTROYED');
1348 IconKind := mikImp;
1349 end;
1350
1351 scrTrade:
1352 begin
1353 OpenSound := 'SHIP_TRADED';
1354 Ship1Plus := false;
1355 Ship2Plus := false;
1356 for i := 0 to nShipPart - 1 do
1357 begin
1358 if Ship1Change[i] > 0 then
1359 Ship1Plus := true;
1360 if Ship2Change[i] > 0 then
1361 Ship2Plus := true;
1362 end;
1363 if Ship1Plus and Ship2Plus then
1364 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBITRADE1') + ' ' +
1365 Tribe[Ship2Owner].TPhrase('SHIPBITRADE2')
1366 else if Ship1Plus then
1367 MessgText := Tribe[Ship1Owner].TPhrase('SHIPUNITRADE1') + ' ' +
1368 Tribe[Ship2Owner].TPhrase('SHIPUNITRADE2')
1369 else // if Ship2Plus then
1370 MessgText := Tribe[Ship2Owner].TPhrase('SHIPUNITRADE1') + ' ' +
1371 Tribe[Ship1Owner].TPhrase('SHIPUNITRADE2');
1372 IconKind := mikImp;
1373 end;
1374
1375 scrCapture:
1376 begin
1377 OpenSound := 'SHIP_CAPTURED';
1378 MessgText := Tribe[Ship2Owner].TPhrase('SHIPCAPTURE1') + ' ' +
1379 Tribe[Ship1Owner].TPhrase('SHIPCAPTURE2');
1380 IconKind := mikShip;
1381 IconIndex := Ship2Owner;
1382 end
1383 end;
1384
1385 if IconKind = mikImp then
1386 begin
1387 MostCost := 0;
1388 for i := 0 to nShipPart - 1 do
1389 begin
1390 TestCost := abs(Ship1Change[i]) * Imp[imShipComp + i].Cost;
1391 if TestCost > MostCost then
1392 begin
1393 MostCost := TestCost;
1394 IconIndex := imShipComp + i
1395 end
1396 end;
1397 end;
1398
1399 Kind := mkOk;
1400 ShowModal;
1401 end;
1402 end;
1403
1404 procedure InitModule;
1405 var
1406 x, y, i, j, Domain: integer;
1407 begin
1408 { search icons for advances: }
1409 for i := 0 to nAdv - 1 do
1410 if i in FutureTech then
1411 AdvIcon[i] := 96 + i - futResearchTechnology
1412 else
1413 begin
1414 AdvIcon[i] := -1;
1415 for Domain := 0 to nDomains - 1 do
1416 for j := 0 to nUpgrade - 1 do
1417 if upgrade[Domain, j].Preq = i then
1418 if AdvIcon[i] >= 0 then
1419 AdvIcon[i] := 85
1420 else
1421 AdvIcon[i] := 86 + Domain;
1422 for j := 0 to nFeature - 1 do
1423 if Feature[j].Preq = i then
1424 for Domain := 0 to nDomains - 1 do
1425 if 1 shl Domain and Feature[j].Domains <> 0 then
1426 if (AdvIcon[i] >= 0) and (AdvIcon[i] <> 86 + Domain) then
1427 AdvIcon[i] := 85
1428 else
1429 AdvIcon[i] := 86 + Domain;
1430 for j := 28 to nImp - 1 do
1431 if Imp[j].Preq = i then
1432 AdvIcon[i] := j;
1433 for j := 28 to nImp - 1 do
1434 if (Imp[j].Preq = i) and (Imp[j].Kind <> ikCommon) then
1435 AdvIcon[i] := j;
1436 for j := 0 to nJob - 1 do
1437 if i = JobPreq[j] then
1438 AdvIcon[i] := 84;
1439 for j := 0 to 27 do
1440 if Imp[j].Preq = i then
1441 AdvIcon[i] := j;
1442 if AdvIcon[i] < 0 then
1443 if AdvValue[i] < 1000 then
1444 AdvIcon[i] := -7
1445 else
1446 AdvIcon[i] := 24 + AdvValue[i] div 1000;
1447 for j := 2 to nGov - 1 do
1448 if GovPreq[j] = i then
1449 AdvIcon[i] := j - 8;
1450 end;
1451 AdvIcon[adConscription] := 86 + dGround;
1452
1453 UnusedTribeFiles := tstringlist.Create;
1454 UnusedTribeFiles.Sorted := true;
1455 TribeNames := tstringlist.Create;
1456
1457 for x := 0 to 11 do
1458 for y := 0 to 1 do
1459 MiniColors[x, y] := GrExt[HGrSystem].Data.Canvas.Pixels
1460 [66 + x, 67 + y];
1461 IsoEngine.Init(InitEnemyModel);
1462 if not IsoEngine.ApplyTileSize(xxt, yyt) and ((xxt <> 48) or (yyt <> 24))
1463 then
1464 ApplyTileSize(48, 24);
1465 // non-default tile size is missing a file, switch to default
1466 MainMap := TIsoMap.Create;
1467 MainMap.SetOutput(offscreen);
1468
1469 HGrStdUnits := LoadGraphicSet('StdUnits');
1470 SmallImp := TBitmap.Create;
1471 SmallImp.PixelFormat := pf24bit;
1472 InitSmallImp;
1473 SoundPreloadDone := 0;
1474 StartRunning := false;
1475 StayOnTop_Ensured := false;
1476
1477 CreatePVSB(sb, Handle, 100 - 200, 122, 100 + MidPanelHeight - 16 - 200);
1478 end; { InitModule }
1479
1480 // sound blocks for preload
1481 const
1482 sbStart = $01;
1483 sbWonder = $02;
1484 sbScience = $04;
1485 sbContact = $08;
1486 sbTurn = $10;
1487 sbAll = $FF;
1488
1489 procedure SoundPreload(Check: integer);
1490 const
1491 nStartBlock = 27;
1492 StartBlock: array [0 .. nStartBlock - 1] of string = ('INVALID',
1493 'TURNEND', 'DISBAND', 'CHEAT', 'MSG_DEFAULT', 'WARNING_DISORDER',
1494 'WARNING_FAMINE', 'WARNING_LOWSUPPORT', 'WARNING_LOWFUNDS',
1495 'MOVE_MOUNTAIN', 'MOVE_LOAD', 'MOVE_UNLOAD', 'MOVE_DIE', 'NOMOVE_TIME',
1496 'NOMOVE_DOMAIN', 'NOMOVE_DEFAULT', 'CITY_SELLIMP', 'CITY_REBUILDIMP',
1497 'CITY_BUYPROJECT', 'CITY_UTILIZE', 'NEWMODEL_0', 'NEWADVANCE_0',
1498 'AGE_0', 'REVOLUTION', 'NEWGOV', 'CITY_INVALIDTYPE', 'MSG_GAMEOVER');
1499
1500 nWonderBlock = 6;
1501 WonderBlock: array [0 .. nWonderBlock - 1] of string = ('WONDER_BUILT',
1502 'WONDER_CAPTURED', 'WONDER_EXPIRED', 'WONDER_DESTROYED', 'MSG_COLDWAR',
1503 'NEWADVANCE_GRLIB');
1504
1505 nScienceBlock = 17;
1506 ScienceBlock: array [0 .. nScienceBlock - 1] of string =
1507 ('MOVE_PARACHUTE', 'MOVE_PLANESTART', 'MOVE_PLANELANDING',
1508 'MOVE_COVERT', 'NEWMODEL_1', 'NEWMODEL_2', 'NEWMODEL_3', 'NEWADVANCE_1',
1509 'NEWADVANCE_2', 'NEWADVANCE_3', 'AGE_1', 'AGE_2', 'AGE_3', 'SHIP_BUILT',
1510 'SHIP_TRADED', 'SHIP_CAPTURED', 'SHIP_DESTROYED');
1511
1512 nContactBlock = 20;
1513 ContactBlock: array [0 .. nContactBlock - 1] of string = ('NEWTREATY',
1514 'CANCELTREATY', 'ACCEPTOFFER', 'MSG_WITHDRAW', 'MSG_BANKRUPT',
1515 'CONTACT_0', 'CONTACT_1', 'CONTACT_2', 'CONTACT_3', 'CONTACT_4',
1516 'CONTACT_5', 'CONTACT_5', 'CONTACT_6', 'NEGO_REJECTED', 'MOVE_CAPTURE',
1517 'MOVE_EXPEL', 'NOMOVE_TREATY', 'NOMOVE_ZOC', 'NOMOVE_SUBMARINE',
1518 'NOMOVE_STEALTH');
1519
1520 var
1521 i, cix, mix: integer;
1522 need: boolean;
1523 mi: TModelInfo;
1524 begin
1525 if Check and sbStart and not SoundPreloadDone <> 0 then
1526 begin
1527 for i := 0 to nStartBlock - 1 do
1528 PreparePlay(StartBlock[i]);
1529 SoundPreloadDone := SoundPreloadDone or sbStart;
1530 end;
1531 if Check and sbWonder and not SoundPreloadDone <> 0 then
1532 begin
1533 need := false;
1534 for i := 0 to 27 do
1535 if MyRO.Wonder[i].CityID <> -1 then
1536 need := true;
1537 if need then
1538 begin
1539 for i := 0 to nWonderBlock - 1 do
1540 PreparePlay(WonderBlock[i]);
1541 SoundPreloadDone := SoundPreloadDone or sbWonder;
1542 end;
1543 end;
1544 if (Check and sbScience and not SoundPreloadDone <> 0) and
1545 (MyRO.Tech[adScience] >= tsApplicable) then
1546 begin
1547 for i := 0 to nScienceBlock - 1 do
1548 PreparePlay(ScienceBlock[i]);
1549 SoundPreloadDone := SoundPreloadDone or sbScience;
1550 end;
1551 if (Check and sbContact and not SoundPreloadDone <> 0) and
1552 (MyRO.nEnemyModel + MyRO.nEnemyCity > 0) then
1553 begin
1554 for i := 0 to nContactBlock - 1 do
1555 PreparePlay(ContactBlock[i]);
1556 SoundPreloadDone := SoundPreloadDone or sbContact;
1557 end;
1558 if Check and sbTurn <> 0 then
1559 begin
1560 if MyRO.Happened and phShipComplete <> 0 then
1561 PreparePlay('MSG_YOUWIN');
1562 if MyData.ToldAlive <> MyRO.Alive then
1563 PreparePlay('MSG_EXTINCT');
1564 for cix := 0 to MyRO.nCity - 1 do
1565 with MyCity[cix] do
1566 if (Loc >= 0) and (Flags and CityRepMask <> 0) then
1567 for i := 0 to 12 do
1568 if 1 shl i and Flags and CityRepMask <> 0 then
1569 PreparePlay(CityEventSoundItem[i]);
1570 for mix := 0 to MyRO.nModel - 1 do
1571 with MyModel[mix] do
1572 if Attack > 0 then
1573 begin
1574 MakeModelInfo(me, mix, MyModel[mix], mi);
1575 PreparePlay(AttackSound(ModelCode(mi)));
1576 end
1577 end
1578 end;
1579
1580 procedure InitTurn(p: integer);
1581 const
1582 nAdvBookIcon = 16;
1583 AdvBookIcon: array [0 .. nAdvBookIcon - 1] of record Adv,
1584 Icon: integer end = ((Adv: adPolyTheism; Icon: woZeus),
1585 (Adv: adBronzeWorking; Icon: woColossus), (Adv: adMapMaking;
1586 Icon: woLighthouse), (Adv: adPoetry; Icon: imTheater),
1587 (Adv: adMonotheism; Icon: woMich), (Adv: adPhilosophy; Icon: woLeo),
1588 (Adv: adTheoryOfGravity; Icon: woNewton), (Adv: adSteel;
1589 Icon: woEiffel), (Adv: adDemocracy; Icon: woLiberty),
1590 (Adv: adAutomobile; Icon: imHighways), (Adv: adSanitation;
1591 Icon: imSewer), (Adv: adElectronics; Icon: woHoover),
1592 (Adv: adNuclearFission; Icon: woManhattan), (Adv: adRecycling;
1593 Icon: imRecycling), (Adv: adComputers; Icon: imResLab),
1594 (Adv: adSpaceFlight; Icon: woMIR));
1595 var
1596 Domain, p1, i, ad, uix, cix, MoveOptions, MoveResult, Loc1, Dist,
1597 NewAgeCenterTo, Bankrupt, ShipMore, Winners, NewGovAvailable, dx,
1598 dy: integer;
1599 MoveAdviceData: TMoveAdviceData;
1600 Picture: TModelPictureInfo;
1601 s, Item, Item2: string;
1602 UpdatePanel, OwnWonder, ok, Stop, ShowCityList, WondersOnly,
1603 AllowCityScreen: boolean;
1604 begin
1605 if IsMultiPlayerGame and (p <> me) then
1606 begin
1607 UnitInfoBtn.Visible := false;
1608 UnitBtn.Visible := false;
1609 TerrainBtn.Visible := false;
1610 EOT.Visible := false;
1611 end;
1612 if IsMultiPlayerGame and (p <> me) and
1613 (G.RO[0].Happened and phShipComplete = 0) then
1614 begin // inter player screen
1615 for i := 0 to ControlCount - 1 do
1616 if Controls[i] is TButtonC then
1617 Controls[i].Visible := false;
1618 me := -1;
1619 SetMainTextureByAge(-1);
1620 with Panel.Canvas do
1621 begin
1622 Brush.Color := $000000;
1623 FillRect(Rect(0, 0, Panel.width, Panel.height));
1624 Brush.Style := bsClear;
1625 end;
1626 with TopBar.Canvas do
1627 begin
1628 Brush.Color := $000000;
1629 FillRect(Rect(0, 0, TopBar.width, TopBar.height));
1630 Brush.Style := bsClear;
1631 end;
1632 Invalidate;
1633
1634 s := TurnToString(G.RO[0].Turn);
1635 if supervising then
1636 SimpleMessage(Format(Phrases.Lookup('SUPERTURN'), [s]))
1637 else
1638 SimpleMessage(Format(Tribe[NewPlayer].TPhrase('TURN'), [s]));
1639 end;
1640 for i := 0 to ControlCount - 1 do
1641 if Controls[i] is TButtonC then
1642 Controls[i].Visible := true;
1643
1644 ItsMeAgain(p);
1645 MyData := G.RO[p].Data;
1646 if not supervising then
1647 SoundPreload(sbAll);
1648 if (me = 0) and ((MyRO.Turn = 0) or (ClientMode = cResume)) then
1649 Invalidate; // colorize empty space
1650
1651 if not supervising then
1652 begin
1653
1654 { if MyRO.Happened and phGameEnd<>0 then
1655 begin
1656 Age:=3;
1657 SetMainTextureByAge(-1);
1658 end
1659 else }
1660 begin
1661 Age := GetAge(me);
1662 if SetMainTextureByAge(Age) then
1663 EOT.Invalidate; // has visible background parts in its bounds
1664 end;
1665 // age:=MyRO.Turn mod 4; //!!!
1666 if ClientMode = cMovieTurn then
1667 EOT.ButtonIndex := eotCancel
1668 else if ClientMode < scContact then
1669 EOT.ButtonIndex := eotGray
1670 else
1671 EOT.ButtonIndex := eotBackToNego;
1672 end
1673 else
1674 begin
1675 Age := 0;
1676 SetMainTextureByAge(-1);
1677 if ClientMode = cMovieTurn then
1678 EOT.ButtonIndex := eotCancel
1679 else
1680 EOT.ButtonIndex := eotBlinkOn;
1681 end;
1682 InitCityMark(MainTexture);
1683 CityDlg.CheckAge;
1684 NatStatDlg.CheckAge;
1685 UnitStatDlg.CheckAge;
1686 HelpDlg.Difficulty := G.Difficulty[me];
1687
1688 UnFocus := -1;
1689 MarkCityLoc := -1;
1690 BlinkON := false;
1691 BlinkTime := -1;
1692 Tracking := false;
1693 TurnComplete := false;
1694
1695 if (ToldSlavery < 0) or
1696 ((ToldSlavery = 1) <> (MyRO.Wonder[woPyramids].EffectiveOwner >= 0))
1697 then
1698 begin
1699 if MyRO.Wonder[woPyramids].EffectiveOwner >= 0 then
1700 ToldSlavery := 1
1701 else
1702 ToldSlavery := 0;
1703 for p1 := 0 to nPl - 1 do
1704 if (Tribe[p1] <> nil) and (Tribe[p1].mixSlaves >= 0) then
1705 with Picture do
1706 begin // replace unit picture
1707 mix := Tribe[p1].mixSlaves;
1708 if ToldSlavery = 1 then
1709 pix := pixSlaves
1710 else
1711 pix := pixNoSlaves;
1712 Hash := 0;
1713 GrName := 'StdUnits';
1714 Tribe[p1].SetModelPicture(Picture, true);
1715 end
1716 end;
1717
1718 if not supervising and (ClientMode = cTurn) then
1719 begin
1720 for cix := 0 to MyRO.nCity - 1 do
1721 if (MyCity[cix].Loc >= 0) and
1722 ((MyRO.Turn = 0) or (MyCity[cix].Flags and chFounded <> 0)) then
1723 MyCity[cix].Status := MyCity[cix].Status and
1724 not csResourceWeightsMask or (3 shl 4);
1725 // new city, set to maximum growth
1726 end;
1727 if (ClientMode = cTurn) or (ClientMode = cContinue) then
1728 CityOptimizer_BeginOfTurn; // maybe peace was made or has ended
1729 SumCities(TaxSum, ScienceSum);
1730
1731 if ClientMode = cMovieTurn then
1732 begin
1733 UnitInfoBtn.Visible := false;
1734 UnitBtn.Visible := false;
1735 TerrainBtn.Visible := false;
1736 EOT.Hint := Phrases.Lookup('BTN_STOP');
1737 EOT.Visible := true;
1738 end
1739 else if ClientMode < scContact then
1740 begin
1741 UnitInfoBtn.Visible := UnFocus >= 0;
1742 UnitBtn.Visible := UnFocus >= 0;
1743 CheckTerrainBtnVisible;
1744 TurnComplete := supervising;
1745 EOT.Hint := Phrases.Lookup('BTN_ENDTURN');
1746 EOT.Visible := Server(sTurn - sExecute, me, 0, nil^) >= rExecuted;
1747 end
1748 else
1749 begin
1750 UnitInfoBtn.Visible := false;
1751 UnitBtn.Visible := false;
1752 TerrainBtn.Visible := false;
1753 EOT.Hint := Phrases.Lookup('BTN_NEGO');
1754 EOT.Visible := true;
1755 end;
1756 SetTroopLoc(-1);
1757 MapValid := false;
1758 NewAgeCenterTo := 0;
1759 if ((MyRO.Turn = 0) and not supervising or IsMultiPlayerGame or
1760 (ClientMode = cResume)) and (MyRO.nCity > 0) then
1761 begin
1762 Loc1 := MyCity[0].Loc;
1763 if (ClientMode = cTurn) and (MyRO.Turn = 0) then
1764 begin // move city out of center to not be covered by welcome screen
1765 dx := MapWidth div (xxt * 5);
1766 if dx > 5 then
1767 dx := 5;
1768 dy := MapHeight div (yyt * 5);
1769 if dy > 5 then
1770 dy := 5;
1771 if Loc1 >= G.lx * G.ly div 2 then
1772 begin
1773 NewAgeCenterTo := -1;
1774 Loc1 := dLoc(Loc1, -dx, -dy)
1775 end
1776 else
1777 begin
1778 NewAgeCenterTo := 1;
1779 Loc1 := dLoc(Loc1, -dx, dy);
1780 end
1781 end;
1782 Centre(Loc1)
1783 end;
1784
1785 for i := 0 to Screen.FormCount - 1 do
1786 if Screen.Forms[i] is TBufferedDrawDlg then
1787 Screen.Forms[i].Enabled := true;
1788
1789 if ClientMode <> cResume then
1790 begin
1791 PaintAll;
1792 if (MyRO.Happened and phChangeGov <> 0) and (MyRO.NatBuilt[imPalace] > 0)
1793 then
1794 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, imPalace,
1795 gAnarchy { , GameMode<>cMovie } );
1796 // first turn after anarchy -- don't show despotism palace!
1797 Update;
1798 for i := 0 to Screen.FormCount - 1 do
1799 if (Screen.Forms[i].Visible) and (Screen.Forms[i] is TBufferedDrawDlg)
1800 then
1801 begin
1802 if @Screen.Forms[i].OnShow <> nil then
1803 Screen.Forms[i].OnShow(nil);
1804 Screen.Forms[i].Invalidate;
1805 Screen.Forms[i].Update;
1806 end;
1807
1808 if MyRO.Happened and phGameEnd <> 0 then
1809 with MessgExDlg do
1810 begin // game ended
1811 if MyRO.Happened and phExtinct <> 0 then
1812 begin
1813 OpenSound := 'MSG_GAMEOVER';
1814 MessgText := Tribe[me].TPhrase('GAMEOVER');
1815 IconKind := mikBigIcon;
1816 IconIndex := 8;
1817 end
1818 else if MyRO.Happened and phShipComplete <> 0 then
1819 begin
1820 Winners := 0;
1821 for p1 := 0 to nPl - 1 do
1822 if 1 shl p1 and MyRO.Alive <> 0 then
1823 begin
1824 Winners := Winners or 1 shl p1;
1825 for i := 0 to nShipPart - 1 do
1826 if MyRO.Ship[p1].Parts[i] < ShipNeed[i] then
1827 Winners := Winners and not(1 shl p1);
1828 end;
1829 assert(Winners <> 0);
1830 if Winners and (1 shl me) <> 0 then
1831 begin
1832 s := '';
1833 for p1 := 0 to nPl - 1 do
1834 if (p1 <> me) and (1 shl p1 and Winners <> 0) then
1835 if s = '' then
1836 s := Tribe[p1].TPhrase('SHORTNAME')
1837 else
1838 s := Format(Phrases.Lookup('SHAREDWIN_CONCAT'),
1839 [s, Tribe[p1].TPhrase('SHORTNAME')]);
1840
1841 OpenSound := 'MSG_YOUWIN';
1842 MessgText := Tribe[me].TPhrase('MYSPACESHIP');
1843 if s <> '' then
1844 MessgText := MessgText + '\' +
1845 Format(Phrases.Lookup('SHAREDWIN'), [s]);
1846 IconKind := mikBigIcon;
1847 IconIndex := 9;
1848 end
1849 else
1850 begin
1851 assert(me = 0);
1852 OpenSound := 'MSG_GAMEOVER';
1853 MessgText := '';
1854 for p1 := 0 to nPl - 1 do
1855 if Winners and (1 shl p1) <> 0 then
1856 MessgText := MessgText + Tribe[p1].TPhrase('SPACESHIP1');
1857 MessgText := MessgText + '\' + Phrases.Lookup('SPACESHIP2');
1858 IconKind := mikEnemyShipComplete;
1859 end
1860 end
1861 else { if MyRO.Happened and fTimeUp<>0 then }
1862 begin
1863 assert(me = 0);
1864 OpenSound := 'MSG_GAMEOVER';
1865 if not supervising then
1866 MessgText := Tribe[me].TPhrase('TIMEUP')
1867 else
1868 MessgText := Phrases.Lookup('TIMEUPSUPER');
1869 IconKind := mikImp;
1870 IconIndex := 22;
1871 end;
1872 Kind := mkOk;
1873 ShowModal;
1874 if MyRO.Happened and phExtinct = 0 then
1875 begin
1876 p1 := 0;
1877 while (p1 < nPl - 1) and (Winners and (1 shl p1) = 0) do
1878 inc(p1);
1879 if MyRO.Happened and phShipComplete = 0 then
1880 DiaDlg.ShowNewContent_Charts(wmModal);
1881 end;
1882 TurnComplete := true;
1883 exit;
1884 end;
1885 if not supervising and (1 shl me and MyRO.Alive = 0) then
1886 begin
1887 TurnComplete := true;
1888 exit;
1889 end;
1890
1891 if (ClientMode = cContinue) and
1892 (DipMem[me].SentCommand and $FF0F = scContact) then
1893 // contact was refused
1894 if MyRO.Treaty[DipMem[me].pContact] >= trPeace then
1895 ContactRefused(DipMem[me].pContact, 'FRREJECTED')
1896 else
1897 SoundMessage(Tribe[DipMem[me].pContact].TPhrase('FRREJECTED'),
1898 'NEGO_REJECTED');
1899
1900 if not supervising and (Age > MyData.ToldAge) and
1901 ((Age > 0) or (ClientMode <> cMovieTurn)) then
1902 with MessgExDlg do
1903 begin
1904 if Age = 0 then
1905 begin
1906 if Phrases2FallenBackToEnglish then
1907 begin
1908 s := Tribe[me].TPhrase('AGE0');
1909 MessgText :=
1910 Format(s, [TurnToString(MyRO.Turn), CityName(MyCity[0].ID)])
1911 end
1912 else
1913 begin
1914 s := Tribe[me].TString(Phrases2.Lookup('AGE0'));
1915 MessgText := Format(s, [TurnToString(MyRO.Turn)]);
1916 end
1917 end
1918 else
1919 begin
1920 s := Tribe[me].TPhrase('AGE' + char(48 + Age));
1921 MessgText := Format(s, [TurnToString(MyRO.Turn)]);
1922 end;
1923 IconKind := mikAge;
1924 IconIndex := Age;
1925 { if age=0 then } Kind := mkOk
1926 { else begin Kind:=mkOkHelp; HelpKind:=hkAdv; HelpNo:=AgePreq[age]; end };
1927 CenterTo := NewAgeCenterTo;
1928 OpenSound := 'AGE_' + char(48 + Age);
1929 ShowModal;
1930 MyData.ToldAge := Age;
1931 if Age > 0 then
1932 MyData.ToldTech[AgePreq[Age]] := MyRO.Tech[AgePreq[Age]];
1933 end;
1934
1935 if MyData.ToldAlive <> MyRO.Alive then
1936 begin
1937 for p1 := 0 to nPl - 1 do
1938 if (MyData.ToldAlive - MyRO.Alive) and (1 shl p1) <> 0 then
1939 with MessgExDlg do
1940 begin
1941 OpenSound := 'MSG_EXTINCT';
1942 s := Tribe[p1].TPhrase('EXTINCT');
1943 MessgText := Format(s, [TurnToString(MyRO.Turn)]);
1944 if MyRO.Alive = 1 shl me then
1945 MessgText := MessgText + Phrases.Lookup('EXTINCTALL');
1946 Kind := mkOk;
1947 IconKind := mikImp;
1948 IconIndex := 21;
1949 ShowModal;
1950 end;
1951 if (ClientMode <> cMovieTurn) and not supervising then
1952 DiaDlg.ShowNewContent_Charts(wmModal);
1953 end;
1954
1955 // tell changes of own credibility
1956 if not supervising then
1957 begin
1958 if RoughCredibility(MyRO.Credibility) <>
1959 RoughCredibility(MyData.ToldOwnCredibility) then
1960 begin
1961 if RoughCredibility(MyRO.Credibility) >
1962 RoughCredibility(MyData.ToldOwnCredibility) then
1963 s := Phrases.Lookup('CREDUP')
1964 else
1965 s := Phrases.Lookup('CREDDOWN');
1966 TribeMessage(me,
1967 Format(s, [Phrases.Lookup('CREDIBILITY',
1968 RoughCredibility(MyRO.Credibility))]), '');
1969 end;
1970 MyData.ToldOwnCredibility := MyRO.Credibility;
1971 end;
1972
1973 for i := 0 to 27 do
1974 begin
1975 OwnWonder := false;
1976 for cix := 0 to MyRO.nCity - 1 do
1977 if (MyCity[cix].Loc >= 0) and
1978 (MyCity[cix].ID = MyRO.Wonder[i].CityID) then
1979 OwnWonder := true;
1980 if MyRO.Wonder[i].CityID <> MyData.ToldWonders[i].CityID then
1981 begin
1982 if MyRO.Wonder[i].CityID = -2 then
1983 with MessgExDlg do
1984 begin { tell about destroyed wonders }
1985 OpenSound := 'WONDER_DESTROYED';
1986 MessgText := Format(Phrases.Lookup('WONDERDEST'),
1987 [Phrases.Lookup('IMPROVEMENTS', i)]);
1988 Kind := mkOkHelp;
1989 HelpKind := hkImp;
1990 HelpNo := i;
1991 IconKind := mikImp;
1992 IconIndex := i;
1993 ShowModal;
1994 end
1995 else
1996 begin
1997 if i = woManhattan then
1998 if MyRO.Wonder[i].EffectiveOwner > me then
1999 MyData.ColdWarStart := MyRO.Turn - 1
2000 else
2001 MyData.ColdWarStart := MyRO.Turn;
2002 if not OwnWonder then
2003 with MessgExDlg do
2004 begin { tell about newly built wonders }
2005 if i = woManhattan then
2006 begin
2007 OpenSound := 'MSG_COLDWAR';
2008 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('COLDWAR')
2009 end
2010 else if MyRO.Wonder[i].EffectiveOwner >= 0 then
2011 begin
2012 OpenSound := 'WONDER_BUILT';
2013 s := Tribe[MyRO.Wonder[i].EffectiveOwner]
2014 .TPhrase('WONDERBUILT')
2015 end
2016 else
2017 begin
2018 OpenSound := 'MSG_DEFAULT';
2019 s := Phrases.Lookup('WONDERBUILTEXP');
2020 // already expired when built
2021 end;
2022 MessgText := Format(s, [Phrases.Lookup('IMPROVEMENTS', i),
2023 CityName(MyRO.Wonder[i].CityID)]);
2024 Kind := mkOkHelp;
2025 HelpKind := hkImp;
2026 HelpNo := i;
2027 IconKind := mikImp;
2028 IconIndex := i;
2029 ShowModal;
2030 end
2031 end
2032 end
2033 else if (MyRO.Wonder[i].EffectiveOwner <> MyData.ToldWonders[i]
2034 .EffectiveOwner) and (MyRO.Wonder[i].CityID > -2) then
2035 if MyRO.Wonder[i].EffectiveOwner < 0 then
2036 begin
2037 if i <> woMIR then
2038 with MessgExDlg do
2039 begin { tell about expired wonders }
2040 OpenSound := 'WONDER_EXPIRED';
2041 MessgText := Format(Phrases.Lookup('WONDEREXP'),
2042 [Phrases.Lookup('IMPROVEMENTS', i),
2043 CityName(MyRO.Wonder[i].CityID)]);
2044 Kind := mkOkHelp;
2045 HelpKind := hkImp;
2046 HelpNo := i;
2047 IconKind := mikImp;
2048 IconIndex := i;
2049 ShowModal;
2050 end
2051 end
2052 else if (MyData.ToldWonders[i].EffectiveOwner >= 0) and not OwnWonder
2053 then
2054 with MessgExDlg do
2055 begin { tell about capture of wonders }
2056 OpenSound := 'WONDER_CAPTURED';
2057 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('WONDERCAPT');
2058 MessgText := Format(s, [Phrases.Lookup('IMPROVEMENTS', i),
2059 CityName(MyRO.Wonder[i].CityID)]);
2060 Kind := mkOkHelp;
2061 HelpKind := hkImp;
2062 HelpNo := i;
2063 IconKind := mikImp;
2064 IconIndex := i;
2065 ShowModal;
2066 end;
2067 end;
2068
2069 if MyRO.Turn = MyData.ColdWarStart + ColdWarTurns then
2070 begin
2071 SoundMessageEx(Phrases.Lookup('COLDWAREND'), 'MSG_DEFAULT');
2072 MyData.ColdWarStart := -ColdWarTurns - 1
2073 end;
2074
2075 TellNewModels;
2076 end; // ClientMode<>cResume
2077 MyData.ToldAlive := MyRO.Alive;
2078 move(MyRO.Wonder, MyData.ToldWonders, SizeOf(MyData.ToldWonders));
2079
2080 NewGovAvailable := -1;
2081 if ClientMode <> cResume then
2082 begin // tell about new techs
2083 for ad := 0 to nAdv - 1 do
2084 if (MyRO.TestFlags and tfAllTechs = 0) and
2085 ((MyRO.Tech[ad] >= tsApplicable) <>
2086 (MyData.ToldTech[ad] >= tsApplicable)) or (ad in FutureTech) and
2087 (MyRO.Tech[ad] <> MyData.ToldTech[ad]) then
2088 with MessgExDlg do
2089 begin
2090 Item := 'RESEARCH_GENERAL';
2091 if GameMode <> cMovie then
2092 OpenSound := 'NEWADVANCE_' + char(48 + Age);
2093 Item2 := Phrases.Lookup('ADVANCES', ad);
2094 if ad in FutureTech then
2095 Item2 := Item2 + ' ' + IntToStr(MyRO.Tech[ad]);
2096 MessgText := Format(Phrases.Lookup(Item), [Item2]);
2097 Kind := mkOkHelp;
2098 HelpKind := hkAdv;
2099 HelpNo := ad;
2100 IconKind := mikBook;
2101 IconIndex := -1;
2102 for i := 0 to nAdvBookIcon - 1 do
2103 if AdvBookIcon[i].Adv = ad then
2104 IconIndex := AdvBookIcon[i].Icon;
2105 ShowModal;
2106 MyData.ToldTech[ad] := MyRO.Tech[ad];
2107 for i := gMonarchy to nGov - 1 do
2108 if GovPreq[i] = ad then
2109 NewGovAvailable := i;
2110 end;
2111 end;
2112
2113 ShowCityList := false;
2114 if ClientMode = cTurn then
2115 begin
2116 if (MyRO.Happened and phTech <> 0) and (MyData.FarTech <> adNexus) then
2117 ChooseResearch;
2118
2119 UpdatePanel := false;
2120 if MyRO.Happened and phChangeGov <> 0 then
2121 begin
2122 ModalSelectDlg.ShowNewContent(wmModal, kGov);
2123 Play('NEWGOV');
2124 Server(sSetGovernment, me, ModalSelectDlg.result, nil^);
2125 CityOptimizer_BeginOfTurn;
2126 UpdatePanel := true;
2127 end;
2128 end; // ClientMode=cTurn
2129
2130 if not supervising and ((ClientMode = cTurn) or (ClientMode = cMovieTurn))
2131 then
2132 for cix := 0 to MyRO.nCity - 1 do
2133 with MyCity[cix] do
2134 Status := Status and not csToldBombard;
2135
2136 if ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) and
2137 (MyRO.Government <> gAnarchy) then
2138 begin
2139 // tell what happened in cities
2140 for WondersOnly := true downto false do
2141 for cix := 0 to MyRO.nCity - 1 do
2142 with MyCity[cix] do
2143 if (MyRO.Turn > 0) and (Loc >= 0) and (Flags and chCaptured = 0)
2144 and (WondersOnly = (Flags and chProduction <> 0) and
2145 (Project0 and cpImp <> 0) and (Project0 and cpIndex < 28)) then
2146 begin
2147 if WondersOnly then
2148 with MessgExDlg do
2149 begin { tell about newly built wonder }
2150 OpenSound := 'WONDER_BUILT';
2151 s := Tribe[me].TPhrase('WONDERBUILTOWN');
2152 MessgText :=
2153 Format(s, [Phrases.Lookup('IMPROVEMENTS',
2154 Project0 and cpIndex), CityName(ID)]);
2155 Kind := mkOkHelp;
2156 HelpKind := hkImp;
2157 HelpNo := Project0 and cpIndex;
2158 IconKind := mikImp;
2159 IconIndex := Project0 and cpIndex;
2160 ShowModal;
2161 end;
2162 if not supervising and (ClientMode = cTurn) then
2163 begin
2164 AllowCityScreen := true;
2165 if (Status and 7 <> 0) and
2166 (Project and (cpImp + cpIndex) = cpImp + imTrGoods) then
2167 if (MyData.ImpOrder[Status and 7 - 1, 0] >= 0) then
2168 begin
2169 if AutoBuild(cix, MyData.ImpOrder[Status and 7 - 1]) then
2170 AllowCityScreen := false
2171 else if Flags and chProduction <> 0 then
2172 Flags := (Flags and not chProduction) or chAllImpsMade
2173 end
2174 else
2175 Flags := Flags or chTypeDel;
2176 if (Size >= NeedAqueductSize) and
2177 (MyRO.Tech[Imp[imAqueduct].Preq] < tsApplicable) or
2178 (Size >= NeedSewerSize) and
2179 (MyRO.Tech[Imp[imSewer].Preq] < tsApplicable) then
2180 Flags := Flags and not chNoGrowthWarning;
2181 // don't remind of unknown building
2182 if Flags and chNoSettlerProd = 0 then
2183 Status := Status and not csToldDelay
2184 else if Status and csToldDelay = 0 then
2185 Status := Status or csToldDelay
2186 else
2187 Flags := Flags and not chNoSettlerProd;
2188 if mRepScreens.Checked then
2189 begin
2190 if (Flags and CityRepMask <> 0) and AllowCityScreen then
2191 begin { show what happened in cities }
2192 SetTroopLoc(MyCity[cix].Loc);
2193 MarkCityLoc := MyCity[cix].Loc;
2194 PanelPaint;
2195 CityDlg.CloseAction := None;
2196 CityDlg.ShowNewContent(wmModal, MyCity[cix].Loc,
2197 Flags and CityRepMask);
2198 UpdatePanel := true;
2199 end
2200 end
2201 else { if mRepList.Checked then }
2202 begin
2203 if Flags and CityRepMask <> 0 then
2204 ShowCityList := true
2205 end
2206 end
2207 end; { city loop }
2208 end; // ClientMode=cTurn
2209
2210 if ClientMode = cTurn then
2211 begin
2212 if NewGovAvailable >= 0 then
2213 with MessgExDlg do
2214 begin
2215 MessgText := Format(Phrases.Lookup('AUTOREVOLUTION'),
2216 [Phrases.Lookup('GOVERNMENT', NewGovAvailable)]);
2217 Kind := mkYesNo;
2218 IconKind := mikPureIcon;
2219 IconIndex := 6 + NewGovAvailable;
2220 ShowModal;
2221 if ModalResult = mrOK then
2222 begin
2223 Play('REVOLUTION');
2224 Server(sRevolution, me, 0, nil^);
2225 end
2226 end;
2227 end; // ClientMode=cTurn
2228
2229 if (ClientMode = cTurn) or (ClientMode = cMovieTurn) then
2230 begin
2231 if MyRO.Happened and phGliderLost <> 0 then
2232 ContextMessage(Phrases.Lookup('GLIDERLOST'), 'MSG_DEFAULT',
2233 hkModel, 200);
2234 if MyRO.Happened and phPlaneLost <> 0 then
2235 ContextMessage(Phrases.Lookup('PLANELOST'), 'MSG_DEFAULT',
2236 hkFeature, mcFuel);
2237 if MyRO.Happened and phPeaceEvacuation <> 0 then
2238 for p1 := 0 to nPl - 1 do
2239 if 1 shl p1 and MyData.PeaceEvaHappened <> 0 then
2240 SoundMessageEx(Tribe[p1].TPhrase('WITHDRAW'), 'MSG_DEFAULT');
2241 if MyRO.Happened and phPeaceViolation <> 0 then
2242 for p1 := 0 to nPl - 1 do
2243 if (1 shl p1 and MyRO.Alive <> 0) and (MyRO.EvaStart[p1] = MyRO.Turn)
2244 then
2245 SoundMessageEx(Format(Tribe[p1].TPhrase('VIOLATION'),
2246 [TurnToString(MyRO.Turn + PeaceEvaTurns - 1)]), 'MSG_WITHDRAW');
2247 TellNewContacts;
2248 end;
2249
2250 if ClientMode = cMovieTurn then
2251 Update
2252 else if ClientMode = cTurn then
2253 begin
2254 if UpdatePanel then
2255 UpdateViews;
2256 Application.ProcessMessages;
2257
2258 if not supervising then
2259 for uix := 0 to MyRO.nUn - 1 do
2260 with MyUn[uix] do
2261 if Loc >= 0 then
2262 begin
2263 if Flags and unWithdrawn <> 0 then
2264 Status := 0;
2265 if Health = 100 then
2266 Status := Status and not usRecover;
2267 if (Master >= 0) or UnitExhausted(uix) then
2268 Status := Status and not usWaiting
2269 else
2270 Status := Status or usWaiting;
2271 CheckToldNoReturn(uix);
2272 if Status and usGoto <> 0 then
2273 begin { continue multi-turn goto }
2274 SetUnFocus(uix);
2275 SetTroopLoc(Loc);
2276 FocusOnLoc(TroopLoc, flRepaintPanel or flImmUpdate);
2277 if Status shr 16 = $7FFF then
2278 MoveResult := GetMoveAdvice(UnFocus, maNextCity,
2279 MoveAdviceData)
2280 else
2281 MoveResult := GetMoveAdvice(UnFocus, Status shr 16,
2282 MoveAdviceData);
2283 if MoveResult >= rExecuted then
2284 begin // !!! Shinkansen
2285 MoveResult := eOK;
2286 ok := true;
2287 for i := 0 to MoveAdviceData.nStep - 1 do
2288 begin
2289 Loc1 := dLoc(Loc, MoveAdviceData.dx[i],
2290 MoveAdviceData.dy[i]);
2291 if (MyMap[Loc1] and (fCity or fOwned) = fCity)
2292 // don't capture cities during auto move
2293 or (MyMap[Loc1] and (fUnit or fOwned) = fUnit) then
2294 // don't attack during auto move
2295 begin
2296 ok := false;
2297 Break
2298 end
2299 else
2300 begin
2301 if (Loc1 = MoveAdviceData.ToLoc) or
2302 (MoveAdviceData.ToLoc = maNextCity) and
2303 (MyMap[dLoc(Loc, MoveAdviceData.dx[i],
2304 MoveAdviceData.dy[i])] and fCity <> 0) then
2305 MoveOptions := muAutoNoWait
2306 else
2307 MoveOptions := 0;
2308 MoveResult := MoveUnit(MoveAdviceData.dx[i],
2309 MoveAdviceData.dy[i], MoveOptions);
2310 if (MoveResult < rExecuted) or
2311 (MoveResult = eEnemySpotted) then
2312 begin
2313 ok := false;
2314 Break
2315 end;
2316 end
2317 end;
2318 Stop := not ok or (Loc = MoveAdviceData.ToLoc) or
2319 (MoveAdviceData.ToLoc = maNextCity) and
2320 (MyMap[Loc] and fCity <> 0)
2321 end
2322 else
2323 begin
2324 MoveResult := eOK;
2325 Stop := true;
2326 end;
2327
2328 if MoveResult <> eDied then
2329 if Stop then
2330 Status := Status and ($FFFF - usGoto)
2331 else
2332 Status := Status and not usWaiting;
2333 end;
2334
2335 if Status and (usEnhance or usGoto) = usEnhance then
2336 // continue terrain enhancement
2337 begin
2338 MoveResult := ProcessEnhancement(uix, MyData.EnhancementJobs);
2339 if MoveResult <> eDied then
2340 if MoveResult = eJobDone then
2341 Status := Status and not usEnhance
2342 else
2343 Status := Status and not usWaiting;
2344 end
2345 end;
2346 end; // ClientMode=cTurn
2347
2348 HaveStrategyAdvice := false;
2349 // (GameMode<>cMovie) and not supervising
2350 // and AdvisorDlg.HaveStrategyAdvice;
2351 GoOnPhase := true;
2352 if supervising or (GameMode = cMovie) then
2353 begin
2354 SetTroopLoc(-1);
2355 PaintAll
2356 end { supervisor }
2357 { else if (ClientMode=cTurn) and (MyRO.Turn=0) then
2358 begin
2359 SetUnFocus(0);
2360 ZoomToCity(MyCity[0].Loc)
2361 end }
2362 else
2363 begin
2364 if ClientMode >= scContact then
2365 SetUnFocus(-1)
2366 else
2367 NextUnit(-1, false);
2368 if UnFocus < 0 then
2369 begin
2370 UnStartLoc := -1;
2371 if IsMultiPlayerGame or (ClientMode = cResume) then
2372 if MyRO.nCity > 0 then
2373 FocusOnLoc(MyCity[0].Loc)
2374 else
2375 FocusOnLoc(G.lx * G.ly div 2);
2376 SetTroopLoc(-1);
2377 PanelPaint
2378 end;
2379 if ShowCityList then
2380 ListDlg.ShowNewContent(wmPersistent, kCityEvents);
2381 end;
2382 end; { InitTurn }
2383
2384 var
2385 i, j, p1, mix, ToLoc, AnimationSpeed, ShowMoveDomain, cix, ecix: integer;
2386 Color: TColor;
2387 Name, s: string;
2388 TribeInfo: TTribeInfo;
2389 mi: TModelInfo;
2390 SkipTurn, IsAlpine, IsTreatyDeal: boolean;
2391
2392 begin { >>>client }
2393 case Command of
2394 cTurn, cResume, cContinue, cMovieTurn, scContact,
2395 scDipStart .. scDipBreak:
2396 begin
2397 supervising := G.Difficulty[NewPlayer] = 0;
2398 ArrangeMidPanel;
2399 end
2400 end;
2401 case Command of
2402 cDebugMessage:
2403 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(@Data));
2404
2405 cShowNego:
2406 with TShowNegoData(Data) do
2407 begin
2408 s := Format('P%d to P%d: ', [pSender, pTarget]);
2409 if (Action = scDipOffer) and (Offer.nDeliver + Offer.nCost > 0) then
2410 begin
2411 s := s + 'Offer ';
2412 for i := 0 to Offer.nDeliver + Offer.nCost - 1 do
2413 begin
2414 if i = Offer.nDeliver then
2415 s := s + ' for '
2416 else if i > 0 then
2417 s := s + '+';
2418 case Offer.Price[i] and opMask of
2419 opChoose:
2420 s := s + 'Price of choice';
2421 opCivilReport:
2422 s := s + 'State report';
2423 opMilReport:
2424 s := s + 'Military report';
2425 opMap:
2426 s := s + 'Map';
2427 opTreaty:
2428 s := s + 'Treaty';
2429 opShipParts:
2430 s := s + 'Ship part';
2431 opMoney:
2432 s := s + IntToStr(Offer.Price[i] and $FFFFFF) + 'o';
2433 opTribute:
2434 s := s + IntToStr(Offer.Price[i] and $FFFFFF) + 'o tribute';
2435 opTech:
2436 s := s + Phrases.Lookup('ADVANCES',
2437 Offer.Price[i] and $FFFFFF);
2438 opAllTech:
2439 s := s + 'All advances';
2440 opModel:
2441 s := s + Tribe[pSender].ModelName[Offer.Price[i] and $FFFFFF];
2442 opAllModel:
2443 s := s + 'All models';
2444 end
2445 end;
2446 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s));
2447 end
2448 else if Action = scDipAccept then
2449 begin
2450 s := s + '--- ACCEPTED! ---';
2451 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s));
2452 end
2453 end;
2454
2455 cInitModule:
2456 begin
2457 Server := TInitModuleData(Data).Server;
2458 // AdvisorDlg.Init;
2459 InitModule;
2460 TInitModuleData(Data).DataSize := SizeOf(TPersistentData);
2461 TInitModuleData(Data).Flags := aiThreaded;
2462 end;
2463
2464 cReleaseModule:
2465 begin
2466 SmallImp.free;
2467 UnusedTribeFiles.free;
2468 TribeNames.free;
2469 MainMap.free;
2470 IsoEngine.Done;
2471 // AdvisorDlg.DeInit;
2472 end;
2473
2474 cHelpOnly, cStartHelp, cStartCredits:
2475 begin
2476 Age := 0;
2477 if Command = cHelpOnly then
2478 SetMainTextureByAge(-1);
2479 Tribes.Init;
2480 HelpDlg.UserLeft := (Screen.width - HelpDlg.width) div 2;
2481 HelpDlg.UserTop := (Screen.height - HelpDlg.height) div 2;
2482 HelpDlg.Difficulty := 0;
2483 if Command = cStartCredits then
2484 HelpDlg.ShowNewContent(wmModal, hkMisc, miscCredits)
2485 else
2486 HelpDlg.ShowNewContent(wmModal, hkMisc, miscMain);
2487 Tribes.Done;
2488 end;
2489
2490 cNewGame, cLoadGame, cMovie, cNewMap:
2491 begin
2492 { if (Command=cNewGame) or (Command=cLoadGame) then
2493 AdvisorDlg.NewGame(Data); }
2494 GenerateNames := mNames.Checked;
2495 GameOK := true;
2496 G := TNewGameData(Data);
2497 me := -1;
2498 pLogo := -1;
2499 ClientMode := -1;
2500 SetMapOptions;
2501 IsoEngine.pDebugMap := -1;
2502 idle := false;
2503 FillChar(Jump, SizeOf(Jump), 0);
2504 if StartRunning then
2505 Jump[0] := 999999;
2506 GameMode := Command;
2507 for i := 0 to nGrExt - 1 do
2508 FillChar(GrExt[i].pixUsed, GrExt[i].Data.height div 49 * 10, 0);
2509 IsoEngine.Reset;
2510 Tribes.Init;
2511 GetTribeList;
2512 for p1 := 0 to nPl - 1 do
2513 if (G.RO[p1] <> nil) and (G.RO[p1].Data <> nil) then
2514 with TPersistentData(G.RO[p1].Data^) do
2515 begin
2516 FarTech := adNone;
2517 FillChar(EnhancementJobs, SizeOf(EnhancementJobs), jNone);
2518 FillChar(ImpOrder, SizeOf(ImpOrder), Byte(-1));
2519 ColdWarStart := -ColdWarTurns - 1;
2520 ToldAge := -1;
2521 ToldModels := 3;
2522 ToldAlive := 0;
2523 ToldContact := 0;
2524 ToldOwnCredibility := InitialCredibility;
2525 for i := 0 to nPl - 1 do
2526 if G.Difficulty[i] > 0 then
2527 inc(ToldAlive, 1 shl i);
2528 PeaceEvaHappened := 0;
2529 for i := 0 to 27 do
2530 with ToldWonders[i] do
2531 begin
2532 CityID := -1;
2533 EffectiveOwner := -1
2534 end;
2535 FillChar(ToldTech, SizeOf(ToldTech), Byte(tsNA));
2536 if G.Difficulty[p1] > 0 then
2537 SoundPreload(sbStart);
2538 end;
2539
2540 // arrange dialogs
2541 ListDlg.UserLeft := 8;
2542 ListDlg.UserTop := TopBarHeight + 8;
2543 HelpDlg.UserLeft := Screen.width - HelpDlg.width - 8;
2544 HelpDlg.UserTop := TopBarHeight + 8;
2545 UnitStatDlg.UserLeft := 397;
2546 UnitStatDlg.UserTop := TopBarHeight + 64;
2547 DiaDlg.UserLeft := (Screen.width - DiaDlg.width) div 2;
2548 DiaDlg.UserTop := (Screen.height - DiaDlg.height) div 2;
2549 NatStatDlg.UserLeft := Screen.width - NatStatDlg.width - 8;
2550 NatStatDlg.UserTop := Screen.height - PanelHeight -
2551 NatStatDlg.height - 8;
2552 if NatStatDlg.UserTop < 8 then
2553 NatStatDlg.UserTop := 8;
2554
2555 Age := 0;
2556 MovieSpeed := 1;
2557 LogDlg.mSlot.Visible := true;
2558 LogDlg.Host := self;
2559 HelpDlg.ClearHistory;
2560 CityDlg.Reset;
2561
2562 Mini.width := G.lx * 2;
2563 Mini.height := G.ly;
2564 for i := 0 to nPl - 1 do
2565 begin
2566 Tribe[i] := nil;
2567 TribeOriginal[i] := false;
2568 end;
2569 ToldSlavery := -1;
2570 RepaintOnResize := false;
2571 Closable := false;
2572 FirstMovieTurn := true;
2573
2574 MenuArea.Visible := GameMode <> cMovie;
2575 TreasuryArea.Visible := GameMode < cMovie;
2576 ResearchArea.Visible := GameMode < cMovie;
2577 ManagementArea.Visible := GameMode < cMovie;
2578 end;
2579
2580 cGetReady, cReplay:
2581 if NewPlayer = 0 then
2582 begin
2583 i := 0;
2584 for p1 := 0 to nPl - 1 do
2585 if (G.Difficulty[p1] > 0) and (Tribe[p1] = nil) then
2586 inc(i);
2587 if i > UnusedTribeFiles.Count then
2588 begin
2589 GameOK := false;
2590 SimpleMessage(Phrases.Lookup('TOOFEWTRIBES'));
2591 end
2592 else
2593 begin
2594 for p1 := 0 to nPl - 1 do
2595 if (G.Difficulty[p1] > 0) and (Tribe[p1] = nil) and
2596 (G.RO[p1] <> nil) then
2597 begin // let player select own tribes
2598 TribeInfo.trix := p1;
2599 TribeNames.Clear;
2600 for j := 0 to UnusedTribeFiles.Count - 1 do
2601 begin
2602 GetTribeInfo(UnusedTribeFiles[j], Name, Color);
2603 TribeNames.AddObject(Name, TObject(Color));
2604 end;
2605 assert(TribeNames.Count > 0);
2606 ModalSelectDlg.ShowNewContent(wmModal, kTribe);
2607 Application.ProcessMessages;
2608 TribeInfo.FileName := UnusedTribeFiles[ModalSelectDlg.result];
2609 UnusedTribeFiles.Delete(ModalSelectDlg.result);
2610
2611 if GameMode = cLoadGame then
2612 CreateTribe(TribeInfo.trix, TribeInfo.FileName, false)
2613 else
2614 Server(cSetTribe + (Length(TribeInfo.FileName) + 1 + 7) div 4,
2615 0, 0, TribeInfo);
2616 end;
2617
2618 for p1 := 0 to nPl - 1 do
2619 if (G.Difficulty[p1] > 0) and (Tribe[p1] = nil) and
2620 (G.RO[p1] = nil) then
2621 begin // autoselect enemy tribes
2622 j := ChooseUnusedTribe;
2623 TribeInfo.FileName := UnusedTribeFiles[j];
2624 UnusedTribeFiles.Delete(j);
2625 TribeInfo.trix := p1;
2626 if GameMode = cLoadGame then
2627 CreateTribe(TribeInfo.trix, TribeInfo.FileName, false)
2628 else
2629 Server(cSetTribe + (Length(TribeInfo.FileName) + 1 + 7) div 4,
2630 0, 0, TribeInfo);
2631 end;
2632 end;
2633 if not mNames.Checked then
2634 for p1 := 0 to nPl - 1 do
2635 if Tribe[p1] <> nil then
2636 Tribe[p1].NumberName := p1;
2637 end;
2638
2639 cBreakGame:
2640 begin
2641 SaveSettings;
2642 CityDlg.CloseAction := None;
2643 for i := 0 to Screen.FormCount - 1 do
2644 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)
2645 then
2646 Screen.Forms[i].Close;
2647 if LogDlg.Visible then
2648 LogDlg.Close;
2649 LogDlg.List.Clear;
2650 StartRunning := not idle and (Jump[0] > 0); // AI called Reload
2651 me := -1;
2652 idle := false;
2653 ClientMode := -1;
2654 UnitInfoBtn.Visible := false;
2655 UnitBtn.Visible := false;
2656 TerrainBtn.Visible := false;
2657 MovieSpeed1Btn.Visible := false;
2658 MovieSpeed2Btn.Visible := false;
2659 MovieSpeed3Btn.Visible := false;
2660 MovieSpeed4Btn.Visible := false;
2661 EOT.Visible := false;
2662 for i := 0 to ControlCount - 1 do
2663 if Controls[i] is TButtonC then
2664 Controls[i].Visible := false;
2665 InitPVSB(sb, 0, 1);
2666 for p1 := 0 to nPl - 1 do
2667 if Tribe[p1] <> nil then
2668 Tribe[p1].free;
2669 Tribes.Done;
2670 RepaintOnResize := false;
2671 Closable := true;
2672 Close;
2673 { if (GameMode=cNewGame) or (GameMode=cLoadGame) then
2674 AdvisorDlg.BreakGame; }
2675 end;
2676
2677 cShowGame:
2678 begin
2679 with Panel.Canvas do
2680 begin
2681 Brush.Color := $000000;
2682 FillRect(Rect(0, 0, Panel.width, Panel.height));
2683 Brush.Style := bsClear;
2684 end;
2685 with TopBar.Canvas do
2686 begin
2687 Brush.Color := $000000;
2688 FillRect(Rect(0, 0, TopBar.width, TopBar.height));
2689 Brush.Style := bsClear;
2690 end;
2691 FormResize(nil); // place mini map correctly according to its size
2692 Show;
2693 Update;
2694 RepaintOnResize := true;
2695 xw := 0;
2696 yw := ywcenter;
2697 if not StayOnTop_Ensured then
2698 begin
2699 StayOnTop_Ensured := true;
2700 CityDlg.StayOnTop_Workaround;
2701 CityTypeDlg.StayOnTop_Workaround;
2702 DiaDlg.StayOnTop_Workaround;
2703 DraftDlg.StayOnTop_Workaround;
2704 EnhanceDlg.StayOnTop_Workaround;
2705 HelpDlg.StayOnTop_Workaround;
2706 NatStatDlg.StayOnTop_Workaround;
2707 NegoDlg.StayOnTop_Workaround;
2708 ModalSelectDlg.StayOnTop_Workaround;
2709 ListDlg.StayOnTop_Workaround;
2710 UnitStatDlg.StayOnTop_Workaround;
2711 WondersDlg.StayOnTop_Workaround;
2712 RatesDlg.StayOnTop_Workaround;
2713 end;
2714 end;
2715
2716 cShowTurnChange:
2717 begin
2718 if integer(Data) >= 0 then
2719 begin
2720 pLogo := integer(Data);
2721 if G.RO[pLogo] = nil then
2722 begin
2723 if AILogo[pLogo] <> nil then
2724 BitBlt(Canvas.Handle, (xRightPanel + 10) - (16 + 64),
2725 ClientHeight - PanelHeight, 64, 64,
2726 AILogo[pLogo].Canvas.Handle, 0, 0, SRCCOPY);
2727 end
2728 end
2729 end;
2730
2731 cTurn, cResume, cContinue:
2732 if not GameOK then
2733 Server(sResign, NewPlayer, 0, nil^)
2734 else
2735 begin
2736 ClientMode := Command;
2737 pTurn := NewPlayer;
2738 pLogo := NewPlayer;
2739
2740 if Command = cResume then
2741 begin // init non-original model pictures (maybe tribes not found)
2742 for p1 := 0 to nPl - 1 do
2743 if G.RO[p1] <> nil then
2744 begin
2745 ItsMeAgain(p1);
2746 for mix := 0 to MyRO.nModel - 1 do
2747 if Tribe[me].ModelPicture[mix].HGr = 0 then
2748 InitMyModel(mix, true);
2749 end;
2750 me := -1;
2751 end;
2752
2753 if Jump[pTurn] > 0 then
2754 Application.ProcessMessages;
2755 if Jump[pTurn] > 0 then
2756 if G.RO[NewPlayer].Happened and phGameEnd <> 0 then
2757 Jump[pTurn] := 0
2758 else
2759 dec(Jump[pTurn]);
2760 SkipTurn := Jump[pTurn] > 0;
2761 if SkipTurn then
2762 begin
2763 ItsMeAgain(NewPlayer);
2764 MyData := G.RO[NewPlayer].Data;
2765 SetTroopLoc(-1);
2766 MiniPaint;
2767 InitAllEnemyModels; // necessary for correct replay
2768 if not EndTurn(true) then
2769 SkipTurn := false;
2770 end;
2771 if not SkipTurn then
2772 begin
2773 if ((ClientMode < scDipStart) or (ClientMode > scDipBreak)) and
2774 NegoDlg.Visible then
2775 NegoDlg.Close;
2776 skipped := false; // always show my moves during my turn
2777 idle := true;
2778 InitTurn(NewPlayer);
2779 DipMem[me].pContact := -1;
2780 (* if (me=0) and (MyRO.Alive and (1 shl me)=0)} then
2781 begin
2782 if SimpleQuery(Phrases.Lookup('RESIGN'))=mrIgnore then
2783 Server(sResign,me,0,nil^)
2784 else Server(sBreak,me,0,nil^)
2785 end
2786 else Play('TURNSTART'); *)
2787 end;
2788 end;
2789
2790 cMovieTurn:
2791 begin
2792 ClientMode := Command;
2793 pTurn := NewPlayer;
2794 pLogo := -1;
2795 skipped := false; // always show my moves during my turn
2796 idle := true;
2797 if FirstMovieTurn then
2798 begin
2799 CheckMovieSpeedBtnState;
2800 FirstMovieTurn := false;
2801 end;
2802 InitTurn(NewPlayer);
2803 Application.ProcessMessages;
2804 if MovieSpeed = 4 then
2805 begin
2806 Sleep(75);
2807 // this break will ensure speed of fast forward does not depend on cpu speed
2808 Application.ProcessMessages;
2809 end
2810 end;
2811
2812 cMovieEndTurn:
2813 begin
2814 RememberPeaceViolation;
2815 pTurn := -1;
2816 pLogo := -1;
2817 MapValid := false;
2818 ClientMode := -1;
2819 idle := false;
2820 skipped := false;
2821 end;
2822
2823 cEditMap:
2824 begin
2825 ClientMode := cEditMap;
2826 SetMapOptions;
2827 IsoEngine.pDebugMap := -1;
2828 ItsMeAgain(0);
2829 MyData := nil;
2830 UnitInfoBtn.Visible := false;
2831 UnitBtn.Visible := false;
2832 TerrainBtn.Visible := false;
2833 MovieSpeed1Btn.Visible := false;
2834 MovieSpeed2Btn.Visible := false;
2835 MovieSpeed3Btn.Visible := false;
2836 MovieSpeed4Btn.Visible := false;
2837 EOT.Visible := false;
2838 HelpDlg.Difficulty := 0;
2839 BrushType := fGrass;
2840 BrushLoc := -1;
2841 Edited := false;
2842 UnFocus := -1;
2843 MarkCityLoc := -1;
2844 Tracking := false;
2845 TurnComplete := false;
2846 MapValid := false;
2847 FormResize(nil); // calculate geometrics and paint all
2848 SetTroopLoc(-1);
2849 idle := true
2850 end;
2851
2852 (* cNewContact:
2853 begin
2854 end;
2855 *)
2856
2857 scContact:
2858 begin
2859 DipMem[NewPlayer].pContact := integer(Data);
2860 if Jump[NewPlayer] > 0 then
2861 DipCall(scReject)
2862 else
2863 begin
2864 ClientMode := Command;
2865 InitTurn(NewPlayer);
2866 MyData.ToldContact := MyData.ToldContact or (1 shl integer(Data));
2867 // don't tell about new nation when already contacted by them
2868 with MessgExDlg do
2869 begin
2870 OpenSound := 'CONTACT_' + char(48 + MyRO.EnemyReport[integer(Data)
2871 ].Attitude);
2872 MessgText := Tribe[integer(Data)].TPhrase('FRCONTACT');
2873 Kind := mkYesNo;
2874 IconKind := mikTribe;
2875 IconIndex := integer(Data);
2876 ShowModal;
2877 if ModalResult = mrOK then
2878 begin
2879 NegoDlg.Respond;
2880 DipMem[me].DeliveredPrices := [];
2881 DipMem[me].ReceivedPrices := [];
2882 DipCall(scDipStart)
2883 end
2884 else
2885 begin
2886 DipCall(scReject);
2887 EndNego
2888 end
2889 end
2890 end;
2891 end;
2892
2893 scDipStart .. scDipBreak:
2894 begin
2895 ClientMode := Command;
2896 InitTurn(NewPlayer);
2897 if Command = scDipStart then
2898 Play('CONTACT_' + char(48 + MyRO.Attitude[DipMem[NewPlayer]
2899 .pContact]))
2900 else if Command = scDipCancelTreaty then
2901 Play('CANCELTREATY')
2902 else if Command = scDipOffer then
2903 begin
2904 ReceivedOffer := TOffer(Data);
2905 InitAllEnemyModels;
2906 end
2907 else if Command = scDipAccept then
2908 begin // remember delivered and received prices
2909 for i := 0 to DipMem[me].SentOffer.nDeliver - 1 do
2910 include(DipMem[me].DeliveredPrices,
2911 DipMem[me].SentOffer.Price[i] shr 24);
2912 for i := 0 to DipMem[me].SentOffer.nCost - 1 do
2913 include(DipMem[me].ReceivedPrices,
2914 DipMem[me].SentOffer.Price[DipMem[me].SentOffer.nDeliver +
2915 i] shr 24);
2916 IsTreatyDeal := false;
2917 for i := 0 to ReceivedOffer.nDeliver + ReceivedOffer.nCost - 1 do
2918 if DipMem[me].SentOffer.Price[i] and opMask = opTreaty then
2919 IsTreatyDeal := true;
2920 if IsTreatyDeal then
2921 Play('NEWTREATY')
2922 else
2923 Play('ACCEPTOFFER');
2924 end;
2925 NegoDlg.Start;
2926 idle := true
2927 end;
2928
2929 cShowCancelTreaty:
2930 if not IsMultiPlayerGame then
2931 begin
2932 case G.RO[NewPlayer].Treaty[integer(Data)] of
2933 trPeace:
2934 s := Tribe[integer(Data)].TPhrase('FRCANCELBYREJECT_PEACE');
2935 trFriendlyContact:
2936 s := Tribe[integer(Data)].TPhrase('FRCANCELBYREJECT_FRIENDLY');
2937 trAlliance:
2938 s := Tribe[integer(Data)].TPhrase('FRCANCELBYREJECT_ALLIANCE');
2939 end;
2940 TribeMessage(integer(Data), s, 'CANCELTREATY');
2941 end;
2942
2943 cShowCancelTreatyByAlliance:
2944 if idle and (NewPlayer = me) then
2945 TribeMessage(integer(Data), Tribe[integer(Data)
2946 ].TPhrase('FRENEMYALLIANCE'), 'CANCELTREATY');
2947
2948 cShowSupportAllianceAgainst:
2949 if not IsMultiPlayerGame and (Jump[0] = 0) then
2950 TribeMessage(integer(Data) and $F,
2951 Tribe[integer(Data) and $F].TPhrase('FRMYALLIANCE1') + ' ' +
2952 Tribe[integer(Data) shr 4].TPhrase('FRMYALLIANCE2'),
2953 'CANCELTREATY');
2954
2955 cShowPeaceViolation:
2956 if not IsMultiPlayerGame and (Jump[0] = 0) then
2957 TribeMessage(integer(Data),
2958 Format(Tribe[integer(Data)].TPhrase('EVIOLATION'),
2959 [TurnToString(MyRO.Turn + PeaceEvaTurns - 1)]), 'MSG_WITHDRAW');
2960
2961 cShowEndContact:
2962 EndNego;
2963
2964 cShowUnitChanged, cShowCityChanged, cShowAfterMove, cShowAfterAttack:
2965 if (idle and (NewPlayer = me) or not idle and not skipped) and
2966 not((GameMode = cMovie) and (MovieSpeed = 4)) then
2967 begin
2968 assert(NewPlayer = me);
2969 if not idle or (GameMode = cMovie) then
2970 Application.ProcessMessages;
2971 if Command = cShowCityChanged then
2972 begin
2973 CurrentMoveInfo.DoShow := false;
2974 if idle then
2975 CurrentMoveInfo.DoShow := true
2976 else if CurrentMoveInfo.IsAlly then
2977 CurrentMoveInfo.DoShow := not mAlNoMoves.Checked
2978 else
2979 CurrentMoveInfo.DoShow := not mEnNoMoves.Checked
2980 end
2981 else if Command = cShowUnitChanged then
2982 begin
2983 CurrentMoveInfo.DoShow := false;
2984 if idle then
2985 CurrentMoveInfo.DoShow := not mEffectiveMovesOnly.Checked
2986 else if CurrentMoveInfo.IsAlly then
2987 CurrentMoveInfo.DoShow :=
2988 not(mAlNoMoves.Checked or mAlEffectiveMovesOnly.Checked)
2989 else
2990 CurrentMoveInfo.DoShow :=
2991 not(mEnNoMoves.Checked or mEnAttacks.Checked)
2992 end;
2993 // else keep DoShow from cShowMove/cShowAttack
2994
2995 if CurrentMoveInfo.DoShow then
2996 begin
2997 if Command = cShowCityChanged then
2998 MapValid := false;
2999 FocusOnLoc(integer(Data), flImmUpdate);
3000 // OldUnFocus:=UnFocus;
3001 // UnFocus:=-1;
3002 if Command = cShowAfterMove then
3003 PaintLoc(integer(Data), CurrentMoveInfo.AfterMovePaintRadius)
3004 // show discovered areas
3005 else
3006 PaintLoc(integer(Data), 1);
3007 // UnFocus:=OldUnFocus;
3008 if (Command = cShowAfterAttack) and
3009 (CurrentMoveInfo.AfterAttackExpeller >= 0) then
3010 begin
3011 SoundMessageEx(Tribe[CurrentMoveInfo.AfterAttackExpeller]
3012 .TPhrase('EXPEL'), '');
3013 CurrentMoveInfo.AfterAttackExpeller := -1;
3014 Update; // remove message box from screen
3015 end
3016 else if not idle then
3017 if Command = cShowCityChanged then
3018 Sleep(MoveTime * WaitAfterShowMove div 16)
3019 else if (Command = cShowUnitChanged) and
3020 (MyMap[integer(Data)] and fUnit <> 0) then
3021 Sleep(MoveTime * WaitAfterShowMove div 32)
3022 end // if CurrentMoveInfo.DoShow
3023 else
3024 MapValid := false;
3025 end;
3026
3027 cShowMoving, cShowCapturing:
3028 if (idle and (NewPlayer = me) or not idle and not skipped and
3029 (TShowMove(Data).emix <> $FFFF)) and
3030 not((GameMode = cMovie) and (MovieSpeed = 4)) then
3031 begin
3032 assert(NewPlayer = me);
3033 if not idle or (GameMode = cMovie) then
3034 Application.ProcessMessages;
3035 with TShowMove(Data) do
3036 begin
3037 CurrentMoveInfo.DoShow := false;
3038 if not idle and (Tribe[Owner].ModelPicture[mix].HGr = 0) then
3039 InitEnemyModel(emix);
3040
3041 ToLoc := dLoc(FromLoc, dx, dy);
3042 if idle then
3043 begin // own unit -- make discovered land visible
3044 assert(Owner = me); // no foreign moves during my turn!
3045 CurrentMoveInfo.DoShow := not mEffectiveMovesOnly.Checked or
3046 (Command = cShowCapturing);
3047 if CurrentMoveInfo.DoShow then
3048 begin
3049 if GameMode = cMovie then
3050 begin
3051 if MovieSpeed = 3 then
3052 AnimationSpeed := 4
3053 else if MovieSpeed = 2 then
3054 AnimationSpeed := 8
3055 else
3056 AnimationSpeed := 16;
3057 end
3058 else
3059 begin
3060 if mVeryFastMoves.Checked then
3061 AnimationSpeed := 4
3062 else if mFastMoves.Checked then
3063 AnimationSpeed := 8
3064 else
3065 AnimationSpeed := 16;
3066 end;
3067 with MyModel[mix] do
3068 begin
3069 if (Kind = mkDiplomat) or (Domain = dAir) or
3070 (Cap[mcRadar] + Cap[mcCarrier] + Cap[mcAcademy] > 0) or
3071 (MyMap[ToLoc] and fTerrain = fMountains) or
3072 (MyMap[ToLoc] and fTerImp = tiFort) or
3073 (MyMap[ToLoc] and fTerImp = tiBase) then
3074 CurrentMoveInfo.AfterMovePaintRadius := 2
3075 else
3076 CurrentMoveInfo.AfterMovePaintRadius := 1;
3077 if (MyRO.Wonder[woShinkansen].EffectiveOwner = me) and
3078 (Domain = dGround) and
3079 (MyMap[FromLoc] and (fRR or fCity) <> 0) and
3080 (MyMap[ToLoc] and (fRR or fCity) <> 0) and
3081 (Flags and umPlaneUnloading = 0) then
3082 AnimationSpeed := 4;
3083 ShowMoveDomain := Domain;
3084 IsAlpine := Cap[mcAlpine] > 0;
3085 end
3086 end
3087 end
3088 else
3089 begin
3090 CurrentMoveInfo.IsAlly := MyRO.Treaty[Owner] = trAlliance;
3091 if GameMode = cMovie then
3092 CurrentMoveInfo.DoShow := true
3093 else if CurrentMoveInfo.IsAlly then
3094 CurrentMoveInfo.DoShow := not mAlNoMoves.Checked and
3095 not(mAlEffectiveMovesOnly.Checked and
3096 (Command <> cShowCapturing))
3097 else
3098 CurrentMoveInfo.DoShow := not mEnNoMoves.Checked and
3099 not(mEnAttacks.Checked and (Command <> cShowCapturing));
3100 if CurrentMoveInfo.DoShow then
3101 begin
3102 if Command = cShowCapturing then
3103 begin // show capture message
3104 if MyMap[ToLoc] and fOwned <> 0 then
3105 begin // own city, search
3106 cix := MyRO.nCity - 1;
3107 while (cix >= 0) and (MyCity[cix].Loc <> ToLoc) do
3108 dec(cix);
3109 s := CityName(MyCity[cix].ID);
3110 end
3111 else
3112 begin // foreign city, search
3113 ecix := MyRO.nEnemyCity - 1;
3114 while (ecix >= 0) and (MyRO.EnemyCity[ecix].Loc <> ToLoc) do
3115 dec(ecix);
3116 s := CityName(MyRO.EnemyCity[ecix].ID);
3117 end;
3118 TribeMessage(Owner, Format(Tribe[Owner].TPhrase('CAPTURE'),
3119 [s]), '');
3120 Update; // remove message box from screen
3121 end;
3122
3123 if CurrentMoveInfo.IsAlly then
3124 begin // allied unit -- make discovered land visible
3125 if mAlFastMoves.Checked then
3126 AnimationSpeed := 8
3127 else
3128 AnimationSpeed := 16;
3129 with MyRO.EnemyModel[emix] do
3130 if (Kind = mkDiplomat) or (Domain = dAir) or
3131 (ATrans_Fuel > 0) or
3132 (Cap and (1 shl (mcRadar - mcFirstNonCap) or
3133 1 shl (mcAcademy - mcFirstNonCap)) <> 0) or
3134 (MyMap[ToLoc] and fTerrain = fMountains) or
3135 (MyMap[ToLoc] and fTerImp = tiFort) or
3136 (MyMap[ToLoc] and fTerImp = tiBase) then
3137 CurrentMoveInfo.AfterMovePaintRadius := 2
3138 else
3139 CurrentMoveInfo.AfterMovePaintRadius := 1
3140 end
3141 else
3142 begin
3143 if mEnFastMoves.Checked then
3144 AnimationSpeed := 8
3145 else
3146 AnimationSpeed := 16;
3147 CurrentMoveInfo.AfterMovePaintRadius := 0;
3148 // enemy unit, nothing discovered
3149 end;
3150 if GameMode = cMovie then
3151 begin
3152 if MovieSpeed = 3 then
3153 AnimationSpeed := 4
3154 else if MovieSpeed = 2 then
3155 AnimationSpeed := 8
3156 else
3157 AnimationSpeed := 16;
3158 end;
3159 ShowMoveDomain := MyRO.EnemyModel[emix].Domain;
3160 IsAlpine := MyRO.EnemyModel[emix].Cap and
3161 (1 shl (mcAlpine - mcFirstNonCap)) <> 0;
3162 end
3163 end;
3164
3165 if CurrentMoveInfo.DoShow then
3166 begin
3167 if Command = cShowCapturing then
3168 Play('MOVE_CAPTURE')
3169 else if EndHealth <= 0 then
3170 Play('MOVE_DIE')
3171 else if Flags and umSpyMission <> 0 then
3172 Play('MOVE_COVERT')
3173 else if Flags and umShipLoading <> 0 then
3174 if ShowMoveDomain = dAir then
3175 Play('MOVE_PLANELANDING')
3176 else
3177 Play('MOVE_LOAD')
3178 else if Flags and umPlaneLoading <> 0 then
3179 Play('MOVE_LOAD')
3180 else if Flags and umShipUnloading <> 0 then
3181 if ShowMoveDomain = dAir then
3182 Play('MOVE_PLANESTART')
3183 else
3184 Play('MOVE_UNLOAD')
3185 else if Flags and umPlaneUnloading <> 0 then
3186 if (MyMap[FromLoc] and fCity = 0) and
3187 (MyMap[FromLoc] and fTerImp <> tiBase) then
3188 Play('MOVE_PARACHUTE')
3189 else
3190 Play('MOVE_UNLOAD')
3191 else if (ShowMoveDomain = dGround) and not IsAlpine and
3192 (MyMap[ToLoc] and fTerrain = fMountains) and
3193 ((MyMap[FromLoc] and (fRoad or fRR or fCity) = 0) or
3194 (MyMap[ToLoc] and (fRoad or fRR or fCity) = 0)) then
3195 Play('MOVE_MOUNTAIN');
3196
3197 FocusOnLoc(FromLoc, flImmUpdate);
3198 PaintLoc_BeforeMove(FromLoc);
3199 if Command = cShowCapturing then
3200 MoveOnScreen(TShowMove(Data), 1, 32, 32)
3201 else
3202 MoveOnScreen(TShowMove(Data), 1, AnimationSpeed, AnimationSpeed)
3203 end // if CurrentMoveInfo.DoShow
3204 else
3205 MapValid := false;
3206 end
3207 end;
3208
3209 cShowAttacking:
3210 if (idle and (NewPlayer = me) or not idle and not skipped and
3211 (TShowMove(Data).emix <> $FFFF)) and
3212 not((GameMode = cMovie) and (MovieSpeed = 4)) then
3213 begin
3214 assert(NewPlayer = me);
3215 if not idle or (GameMode = cMovie) then
3216 Application.ProcessMessages;
3217 with TShowMove(Data) do
3218 begin
3219 CurrentMoveInfo.AfterAttackExpeller := -1;
3220 CurrentMoveInfo.DoShow := false;
3221 if idle then
3222 CurrentMoveInfo.DoShow := true // own unit -- always show attacks
3223 else
3224 begin
3225 CurrentMoveInfo.IsAlly := MyRO.Treaty[Owner] = trAlliance;
3226 if CurrentMoveInfo.IsAlly then
3227 CurrentMoveInfo.DoShow := not mAlNoMoves.Checked
3228 else
3229 CurrentMoveInfo.DoShow := not mEnNoMoves.Checked;
3230 end;
3231 if CurrentMoveInfo.DoShow then
3232 begin
3233 ToLoc := dLoc(FromLoc, dx, dy);
3234 if Tribe[Owner].ModelPicture[mix].HGr = 0 then
3235 InitEnemyModel(emix);
3236
3237 if (MyMap[ToLoc] and (fCity or fUnit or fOwned) = fCity or fOwned)
3238 then
3239 begin // tell about bombardment
3240 cix := MyRO.nCity - 1;
3241 while (cix >= 0) and (MyCity[cix].Loc <> ToLoc) do
3242 dec(cix);
3243 if MyCity[cix].Status and csToldBombard = 0 then
3244 begin
3245 if not supervising then
3246 MyCity[cix].Status := MyCity[cix].Status or csToldBombard;
3247 s := CityName(MyCity[cix].ID);
3248 SoundMessageEx(Format(Tribe[Owner].TPhrase('BOMBARD'),
3249 [s]), '');
3250 Update; // remove message box from screen
3251 end;
3252 end
3253 else if Flags and umExpelling <> 0 then
3254 CurrentMoveInfo.AfterAttackExpeller := Owner;
3255
3256 if Flags and umExpelling <> 0 then
3257 Play('MOVE_EXPEL')
3258 else if Owner = me then
3259 begin
3260 MakeModelInfo(me, mix, MyModel[mix], mi);
3261 Play(AttackSound(ModelCode(mi)));
3262 end
3263 else
3264 Play(AttackSound(ModelCode(MyRO.EnemyModel[emix])));
3265
3266 FocusOnLoc(FromLoc, flImmUpdate);
3267
3268 // before combat
3269 MainMap.AttackBegin(TShowMove(Data));
3270 if MyMap[ToLoc] and fCity <> 0 then
3271 PaintLoc(ToLoc);
3272 PaintLoc(FromLoc);
3273 MoveOnScreen(TShowMove(Data), 1, 9, 16);
3274 MoveOnScreen(TShowMove(Data), 17, 12, 32);
3275 MoveOnScreen(TShowMove(Data), 7, 11, 16);
3276
3277 // after combat
3278 MainMap.AttackEffect(TShowMove(Data));
3279 PaintLoc(ToLoc);
3280 if EndHealth > 0 then
3281 begin
3282 Health := EndHealth;
3283 MoveOnScreen(TShowMove(Data), 10, 0, 16);
3284 end
3285 else if not idle then
3286 Sleep(MoveTime div 2);
3287 MainMap.AttackEnd;
3288 end // if CurrentMoveInfo.DoShow
3289 else
3290 MapValid := false;
3291 end
3292 end;
3293
3294 cShowMissionResult:
3295 if Cardinal(Data) = 0 then
3296 SoundMessageEx(Phrases.Lookup('NOFOREIGNINFO'), '')
3297 else
3298 begin
3299 s := Phrases.Lookup('FOREIGNINFO');
3300 for p1 := 0 to nPl - 1 do
3301 if 3 shl (p1 * 2) and Cardinal(Data) <> 0 then
3302 s := s + '\' + Tribe[p1].TPhrase('SHORTNAME');
3303 SoundMessageEx(s, '')
3304 end;
3305
3306 cShowShipChange:
3307 if not IsMultiPlayerGame and (Jump[0] = 0) then
3308 ShowEnemyShipChange(TShowShipChange(Data));
3309
3310 cShowGreatLibTech:
3311 if not IsMultiPlayerGame and (Jump[0] = 0) then
3312 with MessgExDlg do
3313 begin
3314 MessgText := Format(Phrases.Lookup('GRLIB_GENERAL'),
3315 [Phrases.Lookup('ADVANCES', integer(Data))]);
3316 OpenSound := 'NEWADVANCE_GRLIB';
3317 Kind := mkOk;
3318 IconKind := mikImp;
3319 IconIndex := woGrLibrary;
3320 ShowModal;
3321 end;
3322
3323 cRefreshDebugMap:
3324 begin
3325 if integer(Data) = IsoEngine.pDebugMap then
3326 begin
3327 MapValid := false;
3328 MainOffscreenPaint;
3329 Update;
3330 end
3331 end;
3332
3333 else
3334 if Command >= cClientEx then
3335 case Command and $FFF0 of
3336
3337 cSetTribe:
3338 with TTribeInfo(Data) do
3339 begin
3340 i := UnusedTribeFiles.Count - 1;
3341 while (i >= 0) and
3342 (AnsiCompareFileName(UnusedTribeFiles[i], FileName) <> 0) do
3343 dec(i);
3344 if i >= 0 then
3345 UnusedTribeFiles.Delete(i);
3346 CreateTribe(trix, FileName, true);
3347 end;
3348
3349 cSetNewModelPicture, cSetModelPicture:
3350 if TribeOriginal[TModelPictureInfo(Data).trix] then
3351 Tribe[TModelPictureInfo(Data).trix].SetModelPicture
3352 (TModelPictureInfo(Data), Command and
3353 $FFF0 = cSetNewModelPicture);
3354
3355 cSetSlaveIndex and $FFF0:
3356 Tribe[integer(Data) shr 16].mixSlaves := integer(Data) and $FFFF;
3357
3358 cSetCityName:
3359 with TCityNameInfo(Data) do
3360 if TribeOriginal[ID shr 12] then
3361 Tribe[ID shr 12].SetCityName(ID and $FFF, NewName);
3362
3363 cSetModelName:
3364 with TModelNameInfo(Data) do
3365 if TribeOriginal[NewPlayer] then
3366 Tribe[NewPlayer].ModelName[mix] := NewName;
3367 end
3368 end
3369 end; { <<<client }
3370
3371 { *** main part *** }
3372
3373 procedure TMainScreen.CreateParams(var p: TCreateParams);
3374 var
3375 DefaultOptionChecked: integer;
3376 Reg: TRegistry;
3377 doinit: boolean;
3378 begin
3379 inherited;
3380
3381 // define which menu settings to save
3382 SaveOption[0] := mAlEffectiveMovesOnly.Tag;
3383 SaveOption[1] := mEnMoves.Tag;
3384 SaveOption[2] := mEnAttacks.Tag;
3385 SaveOption[3] := mEnNoMoves.Tag;
3386 SaveOption[4] := mWaitTurn.Tag;
3387 SaveOption[5] := mEffectiveMovesOnly.Tag;
3388 SaveOption[6] := mEnFastMoves.Tag;
3389 SaveOption[7] := mSlowMoves.Tag;
3390 SaveOption[8] := mFastMoves.Tag;
3391 SaveOption[9] := mVeryFastMoves.Tag;
3392 SaveOption[10] := mNames.Tag;
3393 SaveOption[11] := mRepList.Tag;
3394 SaveOption[12] := mRepScreens.Tag;
3395 SaveOption[13] := mSoundOff.Tag;
3396 SaveOption[14] := mSoundOn.Tag;
3397 SaveOption[15] := mSoundOnAlt.Tag;
3398 SaveOption[16] := mScrollSlow.Tag;
3399 SaveOption[17] := mScrollFast.Tag;
3400 SaveOption[18] := mScrollOff.Tag;
3401 SaveOption[19] := mAlSlowMoves.Tag;
3402 SaveOption[20] := mAlFastMoves.Tag;
3403 SaveOption[21] := mAlNoMoves.Tag;
3404 DefaultOptionChecked := 1 shl 1 + 1 shl 7 + 1 shl 10 + 1 shl 12 + 1 shl 14 +
3405 1 shl 18 + 1 shl 19;
3406
3407 Reg := TRegistry.Create;
3408 doinit := true;
3409 if Reg.KeyExists('SOFTWARE\cevo\RegVer9') then
3410 begin
3411 doinit := false;
3412 Reg.OpenKey('SOFTWARE\cevo\RegVer9', false);
3413 try
3414 xxt := Reg.ReadInteger('TileWidth') div 2;
3415 yyt := Reg.ReadInteger('TileHeight') div 2;
3416 OptionChecked := Reg.ReadInteger('OptionChecked');
3417 MapOptionChecked := Reg.ReadInteger('MapOptionChecked');
3418 CityRepMask := Cardinal(Reg.ReadInteger('CityReport'));
3419 except
3420 doinit := true;
3421 end;
3422 Reg.closekey;
3423 if OptionChecked and (7 shl 16) = 0 then
3424 OptionChecked := OptionChecked or (1 shl 16);
3425 // old regver with no scrolling
3426 end;
3427 Reg.free;
3428 if doinit then
3429 begin
3430 xxt := 48;
3431 yyt := 24;
3432 OptionChecked := DefaultOptionChecked;
3433 MapOptionChecked := 1 shl moCityNames;
3434 CityRepMask := Cardinal(not chPopIncrease and not chNoGrowthWarning and
3435 not chCaptured);
3436 end;
3437
3438 if FullScreen then
3439 begin
3440 p.Style := $87000000;
3441 BorderStyle := bsNone;
3442 BorderIcons := [];
3443 end;
3444
3445 if 1 shl 13 and OptionChecked <> 0 then
3446 SoundMode := smOff
3447 else if 1 shl 15 and OptionChecked <> 0 then
3448 SoundMode := smOnAlt
3449 else
3450 SoundMode := smOn
3451 end;
3452
3453 procedure TMainScreen.FormCreate(Sender: TObject);
3454 var
3455 i, j: integer;
3456 begin
3457 Screen.Cursors[crImpDrag] := LoadCursor(HInstance, 'DRAG');
3458 Screen.Cursors[crFlatHand] := LoadCursor(HInstance, 'FLATHAND');
3459
3460 // tag-controlled language
3461 for i := 0 to ComponentCount - 1 do
3462 if Components[i].Tag and $FF <> 0 then
3463 if Components[i] is TMenuItem then
3464 begin
3465 TMenuItem(Components[i]).Caption := Phrases.Lookup('CONTROLS',
3466 -1 + Components[i].Tag and $FF);
3467 for j := 0 to nSaveOption - 1 do
3468 if Components[i].Tag and $FF = SaveOption[j] then
3469 TMenuItem(Components[i]).Checked := 1 shl j and
3470 OptionChecked <> 0;
3471 end
3472 else if Components[i] is TButtonBase then
3473 begin
3474 TButtonBase(Components[i]).Hint := Phrases.Lookup('CONTROLS',
3475 -1 + Components[i].Tag and $FF);
3476 if (Components[i] is TButtonC) and
3477 (TButtonC(Components[i]).ButtonIndex <> 1) then
3478 TButtonC(Components[i]).ButtonIndex :=
3479 MapOptionChecked shr (Components[i].Tag shr 8) and 1 + 2
3480 end;
3481
3482 // non-tag-controlled language
3483 mTechTree.Caption := Phrases2.Lookup('MENU_ADVTREE');
3484 mViewpoint.Caption := Phrases2.Lookup('MENU_VIEWPOINT');
3485 if not Phrases2FallenBackToEnglish then
3486 begin
3487 MenuArea.Hint := Phrases2.Lookup('BTN_MENU');
3488 TreasuryArea.Hint := Phrases2.Lookup('TIP_TREASURY');
3489 ResearchArea.Hint := Phrases.Lookup('SCIENCE');
3490 ManagementArea.Hint := Phrases2.Lookup('BTN_MANAGE');
3491 end;
3492 for i := 0 to mRep.Count - 1 do
3493 begin
3494 j := mRep[i].Tag shr 8;
3495 mRep[i].Caption := CityEventName(j);
3496 mRep[i].Checked := CityRepMask and (1 shl j) <> 0;
3497 end;
3498
3499 Mini := TBitmap.Create;
3500 Mini.PixelFormat := pf24bit;
3501 Panel := TBitmap.Create;
3502 Panel.PixelFormat := pf24bit;
3503 Panel.Canvas.Font.Assign(UniFont[ftSmall]);
3504 Panel.Canvas.Brush.Style := bsClear;
3505 TopBar := TBitmap.Create;
3506 TopBar.PixelFormat := pf24bit;
3507 TopBar.Canvas.Font.Assign(UniFont[ftNormal]);
3508 TopBar.Canvas.Brush.Style := bsClear;
3509 Buffer := TBitmap.Create;
3510 Buffer.PixelFormat := pf24bit;
3511 if 2 * lxmax > 3 * xSizeBig then
3512 Buffer.width := 2 * lxmax
3513 else
3514 Buffer.width := 3 * xSizeBig;
3515 if lymax > 3 * ySizeBig then
3516 Buffer.height := lymax
3517 else
3518 Buffer.height := 3 * ySizeBig;
3519 Buffer.Canvas.Font.Assign(UniFont[ftSmall]);
3520 for i := 0 to nPl - 1 do
3521 AILogo[i] := nil;
3522 Canvas.Font.Assign(UniFont[ftSmall]);
3523 InitButtons();
3524 EOT.Template := Templates;
3525 end;
3526
3527 procedure TMainScreen.FormDestroy(Sender: TObject);
3528 var
3529 i: integer;
3530 begin
3531 TopBar.Free;
3532 Mini.Free;
3533 Buffer.Free;
3534 Panel.Free;
3535 for i := 0 to nPl - 1 do
3536 if AILogo[i] <> nil then
3537 AILogo[i].Free;
3538 end;
3539
3540 procedure TMainScreen.FormResize(Sender: TObject);
3541 var
3542 MiniFrame, MaxMapWidth: integer;
3543 begin
3544 SmallScreen := ClientWidth < 1024;
3545 MaxMapWidth := (G.lx * 2 - 3) * xxt;
3546 // avoide the same tile being visible left and right
3547 if ClientWidth <= MaxMapWidth then
3548 begin
3549 MapWidth := ClientWidth;
3550 MapOffset := 0;
3551 end
3552 else
3553 begin
3554 MapWidth := MaxMapWidth;
3555 MapOffset := (ClientWidth - MapWidth) div 2;
3556 end;
3557 MapHeight := ClientHeight - TopBarHeight - PanelHeight + overlap;
3558 Panel.width := ClientWidth;
3559 Panel.height := PanelHeight;
3560 TopBar.width := ClientWidth;
3561 TopBar.height := TopBarHeight;
3562 MiniFrame := (lxmax_xxx - G.ly) div 2;
3563 xMidPanel := (G.lx + MiniFrame) * 2 + 1;
3564 xRightPanel := ClientWidth - LeftPanelWidth - 10;
3565 if ClientMode = cEditMap then
3566 TrPitch := 2 * xxt
3567 else
3568 TrPitch := 66;
3569 xMini := MiniFrame - 5;
3570 yMini := (PanelHeight - 26 - lxmax_xxx) div 2 + MiniFrame;
3571 ywmax := (G.ly - MapHeight div yyt + 1) and not 1;
3572 ywcenter := -((MapHeight - yyt * (G.ly - 1)) div (4 * yyt)) * 2;
3573 // only for ywmax<=0
3574 if ywmax <= 0 then
3575 yw := ywcenter
3576 else if yw < 0 then
3577 yw := 0
3578 else if yw > ywmax then
3579 yw := ywmax;
3580 UnitInfoBtn.Top := ClientHeight - 29;
3581 UnitInfoBtn.Left := xMidPanel + 7 + 99;
3582 UnitBtn.Top := ClientHeight - 29;
3583 UnitBtn.Left := xMidPanel + 7 + 99 + 31;
3584 TerrainBtn.Top := ClientHeight - 29;
3585 TerrainBtn.Left := xMidPanel + 7 + 99 + 62;
3586 MovieSpeed1Btn.Top := ClientHeight - 91;
3587 MovieSpeed1Btn.Left := ClientWidth div 2 - 62;
3588 MovieSpeed2Btn.Top := ClientHeight - 91;
3589 MovieSpeed2Btn.Left := ClientWidth div 2 - 62 + 29;
3590 MovieSpeed3Btn.Top := ClientHeight - 91;
3591 MovieSpeed3Btn.Left := ClientWidth div 2 - 62 + 2 * 29;
3592 MovieSpeed4Btn.Top := ClientHeight - 91;
3593 MovieSpeed4Btn.Left := ClientWidth div 2 - 62 + 3 * 29 + 12;
3594 EOT.Top := ClientHeight - 64;
3595 EOT.Left := ClientWidth - 62;
3596 SetWindowPos(sb.h, 0, xRightPanel + 10 - 14 -
3597 GetSystemMetrics(SM_CXVSCROLL), ClientHeight - MidPanelHeight + 8, 0, 0,
3598 SWP_NOSIZE or SWP_NOZORDER);
3599 MapBtn0.Left := xMini + G.lx - 44;
3600 MapBtn0.Top := ClientHeight - 15;
3601 MapBtn1.Left := xMini + G.lx - 28;
3602 MapBtn1.Top := ClientHeight - 15;
3603 { MapBtn2.Left:=xMini+G.lx-20;
3604 MapBtn2.Top:=ClientHeight-15;
3605 MapBtn3.Left:=xMini+G.lx-4;
3606 MapBtn3.Top:=ClientHeight-15; }
3607 MapBtn5.Left := xMini + G.lx - 12;
3608 MapBtn5.Top := ClientHeight - 15;
3609 MapBtn4.Left := xMini + G.lx + 20;
3610 MapBtn4.Top := ClientHeight - 15;
3611 MapBtn6.Left := xMini + G.lx + 36;
3612 MapBtn6.Top := ClientHeight - 15;
3613 TreasuryArea.Left := ClientWidth div 2 - 172;
3614 ResearchArea.Left := ClientWidth div 2;
3615 ManagementArea.Left := ClientWidth - xPalace;
3616 ManagementArea.Top := TopBarHeight + MapHeight - overlap + yPalace;
3617 ArrangeMidPanel;
3618 if RepaintOnResize then
3619 begin
3620 RectInvalidate(0, TopBarHeight, ClientWidth, TopBarHeight + MapHeight);
3621 MapValid := false;
3622 PaintAll
3623 end
3624 end;
3625
3626 procedure TMainScreen.FormCloseQuery(Sender: TObject; var CanClose: boolean);
3627 begin
3628 CanClose := Closable;
3629 if not Closable and idle and (me = 0) and (ClientMode < scContact) then
3630 MenuClick(mResign)
3631 end;
3632
3633 procedure TMainScreen.OnScroll(var m: TMessage);
3634 begin
3635 if ProcessPVSB(sb, m) then
3636 begin
3637 PanelPaint;
3638 Update
3639 end
3640 end;
3641
3642 procedure TMainScreen.OnEOT(var Msg: TMessage);
3643 begin
3644 EndTurn
3645 end;
3646
3647 procedure TMainScreen.EOTClick(Sender: TObject);
3648 begin
3649 if GameMode = cMovie then
3650 begin
3651 MessgExDlg.CancelMovie;
3652 Server(sBreak, me, 0, nil^)
3653 end
3654 else if ClientMode < 0 then
3655 skipped := true
3656 else if ClientMode >= scContact then
3657 NegoDlg.ShowNewContent(wmPersistent)
3658 else if Jump[pTurn] > 0 then
3659 begin
3660 Jump[pTurn] := 0;
3661 StartRunning := false
3662 end
3663 else
3664 EndTurn
3665 end;
3666
3667 // set xTerrain, xTroop, and TrRow
3668 procedure TMainScreen.ArrangeMidPanel;
3669 begin
3670 if ClientMode = cEditMap then
3671 xTroop := xMidPanel + 15
3672 else
3673 begin
3674 if supervising then
3675 xTerrain := xMidPanel + 2 * xxt + 14
3676 else if ClientWidth < 1280 then
3677 xTerrain := ClientWidth div 2 + (1280 - ClientWidth) div 3
3678 else
3679 xTerrain := ClientWidth div 2;
3680 xTroop := xTerrain + 2 * xxt + 12;
3681 if SmallScreen and not supervising then
3682 xTroop := xRightPanel + 10 - 3 * 66 -
3683 GetSystemMetrics(SM_CXVSCROLL) - 19 - 4;
3684 // not perfect but we assume almost no one is still playing on a 800x600 screen
3685 end;
3686 TrRow := (xRightPanel + 10 - xTroop - GetSystemMetrics(SM_CXVSCROLL) - 19)
3687 div TrPitch;
3688 end;
3689
3690 function TMainScreen.EndTurn(WasSkipped: boolean): boolean;
3691
3692 function IsResourceUnused(cix, NeedFood, NeedProd: integer): boolean;
3693 var
3694 dx, dy, fix: integer;
3695 CityAreaInfo: TCityAreaInfo;
3696 TileInfo: TTileInfo;
3697 begin
3698 Server(sGetCityAreaInfo, me, cix, CityAreaInfo);
3699 for dy := -3 to 3 do
3700 for dx := -3 to 3 do
3701 if ((dx + dy) and 1 = 0) and (dx * dx * dy * dy < 81) then
3702 begin
3703 fix := (dy + 3) shl 2 + (dx + 3) shr 1;
3704 if (MyCity[cix].Tiles and (1 shl fix) = 0) // not used yet
3705 and (CityAreaInfo.Available[fix] = faAvailable) then // usable
3706 begin
3707 TileInfo.ExplCity := cix;
3708 Server(sGetHypoCityTileInfo, me, dLoc(MyCity[cix].Loc, dx, dy),
3709 TileInfo);
3710 if (TileInfo.Food >= NeedFood) and (TileInfo.Prod >= NeedProd)
3711 then
3712 begin
3713 result := true;
3714 exit
3715 end;
3716 end
3717 end;
3718 result := false;
3719 end;
3720
3721 var
3722 i, p1, uix, cix, CenterLoc: integer;
3723 MsgItem: string;
3724 CityReport: TCityReport;
3725 PlaneReturnData: TPlaneReturnData;
3726 Zoom: boolean;
3727 begin
3728 result := false;
3729 if ClientMode >= scDipOffer then
3730 exit;
3731
3732 if supervising and (me <> 0) then
3733 begin
3734 for i := 0 to Screen.FormCount - 1 do
3735 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)
3736 then
3737 Screen.Forms[i].Close; // close windows
3738 ItsMeAgain(0);
3739 end;
3740
3741 CityOptimizer_EndOfTurn;
3742
3743 if not WasSkipped then // check warnings
3744 begin
3745 // need to move planes home?
3746 for uix := 0 to MyRO.nUn - 1 do
3747 with MyUn[uix] do
3748 if (Loc >= 0) and (MyModel[mix].Domain = dAir) and
3749 (Status and usToldNoReturn = 0) and (Master < 0) and
3750 (MyMap[Loc] and fCity = 0) and (MyMap[Loc] and fTerImp <> tiBase)
3751 then
3752 begin
3753 PlaneReturnData.Fuel := Fuel;
3754 PlaneReturnData.Loc := Loc;
3755 PlaneReturnData.Movement := 0; // end turn without further movement?
3756 if Server(sGetPlaneReturn, me, uix, PlaneReturnData) = eNoWay then
3757 begin
3758 CenterLoc := Loc + G.lx * 6;
3759 // centering the unit itself would make it covered by the query dialog
3760 while CenterLoc >= G.lx * G.ly do
3761 dec(CenterLoc, G.lx * 2);
3762 Centre(CenterLoc);
3763 SetTroopLoc(-1);
3764 PaintAll;
3765
3766 if MyModel[mix].Kind = mkSpecial_Glider then
3767 MsgItem := 'LOWFUEL_GLIDER'
3768 else
3769 MsgItem := 'LOWFUEL';
3770 if SimpleQuery(mkYesNo, Phrases.Lookup(MsgItem),
3771 'WARNING_LOWSUPPORT') <> mrOK then
3772 begin
3773 SetUnFocus(uix);
3774 SetTroopLoc(Loc);
3775 PanelPaint;
3776 exit;
3777 end;
3778 MyUn[uix].Status := MyUn[uix].Status or usToldNoReturn;
3779 end
3780 end;
3781
3782 if not supervising and (MyRO.TestFlags and tfImmImprove = 0) and
3783 (MyRO.Government <> gAnarchy) and (MyRO.Money + TaxSum < 0) and
3784 (MyRO.TaxRate < 100) then // low funds!
3785 with MessgExDlg do
3786 begin
3787 OpenSound := 'WARNING_LOWFUNDS';
3788 MessgText := Phrases.Lookup('LOWFUNDS');
3789 Kind := mkYesNo;
3790 IconKind := mikImp;
3791 IconIndex := imTrGoods;
3792 ShowModal;
3793 if ModalResult <> mrOK then
3794 exit
3795 end;
3796
3797 if MyRO.Government <> gAnarchy then
3798 for cix := 0 to MyRO.nCity - 1 do
3799 with MyCity[cix] do
3800 if (Loc >= 0) and (Flags and chCaptured = 0) then
3801 begin
3802 Zoom := false;
3803 CityReport.HypoTiles := -1;
3804 CityReport.HypoTax := -1;
3805 CityReport.HypoLux := -1;
3806 Server(sGetCityReport, me, cix, CityReport);
3807
3808 if (CityReport.Working - CityReport.Happy > Size shr 1) and
3809 (Flags and chCaptured <= $10000) then
3810 with MessgExDlg do
3811 begin
3812 OpenSound := 'WARNING_DISORDER';
3813 if Status and csResourceWeightsMask = 0 then
3814 MsgItem := 'DISORDER'
3815 else
3816 MsgItem := 'DISORDER_UNREST';
3817 MessgText := Format(Phrases.Lookup(MsgItem), [CityName(ID)]);
3818 Kind := mkYesNo;
3819 // BigIcon:=29;
3820 ShowModal;
3821 Zoom := ModalResult <> mrOK;
3822 end;
3823 if not Zoom and (Food + CityReport.FoodRep - CityReport.Eaten < 0)
3824 then
3825 with MessgExDlg do
3826 begin
3827 OpenSound := 'WARNING_FAMINE';
3828 if Status and csResourceWeightsMask = 0 then
3829 MsgItem := 'FAMINE'
3830 else if (CityReport.Deployed <> 0) and
3831 IsResourceUnused(cix, 1, 0) then
3832 MsgItem := 'FAMINE_UNREST'
3833 else
3834 MsgItem := 'FAMINE_TILES';
3835 MessgText := Format(Phrases.Lookup(MsgItem), [CityName(ID)]);
3836 Kind := mkYesNo;
3837 IconKind := mikImp;
3838 IconIndex := 22;
3839 ShowModal;
3840 Zoom := ModalResult <> mrOK;
3841 end;
3842 if not Zoom and (CityReport.ProdRep < CityReport.Support) then
3843 with MessgExDlg do
3844 begin
3845 OpenSound := 'WARNING_LOWSUPPORT';
3846 if Status and csResourceWeightsMask = 0 then
3847 MsgItem := 'LOWSUPPORT'
3848 else if (CityReport.Deployed <> 0) and
3849 IsResourceUnused(cix, 0, 1) then
3850 MsgItem := 'LOWSUPPORT_UNREST'
3851 else
3852 MsgItem := 'LOWSUPPORT_TILES';
3853 MessgText := Format(Phrases.Lookup(MsgItem), [CityName(ID)]);
3854 Kind := mkYesNo;
3855 IconKind := mikImp;
3856 IconIndex := 29;
3857 ShowModal;
3858 Zoom := ModalResult <> mrOK;
3859 end;
3860 if Zoom then
3861 begin // zoom to city
3862 ZoomToCity(Loc);
3863 exit
3864 end
3865 end;
3866
3867 if (MyRO.Happened and phTech <> 0) and (MyRO.ResearchTech < 0) and
3868 (MyData.FarTech <> adNexus) then
3869 if not ChooseResearch then
3870 exit;
3871 end;
3872
3873 RememberPeaceViolation;
3874
3875 SetUnFocus(-1);
3876 for uix := 0 to MyRO.nUn - 1 do
3877 MyUn[uix].Status := MyUn[uix].Status and usPersistent;
3878
3879 CityDlg.CloseAction := None;
3880 if IsMultiPlayerGame then
3881 begin // close windows for next player
3882 for i := 0 to Screen.FormCount - 1 do
3883 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)
3884 then
3885 Screen.Forms[i].Close;
3886 end
3887 else
3888 begin
3889 if CityDlg.Visible then
3890 CityDlg.Close;
3891 if UnitStatDlg.Visible then
3892 UnitStatDlg.Close;
3893 end;
3894 for i := 0 to Screen.FormCount - 1 do
3895 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then
3896 Screen.Forms[i].Enabled := false;
3897
3898 if Server(sTurn, pTurn, 0, nil^) >= rExecuted then
3899 begin
3900 if Jump[pTurn] > 0 then
3901 EOT.Hint := Phrases.Lookup('BTN_STOP')
3902 else
3903 EOT.Hint := Phrases.Lookup('BTN_SKIP');
3904 result := true;
3905 SetTroopLoc(-1);
3906 pTurn := -1;
3907 pLogo := -1;
3908 UnitInfoBtn.Visible := false;
3909 UnitBtn.Visible := false;
3910 TerrainBtn.Visible := false;
3911 EOT.ButtonIndex := eotCancel;
3912 EOT.Visible := true;
3913 MapValid := false;
3914 PanelPaint;
3915 Update;
3916 ClientMode := -1;
3917 idle := false;
3918 skipped := WasSkipped;
3919 for p1 := 1 to nPl - 1 do
3920 if G.RO[p1] <> nil then
3921 skipped := true; // don't show enemy moves in hotseat mode
3922 end
3923 else
3924 PanelPaint
3925 end; // EndTurn
3926
3927 procedure TMainScreen.EndNego;
3928 begin
3929 if NegoDlg.Visible then
3930 NegoDlg.Close;
3931 HaveStrategyAdvice := false;
3932 // AdvisorDlg.HaveStrategyAdvice;
3933 // negotiation might have changed advices
3934 EOT.ButtonIndex := eotCancel;
3935 EOT.Visible := true;
3936 PanelPaint;
3937 Update;
3938 ClientMode := -1;
3939 idle := false;
3940 end;
3941
3942 procedure TMainScreen.ProcessRect(x0, y0, nx, ny, Options: integer);
3943 var
3944 xs, ys, xl, yl: integer;
3945 begin
3946 xl := nx * xxt + xxt;
3947 yl := ny * yyt + yyt * 2;
3948 xs := (x0 - xw) * (xxt * 2) + y0 and 1 * xxt - G.lx * (xxt * 2);
3949 // |xs+xl/2-MapWidth/2| -> min
3950 while abs(2 * (xs + G.lx * (xxt * 2)) + xl - MapWidth) <
3951 abs(2 * xs + xl - MapWidth) do
3952 inc(xs, G.lx * (xxt * 2));
3953 ys := (y0 - yw) * yyt - yyt;
3954 if xs + xl > MapWidth then
3955 xl := MapWidth - xs;
3956 if ys + yl > MapHeight then
3957 yl := MapHeight - ys;
3958 if (xl <= 0) or (yl <= 0) then
3959 exit;
3960 if Options and prPaint <> 0 then
3961 begin
3962 if Options and prAutoBounds <> 0 then
3963 MainMap.SetPaintBounds(xs, ys, xs + xl, ys + yl);
3964 MainMap.Paint(xs, ys, x0 + G.lx * y0, nx, ny, -1, -1);
3965 end;
3966 if Options and prInvalidate <> 0 then
3967 RectInvalidate(MapOffset + xs, TopBarHeight + ys, MapOffset + xs + xl,
3968 TopBarHeight + ys + yl)
3969 end;
3970
3971 procedure TMainScreen.PaintLoc(Loc: integer; Radius: integer = 0);
3972 var
3973 yLoc, x0: integer;
3974 begin
3975 if MapValid then
3976 begin
3977 yLoc := (Loc + G.lx * 1024) div G.lx - 1024;
3978 x0 := (Loc + (yLoc and 1 - 2 * Radius + G.lx * 1024) div 2) mod G.lx;
3979 offscreen.Canvas.Font.Assign(UniFont[ftSmall]);
3980 ProcessRect(x0, yLoc - 2 * Radius, 4 * Radius + 1, 4 * Radius + 1,
3981 prPaint or prAutoBounds or prInvalidate);
3982 Update;
3983 end
3984 end;
3985
3986 procedure TMainScreen.PaintLocTemp(Loc, Style: integer);
3987 var
3988 y0, x0, xMap, yMap: integer;
3989 begin
3990 if not MapValid then
3991 exit;
3992 Buffer.Canvas.Font.Assign(UniFont[ftSmall]);
3993 y0 := Loc div G.lx;
3994 x0 := Loc mod G.lx;
3995 xMap := (x0 - xw) * (xxt * 2) + y0 and 1 * xxt - G.lx * (xxt * 2);
3996 // |xMap+xxt-MapWidth/2| -> min
3997 while abs(2 * (xMap + G.lx * (xxt * 2)) + 2 * xxt - MapWidth) <
3998 abs(2 * xMap + 2 * xxt - MapWidth) do
3999 inc(xMap, G.lx * (xxt * 2));
4000 yMap := (y0 - yw) * yyt - yyt;
4001 NoMap.SetOutput(Buffer);
4002 NoMap.SetPaintBounds(0, 0, 2 * xxt, 3 * yyt);
4003 NoMap.Paint(0, 0, Loc, 1, 1, -1, -1, Style = pltsBlink);
4004 PaintBufferToScreen(xMap, yMap, 2 * xxt, 3 * yyt);
4005 end;
4006
4007 // paint content of buffer directly to screen instead of offscreen
4008 // panel protusions are added
4009 // NoMap must be set to buffer and bounds before
4010 procedure TMainScreen.PaintBufferToScreen(xMap, yMap, width, height: integer);
4011 begin
4012 if xMap + width > MapWidth then
4013 width := MapWidth - xMap;
4014 if yMap + height > MapHeight then
4015 height := MapHeight - yMap;
4016 if (width <= 0) or (height <= 0) or (width + xMap <= 0) or
4017 (height + yMap <= 0) then
4018 exit;
4019
4020 NoMap.BitBlt(Panel, -xMap - MapOffset, -yMap + MapHeight - overlap,
4021 xMidPanel, overlap, 0, 0, SRCCOPY);
4022 NoMap.BitBlt(Panel, -xMap - MapOffset + xRightPanel,
4023 -yMap + MapHeight - overlap, Panel.width - xRightPanel, overlap,
4024 xRightPanel, 0, SRCCOPY);
4025 if yMap < 0 then
4026 begin
4027 if xMap < 0 then
4028 BitBlt(Canvas.Handle, MapOffset, TopBarHeight, width + xMap,
4029 height + yMap, Buffer.Canvas.Handle, -xMap, -yMap, SRCCOPY)
4030 else
4031 BitBlt(Canvas.Handle, xMap + MapOffset, TopBarHeight, width,
4032 height + yMap, Buffer.Canvas.Handle, 0, -yMap, SRCCOPY)
4033 end
4034 else
4035 begin
4036 if xMap < 0 then
4037 BitBlt(Canvas.Handle, MapOffset, TopBarHeight + yMap, width + xMap,
4038 height, Buffer.Canvas.Handle, -xMap, 0, SRCCOPY)
4039 else
4040 BitBlt(Canvas.Handle, xMap + MapOffset, TopBarHeight + yMap, width,
4041 height, Buffer.Canvas.Handle, 0, 0, SRCCOPY);
4042 end
4043 end;
4044
4045 procedure TMainScreen.PaintLoc_BeforeMove(FromLoc: integer);
4046 var
4047 yLoc, x0: integer;
4048 begin
4049 if MapValid then
4050 begin
4051 yLoc := (FromLoc + G.lx * 1024) div G.lx - 1024;
4052 x0 := (FromLoc + (yLoc and 1 + G.lx * 1024) div 2) mod G.lx;
4053 offscreen.Canvas.Font.Assign(UniFont[ftSmall]);
4054 ProcessRect(x0, yLoc, 1, 1, prPaint or prAutoBounds);
4055 end
4056 end;
4057
4058 procedure TMainScreen.PaintDestination;
4059 var
4060 Destination: integer;
4061 begin
4062 if (UnFocus >= 0) and (MyUn[UnFocus].Status and usGoto <> 0) then
4063 begin
4064 Destination := MyUn[UnFocus].Status shr 16;
4065 if (Destination <> $7FFF) and (Destination <> MyUn[UnFocus].Loc) then
4066 PaintLocTemp(Destination, pltsBlink);
4067 end;
4068 end;
4069
4070 procedure TMainScreen.MiniPaint;
4071 type
4072 TLine = array [0 .. 99999999, 0 .. 2] of Byte;
4073 var
4074 uix, cix, x, y, Loc, i, hw, xm, cm, cmPolOcean, cmPolNone: integer;
4075 PrevMiniLine, MiniLine: ^TLine;
4076 begin
4077 cmPolOcean := GrExt[HGrSystem].Data.Canvas.Pixels[101, 67];
4078 cmPolNone := GrExt[HGrSystem].Data.Canvas.Pixels[102, 67];
4079 hw := MapWidth div (xxt * 2);
4080 with Mini.Canvas do
4081 begin
4082 Brush.Color := $000000;
4083 FillRect(Rect(0, 0, Mini.width, Mini.height));
4084 end;
4085 MiniLine := nil;
4086 for y := 0 to G.ly - 1 do
4087 begin
4088 PrevMiniLine := MiniLine;
4089 MiniLine := Mini.ScanLine[y];
4090 for x := 0 to G.lx - 1 do
4091 if MyMap[x + G.lx * y] and fTerrain <> fUNKNOWN then
4092 begin
4093 Loc := x + G.lx * y;
4094 for i := 0 to 1 do
4095 begin
4096 xm := ((x - xwMini) * 2 + i + y and 1 - hw + G.lx * 5)
4097 mod (G.lx * 2);
4098 cm := MiniColors[MyMap[Loc] and fTerrain, i];
4099 if ClientMode = cEditMap then
4100 begin
4101 if MyMap[Loc] and (fPrefStartPos or fStartPos) <> 0 then
4102 cm := $FFFFFF;
4103 end
4104 else if MyMap[Loc] and fCity <> 0 then
4105 begin
4106 cix := MyRO.nCity - 1;
4107 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do
4108 dec(cix);
4109 if cix >= 0 then
4110 cm := Tribe[me].Color
4111 else
4112 begin
4113 cix := MyRO.nEnemyCity - 1;
4114 while (cix >= 0) and (MyRO.EnemyCity[cix].Loc <> Loc) do
4115 dec(cix);
4116 if cix >= 0 then
4117 cm := Tribe[MyRO.EnemyCity[cix].Owner].Color
4118 end;
4119 cm := $808080 or cm shr 1; { increase brightness }
4120 if PrevMiniLine <> nil then
4121 begin // 2x2 city dot covers two scanlines
4122 PrevMiniLine[xm, 0] := cm shr 16;
4123 PrevMiniLine[xm, 1] := cm shr 8 and $FF;
4124 PrevMiniLine[xm, 2] := cm and $FF;
4125 end
4126 end
4127 else if (i = 0) and (MyMap[Loc] and fUnit <> 0) then
4128 begin
4129 uix := MyRO.nUn - 1;
4130 while (uix >= 0) and (MyUn[uix].Loc <> Loc) do
4131 dec(uix);
4132 if uix >= 0 then
4133 cm := Tribe[me].Color
4134 else
4135 begin
4136 uix := MyRO.nEnemyUn - 1;
4137 while (uix >= 0) and (MyRO.EnemyUn[uix].Loc <> Loc) do
4138 dec(uix);
4139 if uix >= 0 then
4140 cm := Tribe[MyRO.EnemyUn[uix].Owner].Color
4141 end;
4142 cm := $808080 or cm shr 1; { increase brightness }
4143 end
4144 else if MapOptionChecked and (1 shl moPolitical) <> 0 then
4145 begin
4146 if MyMap[Loc] and fTerrain < fGrass then
4147 cm := cmPolOcean
4148 else if MyRO.Territory[Loc] < 0 then
4149 cm := cmPolNone
4150 else
4151 cm := Tribe[MyRO.Territory[Loc]].Color;
4152 end;
4153 MiniLine[xm, 0] := cm shr 16;
4154 MiniLine[xm, 1] := cm shr 8 and $FF;
4155 MiniLine[xm, 2] := cm and $FF;
4156 end;
4157 end
4158 end;
4159 end;
4160
4161 procedure TMainScreen.MainOffscreenPaint;
4162 var
4163 ProcessOptions: integer;
4164 rec: TRect;
4165 DoInvalidate: boolean;
4166 begin
4167 if me < 0 then
4168 with offscreen.Canvas do
4169 begin
4170 Brush.Color := $000000;
4171 FillRect(Rect(0, 0, MapWidth, MapHeight));
4172 Brush.Style := bsClear;
4173 OffscreenUser := self;
4174 exit
4175 end;
4176
4177 MainMap.SetPaintBounds(0, 0, MapWidth, MapHeight);
4178 if OffscreenUser <> self then
4179 begin
4180 if OffscreenUser <> nil then
4181 OffscreenUser.Update;
4182 // complete working with old owner to prevent rebound
4183 if MapValid and (xwd = xw) and (ywd = yw) then
4184 MainMap.SetPaintBounds(0, 0, UsedOffscreenWidth, UsedOffscreenHeight);
4185 MapValid := false;
4186 OffscreenUser := self;
4187 end;
4188
4189 if xw - xwd > G.lx div 2 then
4190 xwd := xwd + G.lx
4191 else if xwd - xw > G.lx div 2 then
4192 xwd := xwd - G.lx;
4193 if not MapValid or (xw - xwd > MapWidth div (xxt * 2)) or
4194 (xwd - xw > MapWidth div (xxt * 2)) or (yw - ywd > MapHeight div yyt) or
4195 (ywd - yw > MapHeight div yyt) then
4196 begin
4197 offscreen.Canvas.Font.Assign(UniFont[ftSmall]);
4198 ProcessRect(xw, yw, MapWidth div xxt, MapHeight div yyt,
4199 prPaint or prInvalidate)
4200 end
4201 else
4202 begin
4203 if (xwd = xw) and (ywd = yw) then
4204 exit; { map window not moved }
4205 offscreen.Canvas.Font.Assign(UniFont[ftSmall]);
4206 rec := Rect(0, 0, MapWidth, MapHeight);
4207 { TODO ScrollDC(offscreen.Canvas.Handle, (xwd - xw) * (xxt * 2),
4208 (ywd - yw) * yyt, rec, rec, 0, nil);}
4209 for DoInvalidate := false to FastScrolling do
4210 begin
4211 if DoInvalidate then
4212 begin
4213 rec.Bottom := MapHeight - overlap;
4214 { TODO ScrollDC(Canvas.Handle, (xwd - xw) * (xxt * 2), (ywd - yw) * yyt, rec,
4215 rec, 0, nil);}
4216 ProcessOptions := prInvalidate;
4217 end
4218 else
4219 ProcessOptions := prPaint or prAutoBounds;
4220 if yw < ywd then
4221 begin
4222 ProcessRect(xw, yw, MapWidth div xxt, ywd - yw - 1, ProcessOptions);
4223 if xw < xwd then
4224 ProcessRect(xw, ywd, (xwd - xw) * 2 - 1, MapHeight div yyt - ywd +
4225 yw, ProcessOptions)
4226 else if xw > xwd then
4227 ProcessRect((xwd + MapWidth div (xxt * 2)) mod G.lx, ywd,
4228 (xw - xwd) * 2 + 1, MapHeight div yyt - ywd + yw, ProcessOptions)
4229 end
4230 else if yw > ywd then
4231 begin
4232 if DoInvalidate then
4233 RectInvalidate(MapOffset, TopBarHeight + MapHeight - overlap -
4234 (yw - ywd) * yyt, MapOffset + MapWidth, TopBarHeight + MapHeight
4235 - overlap)
4236 else
4237 ProcessRect(xw, (ywd + MapHeight div (yyt * 2) * 2),
4238 MapWidth div xxt, yw - ywd + 1, ProcessOptions);
4239 if xw < xwd then
4240 ProcessRect(xw, yw, (xwd - xw) * 2 - 1, MapHeight div yyt - yw + ywd
4241 - 2, ProcessOptions)
4242 else if xw > xwd then
4243 ProcessRect((xwd + MapWidth div (xxt * 2)) mod G.lx, yw,
4244 (xw - xwd) * 2 + 1, MapHeight div yyt - yw + ywd - 2,
4245 ProcessOptions)
4246 end
4247 else if xw < xwd then
4248 ProcessRect(xw, yw, (xwd - xw) * 2 - 1, MapHeight div yyt,
4249 ProcessOptions)
4250 else if xw > xwd then
4251 ProcessRect((xwd + MapWidth div (xxt * 2)) mod G.lx, yw,
4252 (xw - xwd) * 2 + 1, MapHeight div yyt, ProcessOptions);
4253 end;
4254 if not FastScrolling then
4255 RectInvalidate(MapOffset, TopBarHeight, MapOffset + MapWidth,
4256 TopBarHeight + MapHeight - overlap);
4257 RectInvalidate(xMidPanel, TopBarHeight + MapHeight - overlap, xRightPanel,
4258 TopBarHeight + MapHeight)
4259 end;
4260 // if (xwd<>xw) or (ywd<>yw) then
4261 // Server(sChangeSuperView,me,yw*G.lx+xw,nil^); // for synchronizing client side viewer, not used currently
4262 xwd := xw;
4263 ywd := yw;
4264 MapValid := true;
4265 end;
4266
4267 procedure TMainScreen.PaintAll;
4268 begin
4269 MainOffscreenPaint;
4270 xwMini := xw;
4271 ywMini := yw;
4272 MiniPaint;
4273 PanelPaint;
4274 end;
4275
4276 procedure TMainScreen.PaintAllMaps;
4277 begin
4278 MainOffscreenPaint;
4279 xwMini := xw;
4280 ywMini := yw;
4281 MiniPaint;
4282 CopyMiniToPanel;
4283 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 2,
4284 xMini + 2 + G.lx * 2, TopBarHeight + MapHeight - overlap + yMini +
4285 2 + G.ly);
4286 end;
4287
4288 procedure TMainScreen.CopyMiniToPanel;
4289 begin
4290 BitBlt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly,
4291 Mini.Canvas.Handle, 0, 0, SRCCOPY);
4292 if MarkCityLoc >= 0 then
4293 Sprite(Panel, HGrSystem,
4294 xMini - 2 + (4 * G.lx + 2 * (MarkCityLoc mod G.lx) +
4295 (G.lx - MapWidth div (xxt * 2)) - 2 * xwd) mod (2 * G.lx) +
4296 MarkCityLoc div G.lx and 1, yMini - 3 + MarkCityLoc div G.lx, 10,
4297 10, 77, 47)
4298 else if ywmax <= 0 then
4299 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (xxt * 2), yMini + 2,
4300 xMini + 1 + G.lx + MapWidth div (xxt * 2), yMini + 2 + G.ly - 1,
4301 MainTexture.clMark, MainTexture.clMark)
4302 else
4303 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (xxt * 2),
4304 yMini + 2 + yw, xMini + 1 + G.lx + MapWidth div (xxt * 2),
4305 yMini + yw + MapHeight div yyt, MainTexture.clMark, MainTexture.clMark);
4306 end;
4307
4308 procedure TMainScreen.PanelPaint;
4309
4310 function MovementToString(var Un: TUn): string;
4311 begin
4312 result := ScreenTools.MovementToString(Un.Movement);
4313 if Un.Master >= 0 then
4314 result := '(' + result + ')'
4315 else if (MyModel[Un.mix].Domain = dAir) and
4316 (MyModel[Un.mix].Kind <> mkSpecial_Glider) then
4317 result := Format('%s(%d)', [result, Un.Fuel]);
4318 end;
4319
4320 var
4321 i, uix, uixDefender, x, xSrc, ySrc, xSrcBase, ySrcBase, CostFactor, Count,
4322 mixShow, xTreasurySection, xResearchSection, JobFocus, TrueMoney,
4323 TrueResearch: integer;
4324 Tile: Cardinal;
4325 s: string;
4326 unx: TUn;
4327 UnitInfo: TUnitInfo;
4328 JobProgressData: TJobProgressData;
4329 Prio: boolean;
4330 begin
4331 with Panel.Canvas do
4332 begin
4333 Fill(Panel.Canvas, 0, 3, xMidPanel + 7 - 10, PanelHeight - 3,
4334 wMainTexture - (xMidPanel + 7 - 10), hMainTexture - PanelHeight);
4335 Fill(Panel.Canvas, xRightPanel + 10 - 7, 3, Panel.width - xRightPanel - 10
4336 + 7, PanelHeight - 3, -(xRightPanel + 10 - 7),
4337 hMainTexture - PanelHeight);
4338 FillLarge(Panel.Canvas, xMidPanel - 2, PanelHeight - MidPanelHeight,
4339 xRightPanel + 2, PanelHeight, ClientWidth div 2);
4340
4341 Brush.Style := bsClear;
4342 Pen.Color := $000000;
4343 MoveTo(0, 0);
4344 LineTo(xMidPanel + 7 - 8, 0);
4345 LineTo(xMidPanel + 7 - 8, PanelHeight - MidPanelHeight);
4346 LineTo(xRightPanel, PanelHeight - MidPanelHeight);
4347 LineTo(xRightPanel, 0);
4348 LineTo(ClientWidth, 0);
4349 Pen.Color := MainTexture.clBevelLight;
4350 MoveTo(xMidPanel + 7 - 9, PanelHeight - MidPanelHeight + 2);
4351 LineTo(xRightPanel + 10 - 8, PanelHeight - MidPanelHeight + 2);
4352 Pen.Color := MainTexture.clBevelLight;
4353 MoveTo(0, 1);
4354 LineTo(xMidPanel + 7 - 9, 1);
4355 Pen.Color := MainTexture.clBevelShade;
4356 LineTo(xMidPanel + 7 - 9, PanelHeight - MidPanelHeight + 1);
4357 Pen.Color := MainTexture.clBevelLight;
4358 LineTo(xRightPanel + 10 - 9, PanelHeight - MidPanelHeight + 1);
4359 Pen.Color := MainTexture.clBevelLight;
4360 LineTo(xRightPanel + 10 - 9, 1);
4361 LineTo(ClientWidth, 1);
4362 MoveTo(ClientWidth, 2);
4363 LineTo(xRightPanel + 10 - 8, 2);
4364 LineTo(xRightPanel + 10 - 8, PanelHeight);
4365 MoveTo(0, 2);
4366 LineTo(xMidPanel + 7 - 10, 2);
4367 Pen.Color := MainTexture.clBevelShade;
4368 LineTo(xMidPanel + 7 - 10, PanelHeight);
4369 Corner(Panel.Canvas, xMidPanel + 7 - 16, 1, 1, MainTexture);
4370 Corner(Panel.Canvas, xRightPanel + 10 - 9, 1, 0, MainTexture);
4371 if ClientMode <> cEditMap then
4372 begin
4373 if supervising then
4374 begin
4375 ScreenTools.Frame(Panel.Canvas, ClientWidth - xPalace - 1, yPalace - 1,
4376 ClientWidth - xPalace + xSizeBig, yPalace + ySizeBig,
4377 $B0B0B0, $FFFFFF);
4378 RFrame(Panel.Canvas, ClientWidth - xPalace - 2, yPalace - 2,
4379 ClientWidth - xPalace + xSizeBig + 1, yPalace + ySizeBig + 1,
4380 $FFFFFF, $B0B0B0);
4381 BitBlt(Panel.Canvas.Handle, ClientWidth - xPalace, yPalace, xSizeBig,
4382 ySizeBig, GrExt[HGrSystem2].Data.Canvas.Handle, 70, 123, SRCCOPY);
4383 end
4384 else if MyRO.NatBuilt[imPalace] > 0 then
4385 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, imPalace, -1,
4386 GameMode <> cMovie
4387 { (GameMode<>cMovie) and (MyRO.Government<>gAnarchy) } )
4388 else
4389 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, 21, -1,
4390 GameMode <> cMovie
4391 { (GameMode<>cMovie) and (MyRO.Government<>gAnarchy) } );
4392 end;
4393
4394 if GameMode = cMovie then
4395 ScreenTools.Frame(Panel.Canvas, xMini + 1, yMini + 1, xMini + 2 + G.lx * 2,
4396 yMini + 2 + G.ly, $000000, $000000)
4397 else
4398 begin
4399 ScreenTools.Frame(Panel.Canvas, xMini + 1, yMini + 1, xMini + 2 + G.lx * 2,
4400 yMini + 2 + G.ly, $B0B0B0, $FFFFFF);
4401 RFrame(Panel.Canvas, xMini, yMini, xMini + 3 + G.lx * 2,
4402 yMini + 3 + G.ly, $FFFFFF, $B0B0B0);
4403 end;
4404 CopyMiniToPanel;
4405 if ClientMode <> cEditMap then // MapBtn icons
4406 for i := 0 to 5 do
4407 if i <> 3 then
4408 Dump(Panel, HGrSystem, xMini + G.lx - 42 + 16 * i, PanelHeight - 26,
4409 8, 8, 121 + i * 9, 61);
4410
4411 if ClientMode = cEditMap then
4412 begin
4413 for i := 0 to TrRow - 1 do
4414 trix[i] := -1;
4415 Count := 0;
4416 for i := 0 to nBrushTypes - 1 do
4417 begin // display terrain types
4418 if (Count >= TrRow * sb.si.npos) and (Count < TrRow * (sb.si.npos + 1))
4419 then
4420 begin
4421 trix[Count - TrRow * sb.si.npos] := BrushTypes[i];
4422 x := (Count - TrRow * sb.si.npos) * TrPitch;
4423 xSrcBase := -1;
4424 case BrushTypes[i] of
4425 0 .. 8:
4426 begin
4427 xSrc := BrushTypes[i];
4428 ySrc := 0
4429 end;
4430 9 .. 30:
4431 begin
4432 xSrcBase := 2;
4433 ySrcBase := 2;
4434 xSrc := 0;
4435 ySrc := 2 * integer(BrushTypes[i]) - 15
4436 end;
4437 fRiver:
4438 begin
4439 xSrc := 7;
4440 ySrc := 14
4441 end;
4442 fRoad:
4443 begin
4444 xSrc := 0;
4445 ySrc := 9
4446 end;
4447 fRR:
4448 begin
4449 xSrc := 0;
4450 ySrc := 10
4451 end;
4452 fCanal:
4453 begin
4454 xSrc := 0;
4455 ySrc := 11
4456 end;
4457 fPoll:
4458 begin
4459 xSrc := 6;
4460 ySrc := 12
4461 end;
4462 fDeadLands, fDeadLands or fCobalt, fDeadLands or fUranium,
4463 fDeadLands or fMercury:
4464 begin
4465 xSrcBase := 6;
4466 ySrcBase := 2;
4467 xSrc := 8;
4468 ySrc := 12 + BrushTypes[i] shr 25;
4469 end;
4470 tiIrrigation, tiFarm, tiMine, tiBase:
4471 begin
4472 xSrc := BrushTypes[i] shr 12 - 1;
4473 ySrc := 12
4474 end;
4475 tiFort:
4476 begin
4477 xSrc := 3;
4478 ySrc := 12;
4479 xSrcBase := 7;
4480 ySrcBase := 12
4481 end;
4482 fPrefStartPos:
4483 begin
4484 xSrc := 0;
4485 ySrc := 1
4486 end;
4487 fStartPos:
4488 begin
4489 xSrc := 0;
4490 ySrc := 2
4491 end;
4492 end;
4493 if xSrcBase >= 0 then
4494 Sprite(Panel, HGrTerrain, xTroop + 2 + x, yTroop + 9 - yyt,
4495 xxt * 2, yyt * 3, 1 + xSrcBase * (xxt * 2 + 1),
4496 1 + ySrcBase * (yyt * 3 + 1));
4497 Sprite(Panel, HGrTerrain, xTroop + 2 + x, yTroop + 9 - yyt, xxt * 2,
4498 yyt * 3, 1 + xSrc * (xxt * 2 + 1), 1 + ySrc * (yyt * 3 + 1));
4499 if BrushTypes[i] = BrushType then
4500 begin
4501 ScreenTools.Frame(Panel.Canvas, xTroop + 2 + x, yTroop + 7 - yyt div 2,
4502 xTroop + 2 * xxt + x, yTroop + 2 * yyt + 11, $000000, $000000);
4503 ScreenTools.Frame(Panel.Canvas, xTroop + 1 + x, yTroop + 6 - yyt div 2,
4504 xTroop + 2 * xxt - 1 + x, yTroop + 2 * yyt + 10,
4505 MainTexture.clMark, MainTexture.clMark);
4506 end
4507 end;
4508 inc(Count)
4509 end;
4510 case BrushType of
4511 fDesert, fPrairie, fTundra, fArctic, fSwamp, fHills, fMountains:
4512 s := Phrases.Lookup('TERRAIN', BrushType);
4513 fShore:
4514 s := Format(Phrases.Lookup('TWOTERRAINS'),
4515 [Phrases.Lookup('TERRAIN', fOcean), Phrases.Lookup('TERRAIN',
4516 fShore)]);
4517 fGrass:
4518 s := Format(Phrases.Lookup('TWOTERRAINS'),
4519 [Phrases.Lookup('TERRAIN', fGrass), Phrases.Lookup('TERRAIN',
4520 fGrass + 12)]);
4521 fForest:
4522 s := Format(Phrases.Lookup('TWOTERRAINS'),
4523 [Phrases.Lookup('TERRAIN', fForest), Phrases.Lookup('TERRAIN',
4524 fJungle)]);
4525 fRiver:
4526 s := Phrases.Lookup('RIVER');
4527 fDeadLands, fDeadLands or fCobalt, fDeadLands or fUranium,
4528 fDeadLands or fMercury:
4529 s := Phrases.Lookup('TERRAIN', 3 * 12 + BrushType shr 25);
4530 fPrefStartPos:
4531 s := Phrases.Lookup('MAP_PREFSTART');
4532 fStartPos:
4533 s := Phrases.Lookup('MAP_START');
4534 fPoll:
4535 s := Phrases.Lookup('POLL');
4536 else // terrain improvements
4537 begin
4538 case BrushType of
4539 fRoad:
4540 i := 1;
4541 fRR:
4542 i := 2;
4543 tiIrrigation:
4544 i := 4;
4545 tiFarm:
4546 i := 5;
4547 tiMine:
4548 i := 7;
4549 fCanal:
4550 i := 8;
4551 tiFort:
4552 i := 10;
4553 tiBase:
4554 i := 12;
4555 end;
4556 s := Phrases.Lookup('JOBRESULT', i);
4557 end
4558 end;
4559 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop + 1,
4560 PanelHeight - 19, s);
4561 end
4562 else if TroopLoc >= 0 then
4563 begin
4564 Brush.Style := bsClear;
4565 if UnFocus >= 0 then
4566 with MyUn[UnFocus], MyModel[mix] do
4567 begin { display info about selected unit }
4568 if Job = jCity then
4569 mixShow := -1 // building site
4570 else
4571 mixShow := mix;
4572 with Tribe[me].ModelPicture[mixShow] do
4573 begin
4574 Sprite(Panel, HGr, xMidPanel + 7 + 12, yTroop + 1, 64, 48,
4575 pix mod 10 * 65 + 1, pix div 10 * 49 + 1);
4576 if MyUn[UnFocus].Flags and unFortified <> 0 then
4577 Sprite(Panel, HGrStdUnits, xMidPanel + 7 + 12, yTroop + 1,
4578 xxu * 2, yyu * 2, 1 + 6 * (xxu * 2 + 1), 1);
4579 end;
4580
4581 MakeBlue(Panel, xMidPanel + 7 + 12 + 10, yTroop - 13, 44, 12);
4582 s := MovementToString(MyUn[UnFocus]);
4583 RisedTextOut(Panel.Canvas, xMidPanel + 7 + 12 + 32 -
4584 BiColorTextWidth(Panel.Canvas, s) div 2, yTroop - 16, s);
4585
4586 s := IntToStr(Health) + '%';
4587 LightGradient(Panel.Canvas, xMidPanel + 7 + 12 + 7,
4588 PanelHeight - 22, (Health + 1) div 2,
4589 (ColorOfHealth(Health) and $FEFEFE shr 2) * 3);
4590 if Health < 100 then
4591 LightGradient(Panel.Canvas, xMidPanel + 7 + 12 + 7 + (Health + 1)
4592 div 2, PanelHeight - 22, 50 - (Health + 1) div 2, $000000);
4593 RisedTextOut(Panel.Canvas, xMidPanel + 7 + 12 + 32 -
4594 BiColorTextWidth(Panel.Canvas, s) div 2, PanelHeight - 23, s);
4595
4596 FrameImage(Panel.Canvas, GrExt[HGrSystem].Data,
4597 xMidPanel + 7 + xUnitText, yTroop + 15, 12, 14,
4598 121 + Exp div ExpCost * 13, 28);
4599 if Job = jCity then
4600 s := Tribe[me].ModelName[-1]
4601 else
4602 s := Tribe[me].ModelName[mix];
4603 if Home >= 0 then
4604 begin
4605 LoweredTextOut(Panel.Canvas, -1, MainTexture,
4606 xMidPanel + 7 + xUnitText + 18, yTroop + 5, s);
4607 LoweredTextOut(Panel.Canvas, -1, MainTexture,
4608 xMidPanel + 7 + xUnitText + 18, yTroop + 21,
4609 '(' + CityName(MyCity[Home].ID) + ')');
4610 end
4611 else
4612 LoweredTextOut(Panel.Canvas, -1, MainTexture,
4613 xMidPanel + 7 + xUnitText + 18, yTroop + 13, s);
4614 end;
4615
4616 if (UnFocus >= 0) and (MyUn[UnFocus].Loc <> TroopLoc) then
4617 begin // divide panel
4618 if SmallScreen and not supervising then
4619 x := xTroop - 8
4620 else
4621 x := xTroop - 152;
4622 Pen.Color := MainTexture.clBevelShade;
4623 MoveTo(x - 1, PanelHeight - MidPanelHeight + 2);
4624 LineTo(x - 1, PanelHeight);
4625 Pen.Color := MainTexture.clBevelLight;
4626 MoveTo(x, PanelHeight - MidPanelHeight + 2);
4627 LineTo(x, PanelHeight);
4628 end;
4629
4630 for i := 0 to 23 do
4631 trix[i] := -1;
4632 if MyMap[TroopLoc] and fUnit <> 0 then
4633 begin
4634 if MyMap[TroopLoc] and fOwned <> 0 then
4635 begin
4636 if (TrCnt > 1) or (UnFocus < 0) or (MyUn[UnFocus].Loc <> TroopLoc)
4637 then
4638 begin
4639 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop + 10,
4640 PanelHeight - 24, Phrases.Lookup('PRESENT'));
4641 Server(sGetDefender, me, TroopLoc, uixDefender);
4642 Count := 0;
4643 for Prio := true downto false do
4644 for uix := 0 to MyRO.nUn - 1 do
4645 if (uix = uixDefender) = Prio then
4646 begin // display own units
4647 unx := MyUn[uix];
4648 if unx.Loc = TroopLoc then
4649 begin
4650 if (Count >= TrRow * sb.si.npos) and
4651 (Count < TrRow * (sb.si.npos + 1)) then
4652 begin
4653 trix[Count - TrRow * sb.si.npos] := uix;
4654 MakeUnitInfo(me, unx, UnitInfo);
4655 x := (Count - TrRow * sb.si.npos) * TrPitch;
4656 if uix = UnFocus then
4657 begin
4658 ScreenTools.Frame(Panel.Canvas, xTroop + 4 + x, yTroop + 3,
4659 xTroop + 64 + x, yTroop + 47, $000000, $000000);
4660 ScreenTools.Frame(Panel.Canvas, xTroop + 3 + x, yTroop + 2,
4661 xTroop + 63 + x, yTroop + 46, MainTexture.clMark,
4662 MainTexture.clMark);
4663 end
4664 else if (unx.Master >= 0) and (unx.Master = UnFocus)
4665 then
4666 begin
4667 CFrame(Panel.Canvas, xTroop + 4 + x, yTroop + 3,
4668 xTroop + 64 + x, yTroop + 47, 8, $000000);
4669 CFrame(Panel.Canvas, xTroop + 3 + x, yTroop + 2,
4670 xTroop + 63 + x, yTroop + 46, 8,
4671 MainTexture.clMark);
4672 end;
4673 NoMap.SetOutput(Panel);
4674 NoMap.PaintUnit(xTroop + 2 + x, yTroop + 1, UnitInfo,
4675 unx.Status);
4676 if (ClientMode < scContact) and
4677 ((unx.Job > jNone) or
4678 (unx.Status and (usStay or usRecover or usGoto) <> 0))
4679 then
4680 Sprite(Panel, HGrSystem, xTroop + 2 + 60 - 20 + x,
4681 yTroop + 35, 20, 20, 81, 25);
4682
4683 if not supervising then
4684 begin
4685 MakeBlue(Panel, xTroop + 2 + 10 + x,
4686 yTroop - 13, 44, 12);
4687 s := MovementToString(unx);
4688 RisedTextOut(Panel.Canvas,
4689 xTroop + x + 34 - BiColorTextWidth(Panel.Canvas, s)
4690 div 2, yTroop - 16, s);
4691 end
4692 end;
4693 inc(Count)
4694 end;
4695 end; // for uix:=0 to MyRO.nUn-1
4696 assert(Count = TrCnt);
4697 end
4698 end
4699 else
4700 begin
4701 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop + 8,
4702 PanelHeight - 24, Phrases.Lookup('PRESENT'));
4703 Server(sGetUnits, me, TroopLoc, Count);
4704 for i := 0 to Count - 1 do
4705 if (i >= TrRow * sb.si.npos) and (i < TrRow * (sb.si.npos + 1))
4706 then
4707 begin // display enemy units
4708 trix[i - TrRow * sb.si.npos] := i;
4709 x := (i - TrRow * sb.si.npos) * TrPitch;
4710 NoMap.SetOutput(Panel);
4711 NoMap.PaintUnit(xTroop + 2 + x, yTroop + 1,
4712 MyRO.EnemyUn[MyRO.nEnemyUn + i], 0);
4713 end;
4714 end;
4715 end;
4716 if not SmallScreen or supervising then
4717 begin // show terrain and improvements
4718 PaintZoomedTile(Panel, xTerrain - xxt * 2, 110 - yyt * 3, TroopLoc);
4719 if (UnFocus >= 0) and (MyUn[UnFocus].Job <> jNone) then
4720 begin
4721 JobFocus := MyUn[UnFocus].Job;
4722 Server(sGetJobProgress, me, MyUn[UnFocus].Loc, JobProgressData);
4723 MakeBlue(Panel, xTerrain - 72, 148 - 17, 144, 31);
4724 PaintRelativeProgressBar(Panel.Canvas, 3, xTerrain - 68, 148 + 3,
4725 63, JobProgressData[JobFocus].Done,
4726 JobProgressData[JobFocus].NextTurnPlus,
4727 JobProgressData[JobFocus].Required, true, MainTexture);
4728 s := Format('%s/%s',
4729 [ScreenTools.MovementToString(JobProgressData[JobFocus].Done),
4730 ScreenTools.MovementToString(JobProgressData[JobFocus]
4731 .Required)]);
4732 RisedTextOut(Panel.Canvas, xTerrain + 6, 148 - 3, s);
4733 Tile := MyMap[MyUn[UnFocus].Loc];
4734 if (JobFocus = jRoad) and (Tile and fRiver <> 0) then
4735 JobFocus := nJob + 0
4736 else if (JobFocus = jRR) and (Tile and fRiver <> 0) then
4737 JobFocus := nJob + 1
4738 else if JobFocus = jClear then
4739 begin
4740 if Tile and fTerrain = fForest then
4741 JobFocus := nJob + 2
4742 else if Tile and fTerrain = fDesert then
4743 JobFocus := nJob + 3
4744 else
4745 JobFocus := nJob + 4
4746 end;
4747 s := Phrases.Lookup('JOBRESULT', JobFocus);
4748 RisedTextOut(Panel.Canvas, xTerrain - BiColorTextWidth(Panel.Canvas,
4749 s) div 2, 148 - 19, s);
4750 end;
4751 if MyMap[TroopLoc] and (fTerrain or fSpecial) = fGrass or fSpecial1
4752 then
4753 s := Phrases.Lookup('TERRAIN', fGrass + 12)
4754 else if MyMap[TroopLoc] and fDeadLands <> 0 then
4755 s := Phrases.Lookup('TERRAIN', 3 * 12)
4756 else if (MyMap[TroopLoc] and fTerrain = fForest) and
4757 IsJungle(TroopLoc div G.lx) then
4758 s := Phrases.Lookup('TERRAIN', fJungle)
4759 else
4760 s := Phrases.Lookup('TERRAIN', MyMap[TroopLoc] and fTerrain);
4761 RisedTextOut(Panel.Canvas, xTerrain - BiColorTextWidth(Panel.Canvas,
4762 s) div 2, 99, s);
4763 end;
4764
4765 if TerrainBtn.Visible then
4766 with TerrainBtn do
4767 RFrame(Panel.Canvas, Left - 1, Top - self.ClientHeight +
4768 (PanelHeight - 1), Left + width, Top + height - self.ClientHeight
4769 + PanelHeight, MainTexture.clBevelShade, MainTexture.clBevelLight)
4770 end { if TroopLoc>=0 }
4771 end;
4772
4773 for i := 0 to ControlCount - 1 do
4774 if Controls[i] is TButtonB then
4775 with TButtonB(Controls[i]) do
4776 begin
4777 if Visible then
4778 begin
4779 Dump(Panel, HGrSystem, Left, Top - self.ClientHeight + PanelHeight,
4780 25, 25, 169, 243);
4781 Sprite(Panel, HGrSystem, Left, Top - self.ClientHeight +
4782 PanelHeight, 25, 25, 1 + 26 * ButtonIndex, 337);
4783 RFrame(Panel.Canvas, Left - 1, Top - self.ClientHeight +
4784 (PanelHeight - 1), Left + width, Top + height - self.ClientHeight
4785 + PanelHeight, MainTexture.clBevelShade,
4786 MainTexture.clBevelLight);
4787 end;
4788 end;
4789
4790 if ClientMode <> cEditMap then
4791 begin
4792 for i := 0 to ControlCount - 1 do
4793 if Controls[i] is TButtonC then
4794 with TButtonC(Controls[i]) do
4795 begin
4796 Dump(Panel, HGrSystem, Left, Top - self.ClientHeight + PanelHeight,
4797 12, 12, 169, 178 + 13 * ButtonIndex);
4798 RFrame(Panel.Canvas, Left - 1, Top - self.ClientHeight +
4799 (PanelHeight - 1), Left + width, Top + height - self.ClientHeight
4800 + PanelHeight, MainTexture.clBevelShade,
4801 MainTexture.clBevelLight);
4802 end
4803 end;
4804 EOT.SetBack(Panel.Canvas, EOT.Left, EOT.Top - (ClientHeight - PanelHeight));
4805 SmartRectInvalidate(0, ClientHeight - PanelHeight, ClientWidth,
4806 ClientHeight);
4807
4808 // topbar
4809 xTreasurySection := ClientWidth div 2 - 172;
4810 xResearchSection := ClientWidth div 2;
4811 // ClientWidth div 2+68 = maximum to right
4812 FillLarge(TopBar.Canvas, 0, 0, ClientWidth, TopBarHeight - 3,
4813 ClientWidth div 2);
4814 with TopBar.Canvas do
4815 begin
4816 Pen.Color := $000000;
4817 MoveTo(0, TopBarHeight - 1);
4818 LineTo(ClientWidth, TopBarHeight - 1);
4819 Pen.Color := MainTexture.clBevelShade;
4820 MoveTo(0, TopBarHeight - 2);
4821 LineTo(ClientWidth, TopBarHeight - 2);
4822 MoveTo(0, TopBarHeight - 3);
4823 LineTo(ClientWidth, TopBarHeight - 3);
4824 Pen.Color := MainTexture.clBevelLight;
4825 ScreenTools.Frame(TopBar.Canvas, 40, -1, xTreasurySection - 1, TopBarHeight - 7,
4826 MainTexture.clBevelShade, MainTexture.clBevelLight);
4827 ScreenTools.Frame(TopBar.Canvas, xResearchSection + 332, -1, ClientWidth,
4828 TopBarHeight - 7, MainTexture.clBevelShade, MainTexture.clBevelLight);
4829 end;
4830 if GameMode <> cMovie then
4831 ImageOp_BCC(TopBar, Templates, 2, 1, 145, 38, 36, 36, $BFBF20, $4040DF);
4832 if MyRO.nCity > 0 then
4833 begin
4834 TrueMoney := MyRO.Money;
4835 TrueResearch := MyRO.Research;
4836 if supervising then
4837 begin // normalize values from after-turn state
4838 dec(TrueMoney, TaxSum);
4839 if TrueMoney < 0 then
4840 TrueMoney := 0; // shouldn't happen
4841 dec(TrueResearch, ScienceSum);
4842 if TrueResearch < 0 then
4843 TrueResearch := 0; // shouldn't happen
4844 end;
4845
4846 // treasury section
4847 ImageOp_BCC(TopBar, Templates, xTreasurySection + 8, 1, 145, 1, 36, 36,
4848 $40A040, $4030C0);
4849 s := IntToStr(TrueMoney);
4850 LoweredTextOut(TopBar.Canvas, -1, MainTexture, xTreasurySection + 48, 0,
4851 s + '%c');
4852 if MyRO.Government <> gAnarchy then
4853 begin
4854 ImageOp_BCC(TopBar, Templates, xTreasurySection + 48, 22, 124, 1, 14,
4855 14, $0000C0, $0080C0);
4856 if TaxSum >= 0 then
4857 s := Format(Phrases.Lookup('MONEYGAINPOS'), [TaxSum])
4858 else
4859 s := Format(Phrases.Lookup('MONEYGAINNEG'), [TaxSum]);
4860 LoweredTextOut(TopBar.Canvas, -1, MainTexture,
4861 xTreasurySection + 48 + 15, 18, s);
4862 end;
4863
4864 // research section
4865 ImageOp_BCC(TopBar, Templates, xResearchSection + 8, 1, 145, 75, 36, 36,
4866 $FF0000, $00FFE0);
4867 if MyData.FarTech <> adNexus then
4868 begin
4869 if MyRO.ResearchTech < 0 then
4870 CostFactor := 2
4871 else if (MyRO.ResearchTech = adMilitary) or
4872 (MyRO.Tech[MyRO.ResearchTech] = tsSeen) then
4873 CostFactor := 1
4874 else if MyRO.ResearchTech in FutureTech then
4875 if MyRO.Government = gFuture then
4876 CostFactor := 4
4877 else
4878 CostFactor := 8
4879 else
4880 CostFactor := 2;
4881 Server(sGetTechCost, me, 0, i);
4882 CostFactor := CostFactor * 22; // length of progress bar
4883 PaintRelativeProgressBar(TopBar.Canvas, 2, xResearchSection + 48 + 1,
4884 26, CostFactor, TrueResearch, ScienceSum, i, true, MainTexture);
4885
4886 if MyRO.ResearchTech < 0 then
4887 s := Phrases.Lookup('SCIENCE')
4888 else if MyRO.ResearchTech = adMilitary then
4889 s := Phrases.Lookup('INITUNIT')
4890 else
4891 begin
4892 s := Phrases.Lookup('ADVANCES', MyRO.ResearchTech);
4893 if MyRO.ResearchTech in FutureTech then
4894 if MyRO.Tech[MyRO.ResearchTech] >= 1 then
4895 s := s + ' ' + IntToStr(MyRO.Tech[MyRO.ResearchTech] + 1)
4896 else
4897 s := s + ' 1';
4898 end;
4899 if ScienceSum > 0 then
4900 begin
4901 { j:=(i-MyRO.Research-1) div ScienceSum +1;
4902 if j<1 then j:=1;
4903 if j>1 then
4904 s:=Format(Phrases.Lookup('TECHWAIT'),[s,j]); }
4905 LoweredTextOut(TopBar.Canvas, -1, MainTexture,
4906 xResearchSection + 48, 0, s);
4907 end
4908 else
4909 LoweredTextOut(TopBar.Canvas, -1, MainTexture,
4910 xResearchSection + 48, 0, s);
4911 end
4912 else
4913 CostFactor := 0;
4914 if (MyData.FarTech <> adNexus) and (ScienceSum > 0) then
4915 begin
4916 ImageOp_BCC(TopBar, Templates, xResearchSection + 48 + CostFactor + 11,
4917 22, 124, 1, 14, 14, $0000C0, $0080C0);
4918 s := Format(Phrases.Lookup('TECHGAIN'), [ScienceSum]);
4919 LoweredTextOut(TopBar.Canvas, -1, MainTexture, xResearchSection + 48 +
4920 CostFactor + 26, 18, s);
4921 end
4922 end;
4923 if ClientMode <> cEditMap then
4924 begin
4925 TopBar.Canvas.Font.Assign(UniFont[ftCaption]);
4926 s := TurnToString(MyRO.Turn);
4927 RisedTextOut(TopBar.Canvas,
4928 40 + (xTreasurySection - 40 - BiColorTextWidth(TopBar.Canvas, s))
4929 div 2, 6, s);
4930 TopBar.Canvas.Font.Assign(UniFont[ftNormal]);
4931 end;
4932 RectInvalidate(0, 0, ClientWidth, TopBarHeight);
4933 end; { PanelPaint }
4934
4935 procedure TMainScreen.FocusOnLoc(Loc: integer; Options: integer = 0);
4936 var
4937 dx: integer;
4938 Outside, Changed: boolean;
4939 begin
4940 dx := G.lx + 1 - (xw - Loc + G.lx * 1024 + 1) mod G.lx;
4941 Outside := (dx >= (MapWidth + 1) div (xxt * 2) - 2) or (ywmax > 0) and
4942 ((yw > 0) and (Loc div G.lx <= yw + 1) or (yw < ywmax) and
4943 (Loc div G.lx >= yw + (MapHeight - 1) div yyt - 2));
4944 Changed := true;
4945 if Outside then
4946 begin
4947 Centre(Loc);
4948 PaintAllMaps
4949 end
4950 else if not MapValid then
4951 PaintAllMaps
4952 else
4953 Changed := false;
4954 if Options and flRepaintPanel <> 0 then
4955 PanelPaint;
4956 if Changed and (Options and flImmUpdate <> 0) then
4957 Update;
4958 end;
4959
4960 procedure TMainScreen.NextUnit(NearLoc: integer; AutoTurn: boolean);
4961 var
4962 Dist, TestDist: single;
4963 i, uix, NewFocus: integer;
4964 GotoOnly: boolean;
4965 begin
4966 if ClientMode >= scContact then
4967 exit;
4968 DestinationMarkON := false;
4969 PaintDestination;
4970 for GotoOnly := GoOnPhase downto false do
4971 begin
4972 NewFocus := -1;
4973 for i := 1 to MyRO.nUn do
4974 begin
4975 uix := (UnFocus + i) mod MyRO.nUn;
4976 if (MyUn[uix].Loc >= 0) and (MyUn[uix].Job = jNone) and
4977 (MyUn[uix].Status and (usStay or usRecover or usWaiting) = usWaiting)
4978 and (not GotoOnly or (MyUn[uix].Status and usGoto <> 0)) then
4979 if NearLoc < 0 then
4980 begin
4981 NewFocus := uix;
4982 Break
4983 end
4984 else
4985 begin
4986 TestDist := Distance(NearLoc, MyUn[uix].Loc);
4987 if (NewFocus < 0) or (TestDist < Dist) then
4988 begin
4989 NewFocus := uix;
4990 Dist := TestDist
4991 end
4992 end
4993 end;
4994 if GotoOnly then
4995 if NewFocus < 0 then
4996 GoOnPhase := false
4997 else
4998 Break;
4999 end;
5000 if NewFocus >= 0 then
5001 begin
5002 SetUnFocus(NewFocus);
5003 SetTroopLoc(MyUn[NewFocus].Loc);
5004 FocusOnLoc(TroopLoc, flRepaintPanel)
5005 end
5006 else if AutoTurn and not mWaitTurn.Checked then
5007 begin
5008 TurnComplete := true;
5009 SetUnFocus(-1);
5010 SetTroopLoc(-1);
5011 PostMessage(Handle, WM_EOT, 0, 0)
5012 end
5013 else
5014 begin
5015 if { (UnFocus>=0) and } not TurnComplete and EOT.Visible then
5016 Play('TURNEND');
5017 TurnComplete := true;
5018 SetUnFocus(-1);
5019 SetTroopLoc(-1);
5020 PanelPaint;
5021 end;
5022 end; { NextUnit }
5023
5024 procedure TMainScreen.Scroll(dx, dy: integer);
5025 begin
5026 xw := (xw + G.lx + dx) mod G.lx;
5027 if ywmax > 0 then
5028 begin
5029 yw := yw + 2 * dy;
5030 if yw < 0 then
5031 yw := 0
5032 else if yw > ywmax then
5033 yw := ywmax;
5034 end;
5035 MainOffscreenPaint;
5036 xwMini := xw;
5037 ywMini := yw;
5038 MiniPaint;
5039 CopyMiniToPanel;
5040 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 2,
5041 xMini + 2 + G.lx * 2, TopBarHeight + MapHeight - overlap + yMini +
5042 2 + G.ly);
5043 Update;
5044 end;
5045
5046 procedure TMainScreen.Timer1Timer(Sender: TObject);
5047 var
5048 dx, dy, speed: integer;
5049 begin
5050 if idle and (me >= 0) and (GameMode <> cMovie) then
5051 if (fsModal in Screen.ActiveForm.FormState) or
5052 (Screen.ActiveForm is TBufferedDrawDlg) and
5053 (TBufferedDrawDlg(Screen.ActiveForm).WindowMode <> wmPersistent) then
5054 begin
5055 BlinkTime := BlinkOnTime + BlinkOffTime - 1;
5056 if not BlinkON then
5057 begin
5058 BlinkON := true;
5059 if UnFocus >= 0 then
5060 PaintLocTemp(MyUn[UnFocus].Loc)
5061 else if TurnComplete and not supervising then
5062 EOT.SetButtonIndexFast(eotBlinkOn)
5063 end
5064 end
5065 else
5066 begin
5067 if Application.Active and not mScrollOff.Checked then
5068 begin
5069 if mScrollFast.Checked then
5070 speed := 2
5071 else
5072 speed := 1;
5073 dx := 0;
5074 dy := 0;
5075 if Mouse.CursorPos.y < Screen.height - PanelHeight then
5076 if Mouse.CursorPos.x = 0 then
5077 dx := -speed // scroll left
5078 else if Mouse.CursorPos.x = Screen.width - 1 then
5079 dx := speed; // scroll right
5080 if Mouse.CursorPos.y = 0 then
5081 dy := -speed // scroll up
5082 else if (Mouse.CursorPos.y = Screen.height - 1) and
5083 (Mouse.CursorPos.x >= TerrainBtn.Left + TerrainBtn.width) and
5084 (Mouse.CursorPos.x < xRightPanel + 10 - 8) then
5085 dy := speed; // scroll down
5086 if (dx <> 0) or (dy <> 0) then
5087 begin
5088 if (Screen.ActiveForm <> MainScreen) and
5089 (@Screen.ActiveForm.OnDeactivate <> nil) then
5090 Screen.ActiveForm.OnDeactivate(nil);
5091 Scroll(dx, dy);
5092 end
5093 end;
5094
5095 BlinkTime := (BlinkTime + 1) mod (BlinkOnTime + BlinkOffTime);
5096 BlinkON := BlinkTime >= BlinkOffTime;
5097 DestinationMarkON := true;
5098 if UnFocus >= 0 then
5099 begin
5100 if (BlinkTime = 0) or (BlinkTime = BlinkOffTime) then
5101 begin
5102 PaintLocTemp(MyUn[UnFocus].Loc, pltsBlink);
5103 PaintDestination;
5104 // if MoveHintToLoc>=0 then
5105 // ShowMoveHint(MoveHintToLoc, true);
5106 end
5107 end
5108 else if TurnComplete and not supervising then
5109 begin
5110 if BlinkTime = 0 then
5111 EOT.SetButtonIndexFast(eotBlinkOff)
5112 else if BlinkTime = BlinkOffTime then
5113 EOT.SetButtonIndexFast(eotBlinkOn)
5114 end
5115 end
5116 end;
5117
5118 procedure TMainScreen.Centre(Loc: integer);
5119 begin
5120 if FastScrolling and MapValid then
5121 Update;
5122 // necessary because ScrollDC for form canvas is called after
5123 xw := (Loc mod G.lx - (MapWidth - xxt * 2 * ((Loc div G.lx) and 1))
5124 div (xxt * 4) + G.lx) mod G.lx;
5125 if ywmax <= 0 then
5126 yw := ywcenter
5127 else
5128 begin
5129 yw := (Loc div G.lx - MapHeight div (yyt * 2) + 1) and not 1;
5130 if yw < 0 then
5131 yw := 0
5132 else if yw > ywmax then
5133 yw := ywmax;
5134 end
5135 end;
5136
5137 function TMainScreen.ZoomToCity(Loc: integer;
5138 NextUnitOnClose: boolean = false; ShowEvent: integer = 0): boolean;
5139 begin
5140 result := MyMap[Loc] and (fOwned or fSpiedOut) <> 0;
5141 if result then
5142 with CityDlg do
5143 begin
5144 if ClientMode >= scContact then
5145 begin
5146 CloseAction := None;
5147 RestoreUnFocus := -1;
5148 end
5149 else if NextUnitOnClose then
5150 begin
5151 CloseAction := StepFocus;
5152 RestoreUnFocus := -1;
5153 end
5154 else if not Visible then
5155 begin
5156 CloseAction := RestoreFocus;
5157 RestoreUnFocus := UnFocus;
5158 end;
5159 SetUnFocus(-1);
5160 SetTroopLoc(Loc);
5161 MarkCityLoc := Loc;
5162 PanelPaint;
5163 ShowNewContent(wmPersistent, Loc, ShowEvent);
5164 end
5165 end;
5166
5167 function TMainScreen.LocationOfScreenPixel(x, y: integer): integer;
5168 var
5169 qx, qy: integer;
5170 begin
5171 qx := (x * (yyt * 2) + y * (xxt * 2) + xxt * yyt * 2)
5172 div (xxt * yyt * 4) - 1;
5173 qy := (y * (xxt * 2) - x * (yyt * 2) - xxt * yyt * 2 + 4000 * xxt * yyt)
5174 div (xxt * yyt * 4) - 999;
5175 result := (xw + (qx - qy + 2048) div 2 - 1024 + G.lx) mod G.lx + G.lx *
5176 (yw + qx + qy);
5177 end;
5178
5179 procedure TMainScreen.MapBoxMouseDown(Sender: TObject; Button: TMouseButton;
5180 Shift: TShiftState; x, y: integer);
5181 var
5182 i, uix, emix, p1, dx, dy, MouseLoc: integer;
5183 EditTileData: TEditTileData;
5184 m, m2: TMenuItem;
5185 MoveAdviceData: TMoveAdviceData;
5186 DoCenter: boolean;
5187 begin
5188 if GameMode = cMovie then
5189 exit;
5190
5191 if CityDlg.Visible then
5192 CityDlg.Close;
5193 if UnitStatDlg.Visible then
5194 UnitStatDlg.Close;
5195 MouseLoc := LocationOfScreenPixel(x, y);
5196 if (MouseLoc < 0) or (MouseLoc >= G.lx * G.ly) then
5197 exit;
5198 if (Button = mbLeft) and not(ssShift in Shift) then
5199 begin
5200 DoCenter := true;
5201 if ClientMode = cEditMap then
5202 begin
5203 DoCenter := false;
5204 EditTileData.Loc := MouseLoc;
5205 if ssCtrl in Shift then // toggle special resource
5206 case MyMap[MouseLoc] and fTerrain of
5207 fOcean:
5208 EditTileData.NewTile := MyMap[MouseLoc];
5209 fGrass, fArctic:
5210 EditTileData.NewTile := MyMap[MouseLoc] and not fSpecial or
5211 ((MyMap[MouseLoc] shr 5 and 3 + 1) mod 2 shl 5);
5212 else
5213 EditTileData.NewTile := MyMap[MouseLoc] and not fSpecial or
5214 ((MyMap[MouseLoc] shr 5 and 3 + 1) mod 3 shl 5)
5215 end
5216 else if BrushType <= fTerrain then
5217 EditTileData.NewTile := MyMap[MouseLoc] and not fTerrain or
5218 fSpecial or BrushType
5219 else if BrushType and fDeadLands <> 0 then
5220 if MyMap[MouseLoc] and (fDeadLands or fModern) = BrushType and
5221 (fDeadLands or fModern) then
5222 EditTileData.NewTile := MyMap[MouseLoc] and
5223 not(fDeadLands or fModern)
5224 else
5225 EditTileData.NewTile := MyMap[MouseLoc] and
5226 not(fDeadLands or fModern) or BrushType
5227 else if BrushType and fTerImp <> 0 then
5228 if MyMap[MouseLoc] and fTerImp = BrushType then
5229 EditTileData.NewTile := MyMap[MouseLoc] and not fTerImp
5230 else
5231 EditTileData.NewTile := MyMap[MouseLoc] and not fTerImp or BrushType
5232 else if BrushType and (fPrefStartPos or fStartPos) <> 0 then
5233 if MyMap[MouseLoc] and (fPrefStartPos or fStartPos) = BrushType and
5234 (fPrefStartPos or fStartPos) then
5235 EditTileData.NewTile := MyMap[MouseLoc] and
5236 not(fPrefStartPos or fStartPos)
5237 else
5238 EditTileData.NewTile := MyMap[MouseLoc] and
5239 not(fPrefStartPos or fStartPos) or BrushType
5240 else
5241 EditTileData.NewTile := MyMap[MouseLoc] xor BrushType;
5242 Server(sEditTile, me, 0, EditTileData);
5243 Edited := true;
5244 BrushLoc := MouseLoc;
5245 PaintLoc(MouseLoc, 2);
5246 MiniPaint;
5247 BitBlt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly,
5248 Mini.Canvas.Handle, 0, 0, SRCCOPY);
5249 if ywmax <= 0 then
5250 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (2 * xxt),
5251 yMini + 2, xMini + 1 + G.lx + MapWidth div (2 * xxt),
5252 yMini + 2 + G.ly - 1, MainTexture.clMark, MainTexture.clMark)
5253 else
5254 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (2 * xxt),
5255 yMini + 2 + yw, xMini + 2 + G.lx + MapWidth div (2 * xxt) - 1,
5256 yMini + 2 + yw + MapHeight div yyt - 2, MainTexture.clMark,
5257 MainTexture.clMark);
5258 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini +
5259 2, xMini + 2 + G.lx * 2, TopBarHeight + MapHeight - overlap + yMini
5260 + 2 + G.ly)
5261 end
5262 else if MyMap[MouseLoc] and fCity <> 0 then { city clicked }
5263 begin
5264 if MyMap[MouseLoc] and (fOwned or fSpiedOut) <> 0 then
5265 begin
5266 ZoomToCity(MouseLoc);
5267 DoCenter := false;
5268 end
5269 else
5270 begin
5271 UnitStatDlg.ShowNewContent_EnemyCity(wmPersistent, MouseLoc);
5272 DoCenter := false;
5273 end
5274 end
5275 else if MyMap[MouseLoc] and fUnit <> 0 then { unit clicked }
5276 if MyMap[MouseLoc] and fOwned <> 0 then
5277 begin
5278 DoCenter := false;
5279 if not supervising and (ClientMode < scContact) then
5280 begin // not in negotiation mode
5281 if (UnFocus >= 0) and (MyUn[UnFocus].Loc = MouseLoc) then
5282 begin // rotate
5283 uix := (UnFocus + 1) mod MyRO.nUn;
5284 i := MyRO.nUn - 1;
5285 while i > 0 do
5286 begin
5287 if (MyUn[uix].Loc = MouseLoc) and (MyUn[uix].Job = jNone) and
5288 (MyUn[uix].Status and (usStay or usRecover or usEnhance or
5289 usWaiting) = usWaiting) then
5290 Break;
5291 dec(i);
5292 uix := (uix + 1) mod MyRO.nUn;
5293 end;
5294 if i = 0 then
5295 uix := UnFocus
5296 end
5297 else
5298 Server(sGetDefender, me, MouseLoc, uix);
5299 if uix <> UnFocus then
5300 SetUnFocus(uix);
5301 TurnComplete := false;
5302 EOT.ButtonIndex := eotGray;
5303 end;
5304 SetTroopLoc(MouseLoc);
5305 PanelPaint;
5306 end // own unit
5307 else if (MyMap[MouseLoc] and fSpiedOut <> 0) and not(ssCtrl in Shift)
5308 then
5309 begin
5310 DoCenter := false;
5311 SetTroopLoc(MouseLoc);
5312 PanelPaint;
5313 end
5314 else
5315 begin
5316 DoCenter := false;
5317 UnitStatDlg.ShowNewContent_EnemyLoc(wmPersistent, MouseLoc);
5318 end;
5319 if DoCenter then
5320 begin
5321 Centre(MouseLoc);
5322 PaintAllMaps
5323 end
5324 end
5325 else if (ClientMode <> cEditMap) and (Button = mbRight) and
5326 not(ssShift in Shift) then
5327 begin
5328 if supervising then
5329 begin
5330 EditLoc := MouseLoc;
5331 Server(sGetModels, me, 0, nil^);
5332 EmptyMenu(mCreateUnit);
5333 for p1 := 0 to nPl - 1 do
5334 if 1 shl p1 and MyRO.Alive <> 0 then
5335 begin
5336 m := TMenuItem.Create(mCreateUnit);
5337 m.Caption := Tribe[p1].TPhrase('SHORTNAME');
5338 for emix := MyRO.nEnemyModel - 1 downto 0 do
5339 if (MyRO.EnemyModel[emix].Owner = p1) and
5340 (Server(sCreateUnit - sExecute + p1 shl 4, me,
5341 MyRO.EnemyModel[emix].mix, MouseLoc) >= rExecuted) then
5342 begin
5343 if Tribe[p1].ModelPicture[MyRO.EnemyModel[emix].mix].HGr = 0
5344 then
5345 InitEnemyModel(emix);
5346 m2 := TMenuItem.Create(m);
5347 m2.Caption := Tribe[p1].ModelName[MyRO.EnemyModel[emix].mix];
5348 m2.Tag := p1 shl 16 + MyRO.EnemyModel[emix].mix;
5349 m2.OnClick := CreateUnitClick;
5350 m.Add(m2);
5351 end;
5352 m.Visible := m.Count > 0;
5353 mCreateUnit.Add(m);
5354 end;
5355 if FullScreen then
5356 EditPopup.Popup(Left + x, Top + y)
5357 else
5358 EditPopup.Popup(Left + x + 4,
5359 Top + y + GetSystemMetrics(SM_CYCAPTION) + 4);
5360 end
5361 else if (UnFocus >= 0) and (MyUn[UnFocus].Loc <> MouseLoc) then
5362 with MyUn[UnFocus] do
5363 begin
5364 dx := ((MouseLoc mod G.lx * 2 + MouseLoc div G.lx and 1) -
5365 (Loc mod G.lx * 2 + Loc div G.lx and 1) + 3 * G.lx)
5366 mod (2 * G.lx) - G.lx;
5367 dy := MouseLoc div G.lx - Loc div G.lx;
5368 if abs(dx) + abs(dy) < 3 then
5369 begin
5370 DestinationMarkON := false;
5371 PaintDestination;
5372 Status := Status and
5373 ($FFFF - usStay - usRecover - usGoto - usEnhance) or usWaiting;
5374 MoveUnit(dx, dy, muAutoNext) { simple move }
5375 end
5376 else if GetMoveAdvice(UnFocus, MouseLoc, MoveAdviceData) >= rExecuted
5377 then
5378 begin
5379 if MyMap[MouseLoc] and (fUnit or fOwned) = fUnit then
5380 begin // check for suicide mission before movement
5381 with MyUn[UnFocus], BattleDlg.Forecast do
5382 begin
5383 pAtt := me;
5384 mixAtt := mix;
5385 HealthAtt := Health;
5386 ExpAtt := Exp;
5387 FlagsAtt := Flags;
5388 end;
5389 BattleDlg.Forecast.Movement := MyUn[UnFocus].Movement;
5390 if (Server(sGetBattleForecastEx, me, MouseLoc, BattleDlg.Forecast)
5391 >= rExecuted) and (BattleDlg.Forecast.EndHealthAtt <= 0) then
5392 begin
5393 BattleDlg.uix := UnFocus;
5394 BattleDlg.ToLoc := MouseLoc;
5395 BattleDlg.IsSuicideQuery := true;
5396 BattleDlg.ShowModal;
5397 if BattleDlg.ModalResult <> mrOK then
5398 exit;
5399 end
5400 end;
5401 DestinationMarkON := false;
5402 PaintDestination;
5403 Status := Status and not(usStay or usRecover or usEnhance) or
5404 usWaiting;
5405 MoveToLoc(MouseLoc, false); { goto }
5406 end
5407 end
5408 end
5409 else if (Button = mbMiddle) and (UnFocus >= 0) and
5410 (MyModel[MyUn[UnFocus].mix].Kind in [mkSettler, mkSlaves]) then
5411 begin
5412 DestinationMarkON := false;
5413 PaintDestination;
5414 MyUn[UnFocus].Status := MyUn[UnFocus].Status and
5415 ($FFFF - usStay - usRecover - usGoto) or usEnhance;
5416 uix := UnFocus;
5417 if MouseLoc <> MyUn[uix].Loc then
5418 MoveToLoc(MouseLoc, true); { goto }
5419 if (UnFocus = uix) and (MyUn[uix].Loc = MouseLoc) then
5420 MenuClick(mEnhance)
5421 end
5422 else if (Button = mbLeft) and (ssShift in Shift) and
5423 (MyMap[MouseLoc] and fTerrain <> fUNKNOWN) then
5424 HelpOnTerrain(MouseLoc, wmPersistent)
5425 else if (ClientMode <= cContinue) and (Button = mbRight) and
5426 (ssShift in Shift) and (UnFocus >= 0) and
5427 (MyMap[MouseLoc] and (fUnit or fOwned) = fUnit) then
5428 begin // battle forecast
5429 with MyUn[UnFocus], BattleDlg.Forecast do
5430 begin
5431 pAtt := me;
5432 mixAtt := mix;
5433 HealthAtt := Health;
5434 ExpAtt := Exp;
5435 FlagsAtt := Flags;
5436 end;
5437 BattleDlg.Forecast.Movement := MyUn[UnFocus].Movement;
5438 if Server(sGetBattleForecastEx, me, MouseLoc, BattleDlg.Forecast) >= rExecuted
5439 then
5440 begin
5441 BattleDlg.uix := UnFocus;
5442 BattleDlg.ToLoc := MouseLoc;
5443 BattleDlg.Left := x - BattleDlg.width div 2;
5444 if BattleDlg.Left < 0 then
5445 BattleDlg.Left := 0
5446 else if BattleDlg.Left + BattleDlg.width > Screen.width then
5447 BattleDlg.Left := Screen.width - BattleDlg.width;
5448 BattleDlg.Top := y - BattleDlg.height div 2;
5449 if BattleDlg.Top < 0 then
5450 BattleDlg.Top := 0
5451 else if BattleDlg.Top + BattleDlg.height > Screen.height then
5452 BattleDlg.Top := Screen.height - BattleDlg.height;
5453 BattleDlg.IsSuicideQuery := false;
5454 BattleDlg.Show;
5455 end
5456 end
5457 end;
5458
5459 function TMainScreen.MoveUnit(dx, dy: integer; Options: integer): integer;
5460 // move focused unit to adjacent tile
5461 var
5462 i, cix, uix, euix, FromLoc, ToLoc, DirCode, UnFocus0, Defender, Mission, p1,
5463 NewTiles, cixChanged: integer;
5464 OldToTile: Cardinal;
5465 CityCaptured, IsAttack, OldUnrest, NewUnrest, NeedEcoUpdate,
5466 NeedRepaintPanel, ToTransport, ToShip: boolean;
5467 PlaneReturnData: TPlaneReturnData;
5468 QueryItem: string;
5469 begin
5470 result := eInvalid;
5471 UnFocus0 := UnFocus;
5472 FromLoc := MyUn[UnFocus].Loc;
5473 ToLoc := dLoc(FromLoc, dx, dy);
5474 if (ToLoc < 0) or (ToLoc >= G.lx * G.ly) then
5475 begin
5476 result := eInvalid;
5477 exit;
5478 end;
5479 if MyMap[ToLoc] and fStealthUnit <> 0 then
5480 begin
5481 SoundMessage(Phrases.Lookup('ATTACKSTEALTH'), '');
5482 exit;
5483 end;
5484 if MyMap[ToLoc] and fHiddenUnit <> 0 then
5485 begin
5486 SoundMessage(Phrases.Lookup('ATTACKSUB'), '');
5487 exit;
5488 end;
5489
5490 if MyMap[ToLoc] and (fUnit or fOwned) = fUnit then
5491 begin // attack -- search enemy unit
5492 if (MyModel[MyUn[UnFocus].mix].Attack = 0) and
5493 not((MyModel[MyUn[UnFocus].mix].Cap[mcBombs] > 0) and
5494 (MyUn[UnFocus].Flags and unBombsLoaded <> 0)) then
5495 begin
5496 SoundMessage(Phrases.Lookup('NOATTACKER'), '');
5497 exit;
5498 end;
5499 euix := MyRO.nEnemyUn - 1;
5500 while (euix >= 0) and (MyRO.EnemyUn[euix].Loc <> ToLoc) do
5501 dec(euix);
5502 end;
5503
5504 DirCode := dx and 7 shl 4 + dy and 7 shl 7;
5505 result := Server(sMoveUnit - sExecute + DirCode, me, UnFocus, nil^);
5506 if (result < rExecuted) and (MyUn[UnFocus].Job > jNone) then
5507 Server(sStartJob + jNone shl 4, me, UnFocus, nil^);
5508 if (result < rExecuted) and (result <> eNoTime_Move) then
5509 begin
5510 case result of
5511 eNoTime_Load:
5512 if MyModel[MyUn[UnFocus].mix].Domain = dAir then
5513 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'), 'NOMOVE_TIME')
5514 else
5515 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'),
5516 [MovementToString(MyModel[MyUn[UnFocus].mix].speed)]),
5517 'NOMOVE_TIME');
5518 eNoTime_Bombard:
5519 SoundMessage(Phrases.Lookup('NOTIMEBOMBARD'), 'NOMOVE_TIME');
5520 eNoTime_Expel:
5521 SoundMessage(Phrases.Lookup('NOTIMEEXPEL'), 'NOMOVE_TIME');
5522 eNoRoad:
5523 SoundMessage(Phrases.Lookup('NOROAD'), 'NOMOVE_DEFAULT');
5524 eNoNav:
5525 SoundMessage(Phrases.Lookup('NONAV'), 'NOMOVE_DEFAULT');
5526 eNoCapturer:
5527 SoundMessage(Phrases.Lookup('NOCAPTURER'), 'NOMOVE_DEFAULT');
5528 eNoBombarder:
5529 SoundMessage(Phrases.Lookup('NOBOMBARDER'), 'NOMOVE_DEFAULT');
5530 eZOC:
5531 ContextMessage(Phrases.Lookup('ZOC'), 'NOMOVE_ZOC', hkText,
5532 HelpDlg.TextIndex('MOVEMENT'));
5533 eTreaty:
5534 if MyMap[ToLoc] and (fUnit or fOwned) <> fUnit
5535 then { no enemy unit -- move }
5536 SoundMessage(Tribe[MyRO.Territory[ToLoc]].TPhrase('PEACE_NOMOVE'),
5537 'NOMOVE_TREATY')
5538 else
5539 SoundMessage(Tribe[MyRO.EnemyUn[euix].Owner]
5540 .TPhrase('PEACE_NOATTACK'), 'NOMOVE_TREATY');
5541 eDomainMismatch:
5542 begin
5543 if (MyModel[MyUn[UnFocus].mix].Domain < dSea) and
5544 (MyMap[ToLoc] and (fUnit or fOwned) = fUnit or fOwned) then
5545 begin // false load attempt
5546 ToShip := false;
5547 ToTransport := false;
5548 for uix := 0 to MyRO.nUn - 1 do
5549 if (MyUn[uix].Loc = ToLoc) and
5550 (MyModel[MyUn[uix].mix].Domain = dSea) then
5551 begin
5552 ToShip := true;
5553 if MyModel[MyUn[uix].mix].Cap[mcSeaTrans] > 0 then
5554 ToTransport := true;
5555 end;
5556 if ToTransport then
5557 SoundMessage(Phrases.Lookup('FULLTRANSPORT'), 'NOMOVE_DEFAULT')
5558 else if ToShip then
5559 SoundMessage(Phrases.Lookup('NOTRANSPORT'), 'NOMOVE_DEFAULT')
5560 else
5561 Play('NOMOVE_DOMAIN');
5562 end
5563 else
5564 Play('NOMOVE_DOMAIN');
5565 end
5566 else
5567 Play('NOMOVE_DEFAULT');
5568 end;
5569 exit;
5570 end;
5571
5572 if ((result = eWon) or (result = eLost) or (result = eBloody)) and
5573 (MyUn[UnFocus].Movement < 100) and
5574 (MyModel[MyUn[UnFocus].mix].Cap[mcWill] = 0) then
5575 begin
5576 if SimpleQuery(mkYesNo, Format(Phrases.Lookup('FASTATTACK'),
5577 [MyUn[UnFocus].Movement]), 'NOMOVE_TIME') <> mrOK then
5578 begin
5579 result := eInvalid;
5580 exit;
5581 end;
5582 Update; // remove message box from screen
5583 end;
5584
5585 OldUnrest := false;
5586 NewUnrest := false;
5587 if (result >= rExecuted) and (result and rUnitRemoved = 0) and
5588 (MyMap[ToLoc] and (fUnit or fOwned) <> fUnit) then
5589 begin
5590 OldUnrest := UnrestAtLoc(UnFocus, FromLoc);
5591 NewUnrest := UnrestAtLoc(UnFocus, ToLoc);
5592 if NewUnrest > OldUnrest then
5593 begin
5594 if MyRO.Government = gDemocracy then
5595 begin
5596 QueryItem := 'UNREST_NOTOWN';
5597 p1 := me;
5598 end
5599 else
5600 begin
5601 QueryItem := 'UNREST_FOREIGN';
5602 p1 := MyRO.Territory[ToLoc];
5603 end;
5604 with MessgExDlg do
5605 begin
5606 MessgText := Format(Tribe[p1].TPhrase(QueryItem),
5607 [Phrases.Lookup('GOVERNMENT', MyRO.Government)]);
5608 Kind := mkYesNo;
5609 IconKind := mikImp;
5610 IconIndex := imPalace;
5611 ShowModal;
5612 if ModalResult <> mrOK then
5613 begin
5614 result := eInvalid;
5615 exit;
5616 end;
5617 end;
5618 Update; // remove message box from screen
5619 end
5620 end;
5621
5622 if (result >= rExecuted) and (MyModel[MyUn[UnFocus].mix].Domain = dAir) and
5623 (MyUn[UnFocus].Status and usToldNoReturn = 0) then
5624 begin // can plane return?
5625 PlaneReturnData.Fuel := MyUn[UnFocus].Fuel;
5626 if (MyMap[ToLoc] and (fUnit or fOwned) = fUnit) or
5627 (MyMap[ToLoc] and (fCity or fOwned) = fCity) then
5628 begin // attack/expel/bombard -> 100MP
5629 PlaneReturnData.Loc := FromLoc;
5630 PlaneReturnData.Movement := MyUn[UnFocus].Movement - 100;
5631 if PlaneReturnData.Movement < 0 then
5632 PlaneReturnData.Movement := 0;
5633 end
5634 else // move
5635 begin
5636 PlaneReturnData.Loc := ToLoc;
5637 if dx and 1 <> 0 then
5638 PlaneReturnData.Movement := MyUn[UnFocus].Movement - 100
5639 else
5640 PlaneReturnData.Movement := MyUn[UnFocus].Movement - 150;
5641 end;
5642 if Server(sGetPlaneReturn, me, UnFocus, PlaneReturnData) = eNoWay then
5643 begin
5644 if MyModel[MyUn[UnFocus].mix].Kind = mkSpecial_Glider then
5645 QueryItem := 'LOWFUEL_GLIDER'
5646 else
5647 QueryItem := 'LOWFUEL';
5648 if SimpleQuery(mkYesNo, Phrases.Lookup(QueryItem), 'WARNING_LOWSUPPORT')
5649 <> mrOK then
5650 begin
5651 result := eInvalid;
5652 exit;
5653 end;
5654 Update; // remove message box from screen
5655 MyUn[UnFocus].Status := MyUn[UnFocus].Status or usToldNoReturn;
5656 end
5657 end;
5658
5659 if result = eMissionDone then
5660 begin
5661 ModalSelectDlg.ShowNewContent(wmModal, kMission);
5662 Update; // dialog still on screen
5663 Mission := ModalSelectDlg.result;
5664 if Mission < 0 then
5665 exit;
5666 Server(sSetSpyMission + Mission shl 4, me, 0, nil^);
5667 end;
5668
5669 CityCaptured := false;
5670 if result = eNoTime_Move then
5671 Play('NOMOVE_TIME')
5672 else
5673 begin
5674 NeedEcoUpdate := false;
5675 DestinationMarkON := false;
5676 PaintDestination;
5677 if result and rUnitRemoved <> 0 then
5678 CityOptimizer_BeforeRemoveUnit(UnFocus);
5679 IsAttack := (result = eBombarded) or (result <> eMissionDone) and
5680 (MyMap[ToLoc] and (fUnit or fOwned) = fUnit);
5681 if not IsAttack then
5682 begin // move
5683 cix := MyRO.nCity - 1; { look for own city at dest location }
5684 while (cix >= 0) and (MyCity[cix].Loc <> ToLoc) do
5685 dec(cix);
5686 if (result <> eMissionDone) and (MyMap[ToLoc] and fCity <> 0) and
5687 (cix < 0) then
5688 CityCaptured := true;
5689 result := Server(sMoveUnit + DirCode, me, UnFocus, nil^);
5690 case result of
5691 eHiddenUnit:
5692 begin
5693 Play('NOMOVE_SUBMARINE');
5694 PaintLoc(ToLoc)
5695 end;
5696 eStealthUnit:
5697 begin
5698 Play('NOMOVE_STEALTH');
5699 PaintLoc(ToLoc)
5700 end;
5701 eZOC_EnemySpotted:
5702 begin
5703 Play('NOMOVE_ZOC');
5704 PaintLoc(ToLoc, 1)
5705 end;
5706 rExecuted .. maxint:
5707 begin
5708 if result and rUnitRemoved <> 0 then
5709 UnFocus := -1 // unit died
5710 else
5711 begin
5712 assert(UnFocus >= 0);
5713 MyUn[UnFocus].Status := MyUn[UnFocus].Status and
5714 not(usStay or usRecover);
5715 for uix := 0 to MyRO.nUn - 1 do
5716 if MyUn[uix].Master = UnFocus then
5717 MyUn[uix].Status := MyUn[uix].Status and not usWaiting;
5718 if CityCaptured and
5719 (MyRO.Government in [gRepublic, gDemocracy, gFuture]) then
5720 begin // borders have moved, unrest might have changed in any city
5721 CityOptimizer_BeginOfTurn;
5722 NeedEcoUpdate := true;
5723 end
5724 else
5725 begin
5726 if OldUnrest <> NewUnrest then
5727 begin
5728 CityOptimizer_CityChange(MyUn[UnFocus].Home);
5729 for uix := 0 to MyRO.nUn - 1 do
5730 if MyUn[uix].Master = UnFocus then
5731 CityOptimizer_CityChange(MyUn[uix].Home);
5732 NeedEcoUpdate := true;
5733 end;
5734 if (MyRO.Government = gDespotism) and
5735 (MyModel[MyUn[UnFocus].mix].Kind = mkSpecial_TownGuard) then
5736 begin
5737 if MyMap[FromLoc] and fCity <> 0 then
5738 begin // town guard moved out of city in despotism -- reoptimize!
5739 cixChanged := MyRO.nCity - 1;
5740 while (cixChanged >= 0) and
5741 (MyCity[cixChanged].Loc <> FromLoc) do
5742 dec(cixChanged);
5743 assert(cixChanged >= 0);
5744 if cixChanged >= 0 then
5745 begin
5746 CityOptimizer_CityChange(cixChanged);
5747 NeedEcoUpdate := true;
5748 end;
5749 end;
5750 if (MyMap[ToLoc] and fCity <> 0) and not CityCaptured then
5751 begin // town guard moved into city in despotism -- reoptimize!
5752 cixChanged := MyRO.nCity - 1;
5753 while (cixChanged >= 0) and
5754 (MyCity[cixChanged].Loc <> ToLoc) do
5755 dec(cixChanged);
5756 assert(cixChanged >= 0);
5757 if cixChanged >= 0 then
5758 begin
5759 CityOptimizer_CityChange(cixChanged);
5760 NeedEcoUpdate := true;
5761 end
5762 end
5763 end
5764 end
5765 end;
5766 end;
5767 else
5768 assert(false);
5769 end;
5770 SetTroopLoc(ToLoc);
5771 end
5772 else
5773 begin { enemy unit -- attack }
5774 if result = eBombarded then
5775 Defender := MyRO.Territory[ToLoc]
5776 else
5777 Defender := MyRO.EnemyUn[euix].Owner;
5778 { if MyRO.Treaty[Defender]=trCeaseFire then
5779 if SimpleQuery(mkYesNo,Phrases.Lookup('FRCANCELQUERY_CEASEFIRE'),
5780 'MSG_DEFAULT')<>mrOK then
5781 exit; }
5782 if (Options and muNoSuicideCheck = 0) and (result and rUnitRemoved <> 0)
5783 and (result <> eMissionDone) then
5784 begin // suicide query
5785 with MyUn[UnFocus], BattleDlg.Forecast do
5786 begin
5787 pAtt := me;
5788 mixAtt := mix;
5789 HealthAtt := Health;
5790 ExpAtt := Exp;
5791 FlagsAtt := Flags;
5792 end;
5793 BattleDlg.Forecast.Movement := MyUn[UnFocus].Movement;
5794 Server(sGetBattleForecastEx, me, ToLoc, BattleDlg.Forecast);
5795 BattleDlg.uix := UnFocus;
5796 BattleDlg.ToLoc := ToLoc;
5797 BattleDlg.IsSuicideQuery := true;
5798 BattleDlg.ShowModal;
5799 if BattleDlg.ModalResult <> mrOK then
5800 exit;
5801 end;
5802
5803 cixChanged := -1;
5804 if (result and rUnitRemoved <> 0) and (MyRO.Government = gDespotism) and
5805 (MyModel[MyUn[UnFocus].mix].Kind = mkSpecial_TownGuard) and
5806 (MyMap[FromLoc] and fCity <> 0) then
5807 begin // town guard died in city in despotism -- reoptimize!
5808 cixChanged := MyRO.nCity - 1;
5809 while (cixChanged >= 0) and (MyCity[cixChanged].Loc <> FromLoc) do
5810 dec(cixChanged);
5811 assert(cixChanged >= 0);
5812 end;
5813
5814 for i := 0 to MyRO.nEnemyModel - 1 do
5815 LostArmy[i] := MyRO.EnemyModel[i].Lost;
5816 OldToTile := MyMap[ToLoc];
5817 result := Server(sMoveUnit + DirCode, me, UnFocus, nil^);
5818 nLostArmy := 0;
5819 for i := 0 to MyRO.nEnemyModel - 1 do
5820 begin
5821 LostArmy[i] := MyRO.EnemyModel[i].Lost - LostArmy[i];
5822 inc(nLostArmy, LostArmy[i])
5823 end;
5824 if result and rUnitRemoved <> 0 then
5825 begin
5826 UnFocus := -1;
5827 SetTroopLoc(FromLoc);
5828 end;
5829 if (OldToTile and not MyMap[ToLoc] and fCity <> 0) and
5830 (MyRO.Government in [gRepublic, gDemocracy, gFuture]) then
5831 begin // city was destroyed, borders have moved, unrest might have changed in any city
5832 CityOptimizer_BeginOfTurn;
5833 NeedEcoUpdate := true;
5834 end
5835 else
5836 begin
5837 if cixChanged >= 0 then
5838 begin
5839 CityOptimizer_CityChange(cixChanged);
5840 NeedEcoUpdate := true;
5841 end;
5842 if (result = eWon) or (result = eBloody) or (result = eExpelled) then
5843 begin
5844 CityOptimizer_TileBecomesAvailable(ToLoc);
5845 NeedEcoUpdate := true;
5846 end;
5847 end;
5848 if nLostArmy > 1 then
5849 begin
5850 with MessgExDlg do
5851 begin
5852 Kind := mkOk;
5853 IconKind := mikEnemyArmy;
5854 MessgText := Tribe[Defender].TString(Phrases.Lookup('ARMYLOST',
5855 MyRO.EnemyModel[MyRO.EnemyUn[euix].emix].Domain));
5856 ShowModal;
5857 end
5858 end
5859 end;
5860 if result and rUnitRemoved <> 0 then
5861 begin
5862 CityOptimizer_AfterRemoveUnit;
5863 ListDlg.RemoveUnit;
5864 NeedEcoUpdate := true;
5865 end;
5866 if NeedEcoUpdate then
5867 begin
5868 UpdateViews(true);
5869 Update
5870 end
5871 end;
5872
5873 if result = eMissionDone then
5874 begin
5875 p1 := MyRO.Territory[ToLoc];
5876 case Mission of
5877 smStealMap:
5878 begin
5879 MapValid := false;
5880 PaintAllMaps
5881 end;
5882 smStealCivilReport:
5883 TribeMessage(p1, Tribe[p1].TPhrase('DOSSIER_PREPARED'), '');
5884 smStealMilReport:
5885 ListDlg.ShowNewContent_MilReport(wmPersistent, p1);
5886 end;
5887 end;
5888
5889 if UnFocus >= 0 then
5890 CheckToldNoReturn(UnFocus);
5891
5892 NeedRepaintPanel := false;
5893 if result >= rExecuted then
5894 begin
5895 if CityCaptured and (MyMap[ToLoc] and fCity = 0) then
5896 begin // city destroyed
5897 for i := 0 to 27 do { tell about destroyed wonders }
5898 if (MyRO.Wonder[i].CityID = -2) and
5899 (MyData.ToldWonders[i].CityID <> -2) then
5900 with MessgExDlg do
5901 begin
5902 if WondersDlg.Visible then
5903 WondersDlg.SmartUpdateContent(false);
5904 OpenSound := 'WONDER_DESTROYED';
5905 MessgText := Format(Phrases.Lookup('WONDERDEST'),
5906 [Phrases.Lookup('IMPROVEMENTS', i)]);
5907 Kind := mkOkHelp;
5908 HelpKind := hkImp;
5909 HelpNo := i;
5910 IconKind := mikImp;
5911 IconIndex := i;
5912 ShowModal;
5913 MyData.ToldWonders[i] := MyRO.Wonder[i];
5914 end
5915 end;
5916 if CityCaptured and (MyMap[ToLoc] and fCity <> 0) then
5917 begin // city captured
5918 ListDlg.AddCity;
5919 for i := 0 to 27 do { tell about capture of wonders }
5920 if MyRO.City[MyRO.nCity - 1].Built[i] > 0 then
5921 with MessgExDlg do
5922 begin
5923 if WondersDlg.Visible then
5924 WondersDlg.SmartUpdateContent(false);
5925 OpenSound := 'WONDER_CAPTURED';
5926 MessgText := Format(Tribe[me].TPhrase('WONDERCAPTOWN'),
5927 [Phrases.Lookup('IMPROVEMENTS', i)]);
5928 Kind := mkOkHelp;
5929 HelpKind := hkImp;
5930 HelpNo := i;
5931 IconKind := mikImp;
5932 IconIndex := i;
5933 ShowModal;
5934 MyData.ToldWonders[i] := MyRO.Wonder[i];
5935 end;
5936
5937 if MyRO.Happened and phStealTech <> 0 then
5938 begin { Temple of Zeus -- choose advance to steal }
5939 ModalSelectDlg.ShowNewContent(wmModal, kStealTech);
5940 Server(sStealTech, me, ModalSelectDlg.result, nil^);
5941 end;
5942 TellNewModels;
5943
5944 cix := MyRO.nCity - 1;
5945 while (cix >= 0) and (MyCity[cix].Loc <> ToLoc) do
5946 dec(cix);
5947 assert(cix >= 0);
5948 MyCity[cix].Status := MyCity[cix].Status and
5949 not csResourceWeightsMask or (3 shl 4);
5950 // captured city, set to maximum growth
5951 NewTiles := 1 shl 13; { exploit central tile only }
5952 Server(sSetCityTiles, me, cix, NewTiles);
5953 end
5954 else
5955 NeedRepaintPanel := true;
5956 end;
5957 TellNewContacts;
5958
5959 if (UnFocus >= 0) and (MyUn[UnFocus].Master >= 0) then
5960 with MyUn[MyUn[UnFocus].Master] do
5961 if Status and usStay <> 0 then
5962 begin
5963 Status := Status and not usStay;
5964 if (Movement >= 100) and (Status and (usRecover or usGoto) = 0) then
5965 Status := Status or usWaiting;
5966 end;
5967 if Options and (muAutoNoWait or muAutoNext) <> 0 then
5968 begin
5969 if (UnFocus >= 0) and ((result = eNoTime_Move) or UnitExhausted(UnFocus)
5970 or (MyUn[UnFocus].Master >= 0) or
5971 (MyModel[MyUn[UnFocus].mix].Domain = dAir) and
5972 ((MyMap[MyUn[UnFocus].Loc] and fCity <> 0) { aircrafts stop in cities }
5973 or (MyMap[MyUn[UnFocus].Loc] and fTerImp = tiBase))) then
5974 begin
5975 MyUn[UnFocus].Status := MyUn[UnFocus].Status and not usWaiting;
5976 if Options and muAutoNext <> 0 then
5977 if CityCaptured and (MyMap[ToLoc] and fCity <> 0) then
5978 begin
5979 UnFocus := -1;
5980 PaintLoc(ToLoc); // don't show unit in city if not selected
5981 end
5982 else
5983 NextUnit(UnStartLoc, true)
5984 end
5985 else if (UnFocus < 0) and (Options and muAutoNext <> 0) then
5986 NextUnit(UnStartLoc, result <> eMissionDone);
5987 end;
5988
5989 if NeedRepaintPanel and (UnFocus = UnFocus0) then
5990 if IsAttack then
5991 PanelPaint
5992 else
5993 begin
5994 assert(result <> eMissionDone);
5995 CheckTerrainBtnVisible;
5996 FocusOnLoc(ToLoc, flRepaintPanel or flImmUpdate)
5997 end;
5998
5999 if (result >= rExecuted) and CityCaptured and (MyMap[ToLoc] and fCity <> 0)
6000 then
6001 ZoomToCity(ToLoc, UnFocus < 0, chCaptured); // show captured city
6002 end; // moveunit
6003
6004 procedure TMainScreen.MoveOnScreen(ShowMove: TShowMove;
6005 Step0, Step1, nStep: integer; Restore: boolean = true);
6006 var
6007 ToLoc, xFromLoc, yFromLoc, xToLoc, yToLoc, xFrom, yFrom, xTo, yTo, xMin,
6008 yMin, xRange, yRange, xw1, Step, xMoving, yMoving, yl,
6009 SliceCount: integer;
6010 UnitInfo: TUnitInfo;
6011 Ticks0, Ticks: int64;
6012 begin
6013 Timer1.Enabled := false;
6014 QueryPerformanceCounter(Ticks0);
6015 with ShowMove do
6016 begin
6017 UnitInfo.Owner := Owner;
6018 UnitInfo.mix := mix;
6019 UnitInfo.Health := Health;
6020 UnitInfo.Job := jNone;
6021 UnitInfo.Flags := Flags;
6022 if Owner <> me then
6023 UnitInfo.emix := emix;
6024
6025 ToLoc := dLoc(FromLoc, dx, dy);
6026 xToLoc := ToLoc mod G.lx;
6027 yToLoc := ToLoc div G.lx;
6028 xFromLoc := FromLoc mod G.lx;
6029 yFromLoc := FromLoc div G.lx;
6030 if xToLoc > xFromLoc + 2 then
6031 xToLoc := xToLoc - G.lx
6032 else if xToLoc < xFromLoc - 2 then
6033 xToLoc := xToLoc + G.lx;
6034
6035 xw1 := xw + G.lx;
6036 // ((xFromLoc-xw1)*2+yFromLoc and 1+1)*xxt+dx*xxt/2-MapWidth/2 -> min
6037 while abs(((xFromLoc - xw1 + G.lx) * 2 + yFromLoc and 1 + 1) * xxt * 2 +
6038 dx * xxt - MapWidth) < abs(((xFromLoc - xw1) * 2 + yFromLoc and 1 + 1) *
6039 xxt * 2 + dx * xxt - MapWidth) do
6040 dec(xw1, G.lx);
6041
6042 xTo := (xToLoc - xw1) * (xxt * 2) + yToLoc and 1 * xxt + (xxt - xxu);
6043 yTo := (yToLoc - yw) * yyt + (yyt - yyu_anchor);
6044 xFrom := (xFromLoc - xw1) * (xxt * 2) + yFromLoc and 1 * xxt +
6045 (xxt - xxu);
6046 yFrom := (yFromLoc - yw) * yyt + (yyt - yyu_anchor);
6047 if xFrom < xTo then
6048 begin
6049 xMin := xFrom;
6050 xRange := xTo - xFrom
6051 end
6052 else
6053 begin
6054 xMin := xTo;
6055 xRange := xFrom - xTo
6056 end;
6057 if yFrom < yTo then
6058 begin
6059 yMin := yFrom;
6060 yRange := yTo - yFrom
6061 end
6062 else
6063 begin
6064 yMin := yTo;
6065 yRange := yFrom - yTo
6066 end;
6067 inc(xRange, xxt * 2);
6068 inc(yRange, yyt * 3);
6069
6070 MainOffscreenPaint;
6071 NoMap.SetOutput(Buffer);
6072 NoMap.SetPaintBounds(0, 0, xRange, yRange);
6073 for Step := 0 to abs(Step1 - Step0) do
6074 begin
6075 BitBlt(Buffer.Canvas.Handle, 0, 0, xRange, yRange,
6076 offscreen.Canvas.Handle, xMin, yMin, SRCCOPY);
6077 if Step1 <> Step0 then
6078 begin
6079 xMoving := xFrom +
6080 Round((Step0 + Step * (Step1 - Step0) div abs(Step1 - Step0)) *
6081 (xTo - xFrom) / nStep);
6082 yMoving := yFrom +
6083 Round((Step0 + Step * (Step1 - Step0) div abs(Step1 - Step0)) *
6084 (yTo - yFrom) / nStep);
6085 end
6086 else
6087 begin
6088 xMoving := xFrom;
6089 yMoving := yFrom;
6090 end;
6091 NoMap.PaintUnit(xMoving - xMin, yMoving - yMin, UnitInfo, 0);
6092 PaintBufferToScreen(xMin, yMin, xRange, yRange);
6093
6094 SliceCount := 0;
6095 Ticks := Ticks0;
6096 repeat
6097 if (SliceCount = 0) or ((Ticks - Ticks0) * 12000 * (SliceCount + 1)
6098 div SliceCount < MoveTime * PerfFreq) then
6099 begin
6100 if not idle or (GameMode = cMovie) then
6101 Application.ProcessMessages;
6102 Sleep(1);
6103 inc(SliceCount)
6104 end;
6105 QueryPerformanceCounter(Ticks);
6106 until (Ticks - Ticks0) * 12000 >= MoveTime * PerfFreq;
6107 Ticks0 := Ticks
6108 end;
6109 end;
6110 if Restore then
6111 begin
6112 BitBlt(Buffer.Canvas.Handle, 0, 0, xRange, yRange,
6113 offscreen.Canvas.Handle, xMin, yMin, SRCCOPY);
6114 PaintBufferToScreen(xMin, yMin, xRange, yRange);
6115 end;
6116 BlinkTime := -1;
6117 Timer1.Enabled := true;
6118 end;
6119
6120 procedure TMainScreen.MoveToLoc(Loc: integer; CheckSuicide: boolean);
6121 // path finder: move focused unit to loc, start multi-turn goto if too far
6122 var
6123 uix, i, MoveOptions, NextLoc, MoveResult: integer;
6124 MoveAdviceData: TMoveAdviceData;
6125 StopReason: (None, Arrived, Dead, NoTime, EnemySpotted, MoveError);
6126 begin
6127 if MyUn[UnFocus].Job > jNone then
6128 Server(sStartJob + jNone shl 4, me, UnFocus, nil^);
6129 if GetMoveAdvice(UnFocus, Loc, MoveAdviceData) >= rExecuted then
6130 begin
6131 uix := UnFocus;
6132 StopReason := None;
6133 repeat
6134 for i := 0 to MoveAdviceData.nStep - 1 do
6135 begin
6136 if i = MoveAdviceData.nStep - 1 then
6137 MoveOptions := muAutoNext
6138 else
6139 MoveOptions := 0;
6140 NextLoc := dLoc(MyUn[uix].Loc, MoveAdviceData.dx[i],
6141 MoveAdviceData.dy[i]);
6142 if (NextLoc = Loc) or (Loc = maNextCity) and
6143 (MyMap[NextLoc] and fCity <> 0) then
6144 StopReason := Arrived;
6145 if not CheckSuicide and (NextLoc = Loc) then
6146 MoveOptions := MoveOptions or muNoSuicideCheck;
6147 MoveResult := MoveUnit(MoveAdviceData.dx[i], MoveAdviceData.dy[i],
6148 MoveOptions);
6149 if MoveResult < rExecuted then
6150 StopReason := MoveError
6151 else if MoveResult and rUnitRemoved <> 0 then
6152 StopReason := Dead
6153 else if (StopReason = None) and (MoveResult and rEnemySpotted <> 0)
6154 then
6155 StopReason := EnemySpotted;
6156 if StopReason <> None then
6157 Break;
6158 end;
6159 if (StopReason = None) and
6160 ((MoveAdviceData.nStep < 25) or
6161 (MyRO.Wonder[woShinkansen].EffectiveOwner <> me)) then
6162 StopReason := NoTime;
6163 if StopReason <> None then
6164 Break;
6165 if GetMoveAdvice(UnFocus, Loc, MoveAdviceData) < rExecuted then
6166 begin
6167 assert(false);
6168 Break
6169 end
6170 until false;
6171
6172 case StopReason of
6173 None:
6174 assert(false);
6175 Arrived:
6176 MyUn[uix].Status := MyUn[uix].Status and ($FFFF - usGoto);
6177 Dead:
6178 if UnFocus < 0 then
6179 NextUnit(UnStartLoc, false);
6180 else
6181 begin // multi-turn goto
6182 if Loc = maNextCity then
6183 MyUn[uix].Status := MyUn[uix].Status and
6184 ($FFFF - usStay - usRecover) or usGoto + $7FFF shl 16
6185 else
6186 MyUn[uix].Status := MyUn[uix].Status and
6187 ($FFFF - usStay - usRecover) or usGoto + Loc shl 16;
6188 PaintLoc(MyUn[uix].Loc);
6189 if (StopReason = NoTime) and (UnFocus = uix) then
6190 begin
6191 MyUn[uix].Status := MyUn[uix].Status and not usWaiting;
6192 NextUnit(UnStartLoc, true)
6193 end;
6194 end
6195 end
6196 end
6197 end;
6198
6199 procedure TMainScreen.PanelBoxMouseDown(Sender: TObject;
6200 Button: TMouseButton; Shift: TShiftState; x, y: integer);
6201 var
6202 i, xMouse, MouseLoc, p1: integer;
6203 begin
6204 if GameMode = cMovie then
6205 exit;
6206
6207 if Button = mbLeft then
6208 begin
6209 if (x >= xMini + 2) and (y >= yMini + 2) and (x < xMini + 2 + 2 * G.lx)
6210 and (y < yMini + 2 + G.ly) then
6211 if ssShift in Shift then
6212 begin
6213 xMouse := (xwMini + (x - (xMini + 2) + MapWidth div (xxt * 2) +
6214 G.lx) div 2) mod G.lx;
6215 MouseLoc := xMouse + G.lx * (y - (yMini + 2));
6216 if MyMap[MouseLoc] and fTerrain <> fUNKNOWN then
6217 begin
6218 p1 := MyRO.Territory[MouseLoc];
6219 if (p1 = me) or (p1 >= 0) and (MyRO.Treaty[p1] >= trNone) then
6220 NatStatDlg.ShowNewContent(wmPersistent, p1);
6221 end
6222 end
6223 else
6224 begin
6225 if CityDlg.Visible then
6226 CityDlg.Close;
6227 if UnitStatDlg.Visible then
6228 UnitStatDlg.Close;
6229 Tracking := true;
6230 PanelBoxMouseMove(Sender, Shift + [ssLeft], x, y);
6231 end
6232 else if (ClientMode <> cEditMap) and (x >= ClientWidth - xPalace) and
6233 (y >= yPalace) and (x < ClientWidth - xPalace + xSizeBig) and
6234 (y < yPalace + ySizeBig) then
6235 begin
6236 InitPopup(StatPopup);
6237 if FullScreen then
6238 StatPopup.Popup(Left + ClientWidth - xPalace + xSizeBig + 2,
6239 Top + ClientHeight - PanelHeight + yPalace - 1)
6240 else
6241 StatPopup.Popup(Left + ClientWidth - xPalace + 6,
6242 Top + ClientHeight - PanelHeight + yPalace + ySizeBig +
6243 GetSystemMetrics(SM_CYCAPTION) + 3)
6244 end
6245 (* else if (x>=xAdvisor-3) and (y>=yAdvisor-3)
6246 and (x<xAdvisor+16+3) and (y<yAdvisor+16+3) and HaveStrategyAdvice then
6247 AdviceBtnClick *)
6248 else if (x >= xTroop + 1) and (y >= yTroop + 1) and
6249 (x < xTroop + TrRow * TrPitch) and (y <= yTroop + 55) then
6250 begin
6251 i := (x - xTroop - 1) div TrPitch;
6252 if trix[i] >= 0 then
6253 if ClientMode = cEditMap then
6254 begin
6255 BrushType := trix[i];
6256 PanelPaint
6257 end
6258 else if (TroopLoc >= 0) then
6259 if MyMap[TroopLoc] and fOwned <> 0 then
6260 begin
6261 if ssShift in Shift then
6262 UnitStatDlg.ShowNewContent_OwnModel(wmPersistent,
6263 MyUn[trix[i]].mix)
6264 else if not supervising and (ClientMode < scContact) and
6265 (x - xTroop - 1 - i * TrPitch >= 60 - 20) and
6266 (y >= yTroop + 35) and
6267 ((MyUn[trix[i]].Job > jNone) or (MyUn[trix[i]].Status and
6268 (usStay or usRecover or usGoto) <> 0)) then
6269 begin // wake up
6270 MyUn[trix[i]].Status := MyUn[trix[i]].Status and
6271 ($FFFF - usStay - usRecover - usGoto - usEnhance) or
6272 usWaiting;
6273 if MyUn[trix[i]].Job > jNone then
6274 Server(sStartJob + jNone shl 4, me, trix[i], nil^);
6275 if (UnFocus < 0) and not CityDlg.Visible then
6276 begin
6277 SetUnFocus(trix[i]);
6278 SetTroopLoc(MyUn[trix[i]].Loc);
6279 FocusOnLoc(TroopLoc, flRepaintPanel)
6280 end
6281 else
6282 begin
6283 if CityDlg.Visible and (CityDlg.RestoreUnFocus < 0) then
6284 CityDlg.RestoreUnFocus := trix[i];
6285 PanelPaint;
6286 end
6287 end
6288 else if (ClientMode < scContact) then
6289 begin
6290 if supervising then
6291 UnitStatDlg.ShowNewContent_OwnUnit(wmPersistent, trix[i])
6292 else if CityDlg.Visible then
6293 begin
6294 CityDlg.CloseAction := None;
6295 CityDlg.Close;
6296 SumCities(TaxSum, ScienceSum);
6297 SetUnFocus(trix[i]);
6298 end
6299 else
6300 begin
6301 DestinationMarkON := false;
6302 PaintDestination;
6303 UnFocus := trix[i];
6304 UnStartLoc := TroopLoc;
6305 BlinkTime := 0;
6306 BlinkON := false;
6307 PaintLoc(TroopLoc);
6308 end;
6309 if UnFocus >= 0 then
6310 begin
6311 UnitInfoBtn.Visible := true;
6312 UnitBtn.Visible := true;
6313 TurnComplete := false;
6314 EOT.ButtonIndex := eotGray;
6315 end;
6316 CheckTerrainBtnVisible;
6317 PanelPaint;
6318 end
6319 end
6320 else if Server(sGetUnits, me, TroopLoc, TrCnt) >= rExecuted then
6321 if ssShift in Shift then
6322 UnitStatDlg.ShowNewContent_EnemyModel(wmPersistent,
6323 MyRO.EnemyUn[MyRO.nEnemyUn + trix[i]].emix) // model info
6324 else
6325 UnitStatDlg.ShowNewContent_EnemyUnit(wmPersistent,
6326 MyRO.nEnemyUn + trix[i]); // unit info
6327 end
6328 end
6329 end;
6330
6331 procedure TMainScreen.SetTroopLoc(Loc: integer);
6332 var
6333 trixFocus, uix, uixDefender: integer;
6334 Prio: boolean;
6335 begin
6336 TroopLoc := Loc;
6337 TrRow := (xRightPanel + 10 - xTroop - GetSystemMetrics(SM_CXVSCROLL) - 19)
6338 div TrPitch;
6339 TrCnt := 0;
6340 trixFocus := -1;
6341 if ClientMode = cEditMap then
6342 TrCnt := nBrushTypes
6343 else if (Loc >= 0) and (MyMap[Loc] and fUnit <> 0) then
6344 if MyMap[Loc] and fOwned <> 0 then
6345 begin // count own units here
6346 Server(sGetDefender, me, TroopLoc, uixDefender);
6347 for Prio := true downto false do
6348 for uix := 0 to MyRO.nUn - 1 do
6349 if ((uix = uixDefender) = Prio) and (MyUn[uix].Loc = Loc) then
6350 begin
6351 if uix = UnFocus then
6352 trixFocus := TrCnt;
6353 inc(TrCnt);
6354 end
6355 end
6356 else // count enemy units here
6357 Server(sGetUnits, me, Loc, TrCnt);
6358 if TrCnt = 0 then
6359 InitPVSB(sb, 0, 1)
6360 else
6361 begin
6362 InitPVSB(sb, (TrCnt + TrRow - 1) div TrRow - 1, 1);
6363 with sb.si do
6364 if (nMax >= integer(nPage)) and (trixFocus >= 0) then
6365 begin
6366 sb.si.npos := trixFocus div TrRow;
6367 sb.si.FMask := SIF_POS;
6368 SetScrollInfo(sb.h, SB_CTL, sb.si, true);
6369 end
6370 end
6371 end;
6372
6373 (* procedure TMainScreen.ShowMoveHint(ToLoc: integer; Force: boolean = false);
6374 var
6375 Step,Loc,x0,y0,xs,ys: integer;
6376 Info: string;
6377 InfoSize: TSize;
6378 MoveAdvice: TMoveAdviceData;
6379 begin
6380 if (ToLoc<0) or (ToLoc>=G.lx*G.ly)
6381 or (UnFocus<0) or (MyUn[UnFocus].Loc=ToLoc) then
6382 ToLoc:=-1
6383 else
6384 begin
6385 MoveAdvice.ToLoc:=ToLoc;
6386 MoveAdvice.MoreTurns:=0;
6387 MoveAdvice.MaxHostile_MovementLeft:=MyUn[UnFocus].Health-50;
6388 if Server(sGetMoveAdvice,me,UnFocus,MoveAdvice)<rExecuted then
6389 ToLoc:=-1
6390 end;
6391 if (ToLoc=MoveHintToLoc) and not Force then exit;
6392 if (ToLoc<>MoveHintToLoc) and (MoveHintToLoc>=0) then
6393 begin invalidate; update end; // clear old hint from screen
6394 MoveHintToLoc:=ToLoc;
6395 if ToLoc<0 then exit;
6396
6397 with canvas do
6398 begin
6399 Pen.Color:=$80C0FF;
6400 Pen.Width:=3;
6401 Loc:=MyUn[UnFocus].Loc;
6402 for Step:=0 to MoveAdvice.nStep do
6403 begin
6404 y0:=(Loc+G.lx*1024) div G.lx -1024;
6405 x0:=(Loc+(y0 and 1+G.lx*1024) div 2) mod G.lx;
6406 xs:=(x0-xw)*66+y0 and 1*33-G.lx*66;
6407 while abs(2*(xs+G.lx*66)-MapWidth)<abs(2*xs-MapWidth) do
6408 inc(xs,G.lx*66);
6409 ys:=(y0-yw)*16;
6410 if Step=0 then moveto(xs+33,ys+16)
6411 else lineto(xs+33,ys+16);
6412 if Step<MoveAdvice.nStep then
6413 Loc:=dLoc(Loc,MoveAdvice.dx[Step],MoveAdvice.dy[Step]);
6414 end;
6415 Brush.Color:=$80C0FF;
6416 Info:=' '+inttostr(88)+' ';
6417 InfoSize:=TextExtent(Info);
6418 TextOut(xs+33-InfoSize.cx div 2, ys+16-InfoSize.cy div 2, Info);
6419 Brush.Style:=bsClear;
6420 end
6421 end; *)
6422
6423 procedure TMainScreen.SetDebugMap(p: integer);
6424 begin
6425 IsoEngine.pDebugMap := p;
6426 IsoEngine.Options := IsoEngine.Options and not(1 shl moLocCodes);
6427 mLocCodes.Checked := false;
6428 MapValid := false;
6429 MainOffscreenPaint;
6430 end;
6431
6432 procedure TMainScreen.SetViewpoint(p: integer);
6433 var
6434 i: integer;
6435 begin
6436 if supervising and (G.RO[0].Turn > 0) and
6437 ((p = 0) or (1 shl p and G.RO[0].Alive <> 0)) then
6438 begin
6439 for i := 0 to Screen.FormCount - 1 do
6440 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)
6441 then
6442 Screen.Forms[i].Close; // close windows
6443 ItsMeAgain(p);
6444 SumCities(TaxSum, ScienceSum);
6445 for i := 0 to MyRO.nModel - 1 do
6446 if Tribe[me].ModelPicture[i].HGr = 0 then
6447 InitMyModel(i, true);
6448
6449 SetTroopLoc(-1);
6450 PanelPaint;
6451 MapValid := false;
6452 PaintAllMaps;
6453 end
6454 end;
6455
6456 procedure TMainScreen.FormKeyDown(Sender: TObject; var Key: word;
6457 Shift: TShiftState);
6458
6459 procedure MenuClick_Check(Popup: TPopupMenu; Item: TMenuItem);
6460 begin
6461 InitPopup(Popup);
6462 if Item.Visible and Item.Enabled then
6463 MenuClick(Item);
6464 end;
6465
6466 var
6467 dx, dy: integer;
6468 time0, time1: int64;
6469 begin
6470 if GameMode = cMovie then
6471 begin
6472 case Key of
6473 VK_F4:
6474 MenuClick_Check(StatPopup, mScienceStat);
6475 VK_F6:
6476 MenuClick_Check(StatPopup, mDiagram);
6477 VK_F7:
6478 MenuClick_Check(StatPopup, mWonders);
6479 VK_F8:
6480 MenuClick_Check(StatPopup, mShips);
6481 end;
6482 exit;
6483 end;
6484
6485 if not idle then
6486 exit;
6487
6488 if ClientMode = cEditMap then
6489 begin
6490 if Shift = [ssCtrl] then
6491 case char(Key) of
6492 (* 'A':
6493 begin // auto symmetry
6494 Server($7F0,me,0,nil^);
6495 MapValid:=false;
6496 PaintAll;
6497 end;
6498 'B':
6499 begin // land mass
6500 dy:=0;
6501 for dx:=G.lx to G.lx*(G.ly-1)-1 do
6502 if MyMap[dx] and fTerrain>=fGrass then inc(dy);
6503 dy:=dy
6504 end; *)
6505 'Q':
6506 MenuClick(mResign);
6507 'R':
6508 MenuClick(mRandomMap);
6509 end
6510 else if Shift = [] then
6511 case char(Key) of
6512 char(VK_F1):
6513 MenuClick(mHelp);
6514 end;
6515 exit;
6516 end;
6517
6518 if Shift = [ssAlt] then
6519 case char(Key) of
6520 '0':
6521 SetDebugMap(-1);
6522 '1' .. '9':
6523 SetDebugMap(ord(Key) - 48);
6524 end
6525 else if Shift = [ssCtrl] then
6526 case char(Key) of
6527 'J':
6528 MenuClick(mJump);
6529 'K':
6530 mShowClick(mDebugMap);
6531 'L':
6532 mShowClick(mLocCodes);
6533 'M':
6534 if LogDlg.Visible then
6535 LogDlg.Close
6536 else
6537 LogDlg.Show;
6538 'N':
6539 mNamesClick(mNames);
6540 'Q':
6541 MenuClick_Check(GamePopup, mResign);
6542 'R':
6543 MenuClick(mRun);
6544 '0' .. '9':
6545 begin
6546 if ord(Key) - 48 = me then
6547 SetViewpoint(0)
6548 else
6549 SetViewpoint(ord(Key) - 48);
6550 end;
6551 ' ':
6552 begin // test map repaint time
6553 QueryPerformanceCounter(time0);
6554 MapValid := false;
6555 MainOffscreenPaint;
6556 QueryPerformanceCounter(time1);
6557 SimpleMessage(Format('Map repaint time: %.3f ms',
6558 [{$IFDEF VER100}(time1.LowPart - time0.LowPart)
6559{$ELSE}(time1 - time0){$ENDIF} * 1000.0 / PerfFreq]));
6560 end
6561 end
6562 else if Shift = [] then
6563 case char(Key) of
6564 char(VK_F1):
6565 MenuClick(mHelp);
6566 char(VK_F2):
6567 MenuClick_Check(StatPopup, mUnitStat);
6568 char(VK_F3):
6569 MenuClick_Check(StatPopup, mCityStat);
6570 char(VK_F4):
6571 MenuClick_Check(StatPopup, mScienceStat);
6572 char(VK_F5):
6573 MenuClick_Check(StatPopup, mEUnitStat);
6574 char(VK_F6):
6575 MenuClick_Check(StatPopup, mDiagram);
6576 char(VK_F7):
6577 MenuClick_Check(StatPopup, mWonders);
6578 char(VK_F8):
6579 MenuClick_Check(StatPopup, mShips);
6580 char(VK_F9):
6581 MenuClick_Check(StatPopup, mNations);
6582 char(VK_F10):
6583 MenuClick_Check(StatPopup, mEmpire);
6584 char(VK_ADD):
6585 EndTurn;
6586 '1':
6587 MapBtnClick(MapBtn0);
6588 '2':
6589 MapBtnClick(MapBtn1);
6590 '3':
6591 MapBtnClick(MapBtn4);
6592 '4':
6593 MapBtnClick(MapBtn5);
6594 '5':
6595 MapBtnClick(MapBtn6);
6596 'T':
6597 MenuClick(mTechTree);
6598 'W':
6599 MenuClick(mWait);
6600 end;
6601
6602 if UnFocus >= 0 then
6603 if Shift = [ssCtrl] then
6604 case char(Key) of
6605 'C':
6606 MenuClick_Check(UnitPopup, mCancel);
6607 'D':
6608 MenuClick(mDisband);
6609 'P':
6610 MenuClick_Check(UnitPopup, mPillage);
6611 'T':
6612 MenuClick_Check(UnitPopup, mSelectTransport);
6613 end
6614 else if Shift = [] then
6615 case char(Key) of
6616 ' ':
6617 MenuClick(mNoOrders);
6618 'A':
6619 MenuClick_Check(TerrainPopup, mAirBase);
6620 'B':
6621 MenuClick_Check(UnitPopup, mCity);
6622 'C':
6623 MenuClick(mCentre);
6624 'E':
6625 begin
6626 InitPopup(TerrainPopup);
6627 if mEnhance.Visible and mEnhance.Enabled then
6628 MenuClick(mEnhance)
6629 else
6630 MenuClick(mEnhanceDef)
6631 end;
6632 'F':
6633 MenuClick_Check(TerrainPopup, mFort);
6634 'G':
6635 MenuClick_Check(UnitPopup, mGoOn);
6636 'H':
6637 MenuClick_Check(UnitPopup, mHome);
6638 'I':
6639 if JobTest(UnFocus, jFarm, [eTreaty]) then
6640 MenuClick(mFarm)
6641 else if JobTest(UnFocus, jClear, [eTreaty]) then
6642 MenuClick(mClear)
6643 else
6644 MenuClick_Check(TerrainPopup, mIrrigation);
6645 'L':
6646 MenuClick_Check(UnitPopup, mLoad);
6647 'M':
6648 if JobTest(UnFocus, jAfforest, [eTreaty]) then
6649 MenuClick(mAfforest)
6650 else
6651 MenuClick_Check(TerrainPopup, mMine);
6652 'N':
6653 MenuClick_Check(TerrainPopup, mCanal);
6654 'O':
6655 MenuClick_Check(TerrainPopup, MTrans);
6656 'P':
6657 MenuClick_Check(TerrainPopup, mPollution);
6658 'R':
6659 if JobTest(UnFocus, jRR, [eTreaty]) then
6660 MenuClick(mRR)
6661 else
6662 MenuClick_Check(TerrainPopup, mRoad);
6663 'S':
6664 MenuClick(mStay);
6665 'U':
6666 MenuClick_Check(UnitPopup, mUnload);
6667 'V':
6668 MenuClick_Check(UnitPopup, mRecover);
6669 'Z':
6670 MenuClick_Check(UnitPopup, mUtilize);
6671 #33 .. #40, #97 .. #100, #102 .. #105:
6672 begin { arrow keys }
6673 DestinationMarkON := false;
6674 PaintDestination;
6675 MyUn[UnFocus].Status := MyUn[UnFocus].Status and
6676 ($FFFF - usStay - usRecover - usGoto - usEnhance) or
6677 usWaiting;
6678 case Key of
6679 VK_NUMPAD1, VK_END:
6680 begin
6681 dx := -1;
6682 dy := 1
6683 end;
6684 VK_NUMPAD2, VK_DOWN:
6685 begin
6686 dx := 0;
6687 dy := 2
6688 end;
6689 VK_NUMPAD3, VK_NEXT:
6690 begin
6691 dx := 1;
6692 dy := 1
6693 end;
6694 VK_NUMPAD4, VK_LEFT:
6695 begin
6696 dx := -2;
6697 dy := 0
6698 end;
6699 VK_NUMPAD6, VK_RIGHT:
6700 begin
6701 dx := 2;
6702 dy := 0
6703 end;
6704 VK_NUMPAD7, VK_HOME:
6705 begin
6706 dx := -1;
6707 dy := -1
6708 end;
6709 VK_NUMPAD8, VK_UP:
6710 begin
6711 dx := 0;
6712 dy := -2
6713 end;
6714 VK_NUMPAD9, VK_PRIOR:
6715 begin
6716 dx := 1;
6717 dy := -1
6718 end;
6719 end;
6720 MoveUnit(dx, dy, muAutoNext)
6721 end;
6722 end
6723 end;
6724
6725 procedure TMainScreen.MenuClick(Sender: TObject);
6726
6727 function DoJob(j0: integer): integer;
6728 var
6729 Loc0, Movement0: integer;
6730 begin
6731 with MyUn[UnFocus] do
6732 begin
6733 DestinationMarkON := false;
6734 PaintDestination;
6735 Loc0 := Loc;
6736 Movement0 := Movement;
6737 if j0 < 0 then
6738 result := ProcessEnhancement(UnFocus, MyData.EnhancementJobs)
6739 // terrain enhancement
6740 else
6741 result := Server(sStartJob + j0 shl 4, me, UnFocus, nil^);
6742 if result >= rExecuted then
6743 begin
6744 if result = eDied then
6745 UnFocus := -1;
6746 PaintLoc(Loc0);
6747 if UnFocus >= 0 then
6748 begin
6749 if (j0 < 0) and (result <> eJobDone) then
6750 // multi-turn terrain enhancement
6751 Status := Status and ($FFFF - usStay - usRecover - usGoto) or
6752 usEnhance
6753 else
6754 Status := Status and
6755 ($FFFF - usStay - usRecover - usGoto - usEnhance);
6756 if (Job <> jNone) or (Movement0 < 100) then
6757 begin
6758 Status := Status and not usWaiting;
6759 NextUnit(UnStartLoc, true);
6760 end
6761 else
6762 PanelPaint
6763 end
6764 else
6765 NextUnit(UnStartLoc, true);
6766 end
6767 end;
6768 case result of
6769 eNoBridgeBuilding:
6770 SoundMessage(Phrases.Lookup('NOBB'), 'INVALID');
6771 eNoCityTerrain:
6772 SoundMessage(Phrases.Lookup('NOCITY'), 'INVALID');
6773 eTreaty:
6774 SoundMessage(Tribe[MyRO.Territory[Loc0]].TPhrase('PEACE_NOWORK'),
6775 'NOMOVE_TREATY');
6776 else
6777 if result < rExecuted then
6778 Play('INVALID')
6779 end
6780 end;
6781
6782 var
6783 i, uix, NewFocus, Loc0, OldMaster, Destination, cix, cixOldHome,
6784 ServerResult: integer;
6785 AltGovs, Changed: boolean;
6786 QueryText: string;
6787
6788 begin
6789 if Sender = mResign then
6790 if ClientMode = cEditMap then
6791 begin
6792 if Edited then
6793 begin
6794 QueryText := Phrases.Lookup('MAP_CLOSE');
6795 case SimpleQuery(mkYesNoCancel, QueryText, '') of
6796 mrIgnore:
6797 Server(sAbandonMap, me, 0, nil^);
6798 mrOK:
6799 Server(sSaveMap, me, 0, nil^);
6800 end
6801 end
6802 else
6803 Server(sAbandonMap, me, 0, nil^)
6804 end
6805 else
6806 begin
6807 if Server(sGetGameChanged, 0, 0, nil^) = eOK then
6808 begin
6809 QueryText := Phrases.Lookup('RESIGN');
6810 case SimpleQuery(mkYesNoCancel, QueryText, '') of
6811 mrIgnore:
6812 Server(sResign, 0, 0, nil^);
6813 mrOK:
6814 Server(sBreak, 0, 0, nil^)
6815 end
6816 end
6817 else
6818 Server(sResign, 0, 0, nil^)
6819 end
6820 else if Sender = mEmpire then
6821 RatesDlg.ShowNewContent(wmPersistent)
6822 else if Sender = mRevolution then
6823 begin
6824 AltGovs := false;
6825 for i := 2 to nGov - 1 do
6826 if (GovPreq[i] <> preNA) and
6827 ((GovPreq[i] = preNone) or (MyRO.Tech[GovPreq[i]] >= tsApplicable))
6828 then
6829 AltGovs := true;
6830
6831 if not AltGovs then
6832 SoundMessage(Phrases.Lookup('NOALTGOVS'), 'MSG_DEFAULT')
6833 else
6834 begin
6835 Changed := false;
6836 if MyRO.Happened and phChangeGov <> 0 then
6837 begin
6838 ModalSelectDlg.ShowNewContent(wmModal, kGov);
6839 if ModalSelectDlg.result >= 0 then
6840 begin
6841 Play('NEWGOV');
6842 Server(sSetGovernment, me, ModalSelectDlg.result, nil^);
6843 CityOptimizer_BeginOfTurn;
6844 Changed := true;
6845 end
6846 end
6847 else
6848 // TODO with MessgExDlg do
6849 begin // revolution!
6850 MessgExDlg.MessgText := Tribe[me].TPhrase('REVOLUTION');
6851 MessgExDlg.Kind := mkYesNo;
6852 MessgExDlg.IconKind := mikPureIcon;
6853 MessgExDlg.IconIndex := 72; // anarchy palace
6854 MessgExDlg.ShowModal;
6855 if ModalResult = mrOK then
6856 begin
6857 Play('REVOLUTION');
6858 Server(sRevolution, me, 0, nil^);
6859 Changed := true;
6860 if NatStatDlg.Visible then
6861 NatStatDlg.Close;
6862 if CityDlg.Visible then
6863 CityDlg.Close;
6864 end
6865 end;
6866 if Changed then
6867 UpdateViews(true);
6868 end
6869 end
6870 else if Sender = mWebsite then
6871 OpenURL('http://c-evo.org'){ *Převedeno z ShellExecute* }
6872 else if Sender = mRandomMap then
6873 begin
6874 if not Edited or (SimpleQuery(mkYesNo, Phrases.Lookup('MAP_RANDOM'), '')
6875 = mrOK) then
6876 begin
6877 Server(sRandomMap, me, 0, nil^);
6878 Edited := true;
6879 MapValid := false;
6880 PaintAllMaps;
6881 end
6882 end
6883 else if Sender = mJump then
6884 begin
6885 if supervising then
6886 Jump[0] := 20
6887 else
6888 Jump[me] := 20;
6889 EndTurn(true);
6890 end
6891 else if Sender = mRun then
6892 begin
6893 if supervising then
6894 Jump[0] := 999999
6895 else
6896 Jump[me] := 999999;
6897 EndTurn(true);
6898 end
6899 else if Sender = mEnhanceDef then
6900 begin
6901 if UnFocus >= 0 then
6902 EnhanceDlg.ShowNewContent(wmPersistent,
6903 MyMap[MyUn[UnFocus].Loc] and fTerrain)
6904 else
6905 EnhanceDlg.ShowNewContent(wmPersistent)
6906 end
6907 else if Sender = mCityTypes then
6908 CityTypeDlg.ShowNewContent(wmModal)
6909 // must be modal because types are not saved before closing
6910 else if Sender = mUnitStat then
6911 begin
6912 if G.Difficulty[me] > 0 then
6913 ListDlg.ShowNewContent_MilReport(wmPersistent, me)
6914 else
6915 begin
6916 i := 1;
6917 while (i < nPl) and (1 shl i and MyRO.Alive = 0) do
6918 inc(i);
6919 if i < nPl then
6920 ListDlg.ShowNewContent_MilReport(wmPersistent, i);
6921 end;
6922 end
6923 else if Sender = mEUnitStat then
6924 begin
6925 if MyRO.nEnemyModel > 0 then
6926 ListDlg.ShowNewContent(wmPersistent, kAllEModels);
6927 end
6928 else if Sender = mCityStat then
6929 ListDlg.ShowNewContent(wmPersistent, kCities)
6930 else if Sender = mScienceStat then
6931 ListDlg.ShowNewContent(wmPersistent, kScience)
6932 else if Sender = mNations then
6933 NatStatDlg.ShowNewContent(wmPersistent)
6934 else if Sender = mHelp then
6935 if ClientMode = cEditMap then
6936 HelpDlg.ShowNewContent(wmPersistent, hkText,
6937 HelpDlg.TextIndex('MAPEDIT'))
6938 else
6939 HelpDlg.ShowNewContent(wmPersistent, hkMisc, miscMain)
6940 else if Sender = mTechTree then
6941 TechTreeDlg.ShowModal
6942 else if Sender = mWonders then
6943 WondersDlg.ShowNewContent(wmPersistent)
6944 else if Sender = mDiagram then
6945 DiaDlg.ShowNewContent_Charts(wmPersistent)
6946 else if Sender = mShips then
6947 DiaDlg.ShowNewContent_Ship(wmPersistent)
6948 else if Sender = mWait then
6949 begin
6950 if UnFocus >= 0 then
6951 begin
6952 DestinationMarkON := false;
6953 PaintDestination;
6954 MyUn[UnFocus].Status := MyUn[UnFocus].Status and
6955 ($FFFF - usStay - usRecover - usGoto - usEnhance) or usWaiting;
6956 end;
6957 NextUnit(-1, false);
6958 end
6959 else if UnFocus >= 0 then
6960 with MyUn[UnFocus] do
6961 if Sender = mGoOn then
6962 begin
6963 if Status shr 16 = $7FFF then
6964 Destination := maNextCity
6965 else
6966 Destination := Status shr 16;
6967 Status := Status and not(usStay or usRecover) or usWaiting;
6968 MoveToLoc(Destination, true);
6969 end
6970 else if Sender = mHome then
6971 if MyMap[Loc] and fCity <> 0 then
6972 begin
6973 cixOldHome := Home;
6974 if Server(sSetUnitHome, me, UnFocus, nil^) >= rExecuted then
6975 begin
6976 CityOptimizer_CityChange(cixOldHome);
6977 CityOptimizer_CityChange(Home);
6978 UpdateViews(true);
6979 end
6980 else
6981 Play('INVALID');
6982 end
6983 else
6984 begin
6985 Status := Status and not(usStay or usRecover or usEnhance);
6986 MoveToLoc(maNextCity, true)
6987 end
6988 else if Sender = mCentre then
6989 begin
6990 Centre(Loc);
6991 PaintAllMaps
6992 end
6993 else if Sender = mCity then
6994 begin
6995 Loc0 := Loc;
6996 if MyMap[Loc] and fCity = 0 then
6997 begin // build city
6998 if DoJob(jCity) = eCity then
6999 begin
7000 MapValid := false;
7001 PaintAll;
7002 ZoomToCity(Loc0, true, chFounded);
7003 end
7004 end
7005 else
7006 begin
7007 CityOptimizer_BeforeRemoveUnit(UnFocus);
7008 ServerResult := Server(sAddToCity, me, UnFocus, nil^);
7009 if ServerResult >= rExecuted then
7010 begin
7011 cix := MyRO.nCity - 1;
7012 while (cix >= 0) and (MyCity[cix].Loc <> Loc0) do
7013 dec(cix);
7014 assert(cix >= 0);
7015 CityOptimizer_CityChange(cix);
7016 CityOptimizer_AfterRemoveUnit; // does nothing here
7017 SetTroopLoc(Loc0);
7018 UpdateViews(true);
7019 DestinationMarkON := false;
7020 PaintDestination;
7021 UnFocus := -1;
7022 PaintLoc(Loc0);
7023 NextUnit(UnStartLoc, true);
7024 end
7025 else if ServerResult = eMaxSize then
7026 SimpleMessage(Phrases.Lookup('ADDTOMAXSIZE'));
7027 end
7028 end
7029 else if Sender = mRoad then
7030 DoJob(jRoad)
7031 else if Sender = mRR then
7032 DoJob(jRR)
7033 else if Sender = mClear then
7034 DoJob(jClear)
7035 else if Sender = mIrrigation then
7036 DoJob(jIrr)
7037 else if Sender = mFarm then
7038 DoJob(jFarm)
7039 else if Sender = mAfforest then
7040 DoJob(jAfforest)
7041 else if Sender = mMine then
7042 DoJob(jMine)
7043 else if Sender = mCanal then
7044 DoJob(jCanal)
7045 else if Sender = MTrans then
7046 DoJob(jTrans)
7047 else if Sender = mFort then
7048 DoJob(jFort)
7049 else if Sender = mAirBase then
7050 DoJob(jBase)
7051 else if Sender = mPollution then
7052 DoJob(jPoll)
7053 else if Sender = mPillage then
7054 DoJob(jPillage)
7055 else if Sender = mEnhance then
7056 DoJob(-1)
7057 else if Sender = mStay then
7058 begin
7059 DestinationMarkON := false;
7060 PaintDestination;
7061 Status := Status and ($FFFF - usRecover - usGoto - usEnhance)
7062 or usStay;
7063 if Job > jNone then
7064 Server(sStartJob + jNone shl 4, me, UnFocus, nil^);
7065 NextUnit(UnStartLoc, true)
7066 end
7067 else if Sender = mRecover then
7068 begin
7069 DestinationMarkON := false;
7070 PaintDestination;
7071 Status := Status and ($FFFF - usStay - usGoto - usEnhance) or
7072 usRecover;
7073 if Job > jNone then
7074 Server(sStartJob + jNone shl 4, me, UnFocus, nil^);
7075 NextUnit(UnStartLoc, true)
7076 end
7077 else if Sender = mNoOrders then
7078 begin
7079 Status := Status and not usWaiting;
7080 NextUnit(UnStartLoc, true)
7081 end
7082 else if Sender = mCancel then
7083 begin
7084 DestinationMarkON := false;
7085 PaintDestination;
7086 Status := Status and ($FFFF - usRecover - usGoto - usEnhance);
7087 if Job > jNone then
7088 Server(sStartJob + jNone shl 4, me, UnFocus, nil^);
7089 end
7090 else if (Sender = mDisband) or (Sender = mUtilize) then
7091 begin
7092 if (Sender = mUtilize) and
7093 not(Server(sRemoveUnit - sExecute, me, UnFocus, nil^) = eUtilized)
7094 then
7095 begin
7096 SimpleMessage(Phrases2.Lookup('SHIP_UTILIZE'));
7097 // freight for colony ship is the only case in which the command is
7098 // available to player though not valid
7099 exit
7100 end;
7101 if (Sender = mUtilize) and (Health < 100) then
7102 if SimpleQuery(mkYesNo, Phrases.Lookup('DAMAGED_UTILIZE'), '') <> mrOK
7103 then
7104 exit;
7105 Loc0 := Loc;
7106 CityOptimizer_BeforeRemoveUnit(UnFocus);
7107 if Server(sRemoveUnit, me, UnFocus, nil^) = eUtilized then
7108 Play('CITY_UTILIZE')
7109 else
7110 Play('DISBAND');
7111 CityOptimizer_AfterRemoveUnit;
7112 SetTroopLoc(Loc0);
7113 UpdateViews(true);
7114 DestinationMarkON := false;
7115 PaintDestination;
7116 UnFocus := -1;
7117 PaintLoc(Loc0);
7118 NextUnit(UnStartLoc, true);
7119 end
7120 else if Sender = mLoad then
7121 begin
7122 i := Server(sLoadUnit, me, UnFocus, nil^);
7123 if i >= rExecuted then
7124 begin
7125 if MyModel[mix].Domain = dAir then
7126 Play('MOVE_PLANELANDING')
7127 else
7128 Play('MOVE_LOAD');
7129 DestinationMarkON := false;
7130 PaintDestination;
7131 Status := Status and
7132 ($FFFF - usWaiting - usStay - usRecover - usGoto - usEnhance);
7133 NextUnit(UnStartLoc, true);
7134 end
7135 else if i = eNoTime_Load then
7136 if MyModel[mix].Domain = dAir then
7137 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'), 'NOMOVE_TIME')
7138 else
7139 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'),
7140 [MovementToString(MyModel[mix].speed)]), 'NOMOVE_TIME');
7141 end
7142 else if Sender = mUnload then
7143 if Master >= 0 then
7144 begin
7145 OldMaster := Master;
7146 i := Server(sUnloadUnit, me, UnFocus, nil^);
7147 if i >= rExecuted then
7148 begin
7149 if MyModel[mix].Domain = dAir then
7150 Play('MOVE_PLANESTART')
7151 else if (MyModel[MyUn[OldMaster].mix].Domain = dAir) and
7152 (MyMap[Loc] and fCity = 0) and
7153 (MyMap[Loc] and fTerImp <> tiBase) then
7154 Play('MOVE_PARACHUTE')
7155 else
7156 Play('MOVE_UNLOAD');
7157 Status := Status and not usWaiting;
7158 if MyModel[mix].Domain <> dAir then
7159 NextUnit(Loc, true)
7160 else
7161 PanelPaint
7162 end
7163 else if i = eNoTime_Load then
7164 if MyModel[mix].Domain = dAir then
7165 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'), 'NOMOVE_TIME')
7166 else
7167 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'),
7168 [MovementToString(MyModel[mix].speed)]), 'NOMOVE_TIME');
7169 end
7170 else
7171 begin
7172 NewFocus := -1;
7173 uix := UnFocus;
7174 for i := 1 to MyRO.nUn - 1 do
7175 begin
7176 uix := (uix + MyRO.nUn - 1) mod MyRO.nUn;
7177 if (MyUn[uix].Master = UnFocus) and
7178 (MyUn[uix].Movement = integer(MyModel[MyUn[uix].mix].speed))
7179 then
7180 begin
7181 MyUn[uix].Status := MyUn[uix].Status or usWaiting;
7182 NewFocus := uix
7183 end;
7184 end;
7185 if NewFocus >= 0 then
7186 begin
7187 SetUnFocus(NewFocus);
7188 SetTroopLoc(Loc);
7189 PanelPaint
7190 end
7191 end
7192 else if Sender = mSelectTransport then
7193 Server(sSelectTransport, me, UnFocus, nil^)
7194 end;
7195
7196 procedure TMainScreen.InitPopup(Popup: TPopupMenu);
7197 var
7198 i, p1, Tile, Test: integer;
7199 NoSuper, extended, Multi, NeedSep, HaveCities: boolean;
7200 LastSep, m: TMenuItem;
7201 mox: ^TModel;
7202 begin
7203 NoSuper := not supervising and (1 shl me and MyRO.Alive <> 0);
7204 HaveCities := false;
7205 for i := 0 to MyRO.nCity - 1 do
7206 if MyCity[i].Loc >= 0 then
7207 begin
7208 HaveCities := true;
7209 Break
7210 end;
7211 if Popup = GamePopup then
7212 begin
7213 mTechTree.Visible := ClientMode <> cEditMap;
7214 mResign.Enabled := supervising or (me = 0) and (ClientMode < scContact);
7215 mRandomMap.Visible := (ClientMode = cEditMap) and
7216 (Server(sMapGeneratorRequest, me, 0, nil^) = eOK);
7217 mOptions.Visible := ClientMode <> cEditMap;
7218 mManip.Visible := ClientMode <> cEditMap;
7219 if ClientMode <> cEditMap then
7220 begin
7221 mWaitTurn.Visible := NoSuper;
7222 mRep.Visible := NoSuper;
7223 mRepList.Visible := NoSuper;
7224 mRepScreens.Visible := NoSuper;
7225 N10.Visible := NoSuper;
7226 mOwnMovement.Visible := NoSuper;
7227 mAllyMovement.Visible := NoSuper;
7228 case SoundMode of
7229 smOff:
7230 mSoundOff.Checked := true;
7231 smOn:
7232 mSoundOn.Checked := true;
7233 smOnAlt:
7234 mSoundOnAlt.Checked := true;
7235 end;
7236
7237 for i := 0 to nTestFlags - 1 do
7238 mManip[i].Checked := MyRO.TestFlags and (1 shl i) <> 0;
7239 mManip.Enabled := supervising or (me = 0);
7240
7241 Multi := false;
7242 for p1 := 1 to nPl - 1 do
7243 if G.RO[p1] <> nil then
7244 Multi := true;
7245 mEnemyMovement.Visible := not Multi;
7246 end;
7247 mMacro.Visible := NoSuper and (ClientMode < scContact);
7248 if NoSuper and (ClientMode < scContact) then
7249 begin
7250 mCityTypes.Enabled := false;
7251 // check if city types already usefull:
7252 if MyRO.nCity > 0 then
7253 for i := 28 to nImp - 1 do
7254 if (i <> imTrGoods) and (Imp[i].Kind = ikCommon) and
7255 (Imp[i].Preq <> preNA) and
7256 ((Imp[i].Preq = preNone) or
7257 (MyRO.Tech[Imp[i].Preq] >= tsApplicable)) then
7258 begin
7259 mCityTypes.Enabled := true;
7260 Break
7261 end;
7262 end;
7263 mViewpoint.Visible := (ClientMode <> cEditMap) and supervising;
7264 mViewpoint.Enabled := G.RO[0].Turn > 0;
7265 if supervising then
7266 begin
7267 EmptyMenu(mViewpoint);
7268 for p1 := 0 to nPl - 1 do
7269 if (p1 = 0) or (1 shl p1 and G.RO[0].Alive <> 0) then
7270 begin
7271 m := TMenuItem.Create(mViewpoint);
7272 if p1 = 0 then
7273 m.Caption := Phrases.Lookup('SUPER')
7274 else
7275 m.Caption := Tribe[p1].TString(Phrases2.Lookup('BELONG'));
7276 m.Tag := p1;
7277 m.OnClick := ViewpointClick;
7278 if p1 < 10 then
7279 m.ShortCut := ShortCut(48 + p1, [ssCtrl]);
7280 m.RadioItem := true;
7281 if p1 = me then
7282 m.Checked := true;
7283 mViewpoint.Add(m);
7284 end
7285 end;
7286 mDebugMap.Visible := (ClientMode <> cEditMap) and supervising;
7287 if supervising then
7288 begin
7289 EmptyMenu(mDebugMap);
7290 for p1 := 0 to nPl - 1 do
7291 if (p1 = 0) or (1 shl p1 and G.RO[0].Alive <> 0) then
7292 begin
7293 m := TMenuItem.Create(mDebugMap);
7294 if p1 = 0 then
7295 m.Caption := Phrases2.Lookup('MENU_DEBUGMAPOFF')
7296 else
7297 m.Caption := Tribe[p1].TString(Phrases2.Lookup('BELONG'));
7298 if p1 = 0 then
7299 m.Tag := -1
7300 else
7301 m.Tag := p1;
7302 m.OnClick := DebugMapClick;
7303 if p1 < 10 then
7304 m.ShortCut := ShortCut(48 + p1, [ssAlt]);
7305 m.RadioItem := true;
7306 if m.Tag = IsoEngine.pDebugMap then
7307 m.Checked := true;
7308 mDebugMap.Add(m);
7309 end
7310 end;
7311 mSmallTiles.Checked := xxt = 33;
7312 mNormalTiles.Checked := xxt = 48;
7313 end
7314 else if Popup = StatPopup then
7315 begin
7316 mEmpire.Visible := NoSuper;
7317 mEmpire.Enabled := MyRO.Government <> gAnarchy;
7318 mRevolution.Visible := NoSuper;
7319 mRevolution.Enabled := (MyRO.Government <> gAnarchy) and
7320 (ClientMode < scContact);
7321 mUnitStat.Enabled := NoSuper or (MyRO.Turn > 0);
7322 mCityStat.Visible := 1 shl me and MyRO.Alive <> 0;
7323 mCityStat.Enabled := HaveCities;
7324 mScienceStat.Visible := true;
7325 mScienceStat.Enabled := not NoSuper or (MyRO.ResearchTech >= 0) or
7326 (MyRO.Happened and phTech <> 0) or (MyRO.Happened and phGameEnd <> 0)
7327 // no researchtech in case just completed
7328 or (MyRO.TestFlags and (tfAllTechs or tfUncover or
7329 tfAllContact) <> 0);
7330 mEUnitStat.Enabled := MyRO.nEnemyModel > 0;
7331 { mWonders.Enabled:= false;
7332 for i:=0 to 27 do if MyRO.Wonder[i].CityID<>-1 then
7333 mWonders.Enabled:=true; }
7334 mDiagram.Enabled := MyRO.Turn >= 2;
7335 mShips.Enabled := false;
7336 for p1 := 0 to nPl - 1 do
7337 if MyRO.Ship[p1].Parts[spComp] + MyRO.Ship[p1].Parts[spPow] +
7338 MyRO.Ship[p1].Parts[spHab] > 0 then
7339 mShips.Enabled := true;
7340 end
7341 else if Popup = UnitPopup then
7342 begin
7343 mox := @MyModel[MyUn[UnFocus].mix];
7344 Tile := MyMap[MyUn[UnFocus].Loc];
7345 extended := Tile and fCity = 0;
7346 if extended then
7347 begin
7348 mCity.Caption := Phrases.Lookup('BTN_FOUND');
7349 mHome.Caption := Phrases.Lookup('BTN_MOVEHOME')
7350 end
7351 else
7352 begin
7353 mCity.Caption := Phrases.Lookup('BTN_ADD');
7354 mHome.Caption := Phrases.Lookup('BTN_SETHOME')
7355 end;
7356
7357 extended := extended and
7358 ((mox.Kind = mkSettler) or (mox.Kind = mkSlaves) and
7359 (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)) and
7360 (MyUn[UnFocus].Master < 0) and (Tile and fDeadLands = 0);
7361 if (mox.Kind = mkFreight) and (Tile and fCity <> 0) and
7362 not Phrases2FallenBackToEnglish or
7363 (Server(sRemoveUnit - sExecute, me, UnFocus, nil^) = eUtilized) then
7364 begin
7365 mDisband.Visible := false;
7366 mUtilize.Visible := true;
7367 if mox.Kind = mkFreight then
7368 mUtilize.Caption := Phrases.Lookup('UTILIZE')
7369 else
7370 mUtilize.Caption := Phrases.Lookup('INTEGRATE')
7371 end
7372 else
7373 begin
7374 mDisband.Visible := true;
7375 mUtilize.Visible := false
7376 end;
7377 mGoOn.Visible := MyUn[UnFocus].Status and (usGoto or usWaiting)
7378 = usGoto or usWaiting;
7379 mHome.Visible := HaveCities;
7380 mRecover.Visible := (MyUn[UnFocus].Health < 100) and
7381 (Tile and fTerrain >= fGrass) and
7382 ((MyRO.Wonder[woGardens].EffectiveOwner = me) or
7383 (Tile and fTerrain <> fArctic) and (Tile and fTerrain <> fDesert)) and
7384 not((mox.Domain = dAir) and (Tile and fCity = 0) and
7385 (Tile and fTerImp <> tiBase));
7386 mStay.Visible := not((mox.Domain = dAir) and (Tile and fCity = 0) and
7387 (Tile and fTerImp <> tiBase));
7388 mCity.Visible := extended and (mox.Kind = mkSettler) or
7389 (Tile and fCity <> 0) and ((mox.Kind in [mkSettler, mkSlaves]) or
7390 (MyUn[UnFocus].Flags and unConscripts <> 0));
7391 mPillage.Visible := (Tile and (fRoad or fRR or fCanal or fTerImp) <> 0)
7392 and (MyUn[UnFocus].Master < 0) and (mox.Domain = dGround);
7393 mCancel.Visible := (MyUn[UnFocus].Job > jNone) or
7394 (MyUn[UnFocus].Status and (usRecover or usGoto) <> 0);
7395
7396 Test := Server(sLoadUnit - sExecute, me, UnFocus, nil^);
7397 mLoad.Visible := (Test >= rExecuted) or (Test = eNoTime_Load);
7398 mUnload.Visible := (MyUn[UnFocus].Master >= 0) or
7399 (MyUn[UnFocus].TroopLoad + MyUn[UnFocus].AirLoad > 0);
7400 mSelectTransport.Visible := Server(sSelectTransport - sExecute, me,
7401 UnFocus, nil^) >= rExecuted;
7402 end
7403 else { if Popup=TerrainPopup then }
7404 begin
7405 mox := @MyModel[MyUn[UnFocus].mix];
7406 Tile := MyMap[MyUn[UnFocus].Loc];
7407 extended := Tile and fCity = 0;
7408
7409 if (Tile and fRiver <> 0) and
7410 (MyRO.Tech[adBridgeBuilding] >= tsApplicable) then
7411 begin
7412 mRoad.Caption := Phrases.Lookup('BTN_BUILDBRIDGE');
7413 mRR.Caption := Phrases.Lookup('BTN_BUILDRRBRIDGE');
7414 end
7415 else
7416 begin
7417 mRoad.Caption := Phrases.Lookup('BTN_BUILDROAD');
7418 mRR.Caption := Phrases.Lookup('BTN_BUILDRR');
7419 end;
7420 if Tile and fTerrain = fForest then
7421 mClear.Caption := Phrases.Lookup('BTN_CLEAR')
7422 else if Tile and fTerrain = fDesert then
7423 mClear.Caption := Phrases.Lookup('BTN_UNDESERT')
7424 else
7425 mClear.Caption := Phrases.Lookup('BTN_DRAIN');
7426
7427 extended := extended and
7428 ((mox.Kind = mkSettler) or (mox.Kind = mkSlaves) and
7429 (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)) and
7430 (MyUn[UnFocus].Master < 0);
7431 if extended then
7432 begin
7433 mRoad.Visible := JobTest(UnFocus, jRoad,
7434 [eNoBridgeBuilding, eTreaty]);
7435 mRR.Visible := JobTest(UnFocus, jRR, [eNoBridgeBuilding, eTreaty]);
7436 mClear.Visible := JobTest(UnFocus, jClear, [eTreaty]);
7437 mIrrigation.Visible := JobTest(UnFocus, jIrr, [eTreaty]);
7438 mFarm.Visible := JobTest(UnFocus, jFarm, [eTreaty]);
7439 mAfforest.Visible := JobTest(UnFocus, jAfforest, [eTreaty]);
7440 mMine.Visible := JobTest(UnFocus, jMine, [eTreaty]);
7441 MTrans.Visible := JobTest(UnFocus, jTrans, [eTreaty]);
7442 mCanal.Visible := JobTest(UnFocus, jCanal, [eTreaty]);
7443 mFort.Visible := JobTest(UnFocus, jFort, [eTreaty]);
7444 mAirBase.Visible := JobTest(UnFocus, jBase, [eTreaty]);
7445 mPollution.Visible := JobTest(UnFocus, jPoll, [eTreaty]);
7446 mEnhance.Visible := (Tile and fDeadLands = 0) and
7447 (MyData.EnhancementJobs[MyMap[MyUn[UnFocus].Loc] and fTerrain, 0]
7448 <> jNone);
7449 end
7450 else
7451 begin
7452 for i := 0 to Popup.Items.Count - 1 do
7453 Popup.Items[i].Visible := false;
7454 end;
7455 end;
7456
7457 // set menu seperators
7458 LastSep := nil;
7459 NeedSep := false;
7460 for i := 0 to Popup.Items.Count - 1 do
7461 if Popup.Items[i].Caption = '-' then
7462 begin
7463 Popup.Items[i].Visible := NeedSep;
7464 if NeedSep then
7465 LastSep := Popup.Items[i];
7466 NeedSep := false
7467 end
7468 else if Popup.Items[i].Visible then
7469 NeedSep := true;
7470 if (LastSep <> nil) and not NeedSep then
7471 LastSep.Visible := false
7472 end;
7473
7474 procedure TMainScreen.PanelBtnClick(Sender: TObject);
7475 var
7476 Popup: TPopupMenu;
7477 begin
7478 if Sender = UnitBtn then
7479 Popup := UnitPopup
7480 else { if Sender=TerrainBtn then }
7481 Popup := TerrainPopup;
7482 InitPopup(Popup);
7483 if FullScreen then
7484 Popup.Popup(Left + TControl(Sender).Left, Top + TControl(Sender).Top)
7485 else
7486 Popup.Popup(Left + TControl(Sender).Left + 4, Top + TControl(Sender).Top
7487 + GetSystemMetrics(SM_CYCAPTION) + 4);
7488 end;
7489
7490 procedure TMainScreen.CityClosed(Activateuix: integer; StepFocus: boolean;
7491 SelectFocus: boolean);
7492 begin
7493 if supervising then
7494 begin
7495 SetTroopLoc(-1);
7496 PanelPaint
7497 end
7498 else
7499 begin
7500 if Activateuix >= 0 then
7501 begin
7502 SetUnFocus(Activateuix);
7503 SetTroopLoc(MyUn[Activateuix].Loc);
7504 if SelectFocus then
7505 FocusOnLoc(TroopLoc, flRepaintPanel)
7506 else
7507 PanelPaint
7508 end
7509 else if StepFocus then
7510 NextUnit(TroopLoc, true)
7511 else
7512 begin
7513 SetTroopLoc(-1);
7514 PanelPaint
7515 end
7516 end
7517 end;
7518
7519 procedure TMainScreen.Toggle(Sender: TObject);
7520 begin
7521 TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked
7522 end;
7523
7524 procedure TMainScreen.PanelBoxMouseMove(Sender: TObject; Shift: TShiftState;
7525 x, y: integer);
7526 var
7527 xCentre, yCentre: integer;
7528 begin
7529 if Tracking and (ssLeft in Shift) then
7530 begin
7531 if (x >= xMini + 2) and (y >= yMini + 2) and (x < xMini + 2 + 2 * G.lx)
7532 and (y < yMini + 2 + G.ly) then
7533 begin
7534 xCentre := (xwMini + (x - xMini - 2) div 2 + G.lx div 2 +
7535 MapWidth div (xxt * 4)) mod G.lx;
7536 yCentre := (y - yMini - 2);
7537 xw := (xCentre - MapWidth div (xxt * 4) + G.lx) mod G.lx;
7538 if ywmax <= 0 then
7539 yw := ywcenter
7540 else
7541 begin
7542 yw := (yCentre - MapHeight div (yyt * 2) + 1) and not 1;
7543 if yw < 0 then
7544 yw := 0
7545 else if yw > ywmax then
7546 yw := ywmax;
7547 end;
7548 BitBlt(Buffer.Canvas.Handle, 0, 0, G.lx * 2, G.ly, Mini.Canvas.Handle,
7549 0, 0, SRCCOPY);
7550 if ywmax <= 0 then
7551 Frame(Buffer.Canvas, x - xMini - 2 - MapWidth div (xxt * 2), 0,
7552 x - xMini - 2 + MapWidth div (xxt * 2) - 1, G.ly - 1,
7553 MainTexture.clMark, MainTexture.clMark)
7554 else
7555 Frame(Buffer.Canvas, x - xMini - 2 - MapWidth div (xxt * 2), yw,
7556 x - xMini - 2 + MapWidth div (xxt * 2) - 1,
7557 yw + MapHeight div yyt - 2, MainTexture.clMark,
7558 MainTexture.clMark);
7559 BitBlt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly,
7560 Buffer.Canvas.Handle, 0, 0, SRCCOPY);
7561 MainOffscreenPaint;
7562 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini +
7563 2, xMini + 2 + G.lx * 2, TopBarHeight + MapHeight - overlap + yMini
7564 + 2 + G.ly);
7565 Update;
7566 end
7567 end
7568 else
7569 Tracking := false
7570 end;
7571
7572 procedure TMainScreen.PanelBoxMouseUp(Sender: TObject; Button: TMouseButton;
7573 Shift: TShiftState; x, y: integer);
7574 begin
7575 if Tracking then
7576 begin
7577 Tracking := false;
7578 xwMini := xw;
7579 ywMini := yw;
7580 MiniPaint;
7581 PanelPaint;
7582 end
7583 end;
7584
7585 procedure TMainScreen.MapBoxMouseMove(Sender: TObject; Shift: TShiftState;
7586 x, y: integer);
7587 var
7588 MouseLoc: integer;
7589 begin
7590 xMouse := x;
7591 yMouse := y;
7592 if (ClientMode = cEditMap) and (ssLeft in Shift) and not Tracking then
7593 begin
7594 MouseLoc := LocationOfScreenPixel(x, y);
7595 if MouseLoc <> BrushLoc then
7596 MapBoxMouseDown(nil, mbLeft, Shift, x, y);
7597 end
7598 (* else if idle and (UnFocus>=0) then
7599 begin
7600 qx:=(xMouse*32+yMouse*66+16*66) div(32*66)-1;
7601 qy:=(yMouse*66-xMouse*32-16*66+2000*33*32) div(32*66)-999;
7602 MouseLoc:=(xw+(qx-qy+2048) div 2-1024+G.lx) mod G.lx+G.lx*(yw+qx+qy);
7603 ShowMoveHint(MouseLoc);
7604 end *)
7605 end;
7606
7607 procedure TMainScreen.mShowClick(Sender: TObject);
7608 begin
7609 TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
7610 SetMapOptions;
7611 MapValid := false;
7612 PaintAllMaps;
7613 end;
7614
7615 procedure TMainScreen.mNamesClick(Sender: TObject);
7616 var
7617 p1: integer;
7618 begin
7619 mNames.Checked := not mNames.Checked;
7620 GenerateNames := mNames.Checked;
7621 for p1 := 0 to nPl - 1 do
7622 if Tribe[p1] <> nil then
7623 if GenerateNames then
7624 Tribe[p1].NumberName := -1
7625 else
7626 Tribe[p1].NumberName := p1;
7627 MapValid := false;
7628 PaintAll;
7629 end;
7630
7631 function TMainScreen.IsPanelPixel(x, y: integer): boolean;
7632 begin
7633 result := (y >= TopBarHeight + MapHeight) or
7634 (y >= ClientHeight - PanelHeight) and
7635 ((x < xMidPanel) or (x >= xRightPanel))
7636 end;
7637
7638 procedure TMainScreen.FormMouseDown(Sender: TObject; Button: TMouseButton;
7639 Shift: TShiftState; x, y: integer);
7640 begin
7641 if idle then
7642 if (x < 40) and (y < 40) then
7643 begin
7644 if GameMode <> cMovie then
7645 begin
7646 InitPopup(GamePopup);
7647 if FullScreen then
7648 GamePopup.Popup(Left, Top + TopBarHeight - 1)
7649 else
7650 GamePopup.Popup(Left + 4, Top + GetSystemMetrics(SM_CYCAPTION) + 4
7651 + TopBarHeight - 1);
7652 end
7653 end
7654 else if IsPanelPixel(x, y) then
7655 PanelBoxMouseDown(Sender, Button, Shift, x,
7656 y - (ClientHeight - PanelHeight))
7657 else if (y >= TopBarHeight) and (x >= MapOffset) and
7658 (x < MapOffset + MapWidth) then
7659 MapBoxMouseDown(Sender, Button, Shift, x - MapOffset,
7660 y - TopBarHeight)
7661 end;
7662
7663 procedure TMainScreen.FormMouseMove(Sender: TObject; Shift: TShiftState;
7664 x, y: integer);
7665 begin
7666 if idle then
7667 if IsPanelPixel(x, y) then
7668 PanelBoxMouseMove(Sender, Shift, x, y - (ClientHeight - PanelHeight))
7669 else if (y >= TopBarHeight) and (x >= MapOffset) and
7670 (x < MapOffset + MapWidth) then
7671 MapBoxMouseMove(Sender, Shift, x - MapOffset, y - TopBarHeight);
7672 end;
7673
7674 procedure TMainScreen.FormMouseUp(Sender: TObject; Button: TMouseButton;
7675 Shift: TShiftState; x, y: integer);
7676 begin
7677 if idle then
7678 PanelBoxMouseUp(Sender, Button, Shift, x,
7679 y - (ClientHeight - PanelHeight));
7680 end;
7681
7682 procedure TMainScreen.FormPaint(Sender: TObject);
7683 begin
7684 MainOffscreenPaint;
7685 if (MapOffset > 0) or (MapOffset + MapWidth < ClientWidth) then
7686 with Canvas do
7687 begin // pillarbox, make left and right border black
7688 if me < 0 then
7689 Brush.Color := $000000
7690 else
7691 Brush.Color := EmptySpaceColor;
7692 if xMidPanel > MapOffset then
7693 FillRect(Rect(0, TopBarHeight, MapOffset, TopBarHeight + MapHeight
7694 - overlap))
7695 else
7696 begin
7697 FillRect(Rect(0, TopBarHeight, xMidPanel, TopBarHeight + MapHeight -
7698 overlap));
7699 FillRect(Rect(xMidPanel, TopBarHeight, MapOffset,
7700 TopBarHeight + MapHeight));
7701 end;
7702 if xRightPanel < MapOffset + MapWidth then
7703 FillRect(Rect(MapOffset + MapWidth, TopBarHeight, ClientWidth,
7704 TopBarHeight + MapHeight - overlap))
7705 else
7706 begin
7707 FillRect(Rect(MapOffset + MapWidth, TopBarHeight, xRightPanel,
7708 TopBarHeight + MapHeight));
7709 FillRect(Rect(xRightPanel, TopBarHeight, ClientWidth,
7710 TopBarHeight + MapHeight - overlap));
7711 end;
7712 Brush.Style := bsClear;
7713 end;
7714 BitBlt(Canvas.Handle, MapOffset, TopBarHeight, MapWidth,
7715 MapHeight - overlap, offscreen.Canvas.Handle, 0, 0, SRCCOPY);
7716 BitBlt(Canvas.Handle, 0, 0, ClientWidth, TopBarHeight,
7717 TopBar.Canvas.Handle, 0, 0, SRCCOPY);
7718 if xMidPanel > MapOffset then
7719 BitBlt(Canvas.Handle, xMidPanel, TopBarHeight + MapHeight - overlap,
7720 ClientWidth div 2 - xMidPanel, overlap, offscreen.Canvas.Handle,
7721 xMidPanel - MapOffset, MapHeight - overlap, SRCCOPY)
7722 else
7723 BitBlt(Canvas.Handle, MapOffset, TopBarHeight + MapHeight - overlap,
7724 ClientWidth div 2 - MapOffset, overlap, offscreen.Canvas.Handle, 0,
7725 MapHeight - overlap, SRCCOPY);
7726 if xRightPanel < MapOffset + MapWidth then
7727 BitBlt(Canvas.Handle, ClientWidth div 2, TopBarHeight + MapHeight -
7728 overlap, xRightPanel - ClientWidth div 2, overlap,
7729 offscreen.Canvas.Handle, ClientWidth div 2 - MapOffset,
7730 MapHeight - overlap, SRCCOPY)
7731 else
7732 BitBlt(Canvas.Handle, ClientWidth div 2, TopBarHeight + MapHeight -
7733 overlap, MapOffset + MapWidth - ClientWidth div 2, overlap,
7734 offscreen.Canvas.Handle, ClientWidth div 2 - MapOffset,
7735 MapHeight - overlap, SRCCOPY);
7736 BitBlt(Canvas.Handle, 0, TopBarHeight + MapHeight - overlap, xMidPanel,
7737 overlap, Panel.Canvas.Handle, 0, 0, SRCCOPY);
7738 BitBlt(Canvas.Handle, xRightPanel, TopBarHeight + MapHeight - overlap,
7739 Panel.width - xRightPanel, overlap, Panel.Canvas.Handle, xRightPanel,
7740 0, SRCCOPY);
7741 BitBlt(Canvas.Handle, 0, TopBarHeight + MapHeight, Panel.width,
7742 PanelHeight - overlap, Panel.Canvas.Handle, 0, overlap, SRCCOPY);
7743 if (pLogo >= 0) and (G.RO[pLogo] = nil) and (AILogo[pLogo] <> nil) then
7744 BitBlt(Canvas.Handle, xRightPanel + 10 - (16 + 64),
7745 ClientHeight - PanelHeight, 64, 64, AILogo[pLogo].Canvas.Handle, 0, 0,
7746 SRCCOPY);
7747 end;
7748
7749 procedure TMainScreen.RectInvalidate(Left, Top, Rigth, Bottom: integer);
7750 var
7751 r0: HRgn;
7752 begin
7753 r0 := CreateRectRgn(Left, Top, Rigth, Bottom);
7754 InvalidateRgn(Handle, r0, false);
7755 DeleteObject(r0);
7756 end;
7757
7758 procedure TMainScreen.SmartRectInvalidate(Left, Top, Rigth,
7759 Bottom: integer);
7760 var
7761 i: integer;
7762 r0, r1: HRgn;
7763 begin
7764 r0 := CreateRectRgn(Left, Top, Rigth, Bottom);
7765 for i := 0 to ControlCount - 1 do
7766 if not(Controls[i] is TArea) and Controls[i].Visible then
7767 begin
7768 with Controls[i].BoundsRect do
7769 r1 := CreateRectRgn(Left, Top, Right, Bottom);
7770 CombineRgn(r0, r0, r1, RGN_DIFF);
7771 DeleteObject(r1);
7772 end;
7773 InvalidateRgn(Handle, r0, false);
7774 DeleteObject(r0);
7775 end;
7776
7777 procedure TMainScreen.mRepClicked(Sender: TObject);
7778 begin
7779 with TMenuItem(Sender) do
7780 begin
7781 Checked := not Checked;
7782 if Checked then
7783 CityRepMask := CityRepMask or (1 shl (Tag shr 8))
7784 else
7785 CityRepMask := CityRepMask and not(1 shl (Tag shr 8))
7786 end
7787 end;
7788
7789 procedure TMainScreen.mLogClick(Sender: TObject);
7790 begin
7791 LogDlg.Show
7792 end;
7793
7794 procedure TMainScreen.FormShow(Sender: TObject);
7795 begin
7796 Timer1.Enabled := true
7797 end;
7798
7799 procedure TMainScreen.FormClose(Sender: TObject; var Action: TCloseAction);
7800 begin
7801 Timer1.Enabled := false
7802 end;
7803
7804 procedure TMainScreen.Radio(Sender: TObject);
7805 begin
7806 TMenuItem(Sender).Checked := true
7807 end;
7808
7809 procedure TMainScreen.mManipClick(Sender: TObject);
7810 var
7811 Flag: integer;
7812 begin
7813 with TMenuItem(Sender) do
7814 begin
7815 Flag := 1 shl (Tag shr 8);
7816 if Checked then
7817 Server(sClearTestFlag, 0, Flag, nil^)
7818 else
7819 begin
7820 Server(sSetTestFlag, 0, Flag, nil^);
7821 Play('CHEAT');
7822 end;
7823 if not supervising then
7824 begin
7825 if Flag = tfUncover then
7826 begin
7827 MapValid := false;
7828 PaintAllMaps;
7829 end
7830 else if Flag = tfAllTechs then
7831 TellNewModels
7832 end
7833 end
7834 end;
7835
7836 procedure TMainScreen.MapBtnClick(Sender: TObject);
7837 begin
7838 with TButtonC(Sender) do
7839 begin
7840 MapOptionChecked := MapOptionChecked xor (1 shl (Tag shr 8));
7841 SetMapOptions;
7842 ButtonIndex := MapOptionChecked shr (Tag shr 8) and 1 + 2
7843 end;
7844 if Sender = MapBtn0 then
7845 begin
7846 MiniPaint;
7847 PanelPaint
7848 end // update mini map only
7849 else
7850 begin
7851 MapValid := false;
7852 PaintAllMaps;
7853 end; // update main map
7854 end;
7855
7856 procedure TMainScreen.GrWallBtnDownChanged(Sender: TObject);
7857 begin
7858 if TButtonBase(Sender).Down then
7859 begin
7860 MapOptionChecked := MapOptionChecked or (1 shl moGreatWall);
7861 TButtonBase(Sender).Hint := '';
7862 end
7863 else
7864 begin
7865 MapOptionChecked := MapOptionChecked and not(1 shl moGreatWall);
7866 TButtonBase(Sender).Hint := Phrases.Lookup('CONTROLS',
7867 -1 + TButtonBase(Sender).Tag and $FF);
7868 end;
7869 SetMapOptions;
7870 MapValid := false;
7871 PaintAllMaps;
7872 end;
7873
7874 procedure TMainScreen.BareBtnDownChanged(Sender: TObject);
7875 begin
7876 if TButtonBase(Sender).Down then
7877 begin
7878 MapOptionChecked := MapOptionChecked or (1 shl moBareTerrain);
7879 TButtonBase(Sender).Hint := '';
7880 end
7881 else
7882 begin
7883 MapOptionChecked := MapOptionChecked and not(1 shl moBareTerrain);
7884 TButtonBase(Sender).Hint := Phrases.Lookup('CONTROLS',
7885 -1 + TButtonBase(Sender).Tag and $FF);
7886 end;
7887 SetMapOptions;
7888 MapValid := false;
7889 PaintAllMaps;
7890 end;
7891
7892 procedure TMainScreen.FormKeyUp(Sender: TObject; var Key: word;
7893 Shift: TShiftState);
7894 begin
7895 if idle and (Key = VK_APPS) then
7896 begin
7897 InitPopup(GamePopup);
7898 if FullScreen then
7899 GamePopup.Popup(Left, Top + TopBarHeight - 1)
7900 else
7901 GamePopup.Popup(Left + 4, Top + GetSystemMetrics(SM_CYCAPTION) + 4 +
7902 TopBarHeight - 1);
7903 exit
7904 end // windows menu button calls game menu
7905 end;
7906
7907 procedure TMainScreen.CreateUnitClick(Sender: TObject);
7908 var
7909 p1, mix: integer;
7910 begin
7911 p1 := TComponent(Sender).Tag shr 16;
7912 mix := TComponent(Sender).Tag and $FFFF;
7913 if Server(sCreateUnit + p1 shl 4, me, mix, EditLoc) >= rExecuted then
7914 PaintLoc(EditLoc);
7915 end;
7916
7917 procedure TMainScreen.mSoundOffClick(Sender: TObject);
7918 begin
7919 SoundMode := smOff;
7920 end;
7921
7922 procedure TMainScreen.mSoundOnClick(Sender: TObject);
7923 begin
7924 SoundMode := smOn;
7925 end;
7926
7927 procedure TMainScreen.mSoundOnAltClick(Sender: TObject);
7928 begin
7929 SoundMode := smOnAlt;
7930 end;
7931
7932 { procedure TMainScreen.AdviceBtnClick;
7933 var
7934 OldAdviceLoc: integer;
7935 begin
7936 DestinationMarkON:=false;
7937 PaintDestination;
7938 AdvisorDlg.GiveStrategyAdvice;
7939 OldAdviceLoc:=MainMap.AdviceLoc;
7940 MainMap.AdviceLoc:=-1;
7941 PaintLoc(OldAdviceLoc);
7942 end; }
7943
7944 { procedure TMainScreen.SetAdviceLoc(Loc: integer; AvoidRect: TRect);
7945 var
7946 OldAdviceLoc,x,y: integer;
7947 begin
7948 if Loc<>MainMap.AdviceLoc then
7949 begin
7950 if Loc>=0 then
7951 begin // center
7952 y:=Loc div G.lx;
7953 x:=(Loc+G.lx - AvoidRect.Right div (2*66)) mod G.lx;
7954 Centre(y*G.lx+x);
7955 PaintAllMaps;
7956 end;
7957 OldAdviceLoc:=MainMap.AdviceLoc;
7958 MainMap.AdviceLoc:=Loc;
7959 PaintLoc(OldAdviceLoc);
7960 PaintLoc(MainMap.AdviceLoc);
7961 end;
7962 end; }
7963
7964 procedure TMainScreen.UnitInfoBtnClick(Sender: TObject);
7965 begin
7966 if UnFocus >= 0 then
7967 UnitStatDlg.ShowNewContent_OwnModel(wmPersistent, MyUn[UnFocus].mix)
7968 end;
7969
7970 procedure TMainScreen.ViewpointClick(Sender: TObject);
7971 begin
7972 SetViewpoint(TMenuItem(Sender).Tag);
7973 end;
7974
7975 procedure TMainScreen.DebugMapClick(Sender: TObject);
7976 begin
7977 SetDebugMap(TMenuItem(Sender).Tag);
7978 end;
7979
7980 procedure TMainScreen.mSmallTilesClick(Sender: TObject);
7981 begin
7982 SetTileSize(33, 16);
7983 end;
7984
7985 procedure TMainScreen.mNormalTilesClick(Sender: TObject);
7986 begin
7987 SetTileSize(48, 24);
7988 end;
7989
7990 procedure TMainScreen.SetTileSize(x, y: integer);
7991 var
7992 i, CenterLoc: integer;
7993 begin
7994 CenterLoc := (xw + MapWidth div (xxt * 4)) mod G.lx +
7995 (yw + MapHeight div (yyt * 2)) * G.lx;
7996 IsoEngine.ApplyTileSize(x, y);
7997 FormResize(nil);
7998 Centre(CenterLoc);
7999 PaintAllMaps;
8000 for i := 0 to Screen.FormCount - 1 do
8001 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg)
8002 then
8003 TBufferedDrawDlg(Screen.Forms[i]).SmartUpdateContent(false);
8004 end;
8005
8006 procedure TMainScreen.SaveSettings;
8007 var
8008 i, j: integer;
8009 Reg: TRegistry;
8010 begin
8011 OptionChecked := OptionChecked and soExtraMask;
8012 for i := 0 to ComponentCount - 1 do
8013 if Components[i] is TMenuItem then
8014 for j := 0 to nSaveOption - 1 do
8015 if TMenuItem(Components[i]).Checked and
8016 (TMenuItem(Components[i]).Tag = SaveOption[j]) then
8017 inc(OptionChecked, 1 shl j);
8018
8019 Reg := TRegistry.Create;
8020 Reg.OpenKey('SOFTWARE\cevo\RegVer9', true);
8021 Reg.WriteInteger('TileWidth', xxt * 2);
8022 Reg.WriteInteger('TileHeight', yyt * 2);
8023 Reg.WriteInteger('OptionChecked', OptionChecked);
8024 Reg.WriteInteger('MapOptionChecked', MapOptionChecked);
8025 Reg.WriteInteger('CityReport', integer(CityRepMask));
8026 Reg.closekey;
8027 Reg.free;
8028 end;
8029
8030 procedure TMainScreen.MovieSpeedBtnClick(Sender: TObject);
8031 begin
8032 MovieSpeed := TButtonB(Sender).Tag shr 8;
8033 CheckMovieSpeedBtnState;
8034 end;
8035
8036initialization
8037
8038QueryPerformanceFrequency(PerfFreq);
8039
8040end.
Note: See TracBrowser for help on using the repository browser.