source: tags/1.3.1/UMiniMap.pas

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