Message API goes beta, Smart Mobile Studio

Clockwork API

A lightweight version of the QTX message framework has been included in the upcoming hotfix beta for Smart Mobile Studio.

The message API has been previously described here and here. The API itself consolidates older, Win32 type programming with the fully Object Oriented architecture of Smart Mobile Studio

Importance of messages

JavaScript is single threaded event based. This means that dispersing tasks and steps in a process is important. Messages, similar to WinAPI messages, is ideal for the JavaScript environment and processing model.

Messages are especially practical for database bindings and informing visual controls regarding changes in a data-set.

Working with messages

Messages under Smart Mobile Studio are classes, rather than structures (records) like under Delphi or FreePascal. When creating special purpose messages you inherit from TCustomMessage (or TWindowsMessage if you want to target message subscribers by handle).

Receiving messages are done through a message subscription class. You create an instance of such a class, then register the class-types you wish to subscribe to. When such a message enters the message-stack, it is dispatched to all subscribers.

  var
  FHandler: TMessageSubscriber;

  FHandler.OnMessage:=Procedure (const Sender:TMessageSubscriber;const Message:TCustomMessage)
  Begin
    writeln("MESSAGE RECIEVED!");
    message.done;
  end;

  var msg:TMyMessage:=TMyMessage.Create;
  msg.Text:="This is cool stuff!";

  postmessage(msg);

Win32 Emulation

When porting code from Delphi or Lazarus to HTML5, it can be tricky to emulate or refactor code which relies on messages. As such we have included an emulation layer especially for this.

Messages which inherit from TWindowsMessage are treated differently. Each message-subscriber exposed a THandle which simulates a HWND handle in Windows. When using TWindowsMessage you can use sendMessage() to target a message-subscriber via it’s handle.

We also added a shorthand constructor exactly for this type of conversion:

  var
  FHandler: TMessageSubscriber;

  type
  TWMPaint = Class(TWindowsMessage);

  //Using the shorthand constructor to
  //simplify winAPI emulation
  SendMesage(TWmPaint.Create(WM_PAINT,0,0));

Message stack

Below is the final draft for the message-stack. It is roughly 40% of the original IPC found in the QTX library.

unit system.messages;

interface

