Author Topic: game input mapping system v1.0 for gamepad, keyboard  (Read 3373 times)

0 Members and 1 Guest are viewing this topic.

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
game input mapping system v1.0 for gamepad, keyboard
« on: January 07, 2022, 06:43:22 pm »
I needed some basic reusable functionality to map game input from USB game controllers and the keyboard, which could be saved to a config file and reused.
Everything is working now, you can map controls, load/save/edit mappings, test the mapping, or test game controllers.
The input is menu driven, and the menus are very rudimentary, text-based, but it works (at least as far as I can tell).

1. Basic controller test
2. Load controller mapping
3. View controller mapping
4. Edit  controller mapping for 1 or more players
5. Reset controller mapping for 1 or more players
6. Map controllers for 1 or more players
7. Test controller mappings to move around screen
8. Save controller mappings

Code is below and fully self-contained.

Enjoy.

Code: QB64: [Select]
  1. ' ################################################################################################################################################################
  2. ' #TOP
  3.  
  4. ' Game Input Mapping Test
  5. ' Version 1.0 by madscijr
  6.  
  7. ' BASED ON CODE BY SMcNeill FROM:
  8. '     Simple Joystick Detection and Interaction  (Read 316 times)
  9. '     https://www.qb64.org/forum/index.php?topic=2160.msg129051#msg129051
  10. '     https://qb64forum.alephc.xyz/index.php?topic=2160.msg129083#msg129083
  11. ' and others (sources cited throughout).
  12.  
  13. ' ################################################################################################################################################################
  14. ' #CONSTANTS = GLOBAL CONSTANTS
  15.  
  16. ' boolean constants:
  17. Const FALSE = 0
  18. Const TRUE = Not FALSE
  19.  
  20. ' BEGIN GAME CONTROLLER MAPPING CONSTANTS
  21. Const cInputNone = 0
  22. Const cInputKey = 1
  23. Const cInputButton = 2
  24. Const cInputAxis = 3
  25.  
  26. Const cMaxButtons = 12
  27. Const cMaxAxis = 8
  28. Const cMaxControllers = 8
  29. Const cMaxPlayers = 8
  30.  
  31. ' Use as index for array of ControlInputType
  32. Const cInputUp = 1
  33. Const cInputDown = 2
  34. Const cInputLeft = 3
  35. Const cInputRight = 4
  36. Const cInputButton1 = 5
  37. Const cInputButton2 = 6
  38. Const cInputButton3 = 7
  39. Const cInputButton4 = 8
  40.  
  41. Const c_iKeyDown_F10 = 17408
  42. Const c_iKeyHit_AltLeft = -30764
  43. Const c_iKeyHit_AltRight = -30765
  44. ' END GAME CONTROLLER MAPPING CONSTANTS
  45.  
  46. ' ################################################################################################################################################################
  47. ' #UDT #TYPES = USER DEFINED TYPES
  48.  
  49. ' UDT TO HOLD THE INFO FOR A PLAYER
  50. Type PlayerType
  51.     x As Integer ' player x position
  52.     y As Integer ' player y position
  53.     c As Integer ' character to display on screen
  54.     xOld As Integer
  55.     yOld As Integer
  56.  
  57.     ' control buffer
  58.     moveX As Integer
  59.     moveY As Integer
  60.  
  61.     moveUp As Integer
  62.     moveDown As Integer
  63.     moveLeft As Integer
  64.     moveRight As Integer
  65.     button1 As Integer
  66.     button2 As Integer
  67.     button3 As Integer
  68.     button4 As Integer
  69.  
  70.     ' control previous move
  71.     'lastMoveX As Integer
  72.     'lastMoveY As Integer
  73.     lastMoveUp As Integer
  74.     lastMoveDown As Integer
  75.     lastMoveLeft As Integer
  76.     lastMoveRight As Integer
  77.     lastButton1 As Integer
  78.     lastButton2 As Integer
  79.     lastButton3 As Integer
  80.     lastButton4 As Integer
  81.  
  82.     'repeat As Integer
  83. End Type ' PlayerType
  84.  
  85. ' UDT TO HOLD THE INFO FOR A GAME CONTROLLER
  86. Type ControllerType
  87.     buttonCount As Integer
  88.     axisCount As Integer
  89. End Type ' ControllerType
  90.  
  91. ' UDT TO HOLD THE INFO FOR A GAME CONTROLLER
  92. Type ControlInputType
  93.     device As Integer
  94.     typ As Integer ' cInputKey, cInputButton, cInputAxis
  95.     code As Integer
  96.     value As Integer
  97.     repeat As Integer
  98. End Type ' ControlInputType
  99.  
  100. ' ################################################################################################################################################################
  101. ' #VARS = GLOBAL VARIABLES
  102.  
  103. ' ENABLE / DISABLE DEBUG CONSOLE
  104. Dim Shared m_bTesting As Integer: m_bTesting = TRUE
  105.  
  106. ' BASIC PROGRAM METADATA
  107. Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
  108. Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
  109.  
  110. ' GAME CONTROLLER MAPPING
  111. Dim Shared m_ControlMapFileName$: m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
  112. ReDim Shared m_arrControlMap(1 To 8, 1 To 8) As ControlInputType ' holds control mapping for each player (player #, direction)
  113. ReDim Shared m_arrController(1 To 8) As ControllerType ' holds info for each game controller
  114. ReDim Shared m_arrButtonCode(1 To 99) As Integer ' Long
  115. ReDim Shared m_arrButtonKey(1 To 99) As String
  116. ReDim Shared m_arrButtonKeyDesc(0 To 512) As String
  117. Dim Shared m_bInitialized As Integer: m_bInitialized = FALSE
  118. Dim Shared m_bHaveMapping As Integer: m_bHaveMapping = FALSE
  119.  
  120. ' USE TO GLOBALLY ENABLE/DISABLE REPEATING INPUT PER FUNCTION
  121. ' To enable override set m_bRepeatOverride=TRUE,
  122. ' otherwise this can be configured for each individual controller
  123. ' when you map the functions.
  124. Dim Shared m_bRepeatOverride As Integer: m_bRepeatOverride = TRUE
  125. Dim Shared m_bRepeatUp As Integer: m_bRepeatUp = TRUE
  126. Dim Shared m_bRepeatDown As Integer: m_bRepeatDown = TRUE
  127. Dim Shared m_bRepeatLeft As Integer: m_bRepeatLeft = FALSE
  128. Dim Shared m_bRepeatRight As Integer: m_bRepeatRight = FALSE
  129. Dim Shared m_bRepeatButton1 As Integer: m_bRepeatButton1 = TRUE
  130. Dim Shared m_bRepeatButton2 As Integer: m_bRepeatButton2 = TRUE
  131. Dim Shared m_bRepeatButton3 As Integer: m_bRepeatButton3 = FALSE
  132. Dim Shared m_bRepeatButton4 As Integer: m_bRepeatButton4 = FALSE
  133.  
  134. ' VARIABLES FOR GRAPHIC PRINTING ROUTINES
  135. Dim Shared m_NumColumns As Integer: m_NumColumns = 1
  136. Dim Shared m_PrintRow As Integer: m_PrintRow = 0
  137. Dim Shared m_PrintCol As Integer: m_PrintCol = 0
  138. Dim Shared m_StartRow As Integer: m_StartRow = 0
  139. Dim Shared m_EndRow As Integer: m_EndRow = 0
  140. Dim Shared m_StartCol As Integer: m_StartCol = 0
  141. Dim Shared m_EndCol As Integer: m_EndCol = 0
  142.  
  143. ' DEMO GAME / TESTING
  144. ReDim Shared m_arrPlayer(1 To 8) As PlayerType ' holds info for each player
  145.  
  146. ' =============================================================================
  147. ' LOCAL VARIABLES
  148. Dim in$
  149.  
  150. ' ****************************************************************************************************************************************************************
  151. ' ACTIVATE DEBUGGING WINDOW
  152. If m_bTesting = TRUE Then
  153.     $Console
  154.     _Delay 4
  155.     _Console On
  156.     _Echo "Started " + m_ProgramName$
  157.     _Echo "Debugging on..."
  158. ' ****************************************************************************************************************************************************************
  159.  
  160. ' =============================================================================
  161. ' START THE MAIN ROUTINE
  162. main
  163.  
  164. ' =============================================================================
  165. ' FINISH
  166. Print m_ProgramName$ + " finished."
  167. Input "Press <ENTER> to continue", in$
  168.  
  169. ' ****************************************************************************************************************************************************************
  170. ' DEACTIVATE DEBUGGING WINDOW
  171. If m_bTesting = TRUE Then
  172. ' ****************************************************************************************************************************************************************
  173.  
  174. System ' return control to the operating system
  175.  
  176. ' /////////////////////////////////////////////////////////////////////////////
  177.  
  178. Sub main
  179.     Dim RoutineName As String: RoutineName = "main"
  180.     Dim in$
  181.     Dim result$: result$ = ""
  182.  
  183.     ' SET UP SCREEN
  184.     Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
  185.  
  186.     Do
  187.         If Len(result$) = 0 Then
  188.             Cls
  189.         Else
  190.             Print
  191.         End If
  192.  
  193.         Print m_ProgramName$
  194.         Print
  195.         Print "Game Input Mapping Test"
  196.         Print "v1.0, by Softintheheadware (Jan, 2022)"
  197.         Print
  198.  
  199.         Print "1. Basic controller test"
  200.         Print "2. Load controller mapping"
  201.         Print "3. View controller mapping"
  202.         Print "4. Edit  controller mapping for 1 or more players"
  203.         Print "5. Reset controller mapping for 1 or more players"
  204.         Print "6. Map controllers for 1 or more players"
  205.         Print "7. Test controller mappings to move around screen"
  206.         Print "8. Save controller mappings"
  207.         Print
  208.         Print "What to do? ('q' to exit)"
  209.  
  210.         Input in$: in$ = LCase$(Left$(in$, 1))
  211.  
  212.         If in$ = "1" Then
  213.             result$ = TestJoysticks$
  214.         ElseIf in$ = "2" Then
  215.             result$ = LoadMappings$
  216.             If Len(result$) = 0 Then result$ = "Loaded mappings."
  217.         ElseIf in$ = "3" Then
  218.             result$ = ViewMappings$
  219.         ElseIf in$ = "4" Then
  220.             result$ = EditMappings$
  221.         ElseIf in$ = "5" Then
  222.             result$ = ResetMapping$
  223.         ElseIf in$ = "6" Then
  224.             result$ = MapInput$
  225.         ElseIf in$ = "7" Then
  226.             result$ = TestMappings$
  227.         ElseIf in$ = "8" Then
  228.             result$ = SaveMappings$
  229.         End If
  230.  
  231.         If Len(result$) > 0 Then
  232.             Print result$
  233.         End If
  234.  
  235.     Loop Until in$ = "q"
  236.  
  237.     ' RETURN TO TEXT SCREEN
  238.     Screen 0
  239.  
  240. End Sub ' main
  241.  
  242. ' /////////////////////////////////////////////////////////////////////////////
  243. ' TODO: get keyboard input working
  244. ' TODO: get continuous movement working for digital joysticks
  245. ' TODO: adjust analog joystick sensitivity
  246.  
  247. Function TestMappings$
  248.     Dim sResult As String: sResult = ""
  249.     Dim sError As String: sError = ""
  250.  
  251.     Dim iDeviceCount As Integer
  252.     Dim iDevice As Integer
  253.     Dim iNumControllers As Integer
  254.     Dim iController As Integer
  255.     Dim iValue As Integer
  256.     Dim iWhichInput As Integer
  257.  
  258.     Dim arrButton(32, 16) As Integer ' number of buttons on the joystick
  259.     Dim arrButtonNew(32, 16) As Integer ' tracks when to initialize values
  260.     Dim arrAxis(32, 16) As Double ' number of axis on the joystick
  261.     Dim arrAxisNew(32, 16) As Integer ' tracks when to initialize values
  262.  
  263.     Dim iCols As Integer
  264.     Dim iRows As Integer
  265.  
  266.     Dim iPlayer As Integer
  267.     Dim iNextY As Integer
  268.     Dim iNextX As Integer
  269.     Dim iNextC As Integer
  270.  
  271.     Dim iMinX As Integer
  272.     Dim iMaxX As Integer
  273.     Dim iMinY As Integer
  274.     Dim iMaxY As Integer
  275.  
  276.     Dim bHaveInput As Integer
  277.     Dim bFinished As Integer
  278.     Dim bFoundWho As Integer
  279.     Dim bRepeat As Integer
  280.  
  281.     Dim in$
  282.  
  283.     ' MAKE SURE WE HAVE MAPPING
  284.     If m_bHaveMapping = TRUE Then
  285.         ' INITIALIZE
  286.         Cls
  287.         InitKeyboardButtonCodes
  288.         iCols = _Width(0) \ _FontWidth
  289.         iRows = _Height(0) \ _FontHeight
  290.         iMinX = 0: iMaxX = iCols
  291.         iMinY = 0: iMaxY = iRows
  292.  
  293.         ' INITIALIZE PLAYER COORDINATES AND SCREEN CHARACTERS
  294.         iNextY = 1
  295.         iNextX = -3
  296.         iNextC = 64
  297.  
  298.         For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
  299.             iNextX = iNextX + 4
  300.             If iNextX >= iMaxX Then
  301.                 iNextX = iMinX
  302.                 iNextY = iNextY + 4
  303.                 If iNextY > iMaxY Then
  304.                     iNextY = iMinY
  305.                 End If
  306.             End If
  307.             iNextC = iNextC + 1
  308.             m_arrPlayer(iPlayer).x = iNextX
  309.             m_arrPlayer(iPlayer).y = iNextY
  310.             m_arrPlayer(iPlayer).c = iNextC
  311.             m_arrPlayer(iPlayer).xOld = iNextX
  312.             m_arrPlayer(iPlayer).yOld = iNextY
  313.  
  314.             m_arrPlayer(iPlayer).moveX = 0
  315.             m_arrPlayer(iPlayer).moveY = 0
  316.  
  317.             m_arrPlayer(iPlayer).moveUp = FALSE
  318.             m_arrPlayer(iPlayer).moveDown = FALSE
  319.             m_arrPlayer(iPlayer).moveLeft = FALSE
  320.             m_arrPlayer(iPlayer).moveRight = FALSE
  321.             m_arrPlayer(iPlayer).button1 = FALSE
  322.             m_arrPlayer(iPlayer).button2 = FALSE
  323.             m_arrPlayer(iPlayer).button3 = FALSE
  324.             m_arrPlayer(iPlayer).button4 = FALSE
  325.  
  326.             m_arrPlayer(iPlayer).lastMoveUp = FALSE
  327.             m_arrPlayer(iPlayer).lastMoveDown = FALSE
  328.             m_arrPlayer(iPlayer).lastMoveLeft = FALSE
  329.             m_arrPlayer(iPlayer).lastMoveRight = FALSE
  330.             m_arrPlayer(iPlayer).lastButton1 = FALSE
  331.             m_arrPlayer(iPlayer).lastButton2 = FALSE
  332.             m_arrPlayer(iPlayer).lastButton3 = FALSE
  333.             m_arrPlayer(iPlayer).lastButton4 = FALSE
  334.         Next iPlayer
  335.  
  336.         ' COUNT # OF JOYSTICKS
  337.         ' TODO: find out the right way to count joysticks
  338.         If Len(sError) = 0 Then
  339.             ' D= _DEVICES ' MUST be read in order for other 2 device functions to work!
  340.             iDeviceCount = _Devices ' Find the number of devices on someone's system
  341.  
  342.             If iDeviceCount > 2 Then
  343.                 ' LIMIT # OF DEVICES, IF THERE IS A LIMIT DEFINED
  344.                 iNumControllers = iDeviceCount - 2
  345.                 If cMaxControllers > 0 Then
  346.                     If iNumControllers > cMaxControllers Then
  347.                         iNumControllers = cMaxControllers
  348.                     End If
  349.                 End If
  350.             Else
  351.                 ' ONLY 2 FOUND (KEYBOARD, MOUSE)
  352.                 'sError = "No game controllers found."
  353.                 iNumControllers = 0
  354.             End If
  355.         End If
  356.  
  357.         ' INITIALIZE CONTROLLER DATA
  358.         If Len(sError) = 0 Then
  359.             For iController = 1 To iNumControllers
  360.                 m_arrController(iController).buttonCount = cMaxButtons
  361.                 m_arrController(iController).axisCount = cMaxAxis
  362.                 For iLoop = 1 To cMaxButtons
  363.                     arrButtonNew(iController, iLoop) = TRUE
  364.                 Next iLoop
  365.                 For iLoop = 1 To cMaxAxis
  366.                     arrAxisNew(iController, iLoop) = TRUE
  367.                 Next iLoop
  368.             Next iController
  369.         End If
  370.  
  371.         ' INITIALIZE CONTROLLER INPUT
  372.         If Len(sError) = 0 Then
  373.             _KeyClear: _Delay 1
  374.             For iController = 1 To iNumControllers
  375.                 iDevice = iController + 2
  376.                 While _DeviceInput(iDevice) ' clear and update the device buffer
  377.                     For iLoop = 1 To _LastButton(iDevice)
  378.                         If (iLoop > cMaxButtons) Then Exit For
  379.                         m_arrController(iController).buttonCount = iLoop
  380.                         arrButton(iController, iLoop) = FALSE
  381.                     Next iLoop
  382.                     For iLoop = 1 To _LastAxis(iDevice) ' this loop checks all my axis
  383.                         If (iLoop > cMaxAxis) Then Exit For
  384.                         m_arrController(iController).axisCount = iLoop
  385.                         arrAxis(iController, iLoop) = 0
  386.                     Next iLoop
  387.                 Wend ' clear and update the device buffer
  388.             Next iController
  389.         End If
  390.  
  391.         ' GET INPUT AND MOVE PLAYERS AROUND ON SCREEN
  392.         _KeyClear: _Delay 1
  393.         bFinished = FALSE
  394.         Do
  395.             ' Clear control buffer for players
  396.             For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
  397.                 m_arrPlayer(iPlayer).moveUp = FALSE
  398.                 m_arrPlayer(iPlayer).moveDown = FALSE
  399.                 m_arrPlayer(iPlayer).moveLeft = FALSE
  400.                 m_arrPlayer(iPlayer).moveRight = FALSE
  401.                 m_arrPlayer(iPlayer).button1 = FALSE
  402.                 m_arrPlayer(iPlayer).button2 = FALSE
  403.                 m_arrPlayer(iPlayer).button3 = FALSE
  404.                 m_arrPlayer(iPlayer).button4 = FALSE
  405.             Next iPlayer
  406.  
  407.             ' -----------------------------------------------------------------------------
  408.             ' BEGIN CHECK FOR CONTROLLER INPUT
  409.             If iNumControllers > 0 Then
  410.                 For iController = 1 To iNumControllers
  411.                     iDevice = iController + 2
  412.  
  413.                     ' Check all devices
  414.                     While _DeviceInput(iDevice)
  415.                     Wend ' clear and update the device buffer
  416.  
  417.                     ' Check each button
  418.                     For iLoop = 1 To _LastButton(iDevice)
  419.                         If (iLoop > cMaxButtons) Then Exit For
  420.  
  421.                         ' update button array to indicate if a button is up or down currently.
  422.                         'if TRUE=TRUE then
  423.                         If _ButtonChange(iLoop) Then
  424.                             iValue = _Button(iLoop)
  425.                             If iValue <> arrButton(iController, iLoop) Then
  426.                                 ' *****************************************************************************
  427.                                 ' PRESSED BUTTON
  428.  
  429.                                 ' BEGIN find who this is mapped for
  430.                                 bFoundWho = FALSE
  431.                                 For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
  432.                                     For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  433.                                         If m_arrControlMap(iPlayer, iWhichInput).device = iDevice Then
  434.                                             If m_arrControlMap(iPlayer, iWhichInput).typ = cInputButton Then
  435.                                                 If m_arrControlMap(iPlayer, iWhichInput).code = iLoop Then
  436.                                                     'if m_arrControlMap(iPlayer, iWhichInput).value = iValue then
  437.                                                     bFoundWho = TRUE
  438.                                                     Select Case iWhichInput
  439.                                                         Case cInputUp:
  440.                                                             m_arrPlayer(iPlayer).moveUp = TRUE
  441.                                                         Case cInputDown:
  442.                                                             m_arrPlayer(iPlayer).moveDown = TRUE
  443.                                                         Case cInputLeft:
  444.                                                             m_arrPlayer(iPlayer).moveLeft = TRUE
  445.                                                         Case cInputRight:
  446.                                                             m_arrPlayer(iPlayer).moveRight = TRUE
  447.                                                         Case cInputButton1:
  448.                                                             m_arrPlayer(iPlayer).button1 = TRUE
  449.                                                         Case cInputButton2:
  450.                                                             m_arrPlayer(iPlayer).button2 = TRUE
  451.                                                         Case cInputButton3:
  452.                                                             m_arrPlayer(iPlayer).button3 = TRUE
  453.                                                         Case cInputButton4:
  454.                                                             m_arrPlayer(iPlayer).button4 = TRUE
  455.                                                         Case Else:
  456.                                                             '(IGNORE)
  457.                                                     End Select
  458.                                                     Exit For
  459.                                                     'end if
  460.                                                 End If
  461.                                             End If
  462.                                         End If
  463.                                     Next iWhichInput
  464.                                     If bFoundWho = TRUE Then Exit For
  465.                                 Next iPlayer
  466.                                 ' END find who this is mapped for
  467.  
  468.                             End If
  469.                         End If
  470.                     Next iLoop
  471.  
  472.                     ' Check each axis
  473.                     For iLoop = 1 To _LastAxis(iDevice)
  474.                         If (iLoop > cMaxAxis) Then Exit For
  475.                         dblNextAxis = _Axis(iLoop)
  476.                         dblNextAxis = RoundUpDouble#(dblNextAxis, 3)
  477.  
  478.                         ' I like to give a little "jiggle" resistance to my controls, as I have an old joystick
  479.                         ' which is prone to always give minute values and never really center on true 0.
  480.                         ' A value of 1 means my axis is pushed fully in one direction.
  481.                         ' A value greater than 0.1 means it's been partially pushed in a direction (such as at a 45 degree diagional angle).
  482.                         ' A value of less than 0.1 means we count it as being centered. (As if it was 0.)
  483.  
  484.                         ' Set sensitivity:
  485.                         'These are way too sensitive for analog:
  486.                         'IF ABS(_AXIS(iLoop)) <= 1 AND ABS(_AXIS(iLoop)) >= .1 THEN
  487.                         'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .01 THEN
  488.                         'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .001 THEN
  489.                         ''For digital input, we'll use a big picture:
  490.                         'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= 0.75 THEN
  491.                         If Abs(dblNextAxis) <= 1 And Abs(dblNextAxis) >= 0.5 Then
  492.  
  493.                             ' WE WANT CONTINUOUS MOVEMENT (DISABLE FOR NOT)
  494.                             'if TRUE=TRUE then
  495.                             If dblNextAxis <> arrAxis(iController, iLoop) Then
  496.                                 ' *****************************************************************************
  497.                                 ' MOVED STICK
  498.  
  499.                                 ' convert to a digital value
  500.                                 If dblNextAxis < 0 Then
  501.                                     iValue = -1
  502.                                 Else
  503.                                     iValue = 1
  504.                                 End If
  505.  
  506.                                 ' BEGIN find who this is mapped for
  507.                                 bFoundWho = FALSE
  508.                                 For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
  509.                                     For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  510.                                         If m_arrControlMap(iPlayer, iWhichInput).device = iDevice Then
  511.                                             If m_arrControlMap(iPlayer, iWhichInput).typ = cInputAxis Then
  512.                                                 If m_arrControlMap(iPlayer, iWhichInput).code = iLoop Then
  513.                                                     If m_arrControlMap(iPlayer, iWhichInput).value = iValue Then
  514.                                                         bFoundWho = TRUE
  515.                                                         Select Case iWhichInput
  516.                                                             Case cInputUp:
  517.                                                                 m_arrPlayer(iPlayer).moveUp = TRUE
  518.                                                             Case cInputDown:
  519.                                                                 m_arrPlayer(iPlayer).moveDown = TRUE
  520.                                                             Case cInputLeft:
  521.                                                                 m_arrPlayer(iPlayer).moveLeft = TRUE
  522.                                                             Case cInputRight:
  523.                                                                 m_arrPlayer(iPlayer).moveRight = TRUE
  524.                                                             Case cInputButton1:
  525.                                                                 m_arrPlayer(iPlayer).button1 = TRUE
  526.                                                             Case cInputButton2:
  527.                                                                 m_arrPlayer(iPlayer).button2 = TRUE
  528.                                                             Case cInputButton3:
  529.                                                                 m_arrPlayer(iPlayer).button3 = TRUE
  530.                                                             Case cInputButton4:
  531.                                                                 m_arrPlayer(iPlayer).button4 = TRUE
  532.                                                             Case Else:
  533.                                                                 '(IGNORE)
  534.                                                         End Select
  535.                                                         Exit For
  536.                                                     End If
  537.                                                 End If
  538.                                             End If
  539.                                         End If
  540.                                     Next iWhichInput
  541.                                     If bFoundWho = TRUE Then Exit For
  542.                                 Next iPlayer
  543.                                 ' END find who this is mapped for
  544.  
  545.                             End If
  546.                         End If
  547.                     Next iLoop
  548.  
  549.                 Next iController
  550.             End If
  551.             ' END CHECK FOR CONTROLLER INPUT
  552.             ' -----------------------------------------------------------------------------
  553.  
  554.             ' -----------------------------------------------------------------------------
  555.             ' BEGIN CHECK FOR KEYBOARD INPUT #1
  556.             '_KEYCLEAR: _DELAY 1
  557.             While _DeviceInput(1): Wend ' clear and update the keyboard buffer
  558.  
  559.             ' Detect changed key state
  560.             iDevice = 1 ' keyboard
  561.             For iLoop = LBound(m_arrButtonCode) To UBound(m_arrButtonCode)
  562.                 iCode = m_arrButtonCode(iLoop)
  563.                 If _Button(iCode) <> FALSE Then
  564.                     ' *****************************************************************************
  565.                     ' PRESSED KEYBOARD
  566.                     'PRINT "PRESSED " + m_arrButtonKey(iLoop)
  567.  
  568.                     ' BEGIN find who this is mapped for
  569.                     bFoundWho = FALSE
  570.                     For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
  571.                         For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  572.                             If m_arrControlMap(iPlayer, iWhichInput).device = iDevice Then
  573.                                 If m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey Then
  574.                                     'if m_arrControlMap(iPlayer, iWhichInput).code = iLoop then
  575.                                     If m_arrControlMap(iPlayer, iWhichInput).code = iCode Then
  576.                                         'if m_arrControlMap(iPlayer, iWhichInput).value = iValue then
  577.                                         bFoundWho = TRUE
  578.                                         Select Case iWhichInput
  579.                                             Case cInputUp:
  580.                                                 m_arrPlayer(iPlayer).moveUp = TRUE
  581.                                             Case cInputDown:
  582.                                                 m_arrPlayer(iPlayer).moveDown = TRUE
  583.                                             Case cInputLeft:
  584.                                                 m_arrPlayer(iPlayer).moveLeft = TRUE
  585.                                             Case cInputRight:
  586.                                                 m_arrPlayer(iPlayer).moveRight = TRUE
  587.                                             Case cInputButton1:
  588.                                                 m_arrPlayer(iPlayer).button1 = TRUE
  589.                                             Case cInputButton2:
  590.                                                 m_arrPlayer(iPlayer).button2 = TRUE
  591.                                             Case cInputButton3:
  592.                                                 m_arrPlayer(iPlayer).button3 = TRUE
  593.                                             Case cInputButton4:
  594.                                                 m_arrPlayer(iPlayer).button4 = TRUE
  595.                                             Case Else:
  596.                                                 '(IGNORE)
  597.                                         End Select
  598.                                         Exit For
  599.                                         'end if
  600.                                     End If
  601.                                 End If
  602.                             End If
  603.                         Next iWhichInput
  604.                         If bFoundWho = TRUE Then Exit For
  605.                     Next iPlayer
  606.                     ' END find who this is mapped for
  607.  
  608.                 End If
  609.             Next iLoop
  610.             ' END CHECK FOR KEYBOARD INPUT #1
  611.             ' -----------------------------------------------------------------------------
  612.  
  613.             ' NOW DRAW PLAYERS ON SCREEN
  614.             For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
  615.  
  616.                 ' -----------------------------------------------------------------------------
  617.                 ' BEGIN UPDATE MOVEMENT CONTROL STATES
  618.                 ' If repeating keys are disabled then
  619.                 ' disable until the key has been released
  620.  
  621.                 If m_arrControlMap(iPlayer, cInputUp).repeat = FALSE Then
  622.                     If m_arrPlayer(iPlayer).moveUp = TRUE Then
  623.                         If m_arrPlayer(iPlayer).lastMoveUp = TRUE Then
  624.                             m_arrPlayer(iPlayer).moveUp = FALSE
  625.                         End If
  626.                     Else
  627.                         m_arrPlayer(iPlayer).lastMoveUp = FALSE
  628.                     End If
  629.                 End If
  630.  
  631.                 If m_arrControlMap(iPlayer, cInputDown).repeat = FALSE Then
  632.                     If m_arrPlayer(iPlayer).moveDown = TRUE Then
  633.                         If m_arrPlayer(iPlayer).lastMoveDown = TRUE Then
  634.                             m_arrPlayer(iPlayer).moveDown = FALSE
  635.                         End If
  636.                     Else
  637.                         m_arrPlayer(iPlayer).lastMoveDown = FALSE
  638.                     End If
  639.                 End If
  640.  
  641.                 If m_arrControlMap(iPlayer, cInputLeft).repeat = FALSE Then
  642.                     If m_arrPlayer(iPlayer).moveLeft = TRUE Then
  643.                         If m_arrPlayer(iPlayer).lastMoveLeft = TRUE Then
  644.                             m_arrPlayer(iPlayer).moveLeft = FALSE
  645.                         End If
  646.                     Else
  647.                         m_arrPlayer(iPlayer).lastMoveLeft = FALSE
  648.                     End If
  649.                 End If
  650.  
  651.                 If m_arrControlMap(iPlayer, cInputRight).repeat = FALSE Then
  652.                     If m_arrPlayer(iPlayer).moveRight = TRUE Then
  653.                         If m_arrPlayer(iPlayer).lastMoveRight = TRUE Then
  654.                             m_arrPlayer(iPlayer).moveRight = FALSE
  655.                         End If
  656.                     Else
  657.                         m_arrPlayer(iPlayer).lastMoveRight = FALSE
  658.                     End If
  659.                 End If
  660.                 ' END UPDATE MOVEMENT CONTROL STATES
  661.                 ' -----------------------------------------------------------------------------
  662.  
  663.                 ' -----------------------------------------------------------------------------
  664.                 ' BEGIN MOVEMENT ACTIONS
  665.  
  666.                 m_arrPlayer(iPlayer).moveY = 0
  667.                 m_arrPlayer(iPlayer).moveX = 0
  668.  
  669.                 If m_arrPlayer(iPlayer).moveUp = TRUE Then
  670.                     m_arrPlayer(iPlayer).moveY = -1
  671.                     m_arrPlayer(iPlayer).lastMoveUp = TRUE
  672.                 End If
  673.  
  674.                 If m_arrPlayer(iPlayer).moveDown = TRUE Then
  675.                     m_arrPlayer(iPlayer).moveY = 1
  676.                     m_arrPlayer(iPlayer).lastMoveDown = TRUE
  677.                 End If
  678.  
  679.                 If m_arrPlayer(iPlayer).moveLeft = TRUE Then
  680.                     m_arrPlayer(iPlayer).moveX = -1
  681.                     m_arrPlayer(iPlayer).lastMoveLeft = TRUE
  682.                 End If
  683.  
  684.                 If m_arrPlayer(iPlayer).moveRight = TRUE Then
  685.                     m_arrPlayer(iPlayer).moveX = 1
  686.                     m_arrPlayer(iPlayer).lastMoveRight = TRUE
  687.                 End If
  688.                 ' END MOVEMENT ACTIONS
  689.                 ' -----------------------------------------------------------------------------
  690.  
  691.  
  692.                 ' -----------------------------------------------------------------------------
  693.                 ' BEGIN MOVEMENT
  694.  
  695.                 ' MOVE RIGHT/LEFT
  696.                 m_arrPlayer(iPlayer).x = m_arrPlayer(iPlayer).x + m_arrPlayer(iPlayer).moveX
  697.                 If m_arrPlayer(iPlayer).x < iMinX Then
  698.                     m_arrPlayer(iPlayer).x = m_arrPlayer(iPlayer).xOld ' iMinX
  699.                 ElseIf m_arrPlayer(iPlayer).x > iMaxX Then
  700.                     m_arrPlayer(iPlayer).x = m_arrPlayer(iPlayer).xOld ' iMaxX
  701.                 End If
  702.  
  703.                 ' MOVE UP/DOWN
  704.                 m_arrPlayer(iPlayer).y = m_arrPlayer(iPlayer).y + m_arrPlayer(iPlayer).moveY
  705.                 If m_arrPlayer(iPlayer).y < iMinY Then
  706.                     m_arrPlayer(iPlayer).y = m_arrPlayer(iPlayer).yOld ' iMinY
  707.                 ElseIf m_arrPlayer(iPlayer).y > iMaxY Then
  708.                     m_arrPlayer(iPlayer).y = m_arrPlayer(iPlayer).yOld ' iMaxY
  709.                 End If
  710.  
  711.                 ' UPDATE SCREEN
  712.                 '_PRINTSTRING (m_arrPlayer(iPlayer).xOld, m_arrPlayer(iPlayer).yOld), " "
  713.                 '_PRINTSTRING (m_arrPlayer(iPlayer).x, m_arrPlayer(iPlayer).y), CHR$(m_arrPlayer(iPlayer).c)
  714.                 PrintString m_arrPlayer(iPlayer).xOld, m_arrPlayer(iPlayer).yOld, " "
  715.                 PrintString m_arrPlayer(iPlayer).x, m_arrPlayer(iPlayer).y, Chr$(m_arrPlayer(iPlayer).c)
  716.                 m_arrPlayer(iPlayer).xOld = m_arrPlayer(iPlayer).x
  717.                 m_arrPlayer(iPlayer).yOld = m_arrPlayer(iPlayer).y
  718.  
  719.                 ' END MOVEMENT
  720.                 ' -----------------------------------------------------------------------------
  721.  
  722.  
  723.  
  724.  
  725.  
  726.  
  727.  
  728.                 ' -----------------------------------------------------------------------------
  729.                 ' BEGIN UPDATE BUTTON STATES
  730.                 ' If repeating keys are disabled then
  731.                 ' disable until the key has been released
  732.  
  733.                 'if m_bRepeatButton1 = FALSE then
  734.                 If m_arrControlMap(iPlayer, cInputButton1).repeat = FALSE Then
  735.                     If m_arrPlayer(iPlayer).button1 = TRUE Then
  736.                         If m_arrPlayer(iPlayer).lastButton1 = TRUE Then
  737.                             m_arrPlayer(iPlayer).button1 = FALSE
  738.                         End If
  739.                     Else
  740.                         m_arrPlayer(iPlayer).lastButton1 = FALSE
  741.                     End If
  742.                 End If
  743.                 If m_arrControlMap(iPlayer, cInputButton2).repeat = FALSE Then
  744.                     If m_arrPlayer(iPlayer).button2 = TRUE Then
  745.                         If m_arrPlayer(iPlayer).lastButton2 = TRUE Then
  746.                             m_arrPlayer(iPlayer).button2 = FALSE
  747.                         End If
  748.                     Else
  749.                         m_arrPlayer(iPlayer).lastButton2 = FALSE
  750.                     End If
  751.                 End If
  752.                 If m_arrControlMap(iPlayer, cInputButton3).repeat = FALSE Then
  753.                     If m_arrPlayer(iPlayer).button3 = TRUE Then
  754.                         If m_arrPlayer(iPlayer).lastButton3 = TRUE Then
  755.                             m_arrPlayer(iPlayer).button3 = FALSE
  756.                         End If
  757.                     Else
  758.                         m_arrPlayer(iPlayer).lastButton3 = FALSE
  759.                     End If
  760.                 End If
  761.                 If m_arrControlMap(iPlayer, cInputButton4).repeat = FALSE Then
  762.                     If m_arrPlayer(iPlayer).button4 = TRUE Then
  763.                         If m_arrPlayer(iPlayer).lastButton4 = TRUE Then
  764.                             m_arrPlayer(iPlayer).button4 = FALSE
  765.                         End If
  766.                     Else
  767.                         m_arrPlayer(iPlayer).lastButton4 = FALSE
  768.                     End If
  769.                 End If
  770.                 ' END UPDATE BUTTON STATES
  771.                 ' -----------------------------------------------------------------------------
  772.  
  773.  
  774.  
  775.                 ' -----------------------------------------------------------------------------
  776.                 ' BEGIN BUTTON ACTIONS
  777.                 If m_arrPlayer(iPlayer).button1 = TRUE Then
  778.                     MakeSound iPlayer, 1
  779.                     m_arrPlayer(iPlayer).lastButton1 = TRUE
  780.                 End If
  781.  
  782.                 If m_arrPlayer(iPlayer).button2 = TRUE Then
  783.                     MakeSound iPlayer, 2
  784.                     m_arrPlayer(iPlayer).lastButton2 = TRUE
  785.                 End If
  786.  
  787.                 If m_arrPlayer(iPlayer).button3 = TRUE Then
  788.                     MakeSound iPlayer, 3
  789.                     m_arrPlayer(iPlayer).lastButton3 = TRUE
  790.                 End If
  791.  
  792.                 If m_arrPlayer(iPlayer).button4 = TRUE Then
  793.                     MakeSound iPlayer, 4
  794.                     m_arrPlayer(iPlayer).lastButton4 = TRUE
  795.                 End If
  796.                 ' END BUTTON ACTIONS
  797.                 ' -----------------------------------------------------------------------------
  798.  
  799.             Next iPlayer
  800.  
  801.             _Limit 30
  802.         Loop Until _KeyHit = 27 ' ESCAPE to quit
  803.         _KeyClear: _Delay 1
  804.  
  805.         sResult = sError
  806.     Else
  807.         sResult = "No mapping loaded. Please load a mapping or map keys."
  808.     End If
  809.  
  810.     TestMappings$ = sResult
  811. End Function ' TestMappings$
  812.  
  813. ' /////////////////////////////////////////////////////////////////////////////
  814.  
  815. Sub MakeSound (iPlayer As Integer, iButton As Integer)
  816.     Dim note%
  817.     If iPlayer < 1 Then
  818.         iPlayer = 1
  819.     ElseIf iPlayer > 8 Then
  820.         iPlayer = 8
  821.     End If
  822.     If iButton < 1 Then
  823.         iButton = 1
  824.     ElseIf iButton > 4 Then
  825.         iButton = 4
  826.     End If
  827.  
  828.     note% = iPlayer * 100 + (iButton * 25)
  829.     If note% > 4186 Then
  830.         note% = 4186
  831.     End If
  832.     Sound note%, .75
  833. End Sub ' MakeSound
  834.  
  835. ' /////////////////////////////////////////////////////////////////////////////
  836. ' V2 prints in 2 columns.
  837.  
  838. Sub PrintControllerMap2
  839.     Dim RoutineName As String:: RoutineName = "PrintControllerMap2"
  840.     Dim iPlayer As Integer
  841.     Dim iWhichInput As Integer
  842.     Dim iCount As Integer
  843.     Dim sLine As String
  844.     Dim iHalf As Integer
  845.     Dim sColumn1 As String: sColumn1 = ""
  846.     Dim sColumn2 As String: sColumn2 = ""
  847.     ReDim arrColumn1(-1) As String
  848.     ReDim arrColumn2(-1) As String
  849.     Dim iLoop As Integer
  850.     Dim iColWidth As Integer: iColWidth = 75
  851.     Dim sValue As String
  852.     Dim in$
  853.  
  854.     ' INITIALIZE
  855.     InitKeyboardButtonCodes
  856.  
  857.     ' START OUTPUT
  858.     Print "Controller mapping:"
  859.     'Print "Player#  Input      Device#  Type     Code              Value"
  860.     '       1        button #2  x        unknown  x                 x
  861.     '       9        11         9        9        18                9
  862.     '       12345678912345678901123456789123456789123456789012345678123456789
  863.     '       12345678901234567890123456789012345678901234567890123456789012345678901234567890
  864.     '       00000000011111111112222222222333333333344444444445555555555666666666677777777778
  865.  
  866.     If m_bHaveMapping = TRUE Then
  867.         ' THIS IS A LAZY WAY TO GET 2 COLUMNS!
  868.         iHalf = UBound(m_arrControlMap, 1) / 2
  869.  
  870.         sLine = "Player#  Input      Device#  Type     Code              Value    Repeat"
  871.         sColumn1 = sColumn1 + StrPadRight$(sLine, iColWidth) + Chr$(13)
  872.         sLine = "-----------------------------------------------------------------------"
  873.         sColumn1 = sColumn1 + StrPadRight$(sLine, iColWidth) + Chr$(13)
  874.         For iPlayer = LBound(m_arrControlMap, 1) To iHalf
  875.             iCount = 0
  876.             For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  877.                 If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
  878.                     iCount = iCount + 1
  879.                 End If
  880.             Next iWhichInput
  881.             If iCount > 0 Then
  882.                 For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  883.                     If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
  884.                         sLine = IntPadRight$(iPlayer, 9)
  885.                         sLine = sLine + StrPadRight$(InputToString$(iWhichInput), 11)
  886.                         sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).device, 9)
  887.                         sLine = sLine + StrPadRight$(InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ), 9)
  888.  
  889.                         'sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 9)
  890.                         If m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey Then
  891.                             sValue = GetKeyboardButtonCodeText$(m_arrControlMap(iPlayer, iWhichInput).code)
  892.                             sValue = StrPadRight$(sValue, 18)
  893.                         Else
  894.                             sValue = IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 18)
  895.                         End If
  896.                         sLine = sLine + sValue
  897.  
  898.                         sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).value, 9)
  899.  
  900.                         sValue = TrueFalse$(m_arrControlMap(iPlayer, iWhichInput).repeat)
  901.                         sLine = sLine + StrPadRight$(sValue, 6)
  902.  
  903.                         'Print sLine
  904.                         sLine = StrPadRight$(sLine, iColWidth)
  905.                         sColumn1 = sColumn1 + sLine + Chr$(13)
  906.                     End If
  907.                 Next iWhichInput
  908.             Else
  909.                 sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
  910.                 'Print sLine
  911.                 sLine = StrPadRight$(sLine, iColWidth)
  912.                 sColumn1 = sColumn1 + sLine + Chr$(13)
  913.             End If
  914.         Next iPlayer
  915.  
  916.         'sLine = "Player#  Input      Device#  Type     Code              Value"
  917.         sLine = "Player#  Input      Device#  Type     Code              Value    Repeat"
  918.         sColumn2 = sColumn2 + StrPadRight$(sLine, iColWidth) + Chr$(13)
  919.         'sLine = "-------------------------------------------------------------"
  920.         sLine = "-----------------------------------------------------------------------"
  921.         sColumn2 = sColumn2 + StrPadRight$(sLine, iColWidth) + Chr$(13)
  922.         For iPlayer = iHalf + 1 To UBound(m_arrControlMap, 1)
  923.             iCount = 0
  924.             For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  925.                 If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
  926.                     iCount = iCount + 1
  927.                 End If
  928.             Next iWhichInput
  929.             If iCount > 0 Then
  930.                 For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  931.                     If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
  932.                         sLine = IntPadRight$(iPlayer, 9)
  933.                         sLine = sLine + StrPadRight$(InputToString$(iWhichInput), 11)
  934.                         sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).device, 9)
  935.                         sLine = sLine + StrPadRight$(InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ), 9)
  936.  
  937.                         'sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 9)
  938.                         If m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey Then
  939.                             sValue = GetKeyboardButtonCodeText$(m_arrControlMap(iPlayer, iWhichInput).code)
  940.                             sValue = StrPadRight$(sValue, 18)
  941.                         Else
  942.                             sValue = IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 18)
  943.                         End If
  944.                         sLine = sLine + sValue
  945.  
  946.                         sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).value, 9)
  947.  
  948.                         sValue = TrueFalse$(m_arrControlMap(iPlayer, iWhichInput).repeat)
  949.                         sLine = sLine + StrPadRight$(sValue, 6)
  950.  
  951.                         'Print sLine
  952.                         sLine = StrPadRight$(sLine, iColWidth)
  953.                         sColumn2 = sColumn2 + sLine + Chr$(13)
  954.                     End If
  955.                 Next iWhichInput
  956.             Else
  957.                 sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
  958.                 'Print sLine
  959.                 sLine = StrPadRight$(sLine, iColWidth)
  960.                 sColumn2 = sColumn2 + sLine + Chr$(13)
  961.             End If
  962.         Next iPlayer
  963.  
  964.         split sColumn1, Chr$(13), arrColumn1()
  965.         split sColumn2, Chr$(13), arrColumn2()
  966.         If UBound(arrColumn1) > UBound(arrColumn2) Then
  967.             iCount = UBound(arrColumn1)
  968.         Else
  969.             iCount = UBound(arrColumn2)
  970.         End If
  971.         For iLoop = 0 To iCount
  972.             sLine = ""
  973.             If UBound(arrColumn1) >= iLoop Then
  974.                 sLine = sLine + arrColumn1(iLoop)
  975.             Else
  976.                 sLine = sLine + String$(iColWidth, " ")
  977.             End If
  978.             sLine = sLine + "     "
  979.             If UBound(arrColumn2) >= iLoop Then
  980.                 sLine = sLine + arrColumn2(iLoop)
  981.             Else
  982.                 sLine = sLine + String$(iColWidth, " ")
  983.             End If
  984.             Print sLine
  985.         Next iLoop
  986.     Else
  987.         Print "No mapping loaded. Please load a mapping or map keys."
  988.     End If
  989.  
  990. End Sub ' PrintControllerMap2
  991.  
  992. ' /////////////////////////////////////////////////////////////////////////////
  993. ' Original (simple) routine
  994.  
  995. Sub PrintControllerMap1
  996.     Dim RoutineName As String:: RoutineName = "PrintControllerMap1"
  997.     Dim iPlayer As Integer
  998.     Dim iWhichInput As Integer
  999.     Dim sLine As String
  1000.     Dim iCount As Integer
  1001.     Dim in$
  1002.  
  1003.     ' INITIALIZE
  1004.     InitKeyboardButtonCodes
  1005.  
  1006.     ' OUTPUT MAPPING
  1007.     Print "Controller mapping:"
  1008.     Print "Player#  Input      Device#  Type     Code     Value"
  1009.     '      1        button #2  x        unknown  x        x
  1010.     '      9        11         9        9        9        9
  1011.     '      12345678912345678901123456789123456789123456789123456789
  1012.     '      12345678901234567890123456789012345678901234567890123456789012345678901234567890
  1013.     For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
  1014.         iCount = 0
  1015.         For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  1016.             If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
  1017.                 iCount = iCount + 1
  1018.             End If
  1019.         Next iWhichInput
  1020.         If iCount > 0 Then
  1021.             For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  1022.                 If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
  1023.                     sLine = IntPadRight$(iPlayer, 9)
  1024.                     sLine = sLine + StrPadRight$(InputToString$(iWhichInput), 11)
  1025.                     sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).device, 9)
  1026.                     sLine = sLine + StrPadRight$(InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ), 9)
  1027.                     sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 9)
  1028.                     sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).value, 9)
  1029.                     Print sLine
  1030.                 End If
  1031.             Next iWhichInput
  1032.         Else
  1033.             sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
  1034.             Print sLine
  1035.         End If
  1036.     Next iPlayer
  1037. End Sub ' PrintControllerMap1
  1038.  
  1039. ' /////////////////////////////////////////////////////////////////////////////
  1040.  
  1041. Function LoadMappings$
  1042.     Dim sResult As String: sResult = ""
  1043.  
  1044.     ' INITIALIZE
  1045.     InitKeyboardButtonCodes
  1046.  
  1047.     ' Try loading map
  1048.     sResult = LoadControllerMap$
  1049.  
  1050.     LoadMappings$ = sResult
  1051. End Function ' LoadMappings$
  1052.  
  1053. ' /////////////////////////////////////////////////////////////////////////////
  1054.  
  1055. Function SaveMappings$
  1056.     Dim sResult As String: sResult = ""
  1057.     Dim sError As String: sError = ""
  1058.  
  1059.     ' INITIALIZE
  1060.     InitKeyboardButtonCodes
  1061.  
  1062.     ' Try saving map
  1063.     sResult = SaveControllerMap$
  1064.  
  1065.     SaveMappings$ = sResult
  1066. End Function ' SaveMappings$
  1067.  
  1068.  
  1069. ' /////////////////////////////////////////////////////////////////////////////
  1070.  
  1071. Function ViewMappings$
  1072.     ' INITIALIZE
  1073.     InitKeyboardButtonCodes
  1074.  
  1075.     PrintControllerMap2
  1076.     Print
  1077.     Input "PRESS <ENTER> TO CONTINUE", in$
  1078.     Print
  1079.     ViewMappings$ = ""
  1080. End Function ' ViewMappings$
  1081.  
  1082. ' /////////////////////////////////////////////////////////////////////////////
  1083. ' TODO: test this
  1084.  
  1085. Function EditMappings$
  1086.     Dim RoutineName As String: RoutineName = "EditMappings$"
  1087.     Dim in$
  1088.     Dim iPlayer As Integer
  1089.     Dim iWhichInput As Integer
  1090.     Dim iDevice As Integer
  1091.     Dim iType As Integer
  1092.     Dim iCode As Integer
  1093.     Dim iValue As Integer
  1094.     Dim iRepeat As Integer
  1095.     Dim iItem As Integer
  1096.     Dim sResult As String: sResult = ""
  1097.     Dim bContinue1 As Integer: bContinue1 = TRUE
  1098.     Dim bContinue2 As Integer: bContinue2 = TRUE
  1099.     Dim bContinue3 As Integer: bContinue3 = TRUE
  1100.     Dim bContinue4 As Integer: bContinue4 = TRUE
  1101.  
  1102.     ' INITIALIZE
  1103.     InitKeyboardButtonCodes
  1104.  
  1105.     ' EDIT
  1106.     Do
  1107.         PrintControllerMap2
  1108.         Print "To edit a mapping, enter a player number: " _
  1109.             "1-" + cstr$(cMaxPlayers) + ", " + _
  1110.             cstr$(cMaxPlayers+1) + ") or q to exit."
  1111.         Input "Edit mapping for player"; in$
  1112.         If IsNum%(in$) Then
  1113.             iPlayer = Val(in$)
  1114.             If iPlayer > 0 And iPlayer <= cMaxPlayers Then
  1115.                 bContinue2 = TRUE
  1116.                 Do
  1117.                     Print "Editing mappings for player " + cstr$(iPlayer) + "."
  1118.                     For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  1119.                         'Print right$("  " + cstr$(iWhichInput), 2) + ". " + InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ)
  1120.                         Print Right$("  " + cstr$(iWhichInput), 2) + ". " + InputToString$(iWhichInput)
  1121.                     Next iWhichInput
  1122.                     Input "Type # of control to edit or q to quit editing player"; in$
  1123.                     If IsNum%(in$) Then
  1124.                         iWhichInput = Val(in$)
  1125.                         If iWhichInput >= LBound(m_arrControlMap, 2) And m_arrControlMap <= UBound(m_arrControlMap, 2) Then
  1126.                             bContinue3 = TRUE
  1127.                             Do
  1128.                                 Print "Settings for " + InputToString$(iWhichInput) + ":"
  1129.                                 Print "1. Device #     : " + cstr$(m_arrControlMap(iPlayer, iWhichInput).device)
  1130.                                 Print "2. Device type  : " + InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ)
  1131.  
  1132.                                 If m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey Then
  1133.                                     Print "3. Input code   : " + GetKeyboardButtonCodeText$(m_arrControlMap(iPlayer, iWhichInput).code) + _
  1134.                                         " (" + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).code)) + ")"
  1135.                                 Else
  1136.                                     Print "3. Input code   : " + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).code))
  1137.                                 End If
  1138.  
  1139.                                 Print "4. Input value  : " + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).value))
  1140.                                 Print "5. Enable repeat: " + TrueFalse$(m_arrControlMap(iPlayer, iWhichInput).repeat)
  1141.                                 Input "Change item? (1-5 or q to quit editing control)"; in$
  1142.                                 If IsNum%(in$) Then
  1143.                                     iItem = Val(in$)
  1144.                                     Select Case iItem
  1145.                                         Case 1:
  1146.                                             Print "Change the device number."
  1147.                                             Input "Type a new device #, 0 for none (disabled), or blank to leave it unchanged"; in$
  1148.                                             If IsNum%(in$) Then
  1149.                                                 iDevice = Val(in$)
  1150.                                                 m_arrControlMap(iPlayer, iWhichInput).device = iDevice
  1151.                                                 Print "Updated device number. Remember to save mappings when done."
  1152.                                             Else
  1153.                                                 Print "(No change.)"
  1154.                                             End If
  1155.                                         Case 2:
  1156.                                             bContinue4 = TRUE
  1157.                                             Do
  1158.                                                 Print "Change the device type."
  1159.                                                 Print cstr$(cInputKey) + "=keyboard"
  1160.                                                 Print cstr$(cInputButton) + "=game controller button"
  1161.                                                 Print cstr$(cInputAxis) + "=game controller joystick/axis"
  1162.                                                 Print cstr$(cInputNone) + "=none"
  1163.                                                 Input "Device type or blank to leave it unchanged"; in$
  1164.                                                 If IsNum%(in$) Then
  1165.                                                     iType = Val(in$)
  1166.                                                     if iType=cInputKey or iType=cInputButton or _
  1167.                                                         iType=cInputAxis or iType=cInputNone then
  1168.  
  1169.                                                         m_arrControlMap(iPlayer, iWhichInput).typ = iType
  1170.                                                         Print "Updated device type. Remember to save mappings when done."
  1171.                                                         bContinue4 = FALSE: Exit Do
  1172.                                                     Else
  1173.                                                         Print "Please choose one of the listed values."
  1174.                                                     End If
  1175.                                                 Else
  1176.                                                     Print "(No change.)"
  1177.                                                     bContinue4 = FALSE: Exit Do
  1178.                                                 End If
  1179.                                             Loop Until bContinue4 = FALSE
  1180.                                         Case 3:
  1181.                                             Print "Change the input code."
  1182.                                             Input "Type a new input code, or blank to leave it unchanged"; in$
  1183.                                             If IsNum%(in$) Then
  1184.                                                 iCode = Val(in$)
  1185.                                                 m_arrControlMap(iPlayer, iWhichInput).code = iCode
  1186.                                                 Print "Updated input code. Remember to save mappings when done."
  1187.                                             Else
  1188.                                                 Print "(No change.)"
  1189.                                             End If
  1190.                                         Case 4:
  1191.                                             Print "Change the input value."
  1192.                                             Input "Type a new input value, or blank to leave it unchanged"; in$
  1193.                                             If IsNum%(in$) Then
  1194.                                                 iValue = Val(in$)
  1195.                                                 m_arrControlMap(iPlayer, iWhichInput).value = iValue
  1196.                                                 Print "Updated input value. Remember to save mappings when done."
  1197.                                             Else
  1198.                                                 Print "(No change.)"
  1199.                                             End If
  1200.                                         Case 5:
  1201.                                             Print "Change the repeat setting."
  1202.                                             Input "Type 1 to enable or 0 to disable, or blank to leave it unchanged"; in$
  1203.                                             If IsNum%(in$) Then
  1204.                                                 iRepeat = Val(in$)
  1205.                                                 If iRepeat = 0 Then
  1206.                                                     m_arrControlMap(iPlayer, iWhichInput).repeat = FALSE
  1207.                                                     Print "Repeat disabled. Remember to save mappings when done."
  1208.                                                 ElseIf iRepeat = 1 Then
  1209.                                                     m_arrControlMap(iPlayer, iWhichInput).repeat = TRUE
  1210.                                                     Print "Repeat enabled. Remember to save mappings when done."
  1211.                                                 Else
  1212.                                                     Print "(No change.)"
  1213.                                                 End If
  1214.                                             Else
  1215.                                                 Print "(No change.)"
  1216.                                             End If
  1217.                                         Case Else:
  1218.                                             Print "Please choose a number between 1 and 4."
  1219.                                     End Select
  1220.                                 Else
  1221.                                     bContinue3 = FALSE: Exit Do
  1222.                                 End If
  1223.                             Loop Until bContinue3 = FALSE
  1224.                         Else
  1225.                             Print "Please choose a number between " + cstr$(LBound(m_arrControlMap, 2)) + " and " + cstr$(UBound(m_arrControlMap, 2)) + "."
  1226.                         End If
  1227.                     Else
  1228.                         bContinue2 = FALSE: Exit Do
  1229.                     End If
  1230.                 Loop Until bContinue2 = FALSE
  1231.                 If bContinue1 = FALSE Then Exit Do
  1232.             Else
  1233.                 Print "Please choose a number between 1 and " + cstr$(cMaxPlayers) + "."
  1234.             End If
  1235.         Else
  1236.             If Len(sResult) = 0 Then sResult = "(Cancelled.)"
  1237.             bContinue1 = FALSE: Exit Do
  1238.         End If
  1239.     Loop Until bContinue1 = FALSE
  1240.  
  1241.     _KeyClear: _Delay 1
  1242.  
  1243.     EditMappings$ = sResult
  1244. End Function ' EditMappings$
  1245.  
  1246. ' /////////////////////////////////////////////////////////////////////////////
  1247.  
  1248. Function ResetMapping$
  1249.     Dim RoutineName As String: RoutineName = "ResetMapping$"
  1250.     Dim in$
  1251.     Dim iPlayer As Integer
  1252.     Dim sResult As String: sResult = ""
  1253.  
  1254.     ' INITIALIZE
  1255.     InitKeyboardButtonCodes
  1256.  
  1257.     ' RESET
  1258.     Do
  1259.         PrintControllerMap2
  1260.  
  1261.         Print "To delete mapping, enter a player number: " _
  1262.             "1-" + cstr$(cMaxPlayers) + ", " + _
  1263.             cstr$(cMaxPlayers+1) + " for all, or 0 to exit."
  1264.         Input "Delete mapping for player? "; iPlayer
  1265.  
  1266.         If iPlayer > 0 And iPlayer <= cMaxPlayers Then
  1267.             Print "Delete mappings for player " + cstr$(iPlayer) + "."
  1268.             Input "Delete (y/n)"; in$: in$ = LCase$(_Trim$(in$))
  1269.             If in$ = "y" Then
  1270.                 For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  1271.                     If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
  1272.                         m_arrControlMap(iPlayer, iWhichInput).device = 0
  1273.                         m_arrControlMap(iPlayer, iWhichInput).typ = 0
  1274.                         m_arrControlMap(iPlayer, iWhichInput).code = 0
  1275.                         m_arrControlMap(iPlayer, iWhichInput).value = 0
  1276.                         m_arrControlMap(iPlayer, iWhichInput).repeat = 0 ' GetGlobalInputRepeatSetting%(iWhichInput)
  1277.                     End If
  1278.                 Next iWhichInput
  1279.                 sResult = "Mappings deleted for player " + cstr$(iPlayer) + "."
  1280.                 Print sResult
  1281.             End If
  1282.         ElseIf iPlayer = (cMaxPlayers + 1) Then
  1283.             Input "Delete all mappings (y/n)"; in$: in$ = LCase$(_Trim$(in$))
  1284.             If in$ = "y" Then
  1285.                 For iPlayer = 1 To cMaxPlayers
  1286.                     For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  1287.                         If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
  1288.                             m_arrControlMap(iPlayer, iWhichInput).device = 0
  1289.                             m_arrControlMap(iPlayer, iWhichInput).typ = 0
  1290.                             m_arrControlMap(iPlayer, iWhichInput).code = 0
  1291.                             m_arrControlMap(iPlayer, iWhichInput).value = 0
  1292.                             m_arrControlMap(iPlayer, iWhichInput).repeat = 0 ' GetGlobalInputRepeatSetting%(iWhichInput)
  1293.                         End If
  1294.                     Next iWhichInput
  1295.                 Next iPlayer
  1296.                 sResult = "All mappings deleted."
  1297.                 Print sResult
  1298.             End If
  1299.         Else
  1300.             If Len(sResult) = 0 Then sResult = "(Cancelled.)"
  1301.             Exit Do
  1302.         End If
  1303.     Loop
  1304.     ResetMapping$ = sResult
  1305. End Function ' ResetMapping$
  1306.  
  1307. ' /////////////////////////////////////////////////////////////////////////////
  1308.  
  1309. Function MapInput$
  1310.     Dim RoutineName As String: RoutineName = "MapInput$"
  1311.     Dim in$
  1312.     Dim iDeviceCount As Integer
  1313.     Dim iPlayer As Integer
  1314.     Dim sResult As String
  1315.     Dim sError As String
  1316.  
  1317.     ' INITIALIZE
  1318.     InitKeyboardButtonCodes
  1319.  
  1320.     ' SET UP SCREEN
  1321.     Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
  1322.  
  1323.     ' MAKE SURE WE HAVE DEVICES
  1324.     ' 1 is the keyboard
  1325.     ' 2 is the mouse
  1326.     ' 3 is the joystick
  1327.     ' unless someone has a strange setup with multiple mice/keyboards/ect...
  1328.     ' In that case, you can use _DEVICE$(i) to look for "KEYBOARD", "MOUSE", "JOYSTICK", if necessary.
  1329.     ' I've never actually found it necessary, but I figure it's worth mentioning, just in case...
  1330.     iDeviceCount = _Devices ' Find the number of devices on someone's system
  1331.     If iDeviceCount > 2 Then
  1332.         '' Try loading map
  1333.         'sError = LoadControllerMap$
  1334.         'if len(sError) = 0 then
  1335.         '    print "Previous controller mapping loaded."
  1336.         'else
  1337.         '    print "*******************************************************************************"
  1338.         '    print "There were errors loading the controller mapping file:"
  1339.         '    print sError
  1340.         '    print
  1341.         '    print "Try remapping - a new file will be created."
  1342.         '    print "*******************************************************************************"
  1343.         'end if
  1344.         Do
  1345.             PrintControllerMap2
  1346.             Print "To edit mapping, enter a player number (1-" + cstr$(cMaxPlayers) + ") or 0 to exit."
  1347.             Input "Get input for player? "; iPlayer
  1348.             If iPlayer > 0 And iPlayer <= cMaxPlayers Then
  1349.                 sResult = MapInput1$(iPlayer)
  1350.                 If Len(sResult) = 0 Then
  1351.                     Print "Remember to save mappings when done."
  1352.                 Else
  1353.                     Print sResult
  1354.                 End If
  1355.             Else
  1356.                 sResult = "(Cancelled.)"
  1357.                 Exit Do
  1358.             End If
  1359.         Loop
  1360.     Else
  1361.         sResult = "No controller devices found."
  1362.         Input "PRESS <ENTER> TO CONTINUE", in$
  1363.     End If
  1364.     MapInput$ = sResult
  1365.  
  1366. End Function ' MapInput$
  1367.  
  1368. ' /////////////////////////////////////////////////////////////////////////////
  1369. ' Detect controls
  1370. ' THIS VERSION SUPPORTS UPTO 8 JOYSTICKS, WITH UPTO 2 BUTTONS AND 2 AXES EACH
  1371. ' (THIS IS FOR ATARI 2600 JOYSTICKS)
  1372.  
  1373. ' The following shared arrays must be declared:
  1374. '     ReDim Shared m_arrButtonCode(1 To 99) As Long
  1375. '     ReDim Shared m_arrButtonKey(1 To 99) As String
  1376.  
  1377. Function MapInput1$ (iPlayer As Integer)
  1378.     Dim RoutineName As String:: RoutineName = "MapInput1$"
  1379.     Dim sResult As String: sResult = ""
  1380.     Dim sError As String: sError = ""
  1381.  
  1382.     Dim in$
  1383.  
  1384.     Dim iDeviceCount As Integer
  1385.     Dim iDevice As Integer
  1386.     Dim iNumControllers As Integer
  1387.     Dim iController As Integer
  1388.  
  1389.     Dim iLoop As Integer
  1390.     Dim strValue As String
  1391.     Dim strAxis As String
  1392.     Dim dblNextAxis
  1393.     Dim iCount As Long
  1394.     Dim iValue As Integer
  1395.     Dim iCode As Integer
  1396.  
  1397.     Dim arrButton(32, 16) As Integer ' number of buttons on the joystick
  1398.     Dim arrButtonNew(32, 16) As Integer ' tracks when to initialize values
  1399.     Dim arrAxis(32, 16) As Double ' number of axis on the joystick
  1400.     Dim arrAxisNew(32, 16) As Integer ' tracks when to initialize values
  1401.  
  1402.     'Dim arrInput(1 To 8) As ControlInputType
  1403.     Dim iWhichInput As Integer
  1404.     Dim bFinished As Integer
  1405.     Dim bHaveInput As Integer
  1406.     Dim bMoveNext As Integer
  1407.     Dim bCancel As Integer
  1408.     Dim iNextInput As Integer
  1409.  
  1410.     ' FOR PRINTING OUTPUT
  1411.     Dim iDigits As Integer ' # digits to display (values are truncated to this length)
  1412.     Dim iColCount As Integer
  1413.     Dim iGroupCount As Integer
  1414.     Dim sLine As String
  1415.     Dim iCols As Integer
  1416.     Dim iRows As Integer
  1417.     Dim iMaxCols As Integer
  1418.  
  1419.     ' INITIALIZE
  1420.     If Len(sError) = 0 Then
  1421.         iDigits = 4 ' 11
  1422.         iColCount = 3
  1423.         iGroupCount = 0 ' re-initialized at the top of every loop
  1424.         iCols = _Width(0) \ _FontWidth
  1425.         iRows = _Height(0) \ _FontHeight
  1426.     End If
  1427.  
  1428.     ' COUNT # OF JOYSTICKS
  1429.     ' TODO: find out the right way to count joysticks
  1430.     If Len(sError) = 0 Then
  1431.         ' D= _DEVICES ' MUST be read in order for other 2 device functions to work!
  1432.         iDeviceCount = _Devices ' Find the number of devices on someone's system
  1433.  
  1434.         If iDeviceCount > 2 Then
  1435.             ' LIMIT # OF DEVICES, IF THERE IS A LIMIT DEFINED
  1436.             iNumControllers = iDeviceCount - 2
  1437.             If cMaxControllers > 0 Then
  1438.                 If iNumControllers > cMaxControllers Then
  1439.                     iNumControllers = cMaxControllers
  1440.                 End If
  1441.             End If
  1442.         Else
  1443.             ' ONLY 2 FOUND (KEYBOARD, MOUSE)
  1444.             sError = "No game controllers found."
  1445.         End If
  1446.     End If
  1447.  
  1448.     ' INITIALIZE CONTROLLER DATA
  1449.     If Len(sError) = 0 Then
  1450.         For iController = 1 To iNumControllers
  1451.             m_arrController(iController).buttonCount = cMaxButtons
  1452.             m_arrController(iController).axisCount = cMaxAxis
  1453.             For iLoop = 1 To cMaxButtons
  1454.                 arrButtonNew(iController, iLoop) = TRUE
  1455.             Next iLoop
  1456.             For iLoop = 1 To cMaxAxis
  1457.                 arrAxisNew(iController, iLoop) = TRUE
  1458.             Next iLoop
  1459.         Next iController
  1460.     End If
  1461.  
  1462.     ' INITIALIZE CONTROLLER INPUT
  1463.     If Len(sError) = 0 Then
  1464.         Cls
  1465.         Print "We will now detect controllers."
  1466.         Print "Do not touch any keys or game controllers during detection."
  1467.         Input "Press <ENTER> to begin"; in$
  1468.         _KeyClear: Print
  1469.         sLine = "Initializing controllers": Print sLine;
  1470.         iMaxCols = (iCols - Len(sLine)) - 1
  1471.         iCount = 0
  1472.         Do
  1473.             iCount = iCount + 1
  1474.             If iCount < iMaxCols Then
  1475.                 Print ".";
  1476.             Else
  1477.                 Print ".": Print sLine: iCount = 0
  1478.             End If
  1479.             For iController = 1 To iNumControllers
  1480.                 iDevice = iController + 2
  1481.                 While _DeviceInput(iDevice) ' clear and update the device buffer
  1482.                     For iLoop = 1 To _LastButton(iDevice)
  1483.                         If (iLoop > cMaxButtons) Then Exit For
  1484.                         m_arrController(iController).buttonCount = iLoop
  1485.                         'IF _BUTTONCHANGE(iLoop) THEN
  1486.                         '    arrButton(iController, iLoop) = _BUTTON(iLoop)
  1487.                         'END IF
  1488.                         arrButton(iController, iLoop) = FALSE
  1489.                     Next iLoop
  1490.                     For iLoop = 1 To _LastAxis(iDevice) ' this loop checks all my axis
  1491.                         If (iLoop > cMaxAxis) Then Exit For
  1492.                         m_arrController(iController).axisCount = iLoop
  1493.                         arrAxis(iController, iLoop) = 0
  1494.                     Next iLoop
  1495.                 Wend ' clear and update the device buffer
  1496.             Next iController
  1497.             _Limit 30
  1498.         Loop Until iCount > 60 ' quit after 2 seconds
  1499.         Print: Print
  1500.     End If
  1501.  
  1502.     ' WAIT FOR INPUT
  1503.     If Len(sError) = 0 Then
  1504.         Cls
  1505.         Print "Press <ESCAPE> to cancel at any time."
  1506.         Print
  1507.  
  1508.         _KeyClear: _Delay 1
  1509.         bCancel = FALSE
  1510.         bFinished = FALSE
  1511.         iLastPressed = 0
  1512.         For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  1513.             'print "iWhichInput=" + cstr$(iWhichInput)
  1514.             Print "Player #" + cstr$(iPlayer) + " press control for " + InputToString$(iWhichInput) + " or ESC to skip: ";
  1515.  
  1516.             ' =============================================================================
  1517.             ' BEGIN LOOK FOR NEXT INPUT
  1518.             bMoveNext = FALSE
  1519.             Do
  1520.                 ' -----------------------------------------------------------------------------
  1521.                 ' BEGIN CHECK FOR CONTROLLER INPUT
  1522.                 For iController = 1 To iNumControllers
  1523.                     iDevice = iController + 2
  1524.  
  1525.                     ' Check all devices
  1526.                     While _DeviceInput(iDevice)
  1527.  
  1528.                         ' Check each button
  1529.                         If bMoveNext = FALSE Then
  1530.                             For iLoop = 1 To _LastButton(iDevice)
  1531.                                 If (iLoop > cMaxButtons) Then Exit For
  1532.                                 'm_arrController(iController).buttonCount = iLoop
  1533.  
  1534.                                 ' update button array to indicate if a button is up or down currently.
  1535.                                 If _ButtonChange(iLoop) Then
  1536.                                     iValue = _Button(iLoop)
  1537.                                     If iValue <> arrButton(iController, iLoop) Then
  1538.                                         ' *****************************************************************************
  1539.                                         ' PRESSED BUTTON
  1540.  
  1541.                                         ' make sure this isn't already mapped
  1542.                                         bHaveInput = TRUE
  1543.                                         If iWhichInput > LBound(m_arrControlMap, 2) Then
  1544.                                             ' is input unique?
  1545.                                             For iNextInput = LBound(m_arrControlMap, 2) To iWhichInput - 1
  1546.                                                 If m_arrControlMap(iPlayer, iNextInput).device = iDevice Then
  1547.                                                     If m_arrControlMap(iPlayer, iNextInput).typ = cInputButton Then
  1548.                                                         If m_arrControlMap(iPlayer, iNextInput).code = iLoop Then
  1549.                                                             If m_arrControlMap(iPlayer, iNextInput).value = iValue Then
  1550.                                                                 bHaveInput = FALSE
  1551.                                                             End If
  1552.                                                         End If
  1553.                                                     End If
  1554.                                                 End If
  1555.                                             Next iNextInput
  1556.                                         End If
  1557.  
  1558.                                         If bHaveInput Then
  1559.                                             m_arrControlMap(iPlayer, iWhichInput).device = iDevice
  1560.                                             m_arrControlMap(iPlayer, iWhichInput).typ = cInputButton
  1561.                                             m_arrControlMap(iPlayer, iWhichInput).code = iLoop
  1562.                                             m_arrControlMap(iPlayer, iWhichInput).value = iValue
  1563.                                             bMoveNext = TRUE
  1564.                                         End If
  1565.  
  1566.                                     End If
  1567.                                 End If
  1568.                             Next iLoop
  1569.                         End If
  1570.  
  1571.                         ' Check each axis
  1572.                         If bMoveNext = FALSE Then
  1573.                             For iLoop = 1 To _LastAxis(iDevice)
  1574.                                 If (iLoop > cMaxAxis) Then Exit For
  1575.                                 'm_arrController(iController).axisCount = iLoop
  1576.  
  1577.                                 dblNextAxis = _Axis(iLoop)
  1578.                                 dblNextAxis = RoundUpDouble#(dblNextAxis, 3)
  1579.  
  1580.                                 ' I like to give a little "jiggle" resistance to my controls, as I have an old joystick
  1581.                                 ' which is prone to always give minute values and never really center on true 0.
  1582.                                 ' A value of 1 means my axis is pushed fully in one direction.
  1583.                                 ' A value greater than 0.1 means it's been partially pushed in a direction (such as at a 45 degree diagional angle).
  1584.                                 ' A value of less than 0.1 means we count it as being centered. (As if it was 0.)
  1585.  
  1586.                                 'These are way too sensitive for analog:
  1587.                                 'IF ABS(_AXIS(iLoop)) <= 1 AND ABS(_AXIS(iLoop)) >= .1 THEN
  1588.                                 'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .01 THEN
  1589.                                 'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .001 THEN
  1590.  
  1591.                                 'For digital input, we'll use a big picture:
  1592.                                 If Abs(dblNextAxis) <= 1 And Abs(dblNextAxis) >= 0.75 Then
  1593.                                     If dblNextAxis <> arrAxis(iController, iLoop) Then
  1594.                                         ' *****************************************************************************
  1595.                                         ' MOVED STICK
  1596.  
  1597.                                         ' convert to a digital value
  1598.                                         If dblNextAxis < 0 Then
  1599.                                             iValue = -1
  1600.                                         Else
  1601.                                             iValue = 1
  1602.                                         End If
  1603.  
  1604.                                         ' make sure this isn't already mapped
  1605.                                         bHaveInput = TRUE
  1606.                                         If iWhichInput > LBound(m_arrControlMap, 2) Then
  1607.                                             ' is input unique?
  1608.                                             For iNextInput = LBound(m_arrControlMap, 2) To iWhichInput - 1
  1609.                                                 If m_arrControlMap(iPlayer, iNextInput).device = iDevice Then
  1610.                                                     If m_arrControlMap(iPlayer, iNextInput).typ = cInputAxis Then
  1611.                                                         If m_arrControlMap(iPlayer, iNextInput).code = iLoop Then
  1612.                                                             If m_arrControlMap(iPlayer, iNextInput).value = iValue Then
  1613.                                                                 bHaveInput = FALSE
  1614.                                                             End If
  1615.                                                         End If
  1616.                                                     End If
  1617.                                                 End If
  1618.                                             Next iNextInput
  1619.                                         End If
  1620.  
  1621.                                         If bHaveInput Then
  1622.                                             m_arrControlMap(iPlayer, iWhichInput).device = iDevice
  1623.                                             m_arrControlMap(iPlayer, iWhichInput).typ = cInputAxis
  1624.                                             m_arrControlMap(iPlayer, iWhichInput).code = iLoop
  1625.                                             m_arrControlMap(iPlayer, iWhichInput).value = iValue
  1626.                                             bMoveNext = TRUE
  1627.                                         End If
  1628.  
  1629.                                     End If
  1630.                                 End If
  1631.                             Next iLoop
  1632.                         End If
  1633.  
  1634.                     Wend ' clear and update the device buffer
  1635.  
  1636.                 Next iController
  1637.                 ' END CHECK FOR CONTROLLER INPUT
  1638.                 ' -----------------------------------------------------------------------------
  1639.  
  1640.                 ' -----------------------------------------------------------------------------
  1641.                 ' BEGIN CHECK FOR KEYBOARD INPUT #1
  1642.                 If bMoveNext = FALSE Then
  1643.                     '_KEYCLEAR: _DELAY 1
  1644.                     While _DeviceInput(1): Wend ' clear and update the keyboard buffer
  1645.  
  1646.                     ' Detect changed key state
  1647.                     For iLoop = LBound(m_arrButtonCode) To UBound(m_arrButtonCode)
  1648.                         iCode = m_arrButtonCode(iLoop)
  1649.                         If _Button(iCode) <> FALSE Then
  1650.                             ' *****************************************************************************
  1651.                             ' PRESSED KEYBOARD
  1652.                             'PRINT "PRESSED " + m_arrButtonKey(iLoop)
  1653.  
  1654.                             ' make sure this isn't already mapped
  1655.                             bHaveInput = TRUE
  1656.                             If iWhichInput > LBound(m_arrControlMap, 2) Then
  1657.                                 ' is input unique?
  1658.                                 For iNextInput = LBound(m_arrControlMap, 2) To iWhichInput - 1
  1659.                                     If m_arrControlMap(iPlayer, iNextInput).device = 1 Then ' .device 1 = keyboard
  1660.                                         If m_arrControlMap(iPlayer, iNextInput).typ = cInputKey Then
  1661.                                             If m_arrControlMap(iPlayer, iNextInput).code = iCode Then
  1662.                                                 'if m_arrControlMap(iPlayer, iNextInput).value = TRUE then
  1663.                                                 bHaveInput = FALSE
  1664.                                                 'end if
  1665.                                             End If
  1666.                                         End If
  1667.                                     End If
  1668.                                 Next iNextInput
  1669.                             End If
  1670.  
  1671.                             If bHaveInput Then
  1672.                                 m_arrControlMap(iPlayer, iWhichInput).device = 1 ' .device 1 = keyboard
  1673.                                 m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey
  1674.                                 m_arrControlMap(iPlayer, iWhichInput).code = iCode
  1675.                                 m_arrControlMap(iPlayer, iWhichInput).value = TRUE
  1676.                                 bMoveNext = TRUE
  1677.                             End If
  1678.  
  1679.                         End If
  1680.                     Next iLoop
  1681.                 End If
  1682.                 ' END CHECK FOR KEYBOARD INPUT #1
  1683.                 ' -----------------------------------------------------------------------------
  1684.  
  1685.                 If bMoveNext = TRUE Then Exit Do
  1686.                 _Limit 30
  1687.             Loop Until _KeyHit = 27 ' ESCAPE to quit
  1688.             ' END LOOK FOR NEXT INPUT
  1689.             ' =============================================================================
  1690.  
  1691.             If bMoveNext = TRUE Then
  1692.                 Print "Device #" + cstr$(m_arrControlMap(iPlayer, iWhichInput).device) + " " + _
  1693.                     InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) + " " + _
  1694.                     cstr$(m_arrControlMap(iPlayer, iWhichInput).code) + " = " + _
  1695.                     cstr$(m_arrControlMap(iPlayer, iWhichInput).value)
  1696.  
  1697.                 ' Only ask user to select repeat if no override.
  1698.                 If m_bRepeatOverride = FALSE Then
  1699.                     Input "Enable repeat (y/n)"; in$: in$ = LCase$(_Trim$(in$))
  1700.                     If in$ = "y" Then
  1701.                         m_arrControlMap(iPlayer, iWhichInput).repeat = TRUE
  1702.                     Else
  1703.                         m_arrControlMap(iPlayer, iWhichInput).repeat = FALSE
  1704.                     End If
  1705.                 Else
  1706.                     m_arrControlMap(iPlayer, iWhichInput).repeat = GetGlobalInputRepeatSetting%(iWhichInput)
  1707.                 End If
  1708.             Else
  1709.                 Print "(Skipped)"
  1710.                 bCancel = TRUE
  1711.                 bFinished = TRUE
  1712.             End If
  1713.  
  1714.             If bFinished = TRUE Then Exit For
  1715.         Next iWhichInput
  1716.     End If
  1717.  
  1718.     If Len(sError) = 0 Then
  1719.         m_bHaveMapping = TRUE
  1720.     Else
  1721.         sResult = "ERRORS: " + sError
  1722.     End If
  1723.  
  1724.     _KeyClear: _Delay 1
  1725.     MapInput1$ = sResult
  1726. End Function ' MapInput1$
  1727.  
  1728. ' /////////////////////////////////////////////////////////////////////////////
  1729. ' Receives which input contstant and returns a text description
  1730.  
  1731. Function InputToString$ (iWhich As Integer)
  1732.     Select Case iWhich
  1733.         Case cInputUp:
  1734.             InputToString$ = "up"
  1735.         Case cInputDown:
  1736.             InputToString$ = "down"
  1737.         Case cInputLeft:
  1738.             InputToString$ = "left"
  1739.         Case cInputRight:
  1740.             InputToString$ = "right"
  1741.         Case cInputButton1:
  1742.             InputToString$ = "button #1"
  1743.         Case cInputButton2:
  1744.             InputToString$ = "button #2"
  1745.         Case cInputButton3:
  1746.             InputToString$ = "button #3"
  1747.         Case cInputButton4:
  1748.             InputToString$ = "button #4"
  1749.         Case Else:
  1750.             InputToString$ = "unknown"
  1751.     End Select
  1752. End Function ' InputToString$
  1753.  
  1754. ' /////////////////////////////////////////////////////////////////////////////
  1755. ' Receives which input contstant and returns its global "repeat" setting
  1756.  
  1757. ' usage:
  1758. '     m_arrControlMap(iPlayer, iWhichInput).repeat = GetGlobalInputRepeatSetting%(cInputUp)
  1759.  
  1760. Function GetGlobalInputRepeatSetting% (iWhich As Integer)
  1761.     Select Case iWhich
  1762.         Case cInputUp:
  1763.             GetGlobalInputRepeatSetting% = m_bRepeatUp
  1764.         Case cInputDown:
  1765.             GetGlobalInputRepeatSetting% = m_bRepeatDown
  1766.         Case cInputLeft:
  1767.             GetGlobalInputRepeatSetting% = m_bRepeatLeft
  1768.         Case cInputRight:
  1769.             GetGlobalInputRepeatSetting% = m_bRepeatRight
  1770.         Case cInputButton1:
  1771.             GetGlobalInputRepeatSetting% = m_bRepeatButton1
  1772.         Case cInputButton2:
  1773.             GetGlobalInputRepeatSetting% = m_bRepeatButton2
  1774.         Case cInputButton3:
  1775.             GetGlobalInputRepeatSetting% = m_bRepeatButton3
  1776.         Case cInputButton4:
  1777.             GetGlobalInputRepeatSetting% = m_bRepeatButton4
  1778.         Case Else:
  1779.             GetGlobalInputRepeatSetting% = FALSE
  1780.     End Select
  1781. End Function ' GetGlobalInputRepeatSetting%
  1782.  
  1783. ' /////////////////////////////////////////////////////////////////////////////
  1784.  
  1785. Function InputTypeToString$ (iCode As Integer)
  1786.     Select Case iCode
  1787.         Case cInputNone:
  1788.             InputTypeToString$ = "none"
  1789.         Case cInputKey:
  1790.             InputTypeToString$ = "key"
  1791.         Case cInputButton:
  1792.             InputTypeToString$ = "button"
  1793.         Case cInputAxis:
  1794.             InputTypeToString$ = "axis"
  1795.         Case Else:
  1796.             InputTypeToString$ = "unknown"
  1797.     End Select
  1798. End Function ' InputTypeToString$
  1799.  
  1800. ' /////////////////////////////////////////////////////////////////////////////
  1801. ' METHOD v2 = faster
  1802.  
  1803. Function GetKeyboardButtonCodeText$ (iCode As Integer)
  1804.     Dim sResult As String: sResult = ""
  1805.     If LBound(m_arrButtonKeyDesc) <= iCode Then
  1806.         If UBound(m_arrButtonKeyDesc) >= iCode Then
  1807.             sResult = m_arrButtonKeyDesc(iCode)
  1808.         End If
  1809.     End If
  1810.     If Len(sResult) = 0 Then
  1811.         sResult = _Trim$(Str$(iCode)) + " (?)"
  1812.     End If
  1813.     GetKeyboardButtonCodeText$ = sResult
  1814. End Function ' GetKeyboardButtonCodeText$
  1815.  
  1816. ' /////////////////////////////////////////////////////////////////////////////
  1817. ' METHOD v2
  1818. ' Faster lookup - a dictionary with a hash lookup would be best
  1819. ' but this is a quick way to do it since the values never change.
  1820.  
  1821. ' The following shared arrays must be declared:
  1822. '     ReDim Shared m_arrButtonCode(1 To 99) As Long
  1823. '     ReDim Shared m_arrButtonKey(1 To 99) As String
  1824. '     ReDim Shared m_arrButtonKeyDesc(0 To 512) As String
  1825.  
  1826. Sub InitKeyboardButtonCodes ()
  1827.     Dim iLoop As Integer
  1828.  
  1829.     If m_bInitialized = FALSE Then
  1830.         ' CODE(S) DETECTED WITH _BUTTON:
  1831.         m_arrButtonCode(1) = 2: m_arrButtonKey(1) = "Esc"
  1832.         m_arrButtonCode(2) = 60: m_arrButtonKey(2) = "F1"
  1833.         m_arrButtonCode(3) = 61: m_arrButtonKey(3) = "F2"
  1834.         m_arrButtonCode(4) = 62: m_arrButtonKey(4) = "F3"
  1835.         m_arrButtonCode(5) = 63: m_arrButtonKey(5) = "F4"
  1836.         m_arrButtonCode(6) = 64: m_arrButtonKey(6) = "F5"
  1837.         m_arrButtonCode(7) = 65: m_arrButtonKey(7) = "F6"
  1838.         m_arrButtonCode(8) = 66: m_arrButtonKey(8) = "F7"
  1839.         m_arrButtonCode(9) = 67: m_arrButtonKey(9) = "F8"
  1840.         m_arrButtonCode(10) = 68: m_arrButtonKey(10) = "F9"
  1841.         m_arrButtonCode(11) = 88: m_arrButtonKey(11) = "F11"
  1842.         m_arrButtonCode(12) = 89: m_arrButtonKey(12) = "F12"
  1843.         m_arrButtonCode(13) = 42: m_arrButtonKey(13) = "Tilde"
  1844.         m_arrButtonCode(14) = 3: m_arrButtonKey(14) = "1"
  1845.         m_arrButtonCode(15) = 4: m_arrButtonKey(15) = "2"
  1846.         m_arrButtonCode(16) = 5: m_arrButtonKey(16) = "3"
  1847.         m_arrButtonCode(17) = 6: m_arrButtonKey(17) = "4"
  1848.         m_arrButtonCode(18) = 7: m_arrButtonKey(18) = "5"
  1849.         m_arrButtonCode(19) = 8: m_arrButtonKey(19) = "6"
  1850.         m_arrButtonCode(20) = 9: m_arrButtonKey(20) = "7"
  1851.         m_arrButtonCode(21) = 10: m_arrButtonKey(21) = "8"
  1852.         m_arrButtonCode(22) = 11: m_arrButtonKey(22) = "9"
  1853.         m_arrButtonCode(23) = 12: m_arrButtonKey(23) = "0"
  1854.         m_arrButtonCode(24) = 13: m_arrButtonKey(24) = "Minus"
  1855.         m_arrButtonCode(25) = 14: m_arrButtonKey(25) = "Equal"
  1856.         m_arrButtonCode(26) = 15: m_arrButtonKey(26) = "BkSp"
  1857.         m_arrButtonCode(27) = 16: m_arrButtonKey(27) = "Tab"
  1858.         m_arrButtonCode(28) = 17: m_arrButtonKey(28) = "Q"
  1859.         m_arrButtonCode(29) = 18: m_arrButtonKey(29) = "W"
  1860.         m_arrButtonCode(30) = 19: m_arrButtonKey(30) = "E"
  1861.         m_arrButtonCode(31) = 20: m_arrButtonKey(31) = "R"
  1862.         m_arrButtonCode(32) = 21: m_arrButtonKey(32) = "T"
  1863.         m_arrButtonCode(33) = 22: m_arrButtonKey(33) = "Y"
  1864.         m_arrButtonCode(34) = 23: m_arrButtonKey(34) = "U"
  1865.         m_arrButtonCode(35) = 24: m_arrButtonKey(35) = "I"
  1866.         m_arrButtonCode(36) = 25: m_arrButtonKey(36) = "O"
  1867.         m_arrButtonCode(37) = 26: m_arrButtonKey(37) = "P"
  1868.         m_arrButtonCode(38) = 27: m_arrButtonKey(38) = "BracketLeft"
  1869.         m_arrButtonCode(39) = 28: m_arrButtonKey(39) = "BracketRight"
  1870.         m_arrButtonCode(40) = 44: m_arrButtonKey(40) = "Backslash"
  1871.         m_arrButtonCode(41) = 59: m_arrButtonKey(41) = "CapsLock"
  1872.         m_arrButtonCode(42) = 31: m_arrButtonKey(42) = "A"
  1873.         m_arrButtonCode(43) = 32: m_arrButtonKey(43) = "S"
  1874.         m_arrButtonCode(44) = 33: m_arrButtonKey(44) = "D"
  1875.         m_arrButtonCode(45) = 34: m_arrButtonKey(45) = "F"
  1876.         m_arrButtonCode(46) = 35: m_arrButtonKey(46) = "G"
  1877.         m_arrButtonCode(47) = 36: m_arrButtonKey(47) = "H"
  1878.         m_arrButtonCode(48) = 37: m_arrButtonKey(48) = "J"
  1879.         m_arrButtonCode(49) = 38: m_arrButtonKey(49) = "K"
  1880.         m_arrButtonCode(50) = 39: m_arrButtonKey(50) = "L"
  1881.         m_arrButtonCode(51) = 40: m_arrButtonKey(51) = "Semicolon"
  1882.         m_arrButtonCode(52) = 41: m_arrButtonKey(52) = "Apostrophe"
  1883.         m_arrButtonCode(53) = 29: m_arrButtonKey(53) = "Enter"
  1884.         m_arrButtonCode(54) = 43: m_arrButtonKey(54) = "ShiftLeft"
  1885.         m_arrButtonCode(55) = 45: m_arrButtonKey(55) = "Z"
  1886.         m_arrButtonCode(56) = 46: m_arrButtonKey(56) = "X"
  1887.         m_arrButtonCode(57) = 47: m_arrButtonKey(57) = "C"
  1888.         m_arrButtonCode(58) = 48: m_arrButtonKey(58) = "V"
  1889.         m_arrButtonCode(59) = 49: m_arrButtonKey(59) = "B"
  1890.         m_arrButtonCode(60) = 50: m_arrButtonKey(60) = "N"
  1891.         m_arrButtonCode(61) = 51: m_arrButtonKey(61) = "M"
  1892.         m_arrButtonCode(62) = 52: m_arrButtonKey(62) = "Comma"
  1893.         m_arrButtonCode(63) = 53: m_arrButtonKey(63) = "Period"
  1894.         m_arrButtonCode(64) = 54: m_arrButtonKey(64) = "Slash"
  1895.         m_arrButtonCode(65) = 55: m_arrButtonKey(65) = "ShiftRight"
  1896.         m_arrButtonCode(66) = 30: m_arrButtonKey(66) = "CtrlLeft"
  1897.         m_arrButtonCode(67) = 348: m_arrButtonKey(67) = "WinLeft"
  1898.         m_arrButtonCode(68) = 58: m_arrButtonKey(68) = "Spacebar"
  1899.         m_arrButtonCode(69) = 349: m_arrButtonKey(69) = "WinRight"
  1900.         m_arrButtonCode(70) = 350: m_arrButtonKey(70) = "Menu"
  1901.         m_arrButtonCode(71) = 286: m_arrButtonKey(71) = "CtrlRight"
  1902.         m_arrButtonCode(72) = 339: m_arrButtonKey(72) = "Ins"
  1903.         m_arrButtonCode(73) = 328: m_arrButtonKey(73) = "Home"
  1904.         m_arrButtonCode(74) = 330: m_arrButtonKey(74) = "PgUp"
  1905.         m_arrButtonCode(75) = 340: m_arrButtonKey(75) = "Del"
  1906.         m_arrButtonCode(76) = 336: m_arrButtonKey(76) = "End"
  1907.         m_arrButtonCode(77) = 338: m_arrButtonKey(77) = "PgDn"
  1908.         m_arrButtonCode(78) = 329: m_arrButtonKey(78) = "Up"
  1909.         m_arrButtonCode(79) = 332: m_arrButtonKey(79) = "Left"
  1910.         m_arrButtonCode(80) = 337: m_arrButtonKey(80) = "Down"
  1911.         m_arrButtonCode(81) = 334: m_arrButtonKey(81) = "Right"
  1912.         m_arrButtonCode(82) = 71: m_arrButtonKey(82) = "ScrollLock"
  1913.         m_arrButtonCode(83) = 326: m_arrButtonKey(83) = "NumLock"
  1914.         m_arrButtonCode(84) = 310: m_arrButtonKey(84) = "KeypadSlash"
  1915.         m_arrButtonCode(85) = 56: m_arrButtonKey(85) = "KeypadMultiply"
  1916.         m_arrButtonCode(86) = 75: m_arrButtonKey(86) = "KeypadMinus"
  1917.         m_arrButtonCode(87) = 72: m_arrButtonKey(87) = "Keypad7Home"
  1918.         m_arrButtonCode(88) = 73: m_arrButtonKey(88) = "Keypad8Up"
  1919.         m_arrButtonCode(89) = 74: m_arrButtonKey(89) = "Keypad9PgUp"
  1920.         m_arrButtonCode(90) = 79: m_arrButtonKey(90) = "KeypadPlus"
  1921.         m_arrButtonCode(91) = 76: m_arrButtonKey(91) = "Keypad4Left"
  1922.         m_arrButtonCode(92) = 77: m_arrButtonKey(92) = "Keypad5"
  1923.         m_arrButtonCode(93) = 78: m_arrButtonKey(93) = "Keypad6Right"
  1924.         m_arrButtonCode(94) = 80: m_arrButtonKey(94) = "Keypad1End"
  1925.         m_arrButtonCode(95) = 81: m_arrButtonKey(95) = "Keypad2Down"
  1926.         m_arrButtonCode(96) = 82: m_arrButtonKey(96) = "Keypad3PgDn"
  1927.         m_arrButtonCode(97) = 285: m_arrButtonKey(97) = "KeypadEnter"
  1928.         m_arrButtonCode(98) = 83: m_arrButtonKey(98) = "Keypad0Ins"
  1929.         m_arrButtonCode(99) = 84: m_arrButtonKey(99) = "KeypadPeriodDel"
  1930.  
  1931.         ' not sure if this works:
  1932.         '' CODE(S) DETECTED WITH _KEYDOWN:
  1933.         'm_arrButtonCode(100) = -1 : m_arrButtonCode(100) = "F10"
  1934.  
  1935.         ' not sure if this works:
  1936.         '' CODE(S) DETECTED WITH _KEYHIT:
  1937.         'm_arrButtonCode(101) = -2 : m_arrButtonCode(101) = "AltLeft"
  1938.         'm_arrButtonCode(102) = -3 : m_arrButtonCode(102) = "AltRight"
  1939.  
  1940.         ' DESCRIPTIONS BY KEYCODE
  1941.         For iLoop = LBound(m_arrButtonKeyDesc) To UBound(m_arrButtonKeyDesc)
  1942.             m_arrButtonKeyDesc(iLoop) = ""
  1943.         Next iLoop
  1944.         m_arrButtonKeyDesc(2) = "Esc"
  1945.         m_arrButtonKeyDesc(60) = "F1"
  1946.         m_arrButtonKeyDesc(61) = "F2"
  1947.         m_arrButtonKeyDesc(62) = "F3"
  1948.         m_arrButtonKeyDesc(63) = "F4"
  1949.         m_arrButtonKeyDesc(64) = "F5"
  1950.         m_arrButtonKeyDesc(65) = "F6"
  1951.         m_arrButtonKeyDesc(66) = "F7"
  1952.         m_arrButtonKeyDesc(67) = "F8"
  1953.         m_arrButtonKeyDesc(68) = "F9"
  1954.         m_arrButtonKeyDesc(88) = "F11"
  1955.         m_arrButtonKeyDesc(89) = "F12"
  1956.         m_arrButtonKeyDesc(42) = "Tilde"
  1957.         m_arrButtonKeyDesc(3) = "1"
  1958.         m_arrButtonKeyDesc(4) = "2"
  1959.         m_arrButtonKeyDesc(5) = "3"
  1960.         m_arrButtonKeyDesc(6) = "4"
  1961.         m_arrButtonKeyDesc(7) = "5"
  1962.         m_arrButtonKeyDesc(8) = "6"
  1963.         m_arrButtonKeyDesc(9) = "7"
  1964.         m_arrButtonKeyDesc(10) = "8"
  1965.         m_arrButtonKeyDesc(11) = "9"
  1966.         m_arrButtonKeyDesc(12) = "0"
  1967.         m_arrButtonKeyDesc(13) = "Minus"
  1968.         m_arrButtonKeyDesc(14) = "Equal"
  1969.         m_arrButtonKeyDesc(15) = "BkSp"
  1970.         m_arrButtonKeyDesc(16) = "Tab"
  1971.         m_arrButtonKeyDesc(17) = "Q"
  1972.         m_arrButtonKeyDesc(18) = "W"
  1973.         m_arrButtonKeyDesc(19) = "E"
  1974.         m_arrButtonKeyDesc(20) = "R"
  1975.         m_arrButtonKeyDesc(21) = "T"
  1976.         m_arrButtonKeyDesc(22) = "Y"
  1977.         m_arrButtonKeyDesc(23) = "U"
  1978.         m_arrButtonKeyDesc(24) = "I"
  1979.         m_arrButtonKeyDesc(25) = "O"
  1980.         m_arrButtonKeyDesc(26) = "P"
  1981.         m_arrButtonKeyDesc(27) = "BracketLeft"
  1982.         m_arrButtonKeyDesc(28) = "BracketRight"
  1983.         m_arrButtonKeyDesc(44) = "Backslash"
  1984.         m_arrButtonKeyDesc(59) = "CapsLock"
  1985.         m_arrButtonKeyDesc(31) = "A"
  1986.         m_arrButtonKeyDesc(32) = "S"
  1987.         m_arrButtonKeyDesc(33) = "D"
  1988.         m_arrButtonKeyDesc(34) = "F"
  1989.         m_arrButtonKeyDesc(35) = "G"
  1990.         m_arrButtonKeyDesc(36) = "H"
  1991.         m_arrButtonKeyDesc(37) = "J"
  1992.         m_arrButtonKeyDesc(38) = "K"
  1993.         m_arrButtonKeyDesc(39) = "L"
  1994.         m_arrButtonKeyDesc(40) = "Semicolon"
  1995.         m_arrButtonKeyDesc(41) = "Apostrophe"
  1996.         m_arrButtonKeyDesc(29) = "Enter"
  1997.         m_arrButtonKeyDesc(43) = "ShiftLeft"
  1998.         m_arrButtonKeyDesc(45) = "Z"
  1999.         m_arrButtonKeyDesc(46) = "X"
  2000.         m_arrButtonKeyDesc(47) = "C"
  2001.         m_arrButtonKeyDesc(48) = "V"
  2002.         m_arrButtonKeyDesc(49) = "B"
  2003.         m_arrButtonKeyDesc(50) = "N"
  2004.         m_arrButtonKeyDesc(51) = "M"
  2005.         m_arrButtonKeyDesc(52) = "Comma"
  2006.         m_arrButtonKeyDesc(53) = "Period"
  2007.         m_arrButtonKeyDesc(54) = "Slash"
  2008.         m_arrButtonKeyDesc(55) = "ShiftRight"
  2009.         m_arrButtonKeyDesc(30) = "CtrlLeft"
  2010.         m_arrButtonKeyDesc(348) = "WinLeft"
  2011.         m_arrButtonKeyDesc(58) = "Spacebar"
  2012.         m_arrButtonKeyDesc(349) = "WinRight"
  2013.         m_arrButtonKeyDesc(350) = "Menu"
  2014.         m_arrButtonKeyDesc(286) = "CtrlRight"
  2015.         m_arrButtonKeyDesc(339) = "Ins"
  2016.         m_arrButtonKeyDesc(328) = "Home"
  2017.         m_arrButtonKeyDesc(330) = "PgUp"
  2018.         m_arrButtonKeyDesc(340) = "Del"
  2019.         m_arrButtonKeyDesc(336) = "End"
  2020.         m_arrButtonKeyDesc(338) = "PgDn"
  2021.         m_arrButtonKeyDesc(329) = "Up"
  2022.         m_arrButtonKeyDesc(332) = "Left"
  2023.         m_arrButtonKeyDesc(337) = "Down"
  2024.         m_arrButtonKeyDesc(334) = "Right"
  2025.         m_arrButtonKeyDesc(71) = "ScrollLock"
  2026.         m_arrButtonKeyDesc(326) = "NumLock"
  2027.         m_arrButtonKeyDesc(310) = "KeypadSlash"
  2028.         m_arrButtonKeyDesc(56) = "KeypadMultiply"
  2029.         m_arrButtonKeyDesc(75) = "KeypadMinus"
  2030.         m_arrButtonKeyDesc(72) = "Keypad7Home"
  2031.         m_arrButtonKeyDesc(73) = "Keypad8Up"
  2032.         m_arrButtonKeyDesc(74) = "Keypad9PgUp"
  2033.         m_arrButtonKeyDesc(79) = "KeypadPlus"
  2034.         m_arrButtonKeyDesc(76) = "Keypad4Left"
  2035.         m_arrButtonKeyDesc(77) = "Keypad5"
  2036.         m_arrButtonKeyDesc(78) = "Keypad6Right"
  2037.         m_arrButtonKeyDesc(80) = "Keypad1End"
  2038.         m_arrButtonKeyDesc(81) = "Keypad2Down"
  2039.         m_arrButtonKeyDesc(82) = "Keypad3PgDn"
  2040.         m_arrButtonKeyDesc(285) = "KeypadEnter"
  2041.         m_arrButtonKeyDesc(83) = "Keypad0Ins"
  2042.         m_arrButtonKeyDesc(84) = "KeypadPeriodDel"
  2043.  
  2044.         m_bInitialized = TRUE
  2045.     End If
  2046. End Sub ' InitKeyboardButtonCodes
  2047.  
  2048. ' /////////////////////////////////////////////////////////////////////////////
  2049. ' not sure if this works
  2050.  
  2051. ' Returns TRUE if the F10 key is held down.
  2052. ' We use _KEYDOWN for this because _BUTTON doesn't detect F10.
  2053.  
  2054. ' Constant must be declared globally:
  2055. ' Const c_iKeyDown_F10 = 17408
  2056.  
  2057. Function KeydownF10%
  2058.     Dim iCode As Long
  2059.     '_KEYCLEAR: _DELAY 1
  2060.     If _KeyDown(c_iKeyDown_F10) = TRUE Then
  2061.         KeydownF10% = TRUE
  2062.     Else
  2063.         KeydownF10% = FALSE
  2064.     End If
  2065.     '_KEYCLEAR
  2066. End Function ' KeydownF10%
  2067.  
  2068. ' /////////////////////////////////////////////////////////////////////////////
  2069. ' not sure if this works
  2070.  
  2071. ' Returns TRUE if the left ALT key is held down.
  2072. ' We use _KEYHIT for this because _BUTTON doesn't detect ALT.
  2073.  
  2074. ' Constant must be declared globally:
  2075. ' Const c_iKeyHit_AltLeft = -30764
  2076.  
  2077. Function KeyhitAltLeft%
  2078.     '_KEYCLEAR: _DELAY 1
  2079.     If _KeyHit = c_iKeyHit_AltLeft Then
  2080.         KeyhitAltLeft% = TRUE
  2081.     Else
  2082.         KeyhitAltLeft% = FALSE
  2083.     End If
  2084.     '_KEYCLEAR
  2085. End Function ' KeyhitAltLeft%
  2086.  
  2087. ' /////////////////////////////////////////////////////////////////////////////
  2088. ' not sure if this works
  2089.  
  2090. ' Returns TRUE if the right ALT key is held down.
  2091. ' We use _KEYHIT for this because _BUTTON doesn't detect ALT.
  2092.  
  2093. ' Constant must be declared globally:
  2094. ' Const c_iKeyHit_AltRight = -30765
  2095.  
  2096. Function KeyhitAltRight%
  2097.     '_KEYCLEAR: _DELAY 1
  2098.     If _KeyHit = c_iKeyHit_AltRight Then
  2099.         KeyhitAltRight% = TRUE
  2100.     Else
  2101.         KeyhitAltRight% = FALSE
  2102.     End If
  2103.     '_KEYCLEAR
  2104. End Function ' KeyhitAltRight%
  2105.  
  2106. ' /////////////////////////////////////////////////////////////////////////////
  2107. ' DEVICES Button
  2108. ' _LASTBUTTON(1) keyboards will normally return 512 buttons. One button is read per loop through all numbers.
  2109. ' _BUTTONCHANGE(number) returns -1 when pressed, 1 when released and 0 when there is no event since the last read.
  2110. ' _BUTTON(number) returns -1 when a button is pressed and 0 when released
  2111.  
  2112. ' Detects most keys (where the codes are documented?)
  2113.  
  2114. ' However, does not seem to detect:
  2115. ' Key             Use
  2116. ' ---             ---
  2117. ' F10             Function KeydownF10%
  2118. ' Left Alt        Function KeyhitAltLeft%
  2119. ' Right Alt       Function KeyhitAltRight%
  2120. ' Print Screen    (system API call?)
  2121. ' Pause/Break     (system API call?)
  2122.  
  2123. Function KeyPressed% (iCode As Integer)
  2124.     '_KEYCLEAR: _DELAY 1
  2125.     While _DeviceInput(1): Wend ' clear and update the keyboard buffer
  2126.     If _Button(iCode) <> FALSE Then
  2127.         KeyPressed% = TRUE
  2128.     Else
  2129.         KeyPressed% = FALSE
  2130.     End If
  2131.     '_KEYCLEAR
  2132. End Function ' KeyPressed%
  2133.  
  2134. ' /////////////////////////////////////////////////////////////////////////////
  2135.  
  2136. Function TestJoysticks$
  2137.     Dim RoutineName As String: RoutineName = "TestJoysticks$"
  2138.     Dim iDeviceCount As Integer
  2139.     Dim sResult As String
  2140.  
  2141.     ' 1 is the keyboard
  2142.     ' 2 is the mouse
  2143.     ' 3 is the joystick
  2144.     ' unless someone has a strange setup with multiple mice/keyboards/ect...
  2145.     ' In that case, you can use _DEVICE$(i) to look for "KEYBOARD", "MOUSE", "JOYSTICK", if necessary.
  2146.     ' I've never actually found it necessary, but I figure it's worth mentioning, just in case...
  2147.  
  2148.     iDeviceCount = _Devices ' Find the number of devices on someone's system
  2149.     If iDeviceCount > 2 Then
  2150.         TestJoysticks1
  2151.         sResult = ""
  2152.     Else
  2153.         sResult = "No joysticks found."
  2154.     End If
  2155.  
  2156.     _KeyClear
  2157.  
  2158.     TestJoysticks$ = sResult
  2159. End Function ' TestJoysticks$
  2160.  
  2161. ' /////////////////////////////////////////////////////////////////////////////
  2162. ' Reads controllers and displays values on screen.
  2163.  
  2164. ' Currently this is set up to support up to 8 joysticks,
  2165. ' with upto 4 buttons and 2 axes each
  2166. ' Testing with an old USB Logitech RumblePad 2
  2167. ' and Atari 2600 joysticks plugged into using
  2168. ' iCode Atari Joystick, Paddle, Driving to USB Adapter 4 ports
  2169.  
  2170. Sub TestJoysticks1 ()
  2171.     Dim RoutineName As String:: RoutineName = "TestJoysticks1"
  2172.  
  2173.     Dim in$
  2174.     Dim iDeviceCount As Integer
  2175.     Dim iDevice As Integer
  2176.  
  2177.     Dim arrButton(32, 16) As Integer ' number of buttons on the joystick
  2178.     Dim arrButtonMin(32, 16) As Integer ' stores the minimum value read
  2179.     Dim arrButtonMax(32, 16) As Integer ' stores the maximum value read
  2180.     Dim arrAxis(32, 16) As Double ' number of axis on the joystick
  2181.     Dim arrAxisMin(32, 16) As Double ' stores the minimum value read
  2182.     Dim arrAxisMax(32, 16) As Double ' stores the maximum value read
  2183.     Dim arrAxisAvg(32, 16) As Double ' stores the average value read in the last few measurements
  2184.     Dim arrButtonNew(32, 16) As Integer ' tracks when to initialize values
  2185.     Dim arrAxisNew(32, 16) As Integer ' tracks when to initialize values
  2186.  
  2187.     Dim arrController(8) As ControllerType ' holds info for each player
  2188.     Dim iNumControllers As Integer
  2189.     Dim iController As Integer
  2190.     Dim iNextY As Integer
  2191.     Dim iNextX As Integer
  2192.     Dim iNextC As Integer
  2193.     Dim iLoop As Integer
  2194.     Dim iDigits As Integer ' # digits to display (values are truncated to this length)
  2195.     Dim strValue As String
  2196.     Dim strAxis As String
  2197.     Dim dblNextAxis
  2198.     'DIM iMeasureCount AS INTEGER
  2199.     Dim dblAverage As Double
  2200.     Dim sngAverage As Single
  2201.     Dim sLine As String
  2202.     Dim iX As Integer
  2203.     Dim iY As Integer
  2204.  
  2205.     Dim iCol As Integer
  2206.     Dim iRow As Integer
  2207.     Dim iCols As Integer
  2208.     Dim iRows As Integer
  2209.     Dim iColWidth As Integer
  2210.     Dim iColCount As Integer
  2211.     Dim iGroupCount As Integer
  2212.  
  2213.     ' SET UP SCREEN
  2214.     Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
  2215.  
  2216.     ' INITIALIZE
  2217.     iDigits = 4 ' 11
  2218.     iColCount = 3
  2219.     iCols = _Width(0) \ _FontWidth
  2220.     iRows = _Height(0) \ _FontHeight
  2221.     iColWidth = iCols \ iColCount
  2222.  
  2223.     ' COUNT # OF JOYSTICKS
  2224.     ' D= _DEVICES ' MUST be read in order for other 2 device functions to work!
  2225.     iDeviceCount = _Devices ' Find the number of devices on someone's system
  2226.     If iDeviceCount < 3 Then
  2227.         Cls
  2228.         Print "NO JOYSTICKS FOUND, EXITING..."
  2229.         Input "PRESS <ENTER>"; in$
  2230.         Exit Sub
  2231.     End If
  2232.  
  2233.     ' BASE # OF PLAYERS ON HOW MANY CONTROLLERS FOUND
  2234.     iNumControllers = iDeviceCount - 2 ' TODO: find out the right way to count joysticks
  2235.     If iNumControllers > cMaxControllers Then
  2236.         iNumControllers = cMaxControllers
  2237.     End If
  2238.  
  2239.     ' INITIALIZE PLAYER COORDINATES AND SCREEN CHARACTERS
  2240.     iNextY = 1
  2241.     iNextX = -3
  2242.     iNextC = 64
  2243.     For iController = 1 To iNumControllers
  2244.         iNextX = iNextX + 4
  2245.         If iNextX > 80 Then
  2246.             iNextX = 1
  2247.             iNextY = iNextY + 4
  2248.         End If
  2249.         iNextC = iNextC + 1
  2250.         arrController(iController).buttonCount = cMaxButtons
  2251.         arrController(iController).axisCount = cMaxAxis
  2252.  
  2253.         For iLoop = 1 To cMaxButtons
  2254.             arrButtonNew(iController, iLoop) = TRUE
  2255.         Next iLoop
  2256.         For iLoop = 1 To cMaxAxis
  2257.             arrAxisNew(iController, iLoop) = TRUE
  2258.             arrAxisAvg(iController, iLoop) = 0
  2259.         Next iLoop
  2260.     Next iController
  2261.  
  2262.     ' CLEAR THE SCREEN
  2263.     'iMeasureCount = 0
  2264.     Do
  2265.         For iController = 1 To iNumControllers
  2266.             iDevice = iController + 2
  2267.  
  2268.             While _DeviceInput(iDevice) ' clear and update the device buffer
  2269.                 ''IF _DEVICEINPUT = 3 THEN ' this says we only care about joystick input values
  2270.  
  2271.                 ' check all the buttons
  2272.                 For iLoop = 1 To _LastButton(iDevice)
  2273.                     If (iLoop > cMaxButtons) Then
  2274.                         Exit For
  2275.                     End If
  2276.                     arrController(iController).buttonCount = iLoop
  2277.  
  2278.                     ' update button array to indicate if a button is up or down currently.
  2279.                     If _ButtonChange(iLoop) Then
  2280.                         '' _BUTTON(number) returns -1 when a button is pressed and 0 when released.
  2281.                         ''arrButton(iLoop) = NOT arrButton(iLoop)
  2282.                         arrButton(iController, iLoop) = _Button(iLoop)
  2283.                     End If
  2284.  
  2285.                     '' SAVE MINIMUM VALUE
  2286.                     'if arrButton(iController, iLoop) < arrButtonMin(iController, iLoop) then
  2287.                     '    arrButtonMin(iController, iLoop) = arrButton(iController, iLoop)
  2288.                     '
  2289.                     '    ' INITIALIZE THE MAX TO THE MINIMUM VALUE
  2290.                     '    IF arrButtonNew(iController, iLoop) = TRUE THEN
  2291.                     '        arrButtonMax(iController, iLoop) = arrButtonMin(iController, iLoop)
  2292.                     '        arrButtonNew(iController, iLoop) = FALSE
  2293.                     '    END IF
  2294.                     'end if
  2295.                     '
  2296.                     '' SAVE MAXIMUM VALUE
  2297.                     'if arrButton(iController, iLoop) > arrButtonMax(iController, iLoop) then
  2298.                     '    arrButtonMax(iController, iLoop) = arrButton(iController, iLoop)
  2299.                     'end if
  2300.  
  2301.                 Next iLoop
  2302.  
  2303.                 For iLoop = 1 To _LastAxis(iDevice) ' this loop checks all my axis
  2304.                     If (iLoop > cMaxAxis) Then
  2305.                         Exit For
  2306.                     End If
  2307.                     arrController(iController).axisCount = iLoop
  2308.  
  2309.                     ' I like to give a little "jiggle" resistance to my controls, as I have an old joystick
  2310.                     ' which is prone to always give minute values and never really center on true 0.
  2311.                     ' A value of 1 means my axis is pushed fully in one direction.
  2312.                     ' A value greater than 0.1 means it's been partially pushed in a direction (such as at a 45 degree diagional angle).
  2313.                     ' A value of less than 0.1 means we count it as being centered. (As if it was 0.)
  2314.                     'IF ABS(_AXIS(iLoop)) <= 1 AND ABS(_AXIS(iLoop)) >= .1 THEN
  2315.  
  2316.                     dblNextAxis = _Axis(iLoop)
  2317.                     dblNextAxis = RoundUpDouble#(dblNextAxis, 3)
  2318.                     'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .01 THEN
  2319.                     If Abs(dblNextAxis) <= 1 And Abs(dblNextAxis) >= .001 Then
  2320.                         arrAxis(iController, iLoop) = dblNextAxis
  2321.                     Else
  2322.                         arrAxis(iController, iLoop) = 0
  2323.                     End If
  2324.  
  2325.                     '' SAVE MINIMUM VALUE
  2326.                     'if arrAxis(iController, iLoop) < arrAxisMin(iController, iLoop) then
  2327.                     '    arrAxisMin(iController, iLoop) = arrAxis(iController, iLoop)
  2328.                     '
  2329.                     '    ' INITIALIZE THE MAX TO THE MINIMUM VALUE
  2330.                     '    IF arrAxisNew(iController, iLoop) = TRUE THEN
  2331.                     '        arrAxisMax(iController, iLoop) = arrAxisMin(iController, iLoop)
  2332.                     '        arrAxisNew(iController, iLoop) = FALSE
  2333.                     '    END IF
  2334.                     'end if
  2335.                     '
  2336.                     '' SAVE MAXIMUM VALUE
  2337.                     'if arrAxis(iController, iLoop) > arrAxisMax(iController, iLoop) then
  2338.                     '    arrAxisMax(iController, iLoop) = arrAxis(iController, iLoop)
  2339.                     'end if
  2340.                     '
  2341.                     '' ADD CURRENT VALUE TO AVERAGE SUM
  2342.                     'arrAxisAvg(iController, iLoop) = arrAxisAvg(iController, iLoop) + arrAxis(iController, iLoop)
  2343.  
  2344.                 Next iLoop
  2345.             Wend ' clear and update the device buffer
  2346.  
  2347.         Next iController
  2348.  
  2349.         'PRINT "*** iNumControllers=" + cstr$(iNumControllers) + " ***"
  2350.         'iMeasureCount = iMeasureCount + 1
  2351.         'if iMeasureCount = 10 then
  2352.         'iMeasureCount = 0
  2353.  
  2354.         ' And below here is just the simple display routine which displays our values.
  2355.         ' If this was for a game, I'd choose something like arrAxis(1) = -1 for a left arrow style input,
  2356.         ' arrAxis(1) = 1 for a right arrow style input, rather than just using _KEYHIT or INKEY$.
  2357.  
  2358.         InitColumns iColCount
  2359.         m_StartRow = 6
  2360.         m_EndRow = iRows - 2
  2361.         'm_StartCol
  2362.         'm_EndCol
  2363.  
  2364.         Cls
  2365.         PrintString 1, 1, "Game controller test program."
  2366.         PrintString 1, 2, "This program is free to use and distribute per GNU GPLv3 license."
  2367.         PrintString 1, 3, "Tests up to 4 controllers with 2 axes / 2 buttons each."
  2368.         PrintString 1, 4, "Plug in controllers and move them & press buttons."
  2369.         PrintString 1, 5, "-------------------------------------------------------------------------------"
  2370.  
  2371.         iGroupCount = 0
  2372.  
  2373.         For iController = 1 To iNumControllers
  2374.             For iLoop = 1 To arrController(iController).axisCount ' A loop for each axis
  2375.                 strAxis = Right$("  " + cstr$(iLoop), 2)
  2376.  
  2377.                 sLine = ""
  2378.  
  2379.                 ' display their status to the screen
  2380.                 sLine = sLine + "Player " + cstr$(iController)
  2381.  
  2382.                 strValue = FormatNumber$(arrAxis(iController, iLoop), iDigits)
  2383.                 sLine = sLine + ",   Axis #" + strAxis + " = " + strValue
  2384.  
  2385.                 'strValue = FormatNumber$(arrAxisMin(iController, iLoop), iDigits)
  2386.                 'sLine = sLine + ", Min=" + strValue
  2387.                 '
  2388.                 'strValue = FormatNumber$(arrAxisMax(iController, iLoop), iDigits)
  2389.                 'sLine = sLine + ", Max=" + strValue
  2390.                 '
  2391.                 '' COMPUTE AVERAGE
  2392.                 'dblAverage = arrAxisAvg(iController, iLoop) / 10
  2393.                 'dblAverage = RoundUpDouble# (dblAverage, 3)
  2394.                 'strValue = FormatNumber$(dblAverage, iDigits)
  2395.                 'sLine = sLine + ", Avg=" + strValue
  2396.                 '
  2397.                 '' CLEAR THE AVERAGE
  2398.                 'arrAxisAvg(iController, iLoop) = 0
  2399.  
  2400.                 PrintColumn sLine
  2401.             Next iLoop
  2402.             For iLoop = 1 To arrController(iController).buttonCount ' A loop for each button
  2403.                 strAxis = Right$("  " + cstr$(iLoop), 2)
  2404.  
  2405.                 sLine = ""
  2406.  
  2407.                 ' display their status to the screen
  2408.                 sLine = sLine + "Player " + cstr$(iController)
  2409.  
  2410.                 strValue = FormatNumber$(arrButton(iController, iLoop), iDigits)
  2411.                 sLine = sLine + ", Button #" + strAxis + " = " + strValue
  2412.  
  2413.                 'strValue = FormatNumber$(arrButtonMin(iController, iLoop), iDigits)
  2414.                 'sLine = sLine + ", Min=" + strValue
  2415.                 '
  2416.                 'strValue = FormatNumber$(arrButtonMax(iController, iLoop), iDigits)
  2417.                 'sLine = sLine + ", Max=" + strValue
  2418.  
  2419.                 PrintColumn sLine
  2420.             Next iLoop
  2421.  
  2422.             iGroupCount = iGroupCount + 1
  2423.             If iGroupCount = 2 Then
  2424.                 ColumnBreak
  2425.                 iGroupCount = 0
  2426.             End If
  2427.  
  2428.         Next iController
  2429.  
  2430.         PrintString 1, iRows - 1, "-------------------------------------------------------------------------------"
  2431.         PrintString 1, iRows - 0, "PRESS <ESC> TO EXIT"
  2432.  
  2433.         'end if
  2434.  
  2435.         _Limit 30
  2436.     Loop Until _KeyHit = 27 ' ESCAPE to quit
  2437.  
  2438.     ' RETURN TO TEXT SCREEN
  2439.     Screen 0
  2440. End Sub ' TestJoysticks1
  2441.  
  2442. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2443. ' BEGIN FILE FUNCTIONS
  2444. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2445.  
  2446. ' /////////////////////////////////////////////////////////////////////////////
  2447. ' File format is comma-delimited
  2448. ' containing controller info for one action per line
  2449. ' where each line contains the following in this order:
  2450.  
  2451. ' TAB ORDER   INFO             TYPE      DESCRIPTION
  2452. ' 1           {player #}       Integer   player # this mapping is for
  2453. ' 2           {which action}   Integer   which action this mapping is for (up/down/right/left/button 1/button 2, etc.)
  2454. ' 3           {device #}       Integer   number of the device this is mapped to
  2455. ' 4           {type}           Integer   type of input (one of: cInputKey, cInputButton, cInputAxis)
  2456. ' 5           {code}           Integer   if button the _BUTTON #, if axis the _AXIS #, if keyboard the _BUTTON #
  2457. ' 6           {value}          Integer   if axis, the value (-1 or 1), else can be ignored
  2458. ' 7           {repeat}         Integer   if TRUE, and repeating keys not controlled by global values (when m_bRepeatOverride=TRUE), controls repeating keys for this control
  2459.  
  2460. ' These need to be declared globally and populated:
  2461. '     ReDim Shared m_arrControlMap(1 To 8, 1 To 8) As ControlInputType
  2462. '     Dim Shared m_ControlMapFileName$: m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
  2463. '     Dim Shared m_bRepeatOverride As Integer
  2464.  
  2465. ' If there is an error, returns error message,
  2466. ' else returns blank string.
  2467.  
  2468. Function SaveControllerMap$
  2469.     Dim RoutineName As String:: RoutineName = "SaveControllerMap$"
  2470.     Dim sResult As String: sResult = ""
  2471.     Dim sError As String: sError = ""
  2472.     Dim sFile As String
  2473.     Dim in$
  2474.     Dim iPlayer As Integer
  2475.     Dim iWhichInput As Integer
  2476.     Dim sLine As String
  2477.     Dim iCount As Long: iCount = 0
  2478.     'Dim iError As Long: iError = 0
  2479.     Dim sDelim As String: sDelim = "," ' CHR$(9)
  2480.  
  2481.     'DebugPrint "--------------------------------------------------------------------------------"
  2482.     'DebugPrint "Started " + RoutineName
  2483.     'DebugPrint "--------------------------------------------------------------------------------"
  2484.  
  2485.     ' Get file name
  2486.     If Len(m_ControlMapFileName$) = 0 Then
  2487.         m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
  2488.     End If
  2489.     sFile = Mid$(m_ControlMapFileName$, _InStrRev(m_ControlMapFileName$, "\") + 1)
  2490.  
  2491.     '_KeyClear
  2492.     'Cls
  2493.     'Print "SAVE CONTROLLER MAPPING:"
  2494.     'Print "Default file name is " + Chr$(34) + m_ControlMapFileName$ + Chr$(34) + "."
  2495.     'Input "Type save file name, or blank for default: ", in$
  2496.     'in$ = _Trim$(in$)
  2497.     'If Len(in$) > 0 Then
  2498.     '    m_ControlMapFileName$ = in$
  2499.     'End If
  2500.     'sFile = m_ProgramPath$ + m_ControlMapFileName$
  2501.  
  2502.     'DebugPrint "m_ControlMapFileName$=" + CHR$(34) + m_ControlMapFileName$ + CHR$(34)
  2503.  
  2504.     ' Save mapping to file
  2505.     Open m_ControlMapFileName$ For Output As #1
  2506.  
  2507.     For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
  2508.         For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
  2509.             sLine = ""
  2510.  
  2511.             sLine = sLine + _Trim$(Str$(iPlayer))
  2512.             sLine = sLine + sDelim
  2513.  
  2514.             sLine = sLine + _Trim$(Str$(iWhichInput))
  2515.             sLine = sLine + sDelim
  2516.  
  2517.             sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).device))
  2518.             sLine = sLine + sDelim
  2519.  
  2520.             sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).typ))
  2521.             sLine = sLine + sDelim
  2522.  
  2523.             sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).code))
  2524.             sLine = sLine + sDelim
  2525.  
  2526.             sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).value))
  2527.             sLine = sLine + sDelim
  2528.  
  2529.             sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).repeat))
  2530.  
  2531.             Print #1, sLine
  2532.             iCount = iCount + 1
  2533.         Next iWhichInput
  2534.     Next iPlayer
  2535.  
  2536.     Close #1
  2537.  
  2538.     'DebugPrint "Wrote   " + _Trim$(Str$(iCount)) + " lines."
  2539.     'Print "Skipped " + _Trim$(Str$(iError)) + " lines."
  2540.     'DebugPrint ""
  2541.     'Input "PRESS <ENTER> TO CONTINUE", in$
  2542.  
  2543.     If Len(sError) = 0 Then
  2544.         sResult = "Saved mapping file " + Chr$(34) + sFile + Chr$(34) + "."
  2545.     Else
  2546.         sResult = "ERRORS: " + sError
  2547.     End If
  2548.  
  2549.     SaveControllerMap$ = sResult
  2550. End Function ' SaveControllerMap$
  2551.  
  2552. ' /////////////////////////////////////////////////////////////////////////////
  2553.  
  2554. Function LoadControllerMap$
  2555.     Dim RoutineName As String:: RoutineName = "LoadControllerMap$"
  2556.     Dim sResult As String: sResult = ""
  2557.     Dim sError As String: sError = ""
  2558.     Dim sNextErr As String
  2559.  
  2560.     Dim sFile As String
  2561.     Dim sText As String
  2562.     Dim iTotal As Long: iTotal = 0
  2563.  
  2564.     Dim iRead As Long: iRead = 0
  2565.     Dim iValid As Long: iValid = 0
  2566.     Dim iBad As Long: iBad = 0
  2567.     Dim iBlank As Long: iBlank = 0
  2568.  
  2569.     Dim sLine As String
  2570.     ReDim arrNextLine(-1) As String
  2571.     Dim iNumValues As Integer
  2572.     Dim iAdjust As Integer
  2573.  
  2574.     Dim iPlayer As Integer
  2575.     Dim iWhichInput As Integer
  2576.     Dim iDevice As Integer
  2577.     Dim iType As Integer
  2578.     Dim iCode As Integer
  2579.     Dim iValue As Integer
  2580.     Dim bRepeat As Integer
  2581.     'Dim sDebugLine As String
  2582.  
  2583.     'DebugPrint "--------------------------------------------------------------------------------"
  2584.     'DebugPrint "Started " + RoutineName
  2585.     'DebugPrint "--------------------------------------------------------------------------------"
  2586.  
  2587.     ' Get file name
  2588.     If Len(sError) = 0 Then
  2589.         If Len(m_ControlMapFileName$) = 0 Then
  2590.             m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
  2591.         End If
  2592.         sFile = Mid$(m_ControlMapFileName$, _InStrRev(m_ControlMapFileName$, "\") + 1)
  2593.     End If
  2594.  
  2595.     '' Get file name
  2596.     'If Len(sError) = 0 Then
  2597.     '    Cls
  2598.     '    If Len(m_ControlMapFileName$) = 0 Then
  2599.     '        m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
  2600.     '    End If
  2601.     '    Print "LOAD CONTROLLER MAPPING:"
  2602.     '    Print "Default file name is " + Chr$(34) + m_ControlMapFileName$ + Chr$(34) + "."
  2603.     '    Input "Type name of file to open, or blank for default: ", in$
  2604.     '    in$ = _Trim$(in$)
  2605.     '    If Len(in$) > 0 Then
  2606.     '        m_ControlMapFileName$ = in$
  2607.     '    End If
  2608.     '    sFile = m_ProgramPath$ + m_ControlMapFileName$
  2609.     'End If
  2610.  
  2611.     ' Make sure file exists
  2612.     If Len(sError) = 0 Then
  2613.         If _FileExists(m_ControlMapFileName$) = FALSE Then
  2614.             sError = "File not found: " + Chr$(34) + m_ControlMapFileName$ + Chr$(34)
  2615.         Else
  2616.             'DebugPrint "Found file: " + chr$(34) + m_ControlMapFileName$ + chr$(34)
  2617.         End If
  2618.     End If
  2619.  
  2620.     ' Read data from file
  2621.     If Len(sError) = 0 Then
  2622.         'DebugPrint "OPEN m_ControlMapFileName$ FOR BINARY AS #1"
  2623.  
  2624.         Open m_ControlMapFileName$ For Binary As #1
  2625.         sText = Space$(LOF(1))
  2626.         Get #1, , sText
  2627.         Close #1
  2628.         iTotal = Len(sText) - Len(Replace$(sText, Chr$(13), ""))
  2629.         sText = ""
  2630.  
  2631.         Open m_ControlMapFileName$ For Input As #1
  2632.         While Not EOF(1)
  2633.             'INPUT #1, sLine
  2634.             Line Input #1, sLine ' read entire text file line
  2635.  
  2636.             iRead = iRead + 1
  2637.             'DebugPrint "Parsing line " + _Trim$(Str$(iRead)) + _
  2638.             '    " of " + _Trim$(Str$(iTotal))
  2639.  
  2640.             sLine = Replace$(sLine, " ", "") ' Remove spaces
  2641.             sLine = Replace$(sLine, Chr$(9), "") ' Remove tabs
  2642.             sLine = Replace$(sLine, Chr$(10), "") ' Remove line breaks
  2643.             sLine = Replace$(sLine, Chr$(13), "") ' Remove carriage returns
  2644.             'DebugPrint "    Trimmed=" + chr$(34) + sLine + chr$(34)
  2645.  
  2646.             If Len(sLine) > 0 Then
  2647.                 split sLine, ",", arrNextLine()
  2648.                 'DebugPrint "split into arrNextLine()"
  2649.                 'DebugPrint "    lbound =" + _Trim$(Str$(lbound(arrNextLine))) '+ CHR$(10)
  2650.                 'DebugPrint "    ubound =" + _Trim$(Str$(ubound(arrNextLine))) '+ CHR$(10)
  2651.  
  2652.                 iNumValues = (UBound(arrNextLine) - LBound(arrNextLine)) + 1
  2653.                 If iNumValues > 5 Then
  2654.                     iAdjust = -1 '- lbound(arrNextLine)
  2655.  
  2656.                     If Len(sNextErr) = 0 Then
  2657.                         If IsNum%(arrNextLine(1 + iAdjust)) = TRUE Then
  2658.                             iPlayer = Val(arrNextLine(1 + iAdjust))
  2659.                         Else
  2660.                             sNextErr = "Error on line " + cstr$(iRead) + ", value 1: not a number"
  2661.                         End If
  2662.                     End If
  2663.  
  2664.                     If Len(sNextErr) = 0 Then
  2665.                         If IsNum%(arrNextLine(2 + iAdjust)) = TRUE Then
  2666.                             iWhichInput = Val(arrNextLine(2 + iAdjust))
  2667.                         Else
  2668.                             sNextErr = "Error on line " + cstr$(iRead) + ", value 2: not a number"
  2669.                         End If
  2670.                     End If
  2671.  
  2672.                     If Len(sNextErr) = 0 Then
  2673.                         If IsNum%(arrNextLine(3 + iAdjust)) = TRUE Then
  2674.                             iDevice = Val(arrNextLine(3 + iAdjust))
  2675.                         Else
  2676.                             sNextErr = "Error on line " + cstr$(iRead) + ", value 3: not a number"
  2677.                         End If
  2678.                     End If
  2679.  
  2680.                     If Len(sNextErr) = 0 Then
  2681.                         If IsNum%(arrNextLine(4 + iAdjust)) = TRUE Then
  2682.                             iType = Val(arrNextLine(4 + iAdjust))
  2683.                         Else
  2684.                             sNextErr = "Error on line " + cstr$(iRead) + ", value 4: not a number"
  2685.                         End If
  2686.                     End If
  2687.  
  2688.                     If Len(sNextErr) = 0 Then
  2689.                         If IsNum%(arrNextLine(5 + iAdjust)) = TRUE Then
  2690.                             iCode = Val(arrNextLine(5 + iAdjust))
  2691.                         Else
  2692.                             sNextErr = "Error on line " + cstr$(iRead) + ", value 5: not a number"
  2693.                         End If
  2694.                     End If
  2695.  
  2696.                     If Len(sNextErr) = 0 Then
  2697.                         If IsNum%(arrNextLine(6 + iAdjust)) = TRUE Then
  2698.                             iValue = Val(arrNextLine(6 + iAdjust))
  2699.                         Else
  2700.                             sNextErr = "Error on line " + cstr$(iRead) + ", value 6: not a number"
  2701.                         End If
  2702.                     End If
  2703.  
  2704.                     ' validate iPlayer
  2705.                     If Len(sNextErr) = 0 Then
  2706.                         If iPlayer < LBound(m_arrControlMap, 1) Then
  2707.                             sNextErr = "Player value " + _Trim$(Str$(iPlayer)) + _
  2708.                                 " is outside lbound(m_arrControlMap, 1) " + _
  2709.                                 " which is " + _Trim$(Str$(lbound(m_arrControlMap, 1))) + "."
  2710.                         ElseIf iPlayer > UBound(m_arrControlMap, 1) Then
  2711.                             sNextErr = "Player value " + _Trim$(Str$(iPlayer)) + _
  2712.                                 " is outside ubound(m_arrControlMap, 1) " + _
  2713.                                 " which is " + _Trim$(Str$(ubound(m_arrControlMap, 1))) + "."
  2714.                         End If
  2715.                     End If
  2716.  
  2717.                     ' validate iWhichInput
  2718.                     If Len(sNextErr) = 0 Then
  2719.                         If iWhichInput < LBound(m_arrControlMap, 2) Then
  2720.                             sNextErr = "WhichInput value " + _Trim$(Str$(iWhichInput)) + _
  2721.                                 " is outside lbound(m_arrControlMap, 2) " + _
  2722.                                 " which is " + _Trim$(Str$(lbound(m_arrControlMap, 2))) + "."
  2723.                         ElseIf iWhichInput > UBound(m_arrControlMap, 2) Then
  2724.                             sNextErr = "WhichInput value " + _Trim$(Str$(iWhichInput)) + _
  2725.                                 " is outside ubound(m_arrControlMap, 2) " + _
  2726.                                 " which is " + _Trim$(Str$(ubound(m_arrControlMap, 2))) + "."
  2727.                         End If
  2728.                     End If
  2729.  
  2730.                     ' validate repeat setting
  2731.                     If iNumValues > 6 Then
  2732.                         If Len(sNextErr) = 0 Then
  2733.                             If IsNum%(arrNextLine(7 + iAdjust)) = TRUE Then
  2734.                                 bRepeat = Val(arrNextLine(7 + iAdjust))
  2735.                             Else
  2736.                                 sNextErr = "Error on line " + cstr$(iRead) + ", value 7: not a number"
  2737.                             End If
  2738.                         End If
  2739.                     Else
  2740.                         ' get values from global
  2741.                         'if m_bRepeatOverride = TRUE then
  2742.                         bRepeat = GetGlobalInputRepeatSetting%(iWhichInput)
  2743.                         'end if
  2744.                     End If
  2745.                 Else
  2746.                     sNextErr = "Error on line " + cstr$(iRead) + ": detected " + cstr$(iNumValues) + " values, expected 6."
  2747.                 End If
  2748.  
  2749.                 If Len(sNextErr) = 0 Then
  2750.                     iValid = iValid + 1
  2751.                     m_arrControlMap(iPlayer, iWhichInput).device = iDevice
  2752.                     m_arrControlMap(iPlayer, iWhichInput).typ = iType
  2753.                     m_arrControlMap(iPlayer, iWhichInput).code = iCode
  2754.                     m_arrControlMap(iPlayer, iWhichInput).value = iValue
  2755.                     m_arrControlMap(iPlayer, iWhichInput).repeat = bRepeat
  2756.                 Else
  2757.                     iBad = iBad + 1
  2758.                     DebugPrint sNextErr
  2759.                 End If
  2760.             Else
  2761.                 'DebugPrint "    Line is blank: skipped"
  2762.                 iBlank = iBlank + 1
  2763.             End If ' LEN(sLine) > 0
  2764.  
  2765.         Wend
  2766.         Close #1
  2767.     End If
  2768.  
  2769.     'DebugPrint ""
  2770.     'DebugPrint "Lines read: " + _Trim$(Str$(iRead))
  2771.     'DebugPrint "Valid     : " + _Trim$(Str$(iValid))
  2772.     'DebugPrint "Invalid   : " + _Trim$(Str$(iErrors))
  2773.     'DebugPrint "Blank     : " + _Trim$(Str$(iBlank))
  2774.     'DebugPrint ""
  2775.     'Input "PRESS <ENTER> TO CONTINUE", in$
  2776.  
  2777.     If Len(sError) = 0 Then
  2778.         sResult = "Loaded mapping file " + Chr$(34) + sFile + Chr$(34) + "."
  2779.         m_bHaveMapping = TRUE
  2780.     Else
  2781.         sResult = "ERRORS: " + sError
  2782.     End If
  2783.  
  2784.     LoadControllerMap$ = sResult
  2785. End Function ' LoadControllerMap$
  2786.  
  2787. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2788. ' END FILE FUNCTIONS
  2789. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2790.  
  2791. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2792. ' BEGIN GRAPHIC PRINTING ROUTINES
  2793. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2794.  
  2795. ' /////////////////////////////////////////////////////////////////////////////
  2796. ' Eliminates the math.
  2797.  
  2798. ' Text resolution:
  2799. '  648 x  480:  80 x 30
  2800. '  720 x  480:  90 x 30
  2801. '  800 x  600: 100 x 37
  2802. ' 1024 x  768: 128 x 48
  2803. ' 1280 x 1024: 160 x 64
  2804. ' 1920 x 1080: 240 x 67
  2805. ' 2048 x 1152: 256 x 72 (truncated after 70 rows, 255 columns)
  2806. ' 3840 x 2160: 480 x135 (truncated after 133 rows, 479 columns)
  2807.  
  2808. Sub PrintString (iCol As Integer, iRow As Integer, MyString As String)
  2809.     Dim iCols As Integer
  2810.     Dim iRows As Integer
  2811.     Dim iX As Integer
  2812.     Dim iY As Integer
  2813.     iCols = _Width(0) \ _FontWidth
  2814.     iRows = _Height(0) \ _FontHeight
  2815.     iX = _FontWidth * (iCol - 1)
  2816.     iY = _FontHeight * (iRow - 1)
  2817.     _PrintString (iX, iY), MyString
  2818. End Sub ' PrintString
  2819.  
  2820. ' /////////////////////////////////////////////////////////////////////////////
  2821. ' A way to automatically print to columns.
  2822.  
  2823. ' Depends on the following shared variables:
  2824. '     Dim Shared m_NumColumns As Integer : m_NumColumns = 1
  2825. '     Dim Shared m_PrintRow As Integer : m_PrintRow = 0
  2826. '     Dim Shared m_PrintCol As Integer : m_PrintCol = 0
  2827. '     Dim Shared m_StartRow As Integer : m_StartRow = 0
  2828. '     Dim Shared m_EndRow As Integer : m_EndRow = 0
  2829. '     Dim Shared m_StartCol As Integer : m_StartCol = 0
  2830. '     Dim Shared m_EndCol As Integer : m_EndCol = 0
  2831.  
  2832. ' InitColumns 2
  2833. ' m_PrintRow = 5
  2834. ' m_PrintCol = 2
  2835. ' PrintColumn "Col 2, Row 5"
  2836. ' PrintColumn "m_NumColumns=" + cstr$(m_NumColumns)
  2837.  
  2838. Sub PrintColumn (MyString As String)
  2839.     Dim iCols As Integer
  2840.     Dim iRows As Integer
  2841.     Dim iX As Integer
  2842.     Dim iY As Integer
  2843.  
  2844.     ReDim arrLines(-1) As String
  2845.     Dim iRow As Integer
  2846.     Dim iCol As Integer
  2847.     Dim sChar As String
  2848.     Dim sLine As String
  2849.     Dim iColWidth As Integer
  2850.  
  2851.     iCols = _Width(0) \ _FontWidth
  2852.     iRows = _Height(0) \ _FontHeight
  2853.  
  2854.     If m_NumColumns < 1 Or m_NumColumns > iCols Then
  2855.         m_NumColumns = 1
  2856.     End If
  2857.  
  2858.     If m_StartRow < 1 Or m_StartRow > iRows Then
  2859.         m_StartRow = 1
  2860.     End If
  2861.     If m_EndRow < m_StartRow Or m_EndRow > iRows Then
  2862.         m_EndRow = iRows
  2863.     End If
  2864.     If m_StartCol < 1 Or m_StartCol > m_NumColumns Then
  2865.         m_StartCol = 1
  2866.     End If
  2867.     If m_EndCol < m_StartCol Or m_EndCol > m_NumColumns Then
  2868.         m_EndCol = m_NumColumns
  2869.     End If
  2870.  
  2871.     If m_PrintRow < m_StartRow Then
  2872.         m_PrintRow = m_StartRow
  2873.     End If
  2874.     If m_PrintCol < m_StartCol Then
  2875.         m_PrintCol = m_StartCol
  2876.     End If
  2877.  
  2878.     iColWidth = iCols \ m_NumColumns
  2879.  
  2880.     If m_PrintRow <= m_EndRow Then
  2881.         If m_PrintCol <= m_EndCol Then
  2882.             split MyString, Chr$(13), arrLines()
  2883.             For iRow = 0 To UBound(arrlines)
  2884.                 sLine = Left$(arrLines(iRow), iColWidth)
  2885.                 'TODO: wrap remaining text
  2886.                 iX = _FontWidth * ((m_PrintCol - 1) * iColWidth)
  2887.                 iY = _FontHeight * (m_PrintRow - 1)
  2888.                 _PrintString (iX, iY), sLine
  2889.  
  2890.                 m_PrintRow = m_PrintRow + 1
  2891.                 If m_PrintRow > m_EndRow Then
  2892.                     m_PrintRow = m_StartRow
  2893.                     m_PrintCol = m_PrintCol + 1
  2894.                     If m_PrintCol > m_NumColumns Then
  2895.                         'TODO: options for when we reach the bottom of the last column (stop printing, wrap around)
  2896.                         m_PrintCol = 1
  2897.                     End If
  2898.                 End If
  2899.             Next iRow
  2900.         End If
  2901.     End If
  2902. End Sub ' PrintColumn
  2903.  
  2904. ' /////////////////////////////////////////////////////////////////////////////
  2905. ' A way to automatically print to columns.
  2906.  
  2907. Sub ColumnBreak ()
  2908.     m_PrintRow = m_StartRow
  2909.     m_PrintCol = m_PrintCol + 1
  2910.     If m_PrintCol > m_NumColumns Then
  2911.         'TODO: options for when we go past the last column (stop printing, wrap around)
  2912.     End If
  2913. End Sub ' ColumnBreak
  2914.  
  2915. ' /////////////////////////////////////////////////////////////////////////////
  2916. ' A way to automatically print to columns.
  2917.  
  2918. Sub InitColumns (iNumColumns As Integer)
  2919.     Dim iCols As Integer
  2920.     Dim iRows As Integer
  2921.     iCols = _Width(0) \ _FontWidth
  2922.     iRows = _Height(0) \ _FontHeight
  2923.     If iNumColumns < 1 Or iNumColumns > iCols Then
  2924.         m_NumColumns = 1
  2925.     Else
  2926.         m_NumColumns = iNumColumns
  2927.     End If
  2928.  
  2929.     If m_StartRow < 1 Or m_StartRow > iRows Then
  2930.         m_StartRow = 1
  2931.     End If
  2932.     If m_EndRow < m_StartRow Or m_EndRow > iRows Then
  2933.         m_EndRow = iRows
  2934.     End If
  2935.     If m_StartCol < 1 Or m_StartCol > m_NumColumns Then
  2936.         m_StartCol = 1
  2937.     End If
  2938.     If m_EndCol < m_StartCol Or m_EndCol > m_NumColumns Then
  2939.         m_EndCol = m_NumColumns
  2940.     End If
  2941.  
  2942.     m_PrintRow = 1
  2943.     m_PrintCol = 1
  2944. End Sub ' InitColumns
  2945.  
  2946. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2947. ' END GRAPHIC PRINTING ROUTINES
  2948. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2949.  
  2950. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2951. ' BEGIN DEBUGGING ROUTINES #DEBUGGING
  2952. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2953. Sub DebugPrint (s$)
  2954.     If m_bTesting = TRUE Then
  2955.         _Echo s$
  2956.         'ReDim arrLines$(0)
  2957.         'dim delim$ : delim$ = Chr$(13)
  2958.         'split MyString, delim$, arrLines$()
  2959.     End If
  2960. End Sub ' DebugPrint
  2961.  
  2962. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2963. ' END DEBUGGING ROUTINES @DEBUGGING
  2964. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2965.  
  2966. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2967. ' BEGIN GENERAL PURPOSE ROUTINES #GEN
  2968. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2969.  
  2970. ' /////////////////////////////////////////////////////////////////////////////
  2971. ' Convert a value to string and trim it (because normal Str$ adds spaces)
  2972.  
  2973. Function cstr$ (myValue)
  2974.     'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
  2975.     cstr$ = _Trim$(Str$(myValue))
  2976. End Function ' cstr$
  2977.  
  2978. ' /////////////////////////////////////////////////////////////////////////////
  2979. ' Convert a Long value to string and trim it (because normal Str$ adds spaces)
  2980.  
  2981. Function cstrl$ (myValue As Long)
  2982.     cstrl$ = _Trim$(Str$(myValue))
  2983. End Function ' cstrl$
  2984.  
  2985. ' /////////////////////////////////////////////////////////////////////////////
  2986. ' Convert a Single value to string and trim it (because normal Str$ adds spaces)
  2987.  
  2988. Function cstrs$ (myValue As Single)
  2989.     ''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
  2990.     cstrs$ = _Trim$(Str$(myValue))
  2991. End Function ' cstrs$
  2992.  
  2993. ' /////////////////////////////////////////////////////////////////////////////
  2994. ' Convert an unsigned Long value to string and trim it (because normal Str$ adds spaces)
  2995.  
  2996. Function cstrul$ (myValue As _Unsigned Long)
  2997.     cstrul$ = _Trim$(Str$(myValue))
  2998. End Function ' cstrul$
  2999.  
  3000. ' /////////////////////////////////////////////////////////////////////////////
  3001. ' Scientific notation - QB64 Wiki
  3002. ' https://www.qb64.org/wiki/Scientific_notation
  3003.  
  3004. ' Example: A string function that displays extremely small or large exponential decimal values.
  3005.  
  3006. Function DblToStr$ (n#)
  3007.     value$ = UCase$(LTrim$(Str$(n#)))
  3008.     Xpos% = InStr(value$, "D") + InStr(value$, "E") 'only D or E can be present
  3009.     If Xpos% Then
  3010.         expo% = Val(Mid$(value$, Xpos% + 1))
  3011.         If Val(value$) < 0 Then
  3012.             sign$ = "-": valu$ = Mid$(value$, 2, Xpos% - 2)
  3013.         Else valu$ = Mid$(value$, 1, Xpos% - 1)
  3014.         End If
  3015.         dot% = InStr(valu$, "."): L% = Len(valu$)
  3016.         If expo% > 0 Then add$ = String$(expo% - (L% - dot%), "0")
  3017.         If expo% < 0 Then min$ = String$(Abs(expo%) - (dot% - 1), "0"): DP$ = "."
  3018.         For n = 1 To L%
  3019.             If Mid$(valu$, n, 1) <> "." Then num$ = num$ + Mid$(valu$, n, 1)
  3020.         Next
  3021.     Else DblToStr$ = value$: Exit Function
  3022.     End If
  3023.     DblToStr$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
  3024. End Function ' DblToStr$
  3025.  
  3026. ' /////////////////////////////////////////////////////////////////////////////
  3027.  
  3028. Function FormatNumber$ (myValue, iDigits As Integer)
  3029.     Dim strValue As String
  3030.     strValue = DblToStr$(myValue) + String$(iDigits, " ")
  3031.     If myValue < 1 Then
  3032.         If myValue < 0 Then
  3033.             strValue = Replace$(strValue, "-.", "-0.")
  3034.         ElseIf myValue > 0 Then
  3035.             strValue = "0" + strValue
  3036.         End If
  3037.     End If
  3038.     FormatNumber$ = Left$(strValue, iDigits)
  3039. End Function ' FormatNumber$
  3040.  
  3041. ' /////////////////////////////////////////////////////////////////////////////
  3042. ' From: Bitwise Manipulations By Steven Roman
  3043. ' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
  3044.  
  3045. ' Returns the 8-bit binary representation
  3046. ' of an integer iInput where 0 <= iInput <= 255
  3047.  
  3048. Function GetBinary$ (iInput1 As Integer)
  3049.     Dim sResult As String
  3050.     Dim iLoop As Integer
  3051.     Dim iInput As Integer: iInput = iInput1
  3052.  
  3053.     sResult = ""
  3054.  
  3055.     If iInput >= 0 And iInput <= 255 Then
  3056.         For iLoop = 1 To 8
  3057.             sResult = LTrim$(RTrim$(Str$(iInput Mod 2))) + sResult
  3058.             iInput = iInput \ 2
  3059.             'If iLoop = 4 Then sResult = " " + sResult
  3060.         Next iLoop
  3061.     End If
  3062.  
  3063.     GetBinary$ = sResult
  3064. End Function ' GetBinary$
  3065.  
  3066. ' /////////////////////////////////////////////////////////////////////////////
  3067. ' wonderfully inefficient way to read if a bit is set
  3068. ' ival = GetBit256%(int we are comparing, int containing the bits we want to read)
  3069.  
  3070. ' See also: GetBit256%, SetBit256%
  3071.  
  3072. Function GetBit256% (iNum1 As Integer, iBit1 As Integer)
  3073.     Dim iResult As Integer
  3074.     Dim sNum As String
  3075.     Dim sBit As String
  3076.     Dim iLoop As Integer
  3077.     Dim bContinue As Integer
  3078.     'DIM iTemp AS INTEGER
  3079.     Dim iNum As Integer: iNum = iNum1
  3080.     Dim iBit As Integer: iBit = iBit1
  3081.  
  3082.     iResult = FALSE
  3083.     bContinue = TRUE
  3084.  
  3085.     If iNum < 256 And iBit <= 128 Then
  3086.         sNum = GetBinary$(iNum)
  3087.         sBit = GetBinary$(iBit)
  3088.         For iLoop = 1 To 8
  3089.             If Mid$(sBit, iLoop, 1) = "1" Then
  3090.                 'if any of the bits in iBit are false, return false
  3091.                 If Mid$(sNum, iLoop, 1) = "0" Then
  3092.                     iResult = FALSE
  3093.                     bContinue = FALSE
  3094.                     Exit For
  3095.                 End If
  3096.             End If
  3097.         Next iLoop
  3098.         If bContinue = TRUE Then
  3099.             iResult = TRUE
  3100.         End If
  3101.     End If
  3102.  
  3103.     GetBit256% = iResult
  3104. End Function ' GetBit256%
  3105.  
  3106. ' /////////////////////////////////////////////////////////////////////////////
  3107. ' From: Bitwise Manipulations By Steven Roman
  3108. ' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
  3109.  
  3110. ' Returns the integer that corresponds to a binary string of length 8
  3111.  
  3112. Function GetIntegerFromBinary% (sBinary1 As String)
  3113.     Dim iResult As Integer
  3114.     Dim iLoop As Integer
  3115.     Dim strBinary As String
  3116.     Dim sBinary As String: sBinary = sBinary1
  3117.  
  3118.     iResult = 0
  3119.     strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
  3120.     For iLoop = 0 To Len(strBinary) - 1
  3121.         iResult = iResult + 2 ^ iLoop * Val(Mid$(strBinary, Len(strBinary) - iLoop, 1))
  3122.     Next iLoop
  3123.  
  3124.     GetIntegerFromBinary% = iResult
  3125. End Function ' GetIntegerFromBinary%
  3126.  
  3127. ' /////////////////////////////////////////////////////////////////////////////
  3128.  
  3129. Function IIF (Condition, IfTrue, IfFalse)
  3130.     If Condition Then IIF = IfTrue Else IIF = IfFalse
  3131.  
  3132. ' /////////////////////////////////////////////////////////////////////////////
  3133.  
  3134. Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
  3135.     If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
  3136.  
  3137. ' /////////////////////////////////////////////////////////////////////////////
  3138. ' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
  3139.  
  3140. Function IsEven% (n)
  3141.     If n Mod 2 = 0 Then
  3142.         IsEven% = TRUE
  3143.     Else
  3144.         IsEven% = FALSE
  3145.     End If
  3146. End Function ' IsEven%
  3147.  
  3148. ' /////////////////////////////////////////////////////////////////////////////
  3149. ' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
  3150.  
  3151. Function IsOdd% (n)
  3152.     If n Mod 2 = 1 Then
  3153.         IsOdd% = TRUE
  3154.     Else
  3155.         IsOdd% = FALSE
  3156.     End If
  3157. End Function ' IsOdd%
  3158.  
  3159. ' /////////////////////////////////////////////////////////////////////////////
  3160. ' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
  3161.  
  3162. Function IsNum% (text$)
  3163.     Dim a$
  3164.     Dim b$
  3165.     a$ = _Trim$(text$)
  3166.     b$ = _Trim$(Str$(Val(text$)))
  3167.     If a$ = b$ Then
  3168.         IsNum% = TRUE
  3169.     Else
  3170.         IsNum% = FALSE
  3171.     End If
  3172. End Function ' IsNum%
  3173.  
  3174. ' /////////////////////////////////////////////////////////////////////////////
  3175. ' Re: Does a Is Number function exist in QB64?
  3176. ' https://www.qb64.org/forum/index.php?topic=896.15
  3177.  
  3178. ' MWheatley
  3179. ' « Reply #18 on: January 01, 2019, 11:24:30 AM »
  3180.  
  3181. ' returns 1 if string is an integer, 0 if not
  3182. Function IsNumber (text$)
  3183.     Dim i As Integer
  3184.  
  3185.     IsNumber = 1
  3186.     For i = 1 To Len(text$)
  3187.         If Asc(Mid$(text$, i, 1)) < 45 Or Asc(Mid$(text$, i, 1)) >= 58 Then
  3188.             IsNumber = 0
  3189.             Exit For
  3190.         ElseIf Asc(Mid$(text$, i, 1)) = 47 Then
  3191.             IsNumber = 0
  3192.             Exit For
  3193.         End If
  3194.     Next i
  3195. End Function ' IsNumber
  3196.  
  3197. ' /////////////////////////////////////////////////////////////////////////////
  3198. ' Split and join strings
  3199. ' https://www.qb64.org/forum/index.php?topic=1073.0
  3200.  
  3201. 'Combine all elements of in$() into a single string with delimiter$ separating the elements.
  3202.  
  3203. Function join$ (in$(), delimiter$)
  3204.     Dim result$
  3205.     Dim i As Long
  3206.     result$ = in$(LBound(in$))
  3207.     For i = LBound(in$) + 1 To UBound(in$)
  3208.         result$ = result$ + delimiter$ + in$(i)
  3209.     Next i
  3210.     join$ = result$
  3211. End Function ' join$
  3212.  
  3213. ' /////////////////////////////////////////////////////////////////////////////
  3214. ' ABS was returning strange values with type LONG
  3215. ' so I created this which does not.
  3216.  
  3217. Function LongABS& (lngValue As Long)
  3218.     If Sgn(lngValue) = -1 Then
  3219.         LongABS& = 0 - lngValue
  3220.     Else
  3221.         LongABS& = lngValue
  3222.     End If
  3223. End Function ' LongABS&
  3224.  
  3225. ' /////////////////////////////////////////////////////////////////////////////
  3226. ' Writes sText to a debug file in the EXE folder.
  3227. ' Debug file is named the same thing as the program EXE name with ".txt" at the end.
  3228. ' For example the program "C:\QB64\MyProgram.BAS" running as
  3229. ' "C:\QB64\MyProgram.EXE" would have an output file "C:\QB64\MyProgram.EXE.txt".
  3230. ' If the file doesn't exist, it is created, otherwise it is appended to.
  3231.  
  3232. Sub DebugPrintFile (sText As String)
  3233.     Dim sFileName As String
  3234.     Dim sError As String
  3235.     Dim sOut As String
  3236.  
  3237.     sFileName = ProgramPath$ + ProgramName$ + ".txt"
  3238.     sError = ""
  3239.     If _FileExists(sFileName) = FALSE Then
  3240.         sOut = ""
  3241.         sOut = sOut + "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + Chr$(13) + Chr$(10)
  3242.         sOut = sOut + "PROGRAM : " + ProgramName$ + Chr$(13) + Chr$(10)
  3243.         sOut = sOut + "RUN DATE: " + CurrentDateTime$ + Chr$(13) + Chr$(10)
  3244.         sOut = sOut + "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + Chr$(13) + Chr$(10)
  3245.         sError = PrintFile$(sFileName, sOut, FALSE)
  3246.     End If
  3247.     If Len(sError) = 0 Then
  3248.         sError = PrintFile$(sFileName, sText, TRUE)
  3249.     End If
  3250.     If Len(sError) <> 0 Then
  3251.         Print CurrentDateTime$ + " DebugPrintFile FAILED: " + sError
  3252.     End If
  3253. End Sub ' DebugPrintFile
  3254.  
  3255. ' /////////////////////////////////////////////////////////////////////////////
  3256.  
  3257. Function IntPadRight$ (iValue As Integer, iWidth As Integer)
  3258.     IntPadRight$ = Left$(_Trim$(Str$(iValue)) + String$(iWidth, " "), iWidth)
  3259. End Function ' IntPadRight$
  3260.  
  3261. ' /////////////////////////////////////////////////////////////////////////////
  3262. ' Returns blank if successful else returns error message.
  3263.  
  3264. Function PrintFile$ (sFileName As String, sText As String, bAppend As Integer)
  3265.     'x = 1: y = 2: z$ = "Three"
  3266.  
  3267.     Dim sError As String: sError = ""
  3268.  
  3269.     If Len(sError) = 0 Then
  3270.         If (bAppend = TRUE) Then
  3271.             If _FileExists(sFileName) Then
  3272.                 Open sFileName For Append As #1 ' opens an existing file for appending
  3273.             Else
  3274.                 sError = "Error in PrintFile$ : File not found. Cannot append."
  3275.             End If
  3276.         Else
  3277.             Open sFileName For Output As #1 ' opens and clears an existing file or creates new empty file
  3278.         End If
  3279.     End If
  3280.     If Len(sError) = 0 Then
  3281.         ' WRITE places text in quotes in the file
  3282.         'WRITE #1, x, y, z$
  3283.         'WRITE #1, sText
  3284.  
  3285.         ' PRINT does not put text inside quotes
  3286.         Print #1, sText
  3287.  
  3288.         Close #1
  3289.  
  3290.         'PRINT "File created with data. Press a key!"
  3291.         'K$ = INPUT$(1) 'press a key
  3292.  
  3293.         'OPEN sFileName FOR INPUT AS #2 ' opens a file to read it
  3294.         'INPUT #2, a, b, c$
  3295.         'CLOSE #2
  3296.  
  3297.         'PRINT a, b, c$
  3298.         'WRITE a, b, c$
  3299.     End If
  3300.  
  3301.     PrintFile$ = sError
  3302. End Function ' PrintFile$
  3303.  
  3304. ' /////////////////////////////////////////////////////////////////////////////
  3305. ' Generate random value between Min and Max.
  3306. Function RandomNumber% (Min%, Max%)
  3307.     Dim NumSpread%
  3308.  
  3309.     ' SET RANDOM SEED
  3310.     'Randomize ' Initialize random-number generator.
  3311.  
  3312.     ' GET RANDOM # Min%-Max%
  3313.     'RandomNumber = Int((Max * Rnd) + Min) ' generate number
  3314.  
  3315.     NumSpread% = (Max% - Min%) + 1
  3316.  
  3317.     RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
  3318.  
  3319. End Function ' RandomNumber%
  3320.  
  3321. ' /////////////////////////////////////////////////////////////////////////////
  3322.  
  3323. Sub RandomNumberTest
  3324.     Dim iCols As Integer: iCols = 10
  3325.     Dim iRows As Integer: iRows = 20
  3326.     Dim iLoop As Integer
  3327.     Dim iX As Integer
  3328.     Dim iY As Integer
  3329.     Dim sError As String
  3330.     Dim sFileName As String
  3331.     Dim sText As String
  3332.     Dim bAppend As Integer
  3333.     Dim iMin As Integer
  3334.     Dim iMax As Integer
  3335.     Dim iNum As Integer
  3336.     Dim iErrorCount As Integer
  3337.     Dim sInput$
  3338.  
  3339.     sFileName = "c:\temp\maze_test_1.txt"
  3340.     sText = "Count" + Chr$(9) + "Min" + Chr$(9) + "Max" + Chr$(9) + "Random"
  3341.     bAppend = FALSE
  3342.     sError = PrintFile$(sFileName, sText, bAppend)
  3343.     If Len(sError) = 0 Then
  3344.         bAppend = TRUE
  3345.         iErrorCount = 0
  3346.  
  3347.         iMin = 0
  3348.         iMax = iCols - 1
  3349.         For iLoop = 1 To 100
  3350.             iNum = RandomNumber%(iMin, iMax)
  3351.             sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
  3352.             sError = PrintFile$(sFileName, sText, bAppend)
  3353.             If Len(sError) > 0 Then
  3354.                 iErrorCount = iErrorCount + 1
  3355.                 Print Str$(iLoop) + ". ERROR"
  3356.                 Print "    " + "iMin=" + Str$(iMin)
  3357.                 Print "    " + "iMax=" + Str$(iMax)
  3358.                 Print "    " + "iNum=" + Str$(iNum)
  3359.                 Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
  3360.                 Print "    " + sError
  3361.             End If
  3362.         Next iLoop
  3363.  
  3364.         iMin = 0
  3365.         iMax = iRows - 1
  3366.         For iLoop = 1 To 100
  3367.             iNum = RandomNumber%(iMin, iMax)
  3368.             sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
  3369.             sError = PrintFile$(sFileName, sText, bAppend)
  3370.             If Len(sError) > 0 Then
  3371.                 iErrorCount = iErrorCount + 1
  3372.                 Print Str$(iLoop) + ". ERROR"
  3373.                 Print "    " + "iMin=" + Str$(iMin)
  3374.                 Print "    " + "iMax=" + Str$(iMax)
  3375.                 Print "    " + "iNum=" + Str$(iNum)
  3376.                 Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
  3377.                 Print "    " + sError
  3378.             End If
  3379.         Next iLoop
  3380.  
  3381.         Print "Finished generating numbers. Errors: " + Str$(iErrorCount)
  3382.     Else
  3383.         Print "Error creating file " + Chr$(34) + sFileName + Chr$(34) + "."
  3384.         Print sError
  3385.     End If
  3386.  
  3387.     Input "Press <ENTER> to continue", sInput$
  3388. End Sub ' RandomNumberTest
  3389.  
  3390. ' /////////////////////////////////////////////////////////////////////////////
  3391. ' FROM: String Manipulation
  3392. ' found at abandoned, outdated and now likely malicious qb64 dot net website
  3393. ' http://www.qb64.[net]/forum/index_topic_5964-0/
  3394. '
  3395. 'SUMMARY:
  3396. '   Purpose:  A library of custom functions that transform strings.
  3397. '   Author:   Dustinian Camburides (dustinian@gmail.com)
  3398. '   Platform: QB64 (www.qb64.org)
  3399. '   Revision: 1.6
  3400. '   Updated:  5/28/2012
  3401.  
  3402. 'SUMMARY:
  3403. '[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
  3404. 'INPUT:
  3405. 'Text: The input string; the text that's being manipulated.
  3406. 'Find: The specified sub-string; the string sought within the [Text] string.
  3407. 'Add: The sub-string that's being added to the [Text] string.
  3408.  
  3409. Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
  3410.     ' VARIABLES:
  3411.     Dim Text2 As String
  3412.     Dim Find2 As String
  3413.     Dim Add2 As String
  3414.     Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
  3415.     Dim strBefore As String ' The characters before the string to be replaced.
  3416.     Dim strAfter As String ' The characters after the string to be replaced.
  3417.  
  3418.     ' INITIALIZE:
  3419.     ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
  3420.     Text2 = Text1
  3421.     Find2 = Find1
  3422.     Add2 = Add1
  3423.  
  3424.     lngLocation = InStr(1, Text2, Find2)
  3425.  
  3426.     ' PROCESSING:
  3427.     ' While [Find2] appears in [Text2]...
  3428.     While lngLocation
  3429.         ' Extract all Text2 before the [Find2] substring:
  3430.         strBefore = Left$(Text2, lngLocation - 1)
  3431.  
  3432.         ' Extract all text after the [Find2] substring:
  3433.         strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
  3434.  
  3435.         ' Return the substring:
  3436.         Text2 = strBefore + Add2 + strAfter
  3437.  
  3438.         ' Locate the next instance of [Find2]:
  3439.         lngLocation = InStr(1, Text2, Find2)
  3440.  
  3441.         ' Next instance of [Find2]...
  3442.     Wend
  3443.  
  3444.     ' OUTPUT:
  3445.     Replace$ = Text2
  3446. End Function ' Replace$
  3447.  
  3448. ' /////////////////////////////////////////////////////////////////////////////
  3449.  
  3450. Sub ReplaceTest
  3451.     Dim in$
  3452.  
  3453.     Print "-------------------------------------------------------------------------------"
  3454.     Print "ReplaceTest"
  3455.     Print
  3456.  
  3457.     Print "Original value"
  3458.     in$ = "Thiz iz a teZt."
  3459.     Print "in$ = " + Chr$(34) + in$ + Chr$(34)
  3460.     Print
  3461.  
  3462.     Print "Replacing lowercase " + Chr$(34) + "z" + Chr$(34) + " with " + Chr$(34) + "s" + Chr$(34) + "..."
  3463.     in$ = Replace$(in$, "z", "s")
  3464.     Print "in$ = " + Chr$(34) + in$ + Chr$(34)
  3465.     Print
  3466.  
  3467.     Print "Replacing uppercase " + Chr$(34) + "Z" + Chr$(34) + " with " + Chr$(34) + "s" + Chr$(34) + "..."
  3468.     in$ = Replace$(in$, "Z", "s")
  3469.     Print "in$ = " + Chr$(34) + in$ + Chr$(34)
  3470.     Print
  3471.  
  3472.     Print "ReplaceTest finished."
  3473. End Sub ' ReplaceTest
  3474.  
  3475. ' /////////////////////////////////////////////////////////////////////////////
  3476. ' https://www.qb64.org/forum/index.php?topic=3605.0
  3477. ' Quote from: SMcNeill on Today at 03:53:48 PM
  3478. '
  3479. ' Sometimes, you guys make things entirely too  complicated.
  3480. ' There ya go!  Three functions to either round naturally,
  3481. ' always round down, or always round up, to whatever number of digits you desire.
  3482. ' EDIT:  Modified to add another option to round scientific,
  3483. ' since you had it's description included in your example.
  3484.  
  3485. Function Round## (num##, digits%)
  3486.     Round## = Int(num## * 10 ^ digits% + .5) / 10 ^ digits%
  3487.  
  3488. Function RoundUp## (num##, digits%)
  3489.     RoundUp## = _Ceil(num## * 10 ^ digits%) / 10 ^ digits%
  3490.  
  3491. Function RoundDown## (num##, digits%)
  3492.     RoundDown## = Int(num## * 10 ^ digits%) / 10 ^ digits%
  3493.  
  3494. Function Round_Scientific## (num##, digits%)
  3495.     Round_Scientific## = _Round(num## * 10 ^ digits%) / 10 ^ digits%
  3496.  
  3497. Function RoundUpDouble# (num#, digits%)
  3498.     RoundUpDouble# = _Ceil(num# * 10 ^ digits%) / 10 ^ digits%
  3499.  
  3500. Function RoundUpSingle! (num!, digits%)
  3501.     RoundUpSingle! = _Ceil(num! * 10 ^ digits%) / 10 ^ digits%
  3502.  
  3503. ' /////////////////////////////////////////////////////////////////////////////
  3504. ' fantastically inefficient way to set a bit
  3505.  
  3506. ' example use: arrMaze(iX, iY) = SetBit256%(arrMaze(iX, iY), cS, FALSE)
  3507.  
  3508. ' See also: GetBit256%, SetBit256%
  3509.  
  3510. ' newint=SetBit256%(oldint, int containing the bits we want to set, value to set them to)
  3511. Function SetBit256% (iNum1 As Integer, iBit1 As Integer, bVal1 As Integer)
  3512.     Dim sNum As String
  3513.     Dim sBit As String
  3514.     Dim sVal As String
  3515.     Dim iLoop As Integer
  3516.     Dim strResult As String
  3517.     Dim iResult As Integer
  3518.     Dim iNum As Integer: iNum = iNum1
  3519.     Dim iBit As Integer: iBit = iBit1
  3520.     Dim bVal As Integer: bVal = bVal1
  3521.  
  3522.     If iNum < 256 And iBit <= 128 Then
  3523.         sNum = GetBinary$(iNum)
  3524.         sBit = GetBinary$(iBit)
  3525.         If bVal = TRUE Then
  3526.             sVal = "1"
  3527.         Else
  3528.             sVal = "0"
  3529.         End If
  3530.         strResult = ""
  3531.         For iLoop = 1 To 8
  3532.             If Mid$(sBit, iLoop, 1) = "1" Then
  3533.                 strResult = strResult + sVal
  3534.             Else
  3535.                 strResult = strResult + Mid$(sNum, iLoop, 1)
  3536.             End If
  3537.         Next iLoop
  3538.         iResult = GetIntegerFromBinary%(strResult)
  3539.     Else
  3540.         iResult = iNum
  3541.     End If
  3542.  
  3543.     SetBit256% = iResult
  3544. End Function ' SetBit256%
  3545.  
  3546. ' /////////////////////////////////////////////////////////////////////////////
  3547. ' Scientific notation - QB64 Wiki
  3548. ' https://www.qb64.org/wiki/Scientific_notation
  3549.  
  3550. ' Example: A string function that displays extremely small or large exponential decimal values.
  3551.  
  3552. Function SngToStr$ (n!)
  3553.     value$ = UCase$(LTrim$(Str$(n!)))
  3554.     Xpos% = InStr(value$, "D") + InStr(value$, "E") 'only D or E can be present
  3555.     If Xpos% Then
  3556.         expo% = Val(Mid$(value$, Xpos% + 1))
  3557.         If Val(value$) < 0 Then
  3558.             sign$ = "-": valu$ = Mid$(value$, 2, Xpos% - 2)
  3559.         Else valu$ = Mid$(value$, 1, Xpos% - 1)
  3560.         End If
  3561.         dot% = InStr(valu$, "."): L% = Len(valu$)
  3562.         If expo% > 0 Then add$ = String$(expo% - (L% - dot%), "0")
  3563.         If expo% < 0 Then min$ = String$(Abs(expo%) - (dot% - 1), "0"): DP$ = "."
  3564.         For n = 1 To L%
  3565.             If Mid$(valu$, n, 1) <> "." Then num$ = num$ + Mid$(valu$, n, 1)
  3566.         Next
  3567.     Else SngToStr$ = value$: Exit Function
  3568.     End If
  3569.     SngToStr$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
  3570. End Function ' SngToStr$
  3571.  
  3572. ' /////////////////////////////////////////////////////////////////////////////
  3573. ' Split and join strings
  3574. ' https://www.qb64.org/forum/index.php?topic=1073.0
  3575. '
  3576. ' FROM luke, QB64 Developer
  3577. ' Date: February 15, 2019, 04:11:07 AM »
  3578. '
  3579. ' Given a string of words separated by spaces (or any other character),
  3580. ' splits it into an array of the words. I've no doubt many people have
  3581. ' written a version of this over the years and no doubt there's a million
  3582. ' ways to do it, but I thought I'd put mine here so we have at least one
  3583. ' version. There's also a join function that does the opposite
  3584. ' array -> single string.
  3585. '
  3586. ' Code is hopefully reasonably self explanatory with comments and a little demo.
  3587. ' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
  3588.  
  3589. 'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
  3590. 'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
  3591. '
  3592. 'delimiter$ must be one character long.
  3593. 'result$() must have been REDIMmed previously.
  3594.  
  3595. ' Modified to handle multi-character delimiters
  3596.  
  3597. Sub split (in$, delimiter$, result$())
  3598.     Dim start As Integer
  3599.     Dim finish As Integer
  3600.     Dim iDelimLen As Integer
  3601.     ReDim result$(-1)
  3602.  
  3603.     iDelimLen = Len(delimiter$)
  3604.  
  3605.     start = 1
  3606.     Do
  3607.         'While Mid$(in$, start, 1) = delimiter$
  3608.         While Mid$(in$, start, iDelimLen) = delimiter$
  3609.             'start = start + 1
  3610.             start = start + iDelimLen
  3611.             If start > Len(in$) Then
  3612.                 Exit Sub
  3613.             End If
  3614.         Wend
  3615.         finish = InStr(start, in$, delimiter$)
  3616.         If finish = 0 Then
  3617.             finish = Len(in$) + 1
  3618.         End If
  3619.  
  3620.         ReDim _Preserve result$(0 To UBound(result$) + 1)
  3621.  
  3622.         result$(UBound(result$)) = Mid$(in$, start, finish - start)
  3623.         start = finish + 1
  3624.     Loop While start <= Len(in$)
  3625. End Sub ' split
  3626.  
  3627. ' /////////////////////////////////////////////////////////////////////////////
  3628.  
  3629. Sub SplitTest
  3630.     Dim in$
  3631.     Dim delim$
  3632.     ReDim arrTest$(0)
  3633.     Dim iLoop%
  3634.  
  3635.     delim$ = Chr$(10)
  3636.     in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
  3637.     Print "in$ = " + Chr$(34) + in$ + Chr$(34)
  3638.     Print "delim$ = " + Chr$(34) + delim$ + Chr$(34)
  3639.     split in$, delim$, arrTest$()
  3640.  
  3641.     For iLoop% = LBound(arrTest$) To UBound(arrTest$)
  3642.         Print "arrTest$(" + LTrim$(RTrim$(Str$(iLoop%))) + ") = " + Chr$(34) + arrTest$(iLoop%) + Chr$(34)
  3643.     Next iLoop%
  3644.     Print
  3645.     Print "Split test finished."
  3646. End Sub ' SplitTest
  3647.  
  3648. ' /////////////////////////////////////////////////////////////////////////////
  3649.  
  3650. Sub SplitAndReplaceTest
  3651.     Dim in$
  3652.     Dim out$
  3653.     Dim iLoop%
  3654.     ReDim arrTest$(0)
  3655.  
  3656.     Print "-------------------------------------------------------------------------------"
  3657.     Print "SplitAndReplaceTest"
  3658.     Print
  3659.  
  3660.     Print "Original value"
  3661.     in$ = "This line 1 " + Chr$(13) + Chr$(10) + "and line 2" + Chr$(10) + "and line 3 " + Chr$(13) + "finally THE END."
  3662.     out$ = in$
  3663.     out$ = Replace$(out$, Chr$(13), "\r")
  3664.     out$ = Replace$(out$, Chr$(10), "\n")
  3665.     out$ = Replace$(out$, Chr$(9), "\t")
  3666.     Print "in$ = " + Chr$(34) + out$ + Chr$(34)
  3667.     Print
  3668.  
  3669.     Print "Fixing linebreaks..."
  3670.     in$ = Replace$(in$, Chr$(13) + Chr$(10), Chr$(13))
  3671.     in$ = Replace$(in$, Chr$(10), Chr$(13))
  3672.     out$ = in$
  3673.     out$ = Replace$(out$, Chr$(13), "\r")
  3674.     out$ = Replace$(out$, Chr$(10), "\n")
  3675.     out$ = Replace$(out$, Chr$(9), "\t")
  3676.     Print "in$ = " + Chr$(34) + out$ + Chr$(34)
  3677.     Print
  3678.  
  3679.     Print "Splitting up..."
  3680.     split in$, Chr$(13), arrTest$()
  3681.  
  3682.     For iLoop% = LBound(arrTest$) To UBound(arrTest$)
  3683.         out$ = arrTest$(iLoop%)
  3684.         out$ = Replace$(out$, Chr$(13), "\r")
  3685.         out$ = Replace$(out$, Chr$(10), "\n")
  3686.         out$ = Replace$(out$, Chr$(9), "\t")
  3687.         Print "arrTest$(" + cstr$(iLoop%) + ") = " + Chr$(34) + out$ + Chr$(34)
  3688.     Next iLoop%
  3689.     Print
  3690.  
  3691.     Print "SplitAndReplaceTest finished."
  3692. End Sub ' SplitAndReplaceTest
  3693.  
  3694. ' /////////////////////////////////////////////////////////////////////////////
  3695.  
  3696. Function StrPadRight$ (sValue As String, iWidth As Integer)
  3697.     StrPadRight$ = Left$(sValue + String$(iWidth, " "), iWidth)
  3698. End Function ' StrPadRight$
  3699.  
  3700. ' /////////////////////////////////////////////////////////////////////////////
  3701.  
  3702. Function TrueFalse$ (myValue)
  3703.     If myValue = TRUE Then
  3704.         TrueFalse$ = "TRUE"
  3705.     Else
  3706.         TrueFalse$ = "FALSE"
  3707.     End If
  3708. End Function ' TrueFalse$
  3709.  
  3710. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3711. ' END GENERAL PURPOSE ROUTINES
  3712. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3713.  
  3714. ' #END
  3715. ' ################################################################################################################################################################
  3716.