source: tags/1.3.1/LocalPlayer/IsoEngine.pas

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