bgrapixel.inc

{=== Pixel types and functions ===}

{$IFDEF INCLUDE_INTERFACE}
{$UNDEF INCLUDE_INTERFACE}
type
  {* Pointer for direct pixel access. Data is stored as a sequence of ''TBGRAPixel''.
     See [[BGRABitmap tutorial 4]] }
  PBGRAPixel = ^TBGRAPixel;

  {$IFNDEF BGRABITMAP_BGRAPIXEL}
    {$IFDEF BGRABITMAP_USE_LCL}
      {$IFDEF LCLgtk}
        {$DEFINE BGRABITMAP_RGBAPIXEL}
      {$ENDIF}
      {$IFDEF LCLgtk2}
        {$DEFINE BGRABITMAP_RGBAPIXEL}
      {$ENDIF}
      {$IFDEF DARWIN}
		{$IFNDEF LCLQt}
			{$DEFINE BGRABITMAP_RGBAPIXEL}
		{$ENDIF}
      {$ENDIF}
    {$ENDIF}
  {$ENDIF}

  {* Each pixel is a sequence of 4 bytes containing blue, green, red and alpha channel.
     Values range from 0 to 255, color is in sRGB colorspace. The alpha value of 0
     is transparent and 255 is opaque. In the bitmap data, when the pixel is fully transparent,
	 the RGB values are supposed to be set to zero. }

  { TBGRAPixel }
  TBGRAPixel = packed record
  private
    function GetClassIntensity: BGRAWord;
    function GetClassLightness: BGRAWord;
    procedure SetClassIntensity(AValue: BGRAWord);
    procedure SetClassLightness(AValue: BGRAWord);
  public
    {$IFDEF BGRABITMAP_RGBAPIXEL}
    red, green, blue, alpha: byte;
    {$ELSE}
    blue, green, red, alpha: byte;
    {$ENDIF}
    procedure FromRGB(ARed,AGreen,ABlue: Byte; AAlpha: Byte = 255);
    procedure FromColor(AColor: TColor; AAlpha: Byte = 255);
    procedure FromString(AStr: string);
    procedure FromFPColor(AColor: TFPColor);
    procedure ToRGB(out ARed,AGreen,ABlue,AAlpha: Byte); overload;
    procedure ToRGB(out ARed,AGreen,ABlue: Byte); overload;
    function ToColor: TColor;
    function ToString: string;
    function ToGrayscale(AGammaCorrection: boolean = true): TBGRAPixel;
    function ToFPColor: TFPColor;
    class Operator{$IFDEF OBJ}:={$ELSE}Implicit{$ENDIF}(Source: TBGRAPixel): TColor;
    class Operator{$IFDEF OBJ}:={$ELSE}Implicit{$ENDIF}(Source: TColor): TBGRAPixel;
    class Operator{$IFDEF OBJ}<>{$ELSE}NotEqual{$ENDIF}(v1, v2: TBGRAPixel): boolean;
    class Operator{$IFDEF OBJ}={$ELSE}Equal{$ENDIF}(v1, v2: TBGRAPixel): boolean;
    property Intensity: BGRAWord read GetClassIntensity write SetClassIntensity;
    property Lightness: BGRAWord read GetClassLightness write SetClassLightness;
  end;
  TBGRAPixelBuffer = packed array of TBGRAPixel;

procedure AllocateBGRAPixelBuffer(var ABuffer: TBGRAPixelBuffer; ASize: integer);

