unit events;

{$M+}

interface
uses classes;

{ TODO multiple keyboards, other input devices (mouse!) }

type
  TButtonAction = (baNone, baPress, baDoubleClick, baTripleClick, {baHold, }baRelease);
  TKeyboard = Cardinal; // ??
  TMouse = Cardinal; // ??
  TButton = 0..10; // > 0 for valid buttons, =0 for the no-button :)
  TKey = Cardinal; // scan code // FIXME.
  
  TEvent = class
  end;

  TKeyModifier = (kmLeftShift, kmRightShift, kmControl, kmAlt);
  TKeyEvent = class(TEvent)
  public
    Keyboard : TKeyboard;
    Key : TKey;
    Character : Char; // #0 : none; TODO nuke this field?
    
    // extra state: 
    //PressedKeys : TList; // set of TKey; or at least the modifiers?
    Modifiers : set of TKeyModifier;
  end;
  
  TMouseButtonSet = set of TButton;
  
  TMouseEvent = class(TEvent)
  public
    Mouse : TMouse;
    AxisCount : Cardinal;
    Position : array[1..{AxisCount}10] of Cardinal; // 0-based.
    Action : TButtonAction;
    Button : TButton; // if any, otherwise 0.
    
    // extra state:
    PressedButtons : TMouseButtonSet;
  end;
  
  TIdleEvent = class(TEvent)
  end;
  
  TEventHappened = procedure(Sender : TObject; aEvent : TEvent) of object;
  
  IMessageLoop = interface
    function GetFallback : TEventHappened;
    procedure SetFallback(aFallback : TEventHappened);
    property Fallback : TEventHappened read GetFallback write SetFallback;
    procedure Run;
  end;

  TMessageLoop = class(TInterfacedObject, IMessageLoop, IInterface)
  private
    fFallback : TEventHappened;
    fKeyEvent : TKeyEvent;
    fMouseEvent : TMouseEvent;
    fIdleEvent : TIdleEvent;
  protected
    function GetFallback : TEventHappened;
    procedure SetFallback(aFallback : TEventHappened);
    procedure Run;
  public
    destructor Destroy; override;
  published
    constructor Create;
    property Fallback : TEventHappened read GetFallback write SetFallback;
  end;
  
implementation
uses sysutils, debug
{$IFNDEF UNIT_TEST}
, keyboard { TODO use the new "terminals".RegisterInputHandler, once it actually works },
  mouse
{$ENDIF}
{$IFDEF WIN32}
, windows
, winevent
{$ENDIF}
;

{$IFDEF WIN32}
var
  fMouseKey : INPUT_RECORD;
  fPreviousMouseEventHandler : TEventProcedure;

procedure HandleWIN32MouseEvent(var aRecord : INPUT_RECORD);
begin
  fPreviousMouseEventHandler(aRecord);
  //EnterCriticalSection(ChangeMouseEvents);
  //fFallback(Self, fMouseEvent);
  //LeaveCriticalSection(ChangeMouseEvents);
  // PutMouseEvent
  fMouseKey.Event.KeyEvent.bKeyDown := True;
  GetKeyboardEventHandler()(fMouseKey);
  fMouseKey.Event.KeyEvent.bKeyDown := False;
  GetKeyboardEventHandler()(fMouseKey);
end;
{$ENDIF}

constructor TMessageLoop.Create;
begin
  InitKeyboard;
  InitMouse;
  // mouseButtonCount := DetectMouse;
  // PatchKeyboard;
  fKeyEvent := TKeyEvent.Create;
  fIdleEvent := TIdleEvent.Create;
  fMouseEvent := TMouseEvent.Create;
  
{$IFDEF WIN32}
  // install a mouse event handler that will also insert a keyboard event when a mouse event happens.
  
  fPreviousMouseEventHandler := GetMouseEventHandler();
  SetMouseEventHandler(@HandleWIN32MouseEvent);
{$ENDIF}
end;

destructor TMessageLoop.Destroy;
begin
{$IFDEF WIN32}
  SetMouseEventHandler(nil);
{$ENDIF}
  FreeAndNil(fMouseEvent);
  FreeAndNil(fIdleEvent);
  FreeAndNil(fKeyEvent);
  DoneMouse;
  DoneKeyboard; // this is the line that restores sane terminal newline settings.
  inherited;
end;

function TMessageLoop.GetFallback : TEventHappened;
begin
  Result := fFallback;
end;

procedure TMessageLoop.SetFallback(aFallback : TEventHappened);
begin
  fFallback := aFallback;
end;

procedure TranslateMouseEvent(aLowEvent : mouse.TMouseEvent; var outEvent : TMouseEvent; const previouslyPressedButtons : TMouseButtonSet);
var
  deltaButtons : TMouseButtonSet;
  button : TButton;
