Implement greyscales in ColorizeImage and some cosmetics.

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1843 b956fd51-792f-4845-bead-9b4dfca2ff2c

1 files changed, 64 insertions, 24 deletions

diff --git a/src/base/UImage.pas b/src/base/UImage.pas
index f8fd8a05..6b0c509e 100644
--- a/src/base/UImage.pas
+++ b/src/base/UImage.pas
@@ -600,17 +600,17 @@ end;
 function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean;
 var
   {$IFDEF Delphi}
-  Bitmap:    TBitmap;
+  Bitmap:     TBitmap;
   BitmapInfo: TBitmapInfo;
-  Jpeg:      TJpegImage;
-  row:       integer;
+  Jpeg:       TJpegImage;
+  row:        integer;
   {$ELSE}
-  cinfo:     jpeg_compress_struct;
-  jerr :     jpeg_error_mgr;
-  jpgFile:   TFileStream;
-  rowPtr:    array[0..0] of JSAMPROW;
+  cinfo:      jpeg_compress_struct;
+  jerr :      jpeg_error_mgr;
+  jpgFile:    TFileStream;
+  rowPtr:     array[0..0] of JSAMPROW;
   {$ENDIF}
-  converted: boolean;
+  converted:  boolean;
 begin
   Result := false;
 
@@ -794,17 +794,13 @@ end;
 
 function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean;
 begin
-  if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and
-     (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and
-     (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and
-     (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and
-     (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and
-     (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and
-     (fmt1^.Bshift = fmt2^.Bshift)
-  then
-    Result := true
-  else
-    Result := false;
+  Result := 
+    (fmt1^.BitsPerPixel  = fmt2^.BitsPerPixel)  and
+    (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and
+    (fmt1^.Rloss = fmt2^.Rloss)   and (fmt1^.Gloss = fmt2^.Gloss)   and (fmt1^.Bloss = fmt2^.Bloss)   and
+    (fmt1^.Rmask = fmt2^.Rmask)   and (fmt1^.Gmask = fmt2^.Gmask)   and (fmt1^.Bmask = fmt2^.Bmask)   and
+    (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and (fmt1^.Bshift = fmt2^.Bshift)
+  ;
 end;
 
 procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal);
@@ -893,7 +889,7 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: longword);
   // For the conversion algorithms of colors from rgb to hsv space
   // and back simply check the wikipedia.
   // In order to speed up starting time of USDX the division of reals is 
-  // replaced by division of longwords, shifted by 10 bits to keep 
+  // replaced by division of longints, shifted by 10 bits to keep 
   // digits.
 
   // The use of longwards leeds to some type size mismatch warnings
@@ -942,6 +938,8 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: longword);
       if (Hue < 0.0) then
         Hue := Hue + 6.0;
       Result := trunc(Hue*1024);           // '*1024' is shl 10
+ //     if NewColor = $000000 then
+ //       Log.LogError ('Hue: ' +  FloatToStr(Hue), 'ColorToHue');
     end;
   end;
 
@@ -954,6 +952,8 @@ var
   Min, Max, Delta: longword;
   HueInteger: longword;
   f, p, q, t: longword;
+  GreyReal: real;
+  Grey: byte;
 begin
 
   Pixel := ImgSurface^.Pixels;
@@ -967,8 +967,48 @@ begin
     Log.LogError ('ColorizeImage: The pixel size should be 4, but it is '
                    + IntToStr(ImgSurface^.format.BytesPerPixel));
 
+  // Check whether the new color is white, grey or black, 
+  // because a greyscale must be created in a different
+  // way.
+  
+  Red   := ((NewColor and $ff0000) shr 16); // R
+  Green := ((NewColor and   $ff00) shr  8); // G
+  Blue  :=  (NewColor and     $ff)        ; // B
+  
+  if (Red = Green) and (Green = Blue) then // greyscale image
+  begin
+    // According to these recommendations (ITU-R BT.709-5)
+    // the conversion parameters for rgb to greyscale are
+    // 0.299, 0.587, 0.114
+    for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do
+    begin
+      PixelColors := PByteArray(Pixel);
+      {$IFDEF FPC_BIG_ENDIAN}
+      GreyReal := 0.299*PixelColors[3] + 0.587*PixelColors[2] + 0.114*PixelColors[1];
+      //       PixelColors[0] is alpha and remains untouched
+      {$ELSE}
+      GreyReal := 0.299*PixelColors[0] + 0.587*PixelColors[1] + 0.114*PixelColors[2];
+      //       PixelColors[3] is alpha and remains untouched
+      {$ENDIF}
+      Grey := round(GreyReal);
+      {$IFDEF FPC_BIG_ENDIAN}
+      PixelColors[3] := Grey;
+      PixelColors[2] := Grey;
+      PixelColors[1] := Grey;
+      //       PixelColors[0] is alpha and remains untouched
+      {$ELSE}
+      PixelColors[0] := Grey;
+      PixelColors[1] := Grey;
+      PixelColors[2] := Grey;
+      //       PixelColors[3] is alpha and remains untouched
+      {$ENDIF}
+      Inc(Pixel, ImgSurface^.format.BytesPerPixel);
+    end;
+    exit; // we are done with a greyscale image.
+  end;
+
   Hue := ColorToHue(NewColor);   // Hue is shl 10
-  f := Hue and $3ff;             // f is the dezimal part of hue
+  f   := Hue and $3ff;           // f is the dezimal part of hue
   HueInteger := Hue shr 10;
 
   for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do
@@ -1038,9 +1078,9 @@ begin
         // shr 10 corrects that Sat and f are shl 10
         // the resulting p, q and t are unshifted
 
-        p := (Max*(1024-Sat)) shr 10;
-        q := (Max*(1024-(Sat*f) shr 10)) shr 10;
-        t := (Max*(1024-(Sat*(1024-f)) shr 10)) shr 10;
+        p := (Max * (1024 -  Sat                     )) shr 10;
+        q := (Max * (1024 - (Sat *  f        ) shr 10)) shr 10;
+        t := (Max * (1024 - (Sat * (1024 - f)) shr 10)) shr 10;
 
         // The above 3 lines give type size mismatch warning, but all variables are longword and the ranges should be ok.