{%MainUnit carbonint.pas}

{ $Id: carbonobject.inc 12509 2007-10-17 20:00:01Z tombo $ }
{******************************************************************************
  All utility method implementations of the TCarbonWidgetSet class are here.


 ******************************************************************************
 Implementation
 ******************************************************************************

 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL, included in this distribution,        *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}

{ TCarbonWidgetSet }

{
The only drawback to making your own event loop dispatching calls in the main
application thread is that you won't get the standard application event handler
installed. Specifically, the RunApplicationEventLoop function installs handlers
to do the following:
* Allow clicks in the menu bar to begin menu tracking
* Dispatch Apple events by calling AEProcessAppleEvent
* Respond to quit Apple events by quitting RunApplicationEventLoop.

One way to work around this limitation is by creating a dummy custom event
handler. When you are ready to process events, create the dummy event yourself,
post it to the queue and then call RunApplicationEventLoop (to install the
standard application event handler). The dummy event handler can then process
the events manually. For an example of using this method, see Technical
Q&A 1061 in Developer Documentation Technical Q&As.

}

// From: Technical Q&A 1061 in Developer Documentation Technical Q&As
// MWE: modified to fit the LCL, but the basic idea comes from Q&A 1061

function QuitEventHandler(inHandlerCallRef: EventHandlerCallRef;
                          inEvent: EventRef;
                          inUserData: Pointer): OSStatus; stdcall;
  // This event handler is used to override the kEventClassApplication
  // kEventAppQuit event while inside our event loop (EventLoopEventHandler).
  // It simply calls through to the next handler and, if that handler returns
  // noErr (indicating that the application is doing to quit), it sets
  // a Boolean to tell our event loop to quit as well.
  // MWE: in our case, terminates the app also
begin
  Result := CallNextEventHandler(inHandlerCallRef, inEvent);
  if Result <> noErr then Exit;
  
  if (Widgetset <> nil) and TCarbonWidgetSet(Widgetset).FTerminating then Exit;

  TCarbonWidgetSet(Widgetset).FTerminating := True;

  if Application = nil then Exit;
  Application.Terminate;
end;


function EventLoopEventHandler(inHandlerCallRef: EventHandlerCallRef;
                               inEvent: EventRef;
                               inUserData: Pointer): OSStatus; stdcall;
  // This code contains the standard Carbon event dispatch loop,
  // as per "Inside Macintosh: Handling Carbon Events", Listing 3-10,
  // except:
  //
  // o this loop supports yielding to cooperative threads based on the
  //   application maintaining the gNumberOfRunningThreads global
  //   variable, and
  //
  // o it also works around a problem with the Inside Macintosh code
  //   which unexpectedly quits when run on traditional Mac OS 9.
  //
  // See RunApplicationEventLoopWithCooperativeThreadSupport for
  // an explanation of why this is inside a Carbon event handler.
  //
  // The code in Inside Mac has a problem in that it quits the
  // event loop when ReceiveNextEvent returns an error.  This is
  // wrong because ReceiveNextEvent can return eventLoopQuitErr
  // when you call WakeUpProcess on traditional Mac OS.  So, rather
  // than relying on an error from ReceiveNextEvent, this routine tracks
  // whether the application is really quitting by installing a
  // customer handler for the kEventClassApplication/kEventAppQuit
  // Carbon event.  All the custom handler does is call through
  // to the previous handler and, if it returns noErr (which indicates
  // the application is quitting, it sets quitNow so that our event
  // loop quits.
  //
  // Note that this approach continues to support QuitApplicationEventLoop,
  // which is a simple wrapper that just posts a kEventClassApplication/
  // kEventAppQuit event to the event loop.

var
  QuitUPP: EventHandlerUPP;
  QuitHandler: EventHandlerRef;
  TmpSpec: EventTypeSpec;
  Loop: TApplicationMainLoop = nil;
  Dummy: LongWord;