const
  {$IFDEF BGRABITMAP_RGBAPIXEL}
  TBGRAPixel_RGBAOrder = True;
  TBGRAPixel_RedByteOffset = 0;
  TBGRAPixel_GreenByteOffset = 1;
  TBGRAPixel_BlueByteOffset = 2;
  {$ELSE}
  TBGRAPixel_RGBAOrder = False;
  TBGRAPixel_BlueByteOffset = 0;
  TBGRAPixel_GreenByteOffset = 1;
  TBGRAPixel_RedByteOffset = 2;
  {$ENDIF}
  TBGRAPixel_AlphaByteOffset = 3;
  {$IFDEF ENDIAN_LITTLE}
  TBGRAPixel_RedShift = TBGRAPixel_RedByteOffset*8;
  TBGRAPixel_GreenShift = TBGRAPixel_GreenByteOffset*8;
  TBGRAPixel_BlueShift = TBGRAPixel_BlueByteOffset*8;
  TBGRAPixel_AlphaShift = TBGRAPixel_AlphaByteOffset*8;
  {$ELSE}
  TBGRAPixel_RedShift = 24 - TBGRAPixel_RedByteOffset*8;
  TBGRAPixel_GreenShift = 24 - TBGRAPixel_GreenByteOffset*8;
  TBGRAPixel_BlueShift = 24 - TBGRAPixel_BlueByteOffset*8;
  TBGRAPixel_AlphaShift = 24 - TBGRAPixel_AlphaByteOffset*8;
  {$ENDIF}

  {** Creates a pixel with given RGBA values }
  function BGRA(red, green, blue, alpha: byte): TBGRAPixel; overload; {$ifdef inline}inline;{$endif}
  {** Creates a opaque pixel with given RGB values }
  function BGRA(red, green, blue: byte): TBGRAPixel; overload; {$ifdef inline}inline;{$endif}
  {** Checks if two pixels are equal. If they are both transparent,
      RGB values are ignored }
  function BGRAPixelEqual(const c1, c2: TBGRAPixel): boolean; {$ifdef inline}inline;{$endif}
  {** Returns the intensity of a pixel. The intensity is the
     maximum value reached by any component }
  function GetIntensity(c: TBGRAPixel): BGRAWord;{$ifdef inline}inline;{$endif}overload;
  {** Sets the intensity of a pixel }
  function SetIntensity(c: TBGRAPixel; intensity: BGRAWord): TBGRAPixel; overload;
  {** Returns the lightness of a pixel. The lightness is the
     perceived brightness, 0 being black and 65535 being white }
  function GetLightness(c: TBGRAPixel): BGRAWord; overload;
  {** Sets the lightness of a pixel }
  function SetLightness(c: TBGRAPixel; lightness: BGRAWord): TBGRAPixel; overload;
  {** Sets the lightness quickly, by fading towards black if ''lightness'' is
      less than 32768, and fading towards white if ''lightness'' is more
      than 32768 }
  function ApplyLightnessFast(color: TBGRAPixel; lightness: BGRAWord): TBGRAPixel; {$ifdef inline}inline;{$endif}
  {** Sets the intensity quickly, by fading towards black if ''lightness'' is
      less than 32768, and multiplying all components if ''lightness'' is more
      than 32768. In case of saturation, it fades towards white }
  function ApplyIntensityFast(color: TBGRAPixel; lightness: BGRALongWord): TBGRAPixel;
  {** Combines two lightnesses together. A value of 32768 is neutral. The
      result may exceed 65535 }
  function CombineLightness(lightness1,lightness2: Int32or64): Int32or64;
  {** Converts a color into grayscale }
  function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel;
  function BGRAToGrayscaleLinear(c: TBGRAPixel): TBGRAPixel;
  {** Create a gray color with the given ''lightness'' }
  function GrayscaleToBGRA(lightness: BGRAWord): TBGRAPixel;
  {** Merge two colors without gamma correction }
  function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel; overload;
  {** Merge two colors without gamma correction. ''weight1'' and ''weight2''
      indicates the weight of the color barycentre }
  function MergeBGRA(c1: TBGRAPixel; weight1: integer; c2: TBGRAPixel; weight2: integer): TBGRAPixel; overload;
  {** Merge two colors with gamma correction. ''weight1'' and ''weight2''
      indicates the weight of the color barycentre }
  function MergeBGRAWithGammaCorrection(c1: TBGRAPixel; weight1: byte; c2: TBGRAPixel; weight2: byte): TBGRAPixel;
  {** Converts a ''TColor'' value into an opaque pixel }
  function ColorToBGRA(color: TColor): TBGRAPixel; overload;
  {** Converts a ''TColor'' value into a pixel with given ''opacity'' }
  function ColorToBGRA(color: TColor; opacity: byte): TBGRAPixel; overload;
  {** Converts a pixel into a TColor value, discarding the alpha value }
  function BGRAToColor(c: TBGRAPixel): TColor;
  {** Converts a ''TFPColor'' value into a pixel. Note that even if
      ''TFPColor'' have 16-bit values, they are not considered as
      gamma expanded }
  function FPColorToBGRA(AValue: TFPColor): TBGRAPixel;
  {** Converts a pixel into a ''TFPColor'' }
  function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; {$ifdef inline}inline;{$endif}
  function Color16BitToBGRA(AColor: BGRAWord): TBGRAPixel;
  function BGRAToColor16Bit(const AColor: TBGRAPixel): BGRAWord;
  {** Computes the difference (with gamma correction) between two pixels,
      taking into account all dimensions, including transparency. The
      result ranges from 0 to 65535 }
  function BGRAWordDiff(c1, c2: TBGRAPixel): BGRAWord;
  {** Computes the difference (with gamma correction) between two pixels,
      taking into account all dimensions, including transparency. The
      result ranges from 0 to 255 }
  function BGRADiff(c1, c2: TBGRAPixel): byte;
  function FastBGRALinearDiff(c1,c2: TBGRAPixel): byte;
  function FastBGRAExpandedDiff(c1,c2: TBGRAPixel): BGRAWord;

