YCbCr Colorspace support, Tiff ResolutionXY div by zero test (MR 463)

packages/fcl-image/src/fpcolorspace.pas

@@ -14,7 +14,7 @@
  **********************************************************************}
 {
  2023 Massimo Magnano
-     Code ported from bgrabitmap with some modifications and additions.
+     Code ported from bgrabitmap, gimp and imagemagick with some modifications and additions.
 }
 
 {$IFNDEF FPC_DOTTEDUNITS}
@@ -151,6 +151,19 @@ type
     class function New(const ALightness,AChroma,AHue:single): TLChA;overload;static;
   end;
 
+  { TYCbCr }
+
+  TYCbCrSTD = (YCbCr_601, YCbCr_709, YCbCr_2020, YCbCr_JPG);
+  TYCbCrSTD_Factor= packed record
+    a, b, c, d, e :single;
+  end;
+
+  PYCbCr = ^TYCbCr;
+  TYCbCr = packed record
+    Y,Cb,Cr: single;
+    class function New(const AY, ACb, ACr:single): TYCbCr; static;
+  end;
+
   PExpandedPixel = ^TExpandedPixel;
   { TExpandedPixel }
   {* Stores a gamma expanded RGB color. Values range from 0 to 65535 }
@@ -337,6 +350,9 @@ type
     function ToXYZA: TXYZA; overload;
     function ToXYZA(const AReferenceWhite: TXYZReferenceWhite): TXYZA; overload;
     function ToStdRGBA: TStdRGBA;
+    {** SamplePrecision = 2^(YCbCrSamplePrecision-1) }
+    function ToYCbCr(const AStd:TYCbCrSTD=YCbCr_JPG; ASamplePrecision:Single=0.5): TYCbCr; overload;
+    function ToYCbCr(LumaRed:Single=0.299; LumaGreen:Single=0.587; LumaBlue:Single=0.114): TYCbCr; overload;
   end;
 
   { TXYZAHelper }
@@ -378,6 +394,15 @@ type
     function ToLabA: TLabA;
   end;
 
+
+  { TYCbCrHelper }
+
+  TYCbCrHelper = record helper for TYCbCr
+    {** SamplePrecision = 2^(YCbCrSamplePrecision-1) }
+    function ToLinearRGBA(const AStd:TYCbCrSTD=YCbCr_JPG; ASamplePrecision:Single=0.5): TLinearRGBA; overload;
+    function ToLinearRGBA(LumaRed:Single=0.299; LumaGreen:Single=0.587; LumaBlue:Single=0.114): TLinearRGBA; overload;
+  end;
+
   {* How to handle overflow when converting from XYZ }
   TFPColorspaceOverflow =
     {** Colors outside of target colorspace are converted to transparent }
@@ -668,6 +693,15 @@ begin
   Result.alpha := 1;
 end;
 
+{ TYCbCr }
+
+class function TYCbCr.New(const AY, ACb, ACr:single): TYCbCr;
+begin
+  Result.Y := AY;
+  Result.Cb := ACb;
+  Result.Cr := ACr;
+end;
+
 function FPGammaExpansion(ACompressed: word): word;
 const
   fracShift = 8;
@@ -1818,6 +1852,28 @@ begin
   result.Alpha:= self.alpha;
 end;
 
+{ TYCbCrHelper }
+
+function TYCbCrHelper.ToLinearRGBA(const AStd: TYCbCrSTD; ASamplePrecision:Single): TLinearRGBA;
+begin
+  with self, YCbCrSTD_Factors[AStd]  do
+  begin
+    result.red := Y + e * (Cr-ASamplePrecision);
+    result.green := Y - (a * e / b) * (Cr-ASamplePrecision) - (c * d / b) * (Cb-ASamplePrecision);
+    result.blue := Y + d * (Cb-ASamplePrecision);
+  end;
+end;
+
+function TYCbCrHelper.ToLinearRGBA(LumaRed: Single; LumaGreen: Single; LumaBlue: Single): TLinearRGBA;
+begin
+  with self  do
+  begin
+    result.red := Cr * ( 2 - 2 * LumaRed ) + Y;
+    result.blue := Cb * ( 2 - 2 * LumaBlue ) + Y;
+    result.green :=  ( Y - LumaBlue * result.blue - LumaRed * result.red ) / LumaGreen;
+  end;
+end;
+
 { TByteMaskHelper }
 
 function TByteMaskHelper.ToExpandedPixel(AAlpha: byte): TExpandedPixel;