begin
  // Get our TApplicationMainLoop
  Result := GetEventParameter(inEvent, MakeFourCC('Loop'), MakeFourCC('TAML'),
                              @Dummy, SizeOf(Loop), @Dummy, @Loop);
  if Result <> noErr then Exit;
  if not Assigned(Loop) then Exit;

  // Install our override on the kEventClassApplication, kEventAppQuit event.
  QuitUPP := NewEventHandlerUPP(EventHandlerProcPtr(Pointer(@QuitEventHandler)));
  //todo: raise exception ??
  if QuitUPP = nil then Exit;

  try
    TmpSpec := MakeEventSpec(kEventClassApplication, kEventAppQuit);
    if not InstallApplicationEventHandler(QuitUPP, 1, @TmpSpec, nil, @QuitHandler) then Exit;

    try
      // Run our event loop until quitNow is set.
      Loop;
    finally
      FPCMacOSAll.RemoveEventHandler(QuitHandler);
    end;
  finally
    DisposeEventHandlerUPP(QuitUPP);
  end;

(*
  theTarget := GetEventDispatcherTarget;
  repeat
    if MNumberOfRunningThreads = 0
    then timeToWaitForEvent := kEventDurationForever
    else timeToWaitForEvent := kEventDurationNoWait;

    Result := ReceiveNextEvent(0, nil, timeToWaitForEvent, true, theEvent);
    if Result = noErr
    then begin
      SendEventToEventTarget(theEvent, theTarget);
      ReleaseEvent(theEvent);
    end;
    if MNumberOfRunningThreads > 0
    then YieldToAnyThread;
  until quitNow;
*)
end;

{------------------------------------------------------------------------------
  Name:  CarbonApp_CommandProcess
  Handles menu commands
 ------------------------------------------------------------------------------}
