'===========================================================================
' Subject: NEW ASSEMBLY MULTIKEY FUNCTION     Date: 12-20-97 (10:33)       
'  Author: Joe Huber, Jr.                     Code: QB, QBasic, PDS        
'  Origin: Milo Sedlacek                    Packet: KEYBOARD.ABC
'===========================================================================
DECLARE SUB KEYTEST ()
DECLARE FUNCTION MULTIKEY (T)

'New and Improved MULTIKEY function!!
'This version eliminates the key lock-up problem from
'previous verions.  And is MUCH, MUCH faster!!

'ASM Interrupt & support code by Milo Sedlacek
'Everything else by              

'MULTIKEY - main routine
'    Usage:
'    X = MULTIKEY(T)
'    where t can equal -1,-2, and 1-128
'    t = -1: IMPORTANT!!!  Make sure you pass this value to
'             the function before -2 and 1-128!  It turns the
'             interrupt on so you can start reading keys.
'             Returns: nothing
'    t = -2: EXTREMELY IMPORTANT!!!!!!!!
'             ALWAYS pass this before you end your program!
'             If you don't, your computer won't be able to
'             read your keyboard & you'll have to reset!
'             i.e., CTRL-ALT-DEL won't work!!
'             Returns: nothing
'    t = keycode (1-128): Returns status of a key.
'             Returns: 1 or 0 where     
'                   1 = pressed
'                   0 = unpressed
'
'KEYTEST - helps you find new keycodes
'    Usage:
'    CALL KEYTEST or KEYTEST
'    This will show all 128 keycodes & their statuses.
'    Press & hold a key & a 1 will appear somewhere.
'    The number that the 1 is by will be the keycode
'    for that key.  Simple!

' Send any qustions, comments, etc. to:  huberjjr@nicom.com

'Demo code:
'Use arrows to turn & accelerate
'Press space to come to a total stop
'Hit ESC to exit

Z = MULTIKEY(-1)    ' Initalize ASM & hook interrupt


SCREEN 12
CLS

