Browse Source

+ the first part of implementation

Tomas Hajny 25 years ago
parent
commit
e5dc306af5
1 changed files with 86 additions and 1 deletions
  1. 86 1
      api/os2/keyboard.inc

+ 86 - 1
api/os2/keyboard.inc

@@ -3,19 +3,101 @@
 
   $Id$
 }
+uses
+{$IFDEF PPC_FPC}
+ KbdCalls, DosCalls;
+{$ELSE}
+ {$IFDEF PPC_VIRTUAL}
+ OS2Base;
+ {$ELSE}
+  {$IFDEF PPC_BPOS2}
+ Os2Subs, DosProcs;
+  {$ELSE}
+   {$IFDEF PPC_SPEED}
+ BseSub, BseDos;
+   {$ENDIF}
+  {$ENDIF}
+ {$ENDIF} 
+{$ENDIF}
+
+type
+{$IFDEF PPC_VIRTUAL}
+ TKbdKeyInfo = KbdKeyInfo;
+ TKbdInfo = KbdInfo;
+{$ELSE}
+ {$IFDEF PPC_SPEED}
+ TKbdKeyInfo = KbdKeyInfo;
+ TKbdInfo = KbdInfo;
+ {$ENDIF}
+{$ENDIF}
+
+const
+ DefaultKeyboard = 0;
+ Handle: word = DefaultKeyboard;
+
 procedure InitKeyboard;
+var
+ K: TKbdInfo;
 begin
+ if KbdGetFocus (IO_Wait, DefaultKeyboard) = No_Error then
+ begin
+  if KbdOpen (Handle) <> No_Error then Handle := DefaultKeyboard;
+  KbdFlushBuffer (Handle);
+  KbdFreeFocus (DefaultKeyboard);
+  KbdGetFocus (IO_Wait, Handle);
+  K.cb := 10;
+  KbdGetStatus (K, Handle);
+  K.fsMask := $14;
+  KbdSetStatus (K, Handle);
+ end;
 end;
 
 procedure DoneKeyboard;
 begin
+ KbdFreeFocus (Handle);
+ if KbdGetFocus (IO_Wait, DefaultKeyboard) = No_Error then
+ begin
+  KbdClose (Handle);
+  Handle := DefaultKeyboard;
+  KbdFreeFocus (DefaultKeyboard);
+ end;
 end;
 
 function GetKeyEvent: TKeyEvent;
+var
+ K: TKbdKeyInfo;
+ RC: word;
 begin
+ if PendingKeyEvent <> 0 then
+ begin
+  GetKeyEvent := PendingKeyEvent;
+  PendingKeyEvent := 0;
+ end else
+ begin
+  KbdGetFocus (IO_Wait, Handle);
+  while (KbdCharIn (K, IO_Wait, Handle) <> No_Error)
+                                   or (K.fbStatus and $40 = 0) do DosSleep (5);
+  with K do GetKeyEvent := cardinal (fsState or $F) shl 16 or
+                               cardinal (byte (chScan)) shl 8 or byte (chChar);
+ end;
 end;
 
 function PollKeyEvent: TKeyEvent;
+begin
+ if PendingKeyEvent <> 0 then PollKeyEvent := PendingKeyEvent else
+ begin
+{  regs.ah:=$11;
+  realintr($16,regs);
+  if (regs.realflags and zeroflag<>0) then
+   exit(0);
+  if (regs.al=$e0) and (regs.ah<>0) then
+   regs.al:=0;
+  PollKeyEvent:=regs.ax or ((mem[$40:$17] and $f) shl 16);
+}
+ end;
+end;
+
+function PollShiftStateEvent: TKeyEvent;
 begin
 end;
 
@@ -29,7 +111,10 @@ end;
 
 {
   $Log$
-  Revision 1.1  2000-01-06 01:20:31  peter
+  Revision 1.2  2000-01-09 20:42:05  hajny
+    + the first part of implementation
+
+  Revision 1.1  2000/01/06 01:20:31  peter
     * moved out of packages/ back to topdir
 
   Revision 1.1  1999/11/24 23:36:38  peter