type
  {* Array of pixels }
  ArrayOfTBGRAPixel = array of TBGRAPixel;
  {** Merge given colors without gamma correction }
  function MergeBGRA(const colors: array of TBGRAPixel): TBGRAPixel; overload;

{ Get height [0..1] stored in a TBGRAPixel }
function MapHeight(Color: TBGRAPixel): Single;

{ Get TBGRAPixel to store height [0..1] }
function MapHeightToBGRA(Height: Single; Alpha: Byte): TBGRAPixel;

type
  {* Possible modes when drawing a pixel over another one }
  TDrawMode = (
    {** The pixel is replaced }
    dmSet,
    {** The pixel is replaced if the pixel over has an alpha value of 255 }
    dmSetExceptTransparent,
    {** The pixel is blend over the other one according to alpha values,
        however no gamma correction is applied. In other words, the color
        space is assumed to be linear }
    dmLinearBlend,
    {** The pixel is blend over the other one according to alpha values,
        and a gamma correction is applied. In other BGRAWord, the color
        space is assumed to be sRGB }
    dmDrawWithTransparency,
    {** Values of all channels are combined with Xor. This is useful to
        compute the binary difference, however it is not something that makes
        much sense to display on the screen }
    dmXor);

const
  {** An alias for the linear blend, because it is faster than blending
      with gamma correction }
  dmFastBlend = dmLinearBlend;

