lazarus/lcl/interfaces/carbon/carboncanvas.pp

{                 -----------------------------------------
                  carboncanvas.pp  -  Carbon device context
                  -----------------------------------------

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}
unit CarbonCanvas;

{$mode objfpc}{$H+}

interface

// defines
{$I carbondefines.inc}

uses
 // rtl+ftl
  Types, Classes, SysUtils, Math, Contnrs,
 // carbon bindings
  MacOSAll,
 // LCL
  LCLProc, LCLType, Graphics, GraphType, IntfGraphics, Controls, Forms,
 // LCL Carbon
  CarbonDef, CarbonUtils,
  {$ifdef DebugBitmaps}
  CarbonDebug,
  {$endif}
  CarbonGDIObjects;

type
  // device context data for SaveDC/RestoreDC
  TCarbonDCData = class
  public
    CurrentFont: TCarbonFont;
    CurrentBrush: TCarbonBrush;
    CurrentPen: TCarbonPen;
    CurrentRegion: TCarbonRegion;

    BkColor: TColor;
    BkMode: Integer;
    BkBrush: TCarbonBrush;

    TextColor: TColor;
    TextBrush: TCarbonBrush;

    ROP2: Integer;
    PenPos: TPoint;

    WindowOfs: TPoint;
    ViewportOfs: TPoint;

    isClipped: Boolean;
    ClipShape: HIShapeRef;
  end;
  
  TCarbonBitmapContext = class;

  { TCarbonDeviceContext }

  TCarbonDeviceContext = class(TCarbonContext)
  private
    FCurrentFont: TCarbonFont;
    FCurrentBrush: TCarbonBrush;
    FCurrentPen: TCarbonPen;
    FCurrentRegion: TCarbonRegion;

    FBkColor: TColor;
    FBkMode: Integer;
    FBkBrush: TCarbonBrush;

    FTextColor: TColor;
    FTextBrush: TCarbonBrush; // text color is fill color

    FROP2: Integer;
    FPenPos: TPoint;
    FClipRegion: TCarbonRegion;
    
    FSavedDCList: TFPObjectList;
    FTextFractional: Boolean;
    FViewPortOfs,
    FWindowOfs: TPoint;

    isClipped : Boolean;

    procedure SetBkColor(AValue: TColor);
    procedure SetBkMode(const AValue: Integer);
    procedure SetCurrentBrush(const AValue: TCarbonBrush);
    procedure SetCurrentFont(const AValue: TCarbonFont);
    procedure SetCurrentPen(const AValue: TCarbonPen);
    procedure SetCurrentRegion(const AValue: TCarbonRegion);
    procedure SetROP2(const AValue: Integer);
    procedure SetTextColor(AValue: TColor);
  protected
    function GetSize: TPoint; virtual; abstract;
    function SaveDCData: TCarbonDCData; virtual;
    procedure RestoreDCData(const AData: TCarbonDCData); virtual;
    procedure ExcludeClipRect(Left, Top, Right, Bottom: Integer);
    procedure ApplyTransform(Trans: CGAffineTransform);
    procedure ClearClipping;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Reset; override;
    
    function SaveDC: Integer;
    function RestoreDC(ASavedDC: Integer): Boolean;
    
    function BeginTextRender(AStr: PChar; ACount: Integer; out ALayout: TCarbonTextLayout): Boolean;
    procedure EndTextRender(var ALayout: TCarbonTextLayout);
    
    procedure SetAntialiasing(AValue: Boolean);
    function DrawCGImage(X, Y, Width, Height: Integer; CGImage: CGImageRef): Boolean;
    procedure SetCGFillping(Ctx: CGContextRef; Width, Height: Integer);  // Width and Height must be negative to flip the image
    procedure RestoreCGFillping(Ctx: CGContextRef; Width, Height: Integer); // Width and Height must be negative to restore
  public
    procedure DrawFocusRect(ARect: TRect);
    procedure DrawGrid(const ARect: TRect; DX, DY: Integer);
    
    procedure Ellipse(X1, Y1, X2, Y2: Integer);
    function ExtTextOut(X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
    procedure FillRect(Rect: TRect; Brush: TCarbonBrush);
    procedure Frame(X1, Y1, X2, Y2: Integer);
    procedure Frame3D(var ARect: TRect; const FrameWidth: integer; const Style: TBevelCut);
    function GetClipRect: TRect;
    function GetLineLastPixelPos(PrevPos, NewPos: TPoint): TPoint;
    function GetPixel({%H-}X, {%H-}Y: Integer): TGraphicsColor; virtual;
    function GetTextExtentPoint(Str: PChar; Count: Integer; var Size: TSize): Boolean;
    function GetTextMetrics(var TM: TTextMetric): Boolean;
    procedure InvertRectangle(X1, Y1, X2, Y2: Integer);
    procedure LineTo(X, Y: Integer);
    procedure PolyBezier(Points: PPoint; NumPts: Integer; Filled, Continuous: boolean);
    procedure Polygon(Points: PPoint; NumPts: Integer; Winding: boolean);
    procedure Polyline(Points: PPoint; NumPts: Integer);
    procedure Rectangle(X1, Y1, X2, Y2: Integer);
    procedure SetPixel(X, Y: Integer; AColor: TGraphicsColor);
    function StretchDraw(X, Y, Width, Height: Integer; SrcDC: TCarbonBitmapContext;
      XSrc, YSrc, SrcWidth, SrcHeight: Integer; Msk: TCarbonBitmap; XMsk,
      YMsk: Integer; {%H-}Rop: DWORD): Boolean;
    function SetClipRegion(AClipRegion: TCarbonRegion; Mode: Integer): Integer;
    function CopyClipRegion(ADstRegion: TCarbonRegion): Integer;

    procedure UpdateContextOfs(const AWindowOfs, AViewOfs: TPoint);
    procedure SetWindowOfs(const AWindowOfs: TPoint);
    procedure SetViewPortOfs(const AViewOfs: TPoint);
    function GetLogicalOffset: TPoint; override;
  public
    property Size: TPoint read GetSize;

    property CurrentFont: TCarbonFont read FCurrentFont write SetCurrentFont;
    property CurrentBrush: TCarbonBrush read FCurrentBrush write SetCurrentBrush;
    property CurrentPen: TCarbonPen read FCurrentPen write SetCurrentPen;
    property CurrentRegion: TCarbonRegion read FCurrentRegion write SetCurrentRegion;

    property BkColor: TColor read FBkColor write SetBkColor;
    property BkMode: Integer read FBkMode write SetBkMode;
    property BkBrush: TCarbonBrush read FBkBrush;

    property TextColor: TColor read FTextColor write SetTextColor;
    property TextBrush: TCarbonBrush read FTextBrush;

    property ROP2: Integer read FROP2 write SetROP2;
    property PenPos: TPoint read FPenPos write FPenPos;
    
    property TextFractional: Boolean read FTextFractional write FTextFractional;
    property WindowOfs: TPoint read FWindowOfs write SetWindowOfs;
    property ViewPortOfs: TPoint read FViewPortOfs write SetViewPortOfs;
  end;

  { TCarbonScreenContext }

  TCarbonScreenContext = class(TCarbonDeviceContext)
  protected
    function GetSize: TPoint; override;
  public
    constructor Create; // TODO
  end;

  { TCarbonControlContext }

  TCarbonControlContext = class(TCarbonDeviceContext)
  private
    FOwner: TCarbonWidget;    // owner widget
  protected
    function GetSize: TPoint; override;
  public
    constructor Create(AOwner: TCarbonWidget);

    property Owner: TCarbonWidget read FOwner;
  end;

  { TCarbonBitmapContext }

  TCarbonBitmapContext = class(TCarbonDeviceContext)
  private
    FBitmap: TCarbonBitmap;
    function GetBitmap: TCarbonBitmap;
    procedure SetBitmap(const AValue: TCarbonBitmap);
  protected
    function GetSize: TPoint; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Reset; override;
    
    function GetPixel(X, Y: Integer): TGraphicsColor; override;
  public
    property Bitmap: TCarbonBitmap read GetBitmap write SetBitmap;
  end;
  
  // TODO: TCarbonPrinterContext
  
function CheckDC(const DC: HDC; const AMethodName: String; AParamName: String = ''): Boolean;

var
  // context for calculating text parameters for invisible controls
  DefaultContext: TCarbonBitmapContext;
  ScreenContext: TCarbonScreenContext;

implementation

uses LCLIntf, CarbonProc, CarbonDbgConsts;

{------------------------------------------------------------------------------
  Name:    CheckDC
  Params:  DC          - Handle to a device context (TCarbonDeviceContext)
           AMethodName - Method name
           AParamName  - Param name
  Returns: If the DC is valid
 ------------------------------------------------------------------------------}
function CheckDC(const DC: HDC; const AMethodName: String;
  AParamName: String): Boolean;
begin
  if TObject(DC) is TCarbonDeviceContext then Result := True
  else
  begin
    Result := False;
    
    if Pos('.', AMethodName) = 0 then
      DebugLn(SCarbonWSPrefix + AMethodName + ' Error - invalid DC ' +
        AParamName + ' = ' + DbgS(DC) + '!')
    else
      DebugLn(AMethodName + ' Error - invalid DC ' + AParamName + ' = ' +
        DbgS(DC) + '!');
  end;
end;

{ TCarbonDeviceContext }

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.SetBkColor
  Params:  AValue - New background color

  Sets the background color
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.SetBkColor(AValue: TColor);
begin
  AValue := TColor(ColorToRGB(AValue));
  FBkColor := AValue;
  FBkBrush.SetColor(AValue, BkMode = OPAQUE);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.SetBkMode
  Params:  AValue - New background mode (OPAQUE, TRANSPARENT)

  Sets the background mode
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.SetBkMode(const AValue: Integer);
begin
  if FBkMode <> AValue then
  begin
    FBkMode := AValue;
    FBkBrush.SetColor(FBkColor, FBkMode = OPAQUE);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.SetCurrentBrush
  Params:  AValue - New brush

  Sets the current brush
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.SetCurrentBrush(const AValue: TCarbonBrush);
begin
  if AValue = nil then
  begin
    DebugLn('TCarbonDeviceContext.SetCurrentBrush Error - Value is nil!');
    Exit;
  end;
  
  if FCurrentBrush <> AValue then
  begin
    if FCurrentBrush <> nil then FCurrentBrush.Unselect;
    
    FCurrentBrush := AValue;
    FCurrentBrush.Select;
    FCurrentBrush.Apply(Self);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.SetCurrentFont
  Params:  AValue - New font

  Sets the current font
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.SetCurrentFont(const AValue: TCarbonFont);
begin
  if AValue = nil then
  begin
    DebugLn('TCarbonDeviceContext.SetCurrentFont Error - Value is nil!');
    Exit;
  end;
  
  if FCurrentFont <> AValue then
  begin
    //DebugLn('TCarbonDeviceContext.SetCurrentFont ', DbgS(FCurrentFont), '->',
    //  DbgS(AValue));
    if FCurrentFont <> nil then FCurrentFont.Unselect;
    FCurrentFont := AValue;
    FCurrentFont.Select;
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.SetCurrentPen
  Params:  AValue - New pen

  Sets the current pen
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.SetCurrentPen(const AValue: TCarbonPen);
begin
  if AValue = nil then
  begin
    DebugLn('TCarbonDeviceContext.SetCurrentPen Error - Value is nil!');
    Exit;
  end;
  
  if FCurrentPen <> AValue then
  begin
    if FCurrentPen <> nil then FCurrentPen.Unselect;
    
    FCurrentPen := AValue;
    FCurrentPen.Select;
    FCurrentPen.Apply(Self);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.SetCurrentRegion
  Params:  AValue - New region

  Sets the current region
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.SetCurrentRegion(const AValue: TCarbonRegion);
begin
  if AValue = nil then
  begin
    DebugLn('TCarbonDeviceContext.SetCurrentRegion Error - Value is nil!');
    Exit;
  end;

  if FCurrentRegion <> AValue then
  begin
    if FCurrentRegion <> nil then FCurrentRegion.Unselect;

    FCurrentRegion := AValue;
    FCurrentRegion.Select;
    FCurrentRegion.Apply(Self);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.SetROP2
  Params:  AValue - New binary raster operation

  Sets the binary raster operation
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.SetROP2(const AValue: Integer);
begin
  if FROP2 <> AValue then
  begin
    FROP2 := AValue;
    CurrentPen.Apply(Self);
    CurrentBrush.Apply(Self);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.SetTextColor
  Params:  AValue - New text color

  Sets the text color
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.SetTextColor(AValue: TColor);
begin
  AValue := TColor(ColorToRGB(AValue));
  FTextColor := AValue;
  TextBrush.SetColor(AValue, True);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.Create

  Creates new Carbon device context
 ------------------------------------------------------------------------------}