X = 320
Y = 240
cPI = (3.141592654# / 180)
ANGLE = 0
RADIUS = 5
SPEED = .2
DO
        IF MULTIKEY(77) THEN ANGLE = ANGLE - 7 ' Left
        IF MULTIKEY(75) THEN ANGLE = ANGLE + 7 ' Right
        IF MULTIKEY(72) THEN                   ' Up
         VX = VX + (SIN(cPI * ANGLE) * SPEED)
         VY = VY + (COS(cPI * ANGLE) * SPEED)
        END IF
        IF MULTIKEY(80) THEN                   ' Down
         VX = VX - (SIN(cPI * ANGLE) * SPEED)
         VY = VY - (COS(cPI * ANGLE) * SPEED)
        END IF
        IF MULTIKEY(57) THEN                   ' Space
         VX = 0
         VY = 0
        END IF

        IF ANGLE > 360 THEN                   ' Wrap-around angle
         ANGLE = 0 + (ANGLE - 360)
        END IF
        IF ANGLE < 0 THEN
         ANGLE = 360 - (0 + ANGLE)
        END IF

        IF X < 0 + RADIUS THEN VX = -VX        ' Bounce limits
        IF X > 640 - RADIUS THEN VX = -VX
        IF Y < 0 + RADIUS THEN VY = -VY
        IF Y > 480 - RADIUS THEN VY = -VY
     
        X = X + VX                             ' Move it
        Y = Y + VY
      
        X2 = X + SIN(cPI * ANGLE) * RADIUS     ' White dot calc
        Y2 = Y + COS(cPI * ANGLE) * RADIUS     ' ditto
       
        VX = VX * .998                         ' Friction
        VY = VY * .998                         ' ditto
      
        CIRCLE (XX, YY), RADIUS, 0             ' Erase
        PSET (XX2, YY2), 0
        PSET (XX, YY), 0
        CIRCLE (X, Y), RADIUS, 4               ' Draw
        PSET (X2, Y2), 15
        PSET (X, Y), 4
        XX = X: YY = Y: YY2 = Y2: XX2 = X2
        WAIT &H3DA, 8                          ' Wait to vert. retarce
        WAIT &H3DA, 8, 8
LOOP UNTIL MULTIKEY(1) = 1                     ' Hit ESC to exit

Z = MULTIKEY(-2)         'Unhook interrupt

END


'KB Interrrupt source
' &HE9,&H1D,&H00          : '0000   JMP 0020        ;Jump to INSTALL INTERRUPT
' &HE9,&H3C,&H00          : '0003   JMP 0042        ;Jump to UNINSTALL INTERRUPT
' &H00,&H00               : '0006   ADD [BX+SI],AL  ;\
' &H00,&H00               : '0008   ADD [BX+SI],AL  ;  \
' &H00,&H00               : '000A   ADD [BX+SI],AL  ;   } Unused space
' &H00,&H00               : '000C   ADD [BX+SI],AL  ;  /
' &H00,&H00               : '000E   ADD [BX+SI],AL  ;/
' &H00,&H00               : '0010   ADD [BX+SI],AL  ;variable: keyboard_matrix_segment
' &H00,&H00               : '0012   ADD [BX+SI],AL  ;variable: keyboard_matrix_offset
' &H00,&H00               : '0014   ADD [BX+SI],AL  ;variable: dos_isr_handler_offset
' &H00,&H00               : '0016   ADD [BX+SI],AL  ;variable: dos_isr_handler_segment
' &H00,&H00               : '0018   ADD [BX+SI],AL  ;\
' &H00,&H00               : '001A   ADD [BX+SI],AL  ;  \
' &H00,&H00               : '001C   ADD [BX+SI],AL  ;  / Unused space
' &H00,&H00               : '001E   ADD [BX+SI],AL  ;/
' &H1E                    : '0020   PUSH  DS        ;INSTALL INTERRUPT save DS for QBASIC
' &H31,&HC0               : '0021   XOR AX,AX       ;\
' &H8E,&HD8               : '0023   MOV DS,AX       ; } DS:SI -> interrupt vector 9
' &HBE,&H24,&H00          : '0025   MOV SI,0024     ;/
' &H0E                    : '0028   PUSH  CS        ;
' &H07                    : '0029   POP ES          ;ES = CS
' &HBF,&H14,&H00          : '002A   MOV DI,0014     ;ES:DI -> dos_isr_handler_offset
' &HFC                    : '002D   CLD             ;Increment SI, DI on string moves
' &HA5                    : '002E   MOVSW           ;\
' &HA5                    : '002F   MOVSW           ;/ Read address of old handler
' &H8C,&HC3               : '0030   MOV BX,ES       ;BX = CS
' &H8E,&HC0               : '0032   MOV ES,AX       ;ES = 0
' &HBF,&H24,&H00          : '0034   MOV DI,0024     ;ES:DI -> keyboard interrupt vector
' &HB8,&H56,&H00          : '0037   MOV AX,0056     ;AX = Offset of new handler from CS
' &HFA                    : '003A   CLI             ;Disable interrupts
' &HAB                    : '003B   STOSW           ;\
' &H89,&HD8               : '003C   MOV AX,BX       ; } Change keyboard interrupt vector
' &HAB                    : '003E   STOSW           ;/  to point to new handler
' &HFB                    : '003F   STI             ;Enable interrupts
' &H1F                    : '0040   POP DS          ;Restore DS for QBASIC
' &HCB                    : '0041   RETF            ;
' &H1E                    : '0042   PUSH  DS        ;UNINSTALL INTERRUPT save DS for QBASIC
' &H31,&HC0               : '0043   XOR AX,AX       ;\
' &H8E,&HC0               : '0045   MOV ES,AX       ; } ES:DI -> keyboard interrupt vector
' &HBF,&H24,&H00          : '0047   MOV DI,0024     ;/
' &HBE,&H14,&H00          : '004A   MOV SI,0014     ;\
' &H0E                    : '004D   PUSH  CS        ; } DS:SI -> address of old handler
' &H1F                    : '004E   POP DS          ;/
' &HFC                    : '004F   CLD             ;Increment SI, DI on string moves
' &HFA                    : '0050   CLI             ;Disable interrupts
' &HA5                    : '0051   MOVSW           ;\
' &HA5                    : '0052   MOVSW           ;/ Change interrupt vector
' &HFB                    : '0053   STI             ;Enable interrupts
' &H1F                    : '0054   POP DS          ;Restore DS for QBASIC
' &HCB                    : '0055   RETF            ;
' &HFB                    : '0056   STI             ;INTERRUPT HANDLER enable interrupts
' &H9C                    : '0057   PUSHF           ;Save flags
' &H50                    : '0058   PUSH  AX        ;Save registers
' &H53                    : '0059   PUSH  BX        ;
' &H51                    : '005A   PUSH  CX        ;
' &H52                    : '005B   PUSH  DX        ;
' &H1E                    : '005C   PUSH  DS        ;
' &H56                    : '005D   PUSH  SI        ;
' &H06                    : '005E   PUSH  ES        ;
' &H57                    : '005F   PUSH  DI        ;
' &HE4,&H60               : '0060   IN  AL,60       ;AL = Scan code
' &HB4,&H01               : '0062   MOV AH,01       ;Assume it's a make code
' &HA8,&H80               : '0064   TEST  AL,80     ;
' &H74,&H04               : '0066   JZ  006C    ÚÄÄÄ;If it's not a break code then jump
' &HB4,&H00               : '0068   MOV AH,00   ³   ;  It's a break code
' &H24,&H7F               : '006A   AND AL,7F   ³   ;  key index = code AND 127
' &HD0,&HE0               : '006C   SHL AL,1    ÀÄÄ>;\
' &H88,&HC3               : '006E   MOV BL,AL       ; } BX = key index * 2
' &HB7,&H00               : '0070   MOV BH,00       ;/
' &HB0,&H00               : '0072   MOV AL,00       ;
' &H2E                    : '0074   CS:             ;
' &H03,&H1E,&H12,&H00     : '0075   ADD BX,[0012]   ;BX = BX + offset of matrix
' &H2E                    : '0079   CS:             ;
' &H8E,&H1E,&H10,&H00     : '007A   MOV DS,[0010]   ;DS = segment of matrix
' &H86,&HE0               : '007E   XCHG  AH,AL     ;
' &H89,&H07               : '0080   MOV [BX],AX     ;Store key state
' &HE4,&H61               : '0082   IN  AL,61       ;Interrupt Clean up
' &H0C,&H82               : '0084   OR  AL,82       ;
' &HE6,&H61               : '0086   OUT 61,AL       ;
' &H24,&H7F               : '0088   AND AL,7F       ;
' &HE6,&H61               : '008A   OUT 61,AL       ;
' &HB0,&H20               : '008C   MOV AL,20       ;
' &HE6,&H20               : '008E   OUT 20,AL       ;
' &H5F                    : '0090   POP DI          ;Restore registers
' &H07                    : '0091   POP ES          ;
' &H5E                    : '0092   POP SI          ;
' &H1F                    : '0093   POP DS          ;
' &H5A                    : '0094   POP DX          ;
' &H59                    : '0095   POP CX          ;
' &H5B                    : '0096   POP BX          ;
' &H58                    : '0097   POP AX          ;
' &H9D                    : '0098   POPF            ;Restore flags
' &HCF                    : '0099   IRET            ;Exit interrupt

