source: branches/delphi/LocalPlayer/IsoEngine.pas

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