constructor TCarbonDeviceContext.Create;
begin
  inherited Create;
  FBkBrush := TCarbonBrush.Create(False);
  FTextBrush := TCarbonBrush.Create(False);
  
  FCurrentPen := DefaultPen;
  FCurrentPen.Select;
  FCurrentBrush := DefaultBrush;
  FCurrentBrush.Select;
  FCurrentFont := DefaultFont;
  FCurrentFont.Select;
  
  FClipRegion := TCarbonRegion.Create;

  FCurrentRegion := FClipRegion;
  FCurrentRegion.Select;
  
  FTextFractional := True;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.Destroy

  Frees Carbon device context
 ------------------------------------------------------------------------------}
destructor TCarbonDeviceContext.Destroy;
begin
  BkBrush.Free;
  TextBrush.Free;
  
  FSavedDCList.Free;
  
  if FCurrentPen <> nil then FCurrentPen.Unselect;
  if FCurrentBrush <> nil then FCurrentBrush.Unselect;
  if FCurrentFont <> nil then FCurrentFont.Unselect;
  if FCurrentRegion <> nil then FCurrentRegion.Unselect;
  
  FClipRegion.Free;

  inherited Destroy;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.Reset

  Resets the device context properties to defaults (pen, brush, ...)
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.Reset;
begin
  FPenPos.x := 0;
  FPenPos.y := 0;

  // create brush for bk color and mode
  FBkColor := clWhite;
  FBkMode := TRANSPARENT;
  FBkBrush.SetColor(clWhite, False);

  // create brush for text color
  FTextColor := clBlack;
  FTextBrush.SetColor(clBlack, True);

  // set raster operation to copy
  FROP2 := R2_COPYPEN;

  CurrentFont := DefaultFont;
  
  if CGContext <> nil then
  begin
    {$IFDEF VerboseCanvas}
      DebugLn('TCarbonDeviceContext.Reset set defaults');
    {$ENDIF}
    
    // enable anti-aliasing
    CGContextSetShouldAntialias(CGContext, 1);
    
    // set initial pen, brush and font
    CurrentPen := DefaultPen;
    CurrentBrush := DefaultBrush;
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.SaveDC
  Returns: Index of saved device context state
  
  Note: must be used in pair with RestoreDC!
 ------------------------------------------------------------------------------}
