hedgewars: comparison hedgewars/uLand.pas

equal deleted inserted replaced

-:31570b766315
+:ed5a6478e710
 (*
 * Hedgewars, a free turn based strategy game
-* Copyright (c) 2004-2013 Andrey Korotaev <unC0Rr@gmail.com>
+* Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; version 2 of the License
 *
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
-* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+* Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 *)
 {$INCLUDE "options.inc"}
 unit uLand;
 interface
-uses SDLh, uLandTemplates, uFloat, uConsts, uTypes, uAILandMarks;
+uses SDLh, uLandTemplates, uConsts, uTypes, uAILandMarks;
 procedure initModule;
 procedure freeModule;
 procedure DrawBottomBorder;
 procedure GenMap;
 procedure GenPreview(out Preview: TPreview);
+procedure GenPreviewAlpha(out Preview: TPreviewAlpha);
 implementation
 uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture, SysUtils,
 uVariables, uUtils, uCommands, adler32, uDebug, uLandPainted, uTextures,
-uLandGenMaze, uLandOutline, uPhysFSLayer;
+uLandGenMaze, uPhysFSLayer, uScript, uLandGenPerlin,
+uLandGenTemplateBased, uLandUtils;
 var digest: shortstring;
+maskOnly: boolean;
-procedure ResizeLand(width, height: LongWord);
-var potW, potH: LongInt;
-begin
+procedure PrettifyLandAlpha();
-potW:= toPowerOf2(width);
+begin
-potH:= toPowerOf2(height);
+if (cReducedQuality and rqBlurryLand) <> 0 then
-if (potW <> LAND_WIDTH) or (potH <> LAND_HEIGHT) then
+PrettifyAlpha2D(LandPixels, LAND_HEIGHT div 2, LAND_WIDTH div 2)
-begin
-LAND_WIDTH:= potW;
-LAND_HEIGHT:= potH;
-LAND_WIDTH_MASK:= not(LAND_WIDTH-1);
-LAND_HEIGHT_MASK:= not(LAND_HEIGHT-1);
-cWaterLine:= LAND_HEIGHT;
-if (cReducedQuality and rqBlurryLand) = 0 then
-SetLength(LandPixels, LAND_HEIGHT, LAND_WIDTH)
 else
-SetLength(LandPixels, LAND_HEIGHT div 2, LAND_WIDTH div 2);
+PrettifyAlpha2D(LandPixels, LAND_HEIGHT, LAND_WIDTH);
+end;
-SetLength(Land, LAND_HEIGHT, LAND_WIDTH);
-SetLength(LandDirty, (LAND_HEIGHT div 32), (LAND_WIDTH div 32));
-// 0.5 is already approaching on unplayable
-if (width div 4096 >= 2) or (height div 2048 >= 2) then cMaxZoomLevel:= 0.5;
-cMinMaxZoomLevelDelta:= cMaxZoomLevel - cMinZoomLevel
-end;
-end;
 procedure DrawBorderFromImage(Surface: PSDL_Surface);
 var tmpsurf: PSDL_Surface;
 r, rr: TSDL_Rect;
 x, yd, yu: LongInt;
+targetMask: Word;
 begin
 tmpsurf:= LoadDataImage(ptCurrTheme, 'Border', ifCritical or ifIgnoreCaps or ifTransparent);
+// if mask only, all land gets filled with landtex and therefore needs borders
+if maskOnly then
+targetMask:= lfLandMask
+else
+targetMask:= lfBasic;
 for x:= 0 to LAND_WIDTH - 1 do
 begin
 yd:= LAND_HEIGHT - 1;
 repeat
-while (yd > 0) and (Land[yd, x] =  0) do dec(yd);
+while (yd > 0) and ((Land[yd, x] and targetMask) = 0) do dec(yd);
 if (yd < 0) then
 yd:= 0;
