source: tags/1.3.9/LocalPlayer/IsoEngine.pas

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