function CarbonApp_CommandProcess(ANextHandler: EventHandlerCallRef;
  AEvent: EventRef;
  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
var
  Command: HICommand;
  CarbonMenu: TCarbonMenu;
  Msg: TLMessage;
  S: LongWord;
const SName = 'CarbonApp_CommandProcess';
begin
  {$IFDEF VerboseAppEvent}
    DebugLn('CarbonApp_CommandProcess');
  {$ENDIF}
  
  // check command and send "click" message to menu item
  if not OSError(
    GetEventParameter(AEvent, kEventParamDirectObject,
      typeHICommand, nil, SizeOf(HICommand), nil, @Command),
    SName, 'GetEventParameter') then
  begin
    {$IFDEF VerboseMenu}
       DebugLn('CarbonApp_CommandProcess MenuRef: ' + DbgS(Command.menuRef) +
         ' Item: ' + DbgS(Command.menuItemIndex) + ' CommandID: ' + DbgS(Command.commandID) +
         ' Attrs: ' + DbgS(Command.attributes));
    {$ENDIF}
      
    if (Command.commandID = MENU_FOURCC) and
      (Command.attributes and kHICommandFromMenu > 0) and
      (Command.menuRef <> nil) then
    begin
      if not OSError(GetMenuItemProperty(Command.menuRef, Command.menuItemIndex,
          LAZARUS_FOURCC, WIDGETINFO_FOURCC, SizeOf(TCarbonMenu), S, @CarbonMenu),
        SName, 'GetMenuItemProperty') then
      begin
        {$IFDEF VerboseMenu}
           DebugLn('CarbonApp_CommandProcess CarbonMenu: ' + DbgS(CarbonMenu));
        {$ENDIF}
        if CarbonMenu <> nil then
        begin
          Msg.msg := LM_ACTIVATE;
          CarbonMenu.LCLMenuItem.Dispatch(Msg);
          
          Result := noErr;
          Exit;
        end;
      end;
    end;
  end;
  
  Result := CallNextEventHandler(ANextHandler, AEvent);
end;

{------------------------------------------------------------------------------
  Name:  CarbonApp_Shown
  Handles application show
 ------------------------------------------------------------------------------}
function CarbonApp_Shown(ANextHandler: EventHandlerCallRef;
  AEvent: EventRef;
  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
begin
  {$IFDEF VerboseAppEvent}
    DebugLn('CarbonApp_Shown');
  {$ENDIF}
  
  Result := CallNextEventHandler(ANextHandler, AEvent);
  
  Application.IntfAppRestore;
end;

{------------------------------------------------------------------------------
  Name:  CarbonApp_Hidden
  Handles application hide
 ------------------------------------------------------------------------------}
function CarbonApp_Hidden(ANextHandler: EventHandlerCallRef;
  AEvent: EventRef;
  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
begin
  {$IFDEF VerboseAppEvent}
    DebugLn('CarbonApp_Hidden');
  {$ENDIF}

  Result := CallNextEventHandler(ANextHandler, AEvent);

  Application.IntfAppMinimize;
end;

{------------------------------------------------------------------------------
  Name:  CarbonApp_Open
  Handles application open
 ------------------------------------------------------------------------------}
function CarbonApp_Open(var AEvent: AppleEvent; var Reply: AppleEvent;
  Data: SInt32): OSErr; {$IFDEF darwin}mwpascal;{$ENDIF}
var
  DocList: AEDescList;
  FileCount: Integer;
  FileIdx: Integer;
  Keyword: AEKeyword;
  FileDesc: AEDesc;
  FileRef: FSRef;
  FileURL: CFURLRef;
  FileCFStr: CFStringRef;
  Files: Array of String;
const
  SName = 'OpenDocEventHandler';
begin
  //{$IFDEF VerboseAppEvent}
    DebugLn('CarbonApp_Open');
  //{$ENDIF}
  
  if OSError(AEGetParamDesc(AEvent, keyDirectObject, typeAEList, DocList),
    SName, 'AEGetParamDesc') then Exit;

  try
    if OSError(AECountItems(DocList, FileCount), SName, 'AECountItems') then Exit;


    SetLength(Files, 0);
    
    for FileIdx := 1 to FileCount do
    begin
      if OSError(AEGetNthDesc(DocList, FileIdx, typeFSRef, @Keyword, FileDesc),
        SName, 'AEGetNthDesc') then Continue;

      if OSError(AEGetDescData(FileDesc, @FileRef, SizeOf(FSRef)),
        SName, 'AEGetDescData') then Continue;

      if OSError(AEDisposeDesc(FileDesc),
        SName, 'AEDisposeDesc') then Continue;

      FileURL := CFURLCreateFromFSRef(kCFAllocatorDefault, FileRef);
      FileCFStr := CFURLCopyFileSystemPath(FileURL, kCFURLPOSIXPathStyle);
      try
        SetLength(Files, Length(Files) + 1);
        Files[High(Files)] := CFStringToStr(FileCFStr);
      finally
        FreeCFString(FileURL);
        FreeCFString(FileCFStr);
      end;
    end;
    
    if Length(Files) > 0 then
    begin
      if Application <> nil then
      begin
        if Application.MainForm <> nil then
          Application.MainForm.IntfDropFiles(Files);
          
        Application.IntfDropFiles(Files);
      end;
    end;
  finally
    AEDisposeDesc(DocList);
  end;
  
  Result := noErr;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.AppInit
  Params:  ScreenInfo

  Initialize Carbon Widget Set
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.AppInit(var ScreenInfo: TScreenInfo);
var
  ScreenDC: HDC;
begin
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.AppInit');
  {$ENDIF}
  
  WakeMainThread := @OnWakeMainThread;
  
  // fill the screen info
  ScreenDC := GetDC(0);
  try
    ScreenInfo.PixelsPerInchX := GetDeviceCaps(ScreenDC, LOGPIXELSX);
    ScreenInfo.PixelsPerInchY := GetDeviceCaps(ScreenDC, LOGPIXELSY);
    ScreenInfo.ColorDepth := GetDeviceCaps(ScreenDC, BITSPIXEL);
  finally
    ReleaseDC(0, ScreenDC);
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.AppRun
  Params:  ALoop
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.AppRun(const ALoop: TApplicationMainLoop);
  // A reimplementation of RunApplicationEventLoop that supports
  // yielding time to cooperative threads.  It relies on the
  // rest of your application to maintain a global variable,
  // gNumberOfRunningThreads, that reflects the number of threads
  // that are ready to run.
var
  EventLoopUPP: EventHandlerUPP;
  EventLoopHandler: EventHandlerRef;
  DummyEvent: EventRef;
  EventSpec: EventTypeSpec;
  CurMainEventQueue: EventQueueRef;
begin
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.AppRun');
  {$ENDIF}
  
  DummyEvent := nil;

  // Create a UPP for EventLoopEventHandler and QuitEventHandler

  EventLoopUPP := NewEventHandlerUPP(EventHandlerProcPtr(
                                     Pointer(@EventLoopEventHandler)));
  if EventLoopUPP = nil then
    RaiseGDBException('TCarbonWidgetSet.AppRun no eventhandler');

  try
    // Install EventLoopEventHandler, create a dummy event and post it,
    // and then call RunApplicationEventLoop.  The rationale for this
    // is as follows:  We want to unravel RunApplicationEventLoop so
    // that we can can yield to cooperative threads.  In fact, the
    // core code for RunApplicationEventLoop is pretty easy (you
    // can see it above in EventLoopEventHandler).  However, if you
    // just execute this code you miss out on all the standard event
    // handlers.  These are relatively easy to reproduce (handling
    // the quit event and so on), but doing so is a pain because
    // a) it requires a bunch boilerplate code, and b) if Apple
    // extends the list of standard event handlers, your application
    // wouldn't benefit.  So, we execute our event loop from within
    // a Carbon event handler that we cause to be executed by
    // explicitly posting an event to our event loop.  Thus, the
    // standard event handlers are installed while our event loop runs.

    EventSpec := MakeEventSpec(LCLCarbonEventClass, LCLCarbonEventKindMain);
    if not InstallApplicationEventHandler(EventLoopUPP, 1, @EventSpec, nil,
                                      @EventLoopHandler) then Exit;

    try
      if CreateEvent(nil, EventSpec.eventClass, EventSpec.eventKind, 0,
        kEventAttributeNone, DummyEvent) <> noErr
      then
        RaiseGDBException('TCarbonWidgetSet.AppRun create first dummy event failed');

      try
        if SetEventParameter(DummyEvent, MakeFourCC('Loop'),
                             MakeFourCC('TAML'), SizeOf(ALoop),
                             @ALoop) <> noErr
        then
          RaiseGDBException('TCarbonWidgetSet.AppRun setparam to first event failed');

        //DebuglnThrea dLog('TCarbonWidgetSet.AppRun '+dbgs(GetMainEventQueue));
        CurMainEventQueue:=GetMainEventQueue;
        if PostEventToQueue(CurMainEventQueue, DummyEvent,
                            kEventPriorityHigh) <> noErr
        then
          RaiseGDBException('TCarbonWidgetSet.AppRun post dummy event failed');
        fMainEventQueue:=CurMainEventQueue;

        RunApplicationEventLoop;
      finally
        fMainEventQueue:=nil;
        ReleaseEvent(DummyEvent);
      end;
    finally
      FPCMacOSAll.RemoveEventHandler(EventLoopHandler);
    end;
  finally
    DisposeEventHandlerUPP(EventLoopUPP);
  end;
  
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.AppRun END');
  {$ENDIF}
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.AppProcessMessages

  Handle all pending messages
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.AppProcessMessages;
var
  Target: EventTargetRef;
  Event: EventRef;
  CurEventClass: TEventInt;
  CurEventKind: TEventInt;
begin
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.AppProcessMessages');
  {$ENDIF}
  
  Target := GetEventDispatcherTarget;
  CurEventClass.Chars[4] := #0;
  CurEventKind.Chars[4] := #0;
  repeat
    if ReceiveNextEvent(0, nil, kEventDurationNoWait, True,
      Event) <> noErr then Break;
      
    CurEventClass.Int := GetEventClass(Event);
    CurEventKind.Int := GetEventKind(Event);

    {$IFDEF DebugEventLoop}
    DebugLn('EventClass: "',CurEventClass.Chars,'" EventKind: ',IntToStr(CurEventKind.Int));
    {$ENDIF}

    if CurEventClass.Chars=LCLCarbonEventClass then begin
      // internal carbon intf message
      if (CurEventKind.Chars=LCLCarbonEventKindWake) and IsMultiThread then
      begin
        // a thread is waiting -> synchronize
        CheckSynchronize;
      end;
    end;

    SendEventToEventTarget(Event, Target);
    ReleaseEvent(Event);
    
    if Clipboard <> nil then
      if Clipboard.OwnerShips > 0 then Clipboard.CheckOwnerShip;
    
  until Application.Terminated;
  
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.AppProcessMessages END');
  {$ENDIF}
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.AppWaitMessage

  Passes execution control to Carbon
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.AppWaitMessage;
var
  Event: EventRef;
begin
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.AppWaitMessage');
  {$ENDIF}
  
  // Simply wait forever for the next event.
  // Don't pull it, so we can handle it later.
  OSError(ReceiveNextEvent(0, nil, kEventDurationForever, False, Event),
    Self, 'AppWaitMessage', 'ReceiveNextEvent');
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.Create

  Constructor for the class
 ------------------------------------------------------------------------------}
constructor TCarbonWidgetSet.Create;
begin
  CarbonWidgetSet := Self;
  inherited Create;
  FTerminating := False;

  FTimerMap := TMap.Create(its4, SizeOf(TFNTimerProc));
  FCurrentCursor := 0;
  FMainMenu := nil;
  FCaptureWidget := 0;
  
  RegisterEvents;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.Destroy

  Destructor for the class
 ------------------------------------------------------------------------------}
destructor TCarbonWidgetSet.Destroy;
begin
  FreeAndNil(FTimerMap);
  DisposeAEEventHandlerUPP(FOpenEventHandlerUPP);
  
  inherited Destroy;
  CarbonWidgetSet := nil;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.RawImage_DescriptionFromCarbonBitmap

  Creates a rawimage description for a carbonbitmap
 ------------------------------------------------------------------------------}