function TCarbonDeviceContext.SaveDC: Integer;
begin
  ClearClipping;

  Result := 0;
  if CGContext = nil then
  begin
    DebugLn('TCarbonDeviceContext.SaveDC CGContext is nil!');
    Exit;
  end;
  
  if FSavedDCList = nil then FSavedDCList := TFPObjectList.Create(True);
  
  CGContextSaveGState(CGContext);
  Result := FSavedDCList.Add(SaveDCData) + 1;
  
  {$IFDEF VerboseCanvas}
    DebugLn('TCarbonDeviceContext.SaveDC Result: ', DbgS(Result));
  {$ENDIF}
  
  if isClipped then
  begin
    CGContextSaveGState(CGContext);
    FClipRegion.Apply(Self);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.RestoreDC
  Params:  ASavedDC - Index of saved device context
  Returns: If the function succeeds
  
  Restores the previously saved state of device context
 ------------------------------------------------------------------------------}
function TCarbonDeviceContext.RestoreDC(ASavedDC: Integer): Boolean;
begin
  ClearClipping;

  Result := False;
  if (FSavedDCList = nil) or (ASavedDC <= 0) or (ASavedDC > FSavedDCList.Count) then
  begin
    DebugLn(Format('TCarbonDeviceContext.RestoreDC SavedDC %d is not valid!', [ASavedDC]));
    Exit;
  end;
  
  if FSavedDCList.Count > ASavedDC then
    DebugLn(Format('TCarbonDeviceContext.RestoreDC Warning: SaveDC - RestoreDC' +
      ' not used in pair, skipped %d saved states!', [FSavedDCList.Count - ASavedDC]));
    
  while FSavedDCList.Count > ASavedDC do
  begin
    CGContextRestoreGState(CGContext);
    FSavedDCList.Delete(FSavedDCList.Count - 1);
  end;
  
  {$IFDEF VerboseCanvas}
    DebugLn('TCarbonDeviceContext.RestoreDC SavedDC: ', DbgS(ASavedDC));
  {$ENDIF}
  
  CGContextRestoreGState(CGContext);
  RestoreDCData(TCarbonDCData(FSavedDCList[ASavedDC - 1]));
  FSavedDCList.Delete(ASavedDC - 1);
  Result := True;
  
  {$IFDEF VerboseCanvas}
    DebugLn('TCarbonDeviceContext.RestoreDC End');
  {$ENDIF}
  
  if FSavedDCList.Count = 0 then FreeAndNil(FSavedDCList);


  if isClipped then
  begin
    CGContextSaveGState(CGContext);
    FClipRegion.Apply(Self);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.SaveDCData
  Returns: The device context data
 ------------------------------------------------------------------------------}
function TCarbonDeviceContext.SaveDCData: TCarbonDCData;
begin
  Result := TCarbonDCData.Create;
  
  Result.CurrentFont := FCurrentFont;
  Result.CurrentBrush := FCurrentBrush;
  Result.CurrentPen := FCurrentPen;
  Result.CurrentRegion := FCurrentRegion;

  Result.BkColor := FBkColor;
  Result.BkMode := FBkMode;
  Result.BkBrush := FBkBrush;

  Result.TextColor := FTextColor;
  Result.TextBrush := FTextBrush;

  Result.ROP2 := FROP2;
  Result.PenPos := FPenPos;

  Result.WindowOfs := FWindowOfs;
  Result.ViewportOfs := FViewportOfs;

  Result.isClipped := isClipped;
  Result.ClipShape := FClipRegion.GetShapeCopy;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.RestoreDCData
  Params:  AData - Device context data
  
  Restores device context data
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.RestoreDCData(const AData: TCarbonDCData);
begin
  if (FCurrentFont <> AData.CurrentFont) then
  begin
    if (FCurrentFont <> nil) then
      FCurrentFont.Unselect;
    if (AData.CurrentFont <> nil) then
      AData.CurrentFont.Select;
  end;
  FCurrentFont := AData.CurrentFont;

  if (FCurrentBrush <> AData.CurrentBrush) then
  begin
    if (FCurrentBrush <> nil) then
      FCurrentBrush.Unselect;
    if (AData.CurrentBrush <> nil) then
      AData.CurrentBrush.Select;
  end;
  FCurrentBrush := AData.CurrentBrush;
  FCurrentBrush.Apply(Self);
  
  if (FCurrentPen <> AData.CurrentPen) then
  begin
    if (FCurrentPen <> nil) then
      FCurrentPen.Unselect;
    if (AData.CurrentPen <> nil) then
      AData.CurrentPen.Select;
  end;
  FCurrentPen := AData.CurrentPen;
  FCurrentPen.Apply(Self);
  
  if (FCurrentRegion <> AData.CurrentRegion) then
  begin
    if (FCurrentRegion <> nil) then
      FCurrentRegion.Unselect;
    if (AData.CurrentRegion <> nil) then
      AData.CurrentRegion.Select;
  end;
  FCurrentRegion := AData.CurrentRegion;

  FBkColor := AData.BkColor;
  FBkMode := AData.BkMode;
  FBkBrush := AData.BkBrush;

  FTextColor := AData.TextColor;
  FTextBrush := AData.TextBrush;

  FROP2 := AData.ROP2;
  FPenPos := AData.PenPos;

  FWindowOfs := AData.WindowOfs;
  FViewportOfs := AData.ViewportOfs;

  isClipped := AData.isClipped;
  FClipRegion.Shape := AData.ClipShape;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.BeginTextRender
  Params:  AStr    - UTF8 string to render
           ACount  - Count of chars to render
           ALayout - ATSU layout
  Returns: If the function suceeds

  Creates the ATSU text layout for the specified text and manages the device
  context to render the text.
  NOTE: Coordination system is set upside-down!
 ------------------------------------------------------------------------------}
function TCarbonDeviceContext.BeginTextRender(AStr: PChar; ACount: Integer; out
  ALayout: TCarbonTextLayout): Boolean;
var
  S: String;
begin
  Result := False;
  
  if ACount = 0 then Exit;

  // save context
  CGContextSaveGState(CGContext);

  // change coordination system
  CGContextScaleCTM(CGContext, 1, -1);

  if ACount < 0 then S := AStr
  else S := Copy(AStr, 1, ACount);
  
  ALayout := CurrentFont.CreateTextLayout(S, TextFractional);
  ALayout.Apply(Self);

  Result := True;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.EndTextRender
  Params:  ALayout - ATSU layout

  Frees the ATSU text layout and manages the device
  context to render ordinary graphic
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.EndTextRender(var ALayout: TCarbonTextLayout);
begin
  // restore context
  CGContextRestoreGState(CGContext);
  
  ALayout.Release;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.SetAntialiasing
  Params:  AValue - If should antialias

  Sets whether device context should antialias
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.SetAntialiasing(AValue: Boolean);
begin
  if not AValue then
    CGContextSetInterpolationQuality(CGContext, kCGInterpolationNone)
  else
    CGContextSetInterpolationQuality(CGContext, kCGInterpolationDefault);
  CGContextSetShouldAntialias(CGContext, CBool(AValue));
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.DrawCGImage
  Params:  X, Y - Left, Top
           Width, Height
           CGImage
  Returns: If the function succeeds

  Draws CGImage into CGContext
 ------------------------------------------------------------------------------}
function TCarbonDeviceContext.DrawCGImage(X, Y, Width, Height: Integer;
  CGImage: CGImageRef): Boolean;