uses
  System.types,
  system.typecon,
  system.memory,
  system.streams,
  SmartCL.System;

  (*  Message API
      ===========
      Both Delphi and Lazarus/FPC provides message stack wrappers around
      the Windows API. FPC also emulates the windows message stack when
      running under Linux and OS X (or indeed any OS which is not Windows).

      Messages are very helpful and leverages many programming tasks
      which would otherwise be extremely hard to accomplish.

      Smart Mobile Studio deals with messages quite differently from both
      Delphi and Lazarus in that our messages are object instances rather
      than records. This provides a much richer means of passing information
      between instances, because the information does not need to fit
      into a 8 byte storage space.

      I have included a special message-type which will help aid the
      conversion of WinAPI software to HTML5: namely TWindowsMessage.
      This class contains the fields ordinary TMessage records contain
      under Delphi and Lazarus.

      Another difference is that Postmessage() is not handle-based. A handle
      under WinAPI requires a window-handle, which naturally HTML5 doesnt
      provide. As such, Message Subscribers create a custom handle on
      creation - which can be targeted exactly like a HWND handle under
      WinAPI. To use this functionality messages must be dispatched with
      SendMessage().

      In short:
        - PostMessage() does not support targeting handles
        - SendMessage() requires target handle
        - Handles are created for each message subscriber
        - Messages are dispatched to all subscribers who have the class-type
          registered (i.e they subscribe to that message class)
        - When a message's "done" method is called, it stops the message
          from being further dispatched (read: message consumed).

      MISC
      ====

      The priority interval for processing messages is set by the constant
      CNT_MSG_DELAY by default. You can override this in an application by
      calling SetMessageHandlingPriority() to set another millisecond delay
      between message dispatching. The default value is 33ms.
  *)

  const
  CNT_MSG_DELAY = 33;

  type

  TCustomMessage      = class;
  TMessageSubscriber  = Class;
  TMessageClass       = Class of TCustomMessage;


  (* TCustomMessage is the base message-type. You inherit your own
     message types from this class.
     To catch a message you must subscribe to it by creating a message
     subscription class, and then register the class there, as such:

      FSubScription:=TMessageSubscriber.Create;
      FSubScription.SubScribeTo([MessageClass1,MessageClass2]);
      FSubScription.Onmessage := procedure (Sender:TMessageSubscriber
                    Message:TCustomMessage);
        begin
          try
            // React to message
          finally
            /* By calling done the message will not be
               dispatched to more subscribers */
            message.done;
          end;
        end;
  *)

  TCustomMessage  = Class(TObject)
  private
    FDone:      Boolean;
  public
    Property    MessageDone:Boolean read FDone;
    procedure   Done;
  end;

  (* Windows Emulation message:
     This message-type is defined to provide an easier emulation
     path when porting WinAPI applications from Delphi or Lazarus.
     The Constructor allows you to compose "quick" messages

      For example:
      postmessage(handle, TWindowsMessage.Create($1200,L,W) );

     *)
  TWindowsMessage = Class(TCustomMessage)
  private
    FLParam:  Integer;
    FWParam:  Integer;
    FId:      Integer;
  public
    Property    Id:Integer;
    Property    LParam:Integer;
    Property    WParam:Integer;
    Constructor Create(Id,LParam,WParam:Integer);virtual;
  end;

  IMessageSubscriber = Interface
    function  QuerySubscription(const clsid:TMessageClass):Boolean;
    procedure Dispatchmessage(const msg:TCustomMessage);
  end;

  TMessageHandlerEvent = procedure (const Sender:TMessageSubscriber;
                         const Message:TCustomMessage);

  TMessageSubscriber = Class(TObject,IMessageSubscriber)
  private
    FHandle:      THandle;
    FItems:       Array of TMessageClass;
    FEnabled:     Boolean;
    FOnMessage:   TMessageHandlerEvent;
  protected
    function      QuerySubscription(const clsid:TMessageClass):Boolean;virtual;
    procedure     DispatchMessage(const msg:TCustomMessage);virtual;
  published
    Property      Handle:THandle read FHandle;
    Property      OnMessage:TMessageHandlerEvent
                  read FOnMessage write FOnMessage;

    (* Subscribe to messages *)
    procedure     SubscribeTo(const clsid:TMessageClass);overload;
    procedure     SubScribeTo(const MsgClasses:Array of TMessageClass);overload;

    (* Un-subscribe from message classes *)
    procedure     UnSubscribeFrom(const clsid:TMessageClass);overload;
    procedure     UnSubscribeFrom(const MsgClasses:Array of TMessageClass);overload;

    (* To enable/disable message dispatching on this subscriber *)
    Procedure     Disable;
    Procedure     Enable;

    Constructor   Create;virtual;
    Destructor    Destroy;Override;
  end;


  procedure PostMessage(const Msg:TCustomMessage);

  procedure SendMessage(const Handle:THandle;
            const Msg:TWindowsMessage);

  Procedure SetMessageHandlingPriority(const Value:Integer);

implementation

var
_subscribers: Array of TMessageSubscriber;
_tableid: Integer = 210973;
_updateFreq:Integer = CNT_MSG_DELAY;

_MsgStack:  Array of TCustomMessage;

function getNewID:THandle;
begin
  inc(_tableid);
  result:=TVariant.CreateObject;
  result["id"] := _tableid;
end;

Procedure SetMessageHandlingPriority(const Value:Integer);
begin
  _updateFreq:=Value;
end;

procedure PostMessage(const msg:TCustomMessage);
begin
  if msg<>NIL then
  begin
    if _MsgStack.IndexOf(msg)<0 then
    _MsgStack.Push(msg);
  end;
end;

procedure SendMessage(const Handle:THandle;
          const Msg:TWindowsMessage);
var
  mSub: TMessageSubscriber;