function TCarbonWidgetSet.RawImage_DescriptionFromCarbonBitmap(out ADesc: TRawImageDescription; ABitmap: TCarbonBitmap): Boolean;
var
  Prec, Shift, BPR: Byte;
  AlphaInfo: CGImageAlphaInfo;
begin
  ADesc.Init;

  ADesc.Format := ricfRGBA;
  ADesc.Width := ABitmap.Width;
  ADesc.Height := ABitmap.Height;

  //ADesc.PaletteColorCount := 0;

  ADesc.BitOrder := riboReversedBits;
  ADesc.ByteOrder := riboMSBFirst;

  BPR := CGImageGetBytesPerRow(ABitmap.CGImage);
  if BPR and $F = 0 then ADesc.LineEnd := rileDQWordBoundary     // 128bit aligned
  else if BPR and $7 = 0 then ADesc.LineEnd := rileQWordBoundary //  64bit aligned
  else if BPR and $3 = 0 then ADesc.LineEnd := rileWordBoundary  //  32bit aligned
  else if BPR and $1 = 0 then ADesc.LineEnd := rileByteBoundary  //   8bit aligned
  else ADesc.LineEnd := rileTight;

  ADesc.LineOrder := riloTopToBottom;
  ADesc.BitsPerPixel := CGImageGetBitsPerPixel(ABitmap.CGImage);

  ADesc.MaskBitOrder := riboReversedBits;
  ADesc.MaskBitsPerPixel := 1;
  ADesc.MaskLineEnd := rileByteBoundary;
  // ADesc.MaskShift := 0;

  Prec := CGImageGetBitsPerComponent(ABitmap.CGImage);
  AlphaInfo := CGImageGetAlphaInfo(ABitmap.CGImage);

  if AlphaInfo <> kCGImageAlphaOnly
  then begin
    ADesc.RedPrec := Prec;
    ADesc.GreenPrec := Prec;
    ADesc.BluePrec := Prec;
  end;

  // alpha
  case AlphaInfo of
    kCGImageAlphaNone,
    kCGImageAlphaNoneSkipLast,
    kCGImageAlphaNoneSkipFirst: begin
      ADesc.Depth := Prec * 3;
      // ADesc.AlphaPrec := 0;
    end;
  else
    ADesc.Depth := Prec * 4;
    ADesc.AlphaPrec := Prec;
  end;

  case AlphaInfo of
    kCGImageAlphaNone,
    kCGImageAlphaNoneSkipLast: begin
      // RGBx
      Shift := 32 - Prec;
      ADesc.RedShift := Shift;
      Dec(Shift, Prec);
      ADesc.GreenShift := Shift;
      Dec(Shift, Prec);
      ADesc.BlueShift := Shift;
    end;
    kCGImageAlphaNoneSkipFirst: begin
      // xRGB
      Shift := 0;
      ADesc.BlueShift := Shift;
      Inc(Shift, Prec);
      ADesc.GreenShift := Shift;
      Inc(Shift, Prec);
      ADesc.RedShift := Shift;
    end;
    kCGImageAlphaPremultipliedFirst,
    kCGImageAlphaFirst: begin
      // ARGB
      Shift := 32 - Prec;
      ADesc.AlphaShift := Shift;
      Dec(Shift, Prec);
      ADesc.RedShift := Shift;
      Dec(Shift, Prec);
      ADesc.GreenShift := Shift;
      Dec(Shift, Prec);
      ADesc.BlueShift := Shift;
    end;
    kCGImageAlphaPremultipliedLast,
    kCGImageAlphaLast: begin
      // RGBA
      Shift := 32 - Prec;
      ADesc.RedShift := Shift;
      Dec(Shift, Prec);
      ADesc.GreenShift := Shift;
      Dec(Shift, Prec);
      ADesc.BlueShift := Shift;
      Dec(Shift, Prec);
      ADesc.AlphaShift := Shift;
    end;
    kCGImageAlphaOnly: begin
      // A
      //ADesc.AlphaShift := 0;
    end;
  end;

  Result := True;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.RawImage_FromCarbonBitmap

  Creates a rawimage description for a carbonbitmap
 ------------------------------------------------------------------------------}