begin
  Result := False;
  
  // save dest context
  CGContextSaveGState(CGContext);

  CGContextSetBlendMode(CGContext, kCGBlendModeNormal);
  try
    SetCGFillping(CGContext, Width, Height);
    if OSError(
      HIViewDrawCGImage(CGContext,
      GetCGRectSorted(X, Y, X + Width, Y + Height), CGImage),
      'DrawCGImage', 'HIViewDrawCGImage') then Exit;
    RestoreCGFillping(CGContext, Width, Height);
  finally
    CGContextRestoreGState(CGContext);
  end;
  
  Result := True;
end;

procedure TCarbonDeviceContext.SetCGFillping(Ctx: CGContextRef; Width, Height: Integer);
begin
  if Width < 0 then begin
    CGContextTranslateCTM(Ctx, -Width, 0);
    CGContextScaleCTM(Ctx, -1, 1);
  end;

  if Height < 0 then begin
    CGContextTranslateCTM(Ctx, 0, -Height);
    CGContextScaleCTM(Ctx, 1, -1);
  end;
end;

procedure TCarbonDeviceContext.RestoreCGFillping(Ctx: CGContextRef; Width, Height: Integer);
begin
  if Height < 0 then begin
    CGContextTranslateCTM(Ctx, 0, Height);
    CGContextScaleCTM(Ctx, 1, -1);
  end;

  if Width < 0 then begin
    CGContextScaleCTM(Ctx, -1, 1);
    CGContextTranslateCTM(Ctx, Width, 0);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.DrawFocusRect
  Params:  ARect - Bounding rectangle
  Returns: If the function succeeds

  Draws a focus rectangle
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.DrawFocusRect(ARect: TRect);
var
  AOutSet: SInt32;
begin
  // LCL thinks that focus cannot be drawn outside focus rects, but carbon do that
  // => correct rect
  OSError(GetThemeMetric(kThemeMetricFocusRectOutset, AOutSet{%H-}),
    Self, 'DrawFocusRect', 'GetThemeMetric');
  InflateRect(ARect, -AOutSet, -AOutSet);
  OSError(
    HIThemeDrawFocusRect(RectToCGRect(ARect), True, CGContext, kHIThemeOrientationNormal),
    Self, 'DrawFocusRect', 'HIThemeDrawFocusRect');
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.DrawGrid
  Params:  Arect  - Grid rectangle
           DX, DY - Grid cell width and height

  Draws the point grid
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.DrawGrid(const ARect: TRect; DX, DY: Integer);
var
  Y: Integer;
  GridLine: Array [0..1] of Single;
begin
  CGContextSaveGState(CGContext);
  try
    CGContextSetShouldAntialias(CGContext, 0);

    GridLine[0] := 1;
    GridLine[1] := DX - 1;
    CGContextSetLineDash(CGContext, 0, @GridLine[0], Length(GridLine));
    
    CGContextBeginPath(CGContext);

    // draw horzontal dotted lines
    for Y := 0 to (ARect.Bottom - ARect.Top - 1) div DY do
    begin
      CGContextMoveToPoint(CGContext, ARect.Left, ARect.Top + Y * DY + 1);
      CGContextAddLineToPoint(CGContext, ARect.Right, ARect.Top + Y * DY + 1);
    end;
    
    CGContextStrokePath(CGContext);
  finally
    CGContextRestoreGState(CGContext);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.Ellipse
  Params:
           X1 - X-coord. of bounding rectangle's upper-left corner
           Y1 - Y-coord. of bounding rectangle's upper-left corner
           X2 - X-coord. of bounding rectangle's lower-right corner
           Y2 - Y-coord. of bounding rectangle's lower-right corner

  Draws a ellipse. The ellipse is outlined by using the current pen and filled
  by using the current brush.
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.Ellipse(X1, Y1, X2, Y2: Integer);
var
  R: CGRect;
begin
  if (X1 = X2) or (Y1 = Y2) then Exit;

  R := GetCGRectSorted(X1, Y1, X2, Y2);
  R.origin.x := R.origin.x + 0.5;
  R.origin.y := R.origin.y + 0.5;
  R.size.width := R.size.width - 1;
  R.size.height := R.size.height - 1;

  CGContextBeginPath(CGContext);
  CGContextAddEllipseInRect(CGContext, R);
  CGContextDrawPath(CGContext, kCGPathFillStroke);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.ExcludeClipRect
  Params:  Left, Top, Right, Bottom - Rectangle coordinates

  Subtracts all intersecting points of the passed bounding rectangle from the
  current clipping region of the device context.
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.ExcludeClipRect(Left, Top, Right, Bottom: Integer);
var
  ClipBox: TRect;
  Rects: CGRectArray;
begin
  if (Left < Right) and (Top < Bottom) then
  begin
    // get clip bounding box, exclude passed rect and intersect result
    // with clip region
    ClipBox := CGRectToRect(CGContextGetClipBoundingBox(CGContext));

    Rects := ExcludeRect(ClipBox, Classes.Rect(Left, Top, Right, Bottom));

    if Length(Rects) > 0 then
      CGContextClipToRects(CGContext, @Rects[0], Length(Rects))
    else
      CGContextClipToRect(CGContext, CGRectZero);
  end;
end;

procedure TCarbonDeviceContext.ApplyTransform(Trans: CGAffineTransform);
var
  T2: CGAffineTransform;
begin
  T2 := CGContextGetCTM(CGContext);
  // restore old CTM since CTM may changed after the clipping
  if CGAffineTransformEqualToTransform(Trans, T2) = 0 then
    CGContextTranslateCTM(CGContext, Trans.a * Trans.tx - T2.a * T2.tx,
       Trans.d * Trans.ty - T2.d * T2.ty);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.ExtTextOut
  Params:  X       - X-coordinate of reference point
           Y       - Y-coordinate of reference point
           Options - Text-output options
           Rect    - Optional clipping and/or opaquing rectangle (TODO)
           Str     - Character string to be drawn
           Count   - Number of characters in string
           Dx      - Pointer to array of intercharacter spacing values
  Returns: If the string was drawn

  Draws a character string by using the currently selected font
 ------------------------------------------------------------------------------}
