sync: restore source from Google Drive

vendor/kam_remake/src/ext/BGRABitmap/bgraarrow.pas

@@ -0,0 +1,527 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAArrow;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, BGRABitmapTypes, BGRAGraphics;
+
+type
+  { TBGRAArrow }
+
+  TBGRAArrow = class(TBGRACustomArrow)
+  private
+    FLineCap: TPenEndCap;
+    FWidth : single;
+    FStart : ArrayOfTPointF;
+    FStartComputed: boolean;
+    FStartStyle: TBGRAArrowStyle;
+    FStartSizeFactor: TPointF;
+    FStartTipStyle: TPenJoinStyle;
+    FStartOffsetX: single;
+    FStartRepeatCount: integer;
+    FStartRelativePenWidth: single;
+    FStartTriangleBackOffset: single;
+    FEnd : ArrayOfTPointF;
+    FEndComputed: boolean;
+    FEndStyle: TBGRAArrowStyle;
+    FEndSizeFactor: TPointF;
+    FEndTipStyle: TPenJoinStyle;
+    FEndOffsetX: single;
+    FEndRepeatCount: integer;
+    FEndRelativePenWidth: single;
+    FEndTriangleBackOffset: single;
+    function ComputeAnyAt(const AData: ArrayOfTPointF; const APosition, ADirection: TPointF): ArrayOfTPointF;
+    function ComputeData(AStyle: TBGRAArrowStyle; const ASizeFactor: TPointF;
+        ATipStyle: TPenJoinStyle; ALineCap: TPenEndCap; const AWidth: single; AOffsetX: single;
+        ARepeatCount: integer; ARelativePenWidth: single; ATriangleBackOffset: single): ArrayOfTPointF;
+    procedure SetWidth(AValue: single);
+  protected
+    function GetEndRepeatCount: integer; override;
+    function GetEndSizeFactor: TPointF; override;
+    function GetIsEndDefined: boolean; override;
+    function GetIsStartDefined: boolean; override;
+    function GetEndOffsetX: single; override;
+    function GetStartOffsetX: single; override;
+    function GetStartRepeatCount: integer; override;
+    function GetStartSizeFactor: TPointF; override;
+    procedure SetEndOffsetX(AValue: single); override;
+    procedure SetEndRepeatCount(AValue: integer); override;
+    procedure SetEndSizeFactor(AValue: TPointF); override;
+    procedure SetStartOffsetX(AValue: single); override;
+    procedure SetStartRepeatCount(AValue: integer); override;
+    procedure SetStartSizeFactor(AValue: TPointF); override;
+    function GetLineCap: TPenEndCap; override;
+    procedure SetLineCap(AValue: TPenEndCap); override;
+    procedure SetStart(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0);
+    procedure SetEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle = pjsMiter; ARelativePenWidth: single = 1; ATriangleBackOffset: single = 0);
+  public
+    constructor Create;
+    procedure StartAsNone; override;
+    procedure StartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override;
+    procedure StartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override;
+    procedure StartAsTail; override;
+    procedure EndAsNone; override;
+    procedure EndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override;
+    procedure EndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override;
+    procedure EndAsTail; override;
+    function ComputeStartAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; override;
+    function ComputeEndAt(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF; override;
+
+  end;
+
+implementation
+
+uses BGRAClasses, BGRATransform, BGRAPen, BGRAPath;
+
+{ TBGRAArrow }
+
+function TBGRAArrow.ComputeAnyAt(const AData: ArrayOfTPointF; const APosition,
+  ADirection: TPointF): ArrayOfTPointF;
+var m: TAffineMatrix;
+  i: integer;
+begin
+  if (AData = nil) or isEmptyPointF(APosition) or isEmptyPointF(ADirection) or ((ADirection.x = 0) and (ADirection.y = 0)) then
+  begin
+    result := nil;
+    exit;
+  end;
+  m := AffineMatrixTranslation(APosition.x,APosition.y)*AffineMatrixLinear(ADirection, PointF(-ADirection.y, ADirection.x));
+  setlength(result, length(AData));
+  for i := 0 to high(result) do
+    if not isEmptyPointF(AData[i]) then
+      result[i] := m*AData[i]
+    else
+      result[i] := EmptyPointF;
+end;
+
+function TBGRAArrow.ComputeData(AStyle: TBGRAArrowStyle;
+  const ASizeFactor: TPointF; ATipStyle: TPenJoinStyle; ALineCap: TPenEndCap;
+  const AWidth: single; AOffsetX: single; ARepeatCount: integer;
+  ARelativePenWidth: single; ATriangleBackOffset: single): ArrayOfTPointF;
+var sizeFactorX,sizeFactorY,ofsX: single;
+  prefix,suffix,middle: ArrayOfTPointF;
+  arc: TArcDef;
+  i,j,n : integer;
+  withCut: ArrayOfTPointF;
+  subResult: ArrayOfTPointF;
+  w: single;
+  backOfs: single;
+  tailSizeX, tailAdditionalWidth: single;
+begin
+  sizeFactorX := abs(ASizeFactor.X)*AWidth;
+  sizeFactorY := abs(ASizeFactor.Y)*AWidth;
+  if (sizeFactorX = 0) or (sizeFactorY = 0) then
+  begin
+    result := nil;
+    exit;
+  end;
+  w := AWidth*ARelativePenWidth;
+  if AStyle in [asTail,asTailRepeat] then
+  begin
+    tailSizeX := sizeFactorX/SizeFactorY*AWidth*0.5;
+    if AStyle = asTailRepeat then
+    begin
+      tailAdditionalWidth:= AWidth-tailSizeX;
+      if tailAdditionalWidth < 0 then tailAdditionalWidth := 0;
+    end else
+      tailAdditionalWidth:=0;
+  end
+  else
+  begin
+    tailSizeX := 0;
+    tailAdditionalWidth:=0;
+  end;
+  case AStyle of
+  asTriangle,asHollowTriangle: begin
+    backOfs := ATriangleBackOffset*sizeFactorX;
+    if AStyle = asHollowTriangle then
+    begin
+      result := ComputeWidePolylinePoints(PointsF([PointF(0.5*w,-AWidth*0.5),
+             PointF(0.5*w-backOfs,-sizeFactorY+w*0.5),
+             PointF(sizeFactorX-w*0.5,0),
+             PointF(w*0.5-backOfs,sizeFactorY-w*0.5),
+             PointF(0.5*w,AWidth*0.5)]),
+             w,BGRABlack,ALineCap,ATipStyle,nil,[plCycle]);
+    end else
+    begin
+      prefix := PointsF([PointF(0,-AWidth*0.5),PointF(-backOfs,-sizeFactorY)]);
+      suffix := PointsF([PointF(-backOfs,sizeFactorY),PointF(0,AWidth*0.5)]);
+      if (ATipStyle in[pjsRound,pjsBevel]) then
+      begin
+        arc := Html5ArcTo(prefix[1],PointF(sizeFactorX,0),suffix[0],AWidth*0.5);
+        if ATipStyle = pjsRound then
+          middle := ComputeArc(arc)
+        else
+          middle := PointsF([ArcStartPoint(arc),ArcEndPoint(arc)]);
+      end
+      else middle := PointsF([PointF(sizeFactorX,0)]);
+      result := ConcatPointsF([prefix,middle,suffix]);
+    end;
+  end;
+  asNormal,asCut:
+    begin
+      if AStyle = asCut then ALineCap:= pecSquare;
+      result := ComputeWidePolylinePoints([PointF(-sizeFactorX,-sizeFactorY),
+        PointF(0,0),PointF(-sizeFactorX,+sizeFactorY)],w,BGRABlack,ALineCap,ATipStyle,nil,[]);
+    end;
+  asFlipped,asFlippedCut:
+    begin
+      if AStyle = asFlippedCut then ALineCap:= pecSquare;
+      result := ComputeWidePolylinePoints([PointF(+sizeFactorX,-sizeFactorY),
+       PointF(0,0),PointF(+sizeFactorX,+sizeFactorY)],w,BGRABlack,ALineCap,ATipStyle,nil,[]);
+    end;
+  asTail: result := PointsF([PointF(0,-0.5*AWidth),PointF(tailSizeX,-0.5*AWidth),PointF(0,0),PointF(tailSizeX,0.5*AWidth),PointF(0,0.5*AWidth)]);
+  asTailRepeat: result := PointsF([PointF(0,-0.5*AWidth),PointF(tailSizeX+tailAdditionalWidth,-0.5*AWidth),PointF(tailAdditionalWidth,0),PointF(tailSizeX+tailAdditionalWidth,0.5*AWidth),PointF(0,0.5*AWidth),PointF(-tailSizeX,0)]);
+  else
+    result := nil;
+  end;
+  if (AStyle in [asCut,asFlippedCut,asHollowTriangle]) then
+  begin
+    n := 0;
+    setlength(withCut,length(result)*2);
+    for i := 0 to high(result) do
+      if isEmptyPointF(result[i]) then
+      begin
+        if (n > 0) and not isEmptyPointF(withCut[n-1]) then
+        begin
+          withCut[n] := EmptyPointF;
+          inc(n);
+        end;
+      end else
+      if abs(result[i].y)<=sizeFactorY then
+      begin
+        withCut[n] := result[i];
+        inc(n);
+      end else
+      if result[i].y>sizeFactorY then
+      begin
+        j := (i+length(result)-1) mod length(result);
+        if result[j].y<=sizeFactorY then
+        begin
+          withCut[n].x := result[j].x + (result[i].x-result[j].x)/(result[i].y-result[j].y)*(sizeFactorY-result[j].y);
+          withCut[n].y := sizeFactorY;
+          inc(n);
+        end;
+        j := (i+1) mod length(result);
+        if result[j].y<=sizeFactorY then
+        begin
+          withCut[n].x := result[j].x + (result[i].x-result[j].x)/(result[i].y-result[j].y)*(sizeFactorY-result[j].y);
+          withCut[n].y := sizeFactorY;
+          inc(n);
+        end;
+      end else
+      if result[i].y<-sizeFactorY then
+      begin
+        j := (i+length(result)-1) mod length(result);
+        if result[j].y>=-sizeFactorY then
+        begin
+          withCut[n].x := result[j].x + (result[i].x-result[j].x)/(result[i].y-result[j].y)*(-sizeFactorY-result[j].y);
+          withCut[n].y := -sizeFactorY;
+          inc(n);
+        end;
+        j := (i+1) mod length(result);
+        if result[j].y>=-sizeFactorY then
+        begin
+          withCut[n].x := result[j].x + (result[i].x-result[j].x)/(result[i].y-result[j].y)*(-sizeFactorY-result[j].y);
+          withCut[n].y := -sizeFactorY;
+          inc(n);
+        end;
+      end;
+      if (n > 0) and isEmptyPointF(withCut[n-1]) then dec(n);
+      setlength(withCut,n);
+      result := withCut;
+  end;
+  if AOffsetX <> 0 then
+  begin
+    ofsX := AOffsetX*AWidth;
+    for i := 0 to high(result) do
+      if not isEmptyPointF(result[i]) then
+        IncF(result[i].x, ofsX);
+  end;
+  if ARepeatCount > 1 then
+  begin
+    if ARepeatCount > 10 then ARepeatCount:= 10;
+    if AStyle in[asTriangle,asHollowTriangle] then IncF(AOffsetX, sizeFactorX/AWidth)
+    else if AStyle in[asTail,asTailRepeat] then IncF(AOffsetX, (tailSizeX+tailAdditionalWidth)/AWidth+1)
+    else IncF(AOffsetX, 2*ARelativePenWidth);
+    if AStyle = asTail then AStyle := asTailRepeat;
+    subResult := ComputeData(AStyle,ASizeFactor,ATipStyle,ALineCap,AWidth,AOffsetX,ARepeatCount-1,ARelativePenWidth,ATriangleBackOffset);
+    result := ConcatPointsF([result,PointsF([EmptyPointF]),subResult]);
+  end;
+end;
+
+function TBGRAArrow.GetIsEndDefined: boolean;
+begin
+  result := FEndStyle <> asNone;
+end;
+
+function TBGRAArrow.GetIsStartDefined: boolean;
+begin
+  result := FStartStyle <> asNone;
+end;
+
+function TBGRAArrow.GetEndOffsetX: single;
+begin
+  result := FEndOffsetX;
+end;
+
+function TBGRAArrow.GetStartOffsetX: single;
+begin
+  result := FStartOffsetX;
+end;
+
+function TBGRAArrow.GetStartRepeatCount: integer;
+begin
+  result := FStartRepeatCount;
+end;
+
+function TBGRAArrow.GetStartSizeFactor: TPointF;
+begin
+  result := FStartSizeFactor;
+end;
+
+procedure TBGRAArrow.SetEndOffsetX(AValue: single);
+begin
+  if FEndOffsetX=AValue then Exit;
+  FEndOffsetX:=AValue;
+  FEndComputed:= false;
+  FEnd := nil;
+end;
+
+function TBGRAArrow.GetLineCap: TPenEndCap;
+begin
+  result := FLineCap;
+end;
+
+procedure TBGRAArrow.SetEndRepeatCount(AValue: integer);
+begin
+  if FEndRepeatCount=AValue then Exit;
+  FEndRepeatCount:=AValue;
+  FEndComputed:= false;
+  FEnd := nil;
+end;
+
+procedure TBGRAArrow.SetEndSizeFactor(AValue: TPointF);
+begin
+  if FEndSizeFactor=AValue then Exit;
+  FEndSizeFactor:=AValue;
+  FEndComputed:= false;
+  FEnd := nil;
+end;
+
+procedure TBGRAArrow.SetLineCap(AValue: TPenEndCap);
+begin
+  if FLineCap=AValue then Exit;
+  FLineCap:=AValue;
+  FStartComputed:= false;
+  FEndComputed:= false;
+  FStart:= nil;
+  FEnd := nil;
+end;
+
+procedure TBGRAArrow.SetStartOffsetX(AValue: single);
+begin
+  if FStartOffsetX=AValue then Exit;
+  FStartOffsetX:=AValue;
+  FStartComputed:= false;
+  FStart := nil;
+end;
+
+procedure TBGRAArrow.SetStartRepeatCount(AValue: integer);
+begin
+  if FStartRepeatCount=AValue then Exit;
+  FStartRepeatCount:=AValue;
+  FStartComputed:= false;
+  FStart := nil;
+end;
+
+procedure TBGRAArrow.SetStartSizeFactor(AValue: TPointF);
+begin
+  if FStartSizeFactor=AValue then Exit;
+  FStartSizeFactor:=AValue;
+  FStartComputed:= false;
+  FStart := nil;
+end;
+
+procedure TBGRAArrow.SetWidth(AValue: single);
+begin
+  if FWidth=AValue then Exit;
+  FWidth:=AValue;
+  FStartComputed := false;
+  FEndComputed:= false;
+end;
+
+function TBGRAArrow.GetEndRepeatCount: integer;
+begin
+  Result:= FEndRepeatCount;
+end;
+
+function TBGRAArrow.GetEndSizeFactor: TPointF;
+begin
+  Result:= FEndSizeFactor;
+end;
+
+constructor TBGRAArrow.Create;
+begin
+  FWidth := 1;
+  FStartSizeFactor := PointF(2,2);
+  FEndSizeFactor := PointF(2,2);
+end;
+
+procedure TBGRAArrow.StartAsNone;
+begin
+  SetStart(asNone);
+end;
+
+procedure TBGRAArrow.StartAsClassic(AFlipped: boolean; ACut: boolean;
+  ARelativePenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if (LineCap = pecRound) and not ACut then join := pjsRound else join := pjsMiter;
+  if ACut then
+  begin
+    if AFlipped then
+      SetStart(asFlippedCut,join,ARelativePenWidth)
+    else
+      SetStart(asCut,join,ARelativePenWidth)
+  end
+  else
+  begin
+    if AFlipped then
+      SetStart(asFlipped,join,ARelativePenWidth)
+    else
+      SetStart(asNormal,join,ARelativePenWidth)
+  end;
+end;
+
+procedure TBGRAArrow.StartAsTriangle(ABackOffset: single; ARounded: boolean;
+  AHollow: boolean; AHollowPenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if ARounded then join := pjsRound else join := pjsMiter;
+  if AHollow then
+    SetStart(asHollowTriangle, join,AHollowPenWidth, ABackOffset)
+  else
+    SetStart(asTriangle, join,1,ABackOffset);
+end;
+
+procedure TBGRAArrow.StartAsTail;
+begin
+  SetStart(asTail);
+end;
+
+procedure TBGRAArrow.EndAsNone;
+begin
+  SetEnd(asNone);
+end;
+
+procedure TBGRAArrow.EndAsClassic(AFlipped: boolean; ACut: boolean;
+  ARelativePenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if (LineCap = pecRound) and not ACut then join := pjsRound else join := pjsMiter;
+  if ACut then
+  begin
+    if AFlipped then
+      SetEnd(asFlippedCut,join,ARelativePenWidth)
+    else
+      SetEnd(asCut,join,ARelativePenWidth)
+  end
+  else
+  begin
+    if AFlipped then
+      SetEnd(asFlipped,join,ARelativePenWidth)
+    else
+      SetEnd(asNormal,join,ARelativePenWidth)
+  end;
+end;
+
+procedure TBGRAArrow.EndAsTriangle(ABackOffset: single; ARounded: boolean;
+  AHollow: boolean; AHollowPenWidth: single);
+var join: TPenJoinStyle;
+begin
+  if ARounded then join := pjsRound else join := pjsMiter;
+  if AHollow then
+    SetEnd(asHollowTriangle, join,AHollowPenWidth, ABackOffset)
+  else
+    SetEnd(asTriangle, join,1, ABackOffset);
+end;
+
+procedure TBGRAArrow.EndAsTail;
+begin
+  SetEnd(asTail);
+end;
+
+procedure TBGRAArrow.SetStart(AStyle: TBGRAArrowStyle;
+  ATipStyle: TPenJoinStyle; ARelativePenWidth: single; ATriangleBackOffset: single);
+begin
+  FStartStyle := AStyle;
+  FStartTipStyle := ATipStyle;
+  FStartComputed := false;
+  FStartRelativePenWidth:= ARelativePenWidth;
+  FStartTriangleBackOffset := ATriangleBackOffset;
+  FStart := nil;
+end;
+
+procedure TBGRAArrow.SetEnd(AStyle: TBGRAArrowStyle; ATipStyle: TPenJoinStyle;
+  ARelativePenWidth: single; ATriangleBackOffset: single);
+begin
+  FEndStyle := AStyle;
+  FEndTipStyle := ATipStyle;
+  FEndComputed := false;
+  FEndRelativePenWidth:= ARelativePenWidth;
+  FEndTriangleBackOffset := ATriangleBackOffset;
+  FEnd := nil;
+end;
+
+function TBGRAArrow.ComputeStartAt(const APosition: TPointF;
+  const ADirection: TPointF; const AWidth: single; const ACurrentPos: single
+  ): ArrayOfTPointF;
+begin
+  if not IsStartDefined then
+  begin
+    result := nil;
+    exit;
+  end;
+  if AWidth <> FWidth then
+  begin
+    FWidth := AWidth;
+    FStartComputed:= false;
+  end;
+  if not FStartComputed then
+  begin
+    FStart := ComputeData(FStartStyle,FStartSizeFactor,FStartTipStyle,FLineCap,FWidth,
+    FStartOffsetX-ACurrentPos,FStartRepeatCount,FStartRelativePenWidth,FStartTriangleBackOffset);
+    FStartComputed:= true;
+  end;
+  result := ComputeAnyAt(FStart,APosition,ADirection);
+end;
+
+function TBGRAArrow.ComputeEndAt(const APosition: TPointF;
+  const ADirection: TPointF; const AWidth: single; const ACurrentPos: single
+  ): ArrayOfTPointF;
+begin
+  if not IsEndDefined then
+  begin
+    result := nil;
+    exit;
+  end;
+  if AWidth <> FWidth then
+  begin
+    FWidth := AWidth;
+    FEndComputed:= false;
+  end;
+  if not FEndComputed then
+  begin
+    FEnd := ComputeData(FEndStyle,FEndSizeFactor,FEndTipStyle,FLineCap,FWidth,
+      FEndOffsetX-ACurrentPos,FEndRepeatCount,FEndRelativePenWidth,FEndTriangleBackOffset);
+    FEndComputed:= true;
+  end;
+  result := ComputeAnyAt(FEnd,APosition,ADirection);
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrabitmap.inc

@@ -0,0 +1,34 @@
+{$DEFINE BGRABITMAP}
+{ You can define the following compiler directives in the package options,
+  in tab Compiler options, in section Other. Directives must be prefixed with
+  "-d". So for example:
+
+  - to always have RGBA pixel format, write "-dBGRABITMAP_RGBAPIXEL"
+  - to always have BGRA pixel format, write "-dBGRABITMAP_BGRAPIXEL"
+  - to use fpGUI toolkit, write "-dBGRABITMAP_USE_FPGUI" }
+{$IFNDEF BGRABITMAP_DONT_USE_LCL}
+  {$IFDEF LCL}
+    {$DEFINE BGRABITMAP_USE_LCL}
+  {$ENDIF}
+{$ENDIF}
+{$IFDEF BGRABITMAP_USE_FPGUI}
+  {$UNDEF BGRABITMAP_USE_LCL}
+  {$DEFINE TCOLOR_BLUE_IN_LOW_BYTE}
+{$ENDIF}
+{$IFDEF BGRABITMAP_USE_MSEGUI}
+  {$UNDEF BGRABITMAP_USE_LCL}
+  {$DEFINE TCOLOR_BLUE_IN_LOW_BYTE}
+  {$DEFINE BGRABITMAP_DONT_USE_FPCANVAS}
+{$ENDIF}
+{$IFNDEF BGRABITMAP_DONT_USE_FPCANVAS}
+  {$DEFINE BGRABITMAP_USE_FPCANVAS}
+{$ENDIF}
+
+{ Extensions of LCL to be used. Add // at the beginning of the line
+  to comment them if the functions are not available }
+{$DEFINE BGRABITMAP_USE_LCL12} { Use functions of Lazarus 1.2 }
+{$DEFINE BGRABITMAP_USE_LCL15} { Use functions of Lazarus 1.5 }
+
+{$MODESWITCH ADVANCEDRECORDS}
+{$MODESWITCH TypeHelpers}
+

vendor/kam_remake/src/ext/BGRABitmap/bgrabitmap.pas

@@ -0,0 +1,508 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{
+ /**************************************************************************\
+                                bgrabitmap.pas
+                                --------------
+                 Free easy-to-use memory bitmap 32-bit,
+                 8-bit for each channel, transparency.
+                 Channels can be in the following orders:
+                 - B G R A (recommended for Windows, required for fpGUI)
+                 - R G B A (recommended for Gtk and MacOS)
+
+                 - Drawing primitives
+                 - Resample
+                 - Reference counter
+                 - Drawing on LCL canvas
+                 - Loading and saving images
+
+                 Note : line order can change, so if you access
+                 directly to bitmap data, check LineOrder value
+                 or use Scanline to compute position.
+
+
+       --> Include BGRABitmap and BGRABitmapTypes in the 'uses' clause.
+}
+
+unit BGRABitmap;
+
+{$mode objfpc}{$H+}
+{$i bgrabitmap.inc}
+
+interface
+
+{ Compiler directives are used to include the best version according
+  to the platform }
+
+uses
+  BGRAClasses, BGRABitmapTypes, FPImage, SysUtils,
+{$IFDEF BGRABITMAP_USE_FPGUI}
+    BGRAfpGUIBitmap,
+{$ELSE}
+	{$IFDEF BGRABITMAP_USE_LCL}
+	  {$IFDEF LCLwin32}
+		BGRAWinBitmap,
+	  {$ELSE}
+		{$IFDEF LCLgtk}
+		BGRAGtkBitmap,
+		{$ELSE}
+		  {$IFDEF LCLgtk2}
+		BGRAGtkBitmap,
+		  {$ELSE}
+			{$IF defined(LCLqt) or defined(LCLqt5)}
+		BGRAQtBitmap,
+			{$ELSE}
+              {$IFDEF DARWIN}
+                BGRAMacBitmap,
+              {$ELSE}
+		BGRALCLBitmap,
+              {$ENDIF}
+			{$ENDIF}
+		  {$ENDIF}
+		{$ENDIF}
+	  {$ENDIF}
+	{$ELSE}
+	  {$IFDEF BGRABITMAP_USE_MSEGUI}
+            BGRAMSEguiBitmap,
+          {$ELSE}
+            BGRANoGuiBitmap,
+          {$ENDIF}
+	{$ENDIF}
+{$ENDIF}
+  BGRAGraphics;
+
+type
+{$IFDEF BGRABITMAP_USE_FPGUI}
+  TBGRABitmap = class(TBGRAfpGUIBitmap)
+{$ELSE}
+    {$IFDEF BGRABITMAP_USE_LCL}
+      {$IFDEF LCLwin32}
+        TBGRABitmap = class(TBGRAWinBitmap)
+      {$ELSE}
+        {$IFDEF LCLgtk}
+        TBGRABitmap = class(TBGRAGtkBitmap)
+        {$ELSE}
+          {$IFDEF LCLgtk2}
+
+        { TBGRABitmap }
+
+        TBGRABitmap = class(TBGRAGtkBitmap)
+          {$ELSE}
+            {$IF defined(LCLqt) or defined(LCLqt5)}
+        TBGRABitmap = class(TBGRAQtBitmap)
+            {$ELSE}
+              {$IFDEF DARWIN}
+        TBGRABitmap = class(TBGRAMacBitmap)
+              {$ELSE}
+        TBGRABitmap = class(TBGRALCLBitmap)
+              {$ENDIF}
+            {$ENDIF}
+          {$ENDIF}
+        {$ENDIF}
+      {$ENDIF}
+    {$ELSE}
+      {$IFDEF BGRABITMAP_USE_MSEGUI}
+        TBGRABitmap = class(TBGRAMSEguiBitmap)
+      {$ELSE}
+        TBGRABitmap = class(TBGRANoGUIBitmap)
+      {$ENDIF}
+    {$ENDIF}
+{$ENDIF}
+  public
+    function NewBitmap: TBGRABitmap; overload; override;
+    function NewBitmap(AWidth, AHeight: integer): TBGRABitmap; overload; override;
+    function NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel): TBGRABitmap; overload; override;
+    function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGRABitmap; overload; override;
+    function NewBitmap(Filename: string): TBGRABitmap; overload; override;
+    function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRABitmap; overload; override;
+    function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGRABitmap; overload; override;
+    function NewBitmap(AFPImage: TFPCustomImage): TBGRABitmap; overload; override;
+    function NewReference: TBGRABitmap; override;
+    function GetUnique: TBGRABitmap; override;
+    function Duplicate(DuplicateProperties: Boolean = False): TBGRABitmap; overload; override;
+    function Duplicate(DuplicateProperties, DuplicateXorMask: Boolean) : TBGRABitmap; overload; override;
+    function GetPart(const ARect: TRect): TBGRABitmap; override;
+    function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel;
+                AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRABitmap; override;
+    function Resample(newWidth, newHeight: integer;
+      mode: TResampleMode = rmFineResample): TBGRABitmap; override;
+    function RotateCW: TBGRABitmap; override;
+    function RotateCCW: TBGRABitmap; override;
+    function RotateUD: TBGRABitmap; override;
+    function FilterSmartZoom3(Option: TMedianOption): TBGRABitmap; override;
+    function FilterMedian(Option: TMedianOption): TBGRABitmap; override;
+    function FilterSmooth: TBGRABitmap; override;
+    function FilterSharpen(Amount: single = 1): TBGRABitmap; overload; override;
+    function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGRABitmap; overload; override;
+    function FilterContour(AGammaCorrection: boolean = false): TBGRABitmap; override;
+    function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRABitmap; override;
+    function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGRABitmap; overload; override;
+    function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TBGRABitmap; overload; override;
+    function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TBGRABitmap; overload; override;
+    function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TBGRABitmap; overload; override;
+    function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TBGRABitmap; overload; override;
+    function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TBGRABitmap; overload; override;
+    function FilterCustomBlur(mask: TCustomUniversalBitmap): TBGRABitmap; overload; override;
+    function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TBGRABitmap; overload; override;
+    function FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRABitmap; overload; override;
+    function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRABitmap; overload; override;
+    function FilterEmbossHighlight(FillSelection: boolean): TBGRABitmap; overload; override;
+    function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRABitmap; overload; override;
+    function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGRABitmap; overload; override;
+    function FilterGrayscale: TBGRABitmap; overload; override;
+    function FilterGrayscale(ABounds: TRect): TBGRABitmap; overload; override;
+    function FilterNormalize(eachChannel: boolean = True): TBGRABitmap; overload; override;
+    function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRABitmap; overload; override;
+    function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRABitmap; override;
+    function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGRABitmap; override;
+    function FilterSphere: TBGRABitmap; override;
+    function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRABitmap; overload; override;
+    function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRABitmap; overload; override;
+    function FilterCylinder: TBGRABitmap; override;
+    function FilterPlane: TBGRABitmap; override;
+  end;
+
+// draw a bitmap from pure data
+procedure BGRABitmapDraw(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
+  VerticalFlip: boolean; AWidth, AHeight: integer; Opaque: boolean);
+  
+{ Replace the content of the variable Destination with the variable
+  Temp and frees previous object contained in Destination.
+  
+  This function is useful as a shortcut for :
+ 
+  var
+    temp: TBGRABitmap;
+  begin
+    ...
+    temp := someBmp.Filter... as TBGRABitmap;
+    someBmp.Free;
+    someBmp := temp;
+  end;
+  
+  which becomes :
+  
+  begin
+    ...
+    BGRAReplace(someBmp, someBmp.Filter... );
+  end;
+}
+procedure BGRAReplace(var Destination: TBGRABitmap; Temp: TObject);
+
+implementation
+
+uses BGRAReadBMP, BGRAReadBmpMioMap, BGRAReadGif,
+  BGRAReadIco, BGRAReadJpeg, BGRAReadLzp, BGRAReadPCX,
+  BGRAReadPng, BGRAWritePNG, BGRAReadPSD, BGRAReadTGA, BGRAReadXPM,
+  BGRAWriteLzp, BGRAReadWebP, BGRAWriteWebP;
+
+var
+  tempBmp: TBGRABitmap;
+
+procedure BGRABitmapDraw(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
+  VerticalFlip: boolean; AWidth, AHeight: integer; Opaque: boolean);
+var
+  LineOrder: TRawImageLineOrder;
+begin
+  if tempBmp = nil then
+    tempBmp := TBGRABitmap.Create;
+  if VerticalFlip then
+    LineOrder := riloBottomToTop
+  else
+    LineOrder := riloTopToBottom;
+  if Opaque then
+    tempBmp.DataDrawOpaque(ACanvas, Rect, AData, LineOrder, AWidth, AHeight)
+  else
+    tempBmp.DataDrawTransparent(ACanvas, Rect, AData, LineOrder, AWidth, AHeight);
+end;
+
+procedure BGRAReplace(var Destination: TBGRABitmap; Temp: TObject);
+begin
+  Destination.Free;
+  Destination := Temp as TBGRABitmap;
+end;
+
+{ TBGRABitmap }
+
+function TBGRABitmap.NewBitmap: TBGRABitmap;
+begin
+  Result:=inherited NewBitmap as TBGRABitmap;
+end;
+
+function TBGRABitmap.NewBitmap(AWidth, AHeight: integer): TBGRABitmap;
+begin
+  Result:=inherited NewBitmap(AWidth, AHeight) as TBGRABitmap;
+end;
+
+function TBGRABitmap.NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel
+  ): TBGRABitmap;
+begin
+  Result:=inherited NewBitmap(AWidth, AHeight, Color) as TBGRABitmap;
+end;
+
+function TBGRABitmap.NewBitmap(AWidth, AHeight: integer; AColor: Pointer
+  ): TBGRABitmap;
+begin
+  Result:=inherited NewBitmap(AWidth, AHeight, AColor) as TBGRABitmap;
+end;
+
+function TBGRABitmap.NewBitmap(Filename: string): TBGRABitmap;
+begin
+  Result:=inherited NewBitmap(Filename) as TBGRABitmap;
+end;
+
+function TBGRABitmap.NewBitmap(Filename: string; AIsUtf8: boolean): TBGRABitmap;
+begin
+  Result:=inherited NewBitmap(Filename, AIsUtf8) as TBGRABitmap;
+end;
+
+function TBGRABitmap.NewBitmap(Filename: string; AIsUtf8: boolean;
+  AOptions: TBGRALoadingOptions): TBGRABitmap;
+begin
+  Result:=inherited NewBitmap(Filename, AIsUtf8, AOptions) as TBGRABitmap;
+end;
+
+function TBGRABitmap.NewBitmap(AFPImage: TFPCustomImage): TBGRABitmap;
+begin
+  Result:=inherited NewBitmap(AFPImage) as TBGRABitmap;
+end;
+
+function TBGRABitmap.NewReference: TBGRABitmap;
+begin
+  Result:=inherited NewReference as TBGRABitmap;
+end;
+
+function TBGRABitmap.GetUnique: TBGRABitmap;
+begin
+  Result:=inherited GetUnique as TBGRABitmap;
+end;
+
+function TBGRABitmap.Duplicate(DuplicateProperties: Boolean): TBGRABitmap;
+begin
+  Result:=inherited Duplicate(DuplicateProperties) as TBGRABitmap;
+end;
+
+function TBGRABitmap.Duplicate(DuplicateProperties, DuplicateXorMask: Boolean
+  ): TBGRABitmap;
+begin
+  Result:=inherited Duplicate(DuplicateProperties, DuplicateXorMask) as TBGRABitmap;
+end;
+
+function TBGRABitmap.GetPart(const ARect: TRect): TBGRABitmap;
+begin
+  Result:=inherited GetPart(ARect) as TBGRABitmap;
+end;
+
+function TBGRABitmap.CreateBrushTexture(ABrushStyle: TBrushStyle;
+  APatternColor, ABackgroundColor: TBGRAPixel; AWidth: integer;
+  AHeight: integer; APenWidth: single): TBGRABitmap;
+begin
+  Result:=inherited CreateBrushTexture(ABrushStyle, APatternColor,
+    ABackgroundColor, AWidth, AHeight, APenWidth) as TBGRABitmap;
+end;
+
+function TBGRABitmap.Resample(newWidth, newHeight: integer; mode: TResampleMode
+  ): TBGRABitmap;
+begin
+  Result:=inherited Resample(newWidth, newHeight, mode) as TBGRABitmap;
+end;
+
+function TBGRABitmap.RotateCW: TBGRABitmap;
+begin
+  Result:=inherited RotateCW as TBGRABitmap;
+end;
+
+function TBGRABitmap.RotateCCW: TBGRABitmap;
+begin
+  Result:=inherited RotateCCW as TBGRABitmap;
+end;
+
+function TBGRABitmap.RotateUD: TBGRABitmap;
+begin
+  Result:=inherited RotateUD as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterSmartZoom3(Option: TMedianOption): TBGRABitmap;
+begin
+  Result:=inherited FilterSmartZoom3(Option) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterMedian(Option: TMedianOption): TBGRABitmap;
+begin
+  Result:=inherited FilterMedian(Option) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterSmooth: TBGRABitmap;
+begin
+  Result:=inherited FilterSmooth as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterSharpen(Amount: single): TBGRABitmap;
+begin
+  Result:=inherited FilterSharpen(Amount) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterSharpen(ABounds: TRect; Amount: single): TBGRABitmap;
+begin
+  Result:=inherited FilterSharpen(ABounds, Amount) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterContour(AGammaCorrection: boolean = false): TBGRABitmap;
+begin
+  Result:=inherited FilterContour(AGammaCorrection) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterPixelate(pixelSize: integer; useResample: boolean;
+  filter: TResampleFilter): TBGRABitmap;
+begin
+  Result:=inherited FilterPixelate(pixelSize, useResample, filter) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterBlurRadial(radius: single; blurType: TRadialBlurType
+  ): TBGRABitmap;
+begin
+  Result:=inherited FilterBlurRadial(radius, blurType) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterBlurRadial(const ABounds: TRect; radius: single;
+  blurType: TRadialBlurType): TBGRABitmap;
+begin
+  Result:=inherited FilterBlurRadial(ABounds, radius, blurType) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterBlurRadial(radiusX, radiusY: single;
+  blurType: TRadialBlurType): TBGRABitmap;
+begin
+  Result:=inherited FilterBlurRadial(radiusX, radiusY, blurType) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single;
+  blurType: TRadialBlurType): TBGRABitmap;
+begin
+  Result:=inherited FilterBlurRadial(ABounds, radiusX, radiusY, blurType) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterBlurMotion(distance: single; angle: single;
+  oriented: boolean): TBGRABitmap;
+begin
+  Result:=inherited FilterBlurMotion(distance, angle, oriented) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterBlurMotion(const ABounds: TRect; distance: single;
+  angle: single; oriented: boolean): TBGRABitmap;
+begin
+  Result:=inherited FilterBlurMotion(ABounds, distance, angle, oriented) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterCustomBlur(mask: TCustomUniversalBitmap
+  ): TBGRABitmap;
+begin
+  Result:=inherited FilterCustomBlur(mask) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterCustomBlur(const ABounds: TRect;
+  mask: TCustomUniversalBitmap): TBGRABitmap;
+begin
+  Result:=inherited FilterCustomBlur(ABounds, mask) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterEmboss(angle: single; AStrength: integer;
+  AOptions: TEmbossOptions): TBGRABitmap;
+begin
+  Result:=inherited FilterEmboss(angle, AStrength, AOptions) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterEmboss(angle: single; ABounds: TRect;
+  AStrength: integer; AOptions: TEmbossOptions): TBGRABitmap;
+begin
+  Result:=inherited FilterEmboss(angle, ABounds, AStrength, AOptions) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterEmbossHighlight(FillSelection: boolean): TBGRABitmap;
+begin
+  Result:=inherited FilterEmbossHighlight(FillSelection) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterEmbossHighlight(FillSelection: boolean;
+  BorderColor: TBGRAPixel): TBGRABitmap;
+begin
+  Result:=inherited FilterEmbossHighlight(FillSelection, BorderColor) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterEmbossHighlight(FillSelection: boolean;
+  BorderColor: TBGRAPixel; var Offset: TPoint): TBGRABitmap;
+begin
+  Result:=inherited FilterEmbossHighlight(FillSelection, BorderColor, Offset) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterGrayscale: TBGRABitmap;
+begin
+  Result:=inherited FilterGrayscale as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterGrayscale(ABounds: TRect): TBGRABitmap;
+begin
+  Result:=inherited FilterGrayscale(ABounds) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterNormalize(eachChannel: boolean): TBGRABitmap;
+begin
+  Result:=inherited FilterNormalize(eachChannel) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterNormalize(ABounds: TRect; eachChannel: boolean
+  ): TBGRABitmap;
+begin
+  Result:=inherited FilterNormalize(ABounds, eachChannel) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterRotate(origin: TPointF; angle: single;
+  correctBlur: boolean): TBGRABitmap;
+begin
+  Result:=inherited FilterRotate(origin, angle, correctBlur) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean
+  ): TBGRABitmap;
+begin
+  Result:=inherited FilterAffine(AMatrix, correctBlur) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterSphere: TBGRABitmap;
+begin
+  Result:=inherited FilterSphere as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterTwirl(ACenter: TPoint; ARadius: Single;
+  ATurn: Single; AExponent: Single): TBGRABitmap;
+begin
+  Result:=inherited FilterTwirl(ACenter, ARadius, ATurn, AExponent) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterTwirl(ABounds: TRect; ACenter: TPoint;
+  ARadius: Single; ATurn: Single; AExponent: Single): TBGRABitmap;
+begin
+  Result:=inherited FilterTwirl(ABounds, ACenter, ARadius, ATurn, AExponent) as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterCylinder: TBGRABitmap;
+begin
+  Result:=inherited FilterCylinder as TBGRABitmap;
+end;
+
+function TBGRABitmap.FilterPlane: TBGRABitmap;
+begin
+  Result:=inherited FilterPlane as TBGRABitmap;
+end;
+
+initialization
+
+  //this variable is assigned to access appropriate functions
+  //depending on the platform
+  BGRABitmapFactory := TBGRABitmap;
+
+finalization
+
+  tempBmp.Free;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack.pas

@@ -0,0 +1,36 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit BGRABitmapPack;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+  BGRAAnimatedGif, BGRABitmap, BGRABitmapTypes, BGRABlend, BGRACanvas, 
+  BGRACanvas2D, BGRAColorInt, BGRACompressableBitmap, BGRACoordPool3D, 
+  BGRADefaultBitmap, BGRADNetDeserial, BGRAFillInfo, BGRAFilters, 
+  BGRAFreeType, BGRAGradients, BGRAGradientScanner, BGRALayers, BGRAMatrix3D, 
+  BGRAOpenRaster, BGRAPaintNet, BGRAPath, BGRAPen, BGRAPhongTypes, 
+  BGRAPolygon, BGRAPolygonAliased, BGRAResample, BGRAScene3D, 
+  BGRASliceScaling, BGRASSE, BGRAStreamLayers, BGRAText, BGRATextFX, 
+  BGRATransform, BGRATypewriter, BGRAVectorize, BGRAGrayscaleMask, 
+  BGRAReadBMP, BGRAReadGif, BGRAReadPCX, BGRAReadPng, BGRAReadPSD, 
+  BGRAThumbnail, BGRAReadTGA, BGRAReadIco, BGRAReadJpeg, BGRAReadLzp, 
+  UnzipperExt, BGRALzpCommon, BGRAWriteLzp, BGRAReadXPM, BGRASVG, BGRAUnits, 
+  BGRASVGShapes, BGRASVGType, BGRAReadBmpMioMap, BGRAArrow, BGRAPalette, 
+  BGRAColorQuantization, BGRADithering, BGRAUTF8, BGRALCLBitmap, BGRAWritePNG, 
+  BGRAGifFormat, BGRAGraphics, BGRASceneTypes, BGRARenderer3D, 
+  BGRAWriteBmpMioMap, BGRAOpenGLType, BGRASpriteGL, BGRAOpenGL, BGRACanvasGL, 
+  BGRAFontGL, BGRAOpenGL3D, BGRAPhoxo, BGRAFilterScanner, BGRAFilterType, 
+  BGRAFilterBlur, BGRAMultiFileType, BGRAWinResource, BGRALazResource, 
+  BGRAIconCursor, BGRABlurGL, BGRAReadTiff, BGRALazPaint, BGRAMemDirectory, 
+  BGRAUnicode, BGRATextBidi, BGRALayerOriginal, BGRASVGOriginal, 
+  BGRAGradientOriginal, BGRAUnicodeText, UniversalDrawer, LinearRGBABitmap, 
+  XYZABitmap, BGRAWriteTiff, WordXYZABitmap, ExpandedBitmap, libwebp, 
+  linuxlib, BGRAReadWebP, BGRAWriteWebP, BGRAClasses;
+
+implementation
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack4fpgui.pas

@@ -0,0 +1,30 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit BGRABitmapPack4fpGUI;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+  BGRAAnimatedGif, BGRABitmap, BGRABitmapTypes, BGRABlend, BGRACanvas, 
+  BGRACanvas2D, BGRAColorInt, BGRACompressableBitmap, BGRACoordPool3D, 
+  BGRADefaultBitmap, BGRADNetDeserial, BGRAFillInfo, BGRAFilters, 
+  BGRAGradients, BGRAGradientScanner, BGRALayers, BGRAMatrix3D, 
+  BGRAOpenRaster, BGRAPaintNet, BGRAPath, BGRAPen, BGRAPhongTypes, 
+  BGRAPolygon, BGRAPolygonAliased, BGRAResample, BGRAScene3D, 
+  BGRASliceScaling, BGRASSE, BGRAStreamLayers, BGRATransform, 
+  BGRAGrayscaleMask, BGRAReadBMP, BGRAReadGif, BGRAReadPCX, BGRAReadPng, 
+  BGRAReadPSD, BGRAThumbnail, BGRAReadTGA, BGRAReadJpeg, BGRAReadLzp, 
+  UnzipperExt, BGRALzpCommon, BGRAWriteLzp, BGRAReadXPM, BGRAUnits, 
+  BGRAReadBmpMioMap, BGRAArrow, BGRAGraphics, BGRAUTF8, BGRAfpGUIBitmap, 
+  BGRATypewriter, BGRASVG, BGRASVGShapes, BGRASVGType, BGRAPalette, 
+  BGRAColorQuantization, BGRADithering, BGRAFreeType, BGRACustomTextFX, 
+  BGRAWritePNG, BGRAGifFormat, BGRASceneTypes, BGRARenderer3D, 
+  BGRAWriteBmpMioMap, BGRAPhoxo, BGRAFilterScanner, BGRAFilterType, 
+  BGRAFilterBlur, BGRAMultiFileType, BGRAWinResource, BGRAUnicode, BGRAClasses;
+
+implementation
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgrabitmappack4nogui.pas

@@ -0,0 +1,31 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit BGRABitmapPack4NoGUI;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+  BGRAAnimatedGif, BGRABitmap, BGRABitmapTypes, BGRABlend, BGRACanvas, 
+  BGRACanvas2D, BGRAColorInt, BGRACompressableBitmap, BGRACoordPool3D, 
+  BGRADefaultBitmap, BGRADNetDeserial, BGRAFillInfo, BGRAFilters, 
+  BGRAGradients, BGRAGradientScanner, BGRALayers, BGRAMatrix3D, 
+  BGRAOpenRaster, BGRAPaintNet, BGRAPath, BGRAPen, BGRAPhongTypes, 
+  BGRAPolygon, BGRAPolygonAliased, BGRAResample, BGRAScene3D, 
+  BGRASliceScaling, BGRASSE, BGRAStreamLayers, BGRATransform, 
+  BGRAGrayscaleMask, BGRAReadBMP, BGRAReadGif, BGRAReadPCX, BGRAReadPng, 
+  BGRAReadPSD, BGRAThumbnail, BGRAReadTGA, BGRAReadJpeg, BGRAReadLzp, 
+  UnzipperExt, BGRALzpCommon, BGRAWriteLzp, BGRAReadXPM, BGRAUnits, 
+  BGRAReadBmpMioMap, BGRAArrow, BGRAGraphics, BGRAUTF8, BGRATypewriter, 
+  BGRASVG, BGRASVGShapes, BGRASVGType, BGRAPalette, BGRAColorQuantization, 
+  BGRADithering, BGRAFreeType, BGRACustomTextFX, BGRAWritePNG, BGRAGifFormat, 
+  BGRANoGUIBitmap, BGRASceneTypes, BGRARenderer3D, BGRAWriteBmpMioMap, 
+  BGRASpriteGL, BGRAOpenGLType, BGRAOpenGL, BGRACanvasGL, BGRAPhoxo, 
+  BGRAFilterScanner, BGRAFilterType, BGRAFilterBlur, BGRAMultiFileType, 
+  BGRAWinResource, BGRAUnicode, BGRAClasses;
+
+implementation
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgrablurgl.pas

@@ -0,0 +1,200 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRABlurGL;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, BGRAOpenGL3D, BGRABitmapTypes, BGRACanvasGL, BGRAOpenGLType;
+
+type
+
+  { TBGLBlurShader }
+
+  TBGLBlurShader = class(TBGLShader3D)
+  private
+    function GetDirection: TPointF;
+    function GetImageIndex: integer;
+    function GetRadius: Single;
+    function GetTextureSize: TPoint;
+    procedure SetDirection(AValue: TPointF);
+    procedure SetImageIndex(AValue: integer);
+    procedure SetRadius(AValue: Single);
+    procedure SetTextureSize(AValue: TPoint);
+  protected
+    FTextureSize: TUniformVariablePoint;
+    FImageIndex: TUniformVariableInteger;
+    FDirection: TUniformVariablePointF;
+    FRadius: TUniformVariableSingle;
+    FBlurType: TRadialBlurType;
+    procedure StartUse; override;
+  public
+    constructor Create(ACanvas: TBGLCustomCanvas; ABlurType: TRadialBlurType);
+    function FilterBlurMotion(ATexture: IBGLTexture): IBGLTexture; overload;
+    function FilterBlurMotion(ATexture: IBGLTexture; ADirection: TPointF): IBGLTexture; overload;
+    function FilterBlurRadial(ATexture: IBGLTexture): IBGLTexture;
+    property ImageIndex: integer read GetImageIndex write SetImageIndex;
+    property TextureSize: TPoint read GetTextureSize write SetTextureSize;
+    property Direction: TPointF read GetDirection write SetDirection;
+    property Radius: Single read GetRadius write SetRadius;
+    property BlurType: TRadialBlurType read FBlurType;
+  end;
+
+implementation
+
+{ TBGLBlurShader }
+
+function TBGLBlurShader.GetDirection: TPointF;
+begin
+  result := FDirection.Value;
+end;
+
+function TBGLBlurShader.GetImageIndex: integer;
+begin
+  result := FImageIndex.Value;
+end;
+
+function TBGLBlurShader.GetRadius: Single;
+begin
+  result := FRadius.Value;
+  if FBlurType = rbPrecise then result := result * 10;
+end;
+
+function TBGLBlurShader.GetTextureSize: TPoint;
+begin
+  result := FTextureSize.Value;
+end;
+
+procedure TBGLBlurShader.SetDirection(AValue: TPointF);
+begin
+  FDirection.Value := AValue;
+end;
+
+procedure TBGLBlurShader.SetImageIndex(AValue: integer);
+begin
+  FImageIndex.Value := AValue;
+end;
+
+procedure TBGLBlurShader.SetRadius(AValue: Single);
+begin
+  if FBlurType = rbPrecise then AValue := AValue/10;
+  FRadius.Value := AValue;
+end;
+
+procedure TBGLBlurShader.SetTextureSize(AValue: TPoint);
+begin
+  FTextureSize.Value:= AValue;
+end;
+
+constructor TBGLBlurShader.Create(ACanvas: TBGLCustomCanvas; ABlurType: TRadialBlurType);
+var weightFunc: string;
+begin
+  FBlurType:= ABlurType;
+  case ABlurType of
+  rbNormal,rbPrecise: weightFunc:=
+'   float sigma = max(0.1,radius/1.8);'#10+
+'	float normalized = x/sigma;'#10 +
+'	return 1/(2.506628274631*sigma)*exp(-0.5*normalized*normalized);';
+  rbCorona: weightFunc := 'return max(0, 1-abs(x-radius));';
+  rbFast: weightFunc := 'return max(0,radius+1-x);';
+  else {rbBox,rbDisk}
+    weightFunc := 'if (x <= radius) return 1; else return max(0,radius+1-x);';
+  end;
+
+  inherited Create(ACanvas,
+'void main(void) {'#10 +
+'	gl_Position = gl_ProjectionMatrix * gl_Vertex;'#10 +
+'    texCoord = vec2(gl_MultiTexCoord0);'#10 +
+'}',
+
+'uniform sampler2D image;'#10 +
+'uniform ivec2 textureSize;'#10 +
+'uniform vec2 direction;'#10 +
+'uniform float radius;'#10 +
+'out vec4 FragmentColor;'#10 +
+
+'float computeWeight(float x)'#10 +
+'{'#10 +
+weightFunc + #10 +
+'}'#10 +
+
+'void main(void)'#10 +
+'{'#10 +
+'	int range = int(radius+1.5);'#10 +
+
+'	float weight = computeWeight(0);'#10 +
+'	float totalWeight = weight;'#10 +
+'	FragmentColor = texture2D( image, texCoord ) * weight;'#10 +
+
+'	for (int i=1; i<=range; i++) {'#10 +
+'		weight = computeWeight(i);'#10 +
+'		FragmentColor += texture2D( image, texCoord + i*direction/textureSize ) * weight;'#10 +
+'		FragmentColor += texture2D( image, texCoord - i*direction/textureSize ) * weight;'#10 +
+'		totalWeight += 2*weight;'#10 +
+'	}'#10 +
+
+'	FragmentColor /= totalWeight;'#10 +
+'}',
+
+'varying vec2 texCoord;', '130');
+
+  FImageIndex := UniformInteger['image'];
+  FTextureSize := UniformPoint['textureSize'];
+  FDirection := UniformPointF['direction'];
+  FRadius := UniformSingle['radius'];
+
+  ImageIndex:= 0;
+  Direction := PointF(1,0);
+  TextureSize := Point(1,1);
+  Radius := 0;
+end;
+
+function TBGLBlurShader.FilterBlurRadial(ATexture: IBGLTexture): IBGLTexture;
+var horiz: IBGLTexture;
+begin
+  horiz := FilterBlurMotion(ATexture, PointF(1,0));
+  result := FilterBlurMotion(horiz, PointF(0,1));
+end;
+
+function TBGLBlurShader.FilterBlurMotion(ATexture: IBGLTexture): IBGLTexture;
+var previousBuf,buf: TBGLCustomFrameBuffer;
+  previousShader: TBGLCustomShader;
+begin
+  previousBuf := Canvas.ActiveFrameBuffer;
+  buf := Canvas.CreateFrameBuffer(ATexture.Width, ATexture.Height);
+  Canvas.ActiveFrameBuffer := buf;
+
+  TextureSize := Point(ATexture.Width,ATexture.Height);
+  previousShader := Canvas.Lighting.ActiveShader;
+  Canvas.Lighting.ActiveShader := self;
+
+  ATexture.Draw(0, 0); //perform horiz blur
+
+  Canvas.Lighting.ActiveShader := previousShader;
+  Canvas.ActiveFrameBuffer := previousBuf;
+  result := buf.MakeTextureAndFree;
+end;
+
+function TBGLBlurShader.FilterBlurMotion(ATexture: IBGLTexture;
+  ADirection: TPointF): IBGLTexture;
+var prevDir: TPointF;
+begin
+  prevDir := Direction;
+  Direction := ADirection;
+  result := FilterBlurMotion(ATexture);
+  Direction := prevDir;
+end;
+
+procedure TBGLBlurShader.StartUse;
+begin
+  inherited StartUse;
+  FImageIndex.Update;
+  FTextureSize.Update;
+  FDirection.Update;
+  FRadius.Update;
+end;
+
+end.
+
+

vendor/kam_remake/src/ext/BGRABitmap/bgraclasses.pas

@@ -0,0 +1,251 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAClasses;
+
+{$mode objfpc}{$H+}
+{$modeswitch advancedrecords}
+
+interface
+
+uses
+  {$IFDEF BGRABITMAP_USE_MSEGUI}Types, Classes, mclasses, msegraphutils, mseguiglob{$ELSE}Types, Classes{$ENDIF};
+
+type
+  Int32or64 = {$IFDEF CPU64}Int64{$ELSE}LongInt{$ENDIF};
+  UInt32or64 = {$IFDEF CPU64}UInt64{$ELSE}LongWord{$ENDIF};
+
+  //types always imported from Classes
+  TFPList = Classes.TFPList;
+  TList = Classes.TList;
+  TNotifyEvent = Classes.TNotifyEvent;
+  EInvalidOperation = Classes.EInvalidOperation;
+  EFCreateError = Classes.EFCreateError;
+  EFOpenError = Classes.EFOpenError;
+  TAlignment = Classes.TAlignment;
+  TSeekOrigin = Classes.TSeekOrigin;
+  TStream = Classes.TStream;
+  TPersistent = Classes.TPersistent;
+  TStrings = Classes.TStrings;
+  TStringList = Classes.TStringList;
+
+  TComponent = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.TComponent;
+  TResourceStream = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.TResourceStream;
+  TMemoryStream = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.TMemoryStream;
+  THandleStream = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.THandleStream;
+  TStringStream = {$IFDEF BGRABITMAP_USE_MSEGUI}mclasses{$ELSE}Classes{$ENDIF}.TStringStream;
+
+type
+  {$IFDEF BGRABITMAP_USE_MSEGUI}
+  TPoint = msegraphutils.pointty;
+  TSize = msegraphutils.sizety;
+  TRect = Classes.TRect;
+  TClassesPoint = Classes.TPoint;
+  TMSERect = msegraphutils.rectty;
+  {$ELSE}
+  TPoint = Types.TPoint;
+  TSize = Types.TSize;
+  TRect = Types.TRect;
+  {$ENDIF}
+  PPoint = ^TPoint;
+  PSize = ^TSize;
+  PRect = ^TRect;
+
+  {$IF FPC_FULLVERSION>=030001}
+  TPointF = Types.TPointF;
+  TRectF = Types.TRectF;
+  {$ELSE}
+  TPointF = record x : single; y : single; end;
+
+  {$define BGRA_DEFINE_TRECTF}
+  TRectF =
+  {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+  packed
+  {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+  record
+  private
+    function GetHeight: single;
+    function GetWidth: Single;
+  public
+    property Width: Single read GetWidth;
+    property Height: single read GetHeight;
+    procedure Offset (const dx,dy : Single);
+    case Integer of
+     0: (Left, Top, Right, Bottom: Single);
+     1: (TopLeft, BottomRight: TPointF);
+  end;
+  {$ENDIF}
+
+const
+  //types always imported from Classes
+  taLeftJustify = Classes.taLeftJustify;
+  taRightJustify = Classes.taRightJustify;
+  taCenter = Classes.taCenter;
+
+type
+  {$IFDEF BGRABITMAP_USE_MSEGUI}
+  TShiftState = mseguiglob.shiftstatesty;
+  {$ELSE}
+  TShiftState = Classes.TShiftState;
+  {$ENDIF}
+
+const
+  {$IFDEF BGRABITMAP_USE_MSEGUI}
+  ssShift = mseguiglob.ss_shift;
+  ssAlt = mseguiglob.ss_alt;
+  ssCtrl = mseguiglob.ss_ctrl;
+  ssLeft = mseguiglob.ss_left;
+  ssRight = mseguiglob.ss_right;
+  ssMiddle = mseguiglob.ss_middle;
+  ssDouble = mseguiglob.ss_double;
+  ssTriple = mseguiglob.ss_triple;
+  {$ELSE}
+  ssShift = Classes.ssShift;
+  ssAlt = Classes.ssAlt;
+  ssCtrl = Classes.ssCtrl;
+  ssLeft = Classes.ssLeft;
+  ssRight = Classes.ssRight;
+  ssMiddle = Classes.ssMiddle;
+  ssDouble = Classes.ssDouble;
+  ssTriple = Classes.ssTriple;
+  {$ENDIF}
+
+  soBeginning = Classes.soBeginning;
+  soCurrent = Classes.soCurrent;
+  soEnd = Classes.soEnd;
+
+  {$IFDEF BGRABITMAP_USE_MSEGUI}
+  fmCreate        = $FF00;
+  fmOpenRead      = 0;
+  fmOpenWrite     = 1;
+  fmOpenReadWrite = 2;
+
+  soFromBeginning = 0;
+  soFromCurrent = 1;
+  soFromEnd = 2;
+  {$ELSE}
+  fmCreate = Classes.fmCreate;
+  fmOpenRead = Classes.fmOpenRead;
+  fmOpenWrite = Classes.fmOpenWrite;
+  fmOpenReadWrite = Classes.fmOpenReadWrite;
+  soFromBeginning = Classes.soFromBeginning;
+  soFromCurrent = Classes.soFromCurrent;
+  soFromEnd = Classes.soFromEnd;
+  {$ENDIF}
+
+function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
+function Point(AX, AY: Integer): TPoint;
+function Size(AWidth, AHeight: Integer): TSize;
+procedure IncF(var ADest: single; ADelta: single); overload; inline;
+procedure IncF(var ADest: double; ADelta: double); overload; inline;
+procedure DecF(var ADest: single; ADelta: single); overload; inline;
+procedure DecF(var ADest: double; ADelta: double); overload; inline;
+procedure Inc64(var AValue: int64; const ADelta: int64); overload; inline;
+procedure Dec64(var AValue: int64; const ADelta: int64); overload; inline;
+procedure Inc64(var AValue: uint64; const ADelta: uint64); overload; inline;
+procedure Dec64(var AValue: uint64; const ADelta: uint64); overload; inline;
+
+implementation
+
+function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
+begin
+  with Result do
+  begin
+    Left := ALeft;
+    Top := ATop;
+    Right := ARight;
+    Bottom := ABottom;
+  end;
+end;
+
+{$IFDEF BGRA_DEFINE_TRECTF}
+{ TRectF }
+
+function TRectF.GetHeight: single;
+begin
+  result := Bottom-Top;
+end;
+
+function TRectF.GetWidth: Single;
+begin
+  result := Right-Left;
+end;
+
+procedure TRectF.Offset(const dx, dy: Single);
+begin
+  left:=left+dx; right:=right+dx;
+  bottom:=bottom+dy; top:=top+dy;
+end;
+{$ENDIF}
+
+function Point(AX, AY: Integer): TPoint;
+begin
+  with Result do
+  begin
+    X := AX;
+    Y := AY;
+  end;
+end;
+
+function Size(AWidth, AHeight: Integer): TSize;
+begin
+  Result.cx := AWidth;
+  Result.cy := AHeight;
+end;
+
+procedure IncF(var ADest: single; ADelta: single);
+begin
+  ADest := ADest + ADelta;
+end;
+
+procedure IncF(var ADest: double; ADelta: double);
+begin
+  ADest := ADest + ADelta;
+end;
+
+procedure DecF(var ADest: single; ADelta: single);
+begin
+  ADest := ADest - ADelta;
+end;
+
+procedure DecF(var ADest: double; ADelta: double);
+begin
+  ADest := ADest - ADelta;
+end;
+
+procedure Inc64(var AValue: int64; const ADelta: int64);
+begin
+  {$IFDEF CPU64}
+  Inc(AValue, ADelta);
+  {$ELSE}
+  AValue := AValue + ADelta;
+  {$ENDIF}
+end;
+
+procedure Dec64(var AValue: int64; const ADelta: int64);
+begin
+  {$IFDEF CPU64}
+  Dec(AValue, ADelta);
+  {$ELSE}
+  AValue := AValue - ADelta;
+  {$ENDIF}
+end;
+
+procedure Inc64(var AValue: uint64; const ADelta: uint64);
+begin
+  {$IFDEF CPU64}
+  Inc(AValue, ADelta);
+  {$ELSE}
+  AValue := AValue + ADelta;
+  {$ENDIF}
+end;
+
+procedure Dec64(var AValue: uint64; const ADelta: uint64);
+begin
+  {$IFDEF CPU64}
+  Dec(AValue, ADelta);
+  {$ELSE}
+  AValue := AValue - ADelta;
+  {$ENDIF}
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgracolorint.pas

@@ -0,0 +1,363 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAColorInt;
+
+{$mode objfpc}{$H+}
+{$ifdef CPUI386}
+  {$define BGRACOLORINT_USEASM}
+{$endif}
+{$ifdef DARWIN}
+  {$undef BGRACOLORINT_USEASM}
+{$endif}
+
+interface
+
+uses
+  BGRABitmapTypes;
+
+type
+  TColorInt65536 = packed record
+    r,g,b,a: integer;
+  end;
+
+function ColorInt65536(r,g,b,a: integer): TColorInt65536; inline; overload;
+function ColorInt65536(r,g,b: integer): TColorInt65536; inline; overload;
+function ColorFToColorInt65536(colorF: TColorF): TColorInt65536; inline;
+function ColorInt65536ToColorF(color: TColorInt65536): TColorF;
+operator +(const color1,color2: TColorInt65536): TColorInt65536; inline;
+operator *(const color1,color2: TColorInt65536): TColorInt65536;
+operator *(const color1: TColorInt65536; factor65536: integer): TColorInt65536;
+function ColorIntToBGRA(const AColor: TColorInt65536; AGammaCompression: boolean = false): TBGRAPixel;
+function BGRAToColorInt(const AColor: TBGRAPixel; AGammaExpansion: boolean = false): TColorInt65536;
+function BGRAToColorIntMultiply(const color1: TBGRAPixel; const color2: TColorInt65536): TColorInt65536;
+
+implementation
+
+function ColorInt65536(r, g, b, a: integer): TColorInt65536;
+begin
+  result.r := r;
+  result.g := g;
+  result.b := b;
+  result.a := a;
+end;
+
+function ColorInt65536(r, g, b: integer): TColorInt65536;
+begin
+  result.r := r;
+  result.g := g;
+  result.b := b;
+  result.a := 65536;
+end;
+
+function ColorFToColorInt65536(colorF: TColorF): TColorInt65536;
+begin
+  result.r := round(colorF[1]*65536);
+  result.g := round(colorF[2]*65536);
+  result.b := round(colorF[3]*65536);
+  result.a := round(colorF[4]*65536);
+end;
+
+function ColorInt65536ToColorF(color: TColorInt65536): TColorF;
+const oneOver65536 = 1/65536;
+begin
+  result[1] := color.r*oneOver65536;
+  result[2] := color.g*oneOver65536;
+  result[3] := color.b*oneOver65536;
+  result[4] := color.a*oneOver65536;
+end;
+
+operator+(const color1, color2: TColorInt65536): TColorInt65536;
+begin
+  result.r := color1.r+color2.r;
+  result.g := color1.g+color2.g;
+  result.b := color1.b+color2.b;
+  result.a := color1.a+color2.a;
+end;
+
+operator*(const color1, color2: TColorInt65536): TColorInt65536;
+{$ifdef BGRACOLORINT_USEASM} {$asmmode intel} assembler;
+  asm
+    push edx
+    push ebx
+    push esi
+    mov ebx, Color1
+    mov esi, Color2
+    //ecx = @result
+
+    mov eax, [ebx] //r
+    imul [esi]
+    shl edx, 16
+    shr eax, 16
+    or edx, eax
+    mov [ecx], edx
+
+    mov eax, [ebx+4] //g
+    imul [esi+4]
+    shl edx, 16
+    shr eax, 16
+    or edx, eax
+    mov [ecx+4], edx
+
+    mov eax, [ebx+8] //b
+    imul [esi+8]
+    shl edx, 16
+    shr eax, 16
+    or edx, eax
+    mov [ecx+8], edx
+
+    mov eax, [ebx+12] //a
+    imul [esi+12]
+    shl edx, 16
+    shr eax, 16
+    or edx, eax
+    mov [ecx+12], edx
+
+    pop esi
+    pop ebx
+    pop edx
+  end;
+{$ELSE}
+begin
+  result.r := int64(color1.r)*color2.r shr 16;
+  result.g := int64(color1.g)*color2.g shr 16;
+  result.b := int64(color1.b)*color2.b shr 16;
+  result.a := int64(color1.a)*color2.a shr 16;
+end;
+{$ENDIF}
+
+operator*(const color1: TColorInt65536; factor65536: integer): TColorInt65536;
+{$ifdef BGRACOLORINT_USEASM} {$asmmode intel} assembler;
+  asm
+    push edx
+    push ebx
+    push esi
+    mov ebx, Color1
+    mov esi, factor65536
+    //ecx = @result
+
+    mov eax, [ebx] //r
+    imul esi
+    shl edx, 16
+    shr eax, 16
+    or edx, eax
+    mov [ecx], edx
+
+    mov eax, [ebx+4] //g
+    imul esi
+    shl edx, 16
+    shr eax, 16
+    or edx, eax
+    mov [ecx+4], edx
+
+    mov eax, [ebx+8] //b
+    imul esi
+    shl edx, 16
+    shr eax, 16
+    or edx, eax
+    mov [ecx+8], edx
+
+    mov eax, [ebx+12] //a
+    imul esi
+    shl edx, 16
+    shr eax, 16
+    or edx, eax
+    mov [ecx+12], edx
+
+    pop esi
+    pop ebx
+    pop edx
+  end;
+{$else}
+var prod: int64;
+begin
+  prod := int64(color1.r)*factor65536;
+  if prod >= 0 then result.r := prod shr 16
+  else result.r := -((-prod) shr 16);
+  prod := int64(color1.g)*factor65536;
+  if prod >= 0 then result.g := prod shr 16
+  else result.g := -((-prod) shr 16);
+  prod := int64(color1.b)*factor65536;
+  if prod >= 0 then result.b := prod shr 16
+  else result.b := -((-prod) shr 16);
+  prod := int64(color1.a)*factor65536;
+  if prod >= 0 then result.a := prod shr 16
+  else result.a := -((-prod) shr 16);
+end;
+{$endif}
+
+function BGRAToColorInt(const AColor: TBGRAPixel; AGammaExpansion: boolean): TColorInt65536;
+begin
+  if AGammaExpansion then
+  begin
+    result.r := GammaExpansionTab[AColor.red] + (AColor.red shr 7);
+    result.g := GammaExpansionTab[AColor.green] + (AColor.green shr 7);
+    result.b := GammaExpansionTab[AColor.blue] + (AColor.blue shr 7);
+  end else
+  begin
+    result.r := AColor.red shl 8 + AColor.red + (AColor.red shr 7);
+    result.g := AColor.green shl 8 + AColor.green + (AColor.green shr 7);
+    result.b := AColor.blue shl 8 + AColor.blue + (AColor.blue shr 7);
+  end;
+  result.a := AColor.alpha shl 8 + AColor.alpha+ (AColor.alpha shr 7);
+end;
+
+function BGRAToColorIntMultiply(const color1: TBGRAPixel;
+  const color2: TColorInt65536): TColorInt65536;
+{$ifdef BGRACOLORINT_USEASM} {$asmmode intel} assembler;
+  asm
+    push ebx
+    push esi
+
+    mov esi, Color2
+    mov ebx, result
+    mov ecx, [Color1]
+
+    mov eax, ecx
+    shr eax, TBGRAPixel_RedShift
+    and eax, 255
+    mov edx, eax
+    shr edx, 7
+    add eax, edx
+    imul [esi]
+    shl edx, 24
+    shr eax, 8
+    or edx, eax
+    mov [ebx], edx
+
+    mov eax, ecx
+    shr eax, TBGRAPixel_GreenShift
+    and eax, 255
+    mov edx, eax
+    shr edx, 7
+    add eax, edx
+    imul [esi+4]
+    shl edx, 24
+    shr eax, 8
+    or edx, eax
+    mov [ebx+4], edx
+
+    mov eax, ecx
+    shr eax, TBGRAPixel_BlueShift
+    and eax, 255
+    mov edx, eax
+    shr edx, 7
+    add eax, edx
+    imul [esi+8]
+    shl edx, 24
+    shr eax, 8
+    or edx, eax
+    mov [ebx+8], edx
+
+    mov eax, ecx
+    shr eax, TBGRAPixel_AlphaShift
+    and eax, 255
+    mov edx, eax
+    shr edx, 7
+    add eax, edx
+    imul [esi+12]
+    shl edx, 24
+    shr eax, 8
+    or edx, eax
+    mov [ebx+12], edx
+
+    pop esi
+    pop ebx
+  end;
+{$ELSE}
+begin
+  result.r := int64(color2.r)*(color1.red shr 7+color1.red) shr 8;
+  result.g := int64(color2.g)*(color1.green shr 7+color1.green) shr 8;
+  result.b := int64(color2.b)*(color1.blue shr 7+color1.blue) shr 8;
+  result.a := int64(color2.a)*(color1.alpha shr 7+color1.alpha) shr 8;
+end;
+{$ENDIF}
+
+function ColorIntToBGRA(const AColor: TColorInt65536; AGammaCompression: boolean): TBGRAPixel;
+var maxValue,invMaxValue,r,g,b: integer;
+begin
+  if AColor.a <= 0 then
+    result.alpha := 0;
+  if AColor.a >= 65536 then
+    result.alpha := 255
+  else
+    result.alpha := AColor.a shr 8 - (AColor.a shr 15);
+
+  maxValue := AColor.r;
+  if AColor.g > maxValue then maxValue := AColor.g;
+  if AColor.b > maxValue then maxValue := AColor.b;
+
+  if maxValue <= 0 then
+  begin
+    result.red := 0;
+    result.green := 0;
+    result.blue := 0;
+    exit;
+  end;
+
+  if AGammaCompression then
+  begin
+    if maxValue <= 65535 then
+    begin
+      if AColor.r <= 0 then result.red := 0 else
+        result.red := GammaCompressionTab[AColor.r - (AColor.r shr 15)];
+
+      if AColor.g <= 0 then result.green := 0 else
+        result.green :=GammaCompressionTab[AColor.g - (AColor.g shr 15)];
+
+      if AColor.b <= 0 then result.blue := 0 else
+        result.blue := GammaCompressionTab[AColor.b - (AColor.b shr 15)];
+      exit;
+    end;
+
+    invMaxValue := (1073741824+maxValue-1) div maxValue;
+
+    maxValue := (maxValue-65535) shr 1;
+    if AColor.r < 0 then r := maxValue else
+      r := AColor.r*invMaxValue shr 14 + maxValue;
+    if AColor.g < 0 then g := maxValue else
+      g := AColor.g*invMaxValue shr 14 + maxValue;
+    if AColor.b < 0 then b := maxValue else
+      b := AColor.b*invMaxValue shr 14 + 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];
+  end else
+  begin
+    if maxValue <= 65535 then
+    begin
+      if AColor.r <= 0 then result.red := 0 else
+        result.red := AColor.r shr 8 - (AColor.r shr 15);
+
+      if AColor.g <= 0 then result.green := 0 else
+        result.green := AColor.g shr 8 - (AColor.g shr 15);
+
+      if AColor.b <= 0 then result.blue := 0 else
+        result.blue := AColor.b shr 8 - (AColor.b shr 15);
+      exit;
+    end;
+
+    invMaxValue := (1073741824+maxValue-1) div maxValue;
+
+    maxValue := (maxValue-65535) shr 9;
+    if AColor.r < 0 then r := maxValue else
+      r := AColor.r*invMaxValue shr 22 + maxValue;
+    if AColor.g < 0 then g := maxValue else
+      g := AColor.g*invMaxValue shr 22 + maxValue;
+    if AColor.b < 0 then b := maxValue else
+      b := AColor.b*invMaxValue shr 22 + maxValue;
+
+    if r >= 255 then result.red := 255 else
+      result.red := r;
+    if g >= 255 then result.green := 255 else
+        result.green := g;
+    if b >= 255 then result.blue := 255 else
+      result.blue := b;
+  end;
+end;
+
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgracompressablebitmap.pas

@@ -0,0 +1,317 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRACompressableBitmap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+{ This unit contains the TBGRACompressableBitmap class, which
+  can be used to temporarily compress bitmaps in memory.
+  To use it, create an instance with the bitmap you want
+  to compress. You can then free the original bitmap because
+  TBGRACompressableBitmap contains all information necessary
+  to build it again. To construct again your bitmap, call
+  the GetBitmap function.
+
+  When you have your bitmap in TBGRACompressableBitmap,
+  you can call Compress function as many times as necessary
+  until all data is compressed. It does only a part of the
+  work at each call, so you can put it in a loop or in
+  a timer. When it's done, Compress returns false to
+  notify that it did nothing, which means you can
+  stop calling Compress.
+
+  In this implementation, the memory usage grows during
+  the compression process and is lower only after it is
+  finished. So it is recommended to compress one bitmap
+  at a time. }
+
+uses
+  BGRAClasses, SysUtils, BGRABitmapTypes, BGRABitmap, zstream;
+
+type
+
+   { TBGRACompressableBitmap }
+
+   TBGRACompressableBitmap = class
+   private
+     FWidth,FHeight: integer;
+     FCaption: String;
+     FBounds: TRect;
+     FCompressedDataArray: array of TMemoryStream;
+     FUncompressedData: TMemoryStream;
+     FLineOrder: TRawImageLineOrder;
+     FCompressionProgress: Int64;
+     procedure Decompress;
+     procedure FreeData;
+     procedure Init;
+   public
+     CompressionLevel: Tcompressionlevel;
+     constructor Create; overload;
+     constructor Create(Source: TBGRABitmap); overload;
+     function GetBitmap: TBGRABitmap;
+
+     //call Compress as many times as necessary
+     //when it returns false, it means that
+     //the image compression is finished
+     function Compress: boolean;
+     procedure WriteToStream(AStream: TStream);
+     procedure ReadFromStream(AStream: TStream);
+     
+     function UsedMemory: Int64;
+     procedure Assign(Source: TBGRABitmap);
+     destructor Destroy; override;
+     property Width : Integer read FWidth;
+     property Height: Integer read FHeight;
+     property Caption : string read FCaption write FCaption;
+
+   end;
+
+implementation
+
+uses BGRAUTF8;
+
+// size of each chunk treated by Compress function
+const maxPartSize = 524288;
+
+{ TBGRACompressedBitmap }
+
+constructor TBGRACompressableBitmap.Create;
+begin
+  Init;
+end;
+
+constructor TBGRACompressableBitmap.Create(Source: TBGRABitmap);
+begin
+  Init;
+  Assign(Source);
+end;
+
+{ Constructs the bitmap again, decompressing if necessary.
+  After this, the image is not compressed anymore so the
+  memoy usage grows again and the access becomes fast
+  because there is no need to decompress anymore. }
+function TBGRACompressableBitmap.GetBitmap: TBGRABitmap;
+var UsedPart: TBGRABitmap;
+    UsedNbPixels: Integer;
+begin
+  Decompress;
+  if FUncompressedData = nil then
+  begin
+    result := nil;
+    exit;
+  end;
+  result := TBGRABitmap.Create(FWidth,FHeight);
+  result.Caption := FCaption;
+  FUncompressedData.Position := 0;
+  if (FBounds.Left <> 0) or (FBounds.Top <> 0)
+    or (FBounds.Right <> FWidth) or (FBounds.Bottom <> FHeight) then
+  begin
+    UsedNbPixels := (FBounds.Right-FBounds.Left)*(FBounds.Bottom-FBounds.Top);
+    if UsedNbPixels > 0 then
+    begin
+      UsedPart := TBGRABitmap.Create(FBounds.Right-FBounds.Left,FBounds.Bottom-FBounds.Top);
+      FUncompressedData.Read(UsedPart.Data^,UsedPart.NbPixels*Sizeof(TBGRAPixel));
+      if UsedPart.LineOrder <> FLineOrder then UsedPart.VerticalFlip;
+      If TBGRAPixel_RGBAOrder then UsedPart.SwapRedBlue;
+      result.PutImage(FBounds.Left,FBounds.Top,UsedPart,dmSet);
+      UsedPart.Free;
+    end;
+  end else
+  begin
+    FUncompressedData.Read(result.Data^,result.NbPixels*Sizeof(TBGRAPixel));
+    if result.LineOrder <> FLineOrder then result.VerticalFlip;
+    If TBGRAPixel_RGBAOrder then result.SwapRedBlue;
+  end;
+end;
+
+{ Returns the total memory used by this object for storing bitmap data }
+function TBGRACompressableBitmap.UsedMemory: Int64;
+var i: integer;
+begin
+  result := 0;
+  for i := 0 to high(FCompressedDataArray) do
+    inc(result, FCompressedDataArray[i].Size);
+  if FUncompressedData <> nil then inc(result, FUncompressedData.Size);
+end;
+
+{ Do one compress step or return false }
+function TBGRACompressableBitmap.Compress: boolean;
+var comp: Tcompressionstream;
+    partSize: integer;
+begin
+  if FCompressedDataArray = nil then FCompressionProgress := 0;
+  if (FUncompressedData = nil) or (FUncompressedData.Size = 0) then
+  begin
+    result := false;
+    exit;
+  end;
+  if FCompressionProgress < FUncompressedData.Size then
+  begin
+    setlength(FCompressedDataArray, length(FCompressedDataArray)+1);
+    FCompressedDataArray[high(FCompressedDataArray)] := TMemoryStream.Create;
+    FUncompressedData.Position := FCompressionProgress;
+    if FUncompressedData.Size - FCompressionProgress > maxPartSize then
+      partSize := maxPartSize else
+        partSize := integer(FUncompressedData.Size - FCompressionProgress);
+
+    comp := Tcompressionstream.Create(CompressionLevel,FCompressedDataArray[high(FCompressedDataArray)],true);
+    LEWriteLongint(comp, partSize);
+    comp.CopyFrom(FUncompressedData,partSize);
+    comp.Free;
+    inc(FCompressionProgress, partSize);
+  end;
+  if FCompressionProgress >= FUncompressedData.Size then
+    FreeAndNil(FUncompressedData);
+  result := true;
+end;
+
+procedure TBGRACompressableBitmap.WriteToStream(AStream: TStream);
+var i:integer;
+begin
+  repeat
+  until not Compress;
+  LEWriteLongint(AStream,FWidth);
+  LEWriteLongint(AStream,FHeight);
+  LEWriteLongint(AStream,length(FCaption));
+  AStream.Write(FCaption[1],length(FCaption));
+  if (FWidth=0) or (FHeight = 0) then exit;
+
+  LEWriteLongint(AStream,FBounds.Left);
+  LEWriteLongint(AStream,FBounds.Top);
+  LEWriteLongint(AStream,FBounds.Right);
+  LEWriteLongint(AStream,FBounds.Bottom);
+  LEWriteLongint(AStream,ord(FLineOrder));
+
+  LEWriteLongint(AStream,length(FCompressedDataArray));
+  for i := 0 to high(FCompressedDataArray) do
+  begin
+    LEWriteLongint(AStream,FCompressedDataArray[i].Size);
+    FCompressedDataArray[i].Position := 0;
+    AStream.CopyFrom(FCompressedDataArray[i],FCompressedDataArray[i].Size);
+  end;
+end;
+
+procedure TBGRACompressableBitmap.ReadFromStream(AStream: TStream);
+var size,i: integer;
+begin
+  FreeData;
+  FWidth := LEReadLongint(AStream);
+  FHeight := LEReadLongint(AStream);
+  setlength(FCaption,LEReadLongint(AStream));
+  AStream.Read(FCaption[1],length(FCaption));
+  if (FWidth=0) or (FHeight = 0) then
+  begin
+    FUncompressedData := TMemoryStream.Create;
+    exit;
+  end;
+
+  FBounds.Left := LEReadLongint(AStream);
+  FBounds.Top := LEReadLongint(AStream);
+  FBounds.Right := LEReadLongint(AStream);
+  FBounds.Bottom := LEReadLongint(AStream);
+  FLineOrder := TRawImageLineOrder(LEReadLongint(AStream));
+
+  setlength(FCompressedDataArray,LEReadLongint(AStream));
+  for i := 0 to high(FCompressedDataArray) do
+  begin
+    size := LEReadLongint(AStream);
+    FCompressedDataArray[i] := TMemoryStream.Create;
+    FCompressedDataArray[i].CopyFrom(AStream,size);
+  end;
+
+  if FCompressedDataArray = nil then
+    FUncompressedData := TMemoryStream.Create;
+end;
+
+procedure TBGRACompressableBitmap.Decompress;
+var decomp: Tdecompressionstream;
+    i: integer;
+    partSize: integer;
+begin
+  if (FUncompressedData <> nil) or (FCompressedDataArray = nil) then exit;
+  FUncompressedData := TMemoryStream.Create;
+  for i := 0 to high(FCompressedDataArray) do
+  begin
+    FCompressedDataArray[i].Position := 0;
+    decomp := Tdecompressionstream.Create(FCompressedDataArray[i],true);
+    partSize := LEReadLongint(decomp);
+    FUncompressedData.CopyFrom(decomp,partSize);
+    decomp.Free;
+    FreeAndNil(FCompressedDataArray[i]);
+  end;
+  FCompressedDataArray := nil;
+end;
+
+{ Free all data }
+procedure TBGRACompressableBitmap.FreeData;
+var i: integer;
+begin
+  if FCompressedDataArray <> nil then
+  begin
+    for i := 0 to high(FCompressedDataArray) do
+      FCompressedDataArray[I].Free;
+    FCompressedDataArray := nil;
+  end;
+  if FUncompressedData <> nil then FreeAndNil(FUncompressedData);
+end;
+
+procedure TBGRACompressableBitmap.Init;
+begin
+  FUncompressedData := nil;
+  FCompressedDataArray := nil;
+  FWidth := 0;
+  FHeight := 0;
+  FCaption := '';
+  FCompressionProgress := 0;
+  CompressionLevel := clfastest;
+end;
+
+{ Copy a bitmap into this object. As it is copied, you need not
+  keep a copy of the source }
+procedure TBGRACompressableBitmap.Assign(Source: TBGRABitmap);
+var
+  UsedPart: TBGRABitmap;
+  NbUsedPixels: integer;
+begin
+  FreeData;
+  if Source = nil then
+  begin
+    FWidth := 0;
+    FHeight := 0;
+    FCaption := '';
+    exit;
+  end;
+  FWidth := Source.Width;
+  FHeight := Source.Height;
+  FCaption := Source.Caption;
+  FBounds := Source.GetImageBounds([cRed,cGreen,cBlue,cAlpha]);
+  NbUsedPixels := (FBounds.Right-FBounds.Left)*(FBounds.Bottom-FBounds.Top);
+  FUncompressedData := TMemoryStream.Create;
+  if NbUsedPixels = 0 then exit;
+
+  if (FBounds.Left <> 0) or (FBounds.Top <> 0)
+    or (FBounds.Right <> Source.Width) or (FBounds.Bottom <> Source.Height) then
+  begin
+    UsedPart := Source.GetPart(FBounds);
+    If TBGRAPixel_RGBAOrder then UsedPart.SwapRedBlue;
+    FUncompressedData.Write(UsedPart.Data^,NbUsedPixels*Sizeof(TBGRAPixel));
+    FLineOrder := UsedPart.LineOrder;
+    UsedPart.Free;
+  end else
+  begin
+    If TBGRAPixel_RGBAOrder then Source.SwapRedBlue;
+    FUncompressedData.Write(Source.Data^,Source.NbPixels*Sizeof(TBGRAPixel));
+    If TBGRAPixel_RGBAOrder then Source.SwapRedBlue;
+    FLineOrder := Source.LineOrder;
+  end;
+end;
+
+destructor TBGRACompressableBitmap.Destroy;
+begin
+  FreeData;
+  inherited Destroy;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgracoordpool3d.pas

@@ -0,0 +1,435 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRACoordPool3D;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, BGRABitmapTypes, BGRASSE, BGRAMatrix3D;
+
+type
+  PBGRACoordData3D = ^TBGRACoordData3D;
+  TBGRACoordData3D = packed record
+    {0} sceneCoord: TPoint3D_128;
+    {16} viewCoord: TPoint3D_128;
+    {32} projectedCoord: TPointF;
+    {40} InvZ: single;
+    {44} used: wordbool; customNormalUsed: wordbool;
+    {48} viewNormal: TPoint3D_128;
+    {64} customNormal: TPoint3D_128;
+  end; {80}
+
+  PBGRANormalData3D = ^TBGRANormalData3D;
+  TBGRANormalData3D = packed record
+    {0} customNormal: TPoint3D_128;
+    {16} viewNormal: TPoint3D_128;
+    {32} used: longbool;
+    {36} filler1,filler2,filler3: LongWord;
+  end; {48}
+
+  { TBGRAGenericPool }
+
+  TBGRAGenericPool = class
+  private
+    FFirstFree: integer;
+    FNbElements,FCapacity: integer;
+    FElementSize: PtrInt;
+    FUsedCapacity : integer;
+    function GetElement(AIndex: integer): Pointer;
+    procedure SetCapacity(ACapacity: integer);
+  protected
+    FPoolData: TMemoryBlockAlign128;
+    function GetUsed({%H-}AElement: integer): boolean; virtual;
+    procedure SetUsed({%H-}AElement: integer; {%H-}AUsed: boolean); virtual;
+    procedure Remove(AIndex: integer); //does not work if GetUsed/SetUsed are not implemented
+  public
+    constructor Create(ACapacity: integer; AElementSize: integer);
+    destructor Destroy; override;
+    function Add: integer;
+    property Element[AIndex: integer]: Pointer read GetElement;
+    property Capacity: integer read FCapacity;
+    property UsedCapacity: integer read FUsedCapacity;
+  end;
+
+  { TBGRACoordPool3D }
+
+  TBGRACoordPool3D = class(TBGRAGenericPool)
+  private
+    function GetCoordData(AIndex: integer): PBGRACoordData3D;
+  protected
+    function GetUsed(AElement: integer): boolean; override;
+    procedure SetUsed(AElement: integer; AUsed: boolean); override;
+  public
+    procedure Remove(AIndex: integer);
+    constructor Create(ACapacity: integer);
+    procedure ComputeWithMatrix(const AMatrix: TMatrix3D; const AProjection: TProjection3D);
+    property CoordData[AIndex: integer]: PBGRACoordData3D read GetCoordData;
+  end;
+
+  { TBGRANormalPool3D }
+
+  TBGRANormalPool3D = class(TBGRAGenericPool)
+  private
+    function GetNormalData(AIndex: integer): PBGRANormalData3D;
+  protected
+    function GetUsed(AElement: integer): boolean; override;
+    procedure SetUsed(AElement: integer; AUsed: boolean); override;
+  public
+    procedure Remove(AIndex: integer);
+    constructor Create(ACapacity: integer);
+    procedure ComputeWithMatrix(const AMatrix: TMatrix3D);
+    property NormalData[AIndex: integer]: PBGRANormalData3D read GetNormalData;
+  end;
+
+implementation
+
+{ TBGRAGenericPool }
+
+function TBGRAGenericPool.GetElement(AIndex: integer): Pointer;
+begin
+  result := Pointer(PByte(FPoolData.Data)+AIndex*FElementSize);
+end;
+
+procedure TBGRAGenericPool.SetCapacity(ACapacity: integer);
+var NewPoolData: TMemoryBlockAlign128;
+begin
+  if FCapacity <> ACapacity then
+  begin
+    if ACapacity = 0 then
+      FreeAndNil(FPoolData)
+    else
+    begin
+      NewPoolData := TMemoryBlockAlign128.Create(ACapacity*FElementSize);
+      if FCapacity <> 0 then
+      begin
+        //previous block is smaller
+        if FCapacity < ACapacity then
+        begin
+          move(FPoolData.Data^, NewPoolData.Data^, FCapacity*FElementSize);
+          //pad with zeros
+          fillchar((pbyte(NewPoolData.Data)+FCapacity*FElementSize)^,(ACapacity-FCapacity)*FElementSize,0);
+        end
+        else //previous block is greater or equal
+          move(FPoolData.Data^, NewPoolData.Data^, ACapacity*FElementSize);
+        FreeAndNil(FPoolData);
+      end else
+       //clear new block
+        fillchar(pbyte(NewPoolData.Data)^,ACapacity*FElementSize,0);
+
+      FPoolData := NewPoolData;
+    end;
+    FCapacity:= ACapacity;
+  end;
+end;
+
+function TBGRAGenericPool.GetUsed(AElement: integer): boolean;
+begin
+  result := false;
+end;
+
+procedure TBGRAGenericPool.SetUsed(AElement: integer; AUsed: boolean);
+begin
+  //nothing
+end;
+
+constructor TBGRAGenericPool.Create(ACapacity: integer; AElementSize: integer);
+begin
+  FCapacity := 0;
+  FPoolData := nil;
+  FNbElements:= 0;
+  FFirstFree := 0;
+  FUsedCapacity := 0;
+  FElementSize:= AElementSize;
+  SetCapacity(ACapacity);
+end;
+
+destructor TBGRAGenericPool.Destroy;
+begin
+  FreeAndNil(FPoolData);
+  FCapacity := 0;
+  FNbElements:= 0;
+  FFirstFree := 0;
+  FUsedCapacity := 0;
+  inherited Destroy;
+end;
+
+procedure TBGRAGenericPool.Remove(AIndex: integer);
+begin
+  if (AIndex < 0) or (AIndex >= FUsedCapacity) then
+    raise ERangeError.Create('Index out of bounds');
+  if GetUsed(AIndex) then
+  begin
+    SetUsed(AIndex, false);
+    if AIndex < FFirstFree then FFirstFree := AIndex;
+    if AIndex = FUsedCapacity-1 then
+    begin
+      while (FUsedCapacity > 0) and not GetUsed(FUsedCapacity-1) do
+        dec(FUsedCapacity);
+    end;
+  end;
+end;
+
+function TBGRAGenericPool.Add: integer;
+begin
+  //check for free space
+  while FFirstFree < FCapacity do
+  begin
+    if not GetUsed(FFirstFree) then
+    begin
+      SetUsed(FFirstFree,True);
+      result := FFirstFree;
+      inc(FFirstFree);
+      if FFirstFree > FUsedCapacity then
+        FUsedCapacity := FFirstFree;
+      exit;
+    end;
+    inc(FFirstFree);
+  end;
+
+  //no free space
+  SetCapacity(FCapacity*2+8);
+  SetUsed(FFirstFree, true);
+  result := FFirstFree;
+  inc(FFirstFree);
+  if FFirstFree > FUsedCapacity then
+    FUsedCapacity := FFirstFree;
+end;
+
+{ TBGRACoordPool3D }
+
+constructor TBGRACoordPool3D.Create(ACapacity: integer);
+begin
+  inherited Create(ACapacity,SizeOf(TBGRACoordData3D));
+end;
+
+procedure TBGRACoordPool3D.ComputeWithMatrix(const AMatrix: TMatrix3D;
+  const AProjection: TProjection3D);
+var
+  P: PBGRACoordData3D;
+  I: Int32or64;
+begin
+  if UsedCapacity = 0 then exit;
+  P := PBGRACoordData3D(FPoolData.Data);
+  {$IFDEF CPUI386}
+  {$IFDEF BGRASSE_AVAILABLE}
+  {$asmmode intel}
+  if UseSSE then
+  begin
+    Matrix3D_SSE_Load(AMatrix);
+    asm
+      mov eax,[AProjection]
+      movups xmm4,[eax]
+      xorps xmm1,xmm1
+    end;
+    i := UsedCapacity;
+    if UseSSE3 then
+    begin
+      while i > 0 do
+      with P^ do
+      begin
+        if used then
+        begin
+          MatrixMultiplyVect3D_SSE3_Aligned(sceneCoord,viewCoord);
+          if viewCoord.z > 0 then
+          begin
+            asm
+              mov eax, P
+              movaps xmm3, [eax+16] //viewCoord
+              movaps xmm2,xmm3
+              shufps xmm2,xmm3,2+8+32+128
+              rcpps xmm2,xmm2  //xmm2 = InvZ
+              movss [eax+40],xmm2 //-> InvZ
+
+              mulps xmm3,xmm4  //xmm3 *= Projection.Zoom
+              mulps xmm3,xmm2  //xmm3 *= InvZ
+
+              movhlps xmm0,xmm4  //xmm0 = Projection.Center
+              addps xmm3,xmm0  //xmm3 += Projection.Center
+
+              movlps [eax+32],xmm3 //->projectedCoord
+              movaps [eax+48],xmm1 //->normal
+            end;
+          end else
+          asm
+            mov eax, P
+            movlps [eax+32],xmm1  //0->projectedCoord
+            movaps [eax+48],xmm1 //->normal
+          end;
+          if customNormalUsed then
+            MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(customNormal,viewNormal);
+        end;
+        dec(i);
+        inc(p);
+      end;
+    end else
+    begin
+      while i > 0 do
+      with P^ do
+      begin
+        if used then
+        begin
+          MatrixMultiplyVect3D_SSE_Aligned(sceneCoord,viewCoord);
+          if viewCoord.z > 0 then
+          begin
+            asm
+              mov eax, P
+              movaps xmm3, [eax+16] //viewCoord
+              movaps xmm2,xmm3
+              shufps xmm2,xmm3,2+8+32+128
+              rcpps xmm2,xmm2  //xmm2 = InvZ
+              movss [eax+40],xmm2 //-> InvZ
+
+              mulps xmm3,xmm4  //xmm3 *= Projection.Zoom
+              mulps xmm3,xmm2  //xmm3 *= InvZ
+
+              movhlps xmm0,xmm4  //xmm0 = Projection.Center
+              addps xmm3,xmm0  //xmm3 += Projection.Center
+
+              movlps [eax+32],xmm3 //->projectedCoord
+              movaps [eax+48],xmm1 //->normal
+            end;
+          end else
+          asm
+            mov eax, P
+            movlps [eax+32],xmm1  //0 ->projectedCoord
+            movaps [eax+48],xmm1 //->normal
+          end;
+          if customNormalUsed then
+            MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(customNormal,viewNormal);
+        end;
+        dec(i);
+        inc(p);
+      end;
+    end;
+  end
+  else
+  {$ENDIF}
+  {$ENDIF}
+  begin
+    i := UsedCapacity;
+    while i > 0 do
+    with P^ do
+    begin
+      if used then
+      begin
+        viewCoord := AMatrix*sceneCoord;
+        if customNormalUsed then
+          viewNormal := MultiplyVect3DWithoutTranslation(AMatrix,customNormal)
+        else
+          ClearPoint3D_128(viewNormal);
+        if viewCoord.z > 0 then
+        begin
+          InvZ := 1/viewCoord.z;
+          projectedCoord := PointF(viewCoord.x*InvZ*AProjection.Zoom.x + AProjection.Center.x,
+                                   viewCoord.y*InvZ*AProjection.Zoom.Y + AProjection.Center.y);
+        end else
+          projectedCoord := PointF(0,0);
+      end;
+      dec(i);
+      inc(p);
+    end;
+  end;
+end;
+
+function TBGRACoordPool3D.GetCoordData(AIndex: integer): PBGRACoordData3D;
+begin
+  result := PBGRACoordData3D(FPoolData.Data)+AIndex;
+end;
+
+function TBGRACoordPool3D.GetUsed(AElement: integer): boolean;
+begin
+  Result:= CoordData[AElement]^.used;
+end;
+
+procedure TBGRACoordPool3D.SetUsed(AElement: integer; AUsed: boolean);
+begin
+  CoordData[AElement]^.used := AUsed;
+end;
+
+procedure TBGRACoordPool3D.Remove(AIndex: integer);
+begin
+  inherited Remove(AIndex);
+end;
+
+{ TBGRANormalPool3D }
+
+function TBGRANormalPool3D.GetNormalData(AIndex: integer): PBGRANormalData3D;
+begin
+  result := PBGRANormalData3D(FPoolData.Data)+AIndex;
+end;
+
+function TBGRANormalPool3D.GetUsed(AElement: integer): boolean;
+begin
+  Result:= NormalData[AElement]^.used;
+end;
+
+procedure TBGRANormalPool3D.SetUsed(AElement: integer; AUsed: boolean);
+begin
+  NormalData[AElement]^.used := AUsed;
+end;
+
+procedure TBGRANormalPool3D.Remove(AIndex: integer);
+begin
+  inherited Remove(AIndex);
+end;
+
+constructor TBGRANormalPool3D.Create(ACapacity: integer);
+begin
+  inherited Create(ACapacity,SizeOf(TBGRANormalData3D));
+end;
+
+procedure TBGRANormalPool3D.ComputeWithMatrix(const AMatrix: TMatrix3D);
+var
+  P: PBGRANormalData3D;
+  I: Int32or64;
+begin
+  if UsedCapacity = 0 then exit;
+  P := PBGRANormalData3D(FPoolData.Data);
+  {$IFDEF CPUI386}
+  {$IFDEF BGRASSE_AVAILABLE}
+  {$asmmode intel}
+  if UseSSE then
+  begin
+    Matrix3D_SSE_Load(AMatrix);
+    i := UsedCapacity;
+    if UseSSE3 then
+    begin
+      while i > 0 do
+      with P^ do
+      begin
+        if used then
+          MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(customNormal,viewNormal);
+        dec(i);
+        inc(p);
+      end;
+    end else
+    begin
+      while i > 0 do
+      with P^ do
+      begin
+        if used then
+          MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(customNormal,viewNormal);
+        dec(i);
+        inc(p);
+      end;
+    end;
+  end
+  else
+  {$ENDIF}
+  {$ENDIF}
+  begin
+    i := UsedCapacity;
+    while i > 0 do
+    with P^ do
+    begin
+      if used then
+        viewNormal := MultiplyVect3DWithoutTranslation(AMatrix,customNormal);
+      dec(i);
+      inc(p);
+    end;
+  end;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgracustomtextfx.pas

@@ -0,0 +1,600 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRACustomTextFX;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRABitmapTypes, BGRAPhongTypes, BGRAGrayscaleMask;
+
+const DefaultOutlineWidth = 3;
+
+type
+  { TBGRACustomTextEffect }
+
+  TBGRACustomTextEffect = class
+  private
+    function GetBounds: TRect;
+    function GetMaskHeight: integer;
+    class function GetOutlineWidth: integer; static;
+    function GetShadowBounds(ARadius: integer): TRect;
+    function GetMaskWidth: integer;
+    function GetTextHeight: integer;
+    function GetTextWidth: integer;
+    procedure SetShadowQuality(AValue: TRadialBlurType);
+  protected
+    FShadowQuality: TRadialBlurType;
+    FTextMask: TGrayscaleMask;
+    FShadowRadius: integer;
+    FOutlineMask, FShadowMask : TGrayscaleMask;
+    FShadingMask: TBGRACustomBitmap;
+    FShadingAltitude: integer;
+    FShadingRounded: boolean;
+    FTextSize: TSize;
+    FOffset: TPoint;
+    function DrawMaskMulticolored(ADest: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; X,Y: Integer; const AColors: array of TBGRAPixel): TRect;
+    function DrawMask(ADest: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; X,Y: Integer; AColor: TBGRAPixel): TRect; overload;
+    function DrawMask(ADest: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; X,Y: Integer; ATexture: IBGRAScanner): TRect; overload;
+    function InternalDrawShaded(ADest: TBGRACustomBitmap; X,Y: integer; Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; ATexture: IBGRAScanner; ARounded: Boolean): TRect;
+    procedure Init(AMask: TGrayscaleMask; AMaskOwner: boolean; AWidth,AHeight: integer; AOffset: TPoint);
+  public
+    constructor Create(AMask: TBGRACustomBitmap; AMaskOwner: boolean; AWidth,AHeight: integer; AOffset: TPoint);
+    constructor Create(AMask: TGrayscaleMask; AMaskOwner: boolean; AWidth,AHeight: integer; AOffset: TPoint);
+    procedure ApplySphere;
+    procedure ApplyVerticalCylinder;
+    procedure ApplyHorizontalCylinder;
+    function Draw(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel): TRect; overload;
+    function Draw(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner): TRect; overload;
+    function Draw(ADest: TBGRACustomBitmap; X, Y: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect; overload;
+    function Draw(ADest: TBGRACustomBitmap; X, Y: integer; ATexture: IBGRAScanner; AAlign: TAlignment): TRect; overload;
+
+    function DrawShaded(ADest: TBGRACustomBitmap; X,Y: integer; Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; ARounded: Boolean = true): TRect; overload;
+    function DrawShaded(ADest: TBGRACustomBitmap; X,Y: integer; Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner; ARounded: Boolean = true): TRect; overload;
+    function DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel; AAlign: TAlignment; ARounded: Boolean = true): TRect; overload;
+    function DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer; Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner; AAlign: TAlignment; ARounded: Boolean = true): TRect; overload;
+
+    function DrawMulticolored(ADest: TBGRACustomBitmap; X,Y: integer; const AColors: array of TBGRAPixel): TRect; overload;
+    function DrawMulticolored(ADest: TBGRACustomBitmap; X,Y: integer; const AColors: array of TBGRAPixel; AAlign: TAlignment): TRect; overload;
+    function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel): TRect; overload;
+    function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner): TRect; overload;
+    function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect; overload;
+    function DrawOutline(ADest: TBGRACustomBitmap; X,Y: integer; ATexture: IBGRAScanner; AAlign: TAlignment): TRect; overload;
+    function DrawShadow(ADest: TBGRACustomBitmap; X,Y,Radius: integer; AColor: TBGRAPixel): TRect; overload;
+    function DrawShadow(ADest: TBGRACustomBitmap; X,Y,Radius: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect; overload;
+    destructor Destroy; override;
+    property TextMask: TGrayscaleMask read FTextMask;
+    property TextMaskOffset: TPoint read FOffset;
+    property Width: integer read GetTextWidth; deprecated;
+    property Height: integer read GetTextHeight; deprecated;
+    property MaskWidth: integer read GetMaskWidth;
+    property MaskHeight: integer read GetMaskHeight;
+    property TextSize: TSize read FTextSize;
+    property TextWidth: integer read GetTextWidth;
+    property TextHeight: integer read GetTextHeight;
+    property Bounds: TRect read GetBounds;
+    property ShadowBounds[ARadius: integer]: TRect read GetShadowBounds;
+    property ShadowQuality: TRadialBlurType read FShadowQuality write SetShadowQuality;
+    class property OutlineWidth: integer read GetOutlineWidth;
+  end;
+
+implementation
+
+uses Math, BGRAGradientScanner;
+
+procedure BGRACustomReplace(var Destination: TBGRACustomBitmap; Temp: TObject); overload;
+begin
+  Destination.Free;
+  Destination := Temp as TBGRACustomBitmap;
+end;
+
+procedure BGRACustomReplace(var Destination: TGrayscaleMask; Temp: TObject); overload;
+begin
+  Destination.Free;
+  Destination := Temp as TGrayscaleMask;
+end;
+
+{ TBGRACustomTextEffect }
+
+function TBGRACustomTextEffect.GetBounds: TRect;
+begin
+  if FTextMask = nil then
+    result := EmptyRect else
+  with TextMaskOffset do
+    result := rect(X,Y,X+FTextMask.Width,Y+FTextMask.Height);
+end;
+
+function TBGRACustomTextEffect.GetMaskHeight: integer;
+begin
+  if FTextMask = nil then
+    result := 0
+  else
+    result := FTextMask.Height;
+end;
+
+class function TBGRACustomTextEffect.GetOutlineWidth: integer; static;
+begin
+  result := DefaultOutlineWidth;
+end;
+
+function TBGRACustomTextEffect.GetShadowBounds(ARadius: integer): TRect;
+begin
+  result := Bounds;
+  if (ARadius > 0) and not result.IsEmpty then
+    result.Inflate(ARadius, ARadius);
+end;
+
+function TBGRACustomTextEffect.GetMaskWidth: integer;
+begin
+  if FTextMask = nil then
+    result := 0
+  else
+    result := FTextMask.Width;
+end;
+
+function TBGRACustomTextEffect.GetTextHeight: integer;
+begin
+  result := FTextSize.cy;
+end;
+
+function TBGRACustomTextEffect.GetTextWidth: integer;
+begin
+  result := FTextSize.cx;
+end;
+
+procedure TBGRACustomTextEffect.SetShadowQuality(AValue: TRadialBlurType);
+begin
+  if FShadowQuality=AValue then Exit;
+  FShadowQuality:=AValue;
+  FreeAndNil(FShadowMask);
+end;
+
+function TBGRACustomTextEffect.DrawMaskMulticolored(ADest: TBGRACustomBitmap;
+  AMask: TCustomUniversalBitmap; X, Y: Integer; const AColors: array of TBGRAPixel
+  ): TRect;
+var
+  scan: TBGRASolidColorMaskScanner;
+  xb,yb,startX,numColor: integer;
+  p0,p: PByte;
+  emptyCol, nextCol: boolean;
+begin
+  if (AMask = nil) or (length(AColors)=0) then
+  begin
+    result := EmptyRect;
+    exit;
+  end;
+  if (length(AColors)=0) then
+  begin
+    result := DrawMask(ADest,AMask,X,Y,AColors[0]);
+    exit;
+  end;
+  scan := TBGRASolidColorMaskScanner.Create(AMask,Point(-X,-Y),AColors[0]);
+  numColor := 0;
+  startX := -1;
+  p0 := AMask.DataByte;
+  for xb := 0 to AMask.Width-1 do
+  begin
+    p := p0;
+
+    if startX=-1 then
+    begin
+      emptyCol := true;
+      for yb := AMask.Height-1 downto 0 do
+      begin
+        if (p^ <> 0) then
+        begin
+          emptyCol := false;
+          break;
+        end;
+        inc(p, AMask.Width);
+      end;
+
+      if not emptyCol then
+      begin
+        if startX=-1 then
+          startX := xb;
+      end else
+      begin
+        if startX<>-1 then
+        begin
+          ADest.FillRect(X+startX,Y,X+xb,Y+AMask.Height,scan,dmDrawWithTransparency);
+          inc(numColor);
+          if numColor = length(AColors) then
+            numColor := 0;
+          scan.Color := AColors[numColor];
+          startX := -1;
+        end;
+      end;
+
+    end else
+    begin
+      emptyCol := true;
+      nextCol := true;
+      for yb := AMask.Height-1 downto 0 do
+      begin
+        if (p^ <> 0) then
+        begin
+          emptyCol := false;
+          if ((p-1)^ <> 0) then
+          begin
+            nextCol := false;
+            break;
+          end;
+        end;
+        inc(p, AMask.Width);
+      end;
+      if nextCol or emptyCol then
+      begin
+        ADest.FillRect(X+startX,Y,X+xb,Y+AMask.Height,scan,dmDrawWithTransparency);
+        inc(numColor);
+        if numColor = length(AColors) then
+          numColor := 0;
+        scan.Color := AColors[numColor];
+        if emptyCol then startX := -1
+         else startX := xb;
+      end;
+    end;
+
+    inc(p0);
+  end;
+  if startX<>-1 then
+    ADest.FillRect(X+startX,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency);
+  scan.Free;
+  result := rect(X,Y,X+AMask.Width,Y+AMask.Height);
+end;
+
+function TBGRACustomTextEffect.DrawMask(ADest: TBGRACustomBitmap;
+  AMask: TCustomUniversalBitmap; X, Y: Integer; AColor: TBGRAPixel): TRect;
+var
+  scan: TBGRACustomScanner;
+begin
+  if AMask = nil then
+  begin
+    result := EmptyRect;
+    exit;
+  end;
+  scan := TBGRASolidColorMaskScanner.Create(AMask,Point(-X,-Y),AColor);
+  ADest.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency);
+  scan.Free;
+  result := rect(X,Y,X+AMask.Width,Y+AMask.Height);
+end;
+
+function TBGRACustomTextEffect.DrawMask(ADest: TBGRACustomBitmap;
+  AMask: TCustomUniversalBitmap; X, Y: Integer; ATexture: IBGRAScanner): TRect;
+var
+  scan: TBGRACustomScanner;
+begin
+  if AMask = nil then
+  begin
+    result := EmptyRect;
+    exit;
+  end;
+  scan := TBGRATextureMaskScanner.Create(AMask,Point(-X,-Y),ATexture);
+  ADest.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,dmDrawWithTransparency);
+  scan.Free;
+  result := rect(X,Y,X+AMask.Width,Y+AMask.Height);
+end;
+
+function TBGRACustomTextEffect.InternalDrawShaded(ADest: TBGRACustomBitmap; X,
+  Y: integer; Shader: TCustomPhongShading; Altitude: integer;
+  AColor: TBGRAPixel; ATexture: IBGRAScanner; ARounded: Boolean): TRect;
+var
+  WithMargin,GrayMap: TGrayscaleMask;
+  HeightMap: TBGRACustomBitmap;
+  p: PBGRAPixel;
+  n,maxv: integer;
+  v,blurRadius: single;
+  iBlurRadius: integer;
+begin
+  if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then
+  begin
+    result := EmptyRect;
+    exit;
+  end;
+
+  if (FShadingMask <> nil) and ((FShadingAltitude <> Altitude) or (FShadingRounded <> ARounded)) then
+    FreeAndNil(FShadingMask);
+
+  if FShadingMask = nil then
+  begin
+    FShadingRounded := ARounded;
+    FShadingAltitude := Altitude;
+
+    if ARounded then blurRadius := Altitude
+      else blurRadius := Altitude*0.5;
+
+    iBlurRadius := ceil(blurRadius);
+
+    WithMargin := TGrayscaleMask.Create(FTextMask.Width+iBlurRadius*2, FTextMask.Height+iBlurRadius*2,BGRABlack);
+    WithMargin.PutImage(iBlurRadius, iBlurRadius, FTextMask, dmSet);
+    if (iBlurRadius <> blurRadius) and (blurRadius < 3) then
+      GrayMap := WithMargin.FilterBlurRadial(round(blurRadius*10), rbPrecise)
+    else
+      GrayMap := WithMargin.FilterBlurRadial(iBlurRadius, rbFast);
+    HeightMap := BGRABitmapFactory.Create;
+    HeightMap.SetSize(GrayMap.Width, GrayMap.Height);
+    GrayMap.Draw(HeightMap, 0, 0);
+    GrayMap.Free;
+
+    p := HeightMap.Data;
+    maxv := 0;
+    for n := HeightMap.NbPixels-1 downto 0 do
+    begin
+      if p^.green > maxv then
+        maxv := p^.green;
+      inc(p);
+    end;
+
+    if maxv > 0 then
+    begin
+      p := HeightMap.Data;
+      for n := HeightMap.NbPixels-1 downto 0 do
+      begin
+        v := p^.green/maxv;
+        if ARounded then
+        begin
+          if v <= 0.5 then
+            v := v*v*2 else
+            v := 1-(1-v)*(1-v)*2;
+        end;
+        p^ := MapHeightToBGRA( v, p^.alpha);
+        inc(p);
+      end;
+    end;
+
+    HeightMap.ApplyMask(WithMargin);
+    WithMargin.Free;
+    BGRACustomReplace(HeightMap, HeightMap.GetPart( rect(iBlurRadius, iBlurRadius,
+                                 HeightMap.Width-iBlurRadius, HeightMap.Height-iBlurRadius) ) );
+    FShadingMask := HeightMap;
+  end;
+
+  inc(X, FOffset.X);
+  Inc(Y, FOffset.Y);
+  if ATexture <> nil then
+    Shader.DrawScan(ADest,FShadingMask,Altitude,X,Y, ATexture)
+  else
+    Shader.Draw(ADest,FShadingMask,Altitude,X,Y, AColor);
+  result := rect(X,Y, X+FShadingMask.Width,Y+FShadingMask.Height);
+end;
+
+procedure TBGRACustomTextEffect.Init(AMask: TGrayscaleMask;
+  AMaskOwner: boolean; AWidth, AHeight: integer; AOffset: TPoint);
+begin
+  FTextSize := Size(AWidth,AHeight);
+  FOffset := AOffset;
+  if not AMaskOwner then
+    FTextMask := AMask.Duplicate
+  else
+    FTextMask := AMask;
+  FShadowQuality:= rbFast;
+end;
+
+function TBGRACustomTextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
+  AColor: TBGRAPixel; AAlign: TAlignment): TRect;
+begin
+  Case AAlign of
+  taRightJustify: result := Draw(ADest,X-TextSize.cx,Y,AColor);
+  taCenter: result := Draw(ADest,X-TextSize.cx div 2,Y,AColor);
+  else result := Draw(ADest,X,Y,AColor);
+  end;
+end;
+
+function TBGRACustomTextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
+  ATexture: IBGRAScanner; AAlign: TAlignment): TRect;
+begin
+  Case AAlign of
+  taRightJustify: result := Draw(ADest,X-TextSize.cx,Y,ATexture);
+  taCenter: result := Draw(ADest,X-TextSize.cx div 2,Y,ATexture);
+  else result := Draw(ADest,X,Y,ATexture);
+  end;
+end;
+
+function TBGRACustomTextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer;
+  Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel;
+  ARounded: Boolean): TRect;
+begin
+  result := InternalDrawShaded(ADest,X,Y,Shader,Altitude,AColor,nil,ARounded);
+end;
+
+function TBGRACustomTextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer;
+  Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner;
+  ARounded: Boolean): TRect;
+begin
+  result := InternalDrawShaded(ADest,X,Y,Shader,Altitude,BGRAPixelTransparent,ATexture,ARounded);
+end;
+
+function TBGRACustomTextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer;
+  Shader: TCustomPhongShading; Altitude: integer; AColor: TBGRAPixel;
+  AAlign: TAlignment; ARounded: Boolean): TRect;
+begin
+  Case AAlign of
+  taLeftJustify: result := DrawShaded(ADest,X,Y,Shader,Altitude,AColor,ARounded);
+  taRightJustify: result := DrawShaded(ADest,X-TextSize.cx,Y,Shader,Altitude,AColor,ARounded);
+  taCenter: result := DrawShaded(ADest,X-TextSize.cx div 2,Y,Shader,Altitude,AColor,ARounded);
+  else
+    result := EmptyRect;
+  end;
+end;
+
+function TBGRACustomTextEffect.DrawShaded(ADest: TBGRACustomBitmap; X, Y: integer;
+  Shader: TCustomPhongShading; Altitude: integer; ATexture: IBGRAScanner;
+  AAlign: TAlignment; ARounded: Boolean): TRect;
+begin
+  Case AAlign of
+  taLeftJustify: result := DrawShaded(ADest,X,Y,Shader,Altitude,ATexture,ARounded);
+  taRightJustify: result := DrawShaded(ADest,X-TextSize.cx,Y,Shader,Altitude,ATexture,ARounded);
+  taCenter: result := DrawShaded(ADest,X-TextSize.cx div 2,Y,Shader,Altitude,ATexture,ARounded);
+  else
+    result := EmptyRect;
+  end;
+end;
+
+constructor TBGRACustomTextEffect.Create(AMask: TBGRACustomBitmap; AMaskOwner: boolean; AWidth,
+  AHeight: integer; AOffset: TPoint);
+var
+  grayMask: TGrayscaleMask;
+begin
+  grayMask := TGrayscaleMask.Create(AMask, cGreen);
+  if AMaskOwner then AMask.Free;
+  Init(grayMask, true, AWidth, AHeight, AOffset);
+end;
+
+constructor TBGRACustomTextEffect.Create(AMask: TGrayscaleMask;
+  AMaskOwner: boolean; AWidth, AHeight: integer; AOffset: TPoint);
+begin
+  Init(AMask, AMaskOwner, AWidth, AHeight, AOffset);
+end;
+
+procedure TBGRACustomTextEffect.ApplySphere;
+begin
+  if FTextMask = nil then exit;
+  FreeAndNil(FOutlineMask);
+  FreeAndNil(FShadowMask);
+  FShadowRadius := 0;
+  BGRACustomReplace(FTextMask, FTextMask.FilterSphere);
+end;
+
+procedure TBGRACustomTextEffect.ApplyVerticalCylinder;
+begin
+  if FTextMask = nil then exit;
+  FreeAndNil(FOutlineMask);
+  FreeAndNil(FShadowMask);
+  FShadowRadius := 0;
+  BGRACustomReplace(FTextMask, FTextMask.FilterCylinder);
+end;
+
+procedure TBGRACustomTextEffect.ApplyHorizontalCylinder;
+begin
+  if FTextMask = nil then exit;
+  FreeAndNil(FOutlineMask);
+  FreeAndNil(FShadowMask);
+  FShadowRadius := 0;
+  BGRACustomReplace(FTextMask,FTextMask.RotateCW);
+  BGRACustomReplace(FTextMask,FTextMask.FilterCylinder);
+  BGRACustomReplace(FTextMask,FTextMask.RotateCCW);
+end;
+
+function TBGRACustomTextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
+  AColor: TBGRAPixel): TRect;
+begin
+  result := DrawMask(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,AColor);
+end;
+
+function TBGRACustomTextEffect.Draw(ADest: TBGRACustomBitmap; X, Y: integer;
+  ATexture: IBGRAScanner): TRect;
+begin
+  result := DrawMask(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,ATexture);
+end;
+
+function TBGRACustomTextEffect.DrawMulticolored(ADest: TBGRACustomBitmap; X,
+  Y: integer; const AColors: array of TBGRAPixel): TRect;
+begin
+  result := DrawMaskMulticolored(ADest,FTextMask,X+FOffset.X,Y+FOffset.Y,AColors);
+end;
+
+function TBGRACustomTextEffect.DrawMulticolored(ADest: TBGRACustomBitmap; X,
+  Y: integer; const AColors: array of TBGRAPixel; AAlign: TAlignment): TRect;
+begin
+  Case AAlign of
+  taRightJustify: result := DrawMulticolored(ADest,X-TextSize.cx,Y,AColors);
+  taCenter: result := DrawMulticolored(ADest,X-TextSize.cx div 2,Y,AColors);
+  else result := DrawMulticolored(ADest,X,Y,AColors);
+  end;
+end;
+
+function TBGRACustomTextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer;
+  AColor: TBGRAPixel): TRect;
+begin
+  if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then
+  begin
+    result := EmptyRect;
+    exit;
+  end;
+  if FOutlineMask = nil then
+  begin
+    FOutlineMask := FTextMask.FilterContour;
+    FOutlineMask.Negative;
+  end;
+  result := DrawMask(ADest,FOutlineMask,X+FOffset.X,Y+FOffset.Y,AColor);
+end;
+
+function TBGRACustomTextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer;
+  ATexture: IBGRAScanner): TRect;
+begin
+  if (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then
+  begin
+    result := EmptyRect;
+    exit;
+  end;
+  if FOutlineMask = nil then
+  begin
+    FOutlineMask := FTextMask.FilterContour;
+    FOutlineMask.Negative;
+  end;
+  result := DrawMask(ADest,FOutlineMask,X+FOffset.X,Y+FOffset.Y,ATexture);
+end;
+
+function TBGRACustomTextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer;
+  AColor: TBGRAPixel; AAlign: TAlignment): TRect;
+begin
+  Case AAlign of
+  taRightJustify: result := DrawOutline(ADest,X-TextSize.cx,Y,AColor);
+  taCenter: result := DrawOutline(ADest,X-TextSize.cx div 2,Y,AColor);
+  else result := DrawOutline(ADest,X,Y,AColor);
+  end;
+end;
+
+function TBGRACustomTextEffect.DrawOutline(ADest: TBGRACustomBitmap; X, Y: integer;
+  ATexture: IBGRAScanner; AAlign: TAlignment): TRect;
+begin
+  Case AAlign of
+  taRightJustify: result := DrawOutline(ADest,X-TextSize.cx,Y,ATexture);
+  taCenter: result := DrawOutline(ADest,X-TextSize.cx div 2,Y,ATexture);
+  else result := DrawOutline(ADest,X,Y,ATexture);
+  end;
+end;
+
+function TBGRACustomTextEffect.DrawShadow(ADest: TBGRACustomBitmap; X, Y,
+  Radius: integer; AColor: TBGRAPixel): TRect;
+begin
+  if (Radius <= 0) or (FTextMask = nil) or (FTextMask.Width = 0) or (FTextMask.Height = 0) then
+  begin
+    result := Draw(ADest,X,Y,AColor);
+    exit;
+  end;
+  if (FShadowRadius <> Radius) or (FShadowMask = nil) then
+  begin
+    FShadowRadius := Radius;
+    FreeAndNil(FShadowMask);
+    FShadowMask := TGrayscaleMask.Create(FTextMask.Width+Radius*2,FTextMask.Height+Radius*2, 0);
+    FShadowMask.PutImage(Radius,Radius,FTextMask,dmSet);
+    BGRACustomReplace(FShadowMask, FShadowMask.FilterBlurRadial(Radius,ShadowQuality));
+  end;
+  Inc(X,FOffset.X-Radius);
+  Inc(Y,FOffset.Y-Radius);
+  DrawMask(ADest,FShadowMask,X,Y,AColor);
+  result := rect(X,Y,X+FShadowMask.Width,Y+FShadowMask.Height);
+end;
+
+function TBGRACustomTextEffect.DrawShadow(ADest: TBGRACustomBitmap; X, Y,
+  Radius: integer; AColor: TBGRAPixel; AAlign: TAlignment): TRect;
+begin
+  Case AAlign of
+  taRightJustify: result := DrawShadow(ADest,X-TextSize.cx,Y,Radius,AColor);
+  taCenter: result := DrawShadow(ADest,X-TextSize.cx div 2,Y,Radius,AColor);
+  else result := DrawShadow(ADest,X,Y,Radius,AColor);
+  end;
+end;
+
+destructor TBGRACustomTextEffect.Destroy;
+begin
+  FShadowMask.free;
+  FTextMask.Free;
+  FOutlineMask.Free;
+  FShadingMask.Free;
+  inherited Destroy;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgradithering.pas

@@ -0,0 +1,761 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRADithering;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRAFilterType, BGRAPalette, BGRABitmapTypes;
+
+type
+  TOutputPixelProc = procedure(X,Y: Int32or64; AColorIndex: Int32or64; AColor: TBGRAPixel) of object;
+
+  { TDitheringTask }
+
+  TDitheringTask = class(TFilterTask)
+  protected
+    FBounds: TRect;
+    FIgnoreAlpha: boolean;
+    FPalette: TBGRACustomApproxPalette;
+    FCurrentOutputScanline: PBGRAPixel;
+    FCurrentOutputY: Int32or64;
+    FOutputPixel : TOutputPixelProc;
+    FDrawMode: TDrawMode;
+    procedure UpdateCurrentLine(Y: Int32or64); inline;
+    procedure OutputPixel(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual;
+    procedure OutputPixelSet(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual;
+    procedure OutputPixelSetExceptTransparent(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual;
+    procedure OutputPixelLinearBlend(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual;
+    procedure OutputPixelDraw(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual;
+    procedure OutputPixelXor(X,Y: Int32or64; {%H-}AColorIndex: Int32or64; AColor: TBGRAPixel); virtual;
+    procedure ApproximateColor(const AColor: TBGRAPixel; out AApproxColor: TBGRAPixel; out AIndex: integer);
+    procedure SetDrawMode(AValue: TDrawMode);
+    procedure UpdateOutputPixel;
+  public
+    constructor Create(ASource: IBGRAScanner; APalette: TBGRACustomApproxPalette; ADestination: TBGRACustomBitmap; AIgnoreAlpha: boolean; ABounds: TRect); overload;
+    constructor Create(bmp: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean; ABounds: TRect); overload;
+    constructor Create(bmp: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean); overload;
+    property OnOutputPixel: TOutputPixelProc read FOutputPixel write FOutputPixel;
+    property DrawMode: TDrawMode read FDrawMode write SetDrawMode;
+  end;
+
+  { TNearestColorTask }
+
+  TNearestColorTask = class(TDitheringTask)
+  protected
+    procedure DoExecute; override;
+  end;
+
+  { TFloydSteinbergDitheringTask }
+
+  TFloydSteinbergDitheringTask = class(TDitheringTask)
+  protected
+    procedure DoExecute; override;
+  end;
+
+  { TDitheringToIndexedImage }
+
+  TDitheringToIndexedImage = class
+  protected
+    FBitOrder: TRawImageBitOrder;
+    FByteOrder: TRawImageByteOrder;
+    FBitsPerPixel: integer;
+    FLineOrder: TRawImageLineOrder;
+    FPalette: TBGRACustomApproxPalette;
+    FIgnoreAlpha: boolean;
+    FTransparentColorIndex: Int32or64;
+
+    //following variables are used during dithering
+    FCurrentScanlineSize: PtrInt;
+    FCurrentData: PByte;
+    FCurrentOutputY: Int32or64;
+    FCurrentOutputScanline: PByte;
+    FCurrentBitOrderMask: Int32or64;
+    FCurrentMaxY: Int32or64;
+
+    procedure SetPalette(AValue: TBGRACustomApproxPalette);
+    procedure SetIgnoreAlpha(AValue: boolean);
+    procedure SetLineOrder(AValue: TRawImageLineOrder);
+    procedure SetBitOrder(AValue: TRawImageBitOrder); virtual;
+    procedure SetBitsPerPixel(AValue: integer); virtual;
+    procedure SetByteOrder(AValue: TRawImageByteOrder); virtual;
+    procedure OutputPixelSubByte(X,Y: Int32or64; AColorIndex: Int32or64; {%H-}AColor: TBGRAPixel); virtual;
+    procedure OutputPixelFullByte(X,Y: Int32or64; AColorIndex: Int32or64; {%H-}AColor: TBGRAPixel); virtual;
+    function GetScanline(Y: Int32or64): Pointer; virtual;
+    function GetTransparentColorIndex: integer;
+    procedure SetTransparentColorIndex(AValue: integer);
+  public
+    constructor Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer); overload; //use platform byte order
+    constructor Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer; AByteOrder: TRawImageByteOrder); overload; //maybe necessary if larger than 8 bits per pixel
+
+    function DitherImage(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap): Pointer; overload; //use minimum scanline size
+    function DitherImage(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): Pointer; overload;
+    procedure DitherImageTo(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AData: Pointer); overload; //use minimum scanline size
+    procedure DitherImageTo(AAlgorithm: TDitheringAlgorithm; AImage: TBGRACustomBitmap; AData: Pointer; AScanlineSize: PtrInt); overload;
+    function ComputeMinimumScanlineSize(AWidthInPixels: integer): PtrInt;
+    function AllocateSpaceForIndexedData(AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): pointer;
+
+    //optional customization of format
+    property BitsPerPixel: integer read FBitsPerPixel write SetBitsPerPixel;
+    property BitOrder: TRawImageBitOrder read FBitOrder write SetBitOrder;
+    property ByteOrder: TRawImageByteOrder read FByteOrder write SetByteOrder;
+    property LineOrder: TRawImageLineOrder read FLineOrder write SetLineOrder;
+
+    property Palette: TBGRACustomApproxPalette read FPalette write SetPalette;
+    property IgnoreAlpha: boolean read FIgnoreAlpha write SetIgnoreAlpha;
+
+    //when there is no transparent color in the palette, or that IgnoreAlpha is set to True,
+    //this allows to define the index for the fully transparent color
+    property DefaultTransparentColorIndex: integer read GetTransparentColorIndex write SetTransparentColorIndex;
+  end;
+
+function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette;
+  AIgnoreAlpha: boolean): TDitheringTask; overload;
+function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette;
+  AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask; overload;
+function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; ABounds: TRect): TDitheringTask; overload;
+function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette;
+    AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask; overload;
+
+function DitherImageTo16Bit(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): TBGRACustomBitmap;
+
+implementation
+
+uses BGRABlend;
+
+function AbsRGBADiff(const c1, c2: TExpandedPixel): Int32or64;
+begin
+  result := abs(c1.alpha-c2.alpha);
+  inc(result, abs(c1.red-c2.red) );
+  inc(result, abs(c1.green-c2.green) );
+  inc(result, abs(c1.blue-c2.blue) );
+end;
+
+function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette;
+  AIgnoreAlpha: boolean): TDitheringTask;
+begin
+  result := CreateDitheringTask(AAlgorithm, ABitmap, APalette, AIgnoreAlpha, rect(0,0,ABitmap.width, ABitmap.Height));
+end;
+
+function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; APalette: TBGRACustomApproxPalette;
+  AIgnoreAlpha: boolean; ABounds: TRect): TDitheringTask;
+begin
+  result := nil;
+  case AAlgorithm of
+    daNearestNeighbor: result := TNearestColorTask.Create(ABitmap, APalette, False, AIgnoreAlpha, ABounds);
+    daFloydSteinberg: result := TFloydSteinbergDitheringTask.Create(ABitmap, APalette, False, AIgnoreAlpha, ABounds);
+    else raise exception.Create('Unknown algorithm');
+  end;
+end;
+
+function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm;
+  ASource: IBGRAScanner; ADestination: TBGRACustomBitmap; ABounds: TRect
+  ): TDitheringTask;
+begin
+  result := CreateDitheringTask(AAlgorithm, ASource, ADestination, nil, true, ABounds);
+end;
+
+function CreateDitheringTask(AAlgorithm: TDitheringAlgorithm;
+  ASource: IBGRAScanner; ADestination: TBGRACustomBitmap;
+  APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABounds: TRect
+  ): TDitheringTask;
+begin
+  result := nil;
+  case AAlgorithm of
+    daNearestNeighbor: result := TNearestColorTask.Create(ASource, APalette, ADestination, AIgnoreAlpha, ABounds);
+    daFloydSteinberg: result := TFloydSteinbergDitheringTask.Create(ASource, APalette, ADestination, AIgnoreAlpha, ABounds);
+    else raise exception.Create('Unknown algorithm');
+  end;
+end;
+
+function DitherImageTo16Bit(AAlgorithm: TDitheringAlgorithm;
+  ABitmap: TBGRACustomBitmap): TBGRACustomBitmap;
+var
+  palette16bit: TBGRA16BitPalette;
+  dither: TDitheringTask;
+begin
+  palette16bit := TBGRA16BitPalette.Create;
+  dither := CreateDitheringTask(AAlgorithm, ABitmap, palette16bit, false);
+  result := dither.Execute;
+  dither.Free;
+  palette16bit.Free;
+end;
+
+{ TDitheringToIndexedImage }
+
+procedure TDitheringToIndexedImage.SetBitsPerPixel(AValue: integer);
+begin
+  if not (AValue in [1,2,4,8,16,32]) then
+    raise exception.Create('Invalid value for bits per pixel. Allowed values: 1,2,4,8,16,32.');
+  if FBitsPerPixel=AValue then Exit;
+  FBitsPerPixel:=AValue;
+end;
+
+procedure TDitheringToIndexedImage.SetByteOrder(AValue: TRawImageByteOrder);
+begin
+  if FByteOrder=AValue then Exit;
+  FByteOrder:=AValue;
+end;
+
+procedure TDitheringToIndexedImage.OutputPixelSubByte(X, Y: Int32or64;
+  AColorIndex: Int32or64; AColor: TBGRAPixel);
+var p: PByte;
+begin
+  if y <> FCurrentOutputY then
+  begin
+    FCurrentOutputY := y;
+    FCurrentOutputScanline := GetScanline(Y);
+  end;
+  if AColorIndex = -1 then AColorIndex := FTransparentColorIndex;
+  case FBitsPerPixel of
+    1: begin
+         p := FCurrentOutputScanline+(x shr 3);
+         p^ := p^ or ((AColorIndex and 1) shl ((x xor FCurrentBitOrderMask) and 7));
+       end;
+    2: begin
+         p := FCurrentOutputScanline+(x shr 2);
+         p^ := p^ or ((AColorIndex and 1) shl (((x xor FCurrentBitOrderMask) and 3) shl 1));
+       end;
+    4: begin
+         p := FCurrentOutputScanline+(x shr 1);
+         p^ := p^ or ((AColorIndex and 1) shl (((x xor FCurrentBitOrderMask) and 1) shl 2));
+       end;
+  end;
+end;
+
+procedure TDitheringToIndexedImage.OutputPixelFullByte(X, Y: Int32or64;
+  AColorIndex: Int32or64; AColor: TBGRAPixel);
+begin
+  if y <> FCurrentOutputY then
+  begin
+    FCurrentOutputY := y;
+    FCurrentOutputScanline := GetScanline(Y);
+  end;
+  if AColorIndex = -1 then AColorIndex := FTransparentColorIndex;
+  case FBitsPerPixel of
+    8: (FCurrentOutputScanline+x)^ := AColorIndex;
+    16: (PWord(FCurrentOutputScanline)+x)^ := AColorIndex;
+    32: (PLongWord(FCurrentOutputScanline)+x)^ := AColorIndex;
+  end;
+end;
+
+function TDitheringToIndexedImage.GetScanline(Y: Int32or64): Pointer;
+begin
+  if FLineOrder = riloTopToBottom then
+    result := FCurrentData + Y*FCurrentScanlineSize
+  else
+    result := FCurrentData + (FCurrentMaxY-Y)*FCurrentScanlineSize
+end;
+
+procedure TDitheringToIndexedImage.SetIgnoreAlpha(AValue: boolean);
+begin
+  if FIgnoreAlpha=AValue then Exit;
+  FIgnoreAlpha:=AValue;
+end;
+
+procedure TDitheringToIndexedImage.SetTransparentColorIndex(AValue: integer);
+begin
+  if FTransparentColorIndex=AValue then Exit;
+  FTransparentColorIndex:=AValue;
+end;
+
+function TDitheringToIndexedImage.GetTransparentColorIndex: integer;
+begin
+  result := FTransparentColorIndex;
+end;
+
+procedure TDitheringToIndexedImage.SetPalette(AValue: TBGRACustomApproxPalette);
+begin
+  if FPalette=AValue then Exit;
+  FPalette:=AValue;
+end;
+
+procedure TDitheringToIndexedImage.SetLineOrder(AValue: TRawImageLineOrder);
+begin
+  if FLineOrder=AValue then Exit;
+  FLineOrder:=AValue;
+end;
+
+procedure TDitheringToIndexedImage.SetBitOrder(AValue: TRawImageBitOrder);
+begin
+  if FBitOrder=AValue then Exit;
+  FBitOrder:=AValue;
+end;
+
+constructor TDitheringToIndexedImage.Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer);
+begin
+  BitsPerPixel:= ABitsPerPixelForIndices;
+  BitOrder := riboReversedBits; //convention in BMP format
+  {$IFDEF ENDIAN_LITTLE}
+  ByteOrder:= riboLSBFirst;
+  {$ELSE}
+  ByteOrder:= riboMSBFirst;
+  {$ENDIF}
+  Palette := APalette;
+  IgnoreAlpha:= AIgnoreAlpha;
+end;
+
+constructor TDitheringToIndexedImage.Create(APalette: TBGRACustomApproxPalette; AIgnoreAlpha: boolean; ABitsPerPixelForIndices: integer;
+  AByteOrder: TRawImageByteOrder);
+begin
+  BitsPerPixel:= ABitsPerPixelForIndices;
+  BitOrder := riboReversedBits; //convention in BMP format
+  ByteOrder:= AByteOrder;
+  Palette := APalette;
+  IgnoreAlpha:= AIgnoreAlpha;
+end;
+
+function TDitheringToIndexedImage.ComputeMinimumScanlineSize(
+  AWidthInPixels: integer): PtrInt;
+begin
+  result := (AWidthInPixels*FBitsPerPixel+7) shr 3;
+end;
+
+function TDitheringToIndexedImage.AllocateSpaceForIndexedData(AImage: TBGRACustomBitmap;
+  AScanlineSize: PtrInt): pointer;
+var size: integer;
+begin
+  size := AScanlineSize * AImage.Height;
+  GetMem(result, size);
+  Fillchar(result^, size, 0);
+end;
+
+function TDitheringToIndexedImage.DitherImage(AAlgorithm: TDitheringAlgorithm;
+  AImage: TBGRACustomBitmap): Pointer;
+begin
+  result := DitherImage(AAlgorithm, AImage, ComputeMinimumScanlineSize(AImage.Width));
+end;
+
+procedure TDitheringToIndexedImage.DitherImageTo(AAlgorithm: TDitheringAlgorithm;
+  AImage: TBGRACustomBitmap; AData: Pointer);
+begin
+  DitherImageTo(AAlgorithm, AImage, AData, ComputeMinimumScanlineSize(AImage.Width));
+end;
+
+function TDitheringToIndexedImage.DitherImage(AAlgorithm: TDitheringAlgorithm;
+  AImage: TBGRACustomBitmap; AScanlineSize: PtrInt): Pointer;
+begin
+  result := AllocateSpaceForIndexedData(AImage, AScanlineSize);
+  DitherImageTo(AAlgorithm, AImage, result, AScanlineSize);
+end;
+
+procedure TDitheringToIndexedImage.DitherImageTo(AAlgorithm: TDitheringAlgorithm;
+  AImage: TBGRACustomBitmap; AData: Pointer; AScanlineSize: PtrInt);
+var ditherTask: TDitheringTask;
+begin
+  FCurrentOutputY := -1;
+  FCurrentOutputScanline := nil;
+  FCurrentData := AData;
+  FCurrentMaxY:= AImage.Height-1;
+  FCurrentScanlineSize:= AScanlineSize;
+
+  ditherTask := CreateDitheringTask(AAlgorithm, AImage, FPalette, FIgnoreAlpha);
+  try
+    ditherTask.Inplace := True; //do not allocate destination
+    if BitsPerPixel >= 8 then
+      ditherTask.OnOutputPixel := @OutputPixelFullByte
+    else
+    begin
+      ditherTask.OnOutputPixel:= @OutputPixelSubByte;
+      if BitOrder = riboBitsInOrder then
+        FCurrentBitOrderMask := 0
+      else
+        FCurrentBitOrderMask := $ff;
+    end;
+    ditherTask.Execute;
+  finally
+    ditherTask.Free;
+  end;
+end;
+
+{ TDitheringTask }
+
+procedure TDitheringTask.SetDrawMode(AValue: TDrawMode);
+begin
+  if FDrawMode=AValue then Exit;
+  FDrawMode:=AValue;
+  UpdateOutputPixel;
+end;
+
+procedure TDitheringTask.UpdateOutputPixel;
+begin
+  case FDrawMode of
+    dmSet: FOutputPixel := @OutputPixelSet;
+    dmSetExceptTransparent: FOutputPixel := @OutputPixelSetExceptTransparent;
+    dmLinearBlend: FOutputPixel := @OutputPixelLinearBlend;
+    dmXor: FOutputPixel := @OutputPixelXor;
+  else
+    {dmDrawWithTransparency} FOutputPixel := @OutputPixelDraw;
+  end;
+end;
+
+procedure TDitheringTask.UpdateCurrentLine(Y: Int32or64);
+begin
+  if Y <> FCurrentOutputY then
+  begin
+    FCurrentOutputY := Y;
+    FCurrentOutputScanline := Destination.ScanLine[y];
+  end;
+end;
+
+procedure TDitheringTask.OutputPixel(X, Y: Int32or64; AColorIndex: Int32or64;
+  AColor: TBGRAPixel);
+begin
+  UpdateCurrentLine(y);
+  PutPixels(FCurrentOutputScanline+x, @AColor, 1, FDrawMode, 255);
+end;
+
+procedure TDitheringTask.OutputPixelSet(X, Y: Int32or64;
+  AColorIndex: Int32or64; AColor: TBGRAPixel);
+begin
+  UpdateCurrentLine(y);
+  (FCurrentOutputScanline+x)^ := AColor;
+end;
+
+procedure TDitheringTask.OutputPixelSetExceptTransparent(X, Y: Int32or64;
+  AColorIndex: Int32or64; AColor: TBGRAPixel);
+begin
+  UpdateCurrentLine(y);
+  if AColor.alpha = 255 then (FCurrentOutputScanline+x)^ := AColor;
+end;
+
+procedure TDitheringTask.OutputPixelLinearBlend(X, Y: Int32or64;
+  AColorIndex: Int32or64; AColor: TBGRAPixel);
+begin
+  UpdateCurrentLine(y);
+  FastBlendPixelInline(FCurrentOutputScanline+x, AColor);
+end;
+
+procedure TDitheringTask.OutputPixelDraw(X, Y: Int32or64;
+  AColorIndex: Int32or64; AColor: TBGRAPixel);
+begin
+  UpdateCurrentLine(y);
+  DrawPixelInlineWithAlphaCheck(FCurrentOutputScanline+x, AColor);
+end;
+
+procedure TDitheringTask.OutputPixelXor(X, Y: Int32or64;
+  AColorIndex: Int32or64; AColor: TBGRAPixel);
+begin
+  UpdateCurrentLine(y);
+  PLongWord(FCurrentOutputScanline+x)^ := PLongWord(FCurrentOutputScanline+x)^ xor PLongWord(@AColor)^;
+end;
+
+procedure TDitheringTask.ApproximateColor(const AColor: TBGRAPixel;
+  out AApproxColor: TBGRAPixel; out AIndex: integer);
+begin
+  if FPalette <> nil then
+  begin
+    AIndex := FPalette.FindNearestColorIndex(AColor, FIgnoreAlpha);
+    if AIndex = -1 then
+      AApproxColor := BGRAPixelTransparent
+    else
+      AApproxColor := FPalette.Color[AIndex];
+  end else
+  begin
+    if AColor.alpha = 0 then
+    begin
+      AApproxColor := BGRAPixelTransparent;
+      AIndex := -1;
+    end else
+    begin
+      AApproxColor := AColor;
+      AIndex := 0;
+    end;
+  end;
+end;
+
+constructor TDitheringTask.Create(ASource: IBGRAScanner;
+  APalette: TBGRACustomApproxPalette; ADestination: TBGRACustomBitmap;
+  AIgnoreAlpha: boolean; ABounds: TRect);
+begin
+  FPalette := APalette;
+  SetSource(ASource);
+  FBounds := ABounds;
+  FIgnoreAlpha:= AIgnoreAlpha;
+  FCurrentOutputY := -1;
+  FCurrentOutputScanline:= nil;
+  Destination := ADestination;
+  FDrawMode:= dmSet;
+  UpdateOutputPixel;
+end;
+
+constructor TDitheringTask.Create(bmp: TBGRACustomBitmap;
+  APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean;
+  ABounds: TRect);
+begin
+  FPalette := APalette;
+  SetSource(bmp);
+  FBounds := ABounds;
+  FIgnoreAlpha:= AIgnoreAlpha;
+  FCurrentOutputY := -1;
+  FCurrentOutputScanline:= nil;
+  InPlace := AInPlace;
+  FDrawMode:= dmSet;
+  UpdateOutputPixel;
+end;
+
+constructor TDitheringTask.Create(bmp: TBGRACustomBitmap;
+  APalette: TBGRACustomApproxPalette; AInPlace: boolean; AIgnoreAlpha: boolean);
+begin
+  FPalette := APalette;
+  SetSource(bmp);
+  FBounds := rect(0,0,bmp.Width,bmp.Height);
+  FIgnoreAlpha:= AIgnoreAlpha;
+  FCurrentOutputY := -1;
+  FCurrentOutputScanline:= nil;
+  InPlace := AInPlace;
+  FDrawMode:= dmSet;
+  UpdateOutputPixel;
+end;
+
+{ TFloydSteinbergDitheringTask }
+
+procedure TFloydSteinbergDitheringTask.DoExecute;
+const
+  ErrorPrecisionShift = 4;
+  MaxColorDiffForDiffusion = 4096;
+type
+  TAccPixel = record
+    red,green,blue,alpha: Int32or64;
+  end;
+  TLine = array of TAccPixel;
+
+  procedure AddError(var dest: TAccPixel; const src: TAccPixel; factor: Int32or64); inline;
+  const maxError = 65536 shl ErrorPrecisionShift;
+    minError = -(65536 shl ErrorPrecisionShift);
+  begin
+    inc(dest.alpha, src.alpha * factor);
+    if dest.alpha > maxError then dest.alpha := maxError;
+    if dest.alpha < minError then dest.alpha := minError;
+    inc(dest.red, src.red * factor);
+    if dest.red > maxError then dest.red := maxError;
+    if dest.red < minError then dest.red := minError;
+    inc(dest.green, src.green * factor);
+    if dest.green > maxError then dest.green := maxError;
+    if dest.green < minError then dest.green := minError;
+    inc(dest.blue, src.blue * factor);
+    if dest.blue > maxError then dest.blue := maxError;
+    if dest.blue < minError then dest.blue := minError;
+  end;
+
+var
+  w,h: Int32or64;
+
+var
+  p,pNext: PExpandedPixel;
+  destX,destY: Int32or64;
+  orig,cur,approxExp: TExpandedPixel;
+  approx: TBGRAPixel;
+  approxIndex: integer;
+  curPix,diff: TAccPixel;
+  i: Int32or64;
+  yWrite: Int32or64;
+  tempLine, currentLine, nextLine: TLine;
+
+  nextScan,curScan: PExpandedPixel;
+
+  function ClampWordDiv(AValue: Int32or64): Word; inline;
+  begin
+    if AValue < 0 then AValue := -((-AValue) shr ErrorPrecisionShift) else AValue := AValue shr ErrorPrecisionShift;
+    if AValue < 0 then
+      result := 0
+    else if AValue > 65535 then
+      result := 65535
+    else
+      result := AValue;
+  end;
+
+  function Div16(AValue: Int32or64): Int32or64; inline;
+  begin
+    if AValue < 0 then
+      result := -((-AValue) shr 4)
+    else
+      result := AValue shr 4;
+  end;
+
+begin
+  w := FBounds.Right-FBounds.Left;
+  h := FBounds.Bottom-FBounds.Top;
+  if (w <= 0) or (h <= 0) then exit;
+  setlength(currentLine,w);
+  setlength(nextLine,w);
+  curScan := nil;
+  nextScan := RequestSourceExpandedScanLine(FBounds.Left, FBounds.Top, FBounds.Right-FBounds.Left);
+  for yWrite := 0 to h-1 do
+  begin
+    if GetShouldStop(yWrite) then break;
+    ReleaseSourceExpandedScanLine(curScan);
+    curScan := nextScan;
+    nextScan := nil;
+    p := curScan;
+    destX := FBounds.Left;
+    destY := yWrite+FBounds.Top;
+    if yWrite < h-1 then
+      nextScan := RequestSourceExpandedScanLine(FBounds.Left,yWrite+FBounds.Top+1, FBounds.Right-FBounds.Left);
+    pNext := nextScan;
+    if odd(yWrite) then
+    begin
+      inc(p, w);
+      inc(destX, w);
+      if pNext<>nil then inc(pNext, w);
+      for i := w-1 downto 0 do
+      begin
+        dec(p);
+        dec(destX);
+        if pNext<>nil then dec(pNext);
+        if p^.alpha <> 0 then
+        begin
+          orig := p^;
+          with currentLine[i] do
+          begin
+            curPix.alpha := alpha+Int32or64(orig.alpha shl ErrorPrecisionShift);
+            curPix.red := red+Int32or64(orig.red shl ErrorPrecisionShift);
+            curPix.green := green+Int32or64(orig.green shl ErrorPrecisionShift);
+            curPix.blue := blue+Int32or64(orig.blue shl ErrorPrecisionShift);
+            cur.alpha := ClampWordDiv(curPix.alpha);
+            cur.red := ClampWordDiv(curPix.red);
+            cur.green := ClampWordDiv(curPix.green);
+            cur.blue := ClampWordDiv(curPix.blue);
+          end;
+          ApproximateColor(GammaCompression(cur), approx, approxIndex);
+          approxExp := GammaExpansion(approx);
+          diff.alpha := Div16(curPix.alpha - (approxExp.alpha shl ErrorPrecisionShift));
+          if (approxExp.alpha = 0) or (cur.alpha = 0) then
+          begin
+            diff.red := 0;
+            diff.green := 0;
+            diff.blue := 0;
+          end else
+          begin
+            diff.red := Div16(curPix.red - (approxExp.red shl ErrorPrecisionShift));
+            diff.green := Div16(curPix.green - (approxExp.green shl ErrorPrecisionShift));
+            diff.blue := Div16(curPix.blue - (approxExp.blue shl ErrorPrecisionShift));
+          end;
+          if i > 0 then
+          begin
+            if AbsRGBADiff((p-1)^,orig) < MaxColorDiffForDiffusion then
+              AddError(currentLine[i-1], diff, 7);
+          end;
+          if nextLine <> nil then
+          begin
+            if i > 0 then
+            begin
+              if AbsRGBADiff((pNext-1)^,orig) < MaxColorDiffForDiffusion then
+                AddError(nextLine[i-1], diff, 1);
+            end;
+            if AbsRGBADiff(pNext^,orig) < MaxColorDiffForDiffusion then
+              AddError(nextLine[i], diff, 5);
+            if i < w-1 then
+            begin
+              if AbsRGBADiff((pNext+1)^,orig) < MaxColorDiffForDiffusion then
+                AddError(nextLine[i+1], diff, 3);
+            end;
+          end;
+          OnOutputPixel(destX,destY,approxIndex,approx);
+        end else
+        begin
+          ApproximateColor(BGRAPixelTransparent, approx, approxIndex);
+          OnOutputPixel(destX,destY,approxIndex,approx);
+        end;
+      end
+    end
+    else
+    for i := 0 to w-1 do
+    begin
+      if p^.alpha <> 0 then
+      begin
+        orig := p^;
+        with currentLine[i] do
+        begin
+          curPix.alpha := alpha+Int32or64(orig.alpha shl ErrorPrecisionShift);
+          curPix.red := red+Int32or64(orig.red shl ErrorPrecisionShift);
+          curPix.green := green+Int32or64(orig.green shl ErrorPrecisionShift);
+          curPix.blue := blue+Int32or64(orig.blue shl ErrorPrecisionShift);
+          cur.alpha := ClampWordDiv(curPix.alpha);
+          cur.red := ClampWordDiv(curPix.red);
+          cur.green := ClampWordDiv(curPix.green);
+          cur.blue := ClampWordDiv(curPix.blue);
+        end;
+        ApproximateColor(GammaCompression(cur), approx, approxIndex);
+        approxExp := GammaExpansion(approx);
+        diff.alpha := Div16(curPix.alpha - (approxExp.alpha shl ErrorPrecisionShift));
+        if (approxExp.alpha = 0) or (cur.alpha = 0) then
+        begin
+          diff.red := 0;
+          diff.green := 0;
+          diff.blue := 0;
+        end else
+        begin
+          diff.red := Div16(curPix.red - (approxExp.red shl ErrorPrecisionShift));
+          diff.green := Div16(curPix.green - (approxExp.green shl ErrorPrecisionShift));
+          diff.blue := Div16(curPix.blue - (approxExp.blue shl ErrorPrecisionShift));
+        end;
+        if i < w-1 then
+        begin
+          if AbsRGBADiff((p+1)^,orig) < MaxColorDiffForDiffusion then
+            AddError(currentLine[i+1], diff, 7);
+        end;
+        if pNext <> nil then
+        begin
+          if i > 0 then
+          begin
+            if AbsRGBADiff((pNext-1)^,orig) < MaxColorDiffForDiffusion then
+              AddError(nextLine[i-1], diff, 3);
+          end;
+          if AbsRGBADiff(pNext^,orig) < MaxColorDiffForDiffusion then
+            AddError(nextLine[i], diff, 5);
+          if i < w-1 then
+          begin
+            if AbsRGBADiff((pNext+1)^,orig) < MaxColorDiffForDiffusion then
+              AddError(nextLine[i+1], diff, 1);
+          end;
+        end;
+        OnOutputPixel(destX,destY,approxIndex,approx);
+      end else
+      begin
+        ApproximateColor(BGRAPixelTransparent, approx, approxIndex);
+        OnOutputPixel(destX,destY,approxIndex,approx);
+      end;
+      inc(p);
+      inc(destX);
+      if pNext<>nil then inc(pNext);
+    end;
+    tempLine := currentLine;
+    currentLine := nextLine;
+    nextLine := tempLine;
+    if yWrite = h-2 then
+      nextLine := nil
+      else fillchar(nextLine[0], sizeof(nextLine[0])*w, 0);
+  end;
+  ReleaseSourceExpandedScanLine(curScan);
+  ReleaseSourceExpandedScanLine(nextScan);
+  Destination.InvalidateBitmap;
+end;
+
+{ TNearestColorTask }
+
+procedure TNearestColorTask.DoExecute;
+var yb,xb: Int32or64;
+  curScan,psrc: PBGRAPixel;
+  colorIndex: LongInt;
+  colorValue: TBGRAPixel;
+begin
+  for yb := FBounds.Top to FBounds.Bottom - 1 do
+  begin
+    if GetShouldStop(yb) then break;
+    curScan := RequestSourceScanLine(FBounds.Left,yb,FBounds.Right-FBounds.Left);
+    psrc := curScan;
+    for xb := FBounds.Left to FBounds.Right-1 do
+    begin
+      ApproximateColor(psrc^, colorValue, colorIndex);
+      OnOutputPixel(xb,yb,colorIndex,colorValue);
+      inc(psrc);
+    end;
+    ReleaseSourceScanLine(curScan);
+  end;
+  Destination.InvalidateBitmap;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrafilters.pas

@@ -0,0 +1,962 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAFilters;
+
+{$mode objfpc}{$H+}
+
+interface
+
+{ Here are some filters that can be applied to a bitmap. The filters
+  take a source image as a parameter and gives a filtered image as
+  a result. }
+
+uses
+  BGRAClasses, BGRABitmapTypes, BGRAFilterType, BGRAFilterBlur;
+
+type
+  TFilterTask = BGRAFilterType.TFilterTask;
+
+/////////////////////// PIXELWISE FILTERS ////////////////////////////////
+type
+  { TGrayscaleTask }
+  { Grayscale converts colored pixel into grayscale with same luminosity }
+  TGrayscaleTask = class(TFilterTask)
+  private
+    FBounds: TRect;
+  public
+    constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect);
+  protected
+    procedure DoExecute; override;
+  end;
+
+{ Grayscale converts colored pixel into grayscale with same luminosity }
+function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap; overload;
+function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; overload;
+function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect): TFilterTask;
+
+{ Normalize use the whole available range of values, making dark colors darkest possible
+  and light colors lightest possible }
+function FilterNormalize(bmp: TBGRACustomBitmap;
+  eachChannel: boolean = True): TBGRACustomBitmap; overload;
+function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect;
+  eachChannel: boolean = True): TBGRACustomBitmap; overload;
+
+////////////////////// 3X3 FILTERS ////////////////////////////////////////////
+
+{ Sharpen filter add more contrast between pixels }
+function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer = 256): TBGRACustomBitmap; overload;
+function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap; overload;
+
+{ Compute a contour, as if the image was drawn with a 2 pixels-wide black pencil }
+function FilterContour(bmp: TBGRACustomBitmap; AGammaCorrection: boolean = false): TBGRACustomBitmap;
+
+{ Emboss filter compute a color difference in the angle direction }
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload;
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload;
+
+{ Emboss highlight computes a sort of emboss with 45 degrees angle and
+  with standard selection color (white/black and filled with blue) }
+function FilterEmbossHighlight(bmp: TBGRACustomBitmap;
+  FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap;
+function FilterEmbossHighlightOffset(bmp: TBGRACustomBitmap;
+  FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap;
+
+{ The median filter consist in calculating the median value of pixels. Here
+  a square of 9x9 pixel is considered. The median allow to select the most
+  representative colors. The option parameter allow to choose to smooth the
+  result or not. }
+function FilterMedian(bmp: TBGRACustomBitmap; Option: TMedianOption): TBGRACustomBitmap;
+
+//////////////////////// DEFORMATION FILTERS /////////////////////////////////
+
+{ Distort the image as if it were on a sphere }
+function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+
+{ Twirl distortion, i.e. a progressive rotation }
+function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload;
+function FilterTwirl(bmp: TBGRACustomBitmap; ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload;
+
+{ Distort the image as if it were on a vertical cylinder }
+function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+
+{ Compute a plane projection towards infinity (SLOW) }
+function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+
+{ Rotate filter rotate the image and clip it in the bounding rectangle }
+function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF;
+  angle: single; correctBlur: boolean = false): TBGRACustomBitmap;
+
+///////////////////////// BLUR FILTERS //////////////////////////////////////
+
+{ A radial blur applies a blur with a circular influence, i.e, each pixel
+  is merged with pixels within the specified radius. There is an exception
+  with rbFast blur, the optimization entails a hyperbolic shape. }
+type TRadialBlurTask = BGRAFilterBlur.TRadialBlurTask;
+function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload;
+function FilterBlurRadial(bmp: TBGRACustomBitmap; radiusX: single; radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload;
+function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single; ABlurType: TRadialBlurType): TRadialBlurTask; overload;
+function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; ABlurType: TRadialBlurType): TRadialBlurTask; overload;
+
+{ The precise blur allow to specify the blur radius with subpixel accuracy }
+function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single): TBGRACustomBitmap; deprecated 'Use FilterBlurRadial with blurType:=rbPrecise and radius multiplied by 10';
+function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TRadialBlurTask; deprecated 'Use CreateRadialBlurTask with blurType:=rbPrecise and radius multiplied by 10';
+
+{ Motion blur merge pixels in a direction. The oriented parameter specifies
+  if the weights of the pixels are the same along the line or not. }
+type TMotionBlurTask = BGRAFilterBlur.TMotionBlurTask;
+function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap;
+function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ADistance,AAngle: single; AOriented: boolean): TMotionBlurTask;
+
+{ General purpose blur filter, with a blur mask as parameter to describe
+  how pixels influence each other }
+function FilterBlur(bmp: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false): TBGRACustomBitmap;
+function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false): TFilterTask;
+
+////////////////////////////// OTHER FILTERS /////////////////////////////////
+
+{ SmartZoom x3 is a filter that upsizes 3 times the picture and add
+  pixels that could be logically expected (horizontal, vertical, diagonal lines) }
+function FilterSmartZoom3(bmp: TBGRACustomBitmap;
+  Option: TMedianOption): TBGRACustomBitmap;
+
+function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap;
+
+implementation
+
+uses Math, BGRATransform, SysUtils, BGRAFilterScanner;
+
+/////////////////////// PIXELWISE FILTERS ////////////////////////////////
+
+{ TGrayscaleTask }
+
+constructor TGrayscaleTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect);
+begin
+  SetSource(bmp);
+  FBounds := ABounds;
+end;
+
+procedure TGrayscaleTask.DoExecute;
+var
+  yb: LongInt;
+begin
+  if FBounds.IsEmpty then exit;
+  for yb := FBounds.Top to FBounds.bottom - 1 do
+  begin
+    if GetShouldStop(yb) then break;
+    TBGRAFilterScannerGrayscale.ComputeFilterAt(FSource.scanline[yb] + FBounds.left,
+            Destination.scanline[yb] + FBounds.left, FBounds.right-FBounds.left, true);
+  end;
+  Destination.InvalidateBitmap;
+end;
+
+{ Filter grayscale applies BGRAToGrayscale function to all pixels }
+function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+begin
+  result := FilterGrayscale(bmp,rect(0,0,bmp.width,bmp.Height));
+end;
+
+function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap;
+var scanner: TBGRAFilterScannerGrayscale;
+begin
+  result := bmp.NewBitmap(bmp.Width,bmp.Height);
+  scanner := TBGRAFilterScannerGrayscale.Create(bmp,Point(0,0),True);
+  result.FillRect(ABounds,scanner,dmSet);
+  scanner.Free;
+end;
+
+function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect): TFilterTask;
+begin
+  result := TGrayscaleTask.Create(bmp,ABounds);
+end;
+
+function FilterNormalize(bmp: TBGRACustomBitmap; eachChannel: boolean
+  ): TBGRACustomBitmap;
+begin
+  result := FilterNormalize(bmp, rect(0,0,bmp.Width,bmp.Height), eachChannel);
+end;
+
+{ Normalize compute min-max of specified channel and apply an affine transformation
+  to make it use the full range of values }
+function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect;
+  eachChannel: boolean = True): TBGRACustomBitmap;
+var scanner: TBGRAFilterScannerNormalize;
+  remain: TRect;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  remain := TRect.Intersect(ABounds, rect(0,0,bmp.Width,bmp.Height));
+  if remain.IsEmpty then exit;
+  scanner := TBGRAFilterScannerNormalize.Create(bmp,Point(0,0),remain,eachChannel);
+  result.FillRect(remain,scanner,dmSet);
+  scanner.Free;
+end;
+
+////////////////////// 3X3 FILTERS ////////////////////////////////////////////
+
+{ This filter compute for each pixel the mean of the eight surrounding pixels,
+  then the difference between this average pixel and the pixel at the center
+  of the square. Finally the difference is added to the new pixel, exagerating
+  its difference with its neighbours. }
+function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap;
+var scanner: TBGRAFilterScanner;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  if ABounds.IsEmpty then exit;
+  scanner := TBGRASharpenScanner.Create(bmp,ABounds,AAmount);
+  result.FillRect(ABounds,scanner,dmSet);
+  scanner.Free;
+end;
+
+function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer
+  ): TBGRACustomBitmap;
+begin
+  result := FilterSharpen(bmp,rect(0,0,bmp.Width,bmp.Height),AAmount);
+end;
+
+{ Filter contour computes for each pixel
+  the grayscale difference with surrounding pixels (in intensity and alpha)
+  and draw black pixels when there is a difference }
+function FilterContour(bmp: TBGRACustomBitmap; AGammaCorrection: boolean = false): TBGRACustomBitmap;
+var scanner: TBGRAContourScanner;
+begin
+  result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  scanner := TBGRAContourScanner.Create(bmp,rect(0,0,bmp.width,bmp.height),AGammaCorrection);
+  result.Fill(scanner);
+  scanner.Free;
+end;
+
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap;
+begin
+  result := FilterEmboss(bmp, angle, rect(0,0,bmp.Width,bmp.Height), AStrength, AOptions);
+end;
+
+{ Emboss filter computes the difference between each pixel and the surrounding pixels
+  in the specified direction. }
+function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect; AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap;
+var
+  yb, xb: Int32or64;
+  dx, dy: single;
+  idx, idy: Int32or64;
+  x256,y256: Int32or64;
+  cMiddle: TBGRAPixel;
+  hMiddle: THSLAPixel;
+
+  tempPixel, refPixel: TBGRAPixel;
+  pdest: PBGRAPixel;
+
+  bounds: TRect;
+  psrc: PBGRAPixel;
+  redDiff,greenDiff,blueDiff: UInt32or64;
+  diff: Int32or64;
+begin
+  //compute pixel position and weight
+  dx   := cos(angle * Pi / 180);
+  dy   := sin(angle * Pi / 180);
+  idx := floor(dx);
+  idy := floor(dy);
+  x256 := trunc((dx-idx)*256);
+  y256 := trunc((dy-idy)*256);
+
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  if ABounds.IsEmpty then exit;
+
+  bounds := bmp.GetImageBounds;
+  bounds.Intersect(ABounds);
+  if bounds.IsEmpty then exit;
+  bounds.Left   := max(0, bounds.Left - 1);
+  bounds.Top    := max(0, bounds.Top - 1);
+  bounds.Right  := min(bmp.Width, bounds.Right + 1);
+  bounds.Bottom := min(bmp.Height, bounds.Bottom + 1);
+
+  if not (eoTransparent in AOptions) then
+  begin
+    if eoPreserveHue in AOptions then
+      Result.PutImagePart(ABounds.left,ABounds.top,bmp,ABounds,dmSet)
+    else
+      Result.FillRect(ABounds,BGRA(128, 128, 128, 255),dmSet);
+  end;
+
+  //loop through destination
+  for yb := bounds.Top to bounds.bottom - 1 do
+  begin
+    pdest := Result.scanline[yb] + bounds.Left;
+    psrc := bmp.ScanLine[yb]+bounds.Left;
+
+    for xb := bounds.Left+idx to bounds.Right-1+idx do
+    begin
+      refPixel := bmp.GetPixel256(xb,yb+idy,x256,y256);
+      cMiddle := psrc^;
+      inc(psrc);
+
+      if eoPreserveHue in AOptions then
+      begin
+        diff := (integer(refPixel.red * refPixel.alpha) - integer(cMiddle.red * cMiddle.alpha)+
+                 integer(refPixel.green * refPixel.alpha) - integer(cMiddle.green * cMiddle.alpha)+
+                 integer(refPixel.blue * refPixel.alpha) - integer(cMiddle.blue * cMiddle.alpha))* AStrength div 128;
+        if diff > 0 then
+          hMiddle := BGRAToHSLA(refPixel)
+        else
+          hMiddle := BGRAToHSLA(cMiddle);
+        hMiddle.lightness := min(65535,max(0,hMiddle.lightness+diff));
+        if eoTransparent in AOptions then
+          hMiddle.alpha := min(65535,abs(diff));
+        pdest^ := HSLAToBGRA(hMiddle);
+      end else
+      begin
+        {$push}{$hints off}{$r-}
+        redDiff := UInt32or64(max(0, 65536 + (refPixel.red * refPixel.alpha - cMiddle.red * cMiddle.alpha) * AStrength div 64)) shr 9;
+        greenDiff := UInt32or64(max(0, 65536 + (refPixel.green * refPixel.alpha - cMiddle.green * cMiddle.alpha) * AStrength div 64)) shr 9;
+        blueDiff := UInt32or64(max(0, 65536 + (refPixel.blue * refPixel.alpha - cMiddle.blue * cMiddle.alpha) * AStrength div 64)) shr 9;
+        {$pop}
+        if (redDiff <> 128) or (greenDiff <> 128) or (blueDiff <> 128) then
+        begin
+          tempPixel.red := min(255, redDiff);
+          tempPixel.green := min(255, greenDiff);
+          tempPixel.blue := min(255, blueDiff);
+          if eoTransparent in AOptions then
+          begin
+            tempPixel.alpha := min(255,abs(Int32or64(redDiff-128))+abs(Int32or64(greenDiff-128))+abs(Int32or64(blueDiff-128)));
+            pdest^ := tempPixel;
+          end else
+          begin
+            tempPixel.alpha := 255;
+            pdest^ := tempPixel;
+          end;
+        end;
+      end;
+
+      Inc(pdest);
+    end;
+  end;
+  Result.InvalidateBitmap;
+end;
+
+{ Like general emboss, but with fixed direction and automatic color with transparency }
+function FilterEmbossHighlight(bmp: TBGRACustomBitmap;
+  FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap;
+var
+  bounds: TRect;
+  borderColorOverride: boolean;
+  borderColorLevel: Int32or64;
+  scan: TBGRAEmbossHightlightScanner;
+begin
+  borderColorOverride := DefineBorderColor.alpha <> 0;
+  borderColorLevel := DefineBorderColor.red;
+
+  Result    := bmp.NewBitmap(bmp.Width, bmp.Height);
+
+  if borderColorOverride then
+    bounds := bmp.GetImageBounds(cRed, borderColorLevel)
+  else
+    bounds := bmp.GetImageBounds(cRed);
+  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
+    exit;
+  bounds.Left   := max(0, bounds.Left - 1);
+  bounds.Top    := max(0, bounds.Top - 1);
+  bounds.Right  := min(bmp.Width, bounds.Right + 1);
+  bounds.Bottom := min(bmp.Height, bounds.Bottom + 1);
+
+  scan := TBGRAEmbossHightlightScanner.Create(bmp, bounds, borderColorOverride);
+  scan.AllowDirectRead := true;
+  scan.FillSelection := FillSelection;
+  if borderColorOverride then scan.SourceBorderColor := DefineBorderColor;
+  Result.FillRect(bounds, scan, dmSet);
+  scan.Free;
+end;
+
+function FilterEmbossHighlightOffset(bmp: TBGRACustomBitmap;
+  FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap;
+var
+  bounds: TRect;
+  borderColorOverride: boolean;
+  borderColorLevel: int32or64;
+  scan: TBGRAEmbossHightlightScanner;
+begin
+  borderColorOverride := DefineBorderColor.alpha <> 0;
+  borderColorLevel := DefineBorderColor.red;
+
+  if borderColorOverride then
+    bounds := bmp.GetImageBounds(cRed, borderColorLevel)
+  else
+    bounds := bmp.GetImageBounds(cRed);
+  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
+  begin
+    Result    := bmp.NewBitmap(0, 0);
+    exit;
+  end;
+  bounds.Left   := max(0, bounds.Left - 1);
+  bounds.Top    := max(0, bounds.Top - 1);
+  bounds.Right  := min(bmp.Width, bounds.Right + 1);
+  bounds.Bottom := min(bmp.Height, bounds.Bottom + 1);
+
+  Result    := bmp.NewBitmap(bounds.Right-Bounds.Left+1, bounds.Bottom-Bounds.Top+1);
+  inc(Offset.X, bounds.Left);
+  inc(Offset.Y, bounds.Top);
+
+  scan := TBGRAEmbossHightlightScanner.Create(bmp, bounds, borderColorOverride);
+  scan.AllowDirectRead := true;
+  scan.FillSelection := FillSelection;
+  if borderColorOverride then scan.SourceBorderColor := DefineBorderColor;
+  Result.FillRect(rect(0,0,result.Width,result.Height), scan, dmSet, Offset);
+  scan.Free;
+end;
+
+{ For each component, sort values to get the median }
+function FilterMedian(bmp: TBGRACustomBitmap;
+  Option: TMedianOption): TBGRACustomBitmap;
+
+  function ComparePixLt(p1, p2: TBGRAPixel): boolean;
+  begin
+    if (p1.red + p1.green + p1.blue = p2.red + p2.green + p2.blue) then
+      Result := (int32or64(p1.red) shl 8) + (int32or64(p1.green) shl 16) +
+        int32or64(p1.blue) < (int32or64(p2.red) shl 8) + (int32or64(p2.green) shl 16) +
+        int32or64(p2.blue)
+    else
+      Result := (p1.red + p1.green + p1.blue) < (p2.red + p2.green + p2.blue);
+  end;
+
+const
+  nbpix = 9;
+var
+  yb, xb:    int32or64;
+  dx, dy, n, i, j, k: int32or64;
+  a_pixels:  array[0..nbpix - 1] of TBGRAPixel;
+  tempPixel, refPixel: TBGRAPixel;
+  tempValue: byte;
+  sumR, sumG, sumB, sumA, BGRAdiv, nbA: uint32or64;
+  tempAlpha: word;
+  bounds:    TRect;
+  pdest:     PBGRAPixel;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+
+  bounds := bmp.GetImageBounds;
+  if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
+    exit;
+  bounds.Left   := max(0, bounds.Left - 1);
+  bounds.Top    := max(0, bounds.Top - 1);
+  bounds.Right  := min(bmp.Width, bounds.Right + 1);
+  bounds.Bottom := min(bmp.Height, bounds.Bottom + 1);
+
+  for yb := bounds.Top to bounds.bottom - 1 do
+  begin
+    pdest := Result.scanline[yb] + bounds.left;
+    for xb := bounds.left to bounds.right - 1 do
+    begin
+      n := 0;
+      for dy := -1 to 1 do
+        for dx := -1 to 1 do
+        begin
+          a_pixels[n] := bmp.GetPixel(xb + dx, yb + dy);
+          if a_pixels[n].alpha = 0 then
+            a_pixels[n] := BGRAPixelTransparent;
+          Inc(n);
+        end;
+      for i := 1 to n - 1 do
+      begin
+        j := i;
+        while (j > 1) and (a_pixels[j].alpha < a_pixels[j - 1].alpha) do
+        begin
+          tempValue := a_pixels[j].alpha;
+          a_pixels[j].alpha := a_pixels[j - 1].alpha;
+          a_pixels[j - 1].alpha := tempValue;
+          Dec(j);
+        end;
+        j := i;
+        while (j > 1) and (a_pixels[j].red < a_pixels[j - 1].red) do
+        begin
+          tempValue := a_pixels[j].red;
+          a_pixels[j].red := a_pixels[j - 1].red;
+          a_pixels[j - 1].red := tempValue;
+          Dec(j);
+        end;
+        j := i;
+        while (j > 1) and (a_pixels[j].green < a_pixels[j - 1].green) do
+        begin
+          tempValue := a_pixels[j].green;
+          a_pixels[j].green := a_pixels[j - 1].green;
+          a_pixels[j - 1].green := tempValue;
+          Dec(j);
+        end;
+        j := i;
+        while (j > 1) and (a_pixels[j].blue < a_pixels[j - 1].blue) do
+        begin
+          tempValue := a_pixels[j].blue;
+          a_pixels[j].blue := a_pixels[j - 1].blue;
+          a_pixels[j - 1].blue := tempValue;
+          Dec(j);
+        end;
+      end;
+
+      refPixel := a_pixels[n div 2];
+
+      if option in [moLowSmooth, moMediumSmooth, moHighSmooth] then
+      begin
+        sumR    := 0;
+        sumG    := 0;
+        sumB    := 0;
+        sumA    := 0;
+        BGRAdiv := 0;
+        nbA     := 0;
+
+        case option of
+          moHighSmooth, moMediumSmooth:
+          begin
+            j := 2;
+            k := 2;
+          end;
+          else
+          begin
+            j := 1;
+            k := 1;
+          end;
+        end;
+
+         {$hints off}
+        for i := -k to j do
+        begin
+          tempPixel := a_pixels[n div 2 + i];
+          tempAlpha := tempPixel.alpha;
+          if (option = moMediumSmooth) and ((i = -k) or (i = j)) then
+            tempAlpha := tempAlpha div 2;
+
+          inc(sumR, tempPixel.red * tempAlpha );
+          inc(sumG, tempPixel.green * tempAlpha );
+          inc(sumB, tempPixel.blue * tempAlpha );
+          inc(BGRAdiv, tempAlpha);
+
+          inc(sumA, tempAlpha);
+          Inc(nbA);
+        end;
+         {$hints on}
+        if option = moMediumSmooth then
+          Dec(nbA);
+
+        if (BGRAdiv = 0) then
+          refPixel := BGRAPixelTransparent
+        else
+        begin
+          refPixel.red   := round(sumR / BGRAdiv);
+          refPixel.green := round(sumG / BGRAdiv);
+          refPixel.blue  := round(sumB / BGRAdiv);
+          refPixel.alpha := round(sumA / nbA);
+        end;
+      end;
+
+      pdest^ := refPixel;
+      Inc(pdest);
+    end;
+  end;
+end;
+
+//////////////////////// DEFORMATION FILTERS /////////////////////////////////
+
+{ Compute the distance for each pixel to the center of the bitmap,
+  calculate the corresponding angle with arcsin, use this angle
+  to determine a distance from the center in the source bitmap }
+function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+var
+  cx, cy: single;
+  scanner: TBGRASphereDeformationScanner;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  cx     := bmp.Width / 2 - 0.5;
+  cy     := bmp.Height / 2 - 0.5;
+  scanner := TBGRASphereDeformationScanner.Create(bmp,PointF(cx,cy),bmp.Width/2,bmp.Height/2);
+  result.FillEllipseAntialias(cx,cy,bmp.Width/2-0.5,bmp.Height/2-0.5,scanner);
+  scanner.Free;
+end;
+
+{ Applies twirl scanner. See TBGRATwirlScanner }
+function FilterTwirl(bmp: TBGRACustomBitmap; ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;
+var twirl: TBGRATwirlScanner;
+begin
+  twirl := TBGRATwirlScanner.Create(bmp,ACenter,ARadius,ATurn,AExponent);
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  result.FillRect(ABounds, twirl, dmSet);
+  twirl.free;
+end;
+
+function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint;
+  ARadius: Single; ATurn: Single; AExponent: Single): TBGRACustomBitmap;
+begin
+  result := FilterTwirl(bmp,rect(0,0,bmp.Width,bmp.Height),ACenter,ARadius,ATurn,AExponent);
+end;
+
+{ Compute the distance for each pixel to the vertical axis of the bitmap,
+  calculate the corresponding angle with arcsin, use this angle
+  to determine a distance from the vertical axis in the source bitmap }
+function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+var
+  cx: single;
+  scanner: TBGRAVerticalCylinderDeformationScanner;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  cx     := bmp.Width / 2 - 0.5;
+  scanner := TBGRAVerticalCylinderDeformationScanner.Create(bmp,cx,bmp.Width/2);
+  result.Fill(scanner);
+  scanner.Free;
+end;
+
+function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
+const resampleGap=0.6;
+var
+  cy, x1, x2, y1, y2, z1, z2, h: single;
+  yb: int32or64;
+  resampledBmp: TBGRACustomBitmap;
+  resampledBmpWidth: int32or64;
+  resampledFactor,newResampleFactor: single;
+  sub,resampledSub: TBGRACustomBitmap;
+  partRect: TRect;
+  resampleSizeY : int32or64;
+begin
+  resampledBmp := bmp.Resample(bmp.Width*2,bmp.Height*2,rmSimpleStretch);
+  resampledBmpWidth := resampledBmp.Width;
+  resampledFactor := 2;
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height*2);
+  cy     := result.Height / 2 - 0.5;
+  h      := 1;
+  for yb := 0 to ((Result.Height-1) div 2) do
+  begin
+    y1 := (cy - (yb-0.5)) / (cy+0.5);
+    y2 := (cy - (yb+0.5)) / (cy+0.5);
+    if y2 <= 0 then continue;
+    z1 := h/y1;
+    z2 := h/y2;
+    newResampleFactor := 1/(z2-z1)*1.5;
+
+    x1 := (z1+1)/2;
+    x2 := (z2+1)/2;
+    if newResampleFactor <= resampledFactor*resampleGap then
+    begin
+      resampledFactor := newResampleFactor;
+      if resampledBmp <> bmp then resampledBmp.Free;
+      if (x2-x1 >= 1) then resampleSizeY := 1 else
+        resampleSizeY := round(1+((x2-x1)-1)/(1/bmp.Height-1)*(bmp.Height-1));
+      resampledBmp := bmp.Resample(max(1,round(bmp.Width*resampledFactor)),resampleSizeY,rmSimpleStretch);
+      resampledBmpWidth := resampledBmp.Width;
+    end;
+
+    partRect := Rect(round(-resampledBmpWidth/2*z1+resampledBmpWidth/2),floor(x1*resampledBmp.Height),
+       round(resampledBmpWidth/2*z1+resampledBmpWidth/2),floor(x2*resampledBmp.Height)+1);
+    if x2-x1 > 1 then
+    begin
+      partRect.Top := 0;
+      partRect.Bottom := 1;
+    end;
+    sub := resampledBmp.GetPart(partRect);
+    if sub <> nil then
+    begin
+      resampledSub := sub.Resample(bmp.Width,1,rmFineResample);
+      result.PutImage(0,yb,resampledSub,dmSet);
+      result.PutImage(0,Result.Height-1-yb,resampledSub,dmSet);
+      resampledSub.free;
+      sub.free;
+    end;
+  end;
+  if resampledBmp <> bmp then resampledBmp.Free;
+
+  if result.Height <> bmp.Height then
+  begin
+    resampledBmp := result.Resample(bmp.Width,bmp.Height,rmSimpleStretch);
+    result.free;
+    result := resampledBmp;
+  end;
+end;
+
+{ Rotates the image. To do this, loop through the destination and
+  calculates the position in the source bitmap with an affine transformation }
+function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF;
+  angle: single; correctBlur: boolean): TBGRACustomBitmap;
+begin
+  Result := bmp.NewBitmap(bmp.Width, bmp.Height);
+  Result.PutImageAngle(0,0,bmp,angle,origin.x,origin.y,255,true,correctBlur);
+end;
+
+///////////////////////// BLUR FILTERS //////////////////////////////////////
+
+function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap;
+var task: TFilterTask;
+begin
+  task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radius,blurType);
+  result := task.Execute;
+  task.Free;
+end;
+
+function FilterBlurRadial(bmp: TBGRACustomBitmap; radiusX: single; radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap;
+var task: TFilterTask;
+begin
+  task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radiusX,radiusY,blurType);
+  result := task.Execute;
+  task.Free;
+end;
+
+function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single; ABlurType: TRadialBlurType): TRadialBlurTask;
+begin
+  result := TRadialBlurTask.Create(ABmp,ABounds,ARadius,ABlurType);
+end;
+
+function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
+  ARadiusX,ARadiusY: single; ABlurType: TRadialBlurType): TRadialBlurTask;
+begin
+  result := TRadialBlurTask.Create(ABmp,ABounds,ARadiusX,ARadiusY,ABlurType);
+end;
+
+{ Precise blur }
+
+function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single): TBGRACustomBitmap;
+var task: TRadialBlurTask;
+begin
+  task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radius*10,rbPrecise);
+  result := task.Execute;
+  task.Free;
+end;
+
+function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TRadialBlurTask;
+begin
+  result := TRadialBlurTask.Create(ABmp,ABounds,ARadius*10,rbPrecise);
+end;
+
+function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap;
+var task: TFilterTask;
+begin
+  task := CreateMotionBlurTask(bmp, rect(0,0,bmp.Width,bmp.Height), distance, angle, oriented);
+  result := task.Execute;
+  task.Free;
+end;
+
+function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
+  ADistance, AAngle: single; AOriented: boolean): TMotionBlurTask;
+begin
+  result := TMotionBlurTask.Create(ABmp,ABounds,ADistance,AAngle,AOriented);
+end;
+
+function FilterBlur(bmp: TBGRACustomBitmap; AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false): TBGRACustomBitmap;
+var task: TFilterTask;
+begin
+  task := TCustomBlurTask.Create(bmp,rect(0,0,bmp.Width,bmp.Height), AMask, AMaskIsThreadSafe);
+  result := task.Execute;
+  task.Free;
+end;
+
+function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
+  AMask: TCustomUniversalBitmap; AMaskIsThreadSafe: boolean = false): TFilterTask;
+begin
+  result := TCustomBlurTask.Create(ABmp, ABounds, AMask, AMaskIsThreadSafe);
+end;
+
+///////////////////////////////////// OTHER FILTERS ///////////////////////////
+
+function FilterSmartZoom3(bmp: TBGRACustomBitmap;
+  Option: TMedianOption): TBGRACustomBitmap;
+type
+  TSmartDiff = record
+    d, cd, sd, b, a: single;
+  end;
+
+var
+  xb, yb: Int32or64;
+  diag1, diag2, h1, h2, v1, v2: TSmartDiff;
+  c,c1,c2:      TBGRAPixel;
+  temp, median: TBGRACustomBitmap;
+
+  function ColorDiff(c1, c2: TBGRAPixel): single;
+  var
+    max1, max2: Int32or64;
+  begin
+    if (c1.alpha = 0) and (c2.alpha = 0) then
+    begin
+      Result := 0;
+      exit;
+    end
+    else
+    if (c1.alpha = 0) or (c2.alpha = 0) then
+    begin
+      Result := 1;
+      exit;
+    end;
+    max1 := c1.red;
+    if c1.green > max1 then
+      max1 := c1.green;
+    if c1.blue > max1 then
+      max1 := c1.blue;
+
+    max2 := c2.red;
+    if c2.green > max2 then
+      max2 := c2.green;
+    if c2.blue > max2 then
+      max2 := c2.blue;
+
+    if (max1 = 0) or (max2 = 0) then
+    begin
+      Result := 0;
+      exit;
+    end;
+    Result := (abs(c1.red / max1 - c2.red / max2) +
+      abs(c1.green / max1 - c2.green / max2) + abs(c1.blue / max1 - c2.blue / max2)) / 3;
+  end;
+
+  function RGBDiff(c1, c2: TBGRAPixel): single;
+  begin
+    if (c1.alpha = 0) and (c2.alpha = 0) then
+    begin
+      Result := 0;
+      exit;
+    end
+    else
+    if (c1.alpha = 0) or (c2.alpha = 0) then
+    begin
+      Result := 1;
+      exit;
+    end;
+    Result := (abs(c1.red - c2.red) + abs(c1.green - c2.green) +
+      abs(c1.blue - c2.blue)) / 3 / 255;
+  end;
+
+  function smartDiff(x1, y1, x2, y2: Int32or64): TSmartDiff;
+  var
+    c1, c2, c1m, c2m: TBGRAPixel;
+  begin
+    c1  := bmp.GetPixel(x1, y1);
+    c2  := bmp.GetPixel(x2, y2);
+    c1m := median.GetPixel(x1, y1);
+    c2m := median.GetPixel(x2, y2);
+    Result.d := RGBDiff(c1, c2);
+    Result.cd := ColorDiff(c1, c2);
+    Result.a := c1.alpha / 255 * c2.alpha / 255;
+    Result.d := Result.d * Result.a + (1 - Result.a) *
+      (1 + abs(c1.alpha - c2.alpha) / 255) / 5;
+    Result.b := RGBDiff(c1, c1m) * c1.alpha / 255 * c1m.alpha / 255 +
+      RGBDiff(c2, c2m) * c2.alpha / 255 * c2m.alpha / 255 +
+      (abs(c1.alpha - c1m.alpha) + abs(c2.alpha - c2m.alpha)) / 255 / 4;
+    Result.sd := Result.d + Result.cd * 3;
+  end;
+
+var
+  diff: single;
+
+begin
+  median := FilterMedian(bmp, moNone);
+
+  temp   := bmp.Resample(bmp.Width * 3, bmp.Height * 3, rmSimpleStretch);
+  Result := FilterMedian(temp, Option);
+  temp.Free;
+
+  for yb := 0 to bmp.Height - 2 do
+    for xb := 0 to bmp.Width - 2 do
+    begin
+      diag1 := smartDiff(xb, yb, xb + 1, yb + 1);
+      diag2 := smartDiff(xb, yb + 1, xb + 1, yb);
+
+      h1 := smartDiff(xb, yb, xb + 1, yb);
+      h2 := smartDiff(xb, yb + 1, xb + 1, yb + 1);
+      v1 := smartDiff(xb, yb, xb, yb + 1);
+      v2 := smartDiff(xb + 1, yb, xb + 1, yb + 1);
+
+      diff := diag1.sd - diag2.sd;
+      if abs(diff) < 3 then
+        DecF(diff, (diag1.b - diag2.b) * (3 - abs(diff)) / 2);
+      //which diagonal to highlight?
+      if abs(diff) < 0.2 then
+        diff := 0;
+
+      if diff < 0 then
+      begin
+        //same color?
+        if diag1.cd < 0.3 then
+        begin
+          c1 := bmp.GetPixel(xb, yb);
+          c2 := bmp.GetPixel(xb + 1, yb + 1);
+          c := MergeBGRA(c1, c2);
+          //restore
+          Result.SetPixel(xb * 3 + 2, yb * 3 + 2, bmp.GetPixel(xb, yb));
+          Result.SetPixel(xb * 3 + 3, yb * 3 + 3, bmp.GetPixel(xb + 1, yb + 1));
+
+          if (diag1.sd < h1.sd) and (diag1.sd < v2.sd) then
+            Result.SetPixel(xb * 3 + 3, yb * 3 + 2, c);
+          if (diag1.sd < h2.sd) and (diag1.sd < v1.sd) then
+            Result.SetPixel(xb * 3 + 2, yb * 3 + 3, c);
+        end;
+      end
+      else
+      if diff > 0 then
+      begin
+        //same color?
+        if diag2.cd < 0.3 then
+        begin
+          c1 := bmp.GetPixel(xb, yb + 1);
+          c2 := bmp.GetPixel(xb + 1, yb);
+          c := MergeBGRA(c1, c2);
+          //restore
+          Result.SetPixel(xb * 3 + 3, yb * 3 + 2, bmp.GetPixel(xb + 1, yb));
+          Result.SetPixel(xb * 3 + 2, yb * 3 + 3, bmp.GetPixel(xb, yb + 1));
+
+          if (diag2.sd < h1.sd) and (diag2.sd < v1.sd) then
+            Result.SetPixel(xb * 3 + 2, yb * 3 + 2, c);
+          if (diag2.sd < h2.sd) and (diag2.sd < v2.sd) then
+            Result.SetPixel(xb * 3 + 3, yb * 3 + 3, c);
+
+        end;
+      end;
+    end;
+
+  median.Free;
+end;
+
+function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer;
+  useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap;
+var yb,xb, xs,ys, tx,ty: Int32or64;
+    psrc,pdest: PBGRAPixel;
+    temp,stretched: TBGRACustomBitmap;
+    oldfilter: TResampleFilter;
+begin
+  if pixelSize < 1 then
+  begin
+    result := bmp.Duplicate;
+    exit;
+  end;
+  result := bmp.NewBitmap(bmp.Width,bmp.Height);
+
+  tx := (bmp.Width+pixelSize-1) div pixelSize;
+  ty := (bmp.Height+pixelSize-1) div pixelSize;
+  if not useResample then
+  begin
+    temp := bmp.NewBitmap(tx,ty);
+
+    xs := (bmp.Width mod pixelSize) div 2;
+    ys := (bmp.Height mod pixelSize) div 2;
+
+    for yb := 0 to temp.height-1 do
+    begin
+      pdest := temp.ScanLine[yb];
+      psrc := bmp.scanline[ys]+xs;
+      inc(ys,pixelSize);
+      for xb := temp.width-1 downto 0 do
+      begin
+        pdest^ := psrc^;
+        inc(pdest);
+        inc(psrc,pixelSize);
+      end;
+    end;
+    temp.InvalidateBitmap;
+  end else
+  begin
+    oldfilter := bmp.ResampleFilter;
+    bmp.ResampleFilter := filter;
+    temp := bmp.Resample(tx,ty,rmFineResample);
+    bmp.ResampleFilter := oldfilter;
+  end;
+  stretched := temp.Resample(temp.Width*pixelSize,temp.Height*pixelSize,rmSimpleStretch);
+  temp.free;
+  if bmp.Width mod pixelSize = 0 then
+    xs := 0
+  else
+    xs := (-pixelSize+(bmp.Width mod pixelSize)) div 2;
+  if bmp.Height mod pixelSize = 0 then
+    ys := 0
+  else
+    ys := (-pixelSize+(bmp.Height mod pixelSize)) div 2;
+  result.PutImage(xs,ys,stretched,dmSet);
+  stretched.Free;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrafilterscanner.pas

@@ -0,0 +1,788 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAFilterScanner;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, BGRABitmapTypes, BGRAFilterType;
+
+type
+  { TBGRAFilterScannerGrayscale }
+  { Grayscale converts colored pixel into grayscale with same luminosity }
+  TBGRAFilterScannerGrayscale = class(TBGRAFilterScannerPixelwise)
+    class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel;
+      ACount: integer; AGammaCorrection: boolean); override;
+  end;
+
+  { TBGRAFilterScannerNegative }
+
+  TBGRAFilterScannerNegative = class(TBGRAFilterScannerPixelwise)
+    class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel;
+      ACount: integer; AGammaCorrection: boolean); override;
+  end;
+
+  { TBGRAFilterScannerSwapRedBlue }
+
+  TBGRAFilterScannerSwapRedBlue = class(TBGRAFilterScannerPixelwise)
+    class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel;
+      ACount: integer; {%H-}AGammaCorrection: boolean); override;
+  end;
+
+  { TBGRAFilterScannerNormalize }
+  { Normalize compute min-max of specified channel and apply an affine transformation
+    to make it use the full range of values }
+  TBGRAFilterScannerNormalize = class(TBGRAFilterScannerPixelwise)
+  private
+    minValRed, maxValRed, minValGreen, maxValGreen,
+    minValBlue, maxValBlue, minAlpha, maxAlpha: word;
+    addValRed, addValGreen, addValBlue, addAlpha: word;
+    factorValRed, factorValGreen, factorValBlue, factorAlpha: int32or64;
+    procedure DetermineNormalizationFactors(ABounds: TRect; AEachChannel: boolean);
+  protected
+    procedure DoComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel;
+            ACount: integer; {%H-}AGammaCorrection: boolean); override;
+  public
+    constructor Create(ASource: IBGRAScanner; AOffset: TPoint; ABounds: TRect;
+            AEachChannel: boolean);
+    class procedure ComputeFilterAt({%H-}ASource: PBGRAPixel; {%H-}ADest: PBGRAPixel;
+            {%H-}ACount: integer; {%H-}AGammaCorrection: boolean); override;
+  end;
+
+  { TBGRA3X3FilterScanner }
+
+  TBGRA3X3FilterScanner = class(TBGRAFilterScannerMultipixel)
+  protected
+    FSourceBorderColor,FDestinationBorderColor: TBGRAPixel;
+    FAutoSourceBorderColor: boolean;
+    function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; virtual; abstract;
+    procedure DoComputeFilter(BufferX: Integer;
+      const Buffers: array of PBGRAPixel; BufferWidth: integer;
+      ADest: PBGRAPixel; ACount: integer); override;
+  public
+    constructor Create(ASource: IBGRAScanner; ABounds: TRect); overload;
+    constructor Create(ASource: TBGRACustomBitmap); overload;
+    property SourceBorderColor: TBGRAPixel read FSourceBorderColor write FSourceBorderColor;
+    property DestinationBorderColor: TBGRAPixel read FDestinationBorderColor write FDestinationBorderColor;
+    property AutoSourceBorderColor: boolean read FAutoSourceBorderColor write FAutoSourceBorderColor;
+  end;
+
+  { TBGRAContourScanner }
+  { Filter contour compute a grayscale image, then for each pixel
+    calculates the difference with surrounding pixels (in intensity and alpha)
+    and draw black pixels when there is a difference }
+  TBGRAContourScanner = class(TBGRA3X3FilterScanner)
+  protected
+    FGammaCorrection: boolean;
+    FOpacity: byte;
+    function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; override;
+  public
+    constructor Create(ASource: IBGRAScanner; ABounds: TRect;
+                       AGammaCorrection: boolean = False); overload;
+    constructor Create(ASource: TBGRACustomBitmap;
+                       AGammaCorrection: boolean = False); overload;
+    property Opacity: Byte read FOpacity write FOpacity;
+  end;
+
+  { TBGRASharpenScanner }
+
+  TBGRASharpenScanner = class(TBGRA3X3FilterScanner)
+  protected
+    FAmount: integer;
+    function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; override;
+  public
+    constructor Create(ASource: IBGRAScanner; ABounds: TRect;
+                       AAmount: integer = 256); overload;
+    constructor Create(ASource: TBGRACustomBitmap;
+                       AAmount: integer = 256); overload;
+  end;
+
+  { TBGRAEmbossHightlightScanner }
+
+  TBGRAEmbossHightlightScanner = class(TBGRA3X3FilterScanner)
+  protected
+    FFillSelection: boolean;
+    FSourceChannel: TChannel;
+    FChannelOffset: Byte;
+    function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; override;
+    procedure SetSourceChannel(AValue: TChannel);
+  public
+    constructor Create(ASource: IBGRAScanner; ABounds: TRect; ABoundsVisible: Boolean); overload;
+    constructor Create(ASource: TBGRACustomBitmap; ABoundsVisible: Boolean); overload;
+    property FillSelection: boolean read FFillSelection write FFillSelection;
+    property SourceChannel: TChannel read FSourceChannel write SetSourceChannel;
+  end;
+
+implementation
+
+uses BGRABlend, math, SysUtils;
+
+{ TBGRAEmbossHightlightScanner }
+
+procedure TBGRAEmbossHightlightScanner.SetSourceChannel(AValue: TChannel);
+begin
+  FSourceChannel:=AValue;
+  FChannelOffset:= TBGRAPixel_ChannelByteOffset[FSourceChannel];
+end;
+
+function TBGRAEmbossHightlightScanner.DoFilter3X3(PTop, PMiddle,
+  PBottom: PBGRAPixel): TBGRAPixel;
+var
+  sum: Int32or64;
+  slope,h: byte;
+  highlight: TBGRAPixel;
+begin
+  sum := Int32or64((PByte(PTop)+FChannelOffset)^) +
+         Int32or64((PByte(PTop+1)+FChannelOffset)^) +
+         Int32or64((PByte(PMiddle)+FChannelOffset)^) -
+         Int32or64((PByte(PMiddle+2)+FChannelOffset)^) -
+         Int32or64((PByte(PBottom+1)+FChannelOffset)^) -
+         Int32or64((PByte(PBottom+2)+FChannelOffset)^);
+  sum := 128 - sum div 3;
+  if sum > 255 then
+    slope := 255
+  else
+  if sum < 1 then
+    slope := 1
+  else
+    slope := sum;
+  h := (PByte(PMiddle+1)+FChannelOffset)^;
+
+  result.red   := slope;
+  result.green := slope;
+  result.blue  := slope;
+  result.alpha := abs(slope - 128) * 2;
+
+  if FFillSelection then
+  begin
+    highlight := BGRA(h shr 2, h shr 1, h, h shr 1);
+    if result.red < highlight.red then
+      result.red := highlight.red;
+    if result.green < highlight.green then
+      result.green := highlight.green;
+    if result.blue < highlight.blue then
+      result.blue := highlight.blue;
+    if result.alpha < highlight.alpha then
+      result.alpha := highlight.alpha;
+  end;
+end;
+
+constructor TBGRAEmbossHightlightScanner.Create(ASource: IBGRAScanner;
+  ABounds: TRect; ABoundsVisible: Boolean);
+begin
+  inherited Create(ASource,ABounds);
+  SourceChannel := cGreen;
+  FillSelection:= true;
+  AutoSourceBorderColor := not ABoundsVisible;
+end;
+
+constructor TBGRAEmbossHightlightScanner.Create(ASource: TBGRACustomBitmap;
+  ABoundsVisible: Boolean);
+begin
+  inherited Create(ASource);
+  SourceChannel := cGreen;
+  FillSelection:= true;
+  AutoSourceBorderColor := not ABoundsVisible;
+end;
+
+{ TBGRA3X3FilterScanner }
+
+procedure TBGRA3X3FilterScanner.DoComputeFilter(BufferX: Integer;
+  const Buffers: array of PBGRAPixel; BufferWidth: integer; ADest: PBGRAPixel;
+  ACount: integer);
+var MiddleX: Integer;
+  TopLine,MiddleLine,BottomLine: array[0..2] of TBGRAPixel;
+  PTop,PMiddle,PBottom: PBGRAPixel;
+  borderColor: TBGRAPixel;
+begin
+  if Buffers[1] = nil then
+  begin
+    FillDWord(ADest^, ACount, LongWord(FDestinationBorderColor));
+    exit;
+  end;
+  MiddleX := BufferX+1;
+  while (ACount > 0) and (MiddleX < 0) do
+  begin
+    ADest^ := FDestinationBorderColor;
+    Dec(ACount);
+    Inc(ADest);
+    Inc(MiddleX);
+  end;
+  if (ACount > 0) and (MiddleX = 0) and (MiddleX < BufferWidth) then
+  begin
+    MiddleLine[1] := Buffers[1][MiddleX];
+    if AutoSourceBorderColor then borderColor := MiddleLine[1]
+    else borderColor := FSourceBorderColor;
+
+    TopLine[0] := borderColor;
+    MiddleLine[0] := borderColor;
+    BottomLine[0] := borderColor;
+    if Buffers[0] = nil then TopLine[1] := borderColor else TopLine[1] := Buffers[0][MiddleX];
+    if Buffers[2] = nil then BottomLine[1] := borderColor else BottomLine[1] := Buffers[2][MiddleX];
+    inc(MiddleX);
+    if MiddleX >= BufferWidth then
+    begin
+      TopLine[2] := borderColor;
+      MiddleLine[2] := borderColor;
+      BottomLine[2] := borderColor;
+    end else
+    begin
+      if Buffers[0] = nil then TopLine[2] := borderColor else TopLine[2] := Buffers[0][MiddleX];
+      MiddleLine[2] := Buffers[1][MiddleX];
+      if Buffers[2] = nil then BottomLine[2] := borderColor else BottomLine[2] := Buffers[2][MiddleX];
+    end;
+    ADest^ := DoFilter3X3(@TopLine,@MiddleLine,@BottomLine);
+    Dec(ACount);
+    Inc(ADest);
+  end;
+  if (Buffers[0]<>nil) and (Buffers[2]<>nil) then
+  begin
+    while (ACount > 0) and (MiddleX+1 < BufferWidth) do
+    begin
+      ADest^ := DoFilter3X3(@Buffers[0][MiddleX-1],@Buffers[1][MiddleX-1],@Buffers[2][MiddleX-1]);
+      Inc(MiddleX);
+      Dec(ACount);
+      Inc(ADest);
+    end;
+  end else
+  begin
+    if not AutoSourceBorderColor then
+    begin
+      TopLine[0] := FSourceBorderColor;
+      TopLine[1] := FSourceBorderColor;
+      TopLine[2] := FSourceBorderColor;
+      BottomLine[0] := FSourceBorderColor;
+      BottomLine[1] := FSourceBorderColor;
+      BottomLine[2] := FSourceBorderColor;
+    end;
+    while (ACount > 0) and (MiddleX+1 < BufferWidth) do
+    begin
+      PMiddle:= @Buffers[1][MiddleX-1];
+      if Buffers[0] = nil then
+      begin
+        if AutoSourceBorderColor then
+        begin
+          TopLine[0] := PMiddle[1];
+          TopLine[1] := PMiddle[1];
+          TopLine[2] := PMiddle[1];
+        end;
+        PTop := @TopLine;
+      end
+      else PTop := @Buffers[0][MiddleX-1];
+      if Buffers[2] = nil then
+      begin
+        if AutoSourceBorderColor then
+        begin
+          BottomLine[0] := PMiddle[1];
+          BottomLine[1] := PMiddle[1];
+          BottomLine[2] := PMiddle[1];
+        end;
+        PBottom := @BottomLine;
+      end
+      else PBottom := @Buffers[2][MiddleX-1];
+      ADest^ := DoFilter3X3(PTop,PMiddle,PBottom);
+      Inc(MiddleX);
+      Dec(ACount);
+      Inc(ADest);
+    end;
+  end;
+  if (ACount > 0) and (MiddleX < BufferWidth) then
+  begin
+    MiddleLine[1] := Buffers[1][MiddleX];
+    if AutoSourceBorderColor then borderColor := MiddleLine[1]
+    else borderColor := FSourceBorderColor;
+
+    if Buffers[0] = nil then TopLine[0] := borderColor else TopLine[0] := Buffers[0][MiddleX-1];
+    MiddleLine[0] := Buffers[1][MiddleX-1];
+    if Buffers[2] = nil then BottomLine[0] := borderColor else BottomLine[0] := Buffers[2][MiddleX-1];
+    if Buffers[0] = nil then TopLine[1] := borderColor else TopLine[1] := Buffers[0][MiddleX];
+    if Buffers[2] = nil then BottomLine[1] := borderColor else BottomLine[1] := Buffers[2][MiddleX];
+    inc(MiddleX);
+    if MiddleX >= BufferWidth then
+    begin
+      TopLine[2] := borderColor;
+      MiddleLine[2] := borderColor;
+      BottomLine[2] := borderColor;
+    end else
+    begin
+      if Buffers[0] = nil then TopLine[2] := borderColor else TopLine[2] := Buffers[0][MiddleX];
+      MiddleLine[2] := Buffers[1][MiddleX];
+      if Buffers[2] = nil then BottomLine[2] := borderColor else BottomLine[2] := Buffers[2][MiddleX];
+    end;
+    ADest^ := DoFilter3X3(@TopLine,@MiddleLine,@BottomLine);
+    Dec(ACount);
+    Inc(ADest);
+  end;
+  while (ACount > 0) do
+  begin
+    ADest^ := FDestinationBorderColor;
+    Dec(ACount);
+    Inc(ADest);
+  end;
+end;
+
+constructor TBGRA3X3FilterScanner.Create(ASource: IBGRAScanner;
+  ABounds: TRect);
+begin
+  inherited Create(ASource,ABounds,Point(-1,-1),3,3);
+  FSourceBorderColor := BGRAPixelTransparent;
+  FDestinationBorderColor := BGRAPixelTransparent;
+  FAutoSourceBorderColor := False;
+end;
+
+constructor TBGRA3X3FilterScanner.Create(ASource: TBGRACustomBitmap);
+begin
+  inherited Create(ASource,Rect(0,0,ASource.Width,ASource.Height),Point(-1,-1),3,3);
+  FSourceBorderColor := BGRAPixelTransparent;
+  FDestinationBorderColor := BGRAPixelTransparent;
+  FAutoSourceBorderColor := False;
+  AllowDirectRead := true;
+end;
+
+{ TBGRASharpenScanner }
+
+function TBGRASharpenScanner.DoFilter3X3(PTop, PMiddle, PBottom: PBGRAPixel): TBGRAPixel;
+var
+  sumR, sumG, sumB, sumA, nbA: UInt32or64;
+  refPixel: TBGRAPixel;
+  rgbDivShr1: UInt32or64;
+begin
+  if FAmount = 0 then
+  begin
+    result := PMiddle[1];
+    exit;
+  end;
+  //compute sum
+  sumR   := 0;
+  sumG   := 0;
+  sumB   := 0;
+  sumA   := 0;
+  //RGBdiv := 0;
+  nbA    := 0;
+
+  {$hints off}
+  with PTop[0] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end;
+  with PTop[1] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end;
+  with PTop[2] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end;
+  with PMiddle[0] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end;
+  with PMiddle[2] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end;
+  with PBottom[0] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end;
+  with PBottom[1] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end;
+  with PBottom[2] do if alpha <> 0 then begin inc(sumR, red * alpha); inc(sumG, green * alpha); inc(sumB, blue * alpha); inc(sumA, alpha); inc(nbA); end;
+   {$hints on}
+
+  //we finally have an average pixel
+  if (sumA = 0) then
+    refPixel := BGRAPixelTransparent
+  else
+  begin
+    rgbDivShr1:= sumA shr 1;
+    refPixel.red   := (sumR + rgbDivShr1) div sumA;
+    refPixel.green := (sumG + rgbDivShr1) div sumA;
+    refPixel.blue  := (sumB + rgbDivShr1) div sumA;
+    refPixel.alpha := (sumA + nbA shr 1) div nbA;
+  end;
+
+  //read the pixel at the center of the square
+  if refPixel <> BGRAPixelTransparent then
+  begin
+    with PMiddle[1] do
+    begin
+      //compute sharpened pixel by adding the difference
+      if FAmount<>256 then
+        result := BGRA( max(0, min($FFFF, Int32or64(red shl 8) +
+          FAmount*(red - refPixel.red))) shr 8,
+            max(0, min($FFFF, Int32or64(green shl 8) +
+          FAmount*(green - refPixel.green))) shr 8,
+           max(0, min($FFFF, Int32or64(blue shl 8) +
+          FAmount*(blue - refPixel.blue))) shr 8,
+           max(0, min($FFFF, Int32or64(alpha shl 8) +
+          FAmount*(alpha - refPixel.alpha))) shr 8 )
+      else
+        result := BGRA( max(0, min(255, (red shl 1) - refPixel.red)),
+           max(0, min(255, (green shl 1) - refPixel.green)),
+           max(0, min(255, (blue shl 1) - refPixel.blue)),
+           max(0, min(255, (alpha shl 1) - refPixel.alpha)));
+    end;
+  end else
+    result := PMiddle[1];
+end;
+
+constructor TBGRASharpenScanner.Create(ASource: IBGRAScanner;
+  ABounds: TRect; AAmount: integer);
+begin
+  inherited Create(ASource,ABounds);
+  FAmount:= AAmount;
+end;
+
+constructor TBGRASharpenScanner.Create(ASource: TBGRACustomBitmap;
+  AAmount: integer);
+begin
+  inherited Create(ASource);
+  FAmount:= AAmount;
+end;
+
+{ TBGRAContourScanner }
+
+function TBGRAContourScanner.DoFilter3X3(PTop, PMiddle, PBottom: PBGRAPixel): TBGRAPixel;
+var
+  sum: Int32or64;
+  slope: byte;
+begin
+  if FGammaCorrection then
+  begin
+    sum := (FastBGRAExpandedDiff(PTop[0],PBottom[2]) + FastBGRAExpandedDiff(PTop[1],PBottom[1]) +
+        FastBGRAExpandedDiff(PTop[2],PBottom[0]) + FastBGRAExpandedDiff(PMiddle[0],PMiddle[2])) div 3;
+
+    if sum >= 65535 then
+      slope := 0
+    else if sum <= 0 then
+      slope := 255
+    else slope := GammaCompressionTab[65535-sum];
+  end else
+  begin
+      sum := (FastBGRALinearDiff(PTop[0],PBottom[2]) + FastBGRALinearDiff(PTop[1],PBottom[1]) +
+        FastBGRALinearDiff(PTop[2],PBottom[0]) + FastBGRALinearDiff(PMiddle[0],PMiddle[2])) div 3;
+
+    if sum >= 255 then
+      slope := 0
+    else if sum < 0 then
+      slope := 255
+    else slope := 255-sum;
+  end;
+  result.red := slope;
+  result.green := slope;
+  result.blue := slope;
+  result.alpha := FOpacity;
+end;
+
+constructor TBGRAContourScanner.Create(ASource: IBGRAScanner;
+  ABounds: TRect; AGammaCorrection: boolean);
+begin
+  inherited Create(ASource,ABounds);
+  FGammaCorrection := AGammaCorrection;
+  AutoSourceBorderColor:= True;
+  FOpacity:= 255;
+end;
+
+constructor TBGRAContourScanner.Create(ASource: TBGRACustomBitmap;
+  AGammaCorrection: boolean);
+begin
+  inherited Create(ASource);
+  FGammaCorrection := AGammaCorrection;
+  AutoSourceBorderColor:= True;
+  FOpacity:= 255;
+end;
+
+{ TBGRAFilterScannerNormalize }
+
+procedure TBGRAFilterScannerNormalize.DetermineNormalizationFactors(ABounds: TRect; AEachChannel: boolean);
+var
+  buffer: TBGRAPixelBuffer;
+  p: PBGRAPixel;
+  c: TExpandedPixel;
+  yb, xb: LongInt;
+begin
+  if (ABounds.Right <= ABounds.Left) or (ABounds.Bottom <= ABounds.Top) then
+  begin
+    addValRed := 0;
+    addValGreen := 0;
+    addValBlue := 0;
+    addAlpha := 0;
+    factorValRed := 4096;
+    factorValGreen := 4096;
+    factorValBlue := 4096;
+    factorAlpha := 4096;
+    exit;
+  end;
+  maxValRed := 0;
+  minValRed := 65535;
+  maxValGreen := 0;
+  minValGreen := 65535;
+  maxValBlue := 0;
+  minValBlue := 65535;
+  maxAlpha  := 0;
+  minAlpha  := 65535;
+  buffer := nil;
+  for yb := ABounds.Top to ABounds.Bottom do
+  begin
+    if Source.ProvidesScanline(rect(ABounds.Left,yb,ABounds.Right,yb+1)) then
+      p := Source.GetScanlineAt(ABounds.Left,yb)
+    else
+    begin
+      Source.ScanMoveTo(ABounds.Left,yb);
+      AllocateBGRAPixelBuffer(buffer, ABounds.Right-ABounds.Left);
+      p := @buffer[0];
+      ScannerPutPixels(Source,p,ABounds.Right-ABounds.Left,dmSet);
+    end;
+    for xb := ABounds.Right-ABounds.Left-1 downto 0 do
+    begin
+      c := GammaExpansion(p[xb]);
+      if c.red > maxValRed then
+        maxValRed := c.red;
+      if c.green > maxValGreen then
+        maxValGreen := c.green;
+      if c.blue > maxValBlue then
+        maxValBlue := c.blue;
+      if c.red < minValRed then
+        minValRed := c.red;
+      if c.green < minValGreen then
+        minValGreen := c.green;
+      if c.blue < minValBlue then
+        minValBlue := c.blue;
+      if c.alpha > maxAlpha then
+        maxAlpha := c.alpha;
+      if c.alpha < minAlpha then
+        minAlpha := c.alpha;
+    end;
+  end;
+  if not AEachChannel then
+  begin
+    minValRed   := min(min(minValRed, minValGreen), minValBlue);
+    maxValRed   := max(max(maxValRed, maxValGreen), maxValBlue);
+    minValGreen := minValRed;
+    maxValGreen := maxValRed;
+    minValBlue  := minValBlue;
+    maxValBlue  := maxValBlue;
+  end;
+  if maxValRed > minValRed then
+  begin
+    factorValRed := 268431360 div (maxValRed - minValRed);
+    addValRed    := 0;
+  end else
+  begin
+    factorValRed := 0;
+    if minValRed = 0 then
+      addValRed := 0
+    else addValRed := 65535;
+  end;
+  if maxValGreen > minValGreen then
+  begin
+    factorValGreen := 268431360 div (maxValGreen - minValGreen);
+    addValGreen    := 0;
+  end else
+  begin
+    factorValGreen := 0;
+    if minValGreen = 0 then
+      addValGreen := 0
+    else addValGreen := 65535;
+  end;
+  if maxValBlue > minValBlue then
+  begin
+    factorValBlue := 268431360 div (maxValBlue - minValBlue);
+    addValBlue    := 0;
+  end else
+  begin
+    factorValBlue := 0;
+    if minValBlue = 0 then
+      addValBlue := 0 else
+      addValBlue := 65535;
+  end;
+  if maxAlpha > minAlpha then
+  begin
+    factorAlpha := 268431360 div (maxAlpha - minAlpha);
+    addAlpha    := 0;
+  end else
+  begin
+    factorAlpha := 0;
+    if minAlpha = 0 then
+      addAlpha := 0 else
+      addAlpha := 65535;
+  end;
+end;
+
+procedure TBGRAFilterScannerNormalize.DoComputeFilterAt(ASource: PBGRAPixel;
+  ADest: PBGRAPixel; ACount: integer; AGammaCorrection: boolean);
+var
+  c: TExpandedPixel;
+begin
+  While ACount > 0 do
+  begin
+    c := GammaExpansion(ASource^);
+    Inc(ASource);
+    c.red   := ((c.red - minValRed) * factorValRed + 2047) shr 12 + addValRed;
+    c.green := ((c.green - minValGreen) * factorValGreen + 2047) shr 12 + addValGreen;
+    c.blue  := ((c.blue - minValBlue) * factorValBlue + 2047) shr 12 + addValBlue;
+    c.alpha := ((c.alpha - minAlpha) * factorAlpha + 2047) shr 12 + addAlpha;
+    ADest^  := GammaCompression(c);
+    Inc(ADest);
+    dec(ACount);
+  end;
+end;
+
+constructor TBGRAFilterScannerNormalize.Create(ASource: IBGRAScanner;
+  AOffset: TPoint; ABounds: TRect; AEachChannel: boolean);
+begin
+  inherited Create(ASource,AOffset,True);
+  DetermineNormalizationFactors(ABounds, AEachChannel);
+end;
+
+class procedure TBGRAFilterScannerNormalize.ComputeFilterAt(
+  ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer;
+  AGammaCorrection: boolean);
+begin
+  raise exception.Create('Normalize filter scanner cannot be called as a class procedure');
+end;
+
+{ TBGRAFilterScannerSwapRedBlue }
+
+class procedure TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(
+  ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer;
+  AGammaCorrection: boolean);
+const RedMask = 255 shl TBGRAPixel_RedShift;
+      BlueMask = 255 shl TBGRAPixel_BlueShift;
+      GreenAndAlphaMask = (255 shl TBGRAPixel_GreenShift) or (255 shl TBGRAPixel_AlphaShift);
+      RedMask64 = RedMask or (RedMask shl 32);
+      BlueMask64 = BlueMask or (BlueMask shl 32);
+      GreenAndAlphaMask64 = GreenAndAlphaMask or (GreenAndAlphaMask shl 32);
+var
+  temp: LongWord;
+  temp64: QWord;
+  oddN: boolean;
+begin
+  {$PUSH}{$WARNINGS OFF}
+  if ACount <= 0 then exit;
+  oddN := odd(ACount);
+  ACount := ACount shr 1;
+  if TBGRAPixel_RedShift > TBGRAPixel_BlueShift then
+    while ACount > 0 do
+    begin
+      temp64 := PQWord(ASource)^;
+      PQWord(ADest)^ := ((temp64 and BlueMask64) shl (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or
+                    ((temp64 and RedMask64) shr (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or
+                    (temp64 and GreenAndAlphaMask64);
+      dec(ACount);
+      inc(ASource,2);
+      inc(ADest,2);
+    end else
+    while ACount > 0 do
+    begin
+      temp64 := PQWord(ASource)^;
+      PQWord(ADest)^ := ((temp64 and BlueMask64) shr (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or
+                    ((temp64 and RedMask64) shl (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or
+                    (temp64 and GreenAndAlphaMask64);
+      dec(ACount);
+      inc(ASource,2);
+      inc(ADest,2);
+    end;
+  if oddN then
+  begin
+    if TBGRAPixel_RedShift > TBGRAPixel_BlueShift then
+    begin
+      temp := PLongWord(ASource)^;
+      PLongWord(ADest)^ := ((temp and BlueMask) shl (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or
+            ((temp and RedMask) shr (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or
+            (temp and GreenAndAlphaMask);
+    end else
+    begin
+      temp := PLongWord(ASource)^;
+      PLongWord(ADest)^ := ((temp and BlueMask) shr (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or
+            ((temp and RedMask) shl (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or
+            (temp and GreenAndAlphaMask);
+    end;
+  end;
+  {$POP}
+end;
+
+{ TBGRAFilterScannerNegative }
+
+class procedure TBGRAFilterScannerNegative.ComputeFilterAt(
+  ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer;
+  AGammaCorrection: boolean);
+begin
+  if ADest = ASource then
+  begin
+    if AGammaCorrection then
+      while ACount > 0 do
+      begin
+        with ADest^ do
+          if alpha <> 0 then
+          begin
+            ADest^.red := GammaCompressionTab[not GammaExpansionTab[red]];
+            ADest^.green := GammaCompressionTab[not GammaExpansionTab[green]];
+            ADest^.blue := GammaCompressionTab[not GammaExpansionTab[blue]];
+          end;
+        Inc(ADest);
+        dec(ACount);
+      end else
+      while ACount > 0 do
+      begin
+        if ADest^.alpha <> 0 then
+          LongWord(ADest^) := LongWord(ADest^) xor ($ffffffff and not ($ff shl TBGRAPixel_AlphaShift));
+        Inc(ADest);
+        dec(ACount);
+      end;
+  end else
+    if AGammaCorrection then
+      while ACount > 0 do
+      begin
+        with ASource^ do
+          if alpha = 0 then
+            ADest^ := BGRAPixelTransparent
+          else
+          begin
+            ADest^.red := GammaCompressionTab[not GammaExpansionTab[red]];
+            ADest^.green := GammaCompressionTab[not GammaExpansionTab[green]];
+            ADest^.blue := GammaCompressionTab[not GammaExpansionTab[blue]];
+            ADest^.alpha := alpha;
+          end;
+        inc(ASource);
+        Inc(ADest);
+        dec(ACount);
+      end else
+      while ACount > 0 do
+      begin
+        if ASource^.alpha = 0 then
+          ADest^ := BGRAPixelTransparent
+        else
+          LongWord(ADest^) := LongWord(ASource^) xor ($ffffffff and not ($ff shl TBGRAPixel_AlphaShift));
+        inc(ASource);
+        Inc(ADest);
+        dec(ACount);
+      end;
+end;
+
+{ TBGRAFilterScannerGrayscale }
+
+class procedure TBGRAFilterScannerGrayscale.ComputeFilterAt(
+  ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer;
+  AGammaCorrection: boolean);
+begin
+  if ASource = ADest then
+  begin
+    if AGammaCorrection then
+      while ACount > 0 do
+      begin
+        if ADest^.alpha <> 0 then
+          ADest^ := BGRAToGrayscale(ADest^);
+        Inc(ADest);
+        dec(ACount);
+      end else
+      while ACount > 0 do
+      begin
+        if ADest^.alpha <> 0 then
+          ADest^ := BGRAToGrayscaleLinear(ADest^);
+        Inc(ADest);
+        dec(ACount);
+      end;
+  end else
+    if AGammaCorrection then
+      while ACount > 0 do
+      begin
+        ADest^ := BGRAToGrayscale(ASource^);
+        inc(ASource);
+        Inc(ADest);
+        dec(ACount);
+      end else
+      while ACount > 0 do
+      begin
+        ADest^ := BGRAToGrayscaleLinear(ASource^);
+        inc(ASource);
+        Inc(ADest);
+        dec(ACount);
+      end;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrafiltertype.pas

@@ -0,0 +1,464 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAFilterType;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, BGRABitmapTypes;
+
+const
+    FilterScannerChunkSize = 16;
+
+type
+  TCheckShouldStopFunc = function(ACurrentY: integer) : boolean of object;
+
+  { TFilterTask }
+
+  TFilterTask = class
+  private
+    FCheckShouldStop: TCheckShouldStopFunc;
+    FScanOffset: TPoint;
+    procedure SetDestination(AValue: TBGRACustomBitmap);
+    function GetInplace: boolean;
+    procedure SetInplace(AValue: boolean);
+  protected
+    FDestination: TBGRACustomBitmap;
+    FSource: TBGRACustomBitmap;
+    FSourceScanner: IBGRAScanner;
+    FCurrentY: integer;
+    function GetShouldStop(ACurrentY: integer): boolean;
+    procedure DoExecute; virtual; abstract;
+    function RequestSourceScanLine(X,Y,Count: Integer): PBGRAPixel;
+    procedure ReleaseSourceScanLine(P: PBGRAPixel);
+    function RequestSourceExpandedScanLine(X,Y,Count: Integer): PExpandedPixel;
+    procedure ReleaseSourceExpandedScanLine(P: PExpandedPixel);
+    procedure SetSource(ABitmap: TBGRACustomBitmap); overload;
+    procedure SetSource(AScanner: IBGRAScanner); overload;
+  public
+    function Execute: TBGRACustomBitmap;
+    property Destination: TBGRACustomBitmap read FDestination write SetDestination;
+    property CheckShouldStop: TCheckShouldStopFunc read FCheckShouldStop write FCheckShouldStop;
+    property CurrentY: integer read FCurrentY;
+    property ScanOffset: TPoint read FScanOffset write FScanOffset;
+    property Inplace: boolean read GetInplace write SetInplace;
+  end;
+
+  { TBGRAFilterScanner }
+
+  TBGRAFilterScanner = class(TBGRACustomScanner)
+  private
+    FAllowDirectRead: boolean;
+    FCurX,FCurY: integer;
+    FSource: IBGRAScanner;
+    FOffset: TPoint;
+    FVariablePixelBuffer: TBGRAPixelBuffer;
+    FOutputBuffer: packed array[0..FilterScannerChunkSize-1] of TBGRAPixel;
+    FOutputBufferPos: integer;
+  public
+    constructor Create(ASource: IBGRAScanner; AOffset: TPoint);
+    procedure ComputeFilter(ASource: IBGRAScanner; X,Y: Integer; ADest: PBGRAPixel; ACount: integer); virtual; abstract;
+    function ScanAtInteger(X,Y: integer): TBGRAPixel; override;
+    procedure ScanMoveTo(X,Y: Integer); override;
+    function ScanNextPixel: TBGRAPixel; override;
+    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override;
+    procedure ScanSkipPixels(ACount: integer); override;
+    function IsScanPutPixelsDefined: boolean; override;
+    function ScanAt(X,Y: Single): TBGRAPixel; override;
+    property Source: IBGRAScanner read FSource;
+    property Offset: TPoint read FOffset;
+    property AllowDirectRead: boolean read FAllowDirectRead write FAllowDirectRead;
+  end;
+
+  { TBGRAFilterScannerPixelwise }
+
+  TBGRAFilterScannerPixelwise = class(TBGRAFilterScanner)
+  private
+    FBuffer: TBGRAPixelBuffer;
+    FGammaCorrection: boolean;
+  protected
+    procedure DoComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel;
+            ACount: integer; AGammaCorrection: boolean); virtual;
+  public
+    constructor Create(ASource: IBGRAScanner; AOffset: TPoint; AGammaCorrection: boolean = true);
+    procedure ComputeFilter(ASource: IBGRAScanner; X, Y: Integer; ADest: PBGRAPixel;
+      ACount: integer); override;
+    class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel;
+      ACount: integer; AGammaCorrection: boolean); virtual; abstract;
+    class procedure ComputeFilterInplace(ABitmap: TBGRACustomBitmap; ABounds: TRect;
+      AGammaCorrection: boolean); virtual;
+    property GammaCorrection: boolean read FGammaCorrection write FGammaCorrection;
+  end;
+
+  { TBGRAFilterScannerMultipixel }
+
+  TBGRAFilterScannerMultipixel = class(TBGRAFilterScanner)
+  private
+    FSourceBounds: TRect;
+    FKernelWidth,FKernelHeight: integer;
+    FCurBufferY: integer;
+    FCurBufferYDefined: boolean;
+    FBuffers: array of TBGRAPixelBuffer;
+    FPBuffers: array of PBGRAPixel;
+  protected
+    procedure DoComputeFilter(BufferX: Integer; const Buffers: array of PBGRAPixel;
+      BufferWidth: integer; ADest: PBGRAPixel; ACount: integer); virtual; abstract;
+    procedure LoadBuffer(ASource: IBGRAScanner; X,Y: Integer; BufferIndex: Integer; ACount: integer); virtual;
+  public
+    constructor Create(ASource: IBGRAScanner; ASourceBounds: TRect; AOffset: TPoint;
+      AKernelWidth,AKernelHeight: Integer);
+    procedure ComputeFilter(ASource: IBGRAScanner; X, Y: Integer; ADest: PBGRAPixel;
+      ACount: integer); override;
+    property KernelWidth: integer read FKernelWidth;
+    property KernelHeight: integer read FKernelHeight;
+    property SourceBounds: TRect read FSourceBounds;
+  end;
+
+implementation
+
+uses SysUtils, BGRABlend;
+
+{ TFilterTask }
+
+function TFilterTask.GetShouldStop(ACurrentY: integer): boolean;
+begin
+  FCurrentY:= ACurrentY;
+  if Assigned(FCheckShouldStop) then
+    result := FCheckShouldStop(ACurrentY)
+  else
+    result := false;
+end;
+
+function TFilterTask.RequestSourceScanLine(X, Y, Count: Integer): PBGRAPixel;
+begin
+  if FSource <> nil then
+    result := FSource.ScanLine[y]+x
+  else
+  begin
+    getmem(result, sizeof(TBGRAPixel)*Count);
+    FSourceScanner.ScanMoveTo(X+FScanOffset.X,Y+FScanOffset.Y);
+    FSourceScanner.ScanPutPixels(result,count,dmSet);
+  end;
+end;
+
+procedure TFilterTask.ReleaseSourceScanLine(P: PBGRAPixel);
+begin
+  if FSource = nil then
+    if p <> nil then freemem(p);
+end;
+
+function TFilterTask.RequestSourceExpandedScanLine(X, Y, Count: Integer
+  ): PExpandedPixel;
+var p: PBGRAPixel;
+   pexp: PExpandedPixel;
+begin
+  getmem(result, sizeof(TExpandedPixel)*Count);
+  if FSource <> nil then
+  begin
+    p := FSource.ScanLine[Y]+x;
+    pexp := result;
+    while Count > 0 do
+    begin
+      pexp^ := GammaExpansion(p^);
+      inc(pexp);
+      inc(p);
+      dec(Count);
+    end;
+  end else
+  begin
+    FSourceScanner.ScanMoveTo(X+FScanOffset.X,Y+FScanOffset.Y);
+    pexp := result;
+    while Count > 0 do
+    begin
+      pexp^ := FSourceScanner.ScanNextExpandedPixel;
+      inc(pexp);
+      dec(Count);
+    end;
+  end;
+end;
+
+procedure TFilterTask.ReleaseSourceExpandedScanLine(P: PExpandedPixel);
+begin
+  if p <> nil then freemem(p);
+end;
+
+procedure TFilterTask.SetSource(ABitmap: TBGRACustomBitmap);
+begin
+  FSource := ABitmap;
+  FSourceScanner := nil;
+end;
+
+procedure TFilterTask.SetSource(AScanner: IBGRAScanner);
+begin
+  FSource := nil;
+  FSourceScanner := AScanner;
+end;
+
+function TFilterTask.Execute: TBGRACustomBitmap;
+var DestinationOwned: boolean;
+begin
+  FCurrentY := 0;
+  if Destination = nil then
+  begin
+    if FSource = nil then //using default factory
+      FDestination := BGRABitmapFactory.create(FSource.Width,FSource.Height)
+    else
+      FDestination := FSource.NewBitmap(FSource.Width,FSource.Height);
+    DestinationOwned:= true;
+  end else
+    DestinationOwned:= false;
+  try
+    DoExecute;
+    result := Destination;
+    FDestination := nil;
+  except
+    on ex: exception do
+    begin
+      if DestinationOwned then FreeAndNil(FDestination);
+      raise ex;
+    end;
+  end;
+end;
+
+procedure TFilterTask.SetDestination(AValue: TBGRACustomBitmap);
+begin
+  if FDestination <> nil then
+    raise exception.Create('Destination is already defined');
+  FDestination := AValue;
+end;
+
+function TFilterTask.GetInplace: boolean;
+begin
+  result := (Destination = FSource) and (FSource <> nil);
+end;
+
+procedure TFilterTask.SetInplace(AValue: boolean);
+begin
+  if AValue = InPlace then exit;
+  if AValue and (FSource = nil) then
+     raise exception.Create('Inplace is valid only when source image is defined');
+  Destination := FSource;
+end;
+
+{ TBGRAFilterScanner }
+
+constructor TBGRAFilterScanner.Create(ASource: IBGRAScanner; AOffset: TPoint);
+begin
+  FSource := ASource;
+  FOffset := AOffset;
+  FOutputBufferPos := FilterScannerChunkSize;
+end;
+
+function TBGRAFilterScanner.ScanAtInteger(X, Y: integer): TBGRAPixel;
+begin
+  ScanMoveTo(X,Y);
+  result := ScanNextPixel;
+end;
+
+procedure TBGRAFilterScanner.ScanMoveTo(X, Y: Integer);
+begin
+  FCurX := X;
+  FCurY := Y;
+  FOutputBufferPos := FilterScannerChunkSize;
+end;
+
+function TBGRAFilterScanner.ScanNextPixel: TBGRAPixel;
+begin
+  if FOutputBufferPos >= FilterScannerChunkSize then
+  begin
+    ComputeFilter(FSource,FCurX+FOffset.X,FCurY+FOffset.Y,@FOutputBuffer[0],FilterScannerChunkSize);
+    FOutputBufferPos := 0;
+  end;
+  Result:= FOutputBuffer[FOutputBufferPos];
+  inc(FOutputBufferPos);
+  inc(FCurX);
+end;
+
+procedure TBGRAFilterScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer;
+  mode: TDrawMode);
+begin
+  if mode = dmSet then
+  begin
+    ComputeFilter(FSource,FCurX+FOffset.X,FCurY+FOffset.Y,pdest,count);
+    inc(FCurX,count);
+  end else
+  begin
+    AllocateBGRAPixelBuffer(FVariablePixelBuffer, count);
+    ComputeFilter(FSource,FCurX+FOffset.X,FCurY+FOffset.Y,@FVariablePixelBuffer[0],count);
+    inc(FCurX,count);
+    PutPixels(pdest, @FVariablePixelBuffer[0], count, mode, 255);
+  end;
+end;
+
+procedure TBGRAFilterScanner.ScanSkipPixels(ACount: integer);
+begin
+  inc(FOutputBufferPos, ACount);
+  inc(FCurX, ACount);
+end;
+
+function TBGRAFilterScanner.IsScanPutPixelsDefined: boolean;
+begin
+  Result:= true;
+end;
+
+function TBGRAFilterScanner.ScanAt(X, Y: Single): TBGRAPixel;
+begin
+  result := ScanAtInteger(round(X),round(Y));
+end;
+
+{ TBGRAFilterScannerPixelwise }
+
+procedure TBGRAFilterScannerPixelwise.DoComputeFilterAt(ASource: PBGRAPixel;
+  ADest: PBGRAPixel; ACount: integer; AGammaCorrection: boolean);
+begin
+  ComputeFilterAt(ASource,ADest,ACount,AGammaCorrection);
+end;
+
+constructor TBGRAFilterScannerPixelwise.Create(ASource: IBGRAScanner;
+  AOffset: TPoint; AGammaCorrection: boolean);
+begin
+  inherited Create(ASource,AOffset);
+  GammaCorrection := AGammaCorrection;
+  //it is most likely that direct read can be used, the only exception being
+  //that the destination would be equal to the source and that there would
+  //be an offset
+  AllowDirectRead := true;
+end;
+
+procedure TBGRAFilterScannerPixelwise.ComputeFilter(ASource: IBGRAScanner; X,
+  Y: Integer; ADest: PBGRAPixel; ACount: integer);
+var p: PBGRAPixel;
+begin
+  if AllowDirectRead and ASource.ProvidesScanline(rect(x,y,x+ACount,y+1)) then
+  begin
+    p := ASource.GetScanlineAt(x,y);
+  end else
+  begin
+    AllocateBGRAPixelBuffer(FBuffer, ACount);
+    ASource.ScanMoveTo(X,Y);
+    p := @FBuffer[0];
+    ASource.ScanPutPixels(p, ACount, dmSet);
+  end;
+  DoComputeFilterAt(p,ADest,ACount,GammaCorrection);
+end;
+
+class procedure TBGRAFilterScannerPixelwise.ComputeFilterInplace(
+  ABitmap: TBGRACustomBitmap; ABounds: TRect; AGammaCorrection: boolean);
+var
+  yb: LongInt;
+  p: Pointer;
+begin
+  ABitmap.LoadFromBitmapIfNeeded;
+  if (ABounds.Left = 0) and (ABounds.Top = 0) and
+     (ABounds.Right = ABitmap.Width) and (ABounds.Bottom = ABitmap.Height) then
+    ComputeFilterAt(ABitmap.Data,ABitmap.Data,ABitmap.NbPixels,AGammaCorrection)
+  else
+    for yb := ABounds.Top to ABounds.Bottom-1 do
+    begin
+      p := ABitmap.ScanLine[yb]+ABounds.Left;
+      ComputeFilterAt(p,p,ABounds.Right-ABounds.Left,AGammaCorrection);
+    end;
+  ABitmap.InvalidateBitmap;
+end;
+
+{ TBGRAFilterScannerMultipixel }
+
+procedure TBGRAFilterScannerMultipixel.LoadBuffer(ASource: IBGRAScanner; X,
+  Y: Integer; BufferIndex: Integer; ACount: integer);
+begin
+  if (Y < FSourceBounds.Top) or (Y >= FSourceBounds.Bottom) then
+    FPBuffers[BufferIndex] := nil
+  else
+  if AllowDirectRead and ASource.ProvidesScanline(rect(x,y,x+ACount,y+1)) then
+  begin
+    FPBuffers[BufferIndex] := ASource.GetScanlineAt(X,Y);
+  end else
+  begin
+    AllocateBGRAPixelBuffer(FBuffers[BufferIndex], ACount);
+    ASource.ScanMoveTo(X,Y);
+    FPBuffers[BufferIndex] := @(FBuffers[BufferIndex][0]);
+    ASource.ScanPutPixels(FPBuffers[BufferIndex], ACount, dmSet);
+  end;
+end;
+
+constructor TBGRAFilterScannerMultipixel.Create(ASource: IBGRAScanner;
+  ASourceBounds: TRect; AOffset: TPoint; AKernelWidth, AKernelHeight: Integer);
+var
+  temp: Integer;
+begin
+  inherited Create(ASource,AOffset);
+  FSourceBounds := ASourceBounds;
+  if FSourceBounds.Left > FSourceBounds.Right then
+  begin
+    temp := FSourceBounds.Left;
+    FSourceBounds.Left := FSourceBounds.Right;
+    FSourceBounds.Right := temp;
+  end;
+  if FSourceBounds.Top > FSourceBounds.Bottom then
+  begin
+    temp := FSourceBounds.Top;
+    FSourceBounds.Top := FSourceBounds.Bottom;
+    FSourceBounds.Bottom := temp;
+  end;
+  FKernelWidth := AKernelWidth;
+  FKernelHeight:= AKernelHeight;
+  SetLength(FBuffers, FKernelHeight);
+  SetLength(FPBuffers, FKernelHeight);
+  FCurBufferYDefined := false;
+  //it is not sure that direct read can be used, because if the destination
+  //is equal to the source, the output will change the input buffers
+  AllowDirectRead := false;
+end;
+
+procedure TBGRAFilterScannerMultipixel.ComputeFilter(ASource: IBGRAScanner; X,
+  Y: Integer; ADest: PBGRAPixel; ACount: integer);
+var
+  yb,dy: Integer;
+  temp: TBGRAPixelBuffer;
+  p: PBGRAPixel;
+begin
+  if not FCurBufferYDefined or (Abs(Y-FCurBufferY)>=FKernelHeight) then
+  begin
+    FCurBufferY := y;
+    FCurBufferYDefined := true;
+    for yb := 0 to FKernelHeight-1 do
+      LoadBuffer(ASource,FSourceBounds.Left,Y+yb,yb,SourceBounds.Right-FSourceBounds.Left);
+  end else
+  if Y < FCurBufferY then
+  begin
+    dy := FCurBufferY-y;
+    for yb := FKernelHeight-1 downto dy do
+    begin
+      temp := FBuffers[yb];
+      FBuffers[yb] := FBuffers[yb-dy];
+      FBuffers[yb-dy] := temp;
+      p := FPBuffers[yb];
+      FPBuffers[yb] := FPBuffers[yb-dy];
+      FPBuffers[yb-dy] := p;
+    end;
+    for yb := 0 to dy-1 do
+      LoadBuffer(ASource,FSourceBounds.Left,Y+yb,yb,FSourceBounds.Right-FSourceBounds.Left);
+    FCurBufferY := y;
+  end else
+  if Y > FCurBufferY then
+  begin
+    dy := y-FCurBufferY;
+    for yb := 0 to FKernelHeight-1-dy do
+    begin
+      temp := FBuffers[yb];
+      FBuffers[yb] := FBuffers[yb+dy];
+      FBuffers[yb+dy] := temp;
+      p := FPBuffers[yb];
+      FPBuffers[yb] := FPBuffers[yb+dy];
+      FPBuffers[yb+dy] := p;
+    end;
+    for yb := FKernelHeight-1-dy+1 to FKernelHeight-1 do
+      LoadBuffer(ASource,FSourceBounds.Left,Y+yb,yb,FSourceBounds.Right-FSourceBounds.Left);
+    FCurBufferY := y;
+  end;
+  DoComputeFilter(X-FSourceBounds.Left,FPBuffers,FSourceBounds.Right-FSourceBounds.Left,ADest,ACount);
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrafontgl.pas

@@ -0,0 +1,694 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAFontGL;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRAGraphics, BGRAOpenGLType, BGRABitmapTypes,
+  Avl_Tree;
+
+type
+  { TRenderedGlyph }
+
+  TRenderedGlyph = class
+  private
+    FIdentifier: UTF8String;
+    FTexture: IBGLTexture;
+    FHorizontalOverflowPx, FVerticalOverflowPx, FAdvancePx: integer;
+  public
+    constructor Create(AIdentifier: UTF8String; ATexture: IBGLTexture;
+      AHorizontalOverflowPx, AVerticalOverflowPx: integer);
+    procedure Draw(x,y,Scale: single; AColor: TBGRAPixel); overload;
+    procedure Draw(x,y,Scale: single; AGradTopLeft, AGradTopRight, AGradBottomRight, AGradBottomLeft: TBGRAPixel); overload;
+    property Identifier: UTF8String read FIdentifier;
+    property AdvancePx: integer read FAdvancePx;
+  end;
+
+  { IBGLRenderedFont }
+
+  IBGLRenderedFont = interface(IBGLFont)
+    function GetBackgroundColor: TBGRAPixel;
+    function GetColor: TBGRAPixel;
+    function GetFontEmHeight: integer;
+    function GetFontFullHeight: integer;
+    function GetHorizontalOverflow: single;
+    function GetName: string;
+    function GetQuality: TBGRAFontQuality;
+    function GetStyle: TFontStyles;
+    function GetVerticalOverflow: single;
+    procedure SetBackgroundColor(AValue: TBGRAPixel);
+    procedure SetColor(AValue: TBGRAPixel);
+    procedure SetFontEmHeight(AValue: integer);
+    procedure SetFontFullHeight(AValue: integer);
+    procedure SetHorizontalOverflow(AValue: single);
+    procedure SetName(AValue: string);
+    procedure SetQuality(AValue: TBGRAFontQuality);
+    procedure SetStyle(AValue: TFontStyles);
+    procedure SetVerticalOverflow(AValue: single);
+
+    property Name: string read GetName write SetName;
+    property Style: TFontStyles read GetStyle write SetStyle;
+    property Quality: TBGRAFontQuality read GetQuality write SetQuality;
+    property EmHeight: integer read GetFontEmHeight write SetFontEmHeight;
+    property FullHeight: integer read GetFontFullHeight write SetFontFullHeight;
+    property Color: TBGRAPixel read GetColor write SetColor;
+    property HorizontalOverflow: single read GetHorizontalOverflow write SetHorizontalOverflow;
+    property VerticalOverflow: single read GetVerticalOverflow write SetVerticalOverflow;
+    property BackgroundColor: TBGRAPixel read GetBackgroundColor write SetBackgroundColor;
+  end;
+
+  { TBGLRenderedFont }
+
+  TBGLRenderedFont = class(TBGLCustomFont,IBGLRenderedFont)
+  private
+    FGlyphs: TAVLTree;
+
+    FName: string;
+    FColor: TBGRAPixel;
+    FBackgroundColor: TBGRAPixel;
+    FEmHeight: integer;
+    FHorizontalOverflow: single;
+    FVerticalOverflow: single;
+    FQuality: TBGRAFontQuality;
+    FStyle: TFontStyles;
+    FGradTopLeft, FGradTopRight, FGradBottomRight, FGradBottomLeft: TBGRAPixel;
+    FUseGradientColor: boolean;
+    FClipped: boolean;
+    FWordBreakHandler: TWordBreakHandler;
+
+    function FindGlyph(AIdentifier: string): TAVLTreeNode;
+    function GetBackgroundColor: TBGRAPixel;
+    function GetColor: TBGRAPixel;
+    function GetFontEmHeight: integer;
+    function GetGlyph(AIdentifier: string): TRenderedGlyph;
+    function GetHorizontalOverflow: single;
+    function GetName: string;
+    function GetQuality: TBGRAFontQuality;
+    function GetStyle: TFontStyles;
+    function GetVerticalOverflow: single;
+    procedure SetGlyph(AIdentifier: string; AValue: TRenderedGlyph);
+    function GetFontFullHeight: integer;
+    procedure SetBackgroundColor(AValue: TBGRAPixel);
+    procedure SetColor(AValue: TBGRAPixel);
+    procedure SetFontEmHeight(AValue: integer);
+    procedure SetFontFullHeight(AValue: integer);
+    procedure SetHorizontalOverflow(AValue: single);
+    procedure SetName(AValue: string);
+    procedure SetQuality(AValue: TBGRAFontQuality);
+    procedure SetStyle(AValue: TFontStyles);
+    procedure SetVerticalOverflow(AValue: single);
+  protected
+    FRenderer: TBGRACustomFontRenderer;
+    FRendererOwned: boolean;
+    function LoadFromFile({%H-}AFilename: UTF8String): boolean; override;
+    procedure FreeMemoryOnDestroy; override;
+    function CreateGlyph(AIdentifier: string): TRenderedGlyph; virtual;
+    procedure CopyFontToRenderer; virtual;
+    procedure DoTextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel; AHorizontalAlign: TAlignment; AVerticalAlign: TTextLayout); overload; virtual;
+    procedure DoTextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); overload; override;
+    procedure DoTextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); override;
+    function GetClipped: boolean; override;
+    function GetUseGradientColors: boolean; override;
+    procedure SetClipped(AValue: boolean); override;
+    procedure SetUseGradientColors(AValue: boolean); override;
+    procedure DiscardGlyphs; virtual;
+    procedure DefaultWordBreakHandler(var ABefore, AAfter: string);
+    procedure SplitText(var ATextUTF8: string; AMaxWidth: single; out ARemainsUTF8: string);
+    function GetWrappedLines(ATextUTF8: string; AWidth: single): TStringList;
+  public
+    constructor Create(ARenderer: TBGRACustomFontRenderer; ARendererOwned: boolean = true);
+    procedure FreeMemory; override;
+    function TextWidth(const Text: UTF8String): single; override;
+    function TextHeight(const {%H-}Text: UTF8String): single; override;
+    function TextHeight(const Text: UTF8String; AWidth: single): single; override;
+    procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); override;
+    property Name: string read GetName write SetName;
+    property Style: TFontStyles read GetStyle write SetStyle;
+    property Quality: TBGRAFontQuality read GetQuality write SetQuality;
+    property EmHeight: integer read GetFontEmHeight write SetFontEmHeight;
+    property FullHeight: integer read GetFontFullHeight write SetFontFullHeight;
+    property Color: TBGRAPixel read GetColor write SetColor;
+    property HorizontalOverflow: single read GetHorizontalOverflow write SetHorizontalOverflow;
+    property VerticalOverflow: single read GetVerticalOverflow write SetVerticalOverflow;
+    property BackgroundColor: TBGRAPixel read GetBackgroundColor write SetBackgroundColor;
+    property WordBreakHandler: TWordBreakHandler read FWordBreakHandler write FWordBreakHandler;
+    property Glyph[AIdentifier: string]: TRenderedGlyph read GetGlyph;
+  end;
+
+implementation
+
+uses BGRAUTF8;
+
+{ TRenderedGlyph }
+
+constructor TRenderedGlyph.Create(AIdentifier: UTF8String; ATexture: IBGLTexture;
+  AHorizontalOverflowPx, AVerticalOverflowPx: integer);
+begin
+  FIdentifier := AIdentifier;
+  FTexture := ATexture;
+  FHorizontalOverflowPx:= AHorizontalOverflowPx;
+  FVerticalOverflowPx:= AVerticalOverflowPx;
+  FAdvancePx := ATexture.Width - 2*FHorizontalOverflowPx;
+end;
+
+procedure TRenderedGlyph.Draw(x, y, Scale: single; AColor: TBGRAPixel);
+begin
+  FTexture.StretchDraw(x-FHorizontalOverflowPx*Scale,y-FVerticalOverflowPx*Scale, FTexture.Width*Scale, FTexture.Height*Scale, AColor);
+end;
+
+procedure TRenderedGlyph.Draw(x, y, Scale: single; AGradTopLeft, AGradTopRight,
+  AGradBottomRight, AGradBottomLeft: TBGRAPixel);
+begin
+  FTexture.SetGradientColors(AGradTopLeft,AGradTopRight, AGradBottomRight,AGradBottomLeft);
+  FTexture.StretchDraw(x-FHorizontalOverflowPx*Scale,y-FVerticalOverflowPx*Scale, FTexture.Width*Scale, FTexture.Height*Scale);
+  FTexture.GradientColors := false;
+end;
+
+function CompareGlyphNode(Data1, Data2: Pointer): integer;
+begin
+  result := CompareStr(TRenderedGlyph(Data1).Identifier,TRenderedGlyph(Data2).Identifier);
+end;
+
+{ TBGLRenderedFont }
+
+function TBGLRenderedFont.FindGlyph(AIdentifier: string): TAVLTreeNode;
+var Comp: integer;
+  Node: TAVLTreeNode;
+begin
+  Node:=FGlyphs.Root;
+  while (Node<>nil) do begin
+    Comp:=CompareStr(AIdentifier,TRenderedGlyph(Node.Data).Identifier);
+    if Comp=0 then break;
+    if Comp<0 then begin
+      Node:=Node.Left
+    end else begin
+      Node:=Node.Right
+    end;
+  end;
+  result := Node;
+end;
+
+function TBGLRenderedFont.GetBackgroundColor: TBGRAPixel;
+begin
+  result := FBackgroundColor;
+end;
+
+function TBGLRenderedFont.GetColor: TBGRAPixel;
+begin
+  result := FColor;
+end;
+
+function TBGLRenderedFont.GetFontEmHeight: integer;
+begin
+  result := FEmHeight;
+end;
+
+function TBGLRenderedFont.CreateGlyph(AIdentifier: string): TRenderedGlyph;
+var b: TBGLCustomBitmap;
+  hOverflow, vOverflow: integer;
+begin
+  CopyFontToRenderer;
+  with FRenderer.TextSize(AIdentifier) do
+  begin
+    hOverflow := round(cx*HorizontalOverflow)+1;
+    vOverflow:= round(cy*VerticalOverflow)+1;
+    b:= BGLBitmapFactory.Create(cx+2*hOverflow,cy+2*vOverflow,BackgroundColor);
+    FRenderer.TextOut(b, hOverflow,vOverflow, AIdentifier, Color, taLeftJustify);
+    result:= TRenderedGlyph.Create(AIdentifier,b.MakeTextureAndFree,hOverflow,vOverflow);
+  end;
+end;
+
+procedure TBGLRenderedFont.CopyFontToRenderer;
+begin
+  FRenderer.FontName := FName;
+  FRenderer.FontEmHeight := FEmHeight;
+  FRenderer.FontOrientation := 0;
+  FRenderer.FontQuality := FQuality;
+  FRenderer.FontStyle := FStyle;
+end;
+
+procedure TBGLRenderedFont.DoTextOut(X, Y: Single; const Text: UTF8String;
+  AColor: TBGRAPixel; AHorizontalAlign: TAlignment; AVerticalAlign: TTextLayout);
+var
+  pstr: pchar;
+  left,charlen: integer;
+  nextchar: string;
+  g: TRenderedGlyph;
+begin
+  if Text = '' then exit;
+
+  pstr := @Text[1];
+  left := length(Text);
+  case AHorizontalAlign of
+  taCenter: DecF(x, round(TextWidth(Text)/2));
+  taRightJustify: DecF(x, TextWidth(Text));
+  end;
+  case AVerticalAlign of
+  tlCenter: DecF(y, round(TextHeight(Text)/2));
+  tlBottom: DecF(y, TextHeight(Text)*Scale);
+  end;
+  while left > 0 do
+  begin
+    charlen := UTF8CharacterLength(pstr);
+    setlength(nextchar, charlen);
+    move(pstr^, nextchar[1], charlen);
+    inc(pstr,charlen);
+    dec(left,charlen);
+
+    g := GetGlyph(nextchar);
+    if g <> nil then
+    begin
+      if FUseGradientColor then
+        g.Draw(x,y,Scale,FGradTopLeft,FGradTopRight,FGradBottomRight,FGradBottomLeft)
+      else
+        g.Draw(x,y,Scale,AColor);
+      IncF(x, (g.AdvancePx + StepX)  * Scale);
+    end;
+  end;
+end;
+
+procedure TBGLRenderedFont.DoTextOut(X, Y: Single; const Text: UTF8String;
+  AColor: TBGRAPixel);
+begin
+  if Justify then
+    DoTextOut(X,Y,Text,AColor,taLeftJustify,VerticalAlign)
+  else
+    DoTextOut(X,Y,Text,AColor,HorizontalAlign,VerticalAlign);
+end;
+
+procedure TBGLRenderedFont.DoTextRect(X, Y, Width, Height: Single;
+  const Text: UTF8String; AColor: TBGRAPixel);
+
+  procedure DoDrawTextLine(LineY, LineWidth: Single; ALine: string; AJustify: boolean);
+  var CurX: single;
+    words: TStringList;
+    wordStart: integer;
+    i: Integer;
+  begin
+    if AJustify then
+    begin
+      words := TStringList.Create;
+      wordStart := 1;
+      for i := 1 to length(ALine) do
+      begin
+        if ALine[i]=' ' then
+        begin
+          words.Add(copy(ALine,wordStart,i-wordStart));
+          wordStart := i+1;
+        end;
+      end;
+      words.add(copy(ALine,wordStart,length(ALine)+1-wordStart));
+      CurX := X;
+      LineWidth := 0;
+      for i := 0 to words.Count-1 do
+        IncF(LineWidth, TextWidth(words[i]));
+
+      for i := 0 to words.Count-1 do
+      begin
+        DoTextOut(CurX+round((Width-LineWidth)/(words.Count-1)*i),LineY,words[i],AColor,taLeftJustify,tlTop);
+        IncF(CurX, TextWidth(words[i]));
+      end;
+      words.Free;
+    end else
+    begin
+      Case HorizontalAlign of
+      taCenter: CurX := round(X+(Width-LineWidth)/2);
+      taRightJustify: CurX := X+Width-LineWidth;
+      else
+        CurX := X;
+      end;
+      DoTextOut(CurX,LineY,ALine,AColor,taLeftJustify,tlTop);
+    end;
+  end;
+
+var CurY: Single;
+  lineHeight: Single;
+  lines: TStringList;
+  i,originalNbLines: Integer;
+  maxLineCount: int64;
+begin
+  If Text='' then exit;
+  lines := GetWrappedLines(Text,Width);
+  lineHeight := FullHeight * Scale;
+  originalNbLines := lines.Count;
+
+  if Clipped then
+  begin
+    if lineHeight = 0 then exit;
+    maxLineCount := trunc(Height/lineHeight);
+    if maxLineCount <= 0 then exit;
+    while lines.Count > maxLineCount do
+      lines.Delete(lines.Count-1);
+  end;
+
+  case VerticalAlign of
+  tlCenter: CurY := round(Y+( Height - lines.Count*lineHeight )/2);
+  tlBottom: CurY := Y + Height - lines.Count*lineHeight;
+  else CurY := Y;
+  end;
+
+  for i := 0 to lines.Count-1 do
+  begin
+    DoDrawTextLine(CurY,TextWidth(lines[i]),lines[i],Justify and (i<>originalNbLines-1));
+    IncF(CurY, lineHeight);
+  end;
+  lines.Free;
+end;
+
+function TBGLRenderedFont.GetGlyph(AIdentifier: string): TRenderedGlyph;
+var Node: TAVLTreeNode;
+begin
+  Node := FindGlyph(AIdentifier);
+  if Node = nil then
+  begin
+    if UTF8Length(AIdentifier)<>1 then
+      result := nil
+    else
+    begin
+      result := CreateGlyph(AIdentifier);
+      SetGlyph(AIdentifier, result);
+    end;
+  end
+  else
+    result := TRenderedGlyph(Node.Data);
+end;
+
+function TBGLRenderedFont.GetHorizontalOverflow: single;
+begin
+  result := FHorizontalOverflow;
+end;
+
+function TBGLRenderedFont.GetName: string;
+begin
+  result := FName;
+end;
+
+function TBGLRenderedFont.GetQuality: TBGRAFontQuality;
+begin
+  result := FQuality;
+end;
+
+function TBGLRenderedFont.GetStyle: TFontStyles;
+begin
+  result := FStyle;
+end;
+
+function TBGLRenderedFont.GetVerticalOverflow: single;
+begin
+  result := FVerticalOverflow;
+end;
+
+procedure TBGLRenderedFont.SetGlyph(AIdentifier: string; AValue: TRenderedGlyph);
+var Node: TAVLTreeNode;
+begin
+  if AValue.Identifier <> AIdentifier then
+    raise exception.Create('Identifier mismatch');
+  Node := FindGlyph(AIdentifier);
+  if Node <> nil then
+  begin
+    if pointer(AValue) <> Node.Data then
+      TRenderedGlyph(Node.Data).Free;
+    Node.Data := AValue;
+  end else
+    FGlyphs.Add(pointer(AValue));
+end;
+
+procedure TBGLRenderedFont.SetStyle(AValue: TFontStyles);
+begin
+  if FStyle=AValue then Exit;
+  FStyle:=AValue;
+  DiscardGlyphs;
+end;
+
+procedure TBGLRenderedFont.SetVerticalOverflow(AValue: single);
+begin
+  if FVerticalOverflow=AValue then Exit;
+  FVerticalOverflow:=AValue;
+  DiscardGlyphs;
+end;
+
+function TBGLRenderedFont.GetClipped: boolean;
+begin
+  result := FClipped;
+end;
+
+function TBGLRenderedFont.GetUseGradientColors: boolean;
+begin
+  result := FUseGradientColor;
+end;
+
+procedure TBGLRenderedFont.SetClipped(AValue: boolean);
+begin
+  FClipped:= AValue;
+end;
+
+procedure TBGLRenderedFont.SetUseGradientColors(AValue: boolean);
+begin
+  FUseGradientColor:= AValue;
+end;
+
+procedure TBGLRenderedFont.DiscardGlyphs;
+begin
+  FGlyphs.FreeAndClear;
+end;
+
+procedure TBGLRenderedFont.DefaultWordBreakHandler(var ABefore, AAfter: string);
+begin
+  BGRADefaultWordBreakHandler(ABefore,AAfter);
+end;
+
+function TBGLRenderedFont.GetWrappedLines(ATextUTF8: string; AWidth: single
+  ): TStringList;
+var
+  ARemains: string;
+begin
+  result := TStringList.Create;
+  repeat
+    SplitText(ATextUTF8, AWidth, ARemains);
+    result.Add(ATextUTF8);
+    ATextUTF8 := ARemains;
+  until ARemains = '';
+end;
+
+procedure TBGLRenderedFont.SplitText(var ATextUTF8: string; AMaxWidth: single;
+  out ARemainsUTF8: string);
+var
+  pstr: pchar;
+  p,left,charlen: integer;
+  totalWidth: single;
+  firstChar: boolean;
+  nextchar: string;
+  g: TRenderedGlyph;
+begin
+  totalWidth := 0;
+  if ATextUTF8 = '' then
+  begin
+    ARemainsUTF8 := '';
+    exit;
+  end else
+  begin
+    p := 1;
+    pstr := @ATextUTF8[1];
+    left := length(ATextUTF8);
+    firstChar := true;
+    while left > 0 do
+    begin
+      if RemoveLineEnding(ATextUTF8,p) then
+      begin
+        ARemainsUTF8 := copy(ATextUTF8,p,length(ATextUTF8)-p+1);
+        ATextUTF8 := copy(ATextUTF8,1,p-1);
+        exit;
+      end;
+
+      charlen := UTF8CharacterLength(pstr);
+      setlength(nextchar, charlen);
+      move(pstr^, nextchar[1], charlen);
+      inc(pstr,charlen);
+
+      g := GetGlyph(nextchar);
+      if g <> nil then
+      begin
+        if not firstChar then IncF(totalWidth, StepX*Scale);
+        IncF(totalWidth, g.AdvancePx*Scale);
+        if not firstChar and (totalWidth > AMaxWidth) then
+        begin
+          ARemainsUTF8:= copy(ATextUTF8,p,length(ATextUTF8)-p+1);
+          ATextUTF8 := copy(ATextUTF8,1,p-1);
+          if Assigned(FWordBreakHandler) then
+            FWordBreakHandler(ATextUTF8,ARemainsUTF8) else
+              DefaultWordBreakHandler(ATextUTF8,ARemainsUTF8);
+          exit;
+        end;
+      end;
+
+      dec(left,charlen);
+      inc(p,charlen);
+      firstChar := false;
+    end;
+  end;
+  ARemainsUTF8 := ''; //no split
+end;
+
+procedure TBGLRenderedFont.SetName(AValue: string);
+begin
+  if FName=AValue then Exit;
+  FName:=AValue;
+  DiscardGlyphs;
+end;
+
+procedure TBGLRenderedFont.SetFontEmHeight(AValue: integer);
+begin
+  if FEmHeight=AValue then Exit;
+  FEmHeight:=AValue;
+  DiscardGlyphs;
+end;
+
+function TBGLRenderedFont.GetFontFullHeight: integer;
+begin
+  if FEmHeight < 0 then
+    result := -EmHeight
+  else
+    result := FRenderer.TextSize('Hg').cy;
+end;
+
+procedure TBGLRenderedFont.SetBackgroundColor(AValue: TBGRAPixel);
+begin
+  if FBackgroundColor=AValue then Exit;
+  FBackgroundColor:=AValue;
+  DiscardGlyphs;
+end;
+
+procedure TBGLRenderedFont.SetColor(AValue: TBGRAPixel);
+begin
+  if FColor=AValue then Exit;
+  FColor:=AValue;
+  DiscardGlyphs;
+end;
+
+procedure TBGLRenderedFont.SetFontFullHeight(AValue: integer);
+begin
+  EmHeight:= -AValue;
+end;
+
+procedure TBGLRenderedFont.SetHorizontalOverflow(AValue: single);
+begin
+  if FHorizontalOverflow=AValue then Exit;
+  FHorizontalOverflow:=AValue;
+  DiscardGlyphs;
+end;
+
+procedure TBGLRenderedFont.SetQuality(AValue: TBGRAFontQuality);
+begin
+  if FQuality=AValue then Exit;
+  FQuality:=AValue;
+  DiscardGlyphs;
+end;
+
+function TBGLRenderedFont.LoadFromFile(AFilename: UTF8String): boolean;
+begin
+  result := false;
+end;
+
+procedure TBGLRenderedFont.FreeMemoryOnDestroy;
+begin
+  FreeMemory;
+  if FRendererOwned then FreeAndNil(FRenderer);
+  FreeAndNil(FGlyphs);
+end;
+
+constructor TBGLRenderedFont.Create(ARenderer: TBGRACustomFontRenderer;
+  ARendererOwned: boolean);
+begin
+  Init;
+  FRenderer := ARenderer;
+  FRendererOwned := ARendererOwned;
+
+  FName := 'Arial';
+  FColor := BGRAWhite;
+  FBackgroundColor := BGRAPixelTransparent;
+  FEmHeight := 20;
+  FStyle := [];
+  FHorizontalOverflow := 0.33;
+  FVerticalOverflow := 0;
+  FQuality := fqFineAntialiasing;
+
+  FGradTopLeft := BGRAWhite;
+  FGradTopRight := BGRAWhite;
+  FGradBottomLeft := BGRAWhite;
+  FGradBottomRight := BGRAWhite;
+  FUseGradientColor:= false;
+  FClipped:= false;
+
+  FGlyphs := TAVLTree.Create(@CompareGlyphNode);
+  FWordBreakHandler:= nil;
+end;
+
+procedure TBGLRenderedFont.FreeMemory;
+begin
+  DiscardGlyphs;
+  inherited FreeMemory;
+end;
+
+function TBGLRenderedFont.TextWidth(const Text: UTF8String): single;
+var
+  pstr: pchar;
+  left,charlen: integer;
+  nextchar: string;
+  g: TRenderedGlyph;
+  firstChar: boolean;
+begin
+  result := 0;
+  if Text = '' then exit;
+
+  firstChar := true;
+  pstr := @Text[1];
+  left := length(Text);
+  while left > 0 do
+  begin
+    charlen := UTF8CharacterLength(pstr);
+    setlength(nextchar, charlen);
+    move(pstr^, nextchar[1], charlen);
+    inc(pstr,charlen);
+    dec(left,charlen);
+
+    g := GetGlyph(nextchar);
+    if g <> nil then
+    begin
+      if firstChar then
+        firstchar := false
+      else
+        IncF(result, StepX * Scale);
+      IncF(result, g.AdvancePx * Scale);
+    end;
+  end;
+end;
+
+function TBGLRenderedFont.TextHeight(const Text: UTF8String): single;
+begin
+  result := FullHeight * Scale;
+end;
+
+function TBGLRenderedFont.TextHeight(const Text: UTF8String; AWidth: single
+  ): single;
+var
+  lines: TStringList;
+begin
+  lines := GetWrappedLines(Text, AWidth);
+  result := lines.Count * (FullHeight * Scale);
+  lines.Free;
+end;
+
+procedure TBGLRenderedFont.SetGradientColors(ATopLeft, ATopRight, ABottomRight,
+  ABottomLeft: TBGRAPixel);
+begin
+  FGradTopLeft := ATopLeft;
+  FGradTopRight := ATopRight;
+  FGradBottomLeft := ABottomLeft;
+  FGradBottomRight := ABottomRight;
+  GradientColors := true;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrafpcanvas.inc

@@ -0,0 +1,286 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{$IFDEF INCLUDE_INTERFACE}
+{$UNDEF INCLUDE_INTERFACE}
+
+type
+  {* How to draw the end of line }
+  TPenEndCap = TFPPenEndCap;
+
+const
+    {** Draw a half-disk at the end of the line. The diameter of the disk is
+        equal to the pen width. }
+    pecRound = FPCanvas.pecRound;
+    {** Draw a half-square. The size of the square is equal to the pen width.
+        This is visually equivalent to extend the line of half the pen width }
+    pecSquare = FPCanvas.pecSquare;
+    {** The line ends exactly at the end point }
+    pecFlat = FPCanvas.pecFlat;
+
+type
+  {* How to join segments. This makes sense only for geometric pens (that
+     have a certain width) }
+  TPenJoinStyle = TFPPenJoinStyle;
+
+const
+    {** Segments are joined by filling the gap with an arc }
+    pjsRound = FPCanvas.pjsRound;
+    {** Segments are joind by filling the gap with an intermediary segment }
+    pjsBevel = FPCanvas.pjsBevel;
+    {** Segments are joined by extending them up to their intersection.
+        There is a miter limit so that if the intersection is too far,
+        an intermediary segment is used }
+    pjsMiter = FPCanvas.pjsMiter;
+
+type
+  {* Style to use for the pen. The unit for the pattern is the width of the
+     line }
+  TPenStyle = TFPPenStyle;
+  TPenMode = TFPPenMode;
+
+const
+  {** Pen is continuous }
+  psSolid = FPCanvas.psSolid;
+  {** Pen is dashed. The dash have a length of 3 unit and the gaps of 1 unit }
+  psDash = FPCanvas.psDash;
+  {** Pen is dotted. The dots have a length of 1 unit and the gaps of 1 unit }
+  psDot = FPCanvas.psDot;
+  {** Pattern is a dash of length 3 followed by a dot of length 1, separated by a gap of length 1 }
+  psDashDot = FPCanvas.psDashDot;
+  {** Dash of length 3, and two dots of length 1 }
+  psDashDotDot = FPCanvas.psDashDotDot;
+  {** Pen is not drawn }
+  psClear = FPCanvas.psClear;
+  {** Not used. Provided for compatibility }
+  psInsideframe = FPCanvas.psInsideframe;
+  {** Custom pattern used }
+  psPattern = FPCanvas.psPattern;
+
+  pmBlack = FPCanvas.pmBlack;
+  pmWhite = FPCanvas.pmWhite;
+  pmNop = FPCanvas.pmNop;
+  pmNot = FPCanvas.pmNot;
+  pmCopy = FPCanvas.pmCopy;
+  pmNotCopy = FPCanvas.pmNotCopy;
+  pmMergePenNot = FPCanvas.pmMergePenNot;
+  pmMaskPenNot = FPCanvas.pmMaskPenNot;
+  pmMergeNotPen = FPCanvas.pmMergeNotPen;
+  pmMaskNotPen = FPCanvas.pmMaskNotPen;
+  pmMerge = FPCanvas.pmMerge;
+  pmNotMerge = FPCanvas.pmNotMerge;
+  pmMask = FPCanvas.pmMask;
+  pmNotMask = FPCanvas.pmNotMask;
+  pmXor = FPCanvas.pmXor;
+  pmNotXor = FPCanvas.pmNotXor;
+
+type
+  { TPen }
+  {* A class containing a pen }
+  TPen = class(TFPCustomPen)
+  private
+    function GetColor: TColor;
+    procedure SetColor(AValue: TColor);
+  public
+    constructor Create; override;
+    {** Color of the pen }
+    property Color: TColor read GetColor write SetColor;
+    {** Operation done on pixels }
+    property Mode;
+    {** End cap of the pen: how to draw the ends of the lines }
+    property EndCap;
+    {** Join style: how to join the segments of a polyline }
+    property JoinStyle;
+    {** Pen style: solid, dash, dot... }
+    property Style;
+    {** Pen width in pixels }
+    property Width;
+  end;
+
+  {* Pattern when filling with a brush. It is used in BGRACanvas but can
+     also be created with TBGRABitmap.CreateBrushTexture function }
+  TBrushStyle = TFPBrushStyle;
+
+const
+  {** Fill with the current color }
+  bsSolid = FPCanvas.bsSolid;
+  {** Does not fill at all }
+  bsClear = FPCanvas.bsClear;
+  {** Draw horizontal lines }
+  bsHorizontal = FPCanvas.bsHorizontal;
+  {** Draw vertical lines }
+  bsVertical = FPCanvas.bsVertical;
+  {** Draw diagonal lines from top-left to bottom-right }
+  bsFDiagonal = FPCanvas.bsFDiagonal;
+  {** Draw diagonal lines from bottom-left to top-right }
+  bsBDiagonal = FPCanvas.bsBDiagonal;
+  {** Draw both horizontal and vertical lines }
+  bsCross = FPCanvas.bsCross;
+  {** Draw both diagonal lines }
+  bsDiagCross = FPCanvas.bsDiagCross;
+  {** Fills with an image }
+  bsImage = FPCanvas.bsImage;
+
+type
+  { TBrush }
+  {* A class describing a brush }
+  TBrush = class(TFPCustomBrush)
+  private
+    function GetColor: TColor;
+    procedure SetColor(AValue: TColor);
+  public
+    constructor Create; override;
+    {** Color of the brush }
+    property Color: TColor read GetColor write SetColor;
+    {** Style of the brush: solid, diagonal lines, horizontal lines... }
+    property Style;
+  end;
+
+  { TFont }
+  {* Contains the description of a font }
+  TFont = class(TFPCustomFont)
+  private
+    FPixelsPerInch, FHeight: Integer;
+    FQuality: TFontQuality;
+    FStyle: TFontStyles;
+    function GetColor: TColor;
+    function GetHeight: Integer;
+    function GetSize: Integer;
+    function GetStyle: TFontStyles;
+    procedure SetColor(AValue: TColor);
+    procedure SetHeight(AValue: Integer);
+    procedure SetQuality(AValue: TFontQuality);
+    procedure SetStyle(AValue: TFontStyles);
+  protected
+    procedure SetSize(AValue: Integer); override;
+  public
+    constructor Create; override;
+    {** Pixels per inches }
+    property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch;
+    {** Color of the font }
+    property Color: TColor read GetColor write SetColor;
+    {** Height of the font in pixels. When the number is negative, it indicates a size in pixels }
+    property Height: Integer read GetHeight write SetHeight;
+    {** Size of the font in inches. When the number is negative, it indicates a height in inches }
+    property Size: Integer read GetSize write SetSize;
+    {** Quality of the font rendering }
+    property Quality: TFontQuality read FQuality write SetQuality;
+    {** Style to apply to the text }
+    property Style: TFontStyles read GetStyle write SetStyle;
+  end;
+
+{$ENDIF}
+
+{$IFDEF INCLUDE_IMPLEMENTATION}
+{$UNDEF INCLUDE_IMPLEMENTATION}
+
+{ TPen }
+
+procedure TPen.SetColor(AValue: TColor);
+begin
+  FPColor := TColorToFPColor(AValue);
+end;
+
+function TPen.GetColor: TColor;
+begin
+  result := FPColorToTColor(FPColor);
+end;
+
+constructor TPen.Create;
+begin
+  inherited Create;
+  Mode := pmCopy;
+  Style := psSolid;
+  Width := 1;
+  FPColor := colBlack;
+  EndCap:= pecRound;
+  JoinStyle:= pjsRound;
+end;
+
+{ TBrush }
+
+function TBrush.GetColor: TColor;
+begin
+  result := FPColorToTColor(FPColor);
+end;
+
+procedure TBrush.SetColor(AValue: TColor);
+begin
+  FPColor := TColorToFPColor(AValue);
+end;
+
+constructor TBrush.Create;
+begin
+  inherited Create;
+  FPColor := colWhite;
+end;
+
+{ TFont }
+
+function TFont.GetColor: TColor;
+begin
+  result := FPColorToTColor(FPColor);
+end;
+
+function TFont.GetHeight: Integer;
+begin
+  result := FHeight;
+end;
+
+function TFont.GetSize: Integer;
+begin
+  Result := inherited Size;
+end;
+
+function TFont.GetStyle: TFontStyles;
+begin
+  result := FStyle;
+end;
+
+procedure TFont.SetColor(AValue: TColor);
+begin
+  FPColor := TColorToFPColor(AValue);
+end;
+
+procedure TFont.SetHeight(AValue: Integer);
+begin
+  if Height <> AValue then
+  begin
+    FHeight := AValue;
+    inherited SetSize(-MulDiv(AValue, 72, FPixelsPerInch));
+  end;
+end;
+
+procedure TFont.SetQuality(AValue: TFontQuality);
+begin
+  if FQuality=AValue then Exit;
+  FQuality:=AValue;
+end;
+
+procedure TFont.SetSize(AValue: Integer);
+begin
+  if Size <> AValue then
+  begin
+    inherited SetSize(AValue);
+    FHeight := -MulDiv(AValue, FPixelsPerInch, 72);
+  end;
+end;
+
+procedure TFont.SetStyle(AValue: TFontStyles);
+begin
+  if FStyle <> AValue then
+  begin
+    FStyle := AValue;
+    inherited SetFlags(5, fsBold in FStyle);
+    inherited SetFlags(6, fsItalic in FStyle);
+    inherited SetFlags(7, fsUnderline in FStyle);
+    inherited SetFlags(8, fsStrikeOut in FStyle);
+  end;
+end;
+
+constructor TFont.Create;
+begin
+  FPixelsPerInch := GetScreenDPIY;
+  FQuality := fqDefault;
+  FPColor := colBlack;
+end;
+
+{$ENDIF}

vendor/kam_remake/src/ext/BGRABitmap/bgrafpgui.inc

@@ -0,0 +1,78 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{$IFDEF INCLUDE_INTERFACE}
+{$UNDEF INCLUDE_INTERFACE}
+type
+  TColor = TfpgColor;
+  TRawImage = class(TfpgImage)
+    procedure BGRASetSizeAndTransparency(AWidth,AHeight: Integer; ATransparent: boolean);  
+  end;
+  TGUICanvas = TfpgCanvas;
+
+const
+  clNone = fpg_base.clNone;
+  clBlack = fpg_base.clBlack;
+  clWhite = fpg_base.clWhite;
+
+function clRgbBtnHighlight: TColor;
+function clRgbBtnShadow: TColor;
+function ColorToRGB(c: TColor): TColor; inline;
+function GetScreenDPIX: integer;
+function GetScreenDPIY: integer;
+
+{$ENDIF}
+
+{$IFDEF INCLUDE_IMPLEMENTATION}
+{$UNDEF INCLUDE_IMPLEMENTATION}
+
+procedure TRawImage.BGRASetSizeAndTransparency(AWidth,AHeight: Integer; ATransparent: boolean);  
+var
+  tempData: pointer;
+begin
+  if (Width <> AWidth) or (Height <> AHeight) then
+  begin
+    AllocateImage(32,AWidth,AHeight);
+    if ATransparent then AllocateMask;
+  end else
+  begin
+    if ATransparent and not Masked then AllocateMask else
+    if not ATransparent and Masked then
+    begin
+      getmem(tempData, ImageDataSize);
+      if tempData <> nil then
+      begin
+        move(ImageData^, tempData^, ImageDataSize);
+        FreeImage;
+        AllocateImage(32,AWidth,AHeight);
+        move(tempData^, ImageData^, ImageDataSize);
+        freemem(tempData);
+      end;
+    end;
+  end;
+end;
+
+function clRgbBtnHighlight: TColor;
+begin
+  result := fpgColorToRGB(fpg_base.clHilite2);
+end;
+
+function clRgbBtnShadow: TColor;
+begin
+  result := fpgColorToRGB(fpg_base.clShadow2);
+end;
+
+function ColorToRGB(c: TColor): TColor; inline;
+begin
+  result := fpgColorToRGB(c);
+end;
+
+function GetScreenDPIX: integer;
+begin
+  result := fpgApplication.Screen_dpi_x;
+end;
+
+function GetScreenDPIY: integer;
+begin
+  result := fpgApplication.Screen_dpi_y;
+end;
+
+{$ENDIF}

vendor/kam_remake/src/ext/BGRABitmap/bgrafpgui_uses.inc

@@ -0,0 +1 @@
+uses BGRAClasses, FPImage, FPCanvas, fpg_base, fpg_main;

vendor/kam_remake/src/ext/BGRABitmap/bgrafpguibitmap.pas

@@ -0,0 +1,268 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAfpGUIBitmap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, BGRAClasses, BGRAGraphics, BGRABitmapTypes, BGRADefaultBitmap,
+  BGRAFreeType, EasyLazFreeType, LazFreeTypeFontCollection,
+  BGRACanvas;
+
+type
+
+  { TBGRAfpGUIBitmap }
+
+  TBGRAfpGUIBitmap = class(TBGRADefaultBitmap)
+  private
+    FPseudoCanvas: TBGRACanvas;
+    function GetPseudoCanvas: TBGRACanvas;
+    function GetBitmapTransparent: boolean;
+    procedure SetBitmapTransparent(AValue: boolean);
+  protected
+    procedure RebuildBitmap; override;
+    function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override;
+    function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte;
+      AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean
+      =True): boolean; override;
+    procedure Init; override;
+    procedure FreeData; override;
+    procedure ReallocData; override;
+    procedure FreeBitmap; override;
+    procedure NotAvailable;
+  public
+    destructor Destroy; override;
+    class procedure AddFreeTypeFontFolder(ADirectory: string; AUTF8: boolean = false); static;
+    class procedure AddFreeTypeFontFile(AFilename: string; AUTF8: boolean = false); static;
+    procedure Draw(ACanvas: TCanvas; x, y: integer; {%H-}Opaque: boolean=True); override;
+    procedure Draw(ACanvas: TCanvas; Rect: TRect; {%H-}Opaque: boolean=True); override;
+    procedure Draw(ACanvas: TGUICanvas; x, y: integer; {%H-}Opaque: boolean=True); overload;
+    procedure Draw(ACanvas: TGUICanvas; Rect: TRect; {%H-}Opaque: boolean=True); overload;
+    procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //not available
+    procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
+      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
+    procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
+      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
+    procedure TakeScreenshot({%H-}ARect: TRect); override; //not available
+    procedure TakeScreenshotOfPrimaryMonitor; override; //not available
+    procedure LoadFromDevice({%H-}DC: HDC); override; //not available
+    procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; //not available
+    property BitmapTransparent: boolean read GetBitmapTransparent write SetBitmapTransparent;
+    property Canvas: TBGRACanvas read GetPseudoCanvas;
+  end;
+
+implementation
+
+{ TBGRAfpGUIBitmap }
+
+function TBGRAfpGUIBitmap.GetBitmapTransparent: boolean;
+begin
+  result := FBitmap.Transparent;
+end;
+
+function TBGRAfpGUIBitmap.GetPseudoCanvas: TBGRACanvas;
+begin
+  if FPseudoCanvas = nil then
+  begin
+    FPseudoCanvas := TBGRACanvas.Create(self);
+    FPseudoCanvas.AntialiasingMode := amOff;
+  end;
+  result := FPseudoCanvas;
+end;
+
+procedure TBGRAfpGUIBitmap.SetBitmapTransparent(AValue: boolean);
+begin
+  if FBitmap.Transparent <> AValue then
+  begin
+    FBitmap.Transparent:= AValue;
+    InvalidateBitmap;
+  end;
+end;
+
+procedure TBGRAfpGUIBitmap.RebuildBitmap;
+var pmask, pmaskline: PByte;
+  pdata: PBGRAPixel;
+  raw: TRawImage;
+  x,y,bit,masklinesize,curmaskbyte: UInt32or64;
+begin
+  if FBitmap.Transparent then
+  begin
+    raw := FBitmap.RawImage;
+    masklinesize := ((Width+31) div 32)*4;
+    pmaskline := FBitmap.RawImage.MaskData;
+    pdata := raw.ImageData;
+    for y := 0 to Height-1 do
+      begin
+        pmask:= pmaskline;
+        bit := $80;
+        curmaskbyte := 0;
+        for x := Width-1 downto 0 do
+        begin
+          if pdata^.alpha >= $80 then
+            curmaskbyte := curmaskbyte or bit;
+          bit := bit shr 1;
+          if bit = 0 then
+          begin
+            bit := $80;
+            pmask^ := curmaskbyte;
+            inc(pmask);
+            curmaskbyte := 0;
+          end;
+          inc(pdata);
+        end;
+        if bit <> $80 then
+          pmask^ := curmaskbyte;
+        inc(pmaskline, masklinesize);
+      end;
+  end;
+  FBitmap.RawImage.UpdateImage;
+end;
+
+function TBGRAfpGUIBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer;
+begin
+  result := TBGRAFreeTypeFontRenderer.Create;
+end;
+
+function TBGRAfpGUIBitmap.LoadFromRawImage(ARawImage: TRawImage;
+  DefaultOpacity: byte; AlwaysReplaceAlpha: boolean;
+  RaiseErrorOnInvalidPixelFormat: boolean): boolean;
+var
+  lineSize: integer;
+  y: Integer;
+begin
+  if (ARawImage.Width <> Width) or
+    (ARawImage.Height <> Height) then
+    raise Exception.Create('Bitmap size is inconsistent');
+
+  lineSize := Width*sizeof(TBGRAPixel);
+  for y := 0 to Height-1 do
+    move(ARawImage.ScanLine[y]^, ScanLine[y]^, lineSize);
+  if AlwaysReplaceAlpha then AlphaFill(DefaultOpacity);
+  result := true;
+end;
+
+procedure TBGRAfpGUIBitmap.Init;
+begin
+  inherited Init;
+  FBitmap := TBitmap.Create;
+  FontAntialias:= true;
+end;
+
+procedure TBGRAfpGUIBitmap.ReallocData;
+begin
+  FBitmap.Width := Width;
+  FBitmap.Height:= Height;
+  FDataByte := PByte(FBitmap.RawImage.ImageData);
+  InvalidateBitmap;
+  FScanPtr := nil;
+end;
+
+procedure TBGRAfpGUIBitmap.FreeData;
+begin
+  //nothing
+end;
+
+procedure TBGRAfpGUIBitmap.FreeBitmap;
+begin
+  //nothing
+end;
+
+procedure TBGRAfpGUIBitmap.NotAvailable;
+begin
+  raise exception.Create('Function not available with fpGUI');
+end;
+
+destructor TBGRAfpGUIBitmap.Destroy;
+begin
+  FreeAndNil(FBitmap);
+  FreeAndNil(FPseudoCanvas);
+  inherited Destroy;
+end;
+
+class procedure TBGRAfpGUIBitmap.AddFreeTypeFontFolder(ADirectory: string; AUTF8: boolean);
+begin
+  if AUTF8 then ADirectory:= Utf8ToAnsi(ADirectory);
+  EasyLazFreeType.FontCollection.AddFolder(ADirectory);
+end;
+
+class procedure TBGRAfpGUIBitmap.AddFreeTypeFontFile(AFilename: string; AUTF8: boolean);
+begin
+  if AUTF8 then AFilename:= Utf8ToAnsi(AFilename);
+  EasyLazFreeType.FontCollection.AddFile(AFilename);
+end;
+
+procedure TBGRAfpGUIBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean);
+begin
+  Draw(ACanvas.GUICanvas, x, y, Opaque);
+end;
+
+procedure TBGRAfpGUIBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean);
+begin
+  Draw(ACanvas.GUICanvas, Rect, Opaque);
+end;
+
+procedure TBGRAfpGUIBitmap.Draw(ACanvas: TGUICanvas; x, y: integer;
+  Opaque: boolean);
+begin
+  BitmapTransparent := not Opaque;
+  ACanvas.DrawImage(x,y, Bitmap.RawImage);
+end;
+
+procedure TBGRAfpGUIBitmap.Draw(ACanvas: TGUICanvas; Rect: TRect;
+  Opaque: boolean);
+begin
+  BitmapTransparent := not Opaque;
+  ACanvas.StretchDraw(rect.left,rect.top,rect.right-rect.left,rect.bottom-rect.top, FBitmap.RawImage);
+end;
+
+procedure TBGRAfpGUIBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x,
+  y: integer);
+begin
+  NotAvailable;
+end;
+
+procedure TBGRAfpGUIBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+var temp: TBGRAfpGUIBitmap;
+begin
+  temp := TBGRAfpGUIBitmap.Create(AWidth,AHeight);
+  move(AData^, temp.Data^, temp.NbPixels*sizeof(TBGRAPixel));
+  if ALineOrder <> temp.LineOrder then temp.VerticalFlip;
+  temp.Draw(ACanvas, Rect, False);
+  temp.Free;
+end;
+
+procedure TBGRAfpGUIBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+var temp: TBGRAfpGUIBitmap;
+begin
+  temp := TBGRAfpGUIBitmap.Create(AWidth,AHeight);
+  move(AData^, temp.Data^, temp.NbPixels*sizeof(TBGRAPixel));
+  if ALineOrder <> temp.LineOrder then temp.VerticalFlip;
+  temp.Draw(ACanvas, Rect, True);
+  temp.Free;
+end;
+
+procedure TBGRAfpGUIBitmap.TakeScreenshot(ARect: TRect);
+begin
+  NotAvailable;
+end;
+
+procedure TBGRAfpGUIBitmap.TakeScreenshotOfPrimaryMonitor;
+begin
+  NotAvailable;
+end;
+
+procedure TBGRAfpGUIBitmap.LoadFromDevice(DC: HDC);
+begin
+  NotAvailable;
+end;
+
+procedure TBGRAfpGUIBitmap.LoadFromDevice(DC: HDC; ARect: TRect);
+begin
+  NotAvailable;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgragradientoriginal.pas

@@ -0,0 +1,945 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAGradientOriginal;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRALayerOriginal, BGRABitmap, BGRABitmapTypes, BGRAGradientScanner,
+  BGRASVG, BGRASVGShapes, BGRASVGType;
+
+type
+  TBGRAColorInterpolation = BGRAGradientScanner.TBGRAColorInterpolation;
+  TBGRAGradientRepetition = BGRAGradientScanner.TBGRAGradientRepetition;
+  TBGRALayerGradientOriginal = class;
+
+  { TBGRAGradientOriginalDiff }
+
+  TBGRAGradientOriginalDiff = class(TBGRAOriginalDiff)
+  protected
+    FStorageBefore, FStorageAfter: TBGRAMemOriginalStorage;
+  public
+    constructor Create(AOriginal: TBGRALayerGradientOriginal);
+    procedure ComputeDifference(AOriginal: TBGRALayerGradientOriginal);
+    destructor Destroy; override;
+    procedure Apply(AOriginal: TBGRALayerCustomOriginal); override;
+    procedure Unapply(AOriginal: TBGRALayerCustomOriginal); override;
+    function CanAppend(ADiff: TBGRAOriginalDiff): boolean; override;
+    procedure Append(ADiff: TBGRAOriginalDiff); override;
+    function IsIdentity: boolean; override;
+  end;
+
+  { TBGRALayerGradientOriginal }
+
+  TBGRALayerGradientOriginal = class(TBGRALayerCustomOriginal)
+  private
+    function GetIsOpaque: boolean;
+    procedure SetColorInterpolation(AValue: TBGRAColorInterpolation);
+    procedure SetEndColor(AValue: TBGRAPixel);
+    procedure SetFocalPoint(AValue: TPointF);
+    procedure SetFocalRadius(AValue: Single);
+    procedure SetGradientType(AValue: TGradientType);
+    procedure SetOrigin(AValue: TPointF);
+    procedure SetRadius(AValue: Single);
+    procedure SetRepetition(AValue: TBGRAGradientRepetition);
+    procedure SetStartColor(AValue: TBGRAPixel);
+    procedure SetXAxis(AValue: TPointF);
+    procedure SetYAxis(AValue: TPointF);
+  protected
+    FStartColor,FEndColor: TBGRAPixel;
+    FGradientType: TGradientType;
+    FOrigin,FXAxis,FYAxis,FFocalPoint: TPointF;
+    FOriginBackup,FXAxisBackup, FYAxisBackup: TPointF;
+    FRadius,FFocalRadius: single;
+    FColorInterpolation: TBGRAColorInterpolation;
+    FRepetition: TBGRAGradientRepetition;
+    FUpdateCount: integer;
+    FUpdateDiff: TBGRAGradientOriginalDiff;
+    function GetAverageColor: TBGRAPixel;
+    function GetComputedRadius: single;
+    function GetComputedYAxis: TPointF;
+    function GetComputedFocalPoint: TPointF;
+    function GetComputedFocalRadius: single;
+    procedure OnMoveOrigin({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
+    procedure OnMoveXAxis({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
+    procedure OnMoveXAxisNeg({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
+    procedure OnMoveYAxis({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
+    procedure OnMoveFocalPoint({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
+    procedure OnMoveFocalRadius({%H-}ASender: TObject; {%H-}APrevCoord, ANewCoord: TPointF; {%H-}AShift: TShiftState);
+    procedure OnStartMove({%H-}ASender: TObject; {%H-}AIndex: integer; {%H-}AShift: TShiftState);
+    procedure BeginUpdate;
+    procedure EndUpdate;
+    procedure NotifyChangeWithoutDiff;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+    function ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; override;
+    function AddToSVGDefs(const AMatrix: TAffineMatrix; ADefs: TSVGDefine): TObject;
+    function IsInfiniteSurface: boolean; override;
+    procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); overload; override;
+    procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean; ADrawMode: TDrawMode); overload;
+    function CreateScanner(AMatrix: TAffineMatrix; ADraft: boolean = false): TBGRACustomScanner;
+    procedure ConfigureEditor(AEditor: TBGRAOriginalEditor); override;
+    function GetRenderBounds(ADestRect: TRect; {%H-}AMatrix: TAffineMatrix): TRect; override;
+    procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override;
+    procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override;
+    class function StorageClassName: RawByteString; override;
+    class function CanConvertToSVG: boolean; override;
+    property ComputedYAxis: TPointF read GetComputedYAxis;
+    property ComputedRadius: single read GetComputedRadius;
+    property ComputedFocalPoint: TPointF read GetComputedFocalPoint;
+    property ComputedFocalRadius: single read GetComputedFocalRadius;
+    procedure Transform(AMatrix: TAffineMatrix);
+    procedure AssignExceptGeometry(AOther: TBGRALayerGradientOriginal);
+    procedure FitGeometry(const ABox: TAffineBox);
+    procedure SetColors(AStartColor, AEndColor: TBGRAPixel);
+    procedure ApplyOpacity(AOpacity: byte);
+    function Equals(Obj: TObject): boolean; override;
+
+    property StartColor: TBGRAPixel read FStartColor write SetStartColor;
+    property EndColor: TBGRAPixel read FEndColor write SetEndColor;
+    property AverageColor: TBGRAPixel read GetAverageColor;
+    property GradientType: TGradientType read FGradientType write SetGradientType;   //default gtLinear
+    property Origin: TPointF read FOrigin write SetOrigin;
+    property XAxis: TPointF read FXAxis write SetXAxis;
+    property YAxis: TPointF read FYAxis write SetYAxis;
+    property FocalPoint: TPointF read FFocalPoint write SetFocalPoint;     //default Origin
+    property Radius: Single read FRadius write SetRadius;                  //default 1
+    property FocalRadius: Single read FFocalRadius write SetFocalRadius;   //default 0
+    property ColorInterpolation: TBGRAColorInterpolation read FColorInterpolation write SetColorInterpolation;
+    property Repetition: TBGRAGradientRepetition read FRepetition write SetRepetition;
+    property IsOpaque: boolean read GetIsOpaque;
+
+  end;
+
+implementation
+
+uses BGRATransform, BGRABlend, math;
+
+{ TBGRAGradientOriginalDiff }
+
+constructor TBGRAGradientOriginalDiff.Create(AOriginal: TBGRALayerGradientOriginal);
+begin
+  FStorageBefore := TBGRAMemOriginalStorage.Create;
+  AOriginal.SaveToStorage(FStorageBefore);
+end;
+
+procedure TBGRAGradientOriginalDiff.ComputeDifference(
+  AOriginal: TBGRALayerGradientOriginal);
+begin
+  if Assigned(FStorageAfter) then FreeAndNil(FStorageAfter);
+  FStorageAfter := TBGRAMemOriginalStorage.Create;
+  AOriginal.SaveToStorage(FStorageAfter);
+end;
+
+destructor TBGRAGradientOriginalDiff.Destroy;
+begin
+  FStorageBefore.Free;
+  FStorageAfter.Free;
+  inherited Destroy;
+end;
+
+procedure TBGRAGradientOriginalDiff.Apply(AOriginal: TBGRALayerCustomOriginal);
+begin
+  if not Assigned(FStorageAfter) then raise exception.Create('Undefined state after diff');
+  AOriginal.LoadFromStorage(FStorageAfter);
+  (AOriginal as TBGRALayerGradientOriginal).NotifyChangeWithoutDiff;
+end;
+
+procedure TBGRAGradientOriginalDiff.Unapply(AOriginal: TBGRALayerCustomOriginal);
+begin
+  if not Assigned(FStorageBefore) then raise exception.Create('Undefined state before diff');
+  AOriginal.LoadFromStorage(FStorageBefore);
+  (AOriginal as TBGRALayerGradientOriginal).NotifyChangeWithoutDiff;
+end;
+
+function TBGRAGradientOriginalDiff.CanAppend(ADiff: TBGRAOriginalDiff): boolean;
+begin
+  result := ADiff is TBGRAGradientOriginalDiff;
+end;
+
+procedure TBGRAGradientOriginalDiff.Append(ADiff: TBGRAOriginalDiff);
+var
+  next: TBGRAGradientOriginalDiff;
+begin
+  next := ADiff as TBGRAGradientOriginalDiff;
+  FreeAndNil(FStorageAfter);
+  FStorageAfter := next.FStorageAfter.Duplicate as TBGRAMemOriginalStorage;
+end;
+
+function TBGRAGradientOriginalDiff.IsIdentity: boolean;
+begin
+  result := FStorageBefore.Equals(FStorageAfter);
+end;
+
+{ TBGRALayerGradientOriginal }
+
+function TBGRALayerGradientOriginal.GetComputedRadius: single;
+begin
+  if FRadius = EmptySingle then result := 1 else result := FRadius;
+end;
+
+function TBGRALayerGradientOriginal.GetAverageColor: TBGRAPixel;
+begin
+  result := MergeBGRAWithGammaCorrection(StartColor, 1, EndColor, 1);
+end;
+
+function TBGRALayerGradientOriginal.GetIsOpaque: boolean;
+var
+  xLen, yLen, focalLen: Single;
+  focalCoord, u, v: TPointF;
+begin
+  result := (StartColor.alpha = 255) and (EndColor.alpha = 255);
+  if result and (GradientType = gtRadial) and not FocalPoint.IsEmpty and
+    not Origin.IsEmpty and not XAxis.IsEmpty then
+  begin
+    u := XAxis - Origin;
+    v := ComputedYAxis - Origin;
+    xLen := VectLen(u);
+    yLen := VectLen(v);
+    if (xLen = 0) or (yLen = 0) then
+      result := false
+    else
+    begin
+      focalCoord := PointF((FocalPoint - Origin)*u/sqr(xLen),
+                           (FocalPoint - Origin)*v/sqr(yLen));
+      focalLen := VectLen(focalCoord);
+      if (focalLen + ComputedFocalRadius + 0.01 >= ComputedRadius) and not
+        (ComputedFocalRadius > focalLen + ComputedRadius + 0.01) then
+        result := false;
+    end;
+  end;
+end;
+
+procedure TBGRALayerGradientOriginal.SetColorInterpolation(
+  AValue: TBGRAColorInterpolation);
+begin
+  if FColorInterpolation=AValue then Exit;
+  BeginUpdate;
+  FColorInterpolation:=AValue;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.SetEndColor(AValue: TBGRAPixel);
+begin
+  if FEndColor.EqualsExactly(AValue) then Exit;
+  BeginUpdate;
+  FEndColor:=AValue;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.SetFocalPoint(AValue: TPointF);
+begin
+  if FFocalPoint=AValue then Exit;
+  BeginUpdate;
+  FFocalPoint:=AValue;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.SetFocalRadius(AValue: Single);
+begin
+  if FFocalRadius=AValue then Exit;
+  BeginUpdate;
+  FFocalRadius:=AValue;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.SetGradientType(AValue: TGradientType);
+begin
+  if FGradientType=AValue then Exit;
+  BeginUpdate;
+  FGradientType:=AValue;
+  if FGradientType in [gtLinear,gtReflected] then FYAxis := EmptyPointF;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.SetOrigin(AValue: TPointF);
+begin
+  if FOrigin=AValue then Exit;
+  BeginUpdate;
+  FOrigin:=AValue;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.SetRadius(AValue: Single);
+begin
+  if FRadius=AValue then Exit;
+  BeginUpdate;
+  FRadius:=AValue;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.SetRepetition(
+  AValue: TBGRAGradientRepetition);
+begin
+  if FRepetition=AValue then Exit;
+  BeginUpdate;
+  FRepetition:=AValue;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.SetStartColor(AValue: TBGRAPixel);
+begin
+  if FStartColor.EqualsExactly(AValue) then Exit;
+  BeginUpdate;
+  FStartColor:=AValue;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.SetXAxis(AValue: TPointF);
+begin
+  if FXAxis=AValue then Exit;
+  BeginUpdate;
+  FXAxis:=AValue;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.SetYAxis(AValue: TPointF);
+begin
+  if FYAxis=AValue then Exit;
+  BeginUpdate;
+  FYAxis:=AValue;
+  EndUpdate;
+end;
+
+function TBGRALayerGradientOriginal.GetComputedYAxis: TPointF;
+var
+  u: TPointF;
+begin
+  if isEmptyPointF(FYAxis) then
+  begin
+    u := FXAxis - FOrigin;
+    result := FOrigin + PointF(-u.y,u.x)
+  end
+  else
+    result := FYAxis;
+end;
+
+function TBGRALayerGradientOriginal.GetComputedFocalPoint: TPointF;
+begin
+  if isEmptyPointF(FFocalPoint) then result := FOrigin else result := FFocalPoint;
+end;
+
+function TBGRALayerGradientOriginal.GetComputedFocalRadius: single;
+begin
+  if FFocalRadius = EmptySingle then result := 0 else result := FFocalRadius;
+end;
+
+procedure TBGRALayerGradientOriginal.OnMoveOrigin(ASender: TObject; APrevCoord,
+  ANewCoord: TPointF; AShift: TShiftState);
+var
+  delta: TPointF;
+begin
+  BeginUpdate;
+  delta := ANewCoord-APrevCoord;
+  FOrigin.Offset(delta);
+  FXAxis.Offset(delta);
+  FYAxis.Offset(delta);
+  FFocalPoint.Offset(delta);
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.OnMoveXAxis(ASender: TObject; APrevCoord,
+  ANewCoord: TPointF; AShift: TShiftState);
+var
+  m: TAffineMatrix;
+  c: TPointF;
+begin
+  BeginUpdate;
+  if not (ssAlt in AShift) or (GradientType in [gtLinear,gtReflected]) then
+  begin
+    if not isEmptyPointF(FYAxis) and not isEmptyPointF(FYAxisBackup) then
+    begin
+      m := AffineMatrixScaledRotation(FXAxisBackup, ANewCoord, FOrigin);
+      FYAxis := m*FYAxisBackup;
+    end;
+  end else
+    if isEmptyPointF(FYAxis) then FYAxis := ComputedYAxis;
+
+  if (GradientType = gtLinear) and (ssShift in AShift) then
+  begin
+    c := (FOriginBackup+FXAxisBackup)*0.5;
+    m := AffineMatrixScaledRotation(FXAxisBackup, ANewCoord, c);
+    FOrigin := m*FOriginBackup;
+  end
+  else
+    FOrigin := FOriginBackup;
+
+  FXAxis := ANewCoord;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.OnMoveXAxisNeg(ASender: TObject;
+  APrevCoord, ANewCoord: TPointF; AShift: TShiftState);
+var
+  delta, c: TPointF;
+  m: TAffineMatrix;
+begin
+  BeginUpdate;
+  delta := ANewCoord-APrevCoord;
+
+  if (GradientType = gtLinear) and (ssShift in AShift) then
+  begin
+    c := (FOriginBackup+FXAxisBackup)*0.5;
+    m := AffineMatrixScaledRotation(FOriginBackup, (FOrigin+delta), c);
+    FXAxis := m*FXAxisBackup;
+  end
+  else
+    FXAxis := FXAxisBackup;
+
+  FOrigin.Offset(delta);
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.OnMoveYAxis(ASender: TObject; APrevCoord,
+  ANewCoord: TPointF; AShift: TShiftState);
+var
+  m: TAffineMatrix;
+begin
+  BeginUpdate;
+  if not (ssAlt in AShift) or (GradientType in [gtLinear,gtReflected]) then
+  begin
+    if not isEmptyPointF(FXAxis) then
+    begin
+      m := AffineMatrixScaledRotation(FYAxisBackup, ANewCoord, FOrigin);
+      FXAxis := m*FXAxisBackup;
+    end;
+  end;
+  FYAxis := ANewCoord;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.OnMoveFocalPoint(ASender: TObject;
+  APrevCoord, ANewCoord: TPointF; AShift: TShiftState);
+begin
+  FocalPoint := ANewCoord;
+end;
+
+procedure TBGRALayerGradientOriginal.OnMoveFocalRadius(ASender: TObject;
+  APrevCoord, ANewCoord: TPointF; AShift: TShiftState);
+var refLen: single;
+  u, focalOrig: TPointF;
+begin
+  BeginUpdate;
+  focalOrig := ComputedFocalPoint;
+  if isEmptyPointF(focalOrig) or isEmptyPointF(FOrigin) or isEmptyPointF(FXAxis) then exit;
+  refLen := VectLen(FOrigin-FXAxis);
+  if refLen = 0 then exit;
+
+  u := (FOrigin-FXAxis)*(1/refLen);
+  FFocalRadius := u * (ANewCoord-focalOrig) / refLen - 0.1;
+  if FFocalRadius < 0 then FFocalRadius:= 0;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.OnStartMove(ASender: TObject;
+  AIndex: integer; AShift: TShiftState);
+begin
+  FOriginBackup := FOrigin;
+  FXAxisBackup := FXAxis;
+  FYAxisBackup := ComputedYAxis;
+end;
+
+procedure TBGRALayerGradientOriginal.BeginUpdate;
+begin
+  if DiffExpected and (FUpdateCount = 0) then
+    FUpdateDiff := TBGRAGradientOriginalDiff.Create(self);
+  inc(FUpdateCount);
+end;
+
+procedure TBGRALayerGradientOriginal.EndUpdate;
+begin
+  if FUpdateCount > 0 then
+  begin
+    dec(FUpdateCount);
+    if FUpdateCount = 0 then
+    begin
+      if Assigned(FUpdateDiff) then
+        FUpdateDiff.ComputeDifference(self);
+      NotifyChange(FUpdateDiff);
+      FUpdateDiff := nil;
+    end;
+  end;
+end;
+
+procedure TBGRALayerGradientOriginal.NotifyChangeWithoutDiff;
+begin
+  NotifyChange;
+end;
+
+constructor TBGRALayerGradientOriginal.Create;
+begin
+  inherited Create;
+  FStartColor := BGRABlack;
+  FEndColor := BGRAWhite;
+  FGradientType := gtLinear;
+  FColorInterpolation:= ciStdRGB;
+  FRepetition := grPad;
+  FRadius := EmptySingle;
+  FFocalRadius := EmptySingle;
+  FFocalPoint := EmptyPointF;
+  FOrigin := PointF(0,0);
+  FXAxis := EmptyPointF;
+  FYAxis := EmptyPointF;
+end;
+
+destructor TBGRALayerGradientOriginal.Destroy;
+begin
+  FUpdateDiff.Free;
+  inherited Destroy;
+end;
+
+function TBGRALayerGradientOriginal.ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject;
+var
+  svg: TBGRASVG;
+  def: TSVGDefine;
+  grad: TSVGGradient;
+  r: TSVGRectangle;
+begin
+  AOffset:= Point(0, 0);
+  svg := TBGRASVG.Create(640, 480, cuPixel);  // potentially infinite
+  result := svg;
+  def := svg.Content.AppendDefine;
+  grad := AddToSVGDefs(AMatrix, def) as TSVGGradient;
+  r := svg.Content.AppendRect(0, 0, 100, 100, cuPercent);
+  if Assigned(grad) then
+  begin
+    grad.ID := 'grad1';
+    r.fill:= 'url(#grad1)';
+  end else
+    r.fillColor := AverageColor;
+end;
+
+function TBGRALayerGradientOriginal.AddToSVGDefs(const AMatrix: TAffineMatrix;
+  ADefs: TSVGDefine): TObject;
+const ApproxCount = 16;
+  MaxReflectRepeatCount = 8;
+var
+  grad: TSVGGradient;
+  colors: TBGRASimpleGradient;
+  tOrigin, tXAxis, tYAxis, tFocalPoint, reflectedXAxis, repeatedXAxis: TPointF;
+  gt: TGradientType;
+
+  procedure AddColorStops(AOffset, AFactor: single; AIncludeStart: boolean);
+  var i, i0: integer;
+  begin
+    if (Repetition <> grSine) and (ColorInterpolation in [ciStdRGB, ciLinearRGB])  then
+    begin
+      if AFactor >= 0 then
+      begin
+        if AIncludeStart then
+          grad.Content.AppendStop(StartColor, AOffset, false);
+        grad.Content.AppendStop(EndColor, AOffset + AFactor*1, false);
+      end else
+      begin
+        grad.Content.AppendStop(EndColor, AOffset + AFactor*1, false);
+        if AIncludeStart then
+          grad.Content.AppendStop(StartColor, AOffset, false);
+      end;
+    end else
+    begin
+      colors := TBGRASimpleGradient.CreateAny(ColorInterpolation, StartColor,EndColor, Repetition);
+      try
+        if AIncludeStart then i0 := 0 else i0 := 1;
+        if AFactor >= 0 then
+        begin
+          for i := i0 to ApproxCount do
+            grad.Content.AppendStop(colors.GetColorAtF(i/ApproxCount), AOffset + AFactor*i/ApproxCount, false);
+        end else
+          for i := ApproxCount downto i0 do
+            grad.Content.AppendStop(colors.GetColorAtF(i/ApproxCount), AOffset + AFactor*i/ApproxCount, false);
+      finally
+        colors.Free;
+      end;
+    end;
+  end;
+
+var j: integer;
+  m: TAffineMatrix;
+  radialScale: Single;
+  fp, u, v: TPointF;
+  lenU, lenV: Single;
+
+begin
+  m := AffineMatrixTranslation(0.5, 0.5) * AMatrix;
+  tOrigin := m * Origin;
+  tXAxis := m * XAxis;
+  tYAxis := m * ComputedYAxis;
+  tFocalPoint := m * ComputedFocalPoint;
+  gt := GradientType;
+  if (GradientType = gtReflected) and (Repetition = grReflect) then
+    gt := gtLinear; // same as linear in this case
+  case gt of
+  gtLinear:
+      grad := ADefs.Content.AppendLinearGradient(tOrigin.X,tOrigin.Y,tXAxis.X,tXAxis.Y,cuCustom);
+  gtReflected:
+  begin
+    if Repetition <> grPad then j := MaxReflectRepeatCount else j := 1;
+    reflectedXAxis := tOrigin - j*(tXAxis - tOrigin);
+    repeatedXAxis := tOrigin + j*(tXAxis - tOrigin);
+    grad := ADefs.Content.AppendLinearGradient(reflectedXAxis.X,reflectedXAxis.Y,
+      repeatedXAxis.X,repeatedXAxis.Y,cuCustom);
+  end;
+  gtDiamond, gtRadial: // diamond approximated by radial
+    begin
+      u := tXAxis - tOrigin;
+      v := tYAxis - tOrigin;
+      lenU := u.Length;
+      lenV := v.Length;
+      radialScale := (lenU + lenV)/2;
+      if radialScale = 0 then
+        grad := ADefs.Content.AppendRadialGradient(tOrigin.X,tOrigin.Y,0,
+          tOrigin.X,tOrigin.Y,0, cuCustom)
+      else if (lenU = lenV) and (u*v = 0) then
+        grad := ADefs.Content.AppendRadialGradient(tOrigin.X,tOrigin.Y,radialScale*ComputedRadius,
+          tFocalPoint.X,tFocalPoint.Y,radialScale*ComputedFocalRadius, cuCustom)
+      else
+      begin
+        if lenU = 0 then lenU := 1;
+        if lenV = 0 then lenV := 1;
+        fp := PointF((tFocalPoint - tOrigin) * u / sqr(lenU),
+          (tFocalPoint - tOrigin)*v / sqr(lenV));
+        tFocalPoint := tOrigin + (fp.x * radialScale / lenU) * u + (fp.y * radialScale / lenV) * v;
+        grad := ADefs.Content.AppendRadialGradient(tOrigin.X,tOrigin.Y,radialScale*ComputedRadius,
+          tFocalPoint.X,tFocalPoint.Y,radialScale*ComputedFocalRadius, cuCustom);
+        grad.gradientMatrix[cuPixel] :=
+          AffineMatrix((1 / radialScale)*u, (1 / radialScale)*v, tOrigin) *
+          AffineMatrixTranslation(-tOrigin.X, -tOrigin.Y);
+      end;
+    end;
+  gtAngular: exit(nil); // not implemented
+  end;
+  case Repetition of
+  grPad: grad.spreadMethod := ssmPad;
+  grReflect: grad.spreadMethod := ssmReflect;
+  grRepeat, grSine: grad.spreadMethod := ssmRepeat;
+  end;
+  if gt = gtReflected then
+  begin
+    if Repetition <> grPad then
+    begin
+      for j := -MaxReflectRepeatCount+1 to 0 do
+        AddColorStops(0.5 + j/MaxReflectRepeatCount*0.5, -0.5/MaxReflectRepeatCount, true);
+      for j := 0 to MaxReflectRepeatCount-1 do
+        AddColorStops(0.5 + j*0.5/MaxReflectRepeatCount, 0.5/MaxReflectRepeatCount, j > 0);
+    end else
+    begin
+      AddColorStops(0.5, -0.5, true);
+      AddColorStops(0.5, 0.5, false);
+    end;
+  end else
+    AddColorStops(0, 1, true);
+  if ColorInterpolation = ciStdRGB then
+    grad.colorInterpolation := sciStdRGB
+    else grad.colorInterpolation := sciLinearRGB;
+  result := grad;
+end;
+
+function TBGRALayerGradientOriginal.IsInfiniteSurface: boolean;
+begin
+  Result:= true;
+end;
+
+procedure TBGRALayerGradientOriginal.Render(ADest: TBGRABitmap;
+  AMatrix: TAffineMatrix; ADraft: boolean);
+begin
+  Render(ADest,AMatrix,ADraft,dmSet);
+end;
+
+procedure TBGRALayerGradientOriginal.Render(ADest: TBGRABitmap;
+  AMatrix: TAffineMatrix; ADraft: boolean; ADrawMode: TDrawMode);
+var
+  grad: TBGRACustomScanner;
+  temp: TBGRABitmap;
+begin
+  if (ADrawMode in[dmDrawWithTransparency, dmLinearBlend, dmSetExceptTransparent]) and
+    IsOpaque then ADrawMode := dmSet;
+
+  if ADraft and (ADest.ClipRect.Width*ADest.ClipRect.Height > 512*512) then
+  begin
+    temp := TBGRABitmap.Create(0,0);
+    temp.SetSize(min(400,ADest.Width),min(400,ADest.Height));
+    Render(temp, AffineMatrixScale(temp.Width/ADest.Width,
+                                   temp.Height/ADest.Height)*AMatrix, ADraft);
+    ADest.StretchPutImage(rect(0,0,ADest.Width,Adest.Height),temp, ADrawMode);
+    temp.Free;
+  end else
+  begin
+    grad := CreateScanner(AMatrix, ADraft);
+    if ADraft then
+      ADest.FillRect(ADest.ClipRect, grad,ADrawMode)
+      else ADest.FillRect(ADest.ClipRect, grad,ADrawMode, daFloydSteinberg);
+    grad.Free;
+  end;
+end;
+
+function TBGRALayerGradientOriginal.CreateScanner(AMatrix: TAffineMatrix; ADraft: boolean): TBGRACustomScanner;
+var
+  colors: TBGRACustomGradient;
+  grad: TBGRAGradientScanner;
+begin
+  if isEmptyPointF(FOrigin) or isEmptyPointF(FXAxis) then exit(nil);
+
+  colors := TBGRASimpleGradient.CreateAny(FColorInterpolation, FStartColor,FEndColor, FRepetition);
+  if ADraft then
+    colors := TBGRABufferedGradient.Create(colors, true, FRepetition = grPad, 1024);
+
+  if FGradientType = gtRadial then
+  begin
+    grad := TBGRAGradientScanner.Create(FOrigin,FXAxis,ComputedYAxis,ComputedFocalPoint,ComputedRadius,ComputedFocalRadius);
+  end else
+    grad := TBGRAGradientScanner.Create(FGradientType, FOrigin,FXAxis,ComputedYAxis);
+
+  grad.SetGradient(colors, true);
+  grad.Transform := AMatrix;
+
+  exit(grad);
+end;
+
+procedure TBGRALayerGradientOriginal.ConfigureEditor(
+  AEditor: TBGRAOriginalEditor);
+var
+  originPoint: Integer;
+begin
+  if not isEmptyPointF(FOrigin) then
+  begin
+    AEditor.AddStartMoveHandler(@OnStartMove);
+
+    if not isEmptyPointF(FXAxis) and (FGradientType = gtLinear) then
+      originPoint := AEditor.AddPoint((FOrigin + FXAxis)*0.5, @OnMoveOrigin, true)
+    else originPoint := AEditor.AddPoint(FOrigin, @OnMoveOrigin, true);
+
+    if not isEmptyPointF(FXAxis) then
+    begin
+      if not isEmptyPointF(FXAxis) and (FGradientType = gtLinear) then
+      begin
+        AEditor.AddArrow((FOrigin + FXAxis)*0.5, FXAxis, @OnMoveXAxis);
+        AEditor.AddArrow((FOrigin + FXAxis)*0.5, FOrigin, @OnMoveXAxisNeg);
+      end
+      else AEditor.AddArrow(FOrigin, FXAxis, @OnMoveXAxis);
+
+      if FGradientType in[gtDiamond, gtRadial, gtAngular] then
+        AEditor.AddArrow(FOrigin, ComputedYAxis, @OnMoveYAxis);
+    end;
+    if FGradientType = gtRadial then
+    begin
+      AEditor.AddPoint(ComputedFocalPoint, @OnMoveFocalPoint, false, originPoint);
+      AEditor.AddArrow(ComputedFocalPoint, ComputedFocalPoint - (FXAxis - FOrigin) * (ComputedFocalRadius + 0.1), @OnMoveFocalRadius, false);
+    end;
+  end;
+end;
+
+function TBGRALayerGradientOriginal.GetRenderBounds(ADestRect: TRect;
+  AMatrix: TAffineMatrix): TRect;
+begin
+  result := ADestRect;
+end;
+
+procedure TBGRALayerGradientOriginal.LoadFromStorage(
+  AStorage: TBGRACustomOriginalStorage);
+var
+  colorArray: ArrayOfTBGRAPixel;
+begin
+  colorArray := AStorage.ColorArray['colors'];
+
+  FStartColor := colorArray[0];
+  FEndColor := colorArray[high(colorArray)];
+
+  case AStorage.RawString['gradient-type'] of
+  'reflected': FGradientType := gtReflected;
+  'radial': FGradientType := gtRadial;
+  'diamond': FGradientType := gtDiamond;
+  'angular': FGradientType := gtAngular;
+  else {'linear'} FGradientType := gtLinear;
+  end;
+
+  FOrigin := AStorage.PointF['origin'];
+  FXAxis := AStorage.PointF['x-axis'];
+  FYAxis := AStorage.PointF['y-axis'];
+  FFocalPoint := AStorage.PointF['focal-point'];
+
+  FRadius := AStorage.Float['radial'];
+  FFocalRadius := AStorage.Float['focal-radius'];
+
+  case AStorage.RawString['color-interpolation'] of
+  'RGB': FColorInterpolation:= ciLinearRGB;
+  'HSL+': FColorInterpolation:= ciLinearHSLPositive;
+  'HSL-': FColorInterpolation:= ciLinearHSLNegative;
+  'GSB+': FColorInterpolation:= ciGSBPositive;
+  'GSB-': FColorInterpolation:= ciGSBNegative;
+  else {'sRGB'} FColorInterpolation:= ciStdRGB;
+  end;
+
+  case AStorage.RawString['repetition'] of
+  'repeat': FRepetition:= grRepeat;
+  'reflect': FRepetition:= grReflect;
+  'sine': FRepetition := grSine;
+  else {'pad'} FRepetition:= grPad;
+  end;
+end;
+
+procedure TBGRALayerGradientOriginal.SaveToStorage(
+  AStorage: TBGRACustomOriginalStorage);
+var
+  gtStr, ciStr: String;
+  colorArray: ArrayOfTBGRAPixel;
+begin
+  setlength(colorArray,2);
+  colorArray[0] := FStartColor;
+  colorArray[1] := FEndColor;
+  AStorage.ColorArray['colors'] := colorArray;
+
+  case FGradientType of
+  gtReflected: gtStr := 'reflected';
+  gtRadial: gtStr := 'radial';
+  gtDiamond: gtStr := 'diamond';
+  gtAngular: gtStr := 'angular';
+  else {gtLinear} gtStr := 'linear';
+  end;
+  AStorage.RawString['gradient-type'] := gtStr;
+
+  AStorage.PointF['origin'] := FOrigin;
+  AStorage.PointF['x-axis'] := FXAxis;
+
+  if FGradientType in[gtRadial,gtDiamond,gtAngular] then
+    AStorage.PointF['y-axis'] := FYAxis
+  else
+    AStorage.RemoveAttribute('y-axis');
+
+  if FGradientType = gtRadial then
+  begin
+    AStorage.Float['radius'] := FRadius;
+    AStorage.Float['focal-radius'] := FFocalRadius;
+    AStorage.PointF['focal-point'] := FFocalPoint;
+  end else
+  begin
+    AStorage.RemoveAttribute('radius');
+    AStorage.RemoveAttribute('focal-radius');
+  end;
+
+  case FColorInterpolation of
+  ciLinearRGB: ciStr := 'RGB';
+  ciLinearHSLPositive: ciStr := 'HSL+';
+  ciLinearHSLNegative: ciStr := 'HSL-';
+  ciGSBPositive: ciStr := 'GSB+';
+  ciGSBNegative: ciStr := 'GSB-';
+  else {ciStdRGB} ciStr := 'sRGB';
+  end;
+  AStorage.RawString['color-interpolation'] := ciStr;
+
+  case FRepetition of
+  grRepeat: AStorage.RawString['repetition'] := 'repeat';
+  grReflect: AStorage.RawString['repetition'] := 'reflect';
+  grSine: AStorage.RawString['repetition'] := 'sine';
+  else {grPad} AStorage.RawString['repetition'] := 'pad';
+  end;
+end;
+
+class function TBGRALayerGradientOriginal.StorageClassName: RawByteString;
+begin
+  result := 'gradient';
+end;
+
+class function TBGRALayerGradientOriginal.CanConvertToSVG: boolean;
+begin
+  Result:= true;
+end;
+
+procedure TBGRALayerGradientOriginal.Transform(AMatrix: TAffineMatrix);
+begin
+  BeginUpdate;
+  if not isEmptyPointF(FOrigin) then FOrigin := AMatrix*FOrigin;
+  if not isEmptyPointF(FXAxis) then FXAxis := AMatrix*FXAxis;
+  if not isEmptyPointF(FYAxis) then FYAxis := AMatrix*FYAxis;
+  if not isEmptyPointF(FFocalPoint) then FFocalPoint := AMatrix*FFocalPoint;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.AssignExceptGeometry(
+  AOther: TBGRALayerGradientOriginal);
+begin
+  if (GradientType = AOther.GradientType) and
+    (StartColor.EqualsExactly(AOther.StartColor)) and
+    (EndColor.EqualsExactly(AOther.EndColor)) and
+    (ColorInterpolation = AOther.ColorInterpolation) and
+    (Repetition = AOther.Repetition) then exit;
+  BeginUpdate;
+  GradientType := AOther.GradientType;
+  StartColor:= AOther.StartColor;
+  EndColor:= AOther.EndColor;
+  ColorInterpolation:= AOther.ColorInterpolation;
+  Repetition:= AOther.Repetition;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.FitGeometry(const ABox: TAffineBox);
+begin
+  BeginUpdate;
+  if GradientType = gtLinear then
+  begin
+    Origin := ABox.TopLeft;
+    XAxis := ABox.BottomRight;
+  end else
+  begin
+    Origin := (ABox.TopLeft + ABox.BottomRight)*0.5;
+    if GradientType = gtReflected then
+      XAxis := ABox.BottomRight
+    else
+    begin
+      XAxis := (ABox.TopRight + ABox.BottomRight)*0.5;
+      YAxis := (ABox.BottomLeft + ABox.BottomRight)*0.5;
+    end;
+  end;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.SetColors(AStartColor,
+  AEndColor: TBGRAPixel);
+begin
+  if (AStartColor = StartColor) and (AEndColor = EndColor) then exit;
+  BeginUpdate;
+  StartColor := AStartColor;
+  EndColor := AEndColor;
+  EndUpdate;
+end;
+
+procedure TBGRALayerGradientOriginal.ApplyOpacity(AOpacity: byte);
+var
+  cStart, cEnd: TBGRAPixel;
+begin
+  cStart := StartColor;
+  cStart.alpha := BGRABlend.ApplyOpacity(cStart.alpha, AOpacity);
+  cEnd := EndColor;
+  cEnd.alpha := BGRABlend.ApplyOpacity(cEnd.alpha, AOpacity);
+  SetColors(cStart, cEnd);
+end;
+
+function TBGRALayerGradientOriginal.Equals(Obj: TObject): boolean;
+var
+  other: TBGRALayerGradientOriginal;
+begin
+  if Obj is TBGRALayerGradientOriginal then
+  begin
+    other := TBGRALayerGradientOriginal(Obj);
+    result := StartColor.EqualsExactly(other.StartColor) and
+              EndColor.EqualsExactly(other.EndColor) and
+              (GradientType = other.GradientType) and
+              (Origin = other.Origin) and
+              (XAxis = other.XAxis) and
+              ((GradientType in[gtLinear, gtReflected]) or
+               (YAxis = other.YAxis)) and
+              ((GradientType <> gtRadial) or
+               ((FocalPoint = other.FocalPoint) and
+                (FocalRadius = other.FocalRadius))) and
+              (ColorInterpolation = other.ColorInterpolation) and
+              (Repetition = other.Repetition);
+  end else
+    Result:=inherited Equals(Obj);
+end;
+
+initialization
+
+  RegisterLayerOriginal(TBGRALayerGradientOriginal);
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgragraphics.pas

@@ -0,0 +1,724 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAGraphics;
+{=== Types imported from Graphics ===}
+{$mode objfpc}{$H+}
+{$I bgrabitmap.inc}
+
+interface
+
+{$IFDEF BGRABITMAP_USE_LCL}
+uses Graphics, GraphType, FPImage, FPCanvas;
+
+type
+  PColor = Graphics.PColor;
+  TColor = Graphics.TColor;
+  TAntialiasingMode = Graphics.TAntialiasingMode;
+  TGradientDirection = Graphics.TGradientDirection;
+  TPenEndCap = Graphics.TPenEndCap;
+  TPenJoinStyle = Graphics.TPenJoinStyle;
+  TPenStyle = Graphics.TPenStyle;
+  TPenMode = Graphics.TPenMode;
+
+const
+  amDontCare = Graphics.amDontCare;
+  amOn = Graphics.amOn;
+  amOff = Graphics.amOff;
+
+  gdVertical = Graphics.gdVertical;
+  gdHorizontal = Graphics.gdHorizontal;
+
+  pecRound = Graphics.pecRound;
+  pecSquare = Graphics.pecSquare;
+  pecFlat = Graphics.pecFlat;
+
+  pjsRound = Graphics.pjsRound;
+  pjsBevel = Graphics.pjsBevel;
+  pjsMiter = Graphics.pjsMiter;
+
+  psSolid = Graphics.psSolid;
+  psDash = Graphics.psDash;
+  psDot = Graphics.psDot;
+  psDashDot = Graphics.psDashDot;
+  psDashDotDot = Graphics.psDashDotDot;
+  psClear = Graphics.psClear;
+  psInsideframe = Graphics.psInsideframe;
+  psPattern = Graphics.psPattern;
+
+  pmBlack = Graphics.pmBlack;
+  pmWhite = Graphics.pmWhite;
+  pmNop = Graphics.pmNop;
+  pmNot = Graphics.pmNot;
+  pmCopy = Graphics.pmCopy;
+  pmNotCopy = Graphics.pmNotCopy;
+  pmMergePenNot = Graphics.pmMergePenNot;
+  pmMaskPenNot = Graphics.pmMaskPenNot;
+  pmMergeNotPen = Graphics.pmMergeNotPen;
+  pmMaskNotPen = Graphics.pmMaskNotPen;
+  pmMerge = Graphics.pmMerge;
+  pmNotMerge = Graphics.pmNotMerge;
+  pmMask = Graphics.pmMask;
+  pmNotMask = Graphics.pmNotMask;
+  pmXor = Graphics.pmXor;
+  pmNotXor = Graphics.pmNotXor;
+
+  tmAuto = Graphics.tmAuto;
+  tmFixed = Graphics.tmFixed;
+
+type
+  TPen = Graphics.TPen;
+  TTextLayout = Graphics.TTextLayout;
+  TTextStyle = Graphics.TTextStyle;
+
+  TFillStyle = Graphics.TFillStyle;
+  TFillMode = Graphics.TFillMode;
+  TBrushStyle = Graphics.TBrushStyle;
+
+const
+  tlTop = Graphics.tlTop;
+  tlCenter = Graphics.tlCenter;
+  tlBottom = Graphics.tlBottom;
+
+  fsSurface = GraphType.fsSurface;
+  fsBorder = GraphType.fsBorder;
+
+  fmAlternate = Graphics.fmAlternate;
+  fmWinding = Graphics.fmWinding;
+
+  bsSolid = Graphics.bsSolid;
+  bsClear = Graphics.bsClear;
+  bsHorizontal = Graphics.bsHorizontal;
+  bsVertical = Graphics.bsVertical;
+  bsFDiagonal = Graphics.bsFDiagonal;
+  bsBDiagonal = Graphics.bsBDiagonal;
+  bsCross = Graphics.bsCross;
+  bsDiagCross = Graphics.bsDiagCross;
+  bsImage = FPCanvas.bsImage;
+
+type
+  TBrush = Graphics.TBrush;
+  TCanvas = Graphics.TCanvas;
+  TGraphic = Graphics.TGraphic;
+  TRawImage = GraphType.TRawImage;
+  TBitmap = Graphics.TBitmap;
+
+  TRasterImage = Graphics.TRasterImage;
+
+  TFontStyle = Graphics.TFontStyle;
+  TFontStyles = Graphics.TFontStyles;
+  TFontQuality = Graphics.TFontQuality;
+
+type
+  TFont = Graphics.TFont;
+
+const
+  fsBold = Graphics.fsBold;
+  fsItalic = Graphics.fsItalic;
+  fsStrikeOut = Graphics.fsStrikeOut;
+  fsUnderline = Graphics.fsUnderline;
+
+  fqDefault = Graphics.fqDefault;
+  fqDraft = Graphics.fqDraft;
+  fqProof = Graphics.fqProof;
+  fqNonAntialiased = Graphics.fqNonAntialiased;
+  fqAntialiased = Graphics.fqAntialiased;
+  fqCleartype = Graphics.fqCleartype;
+  fqCleartypeNatural = Graphics.fqCleartypeNatural;
+
+  clNone = Graphics.clNone;
+
+  clBlack   = Graphics.clBlack;
+  clMaroon  = Graphics.clMaroon;
+  clGreen   = Graphics.clGreen;
+  clOlive   = Graphics.clOlive;
+  clNavy    = Graphics.clNavy;
+  clPurple  = Graphics.clPurple;
+  clTeal    = Graphics.clTeal;
+  clGray    = Graphics.clGray;
+  clSilver  = Graphics.clSilver;
+  clRed     = Graphics.clRed;
+  clLime    = Graphics.clLime;
+  clYellow  = Graphics.clYellow;
+  clBlue    = Graphics.clBlue;
+  clFuchsia = Graphics.clFuchsia;
+  clAqua    = Graphics.clAqua;
+  clLtGray  = Graphics.clLtGray; // clSilver alias
+  clDkGray  = Graphics.clDkGray; // clGray alias
+  clWhite   = Graphics.clWhite;
+
+function FPColorToTColor(const FPColor: TFPColor): TColor; inline;
+function TColorToFPColor(const c: TColor): TFPColor; inline;
+function ColorToRGB(c: TColor): TColor; inline;
+function RGBToColor(R, G, B: Byte): TColor; inline;
+procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); inline;// does not work on system color
+function clRgbBtnHighlight: TColor;
+function clRgbBtnShadow: TColor;
+
+implementation
+
+function FPColorToTColor(const FPColor: TFPColor): TColor;
+begin
+  result := Graphics.FPColorToTColor(FPColor);
+end;
+
+function TColorToFPColor(const c: TColor): TFPColor;
+begin
+  result := Graphics.TColorToFPColor(c);
+end;
+
+function ColorToRGB(c: TColor): TColor;
+begin
+  result := Graphics.ColorToRGB(c);
+end;
+
+function RGBToColor(R, G, B: Byte): TColor;
+begin
+  result := Graphics.RGBToColor(R, G, B);
+end;
+
+procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte);
+begin
+  Graphics.RedGreenBlue(rgb, Red, Green, Blue);
+end;
+
+function clRgbBtnHighlight: TColor;
+begin
+  result := Graphics.ColorToRGB(clBtnHighlight);
+end;
+
+function clRgbBtnShadow: TColor;
+begin
+  result := Graphics.ColorToRGB(clBtnShadow);
+end;
+
+{$ELSE}
+
+{$IFDEF BGRABITMAP_USE_MSEGUI}
+  {$i bgramsegui_uses.inc}
+{$ELSE}
+  {$IFDEF BGRABITMAP_USE_FPGUI}
+    {$i bgrafpgui_uses.inc}
+  {$ELSE}
+    {$i bgranogui_uses.inc}
+  {$ENDIF}
+{$ENDIF}
+
+type
+  TTransparentMode = (tmAuto, tmFixed);
+  TGraphic = class;
+
+{$DEFINE INCLUDE_INTERFACE}
+{$IFDEF BGRABITMAP_USE_MSEGUI}
+  {$i bgramsegui.inc}
+{$ELSE}
+  {$IFDEF BGRABITMAP_USE_FPGUI}
+    {$i bgrafpgui.inc}
+  {$ELSE}
+    {$i bgranogui.inc}
+  {$ENDIF}
+{$ENDIF}
+
+type
+  {* Pointer to a ''TColor'' value }
+  PColor = ^TColor;
+  {* Contains a color stored as RGB. The red/green/blue values
+   range from 0 to 255. The formula to get the color value is:
+   * ''color'' = ''red'' + (''green'' '''shl''' 8) + (''blue'' '''shl''' 16)
+   *except with fpGUI where it is:
+   * ''color'' = (''red'' '''shl''' 16) + (''green'' '''shl''' 8) + ''blue'' }{import
+  TColor = Int32;
+  }
+  {** Converts a ''TFPColor'' into a ''TColor'' value }
+  function FPColorToTColor(const FPColor: TFPColor): TColor;
+  {** Converts a ''TColor'' into a ''TFPColor'' value }
+  function TColorToFPColor(const c: TColor): TFPColor;
+
+  function RGBToColor(R, G, B: Byte): TColor; inline;
+  procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); // does not work on system color
+
+type
+  {* Direction of change in a gradient }
+  TGradientDirection = (
+    {** Color changes vertically }
+    gdVertical,
+    {** Color changes horizontally }
+    gdHorizontal);
+
+  {* Antialiasing mode for a Canvas }
+  TAntialiasingMode = (
+    {** It does not matter if there is antialiasing or not }
+    amDontCare,
+    {** Antialiasing is required (BGRACanvas provide it) }
+    amOn,
+    {** Antialiasing is disabled }
+    amOff);
+
+type
+  {* Vertical position of a text }
+  TTextLayout = (tlTop, tlCenter, tlBottom);
+  {* Styles to describe how a text is drawn in a rectangle }
+  TTextStyle = packed record
+    {** Horizontal alignment }
+    Alignment : TAlignment;
+
+    {** Vertical alignment }
+    Layout    : TTextLayout;
+
+    {** If WordBreak is false then process #13, #10 as
+        standard chars and perform no Line breaking }
+    SingleLine: boolean;
+
+    {** Clip Text to passed Rectangle }
+    Clipping  : boolean;
+
+    {** Replace #9 by apropriate amount of spaces (default is usually 8) }
+    ExpandTabs: boolean;
+
+    {** Process first single '&' per line as an underscore and draw '&&' as '&' }
+    ShowPrefix: boolean;
+
+    {** If line of text is too long too fit between left and right boundaries
+        try to break into multiple lines between words. See also ''EndEllipsis'' }
+    Wordbreak : boolean;
+
+    {** Fills background with current brush }
+    Opaque    : boolean;
+
+    {** Use the system font instead of canvas font }
+    SystemFont: Boolean;
+
+    {** For RightToLeft text reading (Text Direction) }
+    RightToLeft: Boolean;
+
+    {** If line of text is too long to fit between left and right boundaries
+        truncates the text and adds "...". If Wordbreak is set as well,
+        Workbreak will dominate }
+    EndEllipsis: Boolean;
+  end;
+
+  {* Option for floodfill (used in BGRACanvas) }
+  TFillStyle =
+    (
+      {** Fill up to the color (it fills all except the specified color) }
+      fsSurface,
+      {** Fill the specified color (it fills only connected pixels of this color) }
+      fsBorder
+    );
+  {* How to handle polygons that intersect with themselves and
+     overlapping polygons }
+  TFillMode = (
+    {** Each time a boundary is found, it enters or exit the filling zone }
+    fmAlternate,
+    {** Adds or subtract 1 depending on the order of the points of the
+        polygons (clockwise or counter clockwise) and fill when the
+        result is non-zero. So, to draw a hole, you must specify the points
+        of the hole in the opposite order }
+    fmWinding);
+
+type
+  {$IFNDEF TFontStyle}
+  {* Available font styles }
+  TFontStyle = (
+    {** Font is bold }
+    fsBold,
+    {** Font is italic }
+    fsItalic,
+    {** An horizontal line is drawn in the middle of the text }
+    fsStrikeOut,
+    {** Text is underlined }
+    fsUnderline);
+  {** A combination of font styles }
+  TFontStyles = set of TFontStyle;
+  {$ENDIF}
+  {$IFNDEF TFontQuality}
+  {* Quality to use when font is rendered by the system }
+  TFontQuality = (fqDefault, fqDraft, fqProof, fqNonAntialiased, fqAntialiased, fqCleartype, fqCleartypeNatural);
+  {$ENDIF}
+
+  {$IFNDEF TCanvas}
+  { TCanvas }
+  {* A surface on which to draw }
+  TCanvas = class
+  protected
+    FCanvas: TGUICanvas;
+  public
+    constructor Create(ACanvas: TGUICanvas);
+    {** Draw an image with top-left corner at (''x'',''y'') }
+    procedure Draw(x,y: integer; AImage: TGraphic);
+    {** Draw and stretch an image within the rectangle ''ARect'' }
+    procedure StretchDraw(ARect: TRect; AImage: TGraphic);
+    property GUICanvas: TGUICanvas read FCanvas;
+  end;
+  {$ENDIF}
+
+  { TGraphic }
+  {* A class containing any element that can be drawn within rectangular bounds }
+  TGraphic = class(TPersistent)
+  protected
+    procedure Draw(ACanvas: TCanvas; const Rect: TRect); virtual; abstract;
+    function GetEmpty: Boolean; virtual; abstract;
+    function GetHeight: Integer; virtual; abstract;
+    function GetWidth: Integer; virtual; abstract;
+    function GetTransparent: Boolean; virtual; abstract;
+    procedure SetTransparent(Value: Boolean); virtual; abstract;
+    procedure SetHeight(Value: Integer); virtual; abstract;
+    procedure SetWidth(Value: Integer); virtual; abstract;
+    function GetMimeType: string; virtual;
+  public
+    constructor Create; virtual;
+    {** Load the content from a given file }
+    procedure LoadFromFile({%H-}const Filename: string); virtual;
+    {** Load the content from a given stream }
+    procedure LoadFromStream(Stream: TStream); virtual; abstract;
+    {** Saves the content to a file }
+    procedure SaveToFile({%H-}const Filename: string); virtual;
+    {** Saves the content into a given stream }
+    procedure SaveToStream(Stream: TStream); virtual; abstract;
+    {** Returns the list of possible file extensions }
+    class function GetFileExtensions: string; virtual;
+    {** Clears the content }
+    procedure Clear; virtual;
+  public
+    {** Returns if the content is completely empty }
+    property Empty: Boolean read GetEmpty;
+    {** Returns the height of the bounding rectangle }
+    property Height: Integer read GetHeight write SetHeight;
+    {** Returns the width of the bounding rectangle }
+    property Width: Integer read GetWidth write SetWidth;
+    {** Gets or sets if it is drawn with transparency }
+    property Transparent: Boolean read GetTransparent write SetTransparent;
+  end;
+
+  {$IFNDEF TBitmap}
+  { TBitmap }
+  {* Contains a bitmap }
+  TBitmap = class(TGraphic)
+  private
+    FHeight: integer;
+    FWidth: integer;
+    FInDraw: boolean;
+    FTransparent: boolean;
+    FTransparentColor: TColor;
+    FTransparentMode: TTransparentMode;
+    function GetCanvas: TCanvas;
+    function GetRawImage: TRawImage;
+    procedure SetTransparentColor(AValue: TColor);
+    procedure SetTransparentMode(AValue: TTransparentMode);
+  protected
+    FRawImage: TRawImage;
+    procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
+    procedure Changed(Sender: TObject); virtual;
+    function GetHeight: Integer; override;
+    function GetWidth: Integer; override;
+    procedure SetHeight(Value: Integer); override;
+    procedure SetWidth(Value: Integer); override;
+    function GetEmpty: Boolean; override;
+    function GetTransparent: Boolean; override;
+    procedure SetTransparent({%H-}Value: Boolean); override;
+    function GetMimeType: string; override;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+    procedure LoadFromStream({%H-}Stream: TStream); override;
+    procedure SaveToStream({%H-}Stream: TStream); override;
+    {** Width of the bitmap in pixels }
+    property Width: integer read GetWidth write SetWidth;
+    {** Height of the bitmap in pixels }
+    property Height: integer read GetHeight write SetHeight;
+    property RawImage: TRawImage read GetRawImage;
+    property Canvas: TCanvas read GetCanvas;
+    property TransparentColor: TColor read FTransparentColor
+             write SetTransparentColor default clDefault;
+    property TransparentMode: TTransparentMode read FTransparentMode
+             write SetTransparentMode default tmAuto;
+  end;
+  {$ENDIF}
+
+{* Multiply and divide the number allowing big intermediate number and rounding the result }
+function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer;
+{* Round the number using math convention }
+function MathRound(AValue: ValReal): Int64; inline;
+
+{$IFDEF BGRABITMAP_USE_FPCANVAS}
+{$DEFINE INCLUDE_INTERFACE}
+{$i bgrafpcanvas.inc}
+{$ENDIF}
+
+implementation
+
+uses sysutils, BGRAUTF8;
+
+{$DEFINE INCLUDE_IMPLEMENTATION}
+{$IFDEF BGRABITMAP_USE_MSEGUI}
+  {$i bgramsegui.inc}
+{$ELSE}
+  {$IFDEF BGRABITMAP_USE_FPGUI}
+    {$i bgrafpgui.inc}
+  {$ELSE}
+    {$i bgranogui.inc}
+  {$ENDIF}
+{$ENDIF}
+
+function MathRound(AValue: ValReal): Int64; inline;
+begin
+  if AValue >= 0 then
+    Result := Trunc(AValue + 0.5)
+  else
+    Result := Trunc(AValue - 0.5);
+end;
+
+function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer;
+begin
+  if nDenominator = 0 then
+    Result := -1
+  else
+    Result := MathRound(int64(nNumber) * int64(nNumerator) / nDenominator);
+end;
+
+function FPColorToTColor(const FPColor: TFPColor): TColor;
+begin
+  {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}
+  Result:=((FPColor.Blue shr 8) and $ff)
+       or (FPColor.Green and $ff00)
+       or ((FPColor.Red shl 8) and $ff0000);
+  {$ELSE}
+  Result:=((FPColor.Red shr 8) and $ff)
+       or (FPColor.Green and $ff00)
+       or ((FPColor.Blue shl 8) and $ff0000);
+  {$ENDIF}
+end;
+
+function TColorToFPColor(const c: TColor): TFPColor;
+begin
+  {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}
+  Result.Blue:=(c and $ff);
+  Result.Blue:=Result.Blue+(Result.Blue shl 8);
+  Result.Green:=(c and $ff00);
+  Result.Green:=Result.Green+(Result.Green shr 8);
+  Result.Red:=(c and $ff0000) shr 8;
+  Result.Red:=Result.Red+(Result.Red shr 8);
+  {$ELSE}
+  Result.Red:=(c and $ff);
+  Result.Red:=Result.Red+(Result.Red shl 8);
+  Result.Green:=(c and $ff00);
+  Result.Green:=Result.Green+(Result.Green shr 8);
+  Result.Blue:=(c and $ff0000) shr 8;
+  Result.Blue:=Result.Blue+(Result.Blue shr 8);
+  {$ENDIF}
+  Result.Alpha:=FPImage.alphaOpaque;
+end;
+
+procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte);
+begin
+  {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}
+  Blue := rgb and $000000ff;
+  Green := (rgb shr 8) and $000000ff;
+  Red := (rgb shr 16) and $000000ff;
+  {$ELSE}
+  Red := rgb and $000000ff;
+  Green := (rgb shr 8) and $000000ff;
+  Blue := (rgb shr 16) and $000000ff;
+  {$ENDIF}
+end;
+
+function RGBToColor(R, G, B: Byte): TColor;
+begin
+  {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}
+  Result := (R shl 16) or (G shl 8) or B;
+  {$ELSE}
+  Result := (B shl 16) or (G shl 8) or R;
+  {$ENDIF}
+end;
+
+{ TGraphic }
+
+function TGraphic.GetMimeType: string;
+begin
+  result := '';
+end;
+
+constructor TGraphic.Create;
+begin
+  //nothing
+end;
+
+procedure TGraphic.LoadFromFile(const Filename: string);
+var
+  Stream: TStream;
+begin
+  Stream := TFileStreamUTF8.Create(Filename, fmOpenRead or fmShareDenyWrite);
+  try
+    LoadFromStream(Stream);
+  finally
+    Stream.Free;
+  end;
+end;
+
+procedure TGraphic.SaveToFile(const Filename: string);
+var
+  Stream: TStream;
+begin
+  Stream := TFileStreamUTF8.Create(Filename, fmCreate);
+  try
+    SaveToStream(Stream);
+  finally
+    Stream.Free;
+  end;
+end;
+
+class function TGraphic.GetFileExtensions: string;
+begin
+  result := '';
+end;
+
+procedure TGraphic.Clear;
+begin
+  //nothing
+end;
+
+{$IFNDEF TCanvas}
+{ TCanvas }
+
+constructor TCanvas.Create(ACanvas: TGUICanvas);
+begin
+  FCanvas := ACanvas;
+end;
+
+procedure TCanvas.Draw(x, y: integer; AImage: TGraphic);
+begin
+  if AImage is TBitmap then
+    FCanvas.DrawImage(x,y, TBitmap(AImage).RawImage)
+  else
+    AImage.Draw(self, rect(x,y,x+AImage.Width,y+AImage.Height));
+end;
+
+procedure TCanvas.StretchDraw(ARect: TRect; AImage: TGraphic);
+begin
+  if AImage is TBitmap then
+    FCanvas.StretchDraw(ARect.Left,ARect.Top,ARect.Right-ARect.Left,ARect.Bottom-ARect.Top, TBitmap(AImage).RawImage)
+  else
+    AImage.Draw(self, ARect);
+end;
+{$ENDIF}
+
+{$IFNDEF TBitmap}
+{ TBitmap }
+
+procedure TBitmap.SetWidth(Value: Integer);
+begin
+  if FWidth=Value then Exit;
+  FWidth:=Value;
+end;
+
+function TBitmap.GetEmpty: Boolean;
+begin
+  result := (Width = 0) or (Height = 0);
+end;
+
+function TBitmap.GetTransparent: Boolean;
+begin
+  result := FTransparent;
+end;
+
+procedure TBitmap.SetTransparent(Value: Boolean);
+begin
+  if Value = FTransparent then exit;
+  FTransparent:= Value;
+end;
+
+procedure TBitmap.SetTransparentColor(AValue: TColor);
+begin
+  if FTransparentColor = AValue then exit;
+  FTransparentColor := AValue;
+
+  if AValue = clDefault
+  then FTransparentMode := tmAuto
+  else FTransparentMode := tmFixed;
+end;
+
+procedure TBitmap.SetTransparentMode(AValue: TTransparentMode);
+begin
+  if AValue = TransparentMode then exit;
+  FTransparentMode := AValue;
+
+  if AValue = tmAuto
+  then TransparentColor := clDefault
+end;
+
+function TBitmap.GetMimeType: string;
+begin
+  Result:= 'image/bmp';
+end;
+
+procedure TBitmap.Changed(Sender: TObject);
+begin
+  //nothing
+end;
+
+procedure TBitmap.LoadFromStream(Stream: TStream);
+begin
+  raise exception.Create('Not implemented');
+end;
+
+procedure TBitmap.SaveToStream(Stream: TStream);
+begin
+  raise exception.Create('Not implemented');
+end;
+
+procedure TBitmap.SetHeight(Value: Integer);
+begin
+  if FHeight=Value then Exit;
+  FHeight:=Value;
+end;
+
+function TBitmap.GetRawImage: TRawImage;
+begin
+  FRawImage.BGRASetSizeAndTransparency(FWidth, FHeight, FTransparent);
+  result := FRawImage;
+end;
+
+procedure TBitmap.Draw(ACanvas: TCanvas; const Rect: TRect);
+begin
+  if FInDraw then exit;
+  FInDraw := true;
+  ACanvas.StretchDraw(Rect, self);
+  FInDraw := false;
+end;
+
+function TBitmap.GetHeight: Integer;
+begin
+  result := FHeight;
+end;
+
+function TBitmap.GetWidth: Integer;
+begin
+  result := FWidth;
+end;
+
+function TBitmap.GetCanvas: TCanvas;
+begin
+  result := nil;
+  raise exception.Create('Canvas not available');
+end;
+
+constructor TBitmap.Create;
+begin
+  FRawImage := TRawImage.Create;
+  FTransparent:= false;
+end;
+
+destructor TBitmap.Destroy;
+begin
+  FRawImage.Free;
+  inherited Destroy;
+end;
+{$ENDIF}
+
+{$IFDEF BGRABITMAP_USE_FPCANVAS}
+{$DEFINE INCLUDE_IMPLEMENTATION}
+{$i bgrafpcanvas.inc}
+{$ENDIF}
+
+{$ENDIF}
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgragtkbitmap.pas

@@ -0,0 +1,339 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{
+ /**************************************************************************\
+                             bgragtkbitmap.pas
+                             -----------------
+                 This unit should NOT be added to the 'uses' clause.
+                 It contains patches for Gtk.
+}
+
+unit BGRAGtkBitmap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRALCLBitmap, Graphics,
+  GraphType;
+
+type
+  { TBGRAGtkBitmap }
+
+  TBGRAGtkBitmap = class(TBGRALCLBitmap)
+  private
+    FPixBuf: Pointer;
+    procedure DrawTransparent(ACanvas: TCanvas; Rect: TRect);
+    procedure DrawOpaque(ACanvas: TCanvas; ARect: TRect);
+  protected
+    procedure ReallocData; override;
+    procedure FreeData; override;
+  public
+    procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+      AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+      override;
+    procedure DrawPart(ARect: TRect; ACanvas: TCanvas; x, y: integer; Opaque: boolean); override;
+    procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); override;
+    procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override;
+    procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer;
+      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); overload; override;
+    procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; ADataFirstRow: Pointer;
+      ARowStride: integer; AWidth, AHeight: integer); overload;
+    procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override;
+  end;
+
+implementation
+
+uses BGRABitmapTypes, BGRADefaultBitmap, BGRAFilterScanner, LCLType,
+  LCLIntf, IntfGraphics,
+  {$IFDEF LCLgtk2}
+  gdk2, gtk2def, gdk2pixbuf, glib2,
+  {$ENDIF}
+  {$IFDEF LCLgtk}
+  gdk, gtkdef, gtkProc, gdkpixbuf, glib,
+  {$ENDIF}
+  FPImage, Dialogs;
+
+procedure TBGRAGtkBitmap.ReallocData;
+begin
+  {$IFDEF LCLgtk2}
+  If FPixBuf <> nil then g_object_unref(FPixBuf);
+  {$ELSE}
+  If FPixBuf <> nil then gdk_pixbuf_unref(FPixBuf);
+  {$ENDIF}
+  FPixBuf := nil;  
+  inherited ReallocData;
+  if (FWidth <> 0) and (FHeight <> 0) then
+  begin  
+    FPixbuf := gdk_pixbuf_new_from_data(pguchar(FDataByte),
+      GDK_COLORSPACE_RGB, True, 8, Width, Height, Width*Sizeof(TBGRAPixel), nil, nil);
+    if FPixbuf = nil then
+      raise Exception.Create('Error initializing Pixbuf');
+  end;
+end;
+
+procedure TBGRAGtkBitmap.FreeData;
+begin
+  {$IFDEF LCLgtk2}
+  If FPixBuf <> nil then g_object_unref(FPixBuf);
+  {$ELSE}
+  If FPixBuf <> nil then gdk_pixbuf_unref(FPixBuf);
+  {$ENDIF}
+  FPixBuf := nil;
+  inherited FreeData;
+end;
+
+procedure TBGRAGtkBitmap.DrawTransparent(ACanvas: TCanvas; Rect: TRect);
+var DrawWidth,DrawHeight: integer;
+    stretched: TBGRAGtkBitmap;
+    P: TPoint;
+begin
+  DrawWidth := Rect.Right-Rect.Left;
+  DrawHeight := Rect.Bottom-Rect.Top;
+  if (Height = 0) or (Width = 0) or (DrawWidth <= 0) or (DrawHeight <= 0) then
+    exit;
+
+  if (DrawWidth <> Width) or (DrawHeight <> Height) then
+  begin
+    stretched := Resample(DrawWidth,DrawHeight,rmSimpleStretch) as TBGRAGtkBitmap;
+    stretched.DrawTransparent(ACanvas,Rect);
+    stretched.Free;
+    exit;
+  end;
+
+  LoadFromBitmapIfNeeded;
+
+  {$PUSH}{$WARNINGS OFF}If not TBGRAPixel_RGBAOrder then SwapRedBlue;{$POP}
+  
+  P := Rect.TopLeft;
+  LPToDP(ACanvas.Handle, P, 1);
+  gdk_pixbuf_render_to_drawable(FPixBuf,
+    TGtkDeviceContext(ACanvas.Handle).Drawable,
+    TGtkDeviceContext(ACanvas.Handle).GC,
+    0,0, P.X,P.Y,
+    Width,Height,
+    GDK_RGB_DITHER_NORMAL,0,0);   
+
+  {$PUSH}{$WARNINGS OFF}If not TBGRAPixel_RGBAOrder then SwapRedBlue;{$POP}
+end;
+
+procedure TBGRAGtkBitmap.DrawOpaque(ACanvas: TCanvas; ARect: TRect);
+begin
+  DataDrawOpaque(ACanvas,ARect,Data,LineOrder,Width,Height);
+end;
+
+procedure TBGRAGtkBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+var
+  TempGtk: TBGRAGtkBitmap;
+  temp: integer;
+begin
+  if (AHeight = 0) or (AWidth = 0) or (Rect.Left = Rect.Right) or
+    (Rect.Top = Rect.Bottom) then
+    exit;
+
+  if Rect.Right < Rect.Left then
+  begin
+    temp := Rect.Left;
+    Rect.Left := Rect.Right;
+    Rect.Right := temp;
+  end;
+
+  if Rect.Bottom < Rect.Top then
+  begin
+    temp := Rect.Top;
+    Rect.Top := Rect.Bottom;
+    Rect.Bottom := temp;
+  end;
+
+  TempGtk := TBGRAGtkBitmap.Create(AWidth, AHeight);
+  Move(AData^,TempGtk.Data^,TempGtk.NbPixels*sizeof(TBGRAPixel));
+  if ALineOrder <> TempGtk.LineOrder then TempGtk.VerticalFlip;
+  TempGtk.DrawTransparent(ACanvas,Rect);
+  TempGtk.Free;
+end;
+
+procedure TBGRAGtkBitmap.DrawPart(ARect: TRect; ACanvas: TCanvas; x,
+  y: integer; Opaque: boolean);
+var
+  rowStride,w,h: Integer;
+begin
+  if Opaque then
+  begin
+    if LineOrder = riloTopToBottom then
+      rowStride := Width*sizeof(TBGRAPixel)
+    else
+      rowStride := -Width*sizeof(TBGRAPixel);
+    w:= ARect.Right-ARect.Left;
+    h:= ARect.Bottom-ARect.Top;
+    DataDrawOpaque(ACanvas, rect(x,y,x+w,y+h), Scanline[ARect.Top]+ARect.Left, rowStride, w,h);
+  end
+  else
+    inherited DrawPart(ARect, ACanvas, x, y, Opaque);
+end;
+
+procedure TBGRAGtkBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean);
+begin
+  if self = nil then
+    exit;
+  if Opaque then
+    DrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height))
+  else
+    DrawTransparent(ACanvas, Rect(X, Y, X + Width, Y + Height));
+end;
+
+procedure TBGRAGtkBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean);
+begin
+  if self = nil then
+    exit;
+  if Opaque then
+    DrawOpaque(ACanvas, Rect)
+  else
+    DrawTransparent(ACanvas, Rect);
+end;
+
+procedure TBGRAGtkBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+var
+  rowStride: Integer;
+  firstRow: Pointer;
+begin
+  if ALineOrder = riloTopToBottom then
+  begin
+    rowStride := AWidth*sizeof(TBGRAPixel);
+    firstRow := AData;
+  end
+  else
+  begin
+    rowStride := -AWidth*sizeof(TBGRAPixel);
+    firstRow := PBGRAPixel(AData) + (AWidth*(AHeight-1));
+  end;
+
+  DataDrawOpaque(ACanvas, ARect, firstRow, rowStride, AWidth, AHeight);
+end;
+
+procedure TBGRAGtkBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect;
+  ADataFirstRow: Pointer; ARowStride: integer; AWidth, AHeight: integer);
+
+  procedure DataSwapRedBlue;
+  var
+    y: Integer;
+    p: PByte;
+  begin
+    p := PByte(ADataFirstRow);
+    for y := 0 to AHeight-1 do
+    begin
+      TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(PBGRAPixel(p),PBGRAPixel(p),AWidth,False);
+      inc(p, ARowStride);
+    end;
+  end;
+
+  procedure DrawStretched;
+  var
+    dataStart: Pointer;
+    ptr: TBGRAPtrBitmap;
+    stretched: TBGRACustomBitmap;
+  begin
+    if ARowStride < 0 then
+      dataStart := PByte(ADataFirstRow) + ARowStride*(Height-1)
+    else
+      dataStart := ADataFirstRow;
+
+    if ARowStride <> abs(AWidth*sizeof(TBGRAPixel)) then
+      raise exception.Create('DataDrawOpaque not supported when using custom row stride and resample');
+
+    ptr := TBGRAPtrBitmap.Create(AWidth,AHeight,dataStart);
+    if ARowStride < 0 then
+      ptr.LineOrder := riloBottomToTop
+    else
+      ptr.LineOrder := riloTopToBottom;
+    stretched := ptr.Resample(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top);
+    ptr.free;
+    DataDrawOpaque(ACanvas,ARect,stretched.Data,stretched.LineOrder,stretched.Width,stretched.Height);
+    stretched.Free;
+  end;
+
+var
+  temp: integer;
+  pos: TPoint;
+  dest: HDC;
+
+begin
+  if (AHeight = 0) or (AWidth = 0) or (ARect.Left = ARect.Right) or
+    (ARect.Top = ARect.Bottom) then exit;
+
+  if ARect.Right < ARect.Left then
+  begin
+    temp := ARect.Left;
+    ARect.Left := ARect.Right;
+    ARect.Right := temp;
+  end;
+
+  if ARect.Bottom < ARect.Top then
+  begin
+    temp := ARect.Top;
+    ARect.Top := ARect.Bottom;
+    ARect.Bottom := temp;
+  end;
+
+  if (AWidth <> ARect.Right-ARect.Left) or (AHeight <> ARect.Bottom-ARect.Top) then
+    DrawStretched
+  else
+  begin
+    dest := ACanvas.Handle;
+    pos := ARect.TopLeft;
+    LPtoDP(dest, pos, 1);
+    {$PUSH}{$WARNINGS OFF}if not TBGRAPixel_RGBAOrder then DataSwapRedBlue;{$POP}
+    gdk_draw_rgb_32_image(TGtkDeviceContext(dest).Drawable,
+      TGtkDeviceContext(Dest).GC, pos.x,pos.y,
+      AWidth,AHeight, GDK_RGB_DITHER_NORMAL,
+      ADataFirstRow, ARowStride);
+    {$PUSH}{$WARNINGS OFF}if not TBGRAPixel_RGBAOrder then DataSwapRedBlue;{$POP}
+    ACanvas.Changed;
+  end;
+end;
+
+procedure TBGRAGtkBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer);
+var
+  subBmp: TBGRACustomBitmap;
+  subRect: TRect;
+  cw,ch: integer;
+  P: TPoint;
+begin
+  cw := CanvasSource.Width;
+  ch := CanvasSource.Height;
+  if (x < 0) or (y < 0) or (x+Width > cw) or
+    (y+Height > ch) then
+  begin
+    FillTransparent;
+    if (x+Width <= 0) or (y+Height <= 0) or
+      (x >= cw) or (y >= ch) then
+      exit;
+
+    if (x > 0) then subRect.Left := x else subRect.Left := 0;
+    if (y > 0) then subRect.Top := y else subRect.Top := 0;
+    if (x+Width > cw) then subRect.Right := cw else
+      subRect.Right := x+Width;
+    if (y+Height > ch) then subRect.Bottom := ch else
+      subRect.Bottom := y+Height;
+
+    subBmp := NewBitmap(subRect.Right-subRect.Left,subRect.Bottom-subRect.Top);
+    subBmp.GetImageFromCanvas(CanvasSource,subRect.Left,subRect.Top);
+    PutImage(subRect.Left-x,subRect.Top-y,subBmp,dmSet);
+    subBmp.Free;
+    exit;
+  end;
+
+  P := Point(x,y);
+  LPToDP(CanvasSource.Handle, P, 1);
+  gdk_pixbuf_get_from_drawable(FPixBuf,
+    TGtkDeviceContext(CanvasSource.Handle).Drawable,
+    nil, P.X,P.Y,0,0,Width,Height);
+  {$PUSH}{$WARNINGS OFF}If not TBGRAPixel_RGBAOrder then SwapRedBlue;{$POP}
+  InvalidateBitmap;
+end;
+
+
+end.
+
+

vendor/kam_remake/src/ext/BGRABitmap/bgraiconcursor.pas

@@ -0,0 +1,865 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAIconCursor;
+
+{$mode objfpc}{$H+}
+{$i bgrabitmap.inc}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRAMultiFileType, BGRABitmapTypes;
+
+type
+  { TBGRAIconCursorEntry }
+
+  TBGRAIconCursorEntry = class(TMultiFileEntry)
+  protected
+    FWidth,FHeight,FBitDepth: integer;
+    FExtension: string;
+    FContent: TStream;
+    FHotSpot: TPoint;
+    function GetName: utf8string; override;
+    procedure SetName({%H-}AValue: utf8string); override;
+    function GetExtension: utf8string; override;
+    function GetFileSize: int64; override;
+  public
+    constructor Create(AContainer: TMultiFileContainer; AExtension: string; AInfo: TQuickImageInfo; AContent: TStream);
+    class function TryCreate(AContainer: TMultiFileContainer; AContent: TStream): TBGRAIconCursorEntry; static;
+    destructor Destroy; override;
+    function CopyTo(ADestination: TStream): int64; override;
+    function GetStream: TStream; override;
+    function GetBitmap: TBGRACustomBitmap;
+    property Width: integer read FWidth;
+    property Height: integer read FHeight;
+    property BitDepth: integer read FBitDepth;
+    property HotSpot: TPoint read FHotSpot write FHotSpot;
+  end;
+
+  { TBGRAIconCursor }
+
+  TBGRAIconCursor = class(TMultiFileContainer)
+  private
+    function GetBitDepthAt(AIndex: integer): integer;
+    function GetHeightAt(AIndex: integer): integer;
+    function GetHotSpotAtAt(AIndex: integer): TPoint;
+    function GetWidthAt(AIndex: integer): integer;
+    procedure SetFileType(AValue: TBGRAImageFormat);
+    procedure SetHotSpotAt(AIndex: integer; AValue: TPoint);
+  protected
+    FFileType : TBGRAImageFormat;
+    FLoading : boolean;
+    function CreateEntry(AName: utf8string; AExtension: utf8string;
+      AContent: TStream): TMultiFileEntry; override;
+    function ExpectedMagic: Word;
+    procedure Init; override;
+    procedure AssignTo(Dest: TPersistent); override;
+  public
+    constructor Create(AFileType: TBGRAImageFormat); overload;
+    procedure Assign(Source: TPersistent); override;
+    function Add(ABitmap: TBGRACustomBitmap; ABitDepth: integer; AOverwrite: boolean = false): integer; overload;
+    function Add(AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer; overload;
+    procedure LoadFromStream(AStream: TStream); override;
+    procedure SaveToStream(ADestination: TStream); override;
+    function GetBitmap(AIndex: integer): TBGRACustomBitmap;
+    function GetBestFitBitmap(AWidth,AHeight: integer): TBGRACustomBitmap;
+    function IndexOf(AWidth,AHeight,ABitDepth: integer): integer; overload;
+    property FileType: TBGRAImageFormat read FFileType write SetFileType;
+    property Width[AIndex: integer]: integer read GetWidthAt;
+    property Height[AIndex: integer]: integer read GetHeightAt;
+    property BitDepth[AIndex: integer]: integer read GetBitDepthAt;
+    property HotSpot[AIndex: integer]: TPoint read GetHotSpotAtAt write SetHotSpotAt;
+  end;
+
+function BGRADitherIconCursor(ABitmap: TBGRACustomBitmap; ABitDepth: integer; ADithering: TDitheringAlgorithm): TBGRACustomBitmap;
+function BGRABitDepthIconCursor(ABitmap: TBGRACustomBitmap): integer;
+
+implementation
+
+uses BGRAWinResource, BGRAUTF8, BGRAReadPng, BGRAReadBMP, FPWriteBMP, BGRAPalette, BGRAWritePNG,
+  BGRAColorQuantization{$IFDEF BGRABITMAP_USE_LCL}, Graphics{$ENDIF};
+
+function BGRADitherIconCursor(ABitmap: TBGRACustomBitmap; ABitDepth: integer;
+  ADithering: TDitheringAlgorithm): TBGRACustomBitmap;
+var
+  frameMask, temp: TBGRACustomBitmap;
+  quantizer: TBGRAColorQuantizer;
+  maskQuantizer: TBGRAColorQuantizer;
+
+  x,y: integer;
+  psrc,pdest: PBGRAPixel;
+begin
+  if ABitDepth <= 0 then
+    raise exception.Create('Invalid bit depth');
+
+  if ABitDepth <= 24 then
+  begin
+    if ABitDepth = 1 then
+    begin
+      quantizer := TBGRAColorQuantizer.Create([BGRABlack,BGRAWhite,BGRAPixelTransparent],false,3);
+      result := quantizer.GetDitheredBitmap(ADithering, ABitmap);
+      quantizer.Free;
+    end
+    else
+    begin
+      frameMask := ABitmap.GetMaskFromAlpha;
+      maskQuantizer := TBGRAColorQuantizer.Create([BGRABlack,BGRAWhite],false,2);
+      temp := maskQuantizer.GetDitheredBitmap(ADithering, frameMask);
+      frameMask.Free;
+      frameMask := temp;
+      maskQuantizer.Free;
+
+      result := ABitmap.Duplicate;
+      result.ReplaceTransparent(BGRABlack);
+      result.AlphaFill(255);
+
+      if ABitDepth <= 8 then
+      begin
+        quantizer := TBGRAColorQuantizer.Create(result,acFullChannelInPalette, 1 shl ABitDepth);
+        temp := quantizer.GetDitheredBitmap(daFloydSteinberg, result);
+        result.free;
+        result := temp;
+        quantizer.Free;
+      end;
+
+      result.ApplyMask(frameMask);
+      frameMask.Free;
+    end;
+  end else
+    result := ABitmap.Duplicate;
+
+  if Assigned(ABitmap.XorMask) then
+  begin
+    result.NeedXorMask;
+    for y := 0 to ABitmap.XorMask.Height-1 do
+    begin
+      psrc := ABitmap.XorMask.ScanLine[y];
+      pdest := result.XorMask.ScanLine[y];
+      for x := 0 to ABitmap.XorMask.Width-1 do
+      begin
+        if ((psrc^.red shl 1)+(psrc^.green shl 2)+psrc^.blue >= 128*(1+2+4)) then
+          pdest^ := BGRA(255,255,255,0);
+        inc(psrc);
+        inc(pdest);
+      end;
+    end;
+  end;
+end;
+
+function BGRABitDepthIconCursor(ABitmap: TBGRACustomBitmap): integer;
+var pal: TBGRAPalette;
+  p: PBGRAPixel;
+  n: integer;
+
+  function BlackAndWhite: boolean;
+  var
+    i: Integer;
+  begin
+    if pal.Count > 2 then result := false
+    else
+    begin
+      for i := 0 to pal.Count-1 do
+        if (pal.Color[i] <> BGRAWhite) and (pal.Color[i] <> BGRABlack) then
+          exit(false);
+      result := true;
+    end;
+  end;
+
+begin
+  pal := TBGRAPalette.Create;
+  p := ABitmap.Data;
+  n := ABitmap.NbPixels;
+  while (n > 0) and (pal.Count < 257) do
+  begin
+    if p^.alpha = 0 then
+    begin
+      if pal.Count < 257 then pal.AddColor(BGRABlack);
+    end else
+    if p^.alpha = 255 then
+    begin
+      if pal.Count < 257 then pal.AddColor(p^);
+    end else
+    begin
+      pal.Free;
+      exit(32);
+    end;
+    inc(p);
+    dec(n);
+  end;
+  if pal.Count > 256 then result := 24 else
+  if pal.Count > 16 then result := 8 else
+  if (pal.Count > 2) or not BlackAndWhite then result := 4 else
+    result := 1;
+  pal.Free;
+end;
+
+{ TBGRAIconCursorEntry }
+
+constructor TBGRAIconCursorEntry.Create(AContainer: TMultiFileContainer; AExtension: string; AInfo: TQuickImageInfo;
+  AContent: TStream);
+begin
+  inherited Create(AContainer);
+  FExtension:= AExtension;
+  FWidth := AInfo.Width;
+  FHeight:= AInfo.Height;
+
+  // 16 bit per channel is not relevant for icon depth
+  if AInfo.ColorDepth >= 24 then
+  begin
+    if AInfo.AlphaDepth >= 8 then
+      FBitDepth := 32
+    else
+      FBitDepth := 24;
+  end else
+    FBitDepth := AInfo.ColorDepth;
+
+  FContent := AContent;
+end;
+
+class function TBGRAIconCursorEntry.TryCreate(
+  AContainer: TMultiFileContainer; AContent: TStream): TBGRAIconCursorEntry;
+var
+  format: TBGRAImageFormat;
+  imageInfo: TQuickImageInfo;
+  tempStream: TMemoryStream;
+  reader: TBGRAImageReader;
+  bmp: TBGRACustomBitmap;
+  maskLine: packed array of byte;
+  maskStride: integer;
+  psrc: PBGRAPixel;
+  maskBit: byte;
+  maskPos,x,y: integer;
+  headerSize, dataSize: integer;
+begin
+  AContent.Position:= 0;
+  format := DetectFileFormat(AContent);
+  case format of
+  ifBmp:
+    begin
+      reader := TBGRAReaderBMP.Create;
+      bmp := BGRABitmapFactory.Create;
+      try
+        AContent.Position := 0;
+        imageInfo := reader.GetQuickInfo(AContent);
+        if (imageInfo.width <= 0) or (imageInfo.height <= 0) or
+           (imageInfo.width > 256) or (imageInfo.height > 256) then
+          raise exception.Create('Invalid image size');
+        AContent.Position := 0;
+        //load bitmap to build mask
+        bmp.LoadFromStream(AContent);
+        maskStride := ((bmp.Width+31) div 32)*4;
+
+        tempStream := TMemoryStream.Create;
+        //BMP header is not stored in icon/cursor
+        AContent.Position:= sizeof(TBitMapFileHeader);
+        tempStream.CopyFrom(AContent, AContent.Size - sizeof(TBitMapFileHeader));
+        AContent.Free;
+
+        //fix height
+        tempStream.Position := 0;
+        headerSize := LEtoN(tempStream.ReadDWord);
+        if headerSize = sizeof(TOS2BitmapHeader) then // OS/2 1.x
+        begin
+          tempStream.Position := 6;
+          tempStream.WriteWord(NtoLE(word(bmp.Height*2))); //include mask size
+        end else
+        begin
+          tempStream.Position := 8;
+          tempStream.WriteDWord(NtoLE(LongWord(bmp.Height*2))); //include mask size
+          if headerSize >= 20+4 then
+          begin
+            tempStream.Position:= 20;
+            dataSize := LEtoN(tempStream.ReadDWord);
+            if dataSize <> 0 then
+            begin //if data size is supplied, include mask size
+              inc(dataSize, maskStride*bmp.Height);
+              tempStream.Position:= 20;
+              tempStream.WriteDWord(NtoLE(dataSize));
+            end;
+          end;
+        end;
+
+        //build mask
+        tempStream.Position := tempStream.Size;
+        setlength(maskLine, maskStride);
+        for y := bmp.Height-1 downto 0 do
+        begin
+          maskBit := $80;
+          maskPos := 0;
+          psrc := bmp.ScanLine[y];
+          fillchar(maskLine[0], length(maskLine), 0);
+          for x := 0 to bmp.Width-1 do
+          begin
+            if psrc^.alpha = 0 then
+              maskLine[maskPos] := maskLine[maskPos] or maskBit;
+            maskBit := maskBit shr 1;
+            if maskBit = 0 then
+            begin
+              maskBit := $80;
+              inc(maskPos);
+            end;
+            inc(psrc);
+          end;
+          tempStream.WriteBuffer(maskLine[0], length(maskLine));
+        end;
+
+        result := TBGRAIconCursorEntry.Create(AContainer, 'dib', imageInfo, tempStream);
+      finally
+        bmp.Free;
+        reader.Free;
+      end;
+    end;
+  ifPng:
+    begin
+      reader := TBGRAReaderPNG.Create;
+      imageInfo := reader.GetQuickInfo(AContent);
+      reader.Free;
+      result := TBGRAIconCursorEntry.Create(AContainer, 'png', imageInfo, AContent);
+
+    end;
+  ifUnknown, ifLazPaint {a headerless bmp can be confused for a headerless lzp}:
+    begin
+      //assume headerless BMP
+      AContent.Position := 0;
+      reader := TBGRAReaderBMP.Create;
+      imageInfo := reader.GetQuickInfo(AContent);
+      imageInfo.Height:= imageInfo.Height div 2; //mask size is included
+      reader.Free;
+      if (imageInfo.width <= 0) or (imageInfo.height <= 0) or
+         (imageInfo.width > 256) or (imageInfo.height > 256) then
+        raise exception.Create('Invalid image size');
+      result := TBGRAIconCursorEntry.Create(AContainer, 'dib', imageInfo, AContent);
+    end;
+  else
+    raise exception.Create(SuggestImageExtension(format) + ' format is not handled');
+  end;
+end;
+
+destructor TBGRAIconCursorEntry.Destroy;
+begin
+  FContent.Free;
+  inherited Destroy;
+end;
+
+function TBGRAIconCursorEntry.CopyTo(ADestination: TStream): int64;
+begin
+  if FContent.Size = 0 then
+  begin
+    result := 0;
+    exit;
+  end;
+
+  FContent.Position := 0;
+  result := ADestination.CopyFrom(FContent, FContent.Size);
+end;
+
+function TBGRAIconCursorEntry.GetStream: TStream;
+begin
+  Result:= FContent;
+end;
+
+function TBGRAIconCursorEntry.GetBitmap: TBGRACustomBitmap;
+var reader: TBGRAImageReader;
+begin
+  if Extension = 'dib' then
+  begin
+    reader := TBGRAReaderBMP.Create;
+    TBGRAReaderBMP(reader).Subformat := bsfHeaderlessWithMask;
+  end else
+    reader := TBGRAReaderPNG.create;
+
+  result := BGRABitmapFactory.Create;
+  FContent.Position := 0;
+  try
+    result.LoadFromStream(FContent, reader);
+  except on ex: Exception do
+    begin
+      result.Free;
+      reader.Free;
+      raise ex;
+    end;
+  end;
+  reader.Free;
+
+  result.HotSpot := HotSpot;
+end;
+
+function TBGRAIconCursorEntry.GetName: utf8string;
+begin
+  result := IntToStr(FWidth)+'x'+IntToStr(FHeight)+'x'+IntToStr(FBitDepth);
+end;
+
+procedure TBGRAIconCursorEntry.SetName(AValue: utf8string);
+begin
+  raise exception.Create('Name cannot be changed');
+end;
+
+function TBGRAIconCursorEntry.GetExtension: utf8string;
+begin
+  result := FExtension;
+end;
+
+function TBGRAIconCursorEntry.GetFileSize: int64;
+begin
+  result := FContent.Size;
+end;
+
+{ TBGRAIconCursor }
+
+function TBGRAIconCursor.GetBitDepthAt(AIndex: integer): integer;
+begin
+  if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds');
+  result := TBGRAIconCursorEntry(Entry[AIndex]).BitDepth;
+end;
+
+function TBGRAIconCursor.GetHeightAt(AIndex: integer): integer;
+begin
+  if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds');
+  result := TBGRAIconCursorEntry(Entry[AIndex]).Height;
+end;
+
+function TBGRAIconCursor.GetHotSpotAtAt(AIndex: integer): TPoint;
+begin
+  if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds');
+  result := TBGRAIconCursorEntry(Entry[AIndex]).HotSpot;
+end;
+
+function TBGRAIconCursor.GetWidthAt(AIndex: integer): integer;
+begin
+  if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds');
+  result := TBGRAIconCursorEntry(Entry[AIndex]).Width;
+end;
+
+procedure TBGRAIconCursor.SetFileType(AValue: TBGRAImageFormat);
+begin
+  if FFileType=AValue then Exit;
+  if not (AValue in [ifIco,ifCur,ifUnknown]) then
+    raise exception.Create('Allowed formats: ICO, CUR or unknown');
+  FFileType:=AValue;
+end;
+
+procedure TBGRAIconCursor.SetHotSpotAt(AIndex: integer; AValue: TPoint);
+begin
+  if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds');
+  TBGRAIconCursorEntry(Entry[AIndex]).HotSpot := AValue;
+end;
+
+function TBGRAIconCursor.CreateEntry(AName: utf8string;
+  AExtension: utf8string; AContent: TStream): TMultiFileEntry;
+begin
+  AExtension := UTF8LowerCase(AExtension);
+  if (AExtension <> 'png') and (AExtension <> 'dib') then
+    raise exception.Create('The only supported extensions are PNG and DIB');
+
+  result := TBGRAIconCursorEntry.TryCreate(self, AContent);
+  if result.Extension <> AExtension then
+  begin
+    result.Free;
+    raise exception.Create(AExtension + ' file extension expected but ' + result.Extension + ' found');
+  end;
+
+  if result.Name <> AName then
+  begin
+    result.Free;
+    raise exception.Create('"' + AName + '" dimension expected but "' + result.Name + '" found');
+  end;
+end;
+
+function TBGRAIconCursor.ExpectedMagic: Word;
+begin
+  case FFileType of
+  ifIco: result := ICON_OR_CURSOR_FILE_ICON_TYPE;
+  ifCur: result := ICON_OR_CURSOR_FILE_CURSOR_TYPE;
+  else
+    raise exception.Create('Invalid icon/cursor type');
+  end;
+end;
+
+procedure TBGRAIconCursor.Init;
+begin
+  inherited Init;
+  FFileType:= ifUnknown;
+end;
+
+procedure TBGRAIconCursor.AssignTo(Dest: TPersistent);
+{$IFDEF BGRABITMAP_USE_LCL}
+var
+  temp: TMemoryStream;
+{$ENDIF}
+begin
+  {$IFDEF BGRABITMAP_USE_LCL}
+  if Dest is TCustomIcon then
+  begin
+    temp := TMemoryStream.Create;
+    try
+      SaveToStream(temp);
+      temp.Position:= 0;
+      TCustomIcon(Dest).LoadFromStream(temp);
+    finally
+      temp.Free;
+    end;
+  end else
+  {$ENDIF}
+    inherited AssignTo(Dest);
+end;
+
+constructor TBGRAIconCursor.Create(AFileType: TBGRAImageFormat);
+begin
+  if not (AFileType in [ifIco,ifCur,ifUnknown]) then
+    raise exception.Create('Allowed formats: ICO, CUR or unknown');
+
+  Init;
+  FFileType := AFileType;
+end;
+
+function TBGRAIconCursor.Add(ABitmap: TBGRACustomBitmap; ABitDepth: integer;
+  AOverwrite: boolean): integer;
+var stream, temp: TStream;
+  writer: TFPWriterBMP;
+  bmpXOR: TBGRACustomBitmap;
+  y: Integer;
+  psrcMask, pdest: PBGRAPixel;
+  bitAndMask: array of byte;
+  bitAndMaskPos: integer;
+  bitAndMaskBit: byte;
+  bitAndMaskRowSize, x: integer;
+  palette: TBGRAPalette;
+  writerPng: TBGRAWriterPNG;
+
+begin
+  stream := TMemoryStream.Create;
+  try
+    //PNG format is advised from 256 on but does not handle XOR
+    if ((ABitmap.Width >= 256) or (ABitmap.Height >= 256)) and (ABitDepth >= 8) and
+        ((ABitmap.XorMask = nil) or ABitmap.XorMask.IsZero) then
+    begin
+      writerPng := TBGRAWriterPNG.Create;
+      try
+        writerPng.WordSized := false;
+        if ABitDepth = 8 then
+        begin
+          writerPng.Indexed := true;
+          writerpng.UseAlpha := ABitmap.HasTransparentPixels;
+        end else
+        begin
+          writerPng.Indexed := false;
+          writerpng.UseAlpha := (ABitDepth = 32);
+        end;
+        ABitmap.SaveToStream(stream, writerPng);
+      finally
+        writerPng.Free;
+      end;
+      result := Add(stream, AOverwrite, true);
+      stream := nil;
+    end else
+    if ((ABitmap.XorMask = nil) or ABitmap.XorMask.IsZero) and
+      (not ABitmap.HasTransparentPixels or (ABitDepth = 32)) then
+    begin
+      writer := TFPWriterBMP.Create;
+      writer.BitsPerPixel := ABitDepth;
+      try
+        if not ABitmap.UsePalette and (ABitDepth < 24) then
+        begin
+          palette := TBGRAPalette.Create(ABitmap);
+          try
+            palette.AssignTo(ABitmap);
+          finally
+            palette.Free;
+          end;
+          ABitmap.SaveToStream(stream, writer);
+          ABitmap.UsePalette:= false;
+        end
+        else
+          ABitmap.SaveToStream(stream, writer);
+      finally
+        writer.Free;
+      end;
+      result := Add(stream, AOverwrite, true);
+      stream := nil;
+    end else
+    begin
+      bmpXOR := BGRABitmapFactory.Create(ABitmap);
+      try
+        bitAndMaskRowSize := ((bmpXOR.Width+31) div 32)*4;
+        setlength(bitAndMask, bitAndMaskRowSize*bmpXOR.Height);
+        for y := bmpXOR.Height-1 downto 0 do
+        begin
+          if assigned(ABitmap.XorMask) then
+            psrcMask := ABitmap.XorMask.ScanLine[y]
+          else
+            psrcMask := nil;
+          pdest := bmpXOR.ScanLine[y];
+          bitAndMaskPos := (bmpXOR.Height-1-y)*bitAndMaskRowSize;
+          bitAndMaskBit:= $80;
+          for x := bmpXOR.Width-1 downto 0 do
+          begin
+            //xor mask is either 100% or 0%
+            if assigned(psrcMask) and ((psrcMask^.red <> 0) or (psrcMask^.green <> 0) or (psrcMask^.blue <> 0)) then
+            begin
+              pdest^ := psrcMask^;
+              pdest^.alpha := 255;
+              bitAndMask[bitAndMaskPos] := bitAndMask[bitAndMaskPos] or bitAndMaskBit;
+            end else
+            if pdest^.alpha = 0 then
+            begin
+              bitAndMask[bitAndMaskPos] := bitAndMask[bitAndMaskPos] or bitAndMaskBit;
+              if ABitDepth <= 24 then //if we cannot save alpha, replace with black.
+              begin                   //mask will task care of making it transparent
+                pdest^ := BGRABlack;
+              end;
+            end;
+
+            bitAndMaskBit := bitAndMaskBit shr 1;
+            if bitAndMaskBit = 0 then
+            begin
+              bitAndMaskBit := $80;
+              inc(bitAndMaskPos);
+            end;
+            if assigned(psrcMask) then inc(psrcMask);
+            inc(pdest);
+          end;
+        end;
+        bmpXOR.InvalidateBitmap;
+
+        if ABitDepth < 24 then
+        begin
+          palette := TBGRAPalette.Create(bmpXor);
+          palette.AssignTo(bmpXor);
+          palette.Free;
+        end;
+
+        temp := TMemoryStream.Create;
+        try
+          writer := TFPWriterBMP.Create;
+          writer.BitsPerPixel := ABitDepth;
+          try
+            bmpXOR.SaveToStream(temp, writer);
+            //write double height to include mask
+            temp.Position := 22;
+            temp.WriteDWord(NtoLE(LongWord(bmpXOR.Height*2)));
+            //go after the file header
+            temp.Position := 14;
+            //copy bitmap without header
+            stream.CopyFrom(temp, temp.Size-temp.Position);
+          finally
+            writer.Free;
+          end;
+        finally
+          temp.Free;
+        end;
+        //write mask
+        stream.WriteBuffer(bitAndMask[0],length(bitAndMask));
+        result := Add(stream, AOverwrite, true);
+        stream := nil;
+      finally
+        bmpXOR.Free;
+      end;
+    end;
+
+  finally
+    stream.Free;
+  end;
+end;
+
+function TBGRAIconCursor.Add(AContent: TStream; AOverwrite: boolean;
+  AOwnStream: boolean): integer;
+var
+  index,i: Integer;
+  newEntry: TBGRAIconCursorEntry;
+  contentCopy: TMemoryStream;
+begin
+  if not AOwnStream then
+  begin
+    AContent.Position:= 0;
+    contentCopy := TMemoryStream.Create;
+    contentCopy.CopyFrom(AContent, AContent.Size);
+    newEntry := TBGRAIconCursorEntry.TryCreate(self, contentCopy);
+  end else
+    newEntry := TBGRAIconCursorEntry.TryCreate(self, AContent);
+
+  index := IndexOf(newEntry.Name, newEntry.Extension);
+  if index <> -1 then
+  begin
+    if AOverwrite then
+      Delete(index)
+    else
+    begin
+      newEntry.Free;
+      raise Exception.Create('Duplicate entry');
+    end;
+  end else if not FLoading then
+  begin
+    for i := 0 to Count-1 do
+      if ((Width[i] < newEntry.Width) and (Height[i] < newEntry.Height)) or
+         ((Width[i] = newEntry.Width) and (Height[i] = newEntry.Height) and (BitDepth[i] < newEntry.BitDepth)) then
+      begin
+        index := i;
+        break;
+      end;
+  end;
+  result := AddEntry(newEntry, index);
+end;
+
+procedure TBGRAIconCursor.LoadFromStream(AStream: TStream);
+var header: TGroupIconHeader;
+  dir: packed array of TIconFileDirEntry;
+  startPos: int64;
+  entryContent: TMemoryStream;
+  entryIndex, i: integer;
+begin
+  FLoading:= true;
+  try
+    startPos := AStream.Position;
+    AStream.ReadBuffer({%H-}header, sizeof(header));
+    header.SwapIfNecessary;
+    if header.Reserved <> 0 then
+      raise exception.Create('Invalid file format');
+    if FileType = ifUnknown then
+    begin
+      case header.ResourceType of
+      ICON_OR_CURSOR_FILE_ICON_TYPE: FFileType := ifIco;
+      ICON_OR_CURSOR_FILE_CURSOR_TYPE: FFileType := ifCur;
+      end;
+    end;
+    if header.ResourceType <> ExpectedMagic then
+      raise exception.Create('Invalid resource type');
+    Clear;
+    setlength(dir, header.ImageCount);
+    AStream.ReadBuffer(dir[0], sizeof(TIconFileDirEntry)*length(dir));
+    for i := 0 to high(dir) do
+    begin
+      AStream.Position:= LEtoN(dir[i].ImageOffset) + startPos;
+      entryContent := TMemoryStream.Create;
+      entryContent.CopyFrom(AStream, LEtoN(dir[i].ImageSize));
+      entryIndex := Add(entryContent, false, true);
+      if ((dir[i].Width = 0) and (Width[entryIndex] < 256)) or
+         ((dir[i].Width > 0) and (Width[entryIndex] <> dir[i].Width)) or
+         ((dir[i].Height = 0) and (Height[entryIndex] < 256)) or
+         ((dir[i].Height > 0) and (Height[entryIndex] <> dir[i].Height)) then
+          raise Exception.Create('Inconsistent image size');
+      if FFileType = ifCur then
+        TBGRAIconCursorEntry(Entry[entryIndex]).HotSpot := Point(LEtoN(dir[i].HotSpotX),LEtoN(dir[i].HotSpotY));
+    end;
+  finally
+    FLoading:= false;
+  end;
+end;
+
+procedure TBGRAIconCursor.SaveToStream(ADestination: TStream);
+var header: TGroupIconHeader;
+  i: integer;
+  accSize: LongWord;
+  dir: packed array of TIconFileDirEntry;
+  contentSize: LongWord;
+begin
+  if Count = 0 then
+    raise exception.Create('File cannot be empty');
+  if FileType = ifUnknown then
+    raise exception.Create('You need to specify the file type');
+  header.ImageCount:= Count;
+  header.Reserved := 0;
+  header.ResourceType:= ExpectedMagic;
+  header.SwapIfNecessary;
+  accSize := sizeof(header) + sizeof(TIconFileDirEntry)*Count;
+  setlength(dir, Count);
+  for i := 0 to Count-1 do
+  begin
+    if Width[i] >= 256
+    then dir[i].Width := 0
+    else dir[i].Width := Width[i];
+
+    if Height[i] >= 256
+    then dir[i].Height := 0
+    else dir[i].Height := Height[i];
+
+    if BitDepth[i] < 8 then
+      dir[i].Colors := 1 shl BitDepth[i]
+    else
+      dir[i].Colors := 0;
+    dir[i].Reserved := 0;
+    case FFileType of
+    ifCur: begin dir[i].HotSpotX:= NtoLE(Word(HotSpot[i].X)); dir[i].HotSpotY := NtoLE(Word(HotSpot[i].Y)); end;
+    ifIco: begin dir[i].BitsPerPixel:= NtoLE(Word(BitDepth[i])); dir[i].Planes := NtoLE(Word(1)); end;
+    else dir[i].Variable:= 0;
+    end;
+    dir[i].ImageOffset := LEtoN(accSize);
+    contentSize:= Entry[i].FileSize;
+    dir[i].ImageSize := NtoLE(contentSize);
+    inc(accSize,contentSize);
+  end;
+
+  ADestination.WriteBuffer(header, sizeof(header));
+  ADestination.WriteBuffer(dir[0], sizeof(TIconFileDirEntry)*length(dir));
+  for i := 0 to Count-1 do
+    if Entry[i].CopyTo(ADestination) <> Entry[i].FileSize then
+        raise exception.Create('Unable to write data in stream');
+end;
+
+function TBGRAIconCursor.GetBitmap(AIndex: integer): TBGRACustomBitmap;
+begin
+  if (AIndex < 0) or (AIndex >= Count) then raise ERangeError.Create('Index out of bounds');
+  result := TBGRAIconCursorEntry(Entry[AIndex]).GetBitmap;
+end;
+
+function TBGRAIconCursor.GetBestFitBitmap(AWidth, AHeight: integer): TBGRACustomBitmap;
+var bestIndex: integer;
+  bestSizeDiff: integer;
+  bestBPP: integer;
+  sizeDiff, i: integer;
+begin
+  bestBPP := 0;
+  bestSizeDiff := high(integer);
+  bestIndex := -1;
+  for i := 0 to Count-1 do
+  begin
+    sizeDiff := abs(AWidth-Width[i])+abs(AHeight-Height[i]);
+    if (sizeDiff < bestSizeDiff) or
+      ((sizeDiff = bestSizeDiff) and (BitDepth[i] > bestBPP)) then
+    begin
+      bestIndex := i;
+      bestSizeDiff:= sizeDiff;
+      bestBPP:= BitDepth[i];
+    end;
+  end;
+  if bestIndex = -1 then
+    raise Exception.Create('No bitmap found')
+  else
+    result := GetBitmap(bestIndex);
+end;
+
+function TBGRAIconCursor.IndexOf(AWidth, AHeight, ABitDepth: integer): integer;
+var
+  i: Integer;
+begin
+  for i := 0 to Count-1 do
+    if (Width[i] = AWidth) and (Height[i] = AHeight) and (BitDepth[i] = ABitDepth) then
+    begin
+      result := i;
+      exit;
+    end;
+  result := -1;
+end;
+
+procedure TBGRAIconCursor.Assign(Source: TPersistent);
+{$IFDEF BGRABITMAP_USE_LCL}
+var
+  temp: TMemoryStream;
+{$ENDIF}
+begin
+  {$IFDEF BGRABITMAP_USE_LCL}
+  if Source is TCustomIcon then
+  begin
+    temp := TMemoryStream.Create;
+    try
+      TCustomIcon(Source).SaveToStream(temp);
+      temp.Position:= 0;
+      LoadFromStream(temp);
+    finally
+      temp.Free;
+    end;
+  end else
+  {$ENDIF}
+    inherited Assign(Source);
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgralazpaint.pas

@@ -0,0 +1,264 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRALazPaint;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRALayers, BGRABitmapTypes, BGRAReadLzp, BGRAWriteLzp,
+  BGRALzpCommon, FPimage;
+
+type
+  TLzpCompression = BGRALzpCommon.TLzpCompression;
+
+  { TBGRALazPaintImage }
+
+  TBGRALazPaintImage = class(TBGRALayeredBitmap)
+  private
+    FSelectedLayerIndex: integer;
+  protected
+    procedure InternalLoadFromStream(AStream: TStream);
+    procedure InternalSaveToStream(AStream: TStream);
+  public
+    constructor Create; overload; override;
+    constructor Create(AWidth, AHeight: integer); overload; override;
+    procedure LoadFromStream(AStream: TStream); override;
+    procedure LoadFromFile(const filenameUTF8: string); override;
+    procedure SaveToStream(AStream: TStream); override;
+    procedure SaveToFile(const filenameUTF8: string); override;
+    property SelectedLayerIndex: integer read FSelectedLayerIndex write FSelectedLayerIndex;
+  end;
+
+  { TBGRAWriterLazPaintWithLayers }
+
+  TBGRAWriterLazPaintWithLayers = class(TBGRAWriterLazPaint)
+    protected
+      FLayers: TBGRALayeredBitmap;
+      FSelectedLayerIndex: integer;
+      FCompression: TLzpCompression;
+      function GetNbLayers: integer; override;
+      function InternalWriteLayers(Str: TStream; {%H-}Img: TFPCustomImage): boolean; override;
+    public
+      constructor Create(ALayers: TBGRALayeredBitmap); overload;
+      property SelectedLayerIndex: integer read FSelectedLayerIndex write FSelectedLayerIndex;
+      property Compression: TLzpCompression read FCompression write FCompression;
+  end;
+
+  { TBGRAReaderLazPaintWithLayers }
+
+  TBGRAReaderLazPaintWithLayers = class(TBGRAReaderLazPaint)
+    protected
+      FLayers: TBGRALayeredBitmap;
+      FLayersLoaded: boolean;
+      FSelectedLayerIndex: integer;
+      procedure InternalReadLayers(str: TStream; {%H-}Img: TFPCustomImage); override;
+    public
+      constructor Create(ALayers: TBGRALayeredBitmap); overload;
+      property LayersLoaded: boolean read FLayersLoaded;
+      property SelectedLayerIndex: integer read FSelectedLayerIndex;
+  end;
+
+procedure RegisterLazPaintFormat;
+
+implementation
+
+uses BGRAStreamLayers, BGRABitmap, BGRAUTF8;
+
+{ TBGRALazPaintImage }
+
+constructor TBGRALazPaintImage.Create;
+begin
+  inherited Create;
+  RegisterLazPaintFormat;
+  FSelectedLayerIndex:= 0;
+end;
+
+constructor TBGRALazPaintImage.Create(AWidth, AHeight: integer);
+begin
+  inherited Create(AWidth, AHeight);
+  RegisterLazPaintFormat;
+  FSelectedLayerIndex:= 0;
+end;
+
+procedure TBGRALazPaintImage.LoadFromStream(AStream: TStream);
+begin
+  OnLayeredBitmapLoadFromStreamStart;
+  try
+    InternalLoadFromStream(AStream);
+  finally
+    OnLayeredBitmapLoaded;
+  end;
+end;
+
+procedure TBGRALazPaintImage.InternalLoadFromStream(AStream: TStream);
+var
+  {%H-}header: TLazPaintImageHeader;
+  bmp: TBGRACustomBitmap;
+  reader: TBGRAReaderLazPaintWithLayers;
+begin
+  AStream.ReadBuffer({%H-}header, sizeof(header));
+  LazPaintImageHeader_SwapEndianIfNeeded(header);
+  AStream.Position:= AStream.Position-sizeof(header);
+
+  //use shortcut if possible
+  if (header.magic = LAZPAINT_MAGIC_HEADER) and (header.zero1 = 0)
+   and (header.layersOffset >= sizeof(header)) then
+  begin
+    AStream.Position:= AStream.Position+header.layersOffset;
+    LoadLayersFromStream(AStream, FSelectedLayerIndex, false, self, True);
+  end else
+  begin
+    reader := TBGRAReaderLazPaintWithLayers.Create(self);
+    try
+      bmp := BGRABitmapFactory.Create;
+      bmp.LoadFromStream(AStream, reader);
+      if reader.LayersLoaded then
+      begin
+        bmp.Free;
+      end else
+      begin
+        Clear;
+        SetSize(bmp.Width,bmp.Height);
+        AddOwnedLayer(bmp as TBGRABitmap);
+        LayerName[0] := reader.Caption;
+      end;
+      SelectedLayerIndex:= reader.SelectedLayerIndex;
+    finally
+      reader.Free;
+    end;
+  end;
+end;
+
+procedure TBGRALazPaintImage.LoadFromFile(const filenameUTF8: string);
+var AStream: TFileStreamUTF8;
+begin
+  AStream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite);
+  OnLayeredBitmapLoadStart(filenameUTF8);
+  try
+    LoadFromStream(AStream);
+  finally
+    OnLayeredBitmapLoaded;
+    AStream.Free;
+  end;
+end;
+
+procedure TBGRALazPaintImage.SaveToFile(const filenameUTF8: string);
+var AStream: TFileStreamUTF8;
+begin
+  AStream := TFileStreamUTF8.Create(filenameUTF8,fmCreate or fmShareDenyWrite);
+  OnLayeredBitmapSaveStart(filenameUTF8);
+  try
+    InternalSaveToStream(AStream);
+  finally
+    OnLayeredBitmapSaved;
+    AStream.Free;
+  end;
+end;
+
+procedure TBGRALazPaintImage.SaveToStream(AStream: TStream);
+begin
+  OnLayeredBitmapSaveToStreamStart;
+  try
+    InternalSaveToStream(AStream);
+  finally
+    OnLayeredBitmapSaved;
+  end;
+end;
+
+procedure TBGRALazPaintImage.InternalSaveToStream(AStream: TStream);
+var
+  writer: TBGRAWriterLazPaint;
+  flat: TBGRACustomBitmap;
+begin
+  if NbLayers = 0 then
+    raise exception.Create('File cannot be empty');
+
+  writer := nil;
+  flat := nil;
+  try
+    if (NbLayers > 1) or (LayerOpacity[0] <> 255) or not LayerVisible[0] or (BlendOperation[0]<>boTransparent)
+       or (OriginalCount <> 0) then
+    begin
+      writer := TBGRAWriterLazPaintWithLayers.Create(self);
+      writer.Caption := 'Preview';
+      TBGRAWriterLazPaintWithLayers(writer).SelectedLayerIndex := self.SelectedLayerIndex;
+    end else
+    begin
+      writer := TBGRAWriterLazPaint.Create;
+      writer.Caption := LayerName[0];
+    end;
+
+    writer.IncludeThumbnail:= true;
+    flat := ComputeFlatImage;
+    flat.SaveToStream(AStream, writer);
+  finally
+    writer.Free;
+    flat.Free;
+  end;
+end;
+
+{ TBGRAReaderLazPaintWithLayers }
+
+procedure TBGRAReaderLazPaintWithLayers.InternalReadLayers(str: TStream;
+  Img: TFPCustomImage);
+begin
+  if Assigned(FLayers) then
+  begin
+    if CheckStreamForLayers(str) then
+    begin
+      LoadLayersFromStream(str, FSelectedLayerIndex, false, FLayers, True);
+      FLayersLoaded := true;
+    end;
+  end;
+end;
+
+constructor TBGRAReaderLazPaintWithLayers.Create(ALayers: TBGRALayeredBitmap);
+begin
+  FLayersLoaded := false;
+  FLayers := ALayers;
+  FSelectedLayerIndex:= -1;
+end;
+
+{ TBGRAWriterLazPaintWithLayers }
+
+function TBGRAWriterLazPaintWithLayers.GetNbLayers: integer;
+begin
+  if Assigned(FLayers) then
+    Result:= FLayers.NbLayers
+  else
+    Result := 1;
+end;
+
+function TBGRAWriterLazPaintWithLayers.InternalWriteLayers(Str: TStream;
+  Img: TFPCustomImage): boolean;
+begin
+  If Assigned(FLayers) then
+  begin
+    SaveLayersToStream(str, FLayers, FSelectedLayerIndex, FCompression, True);
+    Result:=true;
+  end
+  else result := False;
+end;
+
+constructor TBGRAWriterLazPaintWithLayers.Create(ALayers: TBGRALayeredBitmap);
+begin
+  inherited Create;
+  FLayers := ALayers;
+  FSelectedLayerIndex:= 0;
+  FCompression:= lzpRLE;
+  IncludeThumbnail:= true;
+end;
+
+var AlreadyRegistered: boolean;
+
+procedure RegisterLazPaintFormat;
+begin
+  if AlreadyRegistered then exit;
+  RegisterLayeredBitmapReader('lzp', TBGRALazPaintImage);
+  RegisterLayeredBitmapWriter('lzp', TBGRALazPaintImage);
+  AlreadyRegistered:= True;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgralazresource.pas

@@ -0,0 +1,416 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRALazResource;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRAMultiFileType;
+
+type
+  { TLazResourceEntry }
+
+  TLazResourceEntry = class(TMultiFileEntry)
+  private
+    procedure Serialize(ADestination: TStream);
+  protected
+    FName: utf8string;
+    FValueType: utf8string;
+    FContent: TStream;
+    function GetName: utf8string; override;
+    procedure SetName(AValue: utf8string); override;
+    function GetExtension: utf8string; override;
+    function GetFileSize: int64; override;
+  public
+    constructor Create(AContainer: TMultiFileContainer; AName: utf8string; AValueType: utf8string; AContent: TStream);
+    destructor Destroy; override;
+    function CopyTo(ADestination: TStream): int64; override;
+    function GetStream: TStream; override;
+  end;
+
+  { TFormDataEntry }
+
+  TFormDataEntry = class(TLazResourceEntry)
+  protected
+    FTextContent: TStream;
+    procedure RequireTextContent;
+    function GetExtension: utf8string; override;
+    function GetFileSize: int64; override;
+  public
+    constructor Create(AContainer: TMultiFileContainer; AName: utf8string; ABinaryContent: TStream);
+    destructor Destroy; override;
+    function CopyTo(ADestination: TStream): int64; override;
+  end;
+
+  { TLazResourceContainer }
+
+  TLazResourceContainer = class(TMultiFileContainer)
+  protected
+    function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; override;
+  public
+    procedure LoadFromStream(AStream: TStream); override;
+    procedure SaveToStream(ADestination: TStream); override;
+  end;
+
+implementation
+
+uses LResources, BGRAUTF8;
+
+{ TFormDataEntry }
+
+procedure TFormDataEntry.RequireTextContent;
+begin
+  if FTextContent = nil then
+  begin
+    FTextContent:= TMemoryStream.Create;
+    FContent.Position:= 0;
+    LRSObjectBinaryToText(FContent, FTextContent);
+  end;
+end;
+
+function TFormDataEntry.GetExtension: utf8string;
+begin
+  Result:= 'lfm';
+end;
+
+function TFormDataEntry.GetFileSize: int64;
+begin
+  RequireTextContent;
+  Result:= FTextContent.Size;
+end;
+
+constructor TFormDataEntry.Create(AContainer: TMultiFileContainer;
+  AName: utf8string; ABinaryContent: TStream);
+begin
+  inherited Create(AContainer,AName,'FORMDATA',ABinaryContent);
+end;
+
+destructor TFormDataEntry.Destroy;
+begin
+  FreeAndNil(FTextContent);
+  inherited Destroy;
+end;
+
+function TFormDataEntry.CopyTo(ADestination: TStream): int64;
+begin
+  RequireTextContent;
+  if FTextContent.Size = 0 then
+    result := 0
+  else
+  begin
+    FTextContent.Position:= 0;
+    result := ADestination.CopyFrom(FTextContent,FTextContent.Size);
+  end;
+end;
+
+{ TLazResourceEntry }
+
+procedure TLazResourceEntry.Serialize(ADestination: TStream);
+begin
+  FContent.Position := 0;
+  BinaryToLazarusResourceCode(FContent, ADestination, Name, FValueType);
+end;
+
+function TLazResourceEntry.GetName: utf8string;
+begin
+  Result:= FName;
+end;
+
+procedure TLazResourceEntry.SetName(AValue: utf8string);
+begin
+  if AValue = FName then exit;
+  if Container.IndexOf(AVAlue, Extension) <> -1 then
+    raise Exception.Create('Name is already used for this extension');
+  FName := AValue;
+end;
+
+function TLazResourceEntry.GetExtension: utf8string;
+begin
+  Result:= FValueType;
+end;
+
+function TLazResourceEntry.GetFileSize: int64;
+begin
+  Result:= FContent.Size;
+end;
+
+destructor TLazResourceEntry.Destroy;
+begin
+  FreeAndNil(FContent);
+  inherited Destroy;
+end;
+
+constructor TLazResourceEntry.Create(AContainer: TMultiFileContainer; AName: utf8string; AValueType: utf8string;
+  AContent: TStream);
+begin
+  inherited Create(AContainer);
+  FName := AName;
+  FValueType := UTF8UpperCase(AValueType);
+  FContent := AContent;
+end;
+
+function TLazResourceEntry.CopyTo(ADestination: TStream): int64;
+begin
+  if FContent.Size = 0 then
+    result := 0
+  else
+  begin
+    FContent.Position:= 0;
+    result := ADestination.CopyFrom(FContent, FContent.Size);
+  end;
+end;
+
+function TLazResourceEntry.GetStream: TStream;
+begin
+  Result:= FContent;
+end;
+
+{ TLazResourceContainer }
+
+procedure TLazResourceContainer.LoadFromStream(AStream: TStream);
+const
+  entryStart = 'LazarusResources.Add(';
+  entryEnd = ');';
+  whiteSpace = [' ',#9,#10,#13,#26];
+var
+  fileContent: String;
+  filePos : integer;
+
+  procedure SkipWhitespace;
+  begin
+    while (filePos <= length(fileContent)) and (fileContent[filePos] in whiteSpace) do inc(filePos);
+  end;
+
+  procedure SkipComma;
+  begin
+    SkipWhitespace;
+    if (filePos <= length(fileContent)) and (fileContent[filePos] = ',') then
+      inc(filePos)
+    else
+      raise Exception.Create('Comma expected');
+  end;
+
+  function ParseString(ignoreCommas: boolean): TStream;
+  var
+    expectPlus: boolean;
+
+    procedure AppendChar(c: char);
+    begin
+      result.WriteByte(ord(c));
+    end;
+
+    function ParseNumber: integer;
+    var numberStart, errPos: integer;
+      s: String;
+    begin
+      numberStart:= filePos;
+      if (filePos <= length(fileContent)) and (fileContent[filePos] = '$') then
+      begin
+        inc(filePos);
+        while (filePos <= length(fileContent)) and (fileContent[filePos] in['0'..'9','a'..'f','A'..'F']) do inc(filePos);
+      end else
+      begin
+        while (filePos <= length(fileContent)) and (fileContent[filePos] in['0'..'9']) do inc(filePos);
+      end;
+      s := copy(fileContent,numberStart,filePos-numberStart);
+      val(s, result, errPos);
+      if errPos <> 0 then
+        raise exception.Create('Invalid number "' + s + '"');
+    end;
+
+    function ParseStringPart: boolean;
+    var charCode: integer;
+    begin
+      SkipWhitespace;
+      if filePos <= length(fileContent) then
+      begin
+        if expectPlus then
+          if fileContent[filePos] <> '+' then
+          begin
+            result := false;
+            expectPlus := false;
+            exit;
+          end else
+          inc(filePos);
+
+        case fileContent[filePos] of
+        '+': raise exception.Create('Unexpected "+"');
+        '''': begin
+            inc(filePos);
+            while (filePos <= length(fileContent)) do
+            begin
+              if fileContent[filePos] = '''' then
+              begin
+                inc(filePos);
+                if (filePos <= length(fileContent)) and (fileContent[filePos] = '''') then
+                begin
+                  AppendChar('''');
+                  inc(filePos);
+                end
+                else break;
+              end else
+              if fileContent[filePos] in[#10,#13] then
+                raise Exception.Create('Unexpected end of line')
+              else
+              begin
+                AppendChar(fileContent[filePos]);
+                inc(filePos);
+              end;
+            end;
+            if (filePos <= length(fileContent)) and (fileContent[filePos] = '#') then
+              expectPlus := false
+            else
+              expectPlus := true;
+            result := true;
+          end;
+        '#': begin
+            inc(filePos);
+            charCode := ParseNumber;
+            if (charCode < 0) or (charCode > 255) then
+              raise exception.Create('Character code out of bounds');
+            AppendChar(chr(charCode));
+            if (filePos <= length(fileContent)) and (fileContent[filePos] in['#','''']) then
+              expectPlus := false
+            else
+              expectPlus := true;
+            result := true;
+          end;
+         else
+         begin
+           result := false;
+           expectPlus := false;
+         end;
+         end;
+      end
+       else
+       begin
+         result := false;
+         expectPlus := false;
+       end;
+    end;
+
+  begin
+    result := TMemoryStream.Create;
+    expectPlus := false;
+    if not ParseStringPart then raise exception.Create('Expecting string');
+    repeat
+      if ignoreCommas then
+      begin
+        SkipWhitespace;
+        if (filePos <= length(fileContent)) and (fileContent[filePos] = ',') then
+        begin
+          inc(filePos);
+          expectPlus := false;
+        end;
+      end;
+    until not ParseStringPart;
+  end;
+
+  procedure ReadContent;
+  var
+    bytesRead: integer;
+  begin
+    setlength(fileContent,AStream.Size-AStream.Position);
+    bytesRead := AStream.Read(fileContent[1],length(fileContent));
+    setlength(fileContent, bytesRead);
+    filePos := 1;
+  end;
+
+  function StreamToUTF8String(AStream: TStream): utf8String;
+  begin
+    setlength(result, AStream.Size);
+    AStream.Position := 0;
+    AStream.Read(result[1], length(result));
+    AStream.Free;
+  end;
+
+var
+  entryName: utf8string;
+  entryType: utf8string;
+  entryContent: TStream;
+  inArray: boolean;
+
+begin
+  Clear;
+  ReadContent;
+  while filePos <= length(fileContent) do
+  begin
+    if (upcase(fileContent[filePos]) = upcase(entryStart[1])) and
+      (CompareText(copy(fileContent,filePos,length(entryStart)),entryStart)=0) then
+    begin
+      inc(filePos, length(entryStart));
+      entryName := StreamToUTF8String(ParseString(false));
+      SkipComma;
+      entryType := StreamToUTF8String(ParseString(false));
+      SkipComma;
+
+      SkipWhitespace;
+      if (filePos <= length(fileContent)) and (fileContent[filePos] = '[') then
+      begin
+        inArray := true;
+        inc(filePos);
+      end else
+        inArray := false;
+      entryContent := ParseString(inArray);
+      SkipWhitespace;
+      if inArray then
+      begin
+        if (filePos <= length(fileContent)) and (fileContent[filePos] = ']') then
+          inc(filePos)
+        else
+          raise exception.Create('Expecting "]"');
+      end;
+
+      if entryType = 'FORMDATA' then
+        AddEntry(TFormDataEntry.Create(self,entryName,entryContent))
+      else
+        AddEntry(TLazResourceEntry.Create(self,entryName,entryType,entryContent));
+
+      if (filePos+length(entryEnd)-1 <= length(fileContent)) and (CompareText(copy(fileContent,filePos,length(entryEnd)),entryEnd)=0) then
+        inc(filePos,length(entryEnd))
+      else
+        raise exception.Create('Expecting "'+entryEnd+'"');
+    end else
+    if fileContent[filePos] in whiteSpace then
+      inc(filePos)
+    else
+      raise exception.Create('Unexpected character "'+fileContent[filePos]+'"');
+  end;
+end;
+
+function TLazResourceContainer.CreateEntry(AName: utf8string; AExtension: utf8string;
+  AContent: TStream): TMultiFileEntry;
+var
+  binContent: TMemoryStream;
+begin
+  if UTF8CompareText(AExtension,'lfm')=0 then
+  begin
+    binContent := TMemoryStream.Create;
+    try
+      AContent.Position:= 0;
+      LRSObjectTextToBinary(AContent, binContent);
+      result := TFormDataEntry.Create(self,AName,binContent);
+    except
+      on ex:Exception do
+      begin
+        binContent.Free;
+        result := nil;
+      end;
+    end;
+    AContent.Free;
+  end
+  else
+    result := TLazResourceEntry.Create(self,AName,UTF8UpperCase(AExtension),AContent);
+end;
+
+procedure TLazResourceContainer.SaveToStream(ADestination: TStream);
+var
+  i: Integer;
+begin
+  for i := 0 to Count-1 do
+    TLazResourceEntry(Entry[i]).Serialize(ADestination);
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgralclbitmap.pas

@@ -0,0 +1,997 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRALCLBitmap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, Graphics, GraphType, BGRABitmapTypes, BGRADefaultBitmap;
+
+type
+  { TBGRALCLBitmap }
+
+  TBGRALCLBitmap = class(TBGRADefaultBitmap)
+  protected
+    function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte;
+      AlwaysReplaceAlpha: boolean = False; RaiseErrorOnInvalidPixelFormat: boolean = True): boolean; override;
+    function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override;
+    procedure DoLoadFromBitmap; override;
+    procedure RebuildBitmap; override;
+    function CreatePtrBitmap(AWidth, AHeight: integer; AData: PBGRAPixel
+      ): TBGRAPtrBitmap; override;
+    procedure AssignRasterImage(ARaster: TRasterImage); virtual;
+    procedure ExtractXorMask;
+  public
+    procedure Assign(Source: TPersistent); override;
+    procedure LoadFromResource(AFilename: string; AOptions: TBGRALoadingOptions); overload; override;
+    procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+      AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
+    procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer;
+      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
+    procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override;
+    procedure LoadFromDevice({%H-}DC: HDC); override;
+    procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override;
+    procedure TakeScreenshotOfPrimaryMonitor; override;
+    procedure TakeScreenshot({%H-}ARect: TRect); override;
+  end;
+
+  { TBGRALCLPtrBitmap }
+
+  TBGRALCLPtrBitmap = class(TBGRAPtrBitmap)
+
+    procedure RebuildBitmap; override;
+    function CreatePtrBitmap(AWidth, AHeight: integer; AData: PBGRAPixel): TBGRAPtrBitmap; override;
+    function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override;
+    function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte;
+      AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean
+      =True): boolean; override;
+  public
+    procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override;
+    procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
+      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
+    procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
+      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
+  end;
+
+type
+
+  { TBitmapTracker }
+
+  TBitmapTracker = class(TBitmap)
+  protected
+    FUser: TBGRADefaultBitmap;
+    procedure Changed(Sender: TObject); override;
+  public
+    constructor Create(AUser: TBGRADefaultBitmap); overload;
+  end;
+
+implementation
+
+uses BGRAText, LCLType, LCLIntf, FPimage;
+
+{ TBitmapTracker }
+
+constructor TBitmapTracker.Create(AUser: TBGRADefaultBitmap);
+begin
+  FUser := AUser;
+  inherited Create;
+end;
+
+procedure TBitmapTracker.Changed(Sender: TObject);
+begin
+  if FUser <> nil then
+    FUser.NotifyBitmapChange;
+  inherited Changed(Sender);
+end;
+
+type
+  TCopyPixelProc = procedure (psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte);
+
+procedure ApplyMask1bit(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; {%H-}sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte);
+var currentBit: byte;
+begin
+  currentBit := 1;
+  while count > 0 do
+  begin
+    if psrc^ and currentBit <> 0 then pdest^.alpha := 0;
+    inc(pdest);
+    if currentBit = 128 then
+    begin
+      currentBit := 1;
+      inc(psrc);
+    end else
+      currentBit := currentBit shl 1;
+    dec(count);
+  end;
+end;
+
+procedure ApplyMask1bitRev(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; {%H-}sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte);
+var currentBit: byte;
+begin
+  currentBit := 128;
+  while count > 0 do
+  begin
+    if psrc^ and currentBit <> 0 then pdest^.alpha := 0;
+    inc(pdest);
+    if currentBit = 1 then
+    begin
+      currentBit := 128;
+      inc(psrc);
+    end else
+      currentBit := currentBit shr 1;
+    dec(count);
+  end;
+end;
+
+procedure CopyFromBW_SetAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; {%H-}sourcePixelSize: PtrInt; defaultOpacity: byte);
+var currentBit: byte;
+begin
+  currentBit := 1;
+  while count > 0 do
+  begin
+    if psrc^ and currentBit <> 0 then
+      pdest^ := BGRAWhite
+    else
+      pdest^ := BGRABlack;
+    pdest^.alpha := DefaultOpacity;
+    inc(pdest);
+    if currentBit = 128 then
+    begin
+      currentBit := 1;
+      inc(psrc);
+    end else
+      currentBit := currentBit shl 1;
+    dec(count);
+  end;
+end;
+
+procedure CopyFromBW_SetAlphaBitRev(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; {%H-}sourcePixelSize: PtrInt; defaultOpacity: byte);
+var currentBit: byte;
+begin
+  currentBit := 128;
+  while count > 0 do
+  begin
+    if psrc^ and currentBit <> 0 then
+      pdest^ := BGRAWhite
+    else
+      pdest^ := BGRABlack;
+    pdest^.alpha := DefaultOpacity;
+    inc(pdest);
+    if currentBit = 1 then
+    begin
+      currentBit := 128;
+      inc(psrc);
+    end else
+      currentBit := currentBit shr 1;
+    dec(count);
+  end;
+end;
+
+procedure CopyFrom24Bit(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte);
+begin
+  while count > 0 do
+  begin
+    PWord(pdest)^ := PWord(psrc)^;
+    (PByte(pdest)+2)^ := (psrc+2)^;
+    pdest^.alpha := DefaultOpacity;
+    inc(psrc,sourcePixelSize);
+    inc(pdest);
+    dec(count);
+  end;
+end;
+
+procedure CopyFrom24Bit_SwapRedBlue(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte);
+begin
+  while count > 0 do
+  begin
+    PByte(pdest)^ := (psrc+2)^;
+    (PByte(pdest)+1)^ := (psrc+1)^;
+    (PByte(pdest)+2)^ := psrc^;
+    pdest^.alpha := DefaultOpacity;
+    inc(psrc,sourcePixelSize);
+    inc(pdest);
+    dec(count);
+  end;
+end;
+
+procedure CopyFromARGB_KeepAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte);
+begin
+  while count > 0 do
+  begin
+    PLongWord(pdest)^ := ((PByte(psrc)+3)^ shl TBGRAPixel_BlueShift) or
+                      ((PByte(psrc)+2)^ shl TBGRAPixel_GreenShift) or
+                      ((PByte(psrc)+1)^ shl TBGRAPixel_RedShift) or
+                      (PByte(psrc)^ shl TBGRAPixel_AlphaShift);
+    dec(count);
+    inc(pdest);
+    inc(psrc, sourcePixelSize);
+  end;
+end;
+
+procedure CopyFromARGB_SetAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte);
+begin
+  while count > 0 do
+  begin
+    PLongWord(pdest)^ := ((PByte(psrc)+3)^ shl TBGRAPixel_BlueShift) or
+                      ((PByte(psrc)+2)^ shl TBGRAPixel_GreenShift) or
+                      ((PByte(psrc)+1)^ shl TBGRAPixel_RedShift) or
+                      (DefaultOpacity shl TBGRAPixel_AlphaShift);
+    inc(psrc, sourcePixelSize);
+    inc(pdest);
+    dec(count);
+  end;
+end;
+
+procedure CopyFromARGB_ReplaceZeroAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte);
+const ARGB_ColorMask = {$IFDEF ENDIAN_LITTLE}$FFFFFF00{$ELSE}$00FFFFFF{$ENDIF};
+      ARGB_RedShift = {$IFDEF ENDIAN_LITTLE}8{$ELSE}16{$ENDIF};
+      ARGB_GreenShift = {$IFDEF ENDIAN_LITTLE}16{$ELSE}8{$ENDIF};
+      ARGB_BlueShift = {$IFDEF ENDIAN_LITTLE}24{$ELSE}0{$ENDIF};
+var
+  sourceval: UInt32or64;
+  alphaValue: UInt32or64;
+  OpacityOrMask: UInt32or64;
+begin
+  OpacityOrMask := DefaultOpacity shl TBGRAPixel_AlphaShift;
+  while count > 0 do
+  begin
+    sourceval := plongword(psrc)^;
+    alphaValue := {$IFDEF ENDIAN_LITTLE}sourceval and $ff{$ELSE}sourceval shr 24{$ENDIF};
+    if (alphaValue = 0) and ((sourceval and ARGB_ColorMask) <> 0) then //if not black but transparent
+    begin
+      PLongWord(pdest)^ := (((sourceval shr ARGB_BlueShift) and $ff) shl TBGRAPixel_BlueShift) or
+                        (((sourceval shr ARGB_GreenShift) and $ff) shl TBGRAPixel_GreenShift) or
+                        (((sourceval shr ARGB_RedShift) and $ff) shl TBGRAPixel_RedShift) or
+                        OpacityOrMask;
+    end else
+    begin
+      PLongWord(pdest)^ := (((sourceval shr ARGB_BlueShift) and $ff) shl TBGRAPixel_BlueShift) or
+                        (((sourceval shr ARGB_GreenShift) and $ff) shl TBGRAPixel_GreenShift) or
+                        (((sourceval shr ARGB_RedShift) and $ff) shl TBGRAPixel_RedShift) or
+                        (alphaValue shl TBGRAPixel_AlphaShift);
+    end;
+    dec(count);
+    inc(pdest);
+    inc(psrc, sourcePixelSize);
+  end;
+end;
+
+const
+  BGRA_AlphaMask = 255 shl TBGRAPixel_AlphaShift;
+  BGRA_RedMask = 255 shl TBGRAPixel_RedShift;
+  BGRA_GreenMask = 255 shl TBGRAPixel_GreenShift;
+  BGRA_BlueMask = 255 shl TBGRAPixel_BlueShift;
+  BGRA_ColorMask = BGRA_RedMask or BGRA_GreenMask or BGRA_BlueMask;
+
+procedure CopyFrom32Bit_KeepAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte);
+begin
+  if sourcePixelSize = 4 then
+    move(psrc^,pdest^,count*sizeof(TBGRAPixel))
+  else
+  begin
+    while count > 0 do
+    begin
+      PLongWord(pdest)^ := PLongWord(psrc)^;
+      dec(count);
+      inc(pdest);
+      inc(psrc, sourcePixelSize);
+    end;
+  end;
+end;
+
+procedure CopyFrom32Bit_SwapRedBlue_KeepAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte);
+var srcValue: UInt32or64;
+begin
+  while count > 0 do
+  begin
+    srcValue := PLongWord(psrc)^;
+    PLongWord(pdest)^ := (srcValue and not (BGRA_RedMask or BGRA_BlueMask))
+                   or (((srcValue and BGRA_RedMask) shr TBGRAPixel_RedShift) shl TBGRAPixel_BlueShift)
+                   or (((srcValue and BGRA_BlueMask) shr TBGRAPixel_BlueShift) shl TBGRAPixel_RedShift);
+    dec(count);
+    inc(pdest);
+    inc(psrc, sourcePixelSize);
+  end;
+end;
+
+procedure CopyFrom32Bit_SetAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte);
+var
+  OpacityOrMask: UInt32or64;
+begin
+  OpacityOrMask := DefaultOpacity shl TBGRAPixel_AlphaShift;
+  while count > 0 do
+  begin
+    PLongWord(pdest)^ := (PLongWord(psrc)^ and not BGRA_AlphaMask) or OpacityOrMask;
+    inc(psrc, sourcePixelSize);
+    inc(pdest);
+    dec(count);
+  end;
+end;
+
+procedure CopyFrom32Bit_SwapRedBlue_SetAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte);
+begin
+  while count > 0 do
+  begin
+    pdest^.red := PBGRAPixel(psrc)^.blue;
+    pdest^.green := PBGRAPixel(psrc)^.green;
+    pdest^.blue := PBGRAPixel(psrc)^.red;
+    pdest^.alpha := DefaultOpacity; //use default opacity
+    inc(psrc, sourcePixelSize);
+    inc(pdest);
+    dec(count);
+  end;
+end;
+
+procedure CopyFrom32Bit_ReplaceZeroAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte);
+var sourceval: UInt32or64;
+  OpacityOrMask : UInt32or64;
+begin
+  OpacityOrMask := DefaultOpacity shl TBGRAPixel_AlphaShift;
+  while count > 0 do
+  begin
+    sourceval := plongword(psrc)^;
+    if ((sourceVal shr TBGRAPixel_AlphaShift) and $ff = 0) and ((sourceval and BGRA_ColorMask) <> 0) then //if not black but transparent
+      plongword(pdest)^ := (sourceval and BGRA_ColorMask) or OpacityOrMask //use default opacity
+    else
+      plongword(pdest)^ := plongword(psrc)^;
+    dec(count);
+    inc(pdest);
+    inc(psrc, sourcePixelSize);
+  end;
+end;
+
+procedure CopyFrom32Bit_SwapRedBlue_ReplaceZeroAlpha(psrc: PByte; pdest: PBGRAPixel; count: Int32or64; sourcePixelSize: PtrInt; defaultOpacity: byte);
+var sourceval: UInt32or64;
+  OpacityOrMask : UInt32or64;
+begin
+  OpacityOrMask := DefaultOpacity shl TBGRAPixel_AlphaShift;
+  while count > 0 do
+  begin
+    sourceval := plongword(psrc)^;
+    if ((sourceVal shr TBGRAPixel_AlphaShift) and $ff = 0) and ((sourceval and BGRA_ColorMask) <> 0) then //if not black but transparent
+      plongword(pdest)^ := (((sourceval and BGRA_RedMask) shr TBGRAPixel_RedShift) shl TBGRAPixel_BlueShift)
+                        or (((sourceval and BGRA_BlueMask) shr TBGRAPixel_BlueShift) shl TBGRAPixel_RedShift)
+                        or (sourceval and BGRA_GreenMask)
+                        or OpacityOrMask
+    else
+      plongword(pdest)^ := (((sourceval and BGRA_RedMask) shr TBGRAPixel_RedShift) shl TBGRAPixel_BlueShift)
+                        or (((sourceval and BGRA_BlueMask) shr TBGRAPixel_BlueShift) shl TBGRAPixel_RedShift)
+                        or (sourceval and (BGRA_GreenMask or BGRA_AlphaMask));
+    dec(count);
+    inc(pdest);
+    inc(psrc, sourcePixelSize);
+  end;
+end;
+
+procedure DoCopyProc(ADestination: TBGRACustomBitmap; ACopyProc: TCopyPixelProc; AData: PByte; ABytesPerLine, ABitsPerPixel: integer; ALineOrder: TRawImageLineOrder; ADefaultOpacity: byte);
+var
+  n: integer;
+  psource_byte, pdest_byte,
+  psource_first, pdest_first: PByte;
+  psource_delta, pdest_delta: integer;
+begin
+  if (ALineOrder = ADestination.LineOrder) and
+    (ABytesPerLine = (ABitsPerPixel shr 3) * LongWord(ADestination.Width)) then
+    ACopyProc(AData, ADestination.Data, ADestination.NbPixels, ABitsPerPixel shr 3, ADefaultOpacity)
+  else
+  begin
+    if ALineOrder = riloTopToBottom then
+    begin
+      psource_first := AData;
+      psource_delta := ABytesPerLine;
+    end else
+    begin
+      psource_first := AData + (ADestination.Height-1) * ABytesPerLine;
+      psource_delta := -ABytesPerLine;
+    end;
+
+    if ADestination.LineOrder = riloTopToBottom then
+    begin
+      pdest_first := PByte(ADestination.Data);
+      pdest_delta := ADestination.Width*sizeof(TBGRAPixel);
+    end else
+    begin
+      pdest_first := PByte(ADestination.Data) + (ADestination.Height-1)*ADestination.Width*sizeof(TBGRAPixel);
+      pdest_delta := -ADestination.Width*sizeof(TBGRAPixel);
+    end;
+
+    psource_byte := psource_first;
+    pdest_byte := pdest_first;
+    for n := ADestination.Height-1 downto 0 do
+    begin
+      ACopyProc(psource_byte, PBGRAPixel(pdest_byte), ADestination.Width, ABitsPerPixel shr 3, ADefaultOpacity);
+      inc(psource_byte, psource_delta);
+      inc(pdest_byte, pdest_delta);
+    end;
+  end;
+end;
+
+procedure ApplyRawImageMask(ADestination: TBGRACustomBitmap; const ARawImage: TRawImage);
+var
+  copyProc: TCopyPixelProc;
+begin
+  if (ARawImage.Description.MaskBitsPerPixel = 1) and (ARawImage.Mask <> nil) then
+  begin
+    if ARawImage.Description.BitOrder = riboBitsInOrder then
+      copyProc := @ApplyMask1bit
+    else
+      copyProc := @ApplyMask1bitRev;
+    DoCopyProc(ADestination, copyProc, ARawImage.Mask, ARawImage.Description.MaskBytesPerLine, ARawImage.Description.MaskBitsPerPixel, ARawImage.Description.LineOrder, 0);
+    ADestination.InvalidateBitmap;
+  end;
+end;
+
+{ Load raw image data. It must be 32bit, 24 bits or 1bit per pixel}
+function LoadFromRawImageImplementation(ADestination: TBGRADefaultBitmap; const ARawImage: TRawImage;
+  DefaultOpacity: byte; AlwaysReplaceAlpha: boolean; RaiseErrorOnInvalidPixelFormat: boolean): boolean;
+var
+  mustSwapRedBlue: boolean;
+  copyProc: TCopyPixelProc;
+  nbColorChannels: integer;
+
+  function FormatError(message: string): boolean;
+  begin
+    if RaiseErrorOnInvalidPixelFormat then
+      raise Exception.Create('Invalid raw image format. ' + message)
+    else
+      result := false;
+  end;
+
+begin
+  if (ARawImage.Description.Width <> LongWord(ADestination.Width)) or
+    (ARawImage.Description.Height <> LongWord(ADestination.Height)) then
+    raise Exception.Create('Bitmap size is inconsistent');
+
+  if (ADestination.Height=0) or (ADestination.Width=0) then
+  begin
+    result := true;
+    exit;
+  end;
+
+  if ARawImage.Description.BitsPerPixel = 1 then
+  begin
+    if ARawImage.Description.BitOrder = riboBitsInOrder then
+      copyProc := @CopyFromBW_SetAlpha
+    else
+      copyProc := @CopyFromBW_SetAlphaBitRev;
+    DefaultOpacity := 255;
+  end else
+  begin
+    if ((ARawImage.Description.BitsPerPixel and 7) <> 0) then
+    begin
+      result := FormatError(IntToStr(ARawImage.Description.Depth) + 'bit found but multiple of 8bit expected');
+      exit;
+    end;
+
+    if (ARawImage.Description.BitsPerPixel < 24) then
+    begin
+      result := FormatError(IntToStr(ARawImage.Description.Depth) + 'bit found but at least 24bit expected');
+      exit;
+    end;
+
+    nbColorChannels := 0;
+    if (ARawImage.Description.RedPrec > 0)  then inc(nbColorChannels);
+    if (ARawImage.Description.GreenPrec > 0)  then inc(nbColorChannels);
+    if (ARawImage.Description.BluePrec > 0)  then inc(nbColorChannels);
+
+    if (nbColorChannels < 3) then
+    begin
+      result := FormatError('One or more color channel is missing (RGB expected)');
+      exit;
+    end;
+
+    //channels are in ARGB order
+    if (ARawImage.Description.BitsPerPixel >= 32) and
+       (ARawImage.Description.AlphaPrec = 8) and
+      (((ARawImage.Description.AlphaShift = 0) and
+      (ARawImage.Description.RedShift = 8) and
+      (ARawImage.Description.GreenShift = 16) and
+      (ARawImage.Description.BlueShift = 24) and
+      (ARawImage.Description.ByteOrder = riboLSBFirst)) or
+      ((ARawImage.Description.AlphaShift = ARawImage.Description.BitsPerPixel - 8) and
+      (ARawImage.Description.RedShift = ARawImage.Description.BitsPerPixel - 16) and
+      (ARawImage.Description.GreenShift = ARawImage.Description.BitsPerPixel - 24) and
+      (ARawImage.Description.BlueShift = ARawImage.Description.BitsPerPixel - 32) and
+      (ARawImage.Description.ByteOrder = riboMSBFirst))) then
+      begin
+        if AlwaysReplaceAlpha then
+          copyProc := @CopyFromARGB_SetAlpha
+        else if DefaultOpacity = 0 then
+          copyProc := @CopyFromARGB_KeepAlpha
+        else
+          copyProc := @CopyFromARGB_ReplaceZeroAlpha;
+      end
+    else //channels are in ARGB order but alpha is not used
+    if (ARawImage.Description.BitsPerPixel >= 32) and
+       (ARawImage.Description.AlphaPrec = 0) and
+      (((ARawImage.Description.RedShift = 8) and
+      (ARawImage.Description.GreenShift = 16) and
+      (ARawImage.Description.BlueShift = 24) and
+      (ARawImage.Description.ByteOrder = riboLSBFirst)) or
+      ((ARawImage.Description.RedShift = ARawImage.Description.BitsPerPixel - 16) and
+      (ARawImage.Description.GreenShift = ARawImage.Description.BitsPerPixel - 24) and
+      (ARawImage.Description.BlueShift = ARawImage.Description.BitsPerPixel - 32) and
+      (ARawImage.Description.ByteOrder = riboMSBFirst))) then
+      begin
+        DefaultOpacity := 255;
+        copyProc := @CopyFromARGB_SetAlpha;
+      end
+    else
+    begin
+      //channels are in RGB order (alpha channel may follow)
+      if (ARawImage.Description.BitsPerPixel >= 24) and
+         (((ARawImage.Description.RedShift = 0) and
+           (ARawImage.Description.GreenShift = 8) and
+           (ARawImage.Description.BlueShift = 16) and
+           (ARawImage.Description.ByteOrder = riboLSBFirst)) or
+          ((ARawImage.Description.RedShift = ARawImage.Description.BitsPerPixel - 8) and
+           (ARawImage.Description.GreenShift = ARawImage.Description.BitsPerPixel - 16) and
+           (ARawImage.Description.BlueShift = ARawImage.Description.BitsPerPixel - 24) and
+           (ARawImage.Description.ByteOrder = riboMSBFirst))) then
+      begin
+        mustSwapRedBlue:= not TBGRAPixel_RGBAOrder;
+      end
+      else
+      //channels are in BGR order (alpha channel may follow)
+      if (ARawImage.Description.BitsPerPixel >= 24) and
+         (((ARawImage.Description.BlueShift = 0) and
+           (ARawImage.Description.GreenShift = 8) and
+           (ARawImage.Description.RedShift = 16) and
+           (ARawImage.Description.ByteOrder = riboLSBFirst)) or
+          ((ARawImage.Description.BlueShift = ARawImage.Description.BitsPerPixel - 8) and
+           (ARawImage.Description.GreenShift = ARawImage.Description.BitsPerPixel - 16) and
+           (ARawImage.Description.RedShift = ARawImage.Description.BitsPerPixel - 24) and
+           (ARawImage.Description.ByteOrder = riboMSBFirst))) then
+      begin
+        mustSwapRedBlue:= TBGRAPixel_RGBAOrder;
+      end
+      else
+      begin
+        result := FormatError('BitsPerPixel: ' + IntToStr(ARawImage.Description.BitsPerPixel) + ', '
+          + 'RedShit: ' + IntToStr(ARawImage.Description.RedShift) + ', Prec: ' + IntToStr(ARawImage.Description.RedPrec)+ ', '
+          + 'GreenShit: ' + IntToStr(ARawImage.Description.GreenShift) + ', Prec: ' + IntToStr(ARawImage.Description.GreenPrec)+ ', '
+          + 'BlueShift: ' + IntToStr(ARawImage.Description.BlueShift) + ', Prec: ' + IntToStr(ARawImage.Description.BluePrec)+ ', '
+          + 'AlphaShift: ' + IntToStr(ARawImage.Description.AlphaShift) + ', Prec: ' + IntToStr(ARawImage.Description.AlphaPrec) );
+        exit;
+      end;
+
+      if not mustSwapRedBlue then
+      begin
+        if ARawImage.Description.BitsPerPixel = 24 then
+          copyProc := @CopyFrom24Bit
+        else
+        if AlwaysReplaceAlpha or (ARawImage.Description.AlphaPrec = 0) then
+          copyProc := @CopyFrom32Bit_SetAlpha
+        else if DefaultOpacity = 0 then
+          copyProc := @CopyFrom32Bit_KeepAlpha
+        else
+          copyProc := @CopyFrom32Bit_ReplaceZeroAlpha;
+      end else
+      begin
+        if ARawImage.Description.BitsPerPixel = 24 then
+          copyProc := @CopyFrom24Bit_SwapRedBlue
+        else
+        if AlwaysReplaceAlpha or (ARawImage.Description.AlphaPrec = 0) then
+          copyProc := @CopyFrom32Bit_SwapRedBlue_SetAlpha
+        else if DefaultOpacity = 0 then
+          copyProc := @CopyFrom32Bit_SwapRedBlue_KeepAlpha
+        else
+          copyProc := @CopyFrom32Bit_SwapRedBlue_ReplaceZeroAlpha;
+      end;
+    end;
+  end;
+
+  DoCopyProc(ADestination, copyProc, ARawImage.Data, ARawImage.Description.BytesPerLine, ARawImage.Description.BitsPerPixel, ARawImage.Description.LineOrder, DefaultOpacity);
+  ADestination.InvalidateBitmap;
+
+  ApplyRawImageMask(ADestination, ARawImage);
+  result := true;
+end;
+
+{ Draw BGRA data to a canvas with transparency }
+procedure DataDrawTransparentImplementation(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+var
+  Temp:     TBitmap;
+  RawImage: TRawImage;
+  BitmapHandle, MaskHandle: HBitmap;
+begin
+  RawImage.Init;
+  RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(AWidth, AHeight);
+  RawImage.Description.LineOrder := ALineOrder;
+  RawImage.Data     := PByte(AData);
+  RawImage.DataSize := AWidth * AHeight * sizeof(TBGRAPixel);
+  if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then
+    raise FPImageException.Create('Failed to create bitmap handle');
+  Temp := TBitmap.Create;
+  Temp.Handle := BitmapHandle;
+  Temp.MaskHandle := MaskHandle;
+  ACanvas.StretchDraw(Rect, Temp);
+  Temp.Free;
+end;
+
+{ Draw BGRA data to a canvas without transparency }
+procedure DataDrawOpaqueImplementation(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+var
+  Temp:      TBitmap;
+  RawImage:  TRawImage;
+  BitmapHandle, MaskHandle: HBitmap;
+  CreateResult: boolean;
+  tempShift: byte;
+begin
+  if (AHeight = 0) or (AWidth = 0) then
+    exit;
+
+  RawImage.Init;
+  RawImage.Description.Init_BPP32_B8G8R8_BIO_TTB(AWidth,AHeight);
+  RawImage.Description.LineOrder := ALineOrder;
+  RawImage.Description.LineEnd := rileDWordBoundary;
+  RawImage.Data := PByte(AData);
+  RawImage.DataSize:= AWidth*AHeight*sizeof(TBGRAPixel);
+  if TBGRAPixel_RGBAOrder then
+  begin
+    tempShift := RawImage.Description.RedShift;
+    RawImage.Description.RedShift := RawImage.Description.BlueShift;
+    RawImage.Description.BlueShift := tempShift;
+  end;
+  CreateResult := RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False);
+
+  if not CreateResult then
+    raise FPImageException.Create('Failed to create bitmap handle');
+
+  Temp := TBitmap.Create;
+  Temp.Handle := BitmapHandle;
+  Temp.MaskHandle := MaskHandle;
+  ACanvas.StretchDraw(Rect, Temp);
+  Temp.Free;
+end;
+
+procedure GetImageFromCanvasImplementation(ADestination: TBGRADefaultBitmap; CanvasSource: TCanvas; x, y: integer);
+var
+  bmp: TBitmap;
+  subBmp: TBGRACustomBitmap;
+  subRect: TRect;
+  cw,ch: integer;
+begin
+  cw := CanvasSource.Width;
+  ch := CanvasSource.Height;
+  if (x < 0) or (y < 0) or (x+ADestination.Width > cw) or
+    (y+ADestination.Height > ch) then
+  begin
+    ADestination.FillTransparent;
+    if (x+ADestination.Width <= 0) or (y+ADestination.Height <= 0) or
+      (x >= cw) or (y >= ch) then
+      exit;
+
+    if (x > 0) then subRect.Left := x else subRect.Left := 0;
+    if (y > 0) then subRect.Top := y else subRect.Top := 0;
+    if (x+ADestination.Width > cw) then subRect.Right := cw else
+      subRect.Right := x+ADestination.Width;
+    if (y+ADestination.Height > ch) then subRect.Bottom := ch else
+      subRect.Bottom := y+ADestination.Height;
+
+    subBmp := ADestination.NewBitmap(subRect.Right-subRect.Left,subRect.Bottom-subRect.Top);
+    subBmp.GetImageFromCanvas(CanvasSource,subRect.Left,subRect.Top);
+    ADestination.PutImage(subRect.Left-x,subRect.Top-y,subBmp,dmSet);
+    subBmp.Free;
+    exit;
+  end;
+  bmp := TBitmap.Create;
+  bmp.PixelFormat := pf24bit;
+  bmp.Width := ADestination.Width;
+  bmp.Height := ADestination.Height;
+  bmp.Canvas.CopyRect(rect(0, 0, ADestination.Width, ADestination.Height), CanvasSource,
+    rect(x, y, x + ADestination.Width, y + ADestination.Height));
+  LoadFromRawImageImplementation(ADestination, bmp.RawImage, 255, True, False);
+  bmp.Free;
+  ADestination.InvalidateBitmap;
+end;
+
+{ TBGRALCLPtrBitmap }
+
+procedure TBGRALCLPtrBitmap.RebuildBitmap;
+var
+  RawImage: TRawImage;
+  BitmapHandle, MaskHandle: HBitmap;
+begin
+  if FBitmap <> nil then
+    FBitmap.Free;
+
+  FBitmap := TBitmapTracker.Create(self);
+
+  if (FWidth > 0) and (FHeight > 0) then
+  begin
+    RawImage.Init;
+    {$PUSH}{$WARNINGS OFF}
+    if TBGRAPixel_RGBAOrder then
+      RawImage.Description.Init_BPP32_R8G8B8A8_BIO_TTB(FWidth, FHeight)
+    else
+      RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(FWidth, FHeight);
+    {$POP}
+    RawImage.Description.LineOrder := FLineOrder;
+    RawImage.Data     := FDataByte;
+    RawImage.DataSize := FWidth * FHeight * sizeof(TBGRAPixel);
+    if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then
+      raise FPImageException.Create('Failed to create bitmap handle');
+    FBitmap.Handle     := BitmapHandle;
+    FBitmap.MaskHandle := MaskHandle;
+  end;
+
+  FBitmap.Canvas.AntialiasingMode := amOff;
+end;
+
+function TBGRALCLPtrBitmap.CreatePtrBitmap(AWidth, AHeight: integer;
+  AData: PBGRAPixel): TBGRAPtrBitmap;
+begin
+  Result:= TBGRALCLPtrBitmap.Create(AWidth,AHeight,AData);
+end;
+
+function TBGRALCLPtrBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer;
+begin
+  result := TLCLFontRenderer.Create;
+end;
+
+function TBGRALCLPtrBitmap.LoadFromRawImage(ARawImage: TRawImage;
+  DefaultOpacity: byte; AlwaysReplaceAlpha: boolean;
+  RaiseErrorOnInvalidPixelFormat: boolean): boolean;
+begin
+  DiscardBitmapChange;
+  result := LoadFromRawImageImplementation(self,ARawImage,DefaultOpacity,AlwaysReplaceAlpha,RaiseErrorOnInvalidPixelFormat);
+end;
+
+procedure TBGRALCLPtrBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x,
+  y: integer);
+begin
+  DiscardBitmapChange;
+  GetImageFromCanvasImplementation(self,CanvasSource,x,y);
+end;
+
+procedure TBGRALCLPtrBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+begin
+  DataDrawTransparentImplementation(ACanvas, Rect, AData, ALineOrder, AWidth, AHeight);
+end;
+
+procedure TBGRALCLPtrBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+begin
+  DataDrawOpaqueImplementation(ACanvas, Rect, AData, ALineOrder, AWidth, AHeight);
+end;
+
+function TBGRALCLBitmap.LoadFromRawImage(ARawImage: TRawImage;
+  DefaultOpacity: byte; AlwaysReplaceAlpha: boolean;
+  RaiseErrorOnInvalidPixelFormat: boolean): boolean;
+begin
+  DiscardBitmapChange;
+  result := LoadFromRawImageImplementation(self,ARawImage,DefaultOpacity,AlwaysReplaceAlpha,RaiseErrorOnInvalidPixelFormat);
+end;
+
+function TBGRALCLBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer;
+begin
+  result := TLCLFontRenderer.Create;
+end;
+
+procedure TBGRALCLBitmap.DoLoadFromBitmap;
+begin
+  if FBitmap <> nil then
+  begin
+    LoadFromRawImage(FBitmap.RawImage, FCanvasOpacity);
+    if FAlphaCorrectionNeeded then DoAlphaCorrection;
+  end;
+end;
+
+procedure TBGRALCLBitmap.RebuildBitmap;
+var
+  RawImage: TRawImage;
+  BitmapHandle, MaskHandle: HBitmap;
+begin
+  if FBitmap <> nil then
+    FBitmap.Free;
+
+  FBitmap := TBitmapTracker.Create(self);
+
+  if (FWidth > 0) and (FHeight > 0) then
+  begin
+    RawImage.Init;
+    {$PUSH}{$WARNINGS OFF}
+    if TBGRAPixel_RGBAOrder then
+      RawImage.Description.Init_BPP32_R8G8B8A8_BIO_TTB(FWidth, FHeight)
+    else
+      RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(FWidth, FHeight);
+    {$POP}
+    RawImage.Description.LineOrder := FLineOrder;
+    RawImage.Data     := FDataByte;
+    RawImage.DataSize := FWidth * FHeight * sizeof(TBGRAPixel);
+    if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then
+      raise FPImageException.Create('Failed to create bitmap handle');
+    FBitmap.Handle     := BitmapHandle;
+    FBitmap.MaskHandle := MaskHandle;
+  end;
+
+  FBitmap.Canvas.AntialiasingMode := amOff;
+end;
+
+function TBGRALCLBitmap.CreatePtrBitmap(AWidth, AHeight: integer;
+  AData: PBGRAPixel): TBGRAPtrBitmap;
+begin
+  Result:= TBGRALCLPtrBitmap.Create(AWidth, AHeight, AData);
+end;
+
+procedure TBGRALCLBitmap.Assign(Source: TPersistent);
+begin
+  if Source is TRasterImage then
+  begin
+    AssignRasterImage(TRasterImage(Source));
+  end else
+    inherited Assign(Source);
+
+  if Source is TCursorImage then
+  begin
+    HotSpot := TCursorImage(Source).HotSpot;
+    ExtractXorMask;
+  end
+  else if Source is TIcon then
+  begin
+    HotSpot := Point(0,0);
+    ExtractXorMask;
+  end;
+end;
+
+procedure TBGRALCLBitmap.LoadFromResource(AFilename: string;
+  AOptions: TBGRALoadingOptions);
+var
+  icon: TCustomIcon;
+  ext: String;
+begin
+  if BGRAResource.IsWinResource(AFilename) then
+  begin
+    ext:= Uppercase(ExtractFileExt(AFilename));
+    if (ext = '.ICO') or (ext = '.CUR') then
+    begin
+      if ext= '.ICO' then icon := TIcon.Create
+      else icon := TCursorImage.Create;
+      try
+        icon.LoadFromResourceName(HInstance, ChangeFileExt(AFilename,''));
+        icon.Current:= icon.GetBestIndexForSize(Size(65536,65536));
+        self.AssignRasterImage(icon);
+      finally
+        icon.Free;
+      end;
+      exit;
+    end;
+  end;
+
+  inherited LoadFromResource(AFilename, AOptions);
+end;
+
+procedure TBGRALCLBitmap.AssignRasterImage(ARaster: TRasterImage);
+var TempBmp: TBitmap;
+begin
+  DiscardBitmapChange;
+  SetSize(ARaster.Width, ARaster.Height);
+  if LoadFromRawImage(ARaster.RawImage,0,False,False) then
+  begin
+    If Empty then
+    begin
+      AlphaFill(255); // if bitmap seems to be empty, assume
+                      // it is an opaque bitmap without alpha channel
+      ApplyRawImageMask(self, ARaster.RawImage);
+    end;
+  end else
+  if (ARaster is TBitmap) or (ARaster is TCustomIcon) then
+  begin //try to convert
+    TempBmp := TBitmap.Create;
+    TempBmp.Width := ARaster.Width;
+    TempBmp.Height := ARaster.Height;
+    TempBmp.Canvas.Draw(0,0,ARaster);
+    try
+      LoadFromRawImage(TempBmp.RawImage,255,False,true);
+      ApplyRawImageMask(self, ARaster.RawImage);
+    finally
+      TempBmp.Free;
+    end;
+  end else
+    raise Exception.Create('Unable to convert image to 24 bit');
+end;
+
+procedure TBGRALCLBitmap.ExtractXorMask;
+var
+  y, x: Integer;
+  p: PBGRAPixel;
+begin
+  DiscardXorMask;
+  for y := 0 to Height-1 do
+  begin
+    p := ScanLine[y];
+    for x := 0 to Width-1 do
+    begin
+      if (p^.alpha = 0) and (PLongWord(p)^<>0) then
+      begin
+        NeedXorMask;
+        XorMask.SetPixel(x,y, p^);
+      end;
+      inc(p);
+    end;
+  end;
+end;
+
+procedure TBGRALCLBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+begin
+  DataDrawTransparentImplementation(ACanvas, Rect, AData, ALineOrder, AWidth, AHeight);
+end;
+
+procedure TBGRALCLBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+begin
+  DataDrawOpaqueImplementation(ACanvas, ARect, AData, ALineOrder, AWidth, AHeight);
+end;
+
+procedure TBGRALCLBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer
+  );
+begin
+  DiscardBitmapChange;
+  GetImageFromCanvasImplementation(self,CanvasSource,x,y);
+end;
+
+procedure TBGRALCLBitmap.LoadFromDevice(DC: HDC);
+var
+  rawImage: TRawImage;
+  sourceSize: TPoint;
+begin
+  sourceSize := Point(0,0);
+  GetDeviceSize(DC, sourceSize);
+  if (sourceSize.x = 0) or (sourceSize.y = 0) then
+  begin
+    SetSize(0,0);
+    exit;
+  end;
+  try
+    if not RawImage_FromDevice(rawImage, DC, rect(0,0,sourceSize.x,sourceSize.y)) then
+      raise Exception.Create('Cannot get raw image from device');
+    SetSize(rawImage.Description.Width, rawImage.Description.Height);
+    LoadFromRawImage(rawImage,255);
+  finally
+    rawImage.FreeData;
+  end;
+end;
+
+procedure TBGRALCLBitmap.LoadFromDevice(DC: HDC; ARect: TRect);
+var
+  rawImage: TRawImage;
+begin
+  if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then
+  begin
+    SetSize(0,0);
+    exit;
+  end;
+  try
+    if not RawImage_FromDevice(rawImage, DC, ARect) then
+      raise Exception.Create('Cannot get raw image from device');
+    SetSize(rawImage.Description.Width, rawImage.Description.Height);
+    LoadFromRawImage(rawImage,255);
+  finally
+    rawImage.FreeData;
+  end;
+end;
+
+procedure TBGRALCLBitmap.TakeScreenshotOfPrimaryMonitor;
+var primaryDC: THandle;
+begin
+  primaryDC := LCLIntf.GetDC(0);
+  LoadFromDevice(primaryDC);
+  LCLIntf.ReleaseDC(0, primaryDC);
+end;
+
+procedure TBGRALCLBitmap.TakeScreenshot(ARect: TRect);
+var primaryDC: THandle;
+begin
+  primaryDC := LCLIntf.GetDC(0);
+  LoadFromDevice(primaryDC, ARect);
+  LCLIntf.ReleaseDC(0, primaryDC);
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgralzpcommon.pas

@@ -0,0 +1,643 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRALzpCommon;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils;
+
+const
+  LAZPAINT_COMPRESSION_MODE_ZSTREAM = 1;
+  LAZPAINT_COMPRESSION_MODE_RLE = 2;
+  LAZPAINT_COMPRESSION_MASK = 255;
+  LAZPAINT_THUMBNAIL_PNG = 256;
+  LAZPAINT_MAGIC_HEADER : array[0..7] of char = 'LazPaint';
+
+  LazpaintChannelGreenFromRed  = 1;
+  LazpaintChannelBlueFromRed   = 2;
+  LazpaintChannelBlueFromGreen = 4;
+  LazpaintChannelNoAlpha       = 8;
+  LazpaintPalettedRGB          = 16;
+
+  LazPaintThumbMaxWidth = 128;
+  LazPaintThumbMaxHeight = 128;
+
+type
+  TLzpCompression = (lzpZStream, //slower and not necessarily better
+                     lzpRLE);    //custom RLE for lzp files
+
+  { TLazPaintImageHeader }
+
+  TLazPaintImageHeader = packed record
+    magic: packed array[0..7] of char;
+    zero1, headerSize: LongWord;
+    width, height, nbLayers, previewOffset: LongWord;
+    zero2, compressionMode, reserved1, layersOffset: LongWord;
+  end;
+
+procedure LazPaintImageHeader_SwapEndianIfNeeded(AHeader: TLazPaintImageHeader);
+
+//routines to compress and uncompress byte-sized values (you need to
+//separate the channels to obtain any compression)
+
+procedure EncodeLazRLE(var sourceBuffer; size:PtrInt; ADest: TStream);
+function DecodeLazRLE(ASource: TStream; var destBuffer; availableOutputSize: PtrInt; availableInputSize: int64 = -1): PtrInt;
+
+implementation
+
+const //flag to distinguish ranges of opcodes
+      simpleRepetitionFlag = $00;    // $01..$3f: normal repetition
+      packedRepetitionFlag = $40;    // $41..$5f: packed repetition
+      repetitionOf0Flag    = $60;    // $60..$6f: repeat 1..16 zeros
+      repetitionOf255Flag  = $70;    // $70..$7f: repeat 1..16 values of 255
+      simpleDumpFlag       = $80;    // $81: dump of size as byte+64,   $82..$bf: simple dump (2..63)
+      packedDumpFlag       = $c0;    // $c3..$df: packed dump (3..31)
+      packedDumpFromLastFlag= $e0;   // $e2..$fe: packed dump from last packed dump value (2..30)
+
+      //special opcodes
+      wordRepetitionOpCode             = $00; //followed by word and then a value to repeat
+      byteRepetitionOpCode             = $40; //followed by byte (add 64 to it to get the repetition count) and then a value to repeat
+      previousWordSizeRepetitionOpCode = $80; //use the last value of opcode $00 so only followed by value to repeat
+      previousByteSizeRepetitionOpCode = $c0; //use the last value of opcode $80 so only followed by value to repeat
+      endOfStreamOpCode                = $e0; //end of RLE stream (not necessarily the end of the image)
+
+      //for future use but must not be accepted in the input stream
+      {%H-}reservedOpCode1 = $c1;
+      {%H-}reservedOpCode2 = $c2;
+      {%H-}reservedOpCode3 = $e1;
+
+      {%H-}optionalOpCode = $ff;  //for future use but should be ignored if not recognized
+
+      //numeric information
+      maxNormalRepetition = 63;
+      maxSmallRepCount    = 31 * 4;  // sets of four packed repetition
+      maxDumpCount        = 255+32;
+
+      maxRepetition = 65535;         // normal: 1..63, byte+64: 64..319, word-sized: 0..65535
+      minSmallRep = 1;
+      maxSmallRep = minSmallRep+3;
+
+
+procedure EncodeLazRLE(var sourceBuffer; size:PtrInt; ADest: TStream);
+const BufferSize = 4096;
+var
+  buffer: array[0..BufferSize-1] of byte;
+  bufferPos: integer;
+  smallRepetitions: array[0..maxSmallRepCount-1] of record
+    value: Int32or64;
+    count: Int32or64; //minSmallRep..maxSmallRep
+  end;
+  smallRepetitionsCount, smallRepTotal: Int32or64;
+  previousWordSizeRepetition, previousByteSizeRepetition: Int32or64;
+  lastPackedDumpValue: Int32or64;
+
+  procedure FlushBuffer;
+  begin
+    ADest.WriteBuffer(buffer, BufferSize);
+    bufferPos := 0;
+  end;
+
+  procedure WriteByte(b: byte); inline;
+  begin
+    buffer[bufferPos] := b;
+    inc(bufferPos);
+    if bufferPos = BufferSize then FlushBuffer;
+  end;
+
+  procedure WriteBytes(p: PByte; ACount: integer);
+  var
+    writeCount: Integer;
+  begin
+    while bufferPos+ACount >= BufferSize do
+    begin
+      writeCount := BufferSize-bufferPos;
+      move(p^, buffer[bufferPos], writeCount);
+      inc(p, writeCount);
+      bufferPos := BufferSize;
+      dec(ACount, writeCount);
+      FlushBuffer;
+    end;
+    if ACount > 0 then
+    begin
+      move(p^, buffer[bufferPos], ACount);
+      inc(bufferPos, ACount);
+    end;
+  end;
+
+  procedure OutputNormalRepetition(AValue,ACount: Int32or64);
+  begin
+    If (ACount < 1) or (ACount > maxNormalRepetition) then
+      raise exception.Create('Invalid count');
+
+    if (AValue = 0) and (ACount <= 16) then
+      begin
+        WriteByte((ACount-1) or repetitionOf0Flag);
+      end else
+    if (AValue = 255) and (ACount <= 16) then
+      begin
+        WriteByte((ACount-1) or repetitionOf255Flag);
+      end else
+      begin
+        WriteByte(ACount or simpleRepetitionFlag);
+        WriteByte(AValue);
+      end;
+  end;
+
+  procedure FlushSmallRepetitions;
+  var i,j: Int32or64;
+    packedCount: Int32or64;
+    smallOutput: Int32or64;
+  begin
+    if smallRepetitionsCount = 0 then exit;
+    if smallRepetitionsCount >= 4 then
+    begin
+      smallOutput:= smallRepetitionsCount and not 3;
+      WriteByte(packedRepetitionFlag or (smallOutput shr 2));
+      packedCount := 0;
+      for i := 0 to smallOutput-1 do
+      begin
+        packedCount := packedCount + ((smallRepetitions[i].count-minSmallRep) shl ((i and 3) shl 1));
+        if (i and 3) = 3 then
+        begin
+          WriteByte(packedCount);
+          for j := i-3 to i do
+            WriteByte(smallRepetitions[j].value);
+          packedCount:= 0;
+        end;
+      end;
+      for i := smallOutput to smallRepetitionsCount-1 do
+        OutputNormalRepetition(smallRepetitions[i].value,smallRepetitions[i].count);
+    end else
+    begin
+      for i := 0 to smallRepetitionsCount-1 do
+        OutputNormalRepetition(smallRepetitions[i].value,smallRepetitions[i].count);
+    end;
+    smallRepetitionsCount := 0;
+    smallRepTotal := 0;
+  end;
+
+  procedure OutputRepetition(AValue,ACount: Int32or64; AAccumulate: boolean = true);
+  begin
+    if AAccumulate and (ACount >= minSmallRep) and (ACount <= maxSmallRep) and (maxSmallRepCount>0) then
+    begin
+      if (smallRepetitionsCount> 0) and (smallRepetitions[smallRepetitionsCount-1].value = AValue) and
+        (smallRepetitions[smallRepetitionsCount-1].count+ACount <= maxSmallRepCount) then
+      begin
+        inc(smallRepetitions[smallRepetitionsCount-1].count, ACount);
+        exit;
+      end;
+      if smallRepetitionsCount = maxSmallRepCount then
+        FlushSmallRepetitions;
+      if smallRepetitionsCount and 3 = 0 then smallRepTotal := 0;
+      smallRepetitions[smallRepetitionsCount].value := AValue;
+      smallRepetitions[smallRepetitionsCount].count := ACount;
+      inc(smallRepetitionsCount);
+      inc(smallRepTotal, ACount);
+    end else
+    begin
+      flushSmallRepetitions;
+      if ACount <= maxNormalRepetition then
+        OutputNormalRepetition(AValue,ACount) else
+      begin
+        if ACount = previousWordSizeRepetition then
+        begin
+          WriteByte(previousWordSizeRepetitionOpCode);
+          WriteByte(AValue);
+        end else
+        if ACount = previousByteSizeRepetition then
+        begin
+          WriteByte(previousByteSizeRepetitionOpCode);
+          WriteByte(AValue);
+        end else
+        if ACount <= 64+255 then
+        begin
+          WriteByte(byteRepetitionOpCode);
+          WriteByte(ACount-64);
+          WriteByte(AValue);
+          previousByteSizeRepetition := ACount;
+        end else
+        if ACount <= 65535 then
+        begin
+          WriteByte(wordRepetitionOpCode);
+          WriteByte(ACount shr 8);
+          WriteByte(ACount and 255);
+          WriteByte(AValue);
+          previousWordSizeRepetition := ACount;
+        end else
+          raise exception.Create('Invalid count');
+      end;
+    end;
+  end;
+
+  procedure DumpNoPack(P: PByte; ACount: Int32or64);
+  begin
+    if ACount = 0 then exit;
+    if ACount = 1 then
+    begin
+      OutputNormalRepetition(p^,1);
+      exit;
+    end;
+    If (ACount < 0) or (ACount > maxDumpCount) then
+      raise exception.Create('Invalid count');
+
+    if ACount > 63 then
+    begin
+      if ACount > 255+64 then
+        raise exception.Create('Invalid count');
+      WriteByte($01 or simpleDumpFlag);
+      WriteByte(ACount-64);
+    end else
+      WriteByte(ACount or simpleDumpFlag);
+
+    WriteBytes(p, ACount);
+  end;
+
+  procedure DumpPacked(p : PByte; ACount: Int32or64);
+  var diffLast: integer;
+      packedValues: array[0..31] of Int32or64;
+      nbPackedValues, idx: Int32or64;
+
+  begin
+    if ACount = 0 then exit else
+    if ACount = 1 then
+    begin
+      OutputNormalRepetition(p^,1);
+      exit;
+    end else
+    if ACount = 2 then
+    begin
+      DumpNoPack(p, ACount);
+      exit;
+    end;
+    If (ACount < 3) or (ACount > maxDumpCount) then
+      raise exception.Create('Invalid count');
+
+    diffLast := p^ - lastPackedDumpValue;
+    if (diffLast < -7) or (diffLast > 7) then
+    begin
+      if ACount > 31 then
+      begin
+        DumpPacked(p, 31);
+        DumpPacked(p+31, ACount-31);
+        exit;
+      end;
+      WriteByte(ACount or packedDumpFlag);
+      lastPackedDumpValue:= p^;
+      WriteByte(lastPackedDumpValue);
+      dec(ACount);
+      inc(p);
+    end else
+    if ACount > 30 then
+    begin
+      while ACount > 30 do
+      begin
+        DumpPacked(p, 30);
+        inc(p,30);
+        dec(ACount,30);
+      end;
+      DumpPacked(p, ACount);
+      exit;
+    end else
+      WriteByte(ACount or packedDumpFromLastFlag);
+
+    nbPackedValues := 0;
+    while ACount >0 do
+    begin
+      packedValues[nbPackedValues] := (p^ - lastPackedDumpValue + 8) and 15;
+      inc(nbPackedValues);
+      lastPackedDumpValue := p^;
+      inc(p);
+      dec(ACount);
+    end;
+
+    idx := 0;
+    while idx < nbPackedValues do
+    begin
+      if idx+1 = nbPackedValues then
+      begin
+        WriteByte(packedValues[idx] shl 4);
+        break;
+      end;
+      WriteByte((packedValues[idx] shl 4) + packedValues[idx+1]);
+      inc(idx,2);
+    end;
+  end;
+
+  procedure Dump(p: PByte; ACount: Int32or64);
+  const smallestPackedDump = 5;
+        smallestPackedDumpTail = 3;
+  var
+    diffVal,i: Int32or64;
+    fitPackStart: Int32or64;
+    p2: PByte;
+  begin
+    if ACount >= smallestPackedDump then
+    begin
+      p2 := p+1;
+      fitPackStart := -1;
+      for i := 1 to ACount-1 do
+      begin
+        diffVal := p2^ - (p2-1)^;
+        if diffVal > 128 then dec(diffVal,256)
+        else if diffVal < -128 then inc(diffVal,256);
+        if (diffVal > 7) or (diffVal < -7) then
+        begin
+          if (fitPackStart <> -1) and
+               ((i-fitPackStart+1 >= smallestPackedDump) or
+                ((i-fitPackStart+1 >= smallestPackedDumpTail) and
+                 (fitPackStart = 1) )) then
+          begin
+            DumpNoPack(p, fitPackStart-1);
+            DumpPacked(p+(fitPackStart-1), i-fitPackStart+1);
+            Dump(p+i, ACount-i);
+            exit;
+          end;
+          fitPackStart := -1;
+        end else
+        if fitPackStart = -1 then fitPackStart := i;
+        inc(p2);
+      end;
+      if (fitPackStart <> -1) and (ACount-fitPackStart+1 >= smallestPackedDumpTail) then
+      begin
+        DumpNoPack(p,fitPackStart-1);
+        DumpPacked(p+(fitPackStart-1), ACount-fitPackStart+1);
+        exit;
+      end;
+      ACount := ACount;
+    end;
+    DumpNoPack(p, ACount);
+  end;
+
+var
+  psrc,psrcBefore: PByte;
+  curValue: Int32or64;
+  curCount: Int32or64;
+begin
+  if size = 0 then exit;
+  psrc := @sourceBuffer;
+  if psrc = nil then
+    raise exception.Create('Source buffer not provided');
+  bufferPos := 0;
+  curValue := psrc^;
+  curCount := 1;
+  inc(psrc);
+  dec(size);
+  smallRepetitionsCount := 0;
+  smallRepTotal := 0;
+  previousWordSizeRepetition := 0;
+  previousByteSizeRepetition := 0;
+  lastPackedDumpValue:= $80;
+  while size > 0 do
+  begin
+    if (psrc^ = curValue) and (curCount < maxRepetition) then
+    begin
+      inc(curCount);
+      dec(size);
+      inc(psrc);
+    end else
+    if (curCount > 1) or (((smallRepetitionsCount and 3) <> 0) and (smallRepTotal >= 5)) then
+    begin
+      outputRepetition(curValue,curCount);
+      curCount := 1;
+      curValue := psrc^;
+      dec(size);
+      inc(psrc);
+    end else //curCount = 1
+    begin
+      psrcBefore := psrc-1;
+      inc(psrc);
+      inc(curCount);
+      dec(size);
+      while (curCount < maxDumpCount) and (size>0) and
+            ( (psrc^ <> (psrc-1)^) or ((size>1) and ((psrc+1)^ <> (psrc-1)^)) ) do //eat doubles too
+      begin
+        inc(psrc);
+        inc(curCount);
+        dec(size);
+        if (curCount > 12) and ((psrc-1)^ = (psrc-2)^) and
+          ((psrc-3)^ = (psrc-4)^) and ((psrc-5)^ = (psrc-6)^) then //three doubles
+        begin
+          dec(psrc,6);
+          dec(curCount,6);
+          inc(size,6);
+          break;
+        end;
+      end;
+      if (size > 1) and (psrc^ = (psrc-1)^) and ((psrc+1)^ = psrc^) then //repetition coming
+      begin
+        dec(psrc);
+        dec(curCount);
+        inc(size);
+      end;
+      FlushSmallRepetitions;
+      if curCount = 1 then OutputRepetition(psrcBefore^,1) else
+      if curCount > 1 then Dump(psrcBefore, curCount);
+      if size > 0 then
+      begin
+        curValue := psrc^;
+        curCount := 1;
+        inc(psrc);
+        dec(size);
+      end else
+      begin
+        curCount := 0;
+        break;
+      end;
+    end;
+  end;
+  if curCount > 0 then OutputRepetition(curValue,curCount);
+  FlushSmallRepetitions;
+  WriteByte(endOfStreamOpCode);
+  FlushBuffer;
+end;
+
+function DecodeLazRLE(ASource: TStream; var destBuffer; availableOutputSize: PtrInt; availableInputSize: int64 = -1): PtrInt;
+const MaxBufferSize = 1024;
+var
+  opCode: Int32or64;
+  pdest: PByte;
+  lastRepeatWordSize, lastRepeatByteSize: Int32or64;
+  lastPackedDumpValue: Int32or64;
+
+  Buffer: packed array of byte;
+  BufferPos, BufferSize: Int32or64;
+  BufferStartLocation: Int64;
+
+  procedure OutputOverflow(AWanted: PtrInt; AFunctionName: string);
+  var position: int64;
+  begin
+    position := ASource.Position - BufferSize + BufferPos;
+    raise exception.Create('Output buffer overflow. Current position is ' + IntToStr(result)+' out of '+ IntToStr(availableOutputSize)+
+    ' and '+IntToStr(AWanted)+' is required by '+AFunctionName+'. ' +
+    'The absolute input position is '+IntToStr(position)+' which is ' + inttostr(position-BufferStartLocation) + ' from start.');
+  end;
+
+  function ReduceAvailableInputSize(AWanted: PtrInt): PtrInt;
+  begin
+    if availableInputSize <> -1 then
+    begin
+      if AWanted>availableInputSize then
+        result := availableInputSize
+      else
+        result := AWanted;
+      dec(availableInputSize, result);
+    end else
+      result := AWanted;
+  end;
+
+  function GetByteFromNextBuffer: byte;
+  begin
+    if BufferSize = 0 then
+      result := $e0
+    else
+    begin
+      BufferSize := ASource.Read(Buffer[0],ReduceAvailableInputSize(length(Buffer)));
+      BufferPos := 0;
+      if BufferPos < BufferSize then
+      begin
+        result := Buffer[BufferPos];
+        inc(BufferPos);
+      end else
+        result := $e0;
+    end;
+  end;
+
+  function GetNextBufferByte: byte; inline;
+  begin
+    if BufferPos < BufferSize then
+    begin
+      result := Buffer[BufferPos];
+      inc(BufferPos);
+    end else
+      result := GetByteFromNextBuffer;
+  end;
+
+  procedure RepeatValue(AValue: Int32or64; ACount: Int32or64);
+  begin
+    if result+ACount > availableOutputSize then OutputOverflow(ACount,'RepeatValue');
+    fillchar(pdest^, ACount, AValue);
+    inc(pdest, ACount);
+    inc(result, ACount);
+  end;
+
+  procedure PackedRepeatValues(ACount: Int32or64);
+  var packedCount: Int32or64;
+  begin
+    while ACount > 0 do
+    begin
+      packedCount := GetNextBufferByte;
+      RepeatValue(GetNextBufferByte, (packedCount and 3) + 1);
+      packedCount:= packedCount shr 2;
+      RepeatValue(GetNextBufferByte, (packedCount and 3) + 1);
+      packedCount:= packedCount shr 2;
+      RepeatValue(GetNextBufferByte, (packedCount and 3) + 1);
+      packedCount:= packedCount shr 2;
+      RepeatValue(GetNextBufferByte, (packedCount and 3) + 1);
+      dec(ACount);
+    end;
+  end;
+
+  procedure DumpValues(ACount: Int32or64);
+  begin
+    if result+ACount > availableOutputSize then OutputOverflow(ACount, 'DumpValues');
+    inc(result, ACount);
+    while ACount > 0 do
+    begin
+      pdest^ := GetNextBufferByte;
+      inc(pdest);
+      dec(ACount);
+    end;
+  end;
+
+  procedure PackedDumpValues(ACount: Int32or64);
+  var packedData: Int32or64;
+  begin
+    if result+ACount > availableOutputSize then OutputOverflow(ACount, 'PackedDumpValues');
+    inc(result, ACount);
+    while ACount > 0 do
+    begin
+      packedData := GetNextBufferByte;
+      lastPackedDumpValue := (lastPackedDumpValue + (packedData shr 4) - 8) and 255;
+      pdest^ := lastPackedDumpValue;
+      if ACount >= 2 then
+      begin
+        lastPackedDumpValue := (lastPackedDumpValue + (packedData and 15) - 8) and 255;
+        (pdest+1)^ := lastPackedDumpValue;
+        inc(pdest,2);
+        dec(ACount,2);
+      end else
+      begin
+        inc(pdest);
+        dec(ACount);
+      end;
+      lastPackedDumpValue:= (pdest-1)^;
+    end;
+  end;
+begin
+  BufferStartLocation:= ASource.Position;
+  setLength(Buffer,MaxBufferSize);
+  BufferSize := ASource.Read(Buffer[0],ReduceAvailableInputSize(length(Buffer)));
+  BufferPos := 0;
+
+  pdest := @destBuffer;
+  result := 0;
+  lastPackedDumpValue:= $80;
+  try
+    repeat
+      opCode := GetNextBufferByte;
+      case opCode of
+      wordRepetitionOpCode: begin
+          lastRepeatWordSize:= GetNextBufferByte shl 8;
+          inc(lastRepeatWordSize, GetNextBufferByte);
+          RepeatValue(GetNextBufferByte, lastRepeatWordSize);
+        end;
+      previousWordSizeRepetitionOpCode: RepeatValue(GetNextBufferByte, lastRepeatWordSize);
+      byteRepetitionOpCode: begin
+          lastRepeatByteSize:= GetNextBufferByte + 64;
+          RepeatValue(GetNextBufferByte, lastRepeatByteSize);
+        end;
+      previousByteSizeRepetitionOpCode: RepeatValue(GetNextBufferByte, lastRepeatByteSize);
+
+      $01..$3f: RepeatValue(GetNextBufferByte, opCode);
+      $41..$5f: PackedRepeatValues(opCode - $40);
+      $60..$6f: RepeatValue($00, opCode - $60 + 1);
+      $70..$7f: RepeatValue($FF, opCode - $70 + 1);
+      $81:      DumpValues(GetNextBufferByte+64);
+      $82..$bf: DumpValues(opCode - $80);
+      $c3..$df: begin
+          lastPackedDumpValue := GetNextBufferByte;
+          RepeatValue(lastPackedDumpValue, 1);
+          PackedDumpValues(opCode - $c0 - 1);
+        end;
+      $e2..$fe: PackedDumpValues(opCode - $e0);
+
+      reservedOpCode1, reservedOpCode2, reservedOpCode3: raise exception.Create('Unexpected opcode');
+      endOfStreamOpCode, optionalOpCode: ;
+      end;
+    until opCode = endOfStreamOpCode;
+  finally
+    ASource.Position:= ASource.Position-BufferSize+BufferPos;
+  end;
+end;
+
+{ TLazPaintImageHeader }
+
+procedure LazPaintImageHeader_SwapEndianIfNeeded(AHeader: TLazPaintImageHeader);
+begin
+  with AHeader do
+  begin
+    headerSize := LEtoN(headerSize);
+    width := LEtoN(width);
+    height := LEtoN(height);
+    nbLayers := LEtoN(nbLayers);
+    height := LEtoN(height);
+    previewOffset := LEtoN(previewOffset);
+    compressionMode := LEtoN(compressionMode);
+    layersOffset := LEtoN(layersOffset);
+  end;
+end;
+
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgramacbitmap.pas

@@ -0,0 +1,84 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAMacBitmap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRALCLBitmap, BGRAGraphics, BGRABitmapTypes;
+
+type
+
+  { TBGRAMacBitmap }
+
+  TBGRAMacBitmap = class(TBGRALCLBitmap)
+     procedure DataDrawOpaque(ACanvas: TCanvas; Rect: TRect; AData: Pointer;
+       ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
+  end;
+
+implementation
+
+uses LCLType, GraphType, LCLIntf, FPimage;
+
+procedure DataDrawOpaqueImplementation(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+type
+  PARGB = ^TARGB;
+  TARGB = packed record
+    alpha,red,green,blue: byte;
+  end;
+
+var
+  Temp:      TBitmap;
+  RawImage:  TRawImage;
+  BitmapHandle, MaskHandle: HBitmap;
+  CreateResult: boolean;
+  psrc: PBGRAPixel;
+  pdest: PARGB;
+  n: Integer;
+begin
+  if (AHeight = 0) or (AWidth = 0) then
+    exit;
+
+  RawImage.Init;
+  RawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(AWidth,AHeight);
+  RawImage.Description.Depth := 24;
+  RawImage.Description.AlphaPrec := 0;
+  RawImage.Description.LineOrder := ALineOrder;
+  RawImage.Description.LineEnd := rileDWordBoundary;
+  RawImage.CreateData(False);
+  psrc := PBGRAPixel(AData);
+  pdest := PARGB(RawImage.Data);
+  for n := AWidth*AHeight-1 downto 0 do
+  begin
+    pdest^.alpha := 255;
+    pdest^.red := psrc^.red;
+    pdest^.green := psrc^.green;
+    pdest^.blue := psrc^.blue;
+    inc(pdest);
+    inc(psrc);
+  end;
+  CreateResult := RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False);
+  RawImage.FreeData;
+
+  if not CreateResult then
+    raise FPImageException.Create('Failed to create bitmap handle');
+
+  Temp := TBitmap.Create;
+  Temp.Handle := BitmapHandle;
+  Temp.MaskHandle := MaskHandle;
+  ACanvas.StretchDraw(Rect, Temp);
+  Temp.Free;
+end;
+
+{ TBGRAMacBitmap }
+
+procedure TBGRAMacBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+begin
+  DataDrawOpaqueImplementation(ACanvas, Rect, AData, ALineOrder, AWidth, AHeight);
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgramatrix3d.pas

@@ -0,0 +1,900 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAMatrix3D;
+
+{$mode objfpc}{$H+}
+
+{$i bgrasse.inc}
+
+{$ifdef CPUI386}
+  {$asmmode intel}
+{$ENDIF}
+{$ifdef cpux86_64}
+  {$asmmode intel}
+{$ENDIF}
+
+interface
+
+uses
+  BGRABitmapTypes, BGRASSE,
+  BGRATransform;
+
+type
+  TMatrix3D = packed array[1..3,1..4] of single;
+  TMatrix4D = packed array[1..4,1..4] of single;
+  TProjection3D = packed record
+    Zoom, Center: TPointF;
+  end;
+  TComputeProjectionFunc = function(AViewCoord: TPoint3D_128): TPointF of object;
+
+operator*(const A: TMatrix3D; const M: TPoint3D): TPoint3D;
+operator*(constref A: TMatrix3D; var M: TPoint3D_128): TPoint3D_128;
+function MultiplyVect3DWithoutTranslation(constref A: TMatrix3D; constref M: TPoint3D_128): TPoint3D_128;
+operator*(A,B: TMatrix3D): TMatrix3D;
+
+function Matrix3D(m11,m12,m13,m14, m21,m22,m23,m24, m31,m32,m33,m34: single): TMatrix3D; overload;
+function Matrix3D(vx,vy,vz,ofs: TPoint3D): TMatrix3D; overload;
+function Matrix3D(vx,vy,vz,ofs: TPoint3D_128): TMatrix3D; overload;
+function MatrixIdentity3D: TMatrix3D;
+function MatrixInverse3D(A: TMatrix3D): TMatrix3D;
+function MatrixTranslation3D(ofs: TPoint3D): TMatrix3D;
+function MatrixScale3D(size: TPoint3D): TMatrix3D;
+function MatrixRotateX(angle: single): TMatrix3D;
+function MatrixRotateY(angle: single): TMatrix3D;
+function MatrixRotateZ(angle: single): TMatrix3D;
+
+operator *(const A, B: TMatrix4D): TMatrix4D;
+function MatrixIdentity4D: TMatrix4D;
+function AffineMatrixToMatrix4D(AValue: TAffineMatrix): TMatrix4D;
+
+{$IFDEF BGRASSE_AVAILABLE}
+procedure Matrix3D_SSE_Load(const A: TMatrix3D);
+procedure MatrixMultiplyVect3D_SSE_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
+procedure MatrixMultiplyVect3D_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
+procedure MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
+procedure MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
+{$ENDIF}
+
+implementation
+
+procedure multiplyVect3(const A : TMatrix3D; const vx,vy,vz,vt: single; out outx,outy,outz: single);
+begin
+  outx := vx * A[1,1] + vy * A[1,2] + vz * A[1,3] + vt * A[1,4];
+  outy := vx * A[2,1] + vy * A[2,2] + vz * A[2,3] + vt * A[2,4];
+  outz := vx * A[3,1] + vy * A[3,2] + vz * A[3,3] + vt * A[3,4];
+end;
+
+procedure multiplyVect4(const A : TMatrix4D; const vx,vy,vz,vt: single; out outx,outy,outz,outt: single);
+begin
+  outx := vx * A[1,1] + vy * A[1,2] + vz * A[1,3] + vt * A[1,4];
+  outy := vx * A[2,1] + vy * A[2,2] + vz * A[2,3] + vt * A[2,4];
+  outz := vx * A[3,1] + vy * A[3,2] + vz * A[3,3] + vt * A[3,4];
+  outt := vx * A[4,1] + vy * A[4,2] + vz * A[4,3] + vt * A[4,4];
+end;
+
+operator*(const A: TMatrix3D; const M: TPoint3D): TPoint3D;
+begin
+  result.x := M.x * A[1,1] + M.y * A[1,2] + M.z * A[1,3] + A[1,4];
+  result.y := M.x * A[2,1] + M.y * A[2,2] + M.z * A[2,3] + A[2,4];
+  result.z := M.x * A[3,1] + M.y * A[3,2] + M.z * A[3,3] + A[3,4];
+end;
+
+operator*(const A, B: TMatrix4D): TMatrix4D;
+begin
+  multiplyVect4(A, B[1,1],B[2,1],B[3,1],B[4,1], result[1,1],result[2,1],result[3,1],result[4,1]);
+  multiplyVect4(A, B[1,2],B[2,2],B[3,2],B[4,2], result[1,2],result[2,2],result[3,2],result[4,2]);
+  multiplyVect4(A, B[1,3],B[2,3],B[3,3],B[4,3], result[1,3],result[2,3],result[3,3],result[4,3]);
+  multiplyVect4(A, B[1,4],B[2,4],B[3,4],B[4,4], result[1,4],result[2,4],result[3,4],result[4,4]);
+end;
+
+function MatrixIdentity4D: TMatrix4D;
+begin
+  result[1,1] := 1;  result[2,1] := 0;  result[3,1] := 0; result[4,1] := 0;
+  result[1,2] := 0;  result[2,2] := 1;  result[3,2] := 0; result[4,2] := 0;
+  result[1,3] := 0;  result[2,3] := 0;  result[3,3] := 1; result[4,3] := 0;
+  result[1,4] := 0;  result[2,4] := 0;  result[3,4] := 0; result[4,4] := 1;
+end;
+
+function AffineMatrixToMatrix4D(AValue: TAffineMatrix): TMatrix4D;
+begin
+  result[1,1] := AValue[1,1];  result[2,1] := AValue[1,2];  result[3,1] := 0; result[4,1] := AValue[1,3];
+  result[1,2] := AValue[2,1];  result[2,2] := AValue[2,2];  result[3,2] := 0; result[4,2] := AValue[2,3];
+  result[1,3] := 0;            result[2,3] := 0;            result[3,3] := 1; result[4,3] := 0;
+  result[1,4] := 0;            result[2,4] := 0;            result[3,4] := 0; result[4,4] := 1;
+end;
+
+{$IFDEF BGRASSE_AVAILABLE}
+var SingleConst1 : single = 1;
+
+  procedure Matrix3D_SSE_Load(const A: TMatrix3D);
+  begin
+    {$IFDEF cpux86_64}
+    asm
+      mov rax, A
+      movups xmm5, [rax]
+      movups xmm6, [rax+16]
+      movups xmm7, [rax+32]
+    end;
+    {$ELSE}
+    asm
+      mov eax, A
+      movups xmm5, [eax]
+      movups xmm6, [eax+16]
+      movups xmm7, [eax+32]
+    end;
+   {$ENDIF}
+  end;
+
+procedure MatrixMultiplyVect3D_SSE_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
+var oldMt: single;
+begin
+  oldMt := M.t;
+  M.t := SingleConst1;
+  {$IFDEF cpux86_64}
+  asm
+    mov rax, M
+    movaps xmm0, [rax]
+
+    mov rax, N
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+
+    movss [rax], xmm2
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+
+    movss [rax+4], xmm2
+
+    mulps xmm0,xmm7
+    //mix1
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $4e
+    addps xmm0, xmm3
+    //mix2
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $11
+    addps xmm0, xmm3
+
+    movss [rax+8], xmm0
+  end;
+  {$ELSE}
+    asm
+    mov eax, M
+    movaps xmm0, [eax]
+
+    mov eax, N
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+
+    movss [eax], xmm2
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+
+    movss [eax+4], xmm2
+
+    mulps xmm0,xmm7
+    //mix1
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $4e
+    addps xmm0, xmm3
+    //mix2
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $11
+    addps xmm0, xmm3
+
+    movss [eax+8], xmm0
+  end;
+  {$ENDIF}
+  M.t := oldMt;
+  N.t := 0;
+end;
+
+procedure MatrixMultiplyVect3D_SSE3_Aligned(var M: TPoint3D_128; out N: TPoint3D_128);
+var oldMt: single;
+begin
+  oldMt := M.t;
+  M.t := SingleConst1;
+  {$IFDEF cpux86_64}
+  asm
+    mov rax, M
+    movaps xmm0, [rax]
+
+    mov rax, N
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss [rax], xmm2
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss [rax+4], xmm2
+
+    mulps xmm0,xmm7
+    haddps xmm0,xmm0
+    haddps xmm0,xmm0
+    movss [rax+8], xmm0
+  end;
+  {$ELSE}
+  asm
+    mov eax, M
+    movaps xmm0, [eax]
+
+    mov eax, N
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss [eax], xmm2
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss [eax+4], xmm2
+
+    mulps xmm0,xmm7
+    haddps xmm0,xmm0
+    haddps xmm0,xmm0
+    movss [eax+8], xmm0
+  end;
+  {$ENDIF}
+  M.t := oldMt;
+end;
+
+procedure MatrixMultiplyVect3DWithoutTranslation_SSE_Aligned(
+  var M: TPoint3D_128; out N: TPoint3D_128);
+begin
+  {$IFDEF cpux86_64}
+  asm
+    mov rax, M
+    movaps xmm0, [rax]
+
+    mov rax, N
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+
+    movss [rax], xmm2
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+
+    movss [rax+4], xmm2
+
+    mulps xmm0,xmm7
+    //mix1
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $4e
+    addps xmm0, xmm3
+    //mix2
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $11
+    addps xmm0, xmm3
+
+    movss [rax+8], xmm0
+  end;
+  {$ELSE}
+    asm
+    mov eax, M
+    movaps xmm0, [eax]
+
+    mov eax, N
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+
+    movss [eax], xmm2
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    //mix1
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $4e
+    addps xmm2, xmm3
+    //mix2
+    movaps xmm3, xmm2
+    shufps xmm3, xmm3, $11
+    addps xmm2, xmm3
+
+    movss [eax+4], xmm2
+
+    mulps xmm0,xmm7
+    //mix1
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $4e
+    addps xmm0, xmm3
+    //mix2
+    movaps xmm3, xmm0
+    shufps xmm3, xmm3, $11
+    addps xmm0, xmm3
+
+    movss [eax+8], xmm0
+  end;
+  {$ENDIF}
+end;
+
+procedure MatrixMultiplyVect3DWithoutTranslation_SSE3_Aligned(
+  var M: TPoint3D_128; out N: TPoint3D_128);
+begin
+  {$IFDEF cpux86_64}
+  asm
+    mov rax, M
+    movaps xmm0, [rax]
+
+    mov rax, N
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss [rax], xmm2
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss [rax+4], xmm2
+
+    mulps xmm0,xmm7
+    haddps xmm0,xmm0
+    haddps xmm0,xmm0
+    movss [rax+8], xmm0
+  end;
+  {$ELSE}
+  asm
+    mov eax, M
+    movaps xmm0, [eax]
+
+    mov eax, N
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm5
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss [eax], xmm2
+
+    movaps xmm2,xmm0
+    mulps xmm2,xmm6
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+    movss [eax+4], xmm2
+
+    mulps xmm0,xmm7
+    haddps xmm0,xmm0
+    haddps xmm0,xmm0
+    movss [eax+8], xmm0
+  end;
+  {$ENDIF}
+end;
+
+{$ENDIF}
+
+operator*(constref A: TMatrix3D; var M: TPoint3D_128): TPoint3D_128;
+{$IFDEF BGRASSE_AVAILABLE}var oldMt: single;
+  resultAddr: pointer;{$ENDIF}
+begin
+  {$IFDEF BGRASSE_AVAILABLE}
+  if UseSSE then
+  begin
+    oldMt := M.t;
+    M.t := SingleConst1;
+    resultAddr := @result;
+    {$IFDEF cpux86_64}
+    if UseSSE3 then
+    asm
+      mov rax, A
+      movups xmm5, [rax]
+      movups xmm6, [rax+16]
+      movups xmm7, [rax+32]
+
+      mov rax, M
+      movups xmm0, [rax]
+
+      mov rax, resultAddr
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm5
+      haddps xmm4,xmm4
+      haddps xmm4,xmm4
+      movss [rax], xmm4
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm6
+      haddps xmm4,xmm4
+      haddps xmm4,xmm4
+      movss [rax+4], xmm4
+
+      mulps xmm0,xmm7
+      haddps xmm0,xmm0
+      haddps xmm0,xmm0
+      movss [rax+8], xmm0
+    end else
+    asm
+      mov rax, A
+      movups xmm5, [rax]
+      movups xmm6, [rax+16]
+      movups xmm7, [rax+32]
+
+      mov rax, M
+      movups xmm0, [rax]
+
+      mov rax, resultAddr
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm5
+      //mix1
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $4e
+      addps xmm4, xmm3
+      //mix2
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $11
+      addps xmm4, xmm3
+
+      movss [rax], xmm4
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm6
+      //mix1
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $4e
+      addps xmm4, xmm3
+      //mix2
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $11
+      addps xmm4, xmm3
+
+      movss [rax+4], xmm4
+
+      mulps xmm0,xmm7
+      //mix1
+      movaps xmm3, xmm0
+      shufps xmm3, xmm3, $4e
+      addps xmm0, xmm3
+      //mix2
+      movaps xmm3, xmm0
+      shufps xmm3, xmm3, $11
+      addps xmm0, xmm3
+
+      movss [rax+8], xmm0
+    end;
+    {$ELSE}
+    if UseSSE3 then
+    asm
+      mov eax, A
+      movups xmm5, [eax]
+      movups xmm6, [eax+16]
+      movups xmm7, [eax+32]
+
+      mov eax, M
+      movups xmm0, [eax]
+
+      mov eax, resultAddr
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm5
+      haddps xmm4,xmm4
+      haddps xmm4,xmm4
+      movss [eax], xmm4
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm6
+      haddps xmm4,xmm4
+      haddps xmm4,xmm4
+      movss [eax+4], xmm4
+
+      mulps xmm0,xmm7
+      haddps xmm0,xmm0
+      haddps xmm0,xmm0
+      movss [eax+8], xmm0
+    end else
+    asm
+      mov eax, A
+      movups xmm5, [eax]
+      movups xmm6, [eax+16]
+      movups xmm7, [eax+32]
+
+      mov eax, M
+      movups xmm0, [eax]
+
+      mov eax, resultAddr
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm5
+      //mix1
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $4e
+      addps xmm4, xmm3
+      //mix2
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $11
+      addps xmm4, xmm3
+
+      movss [eax], xmm4
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm6
+      //mix1
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $4e
+      addps xmm4, xmm3
+      //mix2
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $11
+      addps xmm4, xmm3
+
+      movss [eax+4], xmm4
+
+      mulps xmm0,xmm7
+      //mix1
+      movaps xmm3, xmm0
+      shufps xmm3, xmm3, $4e
+      addps xmm0, xmm3
+      //mix2
+      movaps xmm3, xmm0
+      shufps xmm3, xmm3, $11
+      addps xmm0, xmm3
+
+      movss [eax+8], xmm0
+    end;
+    {$ENDIF}
+    M.t := oldMt;
+    result.t := 0;
+  end else
+  {$ENDIF}
+  begin
+    result.x := M.x * A[1,1] + M.y * A[1,2] + M.z * A[1,3] + A[1,4];
+    result.y := M.x * A[2,1] + M.y * A[2,2] + M.z * A[2,3] + A[2,4];
+    result.z := M.x * A[3,1] + M.y * A[3,2] + M.z * A[3,3] + A[3,4];
+    result.t := 0;
+  end;
+end;
+
+function MultiplyVect3DWithoutTranslation(constref A: TMatrix3D; constref M: TPoint3D_128): TPoint3D_128;
+{$IFDEF BGRASSE_AVAILABLE}var resultAddr: pointer;{$ENDIF}
+begin
+  {$IFDEF BGRASSE_AVAILABLE}
+  if UseSSE then
+  begin
+    resultAddr := @result;
+    {$IFDEF cpux86_64}
+    if UseSSE3 then
+    asm
+      mov rax, A
+      movups xmm5, [rax]
+      movups xmm6, [rax+16]
+      movups xmm7, [rax+32]
+
+      mov rax, M
+      movups xmm0, [rax]
+
+      mov rax, resultAddr
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm5
+      haddps xmm4,xmm4
+      haddps xmm4,xmm4
+      movss [rax], xmm4
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm6
+      haddps xmm4,xmm4
+      haddps xmm4,xmm4
+      movss [rax+4], xmm4
+
+      mulps xmm0,xmm7
+      haddps xmm0,xmm0
+      haddps xmm0,xmm0
+      movss [rax+8], xmm0
+    end else
+    asm
+      mov rax, A
+      movups xmm5, [rax]
+      movups xmm6, [rax+16]
+      movups xmm7, [rax+32]
+
+      mov rax, M
+      movups xmm0, [rax]
+
+      mov rax, resultAddr
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm5
+      //mix1
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $4e
+      addps xmm4, xmm3
+      //mix2
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $11
+      addps xmm4, xmm3
+
+      movss [rax], xmm4
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm6
+      //mix1
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $4e
+      addps xmm4, xmm3
+      //mix2
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $11
+      addps xmm4, xmm3
+
+      movss [rax+4], xmm4
+
+      mulps xmm0,xmm7
+      //mix1
+      movaps xmm3, xmm0
+      shufps xmm3, xmm3, $4e
+      addps xmm0, xmm3
+      //mix2
+      movaps xmm3, xmm0
+      shufps xmm3, xmm3, $11
+      addps xmm0, xmm3
+
+      movss [rax+8], xmm0
+    end;
+    {$ELSE}
+    if UseSSE3 then
+    asm
+      mov eax, A
+      movups xmm5, [eax]
+      movups xmm6, [eax+16]
+      movups xmm7, [eax+32]
+
+      mov eax, M
+      movups xmm0, [eax]
+
+      mov eax, resultAddr
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm5
+      haddps xmm4,xmm4
+      haddps xmm4,xmm4
+      movss [eax], xmm4
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm6
+      haddps xmm4,xmm4
+      haddps xmm4,xmm4
+      movss [eax+4], xmm4
+
+      mulps xmm0,xmm7
+      haddps xmm0,xmm0
+      haddps xmm0,xmm0
+      movss [eax+8], xmm0
+    end else
+    asm
+      mov eax, A
+      movups xmm5, [eax]
+      movups xmm6, [eax+16]
+      movups xmm7, [eax+32]
+
+      mov eax, M
+      movups xmm0, [eax]
+
+      mov eax, resultAddr
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm5
+      //mix1
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $4e
+      addps xmm4, xmm3
+      //mix2
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $11
+      addps xmm4, xmm3
+
+      movss [eax], xmm4
+
+      movaps xmm4,xmm0
+      mulps xmm4,xmm6
+      //mix1
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $4e
+      addps xmm4, xmm3
+      //mix2
+      movaps xmm3, xmm4
+      shufps xmm3, xmm3, $11
+      addps xmm4, xmm3
+
+      movss [eax+4], xmm4
+
+      mulps xmm0,xmm7
+      //mix1
+      movaps xmm3, xmm0
+      shufps xmm3, xmm3, $4e
+      addps xmm0, xmm3
+      //mix2
+      movaps xmm3, xmm0
+      shufps xmm3, xmm3, $11
+      addps xmm0, xmm3
+
+      movss [eax+8], xmm0
+    end;
+    {$ENDIF}
+  end else
+  {$ENDIF}
+  begin
+    result.x := M.x * A[1,1] + M.y * A[1,2] + M.z * A[1,3];
+    result.y := M.x * A[2,1] + M.y * A[2,2] + M.z * A[2,3];
+    result.z := M.x * A[3,1] + M.y * A[3,2] + M.z * A[3,3];
+    result.t := 0;
+  end;
+end;
+
+operator*(A,B: TMatrix3D): TMatrix3D;
+begin
+  multiplyVect3(A, B[1,1],B[2,1],B[3,1],0, result[1,1],result[2,1],result[3,1]);
+  multiplyVect3(A, B[1,2],B[2,2],B[3,2],0, result[1,2],result[2,2],result[3,2]);
+  multiplyVect3(A, B[1,3],B[2,3],B[3,3],0, result[1,3],result[2,3],result[3,3]);
+  multiplyVect3(A, B[1,4],B[2,4],B[3,4],1, result[1,4],result[2,4],result[3,4]);
+end;
+
+function MatrixIdentity3D: TMatrix3D;
+begin
+  result := Matrix3D( 1,0,0,0,
+                      0,1,0,0,
+                      0,0,1,0);
+end;
+
+function Matrix3D(m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33,
+  m34: single): TMatrix3D;
+begin
+  result[1,1] := m11;
+  result[1,2] := m12;
+  result[1,3] := m13;
+  result[1,4] := m14;
+
+  result[2,1] := m21;
+  result[2,2] := m22;
+  result[2,3] := m23;
+  result[2,4] := m24;
+
+  result[3,1] := m31;
+  result[3,2] := m32;
+  result[3,3] := m33;
+  result[3,4] := m34;
+end;
+
+function MatrixInverse3D(A: TMatrix3D): TMatrix3D;
+var ofs: TPoint3D;
+begin
+  ofs := Point3D(A[1,4],A[2,4],A[3,4]);
+
+  result[1,1] := A[1,1];
+  result[1,2] := A[2,1];
+  result[1,3] := A[3,1];
+  result[1,4] := 0;
+
+  result[2,1] := A[1,2];
+  result[2,2] := A[2,2];
+  result[2,3] := A[3,2];
+  result[2,4] := 0;
+
+  result[3,1] := A[1,3];
+  result[3,2] := A[2,3];
+  result[3,3] := A[3,3];
+  result[3,4] := 0;
+
+  result := result*MatrixTranslation3D(-ofs);
+end;
+
+function Matrix3D(vx, vy, vz, ofs: TPoint3D): TMatrix3D;
+begin
+  result := Matrix3D(vx.x, vy.x, vz.x, ofs.x,
+                     vx.y, vy.y, vz.y, ofs.y,
+                     vx.z, vy.z, vz.z, ofs.z);
+end;
+
+function Matrix3D(vx, vy, vz, ofs: TPoint3D_128): TMatrix3D;
+begin
+  result := Matrix3D(vx.x, vy.x, vz.x, ofs.x,
+                     vx.y, vy.y, vz.y, ofs.y,
+                     vx.z, vy.z, vz.z, ofs.z);
+end;
+
+function MatrixTranslation3D(ofs: TPoint3D): TMatrix3D;
+begin
+  result := Matrix3D(1,0,0,ofs.x,
+                     0,1,0,ofs.Y,
+                     0,0,1,ofs.z);
+end;
+
+function MatrixScale3D(size: TPoint3D): TMatrix3D;
+begin
+  result := Matrix3D(size.x,0,0,0,
+                     0,size.y,0,0,
+                     0,0,size.z,0);
+end;
+
+function MatrixRotateX(angle: single): TMatrix3D;
+begin
+  result := Matrix3D( 1,       0,           0,       0,
+                      0,   cos(angle), sin(angle),   0,
+                      0,  -sin(angle), cos(angle),   0);
+end;
+
+function MatrixRotateY(angle: single): TMatrix3D;
+begin
+  result := Matrix3D(  cos(angle), 0, -sin(angle),  0,
+                           0,      1,      0,       0,
+                       sin(angle), 0,  cos(angle),  0);
+end;
+
+function MatrixRotateZ(angle: single): TMatrix3D;
+begin
+  result := Matrix3D(  cos(angle), sin(angle),   0,    0,
+                      -sin(angle), cos(angle),   0,    0,
+                          0,            0,       1,    0);
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgramemdirectory.pas

@@ -0,0 +1,697 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAMemDirectory;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRAMultiFileType, fgl;
+
+const
+  MemDirectoryFileHeader = 'TMemDirectory'#26#0#0;
+  MemDirectoryEntry_FlagDirectory = 1;   //entry is a directory
+  MemDirectoryEntry_FlagCompressed = 2;  //the stream is compressed
+  MemDirectoryEntry_FlagSmallEntryPacked = $8000; //name and size <= 255
+
+type
+  TMemDirectory = class;
+  TEntryFilename = BGRAMultiFileType.TEntryFilename;
+
+type
+  TMemDirectoryPath = specialize TFPGList<TEntryFilename>;
+
+  { TMemDirectoryEntry }
+
+  TMemDirectoryEntry = class(TMultiFileEntry)
+  private
+    FStream: TStream;
+    function GetIsCompressed: boolean;
+    function GetCompressedSize: int64;
+    function GetIsDirectory: boolean;
+    procedure SetIsCompressed(AValue: boolean);
+    procedure LoadExtraFromEmbeddedStream(ADataStream: TStream; AStartPos: int64);
+    procedure SaveToEmbeddedStream(AEntryStream, ADataStream: TStream; AStartPos: int64; out uncompressedSize: int64);
+  protected
+    FFlags: Word;
+    FName,FExtension: utf8String;
+    FUncompressedSize: int64;
+    FEmbeddedStreamPos: int64;
+    FMemDirectory: TMemDirectory;
+    function GetName: utf8string; override;
+    procedure SetName(AValue: utf8string); override;
+    function GetFileSize: int64; override;
+    function GetExtension: utf8string; override;
+    function InternalCopyTo({%H-}ADestination: TStream): int64;
+  public
+    function CopyTo({%H-}ADestination: TStream): int64; override;
+    function GetStream: TStream; override;
+    constructor Create(AContainer: TMultiFileContainer; AFilename: TEntryFilename; AUncompressedStream: TStream; AOwnStream: boolean); overload;
+    constructor CreateDirectory(AContainer: TMultiFileContainer; AFilename: TEntryFilename);
+    constructor CreateFromData(AContainer: TMultiFileContainer; AFilename: TEntryFilename; AStream: TStream; AOwnStream: boolean; AUncompressedSize: int64; AFlags: Word);
+    destructor Destroy; override;
+    property EmbeddedStreamPos: int64 read FEmbeddedStreamPos write FEmbeddedStreamPos;
+    property IsCompressed: boolean read GetIsCompressed write SetIsCompressed;
+    property IsDirectory: boolean read GetIsDirectory;
+    property CompressedSize: int64 read GetCompressedSize;
+    property Flags: Word read FFlags;
+    property MemDirectory: TMemDirectory read FMemDirectory;
+  end;
+
+  TMemDirectory = class(TMultiFileContainer)
+  private
+    FParentDirectory: TMemDirectory;
+    function GetEntryCompressed(AIndex: integer): boolean;
+    function GetIsDirectory(AIndex: integer): boolean;
+    function GetDirectory(AIndex: integer): TMemDirectory;
+    procedure SetEntryCompressed(AIndex: integer; AValue: boolean);
+  protected
+    function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; override;
+    function SplitPath(APath: utf8string): TMemDirectoryPath;
+  public
+    constructor Create(AParentDirectory: TMemDirectory = nil);
+    function Equals(Obj: TObject): boolean; override;
+    procedure LoadFromStream(AStream: TStream); override;
+    class function CheckHeader(AStream: TStream): boolean; static;
+    procedure LoadFromEmbeddedStream(ARootStream, ADataStream: TStream; AStartPos: int64);
+    procedure SaveToStream(ADestination: TStream); override;
+    procedure SaveToEmbeddedStream(ARootDest, ADataDest: TStream; AStartPos: int64);
+    function AddDirectory(AName: utf8string; AExtension: utf8string= ''; ACaseSensitive: boolean= true): integer;
+    function Rename(AName: utf8string; AExtension: utf8string; ANewName: utf8string; ACaseSensitive: boolean= true): boolean;
+    function FindPath(APath: utf8String; ACaseSensitive: boolean = true): TMemDirectory;
+    function FindEntry(APath: utf8String; ACaseSensitive: boolean = true): TMemDirectoryEntry;
+    procedure CopyTo(ADest: TMemDirectory; ARecursive: boolean);
+    property IsEntryCompressed[AIndex: integer]: boolean read GetEntryCompressed write SetEntryCompressed;
+    property Directory[AIndex: integer]: TMemDirectory read GetDirectory;
+    property IsDirectory[AIndex: integer]: boolean read GetIsDirectory;
+    property ParentDirectory: TMemDirectory read FParentDirectory;
+  end;
+
+implementation
+
+uses zstream, BGRAUTF8, strutils;
+
+type
+  TDirEntryRecord = packed record
+    Flags: Word;
+    FilenameSize: Word;
+    Offset: int64;
+  end;
+
+{ TMemDirectory }
+
+function TMemDirectory.GetEntryCompressed(AIndex: integer): boolean;
+begin
+  result := (Entry[AIndex] as TMemDirectoryEntry).IsCompressed;
+end;
+
+function TMemDirectory.GetIsDirectory(AIndex: integer): boolean;
+begin
+  result := (Entry[AIndex] as TMemDirectoryEntry).IsDirectory;
+end;
+
+function TMemDirectory.GetDirectory(AIndex: integer): TMemDirectory;
+begin
+  result := (Entry[AIndex] as TMemDirectoryEntry).MemDirectory;
+end;
+
+procedure TMemDirectory.SetEntryCompressed(AIndex: integer; AValue: boolean);
+begin
+  (Entry[AIndex] as TMemDirectoryEntry).IsCompressed := AValue;
+end;
+
+function TMemDirectory.CreateEntry(AName: utf8string; AExtension: utf8string;
+  AContent: TStream): TMultiFileEntry;
+begin
+  result := TMemDirectoryEntry.Create(self, EntryFilename(AName, AExtension), AContent, true);
+end;
+
+procedure TMemDirectory.LoadFromStream(AStream: TStream);
+var rootPos, rootSize: integer;
+  header: string;
+  rootStream: TStream;
+  startPos: Int64;
+begin
+  startPos := AStream.Position;
+  setlength(header, length(MemDirectoryFileHeader));
+  AStream.ReadBuffer(header[1], length(header));
+  if header<>MemDirectoryFileHeader then
+    raise exception.Create('Invalid header');
+  rootPos := LEReadInt64(AStream);
+  if rootPos = 0 then
+    raise exception.Create('Invalid root offset');
+  rootSize := LEReadInt64(AStream);
+  if rootSize < 4 then
+    raise exception.Create('Invalid root size');
+  AStream.Position:= rootPos + startPos;
+  rootStream:= TMemoryStream.Create;
+  try
+    rootStream.CopyFrom(AStream, rootSize);
+    LoadFromEmbeddedStream(rootStream, AStream, startPos);
+  finally
+    rootStream.Free;
+  end;
+end;
+
+class function TMemDirectory.CheckHeader(AStream: TStream): boolean;
+var
+  startPos: Int64;
+  header: string;
+begin
+  startPos := AStream.Position;
+  setlength(header, length(MemDirectoryFileHeader));
+  AStream.Read(header[1], length(header));
+  result := (header=MemDirectoryFileHeader);
+  AStream.Position:= startPos;
+end;
+
+procedure TMemDirectory.LoadFromEmbeddedStream(ARootStream, ADataStream: TStream;
+  AStartPos: int64);
+var
+  nbEntries,i: LongInt;
+  entryRec: TDirEntryRecord;
+  filename: string;
+  entryData: TStream;
+  newEntry: TMemDirectoryEntry;
+  compressedSize, uncompressedSize: Int64;
+
+begin
+  Clear;
+  ARootStream.Position := 0;
+  nbEntries := LEReadLongint(ARootStream);
+  for i := 1 to nbEntries do
+  begin
+    ARootStream.ReadBuffer({%H-}entryRec, sizeof(entryRec));
+    entryRec.Offset:= LEtoN(entryRec.Offset);
+    entryRec.Flags:= LEtoN(entryRec.Flags);
+    entryRec.FilenameSize:= LEtoN(entryRec.FilenameSize);
+
+    if (entryRec.Flags and MemDirectoryEntry_FlagSmallEntryPacked) <> 0 then
+    begin
+      entryRec.Flags := entryRec.Flags xor MemDirectoryEntry_FlagSmallEntryPacked;
+      compressedSize := entryRec.FilenameSize shr 8;
+      uncompressedSize := compressedSize;
+      entryRec.FilenameSize := entryRec.FilenameSize and 255;
+    end else
+    begin
+      compressedSize := LEReadInt64(ARootStream);
+      uncompressedSize := LEReadInt64(ARootStream);
+    end;
+
+    setlength(filename, entryRec.FilenameSize);
+    if length(filename)> 0 then
+      ARootStream.ReadBuffer(filename[1], entryRec.FilenameSize);
+
+    ADataStream.Position:= entryRec.Offset + AStartPos;
+    entryData := TMemoryStream.Create;
+    try
+      if compressedSize <> 0 then
+        entryData.CopyFrom(ADataStream, compressedSize);
+      newEntry := TMemDirectoryEntry.CreateFromData(self, EntryFilename(filename), entryData, true,
+                  uncompressedSize, entryRec.Flags);
+      newEntry.LoadExtraFromEmbeddedStream(ADataStream, AStartPos);
+      AddEntry(newEntry);
+      entryData := nil;
+    finally
+      entryData.Free;
+    end;
+  end;
+end;
+
+procedure TMemDirectory.SaveToStream(ADestination: TStream);
+var rootPos,rootSize: integer;
+  header: string;
+  rootRecPos, startPos, endPos: int64;
+  rootStream: TStream;
+begin
+  startPos := ADestination.Position;
+  header := MemDirectoryFileHeader;
+  ADestination.WriteBuffer(header[1], length(header));
+
+  rootRecPos := ADestination.Position;
+  LEWriteInt64(ADestination,0); //root pos
+  LEWriteInt64(ADestination,0); //root size
+
+  rootStream := TMemoryStream.Create;
+  try
+    SaveToEmbeddedStream(rootStream, ADestination, startPos);
+    rootStream.Position := 0;
+    rootPos := ADestination.Position - startPos;
+    rootSize := rootStream.Size;
+    ADestination.CopyFrom(rootStream, rootStream.Size);
+    FreeAndNil(rootStream);
+    endPos := ADestination.Position;
+    ADestination.Position := rootRecPos;
+    LEWriteInt64(ADestination, rootPos);
+    LEWriteInt64(ADestination, rootSize);
+    ADestination.Position := endPos;
+  finally
+    rootStream.Free;
+  end;
+end;
+
+procedure TMemDirectory.SaveToEmbeddedStream(ARootDest, ADataDest: TStream;
+  AStartPos: int64);
+var
+  entryRec: TDirEntryRecord;
+  entryStream: TMemoryStream;
+  curEntry: TMemDirectoryEntry;
+  filename: string;
+  i: Integer;
+  uncompressedSize: int64;
+begin
+  LEWriteLongint(ARootDest, Count);
+  entryStream := TMemoryStream.Create;
+  try
+    for i := 0 to Count-1 do
+    begin
+      curEntry := Entry[i] as TMemDirectoryEntry;
+      entryStream.Clear;
+      curEntry.SaveToEmbeddedStream(entryStream, ADataDest, AStartPos, uncompressedSize);
+
+      entryRec.Offset:= ADataDest.Position - AStartPos;
+      entryRec.Offset:= NtoLE(entryRec.Offset);
+      if curEntry.Extension <> '' then
+        filename := curEntry.Name+'.'+curEntry.Extension
+      else
+        filename := curEntry.Name;
+
+      if ((curEntry.Flags and MemDirectoryEntry_FlagCompressed)=0) and
+         (Length(filename)<=255) and (entryStream.Size<=255) then
+      begin
+        entryRec.Flags:= curEntry.Flags or MemDirectoryEntry_FlagSmallEntryPacked;
+        entryRec.Flags:= NtoLE(entryRec.Flags);
+        entryRec.FilenameSize:= length(filename) + (entryStream.Size shl 8);
+        entryRec.FilenameSize := NtoLE(entryRec.FilenameSize);
+        ARootDest.WriteBuffer(entryRec, sizeof(entryRec));
+      end else
+      begin
+        entryRec.Flags:= curEntry.Flags;
+        entryRec.Flags:= NtoLE(entryRec.Flags);
+        entryRec.FilenameSize:= length(filename);
+        entryRec.FilenameSize := NtoLE(entryRec.FilenameSize);
+        ARootDest.WriteBuffer(entryRec, sizeof(entryRec));
+        LEWriteInt64(ARootDest, entryStream.Size);
+        LEWriteInt64(ARootDest, uncompressedSize);
+      end;
+
+      if filename <> '' then
+        ARootDest.WriteBuffer(filename[1], length(filename));
+
+      entryStream.Position:= 0;
+      ADataDest.CopyFrom(entryStream, entryStream.Size);
+    end;
+  finally
+    entryStream.Free;
+  end;
+end;
+
+function TMemDirectory.AddDirectory(AName: utf8string; AExtension: utf8string;
+  ACaseSensitive: boolean): integer;
+var
+  newEntry: TMemDirectoryEntry;
+begin
+  result := IndexOf(AName,AExtension,ACaseSensitive);
+  if result <> -1 then
+  begin
+    if not IsDirectory[result] then
+      raise exception.Create('There is already a file with this name and extension');
+    exit;
+  end;
+  newEntry := TMemDirectoryEntry.CreateDirectory(self, EntryFilename(AName, AExtension));
+  result := AddEntry(newEntry);
+end;
+
+function TMemDirectory.Rename(AName: utf8string; AExtension: utf8string;
+  ANewName: utf8string; ACaseSensitive: boolean): boolean;
+var
+  idx, i: Integer;
+begin
+  idx := IndexOf(AName, AExtension, ACaseSensitive);
+  if idx = -1 then exit(false);
+  for i := 0 to Count-1 do
+  if i <> idx then
+  begin
+    if Entry[i].CompareNameAndExtension(ANewName,AExtension,ACaseSensitive) = 0 then
+      raise exception.Create('Name with extension already in use');
+  end;
+  Entry[idx].Name := ANewName;
+  exit(true);
+end;
+
+function TMemDirectory.FindPath(APath: utf8String; ACaseSensitive: boolean): TMemDirectory;
+var
+  path: TMemDirectoryPath;
+  idxPath: integer;
+  idxSub: LongInt;
+begin
+  path := SplitPath(APath);
+  result := self;
+  if path.Items[0].IsEmpty then
+  begin
+    idxPath := 1;
+    while Assigned(result.ParentDirectory) do result := result.ParentDirectory;
+  end
+  else
+    idxPath := 0;
+
+  while idxPath < path.Count do
+  begin
+    idxSub := result.IndexOf(path[idxPath], ACaseSensitive);
+    if idxSub= -1 then
+    begin
+      result := nil;
+      break;
+    end;
+    result := result.Directory[idxSub];
+    inc(idxPath);
+  end;
+
+  path.Free;
+end;
+
+function TMemDirectory.FindEntry(APath: utf8String; ACaseSensitive: boolean): TMemDirectoryEntry;
+var
+  path: TMemDirectoryPath;
+  idxPath: integer;
+  idxSub, idxEntry: LongInt;
+  curDir: TMemDirectory;
+begin
+  path := SplitPath(APath);
+  curDir := self;
+  if path.Items[0].IsEmpty then
+  begin
+    idxPath := 1;
+    while Assigned(curDir.ParentDirectory) do curDir := curDir.ParentDirectory;
+  end
+  else
+    idxPath := 0;
+
+  while idxPath < path.Count-1 do
+  begin
+    idxSub := curDir.IndexOf(path[idxPath], ACaseSensitive);
+    if idxSub= -1 then
+    begin
+      curDir := nil;
+      break;
+    end;
+    curDir := curDir.Directory[idxSub];
+    inc(idxPath);
+  end;
+
+  if Assigned(curDir) and (idxPath < path.Count) then
+  begin
+    idxEntry := curDir.IndexOf(path[idxPath], ACaseSensitive);
+    if idxEntry = -1 then
+      result := nil
+    else
+      result := curDir.Entry[idxEntry] as TMemDirectoryEntry;
+  end
+  else
+    result := nil;
+
+  path.Free;
+end;
+
+procedure TMemDirectory.CopyTo(ADest: TMemDirectory; ARecursive: boolean);
+var
+  i, idxDir: Integer;
+  entryContent: TMemoryStream;
+begin
+  for i := 0 to Count-1 do
+    if IsDirectory[i] and ARecursive then
+    begin
+      idxDir := ADest.AddDirectory(Entry[i].Name,Entry[i].Extension);
+      Directory[i].CopyTo(ADest.Directory[idxDir], true);
+    end else
+    begin
+      entryContent := TMemoryStream.Create;
+      Entry[i].CopyTo(entryContent);
+      ADest.Add(Entry[i].Name,Entry[i].Extension,entryContent,false,true);
+    end;
+end;
+
+function TMemDirectory.SplitPath(APath: utf8string): TMemDirectoryPath;
+var idx,idxSlash: integer;
+begin
+  result := TMemDirectoryPath.Create;
+  idx := 1;
+  repeat
+    idxSlash := PosEx('/',APath,idx);
+    if idxSlash = 0 then
+    begin
+      result.Add(EntryFilename(copy(APath, idx, length(APath)-idx+1)));
+      break;
+    end else
+    begin
+      result.Add(EntryFilename(copy(APath, idx, idxSlash-idx)));
+      idx := idxSlash+1;
+    end;
+  until false;
+end;
+
+constructor TMemDirectory.Create(AParentDirectory: TMemDirectory);
+begin
+  inherited Create;
+  FParentDirectory := AParentDirectory;
+end;
+
+function TMemDirectory.Equals(Obj: TObject): boolean;
+var
+  other: TMemDirectory;
+  i, j: Integer;
+  data,otherData: TMemoryStream;
+  different: Boolean;
+begin
+  if Obj = self then exit(true);
+  if not (Obj is TMemDirectory) then exit(false);
+  other := TMemDirectory(Obj);
+  if other.Count <> Count then exit(false);
+  for i := 0 to Count-1 do
+  begin
+    j := other.IndexOf(Entry[i].Name,Entry[i].Extension,true);
+    if j = -1 then exit(false);
+    if IsDirectory[i] then
+    begin
+      if not other.IsDirectory[j] then exit(false);
+      if not other.Directory[j].Equals(Directory[i]) then exit(false);
+    end else
+    if Entry[i].FileSize <> other.Entry[j].FileSize then exit(false)
+    else
+    begin
+      data := TMemoryStream.Create;
+      otherData := TMemoryStream.Create;
+      Entry[i].CopyTo(data);
+      other.Entry[j].CopyTo(otherData);
+      different := not CompareMem(data.Memory, otherData.Memory, data.Size);
+      data.Free;
+      otherData.Free;
+      if different then exit(false);
+    end;
+  end;
+  result := true;
+end;
+
+{ TMemDirectoryEntry }
+
+function TMemDirectoryEntry.GetIsCompressed: boolean;
+begin
+  result := (FFlags and MemDirectoryEntry_FlagCompressed) <> 0;
+end;
+
+function TMemDirectoryEntry.GetCompressedSize: int64;
+begin
+  if not IsDirectory and Assigned(FStream) then
+    result := FStream.Size
+  else
+    result := 0;
+end;
+
+function TMemDirectoryEntry.GetIsDirectory: boolean;
+begin
+  result := (FFlags and MemDirectoryEntry_FlagDirectory) <> 0;
+end;
+
+procedure TMemDirectoryEntry.SetIsCompressed(AValue: boolean);
+var compressedStream,decompressed: TMemoryStream;
+  compression: Tcompressionstream;
+begin
+  if AValue = IsCompressed then exit;
+
+  if Assigned(FStream) then
+  begin
+    if AValue then //compress
+    begin
+      compressedStream := TMemoryStream.Create;
+      compression := nil;
+      try
+        compression := Tcompressionstream.create(cldefault, compressedStream, true);
+        FStream.Position := 0;
+        compression.CopyFrom(FStream,FStream.Size);
+        FStream.Free;
+        FStream := compressedStream;
+        compressedStream := nil;
+        FFlags := FFlags xor MemDirectoryEntry_FlagCompressed;
+      finally
+        compression.Free;
+        compressedStream.Free;
+      end;
+    end else
+    begin //decompress
+      decompressed := TMemoryStream.Create;
+      try
+        InternalCopyTo(decompressed);
+        FStream.Free;
+        FStream := decompressed;
+        decompressed := nil;
+        FFlags := FFlags xor MemDirectoryEntry_FlagCompressed;
+      finally
+        decompressed.Free;
+      end;
+    end;
+  end else
+    FFlags := FFlags xor MemDirectoryEntry_FlagCompressed;
+end;
+
+function TMemDirectoryEntry.GetName: utf8string;
+begin
+  result := FName;
+end;
+
+procedure TMemDirectoryEntry.SetName(AValue: utf8string);
+begin
+  while AValue[length(AValue)] = '.' do delete(AValue, length(AValue), 1);
+  FName := AValue;
+end;
+
+function TMemDirectoryEntry.GetFileSize: int64;
+begin
+  if IsDirectory then
+    result := 0
+  else
+    Result:= FUncompressedSize;
+end;
+
+function TMemDirectoryEntry.GetExtension: utf8string;
+begin
+  Result:= FExtension;
+end;
+
+function TMemDirectoryEntry.InternalCopyTo(ADestination: TStream): int64;
+var
+  decomp: Tdecompressionstream;
+begin
+  if not Assigned(FStream) then exit(0);
+  if IsCompressed then
+  begin
+    FStream.Position := 0;
+    decomp := Tdecompressionstream.Create(FStream,true);
+    try
+      result := ADestination.CopyFrom(decomp,FUncompressedSize);
+    finally
+      decomp.Free;
+    end;
+  end else
+  begin
+    FStream.Position := 0;
+    result := ADestination.CopyFrom(FStream, FStream.Size);
+  end;
+end;
+
+function TMemDirectoryEntry.CopyTo(ADestination: TStream): int64;
+begin
+  if IsDirectory then exit(0);
+  result := InternalCopyTo(ADestination);
+end;
+
+function TMemDirectoryEntry.GetStream: TStream;
+begin
+  if IsCompressed then
+    raise exception.Create('Stream cannot be accessed directly because it is compressed')
+  else
+    result := FStream;
+end;
+
+constructor TMemDirectoryEntry.Create(AContainer: TMultiFileContainer; AFilename: TEntryFilename;
+  AUncompressedStream: TStream; AOwnStream: boolean);
+begin
+  CreateFromData(AContainer, AFilename, AUncompressedStream, AOwnStream, AUncompressedStream.Size, 0);
+end;
+
+constructor TMemDirectoryEntry.CreateFromData(AContainer: TMultiFileContainer; AFilename: TEntryFilename;
+  AStream: TStream; AOwnStream: boolean;
+  AUncompressedSize: int64; AFlags: Word);
+begin
+  inherited Create(AContainer);
+  Name := AFilename.Name;
+  FExtension:= AFilename.Extension;
+  if AOwnStream then
+    FStream := AStream
+  else
+  begin
+    FStream := TMemoryStream.Create;
+    AStream.Position:= 0;
+    FStream.CopyFrom(AStream, AStream.Size);
+  end;
+  FUncompressedSize:= AUncompressedSize;
+  FFlags:= AFlags;
+  FMemDirectory := nil;
+end;
+
+procedure TMemDirectoryEntry.SaveToEmbeddedStream(AEntryStream, ADataStream: TStream;
+  AStartPos: int64; out uncompressedSize: int64);
+var
+  entryStartPos: Int64;
+begin
+  if IsDirectory then
+  begin
+    if not Assigned(FMemDirectory) then
+      raise exception.Create('Directory not allocated');
+    FreeAndNil(FStream);
+    IsCompressed:= false;
+    entryStartPos := AEntryStream.Position;
+    FMemDirectory.SaveToEmbeddedStream(AEntryStream, ADataStream, AStartPos);
+    uncompressedSize:= AEntryStream.Position - entryStartPos;
+  end else
+  if Assigned(FStream) then
+  begin
+    FStream.Position:= 0;
+    AEntryStream.CopyFrom(FStream, FStream.Size);
+    uncompressedSize:= FUncompressedSize;
+  end;
+end;
+
+procedure TMemDirectoryEntry.LoadExtraFromEmbeddedStream(ADataStream: TStream;
+  AStartPos: int64);
+begin
+  if IsDirectory and Assigned(FStream) then
+  begin
+    IsCompressed:= false;
+    if not Assigned(FMemDirectory) then
+      FMemDirectory := TMemDirectory.Create(Container as TMemDirectory);
+    FMemDirectory.LoadFromEmbeddedStream(FStream, ADataStream, AStartPos);
+    FreeAndNil(FStream);
+  end;
+end;
+
+constructor TMemDirectoryEntry.CreateDirectory(AContainer: TMultiFileContainer;
+  AFilename: TEntryFilename);
+begin
+  Name := AFilename.Name;
+  FExtension:= AFilename.Extension;
+  FStream := nil;
+  FUncompressedSize:= 0;
+  FFlags := MemDirectoryEntry_FlagDirectory;
+  FContainer := AContainer;
+  FMemDirectory := TMemDirectory.Create(Container as TMemDirectory);
+end;
+
+destructor TMemDirectoryEntry.Destroy;
+begin
+  FStream.Free;
+  FMemDirectory.Free;
+  inherited Destroy;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgramsegui.inc

@@ -0,0 +1,349 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{$IFDEF INCLUDE_INTERFACE}
+{$UNDEF INCLUDE_INTERFACE}
+type
+  TColor = msegraphutils.colorty;
+
+const
+  clNone = msegraphutils.cl_none;
+  clDefault = msegraphutils.cl_default;
+  clBlack = msegraphutils.cl_black;
+  clWhite = msegraphutils.cl_white;
+
+function ColorToRGB(c: TColor): TColor;
+function clRgbBtnHighlight: TColor;
+function clRgbBtnShadow: TColor;
+function GetScreenDPIX: integer;
+function GetScreenDPIY: integer;
+
+type
+  {* How to draw the end of line }
+  TPenEndCap = msegraphics.capstylety;
+
+const
+    {** Draw a half-disk at the end of the line. The diameter of the disk is
+        equal to the pen width. }
+    pecRound = msegraphics.cs_round;
+    {** Draw a half-square. The size of the square is equal to the pen width.
+        This is visually equivalent to extend the line of half the pen width }
+    pecSquare = msegraphics.cs_projecting;
+    {** The line ends exactly at the end point }
+    pecFlat = msegraphics.cs_butt;
+
+type
+  {* How to join segments. This makes sense only for geometric pens (that
+     have a certain width) }
+  TPenJoinStyle = msegraphics.joinstylety;
+
+const
+    {** Segments are joined by filling the gap with an arc }
+    pjsRound = msegraphics.js_round;
+    {** Segments are joind by filling the gap with an intermediary segment }
+    pjsBevel = msegraphics.js_bevel;
+    {** Segments are joined by extending them up to their intersection.
+        There is a miter limit so that if the intersection is too far,
+        an intermediary segment is used }
+    pjsMiter = msegraphics.js_miter;
+
+type
+  {* Style to use for the pen. The unit for the pattern is the width of the
+     line }
+  TPenStyle = msegraphics.dashesstringty;
+  TPenMode = msegraphics.rasteropty;
+
+const
+  {** Pen is continuous }
+  psSolid = TPenStyle('');
+  {** Pen is dashed. The dash have a length of 3 unit and the gaps of 1 unit }
+  psDash = TPenStyle(#3#1);
+  {** Pen is dotted. The dots have a length of 1 unit and the gaps of 1 unit }
+  psDot = TPenStyle(#1#1);
+  {** Pattern is a dash of length 3 followed by a dot of length 1, separated by a gap of length 1 }
+  psDashDot = TPenStyle(#3#1#1#1);
+  {** Dash of length 3, and two dots of length 1 }
+  psDashDotDot = TPenStyle(#3#1#1#1#1#1);
+
+  //the following are not directly compatible with mseGUI
+  {** Pen is not drawn }
+  psClear = TPenStyle(#0#0);
+  {** Custom pattern used }
+  psPattern = TPenStyle(#0#0#0#0);
+
+  pmBlack = msegraphics.rop_clear;
+  pmWhite = msegraphics.rop_set;
+  pmNop = msegraphics.rop_nop;
+  pmNot = msegraphics.rop_not;
+  pmCopy = msegraphics.rop_copy;
+  pmNotCopy = msegraphics.rop_notcopy;
+  pmMergePenNot = msegraphics.rop_notor;
+  pmMaskPenNot = msegraphics.rop_notand;
+  pmMergeNotPen = msegraphics.rop_ornot;
+  pmMaskNotPen = msegraphics.rop_andnot;
+  pmMerge = msegraphics.rop_or;
+  pmNotMerge = msegraphics.rop_nor;
+  pmMask = msegraphics.rop_and;
+  pmNotMask = msegraphics.rop_nand;
+  pmXor = msegraphics.rop_xor;
+  pmNotXor = msegraphics.rop_notxor;
+
+type
+  TPen = class
+  private
+    FColor: TColor;
+    FMode: TPenMode;
+    FEndCap: TPenEndCap;
+    FJoinStyle: TPenJoinStyle;
+    FStyle: TPenStyle;
+    FWidth: integer;
+  public
+    constructor Create;
+    {** Color of the pen }
+    property Color: TColor read FColor write FColor;
+    {** Operation done on pixels }
+    property Mode: TPenMode read FMode write FMode;
+    {** End cap of the pen: how to draw the ends of the lines }
+    property EndCap: TPenEndCap read FEndCap write FEndCap;
+    {** Join style: how to join the segments of a polyline }
+    property JoinStyle: TPenJoinStyle read FJoinStyle write FJoinStyle;
+    {** Pen style: solid, dash, dot... }
+    property Style : TPenStyle read FStyle write FStyle;
+    {** Pen width in pixels }
+    property Width : Integer read FWidth write FWidth;
+  end;
+
+  TBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical, bsFDiagonal,
+                 bsBDiagonal, bsCross, bsDiagCross, bsImage, bsPattern);
+
+type
+  { TBrush }
+  {* A class describing a brush }
+  TBrush = class
+  private
+    FColor: TColor;
+    FStyle: TBrushStyle;
+  public
+    constructor Create;
+    {** Color of the brush }
+    property Color: TColor read FColor write FColor;
+    {** Style of the brush: solid, diagonal lines, horizontal lines... }
+    property Style: TBrushStyle read FStyle write FStyle;
+  end;
+
+type
+  {$DEFINE TCanvas}
+  TCanvas = msegraphics.tcanvas;
+  {$DEFINE TBitmap}
+  TBitmap = msebitmap.tbitmap;
+  TRawImage = TBitmap;
+  TFont = msegraphics.tfont;
+  {$DEFINE TFontStyle}
+  TFontStyle = msegraphutils.fontstylety;
+  TFontStyles = msegraphutils.fontstylesty;
+
+  TBitmapHelper = class helper for TBitmap
+  private
+    function GetTransparent: boolean;
+    function GetTransparentMode: TTransparentMode;
+    function GetTransparentColor: TColor;
+  public
+    class function Create: TBitmap; overload;
+    property Transparent: boolean read GetTransparent;
+    property TransparentMode: TTransparentMode read GetTransparentMode;
+    property TransparentColor: TColor read GetTransparentColor;
+  end;
+
+  TCanvasHelper = class helper for TCanvas
+    procedure Draw(X,Y: integer; AGraphic: TGraphic); overload;
+    procedure StretchDraw(ARect: TRect; AGraphic: TGraphic); overload;
+    procedure Draw(X,Y: integer; ABitmap: TBitmap); overload;
+    procedure StretchDraw(ARect: TRect; ABitmap: TBitmap); overload;
+  end;
+
+  {$DEFINE TFontQuality}
+  TFontQuality = (fqDefault, fqNonAntialiased, fqAntialiased, fqCleartype);
+
+  TFontHelper = class helper for TFont
+  private
+    function GetOrientation: integer;
+    procedure SetOrientation(AOrientation: integer);
+    function GetFontQuality: TFontQuality;
+    procedure SetFontQuality(AQuality: TFontQuality);
+    function GetHeightHelper: integer;
+    procedure SetHeightHelper(AHeight: integer);
+  public
+    property Orientation: integer read GetOrientation write SetOrientation;
+    property Quality: TFontQuality read GetFontQuality write SetFontQuality;
+    property Height: integer read GetHeightHelper write SetHeightHelper;
+  end;
+
+const
+  fsBold = msegraphutils.fs_bold;
+  fsItalic = msegraphutils.fs_italic;
+  fsUnderline = msegraphutils.fs_underline;
+  fsStrikeOut = msegraphutils.fs_strikeout;
+
+operator :=(AClassesPoint: TClassesPoint): TPoint;
+operator :=(AMSERect: TMSERect): TRect;
+operator :=(ARect: TRect): TMSERect;
+{$ENDIF}
+
+{$IFDEF INCLUDE_IMPLEMENTATION}
+{$UNDEF INCLUDE_IMPLEMENTATION}
+function ColorToRGB(c: TColor): TColor;
+var triple: rgbtriplety;
+begin
+  triple := msegraphics.colortorgb(c);
+  result := msegraphics.rgbtocolor(triple.red, triple.green, triple.blue);
+end;
+
+function clRgbBtnHighlight: TColor;
+begin
+  result := ColorToRGB(msegraphutils.cl_highlight);
+end;
+
+function clRgbBtnShadow: TColor;
+begin
+  result := ColorToRGB(msegraphutils.cl_shadow);
+end;
+
+function GetScreenDPIX: integer;
+begin
+  result := 96;
+end;
+
+function GetScreenDPIY: integer;
+begin
+  result := 96;
+end;
+
+{ TPen }
+
+constructor TPen.Create;
+begin
+  inherited Create;
+  Mode := pmCopy;
+  Style := psSolid;
+  Width := 1;
+  Color := cl_black;
+  EndCap:= pecRound;
+  JoinStyle:= pjsRound;
+end;
+
+{ TBrush }
+
+constructor TBrush.Create;
+begin
+  Color := cl_white;
+  Style := bsSolid;
+end;
+
+operator :=(AClassesPoint: TClassesPoint): TPoint;
+begin
+  result.x := AClassesPoint.X;
+  result.y := AClassesPoint.Y;
+end;
+
+operator :=(AMSERect: TMSERect): TRect;
+begin
+  result.Left := AMSERect.x;
+  result.Top := AMSERect.y;
+  result.Right:= AMSERect.x + AMSERect.cx;
+  result.Bottom:= AMSERect.y + AMSERect.cy;
+end;
+
+operator :=(ARect: TRect): TMSERect;
+begin
+  result.x := ARect.Left;
+  result.y := ARect.Top;
+  result.cx := ARect.Right - ARect.Left;
+  result.cy := ARect.Bottom - ARect.Top;
+end;
+
+class function TBitmapHelper.Create: TBitmap;
+begin
+  result := TBitmap.Create(bmk_rgb);
+end;
+
+function TBitmapHelper.GetTransparent: boolean;
+begin
+  result := TransparentColor <> clNone;
+end;
+
+function TBitmapHelper.GetTransparentMode: TTransparentMode;
+begin
+  if TMaskedBitmap(self).TransparentColor = clDefault then
+    result := tmAuto
+  else
+    result := tmFixed;
+end;
+
+function TBitmapHelper.GetTransparentColor: TColor;
+begin
+  if self is TMaskedBitmap then
+    result := TMaskedBitmap(self).TransparentColor
+    else result := clNone;
+end;
+
+procedure TCanvasHelper.Draw(X,Y: integer; ABitmap: TBitmap);
+begin
+  ABitmap.Paint(Self, Point(X,Y));
+End;
+
+procedure TCanvasHelper.StretchDraw(ARect: TRect; ABitmap: TBitmap);
+begin
+  ABitmap.Paint(Self, ARect);
+End;
+
+procedure TCanvasHelper.Draw(X,Y: integer; AGraphic: TGraphic);
+begin
+  AGraphic.Draw(self, rect(x,y,x+AGraphic.Width,y+AGraphic.Height));
+End;
+
+procedure TCanvasHelper.StretchDraw(ARect: TRect; AGraphic: TGraphic);
+begin
+  AGraphic.Draw(self, ARect);
+End;
+
+function TFontHelper.GetOrientation: integer;
+begin
+  result := 0;
+end;
+
+procedure TFontHelper.SetOrientation(AOrientation: integer);
+begin
+  if AOrientation <> 0 then
+    raise exception.Create('Only orientation 0 allowed at font level');
+end;
+
+function TFontHelper.GetFontQuality: TFontQuality;
+begin
+  if foo_antialiased2 in options then result := fqClearType else
+  if foo_antialiased in options then result := fqAntialiased else
+  if foo_nonantialiased in options then result := fqNonAntialiased else
+    result := fqDefault;
+end;
+
+procedure TFontHelper.SetFontQuality(AQuality: TFontQuality);
+begin
+  options := options - [foo_nonantialiased, foo_antialiased, foo_antialiased2];
+  case AQuality of
+  fqNonAntialiased: options := options + [foo_nonantialiased];
+  fqAntialiased: options := options + [foo_antialiased];
+  fqClearType: options := options + [foo_antialiased2];
+  end;
+end;
+
+function TFontHelper.GetHeightHelper: integer;
+begin
+  result := round(inherited Height * 1.5);
+end;
+
+procedure TFontHelper.SetHeightHelper(AHeight: integer);
+begin
+  if AHeight < 0 then
+     inherited Height := -AHeight
+   else
+     inherited Height := round(AHeight/1.5);
+end;
+
+{$ENDIF}

vendor/kam_remake/src/ext/BGRABitmap/bgramsegui_text.inc

@@ -0,0 +1,80 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+procedure BitmapTextOut(ABitmap: TBitmap; ACoord: TPoint; AText: string);
+var sUTF16: UnicodeString;
+begin 
+  sUTF16 := UTF8ToUTF16(AText);
+  inc(ACoord.Y, ABitmap.Canvas.Font.GlyphHeight-1);
+  ABitmap.Canvas.DrawString(sUTF16, ACoord);
+end;
+
+procedure BitmapTextOutAngle(ABitmap: TBitmap; ACoord: TPoint; AText: string; AOrientation: integer);
+var sUTF16: UnicodeString;
+  angleRad: single;
+  ofs, center: TPointF;
+begin
+  angleRad := AOrientation*Pi/1800;
+  ofs := PointF(ACoord.X, ACoord.Y) +
+         PointF(sin(angleRad), cos(angleRad))*(ABitmap.Canvas.Font.GlyphHeight-1);
+  sUTF16 := UTF8ToUTF16(AText);
+  center := PointF(ABitmap.Canvas.GetStringWidth(sUTF16)/2, 
+                   ABitmap.Canvas.Font.Height/2);
+  ABitmap.Canvas.DrawString(sUTF16, Point(round(ofs.X), round(ofs.Y)), 
+                            nil, false, angleRad);
+end;
+
+procedure BitmapTextRect(ABitmap: TBitmap; ARect: TRect; ACoord: TPoint; 
+  AText: string; const AStyle: TTextStyle);
+var sUTF16: UnicodeString;
+begin 
+  sUTF16 := UTF8ToUTF16(AText);
+  case AStyle.Alignment of
+  taRightJustify: ACoord.X := ARect.Right - ABitmap.Canvas.GetStringWidth(sUTF16);
+  taCenter: ACoord.X := ARect.Left + (ARect.Width - ABitmap.Canvas.GetStringWidth(sUTF16)) div 2;
+  end;
+  case AStyle.Layout of
+  tlBottom: ACoord.Y := ARect.Bottom - ABitmap.Canvas.Font.Height;
+  tlCenter: ACoord.Y := ARect.Top + (ARect.Height - ABitmap.Canvas.Font.Height) div 2;
+  end;
+  inc(ACoord.Y, ABitmap.Canvas.Font.GlyphHeight-1);
+  ABitmap.Canvas.DrawString(sUTF16, ACoord);
+end;
+
+function BitmapTextExtent(ABitmap: TBitmap; AText: string): TSize;
+var sUTF16: UnicodeString;
+begin
+  sUTF16 := UTF8ToUTF16(AText);
+  result := Size(ABitmap.Canvas.GetStringWidth(sUTF16), ABitmap.Canvas.Font.Height);
+end;
+
+function BitmapTextExtentAngle(ABitmap: TBitmap; AText: string; AOrientation: integer): TSize;
+begin
+  result := BitmapTextExtent(ABitmap, AText);
+end;
+
+function BitmapTextFitInfo(ABitmap: TBitmap; AText: string; AMaxWidth: integer): integer;
+var 
+  bytePos, charLen: integer;  
+  sUTF16: UnicodeString; 
+begin
+  result := 0;
+  bytePos := 1;
+  while bytePos <= length(AText) do
+  begin
+    charLen := UTF8CharacterLength(@AText[bytePos]);
+    sUTF16 := UTF8ToUTF16(copy(AText, 1, bytePos+charLen-1));
+    if ABitmap.Canvas.GetStringWidth(sUTF16) > AMaxWidth then break;
+    inc(result);
+    inc(bytePos,charLen);
+  end;
+end;
+
+function BitmapTextFitInfoAngle(ABitmap: TBitmap; AText: string; 
+  AMaxWidth: integer; AOrientation: integer): integer;
+begin
+  result := BitmapTextFitInfo(ABitmap, AText, AMaxWidth);
+end;
+
+procedure BitmapFillRect(ABitmap: TBitmap; ARect: TRect; AColor: TColor);
+begin
+  ABitmap.Canvas.FillRect(ARect, AColor);
+end;

vendor/kam_remake/src/ext/BGRABitmap/bgramsegui_uses.inc

@@ -0,0 +1 @@
+uses BGRAClasses, FPimage, msegraphics, msegraphutils, msebitmap;

vendor/kam_remake/src/ext/BGRABitmap/bgramseguibitmap.pas

@@ -0,0 +1,255 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAMSEguiBitmap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, BGRAClasses, BGRAGraphics, BGRABitmapTypes, BGRADefaultBitmap,
+  BGRAText, msebitmap;
+
+type
+
+  { TBGRAMSEguiBitmap }
+
+  TBGRAMSEguiBitmap = class(TBGRADefaultBitmap)
+  protected
+    procedure CopyDataToBitmap(AData: Pointer; AWidth,AHeight: integer; ALineOrder: TRawImageLineOrder; ABitmap: TBitmap);
+    procedure RebuildBitmap; override;
+    procedure DoLoadFromBitmap; override;
+    function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override;
+    function LoadFromRawImage({%H-}ARawImage: TRawImage; {%H-}DefaultOpacity: byte;
+      {%H-}AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean
+      =True): boolean; override;
+    procedure FreeBitmap; override;
+    procedure NotAvailable;
+    procedure InternalAssignBitmapPixels(ASource: TBitmap);
+    function GetCanvas: TCanvas; override;
+  public
+    procedure Assign(ASource: TPersistent); override;
+    destructor Destroy; override;
+    procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //not available
+    procedure DataDrawTransparent({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer;
+      {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override;
+    procedure DataDrawOpaque({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer;
+      {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override;
+    procedure TakeScreenshot({%H-}ARect: TRect); override; //not available
+    procedure TakeScreenshotOfPrimaryMonitor; override; //not available
+    procedure LoadFromDevice({%H-}DC: HDC); override; //not available
+    procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; //not available
+  end;
+  
+type
+  { TBitmapTracker }
+
+  TBitmapTracker = class(TMaskedBitmap)
+  protected
+    FUser: TBGRADefaultBitmap;
+    procedure DoChange; override;
+  public
+    constructor Create(AUser: TBGRADefaultBitmap); overload;
+  end;  
+
+implementation
+
+uses msegraphics, msegraphutils, math;
+
+{ TBitmapTracker }
+
+constructor TBitmapTracker.Create(AUser: TBGRADefaultBitmap);
+begin
+  FUser := AUser;
+  inherited Create(bmk_rgb);
+end;
+
+procedure TBitmapTracker.DoChange;
+begin
+  if FUser <> nil then
+    FUser.NotifyBitmapChange;
+  inherited DoChange;
+end;
+
+{ TBGRAMSEguiBitmap }
+
+procedure TBGRAMSEguiBitmap.CopyDataToBitmap(AData: Pointer; AWidth,AHeight: integer; ALineOrder: TRawImageLineOrder; ABitmap: TBitmap);
+var
+  ppix: PLongword;
+  pbmp: PLongword;
+  pmask: PByte;
+  x,y,yBmp : integer;
+  setMask: boolean;  
+begin
+  ABitmap.Size := Size(AWidth, AHeight);
+  ppix := AData;
+  pmask := nil;
+  if ABitmap is TMaskedBitmap then
+  begin  
+    setMask := true;
+    TMaskedBitmap(ABitmap).Masked := true;
+    TMaskedBitmap(ABitmap).MaskKind := bmk_gray;  
+  end else
+    setMask := false;
+  for y := 0 to Height-1 do
+  begin
+    if ALineOrder = riloTopToBottom then
+      yBmp := y else yBmp := Height-1-y;
+    pbmp := ABitmap.Scanline[yBmp];
+    if setMask then pmask := TMaskedBitmap(ABitmap).Mask.Scanline[yBmp];
+    for x := 0 to Width-1 do
+    begin
+      pbmp^ := ppix^ and $ffffff;
+      if setMask then 
+      begin
+        pmask^ := ppix^ shr 24;
+        inc(pmask);
+      end;
+      inc(ppix);
+      inc(pbmp);
+    end;
+  end;
+end;
+
+procedure TBGRAMSEguiBitmap.RebuildBitmap;
+begin
+  if FBitmap = nil then
+    FBitmap := TBitmapTracker.Create(self);
+
+  CopyDataToBitmap(Data, Width, Height, LineOrder, FBitmap);
+end;
+
+procedure TBGRAMSEguiBitmap.InternalAssignBitmapPixels(ASource: TBitmap);
+var 
+  ppix,pbmp: PLongword;
+  pmask: PByte;
+  getMask: boolean;
+  x,y,wm1: integer;
+begin
+  if ASource is TMaskedBitmap then
+    getMask := TMaskedBitmap(ASource).Masked
+    else getMask := false;
+  wm1 := min(Width-1, ASource.Width-1);
+  for y := 0 to min(Height-1, ASource.Height-1) do
+  begin
+    ppix := plongword(GetScanlineFast(y));
+    pbmp := ASource.Scanline[y];
+    if getMask then pmask := TMaskedBitmap(ASource).Mask.Scanline[y];
+    for x := 0 to wm1 do
+    begin
+      if getMask then
+      begin
+        ppix^ := (pbmp^ and $ffffff) or (pmask^ shl 24); 
+        inc(pmask);
+      end else
+        ppix^ := (pbmp^ and $ffffff) or $ff000000;
+      inc(ppix);
+      inc(pbmp);
+    end;
+  end;
+end;
+
+function TBGRAMSEguiBitmap.GetCanvas: TCanvas; 
+begin
+  result := inherited GetCanvas;
+  NotifyBitmapChange;
+end;
+
+procedure TBGRAMSEguiBitmap.Assign(ASource: TPersistent); 
+var bmp: TBitmap;
+begin
+  if ASource is TBitmap then
+  begin
+    bmp := TBitmap(ASource);
+    SetSize(bmp.Width, bmp.Height);
+    InternalAssignBitmapPixels(bmp);
+    InvalidateBitmap;
+  end else
+    inherited Assign(ASource);
+end;
+
+procedure TBGRAMSEguiBitmap.DoLoadFromBitmap; 
+begin
+  if Assigned(FBitmap) then
+    InternalAssignBitmapPixels(FBitmap);
+end;
+
+function TBGRAMSEguiBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer;
+begin
+  result := TMSEFontRenderer.Create;
+end;
+
+function TBGRAMSEguiBitmap.LoadFromRawImage(ARawImage: TRawImage;
+  DefaultOpacity: byte; AlwaysReplaceAlpha: boolean;
+  RaiseErrorOnInvalidPixelFormat: boolean): boolean;
+begin
+  self.Assign(ARawImage);
+  result := true;
+end;
+
+procedure TBGRAMSEguiBitmap.FreeBitmap;
+begin
+  FreeAndNil(FBitmap);
+end;
+
+procedure TBGRAMSEguiBitmap.NotAvailable;
+begin
+  raise exception.Create('Function not available with MSEgui');
+end;
+
+destructor TBGRAMSEguiBitmap.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TBGRAMSEguiBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x,
+  y: integer);
+begin
+  (Bitmap as TMaskedBitmap).Masked := false;
+  Bitmap.Canvas.CopyArea(CanvasSource, MakeRect(x,y,Bitmap.Width,Bitmap.Height),
+              Point(0,0));              
+end;
+
+procedure TBGRAMSEguiBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+var
+  bmp: TMaskedBitmap;
+begin
+  bmp := TMaskedBitmap.Create(bmk_rgb);
+  CopyDataToBitmap(Data, Width, Height, ALineOrder, bmp);
+  bmp.Paint(ACanvas, Rect);  
+  bmp.Free;
+end;
+
+procedure TBGRAMSEguiBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+var
+  bmp: TBitmap;
+begin
+  bmp := TBitmap.Create(bmk_rgb);
+  CopyDataToBitmap(AData, AWidth, AHeight, ALineOrder, bmp);
+  bmp.Paint(ACanvas, Rect);  
+  bmp.Free;
+end;
+
+procedure TBGRAMSEguiBitmap.TakeScreenshot(ARect: TRect);
+begin
+  NotAvailable;
+end;
+
+procedure TBGRAMSEguiBitmap.TakeScreenshotOfPrimaryMonitor;
+begin
+  NotAvailable;
+end;
+
+procedure TBGRAMSEguiBitmap.LoadFromDevice(DC: HDC);
+begin
+  NotAvailable;
+end;
+
+procedure TBGRAMSEguiBitmap.LoadFromDevice(DC: HDC; ARect: TRect);
+begin
+  NotAvailable;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgramultifiletype.pas

@@ -0,0 +1,500 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAMultiFileType;
+
+{$mode objfpc}{$H+}
+{$MODESWITCH ADVANCEDRECORDS}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, fgl;
+
+type
+
+  { TEntryFilename }
+
+  TEntryFilename = record
+  private
+    FExtension: utf8string;
+    FName: utf8string;
+    function GetFilename: utf8string;
+    function GetIsEmpty: boolean;
+    procedure SetExtension(AValue: utf8string);
+    procedure SetFilename(AValue: utf8string);
+    procedure SetName(AValue: utf8string);
+  public
+    class operator =(const AValue1,AValue2: TEntryFilename): boolean;
+    property Filename: utf8string read GetFilename write SetFilename;
+    property Name: utf8string read FName write SetName;
+    property Extension: utf8string read FExtension write SetExtension;
+    property IsEmpty: boolean read GetIsEmpty;
+  end;
+
+function EntryFilename(AName,AExtension: string): TEntryFilename; overload;
+function EntryFilename(AFilename: string): TEntryFilename; overload;
+
+type
+  TMultiFileContainer = class;
+
+  { TMultiFileEntry }
+
+  TMultiFileEntry = class
+  protected
+    FContainer: TMultiFileContainer;
+    function GetName: utf8string; virtual; abstract;
+    procedure SetName(AValue: utf8string); virtual; abstract;
+    function GetFileSize: int64; virtual;
+    function GetExtension: utf8string; virtual;
+  public
+    constructor Create(AContainer: TMultiFileContainer);
+    function CopyTo({%H-}ADestination: TStream): int64; virtual;
+    function GetStream: TStream; virtual;
+    function CompareNameAndExtension(AName: utf8string; AExtension: utf8string; ACaseSensitive: boolean = true): integer;
+    property Name: utf8string read GetName write SetName;
+    property Extension: utf8string read GetExtension;
+    property FileSize: int64 read GetFileSize;
+    property Container: TMultiFileContainer read FContainer;
+  end;
+
+  TMultiFileEntryList = specialize TFPGList<TMultiFileEntry>;
+
+  { TMultiFileContainer }
+
+  TMultiFileContainer = class(TPersistent)
+  private
+    FEntries: TMultiFileEntryList;
+  protected
+    procedure Init; virtual;
+    function AddEntry(AEntry: TMultiFileEntry; AIndex: integer = -1): integer;
+    function GetCount: integer;
+    function GetEntry(AIndex: integer): TMultiFileEntry;
+    function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; virtual; abstract;
+    function GetRawString(AIndex: integer): RawByteString;
+    function GetRawStringByFilename(AFilename: string): RawByteString;
+    procedure SetRawString(AIndex: integer; AValue: RawByteString);
+    procedure SetRawStringByFilename(AFilename: string; AValue: RawByteString);
+  public
+    constructor Create; overload;
+    constructor Create(AFilename: utf8string); overload;
+    constructor Create(AStream: TStream); overload;
+    constructor Create(AStream: TStream; AStartPos: Int64); overload;
+    procedure Assign(Source: TPersistent); override;
+    function Add(AName: utf8string; AExtension: utf8string; AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer; overload;
+    function Add(AName: utf8string; AExtension: utf8string; AContent: RawByteString; AOverwrite: boolean = false): integer; overload;
+    function Add(AFilename: TEntryFilename; AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer; overload;
+    function Add(AFilename: TEntryFilename; AContent: RawByteString; AOverwrite: boolean = false): integer; overload;
+    procedure Clear; virtual;
+    destructor Destroy; override;
+    procedure LoadFromFile(AFilename: utf8string);
+    procedure LoadFromStream(AStream: TStream); virtual; abstract;
+    procedure LoadFromResource(AFilename: string); virtual;
+    procedure SaveToFile(AFilename: utf8string);
+    procedure SaveToStream(ADestination: TStream); virtual; abstract;
+    procedure Remove(AEntry: TMultiFileEntry); virtual;
+    procedure Delete(AIndex: integer); overload; virtual;
+    function Delete(AName: utf8string; AExtension: utf8string; ACaseSensitive: boolean = True): boolean; overload;
+    function Delete(AFilename: TEntryFilename; ACaseSensitive: boolean = True): boolean; overload;
+    function IndexOf(AEntry: TMultiFileEntry): integer; overload;
+    function IndexOf(AName: utf8string; AExtenstion: utf8string; ACaseSensitive: boolean = True): integer; overload; virtual;
+    function IndexOf(AFilename: TEntryFilename; ACaseSensitive: boolean = True): integer; overload;
+    property Count: integer read GetCount;
+    property Entry[AIndex: integer]: TMultiFileEntry read GetEntry;
+    property RawString[AIndex: integer]: RawByteString read GetRawString write SetRawString;
+    property RawStringByFilename[AFilename: string]: RawByteString read GetRawStringByFilename write SetRawStringByFilename;
+  end;
+
+implementation
+
+uses BGRAUTF8, strutils, BGRABitmapTypes;
+
+{ TEntryFilename }
+
+function TEntryFilename.GetFilename: utf8string;
+begin
+  if Extension = '' then
+    result := Name
+  else
+    result := Name+'.'+Extension;
+end;
+
+function TEntryFilename.GetIsEmpty: boolean;
+begin
+  result := (FName='') and (FExtension = '');
+end;
+
+procedure TEntryFilename.SetExtension(AValue: utf8string);
+var
+  i: Integer;
+begin
+  if FExtension=AValue then Exit;
+  for i := 1 to length(AValue) do
+    if AValue[i] in ['.','/'] then
+      raise Exception.Create('Invalid extension');
+  FExtension:=AValue;
+end;
+
+procedure TEntryFilename.SetFilename(AValue: utf8string);
+var
+  idxDot: SizeInt;
+begin
+  idxDot := RPos('.',AValue);
+  if idxDot = 0 then
+  begin
+    Name := AValue;
+    Extension := '';
+  end
+  else
+  begin
+    Name := copy(AValue,1,idxDot-1);
+    Extension := copy(AValue,idxDot+1,length(AValue)-idxDot);
+  end;
+end;
+
+procedure TEntryFilename.SetName(AValue: utf8string);
+var
+  i: Integer;
+begin
+  if FName=AValue then Exit;
+  for i := 1 to length(AValue) do
+    if AValue[i] = '/' then
+      raise Exception.Create('Invalid name');
+  FName:=AValue;
+end;
+
+function EntryFilename(AName, AExtension: string): TEntryFilename;
+begin
+  result.Name := AName;
+  result.Extension:= AExtension;
+end;
+
+function EntryFilename(AFilename: string): TEntryFilename;
+begin
+  result.Filename:= AFilename;
+end;
+
+class operator TEntryFilename.=(const AValue1, AValue2: TEntryFilename): boolean;
+begin
+  result := (AValue1.Name = AValue2.Name) and (AValue1.Extension = AValue2.Extension);
+end;
+
+{ TMultiFileEntry }
+
+function TMultiFileEntry.GetFileSize: int64;
+begin
+  result := 0;
+end;
+
+function TMultiFileEntry.GetExtension: utf8string;
+begin
+  result := '';
+end;
+
+constructor TMultiFileEntry.Create(AContainer: TMultiFileContainer);
+begin
+  FContainer := AContainer;
+end;
+
+function TMultiFileEntry.CopyTo(ADestination: TStream): int64;
+begin
+  result := 0;
+end;
+
+function TMultiFileEntry.GetStream: TStream;
+begin
+  result := nil;
+end;
+
+function TMultiFileEntry.CompareNameAndExtension(AName: utf8string;
+  AExtension: utf8string; ACaseSensitive: boolean): integer;
+begin
+  if ACaseSensitive then
+    result := CompareStr(AName, Name)
+  else
+    result := UTF8CompareText(AName, Name);
+
+  if result = 0 then
+    result := UTF8CompareText(AExtension, Extension);
+end;
+
+{ TMultiFileContainer }
+
+function TMultiFileContainer.GetCount: integer;
+begin
+  if Assigned(FEntries) then
+    result := FEntries.Count
+  else
+    result := 0;
+end;
+
+function TMultiFileContainer.GetEntry(AIndex: integer): TMultiFileEntry;
+begin
+  result := FEntries[AIndex];
+end;
+
+function TMultiFileContainer.GetRawString(AIndex: integer): RawByteString;
+var s: TMemoryStream;
+begin
+  s := TMemoryStream.Create;
+  try
+    Entry[AIndex].CopyTo(s);
+    setlength(result, s.Size);
+    if length(result)>0 then
+      move(s.Memory^, result[1], length(result));
+  finally
+    s.Free;
+  end;
+end;
+
+function TMultiFileContainer.GetRawStringByFilename(AFilename: string
+  ): RawByteString;
+var
+  idx: Integer;
+begin
+  idx := IndexOf(EntryFilename(AFilename));
+  if idx = -1 then
+    result := ''
+  else
+    result := GetRawString(idx);
+end;
+
+procedure TMultiFileContainer.SetRawString(AIndex: integer;
+  AValue: RawByteString);
+begin
+  with Entry[AIndex] do
+    Add(Name, Extension, AValue, true);
+end;
+
+procedure TMultiFileContainer.SetRawStringByFilename(AFilename: string;
+  AValue: RawByteString);
+var
+  f: TEntryFilename;
+begin
+  f := EntryFilename(AFilename);
+  Add(f.Name,f.Extension,AValue,true);
+end;
+
+procedure TMultiFileContainer.Init;
+begin
+  FEntries := TMultiFileEntryList.Create;
+end;
+
+function TMultiFileContainer.AddEntry(AEntry: TMultiFileEntry; AIndex: integer): integer;
+begin
+  if not Assigned(FEntries) then
+    raise exception.Create('Entry list not created');
+  if (AIndex >= 0) and (AIndex < FEntries.Count) then
+  begin
+    FEntries.Insert(AIndex, AEntry);
+    result := AIndex;
+  end
+  else
+    result := FEntries.Add(AEntry);
+end;
+
+constructor TMultiFileContainer.Create;
+begin
+  Init;
+end;
+
+constructor TMultiFileContainer.Create(AFilename: utf8string);
+begin
+  Init;
+  LoadFromFile(AFilename);
+end;
+
+constructor TMultiFileContainer.Create(AStream: TStream);
+begin
+  Init;
+  LoadFromStream(AStream);
+end;
+
+constructor TMultiFileContainer.Create(AStream: TStream; AStartPos: Int64);
+begin
+  Init;
+  AStream.Position := AStartPos;
+  LoadFromStream(AStream);
+end;
+
+procedure TMultiFileContainer.Assign(Source: TPersistent);
+var
+  other: TMultiFileContainer;
+  otherEntry, newEntry: TMultiFileEntry;
+  i: Integer;
+  content: TMemoryStream;
+begin
+  if Source is TMultiFileContainer then
+  begin
+    Clear;
+    other := TMultiFileContainer(Source);
+    for i := 0 to other.Count-1 do
+    begin
+      content := TMemoryStream.Create;
+      otherEntry := other.Entry[i];
+      otherEntry.CopyTo(content);
+      newEntry := CreateEntry(otherEntry.Name, otherEntry.Extension, content);
+      if not Assigned(newEntry) then
+        raise exception.Create('Unable to create entry');
+      AddEntry(newEntry);
+    end;
+  end else
+    inherited Assign(Source);
+end;
+
+function TMultiFileContainer.Add(AName: utf8string; AExtension: utf8string;
+  AContent: TStream; AOverwrite: boolean; AOwnStream: boolean): integer;
+var
+  index: Integer;
+  newEntry: TMultiFileEntry;
+  contentCopy: TMemoryStream;
+begin
+  index := IndexOf(AName,AExtension);
+  if index <> -1 then
+  begin
+    if AOverwrite then
+      Delete(index)
+    else
+      raise Exception.Create('Duplicate entry');
+  end;
+  if not AOwnStream then
+  begin
+    AContent.Position:= 0;
+    contentCopy := TMemoryStream.Create;
+    contentCopy.CopyFrom(AContent, AContent.Size);
+    newEntry := CreateEntry(AName, AExtension, contentCopy);
+  end else
+    newEntry := CreateEntry(AName, AExtension, AContent);
+  if Assigned(newEntry) then
+    result := AddEntry(newEntry, index)
+  else
+    raise exception.Create('Unable to create entry');
+end;
+
+function TMultiFileContainer.Add(AName: utf8string; AExtension: utf8string;
+  AContent: RawByteString; AOverwrite: boolean): integer;
+var stream: TMemoryStream;
+begin
+  stream := TMemoryStream.Create;
+  if length(AContent) > 0 then stream.Write(AContent[1],length(AContent));
+  result := Add(AName,AExtension,stream,AOverwrite);
+end;
+
+function TMultiFileContainer.Add(AFilename: TEntryFilename; AContent: TStream;
+  AOverwrite: boolean; AOwnStream: boolean): integer;
+begin
+  result := Add(AFilename.Name,AFilename.Extension, AContent, AOverwrite, AOwnStream);
+end;
+
+function TMultiFileContainer.Add(AFilename: TEntryFilename;
+  AContent: RawByteString; AOverwrite: boolean): integer;
+begin
+  result := Add(AFilename.Name,AFilename.Extension, AContent, AOverwrite);
+end;
+
+destructor TMultiFileContainer.Destroy;
+begin
+  Clear;
+  FreeAndNil(FEntries);
+  inherited Destroy;
+end;
+
+procedure TMultiFileContainer.LoadFromFile(AFilename: utf8string);
+var stream: TFileStreamUTF8;
+begin
+  stream := TFileStreamUTF8.Create(AFilename, fmOpenRead);
+  LoadFromStream(stream);
+  stream.Free;
+end;
+
+procedure TMultiFileContainer.LoadFromResource(AFilename: string);
+var
+  stream: TStream;
+begin
+  stream := BGRAResource.GetResourceStream(AFilename);
+  try
+    LoadFromStream(stream);
+  finally
+    stream.Free;
+  end;
+end;
+
+procedure TMultiFileContainer.SaveToFile(AFilename: utf8string);
+var stream: TFileStreamUTF8;
+begin
+  stream := TFileStreamUTF8.Create(AFilename, fmCreate);
+  SaveToStream(stream);
+  stream.Free;
+end;
+
+procedure TMultiFileContainer.Remove(AEntry: TMultiFileEntry);
+var
+  index: Integer;
+begin
+  index := IndexOf(AEntry);
+  if index = -1 then
+    raise exception.Create('Entry not found');
+  Delete(index);
+end;
+
+procedure TMultiFileContainer.Delete(AIndex: integer);
+begin
+  if (AIndex >= 0) and (AIndex < Count) then
+  begin
+    Entry[AIndex].Free;
+    FEntries.Delete(AIndex);
+  end else
+    raise ERangeError.Create('Index out of bounds');
+end;
+
+function TMultiFileContainer.Delete(AName: utf8string; AExtension: utf8string;
+  ACaseSensitive: boolean): boolean;
+var
+  index: Integer;
+begin
+  index := IndexOf(AName, AExtension, ACaseSensitive);
+  if index = -1 then
+    result := false
+  else
+  begin
+    Delete(index);
+    result := true;
+  end;
+end;
+
+function TMultiFileContainer.Delete(AFilename: TEntryFilename;
+  ACaseSensitive: boolean): boolean;
+begin
+  result := Delete(AFilename.Name,AFilename.Extension,ACaseSensitive);
+end;
+
+function TMultiFileContainer.IndexOf(AEntry: TMultiFileEntry): integer;
+begin
+  result := FEntries.IndexOf(AEntry);
+end;
+
+function TMultiFileContainer.IndexOf(AName: utf8string; AExtenstion: utf8string; ACaseSensitive: boolean): integer;
+var
+  i: Integer;
+begin
+  for i := 0 to Count-1 do
+    if Entry[i].CompareNameAndExtension(AName, AExtenstion, ACaseSensitive) = 0 then
+      exit(i);
+  result := -1;
+end;
+
+function TMultiFileContainer.IndexOf(AFilename: TEntryFilename;
+  ACaseSensitive: boolean): integer;
+begin
+  result := IndexOf(AFilename.Name,AFilename.Extension,ACaseSensitive);
+end;
+
+procedure TMultiFileContainer.Clear;
+var
+  i: Integer;
+begin
+  for i := 0 to FEntries.Count-1 do
+    FEntries.Items[i].Free;
+  FEntries.Clear;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgranogui.inc

@@ -0,0 +1,80 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{$IFDEF INCLUDE_INTERFACE}
+{$UNDEF INCLUDE_INTERFACE}
+type
+  TColor = type LongInt;
+  {$warnings off}
+  TRawImage = class(TFPMemoryImage)
+    procedure BGRASetSizeAndTransparency(AWidth,AHeight: Integer; {%H-}ATransparent: boolean);
+    constructor Create;
+  end;
+  {$warnings on}
+  TGUICanvas = class(TFPImageCanvas)
+    procedure DrawImage(x,y: integer; AImage: TFPCustomImage);
+  end;
+
+const
+  clNone    = TColor($1FFFFFFF);
+  clDefault = TColor($20000000);
+  clBlack   = TColor($000000);
+  clMaroon  = TColor($000080);
+  clGreen   = TColor($008000);
+  clOlive   = TColor($008080);
+  clNavy    = TColor($800000);
+  clPurple  = TColor($800080);
+  clTeal    = TColor($808000);
+  clGray    = TColor($808080);
+  clSilver  = TColor($C0C0C0);
+  clRed     = TColor($0000FF);
+  clLime    = TColor($00FF00);
+  clYellow  = TColor($00FFFF);
+  clBlue    = TColor($FF0000);
+  clFuchsia = TColor($FF00FF);
+  clAqua    = TColor($FFFF00);
+  clLtGray  = TColor($C0C0C0); // clSilver alias
+  clDkGray  = TColor($808080); // clGray alias
+  clWhite   = TColor($FFFFFF);
+
+  clRgbBtnHighlight = TColor($E0E0E0);
+  clRgbBtnShadow = TColor($808080);
+
+function ColorToRGB(c: TColor): TColor; inline;
+
+function GetScreenDPIX: integer;
+function GetScreenDPIY: integer;
+
+{$ENDIF}
+
+{$IFDEF INCLUDE_IMPLEMENTATION}
+{$UNDEF INCLUDE_IMPLEMENTATION}
+procedure TRawImage.BGRASetSizeAndTransparency(AWidth,AHeight: Integer; ATransparent: boolean);
+begin
+  SetSize(AWidth,AHeight);
+end;
+
+constructor TRawImage.Create;
+begin
+  inherited Create(0,0);
+end;
+
+procedure TGUICanvas.DrawImage(x,y: integer; AImage: TFPCustomImage);
+begin
+  Draw(x,y, AImage);
+end;
+
+function ColorToRGB(c: TColor): TColor; inline;
+begin
+  result := c;
+end;
+
+function GetScreenDPIX: integer;
+begin
+  result := 96;
+end;
+
+function GetScreenDPIY: integer;
+begin
+  result := 96;
+end;
+
+{$ENDIF}

vendor/kam_remake/src/ext/BGRABitmap/bgranogui_uses.inc

@@ -0,0 +1 @@
+uses BGRAClasses, FPImage, FPCanvas, FPImgCanv;

vendor/kam_remake/src/ext/BGRABitmap/bgranoguibitmap.pas

@@ -0,0 +1,163 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRANoGUIBitmap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, BGRAClasses, BGRAGraphics, BGRABitmapTypes, BGRADefaultBitmap,
+  BGRAFreeType, EasyLazFreeType, LazFreeTypeFontCollection,
+  BGRACanvas;
+
+type
+
+  { TBGRANoGUIBitmap }
+
+  TBGRANoGUIBitmap = class(TBGRADefaultBitmap)
+  private
+    FPseudoCanvas: TBGRACanvas;
+    function GetPseudoCanvas: TBGRACanvas;
+  protected
+    procedure RebuildBitmap; override;
+    function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override;
+    function LoadFromRawImage({%H-}ARawImage: TRawImage; {%H-}DefaultOpacity: byte;
+      {%H-}AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean
+      =True): boolean; override;
+    procedure Init; override;
+    procedure FreeBitmap; override;
+    procedure NotAvailable;
+  public
+    destructor Destroy; override;
+    class procedure AddFreeTypeFontFolder(ADirectory: string; AUTF8: boolean = false); static;
+    class procedure AddFreeTypeFontFile(AFilename: string; AUTF8: boolean = false); static;
+    procedure Draw(ACanvas: TCanvas; x, y: integer; {%H-}Opaque: boolean=True); override;
+    procedure Draw(ACanvas: TCanvas; Rect: TRect; {%H-}Opaque: boolean=True); override;
+    procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //not available
+    procedure DataDrawTransparent({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer;
+      {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override;
+    procedure DataDrawOpaque({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer;
+      {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override;
+    procedure TakeScreenshot({%H-}ARect: TRect); override; //not available
+    procedure TakeScreenshotOfPrimaryMonitor; override; //not available
+    procedure LoadFromDevice({%H-}DC: HDC); override; //not available
+    procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override; //not available
+    property Canvas: TBGRACanvas read GetPseudoCanvas;
+  end;
+
+implementation
+
+{ TBGRANoGUIBitmap }
+
+function TBGRANoGUIBitmap.GetPseudoCanvas: TBGRACanvas;
+begin
+  if FPseudoCanvas = nil then
+  begin
+    FPseudoCanvas := TBGRACanvas.Create(self);
+    FPseudoCanvas.AntialiasingMode := amOff;
+  end;
+  result := FPseudoCanvas;
+end;
+
+procedure TBGRANoGUIBitmap.RebuildBitmap;
+begin
+  //nothing
+end;
+
+function TBGRANoGUIBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer;
+begin
+  result := TBGRAFreeTypeFontRenderer.Create;
+end;
+
+function TBGRANoGUIBitmap.LoadFromRawImage(ARawImage: TRawImage;
+  DefaultOpacity: byte; AlwaysReplaceAlpha: boolean;
+  RaiseErrorOnInvalidPixelFormat: boolean): boolean;
+begin
+  NotAvailable;
+  result := false;
+end;
+
+procedure TBGRANoGUIBitmap.Init;
+begin
+  inherited Init;
+  FontAntialias:= true;
+end;
+
+procedure TBGRANoGUIBitmap.FreeBitmap;
+begin
+  //nothing
+end;
+
+procedure TBGRANoGUIBitmap.NotAvailable;
+begin
+  raise exception.Create('Function not available without GUI');
+end;
+
+destructor TBGRANoGUIBitmap.Destroy;
+begin
+  FreeAndNil(FPseudoCanvas);
+  inherited Destroy;
+end;
+
+class procedure TBGRANoGUIBitmap.AddFreeTypeFontFolder(ADirectory: string; AUTF8: boolean);
+begin
+  if AUTF8 then ADirectory:= Utf8ToAnsi(ADirectory);
+  EasyLazFreeType.FontCollection.AddFolder(ADirectory);
+end;
+
+class procedure TBGRANoGUIBitmap.AddFreeTypeFontFile(AFilename: string; AUTF8: boolean);
+begin
+  if AUTF8 then AFilename:= Utf8ToAnsi(AFilename);
+  EasyLazFreeType.FontCollection.AddFile(AFilename);
+end;
+
+procedure TBGRANoGUIBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean);
+begin
+  ACanvas.GUICanvas.Draw(x,y,self);
+end;
+
+procedure TBGRANoGUIBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean);
+begin
+  ACanvas.GUICanvas.StretchDraw(Rect.Left,Rect.Top,Rect.Right-Rect.Left,Rect.Bottom-Rect.Top,self);
+end;
+
+procedure TBGRANoGUIBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x,
+  y: integer);
+begin
+  NotAvailable;
+end;
+
+procedure TBGRANoGUIBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+begin
+  NotAvailable;
+end;
+
+procedure TBGRANoGUIBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+begin
+  NotAvailable;
+end;
+
+procedure TBGRANoGUIBitmap.TakeScreenshot(ARect: TRect);
+begin
+  NotAvailable;
+end;
+
+procedure TBGRANoGUIBitmap.TakeScreenshotOfPrimaryMonitor;
+begin
+  NotAvailable;
+end;
+
+procedure TBGRANoGUIBitmap.LoadFromDevice(DC: HDC);
+begin
+  NotAvailable;
+end;
+
+procedure TBGRANoGUIBitmap.LoadFromDevice(DC: HDC; ARect: TRect);
+begin
+  NotAvailable;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrapaintnet.pas

@@ -0,0 +1,660 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAPaintNet;
+
+{$mode objfpc}{$H+}
+
+interface
+
+{ This unit reads Paint.NET files. It needs BGRADNetDeserial to deserialize binary .Net objects.
+
+  A Paint.NET image consists in three parts :
+  - Xml header
+  - Binary serialized information (contains layer information)
+  - Compressed data (pixel data)
+
+  The class TPaintDotNetFile do not read the Xml header. ComputeFlatImage builds the resulting image
+  by using blending operations to merge layers.
+
+  The unit registers a TFPCustomImageReader so that it can be read by any image reading function of FreePascal,
+  and also registers a reader for BGRALayers }
+
+uses
+  BGRAClasses, SysUtils, BGRADNetDeserial, FPImage, BGRABitmapTypes, BGRABitmap, BGRALayers;
+
+type
+
+  { TPaintDotNetFile }
+
+  TPaintDotNetFile = class(TBGRACustomLayeredBitmap)
+  public
+    procedure LoadFromFile(const filenameUTF8: string); override;
+    procedure LoadFromStream(stream: TStream); override;
+    procedure Clear; override;
+    function ToString: ansistring; override;
+    function GetLayerBitmapCopy(layer: integer): TBGRABitmap; override;
+    constructor Create; override;
+  protected
+    procedure InternalLoadFromStream(stream: TStream);
+    function GetWidth: integer; override;
+    function GetHeight: integer; override;
+    function GetNbLayers: integer; override;
+    function GetBlendOperation(Layer: integer): TBlendOperation; override;
+    function GetLayerVisible(layer: integer): boolean; override;
+    function GetLayerOpacity(layer: integer): byte; override;
+    function GetLayerName(layer: integer): string; override;
+  private
+    Content:   TDotNetDeserialization;
+    Document:  TSerializedClass;
+    Layers:    TSerializedClass;
+    LayerData: array of TMemoryStream;
+    function InternalGetLayer(num: integer): TSerializedClass;
+    function InternalGetBlendOperation(layer: TSerializedClass): TBlendOperation;
+    function InternalGetLayerName(layer: TSerializedClass): string;
+    function InternalGetLayerVisible(layer: TSerializedClass): boolean;
+    function InternalGetLayerOpacity(layer: TSerializedClass): byte;
+    function LayerDataSize(numLayer: integer): int64;
+    procedure LoadLayer(dest: TMemoryStream; src: TStream; uncompressedSize: int64);
+  end;
+
+  { TFPReaderPaintDotNet }
+
+  TFPReaderPaintDotNet = class(TFPCustomImageReader)
+    private
+      FWidth,FHeight,FNbLayers: integer;
+    protected
+      function InternalCheck(Stream: TStream): boolean; override;
+      procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
+    public
+      property Width: integer read FWidth;
+      property Height: integer read FHeight;
+      property NbLayers: integer read FNbLayers;
+  end;
+
+function IsPaintDotNetFile(filename: string): boolean;
+function IsPaintDotNetFileUTF8(filenameUTF8: string): boolean;
+function IsPaintDotNetStream(stream: TStream): boolean;
+function LoadPaintDotNetFile(filename: string): TBGRABitmap;
+function LoadPaintDotNetFileUTF8(filenameUTF8: string): TBGRABitmap;
+
+procedure RegisterPaintNetFormat;
+
+implementation
+
+uses zstream, Math, BGRAUTF8;
+
+{$hints off}
+function BEReadLongword(Stream: TStream): LongWord;
+begin
+  Stream.Read(Result, sizeof(Result));
+  Result := BEtoN(Result);
+end;
+
+{$hints on}
+
+{$hints off}
+function BEReadLongint(Stream: TStream): longint;
+begin
+  Stream.Read(Result, sizeof(Result));
+  Result := BEtoN(Result);
+end;
+
+function IsPaintDotNetFile(filename: string): boolean;
+var
+  stream: TFileStreamUTF8;
+begin
+  Result := False;
+  if FileExists(filename) then
+  begin
+    stream := TFileStreamUTF8.Create(SysToUTF8(filename), fmOpenRead);
+    Result := IsPaintDotNetStream(stream);
+    stream.Free;
+  end;
+end;
+
+function IsPaintDotNetFileUTF8(filenameUTF8: string): boolean;
+var
+  stream: TFileStreamUTF8;
+begin
+  Result := False;
+  if FileExistsUTF8(filenameUTF8) then
+  begin
+    stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead);
+    Result := IsPaintDotNetStream(stream);
+    stream.Free;
+  end;
+end;
+
+function IsPaintDotNetStream(stream: TStream): boolean;
+var
+  header:  packed array[0..3] of char;
+  SavePos: int64;
+begin
+  Result := False;
+  try
+    if stream.Position + 4 < Stream.Size then
+    begin
+      header  := #0#0#0#0;
+      SavePos := stream.Position;
+      stream.Read(header, 4);
+      stream.Position := SavePos;
+      if (header[0] = 'P') and (header[1] = 'D') and (header[2] = 'N') and
+        (header[3] = '3') then
+        Result := True;
+    end;
+  except
+    on ex: Exception do ;
+  end;
+end;
+
+function LoadPaintDotNetFile(filename: string): TBGRABitmap;
+begin
+  result := LoadPaintDotNetFileUTF8(SysToUTF8(filename));
+end;
+
+function LoadPaintDotNetFileUTF8(filenameUTF8: string): TBGRABitmap;
+var
+  pdn: TPaintDotNetFile;
+begin
+  pdn    := TPaintDotNetFile.Create;
+  Result := nil;
+  try
+    pdn.LoadFromFile(filenameUTF8);
+    Result := pdn.ComputeFlatImage;
+    pdn.Free;
+  except
+    on ex: Exception do
+    begin
+      FreeAndNil(Result);
+      pdn.Free;
+      raise Exception.Create('Error while loading Paint.NET file. ' + ex.Message);
+    end;
+  end;
+end;
+
+function LoadPaintDotNetStream(stream: TStream): TBGRABitmap;
+var
+  pdn: TPaintDotNetFile;
+begin
+  pdn    := TPaintDotNetFile.Create;
+  Result := nil;
+  try
+    pdn.LoadFromStream(stream);
+    Result := pdn.ComputeFlatImage;
+    pdn.Free;
+  except
+    on ex: Exception do
+    begin
+      FreeAndNil(Result);
+      pdn.Free;
+      raise Exception.Create('Error while loading Paint.NET stream. ' + ex.Message);
+    end;
+  end;
+end;
+
+{$hints on}
+
+{ TFPReaderPaintDotNet }
+
+function TFPReaderPaintDotNet.InternalCheck(Stream: TStream): boolean;
+begin
+  result := IsPaintDotNetStream(stream);
+end;
+
+procedure TFPReaderPaintDotNet.InternalRead(Stream: TStream; Img: TFPCustomImage);
+var
+  pdn: TPaintDotNetFile;
+  flat: TBGRABitmap;
+  x,y: integer;
+begin
+  FWidth := 0;
+  FHeight:= 0;
+  FNbLayers:= 0;
+  pdn    := TPaintDotNetFile.Create;
+  try
+    pdn.LoadFromStream(Stream);
+    flat := pdn.ComputeFlatImage;
+    try
+      FWidth:= pdn.Width;
+      FHeight:= pdn.Height;
+      FNbLayers:= pdn.NbLayers;
+
+      if Img is TBGRACustomBitmap then
+        TBGRACustomBitmap(Img).Assign(flat) else
+      begin
+        Img.SetSize(pdn.Width,pdn.Height);
+        for y := 0 to pdn.Height-1 do
+          for x := 0 to pdn.Width-1 do
+            Img.Colors[x,y] := BGRAToFPColor(flat.GetPixel(x,y));
+      end;
+    finally
+      flat.free;
+    end;
+    pdn.Free;
+  except
+    on ex: Exception do
+    begin
+      pdn.Free;
+      raise Exception.Create('Error while loading Paint.NET file. ' + ex.Message);
+    end;
+  end;
+end;
+
+{ TPaintDotNetFile }
+
+procedure TPaintDotNetFile.LoadFromFile(const filenameUTF8: string);
+var
+  stream: TFileStreamUTF8;
+begin
+  stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead);
+  OnLayeredBitmapLoadStart(filenameUTF8);
+  try
+    InternalLoadFromStream(stream);
+  finally
+    OnLayeredBitmapLoaded;
+    stream.Free;
+  end;
+end;
+
+procedure TPaintDotNetFile.LoadFromStream(stream: TStream);
+begin
+  OnLayeredBitmapLoadFromStreamStart;
+  try
+    InternalLoadFromStream(stream);
+  finally
+    OnLayeredBitmapLoaded;
+  end;
+end;
+
+procedure TPaintDotNetFile.InternalLoadFromStream(stream: TStream);
+var
+  header: packed array[0..3] of char;
+  XmlHeaderSize: integer;
+  CompressionFormat: word;
+  i:      integer;
+begin
+  Clear;
+  header := #0#0#0#0;
+  stream.Read(header, 4);
+  if (header[0] <> 'P') or (header[1] <> 'D') or (header[2] <> 'N') or
+    (header[3] <> '3') then
+    raise Exception.Create('Invalid header');
+  XmlHeaderSize := 0;
+  stream.Read(XmlHeaderSize, 3);
+  XmlheaderSize := LEtoN(XmlheaderSize);
+  if Stream.Position + XmlHeaderSize > stream.Size then
+    raise Exception.Create('Xml header size error');
+  Stream.Position:= Stream.Position + XmlHeaderSize;
+     {$hints off}
+  stream.ReadBuffer(CompressionFormat, sizeof(CompressionFormat));
+     {$hints on}
+  CompressionFormat := LEToN(CompressionFormat);
+  Content := TDotNetDeserialization.Create;
+  case Compressionformat of
+    $0100: Content.LoadFromStream(Stream);
+    $8b1f: raise Exception.Create('Serialized data decompression not handled');
+    else
+      raise Exception.Create('Unknown compression format (' +
+        IntToStr(Compressionformat) + ')');
+  end;
+  Document := Content.FindClass('Document');
+  if Document <> nil then
+    Layers := Content.GetObjectField(Document, 'layers') as TSerializedClass;
+  SetLength(LayerData, NbLayers);
+  for i := 0 to NbLayers - 1 do
+  begin
+    OnLayeredBitmapLoadProgress((i+1)*100 div NbLayers);
+    LayerData[i] := TMemoryStream.Create;
+    LoadLayer(LayerData[i], Stream, LayerDataSize(i));
+  end;
+  OnLayeredBitmapLoadProgress(100);
+end;
+
+function TPaintDotNetFile.ToString: ansistring;
+var
+  i, j, nbbytes: integer;
+  b: byte;
+begin
+  Result := 'Paint.Net document' + LineEnding + LineEnding;
+  AppendStr(Result, Content.ToString);
+  for i := 0 to NbLayers - 1 do
+  begin
+    AppendStr(Result, LineEnding + 'Layer ' + IntToStr(i) + ' : ' + LayerName[i] + LineEnding);
+    AppendStr(Result, '[ ');
+    LayerData[i].Position := 0;
+    if LayerData[i].Size > 256 then
+      nbbytes := 256
+    else
+      nbbytes := LayerData[i].Size;
+    for j := 0 to nbbytes - 1 do
+    begin
+        {$hints off}
+      LayerData[i].ReadBuffer(b, 1);
+        {$hints on}
+      AppendStr(Result, IntToHex(b, 2) + ' ');
+    end;
+    if LayerData[i].Size > nbbytes then
+      AppendStr(Result, '...');
+    AppendStr(Result, ']' + lineending);
+  end;
+end;
+
+constructor TPaintDotNetFile.Create;
+begin
+  inherited Create;
+  Content   := nil;
+  Document  := nil;
+  Layers    := nil;
+  LinearBlend := True;
+  RegisterPaintNetFormat;
+end;
+
+procedure TPaintDotNetFile.Clear;
+var
+  i: integer;
+begin
+  FreeAndNil(content);
+  document := nil;
+  Layers   := nil;
+  for i := 0 to high(LayerData) do
+    LayerData[i].Free;
+  setLength(LayerData, 0);
+end;
+
+function TPaintDotNetFile.GetWidth: integer;
+begin
+  if Document = nil then
+    Result := 0
+  else
+    Result := StrToInt(Content.GetSimpleField(Document, 'width'));
+end;
+
+function TPaintDotNetFile.GetHeight: integer;
+begin
+  if Document = nil then
+    Result := 0
+  else
+    Result := StrToInt(Content.GetSimpleField(Document, 'height'));
+end;
+
+function TPaintDotNetFile.GetNbLayers: integer;
+begin
+  if Layers = nil then
+    Result := 0
+  else
+    Result := StrToInt(Content.GetSimpleField(Layers, '_size'));
+end;
+
+function TPaintDotNetFile.GetBlendOperation(Layer: integer): TBlendOperation;
+begin
+  Result := InternalGetBlendOperation(InternalGetLayer(layer));
+end;
+
+function TPaintDotNetFile.GetLayerVisible(layer: integer): boolean;
+begin
+  Result := InternalGetLayerVisible(InternalGetLayer(layer));
+end;
+
+function TPaintDotNetFile.GetLayerOpacity(layer: integer): byte;
+begin
+  Result := InternalGetLayerOpacity(InternalGetLayer(layer));
+end;
+
+function TPaintDotNetFile.GetLayerName(layer: integer): string;
+begin
+  Result := InternalGetLayerName(InternalGetLayer(layer));
+end;
+
+function TPaintDotNetFile.GetLayerBitmapCopy(layer: integer): TBGRABitmap;
+begin
+  if (layer < 0) or (layer >= NbLayers) then
+    raise Exception.Create('Index out of bounds');
+
+  Result := TBGRABitmap.Create(Width, Height);
+  if int64(Result.NbPixels) * 4 <> LayerData[layer].Size then
+  begin
+    Result.Free;
+    raise Exception.Create('Inconsistent layer data size');
+  end
+  else
+  begin
+    layerData[layer].Position := 0;
+    layerData[layer].Read(Result.Data^, LayerData[layer].Size);
+    if TBGRAPixel_RGBAOrder then result.SwapRedBlue;
+    Result.InvalidateBitmap;
+
+    if Result.LineOrder = riloBottomToTop then
+      Result.VerticalFlip;
+  end;
+end;
+
+function TPaintDotNetFile.InternalGetLayerName(layer: TSerializedClass): string;
+var
+  prop: TCustomSerializedObject;
+begin
+  if layer = nil then
+    Result := ''
+  else
+  begin
+    prop := Content.GetObjectField(layer, 'Layer+properties');
+    if prop = nil then
+      Result := ''
+    else
+    begin
+      Result := Content.GetSimpleField(prop, 'name');
+    end;
+  end;
+end;
+
+function TPaintDotNetFile.LayerDataSize(numLayer: integer): int64;
+var
+  layer, surface, scan0: TCustomSerializedObject;
+begin
+  layer := InternalGetLayer(numLayer);
+  if layer = nil then
+    Result := 0
+  else
+  begin
+    surface := Content.GetObjectField(layer, 'surface');
+    if surface = nil then
+      Result := 0
+    else
+    begin
+      scan0  := Content.GetObjectField(surface, 'scan0');
+      Result := StrToInt64(Content.GetSimpleField(scan0, 'length64'));
+    end;
+  end;
+end;
+
+procedure TPaintDotNetFile.LoadLayer(dest: TMemoryStream; src: TStream;
+  uncompressedSize: int64);
+var
+  CompressionFlag: byte;
+  maxChunkSize, decompressedChunkSize, compressedChunkSize: LongWord;
+  chunks:   array of TMemoryStream;
+  numChunk: integer;
+  chunkCount, i: integer;
+  decomp:   Tdecompressionstream;
+  nextPos:  int64;
+
+begin
+  {$hints off}
+  src.ReadBuffer(CompressionFlag, 1);
+  {$hints on}
+  if CompressionFlag = 1 then
+    dest.CopyFrom(src, uncompressedSize)
+  else
+  if CompressionFlag = 0 then
+  begin
+    maxChunkSize := BEReadLongword(src);
+    if maxChunkSize < 4 then
+      raise Exception.Create('Invalid max chunk size');
+    chunkCount := (uncompressedSize + maxChunkSize - 1) div maxChunkSize;
+    setlength(chunks, chunkCount);
+    for i := 0 to ChunkCount - 1 do
+    begin
+      numChunk := BEReadLongint(src);
+      if (numChunk < 0) or (numChunk >= chunkCount) then
+        raise Exception.Create('Chunk number out of bounds');
+      compressedChunkSize := BEReadLongword(src);
+      nextPos := src.Position + compressedChunkSize;
+      src.Position := src.Position + 10; //skip gzip header
+      decompressedChunkSize :=
+        min(maxChunkSize, uncompressedSize - int64(numChunk) * int64(maxChunkSize));
+      decomp := Tdecompressionstream.Create(src, True);
+      chunks[numChunk] := TMemoryStream.Create;
+      chunks[numChunk].CopyFrom(decomp, decompressedChunkSize);
+      FreeAndNil(decomp);
+      src.Position := nextPos;
+    end;
+    for i := 0 to ChunkCount - 1 do
+    begin
+      chunks[i].Position := 0;
+      dest.CopyFrom(chunks[i], chunks[i].size);
+      chunks[i].Free;
+    end;
+    setlength(chunks, 0);
+  end
+  else
+    raise Exception('Unknown compression flag (' + IntToStr(CompressionFlag) + ')');
+end;
+
+function TPaintDotNetFile.InternalGetLayer(num: integer): TSerializedClass;
+var
+  layerList: TCustomSerializedObject;
+begin
+  if Layers = nil then
+    raise Exception.Create('No layers available')
+  else
+  if (num < 0) or (num >= NbLayers) then
+    raise Exception.Create('Layer index out of bounds')
+  else
+  begin
+    layerList := Content.GetObjectField(Layers, '_items');
+    Result    := Content.GetObject(layerList.FieldAsString[num]) as TSerializedClass;
+  end;
+end;
+
+function TPaintDotNetFile.InternalGetBlendOperation(layer: TSerializedClass): TBlendOperation;
+var
+  prop, blendOp: TCustomSerializedObject;
+  blendName:     string;
+begin
+  if layer = nil then
+    Result := boTransparent
+  else
+  begin
+    prop := Content.GetObjectField(layer, 'properties');
+    if prop = nil then
+      Result := boTransparent
+    else
+    begin
+      blendOp := Content.GetObjectField(prop, 'blendOp');
+      if blendOp = nil then
+        Result := boTransparent
+      else
+      begin
+        blendName := blendOp.TypeAsString;
+        if (pos('+', blendName) <> 0) then
+          Delete(blendName, 1, pos('+', blendName));
+        if copy(blendName, length(blendName) - length('BlendOp') +
+          1, length('BlendOp')) = 'BlendOp' then
+          Delete(blendName, length(blendName) - length('BlendOp') +
+            1, length('BlendOp'));
+
+        if blendName = 'Normal' then
+          Result := boTransparent
+        else
+        if blendName = 'Multiply' then
+          Result := boLinearMultiply
+        else
+        if blendName = 'Additive' then
+          Result := boLinearAdd
+        else
+        if blendName = 'ColorBurn' then
+          Result := boColorBurn
+        else
+        if blendName = 'ColorDodge' then
+          Result := boColorDodge
+        else
+        if blendName = 'Reflect' then
+          Result := boReflect
+        else
+        if blendName = 'Glow' then
+          Result := boGlow
+        else
+        if blendName = 'Overlay' then
+          Result := boOverlay
+        else
+        if blendName = 'Difference' then
+          Result := boLinearDifference
+        else
+        if blendName = 'Negation' then
+          Result := boLinearNegation
+        else
+        if blendName = 'Lighten' then
+          Result := boLighten
+        else
+        if blendName = 'Darken' then
+          Result := boDarken
+        else
+        if blendName = 'Screen' then
+          Result := boScreen
+        else
+        if blendName = 'Xor' then
+          Result := boXor
+        else
+          Result := boTransparent;
+      end;
+    end;
+  end;
+end;
+
+function TPaintDotNetFile.InternalGetLayerVisible(layer: TSerializedClass): boolean;
+var
+  prop: TCustomSerializedObject;
+begin
+  if layer = nil then
+    Result := False
+  else
+  begin
+    prop := Content.GetObjectField(layer, 'Layer+properties');
+    if prop = nil then
+      Result := False
+    else
+    begin
+      Result := (Content.GetSimpleField(prop, 'visible') = 'True');
+    end;
+  end;
+end;
+
+function TPaintDotNetFile.InternalGetLayerOpacity(layer: TSerializedClass): byte;
+var
+  prop: TCustomSerializedObject;
+begin
+  if layer = nil then
+    Result := 0
+  else
+  begin
+    prop := Content.GetObjectField(layer, 'Layer+properties');
+    if prop = nil then
+      Result := 0
+    else
+    begin
+      Result := StrToInt(Content.GetSimpleField(prop, 'opacity'));
+    end;
+  end;
+end;
+
+var AlreadyRegistered: boolean;
+
+procedure RegisterPaintNetFormat;
+begin
+  if AlreadyRegistered then exit;
+  ImageHandlers.RegisterImageReader ('Paint.NET image', 'pdn', TFPReaderPaintDotNet);
+  RegisterLayeredBitmapReader('pdn', TPaintDotNetFile);
+  //TPicture.RegisterFileFormat('pdn', 'Paint.NET image', TPaintDotNetFile);
+  DefaultBGRAImageReader[ifPaintDotNet] := TFPReaderPaintDotNet;
+  AlreadyRegistered := true;
+end;
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgraphongtypes.pas

@@ -0,0 +1,85 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAPhongTypes;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRABitmapTypes;
+
+type
+
+{ TCustomPhongShading }
+
+ TCustomPhongShading = class
+   protected
+     FLightPosition3D: TPoint3D;
+     function GetLightPosition: TPoint;
+     procedure SetLightPosition(AValue: TPoint);
+     function GetLightPositionF: TPointF;
+     procedure SetLightPositionF(AValue: TPointF);
+     function GetLightPositionZ: integer;
+     procedure SetLightPositionZ(AValue: integer);
+
+   public
+
+   { Render the specified map on the destination bitmap with one solid color. Map altitude
+     indicate the global height of the map. }
+   procedure Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer;
+                  Color : TBGRAPixel);  overload; virtual; abstract;
+
+   { Render with a color map of the same size as the height map. Map altitude
+     indicate the global height of the map. }
+   procedure Draw(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer;
+                  ColorMap : TBGRACustomBitmap);  overload; virtual; abstract;
+
+   { Render with a scanner. Map altitude
+     indicate the global height of the map. }
+   procedure DrawScan(dest: TBGRACustomBitmap; map: TBGRACustomBitmap; mapAltitude: single; ofsX,ofsY: integer;
+                  ColorScan : IBGRAScanner); virtual; abstract;
+
+   property LightPosition: TPoint read GetLightPosition write SetLightPosition;
+   property LightPositionZ: integer read GetLightPositionZ write SetLightPositionZ;
+   property LightPositionF: TPointF read GetLightPositionF write SetLightPositionF;
+   property LightPosition3D: TPoint3D read FLightPosition3D write FLightPosition3D;
+ end;
+
+implementation
+
+{ TCustomPhongShading }
+
+function TCustomPhongShading.GetLightPositionF: TPointF;
+begin
+  result := PointF(FLightPosition3D.X,FLightPosition3D.Y);
+end;
+
+procedure TCustomPhongShading.SetLightPositionF(AValue: TPointF);
+begin
+  FLightPosition3D.X := AValue.X;
+  FLightPosition3D.Y := AValue.Y;
+end;
+
+function TCustomPhongShading.GetLightPosition: TPoint;
+begin
+  result := Point(round(FLightPosition3D.X),round(FLightPosition3D.Y));
+end;
+
+procedure TCustomPhongShading.SetLightPosition(AValue: TPoint);
+begin
+  FLightPosition3D.X := AValue.X;
+  FLightPosition3D.Y := AValue.Y;
+end;
+
+function TCustomPhongShading.GetLightPositionZ: integer;
+begin
+  result := round(FLightPosition3D.Z);
+end;
+
+procedure TCustomPhongShading.SetLightPositionZ(AValue: integer);
+begin
+  FLightPosition3D.Z := AValue;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgraphoxo.pas

@@ -0,0 +1,602 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAPhoxo;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRABitmapTypes, FPImage, BGRALayers, BGRABitmap, BGRAClasses, SysUtils, BMPcomn;
+
+const
+  PhoxoHeaderMagic : packed array[1..4] of char = 'oXo ';
+  PhoxoBlock_CanvasSize = 1;
+  PhoxoBlock_Layer = 2;
+  PhoxoBlock_TextLayer = 3;
+  PhoxoBlock_DPI = 4;
+  PhoxoBlock_LayerCaption = 5;
+  PhoxoBlock_LazPaintBlendMode = 128;
+  PhoxoBlock_EndOfFile = 255;
+
+type
+  TPhoxoHeader = packed record
+    magic: packed array[1..4] of char;
+    version: LongWord;
+  end;
+
+  TPhoxoBlockHeader = packed record
+    blockType : LongWord;
+    blockSize : LongWord;
+  end;
+
+  TPhoxoLayerHeader = packed record
+    layerVisible: LongWord;
+    layerLimited: LongWord;
+    opacityPercent: LongWord;
+    bmpHeader: TBitMapInfoHeader;
+    redMask,greenMask,blueMask: LongWord;
+  end;
+
+  { TBGRAPhoxoDocument }
+
+  TBGRAPhoxoDocument = class(TBGRALayeredBitmap)
+  private
+    FDPIX,FDPIY: integer;
+  protected
+    function GetMimeType: string; override;
+    procedure AddLayerFromPhoxoData(const ABlockHeader: TPhoxoBlockHeader; ABlockData: PByte);
+    procedure InternalLoadFromStream(AStream: TStream);
+    procedure InternalSaveToStream(AStream: TStream);
+  public
+    constructor Create; overload; override;
+    constructor Create(AWidth, AHeight: integer); overload; override;
+    procedure LoadFromStream(AStream: TStream); override;
+    procedure LoadFromFile(const filenameUTF8: string); override;
+    procedure SaveToStream(AStream: TStream); override;
+    procedure SaveToFile(const filenameUTF8: string); override;
+    class function CheckFormat(Stream: TStream; ARestorePosition: boolean): boolean; static;
+    class function ReadBlock(Stream: TStream; out AHeader: TPhoxoBlockHeader; out ABlockData: PByte): boolean; static;
+    property DPIX: integer read FDPIX;
+    property DPIY: integer read FDPIY;
+  end;
+
+  { TBGRAReaderOXO }
+
+  TBGRAReaderOXO = class(TFPCustomImageReader)
+  private
+    FWidth,FHeight,FNbLayers: integer;
+    FDPIX,FDPIY: integer;
+  protected
+    function InternalCheck(Stream: TStream): boolean; override;
+    procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
+  public
+    property Width: integer read FWidth;
+    property Height: integer read FHeight;
+    property NbLayers: integer read FNbLayers;
+    property DPIX: integer read FDPIX;
+    property DPIY: integer read FDPIY;
+  end;
+
+  { TBGRAWriterOXO }
+
+  TBGRAWriterOXO = class(TFPCustomImageWriter)
+    protected
+      procedure InternalWrite (Str:TStream; Img:TFPCustomImage); override;
+  end;
+
+procedure RegisterPhoxoFormat;
+
+implementation
+
+uses BGRAUTF8;
+
+var AlreadyRegistered: boolean;
+
+function ComputeRowStride(AWidth,ABitsPerPixel: Longword): Longword;
+begin
+  result := ((AWidth * ABitsPerPixel + 31) div 32)*4;
+end;
+
+procedure SwapLayerHeaderIfNeeded(var ALayerHeader: TPhoxoLayerHeader);
+begin
+  with ALayerHeader do
+  begin
+    layerVisible := LEtoN(layerVisible);
+    layerLimited := LEtoN(layerLimited);
+    opacityPercent := LEtoN(opacityPercent);
+    {$IFNDEF ENDIAN_LITTLE}SwapBMPInfoHeader(bmpHeader);{$ENDIF}
+  end;
+end;
+
+procedure RegisterPhoxoFormat;
+begin
+  if AlreadyRegistered then exit;
+  ImageHandlers.RegisterImageReader ('PhoXo', 'oXo', TBGRAReaderOXO);
+  RegisterLayeredBitmapReader('oXo', TBGRAPhoxoDocument);
+  RegisterLayeredBitmapWriter('oXo', TBGRAPhoxoDocument);
+  DefaultBGRAImageReader[ifPhoxo] := TBGRAReaderOXO;
+  DefaultBGRAImageWriter[ifPhoxo] := TBGRAWriterOXO;
+  AlreadyRegistered:= True;
+end;
+
+{ TBGRAWriterOXO }
+
+procedure TBGRAWriterOXO.InternalWrite(Str: TStream; Img: TFPCustomImage);
+var doc: TBGRAPhoxoDocument;
+  tempBmp: TBGRABitmap;
+  x,y: integer;
+begin
+  doc := TBGRAPhoxoDocument.Create;
+  if Img is TBGRABitmap then doc.AddLayer(Img as TBGRABitmap) else
+  begin
+    tempBmp := TBGRABitmap.Create(img.Width,img.Height);
+    for y := 0 to Img.Height-1 do
+      for x := 0 to img.Width-1 do
+        tempBmp.SetPixel(x,y, FPColorToBGRA(img.Colors[x,y]));
+    doc.AddOwnedLayer(tempBmp);
+  end;
+  doc.SaveToStream(Str);
+  doc.Free;
+end;
+
+{ TBGRAReaderOXO }
+
+function TBGRAReaderOXO.InternalCheck(Stream: TStream): boolean;
+begin
+  result := TBGRAPhoxoDocument.CheckFormat(Stream,True);
+end;
+
+procedure TBGRAReaderOXO.InternalRead(Stream: TStream; Img: TFPCustomImage);
+var layeredImage: TBGRAPhoxoDocument;
+  flat: TBGRABitmap;
+  x,y: integer;
+begin
+  FWidth := 0;
+  FHeight:= 0;
+  FNbLayers:= 0;
+  FDPIX := 0;
+  FDPIY := 0;
+  layeredImage := TBGRAPhoxoDocument.Create;
+  try
+    layeredImage.LoadFromStream(Stream);
+    flat := layeredImage.ComputeFlatImage;
+    try
+      FWidth:= layeredImage.Width;
+      FHeight:= layeredImage.Height;
+      FNbLayers:= layeredImage.NbLayers;
+      FDPIX := layeredImage.DPIX;
+      FDPIY := layeredImage.DPIY;
+      if Img is TBGRACustomBitmap then
+        TBGRACustomBitmap(img).Assign(flat)
+      else
+      begin
+        Img.SetSize(flat.Width,flat.Height);
+        for y := 0 to flat.Height-1 do
+          for x := 0 to flat.Width-1 do
+            Img.Colors[x,y] := BGRAToFPColor(flat.GetPixel(x,y));
+      end;
+    finally
+      flat.free;
+    end;
+  finally
+    layeredImage.Free;
+  end;
+end;
+
+{ TBGRAPhoxoDocument }
+
+function TBGRAPhoxoDocument.GetMimeType: string;
+begin
+  Result:= 'image/phoxo';
+end;
+
+procedure TBGRAPhoxoDocument.AddLayerFromPhoxoData(
+  const ABlockHeader: TPhoxoBlockHeader; ABlockData: PByte);
+var
+  layerHeader: TPhoxoLayerHeader;
+  rawImageSize: LongWord;
+  rowStride: LongWord;
+  remaining: LongWord;
+  bmp: TBGRABitmap;
+  layerIndex,y,x: integer;
+  pSrc: PByte;
+  pDest: PBGRAPixel;
+begin
+  remaining := ABlockHeader.blockSize;
+  if remaining < sizeof(TPhoxoLayerHeader) then raise EFormatError.Create('Block too small');
+  move(ABlockData^, {%H-}layerHeader, sizeof(layerHeader));
+  inc(ABlockData, sizeof(layerHeader));
+  dec(remaining, sizeof(layerHeader));
+  SwapLayerHeaderIfNeeded(layerHeader);
+
+  if layerHeader.bmpHeader.Compression <> BI_RGB then raise EFormatError.Create('Compression not supported');
+  if (layerHeader.bmpHeader.Width < 0) or (layerHeader.bmpHeader.Height < 0) then
+    raise EFormatError.Create('Invalid image size');
+  if int64(layerHeader.bmpHeader.Width)*layerHeader.bmpHeader.Height > maxLongint div 4 then
+    raise EOutOfMemory.Create('Image too big');
+  rowStride := ComputeRowStride(layerHeader.bmpHeader.Width,layerHeader.bmpHeader.BitCount);
+  rawImageSize := rowStride * layerHeader.bmpHeader.Height;
+
+  if rawImageSize > remaining then
+     raise EFormatError.Create('Invalid image size');
+
+  bmp := TBGRABitmap.Create(layerHeader.bmpHeader.Width, layerHeader.bmpHeader.Height);
+  layerIndex := AddOwnedLayer(bmp, (layerHeader.opacityPercent*255 + 50) div 100);
+  LayerVisible[layerIndex] := (layerHeader.layerVisible = 1);
+
+  case layerHeader.bmpHeader.BitCount of
+    8: begin
+      for y := bmp.Height-1 downto 0 do
+        begin
+          pSrc := ABlockData + (bmp.Height-1 - y)*rowStride;
+          pDest := bmp.ScanLine[y];
+          for x := bmp.Width-1 downto 0 do
+          begin
+            pDest^ := BGRA(pSrc^,pSrc^,pSrc^);
+            inc(pDest);
+            inc(pSrc,3);
+          end;
+        end;
+    end;
+    24: begin
+      for y := bmp.Height-1 downto 0 do
+        begin
+          pSrc := ABlockData + (bmp.Height-1 - y)*rowStride;
+          pDest := bmp.ScanLine[y];
+          for x := bmp.Width-1 downto 0 do
+          begin
+            pDest^ := BGRA((pSrc+2)^,(pSrc+1)^,pSrc^);
+            inc(pDest);
+            inc(pSrc,3);
+          end;
+        end;
+    end;
+    32: begin
+      move(ABlockData^, bmp.Data^, sizeof(TBGRAPixel)*bmp.NbPixels);
+      if bmp.LineOrder = riloTopToBottom then bmp.VerticalFlip;
+      if TBGRAPixel_RGBAOrder then bmp.SwapRedBlue;
+    end;
+  else
+    raise EFormatError.Create('Unsupported bit depth');
+  end;
+
+  inc(ABlockData, rawImageSize);
+  dec(remaining, rawImageSize);
+  if remaining >= 8 then
+  begin
+    LayerOffset[layerIndex] := Point(LEtoN(PLongInt(ABlockData)^),LEtoN((PLongInt(ABlockData)+1)^));
+    inc(ABlockData, 8);
+    dec(remaining, 8);
+  end;
+end;
+
+constructor TBGRAPhoxoDocument.Create;
+begin
+  inherited Create;
+  RegisterPhoxoFormat;
+end;
+
+constructor TBGRAPhoxoDocument.Create(AWidth, AHeight: integer);
+begin
+  inherited Create(AWidth, AHeight);
+  RegisterPhoxoFormat;
+end;
+
+procedure TBGRAPhoxoDocument.LoadFromStream(AStream: TStream);
+begin
+  OnLayeredBitmapLoadFromStreamStart;
+  try
+    InternalLoadFromStream(AStream);
+  finally
+    OnLayeredBitmapLoaded;
+  end;
+end;
+
+procedure TBGRAPhoxoDocument.InternalLoadFromStream(AStream: TStream);
+var blockHeader: TPhoxoBlockHeader;
+    blockData: PByte;
+    wCaption: widestring;
+    i: Integer;
+begin
+  if not CheckFormat(AStream,False) then
+    raise EFormatError.Create('File header is invalid');
+  Clear;
+  FDPIX := 0;
+  FDPIY := 0;
+  blockData := nil;
+  repeat
+    if not ReadBlock(AStream, blockHeader,blockData) then
+    begin
+      if NbLayers = 0 then
+        raise EFormatError.Create('Error reading block from file')
+      else
+        break;
+    end;
+    try
+      case blockHeader.blockType of
+        PhoxoBlock_CanvasSize:
+          begin
+            if blockHeader.blockSize < 8 then raise EFormatError.Create('Block too small');
+            SetSize(LEtoN(PLongWord(blockData)^),LEtoN((PLongWord(blockData)+1)^));
+          end;
+        PhoxoBlock_DPI:
+          begin
+            if blockHeader.blockSize >= 8 then
+            begin
+              FDPIX := LEtoN(PLongWord(blockData)^);
+              FDPIY := LEtoN((PLongWord(blockData)+1)^);
+            end;
+          end;
+        PhoxoBlock_Layer, PhoxoBlock_TextLayer:
+          AddLayerFromPhoxoData(blockHeader,blockData);
+        PhoxoBlock_LayerCaption:
+          begin
+            if (blockHeader.blockSize >= 2) and (NbLayers > 0) then
+            begin
+              setlength(wCaption, blockHeader.blockSize div 2);
+              for i := 1 to length(wCaption) do
+                Word(wCaption[i]) := LEtoN((PWord(blockData)+i-1)^);
+              if wCaption[1] = #1 then Delete(wCaption,1,1);
+              LayerName[NbLayers-1] := UTF8Encode(wCaption);
+
+            end;
+          end;
+        PhoxoBlock_LazPaintBlendMode:
+          begin
+            if (blockHeader.blockSize >= 2) and (NbLayers > 0) then
+            begin
+              setlength(wCaption, blockHeader.blockSize div 2);
+              for i := 1 to length(wCaption) do
+                Word(wCaption[i]) := LEtoN((PWord(blockData)+i-1)^);
+              BlendOperation[NbLayers-1] := StrToBlendOperation(UTF8Encode(wCaption));
+            end;
+          end;
+      end;
+    finally
+      FreeMem(blockData);
+    end;
+  until blockHeader.blockType = PhoxoBlock_EndOfFile;
+end;
+
+procedure TBGRAPhoxoDocument.LoadFromFile(const filenameUTF8: string);
+var AStream: TFileStreamUTF8;
+begin
+  AStream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite);
+  OnLayeredBitmapLoadStart(filenameUTF8);
+  try
+    InternalLoadFromStream(AStream);
+  finally
+    OnLayeredBitmapLoaded;
+    AStream.Free;
+  end;
+end;
+
+procedure TBGRAPhoxoDocument.SaveToStream(AStream: TStream);
+begin
+  OnLayeredBitmapSaveToStreamStart;
+  try
+    InternalSaveToStream(AStream);
+  finally
+    OnLayeredBitmapSaved;
+  end;
+end;
+
+procedure TBGRAPhoxoDocument.SaveToFile(const filenameUTF8: string);
+var AStream: TFileStreamUTF8;
+begin
+  AStream := TFileStreamUTF8.Create(filenameUTF8,fmCreate or fmShareDenyWrite);
+  OnLayeredBitmapSaveStart(filenameUTF8);
+  try
+    InternalSaveToStream(AStream);
+  finally
+    OnLayeredBitmapSaved;
+    AStream.Free;
+  end;
+end;
+
+procedure TBGRAPhoxoDocument.InternalSaveToStream(AStream: TStream);
+
+  procedure WriteFileHeader;
+  var fileHeader: TPhoxoHeader;
+  begin
+    fileHeader.magic := PhoxoHeaderMagic;
+    fileHeader.version := 1;
+    fileHeader.version := NtoLE(fileHeader.version);
+    AStream.WriteBuffer(fileHeader, sizeof(fileHeader));
+  end;
+
+  procedure WriteBlockHeader(blockType: LongWord; blockSize: LongWord);
+  var blockHeader: TPhoxoBlockHeader;
+  begin
+    blockHeader.blockType := NtoLE(blockType);
+    blockHeader.blockSize := NtoLE(blockSize);
+    AStream.WriteBuffer(blockHeader, sizeof(blockHeader));
+  end;
+
+  procedure WriteLongInt(value: longint);
+  begin
+    value := NtoLE(value);
+    AStream.WriteBuffer(value, sizeof(value));
+  end;
+
+  procedure WriteLayer(index: integer);
+  var wCaption: widestring;
+      pCaption: PWord;
+
+      layerHeader: TPhoxoLayerHeader;
+      rowStride: LongWord;
+
+      temp,pdest: PByte;
+      i,x,y: integer;
+      psrc: PBGRAPixel;
+  begin
+    if LayerVisible[index] then
+      layerHeader.layerVisible := 1
+    else
+      layerHeader.layerVisible := 0;
+    layerHeader.layerLimited:= 0;
+    layerHeader.opacityPercent := (LayerOpacity[index]*100 + 127) div 255;
+    with layerHeader.bmpHeader do
+    begin
+      Size := $28;
+      Width := self.LayerBitmap[index].Width;
+      Height := self.LayerBitmap[index].Height;
+      Planes := 1;
+      BitCount := 32; //24-bit does not seem to be supported
+      Compression := BI_RGB;
+      SizeImage := 0;
+      XPelsPerMeter := 0;
+      YPelsPerMeter := 0;
+      ClrUsed := 0;
+      ClrImportant := 0;
+    end;
+    layerHeader.redMask := 0;
+    layerHeader.greenMask := 0;
+    layerHeader.blueMask := 0;
+
+    rowStride := ComputeRowStride(layerHeader.bmpHeader.Width, layerHeader.bmpHeader.BitCount);
+
+    WriteBlockHeader(PhoxoBlock_Layer, sizeof(layerHeader) + rowStride*layerHeader.bmpHeader.Height + sizeof(TPoint));
+    SwapLayerHeaderIfNeeded(layerHeader);
+    AStream.WriteBuffer(layerHeader,sizeof(layerHeader));
+    SwapLayerHeaderIfNeeded(layerHeader);
+
+    case layerHeader.bmpHeader.BitCount of
+      32: begin
+            if TBGRAPixel_RGBAOrder then self.LayerBitmap[index].SwapRedBlue;
+            for y := self.LayerBitmap[index].Height-1 downto 0 do
+              AStream.WriteBuffer(self.LayerBitmap[index].ScanLine[y]^, rowStride);
+            if TBGRAPixel_RGBAOrder then self.LayerBitmap[index].SwapRedBlue;
+          end;
+      24: begin
+            GetMem(temp, rowStride);
+            fillchar(temp^, rowStride, 0);
+            try
+              for y := self.LayerBitmap[index].Height-1 downto 0 do
+              begin
+                psrc := self.LayerBitmap[index].ScanLine[y];
+                pdest := temp;
+                for x := self.LayerBitmap[index].Width-1 downto 0 do
+                begin
+                  pdest^ := psrc^.blue; inc(pdest);
+                  pdest^ := psrc^.green; inc(pdest);
+                  pdest^ := psrc^.red; inc(pdest);
+                  inc(psrc);
+                end;
+                AStream.WriteBuffer(temp^, rowstride);
+              end;
+            finally
+              FreeMem(temp);
+            end;
+          end
+      else
+        raise exception.Create('Internal error');
+      end;
+
+    WriteLongInt(LayerOffset[index].X);
+    WriteLongInt(LayerOffset[index].Y);
+
+    if LayerName[index]<>'' then
+    begin
+      wCaption := UTF8ToUTF16(LayerName[index]);
+      WriteBlockHeader(PhoxoBlock_LayerCaption, length(wCaption)*2);
+      getmem(pCaption, length(wCaption)*2);
+      try
+        for i := 1 to length(wCaption) do
+          (pCaption+i-1)^ := NtoLE(Word(wCaption[i]));
+        AStream.WriteBuffer(pCaption^, length(wCaption)*2);
+      finally
+        freemem(pCaption);
+      end;
+    end;
+
+    if BlendOperation[index] <> boTransparent then
+    begin
+      wCaption := UTF8ToUTF16(BlendOperationStr[BlendOperation[index]]);
+      WriteBlockHeader(PhoxoBlock_LazPaintBlendMode, length(wCaption)*2);
+      getmem(pCaption, length(wCaption)*2);
+      try
+        for i := 1 to length(wCaption) do
+          (pCaption+i-1)^ := NtoLE(Word(wCaption[i]));
+        AStream.WriteBuffer(pCaption^, length(wCaption)*2);
+      finally
+        freemem(pCaption);
+      end;
+    end;
+  end;
+
+var
+  i: Integer;
+begin
+  WriteFileHeader;
+
+  WriteBlockHeader(PhoxoBlock_CanvasSize, 8);
+  WriteLongInt(Width);
+  WriteLongInt(Height);
+
+  if (DPIX <> 0) and (DPIY <> 0) then
+  begin
+    WriteBlockHeader(PhoxoBlock_DPI, 8);
+    WriteLongInt(DPIX);
+    WriteLongInt(DPIY);
+  end;
+
+  for i := 0 to NbLayers-1 do
+  begin
+    OnLayeredBitmapSaveProgress(round(i*100/NbLayers));
+    WriteLayer(i);
+  end;
+  OnLayeredBitmapSaveProgress(100);
+
+  WriteBlockHeader(PhoxoBlock_EndOfFile,0);
+end;
+
+class function TBGRAPhoxoDocument.CheckFormat(Stream: TStream; ARestorePosition: boolean): boolean;
+var header: TPhoxoHeader;
+  oldPos: int64;
+begin
+  oldPos := Stream.Position;
+  if Stream.Read({%H-}header,sizeof(header))<>sizeof(header) then
+    result := false else
+  begin
+    header.version:= LEtoN(header.version);
+    if (header.magic <> PhoxoHeaderMagic) or (header.version <> 1) then
+      result := false
+    else
+      result := true;
+  end;
+  if ARestorePosition then Stream.Position:= oldPos;
+end;
+
+class function TBGRAPhoxoDocument.ReadBlock(Stream: TStream; out
+  AHeader: TPhoxoBlockHeader; out ABlockData: PByte): boolean;
+begin
+  ABlockData := nil;
+  if Stream.Read({%H-}AHeader,sizeof(AHeader)) <> sizeof(AHeader) then
+  begin
+    AHeader.blockType := 0;
+    AHeader.blockSize := 0;
+    result := false;
+    exit;
+  end;
+  AHeader.blockType := LEtoN(AHeader.blockType);
+  AHeader.blockSize := LEtoN(AHeader.blockSize);
+  if Stream.Position + AHeader.blockSize > Stream.Size then
+  begin
+    AHeader.blockSize := 0;
+    result := false;
+    exit;
+  end;
+  GetMem(ABlockData, AHeader.blockSize);
+  if Stream.Read(ABlockData^, AHeader.blockSize) <> AHeader.blockSize then
+  begin
+    FreeMem(ABlockData);
+    AHeader.blockSize := 0;
+    result := false;
+    exit;
+  end;
+  result := true;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrapixel.inc

@@ -0,0 +1,744 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{=== 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: word;
+    function GetClassLightness: word;
+    procedure SetClassIntensity(AValue: word);
+    procedure SetClassLightness(AValue: word);
+  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;
+    function EqualsExactly(constref AColor: TBGRAPixel): boolean;
+    class Operator := (Source: TBGRAPixel): TColor;
+    class Operator := (Source: TColor): TBGRAPixel;
+    property Intensity: word read GetClassIntensity write SetClassIntensity;
+    property Lightness: word 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; inline;
+  {** Creates a opaque pixel with given RGB values }
+  function BGRA(red, green, blue: byte): TBGRAPixel; overload; inline;
+  {** Checks if two pixels are equal. If they are both transparent,
+      RGB values are ignored }
+  operator = (const c1, c2: TBGRAPixel): boolean; inline;
+  {** Returns the intensity of a pixel. The intensity is the
+     maximum value reached by any component }
+  function GetIntensity(c: TBGRAPixel): word; inline;
+  {** Sets the intensity of a pixel }
+  function SetIntensity(c: TBGRAPixel; intensity: word): TBGRAPixel;
+  {** Returns the lightness of a pixel. The lightness is the
+     perceived brightness, 0 being black and 65535 being white }
+  function GetLightness(c: TBGRAPixel): word; overload;
+  {** Sets the lightness of a pixel }
+  function SetLightness(c: TBGRAPixel; lightness: word): 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: word): TBGRAPixel; inline;
+  {** 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: LongWord): 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: word): 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;
+  function FastRoundDiv257(valueWord: LongWord): byte; inline;
+  {** 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; inline;
+  function Color16BitToBGRA(AColor: Word): TBGRAPixel;
+  function BGRAToColor16Bit(const AColor: TBGRAPixel): Word;
+  {** 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): word;
+  {** 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): word;
+
+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 word, 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,
+    {** SVG implementation of soft light **}
+    boSvgSoftLight,
+    {** Apply mask **}
+    boMask,
+    {** Standard HSL colorspace }
+    boLinearMultiplySaturation, boLinearHue, boLinearColor, boLinearLightness, boLinearSaturation,
+    {** Corrected HSL colorspace (GSB) }
+    boCorrectedHue, boCorrectedColor, boCorrectedLightness, boCorrectedSaturation
+    );
+
+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', 'Mask', 'LinearMultiplySaturation',
+     'LinearHue', 'LinearColor', 'LinearLightness', 'LinearSaturation',
+     'CorrectedHue', 'CorrectedColor', 'CorrectedLightness', 'CorrectedSaturation');
+
+  {** 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;
+begin
+  LongWord(result) := (red shl TBGRAPixel_RedShift) or
+                   (green shl TBGRAPixel_GreenShift) or
+                   (blue shl TBGRAPixel_BlueShift) or
+                   (alpha shl TBGRAPixel_AlphaShift);
+end;
+
+function BGRA(red, green, blue: byte): TBGRAPixel; overload;
+begin
+  LongWord(result) := (red shl TBGRAPixel_RedShift) or
+                   (green shl TBGRAPixel_GreenShift) or
+                   (blue shl TBGRAPixel_BlueShift) or
+                   (255 shl TBGRAPixel_AlphaShift);
+end;
+
+operator = (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): word;
+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: word): TBGRAPixel;
+begin
+  result := GammaCompression(SetIntensity(GammaExpansion(c),intensity));
+end;
+
+function GetLightness(c: TBGRAPixel): word;
+begin
+  result := GetLightness(GammaExpansion(c));
+end;
+
+function SetLightness(c: TBGRAPixel; lightness: word): TBGRAPixel;
+begin
+  result := GammaCompression(SetLightness(GammaExpansion(c),lightness));
+end;
+
+function ApplyLightnessFast(color: TBGRAPixel; lightness: word): TBGRAPixel;
+var
+  r,g,b: word;
+  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
+      dec(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: LongWord): TBGRAPixel;
+var
+    maxValue,invMaxValue,r,g,b: LongWord;
+    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 := (LongWord(2147483647)+LongWord(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:  word;
+  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: word): 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: LongWord;
+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) or (c1.alpha = 0) then
+  begin
+    if (weight2 = 0) or (c2.alpha = 0) then
+      result := BGRAPixelTransparent
+    else
+      Result := c2
+  end
+  else
+  if (weight2 = 0) or (c2.alpha = 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) or (c1.alpha = 0) then
+  begin
+    if (w2 = 0) or (c2.alpha = 0) then
+      result := BGRAPixelTransparent
+    else
+      Result := c2
+  end
+  else
+  if (w2 = 0) or (c2.alpha = 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 }
+{$PUSH}{$R-}
+function ColorToBGRA(color: TColor): TBGRAPixel; overload;
+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; overload;
+begin
+  if (color < 0) or (color > $ffffff) then color := ColorToRGB(color);
+  RedGreenBlue(color, Result.red,Result.green,Result.blue);
+  Result.alpha := opacity;
+end;
+{$POP}
+
+function BGRAToColor(c: TBGRAPixel): TColor;
+begin
+  Result := RGBToColor(c.red, c.green, c.blue);
+end;
+
+function FastRoundDiv257(valueWord: LongWord): byte; inline;
+begin
+  result := LongWord(valueWord + 127 - (valueWord shr 8)) shr 8;
+end;
+
+{ Conversion from TFPColor to TBGRAPixel assuming TFPColor
+  is already gamma compressed }
+function FPColorToBGRA(AValue: TFPColor): TBGRAPixel;
+begin
+  with AValue do
+    Result := BGRA(FastRoundDiv257(red), FastRoundDiv257(green), FastRoundDiv257(blue), alpha shr 8);
+end;
+
+function BGRAToFPColor(AValue: TBGRAPixel): TFPColor; inline;
+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: Word): 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): Word;
+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): word;
+begin
+  if c1 = c2 then result := 0
+  else result := ExpandedDiff(GammaExpansion(c1),GammaExpansion(c2));
+end;
+
+function BGRADiff(c1,c2: TBGRAPixel): byte;
+begin
+  if c1 = c2 then result := 0
+  else 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): word;
+var wa1,wa2: word;
+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: UInt32or64;
+  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
+    inc(sumR, red*alpha);
+    inc(sumG, green*alpha);
+    inc(sumB, blue*alpha);
+    inc(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 LongWord(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);
+    {$PUSH}{$R-}
+    result := BGRA(intval shr 8,intval shr 16,intval,alpha);
+    {$POP}
+  end;
+end;
+{$ENDIF}
+
+{$IFDEF INCLUDE_INIT}
+{$UNDEF INCLUDE_INIT}
+  BGRASetGamma();
+
+  {$DEFINE INCLUDE_INITIALIZATION}
+  {$i extendedcolorspace.inc}
+{$ENDIF}

vendor/kam_remake/src/ext/BGRABitmap/bgrapolygonaliased.pas

@@ -0,0 +1,982 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAPolygonAliased;
+
+{$mode objfpc}{$H+}
+
+{$i bgrasse.inc}
+
+interface
+
+{ This unit provides fast aliased polygon routines.
+
+  To do aliased drawing, only one line is intersected with polygons for each output scanline.
+  Along with intersection coordinates, color and texture coordinates are computed using
+  linear interpolation. Inverse values are used for projective transform. }
+
+uses
+  BGRAClasses, SysUtils, BGRABitmapTypes, BGRAFillInfo, BGRASSE;
+
+type
+  //segment information for linear color
+  TLinearColorInfo = record
+    Color, ColorSlopes: TColorF;
+  end;
+  PLinearColorInfo = ^TLinearColorInfo;
+  ArrayOfTColorF = array of TColorF;
+
+  //add a color information to intersection info
+  TLinearColorGradientIntersectionInfo = class(TIntersectionInfo)
+    Color: TColorF;
+  end;
+
+  { TPolygonLinearColorGradientInfo }
+
+  TPolygonLinearColorGradientInfo = class(TOnePassFillPolyInfo)
+  protected
+    FColors: array of TColorF;
+    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
+      ANumSegment: integer; dy: single; AData: pointer); override;
+  public
+    constructor Create(const points: array of TPointF; const Colors: array of TBGRAPixel);
+    function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override;
+    function CreateIntersectionInfo: TIntersectionInfo; override;
+  end;
+
+procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonLinearColorGradientInfo;
+  NonZeroWinding: boolean); overload;
+procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap; const points: array of TPointF;
+  const Colors: array of TBGRAPixel; NonZeroWinding: boolean); overload;
+
+type
+  //segment information for linear color
+  TPerspectiveColorInfo = record
+    ColorDivZ, ColorSlopesDivZ: TColorF;
+    InvZ, InvZSlope: single;
+  end;
+  PPerspectiveColorInfo = ^TPerspectiveColorInfo;
+
+  //add a color information to intersection info
+  TPerspectiveColorGradientIntersectionInfo = class(TIntersectionInfo)
+    ColorDivZ: TColorF;
+    coordInvZ: single;
+  end;
+
+  { TPolygonPerspectiveColorGradientInfo }
+
+  TPolygonPerspectiveColorGradientInfo = class(TOnePassFillPolyInfo)
+  protected
+    FColors: array of TColorF;
+    FPointsZ: array of single;
+    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
+      ANumSegment: integer; dy: single; AData: pointer); override;
+  public
+    constructor Create(const points: array of TPointF; const pointsZ: array of single; const Colors: array of TBGRAPixel);
+    function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override;
+    function CreateIntersectionInfo: TIntersectionInfo; override;
+  end;
+
+procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonPerspectiveColorGradientInfo;
+  NonZeroWinding: boolean; zbuffer: psingle = nil); overload;
+procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap; const points: array of TPointF;
+  const pointsZ: array of single; const Colors: array of TBGRAPixel; NonZeroWinding: boolean; zbuffer: psingle = nil); overload;
+
+type
+  //segment information for linear texture
+  TLinearTextureInfo = record
+    TexCoord: TPointF;
+    TexCoordSlopes: TPointF;
+    lightness: single;
+    lightnessSlope: single;
+  end;
+  PLinearTextureInfo = ^TLinearTextureInfo;
+
+  //add a texture coordinate to intersection info
+  TLinearTextureMappingIntersectionInfo = class(TIntersectionInfo)
+    texCoord: TPointF;
+    lightness: word;
+  end;
+
+  { TPolygonLinearTextureMappingInfo }
+
+  TPolygonLinearTextureMappingInfo = class(TOnePassFillPolyInfo)
+  protected
+    FTexCoords: array of TPointF;
+    FLightnesses: array of Word;
+    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
+      ANumSegment: integer; dy: single; AData: pointer); override;
+  public
+    constructor Create(const points: array of TPointF; const texCoords: array of TPointF); overload;
+    constructor Create(const points: array of TPointF; const texCoords: array of TPointF; const lightnesses: array of word); overload;
+    function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override;
+    function CreateIntersectionInfo: TIntersectionInfo; override;
+  end;
+
+procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonLinearTextureMappingInfo;
+  texture: IBGRAScanner; TextureInterpolation: Boolean; NonZeroWinding: boolean); overload;
+
+procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; texture: IBGRAScanner;
+  const texCoords: array of TPointF; TextureInterpolation: Boolean; NonZeroWinding: boolean); overload;
+procedure PolygonLinearTextureMappingAliasedWithLightness(bmp: TBGRACustomBitmap; const points: array of TPointF; texture: IBGRAScanner;
+  const texCoords: array of TPointF; TextureInterpolation: Boolean; lightnesses: array of word; NonZeroWinding: boolean); overload;
+
+type
+  //segment information for perspective texture. Use inverse Z and slopes.
+  TPerspectiveTextureInfo = record
+    InvZ,InvZSlope: Single;
+    TexCoordDivByZ: TPointF;
+    TexCoordDivByZSlopes: TPointF;
+    lightness: single;
+    lightnessSlope: single;
+    Position3D, Normal3D: TPoint3D_128;
+    Position3DSlope, Normal3DSlope: TPoint3D_128;
+  end;
+  PPerspectiveTextureInfo = ^TPerspectiveTextureInfo;
+
+  //add a texture coordinate and depth to intersection info (stored as inverse)
+  TPerspectiveTextureMappingIntersectionInfo = class(TIntersectionInfo)
+    texCoordDivByZ: TPointF;
+    coordInvZ: single;
+    lightness: word;
+    Position3D, Normal3D: TPoint3D_128;
+  end;
+
+  { TPolygonPerspectiveTextureMappingInfo }
+
+  TPolygonPerspectiveTextureMappingInfo = class(TOnePassFillPolyInfo)
+  protected
+    FTexCoords: array of TPointF;
+    FPointsZ: array of single;
+    FLightnesses: array of Word;
+    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
+      ANumSegment: integer; dy: single; AData: pointer); override;
+  public
+    constructor Create(const points: array of TPointF; const pointsZ: array of single; const texCoords: array of TPointF); overload;
+    constructor Create(const points: array of TPointF; const pointsZ: array of single; const texCoords: array of TPointF; const lightnesses: array of word); overload;
+    function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override;
+    function CreateIntersectionInfo: TIntersectionInfo; override;
+  end;
+
+  { TPolygonPerspectiveMappingShaderInfo }
+
+  TPolygonPerspectiveMappingShaderInfo = class(TOnePassFillPolyInfo)
+  protected
+    FTexCoords: array of TPointF;
+    FPositions3D, FNormals3D: array of TPoint3D_128;
+    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
+      ANumSegment: integer; dy: single; AData: pointer); override;
+  public
+    constructor Create(const points: array of TPointF; const points3D: array of TPoint3D; const normals: array of TPoint3D; const texCoords: array of TPointF); overload;
+    constructor Create(const points: array of TPointF; const points3D: array of TPoint3D_128; const normals: array of TPoint3D_128; const texCoords: array of TPointF); overload;
+    function CreateSegmentData(numPt, nextPt: integer; ASeg: PCustomPointRecord): pointer; override;
+    function CreateIntersectionInfo: TIntersectionInfo; override;
+  end;
+
+  TShaderFunction3D = function (Context: PBasicLightingContext; Color: TBGRAPixel): TBGRAPixel of object;
+
+procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonPerspectiveTextureMappingInfo;
+         texture: IBGRAScanner; TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle = nil); overload;
+procedure PolygonPerspectiveTextureMappingAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner;
+           const texCoords: array of TPointF; TextureInterpolation: Boolean; NonZeroWinding: boolean; zbuffer: psingle = nil); overload;
+procedure PolygonPerspectiveTextureMappingAliasedWithLightness(bmp: TBGRACustomBitmap; const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner;
+           const texCoords: array of TPointF; TextureInterpolation: Boolean; lightnesses: array of word; NonZeroWinding: boolean; zbuffer: psingle = nil); overload;
+
+procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonPerspectiveMappingShaderInfo;
+         texture: IBGRAScanner; TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean;
+         solidColor: TBGRAPixel; zbuffer: psingle = nil; ShaderContext: PBasicLightingContext= nil); overload;
+procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; const points3D: array of TPoint3D;
+           const normals: array of TPoint3D; texture: IBGRAScanner; const texCoords: array of TPointF;
+           TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean;
+           solidColor: TBGRAPixel; zbuffer: psingle = nil; ShaderContext: PBasicLightingContext= nil); overload;
+procedure PolygonPerspectiveMappingShaderAliased(bmp: TBGRACustomBitmap; const points: array of TPointF; const points3D: array of TPoint3D_128;
+           const normals: array of TPoint3D_128; texture: IBGRAScanner; const texCoords: array of TPointF;
+           TextureInterpolation: Boolean; ShaderFunction: TShaderFunction3D; NonZeroWinding: boolean;
+           solidColor: TBGRAPixel; zbuffer: psingle = nil; ShaderContext: PBasicLightingContext= nil); overload;
+
+{ Aliased round rectangle }
+procedure BGRARoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer;
+  DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency;
+  skipFill: boolean = false); overload;
+procedure BGRARoundRectAliased(dest: TCustomUniversalBitmap; X1, Y1, X2, Y2: integer;
+  DX, DY: integer; const BorderColor, FillColor: TUniversalBrush; AAlpha: Word; skipBorder: boolean = false; skipFill: boolean = false); overload;
+procedure BGRAFillRoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer;
+  DX, DY: integer; FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency);
+
+implementation
+
+uses Math, BGRABlend, BGRAPolygon;
+
+{ TPolygonPerspectiveColorGradientInfo }
+
+procedure TPolygonPerspectiveColorGradientInfo.SetIntersectionValues(
+  AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
+  dy: single; AData: pointer);
+var
+  info: PPerspectiveColorInfo;
+begin
+  AInter.SetValues(AInterX,AWinding,ANumSegment);
+  info := PPerspectiveColorInfo(AData);
+  TPerspectiveColorGradientIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ;
+  TPerspectiveColorGradientIntersectionInfo(AInter).ColorDivZ := info^.ColorDivZ + info^.ColorSlopesDivZ*dy;
+end;
+
+constructor TPolygonPerspectiveColorGradientInfo.Create(
+  const points: array of TPointF; const pointsZ: array of single;
+  const Colors: array of TBGRAPixel);
+var
+  i: Integer;
+  ec: TExpandedPixel;
+begin
+  if (length(Colors) <> length(points)) or (length(points) <> length(pointsZ)) then
+    raise Exception.Create('Dimensions mismatch');
+  inherited Create(points);
+
+  SetLength(FColors, length(FPoints));
+  SetLength(FPointsZ, length(FPoints));
+  for i := 0 to high(FPoints) do
+  begin
+    ec := GammaExpansion(Colors[FPoints[i].originalIndex]);
+    FColors[i] := ColorF(ec.red,ec.green,ec.blue,ec.alpha);
+    FPointsZ[i] := pointsZ[FPoints[i].originalIndex];
+  end;
+end;
+
+function TPolygonPerspectiveColorGradientInfo.CreateSegmentData(numPt, nextPt: integer;
+  ASeg: PCustomPointRecord): pointer;
+var
+  info: PPerspectiveColorInfo;
+  InvTy: single;
+  CurColorDivByZ,NextColorDivByZ: TColorF;
+  CurInvZ,NextInvZ: single;
+begin
+  New(info);
+  InvTy := 1/(ASeg^.y2-ASeg^.y);
+  CurInvZ := 1/FPointsZ[numPt];
+  CurColorDivByZ := FColors[numPt]*CurInvZ;
+  NextInvZ := 1/FPointsZ[nextPt];
+  NextColorDivByZ := FColors[nextPt]*NextInvZ;
+
+  info^.ColorSlopesDivZ := (NextColorDivByZ - CurColorDivByZ)*InvTy;
+  info^.ColorDivZ := CurColorDivByZ;
+
+  info^.InvZSlope := (NextInvZ-CurInvZ)*InvTy;
+  info^.InvZ := CurInvZ;
+
+  Result:= info;
+end;
+
+function TPolygonPerspectiveColorGradientInfo.CreateIntersectionInfo: TIntersectionInfo;
+begin
+  Result:= TPerspectiveColorGradientIntersectionInfo.Create;
+end;
+
+{ TPolygonLinearColorGradientInfo }
+
+procedure TPolygonLinearColorGradientInfo.SetIntersectionValues(
+  AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
+  dy: single; AData: pointer);
+var
+  info: PLinearColorInfo;
+begin
+  AInter.SetValues(AInterX,AWinding,ANumSegment);
+  info := PLinearColorInfo(AData);
+  TLinearColorGradientIntersectionInfo(AInter).color := info^.Color + info^.ColorSlopes*dy;
+end;
+
+constructor TPolygonLinearColorGradientInfo.Create(
+  const points: array of TPointF; const Colors: array of TBGRAPixel);
+var
+  i: Integer;
+  ec: TExpandedPixel;
+begin
+  if length(Colors) <> length(points) then
+    raise Exception.Create('Dimensions mismatch');
+
+  inherited Create(Points);
+  setlength(FColors, length(FPoints));
+  for i := 0 to high(FColors) do
+  begin
+    ec := GammaExpansion(Colors[FPoints[i].originalIndex]);
+    FColors[i] := ColorF(ec.red,ec.green,ec.blue,ec.alpha);
+  end;
+end;
+
+function TPolygonLinearColorGradientInfo.CreateSegmentData(numPt, nextPt: integer;
+  ASeg: PCustomPointRecord): pointer;
+var
+  info: PLinearColorInfo;
+  ty: single;
+begin
+  New(info);
+  ty := ASeg^.y2 - ASeg^.y;
+  info^.ColorSlopes := (FColors[nextPt] - FColors[numPt])*(1/ty);
+  info^.Color := FColors[numPt];
+  Result:= info;
+end;
+
+function TPolygonLinearColorGradientInfo.CreateIntersectionInfo: TIntersectionInfo;
+begin
+  Result:= TLinearColorGradientIntersectionInfo.Create;
+end;
+
+procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap;
+  polyInfo: TPolygonLinearColorGradientInfo; NonZeroWinding: boolean);
+var
+  inter:    array of TIntersectionInfo;
+  nbInter:  integer;
+
+  procedure DrawGradientLine(yb: integer; ix1: integer; ix2: integer;
+    x1: Single; c1: TColorF; x2: Single; c2: TColorF);
+  var
+    colorPos: TColorF;
+    colorStep: TColorF;
+    t: single;
+    pdest: PBGRAPixel;
+    i: LongInt;
+    ec: TExpandedPixel;
+    {%H-}cInt: packed record
+        r,g,b,a: integer;
+       end;
+    {$IFDEF BGRASSE_AVAILABLE} c: TBGRAPixel; {$ENDIF}
+  begin
+    t := ((ix1+0.5)-x1)/(x2-x1);
+    colorPos := c1 + (c2-c1)*t;
+    colorStep := (c2-c1)*(1/(x2-x1));
+    pdest := bmp.ScanLine[yb]+ix1;
+
+    {$IFDEF BGRASSE_AVAILABLE} {$asmmode intel}
+    If UseSSE then
+    begin
+      asm
+        movups xmm4, colorPos
+        movups xmm5, colorStep
+      end;
+      If UseSSE2 then
+      begin
+        for i := ix1 to ix2 do
+        begin
+          asm
+            cvtps2dq xmm0,xmm4
+            movups cInt, xmm0
+            addps xmm4,xmm5
+          end;
+          c.red := GammaCompressionTab[cInt.r];
+          c.green := GammaCompressionTab[cInt.g];
+          c.blue := GammaCompressionTab[cInt.b];
+          c.alpha := GammaCompressionTab[cInt.a];
+          DrawPixelInlineWithAlphaCheck(pdest, c);
+          inc(pdest);
+        end;
+      end else
+      begin
+        for i := ix1 to ix2 do
+        begin
+          asm
+            movups colorPos, xmm4
+            addps xmm4,xmm5
+          end;
+          ec.red := round(colorPos[1]);
+          ec.green := round(colorPos[2]);
+          ec.blue := round(colorPos[3]);
+          ec.alpha := round(colorPos[4]);
+          DrawPixelInlineWithAlphaCheck(pdest, GammaCompression(ec));
+          inc(pdest);
+        end;
+      end;
+    end else
+    {$ENDIF}
+    for i := ix1 to ix2 do
+    begin
+      ec.red := round(colorPos[1]);
+      ec.green := round(colorPos[2]);
+      ec.blue := round(colorPos[3]);
+      ec.alpha := round(colorPos[4]);
+      DrawPixelInlineWithAlphaCheck(pdest, GammaCompression(ec));
+      colorPos := colorPos + colorStep;
+      inc(pdest);
+    end;
+  end;
+
+var
+  miny, maxy, minx, maxx: integer;
+
+  yb, i: integer;
+  x1, x2: single;
+
+  ix1, ix2: integer;
+
+begin
+  If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
+  inter := polyInfo.CreateIntersectionArray;
+
+  //vertical scan
+  for yb := miny to maxy do
+  begin
+    //find intersections
+    polyInfo.ComputeAndSort(yb+0.5,inter,nbInter,NonZeroWinding);
+
+    for i := 0 to nbinter div 2 - 1 do
+    begin
+      x1 := inter[i + i].interX;
+      x2 := inter[i + i+ 1].interX;
+
+      if x1 <> x2 then
+      begin
+        ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2);
+        if ix1 <= ix2 then
+          DrawGradientLine(yb,ix1,ix2,
+            x1,TLinearColorGradientIntersectionInfo(inter[i+i]).Color,
+            x2,TLinearColorGradientIntersectionInfo(inter[i+i+1]).Color);
+      end;
+    end;
+  end;
+
+  polyInfo.FreeIntersectionArray(inter);
+  bmp.InvalidateBitmap;
+end;
+
+procedure PolygonLinearColorGradientAliased(bmp: TBGRACustomBitmap;
+  const points: array of TPointF; const Colors: array of TBGRAPixel;
+  NonZeroWinding: boolean);
+var polyInfo: TPolygonLinearColorGradientInfo;
+begin
+  polyInfo := TPolygonLinearColorGradientInfo.Create(points,Colors);
+  PolygonLinearColorGradientAliased(bmp,polyInfo,NonZeroWinding);
+  polyInfo.Free;
+end;
+
+{ TPolygonLinearTextureMappingInfo }
+
+procedure TPolygonLinearTextureMappingInfo.SetIntersectionValues(
+  AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
+  dy: single; AData: pointer);
+var
+  info: PLinearTextureInfo;
+begin
+  AInter.SetValues(AInterX,AWinding,ANumSegment);
+  info := PLinearTextureInfo(AData);
+  TLinearTextureMappingIntersectionInfo(AInter).texCoord := info^.TexCoord + info^.TexCoordSlopes*dy;
+  if FLightnesses<>nil then
+    TLinearTextureMappingIntersectionInfo(AInter).lightness := round(info^.lightness + info^.lightnessSlope*dy)
+  else
+    TLinearTextureMappingIntersectionInfo(AInter).lightness := 32768;
+end;
+
+constructor TPolygonLinearTextureMappingInfo.Create(const points: array of TPointF;
+  const texCoords: array of TPointF);
+var
+  i: Integer;
+begin
+  if length(texCoords) <> length(points) then
+    raise Exception.Create('Dimensions mismatch');
+  inherited Create(points);
+  SetLength(FTexCoords, length(FPoints));
+  for i := 0 to high(FPoints) do
+    FTexCoords[i] := texCoords[FPoints[i].originalIndex];
+end;
+
+constructor TPolygonLinearTextureMappingInfo.Create(
+  const points: array of TPointF; const texCoords: array of TPointF;
+  const lightnesses: array of word);
+var
+  i: Integer;
+begin
+  if (length(texCoords) <> length(points)) or (length(lightnesses) <> length(points)) then
+    raise Exception.Create('Dimensions mismatch');
+  inherited Create(points);
+  SetLength(FTexCoords, length(FPoints));
+  setlength(FLightnesses, length(FPoints));
+  for i := 0 to high(FPoints) do
+  begin
+    FTexCoords[i] := texCoords[FPoints[i].originalIndex];
+    FLightnesses[i] := lightnesses[FPoints[i].originalIndex];
+  end;
+end;
+
+function TPolygonLinearTextureMappingInfo.CreateSegmentData(numPt, nextPt: integer;
+  ASeg: PCustomPointRecord): pointer;
+var
+  info: PLinearTextureInfo;
+  ty: single;
+begin
+  New(info);
+  ty := ASeg^.y2-ASeg^.y;
+  info^.TexCoordSlopes := (FTexCoords[nextPt] - FTexCoords[numPt])*(1/ty);
+  info^.TexCoord := FTexCoords[numPt];
+  if FLightnesses <> nil then
+  begin
+    info^.lightnessSlope := (FLightnesses[nextPt] - FLightnesses[numPt])*(1/ty);
+    info^.lightness := FLightnesses[numPt];
+  end else
+  begin
+    info^.lightness := 32768;
+    info^.lightnessSlope := 0;
+  end;
+  Result:= info;
+end;
+
+function TPolygonLinearTextureMappingInfo.CreateIntersectionInfo: TIntersectionInfo;
+begin
+  result := TLinearTextureMappingIntersectionInfo.Create;
+end;
+
+{$hints off}
+
+procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap;
+  polyInfo: TPolygonPerspectiveColorGradientInfo; NonZeroWinding: boolean; zbuffer: psingle);
+var
+  inter:    array of TIntersectionInfo;
+  nbInter:  integer;
+
+  procedure DrawGradientLine(yb: integer; ix1: integer; ix2: integer;
+    x1: Single; info1: TPerspectiveColorGradientIntersectionInfo; x2: Single; info2: TPerspectiveColorGradientIntersectionInfo);
+  var
+    diff,colorPos,{%H-}colorPosByZ: TColorF;
+    colorStep: TColorF;
+    t: single;
+    pdest: PBGRAPixel;
+    i: LongInt;
+    ec: TExpandedPixel;
+    invDx: single;
+    z,invZ,InvZStep: single;
+    r,g,b,a: integer;
+    {$IFDEF BGRASSE_AVAILABLE}minVal,maxVal: single;
+    cInt: packed record
+      r,g,b,a: integer;
+    end;
+    c: TBGRAPixel;{$ENDIF}
+    zbufferpos: psingle;
+
+  begin
+    invDx := 1/(x2-x1);
+    t := ((ix1+0.5)-x1)*InvDx;
+    diff := info2.ColorDivZ-info1.ColorDivZ;
+    colorPos := info1.ColorDivZ + diff*t;
+    colorStep := diff*InvDx;
+    invZ := info1.coordInvZ + (info2.coordInvZ-info1.coordInvZ)*t;
+    InvZStep := (info2.coordInvZ-info1.coordInvZ)*InvDx;
+    pdest := bmp.ScanLine[yb]+ix1;
+    if zbuffer <> nil then
+    begin
+    {$DEFINE PARAM_USEZBUFFER}
+      zbufferpos := zbuffer + yb*bmp.Width + ix1;
+      {$IFDEF BGRASSE_AVAILABLE}
+      If UseSSE then
+      begin
+        {$DEFINE PARAM_USESSE}
+        If UseSSE2 then
+        begin
+          {$DEFINE PARAM_USESSE2}
+          {$i perspectivecolorscan.inc}
+          {$UNDEF PARAM_USESSE2}
+        end else
+        begin
+          {$i perspectivecolorscan.inc}
+        end;
+        {$UNDEF PARAM_USESSE}
+      end else
+      {$ENDIF}
+      begin
+        {$i perspectivecolorscan.inc}
+      end;
+    {$UNDEF PARAM_USEZBUFFER}
+    end else
+    begin
+      {$IFDEF BGRASSE_AVAILABLE}
+      If UseSSE then
+      begin
+        {$DEFINE PARAM_USESSE}
+        If UseSSE2 then
+        begin
+          {$DEFINE PARAM_USESSE2}
+          {$i perspectivecolorscan.inc}
+          {$UNDEF PARAM_USESSE2}
+        end else
+        begin
+          {$i perspectivecolorscan.inc}
+        end;
+        {$UNDEF PARAM_USESSE}
+      end else
+      {$ENDIF}
+      begin
+        {$i perspectivecolorscan.inc}
+      end;
+    end;
+  end;
+
+var
+  miny, maxy, minx, maxx: integer;
+
+  yb, i: integer;
+  x1, x2: single;
+
+  ix1, ix2: integer;
+
+begin
+  If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
+  inter := polyInfo.CreateIntersectionArray;
+
+  //vertical scan
+  for yb := miny to maxy do
+  begin
+    //find intersections
+    polyInfo.ComputeAndSort(yb+0.5,inter,nbInter,NonZeroWinding);
+
+    for i := 0 to nbinter div 2 - 1 do
+    begin
+      x1 := inter[i + i].interX;
+      x2 := inter[i + i+ 1].interX;
+
+      if x1 <> x2 then
+      begin
+        ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2);
+        if ix1 <= ix2 then
+          DrawGradientLine(yb,ix1,ix2,
+            x1,TPerspectiveColorGradientIntersectionInfo(inter[i+i]),
+            x2,TPerspectiveColorGradientIntersectionInfo(inter[i+i+1]));
+      end;
+    end;
+  end;
+
+  polyInfo.FreeIntersectionArray(inter);
+  bmp.InvalidateBitmap;
+end;
+
+procedure PolygonPerspectiveColorGradientAliased(bmp: TBGRACustomBitmap;
+  const points: array of TPointF; const pointsZ: array of single;
+  const Colors: array of TBGRAPixel; NonZeroWinding: boolean; zbuffer: psingle);
+var polyInfo: TPolygonPerspectiveColorGradientInfo;
+begin
+  polyInfo := TPolygonPerspectiveColorGradientInfo.Create(points,pointsZ,Colors);
+  PolygonPerspectiveColorGradientAliased(bmp,polyInfo,NonZeroWinding,zbuffer);
+  polyInfo.Free;
+end;
+
+procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap; polyInfo: TPolygonLinearTextureMappingInfo;
+  texture: IBGRAScanner; TextureInterpolation: Boolean; NonZeroWinding: boolean);
+var
+  inter:    array of TIntersectionInfo;
+  nbInter:  integer;
+  scanAtFunc: function(X,Y: Single): TBGRAPixel of object;
+  scanAtIntegerFunc: function(X,Y: integer): TBGRAPixel of object;
+
+  procedure DrawTextureLineWithoutLight(yb: integer; ix1: integer; ix2: integer;
+    info1,info2: TLinearTextureMappingIntersectionInfo;
+    WithInterpolation: boolean);
+    {$i lineartexscan.inc}
+
+  procedure DrawTextureLineWithLight(yb: integer; ix1: integer; ix2: integer;
+    info1,info2: TLinearTextureMappingIntersectionInfo;
+    WithInterpolation: boolean);
+    {$define PARAM_USELIGHTING}
+    {$i lineartexscan.inc}
+
+var
+  miny, maxy, minx, maxx: integer;
+
+  yb, i: integer;
+  x1, x2: single;
+
+  ix1, ix2: integer;
+
+begin
+  If not BGRAShapeComputeMinMax(polyInfo,minx,miny,maxx,maxy,bmp) then exit;
+
+  scanAtFunc := @texture.ScanAt;
+  scanAtIntegerFunc := @texture.ScanAtInteger;
+
+  inter := polyInfo.CreateIntersectionArray;
+
+  //vertical scan
+  for yb := miny to maxy do
+  begin
+    //find intersections
+    polyInfo.ComputeAndSort(yb+0.5,inter,nbInter,NonZeroWinding);
+    for i := 0 to nbinter div 2 - 1 do
+    begin
+      x1 := inter[i + i].interX;
+      x2 := inter[i + i+ 1].interX;
+
+      if x1 <> x2 then
+      begin
+        ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2);
+        if ix1 <= ix2 then
+        begin
+          if (TLinearTextureMappingIntersectionInfo(inter[i+i]).lightness = 32768) and
+             (TLinearTextureMappingIntersectionInfo(inter[i+i+1]).lightness = 32768) then
+            DrawTextureLineWithoutLight(yb,ix1,ix2,
+               TLinearTextureMappingIntersectionInfo(inter[i+i]),
+               TLinearTextureMappingIntersectionInfo(inter[i+i+1]),
+               TextureInterpolation)
+          else
+            DrawTextureLineWithLight(yb,ix1,ix2,
+               TLinearTextureMappingIntersectionInfo(inter[i+i]),
+               TLinearTextureMappingIntersectionInfo(inter[i+i+1]),
+               TextureInterpolation);
+        end;
+      end;
+    end;
+  end;
+
+  polyInfo.FreeIntersectionArray(inter);
+  bmp.InvalidateBitmap;
+end;
+{$hints on}
+
+procedure PolygonLinearTextureMappingAliased(bmp: TBGRACustomBitmap;
+  const points: array of TPointF; texture: IBGRAScanner;
+  const texCoords: array of TPointF; TextureInterpolation: Boolean; NonZeroWinding: boolean);
+var polyInfo: TPolygonLinearTextureMappingInfo;
+begin
+  polyInfo := TPolygonLinearTextureMappingInfo.Create(points,texCoords);
+  PolygonLinearTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation,NonZeroWinding);
+  polyInfo.Free;
+end;
+
+procedure PolygonLinearTextureMappingAliasedWithLightness(
+  bmp: TBGRACustomBitmap; const points: array of TPointF;
+  texture: IBGRAScanner; const texCoords: array of TPointF;
+  TextureInterpolation: Boolean; lightnesses: array of word;
+  NonZeroWinding: boolean);
+var polyInfo: TPolygonLinearTextureMappingInfo;
+begin
+  polyInfo := TPolygonLinearTextureMappingInfo.Create(points,texCoords,lightnesses);
+  PolygonLinearTextureMappingAliased(bmp,polyInfo,texture,TextureInterpolation,NonZeroWinding);
+  polyInfo.Free;
+end;
+
+{$i polyaliaspersp.inc}
+
+{From LazRGBGraphics}
+procedure BGRARoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer;
+  DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency;
+  skipFill: boolean = false);
+var
+  bBorder, bFill: TUniversalBrush;
+  skipBorder: Boolean;
+begin
+  dest.SolidBrush(bBorder, BorderColor, ADrawMode);
+  skipBorder := ((ADrawMode in[dmLinearBlend,dmDrawWithTransparency]) and (BorderColor.alpha=0))
+      or ((ADrawMode = dmSetExceptTransparent) and (BorderColor.alpha<>255))
+      or ((ADrawMode = dmXor) and (PLongWord(@BorderColor)^=0));
+
+  if FillTexture <> nil then
+    dest.ScannerBrush(bFill, FillTexture, ADrawMode)
+  else
+  begin
+    dest.SolidBrush(bFill, FillColor, ADrawMode);
+    skipFill := (skipFill or (ADrawMode in[dmLinearBlend,dmDrawWithTransparency]) and (FillColor.alpha=0))
+        or ((ADrawMode = dmSetExceptTransparent) and (FillColor.alpha<>255))
+        or ((ADrawMode = dmXor) and (PLongWord(@FillColor)^=0));
+  end;
+
+  BGRARoundRectAliased(dest, X1,Y1,X2,Y2, DX,DY, bBorder, bFill, 65535, skipBorder,skipFill);
+end;
+
+procedure BGRARoundRectAliased(dest: TCustomUniversalBitmap; X1, Y1, X2,
+  Y2: integer; DX, DY: integer; const BorderColor, FillColor: TUniversalBrush;
+  AAlpha: Word; skipBorder: boolean; skipFill: boolean);
+var
+  CX, CY, CX1, CY1, A, B, NX, NY: single;
+  X, Y, EX, EY: integer;
+  LX1, LY1: integer;
+  LX2, LY2: integer;
+  DivSqrA, DivSqrB: single;
+  I, J, S: integer;
+  EdgeList: array of TPoint;
+  temp:   integer;
+  LX, LY: integer;
+  RowStart,RowEnd: integer;
+
+  procedure AddEdge(X, Y: integer);
+  begin
+    If (Y > High(EdgeList)) or (Y < 0) then exit;
+    if (EdgeList[Y].X = -1) or (X < EdgeList[Y].X) then
+      EdgeList[Y].X := X;
+    if (EdgeList[Y].Y = -1) or (X > EdgeList[Y].Y) then
+      EdgeList[Y].Y := X;
+  end;
+
+begin
+  if AAlpha = 0 then exit;
+  if BorderColor.DoesNothing then skipBorder:= true;
+  if FillColor.DoesNothing then skipFill:= true;
+  if skipBorder and skipFill then exit;
+  if (x1 > x2) then
+  begin
+    temp := x1;
+    x1   := x2;
+    x2   := temp;
+  end;
+  if (y1 > y2) then
+  begin
+    temp := y1;
+    y1   := y2;
+    y2   := temp;
+  end;
+  if (x2 - x1 <= 0) or (y2 - y1 <= 0) then exit;
+  LX := x2 - x1 - DX;
+  LY := y2 - y1 - DY;
+  if LX < 0 then LX := 0;
+  if LY < 0 then LY := 0;
+  Dec(x2);
+  Dec(y2);
+
+  if (X1 = X2) and (Y1 = Y2) then
+  begin
+    if not skipBorder then
+      dest.DrawPixel(X1, Y1, BorderColor, AAlpha);
+    Exit;
+  end;
+  if (X2 - X1 = 1) or (Y2 - Y1 = 1) then
+  begin
+    if not skipBorder then
+      dest.FillRect(X1, Y1, X2 + 1, Y2 + 1, BorderColor, AAlpha);
+    Exit;
+  end;
+  if (LX > X2 - X1) or (LY > Y2 - Y1) then
+  begin
+    if not skipBorder then
+      dest.Rectangle(X1, Y1, X2 + 1, Y2 + 1, BorderColor, AAlpha);
+    if not skipFill then
+      dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillColor, AAlpha);
+    Exit;
+  end;
+
+  SetLength(EdgeList, Ceil((Y2 - Y1 + 1) / 2));
+  for I := 0 to Pred(High(EdgeList)) do
+    EdgeList[I] := Point(-1, -1);
+  EdgeList[High(EdgeList)] := Point(0, 0);
+
+  A  := (X2 - X1 + 1 - LX) / 2;
+  B  := (Y2 - Y1 + 1 - LY) / 2;
+  CX := (X2 + X1 + 1) / 2;
+  CY := (Y2 + Y1 + 1) / 2;
+
+  CX1 := X2 + 1 - A - Floor(CX);
+  CY1 := Y2 + 1 - B - Floor(CY);
+
+  EX := Floor(Sqr(A) / Sqrt(Sqr(A) + Sqr(B)) + Frac(A));
+  EY := Floor(Sqr(B) / Sqrt(Sqr(A) + Sqr(B)) + Frac(B));
+
+  DivSqrA := 1 / Sqr(A);
+  DivSqrB := 1 / Sqr(B);
+
+  NY := B;
+  AddEdge(Floor(CX1), Round(CY1 + B) - 1);
+  for X := 1 to Pred(EX) do
+  begin
+    NY := B * Sqrt(1 - Sqr(X + 0.5 - Frac(A)) * DivSqrA);
+
+    AddEdge(Floor(CX1) + X, Round(CY1 + NY) - 1);
+  end;
+
+  LX1 := Floor(CX1) + Pred(EX);
+  LY1 := Round(CY1 + NY) - 1;
+
+  NX := A;
+  AddEdge(Round(CX1 + A) - 1, Floor(CY1));
+  for Y := 1 to Pred(EY) do
+  begin
+    NX := A * Sqrt(1 - Sqr(Y + 0.5 - Frac(B)) * DivSqrB);
+
+    AddEdge(Round(CX1 + NX) - 1, Floor(CY1) + Y);
+  end;
+
+  LX2 := Round(CX1 + NX) - 1;
+  LY2 := Floor(CY1) + Pred(EY);
+
+  if Abs(LX1 - LX2) > 1 then
+  begin
+    if Abs(LY1 - LY2) > 1 then
+      AddEdge(LX1 + 1, LY1 - 1)
+    else
+      AddEdge(LX1 + 1, LY1);
+  end
+  else
+  if Abs(LY1 - LY2) > 1 then
+    AddEdge(LX2, LY1 - 1);
+
+  for I := 0 to High(EdgeList) do
+  begin
+    if EdgeList[I].X = -1 then
+      EdgeList[I] := Point(Round(CX1 + A) - 1, Round(CX1 + A) - 1)
+    else
+      Break;
+  end;
+
+  J := 0;
+  while J < Length(EdgeList) do
+  begin
+    if (J = 0) and (Frac(CY) > 0) then
+    begin
+      if not skipBorder then
+      for I := EdgeList[J].X to EdgeList[J].Y do
+      begin
+        dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor, AAlpha);
+        dest.DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor, AAlpha);
+      end;
+
+      if not SkipFill then
+        dest.HorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
+          Pred(EdgeList[J].X), FillColor, AAlpha);
+    end
+    else
+    if (J = High(EdgeList)) then
+    begin
+      if Frac(CX) > 0 then
+        S := -EdgeList[J].Y
+      else
+        S := -Succ(EdgeList[J].Y);
+
+      if not skipBorder then
+      for I := S to EdgeList[J].Y do
+      begin
+        dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor, AAlpha);
+        dest.DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor, AAlpha);
+      end;
+    end
+    else
+    begin
+      if not skipBorder then
+      for I := EdgeList[J].X to EdgeList[J].Y do
+      begin
+        dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, BorderColor, AAlpha);
+        dest.DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor, AAlpha);
+        if Floor(CX) + I <> Ceil(CX) - Succ(I) then
+        begin
+          dest.DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor, AAlpha);
+          dest.DrawPixel(Ceil(CX) - Succ(I), Ceil(CY) - Succ(J), BorderColor, AAlpha);
+        end;
+      end;
+
+      if not SkipFill then
+      begin
+        RowStart := Ceil(CX) - EdgeList[J].X;
+        RowEnd := Floor(CX) + Pred(EdgeList[J].X);
+        if RowEnd >= RowStart then
+        begin
+          dest.HorizLine(RowStart, Floor(CY) + J,
+            RowEnd, FillColor, AAlpha);
+          dest.HorizLine(RowStart, Ceil(CY) - Succ(J),
+            RowEnd, FillColor, AAlpha);
+        end;
+      end;
+
+    end;
+    Inc(J);
+  end;
+end;
+
+procedure BGRAFillRoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2,
+  Y2: integer; DX, DY: integer; FillColor: TBGRAPixel;
+  FillTexture: IBGRAScanner; ADrawMode: TDrawMode);
+var
+  fi: TFillRoundRectangleInfo;
+begin
+  fi := TFillRoundRectangleInfo.Create(x1,y1,x2,y2,dx/2,dy/2,[rrDefault],false);
+  FillShapeAliased(dest, fi, FillColor, false, FillTexture, true, ADrawMode);
+  fi.Free;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgraqtbitmap.pas

@@ -0,0 +1,158 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{
+ /**************************************************************************\
+                             bgraqtbitmap.pas
+                             -----------------
+                 This unit should NOT be added to the 'uses' clause.
+                 It contains patches for Qt.
+}
+
+unit BGRAQtBitmap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRALCLBitmap, Graphics,
+  GraphType, BGRABitmapTypes;
+
+type
+  { TBGRAQtBitmap }
+
+  TBGRAQtBitmap = class(TBGRALCLBitmap)
+  private
+    procedure SlowDrawTransparent(ABitmap: TBGRACustomBitmap;
+      ACanvas: TCanvas; ARect: TRect);
+  public
+    procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+      AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
+    procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer;
+      ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); override;
+    procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); override;
+    procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override;
+    procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override;
+  end;
+
+implementation
+
+uses LCLType,
+  LCLIntf, IntfGraphics,
+  qtobjects, {$ifdef LCLqt5}qt5{$else}qt4{$endif},
+  FPImage;
+
+procedure TBGRAQtBitmap.SlowDrawTransparent(ABitmap: TBGRACustomBitmap;
+  ACanvas: TCanvas; ARect: TRect);
+begin
+  ACanvas.StretchDraw(ARect, ABitmap.Bitmap);
+end;
+
+procedure TBGRAQtBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+var
+  Temp: TBGRALCLPtrBitmap;
+begin
+  Temp := TBGRALCLPtrBitmap.Create(AWidth, AHeight, AData);
+  Temp.LineOrder := ALineOrder;
+  SlowDrawTransparent(Temp, ACanvas, Rect);
+  Temp.Free;
+end;
+
+procedure TBGRAQtBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect;
+  AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
+{$IFDEF DARWIN}
+var
+  psrc,pdest: PBGRAPixel;
+  bmp: TBGRAQtBitmap;
+  x, y: integer;
+{$ENDIF}
+begin
+  {$IFDEF DARWIN}
+  bmp := TBGRAQtBitmap.Create(AWidth,AHeight);
+  try
+    if ALineOrder = riloTopToBottom then psrc := AData
+    else psrc := PBGRAPixel(AData) + (AWidth*(AHeight-1));
+    for y := 0 to AHeight-1 do
+    begin
+      pdest := bmp.ScanLine[y];
+      for x := 0 to AWidth-1 do
+      begin
+        pdest^.red := psrc^.red;
+        pdest^.green:= psrc^.green;
+        pdest^.blue := psrc^.blue;
+        pdest^.alpha := 255;
+        inc(psrc);
+        inc(pdest);
+      end;
+      if ALineOrder = riloBottomToTop then dec(psrc, 2*AWidth);
+    end;
+    bmp.Draw(ACanvas, ARect, false);
+  finally
+    bmp.Free;
+  end;
+  {$ELSE}
+  inherited DataDrawOpaque(ACanvas, ARect, AData, ALineOrder, AWidth, AHeight);
+  {$ENDIF}
+end;
+
+procedure TBGRAQtBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean);
+begin
+  if self = nil then
+    exit;
+  if Opaque then
+    DataDrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height), Data, FLineOrder,
+      FWidth, FHeight)
+  else
+    SlowDrawTransparent(Self, ACanvas, Rect(X, Y, X + Width, Y + Height));
+end;
+
+procedure TBGRAQtBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean);
+begin
+  if self = nil then
+    exit;
+  if Opaque then
+    DataDrawOpaque(ACanvas, Rect, Data, FLineOrder, FWidth, FHeight)
+  else
+    SlowDrawTransparent(Self, ACanvas, Rect);
+end;
+
+procedure TBGRAQtBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer);
+var
+  bmp: TBitmap;
+  Ofs: TPoint;
+  SrcX, SrcY: integer;
+  dcSource, dcDest: TQtDeviceContext;
+  B: Boolean;
+begin
+  DiscardBitmapChange;
+  bmp    := TBitmap.Create;
+  bmp.PixelFormat := pf24bit;
+  bmp.Width := Width;
+  bmp.Height := Height;
+  dcDest := TQtDeviceContext(bmp.Canvas.handle);
+
+  dcSource := TQtDeviceContext(CanvasSource.Handle);
+  LCLIntf.GetWindowOrgEx(CanvasSource.Handle, @Ofs);
+
+  SrcX     := x + Ofs.X;
+  SrcY     := y + Ofs.Y;
+
+  if (dcSource.vImage <> nil) and (dcSource.vImage.Handle <> nil) then
+  begin
+    // we must stop painting on device
+    B := QPainter_isActive(dcDest.Widget);
+    if B then
+      QPainter_end(dcDest.Widget);
+    TQtImage(bmp.Handle).CopyFrom(dcSource.vImage.Handle,
+      SrcX, SrcY, Width, Height);
+    if B then
+      QPainter_begin(dcDest.Widget, TQtImage(bmp.Handle).Handle);
+  end;
+
+  LoadFromRawImage(bmp.RawImage, 255, True);
+  bmp.Free;
+  InvalidateBitmap;
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrareadbmpmiomap.pas

@@ -0,0 +1,260 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAReadBmpMioMap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, FPimage, BGRABitmapTypes;
+
+const
+  MioMapMagicValue = 'RL';
+  MioMapTransparentColor = $F81F;
+
+type
+  TMioHeader = packed record
+    magic: packed array[1..2] of char;
+    format: word;
+    width,height,nbColors,nbChunks: word;
+  end;
+
+  TPixelArray = array of TBGRAPixel;
+
+  { TBGRAReaderBmpMioMap }
+
+  TBGRAReaderBmpMioMap = class(TFPCustomImageReader)
+  private
+    function ReadHeader(Stream: TStream; out header: TMioHeader): boolean;
+    function ReadPalette(Stream: TStream; nbColors: integer; alphaChannel: boolean): TPixelArray;
+    procedure UncompressChunks(Stream: TStream; nbChunks: integer; palette: TPixelArray; img: TFPCustomImage);
+  public
+    procedure InternalRead  (Stream:TStream; Img:TFPCustomImage); override;
+    function  InternalCheck (Stream:TStream) : boolean; override;
+  end;
+
+function MioMapToBGRA(AColor: Word): TBGRAPixel;
+function BGRAToMioMap(const AColor: TBGRAPixel): Word;
+function MioMapToAlpha(AValue: Byte): Byte;
+function AlphaToMioMap(AValue: Byte): Byte;
+
+implementation
+
+uses bufstream;
+
+function MioMapToBGRA(AColor: Word): TBGRAPixel;
+begin
+  if AColor = MioMapTransparentColor then
+    result := BGRAPixelTransparent
+  else
+    result := Color16BitToBGRA(AColor);
+end;
+
+function BGRAToMioMap(const AColor: TBGRAPixel): Word;
+begin
+  if AColor.alpha < 7 then
+    result := MioMapTransparentColor
+  else
+  begin
+    result := BGRAToColor16Bit(AColor);
+    if result = MioMapTransparentColor then dec(result);
+  end;
+end;
+
+function MioMapToAlpha(AValue: Byte): Byte;
+begin
+  result := AValue*255 div 32;
+end;
+
+function AlphaToMioMap(AValue: Byte): Byte;
+begin
+  result := (AValue*32 + 64) div 255;
+end;
+
+{ TBGRAReaderBmpMioMap }
+
+function TBGRAReaderBmpMioMap.ReadHeader(Stream: TStream; out header: TMioHeader
+  ): boolean;
+begin
+  result := false;
+  fillchar({%H-}header,sizeof(header),0);
+  if stream.Read(header, sizeof(header))<> sizeof(header) then exit;
+  if header.magic <> MioMapMagicValue then exit;
+  header.format:= LEtoN(header.format);
+  header.width:= LEtoN(header.width);
+  header.height:= LEtoN(header.height);
+  header.nbColors:= LEtoN(header.nbColors);
+  header.nbChunks:= LEtoN(header.nbChunks);
+  if header.format > 1 then exit;
+  result := true;
+end;
+
+function TBGRAReaderBmpMioMap.ReadPalette(Stream: TStream; nbColors: integer;
+  alphaChannel: boolean): TPixelArray;
+var mioPalette: packed array of word;
+  nbColorsRead,i: integer;
+  colorValue: word;
+  alphaPalette: packed array of byte;
+begin
+  setlength(mioPalette, nbColors);
+  setlength(result,nbColors);
+  nbColorsRead:= Stream.Read({%H-}mioPalette[0], nbColors*2) div 2;
+  for i := 0 to nbColorsRead-1 do
+  begin
+    colorValue := LEtoN(mioPalette[i]);
+    result[i] := MioMapToBGRA(colorValue);
+  end;
+  for i := nbColorsRead to nbColors-1 do
+    result[i] := BGRAPixelTransparent;
+  if alphaChannel then
+  begin
+    setlength(alphaPalette,nbColors);
+    Stream.Read(alphaPalette[0],nbColors);
+    for i := 0 to nbColors-1 do
+      if mioPalette[i] <> MioMapTransparentColor then
+        result[i].alpha := MioMapToAlpha(alphaPalette[i]);
+  end;
+end;
+
+procedure TBGRAReaderBmpMioMap.UncompressChunks(Stream: TStream; nbChunks: integer;
+  palette: TPixelArray; img: TFPCustomImage);
+var i,maxChunkSize: integer;
+  chunkSizes: array of integer;
+  chunkData: packed array of byte;
+  pos,bytesRead: integer;
+  palLen: integer;
+  x,y: integer;
+  p: PBGRAPixel;
+  colorOffset: integer;
+  b: byte;
+  w,h: integer;
+
+  procedure UncompressPixel(colorNumber, repeatCount: integer);
+  var
+    c: TBGRAPixel;
+  begin
+    if colorNumber >= palLen then
+      c := BGRAPixelTransparent
+    else
+      c := palette[colorNumber];
+    while (repeatCount > 0) and (y < h) do
+    begin
+      if p <> nil then
+      begin
+        p^ := c;
+        inc(p);
+      end else
+        img.Colors[x,y] := BGRAToFPColor(c);
+      inc(x);
+      if x = w then
+      begin
+        x := 0;
+        inc(y);
+        if p <> nil then
+        begin
+          if y >= h then p := nil
+          else
+            p := TBGRACustomBitmap(Img).ScanLine[y];
+        end;
+      end;
+      dec(repeatCount);
+    end;
+  end;
+
+begin
+  palLen := length(palette);
+  if (img.Width = 0) or (img.Height = 0) or (palLen = 0) then exit;
+
+  maxChunkSize := 1;
+  setlength(chunkSizes, nbChunks);
+  for i := 0 to nbChunks-1 do
+  begin
+    if stream.read({%H-}b,1)=0 then b := 0;
+    if b < 255 then
+    begin
+      chunkSizes[i] := b;
+    end else
+    begin
+      if stream.read(b,1)=0 then b := 0;
+      chunkSizes[i] := b shl 8;
+      if stream.read(b,1)=0 then b := 0;
+      inc(chunkSizes[i], b);
+    end;
+    if chunkSizes[i]>maxChunkSize then
+      maxChunkSize := chunkSizes[i];
+  end;
+
+  setlength(chunkData, maxChunkSize);
+  x := 0;
+  y := 0;
+  w := img.Width;
+  h := img.Height;
+  colorOffset:= 0;
+  if Img is TBGRACustomBitmap then
+  begin
+    p := TBGRACustomBitmap(Img).ScanLine[y];
+    TBGRACustomBitmap(Img).FillTransparent;
+  end
+  else
+    p := nil;
+  for i:= 0 to nbChunks-1 do
+  begin
+    bytesRead := Stream.Read(chunkData[0], chunkSizes[i]);
+    pos := 0;
+    while pos < bytesRead do
+    begin
+      if (chunkData[pos] = $FE) and (pos+2 < bytesRead) then
+      begin
+        UncompressPixel(chunkData[pos+1]+colorOffset,chunkData[pos+2]);
+        inc(pos,3);
+      end else
+      if (chunkData[pos] = $ff) and (pos+1 < bytesRead) then
+      begin
+        UncompressPixel(0,chunkData[pos+1]);
+        inc(pos,2);
+      end else
+      if (chunkData[pos] = $fd) and (pos+2 < bytesRead) then
+      begin
+        colorOffset:= chunkData[pos+1] + (chunkData[pos+2] shl 8);
+        inc(pos,3);
+      end else
+      if chunkData[pos] = 0 then
+      begin
+        UncompressPixel(0,1);
+        inc(pos);
+      end else
+      begin
+        UncompressPixel(chunkData[pos]+colorOffset,1);
+        inc(pos);
+      end;
+    end;
+  end;
+end;
+
+procedure TBGRAReaderBmpMioMap.InternalRead(Stream: TStream; Img: TFPCustomImage);
+var header: TMioHeader;
+  palette: TPixelArray;
+  buf: TReadBufStream;
+begin
+  if not ReadHeader(stream, header) then exit;
+  buf := TReadBufStream.Create(Stream,1024);
+  Img.SetSize(header.width,header.height);
+  palette := ReadPalette(stream, header.nbColors, header.format = 1);
+  UncompressChunks(stream,header.nbChunks, palette, Img);
+  buf.Free;
+end;
+
+function TBGRAReaderBmpMioMap.InternalCheck(Stream: TStream): boolean;
+var OldPosition : int64;
+  dummy: TMioHeader;
+begin
+  OldPosition:= stream.Position;
+  result := ReadHeader(stream, dummy);
+  stream.Position:= OldPosition;
+end;
+
+initialization
+
+  DefaultBGRAImageReader[ifBmpMioMap] := TBGRAReaderBmpMioMap;
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgrareadgif.pas

@@ -0,0 +1,381 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{ This unit provides some optimisations of TFPReaderGif: decompression algorithm and direct pixel access of TBGRABitmap.
+  Note: to read an animation use TBGRAAnimatedGif instead. }
+
+unit BGRAReadGif;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, FPimage, FPReadGif;
+
+type
+  PGifRGB = ^TGifRGB;
+
+  { TBGRAReaderGif }
+
+  TBGRAReaderGif = class(TFPReaderGif)
+  protected
+    procedure ReadPaletteAtOnce(Stream: TStream; Size: integer);
+    procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
+    function ReadScanLine(Stream: TStream): boolean; override;
+    function WriteScanLineBGRA(Img: TFPCustomImage): Boolean; virtual;
+  end;
+
+implementation
+
+uses BGRABitmapTypes;
+
+{ TBGRAReaderGif }
+
+procedure TBGRAReaderGif.ReadPaletteAtOnce(Stream: TStream; Size: integer);
+Var
+  RGBEntries, RGBEntry : PGifRGB;
+  I : Integer;
+  c : TFPColor;
+begin
+  FPalette.count := 0;
+  getmem(RGBEntries, sizeof(TGifRGB)*Size);
+  Stream.Read(RGBEntries^, sizeof(TGifRGB)*Size);
+  For I:=0 To Size-1 Do
+  Begin
+    RGBEntry := RGBEntries+I;
+    With c do
+    begin
+      Red:=RGBEntry^.Red or (RGBEntry^.Red shl 8);
+      Green:=RGBEntry^.Green or (RGBEntry^.Green shl 8);
+      Blue:=RGBEntry^.Blue or (RGBEntry^.Blue shl 8);
+      Alpha:=alphaOpaque;
+    end;
+    FPalette.Add(C);
+  End;
+  FreeMem(RGBEntries);
+end;
+
+procedure TBGRAReaderGif.InternalRead(Stream: TStream; Img: TFPCustomImage);
+var
+  Introducer:byte;
+  ColorTableSize :Integer;
+  ContProgress: Boolean;
+begin
+  FPalette:=nil;
+  FScanLine:=nil;
+  try
+    ContProgress:=true;
+    Progress(psStarting, 0, False, Rect(0,0,0,0), '', ContProgress);
+    if not ContProgress then exit;
+
+    FPalette := TFPPalette.Create(0);
+
+    Stream.Position:=0;
+    // header
+    Stream.Read(FHeader,SizeOf(FHeader));
+    Progress(psRunning, 0, False, Rect(0,0,0,0), '', ContProgress);
+    if not ContProgress then exit;
+
+    // Endian Fix Mantis 8541. Gif is always little endian
+    {$IFDEF ENDIAN_BIG}
+      with FHeader do
+        begin
+          ScreenWidth := LEtoN(ScreenWidth);
+          ScreenHeight := LEtoN(ScreenHeight);
+        end;
+    {$ENDIF}
+    // global palette
+    if (FHeader.Packedbit and $80) <> 0 then
+    begin
+      ColorTableSize := FHeader.Packedbit and 7 + 1;
+      ReadPaletteAtOnce(stream, 1 shl ColorTableSize);
+    end;
+
+    // skip extensions
+    Repeat
+      Introducer:=SkipBlock(Stream);
+    until (Introducer = $2C) or (Introducer = $3B);
+
+    // descriptor
+    Stream.Read(FDescriptor, SizeOf(FDescriptor));
+    {$IFDEF ENDIAN_BIG}
+      with FDescriptor do
+        begin
+          Left := LEtoN(Left);
+          Top := LEtoN(Top);
+          Width := LEtoN(Width);
+          Height := LEtoN(Height);
+        end;
+    {$ENDIF}
+    // local palette
+    if (FDescriptor.Packedbit and $80) <> 0 then
+    begin
+      ColorTableSize := FDescriptor.Packedbit and 7 + 1;
+      ReadPaletteAtOnce(stream, 1 shl ColorTableSize);
+    end;
+
+    // parse header
+    if not AnalyzeHeader then exit;
+
+    // create image
+    if Assigned(OnCreateImage) then
+      OnCreateImage(Self,Img);
+    Img.SetSize(FWidth,FHeight);
+
+    // read pixels
+    if not ReadScanLine(Stream) then exit;
+    if Img is TBGRACustomBitmap then
+    begin
+      if not WriteScanLineBGRA(Img) then exit;
+    end else
+      if not WriteScanLine(Img) then exit;
+
+    // ToDo: read further images
+  finally
+    FreeAndNil(FPalette);
+    ReAllocMem(FScanLine,0);
+  end;
+  Progress(FPimage.psEnding, 100, false, Rect(0,0,FWidth,FHeight), '', ContProgress);
+end;
+
+function TBGRAReaderGif.ReadScanLine(Stream: TStream): Boolean;
+var
+  OldPos,
+  UnpackedSize,
+  PackedSize:longint;
+  I: Integer;
+  Data,
+  Bits,
+  Code: LongWord;
+  SourcePtr: PByte;
+  InCode: LongWord;
+
+  CodeSize: LongWord;
+  CodeMask: LongWord;
+  FreeCode: LongWord;
+  OldCode: LongWord;
+  Prefix: array[0..4095] of LongWord;
+  Suffix,
+  Stack: array [0..4095] of Byte;
+  StackPointer, StackTop: PByte;
+  StackSize: integer;
+  DataComp,
+  Target: PByte;
+  {%H-}B,
+  {%H-}FInitialCodeSize,
+  FirstChar: Byte;
+  ClearCode,
+  EOICode: Word;
+  ContProgress: Boolean;
+
+begin
+  DataComp:=nil;
+  ContProgress:=true;
+  try
+    // read dictionary size
+    Stream.read({%H-}FInitialCodeSize, 1);
+
+    // search end of compressor table
+    OldPos:=Stream.Position;
+    PackedSize := 0;
+    Repeat
+      Stream.read({%H-}B, 1);
+      if B > 0 then
+      begin
+        inc(PackedSize, B);
+        Stream.Seek(B, soFromCurrent);
+      end;
+    until B = 0;
+
+    Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),
+             False, Rect(0,0,0,0), '', ContProgress);
+    if not ContProgress then exit(false);
+
+    Getmem(DataComp, PackedSize);
+    // read compressor table
+    SourcePtr:=DataComp;
+    Stream.Position:=OldPos;
+    Repeat
+      Stream.read(B, 1);
+      if B > 0 then
+      begin
+         Stream.ReadBuffer(SourcePtr^, B);
+         Inc(SourcePtr,B);
+      end;
+    until B = 0;
+
+    Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),
+             False, Rect(0,0,0,0), '', ContProgress);
+    if not ContProgress then exit(false);
+
+    SourcePtr:=DataComp;
+    Target := FScanLine;
+    CodeSize := FInitialCodeSize + 1;
+    ClearCode := 1 shl FInitialCodeSize;
+    EOICode := ClearCode + 1;
+    FreeCode := ClearCode + 2;
+    OldCode := 4096;
+    CodeMask := (1 shl CodeSize) - 1;
+    UnpackedSize:=FWidth * FHeight;
+    for I := 0 to ClearCode - 1 do
+    begin
+      Prefix[I] := 4096;
+      Suffix[I] := I;
+    end;
+    StackTop := @Stack[high(Stack)];
+    StackPointer := StackTop;
+    FirstChar := 0;
+    Data := 0;
+    Bits := 0;
+    // LZW decompression gif
+    while (UnpackedSize > 0) and (PackedSize > 0) do
+    begin
+      Inc(Data, SourcePtr^ shl Bits);
+      Inc(Bits, 8);
+      while Bits >= CodeSize do
+      begin
+        Code := Data and CodeMask;
+        Data := Data shr CodeSize;
+        Dec(Bits, CodeSize);
+        if Code = EOICode then Break;
+        if Code = ClearCode then
+        begin
+          CodeSize := FInitialCodeSize + 1;
+          CodeMask := (1 shl CodeSize) - 1;
+          FreeCode := ClearCode + 2;
+          OldCode := 4096;
+          Continue;
+        end;
+        if Code > FreeCode then Break;
+        if OldCode = 4096 then
+        begin
+          FirstChar := Suffix[Code];
+          Target^ := FirstChar;
+          Inc(Target);
+          Dec(UnpackedSize);
+          OldCode := Code;
+          Continue;
+        end;
+        InCode := Code;
+        if Code = FreeCode then
+        begin
+          StackPointer^ := FirstChar;
+          dec(StackPointer);
+          Code := OldCode;
+        end;
+        while Code > ClearCode do
+        begin
+          StackPointer^ := Suffix[Code];
+          dec(StackPointer);
+          Code := Prefix[Code];
+        end;
+        FirstChar := Suffix[Code];
+        StackPointer^ := FirstChar;
+        dec(StackPointer);
+        Prefix[FreeCode] := OldCode;
+        Suffix[FreeCode] := FirstChar;
+        if (FreeCode = CodeMask) and
+           (CodeSize < 12) then
+        begin
+          Inc(CodeSize);
+          CodeMask := (1 shl CodeSize) - 1;
+        end;
+        if FreeCode < 4095 then Inc(FreeCode);
+        OldCode := InCode;
+        StackSize := StackTop-StackPointer;
+        if StackSize > 0 then
+        begin
+          Move((StackPointer+1)^, Target^, StackSize);
+          inc(Target, StackSize);
+          StackPointer:= StackTop;
+          dec(UnpackedSize, StackSize);
+        end;
+      end;
+      Inc(SourcePtr);
+      Dec(PackedSize);
+    end;
+    Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),
+             False, Rect(0,0,0,0), '', ContProgress);
+    if not ContProgress then exit(false);
+  finally
+    if DataComp<>nil then
+      FreeMem(DataComp);
+  end;
+  Result:=true;
+end;
+
+function TBGRAReaderGif.WriteScanLineBGRA(Img: TFPCustomImage): Boolean;
+Var
+  Row, Col,i : Integer;
+  Pass, Every : byte;
+  P : PByte;
+  PBGRAPalette: PBGRAPixel;
+  PDest: PBGRAPixel;
+  function IsMultiple(NumberA, NumberB: Integer): Boolean;
+  begin
+    Result := (NumberA >= NumberB) and
+              (NumberB > 0) and
+              (NumberA mod NumberB = 0);
+  end;
+begin
+  Result:=false;
+  P:=FScanLine;
+  getmem(PBGRAPalette, (FPalette.Count)*sizeof(TBGRAPixel));
+  for i := 0 to FPalette.Count-1 do PBGRAPalette[i] := FPColorToBGRA(FPalette.Color[i]);
+  If FInterlace then
+  begin
+    For Pass := 1 to 4 do
+    begin
+      Case Pass of
+         1 : begin
+               Row := 0;
+               Every := 8;
+             end;
+         2 : begin
+               Row := 4;
+               Every := 8;
+             end;
+         3 : begin
+               Row := 2;
+               Every := 4;
+             end;
+         else{4}
+             begin
+               Row := 1;
+               Every := 2;
+             end;
+        end;
+      Repeat
+        PDest := TBGRACustomBitmap(Img).ScanLine[Row];
+        for Col:=Img.Width-1 downto 0 do
+        begin
+          PDest^ := PBGRAPalette[P^];
+          Inc(P);
+          Inc(PDest);
+        end;
+        Inc(Row, Every);
+      until Row >= Img.Height;
+    end;
+  end
+  else
+  begin
+    for Row:=0 to Img.Height-1 do
+    begin
+      PDest := TBGRACustomBitmap(Img).ScanLine[Row];
+      for Col:=Img.Width-1 downto 0 do
+      begin
+        PDest^ := PBGRAPalette[P^];
+        Inc(P);
+        Inc(PDest);
+      end;
+    end;
+  end;
+  FreeMem(PBGRAPalette);
+  Result:=true;
+end;
+
+
+initialization
+
+  DefaultBGRAImageReader[ifGif] := TBGRAReaderGif;
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgrareadico.pas

@@ -0,0 +1,149 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAReadIco;
+
+{$mode objfpc}{$H+}
+{$i bgrabitmap.inc}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, FPimage{$IFDEF BGRABITMAP_USE_LCL}, Graphics{$ENDIF};
+
+type
+  {$IFDEF BGRABITMAP_USE_LCL}TCustomIconClass = class of TCustomIcon;{$ENDIF}
+  TByteSet = set of byte;
+
+  { TBGRAReaderIcoOrCur }
+
+  TBGRAReaderIcoOrCur = class(TFPCustomImageReader)
+  protected
+    procedure InternalRead({%H-}Str: TStream; {%H-}Img: TFPCustomImage); override;
+    function InternalCheck(Str: TStream): boolean; override;
+    function ExpectedMagic: TByteSet; virtual; abstract;
+    {$IFDEF BGRABITMAP_USE_LCL}function LazClass: TCustomIconClass; virtual; abstract;{$ENDIF}
+  public
+    WantedWidth, WantedHeight : integer;
+  end;
+
+  TBGRAReaderIco = class(TBGRAReaderIcoOrCur)
+  protected
+    function ExpectedMagic: TByteSet; override;
+    {$IFDEF BGRABITMAP_USE_LCL}function LazClass: TCustomIconClass; override;{$ENDIF}
+  end;
+
+  { TBGRAReaderCur }
+
+  TBGRAReaderCur = class(TBGRAReaderIcoOrCur)
+  protected
+    function ExpectedMagic: TByteSet; override;
+    {$IFDEF BGRABITMAP_USE_LCL}function LazClass: TCustomIconClass; override;{$ENDIF}
+  end;
+
+implementation
+
+uses BGRABitmapTypes{$IFNDEF BGRABITMAP_USE_LCL}, BGRAIconCursor{$ENDIF};
+
+{ TBGRAReaderCur }
+
+function TBGRAReaderCur.ExpectedMagic: TByteSet;
+begin
+  result := [2];
+end;
+
+{$IFDEF BGRABITMAP_USE_LCL}function TBGRAReaderCur.LazClass: TCustomIconClass;
+begin
+  result := TCursorImage;
+end;{$ENDIF}
+
+{ TBGRAReaderIco }
+
+function TBGRAReaderIco.ExpectedMagic: TByteSet;
+begin
+  result := [1,2];
+end;
+
+{$IFDEF BGRABITMAP_USE_LCL}function TBGRAReaderIco.LazClass: TCustomIconClass;
+begin
+  result := TIcon;
+end;{$ENDIF}
+
+{ TBGRAReaderIcoOrCur }
+
+procedure TBGRAReaderIcoOrCur.InternalRead(Str: TStream; Img: TFPCustomImage);
+{$IFDEF BGRABITMAP_USE_LCL}
+var ico: TCustomIcon; i,bestIdx: integer;
+    height,width: word; format:TPixelFormat;
+    bestHeight,bestWidth: integer; maxFormat: TPixelFormat;
+    compWidth,compHeight: integer;
+begin
+  if WantedWidth > 0 then compWidth:= WantedWidth else compWidth:= 65536;
+  if WantedHeight > 0 then compHeight:= WantedHeight else compHeight:= 65536;
+  ico := LazClass.Create;
+  try
+    ico.LoadFromStream(Str);
+    bestIdx := -1;
+    bestHeight := 0;
+    bestWidth := 0;
+    maxFormat := pfDevice;
+    for i := 0 to ico.Count-1 do
+    begin
+      ico.GetDescription(i,format,height,width);
+      if (bestIdx = -1) or (abs(height-compHeight)+abs(width-compWidth) < abs(bestHeight-compHeight)+abs(bestWidth-compWidth)) or
+      ((height = bestHeight) and (width = bestWidth) and (format > maxFormat)) then
+      begin
+        bestIdx := i;
+        bestHeight := height;
+        bestWidth := width;
+        maxFormat := format;
+      end;
+    end;
+    if (bestIdx = -1) or (bestWidth = 0) or (bestHeight = 0) then
+      raise exception.Create('No adequate icon found') else
+    begin
+      ico.Current := bestIdx;
+      Img.Assign(ico);
+    end;
+  finally
+    ico.free;
+  end;
+end;
+{$ELSE}
+var icoCur: TBGRAIconCursor;
+    compWidth,compHeight: integer;
+    bmp: TBGRACustomBitmap;
+begin
+  if WantedWidth > 0 then compWidth:= WantedWidth else compWidth:= 65536;
+  if WantedHeight > 0 then compHeight:= WantedHeight else compHeight:= 65536;
+  icoCur := TBGRAIconCursor.Create(Str);
+  try
+    bmp := icoCur.GetBestFitBitmap(compWidth,compHeight);
+    try
+      Img.Assign(bmp);
+    finally
+      bmp.Free;
+    end;
+  finally
+    icoCur.Free;
+  end;
+end;
+{$ENDIF}
+
+function TBGRAReaderIcoOrCur.InternalCheck(Str: TStream): boolean;
+var {%H-}magic: packed array[0..5] of byte;
+    oldPos: int64;
+begin
+  oldPos := str.Position;
+  result := (str.Read({%H-}magic,sizeof(magic)) = sizeof(magic));
+  str.Position:= oldPos;
+  if result then
+    result := (magic[0] = $00) and (magic[1] = $00) and (magic[2] in ExpectedMagic) and (magic[3] = $00) and
+             (magic[4] + (magic[5] shl 8) > 0);
+end;
+
+initialization
+
+  DefaultBGRAImageReader[ifIco] := TBGRAReaderIco;
+  DefaultBGRAImageReader[ifCur] := TBGRAReaderCur;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrareadjpeg.pas

@@ -0,0 +1,63 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAReadJpeg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, FPReadJPEG;
+
+type
+  TJPEGScale = FPReadJPEG.TJPEGScale;
+  TJPEGReadPerformance = FPReadJPEG.TJPEGReadPerformance;
+
+const
+  jsFullSize = FPReadJPEG.jsFullSize;
+  jsHalf = FPReadJPEG.jsHalf;
+  jsQuarter = FPReadJPEG.jsQuarter;
+  jsEighth = FPReadJPEG.jsEighth;
+
+  jpBestQuality = FPReadJPEG.jpBestQuality;
+  jpBestSpeed = FPReadJPEG.jpBestSpeed;
+
+type
+  { TBGRAReaderJpeg }
+
+  TBGRAReaderJpeg = class(TFPReaderJPEG)
+    constructor Create; override;
+  protected
+    function InternalCheck(Str: TStream): boolean; override;
+  end;
+
+implementation
+
+uses BGRABitmapTypes;
+
+{ TBGRAReaderJpeg }
+
+constructor TBGRAReaderJpeg.Create;
+begin
+  inherited Create;
+  Performance := jpBestQuality;
+end;
+
+function TBGRAReaderJpeg.InternalCheck(Str: TStream): boolean;
+var {%H-}magic: packed array[0..3] of byte;
+  OldPos,BytesRead:int64;
+begin
+  Result:=false;
+  if Str=nil then exit;
+  OldPos:= str.Position;
+  BytesRead := str.Read({%H-}magic,sizeof(magic));
+  str.Position:=OldPos;
+  if BytesRead<>sizeof(magic) then exit;
+  if (magic[0] = $ff) and (magic[1] = $d8) and (magic[2] = $ff) and (magic[3] >= $c0) then result := true;
+end;
+
+initialization
+
+  DefaultBGRAImageReader[ifJpeg] := TBGRAReaderJpeg;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrareadlzp.pas

@@ -0,0 +1,377 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAReadLzp;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, FPimage, BGRALzpCommon, BGRABitmapTypes, BGRABitmap;
+
+type
+
+  { TBGRAReaderLazPaint }
+
+  TBGRAReaderLazPaint = class(TFPCustomImageReader)
+  private
+    FHeight: integer;
+    FNbLayers: integer;
+    FWidth: integer;
+    FCaption: string;
+    FDimensionsAlreadyFetched: boolean;
+  protected
+    procedure InternalRead(Str: TStream; Img: TFPCustomImage); override;
+    procedure InternalReadLayers({%H-}str: TStream;{%H-}Img: TFPCustomImage); virtual;
+    procedure InternalReadCompressableBitmap(str: TStream; Img: TFPCustomImage); virtual;
+    function InternalCheck(Str: TStream): boolean; override;
+  public
+    WantThumbnail: boolean;
+    class procedure LoadRLEImage(Str: TStream; Img: TFPCustomImage; out ACaption: string); static;
+    property Width: integer read FWidth;
+    property Height: integer read FHeight;
+    property NbLayers: integer read FNbLayers;
+    property Caption: string read FCaption;
+  end;
+
+implementation
+
+uses BGRACompressableBitmap, BGRAReadPng;
+
+{ TBGRAReaderLazPaint }
+
+procedure TBGRAReaderLazPaint.InternalRead(Str: TStream; Img: TFPCustomImage);
+var
+  {%H-}header: TLazPaintImageHeader;
+  oldPos: int64;
+  png: TBGRAReaderPNG;
+
+begin
+  FCaption := '';
+  FWidth:= 0;
+  FHeight:= 0;
+  FNbLayers:= 0;
+  FDimensionsAlreadyFetched:= false;
+  oldPos := str.Position;
+  str.ReadBuffer({%H-}header.magic,sizeof(header.magic));
+  if header.magic = LAZPAINT_MAGIC_HEADER then
+  begin
+    str.ReadBuffer(header.zero1, sizeof(header)-sizeof(header.magic));
+    LazPaintImageHeader_SwapEndianIfNeeded(header);
+    if (header.zero1 <> 0) or (header.zero2 <> 0) or
+       (header.headerSize < $30) then raise exception.Create('Invalid file format');
+    FWidth:= header.width;
+    FHeight:= header.height;
+    FNbLayers:= header.nbLayers;
+    FDimensionsAlreadyFetched:= true;
+
+    if WantThumbnail and ((header.compressionMode and LAZPAINT_THUMBNAIL_PNG) <> 0) then
+      begin
+        str.Position:= oldPos+header.headerSize;
+        png := TBGRAReaderPNG.create;
+        try
+          png.ImageRead(Str,Img);
+        except
+          png.Free;
+          raise exception.Create('Invalid file format');
+        end;
+        png.free;
+        exit;
+      end;
+
+    if ((header.compressionMode and LAZPAINT_COMPRESSION_MASK) <> LAZPAINT_COMPRESSION_MODE_ZSTREAM) and
+      ((header.compressionMode and LAZPAINT_COMPRESSION_MASK) <> LAZPAINT_COMPRESSION_MODE_RLE)  then raise exception.Create('Compression mode not supported');
+
+    str.Position:= oldPos+header.previewOffset;
+    if (header.compressionMode and LAZPAINT_COMPRESSION_MASK) = LAZPAINT_COMPRESSION_MODE_RLE then
+      LoadRLEImage(Str, Img, FCaption)
+    else
+      InternalReadCompressableBitmap(str,Img);
+
+    if header.layersOffset > 0 then
+    begin
+      Str.Position:= oldPos+header.layersOffset;
+      InternalReadLayers(Str,Img);
+    end;
+  end else
+  begin
+    str.Position:= oldPos;
+    InternalReadCompressableBitmap(str,Img);
+    if (Str.Position < Str.Size) and (FCaption = 'Preview') then InternalReadLayers(Str,Img);
+  end;
+end;
+
+procedure TBGRAReaderLazPaint.InternalReadLayers(str: TStream;
+  Img: TFPCustomImage);
+begin
+  //not implemented here
+end;
+
+procedure TBGRAReaderLazPaint.InternalReadCompressableBitmap(str: TStream;
+  Img: TFPCustomImage);
+var
+  compressed: TBGRACompressableBitmap;
+  bmp: TBGRABitmap;
+begin
+  compressed := TBGRACompressableBitmap.Create;
+  try
+    compressed.ReadFromStream(Str);
+    bmp := compressed.GetBitmap;
+    try
+      FCaption := compressed.Caption;
+      if (Img is TBGRACustomBitmap) then
+        TBGRACustomBitmap(Img).Assign(bmp)
+      else
+        Img.Assign(bmp);
+      if not FDimensionsAlreadyFetched then
+        begin
+          FDimensionsAlreadyFetched := true;
+          FWidth:= bmp.width;
+          FHeight:= bmp.height;
+          FNbLayers:= 1;
+        end;
+    finally
+      bmp.Free;
+    end;
+  finally
+    compressed.Free;
+  end;
+end;
+
+function TBGRAReaderLazPaint.InternalCheck(Str: TStream): boolean;
+var {%H-}magic: packed array[0..7] of byte;
+    magicAsText: string;
+    oldPos: int64;
+begin
+  oldPos := str.Position;
+  result := (str.Read({%H-}magic,sizeof(magic)) = sizeof(magic));
+  str.Position:= oldPos;
+  setlength(magicAsText, sizeof(magic));
+  move(magic[0], magicAsText[1], sizeof(magic));
+  result := (copy(magicAsText,1,8) = 'LazPaint') or
+    (((magic[0] <> 0) or (magic[1] <> 0)) and (magic[2] = 0) and (magic[3] = 0) and
+     ((magic[4] <> 0) or (magic[5] <> 0)) and (magic[6] = 0) and (magic[7] = 0));
+end;
+
+class procedure TBGRAReaderLazPaint.LoadRLEImage(Str: TStream; Img: TFPCustomImage; out ACaption: string);
+var channelFlags: byte;
+    w,h,NbPixels,nameLen,channelStreamSize: LongWord;
+    nextPosition: int64;
+    PIndexed,PRed,PGreen,PBlue,PAlpha,
+    PCurRed, PCurGreen, PCurBlue, PCurAlpha: PByte;
+    PDest: PBGRAPixel;
+    x,y: LongWord;
+    c: TFPColor;
+    n,NbNonTransp: LongWord;
+    a,index: Int32or64;
+    ColorTab: packed array[0..256*3-1] of byte;
+begin
+  w := LEtoN(str.ReadDWord);
+  h := LEtoN(str.ReadDWord);
+  nameLen := LEtoN(str.ReadDWord);
+  setlength(ACaption, nameLen);
+  {$PUSH}{$RANGECHECKS OFF}
+  str.ReadBuffer(ACaption[1], nameLen);
+  {$POP}
+  channelFlags := str.ReadByte;
+  NbPixels := w*h;
+
+  PRed := nil;
+  PGreen := nil;
+  PBlue := nil;
+  PAlpha := nil;
+
+  try
+    if (channelFlags and LazpaintChannelNoAlpha) = 0 then
+      begin
+        Getmem(PAlpha, NbPixels);
+        channelStreamSize := LEtoN(str.ReadDWord);
+        nextPosition:= str.Position+channelStreamSize;
+        if (channelStreamSize > 0) and (NbPixels > 0) then DecodeLazRLE(Str, PAlpha^, NbPixels);
+        Str.Position:= nextPosition;
+
+        NbNonTransp := 0;
+        PCurAlpha := PAlpha;
+        for n := NbPixels-1 downto 0 do
+        begin
+          if PCurAlpha^ <> 0 then inc(NbNonTransp);
+          inc(PCurAlpha);
+        end;
+      end else
+        NbNonTransp:= NbPixels;
+
+    if NbNonTransp > 0 then
+    begin
+      if (channelFlags and LazpaintPalettedRGB) <> 0 then
+      begin
+        Getmem(PIndexed, NbNonTransp);
+        try
+          Getmem(PRed, NbNonTransp);
+          Getmem(PGreen, NbNonTransp);
+          Getmem(PBlue, NbNonTransp);
+          fillchar({%H-}ColorTab,sizeof(ColorTab),0);
+
+          channelStreamSize := LEtoN(str.ReadDWord);
+          nextPosition:= str.Position+channelStreamSize;
+          DecodeLazRLE(Str, colorTab[0], 256);
+          Str.Position:= nextPosition;
+
+          if (channelFlags and LazPaintChannelGreenFromRed) <> 0 then
+            move(ColorTab[0],colorTab[256], 256)
+          else
+          begin
+            channelStreamSize := LEtoN(str.ReadDWord);
+            nextPosition:= str.Position+channelStreamSize;
+            DecodeLazRLE(Str, colorTab[256], 256);
+            Str.Position:= nextPosition;
+          end;
+          if (channelFlags and LazPaintChannelBlueFromRed) <> 0 then
+            move(ColorTab[0],colorTab[512], 256)
+          else if (channelFlags and LazpaintChannelBlueFromGreen) <> 0 then
+            move(ColorTab[256],colorTab[512], 256)
+          else
+          begin
+            channelStreamSize := LEtoN(str.ReadDWord);
+            nextPosition:= str.Position+channelStreamSize;
+            DecodeLazRLE(Str, colorTab[512], 256);
+            Str.Position:= nextPosition;
+          end;
+
+          channelStreamSize := LEtoN(str.ReadDWord);
+          nextPosition:= str.Position+channelStreamSize;
+          DecodeLazRLE(Str, PIndexed^, NbNonTransp);
+          Str.Position:= nextPosition;
+
+          for n := 0 to NbNonTransp-1 do
+          begin
+            index := (PIndexed+n)^;
+            (PRed+n)^ := colorTab[index];
+            (PGreen+n)^ := colorTab[index+256];
+            (PBlue+n)^ := colorTab[index+512];
+          end;
+        finally
+          FreeMem(PIndexed);
+        end;
+      end else
+      begin
+        Getmem(PRed, NbNonTransp);
+        channelStreamSize := LEtoN(str.ReadDWord);
+        nextPosition:= str.Position+channelStreamSize;
+        DecodeLazRLE(Str, PRed^, NbNonTransp);
+        Str.Position:= nextPosition;
+
+        if (channelFlags and LazPaintChannelGreenFromRed) <> 0 then PGreen := PRed else
+        begin
+          Getmem(PGreen, NbNonTransp);
+          channelStreamSize := LEtoN(str.ReadDWord);
+          nextPosition:= str.Position+channelStreamSize;
+          DecodeLazRLE(Str, PGreen^, NbNonTransp);
+          Str.Position:= nextPosition;
+        end;
+
+        if (channelFlags and LazPaintChannelBlueFromRed) <> 0 then PBlue := PRed else
+        if (channelFlags and LazPaintChannelBlueFromGreen) <> 0 then PBlue := PGreen else
+        begin
+          Getmem(PBlue, NbNonTransp);
+          channelStreamSize := LEtoN(str.ReadDWord);
+          nextPosition:= str.Position+channelStreamSize;
+          DecodeLazRLE(Str, PBlue^, NbNonTransp);
+          Str.Position:= nextPosition;
+        end;
+      end;
+    end;
+
+    Img.SetSize(w,h);
+
+    if NbNonTransp > 0 then
+    begin
+      PCurRed := PRed;
+      PCurGreen := PGreen;
+      PCurBlue := PBlue;
+      PCurAlpha := PAlpha;
+
+      if Img is TBGRACustomBitmap then
+        begin
+          If PCurAlpha = nil then
+            begin
+              for y := 0 to h-1 do
+              begin
+                PDest := TBGRACustomBitmap(Img).ScanLine[y];
+                for x := w-1 downto 0 do
+                begin
+                  PDest^ := BGRA(PCurRed^,PCurGreen^,PCurBlue^);
+                  inc(PCurBlue);
+                  inc(PCurGreen);
+                  inc(PCurRed);
+                  inc(PDest);
+                end;
+              end;
+            end else
+          for y := 0 to h-1 do
+          begin
+            PDest := TBGRACustomBitmap(Img).ScanLine[y];
+            for x := w-1 downto 0 do
+            begin
+              if PCurAlpha^ = 0 then
+                PDest^ := BGRAPixelTransparent
+              else
+              begin
+                PDest^ := BGRA(PCurRed^,PCurGreen^,PCurBlue^,PCurAlpha^);
+                inc(PCurBlue);
+                inc(PCurGreen);
+                inc(PCurRed);
+              end;
+              inc(PDest);
+              inc(PCurAlpha);
+            end;
+          end;
+        end else
+        begin
+          a := 255;
+          for y := 0 to h-1 do
+            for x := 0 to w-1 do
+            begin
+              if PCurAlpha <> nil then
+              begin
+                a := PCurAlpha^;
+                inc(PCurAlpha);
+              end;
+              if a = 0 then
+              begin
+                img.Colors[x,y] := colTransparent;
+              end else
+              begin
+                c.red := PCurRed^ + (PCurRed^ shl 8);
+                c.green := PCurGreen^ + (PCurGreen^ shl 8);
+                c.blue := PCurBlue^ + (PCurBlue^ shl 8);
+                c.alpha := a + (a shl 8);
+                Img.Colors[x,y] := c;
+                inc(PCurBlue);
+                inc(PCurGreen);
+                inc(PCurRed);
+              end;
+            end;
+        end;
+    end else
+    begin
+      if Img is TBGRACustomBitmap then
+        TBGRACustomBitmap(Img).FillTransparent else
+      begin
+        for y := 0 to h-1 do
+          for x := 0 to w-1 do
+            img.Colors[x,y] := colTransparent;
+      end;
+    end;
+  finally
+    If Assigned(PAlpha) then FreeMem(PAlpha);
+    if Assigned(PBlue) and (PBlue <> PGreen) and (PBlue <> PRed) then FreeMem(PBlue);
+    if Assigned(PGreen) and (PGreen <> PRed) then FreeMem(PGreen);
+    If Assigned(PRed) then FreeMem(PRed);
+  end;
+end;
+
+initialization
+
+  if DefaultBGRAImageReader[ifLazPaint] = nil then
+    DefaultBGRAImageReader[ifLazPaint] := TBGRAReaderLazPaint;
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgrareadpcx.pas

@@ -0,0 +1,228 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{ This unit provides some optimisations of TFPReaderPCX: decompression using a read buffer.
+  It also fixes the progress message and the InternalCheck. }
+
+unit BGRAReadPCX;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses FPImage, BGRAClasses, SysUtils, FPReadPCX;
+
+type
+
+  { TBGRAReaderPCX }
+
+  TBGRAReaderPCX = class(TFPReaderPCX)
+  protected
+    FBuffer: packed array of byte;
+    FBufferPos, FBufferSize: integer;
+    FBufferStream: TStream;
+    function InternalCheck(Stream: TStream): boolean; override;
+    procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
+    procedure ReadScanLine({%H-}Row: integer; Stream: TStream); override;
+    procedure WriteScanLine(Row: integer; Img: TFPCustomImage); override;
+    procedure InitReadBuffer(AStream: TStream; ASize: integer);
+    procedure CloseReadBuffer;
+    function GetNextBufferByte: byte;
+  end;
+
+implementation
+
+uses BGRABitmapTypes;
+
+procedure TBGRAReaderPCX.ReadScanLine(Row: integer; Stream: TStream);
+var
+  P: PByte;
+  B: UInt32or64;
+  bytes, Count: UInt32or64;
+begin
+  if FLineSize <= 0 then exit;
+  P     := FScanLine;
+  bytes := FLineSize;
+  if Compressed then
+  begin
+    while bytes > 0 do
+    begin
+      B := GetNextBufferByte;
+      if (B < $c0) then
+        Count := 1
+      else
+      begin
+        Count := B - $c0;
+        B := GetNextBufferByte;
+      end;
+      if Count = 0 then continue else
+      if Count = 1 then
+      begin
+        P^ := B;
+        Inc(P);
+        Dec(bytes);
+      end else
+      begin
+        if Count > bytes then Count := bytes;
+        fillchar(p^, count, B);
+        Inc(p, count);
+        dec(bytes, count);
+      end;
+    end;
+  end
+  else
+    Stream.ReadBuffer(FScanLine^, FLineSize);
+end;
+
+procedure TBGRAReaderPCX.InternalRead(Stream: TStream; Img: TFPCustomImage);
+var
+  H, Row:   integer;
+  continue: boolean;
+  emptyRect: TRect;
+begin
+  emptyRect := rect(0,0,0,0);
+  continue    := True;
+  Progress(psStarting, 0, False, emptyRect, '', continue);
+  Stream.Read(Header, SizeOf(Header));
+  AnalyzeHeader(Img);
+  case BytesPerPixel of
+    1: CreateBWPalette(Img);
+    4: CreatePalette16(Img);
+    8: ReadPalette(stream, Img);
+    else
+      if (Header.PaletteType = 2) then
+        CreateGrayPalette(Img);
+  end;
+  H := Img.Height;
+  if Compressed then InitReadBuffer(Stream,2048);
+  for Row := 0 to H - 1 do
+  begin
+    ReadScanLine(Row, Stream);
+    WriteScanLine(Row, Img);
+    Progress(psRunning, (Row+1) div H, False, emptyRect, '', continue);
+  end;
+  if Compressed then CloseReadBuffer;
+  Progress(psEnding, 100, False, emptyRect, '', continue);
+  freemem(FScanLine);
+end;
+
+procedure TBGRAReaderPCX.WriteScanLine(Row: integer; Img: TFPCustomImage);
+var
+  Col:   integer;
+  C:     TFPColor;
+  P, P1, P2, P3: PByte;
+  Z2:    word;
+  color: byte;
+begin
+  C.Alpha := AlphaOpaque;
+  P  := FScanLine;
+  Z2 := Header.BytesPerLine;
+  begin
+    case BytesPerPixel of
+      1:
+      begin
+        for Col := 0 to Img.Width - 1 do
+        begin
+          if (P[col div 8] and (128 shr (col mod 8))) <> 0 then
+            Img.Colors[Col, Row] := Img.Palette[1]
+          else
+            Img.Colors[Col, Row] := Img.Palette[0];
+        end;
+      end;
+      4:
+      begin
+        P1 := P;
+        Inc(P1, Z2);
+        P2 := P;
+        Inc(P2, Z2 * 2);
+        P3 := P;
+        Inc(P3, Z2 * 3);
+        for Col := 0 to Img.Width - 1 do
+        begin
+          color := 0;
+          if (P[col div 8] and (128 shr (col mod 8))) <> 0 then
+            Inc(color, 1);
+          if (P1[col div 8] and (128 shr (col mod 8))) <> 0 then
+            Inc(color, 1 shl 1);
+          if (P2[col div 8] and (128 shr (col mod 8))) <> 0 then
+            Inc(color, 1 shl 2);
+          if (P3[col div 8] and (128 shr (col mod 8))) <> 0 then
+            Inc(color, 1 shl 3);
+          Img.Colors[Col, Row] := Img.Palette[color];
+        end;
+      end;
+      8:
+      begin
+        for Col := 0 to Img.Width - 1 do
+        begin
+          Img.Colors[Col, Row] := Img.Palette[P[Col]];
+        end;
+      end;
+      24:
+      begin
+        for Col := 0 to Img.Width - 1 do
+        begin
+          with C do
+          begin
+            Red   := P[col] or (P[col] shl 8);
+            Blue  := P[col + Z2 * 2] or (P[col + Z2 * 2] shl 8);
+            Green := P[col + Z2] or (P[col + Z2] shl 8);
+            Alpha := alphaOpaque;
+          end;
+          Img[col, row] := C;
+        end;
+      end;
+    end;
+  end;
+end;
+
+procedure TBGRAReaderPCX.InitReadBuffer(AStream: TStream; ASize: integer);
+begin
+  setLength(FBuffer,ASize);
+  FBufferSize := AStream.Read(FBuffer[0],ASize);
+  FBufferPos := 0;
+  FBufferStream := AStream;
+end;
+
+procedure TBGRAReaderPCX.CloseReadBuffer;
+begin
+  FBufferStream.Position:= FBufferStream.Position-FBufferSize+FBufferPos;
+end;
+
+function TBGRAReaderPCX.GetNextBufferByte: byte;
+begin
+  if FBufferPos < FBufferSize then
+  begin
+    result := FBuffer[FBufferPos];
+    inc(FBufferPos);
+  end else
+  if FBufferSize = 0 then
+    result := 0
+  else
+  begin
+    FBufferSize := FBufferStream.Read(FBuffer[0],length(FBuffer));
+    FBufferPos := 0;
+    if FBufferPos < FBufferSize then
+    begin
+      result := FBuffer[FBufferPos];
+      inc(FBufferPos);
+    end else
+      result := 0;
+  end;
+end;
+
+function TBGRAReaderPCX.InternalCheck({%H-}Stream: TStream): boolean;
+var
+  {%H-}magic: packed array[0..3] of byte;
+  oldPos: Int64;
+begin
+  oldPos:= stream.Position;
+  result := stream.Read({%H-}magic,SizeOf(magic)) = sizeof(magic);
+  stream.Position:= oldPos;
+  if result then
+    result := (magic[0] in[$0a,$0c,$cd]) and (magic[1] in [0,2,3,4,5]) and (magic[2] in[0,1]) and (magic[3] in[1,2,4,8])
+end;
+
+initialization
+
+  DefaultBGRAImageReader[ifPcx] := TBGRAReaderPCX;
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgrareadpsd.pas

@@ -0,0 +1,620 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{
+    The original file was part of the Free Pascal run time library.
+    Copyright (c) 2008 by the Free Pascal development team
+
+    Psd reader for fpImage modified by circular.
+
+ **********************************************************************
+
+    03/2014 changes by circular :
+    - added MinifyHeight,WantedHeight and OutputHeight (useful for thumbnails)
+}
+unit BGRAReadPSD;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, FPimage, FPReadPSD;
+
+type
+  { TBGRAReaderPSD }
+
+  TBGRAReaderPSD = class(TFPReaderPSD)
+  private
+    FCompressed: boolean;
+  protected
+    FScanLines      : array of PByte;
+    FInputLine     : array of record
+        StreamOffset: Int64;
+        Size: PtrInt;
+      end;
+    FOutputHeight: integer;
+    function ReadPalette(Stream: TStream): boolean;
+    procedure AnalyzeHeader;
+    procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
+    function ReadScanLine(Stream: TStream; AInputSize: PtrInt; AChannel: integer): boolean; overload;
+    procedure WriteScanLine(Img: TFPCustomImage; Row: integer); overload;
+    function  InternalCheck(Stream: TStream) : boolean; override;
+  public
+    MinifyHeight,WantedHeight: integer;
+    constructor Create; override;
+    property Compressed: Boolean read FCompressed;
+    property OutputHeight: integer read FOutputHeight;
+  end;
+
+implementation
+
+uses BGRABitmapTypes;
+
+function clamp(AValue, AMax: integer): integer;
+begin
+  if AValue < 0 then result := 0 else
+  if AValue > AMax then result := AMax else
+   result := AValue;;
+end;
+
+function CMYKtoRGB ( C : TFPColor):  TFPColor;
+var r,g,b: integer;
+begin
+  r := $ffff - c.red + c.green div 10 + c.blue div 10 - c.alpha;
+  g := $ffff + c.red div 10 - c.green + c.blue div 10 - c.alpha;
+  b := $ffff + c.red div 10 + c.green div 10 - c.blue - c.alpha;
+  result.red := clamp(r, 65535);
+  result.green := clamp(g, 65535);
+  result.blue := clamp(b, 65535);
+  Result.alpha:=alphaOpaque;
+end;
+
+function fInv(t: single): single;
+begin
+  if t > 6/29 then result := t*t*t else
+   result := 3*(6/29)*(6/29)*(t-4/29);
+end;
+
+function Csrgb(linear: single): single;
+begin
+  if linear <= 0.0031308 then
+      result := 12.92*linear else
+  result := (1+0.055)*exp(ln(linear)*(1/2.4)) - 0.055;
+end;
+
+function LabToRGB(L,a,b: single):TFPColor; overload;
+var r,g,blue: single;
+begin
+  if a < 0 then
+    r := L + a + 0.25*b
+  else
+    r := L + 0.75*a + 0.25*b;
+  g := L - 0.25*a;
+  blue := L - b;
+  Result.red:= clamp(round((r)*65535),65535);
+  Result.green:= clamp(round((g)*65535),65535);
+  Result.blue:= clamp(round((blue)*65535),65535);
+  result.alpha := 65535;
+end;
+
+function LabToRGB(const Lab:TLab):TFPColor; overload;
+var L: single;
+begin
+  L := 1/255*Lab.L;
+  result := LabToRGB(L,(Lab.a-128)/127,(Lab.b-128)/127);
+end;
+
+{ TBGRAReaderPSD }
+
+function TBGRAReaderPSD.ReadPalette(Stream: TStream): boolean;
+Var
+  I : Integer;
+  c : TFPColor;
+  OldPos: Integer;
+  BufSize:Longint;
+  {%H-}PalBuf: array[0..767] of Byte;
+  ContProgress: Boolean;
+begin
+  Result:=false;
+  ThePalette.count := 0;
+  OldPos := Stream.Position;
+  BufSize:=0;
+  Stream.Read(BufSize, SizeOf(BufSize));
+  BufSize:=BEtoN(BufSize);
+  Stream.Read({%H-}PalBuf, BufSize);
+  ContProgress:=true;
+  Progress(FPimage.psRunning, 0, False, Rect(0,0,0,0), '', ContProgress);
+  if not ContProgress then exit;
+  For I:=0 To BufSize div 3 Do
+  Begin
+    With c do
+    begin
+      Red:=PalBuf[I] shl 8;
+      Green:=PalBuf[I+(BufSize div 3)] shl 8;
+      Blue:=PalBuf[I+(BufSize div 3)* 2] shl 8;
+      Alpha:=alphaOpaque;
+    end;
+    ThePalette.Add(C);
+  End;
+  Stream.Position := OldPos;
+  Result:=true;
+end;
+
+procedure TBGRAReaderPSD.AnalyzeHeader;
+var channel: integer;
+begin
+  With FHeader do
+  begin
+    Depth:=BEtoN(Depth);
+    if (Signature <> '8BPS') then
+      Raise Exception.Create('Unknown/Unsupported PSD image type');
+    Channels:=BEtoN(Channels);
+    if Channels > 4 then
+      FBytesPerPixel:=Depth*4
+    else
+      FBytesPerPixel:=Depth*Channels;
+    Mode:=BEtoN(Mode);
+    FWidth:=BEtoN(Columns);
+    FHeight:=BEtoN(Rows);
+    FChannelCount:=Channels;
+    FLineSize:=(PtrInt(FWidth)*Depth+7) div 8;
+    setlength(FScanLines, FChannelCount);
+    for channel := 0 to FChannelCount-1 do
+      GetMem(FScanLines[channel],FLineSize);
+  end;
+end;
+
+procedure TBGRAReaderPSD.InternalRead(Stream: TStream; Img: TFPCustomImage);
+var
+  H,HOutput,InputLineIndex,LenOfLineIndex,channel: Integer;
+  LenOfLineFactor: PtrInt;
+  BufSize:LongWord;
+  Encoding:word;
+  ContProgress: Boolean;
+  CurOffset: int64;
+  PrevOutputRow, OutputRow, OutputRowAdd, OutputRowAcc, OutputRowAccAdd, OutputRowMod: integer;
+begin
+  FScanLines:=nil;
+  FPalette:=nil;
+  try
+    Stream.Position:=0;
+    ContProgress:=true;
+    Progress(FPimage.psStarting, 0, False, Rect(0,0,0,0), '', ContProgress);
+    if not ContProgress then exit;
+    // read header
+    Stream.Read(FHeader, SizeOf(FHeader));
+    Progress(FPimage.psRunning, 0, False, Rect(0,0,0,0), '', ContProgress);
+    if not ContProgress then exit;
+    AnalyzeHeader;
+    Case FHeader.Mode of
+        0:begin  // Bitmap (monochrome)
+            FPalette := TFPPalette.Create(0);
+            CreateBWPalette;
+          end;
+        1, 8:begin // Gray-scale
+            FPalette := TFPPalette.Create(0);
+            CreateGrayPalette;
+          end;
+        2:begin // Indexed color (palette color)
+            FPalette := TFPPalette.Create(0);
+            if not ReadPalette(stream) then exit;
+          end;
+    end;
+
+    if Assigned(OnCreateImage) then
+      OnCreateImage(Self,Img);
+
+    if (MinifyHeight > 0) and (FHeight > MinifyHeight) then
+      FOutputHeight:= MinifyHeight
+    else
+      if WantedHeight > 0 then
+        FOutputHeight:= WantedHeight
+      else
+        FOutputHeight:= FHeight;
+    Img.SetSize(FWidth,FOutputHeight);
+
+    //  color palette
+    BufSize:=0;
+    Stream.Read(BufSize, SizeOf(BufSize));
+    BufSize:=BEtoN(BufSize);
+    Stream.Seek(BufSize, soCurrent);
+    //  color data block
+    Stream.Read(BufSize, SizeOf(BufSize));
+    BufSize:=BEtoN(BufSize);
+    Stream.Read(FColorDataBlock, SizeOf(FColorDataBlock));
+    Stream.Seek(BufSize-SizeOf(FColorDataBlock), soCurrent);
+    //  mask
+    Stream.Read(BufSize, SizeOf(BufSize));
+    BufSize:=BEtoN(BufSize);
+    Stream.Seek(BufSize, soCurrent);
+    //  compression type
+    Encoding:=0;
+    Stream.Read(Encoding, SizeOf(Encoding));
+    FCompressed:=BEtoN(Encoding) = 1;
+    if BEtoN(Encoding)>1 then
+      Raise Exception.Create('Unknown compression type');
+    If FCompressed then
+    begin
+      SetLength(FLengthOfLine, FHeight * FChannelCount);
+      Stream.ReadBuffer(FLengthOfLine[0], 2 * Length(FLengthOfLine));
+      Progress(FPimage.psRunning, 0, False, Rect(0,0,0,0), '', ContProgress);
+      if not ContProgress then exit;
+      if not (FHeader.Mode in [0, 2]) then
+        LenOfLineFactor := FHeader.Depth div 8
+      else
+        LenOfLineFactor := 1;
+    end else
+    begin
+      FLengthOfLine := nil;
+    end;
+
+    setlength(FInputLine, FHeight * FChannelCount);
+    CurOffset := Stream.Position;
+    H := 0;
+    channel := 0;
+    InputLineIndex:= 0;
+    for LenOfLineIndex := 0 to FHeight * FChannelCount-1 do
+    begin
+      FInputLine[InputLineIndex].StreamOffset := CurOffset;
+      if FLengthOfLine <> nil then
+        FInputLine[InputLineIndex].Size := BEtoN(FLengthOfLine[LenOfLineIndex])*LenOfLineFactor else
+        FInputLine[InputLineIndex].Size := FLineSize;
+      inc(CurOffset, FInputLine[InputLineIndex].Size);
+      inc(H);
+      Inc(InputLineIndex, FChannelCount);
+      if H = FHeight then
+      begin
+        H := 0;
+        Inc(channel);
+        InputLineIndex:= channel;
+      end;
+    end;
+
+    InputLineIndex := 0;
+    PrevOutputRow := -1;
+    OutputRow := 0;
+    OutputRowAdd := FOutputHeight div FHeight;
+    OutputRowMod:= FHeight;
+    OutputRowAccAdd := FOutputHeight mod FHeight;
+    OutputRowAcc:= 0;
+
+    For H := 0 to FHeight - 1 do
+    begin
+      if OutputRow > PrevOutputRow then
+      begin
+        for channel := 0 to FChannelCount-1 do
+        begin
+            Stream.Position := FInputLine[InputLineIndex].StreamOffset;
+            ReadScanLine(Stream, FInputLine[InputLineIndex].Size, channel);
+            Inc(InputLineIndex);
+        end;
+        For HOutput:= PrevOutputRow+1 to OutputRow do WriteScanLine(Img, HOutput);
+        Progress(FPimage.psRunning, round((H+1)*99.0 / (FHeight * FChannelCount)), False, Rect(0,0,0,0), '', ContProgress);
+        if not ContProgress then exit;
+      end else inc(InputLineIndex, FChannelCount);
+
+      PrevOutputRow:= OutputRow;
+      Inc(OutputRow, OutputRowAdd);
+      Inc(OutputRowAcc, OutputRowAccAdd);
+      if OutputRowAcc> OutputRowMod then
+      begin
+        dec(OutputRowAcc, OutputRowMod);
+        inc(OutputRow);
+      end;
+    end;
+    Progress(FPimage.psRunning, 100, False, Rect(0,0,0,0), '', ContProgress);
+    if not ContProgress then exit;
+
+   {$ifdef FPC_Debug_Image}
+    WriteLn('TBGRAReaderPSD.InternalRead AAA1 ',Stream.position,' ',Stream.size);
+    {$endif}
+  finally
+    FreeAndNil(FPalette);
+    for channel := 0 to FChannelCount-1 do
+      ReAllocMem(FScanLines[channel],0);
+  end;
+  Progress(FPimage.psEnding, 100, false, Rect(0,0,FWidth,FHeight), '', ContProgress);
+end;
+
+function TBGRAReaderPSD.ReadScanLine(Stream: TStream; AInputSize: PtrInt;
+  AChannel: integer): boolean;
+Var
+  P : PByte;
+  B : Byte;
+  I, left : PtrInt;
+  N : Shortint;
+  Count:integer;
+  buf, PBuf: PByte;
+begin
+  Result:=false;
+  If Not Compressed then
+    Stream.ReadBuffer(FScanLines[AChannel]^,FLineSize)
+  else
+    begin
+      getmem(buf, AInputSize);
+      if stream.Read(buf^,AInputSize) <> AInputSize then
+      begin
+        freemem(buf);
+        result := false;
+        exit;
+      end;
+      P:=FScanLines[AChannel];
+      left := FLineSize;
+      i:=AInputSize;
+      PBuf := buf;
+      repeat
+        Count:=0;
+        N:= PShortInt(PBuf)^;
+        inc(PBuf);
+        dec(i);
+        If N = -128 then
+        else
+        if N < 0 then
+        begin
+           Count:=-N+1;
+           if Count > left then Count := left;
+           dec(left,Count);
+           B:= PBuf^;
+           Inc(PBuf);
+           dec(i);
+           fillchar(p^,count,B);
+           inc(p,count);
+        end
+        else
+        begin
+           Count:=N+1;
+           if Count > left then Count := left;
+           dec(left,Count);
+           Move(PBuf^, P^, Count);
+           Inc(PBuf, Count);
+           inc(p, count);
+           dec(i, count);
+        end;
+      until (i <= 0) or (left <= 0);
+      freemem(buf);
+    end;
+  Result:=true;
+end;
+
+function Value32To16(p: PLongWord; gamma: single): Word;
+var v: single;
+begin
+  v := (BEtoN(P^) - 1024000000)/40960000;
+  if v <= 0 then result := 0 else
+    if v >= 1 then result := 65535 else
+      result := round(exp(ln(v)*gamma)*65535);
+end;
+
+procedure TBGRAReaderPSD.WriteScanLine(Img: TFPCustomImage; Row: integer);
+Var
+  Col : Integer;
+  C   : TFPColor;
+  P, P1, P2, P3   : PByte;
+  Lab : TLab;
+begin
+  C.Alpha:=AlphaOpaque;
+  P:=FScanLines[0];
+  begin
+    case FBytesPerPixel of
+      1 : begin
+             for Col:=0 to Img.Width-1 do
+               if (P[col div 8] and (128 shr (col mod 8))) <> 0 then
+                 Img.Colors[Col,Row]:=ThePalette[0]
+  	       else
+                 Img.Colors[Col,Row]:=ThePalette[1];
+           end;
+      8 : begin
+             for Col:=0 to Img.Width-1 do
+             begin
+               Img.Colors[Col,Row]:=ThePalette[P[0]];
+               inc(p);
+             end;
+          end;
+      16 : if (FHeader.Mode = 1) or (FHeader.Mode = 8) then
+           begin
+             if FChannelCount = 1 then
+               for Col:=0 to Img.Width-1 do
+               begin
+                 C.Red:=BEtoN(PWord(P)^);
+                 C.green:=C.Red;
+                 C.blue:=C.Red;
+                 C.alpha:=65535;
+                 Img[col, row] := C;
+                 Inc(P,2);
+               end else
+             if FChannelCount = 2 then
+             begin
+               P1:=FScanLines[1];
+               for Col:=0 to Img.Width-1 do
+               begin
+                 C.Red:=P^ shl 8 + P^;
+                 C.green:=C.Red;
+                 C.blue:=C.Red;
+                 C.alpha:=p1^ shl 8 + P1^;
+                 Img[col, row] := C;
+                 Inc(P);
+                 Inc(P1);
+               end;
+             end;
+           end else
+           begin
+             for Col:=0 to Img.Width-1 do
+             begin
+               Img.Colors[Col,Row]:=ThePalette[BEtoN(PWord(P)^)];
+               inc(p,2);
+             end;
+          end;
+      24 : if FChannelCount>=3 then
+           begin
+           P1:=FScanLines[1];
+           P2:=FScanLines[2];
+           for Col:=0 to Img.Width-1 do
+           begin
+             if (FHeader.Mode =9) then
+             begin
+               Lab.L:=P[0];
+               Lab.a:=P1[0];
+               Lab.b:=P2[0];
+               C:=LabToRGB(Lab);
+             end
+             else
+              With C do
+              begin
+                Red:=P[0] or (P[0] shl 8);
+                green:=P1[0] or (P1[0] shl 8);
+                blue:=P2[0] or (P2[0] shl 8);
+                alpha:=alphaOpaque;
+              end;
+              Inc(P);
+              Inc(P1);
+              Inc(P2);
+              Img[col, row] := C;
+           end;
+          end;
+      32 : if (FHeader.Mode = 1) or (FHeader.Mode = 8) then
+           begin
+             if FChannelCount = 1 then
+               for Col:=0 to Img.Width-1 do
+               begin
+                 C.Red:=Value32To16(PLongWord(P),1.3);
+                 C.green:=C.Red;
+                 C.blue:=C.Red;
+                 C.alpha:=65535;
+                 Img[col, row] := C;
+                 Inc(P,4);
+               end else
+             if FChannelCount = 2 then
+             begin
+               P1:=FScanLines[1];
+               for Col:=0 to Img.Width-1 do
+               begin
+                 C.Red:=BEtoN(PWord(P)^);
+                 C.green:=C.Red;
+                 C.blue:=C.Red;
+                 C.alpha:=BEtoN(PWord(p1)^);
+                 Img[col, row] := C;
+                 Inc(P,2);
+                 Inc(P1,2);
+               end;
+             end;
+           end else
+           if FChannelCount >= 4 then
+           begin
+           P1:=FScanLines[1];
+           P2:=FScanLines[2];
+           P3:=FScanLines[3];
+           for Col:=0 to Img.Width-1 do
+           begin
+             if (FHeader.Mode =4) then
+             begin
+                 P^ := 255 - P^;
+                 P1^ := 255 - P1^;
+                 P2^ := 255 - P2^;
+                 P3^ := 255 - P3^;
+             end;
+             C.Red:=P[0] or (P[0] shl 8);
+             C.green:=P1[0] or (P1[0] shl 8);
+             C.blue:=P2[0] or (P2[0] shl 8);
+             C.alpha:=P3[0] or (P3[0] shl 8);
+             if (FHeader.Mode =4) then  C:=CMYKtoRGB(C); // CMYK to RGB
+             Img[col, row] := C;
+             Inc(P);
+             Inc(P1);
+             Inc(P2);
+             Inc(P3);
+           end;
+          end;
+      48 :if FChannelCount = 3 then
+          begin
+           P1:=FScanLines[1];
+           P2:=FScanLines[2];
+           C.alpha:=alphaOpaque;
+           for Col:=0 to Img.Width-1 do
+           begin
+              if (FHeader.Mode =9) then
+                C := LabToRGB(BEtoN(PWord(P)^)/65535, (BEtoN(PWord(P1)^)-32768)/32767, (BEtoN(PWord(P2)^)-32768)/32767)
+              else
+              With C do
+              begin
+                Red:=BEtoN(PWord(P)^);
+                green:=BEtoN(PWord(P1)^);
+                blue:=BEtoN(PWord(P2)^);
+              end;
+              Inc(P,2);
+              Inc(P1,2);
+              Inc(P2,2);
+              Img[col, row] := C;
+           end;
+          end;
+      64 : if FChannelCount = 4 then
+           begin
+           P1:=FScanLines[1];
+           P2:=FScanLines[2];
+           P3:=FScanLines[3];
+           for Col:=0 to Img.Width-1 do
+           begin
+             C.Red:=BEtoN(PWord(P)^);
+             C.green:=BEtoN(PWord(P1)^);
+             C.blue:=BEtoN(PWord(P2)^);
+             C.alpha:=BEtoN(PWord(P3)^);
+             if (FHeader.Mode =4) then
+             begin
+                 C.red:=$ffff-C.red;
+                 C.green:=$ffff-C.green;
+                 C.blue:=$ffff-C.blue;
+                 C.alpha:=$ffff-C.alpha;
+             end;
+             if (FHeader.Mode =4) then  C:=CMYKtoRGB(C); // CMYK to RGB
+             Img[col, row] := C;
+             Inc(P,2);
+             Inc(P1,2);
+             Inc(P2,2);
+             Inc(P3,2);
+           end;
+          end;
+      96 :if FChannelCount = 3 then
+          begin
+           P1:=FScanLines[1];
+           P2:=FScanLines[2];
+           C.alpha:=alphaOpaque;
+           for Col:=0 to Img.Width-1 do
+           begin
+              With C do
+              begin
+                Red:=Value32To16(PLongWord(P),2.7);
+                green:=Value32To16(PLongWord(P1),2.7);
+                blue:=Value32To16(PLongWord(P2),2.7);
+              end;
+              Inc(P,4);
+              Inc(P1,4);
+              Inc(P2,4);
+              Img[col, row] := C;
+           end;
+          end;
+    end;
+  end;
+end;
+
+function TBGRAReaderPSD.InternalCheck(Stream: TStream): boolean;
+var
+  OldPos: Int64;
+begin
+  try
+    OldPos:=Stream.Position;
+    Stream.Read(FHeader,SizeOf(FHeader));
+    Result:=(FHeader.Signature = '8BPS');
+    Stream.Position:=OldPos;
+  except
+    Result:=False;
+  end;
+end;
+
+constructor TBGRAReaderPSD.Create;
+begin
+  inherited Create;
+end;
+
+initialization
+
+  DefaultBGRAImageReader[ifPsd] := TBGRAReaderPSD;
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgrareadtga.pas

@@ -0,0 +1,192 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{*****************************************************************************}
+{
+    The original file is part of the Free Pascal's "Free Components Library".
+    Copyright (c) 2003 by Mazen NEIFER of the Free Pascal development team
+
+    Targa reader implementation modified by circular.
+}
+{*****************************************************************************}
+
+{ - 22/11/2007 Modified by Laurent Jacques for support all format }
+
+{$mode objfpc}
+{$h+}
+
+unit BGRAReadTGA;
+
+interface
+
+uses FPReadTGA, FPimage, BGRAClasses;
+
+type
+  { TBGRAReaderTarga }
+
+  TBGRAReaderTarga = class (TFPReaderTarga)
+  protected
+    FBuffer: packed array of byte;
+    FBufferPos, FBufferSize: integer;
+    FBufferStream: TStream;
+    procedure ReadScanLine({%H-}Row: Integer; Stream: TStream); override;
+    procedure WriteScanLine(Row : Integer; Img : TFPCustomImage); override;
+    procedure InitReadBuffer(AStream: TStream; ASize: integer);
+    procedure CloseReadBuffer;
+    function GetNextBufferByte: byte;
+  end;
+
+Implementation
+
+uses BGRABitmapTypes, targacmn;
+
+procedure TBGRAReaderTarga.ReadScanLine(Row: Integer; Stream: TStream);
+Var
+  P : PByte;
+  B : Byte;
+  I,J : Integer;
+  PixelSizeInBytesMinus1: integer;
+
+begin
+  If Not Compressed then
+    Stream.ReadBuffer(FScanLine^,FLineSize)
+  else
+  begin
+    InitReadBuffer(Stream, 2048);
+    P:=FScanLine;
+    PixelSizeInBytesMinus1 := (BytesPerPixel shr 3)-1;
+    For I:=0 to ToWord(Header.Width)-1 do
+      begin
+      If (FPixelCount>0) then
+        Dec(FPixelCount)
+      else
+      begin
+        Dec(FBlockCount);
+        If (FBlockCount<0) then
+          begin
+          B := GetNextBufferByte;
+          If (B and $80)<>0 then
+            begin
+            FPixelCount:=B and $7F;
+            FblockCount:=0;
+            end
+          else
+            FBlockCount:=B and $7F
+          end;
+        For J:=0 to PixelSizeInBytesMinus1 do
+           FLastPixel[j] := GetNextBufferByte;
+      end;
+      For J:=0 to PixelSizeInBytesMinus1 do
+        begin
+        P[0]:=FLastPixel[j];
+        Inc(P);
+        end;
+      end;
+    CloseReadBuffer;
+  end;
+end;
+
+Procedure TBGRAReaderTarga.WriteScanLine(Row : Integer; Img : TFPCustomImage);
+Var
+  Col : Integer;
+  Value   : UInt32or64;
+  P   : PByte;
+  PDest: PBGRAPixel;
+
+begin
+  P:=FScanLine;
+  PDest := TBGRACustomBitmap(img).ScanLine[Row];
+  Case Header.ImgType of
+    TARGA_INDEXED_IMAGE
+      : for Col:=Img.width-1 downto 0 do
+        begin
+         PDest^ := FPColorToBGRA(FPalette[P^]);
+         Inc(PDest);
+         Inc(P);
+        end;
+    TARGA_TRUECOLOR_IMAGE
+      : if (BytesPerPixel = 32) and (AlphaBits = 8) then
+           Move(P^,PDest^,Img.Width*sizeof(TBGRAPixel)) else
+        if (BytesPerPixel = 24) then
+        begin
+          for Col:=Img.Width-1 downto 0 do
+          begin
+            PDest^ := BGRA((P+2)^,(P+1)^,P^);
+            inc(Pdest);
+            Inc(p,3);
+          end;
+        end
+        else if (BytesPerPixel in[8,16]) then
+        for Col:= Img.Width-1 to 0 do
+          begin
+            Value:=P[0];
+            inc(P);
+            Value:=value or (P[0] shl 8);
+            PDest^ := BGRA(((value)shr 10) shl 3,((value)shr 5) shl 3,((value)) shl 3);
+            Inc(PDest);
+            Inc(P);
+          end;
+    TARGA_GRAY_IMAGE
+      :  case BytesPerPixel of
+           8 : for Col:=Img.width-1 downto 0 do
+              begin
+               PDest^ := FPColorToBGRA(FPalette[P^]);
+               Inc(PDest);
+               Inc(P);
+              end;
+          16 : for Col:=0 to Img.width-1 do
+               begin
+                 With PDest^ do
+                 begin
+                   blue:=FPalette[P^].blue shr 8;
+                   green:=FPalette[P^].green shr 8;
+                   red:=FPalette[P^].red shr 8;
+                   Inc(P);
+                   if alphaBits = 8 then alpha := P^ else
+                     alpha:=255;
+                   Inc(P);
+                 end;
+                 inc(PDest);
+               end;
+         end;
+  end;
+end;
+
+procedure TBGRAReaderTarga.InitReadBuffer(AStream: TStream; ASize: integer);
+begin
+  setLength(FBuffer,ASize);
+  FBufferSize := AStream.Read(FBuffer[0],ASize);
+  FBufferPos := 0;
+  FBufferStream := AStream;
+end;
+
+procedure TBGRAReaderTarga.CloseReadBuffer;
+begin
+  FBufferStream.Position:= FBufferStream.Position-FBufferSize+FBufferPos;
+end;
+
+function TBGRAReaderTarga.GetNextBufferByte: byte;
+begin
+  if FBufferPos < FBufferSize then
+  begin
+    result := FBuffer[FBufferPos];
+    inc(FBufferPos);
+  end else
+  if FBufferSize = 0 then
+    result := 0
+  else
+  begin
+    FBufferSize := FBufferStream.Read(FBuffer[0],length(FBuffer));
+    FBufferPos := 0;
+    if FBufferPos < FBufferSize then
+    begin
+      result := FBuffer[FBufferPos];
+      inc(FBufferPos);
+    end else
+      result := 0;
+  end;
+end;
+
+initialization
+
+  DefaultBGRAImageReader[ifTarga] := TBGRAReaderTarga;
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgrareadwebp.pas

@@ -0,0 +1,151 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAReadWebP;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, FPImage;
+
+type
+  TWebPHeader = record
+    RIFFCode: array[1..4] of char;
+    FileSize: LongWord;
+    WebPCode: array[1..4] of char;
+  end;
+
+  { TBGRAReaderWebP }
+
+  TBGRAReaderWebP = class(TFPCustomImageReader)
+  protected
+    function ReadHeader(Str: TStream): TWebPHeader;
+    procedure InternalRead(Str: TStream; Img: TFPCustomImage); override;
+    function InternalCheck(Str: TStream): boolean; override;
+  end;
+
+implementation
+
+uses libwebp{$ifdef linux}, linuxlib{$endif}, BGRABitmapTypes;
+
+var
+  MyLibWebPLoaded: boolean;
+
+procedure NeedLibWebP;
+begin
+  if not MyLibWebPLoaded then
+  begin
+    if not LibWebPLoad({$ifdef linux}FindLinuxLibrary('libwebp.so', 6){$endif}) then
+      raise exception.Create('Cannot find libwebp library ('+LibWebPFilename+')');
+    MyLibWebPLoaded:= true;
+  end;
+end;
+
+{ TBGRAReaderWebP }
+
+function TBGRAReaderWebP.ReadHeader(Str: TStream): TWebPHeader;
+begin
+  fillchar({%H-}result, sizeof({%H-}result), 0);
+  Str.Read(result, sizeof(result));
+  result.FileSize:= LEtoN(result.FileSize);
+end;
+
+procedure TBGRAReaderWebP.InternalRead(Str: TStream; Img: TFPCustomImage);
+const
+  CopySize = 65536;
+var
+  header: TWebPHeader;
+  oldPos: Int64;
+  mem, p: PByte;
+  totalSize, remain: LongWord;
+  toRead, w, h, x, y: integer;
+  loadInto: TBGRACustomBitmap;
+  pbgra: PBGRAPixel;
+  ok: Boolean;
+begin
+  NeedLibWebP;
+
+  oldPos := Str.Position;
+  header := ReadHeader(Str);
+  if (header.RIFFCode <> 'RIFF') or (header.WebPCode <> 'WEBP') then
+    raise exception.Create('Invalid header');
+  Str.Position:= OldPos;
+  totalSize := header.FileSize+8;
+  getmem(mem, totalSize);
+  loadInto := nil;
+  try
+    p := mem;
+    remain := totalSize;
+    while remain > 0 do
+    begin
+      if remain > CopySize then toRead := CopySize else
+        toRead := remain;
+      Str.ReadBuffer(p^, toRead);
+      inc(p, toRead);
+      dec(remain, toRead);
+    end;
+
+    if WebPGetInfo(mem, totalSize, @w, @h) = 0 then
+      raise exception.Create('Invalid WebP header');
+
+    Img.SetSize(w, h);
+    if Img is TBGRACustomBitmap then
+      loadInto := TBGRACustomBitmap(Img)
+    else
+      loadInto := BGRABitmapFactory.Create(w,h);
+    {$PUSH}{$WARNINGS OFF}
+    if TBGRAPixel_RGBAOrder then
+      ok := WebPDecodeRGBAInto(mem, totalSize, loadInto.DataByte, loadInto.RowSize*h, loadInto.RowSize)<>nil
+    else
+      ok := WebPDecodeBGRAInto(mem, totalSize, loadInto.DataByte, loadInto.RowSize*h, loadInto.RowSize)<>nil;
+    {$POP}
+    loadInto.InvalidateBitmap;
+    if not ok then raise exception.Create('Error decoding WebP');
+    if loadInto.LineOrder = riloBottomToTop then loadInto.VerticalFlip;
+    if Img <> loadInto then
+    begin
+      for y := 0 to h-1 do
+      begin
+        pbgra := loadInto.ScanLine[y];
+        for x := 0 to w-1 do
+        begin
+          Img.Colors[x,y] := pbgra^.ToFPColor;
+          inc(pbgra);
+        end;
+      end;
+    end;
+  finally
+    if Assigned(loadInto) and (loadInto <> Img) then loadInto.Free;
+    freemem(mem);
+  end;
+end;
+
+function TBGRAReaderWebP.InternalCheck(Str: TStream): boolean;
+var
+  oldPos: Int64;
+  header: TWebPHeader;
+begin
+  oldPos := Str.Position;
+  try
+    header := ReadHeader(Str);
+    result := (header.RIFFCode = 'RIFF') and (header.WebPCode = 'WEBP') and
+       (header.FileSize <= $FFFFFFF6) and (header.FileSize <= Str.Size-Str.Position+4);
+  finally
+    Str.Position:= OldPos;
+  end;
+end;
+
+initialization
+
+  DefaultBGRAImageReader[ifWebP] := TBGRAReaderWebP;
+
+finalization
+
+  if MyLibWebPLoaded then
+  begin
+    LibWebPUnload;
+    MyLibWebPLoaded:= false;
+  end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrareadxpm.pas

@@ -0,0 +1,91 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAReadXPM;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, FPReadXPM, FPimage;
+
+type
+
+  { TBGRAReaderXPM }
+
+  TBGRAReaderXPM = class(TFPReaderXPM)
+    protected
+      procedure InternalRead(Str: TStream; Img: TFPCustomImage); override;
+      function InternalCheck(Str: TStream): boolean; override;
+    public
+      class procedure ConvertToXPM3(ASource: TStream; ADestination: TStream); static;
+  end;
+
+implementation
+
+uses BGRABitmapTypes;
+
+{ TBGRAReaderXPM }
+
+procedure TBGRAReaderXPM.InternalRead(Str: TStream; Img: TFPCustomImage);
+var tempStream: TMemoryStream;
+begin
+  tempStream := TMemoryStream.Create;
+  try
+    ConvertToXPM3(Str, tempStream);
+    tempStream.Position:= 0;
+    try
+      img.UsePalette := true;
+      inherited InternalRead(tempStream, Img);
+    finally
+    end;
+  finally
+    tempStream.free;
+  end;
+end;
+
+function TBGRAReaderXPM.InternalCheck(Str: TStream): boolean;
+var {%H-}magic : array[0..5] of char;
+    l : integer;
+    prevPos: int64;
+begin
+  try
+    prevPos := str.Position;
+    l := str.Read ({%H-}magic[0],sizeof(magic));
+    str.Position:= prevPos;
+    result := (l = sizeof(magic)) and (magic = '! XPM2');
+    if not result then result := inherited InternalCheck(Str)
+  except
+    result := false;
+  end;
+end;
+
+class procedure TBGRAReaderXPM.ConvertToXPM3(ASource: TStream;
+  ADestination: TStream);
+var
+  lst: TStringList;
+  i : integer;
+begin
+  lst := TStringList.Create;
+  try
+    lst.LoadFromStream(ASource);
+    if (lst[0] = '! XPM2') and (lst.count > 1) then
+    begin
+      lst[0] := '/* XPM */';
+      lst.Insert(1, 'static char * data[] = {');
+      for i := 2 to lst.Count-2 do
+        lst[i] := '"' + lst[i] + '",';
+      lst[lst.count-1] := '"' + lst[lst.count-1] + '"';
+      lst.Add('}');
+    end;
+    lst.SaveToStream(ADestination);
+  finally
+    lst.free;
+  end;
+end;
+
+initialization
+
+  DefaultBGRAImageReader[ifXPixMap] := TBGRAReaderXPM;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrarenderer3d.pas

@@ -0,0 +1,842 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRARenderer3D;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses BGRABitmapTypes,
+  BGRASceneTypes, BGRASSE,
+  BGRAPolygon, BGRAColorInt,
+  BGRAClasses, BGRAMatrix3D,
+  BGRAPolygonAliased;
+
+type
+  TInt65536ShaderFunction3D = function (Context: PBasicLightingContext; Color: TBGRAPixel): TColorInt65536 of object;
+
+  { TBGRAShader3D }
+
+  TBGRAShader3D = class
+  protected
+    FAmbiantLightness: integer;
+    FAmbiantLightColor: TColorInt65536;
+    FUseAmbiantColor: boolean;
+    FLights: TList;
+    FContextBlock: TMemoryBlockAlign128;
+    FShaderFunc: TShaderFunction3D;
+    FInt65536ShaderFunc: TInt65536ShaderFunction3D;
+    FContext: PBasicLightingContext;
+    FOnlyDirectionalLights: boolean;
+    FWhiteMaterial: boolean;
+
+    procedure ComputeDiffuseLightness(Context: PSceneLightingContext); inline;
+    procedure ComputeDiffuseLight(Context: PSceneLightingContext); inline;
+    procedure ComputeDiffuseAndSpecularLight(Context: PSceneLightingContext); inline;
+
+    function ApplyNoLighting(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel;
+    function ApplyLightingWithAmbiantLightnessOnly(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel;
+    function ApplyLightingWithLightness(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel;
+    function ApplyLightingWithDiffuseColor(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel;
+    function ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel;
+
+    function Int65536ApplyNoLighting(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536;
+    function Int65536ApplyLightingWithAmbiantLightnessOnly(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536;
+    function Int65536ApplyLightingWithLightness(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536;
+    function Int65536ApplyLightingWithDiffuseColor(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536;
+    function Int65536ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536;
+  public
+    constructor Create(const AAmbiantLightColorF: TColorF; ALights: TList);
+    destructor Destroy; override;
+    function Apply(APosition: TPoint3D_128; ANormal: TPoint3D_128; AColor: TBGRAPixel): TBGRAPixel;
+    function Int65536Apply(APosition: TPoint3D_128; ANormal: TPoint3D_128; AColor: TBGRAPixel): TColorInt65536;
+    procedure Prepare(constref ADescription: TFaceRenderingDescription);
+    property ShaderFunction: TShaderFunction3D read FShaderFunc;
+    property Int65536ShaderFunction: TInt65536ShaderFunction3D read FInt65536ShaderFunc;
+    property Context: PBasicLightingContext read FContext;
+    property OnlyDirectionalLights: boolean read FOnlyDirectionalLights;
+  end;
+
+  { TBGRARenderer3D }
+
+  TBGRARenderer3D = class(TCustomRenderer3D)
+  protected
+    FColorGradientTempBmp: TBGRACustomBitmap;
+    FZBuffer: PSingle;
+    FOutputSurface, FRenderSurface: TBGRACustomBitmap;
+    FRenderSurfaceMultisample: Integer;
+    FMultishapeFiller: TBGRAMultishapeFiller;
+    FOptions: TRenderingOptions;
+    FShader: TBGRAShader3D;
+    FDepths: array of single;
+    FLightings: array of word;
+
+    FShadedColors: array of TBGRAPixel;
+    FSameShadedColors: boolean;
+
+    FCenter: record
+      proj: TPointF;
+      pos3D,normal3D: TPoint3D_128;
+      color: TBGRAPixel;
+    end;
+
+    function GetHasZBuffer: boolean; override;
+    function GetGlobalScale: single; override;
+    function GetSurfaceWidth: integer; override;
+    function GetSurfaceHeight: integer; override;
+    function GetHandlesNearClipping: boolean; override;
+    function GetHandlesFaceCulling: boolean; override;
+  public
+    constructor Create(AOutputSurface: TBGRACustomBitmap;
+      ARenderingOptions: TRenderingOptions;
+      AAmbiantLightColorF: TColorF;
+      ALights: TList);
+    function RenderFace(var ADescription: TFaceRenderingDescription;
+      AComputeCoordinate: TComputeProjectionFunc): boolean; override;
+    destructor Destroy; override;
+  end;
+
+implementation
+
+uses SysUtils, BGRAResample;
+
+{ TBGRAShader3D }
+
+constructor TBGRAShader3D.Create(const AAmbiantLightColorF: TColorF;
+  ALights: TList);
+var
+  j: Integer;
+begin
+  FAmbiantLightColor := ColorFToColorInt65536(AAmbiantLightColorF);
+  FAmbiantLightness := round((AAmbiantLightColorF[1]+AAmbiantLightColorF[2]+AAmbiantLightColorF[3])/3*32768);
+  FUseAmbiantColor:= (FAmbiantLightColor.r <> FAmbiantLightColor.g) or (FAmbiantLightColor.g <> FAmbiantLightColor.b);
+  FLights := ALights;
+  FContextBlock := TMemoryBlockAlign128.Create(sizeof(TSceneLightingContext));
+  FOnlyDirectionalLights:= true;
+  for j := 0 to FLights.Count-1 do
+    if not TBGRALight3D(FLights[j]).IsDirectional then FOnlyDirectionalLights := false;
+end;
+
+destructor TBGRAShader3D.Destroy;
+begin
+  FreeAndNil(FContextBlock);
+  inherited Destroy;
+end;
+
+function TBGRAShader3D.Apply(APosition: TPoint3D_128; ANormal: TPoint3D_128;
+  AColor: TBGRAPixel): TBGRAPixel;
+begin
+  with Context^ do
+  begin
+    Position := APosition;
+    Normal := ANormal;
+  end;
+  result := ShaderFunction(Context,AColor);
+end;
+
+function TBGRAShader3D.Int65536Apply(APosition: TPoint3D_128;
+  ANormal: TPoint3D_128; AColor: TBGRAPixel): TColorInt65536;
+begin
+  with Context^ do
+  begin
+    Position := APosition;
+    Normal := ANormal;
+  end;
+  result := Int65536ShaderFunction(Context,AColor);
+end;
+
+procedure TBGRAShader3D.Prepare(constref
+  ADescription: TFaceRenderingDescription);
+var
+  UseDiffuseColor: Boolean;
+  j: Integer;
+  ctx: PSceneLightingContext;
+begin
+  with ADescription do
+  begin
+   FWhiteMaterial:= Texture <> nil;
+   if Material.GetSpecularOn then
+   begin
+     FShaderFunc := TShaderFunction3D(@ApplyLightingWithDiffuseAndSpecularColor);
+     FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyLightingWithDiffuseAndSpecularColor);
+   end else
+   begin
+     UseDiffuseColor := FUseAmbiantColor;
+     if not UseDiffuseColor then
+     begin
+       with Material.GetDiffuseColorInt do
+        UseDiffuseColor := (r <> g) or (g <> b);
+       if not UseDiffuseColor and Material.GetAutoDiffuseColor then
+       begin
+         for j := 0 to FLights.Count-1 do
+           if TBGRALight3D(FLights[j]).GetColoredLight then
+           begin
+             UseDiffuseColor := true;
+             break;
+           end;
+       end;
+     end;
+     if UseDiffuseColor then
+     begin
+       FShaderFunc := TShaderFunction3D(@ApplyLightingWithDiffuseColor);
+       FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyLightingWithDiffuseColor);
+     end else
+     begin
+       if FLights.Count = 0 then
+       begin
+         if FAmbiantLightness = 32768 then
+         begin
+           FShaderFunc := TShaderFunction3D(@ApplyNoLighting);
+           FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyNoLighting);
+         end else
+         begin
+           FShaderFunc := TShaderFunction3D(@ApplyLightingWithAmbiantLightnessOnly);
+           FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyLightingWithAmbiantLightnessOnly);
+         end;
+       end else
+       begin
+        FShaderFunc := TShaderFunction3D(@ApplyLightingWithLightness);
+        FInt65536ShaderFunc := TInt65536ShaderFunction3D(@Int65536ApplyLightingWithLightness);
+       end;
+     end;
+   end;
+
+    ctx := PSceneLightingContext( FContextBlock.Data );
+    ctx^.material := Material;
+    ctx^.LightThroughFactor := LightThroughFactor;
+    ctx^.LightThrough := ctx^.LightThroughFactor > 0;
+    ctx^.SaturationHighF := Material.GetSaturationHigh;
+    ctx^.SaturationLowF := Material.GetSaturationLow;
+    ctx^.SaturationHigh := round(Material.GetSaturationHigh*32768);
+    ctx^.SaturationLow := round(Material.GetSaturationLow*32768);
+    FContext := PBasicLightingContext(ctx);
+  end;
+end;
+
+procedure TBGRAShader3D.ComputeDiffuseLightness(
+  Context: PSceneLightingContext);
+var i: Int32or64;
+begin
+  Context^.lightness := FAmbiantLightness;
+
+  i := FLights.Count-1;
+  while i >= 0 do
+  begin
+    TBGRALight3D(FLights[i]).ComputeDiffuseLightness(Context);
+    dec(i);
+  end;
+end;
+
+procedure TBGRAShader3D.ComputeDiffuseLight(Context: PSceneLightingContext);
+var i: Int32or64;
+  m: TBGRAMaterial3D;
+begin
+  m := TBGRAMaterial3D(Context^.material);
+
+  if FWhiteMaterial or m.GetAutoAmbiantColor then
+    Context^.diffuseColor := FAmbiantLightColor
+  else
+    Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt;
+
+  i := FLights.Count-1;
+  while i >= 0 do
+  begin
+    TBGRALight3D(FLights[i]).ComputeDiffuseColor(Context);
+    dec(i);
+  end;
+
+  Context^.diffuseColor.a := 65536;
+end;
+
+procedure TBGRAShader3D.ComputeDiffuseAndSpecularLight(
+  Context: PSceneLightingContext);
+var i: Int32or64;
+  m: TBGRAMaterial3D;
+begin
+  m := TBGRAMaterial3D(Context^.material);
+
+  if FWhiteMaterial or m.GetAutoAmbiantColor then
+    Context^.diffuseColor := FAmbiantLightColor
+  else
+    Context^.diffuseColor := FAmbiantLightColor*m.GetAmbiantColorInt;
+  Context^.specularColor := ColorInt65536(0,0,0,0);
+
+  i := FLights.Count-1;
+  while i >= 0 do
+  begin
+    TBGRALight3D(FLights[i]).ComputeDiffuseAndSpecularColor(Context);
+    dec(i);
+  end;
+
+  Context^.diffuseColor.a := 65536;
+end;
+
+function TBGRAShader3D.ApplyNoLighting(Context: PSceneLightingContext;
+  Color: TBGRAPixel): TBGRAPixel;
+var
+  m: TBGRAMaterial3D;
+begin
+  m := TBGRAMaterial3D(Context^.material);
+
+  if FWhiteMaterial or m.GetAutoAmbiantColor then
+    result := Color
+  else
+    result := ColorIntToBGRA(BGRAToColorInt(Color,True)*m.GetAmbiantColorInt,True);
+end;
+
+function TBGRAShader3D.ApplyLightingWithAmbiantLightnessOnly(
+  Context: PSceneLightingContext; Color: TBGRAPixel): TBGRAPixel;
+var
+  m: TBGRAMaterial3D;
+begin
+  m := TBGRAMaterial3D(Context^.material);
+
+  if not FWhiteMaterial and not m.GetAutoAmbiantColor then
+    Color := ColorIntToBGRA(BGRAToColorInt(Color,True)* m.GetAmbiantColorInt,True);
+
+  if FAmbiantLightness <= 0 then
+    result := BGRA(0,0,0,color.alpha)
+  else
+    result := ApplyIntensityFast(Color, FAmbiantLightness);
+end;
+
+function TBGRAShader3D.ApplyLightingWithLightness(Context: PSceneLightingContext;
+  Color: TBGRAPixel): TBGRAPixel;
+var
+  m: TBGRAMaterial3D;
+begin
+  ComputeDiffuseLightness(Context);
+
+  m := TBGRAMaterial3D(Context^.material);
+  if not FWhiteMaterial and not m.GetAutoSimpleColor then
+    Color := ColorIntToBGRA(BGRAToColorInt(Color,True)*m.GetSimpleColorInt,True);
+
+  with Context^ do
+    if Lightness <= 0 then
+      result := BGRA(0,0,0,color.alpha)
+    else
+    begin
+      if Lightness <= SaturationLow then
+        result := ApplyIntensityFast(Color, Lightness)
+      else if Lightness >= SaturationHigh then
+        result := BGRA(255,255,255,color.alpha)
+      else
+        result := ApplyLightnessFast( ApplyIntensityFast(Color, SaturationLow),
+                              (Lightness - SaturationLow)*32767 div (SaturationHigh-SaturationLow)+32768 );
+    end;
+end;
+
+function TBGRAShader3D.ApplyLightingWithDiffuseColor(Context: PSceneLightingContext;
+  Color: TBGRAPixel): TBGRAPixel;
+begin
+  ComputeDiffuseLight(Context);
+  result := ColorIntToBGRA(BGRAToColorInt(Color,True)*Context^.diffuseColor,True);
+end;
+
+function TBGRAShader3D.ApplyLightingWithDiffuseAndSpecularColor(Context: PSceneLightingContext;
+  Color: TBGRAPixel): TBGRAPixel;
+begin
+  ComputeDiffuseAndSpecularLight(Context);
+  result := ColorIntToBGRA(BGRAToColorInt(Color,True)*Context^.diffuseColor + Context^.specularColor,True);
+end;
+
+function TBGRAShader3D.Int65536ApplyNoLighting(Context: PSceneLightingContext;
+  Color: TBGRAPixel): TColorInt65536;
+var
+  m: TBGRAMaterial3D;
+begin
+  m := TBGRAMaterial3D(Context^.material);
+
+  if not FWhiteMaterial and not m.GetAutoAmbiantColor then
+    result := BGRAToColorInt(Color,True)* m.GetAmbiantColorInt
+  else
+    result := BGRAToColorInt(Color,True);
+end;
+
+function TBGRAShader3D.Int65536ApplyLightingWithAmbiantLightnessOnly(
+  Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536;
+var
+  m: TBGRAMaterial3D;
+  MaterialColor: TColorInt65536;
+begin
+  m := TBGRAMaterial3D(Context^.material);
+
+  if not FWhiteMaterial and not m.GetAutoAmbiantColor then
+    MaterialColor := BGRAToColorInt(Color,True)* m.GetAmbiantColorInt
+  else
+    MaterialColor := BGRAToColorInt(Color,True);
+
+  if FAmbiantLightness <= 0 then
+    result := ColorInt65536(0,0,0,MaterialColor.a)
+  else
+    result := MaterialColor *
+           ColorInt65536(FAmbiantLightness shl 1,FAmbiantLightness shl 1,FAmbiantLightness shl 1,65536);
+end;
+
+function TBGRAShader3D.Int65536ApplyLightingWithLightness(
+  Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536;
+var
+  MaterialColor: TColorInt65536;
+  m: TBGRAMaterial3D;
+  Extra: Int32or64;
+begin
+  ComputeDiffuseLightness(Context);
+
+  m := TBGRAMaterial3D(Context^.material);
+  if not FWhiteMaterial and not m.GetAutoSimpleColor then
+    MaterialColor := BGRAToColorInt(Color,True)*m.GetSimpleColorInt
+  else
+    MaterialColor := BGRAToColorInt(Color,True);
+
+  with Context^ do
+    if Lightness <= 0 then
+      result := ColorInt65536(0,0,0,MaterialColor.a)
+    else
+    begin
+      if Lightness <= SaturationLow then
+        result := MaterialColor * ColorInt65536(Lightness shl 1,Lightness shl 1,Lightness shl 1,65536)
+      else if Lightness >= SaturationHigh then
+        result := ColorInt65536(65536,65536,65536,MaterialColor.a)
+      else
+      begin
+        result := MaterialColor * ColorInt65536(Lightness shl 1,Lightness shl 1,Lightness shl 1,65536);
+        Extra := (Lightness - SaturationLow)*65536 div (SaturationHigh-SaturationLow);
+        inc(result.r, Extra);
+        inc(result.g, Extra);
+        inc(result.b, Extra);
+      end;
+    end;
+end;
+
+function TBGRAShader3D.Int65536ApplyLightingWithDiffuseColor(
+  Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536;
+begin
+  ComputeDiffuseLight(Context);
+  result := BGRAToColorInt(Color,True)*Context^.diffuseColor;
+end;
+
+function TBGRAShader3D.Int65536ApplyLightingWithDiffuseAndSpecularColor(
+  Context: PSceneLightingContext; Color: TBGRAPixel): TColorInt65536;
+begin
+  ComputeDiffuseAndSpecularLight(Context);
+  result := BGRAToColorInt(Color,True)*Context^.diffuseColor + Context^.specularColor;
+end;
+
+{ TBGRARenderer3D }
+
+function TBGRARenderer3D.GetHasZBuffer: boolean;
+begin
+  result := Assigned(FZBuffer);
+end;
+
+function TBGRARenderer3D.GetGlobalScale: single;
+begin
+  result := FRenderSurfaceMultisample;
+end;
+
+function TBGRARenderer3D.GetSurfaceWidth: integer;
+begin
+  result := FOutputSurface.Width;
+end;
+
+function TBGRARenderer3D.GetSurfaceHeight: integer;
+begin
+  result := FOutputSurface.Height;
+end;
+
+function TBGRARenderer3D.GetHandlesNearClipping: boolean;
+begin
+  result := false;
+end;
+
+function TBGRARenderer3D.GetHandlesFaceCulling: boolean;
+begin
+  result := false;
+end;
+
+constructor TBGRARenderer3D.Create(AOutputSurface: TBGRACustomBitmap;
+            ARenderingOptions: TRenderingOptions;
+            AAmbiantLightColorF: TColorF;
+            ALights: TList);
+begin
+  if AOutputSurface = nil then
+    raise exception.Create('No surface specified');
+  FOutputSurface := AOutputSurface;
+  FOptions := ARenderingOptions;
+
+  if (FOptions.AntialiasingMode = am3dResample)
+    and (FOptions.AntialiasingResampleLevel > 1) then
+  begin
+    FRenderSurface := FOutputSurface.NewBitmap(FOutputSurface.Width*FOptions.AntialiasingResampleLevel,
+                                         FOutputSurface.Height*FOptions.AntialiasingResampleLevel);
+    FRenderSurfaceMultisample := FOptions.AntialiasingResampleLevel;
+  end else
+  begin
+    FRenderSurface := FOutputSurface;
+    FRenderSurfaceMultisample := 1;
+  end;
+
+  FColorGradientTempBmp := FRenderSurface.NewBitmap(2,2);
+  FColorGradientTempBmp.ScanInterpolationFilter := rfLinear;
+
+  if FOptions.PerspectiveMode = pmZBuffer then
+  begin
+    Getmem(FZBuffer, FRenderSurface.NbPixels*sizeof(single));
+    FillDWord(FZBuffer^, FRenderSurface.NbPixels, LongWord(single(0)));
+  end
+  else
+    FZBuffer := nil;
+
+  if (FOptions.AntialiasingMode = am3dMultishape) and
+    (FOptions.PerspectiveMode <> pmZBuffer) then
+  begin
+    FMultishapeFiller := TBGRAMultishapeFiller.Create;
+    FMultishapeFiller.PolygonOrder := poLastOnTop;
+  end
+  else
+    FMultishapeFiller := nil;
+
+  FShader := TBGRAShader3D.Create(AAmbiantLightColorF, ALights);
+end;
+
+function TBGRARenderer3D.RenderFace(var ADescription: TFaceRenderingDescription;
+  AComputeCoordinate: TComputeProjectionFunc): boolean;
+
+  procedure ComputeCenter;
+  var j: Int32or64;
+  begin
+    with ADescription do
+    begin
+      with FCenter do
+      begin
+        ClearPoint3D_128(pos3D);
+        ClearPoint3D_128(normal3D);
+        color := MergeBGRA(slice(Colors,NbVertices));
+      end;
+      for j := 0 to NbVertices-1 do
+      begin
+        FCenter.pos3D.Offset(Positions3D[j]);
+        FCenter.normal3D.Offset(Normals3D[j]);
+      end;
+      with FCenter do
+      begin
+        pos3D.Scale(1/NbVertices);
+        Normalize3D_128(normal3D);
+      end;
+    end;
+    FCenter.proj := AComputeCoordinate(FCenter.pos3D);
+  end;
+
+  procedure DrawFaceWithShader;
+  var
+    j,k: Int32or64;
+    SameColor: boolean;
+  begin
+    with ADescription do
+    begin
+      if Texture <> nil then
+      begin
+        BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface,
+            slice(Projections,NbVertices),slice(Positions3D,NbVertices),slice(Normals3D,NbVertices),
+            Texture,slice(TexCoords,NbVertices),FOptions.TextureInterpolation,
+            FShader.ShaderFunction,True, BGRAPixelTransparent,FZBuffer,FShader.Context);
+        exit;
+      end;
+
+      SameColor := True;
+      for j := 1 to NbVertices-1 do
+        if (Colors[j]<>Colors[j-1]) then SameColor := False;
+
+      if SameColor then
+      begin
+        BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface,
+          slice(Projections,NbVertices),slice(Positions3D,NbVertices),slice(Normals3D,NbVertices),nil,
+            slice(TexCoords,NbVertices),False,FShader.ShaderFunction,True,Colors[0],FZBuffer,FShader.Context);
+      end else
+      if NbVertices = 3 then
+      begin
+        FColorGradientTempBmp.SetPixel(0,0,Colors[0]);
+        FColorGradientTempBmp.SetPixel(1,0,Colors[1]);
+        FColorGradientTempBmp.SetPixel(0,1,Colors[2]);
+        FColorGradientTempBmp.SetPixel(1,1,MergeBGRA(Colors[1],Colors[2]));
+        BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface,
+          slice(Projections,NbVertices),slice(Positions3D,NbVertices),slice(Normals3D,NbVertices),FColorGradientTempBmp,
+            [PointF(0,0),PointF(1,0),PointF(0,1)],True,FShader.ShaderFunction,True, BGRAPixelTransparent,FZBuffer,FShader.Context);
+      end else
+      if NbVertices = 4 then
+      begin
+        FColorGradientTempBmp.SetPixel(0,0,Colors[0]);
+        FColorGradientTempBmp.SetPixel(1,0,Colors[1]);
+        FColorGradientTempBmp.SetPixel(1,1,Colors[2]);
+        FColorGradientTempBmp.SetPixel(0,1,Colors[3]);
+        BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface,
+          slice(Projections,NbVertices),slice(Positions3D,NbVertices),slice(Normals3D,NbVertices),FColorGradientTempBmp,
+            [PointF(0,0),PointF(1,0),PointF(1,1),PointF(0,1)],True,FShader.ShaderFunction,True, BGRAPixelTransparent,FZBuffer,FShader.Context);
+      end else
+      if NbVertices >= 3 then
+      begin //split into triangles
+        ComputeCenter;
+        k := NbVertices-1;
+        for j := 0 to NbVertices-1 do
+        begin
+          FColorGradientTempBmp.SetPixel(0,0,Colors[k]);
+          FColorGradientTempBmp.SetPixel(1,0,Colors[j]);
+          FColorGradientTempBmp.SetPixel(0,1,FCenter.color);
+          FColorGradientTempBmp.SetPixel(1,1,MergeBGRA(Colors[j],FCenter.color));
+          BGRAPolygonAliased.PolygonPerspectiveMappingShaderAliased(FRenderSurface,
+            [Projections[k],Projections[j],FCenter.proj], [Positions3D[k],Positions3D[j],FCenter.pos3D],
+            [Normals3D[k],Normals3D[j],FCenter.normal3D], FColorGradientTempBmp,
+              [PointF(0,0),PointF(1,0),PointF(0,1)],True,FShader.ShaderFunction,True, BGRAPixelTransparent,FZBuffer,FShader.Context);
+          k := j;
+        end;
+      end;
+    end;
+  end;
+
+  procedure ComputeShadedColors;
+  var
+    j: Int32or64;
+  begin
+    with ADescription do
+    begin
+      //Vertex lighting interpolation (low-quality Gouraud, low-quality Phong)
+      if length(FShadedColors) < NbVertices then
+        setlength(FShadedColors, NbVertices);
+
+      for j := 0 to NbVertices-1 do
+        FShadedColors[j] := FShader.Apply(Positions3D[j],Normals3D[j],Colors[j]);
+
+      FSameShadedColors := True;
+      for j := 1 to NbVertices-1 do
+        if (FShadedColors[j]<>FShadedColors[j-1]) then
+        begin
+          FSameShadedColors := False;
+          break;
+        end;
+    end;
+  end;
+
+  procedure DrawWithMultishape;
+  var shadedCenter: TBGRAPixel;
+    j,k: Int32or64;
+  begin
+    with ADescription do
+    begin
+      if Texture <> nil then
+      begin
+        if (FOptions.PerspectiveMode <> pmLinearMapping) and (NbVertices=4) then
+          FMultishapeFiller.AddQuadPerspectiveMapping(
+             Projections[0],Projections[1],Projections[2],Projections[3],
+             Texture,TexCoords[0],TexCoords[1],TexCoords[2],TexCoords[3])
+        else
+        if NbVertices>=3 then
+        begin
+          for j := 0 to NbVertices-3 do
+            FMultishapeFiller.AddTriangleLinearMapping(
+                Projections[j],Projections[j+1],Projections[j+2],
+                Texture,TexCoords[j],TexCoords[j+1],TexCoords[j+2]);
+        end;
+      end
+      else
+      begin
+        ComputeShadedColors;
+
+        if FSameShadedColors then
+          FMultishapeFiller.AddPolygon(slice(Projections,NbVertices),FShadedColors[0])
+        else
+        if NbVertices=3 then
+          FMultishapeFiller.AddTriangleLinearColor(
+             Projections[0],Projections[1],Projections[2],
+             FShadedColors[0],FShadedColors[1],FShadedColors[2])
+        else
+        if NbVertices>=3 then
+        begin  //split into triangles
+          ComputeCenter;
+          shadedCenter := FShader.Apply(FCenter.pos3D,FCenter.normal3D,FCenter.color);
+          k := NbVertices-1;
+          for j := 0 to NbVertices-1 do
+          begin
+            FMultishapeFiller.AddTriangleLinearColor(
+               Projections[k],Projections[j],FCenter.proj,
+               FShadedColors[k],FShadedColors[j],shadedCenter);
+            k := j;
+          end;
+        end;
+      end;
+    end;
+  end;
+
+  procedure DrawAliasedColoredFace;
+  var j,k: integer;
+    shadedCenter: TBGRAPixel;
+  begin
+    with ADescription do
+    begin
+      ComputeShadedColors;
+
+      if FSameShadedColors then
+      begin
+        if FOptions.PerspectiveMode = pmZBuffer then
+          BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(FRenderSurface, slice(Projections,NbVertices),
+          slice(FDepths,NbVertices), slice(FShadedColors,NbVertices),True,FZBuffer)
+        else
+          FRenderSurface.FillPoly(slice(Projections,NbVertices),FShadedColors[0],dmDrawWithTransparency);
+      end
+      else
+      begin
+        if NbVertices > 4 then
+        begin //split into triangles
+          ComputeCenter;
+          shadedCenter := FShader.Apply(FCenter.pos3D,FCenter.normal3D,FCenter.color);
+          k := NbVertices-1;
+          if FOptions.PerspectiveMode = pmLinearMapping then
+          begin
+            for j := 0 to NbVertices-1 do
+            begin
+              FRenderSurface.FillPolyLinearColor([Projections[k],Projections[j],FCenter.proj],[FShadedColors[k],FShadedColors[j],shadedCenter]);
+              k := j;
+            end;
+          end else
+          begin
+            for j := 0 to NbVertices-1 do
+            begin
+              BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(FRenderSurface, [Projections[k],Projections[j],FCenter.proj],
+               [FDepths[k],FDepths[j],FCenter.pos3D.z], [FShadedColors[k],FShadedColors[j],shadedCenter],True,FZBuffer);
+              k := j;
+            end;
+          end;
+        end else
+        begin
+          if FOptions.PerspectiveMode = pmLinearMapping then
+            FRenderSurface.FillPolyLinearColor(slice(Projections,NbVertices),slice(FShadedColors,NbVertices))
+          else
+            BGRAPolygonAliased.PolygonPerspectiveColorGradientAliased(FRenderSurface, slice(Projections,NbVertices),
+             slice(FDepths,NbVertices), slice(FShadedColors,NbVertices),True,FZBuffer);
+        end;
+      end;
+    end;
+  end;
+
+  procedure DrawWithoutShader;
+  var
+    noLighting: Boolean;
+    j: Int32or64;
+  begin
+    with ADescription do
+    begin
+      if length(FDepths) < NbVertices then
+        setlength(FDepths, NbVertices);
+      for j := 0 to NbVertices-1 do
+        FDepths[j] := Positions3D[j].z;
+
+      if Texture <> nil then
+      begin
+        noLighting := True;
+        if length(FLightings) < NbVertices then
+            setlength(FLightings, NbVertices);
+        for j := 0 to NbVertices-1 do
+        begin
+          FLightings[j] := FShader.Int65536Apply(Positions3D[j],Normals3D[j],BGRAWhite).g div 2;
+          if abs(FLightings[j]-32768) > 1 then noLighting := false;
+        end;
+
+        if noLighting then
+        begin
+          if FOptions.PerspectiveMode <> pmLinearMapping then
+            FRenderSurface.FillPolyPerspectiveMapping(slice(Projections,NbVertices),
+            slice(FDepths,NbVertices),Texture,slice(TexCoords,NbVertices),
+            FOptions.TextureInterpolation, FZBuffer)
+          else
+            FRenderSurface.FillPolyLinearMapping(slice(Projections,NbVertices),
+            Texture,slice(TexCoords,NbVertices),FOptions.TextureInterpolation);
+        end else
+        begin
+          if FOptions.PerspectiveMode <> pmLinearMapping then
+            FRenderSurface.FillPolyPerspectiveMappingLightness(
+              slice(Projections,NbVertices),slice(FDepths,NbVertices),Texture,
+              slice(TexCoords,NbVertices),slice(FLightings,NbVertices),
+              FOptions.TextureInterpolation, FZBuffer)
+          else
+            FRenderSurface.FillPolyLinearMappingLightness(
+              slice(Projections,NbVertices),Texture,slice(TexCoords,NbVertices),
+              slice(FLightings,NbVertices),FOptions.TextureInterpolation);
+        end;
+      end
+      else
+        DrawAliasedColoredFace;  //already low-quality shaded
+    end;
+  end;
+
+var
+  j: integer;
+  SkipShader: boolean;
+begin
+  result := true;
+  FShader.Prepare(ADescription);
+  with ADescription do
+  begin
+    //high-quality lighting interpolation, necessary for Phong and high-quality Gouraud
+    if (  (FOptions.LightingInterpolation = liAlwaysHighQuality) or
+          ((FOptions.LightingInterpolation = liSpecularHighQuality) and Material.GetSpecularOn) )
+      and (NormalsMode <> lnNone) then
+    begin
+      //if there are only directional lights and all the normals are the same,
+      //then the lighting will be uniform so we can skip the shader
+      if FShader.OnlyDirectionalLights then
+      begin
+        SkipShader := true;
+        for j := 1 to NbVertices-1 do
+          if Normals3D[j] <> Normals3D[j-1] then
+          begin
+            SkipShader := false;
+            break;
+          end;
+      end else
+        SkipShader := false;
+
+      if not SkipShader then
+      begin
+        DrawFaceWithShader;
+        exit;
+      end;
+    end;
+
+    if Assigned(FMultishapeFiller) then //high-quality antialiasing
+      DrawWithMultishape
+    else
+      DrawWithoutShader;
+  end;
+end;
+
+destructor TBGRARenderer3D.Destroy;
+begin
+  FreeAndNil(FShader);
+
+  if Assigned(FMultishapeFiller) then
+  begin
+    FMultishapeFiller.Draw(FRenderSurface);
+    FreeAndNil(FMultishapeFiller);
+  end;
+
+  if FZBuffer <> nil then
+  begin
+    FreeMem(FZBuffer);
+    FZBuffer := nil;
+  end;
+
+  FreeAndNil(FColorGradientTempBmp);
+
+  if FRenderSurfaceMultisample > 1 then
+  begin
+    BGRAResample.DownSamplePutImage(FRenderSurface,
+               FRenderSurfaceMultisample,FRenderSurfaceMultisample,
+               FOutputSurface, 0,0, dmDrawWithTransparency);
+    FreeAndNil(FRenderSurface);
+    FRenderSurfaceMultisample := 1;
+  end
+  else
+    FRenderSurface := nil;
+
+  inherited Destroy;
+end;
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgrascanner.inc

@@ -0,0 +1,266 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+{$IFDEF INCLUDE_INTERFACE}
+{$UNDEF INCLUDE_INTERFACE}
+type
+  TBGRACustomBitmap = class;
+
+{=== IBGRAScanner ===}
+  {* Interface for a scanner. A scanner is like an image, but its content
+     has no limit and it can be calculated on the fly. It is like a
+     infinite readonly image.
+   *
+   * Note: it must not implement reference counting even if it is an interface
+   *
+   * ''TBGRACustomBitmap'' implements this interface and the content is repeated
+     horizontally and vertically. There are also various classes
+     in ''BGRAGradientScanner'' unit that generate gradients on the fly and
+     in ''BGRATransform'' unit that provide geometrical transformations of images }
+  IBGRAScanner = interface
+    {** Move to the position (''X'',''Y'') for the next call to ''ScanNextPixel'' }
+    procedure ScanMoveTo(X,Y: Integer);
+    {** Scan the pixel at the current location and increments ''X'' }
+    function ScanNextPixel: TBGRAPixel;
+    function ScanNextExpandedPixel: TExpandedPixel;
+    {** Scan at any location using floating point coordinates }
+    function ScanAt(X,Y: Single): TBGRAPixel;
+    function ScanAtExpanded(X,Y: Single): TExpandedPixel;
+    {** Scan at any location using integer coordinates }
+    function ScanAtInteger(X,Y: integer): TBGRAPixel;
+    function ScanAtIntegerExpanded(X,Y: integer): TExpandedPixel;
+    {** Copy a row of pixels from ''X'' to ''X''+''count''-1 to a specified destination
+        ''pdest''. ''mode'' indicates how to combine with existing data }
+    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode);
+    procedure ScanSkipPixels(ACount: integer);
+    {** Returns True if the function ''ScanPutPixels'' is available. Otherwise
+        you need to call ''ScanNextPixel'' and combine pixels for example
+        with ''SetPixel'' }
+    function IsScanPutPixelsDefined: boolean;
+    {** Returns the corresponding OpenGL texture. The value is ''nil'' if no texture is associated. **}
+    function GetTextureGL: IUnknown;
+    function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload;
+    function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload;
+    function ProvidesScanline(ARect: TRect): boolean;
+    function GetScanlineAt(X,Y: integer): PBGRAPixel;
+    function GetScanCustomColorspace: TColorspaceAny;
+    procedure ScanNextCustomChunk(var ACount: integer; out APixels: Pointer);
+    procedure ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer);
+    function ScanAtIntegerMask(X,Y: integer): TByteMask;
+    function ScanAtMask(X,Y: Single): TByteMask;
+  end;
+
+  {** A type of function of a scanner that returns the content at floating point coordinates }
+  TScanAtFunction = function (X,Y: Single): TBGRAPixel of object;
+  {** A type of function of a scanner that returns the content at integer coordinates }
+  TScanAtIntegerFunction = function (X,Y: Integer): TBGRAPixel of object;
+  {** A type of function of a scanner that returns the next pixel }
+  TScanNextPixelFunction = function: TBGRAPixel of object;
+
+  { TBGRACustomScanner }
+  {* Base class for implementing ''IBGRAScanner'' interface }
+  TBGRACustomScanner = class(IBGRAScanner)
+  private
+    FCurX,FCurY: integer;
+    FOwnCur: boolean;
+    FChunk: packed array[0..3] of TExpandedPixel;
+  public
+    function ScanAtInteger(X,Y: integer): TBGRAPixel; virtual;
+    function ScanAtIntegerExpanded(X,Y: integer): TExpandedPixel; virtual;
+    procedure ScanMoveTo(X,Y: Integer); virtual;
+    function ScanNextPixel: TBGRAPixel; virtual;
+    function ScanNextExpandedPixel: TExpandedPixel; virtual;
+    function ScanAt(X,Y: Single): TBGRAPixel; virtual; abstract;
+    function ScanAtExpanded(X,Y: Single): TExpandedPixel; virtual;
+    procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); virtual;
+    procedure ScanSkipPixels(ACount: integer); virtual;
+    function IsScanPutPixelsDefined: boolean; virtual;
+    function GetTextureGL: IUnknown; virtual;
+    function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload; virtual;
+    function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; virtual;
+    function ProvidesScanline({%H-}ARect: TRect): boolean; virtual;
+    function GetScanlineAt({%H-}X,{%H-}Y: integer): PBGRAPixel; virtual;
+    function GetScanCustomColorspace: TColorspaceAny; virtual;
+    procedure ScanNextCustomChunk(var ACount: integer; out APixels: Pointer); virtual;
+    procedure ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); virtual;
+    function ScanAtIntegerMask(X,Y: integer): TByteMask; virtual;
+    function ScanAtMask(X,Y: Single): TByteMask; virtual;
+  protected
+    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+    function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+    function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+  end;
+{$ENDIF}
+
+{$IFDEF INCLUDE_IMPLEMENTATION}
+{$UNDEF INCLUDE_IMPLEMENTATION}
+{ TBGRACustomScanner }
+{ The abstract class record the position so that a derived class
+  need only to redefine ScanAt }
+
+function TBGRACustomScanner.ScanAtInteger(X, Y: integer): TBGRAPixel;
+begin
+  result := ScanAt(X,Y);
+end;
+
+function TBGRACustomScanner.ScanAtIntegerExpanded(X, Y: integer
+  ): TExpandedPixel;
+begin
+  result := GammaExpansion(ScanAtInteger(X,Y));
+end;
+
+procedure TBGRACustomScanner.ScanMoveTo(X, Y: Integer);
+begin
+  FCurX := X;
+  FCurY := Y;
+  FOwnCur := true;
+end;
+
+{ Call ScanAt to determine pixel value }
+function TBGRACustomScanner.ScanNextPixel: TBGRAPixel;
+begin
+  result := ScanAt(FCurX,FCurY);
+  Inc(FCurX);
+end;
+
+function TBGRACustomScanner.ScanNextExpandedPixel: TExpandedPixel;
+begin
+  result := GammaExpansion(ScanNextPixel);
+end;
+
+function TBGRACustomScanner.ScanAtExpanded(X, Y: Single): TExpandedPixel;
+begin
+  result := GammaExpansion(ScanAt(X,Y));
+end;
+
+{$hints off}
+procedure TBGRACustomScanner.ScanPutPixels(pdest: PBGRAPixel; count: integer;
+  mode: TDrawMode);
+begin
+  //do nothing
+end;
+
+procedure TBGRACustomScanner.ScanSkipPixels(ACount: integer);
+begin
+  if FOwnCur then inc(FCurX, ACount)
+  else
+  begin
+    while ACount > 0 do
+    begin
+      ScanNextPixel;
+      dec(ACount);
+    end;
+  end;
+end;
+
+{$hints on}
+
+function TBGRACustomScanner.IsScanPutPixelsDefined: boolean;
+begin
+  result := false;
+end;
+
+function TBGRACustomScanner.GetTextureGL: IUnknown;
+begin
+  result := nil;
+end;
+
+function TBGRACustomScanner.GetImageBoundsWithin(const ARect: TRect;
+  Channel: TChannel; ANothingValue: Byte): TRect;
+begin
+  result := InternalGetImageBoundsWithin(nil,self,ARect,[Channel],ANothingValue);
+end;
+
+function TBGRACustomScanner.GetImageBoundsWithin(const ARect: TRect;
+  Channels: TChannels; ANothingValue: Byte): TRect;
+begin
+  result := InternalGetImageBoundsWithin(nil,self,ARect,Channels,ANothingValue);
+end;
+
+function TBGRACustomScanner.ProvidesScanline(ARect: TRect): boolean;
+begin
+  result := false;
+end;
+
+function TBGRACustomScanner.GetScanlineAt(X, Y: integer): PBGRAPixel;
+begin
+  result := nil;
+end;
+
+function TBGRACustomScanner.GetScanCustomColorspace: TColorspaceAny;
+begin
+  result := TExpandedPixelColorspace;
+end;
+
+procedure TBGRACustomScanner.ScanNextCustomChunk(var ACount: integer; out
+  APixels: Pointer);
+var
+  i: Integer;
+  p: PExpandedPixel;
+begin
+  if ACount > length(FChunk) then ACount := length(FChunk);
+  p := @FChunk[low(FChunk)];
+  APixels := p;
+  for i := ACount-1 downto 0 do
+  begin
+    p^ := ScanNextExpandedPixel;
+    inc(p);
+  end;
+end;
+
+procedure TBGRACustomScanner.ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer);
+var
+  cs: TColorspaceAny;
+  pPixels: Pointer;
+begin
+  cs := GetScanCustomColorspace;
+  if cs = TBGRAPixelColorspace then
+  begin
+    ScanNextCustomChunk(ACount, pPixels);
+    AMask := @PBGRAPixel(pPixels)^.green;
+    AStride := sizeof(TBGRAPixel);
+  end else
+  if cs = TByteMaskColorspace then
+  begin
+    ScanNextCustomChunk(ACount, pPixels);
+    AMask := PByteMask(pPixels);
+    AStride := sizeof(TByteMask);
+  end else
+    raise exception.Create('This scanner does not provide a mask.');
+end;
+
+function TBGRACustomScanner.ScanAtIntegerMask(X,Y: integer): TByteMask;
+begin
+  if GetScanCustomColorspace = TBGRAPixelColorspace then
+    result := ScanAtInteger(X,Y).green
+  else
+    result := ScanAtMask(X,Y);
+end;
+
+function TBGRACustomScanner.ScanAtMask(X,Y: Single): TByteMask;
+begin
+  if GetScanCustomColorspace = TBGRAPixelColorspace then
+    result := ScanAt(X,Y).green
+  else
+    raise exception.Create('This scanner does not provide a mask.');
+end;
+
+{ Interface gateway }
+function TBGRACustomScanner.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  if GetInterface(iid, obj) then
+    Result := S_OK
+  else
+    Result := longint(E_NOINTERFACE);
+end;
+
+{ There is no automatic reference counting, but it is compulsory to define these functions }
+function TBGRACustomScanner._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
+
+function TBGRACustomScanner._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
+begin
+  result := 0;
+end;
+
+{$ENDIF}

vendor/kam_remake/src/ext/BGRABitmap/bgraslicescaling.pas

@@ -0,0 +1,778 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRASliceScaling;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRAGraphics, BGRABitmap, BGRABitmapTypes, IniFiles;
+
+type
+  TMargins = record
+    top, right, bottom, left: integer;
+  end;
+  TSlicePosition = (spTopLeft, spTop, spTopRight, spLeft, spMiddle, spRight,
+    spBottomLeft, spBottom, spBottomRight);
+  TSliceBitmapArray = array[TSlicePosition] of TBGRABitmap;
+  TSliceRectArray = array[TSlicePosition] of TRect;
+  TSliceRepeatPosition = (srpTop, srpLeft, srpMiddleHorizontal,
+    srpMiddleVertical, srpRight, srpBottom);
+  TSliceRepeatArray = array[TSliceRepeatPosition] of boolean;
+
+const
+  SliceRepeatPositionStr : array[TSliceRepeatPosition] of string =
+      ('Top','Left','MiddleHorizontal','MiddleVertical','Right','Bottom');
+
+function Margins(ATop, ARight, ABottom, ALeft: integer): TMargins;
+
+type
+
+  { TBGRASliceScaling }
+
+  TBGRASliceScaling = class
+  private
+    FSliceRectArray: TSliceRectArray;
+    FSliceBitmapArray: TSliceBitmapArray;
+    FSliceRepeat: TSliceRepeatArray;
+    FBitmap: TBGRABitmap;
+    FBitmapOwned: boolean;
+    FBitmapSourceRect: TRect;
+    FMargins: TMargins;
+    FDrawMode: TDrawMode;
+    FResampleMode: TResampleMode;
+    FResampleFilter: TResampleFilter;
+    function GetBitmapHeight: integer;
+    function GetBitmapWidth: integer;
+    function GetSlice(APosition: TSlicePosition): TBGRABitmap;
+    function GetSliceRepeat(Aposition: TSliceRepeatPosition): boolean;
+    function GetSliceRepeatAsString: string;
+    procedure SetBitmap(AValue: TBGRABitmap);
+    procedure SetBitmapSourceRect(AValue: TRect);
+    procedure SetDrawMode(AValue: TDrawMode);
+    procedure SetResampleFilter(AValue: TResampleFilter);
+    procedure SetResampleMode(AValue: TResampleMode);
+    procedure SetSliceRepeat(Aposition: TSliceRepeatPosition; AValue: boolean);
+    procedure SetSliceRepeatAsString(AValue: string);
+  protected
+    // Stuff
+    procedure UpdateSliceRectArray;
+    function ComputeSliceRectArray(ARect: TRect): TSliceRectArray;
+    procedure SliceScalingDraw(ADest: TBGRABitmap; ADestRect: TRect;
+      DrawGrid: boolean = False);
+    procedure Init;
+    procedure ClearBitmapArray;
+  public
+    // Create an instance and stores the bitmap, either as a reference to a TBGRABitmap from the caller,
+    // or as a local owned copy in other cases
+    constructor Create(ABitmap: TBGRABitmap;
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer; ABitmapOwner: boolean = false); overload;
+    constructor Create(ABitmap: TBitmap;
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload;
+    constructor Create(AFilename: string;
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload;
+    constructor Create(AFilename: string; AIsUtf8: boolean;
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload;
+    constructor Create(AStream: TStream;
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload;
+    constructor Create(ABitmap: TBGRABitmap; ABitmapOwner: boolean = false); overload;
+    constructor Create(ABitmap: TBitmap); overload;
+    constructor Create(AFilename: string); overload;
+    constructor Create(AFilename: string; AIsUtf8: boolean); overload;
+    constructor Create(AStream: TStream); overload;
+    constructor Create; overload;
+    procedure SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload;
+    procedure SetMargins(AMargins: TMargins); overload;
+    destructor Destroy; override;
+  public
+    procedure NotifyBitmapChanged; //to notify the source bitmap has changed
+    //so new bitmaps should be used
+    // Draw
+    procedure Draw(ABitmap: TBGRABitmap; ARect: TRect; DrawGrid: boolean = False); overload;
+    procedure Draw(ABitmap: TBGRABitmap; ALeft, ATop, AWidth, AHeight: integer;
+      DrawGrid: boolean = False); overload;
+    procedure AutodetectRepeat;
+  public
+    // Property
+    property DrawMode: TDrawMode read FDrawMode write SetDrawMode;
+    property ResampleMode: TResampleMode read FResampleMode write SetResampleMode;
+    property ResampleFilter: TResampleFilter read FResampleFilter
+      write SetResampleFilter;
+    property BitmapWidth: integer read GetBitmapWidth;
+    property BitmapHeight: integer read GetBitmapHeight;
+    property BitmapSource: TBGRABitmap read FBitmap write SetBitmap;
+    property BitmapSourceRect: TRect read FBitmapSourceRect write SetBitmapSourceRect;
+    property Margins: TMargins read FMargins write SetMargins;
+    property SliceBitmap[APosition: TSlicePosition]: TBGRABitmap read GetSlice;
+    property SliceRepeat[Aposition: TSliceRepeatPosition]: boolean
+      read GetSliceRepeat write SetSliceRepeat;
+    property SliceRepeatAsString: string read GetSliceRepeatAsString write SetSliceRepeatAsString;
+  end;
+
+  TSliceScalingArray = array of TBGRASliceScaling;
+  TSliceScalingDirection = (sdHorizontal, sdVertical);
+  TBGRABitmapArray = array of TBGRABitmap;
+
+  { TBGRAMultiSliceScaling }
+
+  TBGRAMultiSliceScaling = class
+  private
+    FSliceScalingArray: TSliceScalingArray;
+    FBitmapOwned: boolean;
+    FBitmap: TBGRABitmap;
+    function GetCount: integer;
+    procedure SetFSliceScalingArray(AValue: TSliceScalingArray);
+  public
+    constructor Create(ABitmap: TBGRABitmap;
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
+      Direction: TSliceScalingDirection; ABitmapOwner: boolean = false); overload;
+    constructor Create(ABitmap: TBitmap;
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
+      Direction: TSliceScalingDirection); overload;
+    constructor Create(ABitmapFilename: string;
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
+      Direction: TSliceScalingDirection); overload;
+    constructor Create(ABitmapFilename: string; AIsUtf8: boolean;
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
+      Direction: TSliceScalingDirection); overload;
+    constructor Create(AStream: TStream;
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
+      Direction: TSliceScalingDirection); overload;
+    destructor Destroy; override;
+    constructor Create(AIniFilename, ASection: string; AIsUtf8Filename: boolean= false); overload;
+  public
+    procedure Draw(ItemNumber: integer; ABitmap: TBGRABitmap;
+      ARect: TRect; DrawGrid: boolean = False); overload;
+    procedure Draw(ItemNumber: integer; ABitmap: TBGRABitmap;
+      ALeft, ATop, AWidth, AHeight: integer; DrawGrid: boolean = False); overload;
+  public
+    property Count: integer read GetCount;
+    property SliceScalingArray: TSliceScalingArray
+      read FSliceScalingArray write SetFSliceScalingArray;
+  end;
+
+implementation
+
+uses BGRAUTF8;
+
+function Margins(ATop, ARight, ABottom, ALeft: integer): TMargins;
+begin
+  Result.top := atop;
+  Result.right := aright;
+  Result.bottom := abottom;
+  Result.left := aleft;
+end;
+
+{ TBGRAMultiSliceScaling }
+
+procedure TBGRAMultiSliceScaling.SetFSliceScalingArray(AValue: TSliceScalingArray);
+begin
+  if FSliceScalingArray = AValue then
+    Exit;
+  FSliceScalingArray := AValue;
+end;
+
+function TBGRAMultiSliceScaling.GetCount: integer;
+begin
+  result := length(FSliceScalingArray);
+end;
+
+constructor TBGRAMultiSliceScaling.Create(ABitmap: TBGRABitmap;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
+  Direction: TSliceScalingDirection; ABitmapOwner: boolean = false);
+var
+  i: integer;
+  ItemWidth,ItemHeight,ItemStepX,ItemStepY: integer;
+begin
+  FBitmap := ABitmap;
+  FBitmapOwned := ABitmapOwner;
+  ItemWidth := ABitmap.Width;
+  ItemHeight := ABitmap.Height;
+  ItemStepX := 0;
+  ItemStepY := 0;
+  case Direction of
+    sdVertical: begin
+                  ItemHeight:= ABitmap.Height div NumberOfItems;
+                  ItemStepY := ItemHeight;
+                end;
+    sdHorizontal:
+                begin
+                  ItemWidth:= ABitmap.Width div NumberOfItems;
+                  ItemStepX := ItemWidth;
+                end;
+  end;
+
+  SetLength(FSliceScalingArray, NumberOfItems);
+  for i := Low(FSliceScalingArray) to High(FSliceScalingArray) do
+  begin
+    FSliceScalingArray[i] := TBGRASliceScaling.Create(ABitmap,
+      AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
+    FSliceScalingArray[i].BitmapSourceRect := rect(ItemStepX*i,ItemStepY*i,ItemStepX*i+ItemWidth,ItemStepY*i+ItemHeight);
+  end;
+end;
+
+constructor TBGRAMultiSliceScaling.Create(ABitmap: TBitmap;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
+  Direction: TSliceScalingDirection);
+begin
+  Create(TBGRABitmap.Create(ABitmap), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
+    NumberOfItems, Direction, True);
+end;
+
+constructor TBGRAMultiSliceScaling.Create(ABitmapFilename: string;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
+  Direction: TSliceScalingDirection);
+begin
+  Create(TBGRABitmap.Create(ABitmapFilename), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
+    NumberOfItems, Direction, True);
+end;
+
+constructor TBGRAMultiSliceScaling.Create(ABitmapFilename: string; AIsUtf8: boolean;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
+  Direction: TSliceScalingDirection);
+begin
+  Create(TBGRABitmap.Create(ABitmapFilename,AIsUtf8), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
+    NumberOfItems, Direction, True);
+end;
+
+constructor TBGRAMultiSliceScaling.Create(AStream: TStream;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
+  Direction: TSliceScalingDirection);
+begin
+  Create(TBGRABitmap.Create(AStream), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
+    NumberOfItems, Direction, True);
+end;
+
+destructor TBGRAMultiSliceScaling.Destroy;
+var
+  i: integer;
+begin
+  for i := Low(FSliceScalingArray) to High(FSliceScalingArray) do
+    FSliceScalingArray[i].Free;
+  if FBitmapOwned then FBitmap.Free;
+
+  inherited Destroy;
+end;
+
+constructor TBGRAMultiSliceScaling.Create(AIniFilename, ASection: string;
+  AIsUtf8Filename: boolean);
+var
+  i: integer;
+  temp: TMemIniFile;
+  Direction: TSliceScalingDirection;
+  defaultRepeat: string;
+  IniPathUTF8,BitmapFilename: string;
+begin
+  if AIsUtf8Filename then
+  begin
+    if not FileExistsUTF8(AIniFilename) then exit;
+    temp := TMemIniFile.Create(UTF8ToSys(AIniFilename));
+    IniPathUTF8 := ExtractFilePath(AIniFilename);
+  end else
+  begin
+    if not FileExists(AIniFilename) then exit;
+    temp := TMemIniFile.Create(AIniFilename);
+    IniPathUTF8 := SysToUTF8(ExtractFilePath(AIniFilename));
+  end;
+
+  if temp.ReadBool(ASection, 'HorizontalDirection', False) then
+    Direction := sdHorizontal
+  else
+    Direction := sdVertical;
+
+  BitmapFilename := temp.ReadString(ASection, 'Bitmap', '');
+  if (copy(BitmapFilename,1,2) = '.\') or (copy(BitmapFilename,1,2) = './') then
+    BitmapFilename := IniPathUTF8+SysToUTF8(copy(BitmapFilename,3,Length(BitmapFilename)-2));
+  Create(
+    BitmapFilename,True,
+    temp.ReadInteger(ASection, 'MarginTop', 0),
+    temp.ReadInteger(ASection, 'MarginRight', 0),
+    temp.ReadInteger(ASection, 'MarginBottom', 0),
+    temp.ReadInteger(ASection, 'MarginLeft', 0),
+    temp.ReadInteger(ASection, 'NumberOfItems', 1),
+    Direction);
+
+  defaultRepeat := temp.ReadString(ASection, 'Repeat', 'Auto');
+  for i := 0 to High(FSliceScalingArray) do
+    FSliceScalingArray[i].SliceRepeatAsString := temp.ReadString(ASection, 'Repeat'+IntToStr(i+1), defaultRepeat);
+
+  temp.Free;
+end;
+
+procedure TBGRAMultiSliceScaling.Draw(ItemNumber: integer; ABitmap: TBGRABitmap;
+  ARect: TRect; DrawGrid: boolean);
+begin
+  if (ItemNumber < 0) or (ItemNumber >= Count) then exit;
+  FSliceScalingArray[ItemNumber].Draw(ABitmap, ARect, DrawGrid);
+end;
+
+procedure TBGRAMultiSliceScaling.Draw(ItemNumber: integer; ABitmap: TBGRABitmap;
+  ALeft, ATop, AWidth, AHeight: integer; DrawGrid: boolean);
+begin
+  if (ItemNumber < 0) or (ItemNumber >= Count) then exit;
+  FSliceScalingArray[ItemNumber].Draw(ABitmap, ALeft, ATop, AWidth, AHeight, DrawGrid);
+end;
+
+{ TBGRASliceScaling }
+
+procedure TBGRASliceScaling.SetDrawMode(AValue: TDrawMode);
+begin
+  if FDrawMode = AValue then
+    Exit;
+  FDrawMode := AValue;
+end;
+
+procedure TBGRASliceScaling.SetBitmap(AValue: TBGRABitmap);
+begin
+  if FBitmap = AValue then
+    Exit;
+  if FBitmapOwned then
+    FBitmap.Free;
+  FBitmap := AValue;
+  FBitmapOwned := False;
+  UpdateSliceRectArray;
+end;
+
+procedure TBGRASliceScaling.SetBitmapSourceRect(AValue: TRect);
+begin
+  if (FBitmapSourceRect.Left=AValue.Left) and
+     (FBitmapSourceRect.Right=AValue.Right) and
+     (FBitmapSourceRect.Top=AValue.Top) and
+     (FBitmapSourceRect.Bottom=AValue.Bottom) then Exit;
+  FBitmapSourceRect:=AValue;
+  UpdateSliceRectArray;
+end;
+
+function TBGRASliceScaling.GetSlice(APosition: TSlicePosition): TBGRABitmap;
+begin
+  if FSliceBitmapArray[APosition] = nil then
+    with FSliceRectArray[APosition] do
+    begin
+      FSliceBitmapArray[APosition] := TBGRABitmap.Create(right - left, bottom - top);
+      FSliceBitmapArray[APosition].PutImage(-left, -top, FBitmap, dmSet);
+    end;
+  Result := FSliceBitmapArray[APosition];
+end;
+
+function TBGRASliceScaling.GetBitmapHeight: integer;
+begin
+  result := FBitmapSourceRect.Bottom - FBitmapSourceRect.Top;
+end;
+
+function TBGRASliceScaling.GetBitmapWidth: integer;
+begin
+  result := FBitmapSourceRect.Right - FBitmapSourceRect.Left;
+end;
+
+function TBGRASliceScaling.GetSliceRepeat(Aposition: TSliceRepeatPosition): boolean;
+begin
+  Result := FSliceRepeat[Aposition];
+end;
+
+function TBGRASliceScaling.GetSliceRepeatAsString: string;
+var p: TSliceRepeatPosition;
+begin
+  result := '';
+  for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do
+    if SliceRepeat[p] then
+    begin
+      if result <> '' then AppendStr(result, '+');
+      AppendStr(result, SliceRepeatPositionStr[p]);
+    end;
+end;
+
+procedure TBGRASliceScaling.SetResampleFilter(AValue: TResampleFilter);
+begin
+  if FResampleFilter = AValue then
+    Exit;
+  FResampleFilter := AValue;
+end;
+
+procedure TBGRASliceScaling.SetResampleMode(AValue: TResampleMode);
+begin
+  if FResampleMode = AValue then
+    Exit;
+  FResampleMode := AValue;
+end;
+
+procedure TBGRASliceScaling.SetSliceRepeat(Aposition: TSliceRepeatPosition;
+  AValue: boolean);
+begin
+  FSliceRepeat[Aposition] := AValue;
+end;
+
+procedure TBGRASliceScaling.SetSliceRepeatAsString(AValue: string);
+var p: TSliceRepeatPosition;
+  attr: string;
+  idx: integer;
+begin
+  AValue := trim(AValue);
+  if compareText(AValue,'All')=0 then
+  begin
+    for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do
+      SliceRepeat[p] := true;
+    exit;
+  end;
+  for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do
+    SliceRepeat[p] := false;
+  if compareText(AValue,'None')=0 then exit;
+
+  while AValue <> '' do
+  begin
+    idx := pos('+',AValue);
+    if idx <> 0 then
+    begin
+      attr := copy(AValue,1,idx-1);
+      delete(AValue,1,idx);
+    end else
+    begin
+      attr := AValue;
+      AValue := '';
+    end;
+    for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do
+      if CompareText(SliceRepeatPositionStr[p],attr)=0 then
+      begin
+        SliceRepeat[p] := true;
+        attr := '';
+        break;
+      end;
+    if compareText(attr,'Auto')=0 then AutodetectRepeat else
+      if attr <> '' then
+        raise exception.Create('Unknown slice repeat attribute ('+attr+')');
+  end;
+end;
+
+procedure TBGRASliceScaling.UpdateSliceRectArray;
+begin
+  ClearBitmapArray;
+  if FBitmap = nil then exit;
+  FSliceRectArray := ComputeSliceRectArray(FBitmapSourceRect);
+end;
+
+function TBGRASliceScaling.ComputeSliceRectArray(ARect: TRect): TSliceRectArray;
+var
+  Width, Height: integer;
+  pos: TSlicePosition;
+  lMargins: TMargins;
+  ratio: single;
+begin
+  Width := ARect.Right - ARect.Left;
+  Height := ARect.Bottom - ARect.Top;
+  if (Width <= 0) or (Height <= 0) then
+    raise Exception.Create('Empty rectangle');
+
+  lMargins := FMargins;
+  if lMargins.top < 0 then
+    lMargins.top := 0;
+  if lMargins.right < 0 then
+    lMargins.right := 0;
+  if lMargins.bottom < 0 then
+    lMargins.bottom := 0;
+  if lMargins.left < 0 then
+    lMargins.left := 0;
+  if lmargins.left + lMargins.right >= Width then
+  begin
+    ratio := Width / (lmargins.left + lMargins.right + 1);
+    lMargins.left := trunc(lMargins.left * ratio);
+    lMargins.right := trunc(lMargins.right * ratio);
+  end;
+  if lmargins.top + lMargins.bottom >= Height then
+  begin
+    ratio := Height / (lmargins.top + lMargins.bottom + 1);
+    lMargins.top := trunc(lMargins.top * ratio);
+    lMargins.bottom := trunc(lMargins.bottom * ratio);
+  end;
+  with lMargins do
+  begin
+    Result[spTopLeft] := rect(0, 0, Left, Top);
+    Result[spTop] := rect(Left, 0, Width - Right, Top);
+    Result[spTopRight] := rect(Width - Right, 0, Width, Top);
+    Result[spLeft] := rect(0, Top, Left, Height - Bottom);
+    Result[spMiddle] := rect(Left, Top, Width - Right, Height - Bottom);
+    Result[spRight] := rect(Width - Right, Top, Width, Height - Bottom);
+    Result[spBottomLeft] := rect(0, Height - Bottom, Left, Height);
+    Result[spBottom] := rect(Left, Height - Bottom, Width - Right, Height);
+    Result[spBottomRight] := rect(Width - Right, Height - Bottom, Width, Height);
+  end;
+  for pos := low(TSlicePosition) to high(TSlicePosition) do
+    Result[pos].Offset(ARect.Left, ARect.Top);
+end;
+
+procedure TBGRASliceScaling.SliceScalingDraw(ADest: TBGRABitmap;
+  ADestRect: TRect; DrawGrid: boolean);
+var
+  pos: TSlicePosition;
+  tempBGRA: TBGRABitmap;
+  DestSliceRect: TSliceRectArray;
+  repeatSlice: boolean;
+begin
+  if (ADestRect.Right <= ADestRect.Left) or (ADestRect.Bottom <= ADestRect.Top) then
+    exit;
+  DestSliceRect := ComputeSliceRectArray(ADestRect);
+  for pos := Low(TSlicePosition) to High(TSlicePosition) do
+  begin
+    with DestSliceRect[pos] do
+    begin
+      if (right > left) and (bottom > top) then
+      begin
+        case pos of
+          spTop: repeatSlice := SliceRepeat[srpTop];
+          spRight: repeatSlice := SliceRepeat[srpRight];
+          spBottom: repeatSlice := SliceRepeat[srpBottom];
+          spLeft: repeatSlice := SliceRepeat[srpLeft];
+          spMiddle: repeatSlice :=
+              SliceRepeat[srpMiddleHorizontal] and SliceRepeat[srpMiddleVertical];
+          else
+            repeatSlice := False;
+        end;
+        //simple copy
+        if (right - left = FSliceRectArray[pos].right - FSliceRectArray[pos].left) and
+          (bottom - top = FSliceRectArray[pos].bottom - FSliceRectArray[pos].top) then
+        begin
+          FBitmap.ScanOffset :=
+            point(FSliceRectArray[pos].left - left, FSliceRectArray[pos].top - top);
+          ADest.FillRect(left, top, right, bottom, FBitmap, FDrawMode);
+        end
+        else
+        //repeat in both direction
+        if repeatSlice then
+        begin
+          tempBGRA := SliceBitmap[pos];
+          tempBGRA.ScanOffset := point(-left, -top);
+          ADest.FillRect(left, top, right, bottom, tempBGRA, FDrawMode);
+        end
+        else
+        //resample in both directions (or in one direction if the other direction has the same size)
+        if (pos <> spMiddle) or (not SliceRepeat[srpMiddleHorizontal] and
+          not SliceRepeat[srpMiddleVertical]) then
+        begin
+          SliceBitmap[pos].ResampleFilter := ResampleFilter;
+          tempBGRA := SliceBitmap[pos].Resample(right - left, bottom - top, FResampleMode);
+          ADest.PutImage(left, top, tempBGRA, FDrawMode);
+          tempBGRA.Free;
+        end
+        else //one dimension resample, other dimension resample
+        begin
+          SliceBitmap[pos].ResampleFilter := ResampleFilter;
+          if not SliceRepeat[srpMiddleHorizontal] then
+            tempBGRA := SliceBitmap[pos].Resample(
+              right - left, SliceBitmap[pos].Height, FResampleMode)
+          else
+            tempBGRA := SliceBitmap[pos].Resample(
+              SliceBitmap[pos].Width, bottom - top, FResampleMode);
+          tempBGRA.ScanOffset := point(-left, -top);
+          ADest.FillRect(left, top, right, bottom, tempBGRA, FDrawMode);
+          tempBGRA.Free;
+        end;
+      end;
+    end;
+  end;
+  if DrawGrid then
+  begin
+    ADest.DrawLineAntialias(DestSliceRect[spTop].left, DestSliceRect[spTop].top,
+      DestSliceRect[spBottom].left, DestSliceRect[spBottom].bottom,
+      BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False);
+    ADest.DrawLineAntialias(DestSliceRect[spTop].right - 1, DestSliceRect[spTop].top,
+      DestSliceRect[spBottom].right - 1, DestSliceRect[spBottom].bottom,
+      BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False);
+    ADest.DrawLineAntialias(DestSliceRect[spLeft].left, DestSliceRect[spLeft].top,
+      DestSliceRect[spRight].right, DestSliceRect[spRight].top,
+      BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False);
+    ADest.DrawLineAntialias(DestSliceRect[spLeft].left, DestSliceRect[spLeft].bottom - 1,
+      DestSliceRect[spRight].right, DestSliceRect[spRight].bottom - 1,
+      BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False);
+  end;
+end;
+
+procedure TBGRASliceScaling.Init;
+var
+  pos: TSliceRepeatPosition;
+begin
+  FBitmap := nil;
+  FBitmapOwned := False;
+  for pos := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do
+    FSliceRepeat[pos] := False;
+  SetMargins(0, 0, 0, 0);
+  FBitmapSourceRect := rect(0,0,0,0);
+  DrawMode := dmDrawWithTransparency;
+  ResampleMode := rmFineResample;
+  ResampleFilter := rfHalfCosine;
+end;
+
+procedure TBGRASliceScaling.ClearBitmapArray;
+var
+  pos: TSlicePosition;
+begin
+  for pos := low(TSlicePosition) to high(TSlicePosition) do
+    FreeAndNil(FSliceBitmapArray[pos]);
+end;
+
+constructor TBGRASliceScaling.Create(ABitmap: TBGRABitmap;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer; ABitmapOwner: boolean = false);
+begin
+  Create(ABitmap, ABitmapOwner);
+  SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
+end;
+
+constructor TBGRASliceScaling.Create(ABitmap: TBitmap;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
+begin
+  Create(ABitmap);
+  SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
+end;
+
+constructor TBGRASliceScaling.Create(AFilename: string;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
+begin
+  Create(AFilename);
+  SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
+end;
+
+constructor TBGRASliceScaling.Create(AFilename: string; AIsUtf8: boolean;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
+begin
+  Create(AFilename, AIsUtf8);
+  SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
+end;
+
+constructor TBGRASliceScaling.Create(AStream: TStream;
+  AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
+begin
+  Create(AStream);
+  SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
+end;
+
+constructor TBGRASliceScaling.Create(ABitmap: TBGRABitmap; ABitmapOwner: boolean = false);
+begin
+  Init;
+  FBitmap := ABitmap;
+  FBitmapOwned := ABitmapOwner;
+  FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);
+end;
+
+constructor TBGRASliceScaling.Create(ABitmap: TBitmap);
+begin
+  Init;
+  FBitmap := TBGRABitmap.Create(ABitmap);
+  FBitmapOwned := True;
+  FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);
+end;
+
+constructor TBGRASliceScaling.Create(AFilename: string);
+begin
+  Init;
+  FBitmap := TBGRABitmap.Create(AFilename);
+  FBitmapOwned := True;
+  FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);
+end;
+
+constructor TBGRASliceScaling.Create(AFilename: string; AIsUtf8: boolean);
+begin
+  Init;
+  FBitmap := TBGRABitmap.Create(AFilename,AIsUtf8);
+  FBitmapOwned := True;
+  FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);
+end;
+
+constructor TBGRASliceScaling.Create(AStream: TStream);
+begin
+  Init;
+  FBitmap := TBGRABitmap.Create(AStream);
+  FBitmapOwned := True;
+  FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);
+end;
+
+constructor TBGRASliceScaling.Create;
+begin
+  Init;
+end;
+
+procedure TBGRASliceScaling.SetMargins(AMarginTop, AMarginRight,
+  AMarginBottom, AMarginLeft: integer);
+begin
+  SetMargins(BGRASliceScaling.Margins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft));
+end;
+
+procedure TBGRASliceScaling.SetMargins(AMargins: TMargins);
+begin
+  if (AMargins.top <> FMargins.top) or (AMargins.right <> FMargins.right) or
+    (AMargins.bottom <> FMargins.bottom) or (AMargins.left <> FMargins.left) then
+  begin
+    FMargins := AMargins;
+    UpdateSliceRectArray;
+  end;
+end;
+
+destructor TBGRASliceScaling.Destroy;
+begin
+  ClearBitmapArray;
+  if FBitmapOwned then
+    FreeAndNil(FBitmap);
+  inherited Destroy;
+end;
+
+procedure TBGRASliceScaling.NotifyBitmapChanged;
+begin
+  ClearBitmapArray;
+end;
+
+procedure TBGRASliceScaling.Draw(ABitmap: TBGRABitmap; ARect: TRect; DrawGrid: boolean);
+begin
+  SliceScalingDraw(ABitmap, ARect, DrawGrid);
+end;
+
+procedure TBGRASliceScaling.Draw(ABitmap: TBGRABitmap;
+  ALeft, ATop, AWidth, AHeight: integer; DrawGrid: boolean);
+begin
+  Draw(ABitmap, rect(ALeft, ATop, ALeft + AWidth, ATop + AHeight), DrawGrid);
+end;
+
+procedure TBGRASliceScaling.AutodetectRepeat;
+var
+  middleSlice: TBGRABitmap;
+  x, y: integer;
+  p: PBGRAPixel;
+  c0: TBGRAPixel;
+  isRepeating: boolean;
+begin
+  middleSlice := SliceBitmap[spMiddle];
+  isRepeating := True;
+  for y := 0 to middleSlice.Height - 1 do
+  begin
+    p := middleSlice.ScanLine[y];
+    c0 := p^;
+    for x := middleSlice.Width - 1 downto 0 do
+    begin
+      if p^ <> c0 then
+      begin
+        isRepeating := False;
+        break;
+      end;
+      Inc(p);
+    end;
+    if not isRepeating then
+      break;
+  end;
+  if isRepeating then
+    SliceRepeat[srpMiddleHorizontal] := True;
+
+  isRepeating := True;
+  for x := 0 to middleSlice.Width - 1 do
+  begin
+    c0 := middleSlice.GetPixel(x, 0);
+    for y := middleSlice.Height - 1 downto 1 do
+    begin
+      if middleSlice.GetPixel(x, y) <> c0 then
+      begin
+        isRepeating := False;
+        break;
+      end;
+    end;
+    if not isRepeating then
+      break;
+  end;
+  if isRepeating then
+    SliceRepeat[srpMiddleVertical] := True;
+end;
+
+end.

vendor/kam_remake/src/ext/BGRABitmap/bgraspritegl.pas

@@ -0,0 +1,586 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRASpriteGL;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRAOpenGLType,
+  BGRABitmapTypes;
+
+type
+  { TBGLCustomSprite }
+
+  TBGLCustomSprite = class
+  protected
+    FHandle: Pointer;
+    FTexture: IBGLTexture;
+    FFrameLoopStart: integer;
+    FFrameLoopEnd : integer;
+    procedure SetFrameLoopEnd(AValue: integer);
+    procedure SetFrameLoopStart(AValue: integer);
+    function GetHorizontalAlign: TAlignment; virtual; abstract;
+    function GetVerticalAlign: TTextLayout; virtual; abstract;
+    procedure SetHorizontalAlign(AValue: TAlignment); virtual; abstract;
+    procedure SetVerticalAlign(AValue: TTextLayout); virtual; abstract;
+    function GetAlpha: Integer; virtual; abstract;
+    function GetAngle: Single; virtual; abstract;
+    function GetColor: TBGRAPixel; virtual; abstract;
+    function GetActualFrame: Single; virtual; abstract;
+    function GetFrame: Single;
+    function GetH: Single; virtual; abstract;
+    function GetLayer: Integer; virtual; abstract;
+    function GetLocation: TPointF; virtual;
+    function GetVisible: Boolean; virtual;
+    function GetW: Single; virtual; abstract;
+    function GetX: Single; virtual; abstract;
+    function GetY: Single; virtual; abstract;
+    function GetTexture: IBGLTexture; virtual;
+    function GetHandle: Pointer; virtual;
+    procedure SetAlpha(AValue: Integer); virtual; abstract;
+    procedure SetAngle(AValue: Single); virtual; abstract;
+    procedure SetColor(AValue: TBGRAPixel); virtual; abstract;
+    procedure SetFrame(AValue: Single);
+    procedure SetActualFrame(AValue: Single); virtual; abstract;
+    procedure SetH(AValue: Single); virtual; abstract;
+    procedure SetLayer(AValue: Integer); virtual; abstract;
+    procedure SetLocation(AValue: TPointF); virtual;
+    procedure SetW(AValue: Single); virtual; abstract;
+    procedure SetVisible({%H-}AValue: boolean); virtual;
+    procedure SetX(AValue: Single); virtual; abstract;
+    procedure SetY(AValue: Single); virtual; abstract;
+    procedure CreateHandle({%H-}ATexture: IBGLTexture; {%H-}ALayer: Integer); virtual;
+    procedure OnInit; virtual;
+  public
+    constructor Create(ATexture: IBGLTexture; ALayer: integer);
+    destructor Destroy; override;
+    procedure OnDraw; virtual;
+    procedure OnElapse({%H-}AElapsedMs: integer); virtual;
+    procedure OnTimer; virtual;
+    procedure QueryDestroy; virtual; abstract;
+    property Layer   : Integer read GetLayer write SetLayer;
+    property Location: TPointF read GetLocation write SetLocation;
+    property X       : Single read GetX write SetX;
+    property Y       : Single read GetY write SetY;
+    property W       : Single read GetW write SetW;
+    property H       : Single read GetH write SetH;
+    property Angle   : Single read GetAngle write SetAngle;
+    property Frame   : Single read GetFrame write SetFrame;
+    property FrameLoopStart : integer read FFrameLoopStart write SetFrameLoopStart;
+    property FrameLoopEnd : integer read FFrameLoopEnd write SetFrameLoopEnd;
+    property Alpha   : Integer read GetAlpha write SetAlpha;
+    property Color   : TBGRAPixel read GetColor write SetColor;
+    property HorizontalAlign: TAlignment read GetHorizontalAlign write SetHorizontalAlign;
+    property VerticalAlign: TTextLayout read GetVerticalAlign write SetVerticalAlign;
+    property Visible : Boolean read GetVisible write SetVisible;
+    property Texture : IBGLTexture read GetTexture;
+    property Handle  : Pointer read GetHandle;
+  end;
+
+  { TBGLDefaultSprite }
+
+  TBGLDefaultSprite = class(TBGLCustomSprite)
+  protected
+    FColor  : TBGRAPixel;
+    FLocation,FSize: TPointF;
+    FAngle,FFrame  : single;
+    FHorizontalAlign: TAlignment;
+    FVerticalAlign: TTextLayout;
+    FQueryDestroy: boolean;
+    FLayer: integer;
+    FHidden: boolean;
+    function GetHorizontalAlign: TAlignment; override;
+    function GetVerticalAlign: TTextLayout; override;
+    procedure SetHorizontalAlign(AValue: TAlignment); override;
+    procedure SetVerticalAlign(AValue: TTextLayout); override;
+    function GetAlpha: Integer; override;
+    function GetAngle: Single; override;
+    function GetColor: TBGRAPixel; override;
+    function GetDestroy: Boolean;
+    function GetActualFrame: Single; override;
+    function GetH: Single; override;
+    function GetLayer: Integer; override;
+    function GetVisible: Boolean; override;
+    function GetW: Single; override;
+    function GetX: Single; override;
+    function GetY: Single; override;
+    procedure SetAlpha(AValue: Integer); override;
+    procedure SetAngle(AValue: Single); override;
+    procedure SetColor(AValue: TBGRAPixel); override;
+    procedure SetDestroy(AValue: Boolean);
+    procedure SetActualFrame(AValue: Single); override;
+    procedure SetH(AValue: Single); override;
+    procedure SetLayer(AValue: Integer); override;
+    procedure SetVisible(AValue: boolean); override;
+    procedure SetW(AValue: Single); override;
+    procedure SetX(AValue: Single); override;
+    procedure SetY(AValue: Single); override;
+    procedure CreateHandle({%H-}ATexture: IBGLTexture; {%H-}ALayer: Integer); override;
+  public
+    procedure QueryDestroy; override;
+  end;
+
+  { TBGLCustomSpriteEngine }
+
+  TBGLCustomSpriteEngine = class
+  protected
+    function GetSprite(AIndex: integer): TBGLCustomSprite; virtual; abstract;
+    function GetCount: integer; virtual; abstract;
+  public
+    procedure Add(ASprite: TBGLCustomSprite); virtual; abstract;
+    procedure Remove(ASprite: TBGLCustomSprite); virtual; abstract;
+    procedure OnDraw; virtual; abstract;
+    procedure OnTimer; virtual; abstract;
+    procedure OnElapse(AElapsedMs: integer); virtual; abstract;
+    procedure Clear; virtual; abstract;
+    procedure Delete(AIndex: integer); virtual; abstract;
+    property Count: Integer read GetCount;
+    property Sprite[AIndex: integer]: TBGLCustomSprite read GetSprite;
+  end;
+
+  { TBGLDefaultSpriteEngine }
+
+  TBGLDefaultSpriteEngine = class(TBGLCustomSpriteEngine)
+  protected
+    FSpriteRemoved: TBGLCustomSprite;
+    FSprites: array of TBGLDefaultSprite;
+    FSpritesCount: integer;
+    function GetSprite(AIndex: integer): TBGLCustomSprite; override;
+    function GetCount: integer; override;
+  public
+    constructor Create;
+    procedure Add(ASprite: TBGLCustomSprite); override;
+    procedure Remove(ASprite: TBGLCustomSprite); override;
+    procedure OnDraw; override;
+    procedure OnTimer; override;
+    procedure OnElapse(AElapsedMs: integer); override;
+    procedure Clear; override;
+    procedure Delete(AIndex: integer); override;
+  end;
+
+var
+  BGLSpriteEngine  : TBGLCustomSpriteEngine;
+
+implementation
+
+{ TBGLDefaultSpriteEngine }
+
+function TBGLDefaultSpriteEngine.GetSprite(AIndex: integer): TBGLCustomSprite;
+begin
+  if (AIndex < 0) or (Aindex >= Count) then
+    raise ERangeError.Create('Index out of bounds');
+  result := FSprites[AIndex];
+end;
+
+function TBGLDefaultSpriteEngine.GetCount: integer;
+begin
+  result := FSpritesCount;
+end;
+
+constructor TBGLDefaultSpriteEngine.Create;
+begin
+  FSpritesCount := 0;
+end;
+
+procedure TBGLDefaultSpriteEngine.Add(ASprite: TBGLCustomSprite);
+var
+  i: Integer;
+begin
+  if ASprite = nil then exit;
+  if not (ASprite is TBGLDefaultSprite) then
+    raise exception.Create('Invalid class');
+  for i := 0 to Count-1 do
+    if FSprites[i] = ASprite then exit;
+  if Count = length(FSprites) then
+    setlength(FSprites, length(FSprites)*2 + 1);
+  FSprites[Count] := TBGLDefaultSprite(ASprite);
+  Inc(FSpritesCount);
+end;
+
+procedure TBGLDefaultSpriteEngine.Remove(ASprite: TBGLCustomSprite);
+var
+  i: Integer;
+begin
+  if ASprite = FSpriteRemoved then exit;
+  for i := 0 to Count-1 do
+    if FSprites[i] = ASprite then
+    begin
+      Delete(i);
+      exit;
+    end;
+end;
+
+procedure TBGLDefaultSpriteEngine.OnDraw;
+var i: integer;
+begin
+  for i := 0 to Count-1 do
+    FSprites[i].OnDraw;
+end;
+
+procedure TBGLDefaultSpriteEngine.OnTimer;
+var i,j,k: integer;
+    temp: TBGLDefaultSprite;
+begin
+  for i := 0 to Count-1 do
+    FSprites[i].OnTimer;
+  for i := Count-1 downto 0 do
+    if FSprites[i].FQueryDestroy then
+      Delete(i);
+  for i := 1 to Count-1 do
+  begin
+    j := i;
+    while (j > 0) and (FSprites[j-1].Layer > FSprites[i].Layer) do dec(j);
+    if j <> i then
+      begin
+        temp := FSprites[i];
+        for k := i downto j+1 do
+          FSprites[k] := FSprites[k-1];
+        FSprites[j] := temp;
+      end;
+  end;
+end;
+
+procedure TBGLDefaultSpriteEngine.OnElapse(AElapsedMs: integer);
+var i,j,k: integer;
+    temp: TBGLDefaultSprite;
+begin
+  for i := 0 to Count-1 do
+    FSprites[i].OnElapse(AElapsedMs);
+  for i := Count-1 downto 0 do
+    if FSprites[i].FQueryDestroy then
+      Delete(i);
+  for i := 1 to Count-1 do
+  begin
+    j := i;
+    while (j > 0) and (FSprites[j-1].Layer > FSprites[i].Layer) do dec(j);
+    if j <> i then
+      begin
+        temp := FSprites[i];
+        for k := i downto j+1 do
+          FSprites[k] := FSprites[k-1];
+        FSprites[j] := temp;
+      end;
+  end;
+end;
+
+procedure TBGLDefaultSpriteEngine.Clear;
+var i: integer;
+begin
+  for i := 0 to Count-1 do
+  begin
+    FSpriteRemoved := FSprites[i];
+    FSpriteRemoved.Free;
+    FSpriteRemoved := nil;
+  end;
+  FSprites := nil;
+  FSpritesCount := 0;
+end;
+
+procedure TBGLDefaultSpriteEngine.Delete(AIndex: integer);
+var i: integer;
+begin
+  if (AIndex < 0) or (AIndex >= Count) then exit;
+  FSpriteRemoved := FSprites[AIndex];
+  for i := AIndex to Count-1 do
+    FSprites[i] := FSprites[i+1];
+  dec(FSpritesCount);
+  if FSpritesCount <= length(FSprites) div 2 then
+    setlength(FSprites,FSpritesCount);
+  FSpriteRemoved.Free;
+  FSpriteRemoved := nil;
+end;
+
+{ TBGLDefaultSprite }
+
+function TBGLDefaultSprite.GetHorizontalAlign: TAlignment;
+begin
+  result := FHorizontalAlign;
+end;
+
+function TBGLDefaultSprite.GetVerticalAlign: TTextLayout;
+begin
+  result := FVerticalAlign;
+end;
+
+procedure TBGLDefaultSprite.SetHorizontalAlign(AValue: TAlignment);
+begin
+  FHorizontalAlign:= AValue;
+end;
+
+procedure TBGLDefaultSprite.SetVerticalAlign(AValue: TTextLayout);
+begin
+  FVerticalAlign := AValue;
+end;
+
+function TBGLDefaultSprite.GetAlpha: Integer;
+begin
+  result := FColor.alpha;
+end;
+
+function TBGLDefaultSprite.GetAngle: Single;
+begin
+  result := FAngle;
+end;
+
+function TBGLDefaultSprite.GetColor: TBGRAPixel;
+begin
+  result := FColor;
+end;
+
+function TBGLDefaultSprite.GetDestroy: Boolean;
+begin
+  result := FQueryDestroy;
+end;
+
+function TBGLDefaultSprite.GetActualFrame: Single;
+begin
+  result := FFrame;
+end;
+
+function TBGLDefaultSprite.GetH: Single;
+begin
+  result := FSize.Y;
+end;
+
+function TBGLDefaultSprite.GetLayer: Integer;
+begin
+  result := FLayer;
+end;
+
+function TBGLDefaultSprite.GetVisible: Boolean;
+begin
+  Result:= not FHidden;
+end;
+
+function TBGLDefaultSprite.GetW: Single;
+begin
+  result := FSize.X;
+end;
+
+function TBGLDefaultSprite.GetX: Single;
+begin
+  result := FLocation.X;
+end;
+
+function TBGLDefaultSprite.GetY: Single;
+begin
+  result := FLocation.Y;
+end;
+
+procedure TBGLDefaultSprite.SetAlpha(AValue: Integer);
+begin
+  FColor.Alpha := AValue;
+end;
+
+procedure TBGLDefaultSprite.SetAngle(AValue: Single);
+begin
+  FAngle:= AValue;
+end;
+
+procedure TBGLDefaultSprite.SetColor(AValue: TBGRAPixel);
+begin
+  FColor := AValue;
+end;
+
+procedure TBGLDefaultSprite.SetDestroy(AValue: Boolean);
+begin
+  FQueryDestroy:= AValue;
+end;
+
+procedure TBGLDefaultSprite.SetActualFrame(AValue: Single);
+begin
+  FFrame:= AValue;
+end;
+
+procedure TBGLDefaultSprite.SetH(AValue: Single);
+begin
+  FSize.Y := AValue;
+end;
+
+procedure TBGLDefaultSprite.SetLayer(AValue: Integer);
+begin
+  FLayer:= AValue;
+end;
+
+procedure TBGLDefaultSprite.SetVisible(AValue: boolean);
+begin
+  FHidden := not AValue;
+end;
+
+procedure TBGLDefaultSprite.SetW(AValue: Single);
+begin
+  FSize.X := AValue;
+end;
+
+procedure TBGLDefaultSprite.SetX(AValue: Single);
+begin
+  FLocation.X := AValue;
+end;
+
+procedure TBGLDefaultSprite.SetY(AValue: Single);
+begin
+  FLocation.Y := AValue;
+end;
+
+procedure TBGLDefaultSprite.CreateHandle(ATexture: IBGLTexture; ALayer: Integer);
+begin
+  inherited CreateHandle(ATexture, ALayer);
+  FQueryDestroy := false;
+  FLayer:= ALayer;
+end;
+
+procedure TBGLDefaultSprite.QueryDestroy;
+begin
+  SetDestroy(True);
+end;
+
+{ TBGLCustomSprite }
+
+function TBGLCustomSprite.GetTexture: IBGLTexture;
+begin
+  result := FTexture;
+end;
+
+function TBGLCustomSprite.GetHandle: Pointer;
+begin
+  result := FHandle;
+end;
+
+procedure TBGLCustomSprite.SetFrame(AValue: Single);
+var loopLength: integer;
+begin
+  if (FrameLoopEnd <> 0) and (FrameLoopStart <> 0) then
+    begin
+      loopLength := FrameLoopEnd-FrameLoopStart+1;
+      if AValue >= FrameLoopEnd+0.49 then
+        begin
+          if loopLength <= 1 then
+            AValue := FrameLoopEnd+0.49
+          else
+          begin
+            DecF(AValue, Trunc((AValue-(FrameLoopStart-0.5))/loopLength)*loopLength);
+            if AValue > FrameLoopEnd+0.49 then AValue := FrameLoopStart-0.49;
+            if AValue < FrameLoopStart-0.49 then AValue := FrameLoopStart-0.49;
+          end;
+        end else
+      if AValue < FrameLoopStart-0.49 then
+        begin
+          if loopLength <= 1 then
+            AValue := FrameLoopStart-0.49
+          else
+          begin
+            IncF(AValue, Trunc((FrameLoopEnd+0.5-AValue)/loopLength)*loopLength);
+            if AValue > FrameLoopEnd+0.49 then AValue := FrameLoopEnd+0.49;
+            if AValue < FrameLoopStart-0.49 then AValue := FrameLoopEnd+0.49;
+          end;
+        end;
+    end;
+  SetActualFrame(AValue);
+end;
+
+procedure TBGLCustomSprite.SetFrameLoopEnd(AValue: integer);
+begin
+  FFrameLoopEnd := AValue;
+  if FFrameLoopEnd < FFrameLoopStart then
+    FFrameLoopStart := FFrameLoopEnd;
+end;
+
+procedure TBGLCustomSprite.SetFrameLoopStart(AValue: integer);
+begin
+  FFrameLoopStart := AValue;
+  if FFrameLoopStart > FFrameLoopEnd then
+    FFrameLoopEnd := FFrameLoopStart;
+end;
+
+function TBGLCustomSprite.GetFrame: Single;
+begin
+  result := GetActualFrame;
+end;
+
+function TBGLCustomSprite.GetLocation: TPointF;
+begin
+  result := PointF(X,Y);
+end;
+
+function TBGLCustomSprite.GetVisible: Boolean;
+begin
+  result := true;
+end;
+
+procedure TBGLCustomSprite.SetLocation(AValue: TPointF);
+begin
+  X := AValue.X;
+  Y := AValue.Y;
+end;
+
+procedure TBGLCustomSprite.SetVisible(AValue: boolean);
+begin
+  raise ENotImplemented.Create('Not implemented in base class');
+end;
+
+procedure TBGLCustomSprite.CreateHandle(ATexture: IBGLTexture; ALayer: Integer);
+begin
+  FHandle := nil;
+end;
+
+procedure TBGLCustomSprite.OnInit;
+begin
+  //nothing
+end;
+
+constructor TBGLCustomSprite.Create(ATexture: IBGLTexture; ALayer: integer);
+begin
+  CreateHandle(ATexture,ALayer);
+  FTexture := ATexture;
+  Layer := ALayer;
+  if ATexture = nil then
+    begin
+      W := 0;
+      H := 0;
+    end else
+    begin
+      W := ATexture.FrameWidth;
+      H := ATexture.FrameHeight;
+    end;
+  HorizontalAlign := taLeftJustify;
+  VerticalAlign:= tlTop;
+  Color := BGRAWhite;
+  FrameLoopStart := 1;
+  FrameLoopEnd := 0;
+  OnInit;
+  BGLSpriteEngine.Add(self);
+end;
+
+destructor TBGLCustomSprite.Destroy;
+begin
+  if Assigned(BGLSpriteEngine) then
+    BGLSpriteEngine.Remove(self);
+  inherited Destroy;
+end;
+
+procedure TBGLCustomSprite.OnDraw;
+var NumFrame: integer;
+begin
+  if Visible and (Texture <> nil) then
+    begin
+      NumFrame := Trunc(Frame+0.5);
+      if Angle <> 0 then
+        Texture.Frame[NumFrame].StretchDrawAngle(X,Y,W,H,Angle,HorizontalAlign,VerticalAlign, Color)
+      else
+        Texture.Frame[NumFrame].StretchDraw(X,Y,W,H,HorizontalAlign,VerticalAlign, Color)
+    end;
+end;
+
+procedure TBGLCustomSprite.OnElapse(AElapsedMs: integer);
+begin
+  //override if you want to handle time as continuous flow. It is recommended to use floating point positions in this case.
+end;
+
+procedure TBGLCustomSprite.OnTimer;
+begin
+  //override if you want to handle time as discrete frames with fixed time interval
+end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrasse.inc

@@ -0,0 +1,28 @@
+{$IFDEF SSE_LOADV}
+  {$UNDEF SSE_LOADV}
+  {$ifdef cpux86_64}
+  mov rax,v
+  movups xmm1,[rax]
+  {$else}
+  mov eax,v
+  movups xmm1,[eax]
+  {$endif}
+{$ELSE}
+  {$IFDEF SSE_SAVEV}
+    {$UNDEF SSE_SAVEV}
+    {$ifdef cpux86_64}
+    mov rax,v
+    movups [rax],xmm1
+    {$else}
+    mov eax,v
+    movups [eax],xmm1
+    {$endif}  
+  {$ELSE}
+    {$IFDEF CPUI386}
+      {$DEFINE BGRASSE_AVAILABLE}
+    {$ENDIF}
+    {$IFDEF cpux86_64}
+      {$DEFINE BGRASSE_AVAILABLE}
+    {$ENDIF}
+  {$ENDIF}
+{$ENDIF}

vendor/kam_remake/src/ext/BGRABitmap/bgrasse.pas

@@ -0,0 +1,656 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRASSE;
+
+{$mode objfpc}{$H+}
+
+{$i bgrasse.inc}
+{$modeswitch advancedrecords}
+
+interface
+
+{begin  //param: eax, edx, ecx  //float: eax ecx edx
+  //flds $d9
+  //fadds $d8
+  //fstps $d9 +$18
+  //fmuls $d8 +$08
+  //fsubrs $d8 +$28
+  //offset +$40 $..}
+uses
+  BGRABitmapTypes {$ifdef CPUI386}, cpu, mmx{$endif};
+
+const FLAG_ENABLED_SSE = true;
+
+var UseSSE, UseSSE2, UseSSE3 : boolean;
+
+{$ifdef CPUI386}
+  {$asmmode intel}
+{$ENDIF}
+{$ifdef cpux86_64}
+  {$asmmode intel}
+{$ENDIF}
+
+{$ifdef BGRASSE_AVAILABLE}
+  //SSE rotate singles
+  const Shift231 = 1 + 8;
+        Shift312 = 2 + 16;
+{$endif}
+
+type
+
+  { TPoint3D_128 }
+
+  TPoint3D_128 = packed record
+                   x,y,z,t: single;
+                   procedure Offset(const point3D_128: TPoint3D_128);
+                   procedure Scale(AScale: single);
+                 end;
+  PPoint3D_128 = ^TPoint3D_128;
+
+  function Point3D(const point3D_128: TPoint3D_128): TPoint3D; inline; overload;
+  function Point3D_128(const point3D: TPoint3D): TPoint3D_128; inline; overload;
+  function Point3D_128(const pointF: TPointF): TPoint3D_128; inline; overload;
+  function Point3D_128(x,y,z: single): TPoint3D_128; inline; overload;
+  function Point3D_128(x,y,z,t: single): TPoint3D_128; inline; overload;
+  procedure Normalize3D_128_SqLen(var v: TPoint3D_128; out SqLen: single);
+  operator * (const v1: TPoint3D_128; const factor: single): TPoint3D_128;
+  operator + (constref v1,v2: TPoint3D_128): TPoint3D_128;
+  operator - (const v1,v2: TPoint3D_128): TPoint3D_128;
+  operator - (const v: TPoint3D_128): TPoint3D_128; inline;
+  operator = (const v1,v2: TPoint3D_128): boolean; inline;
+  procedure ClearPoint3D_128(out v: TPoint3D_128);
+  {$IFDEF BGRASSE_AVAILABLE}
+  procedure ClearPoint3D_128_AlignedSSE(out v: TPoint3D_128);
+  {$ENDIF}
+  function IsPoint3D_128_Zero(const v: TPoint3D_128): boolean; inline;
+
+var
+  Add3D_Aligned : procedure (var dest: TPoint3D_128; constref src: TPoint3D_128);
+  Normalize3D_128 : procedure (var v: TPoint3D_128);
+  VectProduct3D_128 : procedure (const u,v: TPoint3D_128; out w: TPoint3D_128);
+  DotProduct3D_128 : function (constref v1,v2: TPoint3D_128): single;
+
+const
+  Point3D_128_Zero : TPoint3D_128 = (x:0; y:0; z:0; t:0);
+
+type
+
+  { TMemoryBlockAlign128 }
+
+  TMemoryBlockAlign128 = class
+  private
+    FContainer: Pointer;
+    FData: Pointer;
+  public
+    constructor Create(size: integer);
+    destructor Destroy; override;
+    property Data: pointer read FData;
+  end;
+
+  PBasicLightingContext = ^TBasicLightingContext;
+  TBasicLightingContext = packed record
+    {0} Position, {16} Normal: TPoint3D_128;
+    {32} PositionInvZ, {48} NormalInvZ: TPoint3D_128;
+    {64} PositionStepInvZ, {80} NormalStepInvZ: TPoint3D_128;
+    {96} dummy4: single;
+    {100} dummy3: LongBool;
+    {104} dummy1: LongWord;
+    {108} dummy2: LongWord;
+    {112} dummy: packed array[0..15]of byte;
+  end; {128}
+
+const ExtendedLightingContextSize = 128;
+
+implementation
+
+{ TPoint3D_128 }
+
+procedure TPoint3D_128.Offset(const point3D_128: TPoint3D_128);
+begin
+  self.x := self.x + point3D_128.x;
+  self.y := self.y + point3D_128.y;
+  self.z := self.z + point3D_128.z;
+end;
+
+procedure TPoint3D_128.Scale(AScale: single);
+begin
+  self.x := self.x * AScale;
+  self.y := self.y * AScale;
+  self.z := self.z * AScale;
+end;
+
+function Point3D(const point3D_128: TPoint3D_128): TPoint3D; inline; overload;
+begin
+  result.x := point3D_128.x;
+  result.y := point3D_128.y;
+  result.z := point3D_128.z;
+end;
+
+function Point3D_128(const point3D: TPoint3D): TPoint3D_128; inline; overload;
+begin
+  result.x := point3D.x;
+  result.y := point3D.y;
+  result.z := point3D.z;
+  result.t := 0;
+end;
+
+function Point3D_128(const pointF: TPointF): TPoint3D_128;
+begin
+   result.x := pointF.x;
+   result.y := pointF.y;
+   result.z := 0;
+   result.t := 0;
+end;
+
+function Point3D_128(x,y,z: single): TPoint3D_128; inline; overload;
+begin
+  result.x := x;
+  result.y := y;
+  result.z := z;
+  result.t := 0;
+end;
+
+function Point3D_128(x,y,z,t: single): TPoint3D_128; inline; overload;
+begin
+  result.x := x;
+  result.y := y;
+  result.z := z;
+  result.t := t;
+end;
+
+operator + (constref v1,v2: TPoint3D_128): TPoint3D_128;
+{$ifdef CPUI386} assembler;
+asm
+  db $d9, $00 //flds [eax]
+  db $d8, $02 //fadds [edx]
+  db $d9, $19 //fstps [ecx]
+
+  db $d9, $40, $04 //flds [eax+4]
+  db $d8, $42, $04 //fadds [edx+4]
+  db $d9, $59, $04 //fstps [ecx+4]
+
+  db $d9, $40, $08 //flds [eax+8]
+  db $d8, $42, $08 //fadds [edx+8]
+  db $d9, $59, $08 //fstps [ecx+8]
+
+  xor eax,eax
+  mov [ecx+12],eax
+end;
+{$else}
+begin
+  result.x := v1.x+v2.x;
+  result.y := v1.y+v2.y;
+  result.z := v1.z+v2.z;
+  result.t := 0;
+end;
+{$endif}
+
+{$ifdef BGRASSE_AVAILABLE}
+procedure Add3D_AlignedSSE(var dest: TPoint3D_128; constref src: TPoint3D_128); assembler;
+asm
+  movaps xmm0, [dest]
+  movups xmm1, [src]
+  addps xmm0, xmm1
+  movaps [dest], xmm0
+end;
+{$endif}
+
+procedure Add3D_NoSSE(var dest: TPoint3D_128; constref src: TPoint3D_128);
+{$ifdef CPUI386} assembler;
+asm
+  db $d9, $00 //flds [eax]
+  db $d8, $02 //fadds [edx]
+  db $d9, $18 //fstps [eax]
+
+  db $d9, $40, $04 //flds [eax+4]
+  db $d8, $42, $04 //fadds [edx+4]
+  db $d9, $58, $04 //fstps [eax+4]
+
+  db $d9, $40, $08 //flds [eax+8]
+  db $d8, $42, $08 //fadds [edx+8]
+  db $d9, $58, $08 //fstps [eax+8]
+end;
+{$else}
+begin
+  dest.x := dest.x + src.x;
+  dest.y := dest.y + src.y;
+  dest.z := dest.z + src.z;
+end;
+{$endif}
+
+operator - (const v1,v2: TPoint3D_128): TPoint3D_128;
+{$ifdef CPUI386} assembler;
+asm
+  db $d9, $02 //flds [edx]
+  db $d8, $28 //fsubrs [eax]
+  db $d9, $19 //fstps [ecx]
+
+  db $d9, $42, $04 //flds [edx+4]
+  db $d8, $68, $04 //fsubrs [eax+4]
+  db $d9, $59, $04 //fstps [ecx+4]
+
+  db $d9, $42, $08 //flds [edx+8]
+  db $d8, $68, $08 //fsubrs [eax+8]
+  db $d9, $59, $08 //fstps [ecx+8]
+
+  xor eax,eax
+  mov [ecx+12],eax
+end;
+{$else}
+begin
+  result.x := v1.x-v2.x;
+  result.y := v1.y-v2.y;
+  result.z := v1.z-v2.z;
+  result.t := 0;
+end;
+{$endif}
+
+operator-(const v: TPoint3D_128): TPoint3D_128; inline;
+begin
+  result.x := -v.x;
+  result.y := -v.y;
+  result.z := -v.z;
+  result.t := 0;
+end;
+
+operator=(const v1, v2: TPoint3D_128): boolean; inline;
+begin
+ result := (v1.x=v2.x) and (v1.y=v2.y) and (v1.z=v2.z);
+end;
+
+procedure ClearPoint3D_128(out v: TPoint3D_128);
+{$ifdef cpux86_64} assembler;
+asm
+  push rbx
+  mov rax,v
+  xor rbx,rbx
+  mov [rax],rbx
+  mov [rax+8],rbx
+  pop rbx
+end;
+{$else}
+  {$ifdef CPUI386} assembler;
+  asm
+    push ebx
+    mov eax,v
+    xor ebx,ebx
+    mov [eax],ebx
+    mov [eax+4],ebx
+    mov [eax+8],ebx
+    pop ebx
+  end;
+  {$else}
+  var p: PLongWord;
+  begin
+    p := @v;
+    p^ := 0;
+    inc(p);
+    p^ := 0;
+    inc(p);
+    p^ := 0;
+  end;
+  {$endif}
+{$endif}
+
+procedure ClearPoint3D_128_AlignedSSE(out v: TPoint3D_128);
+{$ifdef BGRASSE_AVAILABLE} assembler;
+ asm
+  xorps xmm0,xmm0
+  {$ifdef cpux86_64}
+  mov rax,v
+  movaps [rax],xmm0
+  {$else}
+  mov eax,v
+  movaps [eax],xmm0
+  {$endif}
+ end;
+{$else}
+var p: PLongWord;
+begin
+  p := @v;
+  p^ := 0;
+  inc(p);
+  p^ := 0;
+  inc(p);
+  p^ := 0;
+end;
+{$endif}
+
+function IsPoint3D_128_Zero(const v: TPoint3D_128): boolean;
+begin
+  result := (v.x=0) and (v.y=0) and (v.z=0);
+end;
+
+operator * (const v1: TPoint3D_128; const factor: single): TPoint3D_128;
+{$ifdef CPUI386} assembler;
+asm
+  db $d9, $00 //flds [eax]
+  db $d8, $4d, $08 //fmuls [ebp+8]
+  db $d9, $1a //fstps [edx]
+
+  db $d9, $40, $04 //flds [eax+4]
+  db $d8, $4d, $08 //fmuls [ebp+8]
+  db $d9, $5a, $04 //fstps [edx+4]
+
+  db $d9, $40, $08 //flds [eax+8]
+  db $d8, $4d, $08 //fmuls [ebp+8]
+  db $d9, $5a, $08 //fstps [edx+8]
+
+  xor eax,eax
+  mov [edx+12],eax
+end;
+{$else}
+begin
+  result.x := v1.x*factor;
+  result.y := v1.y*factor;
+  result.z := v1.z*factor;
+  result.t := 0;
+end;
+{$endif}
+
+{$ifdef BGRASSE_AVAILABLE}
+function DotProduct3D_128_SSE3(constref v1,v2: TPoint3D_128): single; assembler;
+asm
+  movups xmm0, [v1]
+  movups xmm1, [v2]
+  mulps xmm0, xmm1
+
+  haddps xmm0,xmm0
+  haddps xmm0,xmm0
+  movss [result], xmm0
+end;
+{$endif}
+
+function DotProduct3D_128_NoSSE(constref v1,v2: TPoint3D_128): single;
+begin
+  result := v1.x*v2.x + v1.y*v2.y + v1.z*v2.z;
+end;
+
+procedure Normalize3D_128_NoSSE(var v: TPoint3D_128);
+var len2: single;
+begin
+  len2 := DotProduct3D_128_NoSSE(v,v);
+  if len2 = 0 then exit;
+  v.Scale( 1/sqrt(len2) );
+end;
+
+{$ifdef BGRASSE_AVAILABLE}
+procedure Normalize3D_128_SSE1(var v: TPoint3D_128);
+var len2: single;
+begin
+  asm
+    {$DEFINE SSE_LOADV}{$i bgrasse.inc}
+    movaps xmm2, xmm1
+    mulps xmm2, xmm2
+
+    //mix1
+    movaps xmm7, xmm2
+    shufps xmm7, xmm7, $4e
+    addps xmm2, xmm7
+    //mix2
+    movaps xmm7, xmm2
+    shufps xmm7, xmm7, $11
+    addps xmm2, xmm7
+
+    movss len2, xmm2
+  end;
+  if (len2 = 0) then exit;
+  if len2 < 1e-6 then //out of bounds for SSE instruction
+  begin
+     v.Scale( 1/sqrt(len2) );
+  end else
+  asm
+    rsqrtps xmm2, xmm2
+    mulps xmm1, xmm2  //apply
+    {$DEFINE SSE_SAVEV}{$i bgrasse.inc}
+  end;
+end;
+{$endif}
+
+{$ifdef BGRASSE_AVAILABLE}
+procedure Normalize3D_128_SSE3(var v: TPoint3D_128);
+var len2: single;
+begin
+  asm
+    {$DEFINE SSE_LOADV}{$i bgrasse.inc}
+    movaps xmm2, xmm1
+    mulps xmm2, xmm2
+
+    haddps xmm2,xmm2
+    haddps xmm2,xmm2
+
+    movss len2, xmm2
+  end;
+  if (len2 = 0) then exit;
+  if len2 < 1e-6 then //out of bounds for SSE instruction
+  begin
+     v.Scale( 1/sqrt(len2) );
+  end else
+  asm
+    rsqrtps xmm2, xmm2
+    mulps xmm1, xmm2  //apply
+    {$DEFINE SSE_SAVEV}{$i bgrasse.inc}
+  end;
+end;
+{$endif}
+
+procedure Normalize3D_128_SqLen(var v: TPoint3D_128; out SqLen: single);
+begin
+  {$ifdef BGRASSE_AVAILABLE}
+    if UseSSE then
+    begin
+      asm
+        {$DEFINE SSE_LOADV}{$i bgrasse.inc}
+        movaps xmm2, xmm1
+        mulps xmm2, xmm2
+      end;
+      if UseSSE3 then
+      asm
+        haddps xmm2,xmm2
+        haddps xmm2,xmm2
+        {$ifdef cpux86_64}
+        mov rax, SqLen
+        movss [rax], xmm2
+        {$else}
+        mov eax, SqLen
+        movss [eax], xmm2
+        {$endif}
+      end else
+      asm
+        //mix1
+        movaps xmm7, xmm2
+        shufps xmm7, xmm7, $4e
+        addps xmm2, xmm7
+        //mix2
+        movaps xmm7, xmm2
+        shufps xmm7, xmm7, $11
+        addps xmm2, xmm7
+        {$ifdef cpux86_64}
+        mov rax, SqLen
+        movss [rax], xmm2
+        {$else}
+        mov eax, SqLen
+        movss [eax], xmm2
+        {$endif}
+      end;
+      if SqLen = 0 then exit;
+      if SqLen < 1e-6 then //out of bounds for SSE instruction
+      begin
+         v.Scale( 1/sqrt(SqLen) );
+      end else
+      asm
+        rsqrtps xmm2, xmm2
+        mulps xmm1, xmm2  //apply
+        {$DEFINE SSE_SAVEV}{$i bgrasse.inc}
+      end;
+    end
+    else
+{$endif}
+    begin
+      SqLen := DotProduct3D_128_NoSSE(v,v);
+      if SqLen = 0 then exit;
+      v.Scale( 1/sqrt(SqLen) );
+    end;
+end;
+
+procedure VectProduct3D_128_NoSSE(const u,v: TPoint3D_128; out w: TPoint3D_128);
+begin
+  w.x := u.y*v.z-u.z*v.y;
+  w.y := u.z*v.x-u.x*v.z;
+  w.z := u.x*v.Y-u.y*v.x;
+  w.t := 0;
+end;
+
+{$ifdef BGRASSE_AVAILABLE}
+procedure VectProduct3D_128_SSE(constref u,v: TPoint3D_128; out w: TPoint3D_128); assembler;
+asm
+  {$ifdef cpux86_64}
+  mov rax,u
+  movups xmm6,[rax]
+  {$else}
+  mov eax,u
+  movups xmm6,[eax]
+  {$endif}
+  movaps xmm4, xmm6
+  shufps xmm6, xmm6, Shift231
+
+  {$ifdef cpux86_64}
+  mov rax,v
+  movups xmm7,[rax]
+  {$else}
+  mov eax,v
+  movups xmm7,[eax]
+  {$endif}
+  movaps xmm5,xmm7
+  shufps xmm7, xmm7, Shift312
+
+  movaps xmm3,xmm6
+  mulps xmm3,xmm7
+
+  shufps xmm4, xmm4, Shift312
+  shufps xmm5, xmm5, Shift231
+
+  mulps xmm4,xmm5
+  subps xmm3,xmm4
+
+  {$ifdef cpux86_64}
+  mov rax,w
+  movups [rax],xmm3
+  {$else}
+  mov eax,w
+  movups [eax],xmm3
+  {$endif}
+end;
+
+{$endif}
+
+{ TMemoryBlockAlign128 }
+
+{$hints off}
+constructor TMemoryBlockAlign128.Create(size: integer);
+{$IFDEF BGRASSE_AVAILABLE}
+var
+  delta: PtrUInt;
+begin
+  getmem(FContainer, size+15);
+  delta := PtrUInt(FContainer) and 15;
+  if delta <> 0 then delta := 16-delta;
+  FData := pbyte(FContainer)+delta;
+end;
+{$ELSE}
+begin
+  getmem(FContainer, size);
+  FData := FContainer;
+end;
+{$ENDIF}
+{$hints on}
+
+destructor TMemoryBlockAlign128.Destroy;
+begin
+  freemem(FContainer);
+  inherited Destroy;
+end;
+
+{$ifdef BGRASSE_AVAILABLE}
+function sse3_support : boolean;
+
+  var
+     _ecx : longint;
+
+  begin
+    {$IFDEF CPUI386}
+     if cpuid_support then
+       begin
+          asm
+             push ebx
+             mov eax,1
+             cpuid
+             mov _ecx,ecx
+             pop ebx
+          end;
+          sse3_support:=(_ecx and 1)<>0;
+       end
+     else
+       sse3_support:=false;
+    {$ELSE}
+    asm
+       push rbx
+       mov eax,1
+       cpuid
+       mov _ecx,ecx
+       pop rbx
+    end;
+    sse3_support:=(_ecx and 1)<>0;
+    {$ENDIF}
+  end;
+{$endif}
+
+initialization
+
+  {$ifdef CPUI386}
+  UseSSE := is_sse_cpu and FLAG_ENABLED_SSE;
+  {$else}
+    {$ifdef cpux86_64}
+    UseSSE := FLAG_ENABLED_SSE;
+    {$else}
+    UseSSE := false;
+    {$endif}
+  {$endif}
+
+  {$IFDEF BGRASSE_AVAILABLE}
+  if UseSSE then
+  begin
+    {$ifdef cpux86_64}
+    UseSSE2 := true;
+    {$else}
+    UseSSE2 := is_sse2_cpu;
+    {$endif}
+    UseSSE3 := sse3_support;
+
+    Add3D_Aligned := @Add3D_AlignedSSE;
+    VectProduct3D_128 := @VectProduct3D_128_NoSSE; //VectProduct3D_128_SSE is slower (due to access penalty?)
+    if UseSSE3 then
+    begin
+      Normalize3D_128 := @Normalize3D_128_SSE3;
+      DotProduct3D_128 := @DotProduct3D_128_NoSSE; //DotProduct3D_128_SSE3 is slower (due to access penalty?)
+    end
+    else
+    begin
+      Normalize3D_128 := @Normalize3D_128_SSE1;
+      DotProduct3D_128 := @DotProduct3D_128_NoSSE;
+    end;
+  end
+  else
+  {$ENDIF}
+  begin
+    UseSSE := false;
+    UseSSE2 := false;
+    UseSSE3 := false;
+
+    Add3D_Aligned := @Add3D_NoSSE;
+    Normalize3D_128 := @Normalize3D_128_NoSSE;
+    VectProduct3D_128 := @VectProduct3D_128_NoSSE;
+    DotProduct3D_128 := @DotProduct3D_128_NoSSE;
+  end;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrastreamlayers.pas

@@ -0,0 +1,393 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRAStreamLayers;
+
+{$mode objfpc}{$H+}
+{$MODESWITCH ADVANCEDRECORDS}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRALayers, BGRABitmap, BGRALzpCommon, BGRAMemDirectory;
+
+function CheckStreamForLayers(AStream: TStream): boolean;
+function LoadLayersFromStream(AStream: TStream; out ASelectedLayerIndex: integer; ALoadLayerUniqueIds: boolean = false;
+         ADestination: TBGRALayeredBitmap = nil; AProgress: boolean = false): TBGRALayeredBitmap;
+procedure SaveLayersToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap; ASelectedLayerIndex: integer;
+         ACompression: TLzpCompression = lzpZStream; AProgress: boolean = false);
+procedure SaveLayerBitmapToStream(AStream: TStream; ABitmap: TBGRABitmap; ACaption: string; ACompression: TLzpCompression = lzpZStream);
+function LoadLayerBitmapFromStream(AStream: TStream; ACompression: TLzpCompression = lzpZStream) : TBGRABitmap;
+procedure RegisterStreamLayers;
+
+implementation
+
+uses BGRABitmapTypes, BGRACompressableBitmap, zstream, BGRAReadLzp, BGRAWriteLzp,
+     BGRAUTF8, Math;
+
+type
+  PLayerHeader = ^TLayerHeader;
+
+  { TLayerHeader }
+
+  TLayerHeader = packed record
+    LayerOption, BlendOp,
+    LayerOfsX, LayerOfsY,
+    LayerUniqueId, LayerOpacity: Longint;
+    LayerBitmapSize: int64;
+    OriginalGuid: TGuid;
+    OriginalMatrix: TAffineMatrix;
+    procedure FixEndian;
+  end;
+
+{ TLayerHeader }
+
+procedure TLayerHeader.FixEndian;
+begin
+  LayerOption := NtoLE(LayerOption);
+  BlendOp := NtoLE(BlendOp);
+  LayerOfsX := NtoLE(LayerOfsX);
+  LayerOfsY := NtoLE(LayerOfsY);
+  LayerUniqueId := NtoLE(LayerUniqueId);
+  LayerOpacity := NtoLE(LayerOpacity);
+  LayerBitmapSize := NtoLE(LayerBitmapSize);
+  OriginalGuid.D1 := NtoBE(OriginalGuid.D1);
+  OriginalGuid.D2 := NtoBE(OriginalGuid.D2);
+  OriginalGuid.D3 := NtoBE(OriginalGuid.D3);
+  LongWord(OriginalMatrix[1,1]) := NtoLE(LongWord(OriginalMatrix[1,1]));
+  LongWord(OriginalMatrix[2,1]) := NtoLE(LongWord(OriginalMatrix[2,1]));
+  LongWord(OriginalMatrix[1,2]) := NtoLE(LongWord(OriginalMatrix[1,2]));
+  LongWord(OriginalMatrix[2,2]) := NtoLE(LongWord(OriginalMatrix[2,2]));
+  LongWord(OriginalMatrix[1,3]) := NtoLE(LongWord(OriginalMatrix[1,3]));
+  LongWord(OriginalMatrix[2,3]) := NtoLE(LongWord(OriginalMatrix[2,3]));
+end;
+
+procedure SaveLayeredBitmapToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap);
+begin
+  SaveLayersToStream(AStream,ALayers,-1);
+end;
+
+procedure LoadLayeredBitmapFromStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap);
+var selectedIndex: integer;
+begin
+  if not CheckStreamForLayers(AStream) then
+  begin
+    if Assigned(ALayers) then ALayers.Clear;
+  end
+  else
+    LoadLayersFromStream(AStream,selectedIndex,false,ALayers as TBGRALayeredBitmap);
+end;
+
+const
+  StreamHeader = 'TBGRALayeredBitmap'#26#0;
+  StreamMaxLayerCount = 4096;
+  StreamMaxHeaderSize = 256;
+
+function CheckStreamForLayers(AStream: TStream): boolean;
+var
+  OldPosition: Int64;
+  HeaderFound: string;
+begin
+  result := false;
+  OldPosition:= AStream.Position;
+  try
+    SetLength(HeaderFound, length(StreamHeader));
+    SetLength(HeaderFound, AStream.Read(HeaderFound[1], length(HeaderFound)));
+    if HeaderFound = StreamHeader then
+      result := true;
+  except
+    on ex: exception do
+    begin
+      //nothing
+    end;
+  end;
+  AStream.Position:= OldPosition;
+end;
+
+procedure RenameLayersToUniqueId(ALayers: TBGRACustomLayeredBitmap);
+var
+  layerDir: TMemDirectory;
+  i: Integer;
+begin
+  layerDir := ALayers.MemDirectory.FindPath('layers');
+  if Assigned(layerDir) then
+  begin
+    for i := 0 to ALayers.NbLayers-1 do
+      layerDir.Rename('layer'+inttostr(i+1), '', inttostr(ALayers.LayerUniqueId[i]));
+  end;
+end;
+
+procedure RenameLayersToIndex(ALayers: TBGRACustomLayeredBitmap);
+var
+  layerDir: TMemDirectory;
+  i: Integer;
+begin
+  layerDir := ALayers.MemDirectory.FindPath('layers');
+  if Assigned(layerDir) then
+  begin
+    for i := 0 to ALayers.NbLayers-1 do
+      layerDir.Rename(inttostr(ALayers.LayerUniqueId[i]), '', 'layer'+inttostr(i+1));
+  end;
+end;
+
+function LoadLayersFromStream(AStream: TStream; out ASelectedLayerIndex: integer; ALoadLayerUniqueIds: boolean;
+         ADestination: TBGRALayeredBitmap; AProgress: boolean): TBGRALayeredBitmap;
+var
+  OldPosition: Int64;
+  HeaderFound: string;
+  NbLayers, canvasWidth, canvasHeight: LongInt;
+  HeaderSize, LayerHeaderSize: LongInt;
+  LayerStackStartPosition, LayerHeaderPosition,
+  LayerBitmapPosition, LayerEndPosition, MemDirPos: Int64;
+  StackOption: LongInt;
+  Layer: TBGRABitmap;
+  i,LayerIndex: integer;
+  LayerName: string;
+  Compression: TLzpCompression;
+  LayerBlendOp: TBlendOperation;
+  LayerIdFound: boolean;
+  h: TLayerHeader;
+begin
+  if Assigned(ADestination) then
+  begin
+    result := ADestination;
+    result.Clear;
+  end else
+    result := TBGRALayeredBitmap.Create;
+  OldPosition:= AStream.Position;
+  SetLength(HeaderFound, length(StreamHeader));
+  try
+    //format identifier
+    SetLength(HeaderFound, AStream.Read(HeaderFound[1], length(HeaderFound)));
+    if HeaderFound <> StreamHeader then
+      raise exception.Create('Invalid header');
+
+    //header size
+    HeaderSize:= LEReadLongint(AStream);
+    if (HeaderSize < 12) or (HeaderSize > StreamMaxHeaderSize) then
+      raise exception.Create('Invalid header size');
+    LayerStackStartPosition := AStream.Position + HeaderSize;
+
+    NbLayers:= LEReadLongint(AStream);
+    if (NbLayers < 0) or (NbLayers > StreamMaxLayerCount) then
+      raise exception.Create('Invalid layer count');
+
+    ASelectedLayerIndex:= LEReadLongint(AStream);
+    if (ASelectedLayerIndex < -1) or (ASelectedLayerIndex >= NbLayers) then
+      raise exception.Create('Selected layer out of bounds');
+
+    StackOption := LEReadLongint(AStream);
+    result.LinearBlend := (StackOption and 1) = 1;
+    if (StackOption and 2) = 2 then Compression := lzpRLE else Compression:= lzpZStream;
+
+    if headerSize >= 20 then
+    begin
+      canvasWidth := LEReadLongint(AStream);
+      canvasHeight := LEReadLongint(AStream);
+      result.SetSize(canvasWidth,canvasHeight);
+    end;
+
+    if headerSize >= 28 then
+    begin
+      MemDirPos := LEReadInt64(AStream);
+    end else MemDirPos := 0;
+    //end of header
+
+    if MemDirPos <> 0 then
+    begin
+      AStream.Position:= MemDirPos+OldPosition;
+      result.MemDirectory.LoadFromStream(AStream);
+    end else
+      result.MemDirectory.Clear;
+
+    AStream.Position:= LayerStackStartPosition;
+    for i := 0 to NbLayers-1 do
+    begin
+      if AProgress then OnLayeredBitmapLoadProgress(round(i*100/NbLayers));
+      LayerHeaderSize:= LEReadLongint(AStream);
+
+      LayerHeaderPosition := AStream.Position;
+      LayerBitmapPosition := LayerHeaderPosition + LayerHeaderSize;
+      LayerEndPosition := -1;
+
+      fillchar({%H-}h, sizeof(h), 0);
+      h.LayerOption := 1; //visible
+      h.BlendOp:= integer(result.DefaultBlendingOperation);
+      h.LayerOpacity := 65535; //opaque
+      h.LayerUniqueId:= maxLongint;
+      h.FixEndian;
+
+      AStream.ReadBuffer(h, min(LayerHeaderSize, sizeof(h)));
+      h.FixEndian;
+
+      if h.BlendOp > ord(high(TBlendOperation)) then
+        LayerBlendOp := result.DefaultBlendingOperation
+      else
+        LayerBlendOp:= TBlendOperation(h.BlendOp);
+
+      LayerIdFound := h.LayerUniqueId <> maxLongint;
+
+      if h.LayerBitmapSize > 0 then
+        LayerEndPosition:= LayerBitmapPosition+h.LayerBitmapSize;
+
+      AStream.Position:= LayerBitmapPosition;
+      Layer := LoadLayerBitmapFromStream(AStream, Compression);
+      LayerName := Layer.Caption;
+      LayerIndex := result.AddOwnedLayer(Layer);
+      Layer := nil;
+
+      result.LayerName[LayerIndex] := LayerName;
+      result.LayerVisible[LayerIndex] := (h.LayerOption and 1) = 1;
+      result.BlendOperation[LayerIndex]:= LayerBlendOp;
+      result.LayerOffset[LayerIndex] := Point(h.LayerOfsX,h.LayerOfsY);
+      if ALoadLayerUniqueIds and LayerIdFound then
+        result.LayerUniqueId[LayerIndex] := h.LayerUniqueId;
+      result.LayerOpacity[LayerIndex] := h.LayerOpacity shr 8;
+      result.LayerOriginalGuid[LayerIndex] := h.OriginalGuid;
+      result.LayerOriginalMatrix[LayerIndex] := h.OriginalMatrix;
+      result.LayerOriginalRenderStatus[layerIndex] := orsProof;
+
+      if LayerEndPosition <> -1 then AStream.Position := LayerEndPosition;
+    end;
+    if AProgress then OnLayeredBitmapLoadProgress(100);
+
+    RenameLayersToUniqueId(result);
+    result.NotifyLoaded;
+  except
+    on ex: Exception do
+    begin
+      AStream.Position := OldPosition;
+      if not Assigned(ADestination) then result.Free;
+      raise ex;
+    end;
+  end;
+end;
+
+procedure SaveLayersToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap;
+         ASelectedLayerIndex: integer; ACompression: TLzpCompression; AProgress: boolean);
+var
+  StackOption: longint;
+  i: integer;
+  DirectoryOffsetPos, EndPos: int64;
+  LayerHeaderPosition: int64;
+  LayerBitmapPosition,BitmapSize, startPos: int64;
+  bitmap: TBGRABitmap;
+  h: TLayerHeader;
+begin
+  if (ASelectedLayerIndex < -1) or (ASelectedLayerIndex >= ALayers.NbLayers) then
+    raise exception.Create('Selected layer out of bounds');
+
+  ALayers.NotifySaving;
+
+  startPos := AStream.Position;
+  AStream.Write(StreamHeader[1], length(StreamHeader));
+  LEWriteLongint(AStream, 28); //header size
+  LEWriteLongint(AStream, ALayers.NbLayers);
+  LEWriteLongint(AStream, ASelectedLayerIndex);
+  StackOption := 0;
+  if ALayers.LinearBlend then StackOption := StackOption or 1;
+  if ACompression = lzpRLE then StackOption:= StackOption or 2;
+  LEWriteLongint(AStream, StackOption);
+  LEWriteLongint(AStream, ALayers.Width);
+  LEWriteLongint(AStream, ALayers.Height);
+  DirectoryOffsetPos := AStream.Position;
+  LEWriteInt64(AStream, 0);
+  //end of header
+
+  for i := 0 to ALayers.NbLayers-1 do
+  begin
+    if AProgress then OnLayeredBitmapSaveProgress(round(i*100/ALayers.NbLayers));
+    LEWriteLongint(AStream, sizeof(h));
+    LayerHeaderPosition := AStream.Position;
+
+    bitmap := ALayers.GetLayerBitmapDirectly(i); //do it before to ensure update from original
+
+    h.LayerOption:= 0;
+    if ALayers.LayerVisible[i] then h.LayerOption:= h.LayerOption or 1;
+    h.BlendOp:= Longint(ALayers.BlendOperation[i]);
+    h.LayerOfsX:= ALayers.LayerOffset[i].x;
+    h.LayerOfsY:= ALayers.LayerOffset[i].y;
+    h.LayerUniqueId:= ALayers.LayerUniqueId[i];
+    h.LayerOpacity:= integer(ALayers.LayerOpacity[i])*$101;
+    h.LayerBitmapSize := 0;
+    h.OriginalGuid := ALayers.LayerOriginalGuid[i];
+    h.OriginalMatrix := ALayers.LayerOriginalMatrix[i];
+    h.FixEndian;
+    AStream.WriteBuffer(h, sizeof(h));
+    //end of layer header
+
+    LayerBitmapPosition:=AStream.Position;
+    if bitmap <> nil then
+      SaveLayerBitmapToStream(AStream, bitmap, ALayers.LayerName[i], ACompression)
+    else
+    begin
+      bitmap := ALayers.GetLayerBitmapCopy(i);
+      SaveLayerBitmapToStream(AStream, bitmap, ALayers.LayerName[i], ACompression);
+      bitmap.free;
+    end;
+
+    BitmapSize := AStream.Position - LayerBitmapPosition;
+
+    //store back the bitmap size
+    AStream.Position:= LayerHeaderPosition + (PByte(@PLayerHeader(nil)^.LayerBitmapSize)-PByte(nil));
+    LEWriteInt64(AStream, BitmapSize);
+
+    AStream.Position:= LayerBitmapPosition+BitmapSize;
+  end;
+  if AProgress then OnLayeredBitmapSaveProgress(100);
+
+  EndPos:= AStream.Position;
+  if ALayers.HasMemFiles then
+  begin
+    AStream.Position := DirectoryOffsetPos;
+    LEWriteInt64(AStream,EndPos-startPos);
+    AStream.Position:= EndPos;
+    RenameLayersToIndex(ALayers);
+    ALayers.MemDirectory.SaveToStream(AStream);
+    RenameLayersToUniqueId(ALayers);
+  end;
+end;
+
+procedure SaveLayerBitmapToStream(AStream: TStream; ABitmap: TBGRABitmap; ACaption: string; ACompression: TLzpCompression);
+var Compressed: TBGRACompressableBitmap;
+begin
+  if ACompression = lzpZStream then
+  begin
+    Compressed := TBGRACompressableBitmap.Create(ABitmap);
+    Compressed.Caption := ACaption;
+    Compressed.CompressionLevel:= cldefault;
+    Compressed.WriteToStream(AStream);
+    Compressed.Free;
+  end else
+    TBGRAWriterLazPaint.WriteRLEImage(AStream, ABitmap, ACaption);
+end;
+
+function LoadLayerBitmapFromStream(AStream: TStream; ACompression: TLzpCompression): TBGRABitmap;
+var Compressed: TBGRACompressableBitmap;
+  captionFound: string;
+begin
+  if ACompression = lzpZStream then
+  begin
+    Compressed := TBGRACompressableBitmap.Create;
+    Compressed.ReadFromStream(AStream);
+    result := Compressed.GetBitmap;
+    Compressed.Free;
+  end else
+  begin
+    result := TBGRABitmap.Create;
+    TBGRAReaderLazPaint.LoadRLEImage(AStream, result, captionFound);
+    result.Caption := captionFound;
+  end;
+end;
+
+procedure RegisterStreamLayers;
+begin
+  LayeredBitmapSaveToStreamProc := @SaveLayeredBitmapToStream;
+  LayeredBitmapLoadFromStreamProc := @LoadLayeredBitmapFromStream;
+  LayeredBitmapCheckStreamProc := @CheckStreamForLayers;
+end;
+
+initialization
+
+  RegisterStreamLayers;
+
+end.
+

vendor/kam_remake/src/ext/BGRABitmap/bgrasvgoriginal.pas

@@ -0,0 +1,702 @@
+// SPDX-License-Identifier: LGPL-3.0-linking-exception
+unit BGRASVGOriginal;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  BGRAClasses, SysUtils, BGRABitmapTypes, BGRABitmap, BGRASVG, BGRATransform,
+  BGRALayerOriginal, BGRAUnits, BGRALayers;
+
+type
+  TBGRALayerSVGOriginal = class;
+
+  { TBGRASVGOriginalDiff }
+
+  TBGRASVGOriginalDiff = class(TBGRAOriginalDiff)
+  protected
+    FContentVersionBefore,FContentVersionAfter: integer;
+    FSvgStreamBefore,FSvgStreamAfter: TMemoryStream;
+    FDpiBefore, FDpiAfter: single;
+  public
+    constructor Create(AFromOriginal: TBGRALayerSVGOriginal);
+    procedure ComputeDiff(AToOriginal: TBGRALayerSVGOriginal);
+    procedure Apply(AOriginal: TBGRALayerCustomOriginal); override;
+    procedure Unapply(AOriginal: TBGRALayerCustomOriginal); override;
+    function CanAppend(ADiff: TBGRAOriginalDiff): boolean; override;
+    procedure Append(ADiff: TBGRAOriginalDiff); override;
+    function IsIdentity: boolean; override;
+    destructor Destroy; override;
+  end;
+
+  { TBGRALayerSVGOriginal }
+
+  TBGRALayerSVGOriginal = class(TBGRALayerCustomOriginal)
+  private
+    function GetDPI: single;
+    function GetSvgHeight: single;
+    function GetSvgWidth: single;
+    procedure SetDPI(AValue: single);
+  protected
+    FSVG: TBGRASVG;
+    FPresentationMatrix: TAffineMatrix;
+    FDiff: TBGRASVGOriginalDiff;
+    FContentVersion: integer;
+    procedure BeginUpdate;
+    procedure EndUpdate;
+    procedure ComputePresentation(AContainerWidth, AContainerHeight: integer; AScaleDPI: single);
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+    procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); override;
+    function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix): TRect; override;
+    procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override;
+    procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override;
+    procedure LoadFromStream(AStream: TStream); override;
+    procedure SaveSVGToStream(AStream: TStream);
+    procedure SetSVG(ASVG: TBGRASVG; AContainerWidth: integer = 640;
+      AContainerHeight: integer = 480; AScaleDPI: single = 1);
+    procedure LoadSVGFromStream(AStream: TStream; AContainerWidth: integer = 640;
+      AContainerHeight: integer = 480; AScaleDPI: single = 1);
+    function GetSVGCopy: TBGRASVG;
+    class function StorageClassName: RawByteString; override;
+    class function CanConvertToSVG: boolean; override;
+    function ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TBGRASVG; override;
+    property Width: single read GetSvgWidth;
+    property Height: single read GetSvgHeight;
+    property DPI: single read GetDPI write SetDPI;
+    property PresentationMatrix: TAffineMatrix read FPresentationMatrix;
+  end;
+
+  { TBGRALayeredSVG }
+
+  TBGRALayeredSVG = class(TBGRALayeredBitmap)
+    protected
+      function GetMimeType: string; override;
+      procedure InternalLoadFromStream(AStream: TStream);
+      procedure InternalSaveToStream(AStream: TStream);
+    public
+      ContainerWidth, ContainerHeight, DefaultSvgDPI, DPI: integer;
+      DefaultLayerName: string;
+      constructor Create; overload; override;
+      constructor Create(AWidth, AHeight: integer); overload; override;
+      procedure LoadFromStream(AStream: TStream); override;
+      procedure LoadFromFile(const filenameUTF8: string); override;
+      procedure SaveToStream(AStream: TStream); override;
+      procedure SaveToFile(const filenameUTF8: string); override;
+  end;
+
+implementation
+
+uses BGRACanvas2D, BGRAMemDirectory, BGRAUTF8, BGRASVGShapes, math, BGRASVGType,
+  BGRAVectorize;
+
+{ TBGRASVGOriginalDiff }
+
+constructor TBGRASVGOriginalDiff.Create(AFromOriginal: TBGRALayerSVGOriginal);
+begin
+  if Assigned(AFromOriginal.FSVG) then
+  begin
+    FSvgStreamBefore := TMemoryStream.Create;
+    AFromOriginal.FSVG.SaveToStream(FSvgStreamBefore);
+  end;
+  FContentVersionBefore:= AFromOriginal.FContentVersion;
+  FDpiBefore:= AFromOriginal.DPI;
+end;
+
+procedure TBGRASVGOriginalDiff.ComputeDiff(AToOriginal: TBGRALayerSVGOriginal);
+begin
+  FreeAndNil(FSvgStreamAfter);
+  if Assigned(AToOriginal.FSVG) then
+  begin
+    FSvgStreamAfter := TMemoryStream.Create;
+    AToOriginal.FSVG.SaveToStream(FSvgStreamAfter);
+  end;
+  FContentVersionAfter:= AToOriginal.FContentVersion;
+  FDpiAfter:= AToOriginal.DPI;
+end;
+
+procedure TBGRASVGOriginalDiff.Apply(AOriginal: TBGRALayerCustomOriginal);
+var
+  orig: TBGRALayerSVGOriginal;
+begin
+  orig := AOriginal as TBGRALayerSVGOriginal;
+  if Assigned(FSvgStreamAfter) then
+  begin
+    FSvgStreamAfter.Position:= 0;
+    orig.FSVG.LoadFromStream(FSvgStreamAfter);
+  end else
+    orig.FSVG.Content.Clear;
+  orig.FContentVersion := FContentVersionAfter;
+end;
+
+procedure TBGRASVGOriginalDiff.Unapply(AOriginal: TBGRALayerCustomOriginal);
+var
+  orig: TBGRALayerSVGOriginal;
+begin
+  orig := AOriginal as TBGRALayerSVGOriginal;
+  if Assigned(FSvgStreamBefore) then
+  begin
+    FSvgStreamBefore.Position:= 0;
+    orig.FSVG.LoadFromStream(FSvgStreamBefore);
+  end else
+    orig.FSVG.Content.Clear;
+  orig.FContentVersion := FContentVersionBefore;
+end;
+
+function TBGRASVGOriginalDiff.CanAppend(ADiff: TBGRAOriginalDiff): boolean;
+begin
+  result := (ADiff is TBGRASVGOriginalDiff) and
+    (TBGRASVGOriginalDiff(ADiff).FContentVersionAfter >= FContentVersionAfter);
+end;
+
+procedure TBGRASVGOriginalDiff.Append(ADiff: TBGRAOriginalDiff);
+var
+  next: TBGRASVGOriginalDiff;
+begin
+  next := ADiff as TBGRASVGOriginalDiff;
+  if next.FContentVersionAfter < FContentVersionAfter then
+    raise exception.Create('Cannot append diff made before this one.');
+  FDpiAfter:= next.FDpiAfter;
+  FreeAndNil(FSvgStreamAfter);
+  if Assigned(next.FSvgStreamAfter) then
+  begin
+    FSvgStreamAfter := TMemoryStream.Create;
+    next.FSvgStreamAfter.Position:= 0;
+    FSvgStreamAfter.CopyFrom(next.FSvgStreamAfter, next.FSvgStreamAfter.Size);
+  end;
+  FContentVersionAfter:= next.FContentVersionAfter;
+end;
+
+function TBGRASVGOriginalDiff.IsIdentity: boolean;
+begin
+  result := (FDpiBefore = FDpiAfter) and
+    ( ((FSvgStreamBefore=nil) and (FSvgStreamAfter=nil)) or
+      (Assigned(FSvgStreamBefore) and Assigned(FSvgStreamAfter) and
+       (FSvgStreamBefore.Size = FSvgStreamAfter.Size) and
+       CompareMem(FSvgStreamBefore.Memory,FSvgStreamAfter.Memory,FSvgStreamBefore.Size)) );
+end;
+
+destructor TBGRASVGOriginalDiff.Destroy;
+begin
+  FSvgStreamBefore.Free;
+  inherited Destroy;
+end;
+
+{ TBGRALayerSVGOriginal }
+
+function TBGRALayerSVGOriginal.GetDPI: single;
+begin
+  result := FSVG.DefaultDpi;
+end;
+
+function TBGRALayerSVGOriginal.GetSvgHeight: single;
+begin
+  result := FSVG.HeightAsPixel;
+end;
+
+function TBGRALayerSVGOriginal.GetSvgWidth: single;
+begin
+  result := FSVG.WidthAsPixel;
+end;
+
+procedure TBGRALayerSVGOriginal.SetDPI(AValue: single);
+begin
+  BeginUpdate;
+  FSVG.DefaultDpi:= AValue;
+  EndUpdate;
+end;
+
+procedure TBGRALayerSVGOriginal.BeginUpdate;
+begin
+  if DiffExpected and (FDiff=nil) then
+    FDiff := TBGRASVGOriginalDiff.Create(self);
+end;
+
+procedure TBGRALayerSVGOriginal.EndUpdate;
+begin
+  if Assigned(FDiff) then FDiff.ComputeDiff(self);
+  NotifyChange(FDiff);
+  FDiff := nil;
+end;
+
+procedure TBGRALayerSVGOriginal.ComputePresentation(AContainerWidth, AContainerHeight: integer;
+  AScaleDPI: single);
+var
+  compWidth, compHeight: single;
+begin
+  FSVG.Units.ContainerWidth := FloatWithCSSUnit(AContainerWidth / AScaleDPI, cuPixel);
+  FSVG.Units.ContainerHeight := FloatWithCSSUnit(AContainerHeight / AScaleDPI, cuPixel);
+  compWidth := FSVG.WidthAsPixel;
+  compHeight := FSVG.HeightAsPixel;
+  FSVG.WidthAsPixel := compWidth * AScaleDPI;
+  FSVG.HeightAsPixel := compHeight * AScaleDPI;
+  FPresentationMatrix := FSVG.GetStretchPresentationMatrix(cuPixel);
+end;
+
+constructor TBGRALayerSVGOriginal.Create;
+begin
+  inherited Create;
+  FSVG := TBGRASVG.Create;
+  FContentVersion := 0;
+end;
+
+destructor TBGRALayerSVGOriginal.Destroy;
+begin
+  FSVG.Free;
+  FDiff.Free;
+  inherited Destroy;
+end;
+
+procedure TBGRALayerSVGOriginal.Render(ADest: TBGRABitmap;
+  AMatrix: TAffineMatrix; ADraft: boolean);
+var
+  c2D: TBGRACanvas2D;
+begin
+  if Assigned(FSVG) then
+  begin
+    c2D := TBGRACanvas2D.Create(ADest);
+    c2D.transform(AMatrix*FPresentationMatrix);
+    c2D.fontRenderer := TBGRAVectorizedFontRenderer.Create;
+    if ADraft then c2D.antialiasing := false;
+    FSVG.Draw(c2D, 0, 0, cuPixel);
+    c2D.Free;
+  end;
+end;
+
+function TBGRALayerSVGOriginal.GetRenderBounds(ADestRect: TRect;
+  AMatrix: TAffineMatrix): TRect;
+var
+  aff: TAffineBox;
+  r: TRectF;
+begin
+  if Assigned(FSVG) then
+  begin
+    with FSVG.ViewBox do
+      r := RectWithSizeF(min.x, min.y, size.x, size.y);
+    aff := AMatrix * FPresentationMatrix * TAffineBox.AffineBox(r);
+    result := aff.RectBounds;
+  end else
+    result := EmptyRect;
+end;
+
+procedure TBGRALayerSVGOriginal.LoadFromStorage(
+  AStorage: TBGRACustomOriginalStorage);
+var svgStream: TMemoryStream;
+  valDpi: Single;
+begin
+  svgStream := TMemoryStream.Create;
+  try
+    if AStorage.ReadFile('content.svg', svgStream) then
+    begin
+      if not Assigned(FSVG) then FSVG := TBGRASVG.Create;
+      svgStream.Position:= 0;
+      FSVG.LoadFromStream(svgStream);
+    end else
+    begin
+      FreeAndNil(FSVG);
+      FSVG := TBGRASVG.Create;
+    end;
+    FPresentationMatrix := FSVG.GetStretchPresentationMatrix(cuPixel);
+    FContentVersion:= AStorage.Int['content-version'];
+  finally
+    svgStream.Free;
+  end;
+  valDpi := AStorage.Float['dpi'];
+  if valDpi <> EmptySingle then
+    FSVG.DefaultDpi:= valDpi;
+end;
+
+procedure TBGRALayerSVGOriginal.SaveToStorage(
+  AStorage: TBGRACustomOriginalStorage);
+var svgStream: TMemoryStream;
+begin
+  if Assigned(FSVG) then
+  begin
+    if FContentVersion > AStorage.Int['content-version'] then
+    begin
+      svgStream := TMemoryStream.Create;
+      try
+        FSVG.SaveToStream(svgStream);
+        AStorage.WriteFile('content.svg', svgStream, true, true);
+        svgStream := nil;
+        AStorage.Int['content-version'] := FContentVersion;
+      finally
+        svgStream.Free;
+      end;
+    end;
+    AStorage.Float['dpi'] := FSVG.DefaultDpi;
+  end;
+end;
+
+procedure TBGRALayerSVGOriginal.LoadFromStream(AStream: TStream);
+begin
+  if TMemDirectory.CheckHeader(AStream) then
+    inherited LoadFromStream(AStream)
+  else
+    LoadSVGFromStream(AStream);
+end;
+
+procedure TBGRALayerSVGOriginal.SaveSVGToStream(AStream: TStream);
+begin
+  FSVG.SaveToStream(AStream);
+end;
+
+procedure TBGRALayerSVGOriginal.SetSVG(ASVG: TBGRASVG; AContainerWidth: integer;
+      AContainerHeight: integer; AScaleDPI: single);
+begin
+  BeginUpdate;
+  FSVG.Free;
+  FSVG := ASVG;
+  ComputePresentation(AContainerWidth, AContainerHeight, AScaleDPI);
+  Inc(FContentVersion);
+  EndUpdate;
+end;
+
+procedure TBGRALayerSVGOriginal.LoadSVGFromStream(AStream: TStream; AContainerWidth: integer;
+      AContainerHeight: integer; AScaleDPI: single);
+begin
+  BeginUpdate;
+  FSVG.LoadFromStream(AStream);
+  ComputePresentation(AContainerWidth, AContainerHeight, AScaleDPI);
+  Inc(FContentVersion);
+  EndUpdate;
+end;
+
+function TBGRALayerSVGOriginal.GetSVGCopy: TBGRASVG;
+begin
+  result := FSVG.Duplicate;
+end;
+
+class function TBGRALayerSVGOriginal.StorageClassName: RawByteString;
+begin
+  result := 'svg';
+end;
+
+class function TBGRALayerSVGOriginal.CanConvertToSVG: boolean;
+begin
+  Result:= true;
+end;
+
+function TBGRALayerSVGOriginal.ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TBGRASVG;
+begin
+  if not IsAffineMatrixIdentity(AMatrix) then
+    raise exception.Create('Matrix not valid for SVG original');
+  AOffset := Point(0,0);
+  Result:= GetSVGCopy;
+end;
+
+{ TBGRALayeredSVG }
+
+function TBGRALayeredSVG.GetMimeType: string;
+begin
+  Result:= 'image/svg+xml';
+end;
+
+procedure TBGRALayeredSVG.InternalLoadFromStream(AStream: TStream);
+var
+  svg, svgLayer: TBGRASVG;
+  visualWidth, visualHeight: single;
+  svgOrig: TBGRALayerSVGOriginal;
+  idx, i, j: Integer;
+  layer: TSVGGroup;
+  prefix: String;
+  originalViewBox: TSVGViewBox;
+  m: TAffineMatrix;
+begin
+  svg := TBGRASVG.Create;
+  try
+    svg.DefaultDpi := DefaultSvgDPI;
+    svg.LoadFromStream(AStream);
+    svg.Units.ContainerWidth := FloatWithCSSUnit(ContainerWidth / DPI * svg.DefaultDpi, cuPixel);
+    svg.Units.ContainerHeight := FloatWithCSSUnit(ContainerHeight / DPI * svg.DefaultDpi, cuPixel);
+    svg.CropToViewBox(DPI / svg.DefaultDpi);
+    visualWidth := svg.WidthAsPixel;
+    visualHeight := svg.HeightAsPixel;
+    Clear;
+    SetSize(floor(visualWidth + 0.95),floor(visualHeight + 0.95));
+    if svg.LayerCount > 0 then
+    begin
+      for i := 0 to svg.LayerCount-1 do
+      begin
+        layer := svg.Layer[i];
+        svgLayer := TBGRASVG.Create;
+        svgLayer.DefaultDpi:= svg.DefaultDpi;
+        svgLayer.WidthAsPixel := visualWidth;
+        svgLayer.HeightAsPixel := visualHeight;
+        for j := 0 to svg.NamespaceCount-1 do
+        begin
+          prefix := svg.NamespacePrefix[j];
+          svgLayer.NamespaceURI[prefix] := svg.NamespaceURI[prefix];
+        end;
+        try
+          svgLayer.ViewBox := svg.ViewBox;
+          if layer.DOMElement.hasAttribute('bgra:originalViewBox') then
+          begin
+            originalViewBox := TSVGViewBox.Parse(layer.DOMElement.GetAttribute('bgra:originalViewBox'));
+            svgLayer.WidthAsPixel := originalViewBox.size.x;
+            svgLayer.HeightAsPixel := originalViewBox.size.y;
+            svgLayer.ViewBox := originalViewBox;
+            m := layer.matrix[cuPixel] * AffineMatrixTranslation(originalViewBox.min.x, originalViewBox.min.y);
+          end else
+            m := layer.matrix[cuPixel];
+          for j := 0 to svg.Content.IndexOfElement(layer)-1 do
+            if svg.Content.ElementObject[j] is TSVGDefine then
+              svgLayer.Content.CopyElement(svg.Content.ElementObject[j]);
+          for j := 0 to layer.Content.ElementCount-1 do
+            svgLayer.Content.CopyElement(layer.Content.ElementObject[j]);
+          svgOrig := TBGRALayerSVGOriginal.Create;
+          svgOrig.SetSVG(svgLayer);
+          svgLayer := nil;
+          idx := AddLayerFromOwnedOriginal(svgOrig);
+          LayerName[idx] := layer.Name;
+          LayerVisible[idx] := layer.Visible;
+          LayerOpacity[idx] := min(255,max(0,round(layer.opacity*255)));
+          BlendOperation[idx] := layer.mixBlendMode;
+          LayerOriginalMatrix[idx] := m;
+          RenderLayerFromOriginal(idx);
+        finally
+          svgLayer.Free;
+        end;
+      end;
+    end else
+    begin
+      svgOrig := TBGRALayerSVGOriginal.Create;
+      svgOrig.SetSVG(svg);
+      svg := nil;
+      idx := AddLayerFromOwnedOriginal(svgOrig);
+      LayerName[idx] := DefaultLayerName+'1';
+      RenderLayerFromOriginal(idx);
+    end;
+  finally
+    svg.Free;
+  end;
+end;
+
+procedure TBGRALayeredSVG.InternalSaveToStream(AStream: TStream);
+
+  procedure StoreLayerBitmap(ABitmap: TBGRABitmap; AOwned: boolean; const AMatrix: TAffineMatrix;
+        ADestElem: TSVGCustomElement; AContent: TSVGContent);
+  var
+    img: TSVGImage;
+    ab: TAffineBox;
+    vb: TSVGViewBox;
+  begin
+    ab := AMatrix * TAffineBox.AffineBox(PointF(0, 0), PointF(ABitmap.Width, 0), PointF(0, ABitmap.Height));
+
+    img := AContent.AppendImage(AMatrix[1,3], AMatrix[2, 3], ABitmap.Width, ABitmap.Height, ABitmap, AOwned);
+    img.matrix[cuCustom] := AffineMatrixLinear(AMatrix);
+
+    if ADestElem is TSVGGroup then
+    with TSVGGroup(ADestElem) do
+    begin
+      with ab.RectBounds do
+      begin
+        vb.min := PointF(Left, Top);
+        vb.size := PointF(Width, Height);
+      end;
+      DOMElement.SetAttribute('xmlns:bgra', 'https://wiki.freepascal.org/LazPaint_SVG_format');
+      DOMElement.SetAttribute('bgra:originalViewBox', vb.ToString);
+    end;
+  end;
+
+  procedure StoreLayer(ALayerIndex: integer; ASVG: TBGRASVG; ADestElem: TSVGCustomElement;
+        ADest: TSVGContent; out AMatrix: TAffineMatrix);
+  var
+    c: TBGRALayerOriginalAny;
+    bmp, part: TBGRABitmap;
+    layerSvg: TBGRASVG;
+    i: Integer;
+    prefix: String;
+    origViewBox: TSVGViewBox;
+    wantedOfs: TPoint;
+    r: TRect;
+  begin
+    AMatrix := AffineMatrixIdentity;
+    if LayerOriginalKnown[ALayerIndex] then
+      c:= LayerOriginalClass[ALayerIndex]
+      else c := nil;
+
+    if Assigned(c) and c.CanConvertToSVG then
+    begin
+      if LayerOriginal[ALayerIndex].IsInfiniteSurface then
+      begin
+        layerSvg := LayerOriginal[ALayerIndex].ConvertToSVG(LayerOriginalMatrix[ALayerIndex],
+          wantedOfs) as TBGRASVG;
+        layerSvg.WidthAsPixel:= Self.Width;
+        layerSvg.HeightAsPixel:= Self.Height;
+        AMatrix := AffineMatrixTranslation(wantedOfs.X, wantedOfs.Y);
+      end else
+      begin
+        layerSvg := LayerOriginal[ALayerIndex].ConvertToSVG(AffineMatrixIdentity,
+          wantedOfs) as TBGRASVG;
+        AMatrix:= LayerOriginalMatrix[ALayerIndex]
+          * AffineMatrixTranslation(wantedOfs.X, wantedOfs.Y)
+          * layerSvg.GetStretchPresentationMatrix(cuPixel);
+      end;
+      origViewBox := layerSvg.ViewBox;
+      try
+        layerSvg.ConvertToUnit(cuCustom);
+        if ADestElem is TSVGGroup then
+        with TSVGGroup(ADestElem) do
+        begin
+          DOMElement.SetAttribute('xmlns:bgra', 'https://wiki.freepascal.org/LazPaint_SVG_format');
+          DOMElement.SetAttribute('bgra:originalViewBox', origViewBox.ToString);
+        end;
+        for i := 0 to layerSvg.Content.ElementCount-1 do
+          ADest.CopyElement(layerSvg.Content.ElementObject[i]);
+        for i := 0 to layerSvg.NamespaceCount-1 do
+        begin
+          prefix := layerSvg.NamespacePrefix[i];
+          ASVG.NamespaceURI[prefix] := layerSvg.NamespaceURI[prefix];
+        end;
+      finally
+        layerSvg.Free;
+      end;
+    end else
+    begin
+      r := LayerBitmap[ALayerIndex].GetImageBounds;
+      if (r.Left = 0) and (r.Top = 0) and (r.Width = LayerBitmap[ALayerIndex].Width) and
+        (r.Height = LayerBitmap[ALayerIndex].Height) then
+        StoreLayerBitmap(LayerBitmap[ALayerIndex], false,
+          AffineMatrixTranslation(LayerOffset[ALayerIndex].X, LayerOffset[ALayerIndex].Y), ADestElem, ADest)
+      else
+      begin
+        part := LayerBitmap[ALayerIndex].GetPart(r);
+        StoreLayerBitmap(part, true,
+          AffineMatrixTranslation(LayerOffset[ALayerIndex].X + r.Left,
+          LayerOffset[ALayerIndex].Y + r.Top), ADestElem, ADest)
+      end;
+    end;
+  end;
+
+var
+  svg: TBGRASVG;
+  vb : TSVGViewBox;
+  i,j: Integer;
+  g: TSVGGroup;
+  m: TAffineMatrix;
+  identifiers, newIdentifiers: TStringList;
+begin
+  svg := TBGRASVG.Create;
+  identifiers := nil;
+  newIdentifiers := nil;
+  try
+    svg.WidthAsPixel := Width;
+    svg.HeightAsPixel := Height;
+    vb.min := PointF(0, 0);
+    vb.size := PointF(Width, Height);
+    svg.ViewBox := vb;
+    if (NbLayers = 1) and (LayerOpacity[0] = 255) and LayerVisible[0] and
+       (LayerOriginalGuid[0] = GUID_NULL) then
+    begin
+      StoreLayer(0, svg, svg, svg.Content, m);
+    end else
+    begin
+      svg.NamespaceURI['inkscape'] := 'http://www.inkscape.org/namespaces/inkscape';
+      identifiers := TStringList.Create;
+      newIdentifiers := TStringList.Create;
+      for i := 0 to NbLayers-1 do
+      begin
+        g := svg.Content.AppendGroup;
+        g.IsLayer := true;
+        g.Name:= LayerName[i];
+        g.opacity:= LayerOpacity[i]/255;
+        g.Visible:= LayerVisible[i];
+        g.mixBlendMode:= BlendOperation[i];
+        StoreLayer(i, svg, g, g.Content, m);
+        g.matrix[cuPixel] := m;
+        identifiers.Clear;
+        g.ListIdentifiers(identifiers);
+        newIdentifiers.Clear;
+        for j := 0 to identifiers.Count-1 do
+          newIdentifiers.Add('layer'+inttostr(i+1)+'-'+identifiers[j]);
+        g.RenameIdentifiers(identifiers, newIdentifiers);
+      end;
+    end;
+    svg.SaveToStream(AStream);
+  finally
+    newIdentifiers.Free;
+    identifiers.Free;
+    svg.Free;
+  end;
+end;
+
+constructor TBGRALayeredSVG.Create;
+begin
+  inherited Create;
+  ContainerWidth:= 640;
+  ContainerHeight:= 480;
+  DefaultLayerName := 'Layer';
+  DPI := 96;
+  DefaultSvgDPI:= 96;
+end;
+
+constructor TBGRALayeredSVG.Create(AWidth, AHeight: integer);
+begin
+  inherited Create(AWidth, AHeight);
+  ContainerWidth:= 640;
+  ContainerHeight:= 480;
+  DefaultLayerName := 'Layer';
+end;
+
+procedure TBGRALayeredSVG.LoadFromStream(AStream: TStream);
+begin
+  OnLayeredBitmapLoadFromStreamStart;
+  try
+    InternalLoadFromStream(AStream);
+  finally
+    OnLayeredBitmapLoaded;
+  end;
+end;
+
+procedure TBGRALayeredSVG.LoadFromFile(const filenameUTF8: string);
+var AStream: TFileStreamUTF8;
+begin
+  AStream := TFileStreamUTF8.Create(filenameUTF8,fmOpenRead or fmShareDenyWrite);
+  OnLayeredBitmapLoadStart(filenameUTF8);
+  try
+    LoadFromStream(AStream);
+  finally
+    OnLayeredBitmapLoaded;
+    AStream.Free;
+  end;
+end;
+
+procedure TBGRALayeredSVG.SaveToStream(AStream: TStream);
+begin
+  OnLayeredBitmapSaveToStreamStart;
+  try
+    InternalSaveToStream(AStream);
+  finally
+    OnLayeredBitmapSaved;
+  end;
+end;
+
+procedure TBGRALayeredSVG.SaveToFile(const filenameUTF8: string);
+var AStream: TFileStreamUTF8;
+begin
+  AStream := TFileStreamUTF8.Create(filenameUTF8,fmCreate);
+  OnLayeredBitmapSaveStart(filenameUTF8);
+  try
+    InternalSaveToStream(AStream);
+  finally
+    OnLayeredBitmapSaved;
+    AStream.Free;
+  end;
+end;
+
+procedure RegisterLayeredSvgFormat;
+begin
+  RegisterLayeredBitmapReader('svg', TBGRALayeredSVG);
+  RegisterLayeredBitmapWriter('svg', TBGRALayeredSVG);
+end;
+
+initialization
+
+  RegisterLayerOriginal(TBGRALayerSVGOriginal);
+  RegisterLayeredSvgFormat;
+
+end.
+