begin
  Dump(Format('TranslateMouseEvent(event = (buttons: %d, X: %d, Y: %d, action: %d))', [aLowEvent.buttons, aLowEvent.X, aLowEvent.Y, Integer(aLowEvent.action)]));
  outEvent.PressedButtons := [];
  if (aLowEvent.buttons and MouseLeftButton) <> 0 then
    Include(outEvent.PressedButtons, 1);
    
  if (aLowEvent.buttons and MouseRightButton) <> 0 then
    Include(outEvent.PressedButtons, 2);
    
  if (aLowEvent.buttons and MouseMiddleButton) <> 0 then
    Include(outEvent.PressedButtons, 3);
    
{$IFNDEF WIN32}
{$IFDEF MORE_BUTTONS}
  if (aLowEvent.buttons and MouseButton4) <> 0 then
    Include(outEvent.PressedButtons, 4);
    
  if (aLowevent.buttons and MouseButton5) <> 0 then
    Include(outEvent.PressedButtons, 5);
{$ENDIF}
{$ENDIF}
    
  outEvent.AxisCount := 2;
  outEvent.Position[1] := aLowEvent.x;
  outEvent.Position[2] := aLowEvent.y;
  outEvent.Action := baNone;
  
  if aLowEvent.action = MouseActionDown then
    outEvent.Action := baPress
  else if aLowEvent.action = MouseActionUp then
    outEvent.Action := baRelease
  else if aLowEvent.action = MouseActionMove then
    outEvent.Action := baNone;

  outEvent.Button := 1;
  
  // infer which button the action is for.
  
  if outEvent.Action in [baPress, baNone] then 
    deltaButtons := outEvent.PressedButtons - previouslyPressedButtons
  else if outEvent.Action = baRelease then
    deltaButtons := previouslyPressedButtons - outEvent.PressedButtons
  else begin 
    deltaButtons := [];
    outEvent.Button := 0; // none.
  end;
  
  for button := Low(deltaButtons) to High(deltaButtons) do 
    if button in deltaButtons then begin
      outEvent.Button := button;
      Break;
    end;
  
  //outEvent.Button := 
  //lowEvent.button
end;

procedure TMessageLoop.Run;
var
  key : keyboard.TKeyEvent;
  keyRecord : keyboard.TKeyRecord;
  recordType : Integer;
  lowMouseEvent : mouse.TMouseEvent;
  previouslyPressedButtons : TMouseButtonSet;
begin
  previouslyPressedButtons := [];

  key := 0;
  while True do begin
   //  key <> 'q' do begin
{$IFDEF UNIT_TEST}
    Exit;
{$ENDIF}

    fFallback(Self, fIdleEvent); // give it a chance before before we block.

    try
      key := GetKeyEvent();
      key := TranslateKeyEvent(key);
        
      fKeyEvent.Character := chr(0);
      keyRecord := keyboard.TKeyRecord(key);
      recordType := keyRecord.Flags and 3;

      if (recordType = 0) or (recordType = 1) then begin // ASCII, unicode. // cursor keys: 3
        fKeyEvent.Character := Chr(keyRecord.KeyCode);
      end else begin
        fKeyEvent.Character := #0;
      end;
      while PollMouseEvent(lowMouseEvent) do begin // a mouse event implies a key event in an XTerm.
        GetMouseEvent(lowMouseEvent); // remove the element from the queue.
        
        TranslateMouseEvent(lowMouseEvent, fMouseEvent, previouslyPressedButtons);
        previouslyPressedButtons := fMouseEvent.PressedButtons;
        
        fFallback(Self, fMouseEvent);
      end;
    except // EINTR
      fFallback(Self, fIdleEvent);
      Continue;
    end;
    fKeyEvent.Key := keyRecord.KeyCode; // FIXME scan code
    // Flags kbASCII, kbUniCode, kbFnKey, kbPhys, kbReleased
    // FIXME check pressed/released.

    fKeyEvent.Modifiers := [];
    //Writeln(keyRecord.ShiftState);
    if (keyRecord.ShiftState and kbLeftShift) <> 0 then
      Include(fKeyEvent.Modifiers, kmLeftShift);
    if (keyRecord.ShiftState and kbRightShift) <> 0 then
      Include(fKeyEvent.Modifiers, kmRightShift);
    if (keyRecord.ShiftState and kbAlt) <> 0 then
      Include(fKeyEvent.Modifiers, kmAlt);
    if (keyRecord.ShiftState and kbCtrl) <> 0 then
      Include(fKeyEvent.Modifiers, kmControl);
    
    //if fKeyEvent.Key = 0 then begin { magic }
    //  fKeyEvent.Key := Ord(ReadKey);
    //end;
    
    fFallback(Self, fKeyEvent);
  end;
end;

initialization
{$IFDEF WIN32}
  with fMouseKey do begin
    EventType := KEY_EVENT;
    Reserved := 0;
    with Event.KeyEvent do begin
      bKeyDown := True;
      wRepeatCount := 1;
      wVirtualKeyCode := VK_LBUTTON;
      wVirtualScanCode := 0;
      UnicodeChar := #0;
      dwControlKeyState := 0;
    end;
  end;
{$ENDIF}

end.