Примеры созданы в процессе обсуждения¹⁾ «проблемы отсутствия делегатов (procedure of object и т.п.)» в языке Компонентный Паскаль.

Ниже иллюстрируются несколько архитектурных подходов.

В Active Oberon (как и во многих других языках, например, в C#) присутствуют делегаты — процедурные переменные, способные ссылаться на методы объектов. На их основе участник форума Galkov привёл пример связывания объектов-кнопок и методов объекта-плеера. Исходный текст на Active Oberon:

TYPE
  MediaPlayer = OBJECT
    PROCEDURE Play; .... play a movie .... END Play;
    PROCEDURE Stop; .... stop movie .... END Stop;
  END MediaPlayer;

  ClickProc = PROCEDURE {DELEGATE};
  Button = OBJECT
    VAR
    onClick: ClickProc;
    caption: ARRAY 32 OF CHAR;

    PROCEDURE OnClick;
    BEGIN onClick END OnClick;

    PROCEDURE & Init(caption: ARRAY OF CHAR; onClick: ClickProc);
    BEGIN SELF.onClick := onClick; COPY(caption, SELF.caption)
    END Init;
  END Button;

PROCEDURE Init(p: MediaPlayer);
  VAR b0, b1, b2: Button;
BEGIN
(* Reboot -> call system reboot function *)
  NEW(b0, "Reboot", System.Reboot);
  (* MediaPlayer UI: bind buttons with player instance *)
  NEW(b1, "Play", p.Play);
  NEW(b2, "Stop", p.Stop);
END Init;

Достаточно распространённый прием в Компонентном Паскале. Модуль, желающий сообщать о событиях, предоставляет абстрактный тип-обработчик, другие модули его реализуют, получая объекты обратного вызова. (Такие объекты-обработчики в Блэкбоксе часто называют хуками (Hook). Примером может служить модуль Log и инсталляция в него хука модулем StdLog).

Пусть имеются два модуля - Buttons и Players. Их интерфейс (DEFINITION) приведён ниже:

DEFINITION Buttons;
 
   IMPORT Views;
 
   TYPE
      Handler = POINTER TO ABSTRACT RECORD
         (h: Handler) Do-, NEW, ABSTRACT
(* знак "-" означает экспорт процедуры только для реализации. Вызывать её может только модуль Buttons *)
      END;
 
   PROCEDURE New (IN caption: ARRAY OF CHAR; handler: Handler): Views.View;
 
END Buttons.
 
DEFINITION Players;
 
   TYPE
      Player = POINTER TO ABSTRACT RECORD
         (p: Player) Play, NEW, ABSTRACT;
         (p: Player) Stop, NEW, ABSTRACT
      END;
 
   PROCEDURE New (IN mediaFile: ARRAY OF CHAR): Player;
 
END Players.

Как обычно, реальные типы объектов не экспортируются, а порождаются фабриками New. Подразумевается, что кнопка — разновидность вьюшки (объекта изображения, Views.View).

Создадим свой модуль, который связывает две кнопки и плеер с помощью объявленных объектов обработчиков:

MODULE MyApplication;
 
   IMPORT Views, Buttons, Players;
 
   TYPE
      PlayHandler = POINTER TO RECORD (Buttons.Handler) pl: Player END;
      StopHandler = POINTER TO RECORD (Buttons.Handler) pl: Player END;
 
   PROCEDURE (h: PlayHandler) Do;
   BEGIN
      h.pl.Play
   END Do;
 
   PROCEDURE (h: StopHandler) Do;
   BEGIN
      h.pl.Stop
   END Do;
 
   PROCEDURE OpenPlayerDesk* (IN mediaFile: ARRAY OF CHAR);
      VAR pl: Players.Player;
         ph: PlayHandler;
         sh: StopHandler;
         pb, sb: Views.View;
   BEGIN
      pl := Players.New(mediaFile);
      NEW(ph); ph.pl := pl;
      NEW(sh); sh.pl := pl;
      pb := Buttons.New("Play", ph);
      sb := Buttons.New("Stop", sh);
      (* ... Выкладываем куда-нибудь кнопки pb и sb ... *)
   END OpenPlayerDesk;
 
END MyApplication.

Можно рассмотреть преимущества и недостатки такого подхода:

• Особенность: делегирующий слой объявляется явно и типизированно (под конкретную задачу делегирования).
• Недостаток: значительно «многословнее», требуется объявление мелких объектных типов.
• Недостаток: порождается много лишних динамических объектов (нагрузка на сборщик мусора). Также — косвенные вызовы, но эти накладные расходы незначительны для большинства приложений.
• Преимущество расширяемости: слой делегирования явный и может содержать любую посредническую логику. Более того, он даже приглашает нас при развитии приложения расширяться в этом месте. А посредничество, расслоение лежит, так или иначе, в основе всех компонентных паттернов. Нужна расширяемость — закладывается косвенность.
• Концептуально: Оберон предполагает сущности, к которыми можно обращаться, двух видов: процедура и запись, имеющая интерфейс. Статический интерфейс. И два вида ссылок — на процедуры и на записи. «Разламывание» интерфейса на отдельные операции и независимая идентификация операций не предполагается. Такое «разламывание» можно рассматривать только как оптимизацию, «сахар» или «хак» для каких-то частных случаев.

Важно заметить, что прямое связывание объекта-источника события с методом другого объекта обычно невозможно — в силу того, что требуется преобразование параметров, какие-то посреднические действия и проч. Таким образом, должен присутствовать объект-адаптер, который будет это осуществлять. В предыдущем примере на КП объекты, способные выполнять роль адаптера, присутствуют сразу.

Однако, с точки зрения проектирования систем, разумно связать подсистему (например, кнопку) с надсистемой (объектом-агрегатом из кнопок и плеера), у которой будет присутствовать диспетчер событий, инициирующий какие-то нисходящие команды к другим подсистемам (например, плееру).

В принципе, объявление отдельных объектов-посредников концептуально избыточно и может оказываться громоздким.

Следует вспомнить, что, по сути, метод — это процедура с первым параметром - указателем на контекст (экземпляр объекта). Именно такой стиль ООП, кстати, предполагает классический Оберон и Оберон-07, в которых нет связанных с типами процедур. При таком взгляде делегат можно представить как пару из процедурной переменной и указателя на объект, типа:: RECORD handler: PROCEDURE(obj: ANYPTR; ..другие параметры..); obj: ANYPTR) END. Объект, владеющий такой парой, может инициировать для другого объекта операцию.