function TCarbonDeviceContext.ExtTextOut(X, Y: Integer; Options: Longint;
  Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
var
  TextLayout: TCarbonTextLayout;
  BrushSolid: Boolean;
begin
  Result := False;
  //DebugLn('TCarbonDeviceContext.ExtTextOut ' + DbgS(X) + ', ' + DbgS(Y) + ' R: ' + DbgS(Rect^) +
  //  ' S: ' + Str + ' C: ' + DbgS(Count));

  if Assigned(Rect) then
  begin
    // fill background
    if (Options and ETO_OPAQUE) > 0 then
    begin
      BrushSolid := BkBrush.Solid; // must ignore BkMode
      BkBrush.Solid := True;
      FillRect(Rect^, BkBrush);
      BkBrush.Solid := BrushSolid;
    end;
    //DebugLn('TCarbonDeviceContext.ExtTextOut fill ' + DbgS(Rect^));
  end;

  if not BeginTextRender(Str, Count, TextLayout) then Exit;
  try
    if CurrentFont.LineRotation = 0 then // TODO: fill rotated text background
    begin
      // fill drawed text background
      if BkMode = OPAQUE then
      begin
        BrushSolid := BkBrush.Solid; // must ignore BkMode
        BkBrush.Solid := True;
        BkBrush.Apply(Self, False); // do not use ROP2
        CGContextFillRect(CGContext, TextLayout.GetDrawBounds(X, Y));
        BkBrush.Solid := BrushSolid;
      end;
    end;

    // apply text color
    TextBrush.Apply(Self, False); // do not use ROP2

    // finally draw the text
    if not TextLayout.Draw(X, Y, DX, Count) then Exit;
    Result := True;
  finally
    EndTextRender(TextLayout);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.FillRect
  Params:  Rect  - Record with rectangle coordinates
           Brush - Carbon brush

  Fills the rectangle by using the specified brush
  It includes the left and top borders, but excludes the right and
  bottom borders of the rectangle!
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.FillRect(Rect: TRect; Brush: TCarbonBrush);
begin
  Brush.Apply(Self, False); // do not use ROP2
  try
    CGContextFillRect(CGContext, GetCGRectSorted(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom));
  finally
    CurrentBrush.Apply(Self); // apply current brush
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.Frame
  Params:  X1 - X-coordinate of bounding rectangle's upper-left corner
           Y1 - Y-coordinate of bounding rectangle's upper-left corner
           X2 - X-coordinate of bounding rectangle's lower-right corner
           Y2 - Y-coordinate of bounding rectangle's lower-right corner

  Draws a border in Carbon native style
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.Frame(X1, Y1, X2, Y2: Integer);
begin
  StockNullBrush.Apply(Self, False); // do not use ROP2
  try
    Rectangle(X1, Y1, X2 + 1, Y2 + 1);
  finally
    CurrentBrush.Apply(Self); // apply current brush
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.Frame3D
  Params:  ARect      - Bounding box of frame
           FrameWidth - Frame width
           Style      - Frame style

  Draws a 3D border in Carbon native style
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.Frame3D(var ARect: TRect;
  const FrameWidth: integer; const Style: TBevelCut);
var
  I, D: Integer;
  DrawInfo: HIThemeGroupBoxDrawInfo;
const
  SName = 'Frame3D';
begin
  if Style = bvRaised then
  begin
    D := GetCarbonThemeMetric(kThemeMetricPrimaryGroupBoxContentInset, 1);

    // draw frame as group box
    DrawInfo.version := 0;
    DrawInfo.state := kThemeStateActive;
    DrawInfo.kind := kHIThemeGroupBoxKindPrimary;

    for I := 1 to FrameWidth do
    begin
      OSError(
        HIThemeDrawGroupBox(RectToCGRect(ARect), DrawInfo, CGContext,
          kHIThemeOrientationNormal),
        Self, SName, 'HIThemeDrawGroupBox');

      InflateRect(ARect, -D, -D);
    end;
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.GetClipRect
  Returns: Clipping rectangle
 ------------------------------------------------------------------------------}
function TCarbonDeviceContext.GetClipRect: TRect;
begin
  Result := CGRectToRect(CGContextGetClipBoundingBox(CGContext));
end;

function TCarbonDeviceContext.GetLineLastPixelPos(PrevPos, NewPos: TPoint
  ): TPoint;
begin
  Result := NewPos;

  if NewPos.X > PrevPos.X then
    dec(Result.X)
  else
  if NewPos.X < PrevPos.X then
    inc(Result.X);

  if NewPos.Y > PrevPos.Y then
    dec(Result.Y)
  else
  if NewPos.Y < PrevPos.Y then
    inc(Result.Y);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.GetPixel
  Params:  X, Y - Coordinates of pixel
  Returns: Specified pixel color
 ------------------------------------------------------------------------------}
function TCarbonDeviceContext.GetPixel(X, Y: Integer): TGraphicsColor;
begin
  Result := clNone;
  DebugLn('TODO: Implement get pixel for CGContext.');
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.GetTextExtentPoint
  Params:  Str   - Text string
           Count - Number of characters in string
           Size  - The record for the dimensions of the string
  Returns: If the function succeeds

  Computes the width and height of the specified string of text
 ------------------------------------------------------------------------------}
function TCarbonDeviceContext.GetTextExtentPoint(Str: PChar; Count: Integer;
  var Size: TSize): Boolean;
var
  TextLayout: TCarbonTextLayout;
begin
  Result := False;
  Size.cx := 0;
  Size.cy := 0;

  if not BeginTextRender(Str, Count, TextLayout) then Exit;
  try
    Size.cx := TextLayout.GetWidth;
    Size.cy := TextLayout.GetHeight;

    Result := True;
  finally
    EndTextRender(TextLayout);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.GetTextMetrics
  Params:  TM - The Record for the text metrics
  Returns: If the function succeeds

  Fills the specified buffer with the metrics for the currently selected font
  TODO: get exact max. and av. char width, pitch and charset
 ------------------------------------------------------------------------------}
function TCarbonDeviceContext.GetTextMetrics(var TM: TTextMetric): Boolean;
var
  TextStyle: ATSUStyle;
  M: ATSUTextMeasurement;
  B: Boolean;
  TextLayout: TCarbonTextLayout;
const
  SName = 'GetTextMetrics';
  SGetAttrName = 'ATSUGetAttribute';
begin
  Result := False;
  
  TextStyle := CurrentFont.Style;

  FillChar(TM, SizeOf(TM), 0);

  // According to the MSDN library, TEXTMETRIC:
  // the average char width is generally defined as the width of the letter x
  if not BeginTextRender('x', 1, TextLayout) then Exit;
  try

    TM.tmAscent := RoundFixed(TextLayout.Ascent);
    TM.tmDescent := RoundFixed(TextLayout.Descent);
    TM.tmHeight := RoundFixed(TextLayout.Ascent + TextLayout.Descent);

    if OSError(ATSUGetAttribute(TextStyle, kATSULeadingTag, SizeOf(M), @M, nil),
      Self, SName, SGetAttrName, 'kATSULeadingTag', kATSUNotSetErr) then Exit;
    TM.tmInternalLeading := RoundFixed(M);
    TM.tmExternalLeading := 0;

    TM.tmAveCharWidth := RoundFixed(TextLayout.TextAfter - TextLayout.TextBefore);
  finally
    EndTextRender(TextLayout);
  end;

  TM.tmMaxCharWidth := TM.tmAscent; // TODO: don't know how to determine this right
  TM.tmOverhang := 0;
  TM.tmDigitizedAspectX := 0;
  TM.tmDigitizedAspectY := 0;
  TM.tmFirstChar := 'a';
  TM.tmLastChar := 'z';
  TM.tmDefaultChar := 'x';
  TM.tmBreakChar := '?';

  if OSError(ATSUGetAttribute(TextStyle, kATSUQDBoldfaceTag, SizeOf(B), @B, nil),
    Self, SName, SGetAttrName, 'kATSUQDBoldfaceTag', kATSUNotSetErr) then Exit;
  if B then TM.tmWeight := FW_NORMAL
       else TM.tmWeight := FW_BOLD;

  if OSError(ATSUGetAttribute(TextStyle, kATSUQDItalicTag, SizeOf(B), @B, nil),
    Self, SName, SGetAttrName, 'kATSUQDItalicTag', kATSUNotSetErr) then Exit;
  TM.tmItalic := Byte(B);

  if OSError(ATSUGetAttribute(TextStyle, kATSUQDUnderlineTag, SizeOf(B), @B, nil),
    Self, SName, SGetAttrName, 'kATSUQDUnderlineTag', kATSUNotSetErr) then Exit;
  TM.tmUnderlined := Byte(B);

  if OSError(ATSUGetAttribute(TextStyle, kATSUStyleStrikeThroughTag, SizeOf(B), @B, nil),
    Self, SName, SGetAttrName, 'kATSUStyleStrikeThroughTag', kATSUNotSetErr) then Exit;
  TM.tmStruckOut := Byte(B);

  // TODO: get these from font
  TM.tmPitchAndFamily := FIXED_PITCH or TRUETYPE_FONTTYPE;
  TM.tmCharSet := DEFAULT_CHARSET;

  Result := True;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.InvertRectangle
  Params:  X1 - X-coordinate of bounding rectangle's upper-left corner
           Y1 - Y-coordinate of bounding rectangle's upper-left corner
           X2 - X-coordinate of bounding rectangle's lower-right corner
           Y2 - Y-coordinate of bounding rectangle's lower-right corner

  Draws an inverted rectangle.
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.InvertRectangle(X1, Y1, X2, Y2: Integer);
begin
  // save dest context
  CGContextSaveGState(CGContext);
  try
    WhiteBrush.Apply(Self, False);
    CGContextSetBlendMode(CGContext, kCGBlendModeDifference);
    
    CGContextFillRect(CGContext, GetCGRectSorted(X1, Y1, X2, Y2));
  finally
    CGContextRestoreGState(CGContext);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.LineTo
  Params:  X  - X-coordinate of line's ending point
           Y  - Y-coordinate of line's ending point

  Draws a line from the current position up to the specified point and updates
  the current position
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.LineTo(X, Y: Integer);
var
  deltaX, deltaY, absDeltaX, absDeltaY: Integer;
  clipDeltaX, clipDeltaY: Float32;
  tx,ty:Float32;
