source: tags/1.3.5/LocalPlayer/IsoEngine.pas

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