source: branches/highdpi/LocalPlayer/IsoEngine.pas

Last change on this file was 467, checked in by chronos, 5 months ago
  • Modified: DpiControls unit split into multiple units according to their LCL names.
File size: 53.5 KB
Line 
1{$INCLUDE Switches.inc}
2unit IsoEngine;
3
4interface
5
6uses
7 Dpi.Graphics, Dpi.Common,
8 Protocol, ClientTools, ScreenTools, Tribes, LCLIntf, LCLType, SysUtils,
9 Classes, Graphics, PixelPointer, GraphicSet;
10
11const
12 TerrainIconLines = 21;
13 TerrainIconCols = 9;
14
15type
16 TInitEnemyModelEvent = function(emix: Integer): Boolean;
17 TTileSize = (tsSmall, tsMedium, tsBig);
18
19 TTerrainSpriteSize = array of TRect;
20
21 { TCitiesPictures }
22
23 TCitiesPictures = class
24 Pictures: array [2..3, 0..3] of TCityPicture;
25 procedure Prepare(HGrCities: TGraphicSet; xxt, yyt: Integer);
26 end;
27
28 { TIsoMap }
29
30 TIsoMap = class
31 private
32 FTileSize: TTileSize;
33 const
34 Dirx: array [0..7] of Integer = (1, 2, 1, 0, -1, -2, -1, 0);
35 Diry: array [0..7] of Integer = (-1, 0, 1, 2, 1, 0, -1, -2);
36 procedure CityGrid(xm, ym: Integer; CityAllowClick: Boolean);
37 function IsShoreTile(Loc: Integer): Boolean;
38 procedure MakeDark(Line: PPixelPointer; Length: Integer);
39 procedure SetTileSize(AValue: TTileSize);
40 procedure ShadeOutside(x0, y0, Width, Height, xm, ym: Integer);
41 protected
42 FOutput: TDpiBitmap;
43 FLeft: Integer;
44 FTop: Integer;
45 FRight: Integer;
46 FBottom: Integer;
47 RealTop: Integer;
48 RealBottom: Integer;
49 AttLoc: Integer;
50 DefLoc: Integer;
51 DefHealth: Integer;
52 FAdviceLoc: Integer;
53 DataCanvas: TDpiCanvas;
54 MaskCanvas: TDpiCanvas;
55 LandPatch: TDpiBitmap;
56 OceanPatch: TDpiBitmap;
57 Borders: TDpiBitmap;
58 BordersOK: PInteger;
59 CitiesPictures: TCitiesPictures;
60 ShowLoc: Boolean;
61 ShowCityNames: Boolean;
62 ShowObjects: Boolean;
63 ShowBorder: Boolean;
64 ShowMyBorder: Boolean;
65 ShowGrWall: Boolean;
66 ShowDebug: Boolean;
67 FoW: Boolean;
68 function Connection4(Loc, Mask, Value: Integer): Integer;
69 function Connection8(Loc, Mask: Integer): Integer;
70 function OceanConnection(Loc: Integer): Integer;
71 procedure PaintShore(X, Y, Loc: Integer);
72 procedure PaintTileExtraTerrain(X, Y, Loc: Integer);
73 procedure PaintTileObjects(X, Y, Loc, CityLoc, CityOwner: Integer;
74 UseBlink: Boolean);
75 procedure PaintGrid(X, Y, nx, ny: Integer);
76 procedure FillRect(X, Y, Width, Height, Color: Integer);
77 procedure Textout(X, Y, Color: Integer; const S: string);
78 procedure Sprite(HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer);
79 procedure TSprite(xDst, yDst, grix: Integer; PureBlack: Boolean = False);
80 procedure ApplyTileSize(ATileSize: TTileSize);
81 public
82 xxt: Integer; // half of tile size x/y
83 yyt: Integer; // half of tile size x/y
84 TSpriteSize: TTerrainSpriteSize;
85 HGrTerrain: TGraphicSet;
86 HGrCities: TGraphicSet;
87 pDebugMap: Integer; // -1 for off
88 constructor Create;
89 destructor Destroy; override;
90 procedure Reset;
91 procedure SetOutput(Output: TDpiBitmap);
92 procedure SetPaintBounds(Left, Top, Right, Bottom: Integer);
93 procedure Paint(X, Y, Loc, nx, ny, CityLoc, CityOwner: Integer;
94 UseBlink: Boolean = False; CityAllowClick: Boolean = False);
95 procedure PaintUnit(X, Y: Integer; const UnitInfo: TUnitInfo;
96 Status: Integer);
97 procedure PaintCity(X, Y: Integer; const CityInfo: TCityInfo;
98 accessory: Boolean = True);
99 procedure BitBltBitmap(Src: TDpiBitmap; X, Y, Width, Height, xSrc, ySrc,
100 Rop: Integer);
101 procedure AttackBegin(const ShowMove: TShowMove);
102 procedure AttackEffect(const ShowMove: TShowMove);
103 procedure AttackEnd;
104 procedure ReduceTerrainIconsSize;
105 property AdviceLoc: Integer read FAdviceLoc write FAdviceLoc;
106 property TileSize: TTileSize read FTileSize write SetTileSize;
107 end;
108
109 { TIsoMapCache }
110
111 TIsoMapCache = class
112 LandPatch: TDpiBitmap;
113 OceanPatch: TDpiBitmap;
114 Borders: TDpiBitmap;
115 BordersOk: Integer;
116 TSpriteSize: TTerrainSpriteSize;
117 HGrTerrain: TGraphicSet;
118 HGrCities: TGraphicSet;
119 CitiesPictures: TCitiesPictures;
120 procedure AssignToIsoMap(IsoMap: TIsoMap);
121 constructor Create;
122 destructor Destroy; override;
123 end;
124
125const
126 DefaultTileSize: TTileSize = tsMedium;
127 TileSizes: array [TTileSize] of TPoint = ((X: 33; Y: 16), (X: 48; Y: 24),
128 (X: 72; Y: 36));
129
130function IsJungle(Y: Integer): Boolean;
131procedure Init(InitEnemyModelHandler: TInitEnemyModelEvent);
132
133var
134 MapOptions: TMapOptions;
135
136
137implementation
138
139uses
140 Term;
141
142const
143 ShoreDither = fGrass;
144
145 // sprites indexes
146 spRow2 = 2 * TerrainIconCols + 6;
147 spBlink1 = 1 * TerrainIconCols + 8;
148 spBlink2 = 2 * TerrainIconCols + 8;
149 spPrefStartPos = 1 * TerrainIconCols;
150 spStartPos = 2 * TerrainIconCols;
151 spPlain = 2 * TerrainIconCols + 7;
152 spForest = 3 * TerrainIconCols;
153 spRoad = 9 * TerrainIconCols;
154 spRailRoad = 10 * TerrainIconCols;
155 spCanal = 11 * TerrainIconCols;
156 spIrrigation = 12 * TerrainIconCols;
157 spFarmLand = 12 * TerrainIconCols + 1;
158 spMine = 12 * TerrainIconCols + 2;
159 spFortFront = 12 * TerrainIconCols + 3;
160 spBase = 12 * TerrainIconCols + 4;
161 spSpacePort = 12 * TerrainIconCols + 5;
162 spPollution = 12 * TerrainIconCols + 6;
163 spFortBack = 12 * TerrainIconCols + 7;
164 spMinerals = 12 * TerrainIconCols + 8;
165 spRiver = 13 * TerrainIconCols;
166 spRiverMouths = 15 * TerrainIconCols;
167 spGrid = 15 * TerrainIconCols + 6;
168 spJungle = 18 * TerrainIconCols;
169 spCanalMouths = 20 * TerrainIconCols;
170
171var
172 OnInitEnemyModel: TInitEnemyModelEvent;
173 DebugMap: ^TTileList;
174 IsoMapCache: array[TTileSize] of TIsoMapCache;
175
176function IsJungle(Y: Integer): Boolean;
177begin
178 Result := (Y > (G.ly - 2) div 4) and (G.ly - 1 - Y > (G.ly - 2) div 4)
179end;
180
181procedure Init(InitEnemyModelHandler: TInitEnemyModelEvent);
182begin
183 OnInitEnemyModel := InitEnemyModelHandler;
184end;
185
186{ TCitiesPictures }
187
188procedure TCitiesPictures.Prepare(HGrCities: TGraphicSet; xxt, yyt: Integer);
189var
190 Age: Integer;
191 Size: Integer;
192begin
193 // prepare age 2+3 cities
194 for age := 2 to 3 do
195 for size := 0 to 3 do
196 with Pictures[Age, Size] do
197 FindPosition(HGrCities, Size * (xxt * 2 + 1), (Age - 2) * (yyt * 3 + 1),
198 xxt * 2 - 1, yyt * 3 - 1, $00FFFF, xShield, yShield);
199end;
200
201{ TIsoMapCache }
202
203procedure TIsoMapCache.AssignToIsoMap(IsoMap: TIsoMap);
204begin
205 IsoMap.HGrTerrain := HGrTerrain;
206 IsoMap.HGrCities := HGrCities;
207 IsoMap.Borders := Borders;
208 IsoMap.BordersOK := @BordersOk;
209 IsoMap.LandPatch := LandPatch;
210 IsoMap.OceanPatch := OceanPatch;
211 IsoMap.TSpriteSize := TSpriteSize;
212 IsoMap.CitiesPictures := CitiesPictures;
213end;
214
215constructor TIsoMapCache.Create;
216begin
217 LandPatch := TDpiBitmap.Create;
218 LandPatch.PixelFormat := pf24bit;
219 OceanPatch := TDpiBitmap.Create;
220 OceanPatch.PixelFormat := pf24bit;
221 Borders := TDpiBitmap.Create;
222 Borders.PixelFormat := pf24bit;
223 HGrTerrain := nil;
224 HGrCities := nil;
225 SetLength(TSpriteSize, TerrainIconLines * TerrainIconCols);
226 CitiesPictures := TCitiesPictures.Create;
227end;
228
229destructor TIsoMapCache.Destroy;
230begin
231 FreeAndNil(CitiesPictures);
232 FreeAndNil(LandPatch);
233 FreeAndNil(OceanPatch);
234 FreeAndNil(Borders);
235 inherited;
236end;
237
238procedure TIsoMap.ReduceTerrainIconsSize;
239var
240 MaskLine: array of TPixelPointer;
241 Mask24: TDpiBitmap;
242 xSrc: Integer;
243 ySrc: Integer;
244 I: Integer;
245 X: Integer;
246 Y: Integer;
247 Border: Boolean;
248begin
249 SetLength(MaskLine, yyt * 3);
250
251 // reduce size of terrain icons
252 Mask24 := TDpiBitmap.Create;
253 Mask24.Assign(HGrTerrain.Mask);
254 Mask24.PixelFormat := pf24bit;
255 Mask24.BeginUpdate;
256 for ySrc := 0 to TerrainIconLines - 1 do begin
257 for I := 0 to yyt * 3 - 1 do
258 MaskLine[I] := TPixelPointer.Create(Mask24, ScaleToNative(0),
259 ScaleToNative(1 + ySrc * (yyt * 3 + 1) + I));
260 for xSrc := 0 to TerrainIconCols - 1 do begin
261 I := ySrc * 9 + xSrc;
262 TSpriteSize[I].Left := 0;
263 repeat
264 Border := True;
265 for Y := 0 to yyt * 3 - 1 do begin
266 MaskLine[Y].SetX(ScaleToNative(1 + xSrc * (xxt * 2 + 1) + TSpriteSize[I].Left));
267 if MaskLine[Y].Pixel^.B = 0 then Border := False;
268 end;
269 if Border then Inc(TSpriteSize[I].Left);
270 until not Border or (TSpriteSize[I].Left = xxt * 2 - 1);
271 TSpriteSize[I].Top := 0;
272 repeat
273 Border := True;
274 for X := 0 to xxt * 2 - 1 do begin
275 MaskLine[TSpriteSize[I].Top].SetX(ScaleToNative(1 + xSrc * (xxt * 2 + 1) + X));
276 if MaskLine[TSpriteSize[I].Top].Pixel^.B = 0 then Border := False;
277 end;
278 if Border then Inc(TSpriteSize[I].Top);
279 until not Border or (TSpriteSize[I].Top = yyt * 3 - 1);
280 TSpriteSize[I].Right := xxt * 2;
281 repeat
282 Border := True;
283 for Y := 0 to yyt * 3 - 1 do begin
284 MaskLine[Y].SetX(ScaleToNative(xSrc * (xxt * 2 + 1) + TSpriteSize[I].Right));
285 if MaskLine[Y].Pixel^.B = 0 then Border := False;
286 end;
287 if Border then Dec(TSpriteSize[I].Right);
288 until not Border or (TSpriteSize[I].Right = TSpriteSize[I].Left);
289 TSpriteSize[I].Bottom := yyt * 3;
290 repeat
291 Border := True;
292 for X := 0 to xxt * 2 - 1 do begin
293 MaskLine[TSpriteSize[I].Bottom - 1].SetX(ScaleToNative(1 + xSrc * (xxt * 2 + 1) + X));
294 if MaskLine[TSpriteSize[I].Bottom - 1].Pixel^.B = 0 then Border := False;
295 end;
296 if Border then Dec(TSpriteSize[I].Bottom);
297 until not Border or (TSpriteSize[I].Bottom = TSpriteSize[I].Top);
298 end;
299 end;
300 Mask24.EndUpdate;
301 FreeAndNil(Mask24);
302end;
303
304procedure TIsoMap.ApplyTileSize(ATileSize: TTileSize);
305var
306 X: Integer;
307 Y: Integer;
308 xSrc: Integer;
309 ySrc: Integer;
310 LandMore: TDpiBitmap;
311 OceanMore: TDpiBitmap;
312 DitherMask: TDpiBitmap;
313 FileName: string;
314begin
315 FTileSize := ATileSize;
316 xxt := TileSizes[ATileSize].X;
317 yyt := TileSizes[ATileSize].Y;
318
319 if Assigned(IsoMapCache[ATileSize]) then begin
320 IsoMapCache[ATileSize].AssignToIsoMap(Self);
321 Exit;
322 end;
323 IsoMapCache[ATileSize] := TIsoMapCache.Create;
324
325 FileName := Format('Terrain%dx%d.png', [xxt * 2, yyt * 2]);
326 IsoMapCache[ATileSize].HGrTerrain := LoadGraphicSet(FileName);
327 if not Assigned(IsoMapCache[ATileSize].HGrTerrain) then
328 raise Exception.Create(FileName + ' not found.');
329
330 FileName := Format('Cities%dx%d.png', [xxt * 2, yyt * 2]);
331 IsoMapCache[ATileSize].HGrCities := LoadGraphicSet(FileName);
332 if not Assigned(IsoMapCache[ATileSize].HGrCities) then
333 raise Exception.Create(FileName + ' not found.');
334
335 IsoMapCache[ATileSize].AssignToIsoMap(Self);
336
337 CitiesPictures.Prepare(HGrCities, xxt, yyt);
338
339 { prepare dithered ground tiles }
340 LandPatch.Canvas.Brush.Color := 0;
341 LandPatch.SetSize(xxt * 18, yyt * 9);
342 LandPatch.Canvas.FillRect(0, 0, LandPatch.Width, LandPatch.Height);
343 OceanPatch.Canvas.Brush.Color := 0;
344 OceanPatch.SetSize(xxt * 8, yyt * 4);
345 OceanPatch.Canvas.FillRect(0, 0, OceanPatch.Width, OceanPatch.Height);
346 LandMore := TDpiBitmap.Create;
347 LandMore.PixelFormat := pf24bit;
348 LandMore.Canvas.Brush.Color := 0;
349 LandMore.SetSize(xxt * 18, yyt * 9);
350 LandMore.Canvas.FillRect(0, 0, LandMore.Width, LandMore.Height);
351 OceanMore := TDpiBitmap.Create;
352 OceanMore.PixelFormat := pf24bit;
353 OceanMore.Canvas.Brush.Color := 0;
354 OceanMore.SetSize(xxt * 8, yyt * 4);
355 OceanMore.Canvas.FillRect(0, 0, OceanMore.Width, OceanMore.Height);
356 DitherMask := TDpiBitmap.Create;
357 DitherMask.PixelFormat := pf24bit;
358 DitherMask.SetSize(xxt * 2, yyt * 2);
359 DitherMask.Canvas.FillRect(0, 0, DitherMask.Width, DitherMask.Height);
360 DpiBitBltCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt * 2,
361 HGrTerrain.Mask.Canvas, 1 + 7 * (xxt * 2 + 1),
362 1 + yyt + 15 * (yyt * 3 + 1), SRCAND);
363
364 for X := -1 to 6 do begin
365 if X = -1 then begin
366 xSrc := ShoreDither * (xxt * 2 + 1) + 1;
367 ySrc := 1 + yyt;
368 end
369 else if X = 6 then begin
370 xSrc := 1 + (xxt * 2 + 1) * 2;
371 ySrc := 1 + yyt + (yyt * 3 + 1) * 2;
372 end else begin
373 xSrc := (X + 2) * (xxt * 2 + 1) + 1;
374 ySrc := 1 + yyt;
375 end;
376 for Y := -1 to 6 do
377 DpiBitBltCanvas(LandPatch.Canvas, (X + 2) * (xxt * 2), (Y + 2) * yyt,
378 xxt * 2, yyt, HGrTerrain.Data.Canvas, xSrc, ySrc);
379 for Y := -2 to 6 do
380 DpiBitBltCanvas(LandPatch.Canvas, (X + 2) * (xxt * 2), (Y + 2) * yyt, xxt,
381 yyt, HGrTerrain.Data.Canvas, xSrc + xxt, ySrc + yyt,
382 SRCPAINT);
383 for Y := -2 to 6 do
384 DpiBitBltCanvas(LandPatch.Canvas, (X + 2) * (xxt * 2) + xxt, (Y + 2) * yyt,
385 xxt, yyt, HGrTerrain.Data.Canvas, xSrc, ySrc + yyt,
386 SRCPAINT);
387 for Y := -2 to 6 do
388 DpiBitBltCanvas(LandPatch.Canvas, (X + 2) * (xxt * 2), (Y + 2) * yyt, xxt,
389 yyt, DitherMask.Canvas, xxt, yyt, SRCAND);
390 for Y := -2 to 6 do
391 DpiBitBltCanvas(LandPatch.Canvas, (X + 2) * (xxt * 2) + xxt, (Y + 2) * yyt,
392 xxt, yyt, DitherMask.Canvas, 0, yyt, SRCAND);
393 end;
394
395 for Y := -1 to 6 do begin
396 if Y = -1 then begin
397 xSrc := ShoreDither * (xxt * 2 + 1) + 1;
398 ySrc := 1 + yyt;
399 end
400 else if Y = 6 then begin
401 xSrc := 1 + 2 * (xxt * 2 + 1);
402 ySrc := 1 + yyt + 2 * (yyt * 3 + 1);
403 end else begin
404 xSrc := (Y + 2) * (xxt * 2 + 1) + 1;
405 ySrc := 1 + yyt;
406 end;
407 for X := -2 to 6 do
408 DpiBitBltCanvas(LandMore.Canvas, (X + 2) * (xxt * 2), (Y + 2) * yyt,
409 xxt * 2, yyt, HGrTerrain.Data.Canvas, xSrc, ySrc);
410 DpiBitBltCanvas(LandMore.Canvas, xxt * 2, (Y + 2) * yyt, xxt, yyt,
411 HGrTerrain.Data.Canvas, xSrc + xxt, ySrc + yyt, SRCPAINT);
412 for X := 0 to 7 do
413 DpiBitBltCanvas(LandMore.Canvas, (X + 2) * (xxt * 2) - xxt, (Y + 2) * yyt,
414 xxt * 2, yyt, HGrTerrain.Data.Canvas, xSrc, ySrc + yyt,
415 SRCPAINT);
416 for X := -2 to 6 do
417 DpiBitBltCanvas(LandMore.Canvas, (X + 2) * (xxt * 2), (Y + 2) * yyt,
418 xxt * 2, yyt, DitherMask.Canvas, 0, 0, SRCAND);
419 end;
420
421 for X := 0 to 3 do begin
422 for Y := 0 to 3 do begin
423 if (X = 1) and (Y = 1) then xSrc := 1
424 else
425 xSrc := (X mod 2) * (xxt * 2 + 1) + 1;
426 ySrc := 1 + yyt;
427 if (X >= 1) = (Y >= 2) then
428 DpiBitBltCanvas(OceanPatch.Canvas, X * (xxt * 2), Y * yyt, xxt * 2, yyt,
429 HGrTerrain.Data.Canvas, xSrc, ySrc);
430 if (X >= 1) and ((Y < 2) or (X >= 2)) then
431 begin
432 DpiBitBltCanvas(OceanPatch.Canvas, X * (xxt * 2), Y * yyt, xxt, yyt,
433 HGrTerrain.Data.Canvas, xSrc + xxt, ySrc + yyt,
434 SRCPAINT);
435 DpiBitBltCanvas(OceanPatch.Canvas, X * (xxt * 2) + xxt, Y * yyt, xxt, yyt,
436 HGrTerrain.Data.Canvas, xSrc, ySrc + yyt, SRCPAINT);
437 end;
438 DpiBitBltCanvas(OceanPatch.Canvas, X * (xxt * 2), Y * yyt, xxt, yyt,
439 DitherMask.Canvas, xxt, yyt, SRCAND);
440 DpiBitBltCanvas(OceanPatch.Canvas, X * (xxt * 2) + xxt, Y * yyt, xxt, yyt,
441 DitherMask.Canvas, 0, yyt, SRCAND);
442 end;
443 end;
444
445 for Y := 0 to 3 do begin
446 for X := 0 to 3 do begin
447 if (X = 1) and (Y = 1) then xSrc := 1
448 else
449 xSrc := (Y mod 2) * (xxt * 2 + 1) + 1;
450 ySrc := 1 + yyt;
451 if (X < 1) or (Y >= 2) then
452 DpiBitBltCanvas(OceanMore.Canvas, X * (xxt * 2), Y * yyt, xxt * 2, yyt,
453 HGrTerrain.Data.Canvas, xSrc, ySrc);
454 if (X = 1) and (Y < 2) or (X >= 2) and (Y >= 1) then
455 begin
456 DpiBitBltCanvas(OceanMore.Canvas, X * (xxt * 2), Y * yyt, xxt, yyt,
457 HGrTerrain.Data.Canvas, xSrc + xxt, ySrc + yyt,
458 SRCPAINT);
459 DpiBitBltCanvas(OceanMore.Canvas, X * (xxt * 2) + xxt, Y * yyt, xxt, yyt,
460 HGrTerrain.Data.Canvas, xSrc, ySrc + yyt, SRCPAINT);
461 end;
462 DpiBitBltCanvas(OceanMore.Canvas, X * (xxt * 2), Y * yyt, xxt * 2, yyt,
463 DitherMask.Canvas, 0, 0, SRCAND);
464 end;
465 end;
466
467 DpiBitBltCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt * 2,
468 DitherMask.Canvas, 0, 0, DSTINVERT); { invert dither mask }
469 DpiBitBltCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt * 2,
470 HGrTerrain.Mask.Canvas, 1, 1 + yyt, SRCPAINT);
471
472 for X := -1 to 6 do
473 for Y := -2 to 6 do
474 DpiBitBltCanvas(LandPatch.Canvas, (X + 2) * (xxt * 2), (Y + 2) * yyt,
475 xxt * 2, yyt, DitherMask.Canvas, 0, 0, SRCAND);
476
477 for Y := -1 to 6 do
478 for X := -2 to 7 do
479 DpiBitBltCanvas(LandMore.Canvas, (X + 2) * (xxt * 2) - xxt, (Y + 2) * yyt,
480 xxt * 2, yyt, DitherMask.Canvas, 0, yyt, SRCAND);
481
482 DpiBitBltCanvas(LandPatch.Canvas, 0, 0, (xxt * 2) * 9, yyt * 9,
483 LandMore.Canvas, 0, 0, SRCPAINT);
484
485 for X := 0 to 3 do
486 for Y := 0 to 3 do
487 DpiBitBltCanvas(OceanPatch.Canvas, X * (xxt * 2), Y * yyt, xxt * 2, yyt,
488 DitherMask.Canvas, 0, 0, SRCAND);
489
490 for Y := 0 to 3 do
491 for X := 0 to 4 do
492 DpiBitBltCanvas(OceanMore.Canvas, X * (xxt * 2) - xxt, Y * yyt, xxt * 2,
493 yyt, DitherMask.Canvas, 0, yyt, SRCAND);
494
495 DpiBitBltCanvas(OceanPatch.Canvas, 0, 0, (xxt * 2) * 4, yyt * 4,
496 OceanMore.Canvas, 0, 0, SRCPAINT);
497
498 with DitherMask.Canvas do begin
499 Brush.Color := $FFFFFF;
500 FillRect(Rect(0, 0, xxt * 2, yyt));
501 end;
502 DpiBitBltCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt,
503 HGrTerrain.Mask.Canvas, 1, 1 + yyt);
504
505 for X := 0 to 6 do
506 DpiBitBltCanvas(LandPatch.Canvas, (X + 2) * (xxt * 2), yyt, xxt * 2, yyt,
507 DitherMask.Canvas, 0, 0, SRCAND);
508 DpiBitBltCanvas(DitherMask.Canvas, 0, 0, xxt * 2, yyt, DitherMask.Canvas,
509 0, 0, DSTINVERT);
510
511 for Y := 0 to 6 do
512 DpiBitBltCanvas(LandPatch.Canvas, xxt * 2, (Y + 2) * yyt, xxt * 2, yyt,
513 DitherMask.Canvas, 0, 0, SRCAND);
514
515 FreeAndNil(LandMore);
516 FreeAndNil(OceanMore);
517 FreeAndNil(DitherMask);
518
519 ReduceTerrainIconsSize;
520
521 Borders.SetSize(xxt * 2, (yyt * 2) * nPl);
522 Borders.Canvas.FillRect(0, 0, Borders.Width, Borders.Height);
523 BordersOK^ := 0;
524end;
525
526procedure TIsoMap.Reset;
527begin
528 BordersOK^ := 0;
529end;
530
531constructor TIsoMap.Create;
532begin
533 inherited;
534 FLeft := 0;
535 FTop := 0;
536 FRight := 0;
537 FBottom := 0;
538 AttLoc := -1;
539 DefLoc := -1;
540 FAdviceLoc := -1;
541 TileSize := DefaultTileSize;
542end;
543
544destructor TIsoMap.Destroy;
545begin
546 inherited;
547end;
548
549procedure TIsoMap.SetOutput(Output: TDpiBitmap);
550begin
551 FOutput := Output;
552 FLeft := 0;
553 FTop := 0;
554 FRight := FOutput.Width;
555 FBottom := FOutput.Height;
556end;
557
558procedure TIsoMap.SetPaintBounds(Left, Top, Right, Bottom: Integer);
559begin
560 FLeft := Left;
561 FTop := Top;
562 FRight := Right;
563 FBottom := Bottom;
564end;
565
566procedure TIsoMap.FillRect(X, Y, Width, Height, Color: Integer);
567begin
568 if X < FLeft then
569 begin
570 Width := Width - (FLeft - X);
571 X := FLeft;
572 end;
573 if Y < FTop then
574 begin
575 Height := Height - (FTop - Y);
576 Y := FTop;
577 end;
578 if X + Width >= FRight then
579 Width := FRight - X;
580 if Y + Height >= FBottom then
581 Height := FBottom - Y;
582 if (Width <= 0) or (Height <= 0) then
583 Exit;
584
585 FOutput.Canvas.Brush.Color := Color;
586 FOutput.Canvas.FillRect(Rect(X, Y, X + Width, Y + Height));
587 FOutput.Canvas.Brush.Style := bsClear;
588end;
589
590procedure TIsoMap.Textout(X, Y, Color: Integer; const S: string);
591begin
592 FOutput.Canvas.Font.Color := Color;
593 FOutput.Canvas.TextRect(Rect(FLeft, FTop, FRight, FBottom), X, Y, S)
594end;
595
596procedure TIsoMap.BitBltBitmap(Src: TDpiBitmap; X, Y, Width, Height, xSrc, ySrc,
597 Rop: Integer);
598begin
599 if X < FLeft then
600 begin
601 Width := Width - (FLeft - X);
602 xSrc := xSrc + (FLeft - X);
603 X := FLeft;
604 end;
605 if Y < FTop then
606 begin
607 Height := Height - (FTop - Y);
608 ySrc := ySrc + (FTop - Y);
609 Y := FTop;
610 end;
611 if X + Width >= FRight then
612 Width := FRight - X;
613 if Y + Height >= FBottom then
614 Height := FBottom - Y;
615 if (Width <= 0) or (Height <= 0) then
616 Exit;
617
618 DpiBitBltCanvas(FOutput.Canvas, X, Y, Width, Height, Src.Canvas, xSrc, ySrc, Rop);
619end;
620
621procedure TIsoMap.Sprite(HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: Integer);
622begin
623 BitBltBitmap(HGr.Mask, xDst, yDst, Width, Height, xGr, yGr, SRCAND);
624 BitBltBitmap(HGr.Data, xDst, yDst, Width, Height, xGr, yGr, SRCPAINT);
625end;
626
627procedure TIsoMap.TSprite(xDst, yDst, grix: Integer;
628 PureBlack: Boolean = False);
629var
630 Width: Integer;
631 Height: Integer;
632 xSrc: Integer;
633 ySrc: Integer;
634begin
635 Width := TSpriteSize[grix].Right - TSpriteSize[grix].Left;
636 Height := TSpriteSize[grix].Bottom - TSpriteSize[grix].Top;
637 xSrc := 1 + grix mod 9 * (xxt * 2 + 1) + TSpriteSize[grix].Left;
638 ySrc := 1 + grix div 9 * (yyt * 3 + 1) + TSpriteSize[grix].Top;
639 xDst := xDst + TSpriteSize[grix].Left;
640 yDst := yDst - yyt + TSpriteSize[grix].Top;
641 if xDst < FLeft then begin
642 Width := Width - (FLeft - xDst);
643 xSrc := xSrc + (FLeft - xDst);
644 xDst := FLeft;
645 end;
646 if yDst < FTop then begin
647 Height := Height - (FTop - yDst);
648 ySrc := ySrc + (FTop - yDst);
649 yDst := FTop;
650 end;
651 if xDst + Width >= FRight then
652 Width := FRight - xDst;
653 if yDst + Height >= FBottom then
654 Height := FBottom - yDst;
655 if (Width <= 0) or (Height <= 0) then
656 Exit;
657
658 DpiBitBltCanvas(FOutput.Canvas, xDst, yDst, Width, Height, MaskCanvas, xSrc, ySrc, SRCAND);
659 if not PureBlack then
660 DpiBitBltCanvas(FOutput.Canvas, xDst, yDst, Width, Height, DataCanvas, xSrc, ySrc, SRCPAINT);
661end;
662
663procedure TIsoMap.PaintUnit(X, Y: Integer; const UnitInfo: TUnitInfo;
664 Status: Integer);
665var
666 xsh, ysh, xGr, yGr, J, mixShow: Integer;
667begin
668 with UnitInfo do
669 if (Owner = Me) or (emix <> $FFFF) then
670 begin
671 if Job = jCity then
672 mixShow := -1 // building site
673 else
674 mixShow := mix;
675 if (not Assigned(Tribe[Owner].ModelPicture[mixShow].HGr)) and
676 (@OnInitEnemyModel <> nil) then
677 if not OnInitEnemyModel(emix) then
678 Exit;
679 xsh := Tribe[Owner].ModelPicture[mixShow].xShield;
680 ysh := Tribe[Owner].ModelPicture[mixShow].yShield;
681{$IFNDEF SCR} if Status and usStay <> 0 then
682 J := 19
683 else if Status and usRecover <> 0 then
684 J := 16
685 else if Status and (usGoto or usEnhance) = usGoto or usEnhance then
686 J := 18
687 else if Status and usEnhance <> 0 then
688 J := 17
689 else if Status and usGoto <> 0 then
690 J := 20
691 else {$ENDIF} if Job = jCity then
692 J := jNone
693 else
694 J := Job;
695 if Flags and unMulti <> 0 then
696 Sprite(Tribe[Owner].symHGr, X + xsh - 1 + 4, Y + ysh - 2, 14, 12,
697 33 + Tribe[Owner].sympix mod 10 * 65,
698 1 + Tribe[Owner].sympix div 10 * 49);
699 Sprite(Tribe[Owner].symHGr, X + xsh - 1, Y + ysh - 2, 14, 12,
700 18 + Tribe[Owner].sympix mod 10 * 65,
701 1 + Tribe[Owner].sympix div 10 * 49);
702 FillRect(X + xsh, Y + ysh + 5, 1 + Health * 11 div 100, 3,
703 ColorOfHealth(Health));
704 if J > 0 then
705 begin
706 xGr := 121 + J mod 7 * 9;
707 yGr := 1 + J div 7 * 9;
708 BitBltBitmap(HGrSystem.Mask, X + xsh + 3, Y + ysh + 9, 8, 8, xGr,
709 yGr, SRCAND);
710 Sprite(HGrSystem, X + xsh + 2, Y + ysh + 8, 8, 8, xGr, yGr);
711 end;
712 with Tribe[Owner].ModelPicture[mixShow] do
713 Sprite(HGr, X, Y, 64, 48, pix mod 10 * 65 + 1, pix div 10 * 49 + 1);
714 if Flags and unFortified <> 0 then
715 begin
716 { DataCanvas:=HGrTerrain.Data.Canvas;
717 MaskCanvas:=HGrTerrain.Mask.Canvas;
718 TSprite(X,Y+16,12*9+7); }
719 Sprite(HGrStdUnits, X, Y, xxu * 2, yyu * 2, 1 + 6 * (xxu * 2 + 1), 1);
720 end;
721 end;
722end;
723
724procedure TIsoMap.PaintCity(X, Y: Integer; const CityInfo: TCityInfo;
725 accessory: Boolean);
726var
727 age: Integer;
728 cHGr: TGraphicSet;
729 cpix: Integer;
730 xGr: Integer;
731 xShield: Integer;
732 yShield: Integer;
733 LabelTextColor: Integer;
734 LabelLength: Integer;
735 cpic: TCityPicture;
736 S: string;
737begin
738 age := GetAge(CityInfo.Owner);
739 if CityInfo.size < 5 then
740 xGr := 0
741 else if CityInfo.size < 9 then
742 xGr := 1
743 else if CityInfo.size < 13 then
744 xGr := 2
745 else
746 xGr := 3;
747 Tribe[CityInfo.Owner].InitAge(age);
748 if age < 2 then
749 begin
750 cHGr := Tribe[CityInfo.Owner].cHGr;
751 cpix := Tribe[CityInfo.Owner].cpix;
752 if (ciWalled and CityInfo.Flags = 0) or
753 (cHGr.Data.Canvas.Pixels[(xGr + 4) * 65, cpix * 49 + 48] = $00FFFF)
754 then
755 Sprite(cHGr, X - xxc, Y - 2 * yyc, xxc * 2, yyc * 3,
756 xGr * (xxc * 2 + 1) + 1, 1 + cpix * (yyc * 3 + 1));
757 if ciWalled and CityInfo.Flags <> 0 then
758 Sprite(cHGr, X - xxc, Y - 2 * yyc, xxc * 2, yyc * 3,
759 (xGr + 4) * (xxc * 2 + 1) + 1, 1 + cpix * (yyc * 3 + 1));
760 end
761 else
762 begin
763 if ciWalled and CityInfo.Flags <> 0 then
764 Sprite(HGrCities, X - xxt, Y - 2 * yyt, 2 * xxt, 3 * yyt,
765 (xGr + 4) * (2 * xxt + 1) + 1, 1 + (age - 2) * (3 * yyt + 1))
766 else
767 Sprite(HGrCities, X - xxt, Y - 2 * yyt, 2 * xxt, 3 * yyt,
768 xGr * (2 * xxt + 1) + 1, 1 + (age - 2) * (3 * yyt + 1));
769 end;
770
771 if not accessory then
772 Exit;
773
774 { if ciCapital and CityInfo.Flags<>0 then
775 Sprite(Tribe[CityInfo.Owner].symHGr,X+cpic.xf,Y-13+cpic.yf,13,14,
776 1+Tribe[CityInfo.Owner].sympix mod 10 *65,
777 1+Tribe[CityInfo.Owner].sympix div 10 *49); {capital -- paint flag }
778
779 if MyMap[CityInfo.Loc] and fObserved <> 0 then
780 begin
781 if age < 2 then
782 begin
783 cpic := Tribe[CityInfo.Owner].CityPicture[xGr];
784 xShield := X - xxc + cpic.xShield;
785 yShield := Y - 2 * yyc + cpic.yShield;
786 end
787 else
788 begin
789 cpic := CitiesPictures.Pictures[age, xGr];
790 xShield := X - xxt + cpic.xShield;
791 yShield := Y - 2 * yyt + cpic.yShield;
792 end;
793 S := IntToStr(CityInfo.size);
794 LabelLength := FOutput.Canvas.TextWidth(S);
795 FillRect(xShield, yShield, LabelLength + 4, 16, $000000);
796 if MyMap[CityInfo.Loc] and (fUnit or fObserved) = fObserved then
797 // empty city
798 LabelTextColor := Tribe[CityInfo.Owner].Color
799 else
800 begin
801 FillRect(xShield + 1, yShield + 1, LabelLength + 2, 14,
802 Tribe[CityInfo.Owner].Color);
803 LabelTextColor := $000000;
804 end;
805 Textout(xShield + 2, yShield - 1, LabelTextColor, S);
806 end;
807end;
808
809function PoleTile(Loc: Integer): Integer;
810begin { virtual pole tile }
811 Result := fUNKNOWN;
812 if Loc < -2 * G.lx then
813 else if Loc < -G.lx then
814 begin
815 if (MyMap[dLoc(Loc, 0, 2)] and fTerrain <> fUNKNOWN) and
816 (MyMap[dLoc(Loc, -2, 2)] and fTerrain <> fUNKNOWN) and
817 (MyMap[dLoc(Loc, 2, 2)] and fTerrain <> fUNKNOWN) then
818 Result := fArctic;
819 if (MyMap[dLoc(Loc, 0, 2)] and fObserved <> 0) and
820 (MyMap[dLoc(Loc, -2, 2)] and fObserved <> 0) and
821 (MyMap[dLoc(Loc, 2, 2)] and fObserved <> 0) then
822 Result := Result or fObserved;
823 end
824 else if Loc < 0 then
825 begin
826 if (MyMap[dLoc(Loc, -1, 1)] and fTerrain <> fUNKNOWN) and
827 (MyMap[dLoc(Loc, 1, 1)] and fTerrain <> fUNKNOWN) then
828 Result := fArctic;
829 if (MyMap[dLoc(Loc, -1, 1)] and fObserved <> 0) and
830 (MyMap[dLoc(Loc, 1, 1)] and fObserved <> 0) then
831 Result := Result or fObserved;
832 end
833 else if Loc < G.lx * (G.ly + 1) then
834 begin
835 if (MyMap[dLoc(Loc, -1, -1)] and fTerrain <> fUNKNOWN) and
836 (MyMap[dLoc(Loc, 1, -1)] and fTerrain <> fUNKNOWN) then
837 Result := fArctic;
838 if (MyMap[dLoc(Loc, -1, -1)] and fObserved <> 0) and
839 (MyMap[dLoc(Loc, 1, -1)] and fObserved <> 0) then
840 Result := Result or fObserved;
841 end
842 else if Loc < G.lx * (G.ly + 2) then
843 begin
844 if (MyMap[dLoc(Loc, 0, -2)] and fTerrain <> fUNKNOWN) and
845 (MyMap[dLoc(Loc, -2, -2)] and fTerrain <> fUNKNOWN) and
846 (MyMap[dLoc(Loc, 2, -2)] and fTerrain <> fUNKNOWN) then
847 Result := fArctic;
848 if (MyMap[dLoc(Loc, 0, -2)] and fObserved <> 0) and
849 (MyMap[dLoc(Loc, -2, -2)] and fObserved <> 0) and
850 (MyMap[dLoc(Loc, 2, -2)] and fObserved <> 0) then
851 Result := Result or fObserved;
852 end;
853end;
854
855function TIsoMap.Connection4(Loc, Mask, Value: Integer): Integer;
856begin
857 Result := 0;
858 if dLoc(Loc, 1, -1) >= 0 then
859 begin
860 if MyMap[dLoc(Loc, 1, -1)] and Mask = Cardinal(Value) then
861 Inc(Result, 1);
862 if MyMap[dLoc(Loc, -1, -1)] and Mask = Cardinal(Value) then
863 Inc(Result, 8);
864 end;
865 if dLoc(Loc, 1, 1) < G.lx * G.ly then
866 begin
867 if MyMap[dLoc(Loc, 1, 1)] and Mask = Cardinal(Value) then
868 Inc(Result, 2);
869 if MyMap[dLoc(Loc, -1, 1)] and Mask = Cardinal(Value) then
870 Inc(Result, 4);
871 end;
872end;
873
874function TIsoMap.Connection8(Loc, Mask: Integer): Integer;
875var
876 Dir: Integer;
877 ConnLoc: Integer;
878begin
879 Result := 0;
880 for Dir := 0 to 7 do
881 begin
882 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]);
883 if (ConnLoc >= 0) and (ConnLoc < G.lx * G.ly) and
884 (MyMap[ConnLoc] and Mask <> 0) then
885 Inc(Result, 1 shl Dir);
886 end;
887end;
888
889function TIsoMap.OceanConnection(Loc: Integer): Integer;
890var
891 Dir: Integer;
892 ConnLoc: Integer;
893begin
894 Result := 0;
895 for Dir := 0 to 7 do
896 begin
897 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]);
898 if (ConnLoc < 0) or (ConnLoc >= G.lx * G.ly) or
899 ((MyMap[ConnLoc] - 2) and fTerrain < 13) then
900 Inc(Result, 1 shl Dir);
901 end;
902end;
903
904procedure TIsoMap.PaintShore(X, Y, Loc: Integer);
905var
906 Conn: Integer;
907 Tile: Integer;
908begin
909 if (Y <= FTop - yyt * 2) or (Y > FBottom) or (X <= FLeft - xxt * 2) or
910 (X > FRight) then
911 Exit;
912 if (Loc < 0) or (Loc >= G.lx * G.ly) then
913 Exit;
914 Tile := MyMap[Loc];
915 if Tile and fTerrain >= fGrass then
916 Exit;
917 Conn := OceanConnection(Loc);
918 if Conn = 0 then
919 Exit;
920
921 BitBltBitmap(HGrTerrain.Data, X + xxt div 2, Y, xxt, yyt,
922 1 + (Conn shr 6 + Conn and 1 shl 2) * (xxt * 2 + 1),
923 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT);
924 BitBltBitmap(HGrTerrain.Data, X + xxt, Y + yyt div 2, xxt, yyt,
925 1 + (Conn and 7) * (xxt * 2 + 1) + xxt,
926 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT);
927 BitBltBitmap(HGrTerrain.Data, X + xxt div 2, Y + yyt, xxt, yyt,
928 1 + (Conn shr 2 and 7) * (xxt * 2 + 1) + xxt,
929 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT);
930 BitBltBitmap(HGrTerrain.Data, X, Y + yyt div 2, xxt, yyt,
931 1 + (Conn shr 4 and 7) * (xxt * 2 + 1),
932 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT);
933 Conn := Connection4(Loc, fTerrain, fUNKNOWN); { dither to black }
934 if Conn and 1 <> 0 then
935 BitBltBitmap(HGrTerrain.Mask, X + xxt, Y, xxt, yyt, 1 + 7 * (xxt * 2 + 1) +
936 xxt, 1 + yyt + 15 * (yyt * 3 + 1), SRCAND);
937 if Conn and 2 <> 0 then
938 BitBltBitmap(HGrTerrain.Mask, X + xxt, Y + yyt, xxt, yyt,
939 1 + 7 * (xxt * 2 + 1) + xxt, 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND);
940 if Conn and 4 <> 0 then
941 BitBltBitmap(HGrTerrain.Mask, X, Y + yyt, xxt, yyt, 1 + 7 * (xxt * 2 + 1),
942 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND);
943 if Conn and 8 <> 0 then
944 BitBltBitmap(HGrTerrain.Mask, X, Y, xxt, yyt, 1 + 7 * (xxt * 2 + 1),
945 1 + yyt + 15 * (yyt * 3 + 1), SRCAND);
946end;
947
948procedure TIsoMap.PaintTileExtraTerrain(X, Y, Loc: Integer);
949var
950 Dir, Conn, RRConn, yGr, Tile, yLoc: Integer;
951begin
952 if (Loc < 0) or (Loc >= G.lx * G.ly) or (Y <= -yyt * 2) or
953 (Y > FOutput.Height) or (X <= -xxt * 2) or (X > FOutput.Width) then
954 Exit;
955 Tile := MyMap[Loc];
956 if Tile and fTerrain = fForest then
957 begin
958 yLoc := Loc div G.lx;
959 if IsJungle(yLoc) then
960 yGr := spJungle
961 else
962 yGr := spForest;
963 Conn := Connection4(Loc, fTerrain, Tile and fTerrain);
964 if (yLoc = (G.ly - 2) div 4) or (G.ly - 1 - yLoc = (G.ly + 2) div 4) then
965 Conn := Conn and not 6 // no connection to south
966 else if (yLoc = (G.ly + 2) div 4) or (G.ly - 1 - yLoc = (G.ly - 2) div 4)
967 then
968 Conn := Conn and not 9; // no connection to north
969 TSprite(X, Y, yGr + Conn mod 8 + (Conn div 8) * TerrainIconCols);
970 end
971 else if Tile and fTerrain in [fHills, fMountains, fForest] then
972 begin
973 yGr := 3 + 2 * (Tile and fTerrain - fForest);
974 Conn := Connection4(Loc, fTerrain, Tile and fTerrain);
975 TSprite(X, Y, Conn mod 8 + (yGr + Conn div 8) * TerrainIconCols);
976 end
977 else if Tile and fDeadLands <> 0 then
978 TSprite(X, Y, spRow2);
979
980 if ShowObjects then
981 begin
982 if Tile and fTerImp = tiFarm then
983 TSprite(X, Y, spFarmLand)
984 else if Tile and fTerImp = tiIrrigation then
985 TSprite(X, Y, spIrrigation);
986 end;
987 if Tile and fRiver <> 0 then
988 begin
989 Conn := Connection4(Loc, fRiver, fRiver) or
990 Connection4(Loc, fTerrain, fShore) or Connection4(Loc, fTerrain,
991 fUNKNOWN);
992 TSprite(X, Y, spRiver + Conn mod 8 + (Conn div 8) * TerrainIconCols);
993 end;
994
995 if Tile and fTerrain < fGrass then
996 begin
997 Conn := Connection4(Loc, fRiver, fRiver);
998 for Dir := 0 to 3 do
999 if Conn and (1 shl Dir) <> 0 then { river mouths }
1000 TSprite(X, Y, spRiverMouths + Dir);
1001 if ShowObjects then
1002 begin
1003 Conn := Connection8(Loc, fCanal);
1004 for Dir := 0 to 7 do
1005 if Conn and (1 shl Dir) <> 0 then { canal mouths }
1006 TSprite(X, Y, spCanalMouths + 1 + Dir);
1007 end;
1008 end;
1009
1010 if ShowObjects then begin
1011 // Paint canal connections
1012 if (Tile and fCanal <> 0) or (Tile and fCity <> 0) then begin
1013 Conn := Connection8(Loc, fCanal or fCity);
1014 if Tile and fCanal <> 0 then
1015 Conn := Conn or ($FF - OceanConnection(Loc));
1016 if Conn = 0 then begin
1017 if Tile and fCanal <> 0 then
1018 TSprite(X, Y, spCanal);
1019 end
1020 else
1021 for Dir := 0 to 7 do
1022 if (1 shl Dir) and Conn <> 0 then
1023 TSprite(X, Y, spCanal + 1 + Dir);
1024 end;
1025
1026 if Tile and (fRR or fCity) <> 0 then
1027 RRConn := Connection8(Loc, fRR or fCity)
1028 else
1029 RRConn := 0;
1030
1031 // Paint road connections
1032 if Tile and (fRoad or fRR or fCity) <> 0 then begin
1033 Conn := Connection8(Loc, fRoad or fRR or fCity) and not RRConn;
1034 if (Conn = 0) and (Tile and (fRR or fCity) = 0) then
1035 TSprite(X, Y, spRoad)
1036 else if Conn > 0 then
1037 for Dir := 0 to 7 do
1038 if (1 shl Dir) and Conn <> 0 then
1039 TSprite(X, Y, spRoad + 1 + Dir);
1040 end;
1041
1042 // Paint railroad connections
1043 if (Tile and fRR <> 0) and (RRConn = 0) then
1044 TSprite(X, Y, spRailRoad)
1045 else if RRConn > 0 then begin
1046 for Dir := 0 to 7 do
1047 if (1 shl Dir) and RRConn <> 0 then
1048 TSprite(X, Y, spRailRoad + 1 + Dir);
1049 end;
1050 end;
1051end;
1052
1053// (x,y) is top left pixel of (2*xxt,3*yyt) rectangle
1054procedure TIsoMap.PaintTileObjects(X, Y, Loc, CityLoc, CityOwner: Integer;
1055 UseBlink: Boolean);
1056var
1057 p1, p2, uix, cix, dy, Loc1, Tile, Multi, Destination: Integer;
1058 CityInfo: TCityInfo;
1059 UnitInfo: TUnitInfo;
1060 fog: Boolean;
1061 SpecialRow: Integer;
1062 SpecialCol: Integer;
1063
1064 procedure NameCity;
1065 var
1066 cix, xs, W: Integer;
1067 BehindCityInfo: TCityInfo;
1068 S: string;
1069 IsCapital: Boolean;
1070 begin
1071 BehindCityInfo.Loc := Loc - 2 * G.lx;
1072 if ShowCityNames and not (moEditMode in MapOptions) and
1073 (BehindCityInfo.Loc >= 0) and (BehindCityInfo.Loc < G.lx * G.ly) and
1074 (MyMap[BehindCityInfo.Loc] and fCity <> 0) then
1075 begin
1076 GetCityInfo(BehindCityInfo.Loc, cix, BehindCityInfo);
1077 IsCapital := BehindCityInfo.Flags and ciCapital <> 0;
1078 { if Showuix and (cix>=0) then s:=IntToStr(cix)
1079 else } S := CityName(BehindCityInfo.ID);
1080 W := FOutput.Canvas.TextWidth(S);
1081 xs := X + xxt - (W + 1) div 2;
1082 if IsCapital then
1083 FOutput.Canvas.Font.Style := FOutput.Canvas.Font.Style + [fsUnderline];
1084 Textout(xs + 1, Y - 9, $000000, S);
1085 Textout(xs, Y - 10, $FFFFFF, S);
1086 if IsCapital then
1087 FOutput.Canvas.Font.Style := FOutput.Canvas.Font.Style - [fsUnderline];
1088 end;
1089 end;
1090
1091 procedure ShowSpacePort;
1092 begin
1093 if ShowObjects and not (moEditMode in MapOptions) and
1094 (Tile and fCity <> 0) and (CityInfo.Flags and ciSpacePort <> 0) then
1095 TSprite(X + xxt, Y - 6, spSpacePort);
1096 end;
1097
1098 procedure PaintBorder;
1099 var
1100 dx, dy: Integer;
1101 begin
1102 if ShowBorder and (Loc >= 0) and (Loc < G.lx * G.ly) and
1103 (Tile and fTerrain <> fUNKNOWN) then begin
1104 p1 := MyRO.Territory[Loc];
1105 if (p1 >= 0) and (ShowMyBorder or (p1 <> Me)) then begin
1106 if BordersOK^ and (1 shl p1) = 0 then begin
1107 UnshareBitmap(Borders);
1108 DpiBitBltCanvas(Borders.Canvas, 0, p1 * (yyt * 2), xxt * 2,
1109 yyt * 2, HGrTerrain.Data.Canvas,
1110 1 + 8 * (xxt * 2 + 1), 1 + yyt + 16 * (yyt * 3 + 1));
1111 BitmapReplaceColor(Borders, 0, p1 * (yyt * 2), xxt * 2, yyt * 2, $636363, Tribe[p1].Color);
1112 BordersOK^ := BordersOK^ or 1 shl p1;
1113 end;
1114 for dy := 0 to 1 do
1115 for dx := 0 to 1 do begin
1116 Loc1 := dLoc(Loc, dx * 2 - 1, dy * 2 - 1);
1117 begin
1118 if (Loc1 < 0) or (Loc1 >= G.lx * G.ly) then
1119 p2 := -1
1120 else if MyMap[Loc1] and fTerrain = fUNKNOWN then
1121 p2 := p1
1122 else
1123 p2 := MyRO.Territory[Loc1];
1124 if p2 <> p1 then
1125 begin
1126 BitBltBitmap(HGrTerrain.Mask, X + dx * xxt, Y + dy * yyt, xxt,
1127 yyt, 1 + 8 * (xxt * 2 + 1) + dx * xxt,
1128 1 + yyt + 16 * (yyt * 3 + 1) + dy * yyt, SRCAND);
1129 BitBltBitmap(Borders, X + dx * xxt, Y + dy * yyt, xxt, yyt, dx * xxt,
1130 p1 * (yyt * 2) + dy * yyt, SRCPAINT);
1131 end;
1132 end;
1133 end;
1134 end;
1135 end;
1136 end;
1137
1138begin
1139 if (Loc < 0) or (Loc >= G.lx * G.ly) then
1140 Tile := PoleTile(Loc)
1141 else
1142 Tile := MyMap[Loc];
1143 if ShowObjects and not (moEditMode in MapOptions) and
1144 (Tile and fCity <> 0) then
1145 GetCityInfo(Loc, cix, CityInfo);
1146 if (Y <= FTop - yyt * 2) or (Y > FBottom) or (X <= FLeft - xxt * 2) or
1147 (X > FRight) then
1148 begin
1149 NameCity;
1150 ShowSpacePort;
1151 Exit;
1152 end;
1153 if Tile and fTerrain = fUNKNOWN then
1154 begin
1155 NameCity;
1156 ShowSpacePort;
1157 Exit;
1158 end; { square not discovered }
1159
1160 if not(FoW and (Tile and fObserved = 0)) then
1161 PaintBorder;
1162
1163 if (Loc >= 0) and (Loc < G.lx * G.ly) and (Loc = FAdviceLoc) then
1164 TSprite(X, Y, spPlain);
1165
1166 if (Loc >= 0) and (Loc < G.lx * G.ly) and (Tile and fSpecial <> 0)
1167 then { special resources }
1168 begin
1169 dy := Loc div G.lx;
1170 SpecialCol := Tile and fTerrain;
1171 SpecialRow := Tile and fSpecial shr 5;
1172 if SpecialCol < fForest then
1173 TSprite(X, Y, SpecialCol + SpecialRow * TerrainIconCols)
1174 else if (SpecialCol = fForest) and IsJungle(dy) then
1175 TSprite(X, Y, spJungle - 1 + SpecialRow * TerrainIconCols)
1176 else
1177 TSprite(X, Y, spForest - 1 + ((SpecialCol - fForest) * 2 + SpecialRow) * TerrainIconCols);
1178 end;
1179
1180 if ShowObjects then
1181 begin
1182 if Tile and fTerImp = tiMine then
1183 TSprite(X, Y, spMine);
1184 if Tile and fTerImp = tiBase then
1185 TSprite(X, Y, spBase);
1186 if Tile and fPoll <> 0 then
1187 TSprite(X, Y, spPollution);
1188 if Tile and fTerImp = tiFort then
1189 begin
1190 TSprite(X, Y, spFortBack);
1191 if Tile and fObserved = 0 then
1192 TSprite(X, Y, spFortFront);
1193 end;
1194 end;
1195 if (Tile and fDeadLands) <> 0 then
1196 TSprite(X, Y, spMinerals + (Tile shr 25 and 3) * TerrainIconCols);
1197
1198 if moEditMode in MapOptions then
1199 fog := (Loc < 0) or (Loc >= G.lx * G.ly)
1200 // else if CityLoc>=0 then
1201 // fog:= (Loc<0) or (Loc>=G.lx*G.ly) or (Distance(Loc,CityLoc)>5)
1202 else if ShowGrWall then
1203 fog := Tile and fGrWall = 0
1204 else
1205 fog := FoW and (Tile and fObserved = 0);
1206 if fog and ShowObjects then
1207 if Loc < -G.lx then
1208 Sprite(HGrTerrain, X, Y + yyt, xxt * 2, yyt, 1 + 6 * (xxt * 2 + 1),
1209 1 + yyt * 2 + 15 * (yyt * 3 + 1))
1210 else if Loc >= G.lx * (G.ly + 1) then
1211 Sprite(HGrTerrain, X, Y, xxt * 2, yyt, 1 + 6 * (xxt * 2 + 1),
1212 1 + yyt + 15 * (yyt * 3 + 1))
1213 else
1214 TSprite(X, Y, spGrid, xxt <> 33);
1215
1216 if FoW and (Tile and fObserved = 0) then
1217 PaintBorder;
1218
1219{$IFNDEF SCR}
1220 // paint goto destination mark
1221 if DestinationMarkON and (CityOwner < 0) and (UnFocus >= 0) and
1222 (MyUn[UnFocus].Status and usGoto <> 0) then
1223 begin
1224 Destination := MyUn[UnFocus].Status shr 16;
1225 if (Destination = Loc) and (Destination <> MyUn[UnFocus].Loc) then
1226 if not UseBlink or BlinkOn then
1227 TSprite(X, Y, spBlink1)
1228 else
1229 TSprite(X, Y, spBlink2)
1230 end;
1231{$ENDIF}
1232 if moEditMode in MapOptions then
1233 begin
1234 if Tile and fPrefStartPos <> 0 then
1235 TSprite(X, Y, spPrefStartPos)
1236 else if Tile and fStartPos <> 0 then
1237 TSprite(X, Y, spStartPos);
1238 end
1239 else if ShowObjects then
1240 begin
1241 { if (CityLoc<0) and (UnFocus>=0) and (Loc=MyUn[UnFocus].Loc) then
1242 if BlinkOn then TSprite(X,Y,8+9*0)
1243 else TSprite(X,Y,8+9*1); }
1244
1245 NameCity;
1246 ShowSpacePort;
1247 if Tile and fCity <> 0 then
1248 PaintCity(X + xxt, Y + yyt, CityInfo, CityOwner < 0);
1249
1250 if (Tile and fUnit <> 0) and (Loc <> AttLoc) and
1251 ((Loc <> DefLoc) or (DefHealth <> 0))
1252{$IFNDEF SCR} and ((CityOwner >= 0) or (UnFocus < 0) or not UseBlink or
1253 BlinkOn or (Loc <> MyUn[UnFocus].Loc)){$ENDIF}
1254 and ((Tile and fCity <> fCity) or (Loc = DefLoc)
1255{$IFNDEF SCR} or (not UseBlink or BlinkOn) and (UnFocus >= 0) and
1256 (Loc = MyUn[UnFocus].Loc){$ENDIF}) then
1257 begin { unit }
1258 GetUnitInfo(Loc, uix, UnitInfo);
1259 if (Loc = DefLoc) and (DefHealth >= 0) then
1260 UnitInfo.Health := DefHealth;
1261 if (UnitInfo.Owner <> CityOwner) and
1262 not((CityOwner = Me) and (MyRO.Treaty[UnitInfo.Owner] = trAlliance))
1263 then
1264{$IFNDEF SCR} if (UnFocus >= 0) and (Loc = MyUn[UnFocus].Loc) then { active unit }
1265 begin
1266 Multi := UnitInfo.Flags and unMulti;
1267 MakeUnitInfo(Me, MyUn[UnFocus], UnitInfo);
1268 UnitInfo.Flags := UnitInfo.Flags or Multi;
1269 PaintUnit(X + (xxt - xxu), Y + (yyt - yyu_anchor), UnitInfo,
1270 MyUn[UnFocus].Status);
1271 end
1272 else if UnitInfo.Owner = Me then
1273 begin
1274 if ClientMode = cMovieTurn then
1275 PaintUnit(X + (xxt - xxu), Y + (yyt - yyu_anchor), UnitInfo, 0)
1276 // status is not set with precise timing during loading
1277 else
1278 PaintUnit(X + (xxt - xxu), Y + (yyt - yyu_anchor), UnitInfo,
1279 MyUn[uix].Status);
1280 // if Showuix then Textout(x+16,y+5,$80FF00,IntToStr(uix));
1281 end
1282 else {$ENDIF} PaintUnit(X + (xxt - xxu), Y + (yyt - yyu_anchor), UnitInfo, 0);
1283 end
1284 else if Tile and fHiddenUnit <> 0 then
1285 Sprite(HGrStdUnits, X + (xxt - xxu), Y + (yyt - yyu_anchor), xxu * 2,
1286 yyu * 2, 1 + 5 * (xxu * 2 + 1), 1)
1287 else if Tile and fStealthUnit <> 0 then
1288 Sprite(HGrStdUnits, X + (xxt - xxu), Y + (yyt - yyu_anchor), xxu * 2,
1289 yyu * 2, 1 + 5 * (xxu * 2 + 1), 1 + 1 * (yyu * 2 + 1))
1290 end;
1291
1292 if ShowObjects and (Tile and fTerImp = tiFort) and (Tile and fObserved <> 0)
1293 then
1294 TSprite(X, Y, spFortFront);
1295
1296 if (Loc >= 0) and (Loc < G.lx * G.ly) then
1297 if ShowLoc then
1298 Textout(X + xxt - 16, Y + yyt - 9, $FFFF00, IntToStr(Loc))
1299 else if ShowDebug and (DebugMap <> nil) and (Loc >= 0) and
1300 (Loc < G.lx * G.ly) and (DebugMap[Loc] <> 0) then
1301 Textout(X + xxt - 16, Y + yyt - 9, $00E0FF,
1302 IntToStr(Integer(DebugMap[Loc])))
1303end;
1304
1305procedure TIsoMap.PaintGrid(X, Y, nx, ny: Integer);
1306
1307 procedure ClippedLine(dx0, dy0: Integer; mirror: Boolean);
1308 var
1309 x0, x1, dxmin, dymin, dxmax, dymax, N: Integer;
1310 begin
1311 with FOutput.Canvas do
1312 begin
1313 dxmin := (FLeft - X) div xxt;
1314 dymin := (RealTop - Y) div yyt;
1315 dxmax := (FRight - X - 1) div xxt + 1;
1316 dymax := (RealBottom - Y - 1) div yyt + 1;
1317 N := dymax - dy0;
1318 if mirror then
1319 begin
1320 if dx0 - dxmin < N then
1321 N := dx0 - dxmin;
1322 if dx0 > dxmax then
1323 begin
1324 N := N - (dx0 - dxmax);
1325 dy0 := dy0 + (dx0 - dxmax);
1326 dx0 := dxmax
1327 end;
1328 if dy0 < dymin then
1329 begin
1330 N := N - (dymin - dy0);
1331 dx0 := dx0 - (dymin - dy0);
1332 dy0 := dymin
1333 end;
1334 end
1335 else
1336 begin
1337 if dxmax - dx0 < N then
1338 N := dxmax - dx0;
1339 if dx0 < dxmin then
1340 begin
1341 N := N - (dxmin - dx0);
1342 dy0 := dy0 + (dxmin - dx0);
1343 dx0 := dxmin
1344 end;
1345 if dy0 < dymin then
1346 begin
1347 N := N - (dymin - dy0);
1348 dx0 := dx0 + (dymin - dy0);
1349 dy0 := dymin
1350 end;
1351 end;
1352 if N <= 0 then
1353 Exit;
1354 if mirror then
1355 begin
1356 x0 := X + dx0 * xxt - 1;
1357 x1 := X + (dx0 - N) * xxt - 1;
1358 end
1359 else
1360 begin
1361 x0 := X + dx0 * xxt;
1362 x1 := X + (dx0 + N) * xxt;
1363 end;
1364 moveto(x0, Y + dy0 * yyt);
1365 lineto(x1, Y + (dy0 + N) * yyt);
1366 end;
1367 end;
1368
1369var
1370 I: Integer;
1371begin
1372 FOutput.Canvas.pen.Color := $000000; // $FF shl (8*random(3));
1373 for I := 0 to nx div 2 do
1374 ClippedLine(I * 2, 0, False);
1375 for I := 1 to (nx + 1) div 2 do
1376 ClippedLine(I * 2, 0, True);
1377 for I := 0 to ny div 2 do
1378 begin
1379 ClippedLine(0, 2 * I + 2, False);
1380 ClippedLine(nx + 1, 2 * I + 1 + nx and 1, True);
1381 end;
1382end;
1383
1384function TIsoMap.IsShoreTile(Loc: Integer): Boolean;
1385var
1386 Dir: Integer;
1387 ConnLoc: Integer;
1388begin
1389 Result := False;
1390 for Dir := 0 to 7 do
1391 begin
1392 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]);
1393 if (ConnLoc < 0) or (ConnLoc >= G.lx * G.ly) or
1394 ((MyMap[ConnLoc] - 2) and fTerrain < 13) then
1395 Result := True;
1396 end;
1397end;
1398
1399procedure TIsoMap.MakeDark(Line: PPixelPointer; Length: Integer);
1400var
1401 I: Integer;
1402begin
1403 for I := 0 to Length - 1 do begin
1404 Line^.Pixel^.B := (Line^.Pixel^.B shr 1) and $7F;
1405 Line^.Pixel^.G := (Line^.Pixel^.G shr 1) and $7F;
1406 Line^.Pixel^.R := (Line^.Pixel^.R shr 1) and $7F;
1407 Line^.NextPixel;
1408 end;
1409end;
1410
1411procedure TIsoMap.SetTileSize(AValue: TTileSize);
1412begin
1413 if FTileSize = AValue then Exit;
1414 FTileSize := AValue;
1415 ApplyTileSize(AValue);
1416end;
1417
1418procedure TIsoMap.ShadeOutside(x0, y0, Width, Height, xm, ym: Integer);
1419const
1420 rShade = 3.75;
1421var
1422 Y, wBright: Integer;
1423 y_n, w_n: Single;
1424 Line: TPixelPointer;
1425begin
1426 FOutput.BeginUpdate;
1427 Line := TPixelPointer.Create(FOutput, ScaleToNative(x0), ScaleToNative(y0));
1428 for Y := 0 to ScaleToNative(Height) - 1 do begin
1429 y_n := (ScaleFromNative(Y) + y0 - ym) / yyt;
1430 if abs(y_n) < rShade then begin
1431 // Darken left and right parts of elipsis
1432 w_n := sqrt(sqr(rShade) - sqr(y_n));
1433 wBright := trunc(w_n * xxt + 0.5);
1434 Line.SetX(0);
1435 MakeDark(@Line, ScaleToNative(xm - wBright));
1436 Line.SetX(ScaleToNative(xm + wBright));
1437 MakeDark(@Line, ScaleToNative(Width - xm - wBright));
1438 end else begin
1439 // Darken entire line
1440 Line.SetX(0);
1441 MakeDark(@Line, ScaleToNative(Width));
1442 end;
1443 Line.NextLine;
1444 end;
1445 FOutput.EndUpdate;
1446end;
1447
1448procedure TIsoMap.CityGrid(xm, ym: Integer; CityAllowClick: Boolean);
1449var
1450 I: Integer;
1451begin
1452 with FOutput.Canvas do
1453 begin
1454 if CityAllowClick then
1455 pen.Color := $FFFFFF
1456 else
1457 pen.Color := $000000;
1458 pen.Width := 1;
1459 for I := 0 to 3 do
1460 begin
1461 moveto(xm - xxt * (4 - I), ym + yyt * (1 + I));
1462 lineto(xm + xxt * (1 + I), ym - yyt * (4 - I));
1463 moveto(xm - xxt * (4 - I), ym - yyt * (1 + I));
1464 lineto(xm + xxt * (1 + I), ym + yyt * (4 - I));
1465 end;
1466 moveto(xm - xxt * 4, ym + yyt * 1);
1467 lineto(xm - xxt * 1, ym + yyt * 4);
1468 moveto(xm + xxt * 1, ym + yyt * 4);
1469 lineto(xm + xxt * 4, ym + yyt * 1);
1470 moveto(xm - xxt * 4, ym - yyt * 1);
1471 lineto(xm - xxt * 1, ym - yyt * 4);
1472 moveto(xm + xxt * 1, ym - yyt * 4);
1473 lineto(xm + xxt * 4, ym - yyt * 1);
1474 pen.Width := 1;
1475 end;
1476end;
1477
1478procedure TIsoMap.Paint(X, Y, Loc, nx, ny, CityLoc, CityOwner: Integer;
1479 UseBlink: Boolean; CityAllowClick: Boolean);
1480var
1481 dx, dy, xm, ym, ALoc, BLoc, ATer, BTer, Aix, bix: Integer;
1482begin
1483 FoW := True;
1484 ShowLoc := moLocCodes in MapOptions;
1485 ShowDebug := pDebugMap >= 0;
1486 ShowObjects := (CityOwner >= 0) or not (moBareTerrain in MapOptions);
1487 ShowCityNames := ShowObjects and (CityOwner < 0) and
1488 (moCityNames in MapOptions);
1489 ShowBorder := True;
1490 ShowMyBorder := CityOwner < 0;
1491 ShowGrWall := (CityOwner < 0) and (moGreatWall in MapOptions);
1492 if ShowDebug then
1493 Server(sGetDebugMap, Me, pDebugMap, DebugMap)
1494 else
1495 DebugMap := nil;
1496 with FOutput.Canvas do
1497 begin
1498 RealTop := Y - ((Loc + 12345 * G.lx) div G.lx - 12345) * yyt;
1499 RealBottom := Y + (G.ly - ((Loc + 12345 * G.lx) div G.lx - 12345) +
1500 3) * yyt;
1501 Brush.Color := EmptySpaceColor;
1502 if RealTop > FTop then
1503 FillRect(Rect(FLeft, FTop, FRight, RealTop))
1504 else
1505 RealTop := FTop;
1506 if RealBottom < FBottom then
1507 FillRect(Rect(FLeft, RealBottom, FRight, FBottom))
1508 else
1509 RealBottom := FBottom;
1510 Brush.Color := $000000;
1511 FillRect(Rect(FLeft, RealTop, FRight, RealBottom));
1512 Brush.Style := bsClear;
1513 end;
1514
1515 for dy := 0 to ny + 1 do
1516 if (Loc + dy * G.lx >= 0) and (Loc + (dy - 3) * G.lx < G.lx * G.ly) then
1517 for dx := 0 to nx do
1518 begin
1519 ALoc := dLoc(Loc, dx - (dy + dx) and 1, dy - 2);
1520 BLoc := dLoc(Loc, dx - (dy + dx + 1) and 1, dy - 1);
1521 if (ALoc < 0) or (ALoc >= G.lx * G.ly) then
1522 ATer := PoleTile(ALoc) and fTerrain
1523 else
1524 ATer := MyMap[ALoc] and fTerrain;
1525 if (BLoc < 0) or (BLoc >= G.lx * G.ly) then
1526 BTer := PoleTile(BLoc) and fTerrain
1527 else
1528 BTer := MyMap[BLoc] and fTerrain;
1529
1530 if (ATer <> fUNKNOWN) or (BTer <> fUNKNOWN) then
1531 if ((ATer < fGrass) or (ATer = fUNKNOWN)) and
1532 ((BTer < fGrass) or (BTer = fUNKNOWN)) then
1533 begin
1534 if ATer = fUNKNOWN then
1535 Aix := 0
1536 else if IsShoreTile(ALoc) then
1537 if ATer = fOcean then
1538 Aix := -1
1539 else
1540 Aix := 1
1541 else
1542 Aix := ATer + 2;
1543 if BTer = fUNKNOWN then
1544 bix := 0
1545 else if IsShoreTile(BLoc) then
1546 if BTer = fOcean then
1547 bix := -1
1548 else
1549 bix := 1
1550 else
1551 bix := BTer + 2;
1552 if (Aix > 1) or (bix > 1) then
1553 begin
1554 if Aix = -1 then
1555 if bix = fOcean + 2 then
1556 begin
1557 Aix := 0;
1558 bix := 0;
1559 end
1560 else
1561 begin
1562 Aix := 0;
1563 bix := 1;
1564 end
1565 else if bix = -1 then
1566 if Aix = fOcean + 2 then
1567 begin
1568 Aix := 1;
1569 bix := 1;
1570 end
1571 else
1572 begin
1573 Aix := 1;
1574 bix := 0;
1575 end;
1576 BitBltBitmap(OceanPatch, X + dx * xxt, Y + dy * yyt, xxt, yyt,
1577 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY)
1578 end
1579 end
1580 else
1581 begin
1582 if ATer = fUNKNOWN then
1583 Aix := 0
1584 else if (ALoc >= 0) and (ALoc < G.lx * G.ly) and
1585 (MyMap[ALoc] and fDeadLands <> 0) then
1586 Aix := -2
1587 else if ATer = fOcean then
1588 Aix := -1
1589 else if ATer = fShore then
1590 Aix := 1
1591 else if ATer >= fForest then
1592 Aix := 8
1593 else
1594 Aix := ATer;
1595 if BTer = fUNKNOWN then
1596 bix := 0
1597 else if (BLoc >= 0) and (BLoc < G.lx * G.ly) and
1598 (MyMap[BLoc] and fDeadLands <> 0) then
1599 bix := -2
1600 else if BTer = fOcean then
1601 bix := -1
1602 else if BTer = fShore then
1603 bix := 1
1604 else if BTer >= fForest then
1605 bix := 8
1606 else
1607 bix := BTer;
1608 if (Aix = -2) and (bix = -2) then
1609 begin
1610 Aix := fDesert;
1611 bix := fDesert;
1612 end
1613 else if Aix = -2 then
1614 if bix < 2 then
1615 Aix := 8
1616 else
1617 Aix := bix
1618 else if bix = -2 then
1619 if Aix < 2 then
1620 bix := 8
1621 else
1622 bix := Aix;
1623 if Aix = -1 then
1624 BitBltBitmap(HGrTerrain.Data, X + dx * xxt, Y + dy * yyt, xxt,
1625 yyt, 1 + 6 * (xxt * 2 + 1) + (dx + dy + 1) and 1 * xxt, 1 + yyt,
1626 SRCCOPY) // arctic <-> ocean
1627 else if bix = -1 then
1628 BitBltBitmap(HGrTerrain.Data, X + dx * xxt, Y + dy * yyt, xxt,
1629 yyt, 1 + 6 * (xxt * 2 + 1) + xxt - (dx + dy + 1) and 1 * xxt,
1630 1 + yyt * 2, SRCCOPY) // arctic <-> ocean
1631 else
1632 BitBltBitmap(LandPatch, X + dx * xxt, Y + dy * yyt, xxt, yyt,
1633 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, bix * yyt, SRCCOPY)
1634 end;
1635 end;
1636
1637 DataCanvas := HGrTerrain.Data.Canvas;
1638 MaskCanvas := HGrTerrain.Mask.Canvas;
1639 for dy := -2 to ny + 1 do
1640 for dx := -1 to nx do
1641 if (dx + dy) and 1 = 0 then
1642 PaintShore(X + xxt * dx, Y + yyt + yyt * dy, dLoc(Loc, dx, dy));
1643 for dy := -2 to ny + 1 do
1644 for dx := -1 to nx do
1645 if (dx + dy) and 1 = 0 then
1646 PaintTileExtraTerrain(X + xxt * dx, Y + yyt + yyt * dy,
1647 dLoc(Loc, dx, dy));
1648 if CityOwner >= 0 then
1649 begin
1650 for dy := -2 to ny + 1 do
1651 for dx := -2 to nx + 1 do
1652 if (dx + dy) and 1 = 0 then
1653 begin
1654 ALoc := dLoc(Loc, dx, dy);
1655 if Distance(ALoc, CityLoc) > 5 then
1656 PaintTileObjects(X + xxt * dx, Y + yyt + yyt * dy, ALoc, CityLoc,
1657 CityOwner, UseBlink);
1658 end;
1659 dx := ((CityLoc mod G.lx * 2 + CityLoc div G.lx and 1) -
1660 ((Loc + 666 * G.lx) mod G.lx * 2 + (Loc + 666 * G.lx) div G.lx and 1) + 3
1661 * G.lx) mod (2 * G.lx) - G.lx;
1662 dy := CityLoc div G.lx - (Loc + 666 * G.lx) div G.lx + 666;
1663 xm := X + (dx + 1) * xxt;
1664 ym := Y + (dy + 1) * yyt + yyt;
1665 ShadeOutside(FLeft, FTop, FRight - FLeft, FBottom - FTop, xm, ym);
1666 CityGrid(xm, ym, CityAllowClick);
1667 for dy := -2 to ny + 1 do
1668 for dx := -2 to nx + 1 do
1669 if (dx + dy) and 1 = 0 then
1670 begin
1671 ALoc := dLoc(Loc, dx, dy);
1672 if Distance(ALoc, CityLoc) <= 5 then
1673 PaintTileObjects(X + xxt * dx, Y + yyt + yyt * dy, ALoc, CityLoc,
1674 CityOwner, UseBlink);
1675 end;
1676 end
1677 else
1678 begin
1679 if ShowLoc or (moEditMode in MapOptions) or
1680 (moGrid in MapOptions) then
1681 PaintGrid(X, Y, nx, ny);
1682 for dy := -2 to ny + 1 do
1683 for dx := -2 to nx + 1 do
1684 if (dx + dy) and 1 = 0 then
1685 PaintTileObjects(X + xxt * dx, Y + yyt + yyt * dy, dLoc(Loc, dx, dy),
1686 CityLoc, CityOwner, UseBlink);
1687 end;
1688
1689 // frame(FOutput.Canvas,x+1,y+1,x+nx*33+33-2,y+ny*16+32-2,$FFFF,$FFFF);
1690end;
1691
1692procedure TIsoMap.AttackBegin(const ShowMove: TShowMove);
1693begin
1694 AttLoc := ShowMove.FromLoc;
1695 DefLoc := dLoc(AttLoc, ShowMove.dx, ShowMove.dy);
1696 DefHealth := -1;
1697end;
1698
1699procedure TIsoMap.AttackEffect(const ShowMove: TShowMove);
1700begin
1701 DefHealth := ShowMove.EndHealthDef;
1702end;
1703
1704procedure TIsoMap.AttackEnd;
1705begin
1706 AttLoc := -1;
1707 DefLoc := -1;
1708end;
1709
1710procedure IsoEngineDone;
1711var
1712 I: TTileSize;
1713begin
1714 for I := Low(IsoMapCache) to High(IsoMapCache) do
1715 FreeAndNil(IsoMapCache[I]);
1716end;
1717
1718finalization
1719
1720IsoEngineDone;
1721
1722end.
Note: See TracBrowser for help on using the repository browser.