* Somewhat working mouse support (left button + moves), only to be used with FV

* An attempt to optimize forced screen updates in video mode, because they really blow, and Free Vision forces a whole screen update on every window move
* Probably other stuff i already forgot

git-svn-id: trunk@12799 -

rtl/morphos/keyboard.pp

@@ -14,13 +14,6 @@
  **********************************************************************}
 unit Keyboard;
 interface
-{$ifdef DEBUG}
-//uses
-//  windows;
-
-//var
-//  last_ir : Input_Record;
-{$endif DEBUG}
 
 {$i keybrdh.inc}
 
@@ -32,20 +25,17 @@ implementation
            from Win9x.
 }
 
-//uses
+
-{ifndef DEBUG}
-//   Windows,
-{endif DEBUG}
-//   Dos,
-//   WinEvent;
 uses
-   video,
+   video, exec,intuition, inputevent, mouse;
-   exec,intuition, inputevent;
 
 {$i keyboard.inc}
 
 var
    lastShiftState : byte;               {set by handler for PollShiftStateEvent}
+   oldmousex : longint;
+   oldmousey : longint;
+   oldbuttons: word;
 
 
 {*
@@ -66,7 +56,6 @@ var
    HasAltGr  : Boolean = false;
 
 
-
 procedure incqueueindex(var l : longint);
 
   begin
@@ -279,6 +268,8 @@ procedure SysInitKeyboard;
 begin
 //  writeln('sysinitkeyboard');
   lastShiftState:=0;
+  oldmousex:=-1;
+  oldmousey:=-1;
 {*
    KeyBoardLayout:=GetKeyboardLayout(0);
    lastShiftState := 0;
@@ -790,6 +781,12 @@ begin
 end;
 *}
 
+function hasMouseEvent(var x: integer; var y: integer; var btn: integer): boolean;
+begin
+//  if 
+end;
+
+
 
 //#define IsMsgPortEmpty(x)  (((x)->mp_MsgList.lh_TailPred) == (struct Node *)(&(x)->mp_MsgList))
 
@@ -890,19 +887,27 @@ function SysPollKeyEvent: TKeyEvent;
 //var t   : TKeyEventRecord;
 //    k   : TKeyEvent;
 var
+  mouseevent : boolean;
   iMsg : PIntuiMessage;
   KeyCode: longint;
   tmpFCode: word;
   tmpIdx  : longint;
+  mousex  : longint;
+  mousey  : longint;
+  me      : TMouseEvent;
 begin
   KeyCode:=0;
   SysPollKeyEvent:=0;
+  FillChar(me,sizeof(TMouseEvent),0); 
 
   if KeyQueue<>0 then begin
     SysPollKeyEvent:=KeyQueue;
     exit;
   end;
 
+  repeat
+    mouseevent:=false;    
+
     if videoWindow<>nil then begin
       if IsMsgPortEmpty(videoWindow^.UserPort) then exit;
     end;
@@ -920,6 +925,45 @@ begin
         IDCMP_CHANGEWINDOW: begin
             GotResizeWindow;
           end;
+        IDCMP_MOUSEBUTTONS: begin
+            mouseevent:=true;
+            me.x:=(iMsg^.MouseX - videoWindow^.BorderLeft) div 8;
+            me.y:=(iMsg^.MouseY - videoWindow^.BorderTop) div 16;
+            case iMsg^.code of
+              SELECTDOWN: begin
+                  writeln('left button down!');
+                  me.Action:=MouseActionDown;
+                  me.Buttons:=MouseLeftButton;
+                  oldbuttons:=MouseLeftButton;
+                  PutMouseEvent(me);
+                end;
+              SELECTUP: begin
+                  writeln('left button up!');
+                  me.Action:=MouseActionUp;
+                  me.Buttons:=0;
+                  oldbuttons:=0;
+                  PutMouseEvent(me);
+                end;
+            end;
+          end;
+        IDCMP_MOUSEMOVE: begin
+            mouseevent:=true;
+            mousex:=(iMsg^.MouseX - videoWindow^.BorderLeft) div 8;
+            mousey:=(iMsg^.MouseY - videoWindow^.BorderTop) div 16;
+            if (mousex >= 0) and (mousey >= 0) and
+               (mousex < video.ScreenWidth) and (mousey < video.ScreenHeight) and
+               ((mousex <> oldmousex) or (mousey <> oldmousey))
+              then begin
+//              writeln('mousemove:',mousex,'/',mousey,' oldbutt:',oldbuttons);
+              me.Action:=MouseActionMove;
+              me.Buttons:=oldbuttons;
+              me.X:=mousex;
+              me.Y:=mousey;
+              oldmousex:=mousex;
+              oldmousey:=mousey;
+              PutMouseEvent(me);
+            end;
+          end;
         IDCMP_VANILLAKEY: begin
             writeln('vanilla keycode: ',iMsg^.code);
             KeyCode:=iMsg^.code;
@@ -959,7 +1003,7 @@ begin
       end;
       ReplyMsg(PMessage(iMsg));
     end;
-//  end;
+  until (not mouseevent);
  
   // XXX: huh :)
 

rtl/morphos/mouse.pp

@@ -20,121 +20,8 @@ interface
 
 implementation
 
-//uses
-//   windows,dos,Winevent;
-
 {$i mouse.inc}
 
-//var
-//   ChangeMouseEvents : TCriticalSection;
-//   LastHandlerMouseEvent : TMouseEvent;
-
-{
-procedure MouseEventHandler(var ir:INPUT_RECORD);
-  var
-     e : TMouseEvent;
-
-  begin
-    EnterCriticalSection(ChangeMouseEvents);
-    e.x:=ir.Event.MouseEvent.dwMousePosition.x;
-    e.y:=ir.Event.MouseEvent.dwMousePosition.y;
-    e.buttons:=0;
-    e.action:=0;
-    if (ir.Event.MouseEvent.dwButtonState and FROM_LEFT_1ST_BUTTON_PRESSED<>0) then
-      e.buttons:=e.buttons or MouseLeftButton;
-    if (ir.Event.MouseEvent.dwButtonState and FROM_LEFT_2ND_BUTTON_PRESSED<>0) then
-      e.buttons:=e.buttons or MouseMiddleButton;
-    if (ir.Event.MouseEvent.dwButtonState and RIGHTMOST_BUTTON_PRESSED<>0) then
-      e.buttons:=e.buttons or MouseRightButton;
-
-    if (Lasthandlermouseevent.x<>e.x) or (LasthandlerMouseEvent.y<>e.y) then
-      e.Action:=MouseActionMove;
-    if (LastHandlerMouseEvent.Buttons<>e.Buttons) then
-     begin
-      if (LasthandlerMouseEvent.Buttons and e.buttons<>LasthandlerMouseEvent.Buttons) then
-        e.Action:=MouseActionUp
-      else
-        e.Action:=MouseActionDown;
-     end;
-
-
-//
-//  The mouse event compression here was flawed and could lead
-//  to "zero" mouse actions if the new (x,y) was the same as the
-//  previous one. (bug 2312)
-//
-
-     { can we compress the events? }
-   if (PendingMouseEvents>0) and
-      (e.buttons=PendingMouseTail^.buttons) and
-      (e.action=PendingMouseTail^.action) then
-      begin
-         PendingMouseTail^.x:=e.x;
-         PendingMouseTail^.y:=e.y;
-      end
-    else
-      begin
-         if e.action<>0 then
-           begin
-             LastHandlermouseEvent:=e;
-
-             { what till there is again space in the mouse event queue }
-             while PendingMouseEvents>=MouseEventBufSize do
-               begin
-                 LeaveCriticalSection(ChangeMouseEvents);
-                 sleep(0);
-                 EnterCriticalSection(ChangeMouseEvents);
-               end;
-
-             PutMouseEvent(e);
-           end;
-         // this should be done in PutMouseEvent, now it is PM
-         // inc(PendingMouseEvents);
-      end;
-    LastMouseEvent:=e;
-    LeaveCriticalSection(ChangeMouseEvents);
-  end;
-}
-procedure SysInitMouse;
-
-var
-   mode : dword;
-
-begin
-{
-  // enable mouse events
-  GetConsoleMode(StdInputHandle,@mode);
-  mode:=mode or ENABLE_MOUSE_INPUT;
-  SetConsoleMode(StdInputHandle,mode);
-
-  PendingMouseHead:=@PendingMouseEvent;
-  PendingMouseTail:=@PendingMouseEvent;
-  PendingMouseEvents:=0;
-  FillChar(LastMouseEvent,sizeof(TMouseEvent),0);
-  InitializeCriticalSection(ChangeMouseEvents);
-  SetMouseEventHandler(@MouseEventHandler);
-  ShowMouse;
-}
-end;
-
-
-procedure SysDoneMouse;
-var
-   mode : dword;
-begin
-{
-  HideMouse;
-  // disable mouse events
-  GetConsoleMode(StdInputHandle,@mode);
-  mode:=mode and (not ENABLE_MOUSE_INPUT);
-  SetConsoleMode(StdInputHandle,mode);
-
-  SetMouseEventHandler(nil);
-  DeleteCriticalSection(ChangeMouseEvents);
-}
-end;
-
-
 function SysDetectMouse:byte;
 var
   num : dword;
@@ -145,129 +32,28 @@ begin
 end;
 
 
-procedure SysGetMouseEvent(var MouseEvent: TMouseEvent);
-
-var
-   b : byte;
-
-begin
-{
-  repeat
-    EnterCriticalSection(ChangeMouseEvents);
-    b:=PendingMouseEvents;
-    LeaveCriticalSection(ChangeMouseEvents);
-    if b>0 then
-      break
-    else
-      sleep(50);
-  until false;
-  EnterCriticalSection(ChangeMouseEvents);
-  MouseEvent:=PendingMouseHead^;
-  inc(PendingMouseHead);
-  if ptrint(PendingMouseHead)=ptrint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
-   PendingMouseHead:=@PendingMouseEvent;
-  dec(PendingMouseEvents);
-
-  { LastMouseEvent is already set at the end of the mouse event handler,
-    so this code might compare LastMouseEvent with itself leading to
-    "empty" events (FK)
-
-  if (LastMouseEvent.x<>MouseEvent.x) or (LastMouseEvent.y<>MouseEvent.y) then
-   MouseEvent.Action:=MouseActionMove;
-  if (LastMouseEvent.Buttons<>MouseEvent.Buttons) then
-   begin
-     if (LastMouseEvent.Buttons and MouseEvent.buttons<>LastMouseEvent.Buttons) then
-       MouseEvent.Action:=MouseActionUp
-     else
-       MouseEvent.Action:=MouseActionDown;
-   end;
-  if MouseEvent.action=0 then
-    MousEevent.action:=MouseActionMove; // can sometimes happen due to compression of events.
-  LastMouseEvent:=MouseEvent;
-  }
-
-  LeaveCriticalSection(ChangeMouseEvents);
-}
-end;
 
 
-function SysPollMouseEvent(var MouseEvent: TMouseEvent):boolean;
-begin
-{
-  EnterCriticalSection(ChangeMouseEvents);
-  if PendingMouseEvents>0 then
-   begin
-     MouseEvent:=PendingMouseHead^;
-     SysPollMouseEvent:=true;
-   end
-  else
-   SysPollMouseEvent:=false;
-  LeaveCriticalSection(ChangeMouseEvents);
-}
-end;
 
 
-procedure SysPutMouseEvent(const MouseEvent: TMouseEvent);
-begin
-{
-  if PendingMouseEvents<MouseEventBufSize then
-   begin
-     PendingMouseTail^:=MouseEvent;
-     inc(PendingMouseTail);
-     if ptrint(PendingMouseTail)=ptrint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
-      PendingMouseTail:=@PendingMouseEvent;
-      { why isn't this done here ?
-        so the win32 version do this by hand:}
-       inc(PendingMouseEvents);
-   end;
-}
-end;
 
 
-function SysGetMouseX:word;
-begin
-{
-  EnterCriticalSection(ChangeMouseEvents);
-  SysGetMouseX:=LastMouseEvent.x;
-  LeaveCriticalSection(ChangeMouseEvents);
-}
-end;
-
-
-function SysGetMouseY:word;
-begin
-{
-  EnterCriticalSection(ChangeMouseEvents);
-  SysGetMouseY:=LastMouseEvent.y;
-  LeaveCriticalSection(ChangeMouseEvents);
-}
-end;
-
-
-function SysGetMouseButtons:word;
-begin
-{
-  EnterCriticalSection(ChangeMouseEvents);
-  SysGetMouseButtons:=LastMouseEvent.Buttons;
-  LeaveCriticalSection(ChangeMouseEvents);
-}
-end;
 
 const
   SysMouseDriver : TMouseDriver = (
-    UseDefaultQueue : False;
+    UseDefaultQueue : True;
-    InitDriver      : @SysInitMouse;
+    InitDriver      : Nil;
-    DoneDriver      : @SysDoneMouse;
+    DoneDriver      : Nil;
     DetectMouse     : @SysDetectMouse;
     ShowMouse       : Nil;
     HideMouse       : Nil;
-    GetMouseX       : @SysGetMouseX;
+    GetMouseX       : Nil;
-    GetMouseY       : @SysGetMouseY;
+    GetMouseY       : Nil;
-    GetMouseButtons : @SysGetMouseButtons;
+    GetMouseButtons : Nil;
     SetMouseXY      : Nil;
-    GetMouseEvent   : @SysGetMouseEvent;
+    GetMouseEvent   : Nil;
-    PollMouseEvent  : @SysPollMouseEvent;
+    PollMouseEvent  : Nil;
-    PutMouseEvent   : @SysPutMouseEvent;
+    PutMouseEvent   : Nil;
   );
 
 begin

rtl/morphos/video.pp

@@ -76,12 +76,12 @@ begin
       WA_InnerHeight,25*16,
       WA_MaxWidth,32768,
       WA_MaxHeight,32768,
-//      WA_IDCMP,IDCMP_MOUSEBUTTONS Or IDCMP_RAWKEYS,
       WA_IDCMP,IDCMP_VANILLAKEY Or IDCMP_RAWKEY Or
+               IDCMP_MOUSEMOVE Or IDCMP_MOUSEBUTTONS Or
                IDCMP_CLOSEWINDOW Or IDCMP_CHANGEWINDOW,
       WA_Title,DWord(PChar('Free Pascal Video Output')),
       WA_Flags,(WFLG_GIMMEZEROZERO Or WFLG_SMART_REFRESH Or WFLG_NOCAREREFRESH Or
-                WFLG_ACTIVATE Or WFLG_DRAGBAR Or WFLG_DEPTHGADGET Or
+                WFLG_ACTIVATE Or WFLG_DRAGBAR Or WFLG_DEPTHGADGET Or WFLG_REPORTMOUSE Or
                 WFLG_SIZEGADGET Or WFLG_SIZEBBOTTOM Or
                 WFLG_CLOSEGADGET)
    ]);
@@ -137,9 +137,13 @@ begin
   SysSetVideoMode:=true;
 end;
 
+var
+  oldSH, oldSW : longint;
 
 procedure SysClearScreen;
 begin
+  oldSH := -1;
+  oldSW := -1;
   UpdateScreen(true);
 end;
 
@@ -189,12 +193,23 @@ begin
   smallforce:=false;
   cursormoved:=false;
 
-  if force then
+  // override forced update when screen dimensions haven't changed
-    smallforce:=true
+  if force then begin
+    if (oldSH = ScreenHeight) and
+       (oldSW = ScreenWidth) then
+      force:=false
     else begin
+      oldSH := ScreenHeight;
+      oldSW := ScreenWidth;
+    end;
+  end;
+
+  if force then begin
+    smallforce:=true;
+  end else begin
     counter:=0;
     while not smallforce and (counter<(VideoBufSize div 4)-1) do begin
-      if PDWord(VideoBuf)[counter]<>PDWord(OldVideoBuf)[counter] then smallforce:=true;
+      smallforce:=(PDWord(VideoBuf)[counter] <> PDWord(OldVideoBuf)[counter]);
       inc(counter);
     end;
   end;