mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 00:39:34 +02:00
+ more work on video and keyboard units
* less debug during init * SysGetShiftState() support, reworked RawKeyCode support * support for more keys, with qualifiers. for example some clipboard operations work now in FV. git-svn-id: trunk@11973 -
This commit is contained in:
Károly Balogh
parent
b250a0e1c4
commit
07f30fbd47
@ -40,10 +40,14 @@ implementation
|
||||
// WinEvent;
|
||||
uses
|
||||
video,
|
||||
exec,intuition;
|
||||
exec,intuition, inputevent;
|
||||
|
||||
{$i keyboard.inc}
|
||||
|
||||
var
|
||||
lastShiftState : byte; {set by handler for PollShiftStateEvent}
|
||||
|
||||
|
||||
{*
|
||||
const MaxQueueSize = 120;
|
||||
FrenchKeyboard = $040C040C;
|
||||
@ -273,7 +277,8 @@ end;
|
||||
|
||||
procedure SysInitKeyboard;
|
||||
begin
|
||||
writeln('sysinitkeyboard');
|
||||
// writeln('sysinitkeyboard');
|
||||
lastShiftState:=0;
|
||||
{*
|
||||
KeyBoardLayout:=GetKeyboardLayout(0);
|
||||
lastShiftState := 0;
|
||||
@ -788,7 +793,7 @@ end;
|
||||
|
||||
//#define IsMsgPortEmpty(x) (((x)->mp_MsgList.lh_TailPred) == (struct Node *)(&(x)->mp_MsgList))
|
||||
|
||||
function IsMsgPortEmpty(port: PMsgPort): boolean;
|
||||
function IsMsgPortEmpty(port: PMsgPort): boolean; inline;
|
||||
begin
|
||||
IsMsgPortEmpty:=(port^.mp_MsgList.lh_TailPred = @(port^.mp_MsgList));
|
||||
end;
|
||||
@ -796,28 +801,107 @@ end;
|
||||
var
|
||||
KeyQueue: TKeyEvent;
|
||||
|
||||
|
||||
type
|
||||
rawCodeEntry = record
|
||||
rc,n,s,c,a : word; { raw code, normal, shift, ctrl, alt }
|
||||
end;
|
||||
|
||||
const
|
||||
RCTABLE_MAXIDX = 6;
|
||||
rawCodeTable : array[0..RCTABLE_MAXIDX] of rawCodeEntry =
|
||||
((rc: 71; n: $5200; s: $0500; c: $0400; a: $A200; ), // Insert
|
||||
(rc: 72; n: $4900; s: $4900; c: $8400; a: $9900; ), // PgUP // shift?
|
||||
(rc: 73; n: $5100; s: $5100; c: $7600; a: $A100; ), // PgDOWN // shift?
|
||||
|
||||
(rc: 76; n: $4800; s: $4800; c: $8D00; a: $9800; ), // UP // shift?
|
||||
(rc: 77; n: $5000; s: $5000; c: $9100; a: $A000; ), // DOWN // shift?
|
||||
(rc: 78; n: $4D00; s: $4D00; c: $7400; a: $9D00; ), // RIGHT // shift?
|
||||
(rc: 79; n: $4B00; s: $4B00; c: $7300; a: $9B00; ) // LEFT // shift?
|
||||
);
|
||||
|
||||
function rcTableIdx(rc: longint): longint;
|
||||
var counter: longint;
|
||||
begin
|
||||
rcTableIdx := -1;
|
||||
counter := 0;
|
||||
while (rawCodeTable[counter].rc <> rc) and (counter <= RCTABLE_MAXIDX) do inc(counter);
|
||||
if (counter <= RCTABLE_MAXIDX) then rcTableIdx:=counter;
|
||||
end;
|
||||
|
||||
|
||||
function hasShift(iMsg: PIntuiMessage) : boolean; inline;
|
||||
begin
|
||||
hasShift:=false;
|
||||
if ((iMsg^.qualifier and IEQUALIFIER_LSHIFT) > 0) or
|
||||
((iMsg^.qualifier and IEQUALIFIER_RSHIFT) > 0) then hasShift:=true;
|
||||
end;
|
||||
|
||||
function hasCtrl(iMsg: PIntuiMessage) : boolean; inline;
|
||||
begin
|
||||
hasCtrl:=false;
|
||||
if ((iMsg^.qualifier and IEQUALIFIER_CONTROL) > 0) then hasCtrl:=true;
|
||||
end;
|
||||
|
||||
function hasAlt(iMsg: PIntuiMessage) : boolean; inline;
|
||||
begin
|
||||
hasAlt:=false;
|
||||
if ((iMsg^.qualifier and IEQUALIFIER_LALT) > 0) or
|
||||
((iMsg^.qualifier and IEQUALIFIER_RALT) > 0) then hasAlt:=true;
|
||||
end;
|
||||
|
||||
function rcTableCode(iMsg: PIntuiMessage; Idx: longint): longint;
|
||||
begin
|
||||
if (Idx < 0) or (Idx > RCTABLE_MAXIDX) then begin
|
||||
rcTableCode:=-1;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if hasShift(iMsg) then rcTableCode:=rawCodeTable[Idx].s else
|
||||
if hasCtrl(iMsg) then rcTableCode:=rawCodeTable[Idx].c else
|
||||
if hasAlt(iMsg) then rcTableCode:=rawCodeTable[Idx].a else
|
||||
rcTableCode:=rawCodeTable[Idx].n;
|
||||
end;
|
||||
|
||||
procedure setShiftState(iMsg: PIntuiMessage);
|
||||
begin
|
||||
lastShiftState:=0;
|
||||
if ((iMsg^.qualifier and IEQUALIFIER_LSHIFT) > 0) then lastShiftState := lastShiftState or $01;
|
||||
if ((iMsg^.qualifier and IEQUALIFIER_RSHIFT) > 0) then lastShiftState := lastShiftState or $02;
|
||||
if hasCtrl(iMsg) then lastShiftState := lastShiftState or $04;
|
||||
if hasAlt(iMsg) then lastShiftState := lastShiftState or $08;
|
||||
if ((iMsg^.qualifier and IEQUALIFIER_NUMERICPAD) > 0) then lastShiftState := lastShiftState or $20;
|
||||
if ((iMsg^.qualifier and IEQUALIFIER_CAPSLOCK) > 0) then lastShiftState := lastShiftState or $40;
|
||||
end;
|
||||
|
||||
|
||||
function SysPollKeyEvent: TKeyEvent;
|
||||
//var t : TKeyEventRecord;
|
||||
// k : TKeyEvent;
|
||||
var
|
||||
iMsg : PIntuiMessage;
|
||||
KeyCode: longint;
|
||||
tmpFCode: word;
|
||||
tmpIdx : longint;
|
||||
begin
|
||||
KeyCode:=0;
|
||||
SysPollKeyEvent:=0;
|
||||
|
||||
|
||||
if KeyQueue<>0 then begin
|
||||
SysPollKeyEvent:=KeyQueue;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// writeln('keyboard/SysPollKeyEvent');
|
||||
if videoWindow<>nil then begin
|
||||
if IsMsgPortEmpty(videoWindow^.UserPort) then exit;
|
||||
end;
|
||||
|
||||
PMessage(iMsg):=GetMsg(videoWindow^.UserPort);
|
||||
if (iMsg<>nil) then begin
|
||||
// writeln('got msg!');
|
||||
|
||||
// set Shift state qualifiers. do this for all messages we get.
|
||||
setShiftState(iMsg);
|
||||
|
||||
case (iMsg^.iClass) of
|
||||
IDCMP_VANILLAKEY: begin
|
||||
writeln('vanilla keycode: ',iMsg^.code);
|
||||
@ -829,33 +913,40 @@ begin
|
||||
|
||||
127: KeyCode:=$5300; // Del
|
||||
|
||||
164: KeyCode:=$1200; // Alt-E
|
||||
164: KeyCode:=$1200; // Alt-E //XXX: conflicts with Alt-Z(?)
|
||||
174: KeyCode:=$1300; // Alt-R
|
||||
176: KeyCode:=$1100; // Alt-W
|
||||
215: KeyCode:=$2D00; // Alt-X
|
||||
229: KeyCode:=$1000; // Alt-Q
|
||||
254: KeyCode:=$1400; // Alt-T
|
||||
|
||||
end;
|
||||
end;
|
||||
IDCMP_RAWKEY: begin
|
||||
writeln('raw keycode: ',iMsg^.code);
|
||||
|
||||
case (iMsg^.code) of
|
||||
35: KeyCode:=$2100; // Alt-F
|
||||
|
||||
71: KeyCode:=$5200; // Ins (Alt/Shift/Ctrl codes needs processing!)
|
||||
|
||||
72: KeyCode:=$4900; // PgUP
|
||||
73: KeyCode:=$5100; // PgDOWN
|
||||
|
||||
76: KeyCode:=$4800; // UP
|
||||
77: KeyCode:=$5000; // DOWN
|
||||
78: KeyCode:=$4D00; // RIGHT
|
||||
79: KeyCode:=$4B00; // LEFT
|
||||
|
||||
80..89: KeyCode:=($3B+(iMsg^.code-80)) shl 8; // F1..F10
|
||||
80..89: begin // F1..F10
|
||||
tmpFCode:=iMsg^.code-80;
|
||||
if hasShift(iMsg) then begin
|
||||
KeyCode:=($54+tmpFCode) shl 8;
|
||||
end else if hasCtrl(iMsg) then begin
|
||||
KeyCode:=($5E+tmpFCode) shl 8;
|
||||
end else if hasAlt(iMsg) then begin
|
||||
KeyCode:=($68+tmpFCode) shl 8;
|
||||
end else begin
|
||||
KeyCode:=($3B+tmpFCode) shl 8;
|
||||
end;
|
||||
end;
|
||||
|
||||
112: KeyCode:=$4700; // HOME
|
||||
113: KeyCode:=$4F00; // END
|
||||
|
||||
else
|
||||
KeyCode:=-1;
|
||||
KeyCode:=rcTableCode(iMsg,rcTableIdx(iMsg^.code));
|
||||
|
||||
end;
|
||||
end;
|
||||
else begin
|
||||
@ -992,10 +1083,9 @@ end;
|
||||
|
||||
|
||||
function SysGetShiftState: Byte;
|
||||
|
||||
begin
|
||||
{may be better to save the last state and return that if no key is in buffer???}
|
||||
// SysGetShiftState:= lastShiftState;
|
||||
//writeln('SysgetShiftState:',hexstr(lastShiftState,2));
|
||||
SysGetShiftState:= lastShiftState;
|
||||
end;
|
||||
|
||||
Const
|
||||
|
||||
@ -51,7 +51,7 @@ var
|
||||
procedure SysInitVideo;
|
||||
var counter: longint;
|
||||
begin
|
||||
writeln('sysinitvideo');
|
||||
// writeln('sysinitvideo');
|
||||
InitGraphicsLibrary;
|
||||
InitIntuitionLibrary;
|
||||
{
|
||||
|
||||
Loading…
Reference in New Issue
Block a user