begin
  deltaX := X - PenPos.x;
  deltaY := Y - PenPos.y;
  if (deltaX=0) and (deltaY=0) then Exit;

  absDeltaX := Abs(deltaX);
  absDeltaY := Abs(deltaY);
  if (absDeltaX<=1) and (absDeltaY<=1) then
  begin
    // special case for 1-pixel lines
    tx := FPenPos.x + 0.55;
    ty := FPenPos.y + 0.55;
  end
  else
  begin
    // exclude the last pixel from the line
    if absDeltaX > absDeltaY then
    begin
      if deltaX > 0 then clipDeltaX := -1.0 else clipDeltaX := 1.0;
      clipDeltaY := clipDeltaX * deltaY / deltaX;
    end
    else
    begin
      if deltaY > 0 then clipDeltaY := -1.0 else clipDeltaY := 1.0;
      clipDeltaX := clipDeltaY * deltaX / deltaY;
    end;
    tx := X + clipDeltaX + 0.5;
    ty := Y + clipDeltaY + 0.5;
  end;

  CGContextBeginPath(CGContext);
  CGContextMoveToPoint(CGContext, PenPos.x + 0.5, PenPos.y + 0.5);
  CGContextAddLineToPoint(CGContext, tx, ty);
  CGContextStrokePath(CGContext);

  FPenPos.x := X;
  FPenPos.y := Y;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.PolyBezier
  Params:  Points    - Points defining the cubic B<>zier curve
           NumPts    - Number of points passed
           Filled    - Fill the drawed shape
           Continous - Connect B<>zier curves

  Draws a cubic B<>zier curves. The first curve is drawn from the first point to
  the fourth point with the second and third points being the control points.
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.PolyBezier(Points: PPoint; NumPts: Integer;
  Filled, Continuous: boolean);
var
  C1, C2: TPoint;
begin
  if Points = nil then Exit;
  if NumPts < 4 then Exit;
  
  CGContextBeginPath(CGContext);

  if Continuous then
  begin
    CGContextMoveToPoint(CGContext, Points^.x + 0.5, Points^.y + 0.5);
    Dec(NumPts);

    while NumPts >= 3 do
    begin
      Inc(Points);
      C1 := Points^;
      Inc(Points);
      C2 := Points^;
      Inc(Points);

      CGContextAddCurveToPoint(CGContext, C1.x + 0.5, C1.y + 0.5, C2.x + 0.5, C2.y + 0.5,
        Points^.x + 0.5, Points^.y + 0.5);

      Dec(NumPts, 3);
    end;
  end
  else
  begin
    while NumPts >= 4 do
    begin
      CGContextMoveToPoint(CGContext, Points^.x + 0.5, Points^.y + 0.5);

      Inc(Points);
      C1 := Points^;
      Inc(Points);
      C2 := Points^;
      Inc(Points);
      
      CGContextAddCurveToPoint(CGContext, C1.x + 0.5, C1.y + 0.5, C2.x + 0.5, C2.y + 0.5,
        Points^.x + 0.5, Points^.y + 0.5);

      Inc(Points);
      Dec(NumPts, 4);
    end;
  end;

  if Filled and Continuous then
    CGContextDrawPath(CGContext, kCGPathFillStroke)
  else
    CGContextDrawPath(CGContext, kCGPathStroke);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.Polygon
  Params:  Points  - Pointer to polygon's vertices
           NumPts  - Number of polygon's vertices
           Winding - Use winding fill rule

  Draws a closed, many-sided shape on the canvas, using the pen and brush.
  If Winding is set, Polygon fills the shape using the Winding fill algorithm.
  Otherwise, Polygon uses the even-odd (alternative) fill algorithm. The first
  point is always connected to the last point.
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.Polygon(Points: PPoint; NumPts: Integer;
  Winding: boolean);
begin
  if Points = nil then Exit;
  if NumPts < 2 then Exit;
  
  CGContextBeginPath(CGContext);
  CGContextMoveToPoint(CGContext, Points^.x + 0.5, Points^.y + 0.5);
  Dec(NumPts);

  while NumPts > 0 do
  begin
    Inc(Points);
    CGContextAddLineToPoint(CGContext, Points^.x + 0.5, Points^.y + 0.5);
    Dec(NumPts);
  end;
  
  CGContextClosePath(CGContext);

  if Winding then
    CGContextDrawPath(CGContext, kCGPathFillStroke)
  else
    CGContextDrawPath(CGContext, kCGPathEOFillStroke);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.Polyline
  Params:  Points - Pointer to array containing points
           NumPts - Number of points in the array

  Draws a series of line segments by connecting the points in the specified
  array
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.Polyline(Points: PPoint; NumPts: Integer);
var
  P: TPoint;
begin
  if Points = nil then Exit;
  if NumPts < 1 then Exit;

  CGContextBeginPath(CGContext);
  CGContextMoveToPoint(CGContext, Points^.x + 0.5, Points^.y + 0.5);
  Dec(NumPts);

  while NumPts > 1 do
  begin
    Inc(Points);
    CGContextAddLineToPoint(CGContext, Points^.x + 0.5, Points^.y + 0.5);
    Dec(NumPts);
  end;
  P := GetLineLastPixelPos(Points[0], Points[1]);
  CGContextAddLineToPoint(CGContext, P.x + 0.5, P.y + 0.5);

  CGContextStrokePath(CGContext);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.Rectangle
  Params:  X1 - X-coordinate of bounding rectangle's upper-left corner
           Y1 - Y-coordinate of bounding rectangle's upper-left corner
           X2 - X-coordinate of bounding rectangle's lower-right corner
           Y2 - Y-coordinate of bounding rectangle's lower-right corner

  Draws a rectangle. The rectangle is outlined by using the current pen and
  filled by using the current brush.
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.Rectangle(X1, Y1, X2, Y2: Integer);
var
  R: CGRect;
begin
  //DebugLn('TCarbonDeviceContext.Rectangle ' + DbgS(Classes.Rect(X1, Y1, X2, Y2)));
  if (X1 = X2) or (Y1 = Y2) then Exit;
  
  R := GetCGRectSorted(X1, Y1, X2, Y2);
  R.origin.x := R.origin.x + 0.5;
  R.origin.y := R.origin.y + 0.5;
  R.size.width := R.size.width - 1;
  R.size.height := R.size.height - 1;

  CGContextBeginPath(CGContext);
  CGContextAddRect(CGContext, R);
  CGContextDrawPath(CGContext, kCGPathFillStroke);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonDeviceContext.SetPixel
  Params:  X, Y   - Position
           AColor - New color for specified position

  Sets the color of the specified pixel on the canvas
 ------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.SetPixel(X, Y: Integer; AColor: TGraphicsColor);
