diff -r 31570b766315 -r ed5a6478e710 hedgewars/uLand.pas --- a/hedgewars/uLand.pas Tue Nov 10 18:16:35 2015 +0100 +++ b/hedgewars/uLand.pas Tue Nov 10 20:43:13 2015 +0100 @@ -1,6 +1,6 @@ (* * Hedgewars, a free turn based strategy game - * Copyright (c) 2004-2013 Andrey Korotaev + * Copyright (c) 2004-2015 Andrey Korotaev * * 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 @@ -13,76 +13,70 @@ * * 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 -potW:= toPowerOf2(width); -potH:= toPowerOf2(height); -if (potW <> LAND_WIDTH) or (potH <> LAND_HEIGHT) then - 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) + +procedure PrettifyLandAlpha(); +begin + if (cReducedQuality and rqBlurryLand) <> 0 then + PrettifyAlpha2D(LandPixels, LAND_HEIGHT div 2, LAND_WIDTH div 2) else - SetLength(LandPixels, LAND_HEIGHT div 2, LAND_WIDTH div 2); - - 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; + PrettifyAlpha2D(LandPixels, LAND_HEIGHT, LAND_WIDTH); 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 < yd ) and (Land[yu, x] = 0) do inc(yu); + while (yu > 0 ) and ((Land[yu, x] and targetMask) <> 0) do dec(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 @@ -120,16 +114,16 @@ // 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 @@ -144,26 +138,26 @@ 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; 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 @@ -178,31 +172,34 @@ 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 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 - begin + y:= 0; + while y < LAND_HEIGHT do + begin r.x:= 0; while r.x < LAND_WIDTH do - begin + 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 @@ -210,138 +207,6 @@ 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 @@ -372,7 +237,7 @@ 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])]; @@ -384,7 +249,7 @@ 6: begin SelectTemplate:= min(LuaTemplateNumber,High(EdgeTemplates)); GetRandom(2) // burn 1 - end; + end end end; @@ -410,7 +275,7 @@ 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 @@ -433,12 +298,12 @@ 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 + 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 @@ -446,16 +311,16 @@ 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; @@ -470,25 +335,25 @@ ((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; @@ -516,8 +381,16 @@ 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); -BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf); +// not critical because if no R we can fallback to mirrored L +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; @@ -585,7 +458,7 @@ 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 @@ -661,7 +534,6 @@ procedure GenMap; var x, y, w, c: Longword; map, mask: shortstring; - maskOnly: boolean; begin hasBorder:= false; maskOnly:= false; @@ -689,9 +561,10 @@ begin WriteLnToConsole('Generating land...'); case cMapGen of - 0: GenBlank(EdgeTemplates[SelectTemplate]); - 1: begin ResizeLand(4096,2048); GenMaze; end; - 2: GenDrawnMap; + 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; @@ -721,10 +594,19 @@ if hasBorder then begin - 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 + if WorldEdge = weNone then + begin + 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 @@ -775,7 +657,7 @@ if (GameFlags and gfForts = 0) and (maskOnly or (cPathz[ptMapCurrent] = '')) then AddObjects - + else AddProgress(); @@ -802,12 +684,17 @@ 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); @@ -815,9 +702,10 @@ begin WriteLnToConsole('Generating preview...'); case cMapGen of - 0: GenBlank(EdgeTemplates[SelectTemplate]); - 1: begin ResizeLand(4096,2048); GenMaze; end; - 2: GenDrawnMap; + 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; @@ -831,7 +719,7 @@ rw:= rh*2; end; if rh < rw div 2 then rh:= rw * 2; - + ox:= (rw-LAND_WIDTH) div 2; oy:= rh-LAND_HEIGHT; @@ -847,7 +735,7 @@ 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) + 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 @@ -857,6 +745,49 @@ 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); @@ -874,6 +805,8 @@ 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; @@ -885,6 +818,7 @@ LandBackSurface:= nil; digest:= ''; + maskOnly:= false; LAND_WIDTH:= 0; LAND_HEIGHT:= 0; (*