-while (yd < LAND_HEIGHT) and (Land[yd, x] <> 0) do
+while (yd < LAND_HEIGHT) and ((Land[yd, x] and targetMask) <> 0) do
 inc(yd);
 dec(yd);
 yu:= yd;
-while (yu > 0  ) and (Land[yu, x] <> 0) do dec(yu);
+while (yu > 0  ) and ((Land[yu, x] and targetMask) <> 0) do dec(yu);
-while (yu < yd ) and (Land[yu, x] =  0) do inc(yu);
+while (yu < yd ) and ((Land[yu, x] and targetMask) =  0) do inc(yu);
 if (yd < LAND_HEIGHT - 1) and ((yd - yu) >= 16) then
 begin
 rr.x:= x;
 rr.y:= yd - 15;
 c1:= AMask;
 c2:= AMask or RMask or GMask;
 // vertical
 s:= LAND_HEIGHT;
 for x:= 0 to LAND_WIDTH - 1 do
 for y:= 0 to LAND_HEIGHT - 1 do
-if LandPixels[y, x] = 0 then
+if Land[y, x] = 0 then
 if s < y then
 begin
 for i:= max(s, y - 8) to y - 1 do
 begin
 if ((x + i) and 16) = 0 then c:= c1 else c:= c2;
 if (cReducedQuality and rqBlurryLand) = 0 then
 LandPixels[i, x]:= c
 else
 LandPixels[i div 2, x div 2]:= c
 end;
 begin
 if s > y then s:= y;
 if s + 8 > y then
 begin
 if ((x + y) and 16) = 0 then c:= c1 else c:= c2;
 if (cReducedQuality and rqBlurryLand) = 0 then
 LandPixels[y, x]:= c
 else
 LandPixels[y div 2, x div 2]:= c
 end;
 end;
 // horizontal
 s:= LAND_WIDTH;
 for y:= 0 to LAND_HEIGHT - 1 do
 for x:= 0 to LAND_WIDTH - 1 do
-if LandPixels[y, x] = 0 then
+if Land[y, x] = 0 then
 if s < x then
 begin
 for i:= max(s, x - 8) to x - 1 do
 begin
 if ((y + i) and 16) = 0 then c:= c1 else c:= c2;
 if (cReducedQuality and rqBlurryLand) = 0 then
 LandPixels[y, i]:= c
 else
 LandPixels[y div 2, i div 2]:= c
 end;
 begin
 if s > x then s:= x;
 if s + 8 > x then
 begin
 if ((x + y) and 16) = 0 then c:= c1 else c:= c2;
 if (cReducedQuality and rqBlurryLand) = 0 then
 LandPixels[y, x]:= c
 else
 LandPixels[y div 2, x div 2]:= c
 end;
 end
 end;
 procedure ColorizeLand(Surface: PSDL_Surface);
 var tmpsurf: PSDL_Surface;
 r: TSDL_Rect;
+y: LongInt; // stupid SDL 1.2 uses stupid SmallInt for y which limits us to 32767.  But is even worse if LandTex is large, can overflow on 32767 map.
 begin
 tmpsurf:= LoadDataImage(ptCurrTheme, 'LandTex', ifCritical or ifIgnoreCaps);
 r.y:= 0;
-while r.y < LAND_HEIGHT do
+y:= 0;
-begin
+while y < LAND_HEIGHT do
+begin
 r.x:= 0;
 while r.x < LAND_WIDTH do
 begin
 SDL_UpperBlit(tmpsurf, nil, Surface, @r);
 inc(r.x, tmpsurf^.w)
+end;
+inc(y, tmpsurf^.h);
+r.y:= y
 end;
-inc(r.y, tmpsurf^.h)
-end;
 SDL_FreeSurface(tmpsurf);
 // freed in freeModule() below
 LandBackSurface:= LoadDataImage(ptCurrTheme, 'LandBackTex', ifIgnoreCaps or ifTransparent);
 if (LandBackSurface <> nil) and GrayScale then Surface2GrayScale(LandBackSurface);
 end;
-procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr; fps: PPointArray);
-var i: LongInt;
-begin
-with Template do
-begin
-pa.Count:= BasePointsCount;
-for i:= 0 to pred(pa.Count) do
-begin
-pa.ar[i].x:= BasePoints^[i].x + LongInt(GetRandom(BasePoints^[i].w));
-if pa.ar[i].x <> NTPX then
-pa.ar[i].x:= pa.ar[i].x + ((LAND_WIDTH - Template.TemplateWidth) div 2);
-pa.ar[i].y:= BasePoints^[i].y + LongInt(GetRandom(BasePoints^[i].h)) + LAND_HEIGHT - LongInt(Template.TemplateHeight)
-end;
-if canMirror then
-if getrandom(2) = 0 then
-begin
-for i:= 0 to pred(BasePointsCount) do
-if pa.ar[i].x <> NTPX then
-pa.ar[i].x:= LAND_WIDTH - 1 - pa.ar[i].x;
-for i:= 0 to pred(FillPointsCount) do
-fps^[i].x:= LAND_WIDTH - 1 - fps^[i].x;
-end;
-(*  Experiment in making this option more useful
-if ((not isNegative) and (cTemplateFilter = 4)) or
-(canFlip and (getrandom(2) = 0)) then
-begin
-for i:= 0 to pred(BasePointsCount) do
-begin
-pa.ar[i].y:= LAND_HEIGHT - 1 - pa.ar[i].y + (LAND_HEIGHT - TemplateHeight) * 2;
-if pa.ar[i].y > LAND_HEIGHT - 1 then
-pa.ar[i].y:= LAND_HEIGHT - 1;
-end;
-for i:= 0 to pred(FillPointsCount) do
-begin
-FillPoints^[i].y:= LAND_HEIGHT - 1 - FillPoints^[i].y + (LAND_HEIGHT - TemplateHeight) * 2;
-if FillPoints^[i].y > LAND_HEIGHT - 1 then
-FillPoints^[i].y:= LAND_HEIGHT - 1;
-end;
-end;
-end
-*)
-// template recycling.  Pull these off the floor a bit
-if (not isNegative) and (cTemplateFilter = 4) then
-begin
-for i:= 0 to pred(BasePointsCount) do
-begin
-dec(pa.ar[i].y, 100);
-if pa.ar[i].y < 0 then
-pa.ar[i].y:= 0;
-end;
-for i:= 0 to pred(FillPointsCount) do
-begin
-dec(fps^[i].y, 100);
-if fps^[i].y < 0 then
-fps^[i].y:= 0;
-end;
-end;
-if (canFlip and (getrandom(2) = 0)) then
-begin
-for i:= 0 to pred(BasePointsCount) do
-pa.ar[i].y:= LAND_HEIGHT - 1 - pa.ar[i].y;
-for i:= 0 to pred(FillPointsCount) do
-fps^[i].y:= LAND_HEIGHT - 1 - fps^[i].y;
-end;
-end
-end;
-procedure GenBlank(var Template: TEdgeTemplate);
-var pa: TPixAr;
-i: Longword;
-y, x: Longword;
-fps: TPointArray;
-begin
-fps:=Template.FillPoints^;
-ResizeLand(Template.TemplateWidth, Template.TemplateHeight);
-for y:= 0 to LAND_HEIGHT - 1 do
-for x:= 0 to LAND_WIDTH - 1 do
-Land[y, x]:= lfBasic;
-{$HINTS OFF}
-SetPoints(Template, pa, @fps);
-{$HINTS ON}
-for i:= 1 to Template.BezierizeCount do
-begin
-BezierizeEdge(pa, _0_5);
-RandomizePoints(pa);
-RandomizePoints(pa)
-end;
-for i:= 1 to Template.RandPassesCount do
-RandomizePoints(pa);
-BezierizeEdge(pa, _0_1);
-DrawEdge(pa, 0);
-with Template do
-for i:= 0 to pred(FillPointsCount) do
-with fps[i] do
-FillLand(x, y);
-DrawEdge(pa, lfBasic);
-MaxHedgehogs:= Template.MaxHedgehogs;
-hasGirders:= Template.hasGirders;
-playHeight:= Template.TemplateHeight;
-playWidth:= Template.TemplateWidth;
-leftX:= ((LAND_WIDTH - playWidth) div 2);
-rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
-topY:= LAND_HEIGHT - playHeight;
-// HACK: force to only cavern even if a cavern map is invertable if cTemplateFilter = 4 ?
-if (cTemplateFilter = 4)
-or (Template.canInvert and (getrandom(2) = 0))
-or (not Template.canInvert and Template.isNegative) then
-begin
-hasBorder:= true;
-for y:= 0 to LAND_HEIGHT - 1 do
-for x:= 0 to LAND_WIDTH - 1 do
-if (y < topY) or (x < leftX) or (x > rightX) then
-Land[y, x]:= 0
-else
-begin
-if Land[y, x] = 0 then
-Land[y, x]:= lfBasic
-else if Land[y, x] = lfBasic then
-Land[y, x]:= 0;
-end;
-end;
-end;
 procedure GenDrawnMap;
 begin
 ResizeLand(4096, 2048);
 uLandPainted.Draw;
 repeat
 inc(cTemplateFilter);
 dec(l, TemplateCounts[cTemplateFilter]);
 until l < 0;
 end else getRandom(1);
 case cTemplateFilter of
 0: OutError('Ask unC0Rr about what you did wrong', true);
 1: SelectTemplate:= SmallTemplates[getrandom(TemplateCounts[cTemplateFilter])];
 2: SelectTemplate:= MediumTemplates[getrandom(TemplateCounts[cTemplateFilter])];
 3: SelectTemplate:= LargeTemplates[getrandom(TemplateCounts[cTemplateFilter])];
 5: SelectTemplate:= WackyTemplates[getrandom(TemplateCounts[cTemplateFilter])];
 // For lua only!
 6: begin
 SelectTemplate:= min(LuaTemplateNumber,High(EdgeTemplates));
 GetRandom(2) // burn 1
