'===========================================================================
' Subject: KEY CHOOSER/CONFIGURATION          Date: 11-20-00 (23:11)       
'  Author: Joel Nothman                       Code: QB, QBasic, PDS        
'  Origin: jnothman@crosswinds.net          Packet: KEYBOARD.ABC
'===========================================================================

'this set of routines should allow users to choose their keys in games etc.
'it stores the names of the keys in an array it builds
'pity i didn't know the existence or use of scan codes! o well!
'it's pretty cheap and buggy.
'
' - Joel Nothman

DECLARE FUNCTION Trim$ (t$)
DECLARE FUNCTION NotIt! (Num!)
DECLARE FUNCTION GetKey! (x!, y!)
DECLARE FUNCTION KKeyName$ (a$)
DECLARE FUNCTION KKeyNameFromNum$ (Num!)
DECLARE FUNCTION KKeyNum! (a$)
DECLARE FUNCTION KKeyPress$ (Num!)
DECLARE SUB KSetKeys (Pre$, Lets$, start!)
DECLARE SUB KSetKeys2 (Pre$, Words$(), l!, start!)
DECLARE SUB SetUpKeyArray ()
DECLARE SUB ChangeKeys ()

CONST NumGameKeys = 5
DIM SHARED KeyNames(512) AS STRING * 15
DIM GameKeys(-1 TO NumGameKeys - 1) AS STRING
DIM GameKeyNum(-1 TO NumGameKeys - 1) AS INTEGER

SetUpKeyArray

CLS
PRINT "set the keys:"
GameKeys(-1) = "Quit"
GameKeyNum(-1) = 27
FOR k = 0 TO NumGameKeys - 1
     LOCATE k + 3, 1
     GameKeys(k) = "Key" + STR$(k)
     PRINT GameKeys(k)
     DO
          GameKeyNum(k) = GetKey(k + 3, 10)
          flag = 0
          FOR j = -1 TO k - 1
               IF GameKeyNum(k) = GameKeyNum(j) THEN flag = 1
          NEXT
          IF flag = 1 THEN BEEP
     LOOP UNTIL flag = 0
     PRINT KKeyNameFromNum$((GameKeyNum(k)))
NEXT

PRINT
PRINT
PRINT "Press your keys!!! esc to quit:"
DO
     DO
          a$ = INKEY$
     LOOP UNTIL a$ <> ""
     k = KKeyNum(UCASE$(a$))
     PRINT KKeyNameFromNum(k),
     FOR j = -1 TO NumGameKeys - 1
          IF k = GameKeyNum(j) THEN PRINT GameKeys(j),
     NEXT
     PRINT
LOOP UNTIL k = GameKeyNum(-1)

FUNCTION GetKey (x, y)
     DO
     LOOP UNTIL INKEY$ = ""
     DO
          IF TIMER - .2 > q THEN
               q = TIMER
               j = NotIt(j)
               COLOR j * 15
               LOCATE x, y
               PRINT "_"
          END IF
          a$ = INKEY$
     LOOP UNTIL a$ <> "" AND KKeyName(a$) <> ""

     IF LEN(a$) = 1 THEN
          a$ = UCASE$(a$)
     END IF

     GetKey = KKeyNum(a$)

     LOCATE x, y
     PRINT " "
     LOCATE x, y
     COLOR 7
END FUNCTION

FUNCTION KKeyName$ (a$)
     KKeyName$ = Trim$(KeyNames(KKeyNum(a$)))
END FUNCTION

FUNCTION KKeyNameFromNum$ (Num)
     KKeyNameFromNum$ = Trim$(KeyNames(Num))
END FUNCTION

FUNCTION KKeyNum (a$)
     IF a$ = "" THEN
          KKeyNum = 0
     ELSE
          KKeyNum = 256 * (LEN(a$) - 1) + ASC(RIGHT$(a$, 1))
     END IF
END FUNCTION

FUNCTION KKeyPress$ (Num)
     IF Num / 256 >= 1 THEN
          a$ = CHR$(0)
     END IF
     KKeyPress$ = a$ + CHR$(Num MOD 256)
END FUNCTION

SUB KSetKeys (Pre$, Lets$, start)
     FOR j = 1 TO LEN(Lets$)
          KeyNames(start + j - 1) = Pre$ + MID$(Lets$, j, 1)
     NEXT
END SUB

SUB KSetKeys2 (Pre$, Words$(), l, start)
     FOR j = 0 TO l - 1
          KeyNames(start + j) = Pre$ + Words$(j)
     NEXT
END SUB

FUNCTION NotIt (Num)
     IF Num = 0 THEN
          NotIt = 1
     ELSE
          NotIt = 0
     END IF
END FUNCTION

SUB SetUpKeyArray
     KSetKeys "ALT + ", "1234567890-=", 256 + 120
     KSetKeys "ALT + ", "QWERTYUIOP", 256 + 16
     KSetKeys "ALT + ", "ASDFGHJKL", 256 + 30
     KSetKeys "ALT + ", "ZXCVBNM", 256 + 44
     KSetKeys "ALT + F", "123456789", 256 + 104
     KeyNames(256 + 104 + 9) = "ALT + F10"
     KeyNames(256 + 139) = "ALT + F11"
     KeyNames(256 + 140) = "ALT + F12"
     KSetKeys "F", "123456789", 256 + 59
     KeyNames(256 + 59 + 9) = "F10"
     KeyNames(256 + 133) = "F11"
     KeyNames(256 + 134) = "F12"
     KSetKeys "CTRL + F", "123456789", 256 + 94
     KeyNames(256 + 103) = "CTRL + F10"
     KeyNames(256 + 137) = "CTRL + F11"
     KeyNames(256 + 138) = "CTRL + F12"

     DIM TempArray(12) AS STRING
     TempArray(0) = "HOME"
     TempArray(1) = "UP"
     TempArray(2) = "PAGE UP"
     TempArray(3) = ""
     TempArray(4) = "LEFT"
     TempArray(5) = "NUMPAD 5"
     TempArray(6) = "RIGHT"
     TempArray(7) = ""
     TempArray(8) = "END"
     TempArray(9) = "DOWN"
     TempArray(10) = "PAGE DOWN"
     TempArray(11) = "INSERT"
     TempArray(12) = "DELETE"
     KSetKeys2 "", TempArray(), 13, 256 + 71

     TempArray(0) = "CTRL + LEFT"
     TempArray(1) = "CTRL + RIGHT"
     TempArray(2) = "CTRL + END"
     TempArray(3) = "CTRL + PGDN"
     TempArray(4) = "CTRL + HOME"
     KSetKeys2 "", TempArray(), 5, 256 + 115
     KeyNames(256 + 132) = "CTRL+PGUP"

     KSetKeys "CTRL + ", "ABCDEFGHIJKLMNOPQRSTUVWXYZ", 1
     
     FOR j = 33 TO 127
          KeyNames(j) = UCASE$(CHR$(j))
     NEXT

     KeyNames(8) = "BACK"
     KeyNames(9) = "TAB"
     KeyNames(13) = "ENTER"
     KeyNames(27) = "ESCAPE"
     KeyNames(32) = "SPACE"
END SUB

FUNCTION Trim$ (t$)
     txt$ = LTRIM$(RTRIM$(t$))
     FOR j = 1 TO LEN(txt$)
          IF ASC(MID$(txt$, j)) > 0 THEN
               txt$ = MID$(txt$, j)
               j = LEN(txt$) + 1000
          END IF
     NEXT
     Trim$ = txt$
END FUNCTION