function TCarbonWidgetSet.RawImage_FromCarbonBitmap(out ARawImage: TRawImage; ABitmap, AMask: TCarbonBitmap; const ARect: TRect): Boolean;
begin
  FillChar(ARawImage, SizeOf(ARawImage), 0);
  RawImage_DescriptionFromCarbonBitmap(ARawImage.Description, ABitmap);

  ARawImage.DataSize := ABitmap.DataSize;
  ReAllocMem(ARawImage.Data, ARawImage.DataSize);
  if ARawImage.DataSize > 0 then
    System.Move(ABitmap.Data^, ARawImage.Data^, ARawImage.DataSize);

  Result := True;
  
  if AMask = nil then Exit;
  if AMask.Depth > 1
  then begin
    DebugLn('[WARNING] RawImage_FromCarbonBitmap: AMask.Depth > 1');
    Exit;
  end;

  ARawImage.MaskSize := AMask.DataSize;
  ReAllocMem(ARawImage.Mask, ARawImage.MaskSize);
  if ARawImage.MaskSize > 0 then
    System.Move(AMask.Data^, ARawImage.Mask^, ARawImage.MaskSize);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.CreateThemeServices
  Returns: Theme Services object for Carbon interface
 ------------------------------------------------------------------------------}
function TCarbonWidgetSet.CreateThemeServices: TThemeServices;
begin
  Result := TCarbonThemeServices.Create;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.PassCmdLineOptions

  Not used
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.PassCmdLineOptions;
begin
  inherited PassCmdLineOptions;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.SendCheckSynchronizeMessage
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.SendCheckSynchronizeMessage;
var
  EventSpec: EventTypeSpec;
  DummyEvent: EventRef;