type
  {* Advanced blending modes. See [http://www.brighthub.com/multimedia/photography/articles/18301.aspx Paint.NET blend modes]
    and [http://www.pegtop.net/delphi/articles/blendmodes/ Formulas]. Blending layers has two steps. The first one is
    to apply the blend operations listed below, and the second is the actual merging of the colors }
  TBlendOperation = (
    {** Simple blend, except that it forces a linear merge so it is equivalent to ''dmLinearBlend'' }
    boLinearBlend,
    {** Simple blend. It is equivalent to ''dmLinearBlend'' or ''dmDrawWithTransparency'' }
    boTransparent,
    {** Lighting blend modes (tends to increase the luminosity) }
    boLighten, boScreen, boAdditive, boLinearAdd, boColorDodge, boDivide, boNiceGlow, boSoftLight, boHardLight,
    {** Masking blend modes (tends to decrease the luminosity) }
    boGlow, boReflect, boOverlay, boDarkOverlay, boDarken, boMultiply, boColorBurn,
    {** Difference blend modes }
    boDifference, boLinearDifference, boExclusion, boLinearExclusion, boSubtract, boLinearSubtract, boSubtractInverse, boLinearSubtractInverse,
    {** Negation blend modes }
    boNegation, boLinearNegation,
    {** Xor blend mode. It is sightly different from ''dmXor'' because the alpha value is used like in other blends modes }
    boXor,
    {** Additional blend modes **}
    boSvgSoftLight);

const
  {** Alias to glow that express that this blend mode masks the part where the top layer is black }
  boGlowMask = boGlow;
  {** Alias because linear or non linear multiply modes are identical }
  boLinearMultiply = boMultiply;
  {** Alias to express that dark overlay is simply an overlay with gamma correction }
  boNonLinearOverlay = boDarkOverlay;

const
  {** String constants for blend modes }
  BlendOperationStr : array[TBlendOperation] of string
  = ('LinearBlend', 'Transparent',
     'Lighten', 'Screen', 'Additive', 'LinearAdd', 'ColorDodge', 'Divide', 'NiceGlow', 'SoftLight', 'HardLight',
     'Glow', 'Reflect', 'Overlay', 'DarkOverlay', 'Darken', 'Multiply', 'ColorBurn',
     'Difference', 'LinearDifference', 'Exclusion', 'LinearExclusion', 'Subtract', 'LinearSubtract', 'SubtractInverse', 'LinearSubtractInverse',
     'Negation', 'LinearNegation', 'Xor', 'SvgSoftLight');

  {** Returns the blend mode expressed by the string }
  function StrToBlendOperation(str: string): TBlendOperation;

type
  {* Specifies how a palette handles the alpha channel }
  TAlphaChannelPaletteOption = (
    {** The alpha channel is ignored. The alpha channel is considered to be stored elsewhere }
    acIgnore,
    {** One entry is allocated the fully transparent color }
    acTransparentEntry,
    {** The alpha channel is fully embedded in the palette so that a color is identified by its four RGBA channels }
    acFullChannelInPalette);

  {* Dithering algorithms that specifies how to handle colors that are not found in the palette }
  TDitheringAlgorithm = (
    {** The nearest color is to be used instead }
    daNearestNeighbor,
    {** The nearest color may be used however another color may be used to compensate for the error,
        following Floyd-Steinberg algorithm }
    daFloydSteinberg);

{$DEFINE INCLUDE_INTERFACE}
{$i basiccolorspace.inc}

{$DEFINE INCLUDE_INTERFACE}
{$i extendedcolorspace.inc}

{$ENDIF}

{$IFDEF INCLUDE_IMPLEMENTATION}
{$UNDEF INCLUDE_IMPLEMENTATION}

{$DEFINE INCLUDE_IMPLEMENTATION}
{$i basiccolorspace.inc}

{$DEFINE INCLUDE_IMPLEMENTATION}
{$i extendedcolorspace.inc}

function StrToBlendOperation(str: string): TBlendOperation;
var op: TBlendOperation;
begin
  result := boTransparent;
  str := LowerCase(str);
  for op := low(TBlendOperation) to high(TBlendOperation) do
    if str = LowerCase(BlendOperationStr[op]) then
    begin
      result := op;
      exit;
    end;
end;

{************************** Color functions **************************}

procedure AllocateBGRAPixelBuffer(var ABuffer: TBGRAPixelBuffer; ASize: integer);
begin
  if ASize > length(ABuffer) then
    setlength(ABuffer, max(length(ABuffer)*2,ASize));
end;

function BGRA(red, green, blue, alpha: byte): TBGRAPixel; overload;
{$IFDEF BDS}var _BGRADWord : BGRADWord;{$ENDIF}
begin
  {$IFDEF BDS}_BGRADWord{$ELSE}BGRADWord(result){$ENDIF} := (red shl TBGRAPixel_RedShift) or
                                                    (green shl TBGRAPixel_GreenShift) or
                                                    (blue shl TBGRAPixel_BlueShift) or
                                                    (alpha shl TBGRAPixel_AlphaShift);
  {$IFDEF BDS}move(_BGRADWord , Result, sizeof(BGRADWord));{$ENDIF}
end;

function BGRA(red, green, blue: byte): TBGRAPixel; overload;
{$IFDEF BDS}var _BGRADWord : BGRADWord;{$ENDIF}
begin
  {$IFDEF BDS}_BGRADWord{$ELSE}BGRADWord(result){$ENDIF} := (red shl TBGRAPixel_RedShift) or
                                                    (green shl TBGRAPixel_GreenShift) or
                                                    (blue shl TBGRAPixel_BlueShift) or
                                                    (255 shl TBGRAPixel_AlphaShift);

  {$IFDEF BDS}move(_BGRADWord , Result, sizeof(BGRADWord));{$ENDIF}
end;

function BGRAPixelEqual(const c1, c2: TBGRAPixel): boolean;
begin
  if (c1.alpha = 0) and (c2.alpha = 0) then
    Result := True
  else
    Result := (c1.alpha = c2.alpha) and (c1.red = c2.red) and
      (c1.green = c2.green) and (c1.blue = c2.blue);
end;

function GetIntensity(c: TBGRAPixel): BGRAWord;
begin
  Result := c.red;
  if c.green > Result then
    Result := c.green;
  if c.blue > Result then
    Result := c.blue;
  result := GammaExpansionTab[Result];
end;

function SetIntensity(c: TBGRAPixel; intensity: BGRAWord): TBGRAPixel;
begin
  result := GammaCompression(SetIntensity(GammaExpansion(c),intensity));
end;

function GetLightness(c: TBGRAPixel): BGRAWord;
begin
  result := GetLightness(GammaExpansion(c));
end;

function SetLightness(c: TBGRAPixel; lightness: BGRAWord): TBGRAPixel;
begin
  result := GammaCompression(SetLightness(GammaExpansion(c),lightness));
end;

function ApplyLightnessFast(color: TBGRAPixel; lightness: BGRAWord): TBGRAPixel;
var
  r,g,b: BGRAWord;
  lightness256: byte;
begin
  if lightness <= 32768 then
  begin
    if lightness = 32768 then
      result := color else
    begin
      lightness256 := GammaCompressionTab[lightness shl 1];
      result := BGRA(color.red * lightness256 shr 8, color.green*lightness256 shr 8,
                     color.blue * lightness256 shr 8, color.alpha);
    end;
  end else
  begin
    if lightness = 65535 then
      result := BGRA(255,255,255,color.alpha) else
    begin
      lightness := lightness -32767;
      r := GammaExpansionTab[color.red];
      g := GammaExpansionTab[color.green];
      b := GammaExpansionTab[color.blue];
      result := BGRA(GammaCompressionTab[ r + (not r)*lightness shr 15 ],
                     GammaCompressionTab[ g + (not g)*lightness shr 15 ],
                     GammaCompressionTab[ b + (not b)*lightness shr 15 ],
                     color.alpha);
    end;
  end;
end;

function ApplyIntensityFast(color: TBGRAPixel; lightness: BGRALongWord): TBGRAPixel;
var
    maxValue,invMaxValue,r,g,b: BGRALongWord;
    lightness256: byte;
begin
  if lightness <= 32768 then
  begin
    if lightness = 32768 then
      result := color else
    begin
      lightness256 := GammaCompressionTab[lightness shl 1];
      result := BGRA(color.red * lightness256 shr 8, color.green*lightness256 shr 8,
                     color.blue * lightness256 shr 8, color.alpha);
    end;
  end else
  begin
    r := CombineLightness(GammaExpansionTab[color.red], lightness);
    g := CombineLightness(GammaExpansionTab[color.green], lightness);
    b := CombineLightness(GammaExpansionTab[color.blue], lightness);
    maxValue := r;
    if g > maxValue then maxValue := g;
    if b > maxValue then maxValue := b;
    if maxValue <= 65535 then
      result := BGRA(GammaCompressionTab[r],
                     GammaCompressionTab[g],
                     GammaCompressionTab[b],
                     color.alpha)
    else
    begin
      invMaxValue := (BGRALongWord(2147483647)+BGRALongWord(maxValue-1)) div maxValue;
      maxValue := (maxValue-65535) shr 1;
      r := r*invMaxValue shr 15 + maxValue;
      g := g*invMaxValue shr 15 + maxValue;
      b := b*invMaxValue shr 15 + maxValue;
      if r >= 65535 then result.red := 255 else
        result.red := GammaCompressionTab[r];
      if g >= 65535 then result.green := 255 else
        result.green := GammaCompressionTab[g];
      if b >= 65535 then result.blue := 255 else
        result.blue := GammaCompressionTab[b];
      result.alpha := color.alpha;
    end;
  end;
end;

function CombineLightness(lightness1,lightness2: Int32or64): Int32or64;
{$ifdef CPUI386} {$asmmode intel} assembler;
  asm
    imul edx
    shl edx, 17
    shr eax, 15
    or edx, eax
    mov result, edx
  end;
{$ELSE}
begin
  if (lightness1 < 0) xor (lightness2 < 0) then
    result := -(int64(-lightness1)*lightness2 shr 15)
  else
    result := int64(lightness1)*lightness2 shr 15;
end;
{$ENDIF}

// Conversion to grayscale by taking into account
// different color weights
function BGRAToGrayscale(c: TBGRAPixel): TBGRAPixel;
var
  ec:    TExpandedPixel;
  gray:  BGRAWord;
  cgray: byte;
begin
  if c.alpha = 0 then
  begin
    result := BGRAPixelTransparent;
    exit;
  end;
  //gamma expansion
  ec    := GammaExpansion(c);
  //gray composition
  gray  := (ec.red * redWeightShl10 + ec.green * greenWeightShl10 +
    ec.blue * blueWeightShl10 + 512) shr 10;
  //gamma compression
  cgray := GammaCompressionTab[gray];
  Result.red := cgray;
  Result.green := cgray;
  Result.blue := cgray;
  Result.alpha := c.alpha;
end;

function BGRAToGrayscaleLinear(c: TBGRAPixel): TBGRAPixel;
var
  gray:  byte;
begin
  if c.alpha = 0 then
  begin
    result := BGRAPixelTransparent;
    exit;
  end;
  //gray composition
  gray  := (c.red * redWeightShl10 + c.green * greenWeightShl10 +
    c.blue * blueWeightShl10 + 512) shr 10;
  //gamma compression
  Result.red := gray;
  Result.green := gray;
  Result.blue := gray;
  Result.alpha := c.alpha;
end;

function GrayscaleToBGRA(lightness: BGRAWord): TBGRAPixel;
begin
  result.red := GammaCompressionTab[lightness];
  result.green := result.red;
  result.blue := result.red;
  result.alpha := $ff;
end;

{ Merge linearly two colors of same importance }
function MergeBGRA(c1, c2: TBGRAPixel): TBGRAPixel;
var c12: BGRACardinal;
begin
  if (c1.alpha = 0) then
    Result := c2
  else
  if (c2.alpha = 0) then
    Result := c1
  else
  begin
    c12 := c1.alpha + c2.alpha;
    Result.red   := (c1.red * c1.alpha + c2.red * c2.alpha + c12 shr 1) div c12;
    Result.green := (c1.green * c1.alpha + c2.green * c2.alpha + c12 shr 1) div c12;
    Result.blue  := (c1.blue * c1.alpha + c2.blue * c2.alpha + c12 shr 1) div c12;
    Result.alpha := (c12 + 1) shr 1;
  end;
end;

function MergeBGRA(c1: TBGRAPixel; weight1: integer; c2: TBGRAPixel;
  weight2: integer): TBGRAPixel;
var
    f1,f2,f12: int64;
begin
  if (weight1 = 0) then
  begin
    if (weight2 = 0) then
      result := BGRAPixelTransparent
    else
      Result := c2
  end
  else
  if (weight2 = 0) then
    Result := c1
  else
  if (weight1+weight2 = 0) then
    Result := BGRAPixelTransparent
  else
  begin
    f1 := int64(c1.alpha)*weight1;
    f2 := int64(c2.alpha)*weight2;
    f12 := f1+f2;
    if f12 = 0 then
      result := BGRAPixelTransparent
    else
    begin
      Result.red   := (c1.red * f1 + c2.red * f2 + f12 shr 1) div f12;
      Result.green := (c1.green * f1 + c2.green * f2 + f12 shr 1) div f12;
      Result.blue  := (c1.blue * f1 + c2.blue * f2 + f12 shr 1) div f12;
      {$hints off}
      Result.alpha := (f12 + ((weight1+weight2) shr 1)) div (weight1+weight2);
      {$hints on}
    end;
  end;
end;

function MergeBGRAWithGammaCorrection(c1: TBGRAPixel; weight1: byte; c2: TBGRAPixel;
  weight2: byte): TBGRAPixel;
var
    w1,w2,f1,f2,f12,a: UInt32or64;
begin
  w1 := weight1;
  w2 := weight2;
  if (w1 = 0) then
  begin
    if (w2 = 0) then
      result := BGRAPixelTransparent
    else
      Result := c2
  end
  else
  if (w2 = 0) then
    Result := c1
  else
  begin
    f1 := c1.alpha*w1;
    f2 := c2.alpha*w2;
    a := (f1+f2 + ((w1+w2) shr 1)) div (w1+w2);
    if a = 0 then
    begin
      result := BGRAPixelTransparent;
      exit;
    end else
      Result.alpha := a;
    {$IFNDEF CPU64}
    if (f1 >= 32768) or (f2 >= 32768) then
    begin
      f1 := f1 shr 1;
      f2 := f2 shr 1;
    end;
    {$ENDIF}
    f12 := f1+f2;
    Result.red   := GammaCompressionTab[(GammaExpansionTab[c1.red] * f1 + GammaExpansionTab[c2.red] * f2) div f12];
    Result.green := GammaCompressionTab[(GammaExpansionTab[c1.green] * f1 + GammaExpansionTab[c2.green] * f2) div f12];
    Result.blue  := GammaCompressionTab[(GammaExpansionTab[c1.blue] * f1 + GammaExpansionTab[c2.blue] * f2) div f12];
  end;
end;

{ Convert a TColor value to a TBGRAPixel value }
{$IFDEF FPC}{$PUSH}{$ENDIF}{$R-}
function ColorToBGRA(color: TColor): TBGRAPixel;
begin
  if (color < 0) or (color > $ffffff) then color := ColorToRGB(color);
  RedGreenBlue(color, Result.red,Result.green,Result.blue);
  Result.alpha := 255;
end;

function ColorToBGRA(color: TColor; opacity: byte): TBGRAPixel;
begin
  if (color < 0) or (color > $ffffff) then color := ColorToRGB(color);
  RedGreenBlue(color, Result.red,Result.green,Result.blue);
  Result.alpha := opacity;
end;
{$IFDEF FPC}{$POP}{$ENDIF}

function BGRAToColor(c: TBGRAPixel): TColor;
begin
  Result := RGBToColor(c.red, c.green, c.blue);
end;

{ Conversion from TFPColor to TBGRAPixel assuming TFPColor
  is already gamma compressed }
function FPColorToBGRA(AValue: TFPColor): TBGRAPixel;
begin
  with AValue do
    Result := BGRA(red shr 8, green shr 8, blue shr 8, alpha shr 8);
end;

function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; {$ifdef inline}inline;{$endif}
begin
  result.red := AValue.red shl 8 + AValue.red;
  result.green := AValue.green shl 8 + AValue.green;
  result.blue := AValue.blue shl 8 + AValue.blue;
  result.alpha := AValue.alpha shl 8 + AValue.alpha;
end;

function Color16BitToBGRA(AColor: BGRAWord): TBGRAPixel;
begin
  result := BGRA( ((AColor and $F800) shr 11)*255 div 31,
                  ((AColor and $07e0) shr 5)*255 div 63,
                  (AColor and $001f)*255 div 31 );
end;

function BGRAToColor16Bit(const AColor: TBGRAPixel): BGRAWord;
begin
  result := (((AColor.Red * 31 + 64) div 255) shl 11) +
            (((AColor.green * 63 + 64) div 255) shl 5) +
             ((AColor.blue * 31 + 64) div 255);
end;

function BGRAWordDiff(c1, c2: TBGRAPixel): BGRAWord;
begin
  result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2));
