source: tags/1.3.5/MiniMap.pas

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