'===========================================================================
' Subject: 2 Key Input Routines               Date: 06-21-01 (20:30)       
'  Author: Walt Decker                        Code: QB, QBasic, PDS, PB    
'  Origin: lydia2hg@Yahoo.com               Packet: KEYBOARD.ABC
'===========================================================================
DECLARE FUNCTION GetKeyMask% ()
DECLARE FUNCTION gstFNGetKey$ (intF AS INTEGER, intE AS INTEGER, intB AS INTEGER)

DEFINT A-Z
FUNCTION GetKeyMask
'********************** CHECKS FOR KEY PRESSES *****************************
'      This function can be modified to detect multiple (up to 3) simultaneous
'      key presses.
'***************************************************************************
   ExtKeySeg = INP(96)
  SELECT CASE ExtKeySeg
    CASE 75
      L = ExtKeySeg                        'cursor left
    CASE 72
      U = ExtKeySeg                        'cursor up
    CASE 77
      R = ExtKeySeg                        'cursor right
    CASE 80
      D = ExtKeySeg                        'cursor down
    CASE 28
      ent = ExtKeySeg                      'Enter
    CASE 57
      SB = ExtKeySeg                       'Space Bar
    CASE 1
      esc = ExtKeySeg                      'Escape
    CASE 73
      PgU = ExtKeySeg                      'page up
    CASE 81
      PgD = ExtKeySeg                      'page down
    CASE 71
      Hm = ExtKeySeg
    CASE 79
      EndKey = ExtKeySeg
  END SELECT

'********************** CLEAR KEYBOARD BUFFER ******************************

   DEF SEG = &H40                      'point head to tail thus emptying
   POKE &H1A, PEEK(&H1C)               'the keyboard buffer

'********************** SETUP CHECK FOR PROPER KEY PRESS *******************

   lowbyte = L OR U OR R OR D OR ent OR SB OR esc OR PgU
   highbyte = PgD OR Hm OR EndKey

   DEF SEG                                       'default segment
   hbptr = VARPTR(highbyte)
   POKE hbptr + 1, PEEK(hbptr)                   'move low byte to high
   POKE hbptr, 0                                 'clear low byte


   GetKeyMask = lowbyte OR highbyte              'return all of it

END FUNCTION

FUNCTION gstFNGetKey$ (intF AS INTEGER, intE AS INTEGER, intB AS INTEGER)

'****************************************************************************
'    This function checks for keys equal to those contained in the module
'    level arrays gstFkeys(), gstEkeys(), and gstBkeys().
'    If a match is found, the array element is returned in intF, intE, or
'    intB.

'    If a match is not found, it is assumed that the key was one of the normal
'    keys and the keystroke is returned through gstFNGetKey.

'****************************************************************************

  DIM strKey AS STRING         ' temporary variables
  DIM intI AS INTEGER

  gstFNGetKey = ""             'initialize variables
  intF = 0
  intE = 0
  intB = 0

  DO                           'loop until a key is pressed
    strKey = INKEY$
  LOOP WHILE strKey = ""

  IF LEN(strKey) < 2 THEN GOTO Other.Keys   'must be a "normal" key

  FOR intI = 1 TO 10                        'Check for keys F1 - F10
    IF strKey = gstFkeys(intI) THEN
      intF = intI
      EXIT FUNCTION
    END IF
  NEXT intI

  FOR intI = 1 TO 11                       'Check for arrow keys and such
    IF strKey = gstEkeys(intI) THEN
      intE = intI
      EXIT FUNCTION
    END IF
  NEXT intI

Other.Keys: '

  FOR intI = 1 TO 4                       'Check for ESC, ENTER, etc
    IF strKey = gstBkeys(intI) THEN
      intB = intI
      EXIT FUNCTION
    END IF
  NEXT intI

gstFNGetKey = strKey                      'Normal key (i.e., A - Z, 0 - 9,
                                          'etc.

END FUNCTION