end;

function BGRADiff(c1,c2: TBGRAPixel): byte;
begin
  result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2)) shr 8;
end;

function FastBGRALinearDiff(c1, c2: TBGRAPixel): byte;
begin
  result := max(min((abs(c1.red-c2.red)+(abs(c1.green-c2.green) shl 1)+abs(c1.blue-c2.blue)) shr 2,
             min(c1.alpha,c2.alpha)), abs(c1.alpha-c2.alpha));
end;

function FastBGRAExpandedDiff(c1, c2: TBGRAPixel): BGRAWord;
var wa1,wa2: BGRAWord;
begin
  wa1 := c1.alpha shl 8 + c1.alpha;
  wa2 := (c2.alpha shl 8) + c2.alpha;
  result := max(min((abs(GammaExpansionTab[c1.red]-GammaExpansionTab[c2.red])+
               (abs(GammaExpansionTab[c1.green]-GammaExpansionTab[c2.green]) shl 1)+
               abs(GammaExpansionTab[c1.blue]-GammaExpansionTab[c2.blue])) shr 2,
             min(wa1,wa2)),
             abs(wa1-wa2));
end;

function MergeBGRA(const colors: array of TBGRAPixel): TBGRAPixel;
var
  sumR,sumG,sumB,sumA: BGRANativeUInt;
  i: integer;