-end;
+end
 end
 end;
 WriteLnToConsole('Selected template #'+inttostr(SelectTemplate)+' using filter #'+inttostr(cTemplateFilter));
 end;
 if (cReducedQuality and rqBlurryLand) = 0 then
 LandPixels[y, x]:= p^[x] or AMask
 else
 LandPixels[y div 2, x div 2]:= p^[x] or AMask;
-p:= @(p^[Surface^.pitch div 4]);
+p:= PLongwordArray(@(p^[Surface^.pitch div 4]));
 end;
 if SDL_MustLock(Surface) then
 SDL_UnlockSurface(Surface);
 end;
 if gameFlags and gfShoppaBorder = 0 then DrawBorderFromImage(tmpsurf);
 AddOnLandObjects(tmpsurf);
 LandSurface2LandPixels(tmpsurf);
 SDL_FreeSurface(tmpsurf);
 if gameFlags and gfShoppaBorder <> 0 then DrawShoppaBorder;
 for x:= leftX+2 to rightX-2 do
 for y:= topY+2 to LAND_HEIGHT-3 do
 if (Land[y, x] = 0) and
 (((Land[y, x-1] = lfBasic) and ((Land[y+1,x] = lfBasic)) or (Land[y-1,x] = lfBasic)) or
 ((Land[y, x+1] = lfBasic) and ((Land[y-1,x] = lfBasic) or (Land[y+1,x] = lfBasic)))) then
 begin
 if (cReducedQuality and rqBlurryLand) = 0 then
 begin
 if (Land[y, x-1] = lfBasic) and (LandPixels[y, x-1] and AMask <> 0) then
 LandPixels[y, x]:= LandPixels[y, x-1]
 else if (Land[y, x+1] = lfBasic) and (LandPixels[y, x+1] and AMask <> 0) then
 LandPixels[y, x]:= LandPixels[y, x+1]
 else if (Land[y-1, x] = lfBasic) and (LandPixels[y-1, x] and AMask <> 0) then
 LandPixels[y, x]:= LandPixels[y-1, x]
 else if (Land[y+1, x] = lfBasic) and (LandPixels[y+1, x] and AMask <> 0) then
 LandPixels[y, x]:= LandPixels[y+1, x];
 if (((LandPixels[y,x] and AMask) shr AShift) > 10) then
 LandPixels[y,x]:= (LandPixels[y,x] and (not AMask)) or (128 shl AShift)
 end;
 Land[y,x]:= lfObject
 end
 ((Land[y, x+1] = lfBasic) and (Land[y-1,x+1] = lfBasic) and (Land[y-2,x] = lfBasic)) or
 ((Land[y+1, x] = lfBasic) and (Land[y+1,x+1] = lfBasic) and (Land[y,x+2] = lfBasic)) or
 ((Land[y-1, x] = lfBasic) and (Land[y-1,x+1] = lfBasic) and (Land[y,x+2] = lfBasic)) or
 ((Land[y+1, x] = lfBasic) and (Land[y+1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic)) or
 ((Land[y-1, x] = lfBasic) and (Land[y-1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic))) then
 begin
 if (cReducedQuality and rqBlurryLand) = 0 then
 begin
 if (Land[y, x-1] = lfBasic) and (LandPixels[y,x-1] and AMask <> 0) then
 LandPixels[y, x]:= LandPixels[y, x-1]
 else if (Land[y, x+1] = lfBasic) and (LandPixels[y,x+1] and AMask <> 0) then
 LandPixels[y, x]:= LandPixels[y, x+1]
 else if (Land[y+1, x] = lfBasic) and (LandPixels[y+1,x] and AMask <> 0) then
 LandPixels[y, x]:= LandPixels[y+1, x]
 else if (Land[y-1, x] = lfBasic) and (LandPixels[y-1,x] and AMask <> 0) then
 LandPixels[y, x]:= LandPixels[y-1, x];
 if (((LandPixels[y,x] and AMask) shr AShift) > 10) then
 LandPixels[y,x]:= (LandPixels[y,x] and (not AMask)) or (64 shl AShift)
 end;
 Land[y,x]:= lfObject
 end;
 tmpsurf:= LoadDataImage(ptForts, ClansArray[0]^.Teams[0]^.FortName + 'L', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
 BlitImageAndGenerateCollisionInfo(leftX+150, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
 SDL_FreeSurface(tmpsurf);
-tmpsurf:= LoadDataImage(ptForts, ClansArray[1]^.Teams[0]^.FortName + 'R', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
+// not critical because if no R we can fallback to mirrored L
-BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
+tmpsurf:= LoadDataImage(ptForts, ClansArray[1]^.Teams[0]^.FortName + 'R', ifAlpha or ifTransparent or ifIgnoreCaps);
+// fallback
+if tmpsurf = nil then
+begin
+tmpsurf:= LoadDataImage(ptForts, ClansArray[1]^.Teams[0]^.FortName + 'L', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);
+BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf, 0, true);
+end
+else
+BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
 SDL_FreeSurface(tmpsurf);
 end;
 procedure LoadMapConfig;
 var f: PFSFile;
 p:= tmpsurf^.pixels;
 for y:= 0 to Pred(tmpsurf^.h) do
 begin
 for x:= 0 to Pred(tmpsurf^.w) do
 SetLand(Land[cpY + y, cpX + x], p^[x]);
-p:= @(p^[tmpsurf^.pitch div 4]);
+p:= PLongwordArray(@(p^[tmpsurf^.pitch div 4]));
 end;
 if SDL_MustLock(tmpsurf) then
 SDL_UnlockSurface(tmpsurf);
 if not disableLandBack then
 end;
 procedure GenMap;
 var x, y, w, c: Longword;
 map, mask: shortstring;
-maskOnly: boolean;
 begin
 hasBorder:= false;
 maskOnly:= false;
 LoadThemeConfig;
 end
 else
 begin
 WriteLnToConsole('Generating land...');
 case cMapGen of
-0: GenBlank(EdgeTemplates[SelectTemplate]);
+mgRandom: GenTemplated(EdgeTemplates[SelectTemplate]);
-1: begin ResizeLand(4096,2048); GenMaze; end;
+mgMaze  : begin ResizeLand(4096,2048); GenMaze; end;
-2: GenDrawnMap;
+mgPerlin: begin ResizeLand(4096,2048); GenPerlin; end;
+mgDrawn : GenDrawnMap;
 else
 OutError('Unknown mapgen', true);
 end;
 GenLandSurface
 end
 end;
 end;
 if hasBorder then
 begin
-for y:= 0 to LAND_HEIGHT - 1 do
+if WorldEdge = weNone then
-for x:= 0 to LAND_WIDTH - 1 do
+begin
-if (y < topY) or (x < leftX) or (x > rightX) then
+for y:= 0 to LAND_HEIGHT - 1 do
+for x:= 0 to LAND_WIDTH - 1 do
+if (y < topY) or (x < leftX) or (x > rightX) then
+Land[y, x]:= lfIndestructible;
+end
+else if topY > 0 then
+begin
+for y:= 0 to LongInt(topY) - 1 do
+for x:= 0 to LAND_WIDTH - 1 do
 Land[y, x]:= lfIndestructible;
+end;
 // experiment hardcoding cave
 // also try basing cave dimensions on map/template dimensions, if they exist
 for w:= 0 to 5 do // width of 3 allowed hogs to be knocked through with grenade
 begin
 if (WorldEdge <> weBounce) and (WorldEdge <> weWrap) then
 if (GameFlags and gfDisableGirders) <> 0 then
 hasGirders:= false;
 if (GameFlags and gfForts = 0) and (maskOnly or (cPathz[ptMapCurrent] = '')) then
 AddObjects
 else
 AddProgress();
 FreeLandObjects;
 for x:= leftX div 2 to rightX div 2 do
 for y:= topY div 2 to LAND_HEIGHT-1 div 2 do
 begin
 w:= LandPixels[y div 2,x div 2];
 w:= ((w shr RShift and $FF) +  (w shr BShift and $FF) + (w shr GShift and $FF)) div 3;
-if w > 255 then
-w:= 255;
 w:= (w and $FF shl RShift) or (w and $FF shl BShift) or (w and $FF shl GShift) or (LandPixels[y div 2,x div 2] and AMask);
 LandPixels[y,x]:= w or (LandPixels[y div 2, x div 2] and AMask)
 end
 end;
+PrettifyLandAlpha();
+// adjust world edges for borderless maps
+if (WorldEdge <> weNone) and (not hasBorder) then
+InitWorldEdges();
 end;
 procedure GenPreview(out Preview: TPreview);
 var rh, rw, ox, oy, x, y, xx, yy, t, bit, cbit, lh, lw: LongInt;
 begin
 WriteLnToConsole('Generating preview...');
 case cMapGen of
-0: GenBlank(EdgeTemplates[SelectTemplate]);
+mgRandom: GenTemplated(EdgeTemplates[SelectTemplate]);
-1: begin ResizeLand(4096,2048); GenMaze; end;
+mgMaze: begin ResizeLand(4096,2048); GenMaze; end;
-2: GenDrawnMap;
+mgPerlin: begin ResizeLand(4096,2048); GenPerlin; end;
+mgDrawn: GenDrawnMap;
 else
 OutError('Unknown mapgen', true);
 end;
 // strict scaling needed here since preview assumes a rectangle
 if rw < rh*2 then
 begin
 rw:= rh*2;
 end;
 if rh < rw div 2 then rh:= rw * 2;
 ox:= (rw-LAND_WIDTH) div 2;
 oy:= rh-LAND_HEIGHT;
 lh:= rh div 128;
 lw:= rw div 32;
 begin
 t:= 0;
 cbit:= bit * 8;
 for yy:= y * lh to y * lh + 7 do
 for xx:= x * lw + cbit to x * lw + cbit + 7 do
 if ((yy-oy) and LAND_HEIGHT_MASK = 0) and ((xx-ox) and LAND_WIDTH_MASK = 0)
 and (Land[yy-oy, xx-ox] <> 0) then
 inc(t);
 if t > 8 then
 Preview[y, x]:= Preview[y, x] or ($80 shr bit);
 end;
 end;
 end;
+procedure GenPreviewAlpha(out Preview: TPreviewAlpha);
+var rh, rw, ox, oy, x, y, xx, yy, t, lh, lw: LongInt;
+begin
+WriteLnToConsole('Generating preview...');
+case cMapGen of
+mgRandom: GenTemplated(EdgeTemplates[SelectTemplate]);
+mgMaze: begin ResizeLand(4096,2048); GenMaze; end;
+mgPerlin: begin ResizeLand(4096,2048); GenPerlin; end;
+mgDrawn: GenDrawnMap;
+else
+OutError('Unknown mapgen', true);
+end;
+// strict scaling needed here since preview assumes a rectangle
+rh:= max(LAND_HEIGHT, 2048);
+rw:= max(LAND_WIDTH, 4096);
+ox:= 0;
+if rw < rh*2 then
+begin
+rw:= rh*2;
+end;
+if rh < rw div 2 then rh:= rw * 2;
+ox:= (rw-LAND_WIDTH) div 2;
+oy:= rh-LAND_HEIGHT;
+lh:= rh div 128;
+lw:= rw div 256;
+for y:= 0 to 127 do
+for x:= 0 to 255 do
+begin
+t:= 0;
+for yy:= y * lh - oy to y * lh + lh - 1 - oy do
+for xx:= x * lw - ox to x * lw + lw - 1 - ox do
+if (yy and LAND_HEIGHT_MASK = 0) and (xx and LAND_WIDTH_MASK = 0)
+and (Land[yy, xx] <> 0) then
+inc(t);
+Preview[y, x]:= t * 255 div (lh * lw);
+end;
+end;
 procedure chLandCheck(var s: shortstring);
 begin
 AddFileLog('CheckLandDigest: ' + s + ' digest : ' + digest);
 if digest = '' then
 digest:= s
 adler:= 1;
 for i:= 0 to LAND_HEIGHT-1 do
 adler:= Adler32Update(adler, @Land[i,0], LAND_WIDTH);
 s:= 'M' + IntToStr(adler) + cScriptName;
+ScriptSetString('LandDigest', s);
 chLandCheck(s);
 SendIPCRaw(@s[0], Length(s) + 1)
 end;
 procedure initModule;
 RegisterVariable('landcheck', @chLandCheck, false);
 RegisterVariable('sendlanddigest', @chSendLandDigest, false);
 LandBackSurface:= nil;
 digest:= '';
+maskOnly:= false;
 LAND_WIDTH:= 0;
 LAND_HEIGHT:= 0;
 (*
 if (cReducedQuality and rqBlurryLand) = 0 then
 SetLength(LandPixels, LAND_HEIGHT, LAND_WIDTH)

branch	sdl2transition
changeset 11362	ed5a6478e710
parent 9682	aa2431ed87b2
parent 11046	47a8c19ecb60
child 11473	023db094b22d