var
  R, G, B: Byte;
begin
  CGContextSaveGState(CGContext);
  try
    // apply color to fill
    CGContextSetBlendMode(CGContext, kCGBlendModeNormal);
    RedGreenBlue(ColorToRGB(AColor), R, G, B);
    CGContextSetRGBFillColor(CGContext, R / 255, G / 255, B / 255, 1.0);
    
    CGContextFillRect(CGContext, GetCGRect(X, Y, X + 1, Y + 1));
  finally
    CGContextRestoreGState(CGContext);
  end;
end;

{------------------------------------------------------------------------------
  Method:  StretchMaskBlt
  Params:  X, Y                  - Left/top corner of the destination rectangle
           Width, Height         - Size of the destination rectangle
           SrcDC                 - Carbon device context
           XSrc, YSrc            - Left/top corner of the source rectangle
           SrcWidth, SrcHeight   - Size of the source rectangle
           Mask                  - mask bitmap
           XMask, YMask          - Left/top corner of the mask rectangle
           Rop                   - Raster operation to be performed (TODO)
  Returns: If the function succeeds

  Copies a bitmap from a source rectangle into a destination rectangle using
  the specified raster operations. If needed it resizes the bitmap to
  fit the dimensions of the destination rectangle. Sizing is done according to
  the stretching mode currently set in the destination device context.
  TODO: copy from any canvas
        ROP
        stretch mode (should be set by winapi call in DC (MWE))
 ------------------------------------------------------------------------------}
function TCarbonDeviceContext.StretchDraw(X, Y, Width, Height: Integer;
  SrcDC: TCarbonBitmapContext; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
  Msk: TCarbonBitmap; XMsk, YMsk: Integer; Rop: DWORD): Boolean;
var
  Image, MskImage: CGImageRef;
  SubImage, SubMask: Boolean;
  Bitmap: TCarbonBitmap;
  LayRect, DstRect: CGRect;
  ImgRect: CGRect;
  LayerContext: CGContextRef;
  Layer: CGLayerRef;
  UseLayer: Boolean;
begin
  Result := False;
  
  Image := nil;
  Bitmap := SrcDC.GetBitmap;
  if Bitmap <> nil then Image := Bitmap.CGImage;

  if Image = nil then Exit;

  DstRect := CGRectMake(X, Y, Abs(Width), Abs(Height));

  SubMask := (Msk <> nil)
         and (Msk.CGImage <> nil)
         and (  (XMsk <> 0)
             or (YMsk <> 0)
             or (Msk.Width <> SrcWidth)
             or (Msk.Height <> SrcHeight));

  SubImage := ((Msk <> nil) and (Msk.CGImage <> nil))
           or (XSrc <> 0)
           or (YSrc <> 0)
           or (SrcWidth <> Bitmap.Width)
           or (SrcHeight <> Bitmap.Height);


  if SubMask then
    MskImage := Msk.CreateSubImage(Bounds(XMsk, YMsk, SrcWidth, SrcHeight))
  else
    if Msk <> nil then MskImage := Msk.CGImage
    else MskImage := nil;

  if SubImage then
    Image := Bitmap.CreateSubImage(Bounds(XSrc, YSrc, SrcWidth, SrcHeight));


  UseLayer:=Assigned(MskImage)
            or (CGImageGetWidth(Image){%H-}<>SrcWidth)
            or (CGImageGetHeight(Image){%H-}<>SrcHeight);

  try
    if not UseLayer then
    begin
      // Normal drawing
      Result := DrawCGImage(X, Y, Width, Height, Image);
    end
    else
    begin
      // use temp layer to mask source image
      // todo find a way to mask "hard" when stretching, now some soft remains are visible
      LayRect := CGRectMake(0, 0, SrcWidth, SrcHeight);
      Layer := CGLayerCreateWithContext(SrcDC.CGContext, LayRect.size, nil);

      // the sub-image is out of edges
      if (CGImageGetWidth(Image){%H-}<>SrcWidth) or (CGImageGetHeight(Image){%H-}<>SrcHeight) then
      begin
        with ImgRect do
          if XSrc<0 then origin.x:=SrcWidth-CGImageGetWidth(Image) else origin.x:=0;
        with ImgRect do
          if YSrc<0 then origin.y:=0 else origin.y:=SrcHeight-CGImageGetHeight(Image);

        ImgRect.size.width:=CGImageGetWidth(Image);
        ImgRect.size.height:=CGImageGetHeight(Image);
      end
      else
        ImgRect:=LayRect;

      try
        LayerContext := CGLayerGetContext(Layer);
        CGContextScaleCTM(LayerContext, 1, -1);
        CGContextTranslateCTM(LayerContext, 0, -SrcHeight);

        SetCGFillping(LayerContext, Width, Height);
        if Assigned(MskImage) then CGContextClipToMask(LayerContext, ImgRect, MskImage);
        CGContextDrawImage(LayerContext, ImgRect, Image);

        CGContextDrawLayerInRect(CGContext, DstRect, Layer);
        
        Result := True;
      finally
        CGLayerRelease(Layer);
      end;
    end;

  finally
    if SubImage then CGImageRelease(Image);
    if SubMask then CGImageRelease(MskImage);
  end;
  
  //DebugLn('StretchMaskBlt succeeds: ', Format('Dest %d Src %d X %d Y %d',
  //  [Integer(CGContext),
  //  Integer(Image),
  //  X, Y]));
end;

procedure TCarbonDeviceContext.ClearClipping;
var
  Trans: CGAffineTransform;
begin
  if isClipped  then
  begin
    Trans := CGContextGetCTM(CGContext);
    CGContextRestoreGState(CGContext);
    ApplyTransform(Trans);
  end;
end;

function TCarbonDeviceContext.SetClipRegion(AClipRegion: TCarbonRegion; Mode: Integer): Integer;
begin
  ClearClipping;
  isClipped := False;

  if not Assigned(AClipRegion) then
    HIShapeSetEmpty(FClipRegion.Shape)
  else
  begin
    CGContextSaveGState(CGContext);
    FClipRegion.CombineWith(AClipRegion, Mode);
    FClipRegion.Apply(Self);
    isClipped := true;
  end;
  Result := FClipRegion.GetType;
end;

function TCarbonDeviceContext.CopyClipRegion(ADstRegion: TCarbonRegion): Integer;
begin
  if Assigned(ADstRegion)
    then Result := ADstRegion.CombineWith(FClipRegion, RGN_COPY)
    else Result := LCLType.Error;
end;

procedure GetWindowViewTranslate(const AWindowOfs, AViewOfs: TPoint; out dx, dy: Integer); inline;
begin
  dx := AViewOfs.x - AWindowOfs.x;
  dy := AViewOfs.y - AWindowOfs.y;
end;

function isSamePoint(const p1, p2: TPoint): Boolean;
begin
  Result:=(p1.x=p2.x) and (p1.y=p2.y);
end;

procedure TCarbonDeviceContext.UpdateContextOfs(const AWindowOfs, AViewOfs: TPoint);
var
  dx, dy: Integer;