Пример:

DEFINITION Buttons;
 
   TYPE
      Handler = PROCEDURE (obj: ANYPTR);
 
   PROCEDURE New (IN caption: ARRAY OF CHAR; handler: Handler; obj: ANYPTR): Views.View;
 
END Buttons.
 
DEFINITION Players;
 
   TYPE
      Player = POINTER TO ABSTRACT RECORD
         (p: Player) Play ( ..какие-то параметры.. ), NEW, ABSTRACT;
         (p: Player) Stop ( ..какие-то параметры.. ), NEW, ABSTRACT
      END;
 
   PROCEDURE New (...): Player;
 
END Players.

MODULE Desks;
 
   IMPORT Views, Buttons, Players;
 
   TYPE
      Desk = POINTER TO RECORD (Views.View)
         playButton, stopButton: Views.View;
         player: Players.Player
      END;
 
   PROCEDURE PlayHandler (obj: ANYPTR);
   BEGIN
      obj(Desk).player.Play(...)
   END PlayHandler;
 
   PROCEDURE StopHandler (obj: ANYPTR);
   BEGIN
      obj(Desk).player.Stop(...)
   END Stophandler;
 
   PROCEDURE New* (...): Views.View;
      VAR d: Desk;
   BEGIN
      NEW(d); d.player := Players.New(...);
      d.playButton := Buttons.New("Play", PlayHandler, d);
      d.stopButton := Buttons.New("Stop", StopHandler, d);
   END New;
 
END Desks.

Вышеприведённый пример слишком «игрушечный». На самом деле, при соединении объектов нужно пересылать сигналы разных типов, заранее неизвестных.

Модифицируем пример, чтобы показать более общий подход.

Процедура-делегат должна получать свой объект, объект-источник и расширяемое VAR-сообщение (см. архитектурный приём generic message bus, например, http://forum.oberoncore.ru/viewtopic.php?f=90&t=258).

Обратим внимание, что появилась возможность сконцентрировать всю обработку событий в модуле системы-агрегата в одной процедуре, которая принимает решение на основе того, какое сообщение от какого объекта получено. Разумеется, можно было оставить две отдельных процедуры, как в предыдущем примере (поклонники оптимизации заметят, что избегаются лишние проверки внутри процедуры).

DEFINITION Buttons;
 
   TYPE
      Handler = PROCEDURE (obj, sourceObj: ANYPTR; VAR msg: ANYREC);
      ClickMsg = RECORD ... END;
 
   PROCEDURE New (IN caption: ARRAY OF CHAR; handler: Handler; obj: ANYPTR): Views.View;
 
END Buttons.
 
DEFINITION Players;
 
   TYPE
      Player = POINTER TO ABSTRACT RECORD
         (p: Player) Play ( ... ), NEW, ABSTRACT;
         (p: Player) Stop ( ... ), NEW, ABSTRACT
      END;
 
   PROCEDURE New (...): Player;
 
END Players.

MODULE Desks;
 
   IMPORT Views, Buttons, Players;
 
   TYPE
      Desk = POINTER TO RECORD (Views.View)
         playButton, stopButton: Views.View;
         player: Players.Player
      END;
 
   PROCEDURE Handler (d, sourceObj: ANYPTR; VAR msg: ANYREC);
   BEGIN
      WITH d: Desk DO
         IF msg IS Buttons.ClickMsg THEN
            IF sourceObj = d.playButton THEN
               d.player.Play(...)
            ELSIF sourceObj = d.stopButton THEN
               d.player.Stop(...)
            END
         END
      END
   END Handler;
 
   PROCEDURE New* (...): Views.View;
      VAR d: Desk;
   BEGIN
      NEW(d); d.player := Players.New(...);
      d.playButton := Buttons.New("Play", Handler, d);
      d.stopButton := Buttons.New("Stop", Handler, d);
   END New;
 
END Desks.