hedgewars/uLand.pas
changeset 11019 67ef02300508
parent 11006 cb06b7985261
child 11046 47a8c19ecb60
equal deleted inserted replaced
11018:b524ae93098f 11019:67ef02300508
    34      uVariables, uUtils, uCommands, adler32, uDebug, uLandPainted, uTextures,
    34      uVariables, uUtils, uCommands, adler32, uDebug, uLandPainted, uTextures,
    35      uLandGenMaze, uPhysFSLayer, uScript, uLandGenPerlin,
    35      uLandGenMaze, uPhysFSLayer, uScript, uLandGenPerlin,
    36      uLandGenTemplateBased, uLandUtils;
    36      uLandGenTemplateBased, uLandUtils;
    37 
    37 
    38 var digest: shortstring;
    38 var digest: shortstring;
       
    39     maskOnly: boolean;
    39 
    40 
    40 
    41 
    41 procedure PrettifyLandAlpha();
    42 procedure PrettifyLandAlpha();
    42 begin
    43 begin
    43     if (cReducedQuality and rqBlurryLand) <> 0 then
    44     if (cReducedQuality and rqBlurryLand) <> 0 then
    48 
    49 
    49 procedure DrawBorderFromImage(Surface: PSDL_Surface);
    50 procedure DrawBorderFromImage(Surface: PSDL_Surface);
    50 var tmpsurf: PSDL_Surface;
    51 var tmpsurf: PSDL_Surface;
    51     r, rr: TSDL_Rect;
    52     r, rr: TSDL_Rect;
    52     x, yd, yu: LongInt;
    53     x, yd, yu: LongInt;
       
    54     targetMask: Word;
    53 begin
    55 begin
    54     tmpsurf:= LoadDataImage(ptCurrTheme, 'Border', ifCritical or ifIgnoreCaps or ifTransparent);
    56     tmpsurf:= LoadDataImage(ptCurrTheme, 'Border', ifCritical or ifIgnoreCaps or ifTransparent);
       
    57 
       
    58     // if mask only, all land gets filled with landtex and therefore needs borders
       
    59     if maskOnly then
       
    60         targetMask:= lfLandMask
       
    61     else
       
    62         targetMask:= lfBasic;
       
    63 
    55     for x:= 0 to LAND_WIDTH - 1 do
    64     for x:= 0 to LAND_WIDTH - 1 do
    56     begin
    65     begin
    57         yd:= LAND_HEIGHT - 1;
    66         yd:= LAND_HEIGHT - 1;
    58         repeat
    67         repeat
    59             while (yd > 0) and (Land[yd, x] <> lfBasic) do dec(yd);
    68             while (yd > 0) and ((Land[yd, x] and targetMask) = 0) do dec(yd);
    60 
    69 
    61             if (yd < 0) then
    70             if (yd < 0) then
    62                 yd:= 0;
    71                 yd:= 0;
    63 
    72 
    64             while (yd < LAND_HEIGHT) and (Land[yd, x] = lfBasic) do
    73             while (yd < LAND_HEIGHT) and ((Land[yd, x] and targetMask) <> 0) do
    65                 inc(yd);
    74                 inc(yd);
    66             dec(yd);
    75             dec(yd);
    67             yu:= yd;
    76             yu:= yd;
    68 
    77 
    69             while (yu > 0  ) and (Land[yu, x] = lfBasic) do dec(yu);
    78             while (yu > 0  ) and ((Land[yu, x] and targetMask) <> 0) do dec(yu);
    70             while (yu < yd ) and (Land[yu, x] <>  lfBasic) do inc(yu);
    79             while (yu < yd ) and ((Land[yu, x] and targetMask) =  0) do inc(yu);
    71 
    80 
    72             if (yd < LAND_HEIGHT - 1) and ((yd - yu) >= 16) then
    81             if (yd < LAND_HEIGHT - 1) and ((yd - yu) >= 16) then
    73                 begin
    82                 begin
    74                 rr.x:= x;
    83                 rr.x:= x;
    75                 rr.y:= yd - 15;
    84                 rr.y:= yd - 15;
   523 end;
   532 end;
   524 
   533 
   525 procedure GenMap;
   534 procedure GenMap;
   526 var x, y, w, c: Longword;
   535 var x, y, w, c: Longword;
   527     map, mask: shortstring;
   536     map, mask: shortstring;
   528     maskOnly: boolean;
       
   529 begin
   537 begin
   530     hasBorder:= false;
   538     hasBorder:= false;
   531     maskOnly:= false;
   539     maskOnly:= false;
   532 
   540 
   533     LoadThemeConfig;
   541     LoadThemeConfig;
   808     RegisterVariable('landcheck', @chLandCheck, false);
   816     RegisterVariable('landcheck', @chLandCheck, false);
   809     RegisterVariable('sendlanddigest', @chSendLandDigest, false);
   817     RegisterVariable('sendlanddigest', @chSendLandDigest, false);
   810 
   818 
   811     LandBackSurface:= nil;
   819     LandBackSurface:= nil;
   812     digest:= '';
   820     digest:= '';
       
   821     maskOnly:= false;
   813     LAND_WIDTH:= 0;
   822     LAND_WIDTH:= 0;
   814     LAND_HEIGHT:= 0;
   823     LAND_HEIGHT:= 0;
   815 (*
   824 (*
   816     if (cReducedQuality and rqBlurryLand) = 0 then
   825     if (cReducedQuality and rqBlurryLand) = 0 then
   817         SetLength(LandPixels, LAND_HEIGHT, LAND_WIDTH)
   826         SetLength(LandPixels, LAND_HEIGHT, LAND_WIDTH)