hedgewars/uLandGraphics.pas
changeset 8592 bb724ef609db
parent 8588 47084c6fcb4e
child 8612 f7c194533d45
equal deleted inserted replaced
8590:c64b758e0412 8592:bb724ef609db
    35 function  DrawExplosion(X, Y, Radius: LongInt): Longword;
    35 function  DrawExplosion(X, Y, Radius: LongInt): Longword;
    36 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    36 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    37 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    37 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    38 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    38 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    39 procedure FillRoundInLandWithIce(X, Y, Radius: LongInt);
    39 procedure FillRoundInLandWithIce(X, Y, Radius: LongInt);
       
    40 procedure DrawSemiRound(x, y, height, radius:Longint); 
    40 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
    41 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
    41 function  LandBackPixel(x, y: LongInt): LongWord;
    42 function  LandBackPixel(x, y: LongInt): LongWord;
    42 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword);
    43 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword);
    43 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword);
    44 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword);
    44 procedure DumpLandToLog(x, y, r: LongInt);
    45 procedure DumpLandToLog(x, y, r: LongInt);
   245                 LandPixels[t div 2, i div 2]:= 0;
   246                 LandPixels[t div 2, i div 2]:= 0;
   246 
   247 
   247 end;
   248 end;
   248 
   249 
   249 
   250 
   250 function isLandscapeEdge(weight:Longint):boolean;
       
   251 begin
       
   252     result := (weight < 8) and (weight >= 2);
       
   253 end;
       
   254 
       
   255 function isLandscape(weight:Longint):boolean;
       
   256 begin
       
   257     result := weight < 2;
       
   258 end;
       
   259 
       
   260 function isEmptySpace(weight:Longint):boolean;
       
   261 begin
       
   262     result := not isLandscape(weight) and not isLandscapeEdge(weight);
       
   263 end;
       
   264 
       
   265 function getPixelWeight(x, y:Longint): Longint;
   251 function getPixelWeight(x, y:Longint): Longint;
   266 var
   252 var
   267     i, j:Longint;
   253     i, j:Longint;
   268 begin
   254 begin
   269     result := 0;
   255     result := 0;
   288     pictureX, pictureY: LongInt;
   274     pictureX, pictureY: LongInt;
   289     w, c: LongWord;
   275     w, c: LongWord;
   290     weight: Longint;
   276     weight: Longint;
   291 begin
   277 begin
   292     weight := getPixelWeight(x, y);
   278     weight := getPixelWeight(x, y);
   293     if isLandscape(weight) then
   279     if weight < 2 then
   294         begin
   280         begin
   295         // So. 3 parameters here. Ice colour, Ice opacity, and a bias on the greyscaled pixel towards lightness
   281         // So. 3 parameters here. Ice colour, Ice opacity, and a bias on the greyscaled pixel towards lightness
   296         iceSurface:= SpritesData[sprIceTexture].Surface;
   282         iceSurface:= SpritesData[sprIceTexture].Surface;
   297         pictureX := x mod iceSurface^.w;
   283         pictureX := x mod iceSurface^.w;
   298         pictureY := y mod iceSurface^.h;
   284         pictureY := y mod iceSurface^.h;
   305         if w > 255 then w:= 255;
   291         if w > 255 then w:= 255;
   306         w:= (w shl RShift) or (w shl BShift) or (w shl GShift) or (LandPixels[y,x] and AMask);
   292         w:= (w shl RShift) or (w shl BShift) or (w shl GShift) or (LandPixels[y,x] and AMask);
   307         //LandPixels[y, x]:= w;
   293         //LandPixels[y, x]:= w;
   308         LandPixels[y, x]:= addBgColor(w, IceColor);
   294         LandPixels[y, x]:= addBgColor(w, IceColor);
   309         LandPixels[y, x]:= addBgColor(LandPixels[y, x], icePixels^[iceSurface^.w * (y mod iceSurface^.h) + (x mod iceSurface^.w)]);
   295         LandPixels[y, x]:= addBgColor(LandPixels[y, x], icePixels^[iceSurface^.w * (y mod iceSurface^.h) + (x mod iceSurface^.w)]);
   310         Land[y, x] := land[y, x] or lfIce;
       
   311         end
   296         end
   312     else if (isLandscapeEdge(weight)) then
   297     else if weight < 8 then
   313         begin
   298         begin
   314         LandPixels[y, x] := $FFB2AF8A;
   299         LandPixels[y, x] := $FFB2AF8A;
   315         if Land[y, x] > 255 then Land[y, x] := Land[y, x] or lfIce;
       
   316         end;
   300         end;
   317 
   301 
   318 end;
   302 end;
   319 
   303 
   320 function getIncrementInquarter(dx, dy, quarter: Longint): Longint;
   304 function getIncrementInquarter(dx, dy, quarter: Longint): Longint;
   329 const directionX : array [0..3] of Longint = (1, 1, 0, 0);
   313 const directionX : array [0..3] of Longint = (1, 1, 0, 0);
   330 begin
   314 begin
   331     getIncrementInquarter2 := directionX[quarter] * dx + directionY[quarter] * dy;
   315     getIncrementInquarter2 := directionX[quarter] * dx + directionY[quarter] * dy;
   332 end;
   316 end;
   333 
   317 
       
   318 
   334 procedure FillLandCircleLinesIce(x, y, dx, dy: LongInt);
   319 procedure FillLandCircleLinesIce(x, y, dx, dy: LongInt);
   335 var q, i, t: LongInt;
   320 var q, i, t: LongInt;
   336 begin
   321 begin
   337 for q := 0 to 3 do
   322 for q := 0 to 3 do
   338     begin
   323     begin
   339         t:= y + getIncrementInquarter(dx, dy, q);
   324     t:= min(y + getIncrementInquarter(dx, dy, q), LAND_HEIGHT - 1);
   340         if (t and LAND_HEIGHT_MASK) = 0 then
   325     if (t and LAND_HEIGHT_MASK) = 0 then
   341             for i:= Max(x - getIncrementInquarter2(dx, dy, q), 0) to Min(x + getIncrementInquarter2(dx, dy, q), LAND_WIDTH - 1) do
   326         for i:= Max(x - getIncrementInquarter2(dx, dy, q), 0) to Min(x + getIncrementInquarter2(dx, dy, q), LAND_WIDTH - 1) do
   342                 if (Land[t, i] and (lfIndestructible or lfIce) = 0) and (not disableLandBack or (Land[t, i] > 255))  then
   327             begin
       
   328             if (Land[t, i] and (lfIndestructible or lfIce) = 0) and (not disableLandBack or (Land[t, i] > 255))  then
       
   329                 begin
   343                     if (cReducedQuality and rqBlurryLand) = 0 then
   330                     if (cReducedQuality and rqBlurryLand) = 0 then
   344                        drawIcePixel(t, i)
   331                        drawIcePixel(t, i)
   345                     else
   332                     else
   346                        drawIcePixel(t div 2, i div 2) ;
   333                        drawIcePixel(t div 2, i div 2) ;
       
   334                     if Land[t, i] > 255 then Land[t, i] := Land[t, i] or lfIce;                                    
       
   335                 end;
       
   336             end;
   347     end;
   337     end;
   348 end;
   338 end;
   349 
   339 
   350 procedure FillRoundInLandWithIce(X, Y, Radius: LongInt);
   340 procedure FillRoundInLandWithIce(X, Y, Radius: LongInt);
   351 var dx, dy, d: LongInt;
   341 var dx, dy, d: LongInt;
       
   342     landRect: TSDL_Rect;
   352 begin
   343 begin
   353 dx:= 0;
   344 dx:= 0;
   354 dy:= Radius;
   345 dy:= Radius;
   355 d:= 3 - 2 * Radius;
   346 d:= 3 - 2 * Radius;
   356     while (dx < dy) do
   347     while (dx < dy) do
   365             end;
   356             end;
   366         inc(dx)
   357         inc(dx)
   367         end;
   358         end;
   368     if (dx = dy) then
   359     if (dx = dy) then
   369         FillLandCircleLinesIce(x, y, dx, dy);
   360         FillLandCircleLinesIce(x, y, dx, dy);
   370 end;
   361     landRect.x := min(max(x - Radius, 0), LAND_WIDTH - 1);
       
   362     landRect.y := min(max(y - Radius, 0), LAND_HEIGHT - 1);
       
   363     landRect.w := min(2*Radius, LAND_WIDTH - landRect.x - 1);
       
   364     landRect.h := min(2*Radius, LAND_HEIGHT - landRect.y - 1);
       
   365     UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true);        
       
   366 end;
       
   367 
       
   368 
       
   369 procedure FillLandCircleLinesColor(x, y, dx, dy, border: LongInt);
       
   370 var q, i, t: LongInt;
       
   371 begin
       
   372 for q := 0 to 3 do
       
   373     begin
       
   374         t:= y + getIncrementInquarter(dx, dy, q);
       
   375         if (t and LAND_HEIGHT_MASK) = 0 then
       
   376             for i:= Max(x - getIncrementInquarter2(dx, dy, q), 0) to Min(x + getIncrementInquarter2(dx, dy, q), LAND_WIDTH - 1) do
       
   377             begin
       
   378                 if (Land[t, i] and (lfIndestructible or lfIce) = 0) and (not disableLandBack or (Land[t, i] > 255))  and (t > border) then
       
   379                     begin
       
   380                     if (cReducedQuality and rqBlurryLand) = 0 then
       
   381                        LandPixels[t, i] := $FFFFFFFF
       
   382                     else
       
   383                        LandPixels[t div 2, i div 2] := $FFFFFFFF;
       
   384                     Land[t, i] := lfBasic;                        
       
   385                     end;
       
   386             end;
       
   387     end;
       
   388 end;
       
   389 
       
   390 
       
   391 procedure DrawSemiRound(x, y, height, radius:Longint);    
       
   392 var dx, dy, d: LongInt;
       
   393     landRect: TSDL_Rect;
       
   394 begin
       
   395 dx:= 0;
       
   396 dy:= Radius;
       
   397 d:= 3 - 2 * Radius;
       
   398     while (dx < dy) do
       
   399         begin        
       
   400             FillLandCircleLinesColor(x, y, dx, dy, y);
       
   401         if (d < 0) then
       
   402             d:= d + 4 * dx + 6
       
   403         else
       
   404             begin
       
   405             d:= d + 4 * (dx - dy) + 10;
       
   406             dec(dy)
       
   407             end;
       
   408         inc(dx)
       
   409         end;
       
   410     if (dx = dy) then
       
   411            FillLandCircleLinesColor(x, y, dx, dy, y);
       
   412     landRect.x := min(max(x - Radius, 0), LAND_WIDTH - 1);
       
   413     landRect.y := min(max(y - Radius, 0), LAND_HEIGHT - 1);
       
   414     landRect.w := min(2*Radius, LAND_WIDTH - landRect.x - 1);
       
   415     landRect.h := min(2*Radius, LAND_HEIGHT - landRect.y - 1);
       
   416     UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true);                
       
   417 end;
       
   418 
       
   419 
   371 
   420 
   372 
   421 
   373 function FillLandCircleLinesBG(x, y, dx, dy: LongInt): Longword;
   422 function FillLandCircleLinesBG(x, y, dx, dy: LongInt): Longword;
   374 var i, t, by, bx: LongInt;
   423 var i, t, by, bx: LongInt;
   375     cnt: Longword;
   424     cnt: Longword;