hedgewars/uLand.pas
branchhedgeroid
changeset 5725 e27100a0e2d0
parent 5495 272ed78e59a7
parent 5719 0ed1f543f301
child 5824 2e5835130d9a
equal deleted inserted replaced
5671:ba4c3a4c8b09 5725:e27100a0e2d0
    28     DIR_S: direction = (x: 0; y: 1);
    28     DIR_S: direction = (x: 0; y: 1);
    29     DIR_W: direction = (x: -1; y: 0);
    29     DIR_W: direction = (x: -1; y: 0);
    30 
    30 
    31 procedure initModule;
    31 procedure initModule;
    32 procedure freeModule;
    32 procedure freeModule;
       
    33 procedure DrawBottomBorder;
    33 procedure GenMap;
    34 procedure GenMap;
    34 function  GenPreview: TPreview;
    35 function  GenPreview: TPreview;
    35 
    36 
    36 implementation
    37 implementation
    37 uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture, sysutils,
    38 uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture, sysutils,
  1068                (((Land[y, x-1] = lfBasic) and ((Land[y+1,x] = lfBasic)) or (Land[y-1,x] = lfBasic)) or
  1069                (((Land[y, x-1] = lfBasic) and ((Land[y+1,x] = lfBasic)) or (Land[y-1,x] = lfBasic)) or
  1069                ((Land[y, x+1] = lfBasic) and ((Land[y-1,x] = lfBasic) or (Land[y+1,x] = lfBasic)))) then
  1070                ((Land[y, x+1] = lfBasic) and ((Land[y-1,x] = lfBasic) or (Land[y+1,x] = lfBasic)))) then
  1070             begin
  1071             begin
  1071                 if (cReducedQuality and rqBlurryLand) = 0 then
  1072                 if (cReducedQuality and rqBlurryLand) = 0 then
  1072                     begin
  1073                     begin
  1073                     if Land[y, x-1] = lfBasic then LandPixels[y, x]:= LandPixels[y, x-1]
  1074                     if (Land[y, x-1] = lfBasic) and (LandPixels[y, x-1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x-1]
  1074                     else if Land[y, x+1] = lfBasic then LandPixels[y, x]:= LandPixels[y, x+1];
  1075                     else if (Land[y, x+1] = lfBasic) and (LandPixels[y, x+1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x+1]
  1075                     LandPixels[y,x]:= (LandPixels[y,x] and not AMask) or (128 shl AShift)
  1076                     else if (Land[y-1, x] = lfBasic) and (LandPixels[y-1, x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y-1, x]
       
  1077                     else if (Land[y+1, x] = lfBasic) and (LandPixels[y+1, x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y+1, x];
       
  1078                     if (((LandPixels[y,x] and AMask) shr AShift) > 10) then LandPixels[y,x]:= (LandPixels[y,x] and not AMask) or (128 shl AShift)
  1076                     end;
  1079                     end;
  1077                 Land[y,x]:= lfObject
  1080                 Land[y,x]:= lfObject
  1078             end
  1081             end
  1079             else if (Land[y, x] = 0) and
  1082             else if (Land[y, x] = 0) and
  1080                     (((Land[y, x-1] = lfBasic) and (Land[y+1,x-1] = lfBasic) and (Land[y+2,x] = lfBasic)) or
  1083                     (((Land[y, x-1] = lfBasic) and (Land[y+1,x-1] = lfBasic) and (Land[y+2,x] = lfBasic)) or
  1086                     ((Land[y+1, x] = lfBasic) and (Land[y+1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic)) or
  1089                     ((Land[y+1, x] = lfBasic) and (Land[y+1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic)) or
  1087                     ((Land[y-1, x] = lfBasic) and (Land[y-1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic))) then
  1090                     ((Land[y-1, x] = lfBasic) and (Land[y-1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic))) then
  1088             begin
  1091             begin
  1089                 if (cReducedQuality and rqBlurryLand) = 0 then
  1092                 if (cReducedQuality and rqBlurryLand) = 0 then
  1090                     begin
  1093                     begin
  1091                     if Land[y, x-1] = lfBasic then LandPixels[y, x]:= LandPixels[y, x-1]
  1094                     if (Land[y, x-1] = lfBasic) and (LandPixels[y,x-1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x-1]
  1092                     else if Land[y, x+1] = lfBasic then LandPixels[y, x]:= LandPixels[y, x+1]
  1095                     else if (Land[y, x+1] = lfBasic) and (LandPixels[y,x+1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x+1]
  1093                     else if Land[y+1, x] = lfBasic then LandPixels[y, x]:= LandPixels[y+1, x]
  1096                     else if (Land[y+1, x] = lfBasic) and (LandPixels[y+1,x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y+1, x]
  1094                     else if Land[y-1, x] = lfBasic then LandPixels[y, x]:= LandPixels[y-1, x];
  1097                     else if (Land[y-1, x] = lfBasic) and (LandPixels[y-1,x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y-1, x];
  1095                     LandPixels[y,x]:= (LandPixels[y,x] and not AMask) or (64 shl AShift)
  1098                     if (((LandPixels[y,x] and AMask) shr AShift) > 10) then LandPixels[y,x]:= (LandPixels[y,x] and not AMask) or (64 shl AShift)
  1096                     end;
  1099                     end;
  1097                 Land[y,x]:= lfObject
  1100                 Land[y,x]:= lfObject
  1098             end;
  1101             end;
  1099 
  1102 
  1100     AddProgress();
  1103     AddProgress();
  1216     tmpsurf^.w,
  1219     tmpsurf^.w,
  1217     tmpsurf);
  1220     tmpsurf);
  1218 SDL_FreeSurface(tmpsurf);
  1221 SDL_FreeSurface(tmpsurf);
  1219 
  1222 
  1220 LoadMask(mapname);
  1223 LoadMask(mapname);
       
  1224 end;
       
  1225 
       
  1226 procedure DrawBottomBorder; // broken out from other borders for doing a floor-only map, or possibly updating bottom during SD
       
  1227 var x, y, w, c: Longword;
       
  1228 begin
       
  1229 for w:= 0 to 23 do
       
  1230     for x:= leftX to rightX do
       
  1231         begin
       
  1232         Land[cWaterLine-1 - w, x]:= lfIndestructible;
       
  1233         if (x + w) mod 32 < 16 then
       
  1234             c:= AMask
       
  1235         else
       
  1236             c:= AMask or RMask or GMask; // FF00FFFF
       
  1237 
       
  1238         if (cReducedQuality and rqBlurryLand) = 0 then
       
  1239             LandPixels[cWaterLine-1 - w, x]:= c
       
  1240         else
       
  1241             LandPixels[(cWaterLine-1 - w) div 2, x div 2]:= c
       
  1242         end
  1221 end;
  1243 end;
  1222 
  1244 
  1223 procedure GenMap;
  1245 procedure GenMap;
  1224 var x, y, w, c: Longword;
  1246 var x, y, w, c: Longword;
  1225 begin
  1247 begin
  1268     // experiment hardcoding cave
  1290     // experiment hardcoding cave
  1269     // also try basing cave dimensions on map/template dimensions, if they exist
  1291     // also try basing cave dimensions on map/template dimensions, if they exist
  1270     for w:= 0 to 5 do // width of 3 allowed hogs to be knocked through with grenade
  1292     for w:= 0 to 5 do // width of 3 allowed hogs to be knocked through with grenade
  1271         begin
  1293         begin
  1272         for y:= topY to LAND_HEIGHT - 1 do
  1294         for y:= topY to LAND_HEIGHT - 1 do
  1273             begin
  1295                 begin
  1274                 Land[y, leftX + w]:= lfIndestructible;
  1296                 Land[y, leftX + w]:= lfIndestructible;
  1275                 Land[y, rightX - w]:= lfIndestructible;
  1297                 Land[y, rightX - w]:= lfIndestructible;
  1276                 if (y + w) mod 32 < 16 then
  1298                 if (y + w) mod 32 < 16 then
  1277                     c:= AMask
  1299                     c:= AMask
  1278                 else
  1300                 else
  1279                     c:= AMask or RMask or GMask; // FF00FFFF
  1301                     c:= AMask or RMask or GMask; // FF00FFFF
  1280 
  1302 
  1281                 if (cReducedQuality and rqBlurryLand) = 0 then
  1303                 if (cReducedQuality and rqBlurryLand) = 0 then
  1282                 begin
  1304                     begin
  1283                     LandPixels[y, leftX + w]:= c;
  1305                     LandPixels[y, leftX + w]:= c;
  1284                     LandPixels[y, rightX - w]:= c;
  1306                     LandPixels[y, rightX - w]:= c;
  1285                 end
  1307                     end
  1286                 else
  1308                 else
  1287                 begin
  1309                     begin
  1288                     LandPixels[y div 2, (leftX + w) div 2]:= c;
  1310                     LandPixels[y div 2, (leftX + w) div 2]:= c;
  1289                     LandPixels[y div 2, (rightX - w) div 2]:= c;
  1311                     LandPixels[y div 2, (rightX - w) div 2]:= c;
       
  1312                     end;
  1290                 end;
  1313                 end;
  1291             end;
       
  1292 
  1314 
  1293         for x:= leftX to rightX do
  1315         for x:= leftX to rightX do
  1294             begin
  1316             begin
  1295                 Land[topY + w, x]:= lfIndestructible;
  1317             Land[topY + w, x]:= lfIndestructible;
  1296                 if (x + w) mod 32 < 16 then
  1318             if (x + w) mod 32 < 16 then
  1297                     c:= AMask
  1319                 c:= AMask
  1298                 else
  1320             else
  1299                     c:= AMask or RMask or GMask; // FF00FFFF
  1321                 c:= AMask or RMask or GMask; // FF00FFFF
  1300 
  1322 
  1301                 if (cReducedQuality and rqBlurryLand) = 0 then
  1323             if (cReducedQuality and rqBlurryLand) = 0 then
  1302                     LandPixels[topY + w, x]:= c
  1324                 LandPixels[topY + w, x]:= c
  1303                 else
  1325             else
  1304                     LandPixels[(topY + w) div 2, x div 2]:= c;
  1326                 LandPixels[(topY + w) div 2, x div 2]:= c;
  1305             end;
  1327             end;
  1306         end;
  1328         end;
  1307     end;
  1329     end;
       
  1330 
       
  1331 if (GameFlags and gfBottomBorder) <> 0 then DrawBottomBorder;
  1308 
  1332 
  1309 if (GameFlags and gfDisableGirders) <> 0 then hasGirders:= false;
  1333 if (GameFlags and gfDisableGirders) <> 0 then hasGirders:= false;
  1310 
  1334 
  1311 if ((GameFlags and gfForts) = 0)
  1335 if ((GameFlags and gfForts) = 0)
  1312     and (Pathz[ptMapCurrent] = '')
  1336     and (Pathz[ptMapCurrent] = '')