Использование code blocks из Objective-C в Delphi на macOS: как мы навели мосты

    image


    Многие, наверное, слышали о замечательном способе решения программистских задач под названием метод утенка (rubber duck debugging). Суть метода в том, что надо сесть в ванную, расслабиться, посадить на воду игрушечного утенка, и объяснить ему суть той проблемы, решение которой вы не можете найти. И, чудесным образом, после такой беседы решение находится.


    В своей прошлой статье на Хабре, где я рассказывал о разработке TamoGraph Site Survey для macOS, в роли утенка оказался сам Хабр: я пожаловался на то, что нам никак не удается придумать способ реализации code blocks из Objective-C в Delphi. И это помогло! Пришло просветление, и всё получилось. О ходе мыслей и о конечном результате я и хочу рассказать.


    Итак, для тех кто не читал прошлую статью, еще раз кратко излагаю суть проблемы. Code blocks — это языковая фича С++ и Objective-C, которая не поддерживается в Delphi. Точнее, Delphi имеет свой аналог code blocks, но он несовместим с теми code blocks, которые ожидает от наc macOS API. Дело в том, что многие классы имеют функции, в которых используются code blocks в качестве handler'ов завершения. Самый простой пример — beginWithCompletionHandler классов NSSavePanel и NSOpenPanel. Передаваемый сode block выполняется в момент закрытия диалога:


    - (IBAction)openExistingDocument:(id)sender {
       NSOpenPanel* panel = [NSOpenPanel openPanel];
    
       // This method displays the panel and returns immediately.
       // The completion handler is called when the user selects an
       // item or cancels the panel.
       [panel beginWithCompletionHandler:^(NSInteger result){
          if (result == NSFileHandlingPanelOKButton) {
             NSURL*  theDoc = [[panel URLs] objectAtIndex:0];
    
             // Open  the document.
          }
    
       }];
    }

    Побеседовав с утенком, я осознал, что не с того конца подходил к решению проблемы. Наверняка эта проблема существует не только в Delphi. Следовательно, надо начать с того, как решается проблема в других языках. Google в руки и мы находим очень близкий к нашей теме код для Python и JavaScript тут и тут. Хороший старт: если им это удалось, то удастся и нам. По сути, нам нужно всего лишь создать структуру в правильном формате, заполнить поля, и указатель на такую структуру и будет тем самым магическим указателем, который мы сможем передавать в те методы классов macOS, которые ожидают от нас блоков. Еще немного гугления, и мы находим хедер на сайте Apple:


    struct Block_descriptor {
        unsigned long int reserved;
        unsigned long int size;
        void (*copy)(void *dst, void *src);
        void (*dispose)(void *);
    };
    
    struct Block_layout {
        void *isa;
        int flags;
        int reserved; 
        void (*invoke)(void *, ...);
        struct Block_descriptor *descriptor;
        // imported variables
    };

    Излагаем это на Паскале:


      Block_Descriptor = packed record
        Reserved: NativeUint;
        Size: NativeUint;
        copy_helper: pointer;
        dispose_helper: pointer;
      end;
      PBlock_Descriptor = ^Block_Descriptor;
    
      Block_Literal = packed record
        Isa: pointer;
        Flags: integer;
        Reserved: integer;
        Invoke: pointer;
        Descriptor: PBlock_Descriptor;
      end;
      PBlock_Literal = ^Block_Literal;

    Теперь, почитав еще немного о блоках (How blocks are implemented и на Хабре, Objective-C: как работают блоки), перейдем к созданию блока, пока в самом простом варианте, на коленке:


    Var
      OurBlock: Block_Literal;
    function CreateBlock: pointer;
    var
      aDesc:  PBlock_Descriptor;
    begin
      FillChar(OurBlock, SizeOf(Block_Literal), 0);
      // Isa – первое поле нашего блока-объекта, и мы пишем в него
      // указатель на класс объекта, "NSBlock".
      OurBlock.Isa    := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID);
      // Указатель на наш коллбек. Это обычная функция cdecl, обявленная в нашем коде.
      OurBlock.Invoke := @InvokeCallback;
      // Аллоцируем память для Block_Descriptor
      New(aDesc);
      aDesc.Reserved       := 0;
      // прописываем размер
      aDesc.Size           := SizeOf(Block_Literal);
      OurBlock.Descriptor := aDesc;
    
      result:= @OurBlock;
    end;

    Поле flags мы пока оставляем нулевым, для простоты. Позже оно нам пригодится. Нам осталось задекларировать пока пустую функцию коллбека. Первым аргументом в коллбеке будет указатель на экземпляр класса NSBlock, а список остальных параметров зависит от конкретного метода Cocoa-класса, который будет вызывать code block. В примере выше, с NSSavePanel, это процедура с одним аргументом типа NSInteger. Так и запишем для начала:


    procedure InvokeCallback (aNSBlock: pointer; i1: NSInteger); cdecl;
    begin
      Sleep(0);
    end;

    Ответственный момент, удар по воротам:


        FSaveFile := TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel);
        NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd;
        objc_msgSendP2(
                       (FSaveFile as ILocalObject).GetObjectID,
                       sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')),
                       (NSWin as ILocalObject).GetObjectID,
                       CreateBlock
                       );
    

    Открывается диалог сохранения файла, мы жмем ОК или Cancel и … да! Мы попадем на break point, который поставили на Sleep(0), и да, в аргументе i1 будет либо 0, либо 1, в зависимости от того, какую кнопку в диалоге мы нажали. Победа! Мы с утенком счастливы, но впереди много работы:


    • Количество и тип аргументов коллбека могут быть разными. Есть определенные наиболее популярные наборы, но требуется гибкость.
    • У нас может быть в работе много код-блоков одновременно. Например, мы можем скачивать файл с вызовом completion handler по завершении и, параллельно, открывать и закрывать диалог сохранения файла. Сначала сработает код-блок, который мы создали вторым, а когда докачается файл, сработает первый код-блок. Хорошо бы вести учет.
    • Нам нужно как-то идентифицировать тот блок, который вызвал коллбек, и вызывать соответствующий этому блоку код Delphi.
    • Было бы здорово сделать мостик между анонимными методами в Delphi и код-блоками, без этого теряется всё удобство и красота. Хочется, чтобы вызов выглядел примерно так:

    SomeNSClassInstance.SomeMethodWithCallback (
                    Arg1,
                    Arg2, 
                       TObjCBlock.CreateBlockWithProcedure(
                              procedure (p1: NSInteger)
                              begin
                                if p1 = 0
                                  then ShowMessage ('Cancel')
                                  else ShowMessage ('OK');
                               end)
                       );

    Начнем с вида коллбеков. Очевидно, что самый простой и самый надежный способ – иметь под каждый тип функции свой коллбек:


    procedure InvokeCallback1 (aNSBlock: pointer; p1: pointer); cdecl;
    procedure InvokeCallback2 (aNSBlock: pointer; p1, p2: pointer); cdecl;
    procedure InvokeCallback3 (aNSBlock: pointer; p1, p2, p3: pointer); cdecl;

    И так далее. Но как-то это нудно и неэлегантно, правда? Поэтому мысль ведет нас дальше. Что, если объявить только один вид коллбека, проидентифицировать блок, который вызвал коллбек, узнать число аргументов и поползти по стеку, читая нужное количество аргументов?


    procedure InvokeCallback (aNSBlock: pointer); cdecl;
    var
      i, ArgNum: integer;
      p: PByte;
      Args: array of pointer;
    begin
      i:= FindMatchingBlock(aNSBlock);
      if i >= 0 then
      begin
        p:= @aNSBlock;
        Inc(p, Sizeof(pointer));   // Прыгаем в начало списка аргументов
        ArgNum:= GetArgNum(...);
        if ArgNum > 0 then
        begin
          SetLength(Args, ArgNum);
          Move(p^, Args[0], SizeOf(pointer) * ArgNum);
        end;
      ...
    end;

    Хорошая мысль? Нет, плохая. Это будет работать в 32-битном коде, но грохнется к чертовой матери в 64-битном, потому что никакого cdecl в 64-битном коде не бывает, а есть одна общая calling convention, которая, в отличие от cdecl, аргументы передает не в стэке, а в регистрах процессора. Ну что же, тогда поступим еще проще, объявим коллбек так:


    function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl;

    И просто будем читать столько аргументов, сколько нам нужно. В оставшихся аргументах будет мусор, но мы к ним и не будем обращаться. И заодно мы сменили procedure на function, на случай, если code block требует результата. Disclaimer: если вы не уверены в безопасности такого подхода, используйте отдельные коллбеки под каждый тип функции. Мне подход кажется довольно безопасным, но, как говорится, tastes differ.


    Что касается идентификации блока, то тут всё оказалось довольно просто: aNSBlock, который приходит к нам, как первый аргумент в коллбеке, указывает ровно на тот же Descriptor, который мы аллоцировали при создании блока.


    Теперь можно заняться анонимными методами разных типов, мы покроем процентов 90 из возможных наборов аргументов, которые встречаются на практике в классах macOS и мы всегда можем расширить список:


    type
    
      TProc1 = TProc;
      TProc2 = TProc<pointer>;
      TProc3 = TProc<pointer, pointer>;
      TProc4 = TProc<pointer, pointer, pointer>;
      TProc5 = TProc<pointer, pointer, pointer, pointer>;
      TProc6 = TProc<NSInteger>;
      TProc7 = TFunc<NSRect, boolean>;
    
      TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7);
    
      TObjCBlock = record
       private
         class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static;
       public
         class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static;
         class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static;
         class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static;
         class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static;
         class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static;
         class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static;
         class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static;
      end;

    Таким образом, создание блока с процедурой, которая, например, имеет два аргумента размером SizeOf(pointer), будет выглядеть так:


    class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer;
    begin
      result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3);
    end;

    CreateBlockWithCFunc выглядит так:


    class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer;
    begin
      result:= BlockObj.AddNewBlock(aTProc, aType);
    end;

    То есть. мы обращается к BlockObj, singleton-экземпляру класса TObjCBlockList, который нужен для управления всем этим хозяйством и недоступен снаружи юнита:


      TBlockInfo = packed record
         BlockStructure: Block_Literal;
         LocProc: TProc;
         ProcType: TProcType;
      end;
      PBlockInfo = ^TBlockInfo;
    
      TObjCBlockList = class (TObject)
      private
        FBlockList: TArray<TBlockInfo>;
        procedure ClearAllBlocks;
      public
        constructor Create;
        destructor Destroy; override;
        function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer;
        function FindMatchingBlock(const aCurrBlock: pointer): integer;
        procedure ClearBlock(const idx: integer);
        property BlockList: TArray<TBlockInfo> read FBlockList ;
      end;
    
    var
      BlockObj: TObjCBlockList;

    "Сердце" нашего класса бьется тут:


    function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer;
    var
      aDesc:  PBlock_Descriptor;
    const
      BLOCK_HAS_COPY_DISPOSE = 1 shl 25;
    begin
      // Добавляем в наш массив блоков новый элемент и обнуляем его
      SetLength(FBlockList, Length(FBlockList) + 1);
      FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0);
      // Это я уже объяснял выше
      FBlockList[High(FBlockList)].BlockStructure.Isa    := NSClassFromString ((StrToNSStr('NSBlock') 
                                          as ILocalobject).GetObjectID);
      FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback;
      // Сообщаем системе, что наш блок будет иметь два доп. хелпера,
      // для copy и displose. Зачем? Об этом ниже.
      FBlockList[High(FBlockList)].BlockStructure.Flags  := BLOCK_HAS_COPY_DISPOSE;
      // Сохраним тип нашего анонимного метода и ссылку на него:
      FBlockList[High(FBlockList)].ProcType              := aType;
      FBlockList[High(FBlockList)].LocProc               := aTProc;
    
      New(aDesc);
      aDesc.Reserved       := 0;
      aDesc.Size           := SizeOf(Block_Literal);
      // Укажем адреса хелпер-функций:
      aDesc.copy_helper    := @CopyCallback;
      aDesc.dispose_helper := @DisposeCallback;
      FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc;
    
      result:= @FBlockList[High(FBlockList)].BlockStructure;
    end;

    Ну вот, всё основное мы написали. Остается всего несколько тонких моментов.


    Во-первых, нам нужно добавить thread safety, чтобы с экземпляром класса можно было работать из разных нитей. Это довольно просто, и мы добавили соответствующий код.


    Во-вторых, нам надо бы узнать, а когда же можно наконец "прибить" созданную нами структуру, т.е. элемент массива FBlockList. На первый взгляд кажется, что как только система вызвала коллбек, блок можно удалять: загрузился файл, был вызван completion handler – всё, дело сделано. На самом деле, это не всегда так. Есть блоки, которые вызываются сколько угодно раз; например, в методе imageWithSize:flipped:drawingHandler: класса NSImage нужно передать указатель на блок, который будет отрисовывать картинку, что, как вы понимаете, может происходить хоть миллион раз. Вот тут-то нам и пригодится aDesc.dispose_helper := @DisposeCallback. Вызов процедуры DisposeCallback как раз и будет сигнализировать о том, что блок больше не нужен и его можно смело удалять.


    Вишенка на торте


    А давайте еще self-test напишем, прямо в том же юните? Вдруг что-то сломается в следующей версии компилятора или при переходе на 64 бита. Как можно протестировать блоки, не обращаясь к Cocoa-классам? Оказывается, для этого есть специальные низкоуровневые функции, которые нам надо для начала задекларировать в Delphi так:


      function imp_implementationWithBlock(block: id): pointer; cdecl;
                        external libobjc name _PU + 'imp_implementationWithBlock';
      function imp_removeBlock(anImp: pointer): integer; cdecl;
                        external libobjc name _PU + 'imp_removeBlock';

    Первая функция возвращает указатель на C-функцию, которая вызывает блок, который мы передали как аргумент. Вторая просто "подчищает" потом память. Отлично, значит нам нужно создать блок с помощью нашего прекрасного класса, передать его в imp_implementationWithBlock, вызвать функцию по полученному адресу и с замиранием сердца посмотреть, как отработал блок. Пробуем всё это исполнить. Вариант первый, наивный:


    class procedure TObjCBlock.SelfTest;
    var
      p: pointer;
      test: NativeUint;
      func : procedure ( p1, p2, p3, p4: pointer); cdecl;
    begin
      test:= 0;
      p:= TObjCBlock.CreateBlockWithProcedure(
                              procedure (p1, p2, p3, p4: pointer)
                              begin
                                test:= NativeUint(p1) + NativeUint(p2) +
                                       NativeUint(p3) + NativeUint(p4);
                              end);
      @func := imp_implementationWithBlock(p);
      func(pointer(1), pointer(2),  pointer(3),  pointer(4));
      imp_removeBlock(@func);
      if test <> (1 + 2 + 3 + 4)
        then raise Exception.Create('Objective-C code block self-test failed!');
    end;

    Запускаем и… упс. Попадаем в анонимный метод: p1=1, p2=3, p3=4, p4=мусор. What the …? Кто съел двойку? И почему в последнем параметре мусор? Оказывается, дело в том, что imp_implementationWithBlock возвращает trampoline, который позволяет вызывать блок как IMP. Проблема в том, что IMP в Objective-C всегда имеет два обязательных первых аргумента, (id self, SEL _cmd), т.е. указатели на объект и на селектор, а код-блок имеет лишь один обязательный аргумент в начале. Возвращаемый trampoline при вызове редактирует список аргументов: второй аргумент, _cmd, выкидывается за ненужностью, на его место пишется первый аргумент, а вот на место первого аргумента подставляется указатель на NSBlock.


    Да, вот так, trampoline подкрался незаметно. Ладно, вариант второй, правильный:


    class procedure TObjCBlock.SelfTest;
    var
      p: pointer;
      test: NativeUint;
      func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl;
    begin
      test:= 0;
      p:= TObjCBlock.CreateBlockWithProcedure(
                              procedure (p1, p2, p3, p4: pointer)
                              begin
                                test:= NativeUint(p1) + NativeUint(p2) +
                                       NativeUint(p3) + NativeUint(p4);
                              end);
      @func := imp_implementationWithBlock(p);
      // Да, _cmd будет проигнорирован!
      func(pointer(1), nil, pointer(2),  pointer(3),  pointer(4));
      imp_removeBlock(@func);
      if test <> (1 + 2 + 3 + 4)
        then raise Exception.Create('Objective-C code block self-test failed!');
    end;

    Вот теперь всё проходит гладко и можно наслаждаться работой с блоками. Целиком юнит можно скачать тут или посмотреть ниже. Комментарии ("ламеры, у вас тут течет память") и предложения по улучшению приветствуются.


    Полный сорс-код
    {*******************************************************}
    {                                                       }
    {     Implementation of Objective-C Code Blocks         }
    {                                                       }
    {       Copyright(c) 2017 TamoSoft Limited              }
    {                                                       }
    {*******************************************************}
    
    {
    LICENSE:
    
    Permission is hereby granted, free of charge, to any person obtaining a copy
    of this software and associated documentation files (the "Software"), to deal
    in the Software without restriction, including without limitation the rights
    to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
    copies of the Software, and to permit persons to whom the Software is
    furnished to do so, subject to the following conditions:
    
    You may not use the Software in any projects published under viral licenses,
    including, but not limited to, GNU GPL.
    
    The above copyright notice and this permission notice shall be included in all
    copies or substantial portions of the Software.
    
    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
    SOFTWARE
    }
    //USAGE EXAMPLE
    //
    //    FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel);
    //    NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd;
    //    objc_msgSendP2(
    //                   (FSaveFile as ILocalObject).GetObjectID,
    //                   sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')),
    //                   (NSWin as ILocalObject).GetObjectID,
    //                   TObjCBlock.CreateBlockWithProcedure(
    //                          procedure (p1: NSInteger)
    //                          begin
    //                            if p1 = 0
    //                              then ShowMessage ('Cancel')
    //                              else ShowMessage ('OK');
    //                           end)
    //                          );
    
    unit Mac.CodeBlocks;
    
    interface
    
    uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers,
         Macapi.ObjCRuntime, Macapi.CocoaTypes;
    
    type
    
      TProc1 = TProc;
      TProc2 = TProc<pointer>;
      TProc3 = TProc<pointer, pointer>;
      TProc4 = TProc<pointer, pointer, pointer>;
      TProc5 = TProc<pointer, pointer, pointer, pointer>;
      TProc6 = TProc<NSInteger>;
      TProc7 = TFunc<NSRect, boolean>;
    
      TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7);
    
      TObjCBlock = record
       private
         class procedure SelfTest; static;
         class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static;
       public
         class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static;
         class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static;
         class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static;
         class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static;
         class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static;
         class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static;
         class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static;
      end;
    
    implementation
    
      function imp_implementationWithBlock(block: id): pointer; cdecl;
                        external libobjc name _PU + 'imp_implementationWithBlock';
      function imp_removeBlock(anImp: pointer): integer; cdecl;
                        external libobjc name _PU + 'imp_removeBlock';
    
    type
    
      Block_Descriptor = packed record
        Reserved: NativeUint;
        Size: NativeUint;
        copy_helper: pointer;
        dispose_helper: pointer;
      end;
      PBlock_Descriptor = ^Block_Descriptor;
    
      Block_Literal = packed record
        Isa: pointer;
        Flags: integer;
        Reserved: integer;
        Invoke: pointer;
        Descriptor: PBlock_Descriptor;
      end;
      PBlock_Literal = ^Block_Literal;
    
      TBlockInfo = packed record
         BlockStructure: Block_Literal;
         LocProc: TProc;
         ProcType: TProcType;
      end;
      PBlockInfo = ^TBlockInfo;
    
      TObjCBlockList = class (TObject)
      private
        FBlockList: TArray<TBlockInfo>;
        procedure ClearAllBlocks;
      public
        constructor Create;
        destructor Destroy; override;
        function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer;
        function FindMatchingBlock(const aCurrBlock: pointer): integer;
        procedure ClearBlock(const idx: integer);
        property BlockList: TArray<TBlockInfo> read FBlockList ;
      end;
    
    var
      BlockObj: TObjCBlockList;
    
    function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl;
    var
      i: integer;
      aRect: NSRect;
    begin
      result:= nil;
      if Assigned(BlockObj) then
      begin
        TMonitor.Enter(BlockObj);
        try
          i:= BlockObj.FindMatchingBlock(aNSBlock);
          if i >= 0 then
          begin
            case  BlockObj.BlockList[i].ProcType of
              TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)();
              TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1);
              TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2);
              TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3);
              TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4);
              TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1));
              TProcType.pt7:
              begin
                aRect.origin.x   := CGFloat(p1);
                aRect.origin.y   := CGFloat(p2);
                aRect.size.width := CGFloat(p3);
                aRect.size.height:= CGFloat(p4);
                result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect));
              end;
            end;
          end;
        finally
          TMonitor.Exit(BlockObj);
        end;
      end;
    end;
    
    procedure DisposeCallback(aNSBlock: pointer) cdecl;
    var
      i: integer;
    begin
      if Assigned(BlockObj) then
      begin
        TMonitor.Enter(BlockObj);
        try
          i:= BlockObj.FindMatchingBlock(aNSBlock);
          if i >= 0
            then BlockObj.ClearBlock(i);
        finally
          TMonitor.Exit(BlockObj);
        end;
      end;
      TNSObject.Wrap(aNSBlock).release;
    end;
    
    procedure CopyCallback(scr, dst: pointer) cdecl;
    begin
     //
    end;
    
    class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer;
    begin
      result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1);
    end;
    
    class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer;
    begin
      result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2);
    end;
    
    class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer;
    begin
      result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3);
    end;
    
    class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer;
    begin
      result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4);
    end;
    
    class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer;
    begin
      result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5);
    end;
    
    class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer;
    begin
      result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6);
    end;
    
    class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer;
    begin
      result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7);
    end;
    
    class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer;
    begin
      result:= nil;
      if Assigned(BlockObj) then
      begin
        TMonitor.Enter(BlockObj);
        try
          result:= BlockObj.AddNewBlock(aTProc, aType);
        finally
          TMonitor.Exit(BlockObj);
        end;
      end;
    end;
    
    class procedure TObjCBlock.SelfTest;
    var
      p: pointer;
      test: NativeUint;
      // Yes, _cmd is ignored!
      func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl;
    begin
      test:= 0;
      p:= TObjCBlock.CreateBlockWithProcedure(
                              procedure (p1, p2, p3, p4: pointer)
                              begin
                                test:= NativeUint(p1) + NativeUint(p2) +
                                       NativeUint(p3) + NativeUint(p4);
                              end);
      @func := imp_implementationWithBlock(p);
      // Yes, _cmd is ignored!
      func(pointer(1), nil, pointer(2),  pointer(3),  pointer(4));
      imp_removeBlock(@func);
      if test <> (1 + 2 + 3 + 4)
        then raise Exception.Create('Objective-C code block self-test failed!');
    end;
    
    {TObjCBlockList}
    
    constructor TObjCBlockList.Create;
    begin
      inherited;
    end;
    
    destructor TObjCBlockList.Destroy;
    begin
      TMonitor.Enter(Self);
      try
        ClearAllBlocks;
      finally
        TMonitor.Exit(Self);
      end;
      inherited Destroy;
    end;
    
    procedure TObjCBlockList.ClearBlock(const idx: integer);
    begin
      Dispose(FBlockList[idx].BlockStructure.Descriptor);
      FBlockList[idx].BlockStructure.isa:= nil;
      FBlockList[idx].LocProc:= nil;
      Delete(FBlockList, idx, 1);
    end;
    
    function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer;
    var
      aDesc:  PBlock_Descriptor;
    const
      BLOCK_HAS_COPY_DISPOSE = 1 shl 25;
    begin
      SetLength(FBlockList, Length(FBlockList) + 1);
      FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0);
    
      FBlockList[High(FBlockList)].BlockStructure.Isa    := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID);
      FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback;
      FBlockList[High(FBlockList)].BlockStructure.Flags  := BLOCK_HAS_COPY_DISPOSE;
      FBlockList[High(FBlockList)].ProcType              := aType;
      FBlockList[High(FBlockList)].LocProc               := aTProc;
    
      New(aDesc);
      aDesc.Reserved       := 0;
      aDesc.Size           := SizeOf(Block_Literal);
      aDesc.copy_helper    := @CopyCallback;
      aDesc.dispose_helper := @DisposeCallback;
      FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc;
    
      result:= @FBlockList[High(FBlockList)].BlockStructure;
    end;
    
    procedure TObjCBlockList.ClearAllBlocks();
    var
      i: integer;
    begin
      for i := High(FBlockList) downto Low(FBlockList) do
         ClearBlock(i);
    end;
    
    function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer;
    var
      i: integer;
    begin
      result:= -1;
      if aCurrBlock <> nil then
      begin
        for i:= Low(FBlockList) to High(FBlockList) do
        begin
          if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor
            then Exit(i);
        end;
      end;
    end;
    
    initialization
      BlockObj:=TObjCBlockList.Create;
      TObjCBlock.SelfTest;
    
    finalization
      FreeAndNil(BlockObj);
    
    end.
    Поделиться публикацией
    Похожие публикации
    Ой, у вас баннер убежал!

    Ну. И что?
    Реклама
    Комментарии 6
      –2
      нам никак не удается придумать способ реализации code blocks из Objective-C в Delphi

      Может стоит взглянуть на то, что давно изобретено даже для Delphi — анонимные функции.
        0
        Простите, но вы ничего не поняли в статье. Анонимные функции Delphi не могут быть напрямую использованы как блоки в методах Cocoa. Решению как раз этой проблемы и посвящена публикация.
          –1
          Зачем вам использовать блоки из Objective-C?
          Неужели язык Delphi настолько ограничен что не позволяет использовать нативные способы?
          Может на задачу, которую вы пытаетесь решить, нужно взглянуть свежим взглядом?

          Просто такими подходами вы в конечном итоге перенесете огромную часть инфраструктуры языка Objective-c (фреймворки/библиотеки) ибо со временем вам будет недоставать остальных инструментов из этого языка.
        +1
        Действительно, зачем использовать WinAPI, когда вы пишете для Windows? Неужели Delphi настолько ограничен, что нельзя обойтись без этого? Расскажите миру, как в Windows узнать IP-адрес адаптера средствами Delphi или как в macOS узнать, когда система отправляется в sleep средствами Delphi. Без API. Нет, не выходит:)? Нужен свежий взгляд.
          –1
          Зря Вы так.
          Я сейчас сам вынужден поддерживать кросс-платформенные приложения и знаю какой это АД.
          Приходиться использовать такие платформы как:
          — Xamarin это основной язык C# mono
          — Robovm это основной язык java

          Весь непортируемый код на нативном Objective-c приходиться компилить во wrapper библиотеку.
          И потом линковать эту библиотеку к виртуальной машине C# mono или Java.
            0
            Ну замечательно, т.е. вы согласны, что нужен доступ к native API платформы. Тогда встает вопрос: как нормально использовать методы Cocoa-классов, которые требуют в качестве параметра указатель на code block? До сих пор решений для Delphi не было, я его предложил. Для Xamarin, кстати, оно есть.

        Только полноправные пользователи могут оставлять комментарии. Войдите, пожалуйста.

        Самое читаемое