@@ -1877,6 +1933,26 @@ begin
   result.alpha := self.alpha;
 end;
 
+function TLinearRGBAHelper.ToYCbCr(const AStd: TYCbCrSTD; ASamplePrecision:Single=0.5): TYCbCr;
+begin
+  with self, YCbCrSTD_Factors[AStd]  do
+  begin
+    result.Y := a * red + b * green + c * blue;
+    result.Cb := ((blue - result.Y) / d)+ASamplePrecision;
+    result.Cr := ((red - result.Y) / e)+ASamplePrecision;
+  end;
+end;
+
+function TLinearRGBAHelper.ToYCbCr(LumaRed: Single; LumaGreen: Single; LumaBlue: Single): TYCbCr;
+begin
+  with self  do
+  begin
+    result.Y :=  ( LumaRed * red + LumaGreen * green + LumaBlue * blue );
+    result.Cb := ( blue - result.Y ) / ( 2 - 2 * LumaBlue );
+    result.Cr := ( red - result.Y ) / ( 2 - 2 * LumaRed );
+  end;
+end;
+
 { TXYZAHelper }
 
 function TXYZAHelper.ToLinearRGBA: TLinearRGBA;

packages/fcl-image/src/fpreadtiff.pas

@@ -346,6 +346,17 @@ begin
       IFD.GrayBits:=SampleBits[3];  //black
       PremultipliedAlpha:= false;
     end;
+  6:
+    begin
+      if RegularSampleCnt<>3 then
+        TiffError('YCbCr images expect 3 samples per pixel, but found '+
+          IntToStr(SampleCnt));
+
+      IFD.GrayBits:=SampleBits[0];   //Y
+      IFD.BlueBits:=SampleBits[1];   //Cb
+      IFD.RedBits:=SampleBits[2];    //Cr
+      PremultipliedAlpha:= false;
+    end;
   8,9:
     begin
       if (RegularSampleCnt<>1) and (RegularSampleCnt<>3) then
@@ -707,6 +718,7 @@ var
   WordBuffer: PWord;
   Count: SizeUInt;
   i: Integer;
+  Value:TTiffRational;
 
   function GetPos: SizeUInt;
   begin
@@ -860,6 +872,7 @@ begin
         3: write('3=Palette color');
         4: write('4=Transparency Mask');
         5: write('5=CMYK 8bit');
+        5: write('6=YcbCr 8bit');
         8: write('8=L*a*b* with a and b [-128;127]');
         9: write('9=L*a*b* with a and b [0;255]');
         end;
@@ -1419,6 +1432,24 @@ begin
         writeln('TFPReaderTiff.ReadDirectoryEntry Tag 521: skipping JPEGACTables');
       {$endif}
     end;
+  529:
+    begin
+      //MaxM: is correct to Read 3 Rational in sequense??? TEST
+      Value:=ReadEntryRational;
+      if Value.Denominator>0
+      then IFD.YCbCr_LumaRed :=Value.Numerator/Value.Denominator
+      else IFD.YCbCr_LumaRed :=Value.Numerator;
+
+      Value:=ReadEntryRational;
+      if Value.Denominator>0
+      then IFD.YCbCr_LumaGreen :=Value.Numerator/Value.Denominator
+      else IFD.YCbCr_LumaGreen :=Value.Numerator;
+
+      Value:=ReadEntryRational;
+      if Value.Denominator>0
+      then IFD.YCbCr_LumaBlue :=Value.Numerator/Value.Denominator
+      else IFD.YCbCr_LumaBlue :=Value.Numerator;
+    end;
   530:
     begin
       // ToDo: YCbCrSubSampling alias ChromaSubSampling
@@ -1858,6 +1889,7 @@ var
     GrayValue: Word;
     lab: TLabA;
     cmyk: TStdCMYK;
