mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 02:49:21 +02:00
+ 83/84-key keyboard support added to unit keyboard for i8086-msdos
git-svn-id: trunk@25490 -
This commit is contained in:
parent
034f9c6b71
commit
d2c2193505
@ -25,13 +25,31 @@ uses
|
|||||||
|
|
||||||
{$i keyboard.inc}
|
{$i keyboard.inc}
|
||||||
|
|
||||||
|
var
|
||||||
|
keyboard_type: byte; { 0=83/84-key keyboard, $10=101/102+ keyboard }
|
||||||
|
|
||||||
|
|
||||||
|
procedure SysInitKeyboard;
|
||||||
|
var
|
||||||
|
regs: registers;
|
||||||
|
begin
|
||||||
|
keyboard_type:=0;
|
||||||
|
if (Mem[$40:$96] and $10)<>0 then
|
||||||
|
begin
|
||||||
|
regs.ax:=$1200;
|
||||||
|
intr($16,regs);
|
||||||
|
if regs.ax<>$1200 then
|
||||||
|
keyboard_type:=$10;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
function SysGetKeyEvent: TKeyEvent;
|
function SysGetKeyEvent: TKeyEvent;
|
||||||
|
|
||||||
var
|
var
|
||||||
regs : registers;
|
regs : registers;
|
||||||
begin
|
begin
|
||||||
regs.ah:=$10;
|
regs.ah:=keyboard_type;
|
||||||
intr($16,regs);
|
intr($16,regs);
|
||||||
if (regs.al=$e0) and (regs.ah<>0) then
|
if (regs.al=$e0) and (regs.ah<>0) then
|
||||||
regs.al:=0;
|
regs.al:=0;
|
||||||
@ -43,7 +61,7 @@ function SysPollKeyEvent: TKeyEvent;
|
|||||||
var
|
var
|
||||||
regs : registers;
|
regs : registers;
|
||||||
begin
|
begin
|
||||||
regs.ah:=$11;
|
regs.ah:=keyboard_type+1;
|
||||||
intr($16,regs);
|
intr($16,regs);
|
||||||
if (regs.flags and fzero)<>0 then
|
if (regs.flags and fzero)<>0 then
|
||||||
exit(0);
|
exit(0);
|
||||||
@ -61,7 +79,7 @@ end;
|
|||||||
|
|
||||||
Const
|
Const
|
||||||
SysKeyboardDriver : TKeyboardDriver = (
|
SysKeyboardDriver : TKeyboardDriver = (
|
||||||
InitDriver : Nil;
|
InitDriver : @SysInitKeyboard;
|
||||||
DoneDriver : Nil;
|
DoneDriver : Nil;
|
||||||
GetKeyevent : @SysGetKeyEvent;
|
GetKeyevent : @SysGetKeyEvent;
|
||||||
PollKeyEvent : @SysPollKeyEvent;
|
PollKeyEvent : @SysPollKeyEvent;
|
||||||
|
Loading…
Reference in New Issue
Block a user