begin
  if FMainEventQueue=nil then exit;
  
  {$IFDEF VerboseObject}
    DebugLnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage ');
  {$ENDIF}
  
  EventSpec := MakeEventSpec(LCLCarbonEventClass,LCLCarbonEventKindWake);
  DummyEvent:=nil;
  try
    if CreateEvent(nil, EventSpec.eventClass, EventSpec.eventKind,
      0{GetCurrentEventTime}, kEventAttributeNone, DummyEvent) <> noErr then
    begin
      {$IFDEF VerboseObject}
        DebugLnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage Create event FAILED');
      {$ENDIF}
      
      Exit;
    end;
    
    {$IFDEF VerboseObject}
      DebugLnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage GetMainEventQueue='+dbgs(GetMainEventQueue));
    {$ENDIF}

    if PostEventToQueue(FMainEventQueue, DummyEvent,
      kEventPriorityHigh) <> noErr then
    begin
      {$IFDEF VerboseObject}
        DebugLnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage Post event FAILED');
      {$ENDIF}
      
      Exit;
    end;
  finally
    if DummyEvent <> nil then ReleaseEvent(DummyEvent);
  end;
  
  {$IFDEF VerboseObject}
    DebugLnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage END');
  {$ENDIF}
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.OnWakeMainThread
  Params:  Sender
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.OnWakeMainThread(Sender: TObject);
begin
  SendCheckSynchronizeMessage;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.RegisterEvents
  Registers events for Carbon application
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.RegisterEvents;
var
  TmpSpec: EventTypeSpec;
const
  SName = 'RegisterEvents';
