Changeset 326
- Timestamp:
- Mar 24, 2021, 12:08:28 AM (4 years ago)
- Location:
- trunk
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/GameServer.pas
r319 r326 44 44 fDotNet = $20000000; 45 45 fUsed = $40000000; 46 47 // save map tile flags48 smOwned = $20;49 smUnit = $40;50 smCity = $80;51 46 52 47 maxBrain = 255; -
trunk/LocalPlayer/ClientTools.pas
r294 r326 59 59 procedure CityOptimizer_AfterRemoveUnit; 60 60 procedure CityOptimizer_EndOfTurn; 61 function GetMyCityByLoc(Loc: Integer): PCity; 62 function GetEnemyCityByLoc(Loc: Integer): PCityInfo; 63 function GetMyUnitByLoc(Loc: Integer): PUn; 64 function GetEnemyUnitByLoc(Loc: Integer): PUnitInfo; 61 65 62 66 … … 696 700 end; 697 701 702 function GetMyCityByLoc(Loc: Integer): PCity; 703 var 704 I: Integer; 705 begin 706 I := MyRO.nCity - 1; 707 while (I >= 0) and (MyCity[I].Loc <> Loc) do Dec(I); 708 if I >= 0 then Result := @MyCity[I] 709 else Result := nil; 710 end; 711 712 function GetEnemyCityByLoc(Loc: Integer): PCityInfo; 713 var 714 I: Integer; 715 begin 716 I := MyRO.nEnemyCity - 1; 717 while (I >= 0) and (MyRo.EnemyCity[I].Loc <> Loc) do Dec(I); 718 if I >= 0 then Result := @MyRo.EnemyCity[I] 719 else Result := nil; 720 end; 721 722 function GetMyUnitByLoc(Loc: Integer): PUn; 723 var 724 I: Integer; 725 begin 726 I := MyRO.nUn - 1; 727 while (I >= 0) and (MyUn[I].Loc <> Loc) do Dec(I); 728 if I >= 0 then Result := @MyUn[I] 729 else Result := nil; 730 end; 731 732 function GetEnemyUnitByLoc(Loc: Integer): PUnitInfo; 733 var 734 I: Integer; 735 begin 736 I := MyRO.nEnemyUn - 1; 737 while (I >= 0) and (MyRO.EnemyUn[I].Loc <> Loc) do Dec(I); 738 if I >= 0 then Result := @MyRO.EnemyUn[I] 739 else Result := nil; 740 end; 741 742 698 743 initialization 699 744 -
trunk/LocalPlayer/IsoEngine.pas
r325 r326 80 80 var 81 81 NoMap: TIsoMap; 82 Options: integer;83 pDebugMap: integer; // -1 for off82 Options: Integer; 83 pDebugMap: Integer; // -1 for off 84 84 85 85 function IsJungle(y: integer): boolean; … … 87 87 function ApplyTileSize(ATileSize: TTileSize): boolean; 88 88 procedure Done; 89 procedure Reset;89 procedure IsoEngineReset; 90 90 91 91 implementation … … 466 466 end; 467 467 468 procedure Reset;468 procedure IsoEngineReset; 469 469 begin 470 470 BordersOK := 0; -
trunk/LocalPlayer/Term.pas
r325 r326 14 14 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, DrawDlg, Types, 15 15 Forms, Menus, ExtCtrls, dateutils, Platform, ButtonB, ButtonC, EOTButton, Area, 16 UGraphicSet ;16 UGraphicSet, UMiniMap; 17 17 18 18 const … … 253 253 trix: array [0 .. 63] of Integer; 254 254 AILogo: array [0 .. nPl - 1] of TBitmap; 255 Mini : TBitmap;255 MiniMap: TMiniMap; 256 256 Panel: TBitmap; 257 257 TopBar: TBitmap; … … 274 274 procedure ArrangeMidPanel; 275 275 procedure MainOffscreenPaint; 276 procedure Mini Paint;276 procedure MiniMapPaint; 277 277 procedure PaintAll; 278 278 procedure PaintAllMaps; … … 1266 1266 procedure TMainScreen.SetMapOptions; 1267 1267 begin 1268 MiniMap.Options := MapOptionChecked; 1268 1269 IsoEngine.Options := MapOptionChecked; 1269 1270 if ClientMode = cEditMap then … … 2586 2587 GameMode := Command; 2587 2588 GrExt.ResetPixUsed; 2588 IsoEngine .Reset;2589 IsoEngineReset; 2589 2590 Tribes.Init; 2590 2591 GetTribeList; … … 2639 2640 CityDlg.Reset; 2640 2641 2641 Mini .SetSize(G.lx * 2, G.ly);2642 MiniMap.Size := Point(G.lx, G.ly); 2642 2643 for i := 0 to nPl - 1 do 2643 2644 begin … … 2842 2843 MyData := G.RO[NewPlayer].Data; 2843 2844 SetTroopLoc(-1); 2844 Mini Paint;2845 MiniMapPaint; 2845 2846 InitAllEnemyModels; // necessary for correct replay 2846 2847 if not EndTurn(true) then … … 3524 3525 end; 3525 3526 3526 Mini := TBitmap.Create; 3527 Mini.PixelFormat := pf24bit; 3527 MiniMap := TMiniMap.Create; 3528 3528 Panel := TBitmap.Create; 3529 3529 Panel.PixelFormat := pf24bit; … … 3560 3560 FreeAndNil(sb); 3561 3561 FreeAndNil(TopBar); 3562 FreeAndNil(Mini );3562 FreeAndNil(MiniMap); 3563 3563 FreeAndNil(Buffer); 3564 3564 FreeAndNil(Panel); … … 4106 4106 end; 4107 4107 4108 procedure TMainScreen.MiniPaint;4109 var4110 uix, cix, x, y, Loc, i, hw, xm, cm, cmPolOcean, cmPolNone: integer;4111 PrevMiniPixel: TPixelPointer;4112 MiniPixel: TPixelPointer;4113 TerrainTile: Cardinal;4114 begin4115 if not Assigned(MyMap) then Exit;4116 cmPolOcean := HGrSystem.Data.Canvas.Pixels[101, 67];4117 cmPolNone := HGrSystem.Data.Canvas.Pixels[102, 67];4118 hw := MapWidth div (xxt * 2);4119 with Mini.Canvas do begin4120 Brush.Color := $000000;4121 FillRect(Rect(0, 0, Mini.width, Mini.height));4122 end;4123 Mini.BeginUpdate;4124 MiniPixel := PixelPointer(Mini);4125 PrevMiniPixel := PixelPointer(Mini);4126 for y := 0 to ScaleToNative(G.ly) - 1 do begin4127 for x := 0 to ScaleToNative(G.lx) - 1 do begin4128 Loc := ScaleFromNative(x) + G.lx * ScaleFromNative(y);4129 if (MyMap[Loc] and fTerrain) <> fUNKNOWN then begin4130 for i := 0 to 1 do begin4131 xm := ((x - ScaleToNative(xwMini)) * 2 + i + y and 1 - ScaleToNative(hw) +4132 ScaleToNative(G.lx) * 5) mod (ScaleToNative(G.lx) * 2);4133 MiniPixel.SetXY(xm, y);4134 TerrainTile := MyMap[Loc] and fTerrain;4135 if TerrainTile > 11 then TerrainTile := 0;4136 cm := MiniColors[TerrainTile, i];4137 if ClientMode = cEditMap then4138 begin4139 if MyMap[Loc] and (fPrefStartPos or fStartPos) <> 0 then4140 cm := $FFFFFF;4141 end4142 else if MyMap[Loc] and fCity <> 0 then4143 begin4144 cix := MyRO.nCity - 1;4145 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do4146 dec(cix);4147 if cix >= 0 then4148 cm := Tribe[me].Color4149 else4150 begin4151 cix := MyRO.nEnemyCity - 1;4152 while (cix >= 0) and (MyRO.EnemyCity[cix].Loc <> Loc) do4153 dec(cix);4154 if cix >= 0 then4155 cm := Tribe[MyRO.EnemyCity[cix].Owner].Color4156 end;4157 cm := $808080 or cm shr 1; { increase brightness }4158 if y > 0 then begin4159 // 2x2 city dot covers two lines4160 PrevMiniPixel.SetXY(xm, y - 1);4161 PrevMiniPixel.Pixel^.B := cm shr 16;4162 PrevMiniPixel.Pixel^.G := cm shr 8 and $FF;4163 PrevMiniPixel.Pixel^.R := cm and $FF;4164 end;4165 end4166 else if (i = 0) and (MyMap[Loc] and fUnit <> 0) then4167 begin4168 uix := MyRO.nUn - 1;4169 while (uix >= 0) and (MyUn[uix].Loc <> Loc) do4170 dec(uix);4171 if uix >= 0 then4172 cm := Tribe[me].Color4173 else4174 begin4175 uix := MyRO.nEnemyUn - 1;4176 while (uix >= 0) and (MyRO.EnemyUn[uix].Loc <> Loc) do4177 dec(uix);4178 if uix >= 0 then4179 cm := Tribe[MyRO.EnemyUn[uix].Owner].Color4180 end;4181 cm := $808080 or cm shr 1; { increase brightness }4182 end4183 else if MapOptionChecked and (1 shl moPolitical) <> 0 then4184 begin4185 if MyMap[Loc] and fTerrain < fGrass then4186 cm := cmPolOcean4187 else if MyRO.Territory[Loc] < 0 then4188 cm := cmPolNone4189 else4190 cm := Tribe[MyRO.Territory[Loc]].Color;4191 end;4192 MiniPixel.Pixel^.B := cm shr 16;4193 MiniPixel.Pixel^.G := cm shr 8 and $FF;4194 MiniPixel.Pixel^.R := cm and $FF;4195 end;4196 end;4197 end;4198 end;4199 Mini.EndUpdate;4200 end;4201 4202 4108 {$IFDEF LINUX} 4203 4109 // Can't do scrolling of DC under Linux, then fallback into BitBlt. … … 4327 4233 end; 4328 4234 4235 procedure TMainScreen.MiniMapPaint; 4236 begin 4237 MiniMap.Paint(MyMap, MapWidth, ClientMode, xxt, xwMini); 4238 end; 4239 4329 4240 procedure TMainScreen.PaintAll; 4330 4241 begin … … 4332 4243 xwMini := xw; 4333 4244 ywMini := yw; 4334 Mini Paint;4245 MiniMapPaint; 4335 4246 PanelPaint; 4336 4247 end; … … 4341 4252 xwMini := xw; 4342 4253 ywMini := yw; 4343 Mini Paint;4254 MiniMapPaint; 4344 4255 CopyMiniToPanel; 4345 4256 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 2, … … 4351 4262 begin 4352 4263 BitBltCanvas(Panel.Canvas, xMini + 2, yMini + 2, G.lx * 2, G.ly, 4353 Mini .Canvas, 0, 0);4264 MiniMap.Bitmap.Canvas, 0, 0); 4354 4265 if MarkCityLoc >= 0 then 4355 4266 Sprite(Panel, HGrSystem, xMini - 2 + (4 * G.lx + 2 * (MarkCityLoc mod G.lx) … … 4358 4269 CityMark2.Height, CityMark2.Left, CityMark2.Top) 4359 4270 else if ywmax <= 0 then 4360 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (xxt * 2), yMini + 2, 4271 Frame(Panel.Canvas, 4272 xMini + 2 + G.lx - MapWidth div (xxt * 2), yMini + 2, 4361 4273 xMini + 1 + G.lx + MapWidth div (xxt * 2), yMini + 2 + G.ly - 1, 4362 4274 MainTexture.clMark, MainTexture.clMark) 4363 4275 else 4364 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (xxt * 2), 4365 yMini + 2 + yw, xMini + 1 + G.lx + MapWidth div (xxt * 2), 4366 yMini + yw + MapHeight div yyt, MainTexture.clMark, MainTexture.clMark); 4276 Frame(Panel.Canvas, 4277 xMini + 2 + G.lx - MapWidth div (xxt * 2), yMini + 2 + yw, 4278 xMini + 1 + G.lx + MapWidth div (xxt * 2), yMini + yw + MapHeight div yyt, 4279 MainTexture.clMark, MainTexture.clMark); 4367 4280 end; 4368 4281 … … 5092 5005 xwMini := xw; 5093 5006 ywMini := yw; 5094 Mini Paint;5007 MiniMapPaint; 5095 5008 CopyMiniToPanel; 5096 5009 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 2, … … 5298 5211 BrushLoc := MouseLoc; 5299 5212 PaintLoc(MouseLoc, 2); 5300 Mini Paint;5213 MiniMapPaint; 5301 5214 BitBltCanvas(Panel.Canvas, xMini + 2, yMini + 2, G.lx * 2, G.ly, 5302 Mini .Canvas, 0, 0);5215 MiniMap.Bitmap.Canvas, 0, 0); 5303 5216 if ywmax <= 0 then 5304 5217 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (2 * xxt), … … 7570 7483 yw := ywmax; 7571 7484 end; 7572 BitBltCanvas(Buffer.Canvas, 0, 0, G.lx * 2, G.ly, Mini .Canvas, 0, 0);7485 BitBltCanvas(Buffer.Canvas, 0, 0, G.lx * 2, G.ly, MiniMap.Bitmap.Canvas, 0, 0); 7573 7486 if ywmax <= 0 then 7574 7487 Frame(Buffer.Canvas, x - xMini - 2 - MapWidth div (xxt * 2), 0, … … 7600 7513 xwMini := xw; 7601 7514 ywMini := yw; 7602 Mini Paint;7515 MiniMapPaint; 7603 7516 PanelPaint; 7604 7517 end; … … 7881 7794 end 7882 7795 else if Flag = tfAllTechs then 7883 TellNewModels 7796 TellNewModels; 7884 7797 end; 7885 7798 end; … … 7892 7805 MapOptionChecked := MapOptionChecked xor (1 shl (Tag shr 8)); 7893 7806 SetMapOptions; 7894 ButtonIndex := MapOptionChecked shr (Tag shr 8) and 1 + 2 7807 ButtonIndex := MapOptionChecked shr (Tag shr 8) and 1 + 2; 7895 7808 end; 7896 7809 if Sender = MapBtn0 then 7897 7810 begin 7898 Mini Paint;7899 PanelPaint 7811 MiniMapPaint; 7812 PanelPaint; 7900 7813 end // update mini map only 7901 7814 else -
trunk/Protocol.pas
r319 r326 1291 1291 Flags: Cardinal; 1292 1292 end; 1293 PUn = ^TUn; 1293 1294 1294 1295 { TCity } … … 1314 1315 // array value =1 indicates built improvement 1315 1316 end; 1317 PCity = ^TCity; 1316 1318 1317 1319 TModel = packed record … … 1352 1354 Flags: Word; 1353 1355 end; 1356 PUnitInfo = ^TUnitInfo; 1354 1357 1355 1358 TCityInfo = packed record … … 1362 1365 Flags: Word; 1363 1366 end; 1367 PCityInfo = ^TCityInfo; 1364 1368 1365 1369 TModelInfo = packed record … … 1591 1595 1592 1596 TTileList = array [0 .. INFIN] of Cardinal; 1597 PTileList = ^TTileList; 1593 1598 TTileObservedLastList = array [0 .. INFIN] of SmallInt; 1594 1599 TOwnerList = array [0 .. INFIN] of ShortInt; -
trunk/UMiniMap.pas
r320 r326 22 22 Colors: array [0 .. 11, 0 .. 1] of TColor; 23 23 Mode: TMiniMode; 24 Options: Integer; 24 25 procedure LoadFromLogFile(FileName: string; var LastTurn: Integer; DefaultSize: TPoint); 25 26 procedure LoadFromMapFile(FileName: string; var nMapLandTiles, nMapStartPositions: Integer); 26 27 procedure PaintRandom(Brightness, StartLandMass: Integer; WorldSize: TPoint); 27 28 procedure PaintFile(SaveMap: TMapArray); 29 procedure Paint(MyMap: PTileList; MapWidth: Integer; ClientMode: Integer; 30 xxt, xwMini: Integer); 28 31 constructor Create; 29 32 destructor Destroy; override; … … 34 37 35 38 uses 36 ScreenTools, UPixelPointer, Global, GameServer; 39 ScreenTools, UPixelPointer, Global, GameServer, IsoEngine, Tribes, ClientTools; 40 41 const 42 // save map tile flags 43 smOwned = $20; 44 smUnit = $40; 45 smCity = $80; 37 46 38 47 { TMiniMap } … … 169 178 xm := (x * 2 + i + y and 1) mod (ScaleToNative(Size.X) * 2); 170 179 MiniPixel.SetX(xm); 171 cm := Colors 172 [Map[ScaleFromNative(x) * lxmax div Size.X + lxmax * 180 cm := Colors[Map[ScaleFromNative(x) * lxmax div Size.X + lxmax * 173 181 ((ScaleFromNative(y) * (lymax - 1) + Size.Y div 2) div (Size.Y - 1))] and 174 182 fTerrain, i]; … … 205 213 if Tile and fTerrain = fUNKNOWN then 206 214 cm := $000000 207 else if Tile and smCity <> 0 then 208 begin 209 if Tile and smOwned <> 0 then 210 cm := OwnColor 211 else 212 cm := EnemyColor; 215 else if Tile and smCity <> 0 then begin 216 if Tile and smOwned <> 0 then cm := OwnColor 217 else cm := EnemyColor; 213 218 if y > 0 then begin 214 219 // 2x2 city dot covers two lines … … 219 224 end; 220 225 end 221 else if (i = 0) and (Tile and smUnit <> 0) then 222 if Tile and smOwned <> 0 then 223 cm := OwnColor 224 else cm := EnemyColor 225 else 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 226 230 cm := Colors[Tile and fTerrain, i]; 227 231 MiniPixel.Pixel^.B := (cm shr 16) and $ff; … … 237 241 end; 238 242 243 procedure TMiniMap.Paint(MyMap: PTileList; MapWidth: Integer; ClientMode: Integer; 244 xxt, xwMini: Integer); 245 var 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; 254 begin 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 Options and (1 shl moPolitical) <> 0 then begin 313 // Political 314 if MyMap[Loc] and fTerrain < fGrass then 315 cm := cmPolOcean 316 else if MyRO.Territory[Loc] < 0 then 317 cm := cmPolNone 318 else 319 cm := Tribe[MyRO.Territory[Loc]].Color; 320 end; 321 MiniPixel.Pixel^.B := (cm shr 16) and $ff; 322 MiniPixel.Pixel^.G := (cm shr 8) and $ff; 323 MiniPixel.Pixel^.R := (cm shr 0) and $ff; 324 end; 325 end; 326 end; 327 MiniPixel.NextLine; 328 PrevMiniPixel.NextLine; 329 end; 330 Bitmap.EndUpdate; 331 end; 332 239 333 240 334 end.
Note:
See TracChangeset
for help on using the changeset viewer.