source: tags/1.3.4/MiniMap.pas

Last change on this file was 545, checked in by chronos, 20 months ago
  • Fixed: Incorrect range checking in scaled bitmap drawing method.
File size: 11.5 KB
Line 
1{$INCLUDE Switches.inc}
2unit MiniMap;
3
4interface
5
6uses
7 Classes, SysUtils, Protocol, ClientTools,
8 {$IFDEF DPI}Dpi.Graphics, Dpi.Common{$ELSE}Graphics{$ENDIF};
9
10type
11 TMiniMode = (mmNone, mmPicture, mmMultiPlayer);
12 TMapArray = array[0 .. lxmax * lymax - 1] of Byte;
13
14 { TMiniMap }
15
16 TMiniMap = class
17 const
18 MaxWidthMapLogo = 96;
19 MaxHeightMapLogo = 96;
20 var
21 Bitmap: TBitmap; { game world sample preview }
22 Size: TPoint;
23 Colors: array [0..31, 0..1] of TColor;
24 Mode: TMiniMode;
25 MapOptions: TMapOptions;
26 procedure LoadFromLogFile(FileName: string; var LastTurn: Integer; DefaultSize: TPoint);
27 procedure LoadFromMapFile(FileName: string; var nMapLandTiles, nMapStartPositions: Integer);
28 procedure PaintRandom(Brightness, StartLandMass: Integer; WorldSize: TPoint);
29 procedure PaintFile(SaveMap: TMapArray);
30 procedure Paint(MyMap: PTileList; MapWidth: Integer; ClientMode: Integer;
31 xxt, xwMini: Integer);
32 constructor Create;
33 destructor Destroy; override;
34 end;
35
36
37implementation
38
39uses
40 {$IFDEF DPI}Dpi.PixelPointer,{$ELSE}PixelPointer,{$ENDIF}
41 ScreenTools, Global, GameServer, IsoEngine, Tribes;
42
43const
44 // save map tile flags
45 smOwned = $20;
46 smUnit = $40;
47 smCity = $80;
48
49{ TMiniMap }
50
51constructor TMiniMap.Create;
52var
53 X, Y: Integer;
54begin
55 Bitmap := TBitmap.Create;
56
57 for X := 0 to 11 do
58 for Y := 0 to 1 do
59 Colors[X, Y] := HGrSystem.Data.Canvas.Pixels[66 + X, 67 + Y];
60end;
61
62destructor TMiniMap.Destroy;
63begin
64 FreeAndNil(Bitmap);
65 inherited;
66end;
67
68procedure TMiniMap.LoadFromLogFile(FileName: string; var LastTurn: Integer; DefaultSize: TPoint);
69var
70 SaveMap: TMapArray;
71 y: Integer;
72 Dummy: Integer;
73 FileLandMass: Integer;
74 LogFile: file;
75 s: string[255];
76 MapRow: array [0 .. lxmax - 1] of Cardinal;
77begin
78 AssignFile(LogFile, FileName);
79 try
80 Reset(LogFile, 4);
81 BlockRead(LogFile, s[1], 2); { file id }
82 BlockRead(LogFile, Dummy, 1); { format id }
83 if Dummy >= $000E01 then
84 BlockRead(LogFile, Dummy, 1); { item stored since 0.14.1 }
85 BlockRead(LogFile, Size.X, 1);
86 BlockRead(LogFile, Size.Y, 1);
87 BlockRead(LogFile, FileLandMass, 1);
88 if FileLandMass = 0 then
89 for y := 0 to Size.Y - 1 do
90 BlockRead(LogFile, MapRow, Size.X);
91 BlockRead(LogFile, Dummy, 1);
92 BlockRead(LogFile, Dummy, 1);
93 BlockRead(LogFile, LastTurn, 1);
94 BlockRead(LogFile, SaveMap, 1);
95 if SaveMap[0] = $80 then
96 Mode := mmMultiPlayer
97 else
98 Mode := mmPicture;
99 if Mode = mmPicture then
100 BlockRead(LogFile, SaveMap[4], (Size.X * Size.Y - 1) div 4);
101 CloseFile(LogFile);
102 except
103 CloseFile(LogFile);
104 LastTurn := 0;
105 Size := DefaultSize;
106 Mode := mmNone;
107 end;
108 PaintFile(SaveMap);
109end;
110
111procedure TMiniMap.LoadFromMapFile(FileName: string; var nMapLandTiles, nMapStartPositions: Integer);
112var
113 x, y, lxFile, lyFile: integer;
114 MapFile: file;
115 s: string[255];
116 MapRow: array [0 .. lxmax - 1] of Cardinal;
117 ImageFileName: string;
118begin
119 ImageFileName := Copy(FileName, 1, Length(FileName) - Length(CevoMapExt)) + CevoMapPictureExt;
120 Mode := mmPicture;
121 if LoadGraphicFile(Bitmap, ImageFileName, [gfNoError]) then
122 begin
123 if Bitmap.Width div 2 > MaxWidthMapLogo then
124 Bitmap.Width := MaxWidthMapLogo * 2;
125 if Bitmap.Height > MaxHeightMapLogo then
126 Bitmap.Height := MaxHeightMapLogo;
127 Size.X := Bitmap.Width div 2;
128 Size.Y := Bitmap.Height;
129 end else begin
130 Mode := mmNone;
131 Size.X := MaxWidthMapLogo;
132 Size.Y := MaxHeightMapLogo;
133 end;
134
135 AssignFile(MapFile, FileName);
136 try
137 Reset(MapFile, 4);
138 BlockRead(MapFile, s[1], 2); { file id }
139 BlockRead(MapFile, x, 1); { format id }
140 BlockRead(MapFile, x, 1); // MaxTurn
141 BlockRead(MapFile, lxFile, 1);
142 BlockRead(MapFile, lyFile, 1);
143 nMapLandTiles := 0;
144 nMapStartPositions := 0;
145 for y := 0 to lyFile - 1 do begin
146 BlockRead(MapFile, MapRow, lxFile);
147 for x := 0 to lxFile - 1 do
148 begin
149 if (MapRow[x] and fTerrain) in [fGrass, fPrairie, fTundra, fSwamp,
150 fForest, fHills] then
151 Inc(nMapLandTiles);
152 if MapRow[x] and (fPrefStartPos or fStartPos) <> 0 then
153 Inc(nMapStartPositions);
154 end
155 end;
156 if nMapStartPositions > nPl then
157 nMapStartPositions := nPl;
158 CloseFile(MapFile);
159 except
160 CloseFile(MapFile);
161 end;
162end;
163
164procedure TMiniMap.PaintRandom(Brightness, StartLandMass: Integer; WorldSize: TPoint);
165var
166 i, x, y, xm, cm: Integer;
167 MiniPixel: TPixelPointer;
168 Map: ^TTileList;
169 xx, yy: Integer;
170begin
171 Map := PreviewMap(StartLandMass);
172 Size := WorldSize;
173
174 Bitmap.PixelFormat := TPixelFormat.pf24bit;
175 Bitmap.SetSize(Size.X * 2, Size.Y);
176 Bitmap.BeginUpdate;
177 MiniPixel := TPixelPointer.Create(Bitmap);
178 xx := ScaleToNative(Size.X);
179 yy := ScaleToNative(Size.Y);
180 for y := 0 to yy - 1 do begin
181 for x := 0 to xx - 1 do begin
182 for i := 0 to 1 do begin
183 xm := (x * 2 + i + y and 1) mod (xx * 2);
184 MiniPixel.SetX(xm);
185 cm := Colors[Map[ScaleFromNative(x) * lxmax div Size.X + lxmax *
186 ((ScaleFromNative(y) * (lymax - 1) + Size.Y div 2) div (Size.Y - 1))] and
187 fTerrain, I];
188 if (PByte(MiniPixel.Pixel) >= Bitmap.RawImage.Data) and
189 (PByte(MiniPixel.Pixel) < (Bitmap.RawImage.Data + yy * MiniPixel.BytesPerLine)) then begin
190 MiniPixel.PixelB := ((cm shr 16) and $FF) * Brightness div 3;
191 MiniPixel.PixelG := ((cm shr 8) and $FF) * Brightness div 3;
192 MiniPixel.PixelR := ((cm shr 0) and $FF) * Brightness div 3;
193 end;
194 end;
195 end;
196 MiniPixel.NextLine;
197 end;
198 Bitmap.EndUpdate;
199end;
200
201procedure TMiniMap.PaintFile(SaveMap: TMapArray);
202var
203 i, x, y, xm, cm, Tile, OwnColor, EnemyColor: integer;
204 MiniPixel: TPixelPointer;
205 PrevMiniPixel: TPixelPointer;
206 xx, yy: Integer;
207begin
208 OwnColor := HGrSystem.Data.Canvas.Pixels[95, 67];
209 EnemyColor := HGrSystem.Data.Canvas.Pixels[96, 67];
210 Bitmap.PixelFormat := TPixelFormat.pf24bit;
211 Bitmap.SetSize(Size.X * 2, Size.Y);
212 if Mode = mmPicture then begin
213 Bitmap.BeginUpdate;
214 MiniPixel := TPixelPointer.Create(Bitmap);
215 PrevMiniPixel := TPixelPointer.Create(Bitmap);
216 xx := ScaleToNative(Size.X);
217 yy := ScaleToNative(Size.Y);
218 for y := 0 to yy - 1 do begin
219 for x := 0 to xx - 1 do begin
220 for i := 0 to 1 do begin
221 xm := (x * 2 + i + y and 1) mod (xx * 2);
222 MiniPixel.SetX(xm);
223 Tile := SaveMap[ScaleFromNative(x) + Size.X * ScaleFromNative(y)];
224 if Tile and fTerrain = fUNKNOWN then
225 cm := $000000
226 else if Tile and smCity <> 0 then begin
227 if Tile and smOwned <> 0 then cm := OwnColor
228 else cm := EnemyColor;
229 if y > 0 then begin
230 // 2x2 city dot covers two lines
231 PrevMiniPixel.SetX(xm);
232 if (PByte(PrevMiniPixel.Pixel) >= Bitmap.RawImage.Data) and
233 (PByte(PrevMiniPixel.Pixel) < (Bitmap.RawImage.Data + yy * PrevMiniPixel.BytesPerLine)) then begin
234 PrevMiniPixel.PixelB := cm shr 16;
235 PrevMiniPixel.PixelG:= cm shr 8 and $FF;
236 PrevMiniPixel.PixelR := cm and $FF;
237 end;
238 end;
239 end
240 else if (i = 0) and (Tile and smUnit <> 0) then begin
241 if Tile and smOwned <> 0 then cm := OwnColor
242 else cm := EnemyColor;
243 end else
244 cm := Colors[Tile and fTerrain, i];
245 if (PByte(MiniPixel.Pixel) >= Bitmap.RawImage.Data) and
246 (PByte(MiniPixel.Pixel) < (Bitmap.RawImage.Data + yy * MiniPixel.BytesPerLine)) then begin
247 MiniPixel.PixelB := (cm shr 16) and $ff;
248 MiniPixel.PixelG := (cm shr 8) and $ff;
249 MiniPixel.PixelR := (cm shr 0) and $ff;
250 end;
251 end;
252 end;
253 MiniPixel.NextLine;
254 if y > 0 then PrevMiniPixel.NextLine;
255 end;
256 Bitmap.EndUpdate;
257 end;
258end;
259
260procedure TMiniMap.Paint(MyMap: PTileList; MapWidth: Integer; ClientMode: Integer;
261 xxt, xwMini: Integer);
262var
263 x, y, Loc, i, hw, xm, cm, cmPolOcean, cmPolNone: integer;
264 PrevMiniPixel: TPixelPointer;
265 MiniPixel: TPixelPointer;
266 TerrainTile: Cardinal;
267 MyCity: PCity;
268 EnemyCity: PCityInfo;
269 MyUnit: PUn;
270 EnemyUnit: PUnitInfo;
271 xx, yy: Integer;
272begin
273 if not Assigned(MyMap) then Exit;
274 cmPolOcean := HGrSystem.Data.Canvas.Pixels[101, 67];
275 cmPolNone := HGrSystem.Data.Canvas.Pixels[102, 67];
276 hw := MapWidth div (xxt * 2);
277 with Bitmap.Canvas do begin
278 Brush.Color := $000000;
279 FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
280 end;
281 Bitmap.PixelFormat := TPixelFormat.pf24bit;
282 Bitmap.SetSize(Size.X * 2, Size.Y);
283 Bitmap.BeginUpdate;
284 MiniPixel := TPixelPointer.Create(Bitmap);
285 PrevMiniPixel := TPixelPointer.Create(Bitmap);
286
287 xx := ScaleToNative(Size.X);
288 yy := ScaleToNative(Size.Y);
289 for y := 0 to yy - 1 do begin
290 for x := 0 to xx - 1 do begin
291 Loc := ScaleFromNative(x) + Size.X * ScaleFromNative(y);
292 if (MyMap[Loc] and fTerrain) <> fUNKNOWN then begin
293 for i := 0 to 1 do begin
294 xm := ((x - ScaleToNative(xwMini)) * 2 + i + y and 1 - ScaleToNative(hw) +
295 xx * 5) mod (xx * 2);
296 MiniPixel.SetX(xm);
297 TerrainTile := MyMap[Loc] and fTerrain;
298 if TerrainTile > 11 then TerrainTile := 0;
299 cm := Colors[TerrainTile, i];
300 if ClientMode = cEditMap then begin
301 if MyMap[Loc] and (fPrefStartPos or fStartPos) <> 0 then
302 cm := $FFFFFF;
303 end
304 else if MyMap[Loc] and fCity <> 0 then begin
305 // City
306 MyCity := GetMyCityByLoc(Loc);
307 if Assigned(MyCity) then cm := Tribe[me].Color
308 else begin
309 EnemyCity := GetEnemyCityByLoc(Loc);
310 if Assigned(EnemyCity) then
311 cm := Tribe[EnemyCity^.Owner].Color;
312 end;
313 cm := $808080 or cm shr 1; { increase brightness }
314 if y > 0 then begin
315 // 2x2 city dot covers two lines
316 PrevMiniPixel.SetX(xm);
317 if (PByte(PrevMiniPixel.Pixel) >= Bitmap.RawImage.Data) and
318 (PByte(PrevMiniPixel.Pixel) < (Bitmap.RawImage.Data + yy * PrevMiniPixel.BytesPerLine)) then begin
319 PrevMiniPixel.PixelB := (cm shr 16) and $ff;
320 PrevMiniPixel.PixelG := (cm shr 8) and $ff;
321 PrevMiniPixel.PixelR := (cm shr 0) and $ff;
322 end;
323 end;
324 end
325 else if (i = 0) and (MyMap[Loc] and fUnit <> 0) then begin
326 // Unit
327 MyUnit := GetMyUnitByLoc(Loc);
328 if Assigned(MyUnit) then cm := Tribe[me].Color
329 else begin
330 EnemyUnit := GetEnemyUnitByLoc(Loc);
331 if Assigned(EnemyUnit) then
332 cm := Tribe[EnemyUnit.Owner].Color;
333 end;
334 cm := $808080 or cm shr 1; { increase brightness }
335 end
336 else if moPolitical in MapOptions then begin
337 // Political
338 if MyMap[Loc] and fTerrain < fGrass then cm := cmPolOcean
339 else if MyRO.Territory[Loc] < 0 then cm := cmPolNone
340 else cm := Tribe[MyRO.Territory[Loc]].Color;
341 end;
342 if (PByte(MiniPixel.Pixel) >= Bitmap.RawImage.Data) and
343 (PByte(MiniPixel.Pixel) < (Bitmap.RawImage.Data + yy * MiniPixel.BytesPerLine)) then begin
344 MiniPixel.PixelB := (cm shr 16) and $ff;
345 MiniPixel.PixelG := (cm shr 8) and $ff;
346 MiniPixel.PixelR := (cm shr 0) and $ff;
347 end;
348 end;
349 end;
350 end;
351 MiniPixel.NextLine;
352 if y > 0 then PrevMiniPixel.NextLine;
353 end;
354 Bitmap.EndUpdate;
355end;
356
357end.
358
359
Note: See TracBrowser for help on using the repository browser.