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