begin
  if length(colors)<=0 then
  begin
    result := BGRAPixelTransparent;
    exit;
  end;
  sumR := 0;
  sumG := 0;
  sumB := 0;
  sumA := 0;
  for i := 0 to high(colors) do
  with colors[i] do
  begin
    sumR := sumR +(red  *alpha);
    sumG := sumG +(green*alpha);
    sumB := sumB +(blue *alpha);
    sumA := sumA +alpha;
  end;
  if sumA > 0 then
  begin
    result.red := (sumR + sumA shr 1) div sumA;
    result.green := (sumG + sumA shr 1) div sumA;
    result.blue := (sumB + sumA shr 1) div sumA;
    result.alpha := sumA div BGRALongWord(length(colors));
  end
  else
    result := BGRAPixelTransparent;
end;

function MapHeight(Color: TBGRAPixel): Single;
var intval: integer;
begin
  intval := color.Green shl 16 + color.red shl 8 + color.blue;
  result := intval*5.960464832810452e-8;
end;

function MapHeightToBGRA(Height: Single; Alpha: Byte): TBGRAPixel;
var intval: integer;
begin
  if Height >= 1 then result := BGRA(255,255,255,alpha) else
  if Height <= 0 then result := BGRA(0,0,0,alpha) else
  begin
    intval := round(Height*16777215);
    {$IFDEF FPC}{$PUSH}{$ENDIF}{$R-}
    result := BGRA(intval shr 8,intval shr 16,intval,alpha);
    {$IFDEF FPC}{$POP}{$ENDIF}
  end;
end;
{$ENDIF}

{$IFDEF INCLUDE_INIT}
{$UNDEF INCLUDE_INIT}
  BGRASetGamma();

  {$DEFINE INCLUDE_INITIALIZATION}
  {$i extendedcolorspace.inc}
{$ENDIF}