paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 08:28:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
* 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 -
This commit is contained in:
Károly Balogh 2009-02-26 00:46:27 +00:00
parent 5738d9ab55
commit c9308d4299
3 changed files with 96 additions and 251 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
rtl/morphos/keyboard.pp
View File

@ -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,
exec,intuition, inputevent;
video, exec,intuition, inputevent, mouse;
{$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,23 +887,31 @@ 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;
if videoWindow<>nil then begin
if IsMsgPortEmpty(videoWindow^.UserPort) then exit;
end;
repeat
mouseevent:=false;
if videoWindow<>nil then begin
if IsMsgPortEmpty(videoWindow^.UserPort) then exit;
end;
PMessage(iMsg):=GetMsg(videoWindow^.UserPort);
if (iMsg<>nil) then begin
@ -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,8 +1003,8 @@ begin
end;
ReplyMsg(PMessage(iMsg));
end;
// end;
until (not mouseevent);
// XXX: huh :)
if KeyCode>=0 then begin

232
rtl/morphos/mouse.pp
View File

@ -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;
InitDriver : @SysInitMouse;
DoneDriver : @SysDoneMouse;
UseDefaultQueue : True;
InitDriver : Nil;
DoneDriver : Nil;
DetectMouse : @SysDetectMouse;
ShowMouse : Nil;
HideMouse : Nil;
GetMouseX : @SysGetMouseX;
GetMouseY : @SysGetMouseY;
GetMouseButtons : @SysGetMouseButtons;
GetMouseX : Nil;
GetMouseY : Nil;
GetMouseButtons : Nil;
SetMouseXY : Nil;
GetMouseEvent : @SysGetMouseEvent;
PollMouseEvent : @SysPollMouseEvent;
PutMouseEvent : @SysPutMouseEvent;
GetMouseEvent : Nil;
PollMouseEvent : Nil;
PutMouseEvent : Nil;
);
begin

27
rtl/morphos/video.pp
View File

@ -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
smallforce:=true
else begin
// override forced update when screen dimensions haven't changed
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;