source: tags/1.3.0/LocalPlayer/Term.pas

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