+    ycbcr: TYCbCr;
   begin
     for Channel := 0 to SampleCnt-1 do
       ReadImgValue(SampleBits[Channel], Run,BitPos,IFD.FillOrder,
@@ -1899,7 +1931,15 @@ var
         result :=cmyk.ToExpandedPixel.ToFPColor(true); //MaxM: in Future we can use GammaCompression
       end;
 
-     //6: YCBCR: CCIR 601
+    6: // YCBCR: CCIR 601
+      begin
+        ycbcr :=TYCbCr.New(ChannelValues[0]/$ffff, ChannelValues[1]/$ffff, ChannelValues[2]/$ffff);
+
+        if IFD.YCbCr_LumaRed<>0
+        then result :=ycbcr.ToLinearRGBA(IFD.YCbCr_LumaRed, IFD.YCbCr_LumaGreen, IFD.YCbCr_LumaBlue).ToExpandedPixel.ToFPColor(false)
+        else result :=ycbcr.ToLinearRGBA(YCbCr_601).ToExpandedPixel.ToFPColor(false);
+      end;
+
      //8: CIELAB: 1976 CIE L*a*b*
      //9: ICCLAB: ICC L*a*b*. Introduced post TIFF rev 6.0 by Adobe TIFF Technote 4
      //10: ITULAB: ITU L*a*b*
@@ -1945,8 +1985,12 @@ var
   procedure ReadResolutionValues;
   begin
        CurFPImg.ResolutionUnit :=TifResolutionUnitToResolutionUnit(IFD.ResolutionUnit);
-       CurFPImg.ResolutionX :=IFD.XResolution.Numerator/IFD.XResolution.Denominator;
-       CurFPImg.ResolutionY :=IFD.YResolution.Numerator/IFD.YResolution.Denominator;
+       if (IFD.XResolution.Denominator>0)
+       then CurFPImg.ResolutionX :=IFD.XResolution.Numerator/IFD.XResolution.Denominator
+       else CurFPImg.ResolutionX :=IFD.XResolution.Numerator;
+       if (IFD.YResolution.Denominator>0)
+       then CurFPImg.ResolutionY :=IFD.YResolution.Numerator/IFD.YResolution.Denominator
+       else CurFPImg.ResolutionY :=IFD.YResolution.Numerator;
   end;
 
 begin

packages/fcl-image/src/fpspectraldata.inc

@@ -1,5 +1,5 @@
-// SPDX-License-Identifier: LGPL-3.0-linking-exception
-const //horseshoe shape of visible colors at 2° (illuminant E)
+const
+  //horseshoe shape of visible colors at 2° (illuminant E)
   SpectralLocus: array[0..94] of TSpectralLocusPoint =
  ((W:360; X:0.0001299; Y:0.000003917; Z:0.0006061),
   (W:365; X:0.0002321; Y:0.000006965; Z:0.001086),
@@ -97,7 +97,7 @@ const //horseshoe shape of visible colors at 2° (illuminant E)
   (W:825; X:1.776509E-06; Y:6.4153E-07; Z:0),
   (W:830; X:1.251141E-06; Y:4.5181E-07; Z:0));
 
-const //D65 illuminant
+  //D65 illuminant
   IlluminantSpectrumD65: array[0..94] of TIlluminantSpectrumPoint =
  ((W:360; Y:46.6383),
   (W:365; Y:49.3637),
@@ -195,3 +195,10 @@ const //D65 illuminant
   (W:825; Y:58.8765),
   (W:830; Y:60.3125));
 
+  //YcbCr to From RGB Factors
+  YCbCrSTD_Factors : array [TYCbCrSTD] of TYCbCrSTD_Factor = (
+  (a:0.299; b:0.587; c:0.114; d:1.772; e:1.402),        //BT.601
+  (a:0.2126; b:0.7152; c:0.0722; d:1.8556; e:1.5748),   //BT.709
+  (a:0.2627; b:0.6780; c:0.0593; d:1.8814; e:1.4746),   //BT.2020
+  (a:0.299; b:0.587; c:0.114; d:1.772; e:1.402)         //JPG Same Factor of 601?
+  );

packages/fcl-image/src/fptiffcmn.pas

@@ -185,6 +185,7 @@ type
     Tresholding: DWord;
     XResolution: TTiffRational;
     YResolution: TTiffRational;
+    YCbCr_LumaRed, YCbCr_LumaGreen, YCbCr_LumaBlue :Single;
     // image
     Img: TFPCustomImage;
     FreeImg: boolean;
@@ -471,6 +472,11 @@ end;
 constructor TTiffIFD.Create;
 begin
   PlanarConfiguration:=TiffPlanarConfigurationChunky;
+
+  //Use the Standard 601 Constants
+  YCbCr_LumaRed:=0;
+  YCbCr_LumaGreen:=0;
+  YCbCr_LumaBlue:=0;
 end;
 
 destructor TTiffIFD.Destroy;