diff -r 08679e8186a3 -r f2edd6d5f958 hedgewars/uLandGraphics.pas --- a/hedgewars/uLandGraphics.pas Tue Feb 26 11:00:09 2013 +0200 +++ b/hedgewars/uLandGraphics.pas Tue Feb 26 15:15:20 2013 +0200 @@ -36,6 +36,7 @@ procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); +procedure FillRoundInLandWithIce(X, Y, Radius: LongInt); procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); function LandBackPixel(x, y: LongInt): LongWord; procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); @@ -158,6 +159,8 @@ end end; + + procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); var dx, dy, d: LongInt; begin @@ -243,6 +246,133 @@ end; + +function isLandscapeEdge(weight:Longint):boolean; +begin + result := (weight < 8) and (weight >= 2); +end; + +function isLandscape(weight:Longint):boolean; +begin + result := weight < 2; +end; + +function isEmptySpace(weight:Longint):boolean; +begin + result := not isLandscape(weight) and not isLandscapeEdge(weight); +end; + +function getPixelWeight(x, y:Longint): Longint; +var + i, j:Longint; +begin + result := 0; + for i := x - 1 to x + 1 do + for j := y - 1 to y + 1 do + begin + if (i < 0) or + (i > LAND_WIDTH - 1) or + (j < 0) or + (j > LAND_HEIGHT -1) or + ((Land[j, i] and $FF00) = 0) then + begin + result := result + 1; + end; + end; +end; + +procedure drawIcePixel(y, x:Longint); +var + iceSurface: PSDL_Surface; + icePixels: PLongwordArray; + pictureX, pictureY: LongInt; + w, c: LongWord; + weight: Longint; +begin + weight := getPixelWeight(x, y); + if isLandscape(weight) then + begin + // So. 3 parameters here. Ice colour, Ice opacity, and a bias on the greyscaled pixel towards lightness + c:= $7dc1ccff; + // FIXME should be a global value, not set every single pixel. Just for test purposes + c:= ($44 shl RShift) or ($97 shl GShift) or ($A9 shl BShift) or ($A0 shl AShift); + iceSurface:= SpritesData[sprIceTexture].Surface; + pictureX := x mod iceSurface^.w; + pictureY := y mod iceSurface^.h; + icePixels := iceSurface^.pixels; + w:= LandPixels[y, x]; + w:= round(((w shr RShift and $FF) * RGB_LUMINANCE_RED + + (w shr BShift and $FF) * RGB_LUMINANCE_GREEN + + (w shr GShift and $FF) * RGB_LUMINANCE_BLUE)); + if w < 128 then w:= w+128; + if w > 255 then w:= 255; + w:= (w shl RShift) or (w shl BShift) or (w shl GShift) or (LandPixels[y,x] and AMask); + //LandPixels[y, x]:= w; + LandPixels[y, x]:= addBgColor(w, c); + LandPixels[y, x]:= addBgColor(LandPixels[y, x], icePixels^[iceSurface^.w * (y mod iceSurface^.h) + (x mod iceSurface^.w)]); + Land[y, x] := land[y, x] or lfIce; + end + else if (isLandscapeEdge(weight)) then + begin + LandPixels[y, x] := $FFB2AF8A; + if Land[y, x] > 255 then Land[y, x] := Land[y, x] or lfIce; + end; + +end; + +function getIncrementInquarter(dx, dy, quarter: Longint): Longint; +const directionX : array [0..3] of Longint = (0, 0, 1, -1); +const directionY : array [0..3] of Longint = (1, -1, 0, 0); +begin + getIncrementInquarter := directionX[quarter] * dx + directionY[quarter] * dy; +end; + +function getIncrementInquarter2(dx, dy, quarter: Longint): Longint; +const directionY : array [0..3] of Longint = (0, 0, 1, 1); +const directionX : array [0..3] of Longint = (1, 1, 0, 0); +begin + getIncrementInquarter2 := directionX[quarter] * dx + directionY[quarter] * dy; +end; + +procedure FillLandCircleLinesIce(x, y, dx, dy: LongInt); +var q, i, t: LongInt; +begin +for q := 0 to 3 do + begin + t:= y + getIncrementInquarter(dx, dy, q); + if (t and LAND_HEIGHT_MASK) = 0 then + for i:= Max(x - getIncrementInquarter2(dx, dy, q), 0) to Min(x + getIncrementInquarter2(dx, dy, q), LAND_WIDTH - 1) do + if ((Land[t, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[t, i] > 255)) then + if (cReducedQuality and rqBlurryLand) = 0 then + drawIcePixel(t, i) + else + drawIcePixel(t div 2, i div 2) ; + end; +end; + +procedure FillRoundInLandWithIce(X, Y, Radius: LongInt); +var dx, dy, d: LongInt; +begin +dx:= 0; +dy:= Radius; +d:= 3 - 2 * Radius; + while (dx < dy) do + begin + FillLandCircleLinesIce(x, y, dx, dy); + if (d < 0) then + d:= d + 4 * dx + 6 + else + begin + d:= d + 4 * (dx - dy) + 10; + dec(dy) + end; + inc(dx) + end; + if (dx = dy) then + FillLandCircleLinesIce(x, y, dx, dy); +end; + + function FillLandCircleLinesBG(x, y, dx, dy: LongInt): Longword; var i, t, by, bx: LongInt; cnt: Longword;