unit WIN32_events;

{$ASSERTIONS ON}
{$MODE OBJFPC}

interface
uses Windows, type_fixes;

type
  // TODO HWND_BROADCAST 

  TMessageEvent = procedure(var aMsg : TMsg; var aBHandled : Boolean) of object;
  //TWindowHook = function(var Message : TMessage) : Boolean of object;
  TMsg = Windows.TMsg; // HWND, message, wparam, lparam, time, pt (point)
  TMessageEventP = ^TMessageEvent;

  // 
  TMessageMapEntry = record // message ID
    ID : Word;
    Callback : TMessageEventP; // so that it can be changed on a whim without having to walk here... TMessageEvent;
    // TODO: user data?
  end;
  TMessageMap = object
    Entries : array of TMessageMapEntry;
    WritePosition : TCardinal;

    constructor Init(aSize : TCardinal);
    destructor Done;
    procedure Add(aID : Word; aCallback : TMessageEventP);
    function Get(aID : Word) : TMessageEventP;
  end;
  TMessageMapP = ^TMessageMap;

  // Painted, Destroyed, ...?
  // OnPaint : TMessageEvent ...
  // OnDestroy : TMessageEvent ...
  // oder: procedure Paint(var aMsg : TMsg; var aBHandled : Boolean); message WM_PAINT;

implementation
uses sysutils;

constructor TMessageMap.Init(aSize : TCardinal);
begin
  SetLength(Entries, aSize);
  WritePosition := 0;
end;

destructor TMessageMap.Done;
begin
  SetLength(Entries, 0);
  WritePosition := 0;
end;


procedure TMessageMap.Add(aID : Word; aCallback : TMessageEventP);
var
  vCurrentLength : TCardinal;
begin
  assert(aCallback <> nil);
  vCurrentLength := TCardinal(Length(Entries));
  if WritePosition <= vCurrentLength then begin
    SetLength(Entries, (vCurrentLength + 4));
    vCurrentLength := TCardinal(Length(Entries));
  end;

  assert(vCurrentLength > WritePosition);
  with Entries[WritePosition] do begin
    ID := aID;
    Callback := aCallback;
    assert(aCallback <> nil);
  end;
  Inc(WritePosition);
end;

function TMessageMap.Get(aID : Word) : TMessageEventP;
var
  vIndex : TCardinal;
begin
  Result := nil;
  if WritePosition > 0 then
    for vIndex := 0 to WritePosition - 1 do
      with Entries[vIndex] do
        if ID = aID then begin
          Result := Callback;
          Break;
        end;
end;

end.