hedgewars/uLandGraphics.pas
branchicegun
changeset 8583 f2edd6d5f958
parent 8579 d18bc19d780a
child 8584 ea20d9cc8515
child 8585 da608f69d853
--- 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;