SUB KEYTEST

SCREEN 0
CLS

Z = MULTIKEY(-1)
DO
X = 1
Y = 1

 FOR I = 1 TO 128
 
  TEST = MULTIKEY(I)
  LOCATE Y, X
  PRINT USING "## =###"; TEST; I

  IF Y < 23 THEN
   Y = Y + 1
  ELSE
   Y = 1
   X = X + 9
  END IF

 NEXT I

LOOP WHILE MULTIKEY(1) = 0

Z = MULTIKEY(-2)

END

END SUB

FUNCTION MULTIKEY (T)

STATIC kbcontrol%(), kbmatrix%(), Firsttime, StatusFlag

IF Firsttime = 0 THEN          'Initalize
 DIM kbcontrol%(128)
 DIM kbmatrix%(128)
 code$ = ""
 code$ = code$ + "E91D00E93C00000000000000000000000000000000000000000000000000"
 code$ = code$ + "00001E31C08ED8BE24000E07BF1400FCA5A58CC38EC0BF2400B85600FAAB"
 code$ = code$ + "89D8ABFB1FCB1E31C08EC0BF2400BE14000E1FFCFAA5A5FB1FCBFB9C5053"
 code$ = code$ + "51521E560657E460B401A8807404B400247FD0E088C3B700B0002E031E12"
 code$ = code$ + "002E8E1E100086E08907E4610C82E661247FE661B020E6205F075E1F5A59"
 code$ = code$ + "5B589DCF"
 DEF SEG = VARSEG(kbcontrol%(0))
 FOR I% = 0 TO 155                     ' Load ASM
     d% = VAL("&h" + MID$(code$, I% * 2 + 1, 2))
     POKE VARPTR(kbcontrol%(0)) + I%, d%
 NEXT I%
 I& = 16       ' I think this stuff connects the interrupt with kbmatrix%()
 N& = VARSEG(kbmatrix%(0)): l& = N& AND 255: h& = ((N& AND &HFF00) \ 256): POKE I&, l&: POKE I& + 1, h&: I& = I& + 2
 N& = VARPTR(kbmatrix%(0)): l& = N& AND 255: h& = ((N& AND &HFF00) \ 256): POKE I&, l&: POKE I& + 1, h&: I& = I& + 2
 DEF SEG
 Firsttime = 1
END IF

SELECT CASE T
 CASE -1
  IF StatusFlag = 0 THEN
   DEF SEG = VARSEG(kbcontrol%(0))
   CALL ABSOLUTE(0)                     ' Run interrupt
   DEF SEG
   StatusFlag = 1
  END IF
 CASE -2
  IF StatusFlag = 1 THEN
   DEF SEG = VARSEG(kbcontrol%(0))      ' Turn off interrupt
   CALL ABSOLUTE(3)
   DEF SEG
   StatusFlag = 0
  END IF
 CASE 1 TO 128
  MULTIKEY = kbmatrix%(T)               ' Return status
 CASE ELSE
  MULTIKEY = 0                          ' User Supidity Error
END SELECT

END FUNCTION