begin
  for mSub in _subscribers do
  begin
    if mSub.Handle["id"] = Handle["id"] then
    begin
      (mSub as IMessageSubscriber).DispatchMessage(msg);
      msg.free;
      break;
    end;
  end;
end;

Procedure RegisterSubscriber(Const Instance:TMessageSubscriber);
Begin
  if _SubScribers.IndexOf(Instance)<0 then
  _subscribers.add(Instance);
end;

procedure UnRegisterSubscriber(const Instance:TMessageSubscriber);
var
  mIndex: Integer;
Begin
  mIndex:=_SubScribers.IndexOf(Instance);
  if mIndex>=0 then
  _subscribers.Delete(mIndex);
end;

//############################################################################
// TWindowsMessage
//############################################################################

Constructor TWindowsMessage.Create(Id,LParam,WParam:Integer);
begin
  inherited Create;
  self.id:=Id;
  self.LParam:=LParam;
  self.WParam:=WParam;
end;

//############################################################################
// TCustomMessage
//############################################################################

procedure TCustomMessage.Done;
begin
  FDone:=true;
end;

//############################################################################
// TMessageSubscriber
//############################################################################

Constructor TMessageSubscriber.Create;
begin
  inherited Create;
  FEnabled:=True;

  RegisterSubscriber(self);
  FHandle:=getNewID;
end;

Destructor TMessageSubscriber.Destroy;
begin
  UnRegisterSubscriber(self);
  inherited;
end;

Procedure TMessageSubscriber.Disable;
begin
  FEnabled:=False;
end;

Procedure TMessageSubscriber.Enable;
begin
  FEnabled:=True;
end;

procedure TMessageSubscriber.SubScribeTo(const MsgClasses:Array of TMessageClass);
var
  mClass: TMessageClass;
begin
  for mClass in MsgClasses do
  SubScribeTo(mClass);
end;

procedure TMessageSubscriber.SubScribeTo(const clsid:TMessageClass);
begin
  if clsID<>NIL then
  begin
    if FItems.IndexOf(clsid)<0 then
    FItems.add(clsid);
  end;
end;

procedure TMessageSubscriber.UnSubscribeFrom
          (const MsgClasses:Array of TMessageClass);
var
  mClass: TMessageClass;
begin
  for mClass in MsgClasses do
  UnSubscribeFrom(mClass);
end;

procedure TMessageSubscriber.UnSubscribeFrom(const clsid:TMessageClass);
begin
  if clsid<>NIL then
  begin
    var mId:=Fitems.IndexOf(clsid);
    if mId>=0 then
    FItems.delete(mid,1);
  end;
end;

function TMessageSubscriber.QuerySubscription
          (const clsid:TMessageClass):Boolean;
var
  x:  integer;
begin
  if FEnabled then
  begin
    for x:=0 to FItems.Count-1 do
    begin
      result:=(FItems[x] = clsid);
      if result then
      break;
    end;
  end;
end;

procedure TMessageSubscriber.DispatchMessage
          (const msg:TCustomMessage);
begin
  if msg<>NIL then
  begin
    if not msg.MessageDone then
    begin
      if QuerySubscription(TMessageClass(msg.ClassType)) then
      Begin

        if assigned(FOnMessage) then
        begin
          try
            FOnMessage(self,msg);
          except
            on e: exception do;
          end;
        end;
        msg.Done;
      end;
    end;
  end;
end;

procedure ProcessMessages;
var
  Msg: TCustomMessage;
  x:  Integer;
begin
  if _MsgStack.Count>0 then
  begin
    Msg:=_MsgStack.Pop;
    for x:=0 to _subscribers.count-1 do
    begin
      if (_subScribers[x] as IMessageSubscriber)
         .QuerySubscription(TMessageClass(msg.classType)) then
      Begin
        (_subScribers[x] as IMessageSubscriber).DispatchMessage(msg);
        if msg.MessageDone then
        Begin
          msg.free;
          break;
        end;
      end;
    end;
  end;
  w3_setTimeOut(ProcessMessages,_updateFreq);
end;


Initialization
begin
  ProcessMessages;
end;


end.