begin
  TmpSpec := MakeEventSpec(kEventClassCommand, kEventCommandProcess);
  InstallApplicationEventHandler(RegisterEventHandler(@CarbonApp_CommandProcess),
    1, @TmpSpec, nil, nil);
    
  TmpSpec := MakeEventSpec(kEventClassApplication, kEventAppShown);
  InstallApplicationEventHandler(RegisterEventHandler(@CarbonApp_Shown),
    1, @TmpSpec, nil, nil);
    
  TmpSpec := MakeEventSpec(kEventClassApplication, kEventAppHidden);
  InstallApplicationEventHandler(RegisterEventHandler(@CarbonApp_Hidden),
    1, @TmpSpec, nil, nil);
    
  FOpenEventHandlerUPP := NewAEEventHandlerUPP(AEEventHandlerProcPtr(@CarbonApp_Open));
  OSError(
    AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments, FOpenEventHandlerUPP, 0, False),
    Self, SName, 'AEInstallEventHandler');
  OSError(
    AEInstallEventHandler(kCoreEventClass, kAEOpenContents, FOpenEventHandlerUPP, 0, False),
    Self, SName, 'AEInstallEventHandler');
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.AppTerminate

  Tells Carbon to halt the application
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.AppTerminate;
begin
  if FTerminating then Exit;
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.AppTerminate');
  {$ENDIF}
  
  QuitApplicationEventLoop;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.AppMinimize

  Minimizes the whole application to the taskbar
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.AppMinimize;
var
  Proc: ProcessSerialNumber;
const
  SName = 'AppMinimize';
begin
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.AppMinimize');
  {$ENDIF}
  
  // hide process
  if OSError(GetCurrentProcess(Proc), Self, SName, SGetCurrentProc) then Exit;
    OSError(ShowHideProcess(Proc, False), Self, SName, SShowHideProc);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.AppRestore

  Restores the whole minimized application from the taskbar
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.AppRestore;
var
  Proc: ProcessSerialNumber;
const
  SName = 'AppRestore';
begin
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.AppRestore');
  {$ENDIF}

  // show process
  if OSError(GetCurrentProcess(Proc), Self, SName, SGetCurrentProc) then Exit;
  OSError(ShowHideProcess(Proc, True), Self, SName, SShowHideProc);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.AppBringToFront

  Brings the entire application on top of all other non-topmost programs
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.AppBringToFront;
var
  Proc: ProcessSerialNumber;
const SName = 'AppBringToFront';
begin
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.AppBringToFront');
  {$ENDIF}
  
  (*
    According to Carbon Development Tips & Tricks:
    34. How do I bring all my windows to the front?
  *)

  if OSError(GetCurrentProcess(Proc), Self, SName, SGetCurrentProc) then Exit;
  OSError(SetFrontProcess(Proc), Self, SName, 'SetFrontProcess');
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.AppSetTitle
  Params:  ATitle - New application title

  Changes the application title
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.AppSetTitle(const ATitle: string);
begin
  // TODO
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.LCLPlatform
  Returns: lpCarbon - enum value for Carbon widgetset
 ------------------------------------------------------------------------------}
function TCarbonWidgetSet.LCLPlatform: TLCLPlatform;
begin
  Result:= lpCarbon;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.AttachMenuToWindow
  Params:  AMenuObject - Menu

  Attaches the menu of window to menu bar
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.AttachMenuToWindow(AMenuObject: TComponent);
const SName = 'TCarbonWidgetSet.AttachMenuToWindow';
begin
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.AttachMenuToWindow ' + AMenuObject.Name);
  {$ENDIF}
  
  if AMenuObject is TMainMenu then
    SetRootMenu(AMenuObject as TMainMenu);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.DCGetPixel
  Params:  CanvasHandle - Canvas handle to get color from
           X, Y         - Position
  Returns: Color of the specified pixel on the canvas
  Not implemented!
 ------------------------------------------------------------------------------}
function TCarbonWidgetSet.DCGetPixel(CanvasHandle: HDC; X, Y: integer
  ): TGraphicsColor;
begin
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.DCGetPixel DC: ' + DbgS(CanvasHandle) + ' X: ' + DbgS(X) + ' Y: ' + DbgS(Y));
  {$ENDIF}
  
  DebugLn('TCarbonWidgetSet.DCGetPixel TODO');
  Result := clNone;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.DCSetPixel
  Params:  CanvasHandle - Canvas handle to get color from
           X, Y         - Position
           AColor       - New color for specified position

  Sets the color of the specified pixel on the canvas
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.DCSetPixel(CanvasHandle: HDC; X, Y: integer;
  AColor: TGraphicsColor);