begin
  if isSamePoint(AWindowOfs, fWindowOfs) and isSamePoint(AViewOfs, fViewPortOfs) then Exit;
  GetWindowViewTranslate(FWindowOfs, FViewPortOfs, dx{%H-}, dy{%H-});
  CGContextTranslateCTM(CGContext, -dx, -dy);

  FWindowOfs := AWindowOfs;
  FViewPortOfs := AViewOfs;
  GetWindowViewTranslate(FWindowOfs, FViewPortOfs, dx, dy);
  CGContextTranslateCTM(CGContext, dx, dy);
end;

procedure TCarbonDeviceContext.SetWindowOfs(const AWindowOfs: TPoint);
begin
  UpdateContextOfs(AWindowOfs, ViewPortOfs);
end;

procedure TCarbonDeviceContext.SetViewPortOfs(const AViewOfs: TPoint);
begin
  UpdateContextOfs(WindowOfs, AViewOfs);
end;

function TCarbonDeviceContext.GetLogicalOffset: TPoint;
begin
  GetWindowViewTranslate(WindowOfs, ViewportOfs, Result.X, Result.Y);
end;

{ TCarbonScreenContext }

{------------------------------------------------------------------------------
  Method:  TCarbonScreenContext.GetSize
  Returns: Size of screen context
 ------------------------------------------------------------------------------}
function TCarbonScreenContext.GetSize: TPoint;
begin
  Result.X := CGDisplayPixelsWide(CGMainDisplayID);
  Result.Y := CGDisplayPixelsHigh(CGMainDisplayID);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonScreenContext.Create

  Creates new screen context
 ------------------------------------------------------------------------------}
constructor TCarbonScreenContext.Create;
begin
  inherited Create;
  Reset;
end;

{ TCarbonControlContext }

{------------------------------------------------------------------------------
  Method:  TCarbonControlContext.GetSize
  Returns: Size of control context
 ------------------------------------------------------------------------------}
function TCarbonControlContext.GetSize: TPoint;
var
  R: TRect;
begin
  FOwner.GetClientRect(R{%H-});
  Result.X := (R.Right - R.Left);
  Result.Y := (R.Bottom - R.Top);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonControlContext.Create
  Params:  AOwner - Context widget

  Creates new control context
 ------------------------------------------------------------------------------}
constructor TCarbonControlContext.Create(AOwner: TCarbonWidget);
begin
  inherited Create;

  FOwner := AOwner;
  Reset;
end;

{ TCarbonBitmapContext }

{------------------------------------------------------------------------------
  Method:  TCarbonBitmapContext.SetBitmap
  Params:  AValue - New bitmap

  Sets the bitmap
 ------------------------------------------------------------------------------}
procedure TCarbonBitmapContext.SetBitmap(const AValue: TCarbonBitmap);
begin
  if AValue = nil then
  begin
    DebugLn('TCarbonBitmapContext.SetBitmap Error - Value is nil!');
    Exit;
  end;
  
  if FBitmap <> AValue then
  begin
    FBitmap := AValue;
    
    Reset;
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonBitmapContext.GetSize
  Returns: Size of bitmap context
 ------------------------------------------------------------------------------}
function TCarbonBitmapContext.GetSize: TPoint;
begin
  if FBitmap <> nil then
  begin
    Result.X := FBitmap.Width;
    Result.Y := FBitmap.Height;
  end
  else
  begin
    Result.X := 0;
    Result.Y := 0;
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonBitmapContext.Create

  Creates new bitmap context
 ------------------------------------------------------------------------------}
constructor TCarbonBitmapContext.Create;
begin
  inherited Create;
  FBitmap := DefaultBitmap;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonBitmapContext.Destroy

  Frees bitmap context
 ------------------------------------------------------------------------------}
destructor TCarbonBitmapContext.Destroy;
begin
  if CGContext <> nil then CGContextRelease(CGContext);

  inherited Destroy;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonBitmapContext.Reset

  Resets the bitmap context properties to defaults (pen, brush, ...)
 ------------------------------------------------------------------------------}
procedure TCarbonBitmapContext.Reset;
var
  Info: CGBitmapInfo;
begin
  if CGContext <> nil then
  begin
    CGContextRelease(CGContext);
    CGContext := nil;
  end;


  if FBitmap <> nil then
  begin
    {$note TODO: convert data if image format is incomatible with context}
    // MWE:
    // A CGContext only supports a few formats of all the available image formats.
    // When a format doesn't match we should convert the image data to the closest
    // format supported. In order to do so, we should create the context and not
    // the bitmap, since if a conversion is needed, we need to manage our own data.
    // See QA1037 (for all)
    //
    // supported formats might use (there are more)
    //  Gray 8 kCGImageAlphaNone               WWWWWWWW
    //  RGB  5 kCGImageAlphaNoneSkipFirst      -RRRRRGGGGGBBBBB
    //  RGB  8 kCGImageAlphaNoneSkipFirst      --------RRRRRRRRRGGGGGGGGBBBBBBBB
    //  RGB  8 kCGImageAlphaNoneSkipLast       RRRRRRRRRGGGGGGGGBBBBBBBB--------
    //  RGB  8 kCGImageAlphaPremultipliedFirst AAAAAAAARRRRRRRRRGGGGGGGGBBBBBBBB
    //  RGB  8 kCGImageAlphaPremultipliedLast  RRRRRRRRRGGGGGGGGBBBBBBBBAAAAAAAA

    // create CGBitmapContext
    
    Info := FBitmap.Info;
    // convert kCGImageAlphaFirst -> kCGImageAlphaPremultipliedFirst
    if (Info and kCGImageAlphaFirst > 0) then
      Info := (Info and (not kCGImageAlphaFirst)) or kCGImageAlphaPremultipliedFirst;
    
    CGContext := CGBitmapContextCreate(FBitmap.Data, FBitmap.Width, FBitmap.Height,
                   FBitmap.BitsPerComponent, FBitmap.BytesPerRow, FBitmap.ColorSpace,
                   Info);
                   
    if CGContext = nil then
      DebugLn('Unable to create Canvas Handle for Bitmap. Format "', DbgS(Info), '" is not supported!');

    // flip and offset CTM to upper left corner
    CGContextTranslateCTM(CGContext, 0, FBitmap.Height);
    CGContextScaleCTM(CGContext, 1, -1);
  end;

  inherited Reset;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonBitmapContext.GetPixel
  Params:  X, Y - Coordinates of pixel
  Returns: Specified pixel color
 ------------------------------------------------------------------------------}
function TCarbonBitmapContext.GetPixel(X, Y: Integer): TGraphicsColor;
var
  S: TPoint;
  R: TRect;
  RawImage: TRawImage;
  IntfImage: TLazIntfImage;
begin
  Result := clNone;
  
  S := GetSize;
  if (X < 0) or (Y < 0) or (X > S.X - 1) or (Y > S.Y - 1) then Exit;
  
  R := Classes.Rect(X, Y, 1, 1);
  if not RawImage_FromBitmap(RawImage, HBITMAP(Bitmap), 0, @R) then Exit;
  IntfImage := TLazIntfImage.Create(RawImage, True);
  try
    Result := IntfImage.TColors[X, Y];
  finally
    IntfImage.Free;
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonBitmapContext.GetBitmap
  Returns: The bitmap of bitmap context
 ------------------------------------------------------------------------------}
function TCarbonBitmapContext.GetBitmap: TCarbonBitmap;
begin
  if FBitmap = nil then Result := nil
  else
  begin
    {$note TODO: convert data if image format is incomatible with context}
    // See also comments in Reset.
    // Before we update the bitmap, if needed, first the context data need to be
    // converted
    
    // update bitmap to reflect changes made via canvas
    FBitmap.UpdateImage;
    Result := FBitmap;
  end;
end;

end.