begin
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.DCSetPixel DC: ' + DbgS(CanvasHandle) + ' X: ' + DbgS(X) + ' Y: ' + DbgS(Y) + 'Color: ' + DbgS(AColor));
  {$ENDIF}

  if not CheckDC(CanvasHandle, 'DCSetPixel') then Exit;

  TCarbonDeviceContext(CanvasHandle).SetPixel(X, Y, AColor);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.DCReDraw
  Params:  CanvasHandle - Canvas handle to redraw

  Redraws (the window of) a canvas
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.DCRedraw(CanvasHandle: HDC);
begin
  {$IFDEF VerboseObject}
    DebugLn('TCarbonWidgetSet.DCRedraw DC: ' + DbgS(CanvasHandle));
  {$ENDIF}
  
  if not CheckDC(CanvasHandle, 'DCRedraw') then Exit;
  
  CGContextFlush(TCarbonContext(CanvasHandle).CGContext);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.SetDesigning
  Params:  AComponent - Component to set designing

  Not implemented!
 ------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.SetDesigning(AComponent: TComponent);
begin

end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.CreateComponent
  Params:  Sender

  Tells Carbon to create a control
  Deprecated! Implement TCarbonWS*.CreateHandle method instead.
 ------------------------------------------------------------------------------}
function TCarbonWidgetSet.CreateComponent(Sender: TObject): THandle;
begin
  DebugLn('WARNING: TCarbonWidgetSet.CreateComponent is deprecated, should not be called!! Go whack somebody with a large throut!');
  Result := 0;
end;

{------------------------------------------------------------------------------
  Method:  TimerCallback
  Params:  inTimer    - Timer reference
           inUserData - User data passed when installing timer

  Calls the timer function associated with specified timer
 ------------------------------------------------------------------------------}
procedure TimerCallback(inTimer: EventLoopTimerRef; inUserData: UnivPtr);
var
  TimerFunc: TFNTimerProc;
begin
  {$IFDEF VerboseTimer}
    DebugLn('TimerCallback');
  {$ENDIF}
  
  if CarbonWidgetSet = nil then Exit;
  if CarbonWidgetSet.FTimerMap.GetData(inTimer, TimerFunc) then
  begin
    {$IFDEF VerboseTimer}
      DebugLn('TimerCallback Timer instaåled, calling func.');
    {$ENDIF}
    
    TimerFunc;
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.CreateTimer
  Params:  Interval  - New timer interval
           TimerFunc - New timer callback
  Returns: A Timer id

  Creates new timer with specified interval and callback function
 ------------------------------------------------------------------------------}
function TCarbonWidgetSet.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): THandle;
var
  Timer: EventLoopTimerRef;
begin
  {$IFDEF VerboseTimer}
    DebugLn('TCarbonWidgetSet.CreateTimer Interval: ' + DbgS(Interval));
  {$ENDIF}
  Result := 0;
  
  if (Interval > 0) and (TimerFunc <> nil) then
  begin
    if OSError(InstallEventLoopTimer(GetMainEventLoop,
      Interval / 1000, Interval / 1000, // converts msec -> sec
      EventLoopTimerUPP(@TimerCallback), nil, Timer), Self,
      'CreateTimer', 'InstallEventLoopTimer') then Exit;
      
    FTimerMap.Add(Timer, TimerFunc);
    Result := THandle(Timer)
  end;
  
  {$IFDEF VerboseTimer}
    DebugLn('TCarbonWidgetSet.CreateTimer Result: ' + DbgS(Result));
  {$ENDIF}
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWidgetSet.Destroy
  Params:  TimerHandle - Timer id to destroy
  Returns: If the function succeeds

  Destroys specified timer
 ------------------------------------------------------------------------------}
function TCarbonWidgetSet.DestroyTimer(TimerHandle: THandle): boolean;
begin
  {$IFDEF VerboseTimer}
    DebugLn('TCarbonWidgetSet.DestroyTimer Handle: ' + DbgS(TimerHandle));
  {$ENDIF}

  Result := FTimerMap.Delete(TimerHandle);
  
  if Result then // valid timer
    OSError(RemoveEventLoopTimer(EventLoopTimerRef(TimerHandle)), Self,
      'DestroyTimer', 'RemoveEventLoopTimer');
end;
