Author Topic: WIP: game input mapping for gamepad, keyboard, v0.90 (Read 3667 times)

madscijr · « **on:** January 06, 2022, 05:01:11 pm »

Here's some code I have been working on, on and off for a while.
I needed some reusable simple way to map game input from USB game controllers and the keyboard, which could be saved to a config file and reused.
It's totally a WIP and there are currently a couple issues

The mapping part lets you map keys from the keyboard but for some reason the test routine that lets you move objects around the screen isn't reading the keyboard input.
Digital joysticks don't allow continuous movement.

Most other features are working and may come in handy.
I would be curious to hear any feedback or advice.
Enjoy

Code: QB64: [Select]

' ################################################################################################################################################################
' #TOP
 
' Game Input Mapping Test
' Version 0.90 by madscijr
 
' BASED ON CODE BY SMcNeill FROM:
'     Simple Joystick Detection and Interaction  (Read 316 times)
'     https://www.qb64.org/forum/index.php?topic=2160.msg129051#msg129051
'     https://qb64forum.alephc.xyz/index.php?topic=2160.msg129083#msg129083
' and others (sources cited throughout).
 
' ################################################################################################################################################################
' #CONSTANTS = GLOBAL CONSTANTS
 
' boolean constants:
Const FALSE = 0
Const TRUE = Not FALSE
 
Const cInputNone = 0
Const cInputKey = 1
Const cInputButton = 2
Const cInputAxis = 3
 
Const cMaxButtons = 12
Const cMaxAxis = 8
Const cMaxControllers = 8
Const cMaxPlayers = 8
 
' Use as index for array of ControlInputType
Const cInputUp = 1
Const cInputDown = 2
Const cInputLeft = 3
Const cInputRight = 4
Const cInputButton1 = 5
Const cInputButton2 = 6
Const cInputButton3 = 7
Const cInputButton4 = 8
 
Const c_iKeyDown_F10 = 17408
Const c_iKeyHit_AltLeft = -30764
Const c_iKeyHit_AltRight = -30765
 
' ################################################################################################################################################################
' #UDT #TYPES = USER DEFINED TYPES
 
' UDT TO HOLD THE INFO FOR A PLAYER
TYPE PlayerType
    x AS INTEGER ' player x position
    y AS INTEGER ' player y position
    c AS INTEGER ' character to display on screen
    xOld AS INTEGER
    yOld AS INTEGER
    
    moveX As Integer
    lastMoveX As Integer
    moveY As Integer
    lastMoveY As Integer
    button1 As Integer
    lastButton1 As Integer
    button2 As Integer
    lastButton2 As Integer
    button3 As Integer
    lastButton3 As Integer
    button4 As Integer
    lastButton4 As Integer
    
END TYPE ' PlayerType
 
' UDT TO HOLD THE INFO FOR A GAME CONTROLLER
TYPE ControllerType
    buttonCount AS INTEGER
    axisCount AS INTEGER
END TYPE ' ControllerType
 
' UDT TO HOLD THE INFO FOR A GAME CONTROLLER
TYPE ControlInputType
    device As Integer
    typ As Integer ' cInputKey, cInputButton, cInputAxis
    code As Integer
    value As Integer
END TYPE ' ControlInputType
 
'' KEY MAPPING v1:
'Type DirKeyMapType
'    KeyBack As Long
'    KeyForward As Long
'    KeyLeft As Long
'    KeyRight As Long
'    KeyUp As Long
'    KeyDown As Long
'End Type ' DirKeyMapType
'
'Type ColorTextType
'    s as string
'    fg As _Unsigned Long ' foreground color
'    bg As _Unsigned Long ' background color
'End Type ' ColorTextType
'
'Type xyByteType
'    x as _byte
'    y as _byte
'End Type ' xyByteType
'
'Type xyzByteType
'    x as _byte
'    y as _byte
'    z as _byte
'End Type ' xyzByteType
'
'Type xyIntegerType
'    x as integer
'    y as integer
'End Type ' xyPointType
'
'Type xyzIntegerType
'    x as integer
'    y as integer
'    z as integer
'End Type ' xyzPointType
 
' ################################################################################################################################################################
' #VARS = GLOBAL VARIABLES
 
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
Dim Shared m_ControlMapFileName$: m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
 
' -----------------------------------------------------------------------------
' VARIABLES FOR GRAPHIC PRINTING ROUTINES
' -----------------------------------------------------------------------------
Dim Shared m_NumColumns As Integer : m_NumColumns = 1
Dim Shared m_PrintRow As Integer : m_PrintRow = 0
Dim Shared m_PrintCol As Integer : m_PrintCol = 0
Dim Shared m_StartRow As Integer : m_StartRow = 0
Dim Shared m_EndRow As Integer : m_EndRow = 0
Dim Shared m_StartCol As Integer : m_StartCol = 0
Dim Shared m_EndCol As Integer : m_EndCol = 0
' -----------------------------------------------------------------------------
 
'Dim Shared m_iMapMinX As Integer: m_iMapMinX = 0
'Dim Shared m_iMapMaxX As Integer: m_iMapMaxX = 64
'Dim Shared m_iMapMidX As Integer: m_iMapMidX = (m_iMapMaxX - m_iMapMinX) \ 2
'Dim Shared m_iMapMinY As Integer: m_iMapMinY = 0
'Dim Shared m_iMapMaxY As Integer: m_iMapMaxY = 64
'Dim Shared m_iMapMidY As Integer: m_iMapMidY = (m_iMapMaxY - m_iMapMinY) \ 2
'Dim Shared m_iMapMinZ As Integer: m_iMapMinZ = 0
'Dim Shared m_iMapMaxZ As Integer: m_iMapMaxZ = 64
'Dim Shared m_iMapMidZ As Integer: m_iMapMidZ = (m_iMapMaxZ - m_iMapMinZ) \ 2
'
'Dim Shared m_iPlayerMin As Integer: m_iPlayerMin = 1
'Dim Shared m_iPlayerMax As Integer: m_iPlayerMax = 4
'Dim Shared m_iPlayerCount As Integer: m_iPlayerCount = 0
'Dim Shared m_iObjectCount As Integer: m_iObjectCount = 0 ' <- TO BE USED WHEN WE HAVE OBJECTS
'
'Dim Shared m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
'Dim Shared m_arrRender0(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
'Dim Shared m_arrRender1(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
'Dim Shared m_arrRender2(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
'Dim Shared m_arrPlayer(m_iPlayerMin To m_iPlayerMax) As PlayerType
'' For each player, map the 6 directional keys differently for each of the 6 directional orientations!
'Dim Shared m_arrDirKeyMap(m_iPlayerMin To m_iPlayerMax, c_iDir_Min To c_iDir_Max) As DirKeyMapType
 
ReDim Shared m_arrPlayer(1 To 8) As PlayerType ' holds info for each player
ReDim Shared m_arrControlMap(1 To 8, 1 To 8) As ControlInputType ' holds control mapping for each player (player #, direction)
ReDim Shared m_arrController(1 To 8) As ControllerType ' holds info for each game controller
 
ReDim Shared m_arrButtonCode(1 To 99) As Integer ' Long
ReDim Shared m_arrButtonKey(1 To 99) As String
ReDim Shared m_arrButtonKeyDesc(0 To 512) As String
 
' ENABLE / DISABLE DEBUG CONSOLE
Dim Shared m_bTesting As Integer : m_bTesting = TRUE
 
' =============================================================================
' LOCAL VARIABLES
Dim in$
 
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
IF m_bTesting = TRUE THEN
    $Console
    _Delay 4
    _Console On
    _Echo "Started " + m_ProgramName$
    _Echo "Debugging on..."
END IF
' ****************************************************************************************************************************************************************
 
' =============================================================================
' START THE MAIN ROUTINE
main
 
' =============================================================================
' FINISH
SCREEN 0
Print m_ProgramName$ + " finished."
Input "Press <ENTER> to continue", in$
 
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
IF m_bTesting = TRUE THEN
    _Console Off
END IF
' ****************************************************************************************************************************************************************
 
System ' return control to the operating system
End
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub main
    Dim RoutineName As String: RoutineName = "main"
    Dim in$
    Dim result$ : result$ = ""
 
    ' SET UP SCREEN
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
    
    Do
        If Len(result$) = 0 Then
            Cls
        Else
            Print
        End If
        
        Print m_ProgramName$
        Print
        Print "Game Input Mapping Test"
        Print "v0.90, by Softintheheadware (Jan, 2022)"
        Print
        
        Print "1. Basic controller test"
        Print "2. Load controller mapping"
        Print "3. View controller mapping"
        Print "4. Edit  controller mapping for 1 or more players"
        Print "   Note: not tested yet"
        Print "5. Reset controller mapping for 1 or more players"
        Print "6. Map controllers for 1 or more players"
        Print "7. Test controller mappings to move around screen"
        Print "   Issue #1: Keyboard input not working yet"
        Print "   Issue #2: Digital joysticks don't allow continuous movement"
        Print "   Issue #3: Need analog joystick sensitivity adjustment option"
        Print "8. Save controller mappings"
        Print
        Print "What to do? ('q' to exit)"
        
        Input in$: in$ = LCase$(Left$(in$, 1))
        
        If in$ = "1" Then
            result$ = TestJoysticks$
        ElseIf in$ = "2" Then
            result$ = LoadMappings$
            if len(result$)=0 then result$="Loaded mappings."
        ElseIf in$ = "3" Then
            result$ = ViewMappings$
        ElseIf in$ = "4" Then
            result$ = EditMappings$
        ElseIf in$ = "5" Then
            result$ = ResetMapping$
        ElseIf in$ = "6" Then
            result$ = MapInput$
        ElseIf in$ = "7" Then
            result$ = TestMappings$
        ElseIf in$ = "8" Then
            result$ = SaveMappings$
        End If
        
        If Len(result$) > 0 Then
            Print result$
        End If
        
    Loop Until in$ = "q"
    
    ' RETURN TO TEXT SCREEN
    Screen 0
    
End Sub ' main
 
' /////////////////////////////////////////////////////////////////////////////
' TODO: get keyboard input working
' TODO: get continuous movement working for digital joysticks
' TODO: adjust analog joystick sensitivity
 
Function TestMappings$
    DIM iDeviceCount AS INTEGER
    DIM iDevice AS INTEGER
    DIM iNumControllers AS INTEGER
    DIM iController AS INTEGER
    Dim iValue As Integer
    Dim iWhichInput As Integer
    
    DIM arrButton(32, 16) As Integer ' number of buttons on the joystick
    DIM arrButtonNew(32, 16) As Integer ' tracks when to initialize values
    DIM arrAxis(32, 16) As Double ' number of axis on the joystick
    DIM arrAxisNew(32, 16) As Integer ' tracks when to initialize values
    
    Dim iCols As Integer
    Dim iRows As Integer
    
    Dim iPlayer As Integer
    Dim iNextY As Integer
    Dim iNextX As Integer
    Dim iNextC As Integer
    
    Dim iMinX As Integer
    Dim iMaxX As Integer
    Dim iMinY As Integer
    Dim iMaxY As Integer
    
    Dim sError As String : sError = ""
    Dim bHaveInput As Integer
    Dim bFinished As Integer
    Dim bFoundWho As Integer
    
    Dim in$
    
    ' INITIALIZE
    CLS
    iCols = _WIDTH(0) \ _FontWidth
    iRows = _HEIGHT(0) \ _FontHeight
    iMinX = 0 : iMaxX = iCols
    iMinY = 0 : iMaxY = iRows
    
    ' INITIALIZE PLAYER COORDINATES AND SCREEN CHARACTERS
    iNextY = 1
    iNextX = -3
    iNextC = 64
    FOR iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
        iNextX = iNextX + 4
        IF iNextX >= iMaxX THEN
            iNextX = iMinX
            iNextY = iNextY + 4
            if iNextY > iMaxY THEN
                iNextY = iMinY
            end if
        END IF
        iNextC = iNextC + 1
        m_arrPlayer(iPlayer).x = iNextX
        m_arrPlayer(iPlayer).y = iNextY
        m_arrPlayer(iPlayer).c = iNextC
        m_arrPlayer(iPlayer).xOld = iNextX
        m_arrPlayer(iPlayer).yOld = iNextY
        
        m_arrPlayer(iPlayer).moveX = 0
        m_arrPlayer(iPlayer).lastMoveX = 0
        m_arrPlayer(iPlayer).moveY = 0
        m_arrPlayer(iPlayer).lastMoveY = 0
        m_arrPlayer(iPlayer).button1 = 0
        m_arrPlayer(iPlayer).lastButton1 = 0
        m_arrPlayer(iPlayer).button2 = 0
        m_arrPlayer(iPlayer).lastButton2 = 0
        m_arrPlayer(iPlayer).button3 = 0
        m_arrPlayer(iPlayer).lastButton3 = 0
        m_arrPlayer(iPlayer).button4 = 0
        m_arrPlayer(iPlayer).lastButton4 = 0
    NEXT iPlayer
    
    ' COUNT # OF JOYSTICKS
    ' TODO: find out the right way to count joysticks
    if len(sError) = 0 then
        ' D= _DEVICES ' MUST be read in order for other 2 device functions to work!
        iDeviceCount = _DEVICES ' Find the number of devices on someone's system
        
        IF iDeviceCount > 2 THEN
            ' LIMIT # OF DEVICES, IF THERE IS A LIMIT DEFINED
            iNumControllers = iDeviceCount - 2
            IF cMaxControllers > 0 THEN
                IF iNumControllers > cMaxControllers THEN
                    iNumControllers = cMaxControllers
                END IF
            END IF
        ELSE
            ' ONLY 2 FOUND (KEYBOARD, MOUSE)
            'sError = "No game controllers found."
            iNumControllers = 0
        END IF
    end if
    
    ' INITIALIZE CONTROLLER DATA
    if len(sError) = 0 then
        FOR iController = 1 TO iNumControllers
            m_arrController(iController).buttonCount = cMaxButtons
            m_arrController(iController).axisCount = cMaxAxis
            for iLoop = 1 to cMaxButtons
                arrButtonNew(iController, iLoop) = TRUE
            next iloop
            for iLoop = 1 to cMaxAxis
                arrAxisNew(iController, iLoop) = TRUE
            next iLoop
        NEXT iController
    end if
    
    ' INITIALIZE CONTROLLER INPUT
    if len(sError) = 0 then
        _KEYCLEAR: _DELAY 1
        FOR iController = 1 TO iNumControllers
            iDevice = iController + 2
            WHILE _DEVICEINPUT(iDevice) ' clear and update the device buffer
                FOR iLoop = 1 TO _LASTBUTTON(iDevice)
                    IF (iLoop > cMaxButtons) THEN EXIT FOR
                    m_arrController(iController).buttonCount = iLoop
                    arrButton(iController, iLoop) = FALSE
                NEXT iLoop
                FOR iLoop = 1 TO _LASTAXIS(iDevice) ' this loop checks all my axis
                    IF (iLoop > cMaxAxis) THEN EXIT FOR
                    m_arrController(iController).axisCount = iLoop
                    arrAxis(iController, iLoop) = 0
                NEXT iLoop
            WEND ' clear and update the device buffer
        NEXT iController
    end if
    
    ' GET INPUT AND MOVE PLAYERS AROUND ON SCREEN
    _KEYCLEAR: _DELAY 1
    bFinished = FALSE
    Do
        ' Clear control buffer for players
        FOR iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
            m_arrPlayer(iPlayer).lastMoveX = m_arrPlayer(iPlayer).moveX
            m_arrPlayer(iPlayer).moveX = 0
            m_arrPlayer(iPlayer).lastMoveY = m_arrPlayer(iPlayer).moveY
            m_arrPlayer(iPlayer).moveY = 0
            m_arrPlayer(iPlayer).lastButton1 = m_arrPlayer(iPlayer).button1
            m_arrPlayer(iPlayer).button1 = 0
            m_arrPlayer(iPlayer).lastButton2 = m_arrPlayer(iPlayer).button2
            m_arrPlayer(iPlayer).button2 = 0
            m_arrPlayer(iPlayer).lastButton3 = m_arrPlayer(iPlayer).button3
            m_arrPlayer(iPlayer).button3 = 0
            m_arrPlayer(iPlayer).lastButton4 = m_arrPlayer(iPlayer).button4
            m_arrPlayer(iPlayer).button4 = 0
        NEXT iPlayer
        
        ' -----------------------------------------------------------------------------
        ' BEGIN CHECK FOR CONTROLLER INPUT
        if iNumControllers > 0 then
            FOR iController = 1 TO iNumControllers
                iDevice = iController + 2
                
                ' Check all devices
                WHILE _DEVICEINPUT(iDevice)
                    
                    ' Check each button
                    FOR iLoop = 1 TO _LASTBUTTON(iDevice)
                        IF (iLoop > cMaxButtons) THEN EXIT FOR
                        
                        ' update button array to indicate if a button is up or down currently.
                        if TRUE=TRUE then
                        'IF _BUTTONCHANGE(iLoop) THEN
                            iValue = _BUTTON(iLoop)
                            if iValue <> arrButton(iController, iLoop) then
                                ' *****************************************************************************
                                ' PRESSED BUTTON
                                
                                ' BEGIN find who this is mapped for
                                bFoundWho = FALSE
                                For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
                                    For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                                        if m_arrControlMap(iPlayer, iWhichInput).device = iDevice then
                                            if m_arrControlMap(iPlayer, iWhichInput).typ = cInputButton then
                                                if m_arrControlMap(iPlayer, iWhichInput).code = iLoop then
                                                    'if m_arrControlMap(iPlayer, iWhichInput).value = iValue then
                                                        bFoundWho = TRUE
                                                        Select Case iWhichInput
                                                            Case cInputUp:
                                                                m_arrPlayer(iPlayer).moveY = -1
                                                            Case cInputDown:
                                                                m_arrPlayer(iPlayer).moveY = 1
                                                            Case cInputLeft:
                                                                m_arrPlayer(iPlayer).moveX = -1
                                                            Case cInputRight:
                                                                m_arrPlayer(iPlayer).moveX = 1
                                                            Case cInputButton1:
                                                                m_arrPlayer(iPlayer).button1 = TRUE
                                                            Case cInputButton2:
                                                                m_arrPlayer(iPlayer).button2 = TRUE
                                                            Case cInputButton3:
                                                                m_arrPlayer(iPlayer).button3 = TRUE
                                                            Case cInputButton4:
                                                                m_arrPlayer(iPlayer).button4 = TRUE
                                                            Case Else:
                                                                '(IGNORE)
                                                        End Select
                                                        Exit For
                                                    'end if
                                                end if
                                            end if
                                        end if
                                    Next iWhichInput
                                    If bFoundWho=TRUE Then Exit For
                                Next iPlayer
                                ' END find who this is mapped for
                                
                            end if
                        END IF
                    NEXT iLoop
                    
                    ' Check each axis
                    FOR iLoop = 1 TO _LASTAXIS(iDevice)
                        IF (iLoop > cMaxAxis) THEN EXIT FOR
                        dblNextAxis = _AXIS(iLoop)
                        dblNextAxis = RoundUpDouble# (dblNextAxis, 3)
                        
                        ' I like to give a little "jiggle" resistance to my controls, as I have an old joystick
                        ' which is prone to always give minute values and never really center on true 0.
                        ' A value of 1 means my axis is pushed fully in one direction.
                        ' A value greater than 0.1 means it's been partially pushed in a direction (such as at a 45 degree diagional angle).
                        ' A value of less than 0.1 means we count it as being centered. (As if it was 0.)
                        
                        ' Set sensitivity:
                        'These are way too sensitive for analog:
                        'IF ABS(_AXIS(iLoop)) <= 1 AND ABS(_AXIS(iLoop)) >= .1 THEN
                        'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .01 THEN
                        'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .001 THEN
                        ''For digital input, we'll use a big picture:
                        'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= 0.75 THEN
                        IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= 0.5 THEN
                        
                            ' WE WANT CONTINUOUS MOVEMENT (DISABLE FOR NOT)
                            if TRUE=TRUE then
                            'if dblNextAxis <> arrAxis(iController, iLoop) then
                                ' *****************************************************************************
                                ' MOVED STICK
                                
                                ' convert to a digital value
                                if dblNextAxis < 0 then
                                    iValue = -1
                                else
                                    iValue = 1
                                end if
                                
                                ' BEGIN find who this is mapped for
                                bFoundWho = FALSE
                                For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
                                    For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                                        if m_arrControlMap(iPlayer, iWhichInput).device = iDevice then
                                            if m_arrControlMap(iPlayer, iWhichInput).typ = cInputAxis then
                                                if m_arrControlMap(iPlayer, iWhichInput).code = iLoop then
                                                    if m_arrControlMap(iPlayer, iWhichInput).value = iValue then
                                                        bFoundWho = TRUE
                                                        Select Case iWhichInput
                                                            Case cInputUp:
                                                                m_arrPlayer(iPlayer).moveY = -1
                                                            Case cInputDown:
                                                                m_arrPlayer(iPlayer).moveY = 1
                                                            Case cInputLeft:
                                                                m_arrPlayer(iPlayer).moveX = -1
                                                            Case cInputRight:
                                                                m_arrPlayer(iPlayer).moveX = 1
                                                            Case cInputButton1:
                                                                m_arrPlayer(iPlayer).button1 = TRUE
                                                            Case cInputButton2:
                                                                m_arrPlayer(iPlayer).button2 = TRUE
                                                            Case cInputButton3:
                                                                m_arrPlayer(iPlayer).button3 = TRUE
                                                            Case cInputButton4:
                                                                m_arrPlayer(iPlayer).button4 = TRUE
                                                            Case Else:
                                                                '(IGNORE)
                                                        End Select
                                                        Exit For
                                                    end if
                                                end if
                                            end if
                                        end if
                                    Next iWhichInput
                                    If bFoundWho=TRUE Then Exit For
                                Next iPlayer
                                ' END find who this is mapped for
                                
                            end if
                        END IF
                    NEXT iLoop
                    
                WEND ' clear and update the device buffer
                
            NEXT iController
        End If
        ' END CHECK FOR CONTROLLER INPUT
        ' -----------------------------------------------------------------------------
        
        ' -----------------------------------------------------------------------------
        ' BEGIN CHECK FOR KEYBOARD INPUT #1
        '_KEYCLEAR: _DELAY 1
        WHILE _DEVICEINPUT(1): WEND ' clear and update the keyboard buffer
        
        ' Detect changed key state
        For iLoop = lbound(m_arrButtonCode) to ubound(m_arrButtonCode)
            iCode = m_arrButtonCode(iLoop)
            If _BUTTON(iCode) <> FALSE Then
                ' *****************************************************************************
                ' PRESSED KEYBOARD
                'PRINT "PRESSED " + m_arrButtonKey(iLoop)
                
                ' BEGIN find who this is mapped for
                bFoundWho = FALSE
                For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
                    For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                        if m_arrControlMap(iPlayer, iWhichInput).device = iDevice then
                            if m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey then
                                
                                'if m_arrControlMap(iPlayer, iWhichInput).code = iLoop then
                                if m_arrControlMap(iPlayer, iWhichInput).code = iCode then
                                    'if m_arrControlMap(iPlayer, iWhichInput).value = iValue then
                                        bFoundWho = TRUE
                                        Select Case iWhichInput
                                            Case cInputUp:
                                                m_arrPlayer(iPlayer).moveY = -1
                                            Case cInputDown:
                                                m_arrPlayer(iPlayer).moveY = 1
                                            Case cInputLeft:
                                                m_arrPlayer(iPlayer).moveX = -1
                                            Case cInputRight:
                                                m_arrPlayer(iPlayer).moveX = 1
                                            Case cInputButton1:
                                                m_arrPlayer(iPlayer).button1 = TRUE
                                            Case cInputButton2:
                                                m_arrPlayer(iPlayer).button2 = TRUE
                                            Case cInputButton3:
                                                m_arrPlayer(iPlayer).button3 = TRUE
                                            Case cInputButton4:
                                                m_arrPlayer(iPlayer).button4 = TRUE
                                            Case Else:
                                                '(IGNORE)
                                        End Select
                                        Exit For
                                    'end if
                                end if
                            end if
                        end if
                    Next iWhichInput
                    If bFoundWho=TRUE Then Exit For
                Next iPlayer
                ' END find who this is mapped for
                
            End If
        Next iLoop
        ' END CHECK FOR KEYBOARD INPUT #1
        ' -----------------------------------------------------------------------------
        
        
        
        ' NOW DRAW PLAYERS ON SCREEN
        FOR iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
            
            ' MOVE RIGHT/LEFT
            m_arrPlayer(iPlayer).x = m_arrPlayer(iPlayer).x + m_arrPlayer(iPlayer).moveX
            if m_arrPlayer(iPlayer).x < iMinX then
                m_arrPlayer(iPlayer).x = m_arrPlayer(iPlayer).xOld ' iMinX
            elseif m_arrPlayer(iPlayer).x > iMaxX then
                m_arrPlayer(iPlayer).x = m_arrPlayer(iPlayer).xOld ' iMaxX
            end if
            
            ' MOVE UP/DOWN
            m_arrPlayer(iPlayer).y = m_arrPlayer(iPlayer).y + m_arrPlayer(iPlayer).moveY
            if m_arrPlayer(iPlayer).y < iMinY then
                m_arrPlayer(iPlayer).y = m_arrPlayer(iPlayer).yOld ' iMinY
            elseif m_arrPlayer(iPlayer).y > iMaxY then
                m_arrPlayer(iPlayer).y = m_arrPlayer(iPlayer).yOld ' iMaxY
            end if
            
            ' UPDATE SCREEN
            '_PRINTSTRING (m_arrPlayer(iPlayer).xOld, m_arrPlayer(iPlayer).yOld), " "
            '_PRINTSTRING (m_arrPlayer(iPlayer).x, m_arrPlayer(iPlayer).y), CHR$(m_arrPlayer(iPlayer).c)
            PrintString m_arrPlayer(iPlayer).xOld, m_arrPlayer(iPlayer).yOld, " "
            PrintString m_arrPlayer(iPlayer).x, m_arrPlayer(iPlayer).y, CHR$(m_arrPlayer(iPlayer).c)
            m_arrPlayer(iPlayer).xOld = m_arrPlayer(iPlayer).x
            m_arrPlayer(iPlayer).yOld = m_arrPlayer(iPlayer).y
            
            ' BUTTON ACTIONS
            if m_arrPlayer(iPlayer).button1 = TRUE then
                MakeSound iPlayer, 1
            end if
            
            if m_arrPlayer(iPlayer).button2 = TRUE then
                MakeSound iPlayer, 2
            end if
            
            if m_arrPlayer(iPlayer).button3 = TRUE then
                MakeSound iPlayer, 3
            end if
            
            if m_arrPlayer(iPlayer).button4 = TRUE then
                MakeSound iPlayer, 4
            end if
        NEXT iPlayer
        
        _LIMIT 30
    LOOP UNTIL _KEYHIT = 27 ' ESCAPE to quit
    
    _KEYCLEAR: _DELAY 1
    
End Function ' TestMappings$
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub MakeSound(iPlayer As Integer, iButton As Integer)
    Dim note%
    If iPlayer < 1 Then 
        iPlayer = 1 
    ElseIf iPlayer > 8 Then 
        iPlayer = 8
    End If
    If iButton < 1 Then 
        iButton = 1
    ElseIf iButton > 4 Then 
        iButton = 4
    End If
    
    note% = iPlayer * 100 + (iButton * 25)
    IF note% > 4186 THEN 
        note% = 4186
    END IF
    SOUND note%, .75
End Sub ' MakeSound
 
' /////////////////////////////////////////////////////////////////////////////
' V2 prints in 2 columns.
 
Sub PrintControllerMap2
    Dim RoutineName As String:: RoutineName = "PrintControllerMap2"
    Dim iPlayer As Integer
    Dim iWhichInput As Integer
    Dim iCount As Integer
    Dim sLine As String
    Dim iHalf As Integer
    Dim sColumn1 As String : sColumn1 = ""
    Dim sColumn2 As String : sColumn2 = ""
    ReDim arrColumn1(-1) As String
    ReDim arrColumn2(-1) As String
    Dim iLoop As Integer
    Dim iColWidth As Integer : iColWidth = 65
    Dim sValue As String
    Dim in$
    
    ' INITIALIZE
    InitKeyboardButtonCodes
    
    ' START OUTPUT
    Print "Controller mapping:"
    'Print "Player#  Input      Device#  Type     Code              Value"
    '       1        button #2  x        unknown  x                 x
    '       9        11         9        9        18                9
    '       12345678912345678901123456789123456789123456789012345678123456789
    '       12345678901234567890123456789012345678901234567890123456789012345678901234567890
    '       00000000011111111112222222222333333333344444444445555555555666666666677777777778
    
    ' THIS IS A LAZY WAY TO GET 2 COLUMNS!
    iHalf = UBound(m_arrControlMap, 1) / 2
    
    sLine = "Player#  Input      Device#  Type     Code              Value"
    sColumn1 = sColumn1 + StrPadRight$(sLine, iColWidth) + chr$(13)
    sLine = "-------------------------------------------------------------"
    sColumn1 = sColumn1 + StrPadRight$(sLine, iColWidth) + chr$(13)
    For iPlayer = LBound(m_arrControlMap, 1) To iHalf
        iCount = 0
        For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
            if InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" then
                iCount = iCount + 1
            end if
        Next iWhichInput
        if iCount > 0 then
            For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                if InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" then
                    sLine = IntPadRight$(iPlayer, 9)
                    sLine = sLine + StrPadRight$(InputToString$(iWhichInput), 11)
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).device, 9)
                    sLine = sLine + StrPadRight$(InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ), 9)
                    
                    'sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 9)
                    if m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey then
                        sValue = GetKeyboardButtonCodeText$( m_arrControlMap(iPlayer, iWhichInput).code )
                        sValue = StrPadRight$(sValue, 18)
                    else
                        sValue = IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 18)
                    end if
                    sLine = sLine + sValue
                    
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).value, 9)
                    'Print sLine
                    sLine = StrPadRight$(sLine, iColWidth)
                    sColumn1 = sColumn1 + sLine + chr$(13)
                end if
            Next iWhichInput
        else
            sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
            'Print sLine
            sLine = StrPadRight$(sLine, iColWidth)
            sColumn1 = sColumn1 + sLine + chr$(13)
        end if
    Next iPlayer
    
    sLine = "Player#  Input      Device#  Type     Code              Value"
    sColumn2 = sColumn2 + StrPadRight$(sLine, iColWidth) + chr$(13)
    sLine = "-------------------------------------------------------------"
    sColumn2 = sColumn2 + StrPadRight$(sLine, iColWidth) + chr$(13)
    For iPlayer = iHalf + 1 To UBound(m_arrControlMap, 1)
        iCount = 0
        For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
            if InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" then
                iCount = iCount + 1
            end if
        Next iWhichInput
        if iCount > 0 then
            For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                if InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" then
                    sLine = IntPadRight$(iPlayer, 9)
                    sLine = sLine + StrPadRight$(InputToString$(iWhichInput), 11)
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).device, 9)
                    sLine = sLine + StrPadRight$(InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ), 9)
                    
                    'sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 9)
                    if m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey then
                        sValue = GetKeyboardButtonCodeText$( m_arrControlMap(iPlayer, iWhichInput).code )
                        sValue = StrPadRight$(sValue, 18)
                    else
                        sValue = IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 18)
                    end if
                    sLine = sLine + sValue
                    
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).value, 9)
                    'Print sLine
                    sLine = StrPadRight$(sLine, iColWidth)
                    sColumn2 = sColumn2 + sLine + chr$(13)
                end if
            Next iWhichInput
        else
            sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
            'Print sLine
            sLine = StrPadRight$(sLine, iColWidth)
            sColumn2 = sColumn2 + sLine + chr$(13)
        end if
    Next iPlayer
    
    split sColumn1, chr$(13), arrColumn1()    
    split sColumn2, chr$(13), arrColumn2()    
    if ubound(arrColumn1) > ubound(arrColumn2) then
        iCount = ubound(arrColumn1)
    else
        iCount = ubound(arrColumn2)
    end if
    for iLoop = 0 to iCount
        sLine = ""
        if ubound(arrColumn1) >= iLoop then
            sLine = sLine + arrColumn1(iLoop)
        else
            sLine = sLine + STRING$(iColWidth, " ")
        end if
        sLine = sLine + "     "
        if ubound(arrColumn2) >= iLoop then
            sLine = sLine + arrColumn2(iLoop)
        else
            sLine = sLine + STRING$(iColWidth, " ")
        end if
        print sLine
    next iLoop
End Sub ' PrintControllerMap2
 
' /////////////////////////////////////////////////////////////////////////////
' Original (simple) routine
 
Sub PrintControllerMap1
    Dim RoutineName As String:: RoutineName = "PrintControllerMap1"
    Dim iPlayer As Integer
    Dim iWhichInput As Integer
    Dim sLine As String
    Dim iCount As Integer
    Dim in$
    
    ' INITIALIZE
    InitKeyboardButtonCodes
    
    ' OUTPUT MAPPING
    Print "Controller mapping:"
    Print "Player#  Input      Device#  Type     Code     Value"
    '      1        button #2  x        unknown  x        x
    '      9        11         9        9        9        9
    '      12345678912345678901123456789123456789123456789123456789
    '      12345678901234567890123456789012345678901234567890123456789012345678901234567890
    For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
        iCount = 0
        For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
            if InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" then
                iCount = iCount + 1
            end if
        Next iWhichInput
        if iCount > 0 then
            For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                if InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" then
                    sLine = IntPadRight$(iPlayer, 9)
                    sLine = sLine + StrPadRight$(InputToString$(iWhichInput), 11)
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).device, 9)
                    sLine = sLine + StrPadRight$(InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ), 9)
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 9)
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).value, 9)
                    Print sLine
                end if
            Next iWhichInput
        else
            sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
            Print sLine
        end if
    Next iPlayer
End Sub ' PrintControllerMap1
 
' /////////////////////////////////////////////////////////////////////////////
 
Function LoadMappings$
    Dim sResult As String : sResult = ""
    
    ' INITIALIZE
    InitKeyboardButtonCodes
    
    ' Try loading map
    sResult = LoadControllerMap$
    
    LoadMappings$ = sResult
End Function ' LoadMappings$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function SaveMappings$
    Dim sResult As String : sResult = ""
    Dim sError As String : sError = ""
    
    ' INITIALIZE
    InitKeyboardButtonCodes
    
    ' Try saving map
    sResult = SaveControllerMap$
    
    SaveMappings$ = sResult
End Function ' SaveMappings$
 
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ViewMappings$
    ' INITIALIZE
    InitKeyboardButtonCodes
    
    PrintControllerMap2
    Print
    Input "PRESS <ENTER> TO CONTINUE", in$
    Print
    ViewMappings$ = ""
End Function ' ViewMappings$
 
' /////////////////////////////////////////////////////////////////////////////
' TODO: test this
 
Function EditMappings$
    Dim RoutineName As String: RoutineName = "EditMappings$"
    Dim in$
    Dim iPlayer As Integer
    Dim iWhichInput As Integer
    Dim iDevice As Integer
    Dim iType As Integer
    Dim iWhich As Integer
    Dim iValue As Integer
    Dim iItem As Integer
    Dim sResult As String : sResult = ""
    Dim bContinue1 As Integer : bContinue1 = TRUE
    Dim bContinue2 As Integer : bContinue2 = TRUE
    Dim bContinue3 As Integer : bContinue3 = TRUE
    Dim bContinue4 As Integer : bContinue4 = TRUE
    
    ' INITIALIZE
    InitKeyboardButtonCodes
    
    ' EDIT
    Do
        PrintControllerMap2
        Print "To edit a mapping, enter a player number: " _ 
            "1-" + cstr$(cMaxPlayers) + ", " + _ 
            cstr$(cMaxPlayers+1) + ") or 0 to exit."
        Input "Edit mapping for player? ";iPlayer
        if iPlayer > 0 and iPlayer <= cMaxPlayers then
            bContinue2 = TRUE
            Do
                Print "Editing mappings for player " + cstr$(iPlayer) + "."
                For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                    Print right$("  " + cstr$(iWhichInput), 2) + ". " + InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ)
                Next iWhichInput
                Input "Type # of control to edit or q to quit editing player.";in$
                if IsNum%(in$) then
                    iWhichInput = VAL(in$)
                    if iWhichInput >= lbound(m_arrControlMap, 2) and m_arrControlMap <= ubound(m_arrControlMap, 2) then
                        bContinue3 = TRUE
                        Do
                            Print "Settings for " + chr$(34) + InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) + chr$(34) + ":"
                            Print "1. Device #   : " + cstr$(m_arrControlMap(iPlayer, iWhichInput).device)
                            Print "2. Device type: " + InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ)
                            Print "3. Input code : " + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).code))
                            Print "4. Input value: " + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).value))
                            INPUT "Change item? (1-4 or q to quit editing control)";in$
                            if IsNum%(in$) then
                                iItem = VAL(in$)
                                Select Case iItem
                                    Case 1:
                                        Print "Change the device number."
                                        Input "Type a new device #, 0 for none, or blank to leave it unchanged";in$
                                        if IsNum%(in$) then
                                            iDevice = VAL(in$)
                                            m_arrControlMap(iPlayer, iWhichInput).device = iDevice
                                            Print "Updated device number. Remember to save mappings when done."
                                        else
                                            Print "(No change.)"
                                        end if
                                    Case 2:
                                        bContinue4 = TRUE
                                        Do
                                            Print "Change the device type."
                                            Print cstr$(cInputKey) + "=keyboard"
                                            Print cstr$(cInputButton) + "=game controller button"
                                            Print cstr$(cInputAxis) + "=game controller joystick/axis"
                                            Print cstr$(cInputNone) + "=none"
                                            Input "Device type or blank to leave it unchanged";in$
                                            if IsNum%(in$) then
                                                iType = VAL(in$)
                                                if iType=cInputKey or iType=cInputButton or _
                                                    iType=cInputAxis or iType=cInputNone then
                                                    
                                                    m_arrControlMap(iPlayer, iWhichInput).typ = iType
                                                    Print "Updated device type. Remember to save mappings when done."
                                                    bContinue4 = FALSE : Exit Do
                                                else
                                                    Print "Please choose one of the listed values."
                                                end if
                                            else
                                                Print "(No change.)"
                                                bContinue4 = FALSE : Exit Do
                                            end if
                                        Loop Until bContinue4 = FALSE
                                    Case 3:
                                        Print "Change the input code."
                                        Input "Type a new input code, or blank to leave it unchanged";in$
                                        if IsNum%(in$) then
                                            iWhich = VAL(in$)
                                            m_arrControlMap(iPlayer, iWhichInput).code = iWhich
                                            Print "Updated input code. Remember to save mappings when done."
                                        else
                                            Print "(No change.)"
                                        end if
                                    Case 4:
                                        Print "Change the input value."
                                        Input "Type a new input value, or blank to leave it unchanged";in$
                                        if IsNum%(in$) then
                                            iValue = VAL(in$)
                                            m_arrControlMap(iPlayer, iWhichInput).value = value
                                            Print "Updated input value. Remember to save mappings when done."
                                        else
                                            Print "(No change.)"
                                        end if
                                    Case Else:
                                        Print "Please choose a number between 1 and 4."
                                End Select
                            else
                                bContinue3 = FALSE : Exit Do
                            end if
                        Loop Until bContinue3 = FALSE
                    else
                        Print "Please choose a number between " + cstr$(lbound(m_arrControlMap, 2)) + " and " + cstr$(ubound(m_arrControlMap, 2)) + "."
                    end if
                else
                    bContinue2 = FALSE : Exit Do
                end if
            Loop Until bContinue2 = FALSE
            if bContinue1 = FALSE then exit do
        else
            if len(sResult) = 0 then sResult = "(Cancelled.)"
            bContinue1 = FALSE : Exit Do
        end if
    Loop Until bContinue1 = FALSE
    
    _KEYCLEAR: _DELAY 1
    
    EditMappings$ = sResult
END Function ' EditMappings$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ResetMapping$
    Dim RoutineName As String: RoutineName = "ResetMapping$"
    Dim in$
    Dim iPlayer As Integer
    Dim sResult As String : sResult = ""
    
    ' INITIALIZE
    InitKeyboardButtonCodes
    
    ' RESET
    Do
        PrintControllerMap2
        
        Print "To delete mapping, enter a player number: " _ 
            "1-" + cstr$(cMaxPlayers) + ", " + _ 
            cstr$(cMaxPlayers+1) + " for all, or 0 to exit."
        Input "Delete mapping for player? ";iPlayer
        
        if iPlayer > 0 and iPlayer <= cMaxPlayers then
            Print "Delete mappings for player " + cstr$(iPlayer) + "."
            Input "Delete (y/n)";in$ : in$ = lcase$(_Trim$(in$))
            if in$ = "y" then
                For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                    if InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" then
                        m_arrControlMap(iPlayer, iWhichInput).device = 0
                        m_arrControlMap(iPlayer, iWhichInput).typ = 0
                        m_arrControlMap(iPlayer, iWhichInput).code = 0
                        m_arrControlMap(iPlayer, iWhichInput).value = 0
                    end if
                Next iWhichInput
                sResult = "Mappings deleted for player " + cstr$(iPlayer) + "."
                print sResult
            end if
        elseif iPlayer = (cMaxPlayers+1) then
            Input "Delete all mappings (y/n)";in$ : in$ = lcase$(_Trim$(in$))
            if in$ = "y" then
                For iPlayer = 1 to cMaxPlayers
                    For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                        if InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" then
                            m_arrControlMap(iPlayer, iWhichInput).device = 0
                            m_arrControlMap(iPlayer, iWhichInput).typ = 0
                            m_arrControlMap(iPlayer, iWhichInput).code = 0
                            m_arrControlMap(iPlayer, iWhichInput).value = 0
                        end if
                    Next iWhichInput
                Next iPlayer
                sResult = "All mappings deleted."
                print sResult
            end if
        else
            if len(sResult) = 0 then sResult = "(Cancelled.)"
            exit do
        end if
    Loop
    ResetMapping$ = sResult
END Function ' ResetMapping$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function MapInput$
    Dim RoutineName As String: RoutineName = "MapInput$"
    Dim in$
    DIM iDeviceCount As Integer
    Dim iPlayer As Integer
    Dim sResult As String
    Dim sError As String
    
    ' INITIALIZE
    InitKeyboardButtonCodes
    
    ' SET UP SCREEN
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
    
    ' MAKE SURE WE HAVE DEVICES
    ' 1 is the keyboard
    ' 2 is the mouse
    ' 3 is the joystick
    ' unless someone has a strange setup with multiple mice/keyboards/ect...
    ' In that case, you can use _DEVICE$(i) to look for "KEYBOARD", "MOUSE", "JOYSTICK", if necessary.
    ' I've never actually found it necessary, but I figure it's worth mentioning, just in case...
    iDeviceCount = _DEVICES ' Find the number of devices on someone's system
    IF iDeviceCount > 2 THEN
        '' Try loading map
        'sError = LoadControllerMap$
        'if len(sError) = 0 then
        '    print "Previous controller mapping loaded."
        'else
        '    print "*******************************************************************************"
        '    print "There were errors loading the controller mapping file:"
        '    print sError
        '    print
        '    print "Try remapping - a new file will be created."
        '    print "*******************************************************************************"
        'end if
        Do
            PrintControllerMap2
            Print "To edit mapping, enter a player number (1-" + cstr$(cMaxPlayers) + ") or 0 to exit."
            Input "Get input for player? ";iPlayer
            if iPlayer > 0 and iPlayer <= cMaxPlayers then
                sResult = MapInput1$(iPlayer)
                if len(sResult) = 0 then
                    Print "Remember to save mappings when done."
                else
                    Print sResult
                end if
            else
                sResult = "(Cancelled.)"
                exit do
            end if
        Loop
    ELSE
        sResult = "No controller devices found."
        INPUT "PRESS <ENTER> TO CONTINUE", in$
    END IF
    MapInput$ = sResult
    
END Function ' MapInput$
 
' /////////////////////////////////////////////////////////////////////////////
' Detect controls
' THIS VERSION SUPPORTS UPTO 8 JOYSTICKS, WITH UPTO 2 BUTTONS AND 2 AXES EACH
' (THIS IS FOR ATARI 2600 JOYSTICKS)
 
' The following shared arrays must be declared:
'     ReDim Shared m_arrButtonCode(1 To 99) As Long
'     ReDim Shared m_arrButtonKey(1 To 99) As String
 
Function MapInput1$ (iPlayer As Integer)
    DIM RoutineName AS STRING:: RoutineName = "MapInput1$"
    Dim sResult As String : sResult = ""
    Dim sError As String : sError = ""
    
    DIM in$
    
    DIM iDeviceCount AS INTEGER
    DIM iDevice AS INTEGER
    DIM iNumControllers AS INTEGER
    DIM iController AS INTEGER
    
    DIM iLoop AS INTEGER
    DIM strValue AS STRING
    Dim strAxis AS STRING
    DIM dblNextAxis
    Dim iCount As Long
    Dim iValue As Integer
    Dim iCode As Integer
    
    DIM arrButton(32, 16) As Integer ' number of buttons on the joystick
    DIM arrButtonNew(32, 16) As Integer ' tracks when to initialize values
    DIM arrAxis(32, 16) As Double ' number of axis on the joystick
    DIM arrAxisNew(32, 16) As Integer ' tracks when to initialize values
    
    'Dim arrInput(1 To 8) As ControlInputType
    Dim iWhichInput As Integer
    Dim bFinished As Integer
    Dim bHaveInput As Integer
    Dim bMoveNext As Integer
    Dim bCancel As Integer
    Dim iNextInput As Integer
    
    ' FOR PRINTING OUTPUT
    DIM iDigits AS INTEGER ' # digits to display (values are truncated to this length)
    Dim iColCount As Integer
    Dim iGroupCount As Integer
    Dim sLine As String
    Dim iCols As Integer
    Dim iRows As Integer
    Dim iMaxCols As Integer
    
    ' INITIALIZE
    if len(sError) = 0 then
        iDigits = 4 ' 11
        iColCount = 3
        iGroupCount = 0 ' re-initialized at the top of every loop
        iCols = _WIDTH(0) \ _FontWidth
        iRows = _HEIGHT(0) \ _FontHeight
    end if
    
    ' COUNT # OF JOYSTICKS
    ' TODO: find out the right way to count joysticks
    if len(sError) = 0 then
        ' D= _DEVICES ' MUST be read in order for other 2 device functions to work!
        iDeviceCount = _DEVICES ' Find the number of devices on someone's system
        
        IF iDeviceCount > 2 THEN
            ' LIMIT # OF DEVICES, IF THERE IS A LIMIT DEFINED
            iNumControllers = iDeviceCount - 2
            IF cMaxControllers > 0 THEN
                IF iNumControllers > cMaxControllers THEN
                    iNumControllers = cMaxControllers
                END IF
            END IF
        ELSE
            ' ONLY 2 FOUND (KEYBOARD, MOUSE)
            sError = "No game controllers found."
        END IF
    end if
    
    ' INITIALIZE CONTROLLER DATA
    if len(sError) = 0 then
        FOR iController = 1 TO iNumControllers
            m_arrController(iController).buttonCount = cMaxButtons
            m_arrController(iController).axisCount = cMaxAxis
            for iLoop = 1 to cMaxButtons
                arrButtonNew(iController, iLoop) = TRUE
            next iloop
            for iLoop = 1 to cMaxAxis
                arrAxisNew(iController, iLoop) = TRUE
            next iLoop
        NEXT iController
    end if
    
    ' INITIALIZE CONTROLLER INPUT
    if len(sError) = 0 then
        CLS
        Print "We will now detect controllers."
        Print "Do not touch any keys or game controllers during detection."
        Input "Press <ENTER> to begin";in$
        _KeyClear : Print 
        sLine = "Initializing controllers" : Print sLine;
        iMaxCols = (iCols - len(sLine)) - 1
        iCount = 0
        DO
            iCount = iCount + 1
            if iCount < iMaxCols then
                Print ".";
            else 
                Print "." : Print sLine : iCount = 0
            end if
            FOR iController = 1 TO iNumControllers
                iDevice = iController + 2
                WHILE _DEVICEINPUT(iDevice) ' clear and update the device buffer
                    FOR iLoop = 1 TO _LASTBUTTON(iDevice)
                        IF (iLoop > cMaxButtons) THEN EXIT FOR
                        m_arrController(iController).buttonCount = iLoop
                        'IF _BUTTONCHANGE(iLoop) THEN
                        '    arrButton(iController, iLoop) = _BUTTON(iLoop)
                        'END IF
                        arrButton(iController, iLoop) = FALSE
                    NEXT iLoop
                    FOR iLoop = 1 TO _LASTAXIS(iDevice) ' this loop checks all my axis
                        IF (iLoop > cMaxAxis) THEN EXIT FOR
                        m_arrController(iController).axisCount = iLoop
                        arrAxis(iController, iLoop) = 0
                    NEXT iLoop
                WEND ' clear and update the device buffer
            NEXT iController
            _LIMIT 30
        LOOP UNTIL iCount > 60 ' quit after 2 seconds
        Print : Print
    end if
    
    ' WAIT FOR INPUT
    if len(sError) = 0 then
        CLS
        Print "Press <ESCAPE> to cancel at any time."
        Print 
        
        _KEYCLEAR: _DELAY 1
        bCancel = FALSE
        bFinished = FALSE
        iLastPressed = 0
        For iWhichInput = lbound(m_arrControlMap, 2) to ubound(m_arrControlMap, 2)
            'print "iWhichInput=" + cstr$(iWhichInput)
            Print "Player #" + cstr$(iPlayer) + " press control for " + InputToString$(iWhichInput) + " or ESC to skip: ";
            
            ' =============================================================================
            ' BEGIN LOOK FOR NEXT INPUT
            bMoveNext = FALSE
            DO
                ' -----------------------------------------------------------------------------
                ' BEGIN CHECK FOR CONTROLLER INPUT
                FOR iController = 1 TO iNumControllers
                    iDevice = iController + 2
                    
                    ' Check all devices
                    WHILE _DEVICEINPUT(iDevice)
                        
                        ' Check each button
                        If bMoveNext = FALSE Then
                            FOR iLoop = 1 TO _LASTBUTTON(iDevice)
                                IF (iLoop > cMaxButtons) THEN EXIT FOR
                                'm_arrController(iController).buttonCount = iLoop
                                
                                ' update button array to indicate if a button is up or down currently.
                                IF _BUTTONCHANGE(iLoop) THEN
                                    iValue = _BUTTON(iLoop)
                                    if iValue <> arrButton(iController, iLoop) then
                                        ' *****************************************************************************
                                        ' PRESSED BUTTON
                                        
                                        ' make sure this isn't already mapped
                                        bHaveInput = TRUE
                                        if iWhichInput > lbound(m_arrControlMap, 2) then
                                            ' is input unique?
                                            For iNextInput = lbound(m_arrControlMap, 2) to iWhichInput-1
                                                if m_arrControlMap(iPlayer, iNextInput).device = iDevice then
                                                    if m_arrControlMap(iPlayer, iNextInput).typ = cInputButton then
                                                        if m_arrControlMap(iPlayer, iNextInput).code = iLoop then
                                                            if m_arrControlMap(iPlayer, iNextInput).value = iValue then
                                                                bHaveInput = FALSE
                                                            end if
                                                        end if
                                                    end if
                                                end if
                                            Next iNextInput
                                        end if
                                        
                                        if bHaveInput then
                                            m_arrControlMap(iPlayer, iWhichInput).device = iDevice
                                            m_arrControlMap(iPlayer, iWhichInput).typ = cInputButton
                                            m_arrControlMap(iPlayer, iWhichInput).code = iLoop
                                            m_arrControlMap(iPlayer, iWhichInput).value = iValue
                                            bMoveNext = TRUE
                                        end if
                                        
                                    end if
                                END IF
                            NEXT iLoop
                        End If
                        
                        ' Check each axis
                        If bMoveNext = FALSE Then
                            FOR iLoop = 1 TO _LASTAXIS(iDevice)
                                IF (iLoop > cMaxAxis) THEN EXIT FOR
                                'm_arrController(iController).axisCount = iLoop
                                
                                dblNextAxis = _AXIS(iLoop)
                                dblNextAxis = RoundUpDouble# (dblNextAxis, 3)
                                
                                ' I like to give a little "jiggle" resistance to my controls, as I have an old joystick
                                ' which is prone to always give minute values and never really center on true 0.
                                ' A value of 1 means my axis is pushed fully in one direction.
                                ' A value greater than 0.1 means it's been partially pushed in a direction (such as at a 45 degree diagional angle).
                                ' A value of less than 0.1 means we count it as being centered. (As if it was 0.)
                                
                                'These are way too sensitive for analog:
                                'IF ABS(_AXIS(iLoop)) <= 1 AND ABS(_AXIS(iLoop)) >= .1 THEN
                                'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .01 THEN
                                'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .001 THEN
                                
                                'For digital input, we'll use a big picture:
                                IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= 0.75 THEN
                                    if dblNextAxis <> arrAxis(iController, iLoop) then
                                        ' *****************************************************************************
                                        ' MOVED STICK
                                        
                                        ' convert to a digital value
                                        if dblNextAxis < 0 then
                                            iValue = -1
                                        else
                                            iValue = 1
                                        end if
                                        
                                        ' make sure this isn't already mapped
                                        bHaveInput = TRUE
                                        if iWhichInput > lbound(m_arrControlMap, 2) then
                                            ' is input unique?
                                            For iNextInput = lbound(m_arrControlMap, 2) to iWhichInput-1
                                                if m_arrControlMap(iPlayer, iNextInput).device = iDevice then
                                                    if m_arrControlMap(iPlayer, iNextInput).typ = cInputAxis then
                                                        if m_arrControlMap(iPlayer, iNextInput).code = iLoop then
                                                            if m_arrControlMap(iPlayer, iNextInput).value = iValue then
                                                                bHaveInput = FALSE
                                                            end if
                                                        end if
                                                    end if
                                                end if
                                            Next iNextInput
                                        end if
                                        
                                        if bHaveInput then
                                            m_arrControlMap(iPlayer, iWhichInput).device = iDevice
                                            m_arrControlMap(iPlayer, iWhichInput).typ = cInputAxis
                                            m_arrControlMap(iPlayer, iWhichInput).code = iLoop
                                            m_arrControlMap(iPlayer, iWhichInput).value = iValue
                                            bMoveNext = TRUE
                                        end if
                                        
                                    end if
                                END IF
                            NEXT iLoop
                        End If
                        
                    WEND ' clear and update the device buffer
                    
                NEXT iController
                ' END CHECK FOR CONTROLLER INPUT
                ' -----------------------------------------------------------------------------
                
                ' -----------------------------------------------------------------------------
                ' BEGIN CHECK FOR KEYBOARD INPUT #1
                If bMoveNext = FALSE Then
                    '_KEYCLEAR: _DELAY 1
                    WHILE _DEVICEINPUT(1): WEND ' clear and update the keyboard buffer
                    
                    ' Detect changed key state
                    For iLoop = lbound(m_arrButtonCode) to ubound(m_arrButtonCode)
                        iCode = m_arrButtonCode(iLoop)
                        If _BUTTON(iCode) <> FALSE Then
                            ' *****************************************************************************
                            ' PRESSED KEYBOARD
                            'PRINT "PRESSED " + m_arrButtonKey(iLoop)
                            
                            ' make sure this isn't already mapped
                            bHaveInput = TRUE
                            if iWhichInput > lbound(m_arrControlMap, 2) then
                                ' is input unique?
                                For iNextInput = lbound(m_arrControlMap, 2) to iWhichInput-1
                                    if m_arrControlMap(iPlayer, iNextInput).device = 1 then ' .device 1 = keyboard
                                        if m_arrControlMap(iPlayer, iNextInput).typ = cInputKey then
                                            if m_arrControlMap(iPlayer, iNextInput).code = iCode then
                                                'if m_arrControlMap(iPlayer, iNextInput).value = TRUE then
                                                    bHaveInput = FALSE
                                                'end if
                                            end if
                                        end if
                                    end if
                                Next iNextInput
                            end if
                            
                            if bHaveInput then
                                m_arrControlMap(iPlayer, iWhichInput).device = 1 ' .device 1 = keyboard
                                m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey
                                m_arrControlMap(iPlayer, iWhichInput).code = iCode
                                m_arrControlMap(iPlayer, iWhichInput).value = TRUE
                                bMoveNext = TRUE
                            end if
                            
                        End If
                    Next iLoop
                End If
                ' END CHECK FOR KEYBOARD INPUT #1
                ' -----------------------------------------------------------------------------
                
                IF bMoveNext = TRUE THEN EXIT DO
                _LIMIT 30
            LOOP UNTIL _KEYHIT = 27 ' ESCAPE to quit
            ' END LOOK FOR NEXT INPUT
            ' =============================================================================
            
            IF bMoveNext = TRUE THEN
                Print "Device #" + cstr$(m_arrControlMap(iPlayer, iWhichInput).device) + " " + _ 
                    InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) + " " + _ 
                    cstr$(m_arrControlMap(iPlayer, iWhichInput).code) + " = " + _ 
                    cstr$(m_arrControlMap(iPlayer, iWhichInput).value)
            ELSE
                PRINT "(Skipped)"
                bCancel = TRUE
                bFinished = TRUE
            END IF
            
            if bFinished = TRUE then Exit For
        next iWhichInput
    end if
    
    if len(sError) > 0 then
        sResult = "ERRORS: " + sError
    end if
    
    _KEYCLEAR: _DELAY 1
    MapInput1$ = sResult
END SUB ' MapInput1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function InputToString$(iCode As Integer)
    Select Case iCode
        Case cInputUp:
            InputToString$ = "up"
        Case cInputDown:
            InputToString$ = "down"
        Case cInputLeft:
            InputToString$ = "left"
        Case cInputRight:
            InputToString$ = "right"
        Case cInputButton1:
            InputToString$ = "button #1"
        Case cInputButton2:
            InputToString$ = "button #2"
        Case cInputButton3:
            InputToString$ = "button #3"
        Case cInputButton4:
            InputToString$ = "button #4"
        Case Else:
            InputToString$ = "unknown"
    End Select
End Function ' InputToString$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function InputTypeToString$(iCode As Integer)
    Select Case iCode
        Case cInputNone:
            InputTypeToString$ = "none"
        Case cInputKey:
            InputTypeToString$ = "key"
        Case cInputButton:
            InputTypeToString$ = "button"
        Case cInputAxis:
            InputTypeToString$ = "axis"
        Case Else:
            InputTypeToString$ = "unknown"
    End Select
End Function ' InputTypeToString$
 
' /////////////////////////////////////////////////////////////////////////////
' METHOD v2 = faster
 
Function GetKeyboardButtonCodeText$(iCode As Integer)
    Dim sResult As String : sResult = ""
    If lbound(m_arrButtonKeyDesc) <= iCode Then
        If ubound(m_arrButtonKeyDesc) >= iCode Then
            sResult = m_arrButtonKeyDesc(iCode)
        End If
    End If
    If Len(sResult) = 0 Then
        sResult = _TRIM$(STR$(iCode)) + " (?)"
    End If
    GetKeyboardButtonCodeText$ = sResult
End Function ' GetKeyboardButtonCodeText$
 
' /////////////////////////////////////////////////////////////////////////////
' METHOD v2
' Faster lookup - a dictionary with a hash lookup would be best
' but this is a quick way to do it since the values never change.
 
' The following shared arrays must be declared:
'     ReDim Shared m_arrButtonCode(1 To 99) As Long
'     ReDim Shared m_arrButtonKey(1 To 99) As String
'     ReDim Shared m_arrButtonKeyDesc(0 To 512) As String
 
Sub InitKeyboardButtonCodes()
    Dim iLoop As Integer
    
    ' CODE(S) DETECTED WITH _BUTTON:
    m_arrButtonCode(1) = 2 : m_arrButtonKey(1) = "Esc"
    m_arrButtonCode(2) = 60 : m_arrButtonKey(2) = "F1"
    m_arrButtonCode(3) = 61 : m_arrButtonKey(3) = "F2"
    m_arrButtonCode(4) = 62 : m_arrButtonKey(4) = "F3"
    m_arrButtonCode(5) = 63 : m_arrButtonKey(5) = "F4"
    m_arrButtonCode(6) = 64 : m_arrButtonKey(6) = "F5"
    m_arrButtonCode(7) = 65 : m_arrButtonKey(7) = "F6"
    m_arrButtonCode(8) = 66 : m_arrButtonKey(8) = "F7"
    m_arrButtonCode(9) = 67 : m_arrButtonKey(9) = "F8"
    m_arrButtonCode(10) = 68 : m_arrButtonKey(10) = "F9"
    m_arrButtonCode(11) = 88 : m_arrButtonKey(11) = "F11"
    m_arrButtonCode(12) = 89 : m_arrButtonKey(12) = "F12"
    m_arrButtonCode(13) = 42 : m_arrButtonKey(13) = "Tilde"
    m_arrButtonCode(14) = 3 : m_arrButtonKey(14) = "1"
    m_arrButtonCode(15) = 4 : m_arrButtonKey(15) = "2"
    m_arrButtonCode(16) = 5 : m_arrButtonKey(16) = "3"
    m_arrButtonCode(17) = 6 : m_arrButtonKey(17) = "4"
    m_arrButtonCode(18) = 7 : m_arrButtonKey(18) = "5"
    m_arrButtonCode(19) = 8 : m_arrButtonKey(19) = "6"
    m_arrButtonCode(20) = 9 : m_arrButtonKey(20) = "7"
    m_arrButtonCode(21) = 10 : m_arrButtonKey(21) = "8"
    m_arrButtonCode(22) = 11 : m_arrButtonKey(22) = "9"
    m_arrButtonCode(23) = 12 : m_arrButtonKey(23) = "0"
    m_arrButtonCode(24) = 13 : m_arrButtonKey(24) = "Minus"
    m_arrButtonCode(25) = 14 : m_arrButtonKey(25) = "Equal"
    m_arrButtonCode(26) = 15 : m_arrButtonKey(26) = "BkSp"
    m_arrButtonCode(27) = 16 : m_arrButtonKey(27) = "Tab"
    m_arrButtonCode(28) = 17 : m_arrButtonKey(28) = "Q"
    m_arrButtonCode(29) = 18 : m_arrButtonKey(29) = "W"
    m_arrButtonCode(30) = 19 : m_arrButtonKey(30) = "E"
    m_arrButtonCode(31) = 20 : m_arrButtonKey(31) = "R"
    m_arrButtonCode(32) = 21 : m_arrButtonKey(32) = "T"
    m_arrButtonCode(33) = 22 : m_arrButtonKey(33) = "Y"
    m_arrButtonCode(34) = 23 : m_arrButtonKey(34) = "U"
    m_arrButtonCode(35) = 24 : m_arrButtonKey(35) = "I"
    m_arrButtonCode(36) = 25 : m_arrButtonKey(36) = "O"
    m_arrButtonCode(37) = 26 : m_arrButtonKey(37) = "P"
    m_arrButtonCode(38) = 27 : m_arrButtonKey(38) = "BracketLeft"
    m_arrButtonCode(39) = 28 : m_arrButtonKey(39) = "BracketRight"
    m_arrButtonCode(40) = 44 : m_arrButtonKey(40) = "Backslash"
    m_arrButtonCode(41) = 59 : m_arrButtonKey(41) = "CapsLock"
    m_arrButtonCode(42) = 31 : m_arrButtonKey(42) = "A"
    m_arrButtonCode(43) = 32 : m_arrButtonKey(43) = "S"
    m_arrButtonCode(44) = 33 : m_arrButtonKey(44) = "D"
    m_arrButtonCode(45) = 34 : m_arrButtonKey(45) = "F"
    m_arrButtonCode(46) = 35 : m_arrButtonKey(46) = "G"
    m_arrButtonCode(47) = 36 : m_arrButtonKey(47) = "H"
    m_arrButtonCode(48) = 37 : m_arrButtonKey(48) = "J"
    m_arrButtonCode(49) = 38 : m_arrButtonKey(49) = "K"
    m_arrButtonCode(50) = 39 : m_arrButtonKey(50) = "L"
    m_arrButtonCode(51) = 40 : m_arrButtonKey(51) = "Semicolon"
    m_arrButtonCode(52) = 41 : m_arrButtonKey(52) = "Apostrophe"
    m_arrButtonCode(53) = 29 : m_arrButtonKey(53) = "Enter"
    m_arrButtonCode(54) = 43 : m_arrButtonKey(54) = "ShiftLeft"
    m_arrButtonCode(55) = 45 : m_arrButtonKey(55) = "Z"
    m_arrButtonCode(56) = 46 : m_arrButtonKey(56) = "X"
    m_arrButtonCode(57) = 47 : m_arrButtonKey(57) = "C"
    m_arrButtonCode(58) = 48 : m_arrButtonKey(58) = "V"
    m_arrButtonCode(59) = 49 : m_arrButtonKey(59) = "B"
    m_arrButtonCode(60) = 50 : m_arrButtonKey(60) = "N"
    m_arrButtonCode(61) = 51 : m_arrButtonKey(61) = "M"
    m_arrButtonCode(62) = 52 : m_arrButtonKey(62) = "Comma"
    m_arrButtonCode(63) = 53 : m_arrButtonKey(63) = "Period"
    m_arrButtonCode(64) = 54 : m_arrButtonKey(64) = "Slash"
    m_arrButtonCode(65) = 55 : m_arrButtonKey(65) = "ShiftRight"
    m_arrButtonCode(66) = 30 : m_arrButtonKey(66) = "CtrlLeft"
    m_arrButtonCode(67) = 348 : m_arrButtonKey(67) = "WinLeft"
    m_arrButtonCode(68) = 58 : m_arrButtonKey(68) = "Spacebar"
    m_arrButtonCode(69) = 349 : m_arrButtonKey(69) = "WinRight"
    m_arrButtonCode(70) = 350 : m_arrButtonKey(70) = "Menu"
    m_arrButtonCode(71) = 286 : m_arrButtonKey(71) = "CtrlRight"
    m_arrButtonCode(72) = 339 : m_arrButtonKey(72) = "Ins"
    m_arrButtonCode(73) = 328 : m_arrButtonKey(73) = "Home"
    m_arrButtonCode(74) = 330 : m_arrButtonKey(74) = "PgUp"
    m_arrButtonCode(75) = 340 : m_arrButtonKey(75) = "Del"
    m_arrButtonCode(76) = 336 : m_arrButtonKey(76) = "End"
    m_arrButtonCode(77) = 338 : m_arrButtonKey(77) = "PgDn"
    m_arrButtonCode(78) = 329 : m_arrButtonKey(78) = "Up"
    m_arrButtonCode(79) = 332 : m_arrButtonKey(79) = "Left"
    m_arrButtonCode(80) = 337 : m_arrButtonKey(80) = "Down"
    m_arrButtonCode(81) = 334 : m_arrButtonKey(81) = "Right"
    m_arrButtonCode(82) = 71 : m_arrButtonKey(82) = "ScrollLock"
    m_arrButtonCode(83) = 326 : m_arrButtonKey(83) = "NumLock"
    m_arrButtonCode(84) = 310 : m_arrButtonKey(84) = "KeypadSlash"
    m_arrButtonCode(85) = 56 : m_arrButtonKey(85) = "KeypadMultiply"
    m_arrButtonCode(86) = 75 : m_arrButtonKey(86) = "KeypadMinus"
    m_arrButtonCode(87) = 72 : m_arrButtonKey(87) = "Keypad7Home"
    m_arrButtonCode(88) = 73 : m_arrButtonKey(88) = "Keypad8Up"
    m_arrButtonCode(89) = 74 : m_arrButtonKey(89) = "Keypad9PgUp"
    m_arrButtonCode(90) = 79 : m_arrButtonKey(90) = "KeypadPlus"
    m_arrButtonCode(91) = 76 : m_arrButtonKey(91) = "Keypad4Left"
    m_arrButtonCode(92) = 77 : m_arrButtonKey(92) = "Keypad5"
    m_arrButtonCode(93) = 78 : m_arrButtonKey(93) = "Keypad6Right"
    m_arrButtonCode(94) = 80 : m_arrButtonKey(94) = "Keypad1End"
    m_arrButtonCode(95) = 81 : m_arrButtonKey(95) = "Keypad2Down"
    m_arrButtonCode(96) = 82 : m_arrButtonKey(96) = "Keypad3PgDn"
    m_arrButtonCode(97) = 285 : m_arrButtonKey(97) = "KeypadEnter"
    m_arrButtonCode(98) = 83 : m_arrButtonKey(98) = "Keypad0Ins"
    m_arrButtonCode(99) = 84 : m_arrButtonKey(99) = "KeypadPeriodDel"
    
' not sure if this works:
    '' CODE(S) DETECTED WITH _KEYDOWN:
    'm_arrButtonCode(100) = -1 : m_arrButtonCode(100) = "F10"
    
' not sure if this works:
    '' CODE(S) DETECTED WITH _KEYHIT:
    'm_arrButtonCode(101) = -2 : m_arrButtonCode(101) = "AltLeft"
    'm_arrButtonCode(102) = -3 : m_arrButtonCode(102) = "AltRight"
    
    ' DESCRIPTIONS BY KEYCODE
    For iLoop = lbound(m_arrButtonKeyDesc) to ubound (m_arrButtonKeyDesc)
        m_arrButtonKeyDesc(iLoop) = ""
    Next iLoop
    m_arrButtonKeyDesc(2) = "Esc"
    m_arrButtonKeyDesc(60) = "F1"
    m_arrButtonKeyDesc(61) = "F2"
    m_arrButtonKeyDesc(62) = "F3"
    m_arrButtonKeyDesc(63) = "F4"
    m_arrButtonKeyDesc(64) = "F5"
    m_arrButtonKeyDesc(65) = "F6"
    m_arrButtonKeyDesc(66) = "F7"
    m_arrButtonKeyDesc(67) = "F8"
    m_arrButtonKeyDesc(68) = "F9"
    m_arrButtonKeyDesc(88) = "F11"
    m_arrButtonKeyDesc(89) = "F12"
    m_arrButtonKeyDesc(42) = "Tilde"
    m_arrButtonKeyDesc(3) = "1"
    m_arrButtonKeyDesc(4) = "2"
    m_arrButtonKeyDesc(5) = "3"
    m_arrButtonKeyDesc(6) = "4"
    m_arrButtonKeyDesc(7) = "5"
    m_arrButtonKeyDesc(8) = "6"
    m_arrButtonKeyDesc(9) = "7"
    m_arrButtonKeyDesc(10) = "8"
    m_arrButtonKeyDesc(11) = "9"
    m_arrButtonKeyDesc(12) = "0"
    m_arrButtonKeyDesc(13) = "Minus"
    m_arrButtonKeyDesc(14) = "Equal"
    m_arrButtonKeyDesc(15) = "BkSp"
    m_arrButtonKeyDesc(16) = "Tab"
    m_arrButtonKeyDesc(17) = "Q"
    m_arrButtonKeyDesc(18) = "W"
    m_arrButtonKeyDesc(19) = "E"
    m_arrButtonKeyDesc(20) = "R"
    m_arrButtonKeyDesc(21) = "T"
    m_arrButtonKeyDesc(22) = "Y"
    m_arrButtonKeyDesc(23) = "U"
    m_arrButtonKeyDesc(24) = "I"
    m_arrButtonKeyDesc(25) = "O"
    m_arrButtonKeyDesc(26) = "P"
    m_arrButtonKeyDesc(27) = "BracketLeft"
    m_arrButtonKeyDesc(28) = "BracketRight"
    m_arrButtonKeyDesc(44) = "Backslash"
    m_arrButtonKeyDesc(59) = "CapsLock"
    m_arrButtonKeyDesc(31) = "A"
    m_arrButtonKeyDesc(32) = "S"
    m_arrButtonKeyDesc(33) = "D"
    m_arrButtonKeyDesc(34) = "F"
    m_arrButtonKeyDesc(35) = "G"
    m_arrButtonKeyDesc(36) = "H"
    m_arrButtonKeyDesc(37) = "J"
    m_arrButtonKeyDesc(38) = "K"
    m_arrButtonKeyDesc(39) = "L"
    m_arrButtonKeyDesc(40) = "Semicolon"
    m_arrButtonKeyDesc(41) = "Apostrophe"
    m_arrButtonKeyDesc(29) = "Enter"
    m_arrButtonKeyDesc(43) = "ShiftLeft"
    m_arrButtonKeyDesc(45) = "Z"
    m_arrButtonKeyDesc(46) = "X"
    m_arrButtonKeyDesc(47) = "C"
    m_arrButtonKeyDesc(48) = "V"
    m_arrButtonKeyDesc(49) = "B"
    m_arrButtonKeyDesc(50) = "N"
    m_arrButtonKeyDesc(51) = "M"
    m_arrButtonKeyDesc(52) = "Comma"
    m_arrButtonKeyDesc(53) = "Period"
    m_arrButtonKeyDesc(54) = "Slash"
    m_arrButtonKeyDesc(55) = "ShiftRight"
    m_arrButtonKeyDesc(30) = "CtrlLeft"
    m_arrButtonKeyDesc(348) = "WinLeft"
    m_arrButtonKeyDesc(58) = "Spacebar"
    m_arrButtonKeyDesc(349) = "WinRight"
    m_arrButtonKeyDesc(350) = "Menu"
    m_arrButtonKeyDesc(286) = "CtrlRight"
    m_arrButtonKeyDesc(339) = "Ins"
    m_arrButtonKeyDesc(328) = "Home"
    m_arrButtonKeyDesc(330) = "PgUp"
    m_arrButtonKeyDesc(340) = "Del"
    m_arrButtonKeyDesc(336) = "End"
    m_arrButtonKeyDesc(338) = "PgDn"
    m_arrButtonKeyDesc(329) = "Up"
    m_arrButtonKeyDesc(332) = "Left"
    m_arrButtonKeyDesc(337) = "Down"
    m_arrButtonKeyDesc(334) = "Right"
    m_arrButtonKeyDesc(71) = "ScrollLock"
    m_arrButtonKeyDesc(326) = "NumLock"
    m_arrButtonKeyDesc(310) = "KeypadSlash"
    m_arrButtonKeyDesc(56) = "KeypadMultiply"
    m_arrButtonKeyDesc(75) = "KeypadMinus"
    m_arrButtonKeyDesc(72) = "Keypad7Home"
    m_arrButtonKeyDesc(73) = "Keypad8Up"
    m_arrButtonKeyDesc(74) = "Keypad9PgUp"
    m_arrButtonKeyDesc(79) = "KeypadPlus"
    m_arrButtonKeyDesc(76) = "Keypad4Left"
    m_arrButtonKeyDesc(77) = "Keypad5"
    m_arrButtonKeyDesc(78) = "Keypad6Right"
    m_arrButtonKeyDesc(80) = "Keypad1End"
    m_arrButtonKeyDesc(81) = "Keypad2Down"
    m_arrButtonKeyDesc(82) = "Keypad3PgDn"
    m_arrButtonKeyDesc(285) = "KeypadEnter"
    m_arrButtonKeyDesc(83) = "Keypad0Ins"
    m_arrButtonKeyDesc(84) = "KeypadPeriodDel"
End Sub ' InitKeyboardButtonCodes
 
' /////////////////////////////////////////////////////////////////////////////
' not sure if this works
 
' Returns TRUE if the F10 key is held down.
' We use _KEYDOWN for this because _BUTTON doesn't detect F10.
 
' Constant must be declared globally:
' Const c_iKeyDown_F10 = 17408
 
Function KeydownF10%
    Dim iCode AS Long
    '_KEYCLEAR: _DELAY 1
    If _KEYDOWN(c_iKeyDown_F10) = TRUE THEN
        KeydownF10% = TRUE
    Else
        KeydownF10% = FALSE
    End If
    '_KEYCLEAR
End Function ' KeydownF10%
 
' /////////////////////////////////////////////////////////////////////////////
' not sure if this works
 
' Returns TRUE if the left ALT key is held down.
' We use _KEYHIT for this because _BUTTON doesn't detect ALT.
 
' Constant must be declared globally:
' Const c_iKeyHit_AltLeft = -30764    
 
Function KeyhitAltLeft%
    '_KEYCLEAR: _DELAY 1
    If _KEYHIT = c_iKeyHit_AltLeft Then
        KeyhitAltLeft% = TRUE
    Else
        KeyhitAltLeft% = FALSE
    End If
    '_KEYCLEAR
End Function ' KeyhitAltLeft%
 
' /////////////////////////////////////////////////////////////////////////////
' not sure if this works
 
' Returns TRUE if the right ALT key is held down.
' We use _KEYHIT for this because _BUTTON doesn't detect ALT.
 
' Constant must be declared globally:
' Const c_iKeyHit_AltRight = -30765
 
Function KeyhitAltRight%
    '_KEYCLEAR: _DELAY 1
    If _KEYHIT = c_iKeyHit_AltRight Then
        KeyhitAltRight% = TRUE
    Else
        KeyhitAltRight% = FALSE
    End If
    '_KEYCLEAR
End Function ' KeyhitAltRight%
 
' /////////////////////////////////////////////////////////////////////////////
' DEVICES Button
' _LASTBUTTON(1) keyboards will normally return 512 buttons. One button is read per loop through all numbers.
' _BUTTONCHANGE(number) returns -1 when pressed, 1 when released and 0 when there is no event since the last read.
' _BUTTON(number) returns -1 when a button is pressed and 0 when released
 
' Detects most keys (where the codes are documented?)
 
' However, does not seem to detect:
' Key             Use
' ---             ---
' F10             Function KeydownF10%
' Left Alt        Function KeyhitAltLeft%
' Right Alt       Function KeyhitAltRight%
' Print Screen    (system API call?)
' Pause/Break     (system API call?)
 
Function KeyPressed%(iCode As Integer)
    '_KEYCLEAR: _DELAY 1
    WHILE _DEVICEINPUT(1): WEND ' clear and update the keyboard buffer
    If _BUTTON(iCode) <> FALSE Then
        KeyPressed% = TRUE
    Else
        KeyPressed% = FALSE
    End If
    '_KEYCLEAR
End Function ' KeyPressed%
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestJoysticks$
    Dim RoutineName As String: RoutineName = "TestJoysticks$"
    DIM iDeviceCount As Integer
    Dim sResult As String
    
    ' 1 is the keyboard
    ' 2 is the mouse
    ' 3 is the joystick
    ' unless someone has a strange setup with multiple mice/keyboards/ect...
    ' In that case, you can use _DEVICE$(i) to look for "KEYBOARD", "MOUSE", "JOYSTICK", if necessary.
    ' I've never actually found it necessary, but I figure it's worth mentioning, just in case...
    
    iDeviceCount = _DEVICES ' Find the number of devices on someone's system
    IF iDeviceCount > 2 THEN
        TestJoysticks1
        sResult = ""
    ELSE
        sResult = "No joysticks found."
    END IF
    
    _KeyClear
    
    TestJoysticks$ = sResult
END Function ' TestJoysticks$
 
' /////////////////////////////////////////////////////////////////////////////
' Reads controllers and displays values on screen.
 
' Currently this is set up to support up to 8 joysticks, 
' with upto 4 buttons and 2 axes each 
' Testing with an old USB Logitech RumblePad 2 
' and Atari 2600 joysticks plugged into using 
' iCode Atari Joystick, Paddle, Driving to USB Adapter 4 ports
 
SUB TestJoysticks1 ()
    DIM RoutineName AS STRING:: RoutineName = "TestJoysticks1"
 
    DIM in$
    DIM iDeviceCount AS INTEGER
    DIM iDevice AS INTEGER
 
    DIM arrButton(32, 16) As Integer ' number of buttons on the joystick
    DIM arrButtonMin(32, 16) As Integer ' stores the minimum value read
    DIM arrButtonMax(32, 16) As Integer ' stores the maximum value read
    DIM arrAxis(32, 16) As Double ' number of axis on the joystick
    DIM arrAxisMin(32, 16) As Double ' stores the minimum value read
    DIM arrAxisMax(32, 16) As Double ' stores the maximum value read
    DIM arrAxisAvg(32, 16) As Double ' stores the average value read in the last few measurements
    DIM arrButtonNew(32, 16) As Integer ' tracks when to initialize values
    DIM arrAxisNew(32, 16) As Integer ' tracks when to initialize values
    
    DIM arrController(8) AS ControllerType ' holds info for each player
    DIM iNumControllers AS INTEGER
    DIM iController AS INTEGER
    DIM iNextY AS INTEGER
    DIM iNextX AS INTEGER
    DIM iNextC AS INTEGER
    DIM iLoop AS INTEGER
    DIM iDigits AS INTEGER ' # digits to display (values are truncated to this length)
    DIM strValue AS STRING
    Dim strAxis AS STRING
    DIM dblNextAxis
    'DIM iMeasureCount AS INTEGER
    DIM dblAverage AS DOUBLE
    DIM sngAverage AS SINGLE
    Dim sLine As String
    Dim iX As Integer
    Dim iY As Integer
    
    Dim iCol As Integer
    Dim iRow As Integer
    Dim iCols As Integer
    Dim iRows As Integer
    Dim iColWidth As Integer
    Dim iColCount As Integer
    Dim iGroupCount As Integer
    
    ' SET UP SCREEN
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
    
    ' INITIALIZE
    iDigits = 4 ' 11
    iColCount = 3
    iCols = _WIDTH(0) \ _FontWidth
    iRows = _HEIGHT(0) \ _FontHeight
    iColWidth = iCols \ iColCount
    
    ' COUNT # OF JOYSTICKS
    ' D= _DEVICES ' MUST be read in order for other 2 device functions to work!
    iDeviceCount = _DEVICES ' Find the number of devices on someone's system
    IF iDeviceCount < 3 THEN
        CLS
        PRINT "NO JOYSTICKS FOUND, EXITING..."
        INPUT "PRESS <ENTER>";in$
        EXIT SUB
    END IF
    
    ' BASE # OF PLAYERS ON HOW MANY CONTROLLERS FOUND
    iNumControllers = iDeviceCount - 2 ' TODO: find out the right way to count joysticks
    IF iNumControllers > cMaxControllers THEN
        iNumControllers = cMaxControllers
    END IF
    
    ' INITIALIZE PLAYER COORDINATES AND SCREEN CHARACTERS
    iNextY = 1
    iNextX = -3
    iNextC = 64
    FOR iController = 1 TO iNumControllers
        iNextX = iNextX + 4
        IF iNextX > 80 THEN
            iNextX = 1
            iNextY = iNextY + 4
        END IF
        iNextC = iNextC + 1
        arrController(iController).buttonCount = cMaxButtons
        arrController(iController).axisCount = cMaxAxis
        
        for iLoop = 1 to cMaxButtons
            arrButtonNew(iController, iLoop) = TRUE
        next iloop
        for iLoop = 1 to cMaxAxis
            arrAxisNew(iController, iLoop) = TRUE
            arrAxisAvg(iController, iLoop) = 0
        next iLoop
    NEXT iController
 
    ' CLEAR THE SCREEN
    'iMeasureCount = 0
    DO
        FOR iController = 1 TO iNumControllers
            iDevice = iController + 2
 
            WHILE _DEVICEINPUT(iDevice) ' clear and update the device buffer
                ''IF _DEVICEINPUT = 3 THEN ' this says we only care about joystick input values
                
                ' check all the buttons
                FOR iLoop = 1 TO _LASTBUTTON(iDevice)
                    IF (iLoop > cMaxButtons) THEN
                        EXIT FOR
                    END IF
                    arrController(iController).buttonCount = iLoop
                    
                    ' update button array to indicate if a button is up or down currently.
                    IF _BUTTONCHANGE(iLoop) THEN
                        '' _BUTTON(number) returns -1 when a button is pressed and 0 when released.
                        ''arrButton(iLoop) = NOT arrButton(iLoop)
                        arrButton(iController, iLoop) = _BUTTON(iLoop)
                    END IF
                    
                    '' SAVE MINIMUM VALUE
                    'if arrButton(iController, iLoop) < arrButtonMin(iController, iLoop) then
                    '    arrButtonMin(iController, iLoop) = arrButton(iController, iLoop)
                    '    
                    '    ' INITIALIZE THE MAX TO THE MINIMUM VALUE
                    '    IF arrButtonNew(iController, iLoop) = TRUE THEN
                    '        arrButtonMax(iController, iLoop) = arrButtonMin(iController, iLoop)
                    '        arrButtonNew(iController, iLoop) = FALSE
                    '    END IF
                    'end if
                    '
                    '' SAVE MAXIMUM VALUE
                    'if arrButton(iController, iLoop) > arrButtonMax(iController, iLoop) then
                    '    arrButtonMax(iController, iLoop) = arrButton(iController, iLoop)
                    'end if
                    
                NEXT iLoop
                
                FOR iLoop = 1 TO _LASTAXIS(iDevice) ' this loop checks all my axis
                    IF (iLoop > cMaxAxis) THEN
                        EXIT FOR
                    END IF
                    arrController(iController).axisCount = iLoop
                    
                    ' I like to give a little "jiggle" resistance to my controls, as I have an old joystick
                    ' which is prone to always give minute values and never really center on true 0.
                    ' A value of 1 means my axis is pushed fully in one direction.
                    ' A value greater than 0.1 means it's been partially pushed in a direction (such as at a 45 degree diagional angle).
                    ' A value of less than 0.1 means we count it as being centered. (As if it was 0.)
                    'IF ABS(_AXIS(iLoop)) <= 1 AND ABS(_AXIS(iLoop)) >= .1 THEN
                    
                    dblNextAxis = _AXIS(iLoop)
                    dblNextAxis = RoundUpDouble# (dblNextAxis, 3)
                    'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .01 THEN
                    IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .001 THEN
                        arrAxis(iController, iLoop) = dblNextAxis
                    ELSE
                        arrAxis(iController, iLoop) = 0
                    END IF
                    
                    '' SAVE MINIMUM VALUE
                    'if arrAxis(iController, iLoop) < arrAxisMin(iController, iLoop) then
                    '    arrAxisMin(iController, iLoop) = arrAxis(iController, iLoop)
                    '    
                    '    ' INITIALIZE THE MAX TO THE MINIMUM VALUE
                    '    IF arrAxisNew(iController, iLoop) = TRUE THEN
                    '        arrAxisMax(iController, iLoop) = arrAxisMin(iController, iLoop)
                    '        arrAxisNew(iController, iLoop) = FALSE
                    '    END IF
                    'end if
                    '
                    '' SAVE MAXIMUM VALUE
                    'if arrAxis(iController, iLoop) > arrAxisMax(iController, iLoop) then
                    '    arrAxisMax(iController, iLoop) = arrAxis(iController, iLoop)
                    'end if
                    '
                    '' ADD CURRENT VALUE TO AVERAGE SUM
                    'arrAxisAvg(iController, iLoop) = arrAxisAvg(iController, iLoop) + arrAxis(iController, iLoop)
                    
                NEXT iLoop
            WEND ' clear and update the device buffer
 
        NEXT iController
        
        'PRINT "*** iNumControllers=" + cstr$(iNumControllers) + " ***"
        'iMeasureCount = iMeasureCount + 1
        'if iMeasureCount = 10 then
            'iMeasureCount = 0
            
            ' And below here is just the simple display routine which displays our values.
            ' If this was for a game, I'd choose something like arrAxis(1) = -1 for a left arrow style input,
            ' arrAxis(1) = 1 for a right arrow style input, rather than just using _KEYHIT or INKEY$.
            
            InitColumns iColCount
            m_StartRow = 6
            m_EndRow = iRows - 2
            'm_StartCol
            'm_EndCol
            
            CLS
            PrintString 1, 1, "Game controller test program."
            PrintString 1, 2, "This program is free to use and distribute per GNU GPLv3 license."
            PrintString 1, 3, "Tests up to 4 controllers with 2 axes / 2 buttons each."
            PrintString 1, 4, "Plug in controllers and move them & press buttons."
            PrintString 1, 5, "-------------------------------------------------------------------------------"
            
            iGroupCount = 0
            
            FOR iController = 1 TO iNumControllers
                FOR iLoop = 1 TO arrController(iController).axisCount ' A loop for each axis
                    strAxis = right$("  " + cstr$(iLoop), 2)
                    
                    sLine = ""
                    
                    ' display their status to the screen
                    sLine = sLine + "Player " + cstr$(iController)
                    
                    strValue = FormatNumber$(arrAxis(iController, iLoop), iDigits)
                    sLine = sLine + ",   Axis #" + strAxis + " = " + strValue
                    
                    'strValue = FormatNumber$(arrAxisMin(iController, iLoop), iDigits)
                    'sLine = sLine + ", Min=" + strValue
                    '
                    'strValue = FormatNumber$(arrAxisMax(iController, iLoop), iDigits)
                    'sLine = sLine + ", Max=" + strValue
                    '
                    '' COMPUTE AVERAGE
                    'dblAverage = arrAxisAvg(iController, iLoop) / 10
                    'dblAverage = RoundUpDouble# (dblAverage, 3)
                    'strValue = FormatNumber$(dblAverage, iDigits)
                    'sLine = sLine + ", Avg=" + strValue
                    '
                    '' CLEAR THE AVERAGE
                    'arrAxisAvg(iController, iLoop) = 0
                    
                    PrintColumn sLine
                NEXT iLoop
                FOR iLoop = 1 TO arrController(iController).buttonCount ' A loop for each button
                    strAxis = right$("  " + cstr$(iLoop), 2)
                    
                    sLine = ""
                    
                    ' display their status to the screen
                    sLine = sLine + "Player " + cstr$(iController)
                    
                    strValue = FormatNumber$(arrButton(iController, iLoop), iDigits)
                    sLine = sLine + ", Button #" + strAxis + " = " + strValue
                    
                    'strValue = FormatNumber$(arrButtonMin(iController, iLoop), iDigits)
                    'sLine = sLine + ", Min=" + strValue
                    '
                    'strValue = FormatNumber$(arrButtonMax(iController, iLoop), iDigits)
                    'sLine = sLine + ", Max=" + strValue
                    
                    PrintColumn sLine
                NEXT iLoop
                
                iGroupCount = iGroupCount + 1
                if iGroupCount = 2 then
                    ColumnBreak
                    iGroupCount = 0
                end if
                
            NEXT iController
            
            PrintString 1, iRows - 1, "-------------------------------------------------------------------------------"
            PrintString 1, iRows - 0, "PRESS <ESC> TO EXIT"
            
        'end if
        
        _LIMIT 30
    LOOP UNTIL _KEYHIT = 27 ' ESCAPE to quit
    
    ' RETURN TO TEXT SCREEN
    Screen 0
END SUB ' TestJoysticks1
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN FILE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
' File format is comma-delimited
' containing controller info for one action per line
' where each line contains the following in this order:
 
' TAB ORDER   INFO             TYPE      DESCRIPTION
' 1           {player #}       Integer   player # this mapping is for
' 2           {which action}   Integer   which action this mapping is for (up/down/right/left/button 1/button 2, etc.)
' 3           {device #}       Integer   number of the device this is mapped to
' 4           {type}           Integer   type of input (one of: cInputKey, cInputButton, cInputAxis)
' 5           {which}          Integer   if button the _BUTTON #, if axis the _AXIS #, if keyboard the _BUTTON #
' 6           {value}          Integer   if axis, the value (-1 or 1), else can be ignored
 
' These need to be declared globally and populated:
'     ReDim Shared m_arrControlMap(1 To 8, 1 To 8) As ControlInputType
'     Dim Shared m_ControlMapFileName$: m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
 
' If there is an error, returns error message, 
' else returns blank string.
 
Function SaveControllerMap$
    Dim RoutineName As String:: RoutineName = "SaveControllerMap$"
    Dim sResult As String : sResult = ""
    Dim sError As String: sError = ""
    Dim sFile As String
    Dim in$
    Dim iPlayer As Integer
    Dim iWhichInput As Integer
    Dim sLine As String
    Dim iCount As Long: iCount = 0
    'Dim iError As Long: iError = 0
    Dim sDelim As String : sDelim = "," ' CHR$(9)
    
    DebugPrint "--------------------------------------------------------------------------------"
    DebugPrint "Started " + RoutineName
    DebugPrint "--------------------------------------------------------------------------------"
    
    ' Get file name
    If Len(m_ControlMapFileName$) = 0 Then
        m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
    End If
    sFile = Mid$(m_ControlMapFileName$, _InStrRev(m_ControlMapFileName$, "\") + 1)
    
    '_KeyClear
    'Cls
    'Print "SAVE CONTROLLER MAPPING:"
    'Print "Default file name is " + Chr$(34) + m_ControlMapFileName$ + Chr$(34) + "."
    'Input "Type save file name, or blank for default: ", in$
    'in$ = _Trim$(in$)
    'If Len(in$) > 0 Then
    '    m_ControlMapFileName$ = in$
    'End If
    'sFile = m_ProgramPath$ + m_ControlMapFileName$
    
    DebugPrint "m_ControlMapFileName$=" + CHR$(34) + m_ControlMapFileName$ + CHR$(34)
    
    ' Save mapping to file
    Open m_ControlMapFileName$ For Output As #1
    
    For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
        For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
            sLine = ""
            
            sLine = sLine + _Trim$(Str$(iPlayer))
            sLine = sLine + sDelim
            
            sLine = sLine + _Trim$(Str$(iWhichInput))
            sLine = sLine + sDelim
            
            sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).device))            
            sLine = sLine + sDelim
            
            sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).typ))
            sLine = sLine + sDelim
            
            sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).code))
            sLine = sLine + sDelim
            
            sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).value))
            
            Print #1, sLine
            iCount = iCount + 1
        Next iWhichInput
    Next iPlayer
 
    Close #1
 
    DebugPrint "Wrote   " + _Trim$(Str$(iCount)) + " lines."
    'Print "Skipped " + _Trim$(Str$(iError)) + " lines."
    DebugPrint ""
    'Input "PRESS <ENTER> TO CONTINUE", in$
    
    If len(sError) = 0 then
        sResult = "Saved mapping file " + chr$(34) + sFile + chr$(34) + "."
    Else
        sResult = "ERRORS: " + sError
    End If
    
    SaveControllerMap$ = sResult
End Function ' SaveControllerMap$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function LoadControllerMap$
    Dim RoutineName As String:: RoutineName = "LoadControllerMap$"
    Dim sResult As String: sResult = ""
    Dim sError As String: sError = ""
    Dim sNextErr As String
    
    Dim sFile As String
    Dim sText As String
    Dim iTotal As Long: iTotal = 0
    
    Dim iRead As Long: iRead = 0
    Dim iValid As Long : iValid = 0
    Dim iBad As Long : iBad = 0
    Dim iBlank As Long : iBlank = 0
    
    Dim sLine As String
    ReDim arrNextLine(-1) As String
    Dim iNumValues As Integer
    Dim iAdjust As Integer
    
    Dim iPlayer As Integer
    Dim iWhichInput As Integer
    Dim iDevice As Integer
    Dim iType As Integer
    Dim iWhich As Integer
    Dim iValue As Integer
    
    'Dim sDebugLine As String
    
    DebugPrint "--------------------------------------------------------------------------------"
    DebugPrint "Started " + RoutineName
    DebugPrint "--------------------------------------------------------------------------------"
    
    ' Get file name
    If Len(sError) = 0 Then
        If Len(m_ControlMapFileName$) = 0 Then
            m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
        End If
        sFile = Mid$(m_ControlMapFileName$, _InStrRev(m_ControlMapFileName$, "\") + 1)
    End If
    
    '' Get file name
    'If Len(sError) = 0 Then
    '    Cls
    '    If Len(m_ControlMapFileName$) = 0 Then
    '        m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
    '    End If
    '    Print "LOAD CONTROLLER MAPPING:"
    '    Print "Default file name is " + Chr$(34) + m_ControlMapFileName$ + Chr$(34) + "."
    '    Input "Type name of file to open, or blank for default: ", in$
    '    in$ = _Trim$(in$)
    '    If Len(in$) > 0 Then
    '        m_ControlMapFileName$ = in$
    '    End If
    '    sFile = m_ProgramPath$ + m_ControlMapFileName$
    'End If
    
    ' Make sure file exists
    If Len(sError) = 0 Then
        If _FileExists(m_ControlMapFileName$) = FALSE Then
            sError = "File not found: " + Chr$(34) + m_ControlMapFileName$ + Chr$(34)
        Else
            DebugPrint "Found file: " + chr$(34) + m_ControlMapFileName$ + chr$(34)
        End If
    End If
    
    ' Read data from file
    If Len(sError) = 0 Then
        DebugPrint "OPEN m_ControlMapFileName$ FOR BINARY AS #1"
        
        Open m_ControlMapFileName$ For Binary As #1
        sText = Space$(LOF(1))
        Get #1, , sText
        Close #1
        iTotal = Len(sText) - Len(Replace$(sText, Chr$(13), ""))
        sText = ""
        
        Open m_ControlMapFileName$ For Input As #1
        While Not EOF(1)
            'INPUT #1, sLine
            Line Input #1, sLine ' read entire text file line
 
            iRead = iRead + 1
            DebugPrint "Parsing line " + _Trim$(Str$(iRead)) + _ 
                " of " + _Trim$(Str$(iTotal))
            
            sLine = Replace$(sLine, " ", "") ' Remove spaces
            sLine = Replace$(sLine, Chr$(9), "") ' Remove tabs
            sLine = Replace$(sLine, Chr$(10), "") ' Remove line breaks
            sLine = Replace$(sLine, Chr$(13), "") ' Remove carriage returns
            DebugPrint "    Trimmed=" + chr$(34) + sLine + chr$(34)
            
            If Len(sLine) > 0 Then
                split sLine, ",", arrNextLine()
                DebugPrint "split into arrNextLine()"
                DebugPrint "    lbound =" + _Trim$(Str$(lbound(arrNextLine))) '+ CHR$(10)
                DebugPrint "    ubound =" + _Trim$(Str$(ubound(arrNextLine))) '+ CHR$(10)
                
                iNumValues = (ubound(arrNextLine) - lbound(arrNextLine)) + 1
                if iNumValues > 5 then
                    iAdjust = -1 '- lbound(arrNextLine)
                    
                    if len(sNextErr) = 0 then
                        if IsNum%(arrNextLine(1 + iAdjust)) = TRUE then
                            iPlayer = VAL(arrNextLine(1 + iAdjust))
                        else
                            sNextErr = "Error on line " + cstr$(iRead) + ", value 1: not a number"
                        end if
                    end if
                    
                    if len(sNextErr) = 0 then
                        if IsNum%(arrNextLine(2 + iAdjust)) = TRUE then
                            iWhichInput = VAL(arrNextLine(2 + iAdjust))
                        else
                            sNextErr = "Error on line " + cstr$(iRead) + ", value 2: not a number"
                        end if
                    end if
                    
                    if len(sNextErr) = 0 then
                        if IsNum%(arrNextLine(3 + iAdjust)) = TRUE then
                            iDevice = VAL(arrNextLine(3 + iAdjust))
                        else
                            sNextErr = "Error on line " + cstr$(iRead) + ", value 3: not a number"
                        end if
                    end if
                    
                    if len(sNextErr) = 0 then
                        if IsNum%(arrNextLine(4 + iAdjust)) = TRUE then
                            iType = VAL(arrNextLine(4 + iAdjust))
                        else
                            sNextErr = "Error on line " + cstr$(iRead) + ", value 4: not a number"
                        end if
                    end if
                    
                    if len(sNextErr) = 0 then
                        if IsNum%(arrNextLine(5 + iAdjust)) = TRUE then
                            iWhich = VAL(arrNextLine(5 + iAdjust))
                        else
                            sNextErr = "Error on line " + cstr$(iRead) + ", value 5: not a number"
                        end if
                    end if
                    
                    if len(sNextErr) = 0 then
                        if IsNum%(arrNextLine(6 + iAdjust)) = TRUE then
                            iValue = VAL(arrNextLine(6 + iAdjust))
                        else
                            sNextErr = "Error on line " + cstr$(iRead) + ", value 6: not a number"
                        end if
                    end if
                    
                    ' validate iPlayer
                    if len(sNextErr) = 0 then
                        if iPlayer < lbound(m_arrControlMap, 1) then
                            sNextErr = "Player value " + _Trim$(Str$(iPlayer)) + _ 
                                " is outside lbound(m_arrControlMap, 1) " + _ 
                                " which is " + _Trim$(Str$(lbound(m_arrControlMap, 1))) + "."
                        elseif iPlayer > ubound(m_arrControlMap, 1) then
                            sNextErr = "Player value " + _Trim$(Str$(iPlayer)) + _ 
                                " is outside ubound(m_arrControlMap, 1) " + _ 
                                " which is " + _Trim$(Str$(ubound(m_arrControlMap, 1))) + "."
                        end if
                    end if
                    
                    ' validate iWhichInput
                    if len(sNextErr) = 0 then
                        if iWhichInput < lbound(m_arrControlMap, 2) then
                            sNextErr = "WhichInput value " + _Trim$(Str$(iWhichInput)) + _ 
                                " is outside lbound(m_arrControlMap, 2) " + _ 
                                " which is " + _Trim$(Str$(lbound(m_arrControlMap, 2))) + "."
                        elseif iWhichInput > ubound(m_arrControlMap, 2) then
                            sNextErr = "WhichInput value " + _Trim$(Str$(iWhichInput)) + _ 
                                " is outside ubound(m_arrControlMap, 2) " + _ 
                                " which is " + _Trim$(Str$(ubound(m_arrControlMap, 2))) + "."
                        end if
                    end if
                    
                else
                    sNextErr = "Error on line " + cstr$(iRead) + ": detected " + cstr$(iNumValues) + " values, expected 6."
                end if
                
                if len(sNextErr) = 0 then
                    iValid = iValid + 1
                    m_arrControlMap(iPlayer, iWhichInput).device = iDevice
                    m_arrControlMap(iPlayer, iWhichInput).typ = iType
                    m_arrControlMap(iPlayer, iWhichInput).code = iWhich
                    m_arrControlMap(iPlayer, iWhichInput).value = iValue
                else
                    iBad = iBad + 1
                    DebugPrint sNextErr
                end if
            Else
                DebugPrint "    Line is blank: skipped"
                iBlank = iBlank + 1
            End If ' LEN(sLine) > 0
 
        Wend
        Close #1
    End If
    
    DebugPrint ""
    DebugPrint "Lines read: " + _Trim$(Str$(iRead))
    DebugPrint "Valid     : " + _Trim$(Str$(iValid))
    DebugPrint "Invalid   : " + _Trim$(Str$(iErrors))
    DebugPrint "Blank     : " + _Trim$(Str$(iBlank))
    DebugPrint ""
    'Input "PRESS <ENTER> TO CONTINUE", in$
    
    If len(sError) = 0 then
        sResult = "Loaded mapping file " + chr$(34) + sFile + chr$(34) + "."
    Else
        sResult = "ERRORS: " + sError
    End If
    
    LoadControllerMap$ = sResult
End Function ' LoadControllerMap$
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END FILE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GRAPHIC PRINTING ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
' Eliminates the math.
 
' Text resolution:
'  648 x  480:  80 x 30
'  720 x  480:  90 x 30
'  800 x  600: 100 x 37
' 1024 x  768: 128 x 48
' 1280 x 1024: 160 x 64
' 1920 x 1080: 240 x 67
' 2048 x 1152: 256 x 72 (truncated after 70 rows, 255 columns)
' 3840 x 2160: 480 x135 (truncated after 133 rows, 479 columns)
 
SUB PrintString(iCol As Integer, iRow As Integer, MyString As String)
    Dim iCols As Integer
    Dim iRows As Integer
    Dim iX As Integer
    Dim iY As Integer
    iCols = _WIDTH(0) \ _FontWidth
    iRows = _HEIGHT(0) \ _FontHeight
    iX = _FontWidth * (iCol - 1)
    iY = _FontHeight * (iRow - 1)
    _PRINTSTRING (iX, iY), MyString
END SUB ' PrintString
 
' /////////////////////////////////////////////////////////////////////////////
' A way to automatically print to columns.
 
' Depends on the following shared variables:
'     Dim Shared m_NumColumns As Integer : m_NumColumns = 1
'     Dim Shared m_PrintRow As Integer : m_PrintRow = 0
'     Dim Shared m_PrintCol As Integer : m_PrintCol = 0
'     Dim Shared m_StartRow As Integer : m_StartRow = 0
'     Dim Shared m_EndRow As Integer : m_EndRow = 0
'     Dim Shared m_StartCol As Integer : m_StartCol = 0
'     Dim Shared m_EndCol As Integer : m_EndCol = 0
 
' InitColumns 2
' m_PrintRow = 5
' m_PrintCol = 2
' PrintColumn "Col 2, Row 5"
' PrintColumn "m_NumColumns=" + cstr$(m_NumColumns)
 
SUB PrintColumn(MyString As String)
    Dim iCols As Integer
    Dim iRows As Integer
    Dim iX As Integer
    Dim iY As Integer
    
    REDIM arrLines(-1) As String
    DIM iRow As Integer
    DIM iCol As Integer
    DIM sChar As String
    Dim sLine As String
    Dim iColWidth As Integer
    
    iCols = _WIDTH(0) \ _FontWidth
    iRows = _HEIGHT(0) \ _FontHeight
    
    if m_NumColumns < 1 or m_NumColumns > iCols then
        m_NumColumns = 1
    end if
    
    if m_StartRow < 1 or m_StartRow > iRows then
        m_StartRow = 1
    end if
    if m_EndRow < m_StartRow or m_EndRow > iRows then
        m_EndRow = iRows
    end if
    if m_StartCol < 1 or m_StartCol > m_NumColumns then
        m_StartCol = 1
    end if
    if m_EndCol < m_StartCol or m_EndCol > m_NumColumns then
        m_EndCol = m_NumColumns
    end if
    
    if m_PrintRow < m_StartRow then
        m_PrintRow = m_StartRow
    end if
    if m_PrintCol < m_StartCol then
        m_PrintCol = m_StartCol
    end if
    
    iColWidth = iCols \ m_NumColumns
    
    IF m_PrintRow <= m_EndRow THEN
        IF m_PrintCol <= m_EndCol THEN
            split MyString, chr$(13), arrLines()
            FOR iRow = 0 TO UBOUND(arrlines)
                sLine = left$(arrLines(iRow), iColWidth)
                'TODO: wrap remaining text
                iX = _FontWidth * ((m_PrintCol - 1) * iColWidth)
                iY = _FontHeight * (m_PrintRow - 1)
                _PRINTSTRING (iX, iY), sLine
                
                m_PrintRow = m_PrintRow + 1
                IF m_PrintRow > m_EndRow THEN
                    m_PrintRow = m_StartRow
                    m_PrintCol = m_PrintCol + 1
                    if m_PrintCol > m_NumColumns then
                        'TODO: options for when we reach the bottom of the last column (stop printing, wrap around)
                        m_PrintCol = 1
                    end if
                END IF
            NEXT iRow
        END IF
    END IF
END SUB ' PrintColumn
 
' /////////////////////////////////////////////////////////////////////////////
' A way to automatically print to columns.
 
SUB ColumnBreak()
    m_PrintRow = m_StartRow
    m_PrintCol = m_PrintCol + 1
    if m_PrintCol > m_NumColumns then
        'TODO: options for when we go past the last column (stop printing, wrap around)
    end if
END SUB ' ColumnBreak
 
' /////////////////////////////////////////////////////////////////////////////
' A way to automatically print to columns.
 
SUB InitColumns(iNumColumns As Integer)
    Dim iCols As Integer
    Dim iRows As Integer
    iCols = _WIDTH(0) \ _FontWidth
    iRows = _HEIGHT(0) \ _FontHeight
    if iNumColumns < 1 or iNumColumns > iCols then
        m_NumColumns = 1
    else
        m_NumColumns = iNumColumns
    end if
    
    if m_StartRow < 1 or m_StartRow > iRows then
        m_StartRow = 1
    end if
    if m_EndRow < m_StartRow or m_EndRow > iRows then
        m_EndRow = iRows
    end if
    if m_StartCol < 1 or m_StartCol > m_NumColumns then
        m_StartCol = 1
    end if
    if m_EndCol < m_StartCol or m_EndCol > m_NumColumns then
        m_EndCol = m_NumColumns
    end if
    
    m_PrintRow = 1
    m_PrintCol = 1
END SUB ' InitColumns
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GRAPHIC PRINTING ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DEBUGGING ROUTINES #DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub DebugPrint(s$)
    IF m_bTesting = TRUE THEN
        _echo s$
        'ReDim arrLines$(0)
        'dim delim$ : delim$ = Chr$(13)
        'split MyString, delim$, arrLines$()
    END IF
end sub ' DebugPrint
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DEBUGGING ROUTINES @DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE ROUTINES #GEN
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
' Convert a value to string and trim it (because normal Str$ adds spaces)
 
FUNCTION cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _TRIM$(STR$(myValue))
END FUNCTION ' cstr$
 
' /////////////////////////////////////////////////////////////////////////////
' Convert a Long value to string and trim it (because normal Str$ adds spaces)
 
FUNCTION cstrl$ (myValue AS LONG)
    cstrl$ = _TRIM$(STR$(myValue))
END FUNCTION ' cstrl$
 
' /////////////////////////////////////////////////////////////////////////////
' Convert a Single value to string and trim it (because normal Str$ adds spaces)
 
Function cstrs$ (myValue As Single)
    ''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstrs$ = _Trim$(Str$(myValue))
End Function ' cstrs$
 
' /////////////////////////////////////////////////////////////////////////////
' Convert an unsigned Long value to string and trim it (because normal Str$ adds spaces)
 
Function cstrul$ (myValue As _Unsigned Long)
    cstrul$ = _Trim$(Str$(myValue))
End Function ' cstrul$
 
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
 
' Example: A string function that displays extremely small or large exponential decimal values.
 
FUNCTION DblToStr$ (n#)
    value$ = UCASE$(LTRIM$(STR$(n#)))
    Xpos% = INSTR(value$, "D") + INSTR(value$, "E")  'only D or E can be present
    IF Xpos% THEN
      expo% = VAL(MID$(value$, Xpos% + 1))
      IF VAL(value$) < 0 THEN
        sign$ = "-": valu$ = MID$(value$, 2, Xpos% - 2)
      ELSE valu$ = MID$(value$, 1, Xpos% - 1)
      END IF
      dot% = INSTR(valu$, "."): L% = LEN(valu$)
      IF expo% > 0 THEN add$ = STRING$(expo% - (L% - dot%), "0")
      IF expo% < 0 THEN min$ = STRING$(ABS(expo%) - (dot% - 1), "0"): DP$ = "."
      FOR n = 1 TO L%
        IF MID$(valu$, n, 1) <> "." THEN num$ = num$ + MID$(valu$, n, 1)
      NEXT
    ELSE DblToStr$ = value$: EXIT FUNCTION
    END IF
    DblToStr$ = _TRIM$( sign$ + DP$ + min$ + num$ + add$ )
END FUNCTION ' DblToStr$
 
' /////////////////////////////////////////////////////////////////////////////
 
FUNCTION FormatNumber$(myValue, iDigits AS INTEGER)
    DIM strValue AS STRING
    strValue = DblToStr$(myValue) + STRING$(iDigits, " ")
    IF myValue < 1 THEN 
        IF myValue < 0 THEN
            strValue = Replace$(strValue, "-.", "-0.")
        ELSEIF myValue > 0 THEN
            strValue = "0" + strValue
        END IF
    END IF
    FormatNumber$ = LEFT$(strValue, iDigits)
END FUNCTION ' FormatNumber$
 
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
 
' Returns the 8-bit binary representation
' of an integer iInput where 0 <= iInput <= 255
 
Function GetBinary$ (iInput1 As Integer)
    Dim sResult As String
    Dim iLoop As Integer
    Dim iInput As Integer: iInput = iInput1
 
    sResult = ""
 
    If iInput >= 0 And iInput <= 255 Then
        For iLoop = 1 To 8
            sResult = LTrim$(RTrim$(Str$(iInput Mod 2))) + sResult
            iInput = iInput \ 2
            'If iLoop = 4 Then sResult = " " + sResult
        Next iLoop
    End If
 
    GetBinary$ = sResult
End Function ' GetBinary$
 
' /////////////////////////////////////////////////////////////////////////////
' wonderfully inefficient way to read if a bit is set
' ival = GetBit256%(int we are comparing, int containing the bits we want to read)
 
' See also: GetBit256%, SetBit256%
 
Function GetBit256% (iNum1 As Integer, iBit1 As Integer)
    Dim iResult As Integer
    Dim sNum As String
    Dim sBit As String
    Dim iLoop As Integer
    Dim bContinue As Integer
    'DIM iTemp AS INTEGER
    Dim iNum As Integer: iNum = iNum1
    Dim iBit As Integer: iBit = iBit1
 
    iResult = FALSE
    bContinue = TRUE
 
    If iNum < 256 And iBit <= 128 Then
        sNum = GetBinary$(iNum)
        sBit = GetBinary$(iBit)
        For iLoop = 1 To 8
            If Mid$(sBit, iLoop, 1) = "1" Then
                'if any of the bits in iBit are false, return false
                If Mid$(sNum, iLoop, 1) = "0" Then
                    iResult = FALSE
                    bContinue = FALSE
                    Exit For
                End If
            End If
        Next iLoop
        If bContinue = TRUE Then
            iResult = TRUE
        End If
    End If
 
    GetBit256% = iResult
End Function ' GetBit256%
 
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
 
' Returns the integer that corresponds to a binary string of length 8
 
Function GetIntegerFromBinary% (sBinary1 As String)
    Dim iResult As Integer
    Dim iLoop As Integer
    Dim strBinary As String
    Dim sBinary As String: sBinary = sBinary1
 
    iResult = 0
    strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
    For iLoop = 0 To Len(strBinary) - 1
        iResult = iResult + 2 ^ iLoop * Val(Mid$(strBinary, Len(strBinary) - iLoop, 1))
    Next iLoop
 
    GetIntegerFromBinary% = iResult
End Function ' GetIntegerFromBinary%
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsEven% (n)
    If n Mod 2 = 0 Then
        IsEven% = TRUE
    Else
        IsEven% = FALSE
    End If
End Function ' IsEven%
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsOdd% (n)
    If n Mod 2 = 1 Then
        IsOdd% = TRUE
    Else
        IsOdd% = FALSE
    End If
End Function ' IsOdd%
 
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
 
Function IsNum% (text$)
    Dim a$
    Dim b$
    a$ = _Trim$(text$)
    b$ = _Trim$(Str$(Val(text$)))
    If a$ = b$ Then
        IsNum% = TRUE
    Else
        IsNum% = FALSE
    End If
End Function ' IsNum%
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Does a Is Number function exist in QB64?
' https://www.qb64.org/forum/index.php?topic=896.15
 
' MWheatley
' « Reply #18 on: January 01, 2019, 11:24:30 AM »
 
' returns 1 if string is an integer, 0 if not
Function IsNumber (text$)
    Dim i As Integer
 
    IsNumber = 1
    For i = 1 To Len(text$)
        If Asc(Mid$(text$, i, 1)) < 45 Or Asc(Mid$(text$, i, 1)) >= 58 Then
            IsNumber = 0
            Exit For
        ElseIf Asc(Mid$(text$, i, 1)) = 47 Then
            IsNumber = 0
            Exit For
        End If
    Next i
End Function ' IsNumber
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
 
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
 
Function join$ (in$(), delimiter$)
    Dim result$
    Dim i As Long
    result$ = in$(LBound(in$))
    For i = LBound(in$) + 1 To UBound(in$)
        result$ = result$ + delimiter$ + in$(i)
    Next i
    join$ = result$
End Function ' join$
 
' /////////////////////////////////////////////////////////////////////////////
' ABS was returning strange values with type LONG
' so I created this which does not.
 
Function LongABS& (lngValue As Long)
    If Sgn(lngValue) = -1 Then
        LongABS& = 0 - lngValue
    Else
        LongABS& = lngValue
    End If
End Function ' LongABS&
 
' /////////////////////////////////////////////////////////////////////////////
' Writes sText to a debug file in the EXE folder.
' Debug file is named the same thing as the program EXE name with ".txt" at the end.
' For example the program "C:\QB64\MyProgram.BAS" running as
' "C:\QB64\MyProgram.EXE" would have an output file "C:\QB64\MyProgram.EXE.txt".
' If the file doesn't exist, it is created, otherwise it is appended to.
 
Sub DebugPrintFile (sText As String)
    Dim sFileName As String
    Dim sError As String
    Dim sOut As String
 
    sFileName = ProgramPath$ + ProgramName$ + ".txt"
    sError = ""
    If _FileExists(sFileName) = FALSE Then
        sOut = ""
        sOut = sOut + "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + Chr$(13) + Chr$(10)
        sOut = sOut + "PROGRAM : " + ProgramName$ + Chr$(13) + Chr$(10)
        sOut = sOut + "RUN DATE: " + CurrentDateTime$ + Chr$(13) + Chr$(10)
        sOut = sOut + "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + Chr$(13) + Chr$(10)
        sError = PrintFile$(sFileName, sOut, FALSE)
    End If
    If Len(sError) = 0 Then
        sError = PrintFile$(sFileName, sText, TRUE)
    End If
    If Len(sError) <> 0 Then
        Print CurrentDateTime$ + " DebugPrintFile FAILED: " + sError
    End If
End Sub ' DebugPrintFile
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IntPadRight$(iValue As Integer, iWidth As Integer)
    IntPadRight$ = left$( _TRIM$(STR$(iValue)) + STRING$(iWidth, " "), iWidth)
End Function ' IntPadRight$
 
' /////////////////////////////////////////////////////////////////////////////
' Returns blank if successful else returns error message.
 
Function PrintFile$ (sFileName As String, sText As String, bAppend As Integer)
    'x = 1: y = 2: z$ = "Three"
 
    Dim sError As String: sError = ""
 
    If Len(sError) = 0 Then
        If (bAppend = TRUE) Then
            If _FileExists(sFileName) Then
                Open sFileName For Append As #1 ' opens an existing file for appending
            Else
                sError = "Error in PrintFile$ : File not found. Cannot append."
            End If
        Else
            Open sFileName For Output As #1 ' opens and clears an existing file or creates new empty file
        End If
    End If
    If Len(sError) = 0 Then
        ' WRITE places text in quotes in the file
        'WRITE #1, x, y, z$
        'WRITE #1, sText
 
        ' PRINT does not put text inside quotes
        Print #1, sText
 
        Close #1
 
        'PRINT "File created with data. Press a key!"
        'K$ = INPUT$(1) 'press a key
 
        'OPEN sFileName FOR INPUT AS #2 ' opens a file to read it
        'INPUT #2, a, b, c$
        'CLOSE #2
 
        'PRINT a, b, c$
        'WRITE a, b, c$
    End If
 
    PrintFile$ = sError
End Function ' PrintFile$
 
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
Function RandomNumber% (Min%, Max%)
    Dim NumSpread%
 
    ' SET RANDOM SEED
    'Randomize ' Initialize random-number generator.
    Randomize Timer
 
    ' GET RANDOM # Min%-Max%
    'RandomNumber = Int((Max * Rnd) + Min) ' generate number
 
    NumSpread% = (Max% - Min%) + 1
 
    RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
 
End Function ' RandomNumber%
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub RandomNumberTest
    Dim iCols As Integer: iCols = 10
    Dim iRows As Integer: iRows = 20
    Dim iLoop As Integer
    Dim iX As Integer
    Dim iY As Integer
    Dim sError As String
    Dim sFileName As String
    Dim sText As String
    Dim bAppend As Integer
    Dim iMin As Integer
    Dim iMax As Integer
    Dim iNum As Integer
    Dim iErrorCount As Integer
    Dim sInput$
 
    sFileName = "c:\temp\maze_test_1.txt"
    sText = "Count" + Chr$(9) + "Min" + Chr$(9) + "Max" + Chr$(9) + "Random"
    bAppend = FALSE
    sError = PrintFile$(sFileName, sText, bAppend)
    If Len(sError) = 0 Then
        bAppend = TRUE
        iErrorCount = 0
 
        iMin = 0
        iMax = iCols - 1
        For iLoop = 1 To 100
            iNum = RandomNumber%(iMin, iMax)
            sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
            sError = PrintFile$(sFileName, sText, bAppend)
            If Len(sError) > 0 Then
                iErrorCount = iErrorCount + 1
                Print Str$(iLoop) + ". ERROR"
                Print "    " + "iMin=" + Str$(iMin)
                Print "    " + "iMax=" + Str$(iMax)
                Print "    " + "iNum=" + Str$(iNum)
                Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
                Print "    " + sError
            End If
        Next iLoop
 
        iMin = 0
        iMax = iRows - 1
        For iLoop = 1 To 100
            iNum = RandomNumber%(iMin, iMax)
            sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
            sError = PrintFile$(sFileName, sText, bAppend)
            If Len(sError) > 0 Then
                iErrorCount = iErrorCount + 1
                Print Str$(iLoop) + ". ERROR"
                Print "    " + "iMin=" + Str$(iMin)
                Print "    " + "iMax=" + Str$(iMax)
                Print "    " + "iNum=" + Str$(iNum)
                Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
                Print "    " + sError
            End If
        Next iLoop
 
        Print "Finished generating numbers. Errors: " + Str$(iErrorCount)
    Else
        Print "Error creating file " + Chr$(34) + sFileName + Chr$(34) + "."
        Print sError
    End If
 
    Input "Press <ENTER> to continue", sInput$
End Sub ' RandomNumberTest
 
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' found at abandoned, outdated and now likely malicious qb64 dot net website
' http://www.qb64.[net]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.qb64.org)
'   Revision: 1.6
'   Updated:  5/28/2012
 
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
 
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.
 
    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1
 
    lngLocation = InStr(1, Text2, Find2)
 
    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)
 
        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
 
        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter
 
        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)
 
        ' Next instance of [Find2]...
    Wend
 
    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub ReplaceTest
    Dim in$
 
    Print "-------------------------------------------------------------------------------"
    Print "ReplaceTest"
    Print
 
    Print "Original value"
    in$ = "Thiz iz a teZt."
    Print "in$ = " + Chr$(34) + in$ + Chr$(34)
    Print
 
    Print "Replacing lowercase " + Chr$(34) + "z" + Chr$(34) + " with " + Chr$(34) + "s" + Chr$(34) + "..."
    in$ = Replace$(in$, "z", "s")
    Print "in$ = " + Chr$(34) + in$ + Chr$(34)
    Print
 
    Print "Replacing uppercase " + Chr$(34) + "Z" + Chr$(34) + " with " + Chr$(34) + "s" + Chr$(34) + "..."
    in$ = Replace$(in$, "Z", "s")
    Print "in$ = " + Chr$(34) + in$ + Chr$(34)
    Print
 
    Print "ReplaceTest finished."
End Sub ' ReplaceTest
 
' /////////////////////////////////////////////////////////////////////////////
' https://www.qb64.org/forum/index.php?topic=3605.0
' Quote from: SMcNeill on Today at 03:53:48 PM
' 
' Sometimes, you guys make things entirely too  complicated.
' There ya go!  Three functions to either round naturally, 
' always round down, or always round up, to whatever number of digits you desire.
' EDIT:  Modified to add another option to round scientific, 
' since you had it's description included in your example.
 
FUNCTION Round## (num##, digits%)
    Round## = INT(num## * 10 ^ digits% + .5) / 10 ^ digits%
END FUNCTION
 
FUNCTION RoundUp## (num##, digits%)
    RoundUp## = _CEIL(num## * 10 ^ digits%) / 10 ^ digits%
END FUNCTION
 
FUNCTION RoundDown## (num##, digits%)
    RoundDown## = INT(num## * 10 ^ digits%) / 10 ^ digits%
END FUNCTION
 
FUNCTION Round_Scientific## (num##, digits%)
    Round_Scientific## = _ROUND(num## * 10 ^ digits%) / 10 ^ digits%
END FUNCTION
 
FUNCTION RoundUpDouble# (num#, digits%)
    RoundUpDouble# = _CEIL(num# * 10 ^ digits%) / 10 ^ digits%
END FUNCTION
 
FUNCTION RoundUpSingle! (num!, digits%)
    RoundUpSingle! = _CEIL(num! * 10 ^ digits%) / 10 ^ digits%
END FUNCTION
 
' /////////////////////////////////////////////////////////////////////////////
' fantastically inefficient way to set a bit
 
' example use: arrMaze(iX, iY) = SetBit256%(arrMaze(iX, iY), cS, FALSE)
 
' See also: GetBit256%, SetBit256%
 
' newint=SetBit256%(oldint, int containing the bits we want to set, value to set them to)
Function SetBit256% (iNum1 As Integer, iBit1 As Integer, bVal1 As Integer)
    Dim sNum As String
    Dim sBit As String
    Dim sVal As String
    Dim iLoop As Integer
    Dim strResult As String
    Dim iResult As Integer
    Dim iNum As Integer: iNum = iNum1
    Dim iBit As Integer: iBit = iBit1
    Dim bVal As Integer: bVal = bVal1
 
    If iNum < 256 And iBit <= 128 Then
        sNum = GetBinary$(iNum)
        sBit = GetBinary$(iBit)
        If bVal = TRUE Then
            sVal = "1"
        Else
            sVal = "0"
        End If
        strResult = ""
        For iLoop = 1 To 8
            If Mid$(sBit, iLoop, 1) = "1" Then
                strResult = strResult + sVal
            Else
                strResult = strResult + Mid$(sNum, iLoop, 1)
            End If
        Next iLoop
        iResult = GetIntegerFromBinary%(strResult)
    Else
        iResult = iNum
    End If
 
    SetBit256% = iResult
End Function ' SetBit256%
 
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
 
' Example: A string function that displays extremely small or large exponential decimal values.
 
FUNCTION SngToStr$ (n!)
    value$ = UCASE$(LTRIM$(STR$(n!)))
    Xpos% = INSTR(value$, "D") + INSTR(value$, "E")  'only D or E can be present
    IF Xpos% THEN
      expo% = VAL(MID$(value$, Xpos% + 1))
      IF VAL(value$) < 0 THEN
        sign$ = "-": valu$ = MID$(value$, 2, Xpos% - 2)
      ELSE valu$ = MID$(value$, 1, Xpos% - 1)
      END IF
      dot% = INSTR(valu$, "."): L% = LEN(valu$)
      IF expo% > 0 THEN add$ = STRING$(expo% - (L% - dot%), "0")
      IF expo% < 0 THEN min$ = STRING$(ABS(expo%) - (dot% - 1), "0"): DP$ = "."
      FOR n = 1 TO L%
        IF MID$(valu$, n, 1) <> "." THEN num$ = num$ + MID$(valu$, n, 1)
      NEXT
    ELSE SngToStr$ = value$: EXIT FUNCTION
    END IF
    SngToStr$ = _TRIM$( sign$ + DP$ + min$ + num$ + add$ )
END FUNCTION ' SngToStr$
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM »
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
 
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
 
' Modified to handle multi-character delimiters
 
Sub split (in$, delimiter$, result$())
    Dim start As Integer
    Dim finish As Integer
    Dim iDelimLen As Integer
    ReDim result$(-1)
 
    iDelimLen = Len(delimiter$)
 
    start = 1
    Do
        'While Mid$(in$, start, 1) = delimiter$
        While Mid$(in$, start, iDelimLen) = delimiter$
            'start = start + 1
            start = start + iDelimLen
            If start > Len(in$) Then
                Exit Sub
            End If
        Wend
        finish = InStr(start, in$, delimiter$)
        If finish = 0 Then
            finish = Len(in$) + 1
        End If
 
        ReDim _Preserve result$(0 To UBound(result$) + 1)
 
        result$(UBound(result$)) = Mid$(in$, start, finish - start)
        start = finish + 1
    Loop While start <= Len(in$)
End Sub ' split
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub SplitTest
    Dim in$
    Dim delim$
    ReDim arrTest$(0)
    Dim iLoop%
 
    delim$ = Chr$(10)
    in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
    Print "in$ = " + Chr$(34) + in$ + Chr$(34)
    Print "delim$ = " + Chr$(34) + delim$ + Chr$(34)
    split in$, delim$, arrTest$()
 
    For iLoop% = LBound(arrTest$) To UBound(arrTest$)
        Print "arrTest$(" + LTrim$(RTrim$(Str$(iLoop%))) + ") = " + Chr$(34) + arrTest$(iLoop%) + Chr$(34)
    Next iLoop%
    Print
    Print "Split test finished."
End Sub ' SplitTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub SplitAndReplaceTest
    Dim in$
    Dim out$
    Dim iLoop%
    ReDim arrTest$(0)
 
    Print "-------------------------------------------------------------------------------"
    Print "SplitAndReplaceTest"
    Print
 
    Print "Original value"
    in$ = "This line 1 " + Chr$(13) + Chr$(10) + "and line 2" + Chr$(10) + "and line 3 " + Chr$(13) + "finally THE END."
    out$ = in$
    out$ = Replace$(out$, Chr$(13), "\r")
    out$ = Replace$(out$, Chr$(10), "\n")
    out$ = Replace$(out$, Chr$(9), "\t")
    Print "in$ = " + Chr$(34) + out$ + Chr$(34)
    Print
 
    Print "Fixing linebreaks..."
    in$ = Replace$(in$, Chr$(13) + Chr$(10), Chr$(13))
    in$ = Replace$(in$, Chr$(10), Chr$(13))
    out$ = in$
    out$ = Replace$(out$, Chr$(13), "\r")
    out$ = Replace$(out$, Chr$(10), "\n")
    out$ = Replace$(out$, Chr$(9), "\t")
    Print "in$ = " + Chr$(34) + out$ + Chr$(34)
    Print
 
    Print "Splitting up..."
    split in$, Chr$(13), arrTest$()
 
    For iLoop% = LBound(arrTest$) To UBound(arrTest$)
        out$ = arrTest$(iLoop%)
        out$ = Replace$(out$, Chr$(13), "\r")
        out$ = Replace$(out$, Chr$(10), "\n")
        out$ = Replace$(out$, Chr$(9), "\t")
        Print "arrTest$(" + cstr$(iLoop%) + ") = " + Chr$(34) + out$ + Chr$(34)
    Next iLoop%
    Print
 
    Print "SplitAndReplaceTest finished."
End Sub ' SplitAndReplaceTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Function StrPadRight$(sValue As String, iWidth As Integer)
    StrPadRight$ = left$( sValue + STRING$(iWidth, " "), iWidth)
End Function ' StrPadRight$
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' #END
' ################################################################################################################################################################
 

Cobalt · « **Reply #1 on:** January 06, 2022, 10:12:58 pm »

Quote from: madscijr on January 06, 2022, 05:01:11 pm

The mapping part lets you map keys from the keyboard but for some reason the test routine that lets you move objects around the screen isn't reading the keyboard input.
Digital joysticks don't allow continuous movement.

If you don't get these figured out soon, perhaps take a look at my Zelda clone work. Mainly the Get_Input%% FUNCTION and Custom_Controls SUB. They might be of some help figuring out why you currently having trouble. Its got a few comments but feel free to ask if you still have trouble.

it would also be interesting to see how my setup works with a joypad that gives analog axis Values.

I recommend customizing the controls before you try actually playing the game, default START BUTTON is A(upper case) SELECT BUTTON is B(upper case)
the Options menu sliders are mouse controlled. And the custom controls menu is used with mouse too.

This is the last update of this version of my Zelda clone, as I messed the data structure up and cant get certain effects and extras to work. Also at some point I broke the ability to shoot the sword,(you still can but it throws some errors you have to OK though).
But you can watch the title sequence, explore the world, enter some caves, and collect the wood sword

Code: QB64: [Select]

'Zelda Clone take 2
 
TYPE ControllerKeys
 KBCon_Up AS LONG
 KBCon_Down AS LONG
 KBCon_Left AS LONG
 KBCon_Right AS LONG
 KBCon_Select AS LONG
 KBCon_Start AS LONG
 KBCon_A_Button AS LONG
 KBCon_B_Button AS LONG
 Control_Pad AS _BYTE 'which Gamepad\Joystick Device Is player Using?
 BAD_Pad AS _BYTE 'option for Buttons As Directions
 Joy_Up AS _BYTE 'axis for up
 Joy_Up_Val AS _BYTE 'axis value for up
 Joy_Down AS _BYTE 'axis for down
 Joy_Down_Val AS _BYTE 'axis value for down
 Joy_Left AS _BYTE 'axis for left
 Joy_Left_Val AS _BYTE 'axis value for left
 Joy_Right AS _BYTE 'axis for right
 Joy_Right_Val AS _BYTE 'axis value for right
 Joy_Select AS _BYTE
 Joy_Start AS _BYTE
 Joy_A_Button AS _BYTE
 Joy_B_Button AS _BYTE
 Joy_Button_Up AS _BYTE 'for people whos controllers give BUTTON states for direction keys
 Joy_Button_Down AS _BYTE 'or just want to use buttons for the direction keys.
 Joy_Button_Left AS _BYTE '""""
 Joy_Button_Right AS _BYTE 'however this fails to work so may not be implemented.
END TYPE
 
TYPE Game_Data
 Impactflag AS _BYTE
 Scale_Factor AS _BYTE
 Scale_X AS _BYTE
 Scale_Y AS _BYTE
 NextScreen AS _BYTE
 Wtime AS _BYTE
 Atime AS _BYTE
 Wframe AS _BYTE
 Aframe AS _BYTE
 Projectile_Count AS _BYTE 'Number of projectiles (including bombs) on screen
 LoadedGame AS _BYTE '  which game is loaded?(1-3)
 MSTR_Vol AS _BYTE '    Master Volume level
 SFX_Vol AS _BYTE '     Sound FX Volume level
 BGM_vol AS _BYTE '     Music Volume level
 ControlType AS _BYTE ' player using Keyboard or Joypad?
 Device_Count AS _BYTE 'Total input Devices aviliable
 ItemCount AS _BYTE '   Number of items on screen
 Collected AS _BYTE '   item link just picked up
END TYPE
 
TYPE Projectile_Data
 Id AS _BYTE '       Kind of projectile; Sword\Arrow\Rock\Ball
 Xloc AS INTEGER '   Projectile location
 Yloc AS INTEGER '
 Direction AS _BYTE 'Direction Projectile is traveling
 Hits AS _BYTE '     Hits per projectile\(AKA:damage) in half heart increments
 Owner AS _BYTE '    Who shot the projectile
END TYPE
 
TYPE Links_Data
 '-----Position data-----
 World AS _BYTE '           Player in Overworld or Underworld
 World_X AS _BYTE '         Overworld X position
 World_Y AS _BYTE '         Overworld Y position
 Tile_X AS _UNSIGNED _BYTE 'Array X location:for Collision\entrances
 Tile_Y AS _BYTE '          Array Y location:for Collision\entrances
 Screen_X AS INTEGER '      X Position on screen
 Screen_Y AS INTEGER '      Y Position on screen
 Direction AS _BYTE '       Direction player is moving\facing
 '-----------------------
 '------Status Data------
 Hearts AS _BYTE '    Units of health: 2 units(halves) per heart
 Containers AS _BYTE 'Max number of health: total full hearts
 Hits AS _BYTE '      Used when Link has defence rings;Blue = 2 hits per 1\2 heart, Red = 4 hits per 1\2 heart
 Max_Bombs AS _BYTE ' how many bombs can Link carry
 '-----------------------
 '------Items Data-------
 Sword AS _BYTE '      Which Sword does player have? Wooden-1,Silver-2,Magical-3
 Weapon AS _BYTE '     Which Weapon is in hand A? Wooden-1,Silver-2,Magical-3,Wand-4
 Ring AS _BYTE '       Which does player have? 0-none, 1-blue,2-red
 Has_Bow AS _BYTE
 Has_Wand AS _BYTE
 Has_Bait AS _BYTE
 Has_Arrow AS _BYTE
 Has_Boomerang AS _BYTE
 Has_Bombs AS _BYTE
 Has_Bracelet AS _BYTE
 Has_Book AS _BYTE
 Has_MagicKey AS _BYTE
 Has_Candle AS _BYTE ' 1-Blue, 2-Red
 Has_Letter AS _BYTE ' 1-letter, 2-Blue Potion, 3-Red Potion
 Has_Ladder AS _BYTE
 Has_Raft AS _BYTE
 Has_Ring AS _BYTE '   1-Blue, 2-Red
 Has_Shield AS _BYTE ' Player has Magic Shield
 Keys AS _BYTE '
 Ruby AS _UNSIGNED _BYTE '
 TriForce AS _BYTE '   each bit represents a collected piece
 Has_Map AS INTEGER '  each bit represents a dungeon map
 Has_Compass AS INTEGER ' each bit represents a dungeon compass
 '-----------------------
 '------Extra Data-------
 Action AS _BYTE '          is player; using an item, Aquiring an item\sword, or aquiring a piece of the triforce?
 Shot AS _BYTE '            player has shot sword
 Projectile_id AS _BYTE '
 Played AS _UNSIGNED _BYTE 'how many times has player played?
 Beaten AS _BYTE '          Has player beaten Game 1? Game 2?
 Shown_Letter AS _BYTE '    Has player shown Old woman the letter?
 '-----------------------
END TYPE
 
TYPE Map_Data
 Id AS _UNSIGNED _BYTE '      Tile id
 Id2 AS _UNSIGNED _BYTE '     if hidden what is under top tile
 Hidden AS _BYTE '            is there something under the tile?
 Burnable AS _BYTE '          can the tile be burnt with candle?
 Pushable AS _BYTE '          can the tile be moved by pushing?
 Bombable AS _BYTE '          can the tile be blown up with bomb?
 PushableXtra AS _BYTE '      can the tile be moved by pushing with braclet?
 Is_Shop AS _BYTE '           is there a shop here?(shop\gift\gamble)
 Is_Secret AS _BYTE '         secrets under bushes dont walk in, just jump in.
 Is_Dungeon AS _BYTE '        is this a dungeon entrace? contains which one
 Walkable AS _BYTE '          can the tile be walk upon?
 Can_Awaken AS _BYTE '        touching the tile awakens the monster (graves and statues)
 Is_Open AS _BYTE '           the player has blown up\burnt\pushed the tile out of the way
 Linked_X AS _UNSIGNED _BYTE 'acts upon a different tile
 Linked_Y AS _BYTE
 Candle_Used AS _BYTE '       the player used the candle
 Movement_Special AS _BYTE '  can the player move freely?
 
 Mob_List AS _UNSIGNED _BYTE 'Which Monsters appear on map segment
END TYPE
 
TYPE KeyCodeData
 Nam AS STRING * 8
 Value AS LONG
END TYPE
 
TYPE DEVICE_Info
 Buttons AS INTEGER
 Axis_p AS _BYTE
END TYPE
 
TYPE Drop_Data
 ID AS _BYTE '         What is it?
 Xloc AS INTEGER '     X location of the item\collision box
 Yloc AS INTEGER '     Y location of the item\collision box
 Xsiz AS _BYTE '       Xsize of the collision box
 Ysiz AS _BYTE '       Ysize of the collision box
 Is_Special AS _BYTE ' Is this a special pickup? pauses game while Link lifts the item
 Death AS INTEGER '     items vanish after 90sec(by game count not timer) except for Special items
END TYPE
 
TYPE Item_Data
 Sprite_X AS INTEGER 'Items sprite sheet location
 Sprite_Y AS INTEGER '
 BoxSize_X AS _BYTE 'Sprites size(8x8,8x16,16x16)
 BoxSize_Y AS _BYTE
END TYPE
 
TYPE Shop_Data
 Item AS _BYTE
 Cost AS _UNSIGNED _BYTE
END TYPE
 
CONST TRUE = -1, FALSE = NOT TRUE, None = 0
CONST Up = 3, Right = 2, Left = 1, Down = 0, SELECT_BUTTON = 4, START_BUTTON = 5, BUTTON_B = 6, BUTTON_A = 7
CONST OverWorld = 0, UnderWorld = 1
CONST Walking = 1, Useing = 2, GetItem = 3, GetTriforce = 4, Attack = 5
CONST Key_Right = 19712, Key_Left = 19200, Key_Up = 18432, Key_Down = 20480
CONST Key_Space = 32, Key_Enter = 13
CONST Default_Key_Right = 19712, Default_Key_Left = 19200, Default_Key_Up = 18432, Default_Key_Down = 20480
CONST Default_A_Button = 32, Default_B_Button = 13, Default_Start_Button = 65, Default_Select_Button = 66
CONST Sword = 1, Arrow = 2, Rock = 3, Ball = 4, Boomerang = 5
CONST Player = 1, Monster = 2, KeyBoard = -1, JoyPad = 0, GO_IN = 1, GO_OUT = 2
CONST Items = 0, Slash = 1, Stairs = 2, SwordShot = 3
 
DIM SHARED Layer(24) AS LONG, Hyrule(255, 87) AS Map_Data, Link AS Links_Data, Reset_Link AS Links_Data
DIM SHARED C AS ControllerKeys, G AS Game_Data, P(16) AS Projectile_Data, Letter(44) AS STRING * 1
DIM SHARED Offset_X(3) AS INTEGER, Offset_Y(3) AS INTEGER, Cave(15, 10) AS Map_Data
DIM SHARED BGM(8) AS LONG, SFX(10) AS LONG, FFX(1) AS LONG, TFX(8) AS LONG
DIM SHARED Records(3) AS Links_Data, Nick(3) AS STRING * 8 'loading\registering\elimination
DIM SHARED KeyCodes(134) AS KeyCodeData, DeviceData(16) AS DEVICE_Info
DIM SHARED Drop(17) AS Drop_Data, Item(37) AS Item_Data, Shop(17, 3) AS Shop_Data
'-------------Graphical setup------------
SCREEN _NEWIMAGE(800, 600, 32)
Layer(0) = _DISPLAY
Layer(1) = _NEWIMAGE(800, 600, 32) 'temp layer
Layer(2) = _NEWIMAGE(640, 480, 256) 'palettized sprite sheet for color shifting
Layer(3) = _NEWIMAGE(800, 600, 32) 'Map background prebuild layer
Layer(4) = _NEWIMAGE(800, 600, 32) 'Mob layer
Layer(5) = _NEWIMAGE(800, 600, 32) 'Sprite layer, moveable\burnable items + bomb holes + pickups
Layer(6) = _NEWIMAGE(12288, 4224, 32) 'PreBuilt Map, upto 300%, for easier map scrolling.
Layer(8) = _NEWIMAGE(800, 600, 32) 'debug map display
Layer(16) = _NEWIMAGE(800, 600, 32) 'temp
Layer(19) = _NEWIMAGE(800, 600, 32) 'item\creature collision layer
MFI_Loader "Zelda.MFI"
_FONT FFX(0), Layer(1)
_FONT FFX(0), Layer(3)
_FONT FFX(0), Layer(16)
_CLEARCOLOR _RGB32(31), Layer(7)
_CLEARCOLOR _RGB32(116), Layer(12)
_CLEARCOLOR _RGB32(116), Layer(17)
_SCREENMOVE 10, 10
'----------------------------------------
TFX(0) = _FREETIMER
ON TIMER(TFX(0), .016) Flame_Burn_Cave
'==================================
G.Scale_Factor = 2
G.Scale_X = 16 * G.Scale_Factor - 1
G.Scale_Y = 16 * G.Scale_Factor - 1
Link.Screen_X = Offset_X(G.Scale_Factor) + (16 * G.Scale_Factor * 7) + 8 * G.Scale_Factor '392
Link.Screen_Y = Offset_Y(G.Scale_Factor) + (16 * G.Scale_Factor * 5) '292
Nick(0) = "": Nick(1) = "": Nick(2) = "": Nick(3) = ""
G.BGM_vol = 66
G.SFX_Vol = 75
G.MSTR_Vol = 100
'OPEN "debug.txt" FOR OUTPUT AS #6
'==================================
 
Get_JoyPads
G.ControlType = KeyBoard
Title_Screen
Select_Screen
 
Build_Map_Screen 16 * Link.World_X, 11 * Link.World_Y
ClearLayer Layer(6)
Build_Map_in_Totallity 'prebuild the entire map at the current scale factor
ClearLayer Layer(1)
_SOURCE Layer(19)
DO
 IF Link.Action <> GetItem THEN
  SELECT CASE Get_Input
   CASE BUTTON_A
    IF Link.Sword <> FALSE THEN
     IF G.Aframe = 0 AND G.Atime = 0 THEN _SNDPLAY SFX(Slash): Link.Action = Attack: Press = Press + 1
     Check_Link_Sword_Shot
    END IF
   CASE Up
    IF Link.Action <> Attack THEN Link.Direction = Up: Link.Action = Walking
   CASE Down
    IF Link.Action <> Attack THEN Link.Direction = Down: Link.Action = Walking
   CASE Right
    IF Link.Action <> Attack THEN Link.Direction = Right: Link.Action = Walking
   CASE Left
    IF Link.Action <> Attack THEN Link.Direction = Left: Link.Action = Walking
   CASE ELSE
    IF Link.Action = Walking THEN Link.Action = None
  END SELECT
 END IF
 
 IF Link.Action = GetItem OR Link.Action = GetTriforce THEN
  IF NOT _SNDPLAYING(SFX(Items)) THEN Link.Action = None: G.Collected = -1
 END IF
 IF Link.World = OverWorld AND Hyrule(Link.Tile_X, Link.Tile_Y).Is_Shop THEN Enter_Shop Hyrule(Link.Tile_X, Link.Tile_Y).Is_Shop
 '-------Items code----------
 IF G.ItemCount THEN Age_items 'only run if there are items to age
 IF Link_Object_Collision THEN Pickup_Item G.Collected
 '---------------------------
 '------Graphx build------
 _PUTIMAGE , Layer(3), Layer(1)
 _PUTIMAGE , Layer(5), Layer(1)
 IF Link.Action = Walking THEN Move_Link
 IF Link.Shot THEN Move_Sword_Shot
 IF G.Impactflag THEN Impact 0, 0
 IF G.ItemCount THEN Display_drops
 IF Link.Action = GetItem THEN Display_Lifted_Item
 _PRINTSTRING (0, 570), STR$(Link.Action) + STR$(G.Collected), Layer(1)
 Place_Link
 IF G.Scale_Factor = 1 THEN _PUTIMAGE , Layer(8), Layer(1)
 IF G.Scale_Factor = 1 THEN _DEST Layer(1): LINE (100 + 2 * Link.Tile_X, 0 + 2 * Link.Tile_Y)-STEP(1, 1), _RGB32(255, 255, 0), BF
 _PUTIMAGE , Layer(1), Layer(0)
 ClearLayer Layer(1)
 '------------------------
 IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
 _LIMIT 60
LOOP UNTIL ExitFlag%%
 
CLS
_PUTIMAGE , Layer(19), Layer(0)
SUB Add_Projectile (What%%, Who%%)
 SELECT CASE What%%
  CASE Sword
   P(G.Projectile_Count).Owner = Who%%
   P(G.Projectile_Count).Id = Sword
   P(G.Projectile_Count).Direction = Link.Direction
   IF Who%% = Player THEN
    P(G.Projectile_Count).Xloc = Link.Screen_X
    P(G.Projectile_Count).Yloc = Link.Screen_Y
   ELSE
   END IF
   G.Projectile_Count = G.Projectile_Count + 1
 END SELECT
END SUB
 
SUB Age_items
 FOR i%% = 0 TO G.ItemCount - 1
  IF Drop(i%%).Death > 0 THEN Drop(i%%).Death = Drop(i%%).Death - 1 'only age normal drops and live drops
  IF Drop(i%%).Death = 0 THEN
   Reduce%% = Reduce%% + 1
   Kill_Item i%%
  END IF
 NEXT i%%
 G.ItemCount = G.ItemCount - Reduce%%
 IF Reduce%% <> 0 THEN Build_Item_Collision_layer 'update the collsion layer if some items have died off
END SUB
 
SUB Remove_Projectile (What%%, Who%%)
 SELECT CASE What%%
  CASE Sword
   IF Who%% = Player THEN
    G.Projectile_Count = G.Projectile_Count - 1
   END IF
 END SELECT
END SUB
 
SUB Build_Cave_Screen
 FOR Y%% = 0 TO 10
  FOR X%% = 0 TO 15
   Place_Tile_On_Screen (16 * G.Scale_Factor) * X%%, (16 * G.Scale_Factor) * Y%%, Cave(X%%, Y%%).Id, Layer(3)
  NEXT
 NEXT
END SUB
 
SUB Build_Item_Collision_layer
 _DEST Layer(19)
 LINE (0, 0)-STEP(799, 599), _RGB32(0), BF 'faster than CLS???
 FOR i%% = 0 TO G.ItemCount - 1
  LINE (Drop(i%%).Xloc, Drop(i%%).Yloc)-STEP(Item(Drop(i%%).ID).BoxSize_X * G.Scale_Factor - 1, Item(Drop(i%%).ID).BoxSize_Y * G.Scale_Factor - 1), _RGB32(1 + i%%, 0, 100), BF 'item mask for collision
 NEXT i%%
 _DEST Layer(1)
END SUB
 
SUB Build_Map_Screen (Map_X~%%, Map_Y%%)
 _DEST Layer(8)
 FOR Y%% = 0 TO 10
  FOR X%% = 0 TO 15
   Place_Tile_On_Screen (16 * G.Scale_Factor) * X%%, (16 * G.Scale_Factor) * Y%%, Hyrule(Map_X~%% + X%%, Map_Y%% + Y%%).Id, Layer(3)
  NEXT
 NEXT
 FOR Y%% = 0 TO 87
  FOR x~%% = 0 TO 255
   IF Hyrule(x~%%, Y%%).Walkable = FALSE THEN LINE (100 + 2 * x~%%, 0 + 2 * Y%%)-STEP(1, 1), _RGB32(255), BF
  NEXT
 NEXT
 _DEST Layer(0)
END SUB
 
SUB Build_Map_in_Totallity
 FOR Y%% = 0 TO 87
  FOR X~%% = 0 TO 255
   tile~%% = Hyrule(X~%%, Y%%).Id
   Gy% = 17 * (tile~%% \ 20) 'get which row it comes from
   Gx% = 17 * (tile~%% MOD 20) 'which column position
   _PUTIMAGE ((16 * G.Scale_Factor) * X~%%, (16 * G.Scale_Factor) * Y%%)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(6), (1 + Gx%, 1 + Gy%)-STEP(15, 15)
  NEXT
 NEXT
END SUB
 
SUB Check_Link_Location
 Ax% = Link.World_X * 16 * (16 * G.Scale_Factor) 'gets the Left most pixel point for the current map screen
 Ay% = Link.World_Y * 11 * (16 * G.Scale_Factor) 'gets the Top most pixel point for the current map screen
 Tx~%% = (Ax% + Link.Screen_X - Offset_X(G.Scale_Factor) + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent x-offset+50% sprite size
 Ty%% = (Ay% + Link.Screen_Y - Offset_Y(G.Scale_Factor) - 2 + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent y-offset+50% sprite size
 IF Hyrule(Tx~%%, Ty%%).Is_Shop THEN Enter_Shop Hyrule(Tx~%%, Ty%%).Is_Shop
 
END SUB
 
 
SUB Check_Link_Sword_Shot 'Can Link shoot his sword?
 IF Link.Hearts = Link.Containers * 2 THEN 'Link has full hearts and can shoot
  IF NOT _SNDPLAYING(SFX(SwordShot)) THEN 'Link did not just shoot
   IF NOT G.Impactflag THEN 'Link's last shot has finished
    IF NOT Link.Shot THEN
     _SNDPLAY SFX(SwordShot)
     Link.Shot = TRUE
     Add_Projectile Sword, Player
    END IF
   END IF
  END IF
 END IF
END SUB
 
SUB ClearLayer (L&)
 _DEST L&
 CLS
 _DEST _DISPLAY
END SUB
 
SUB ClearLayerTrans (L&)
 _DEST L&
 CLS , 0
 _DEST _DISPLAY
END SUB
 
SUB DarkenImage (Image AS LONG, Value_From_0_To_1 AS SINGLE)
 IF Value_From_0_To_1 <= 0 OR Value_From_0_To_1 >= 1 OR _PIXELSIZE(Image) <> 4 THEN EXIT SUB
 DIM Buffer AS _MEM: Buffer = _MEMIMAGE(Image) 'Get a memory reference to our image
 DIM Frac_Value AS LONG: Frac_Value = Value_From_0_To_1 * 65536 'Used to avoid slow floating point calculations
 DIM O AS _OFFSET, O_Last AS _OFFSET
 O = Buffer.OFFSET 'We start at this offset
 O_Last = Buffer.OFFSET + _WIDTH(Image) * _HEIGHT(Image) * 4 'We stop when we get to this offset
 'use on error free code ONLY!
 $CHECKING:OFF
 DO
  _MEMPUT Buffer, O, _MEMGET(Buffer, O, _UNSIGNED _BYTE) * Frac_Value \ 65536 AS _UNSIGNED _BYTE
  _MEMPUT Buffer, O + 1, _MEMGET(Buffer, O + 1, _UNSIGNED _BYTE) * Frac_Value \ 65536 AS _UNSIGNED _BYTE
  _MEMPUT Buffer, O + 2, _MEMGET(Buffer, O + 2, _UNSIGNED _BYTE) * Frac_Value \ 65536 AS _UNSIGNED _BYTE
  O = O + 4
 LOOP UNTIL O = O_Last
 'turn checking back on when done!
 $CHECKING:ON
 _MEMFREE Buffer
END SUB
 
SUB Display_drops
 FOR i%% = 0 TO G.ItemCount
  _PUTIMAGE (Drop(i%%).Xloc, Drop(i%%).Yloc)-STEP(Item(Drop(i%%).ID).BoxSize_X * G.Scale_Factor - 1, Item(Drop(i%%).ID).BoxSize_Y * G.Scale_Factor - 1), Layer(7), Layer(1), (Item(Drop(i%%).ID).Sprite_X, Item(Drop(i%%).ID).Sprite_Y)-STEP(Item(Drop(i%%).ID).BoxSize_X - 1, Item(Drop(i%%).ID).BoxSize_Y - 1)
 NEXT i%%
END SUB
 
SUB Display_Lifted_Item
 _PUTIMAGE (Link.Screen_X, Link.Screen_Y - 16 * G.Scale_Factor)-STEP(Item(G.Collected + 1).BoxSize_X * G.Scale_Factor - 1, Item(G.Collected + 1).BoxSize_Y * G.Scale_Factor - 1), Layer(7), Layer(1), (Item(G.Collected + 1).Sprite_X, Item(G.Collected + 1).Sprite_Y)-STEP(Item(G.Collected + 1).BoxSize_X - 1, Item(G.Collected + 1).BoxSize_Y - 1)
END SUB
 
SUB Drop_Item (Id%%, X%, Y%, Status%%)
 Drop(G.ItemCount).ID = Id%%
 Drop(G.ItemCount).Xloc = X%
 Drop(G.ItemCount).Yloc = Y%
 Drop(G.ItemCount).Xsiz = Item(Id%%).BoxSize_X * G.Scale_Factor
 Drop(G.ItemCount).Ysiz = Item(Id%%).BoxSize_X * G.Scale_Factor
 Drop(G.ItemCount).Is_Special = Status%%
 IF Status%% = FALSE THEN
  Drop(G.ItemCount).Death = 5400 'clicks[60 per second]
 ELSE
  Drop(G.ItemCount).Death = -1 'special items dont die
 END IF
 G.ItemCount = G.ItemCount + 1
 Build_Item_Collision_layer
END SUB
 
SUB Enter_Shop (Which%%)
 'covers all cave screens; Shop\Gamble\Old Man\Old Woman\Information\Gifts\ and Thefts
 IF NOT Hyrule(Link.Tile_X, Link.Tile_Y).Burnable THEN Walk_InOut GO_IN
 Build_Cave_Screen
 X% = Offset_X(G.Scale_Factor)
 Y% = Offset_Y(G.Scale_Factor)
 _PUTIMAGE , Layer(3), Layer(1)
 Link.World = UnderWorld
 SELECT CASE Which%%
  CASE 1 'get the wood sword
   'place the old man
   IF Link.Sword = 0 THEN 'only show if player has not taken the wooden sword yet.
    _PRINTSTRING (X% + 16 * G.Scale_Factor + 64, Y% + 16 * G.Scale_Factor + 48), "It's dangerous to go", Layer(3)
    _PRINTSTRING (X% + 16 * G.Scale_Factor + 96, Y% + 16 * G.Scale_Factor + 64), "alone, take this.", Layer(3)
    _PUTIMAGE (X% + (16 * G.Scale_Factor * 7.5), Y% + (16 * G.Scale_Factor * 4))-STEP(G.Scale_X, G.Scale_Y), Layer(17), Layer(3), (1, 11)-STEP(15, 15)
    Drop_Item Shop(1, 1).Item, X% + (16 * G.Scale_Factor * 7.75), Y% + (16 * G.Scale_Factor * 5.5), TRUE
   END IF
  CASE 2 'Shop 1: Sheild 160, Key 100, Blue Candle 60
  CASE 3 'old woman with life potions
  CASE 4 'Shop 2: Sheild 130, Bomb 20, Arrow 80
  CASE 5 'Shop 3: Blue Ring 250, Key 80, Bait 60
  CASE 6 'Old woman:"Meet the Old man":"At the Grave"
  CASE 7 'Old Woman: Informant
  CASE 8 'Old Man: Life bottle or Heart Container "Take any one you want"
  CASE 9 'Moblin: Gambling game
  CASE 10 'Old Man: "Show this to the":"Old woman" Get the Letter
 END SELECT
END SUB
 
SUB Fade_Out (L&)
 FOR n! = 1 TO 0.5 STEP -0.05
  i2& = _COPYIMAGE(L&)
  DarkenImage i2&, n!
  _PUTIMAGE (0, 0), i2&, Layer(0)
  _FREEIMAGE i2&
  _DELAY .03
 NEXT
END SUB
 
SUB Fade_In (L&)
 FOR n! = 0.01 TO 1 STEP 0.05
  i2& = _COPYIMAGE(L&)
  DarkenImage i2&, n!
  _PUTIMAGE (0, 0), i2&, Layer(0)
  _FREEIMAGE i2&
  _DELAY .03
 NEXT
END SUB
 
FUNCTION Find_First_Available%% (Which%%, Start%%)
 Selection%% = Start%% 'always start at the first saved game slot then check
 DO 'lets find the first available selection (if there are any saved games)
  IF Selection%% < 4 THEN
   IF Which%% = 0 THEN IF RTRIM$(Nick(Selection%%)) = "" THEN Selection%% = Selection%% + 1 ELSE Good_Selection%% = TRUE
   IF Which%% = 1 THEN IF RTRIM$(Nick(Selection%%)) = "" THEN Good_Selection%% = TRUE ELSE Selection%% = Selection%% + 1
  ELSE '4 and 5 are always good selections
   Good_Selection%% = TRUE
  END IF
 LOOP UNTIL Good_Selection%%
 Find_First_Available = Selection%%
END FUNCTION
 
SUB Flame_Burn_Cave
 STATIC Frame%%, Tick%%
 X% = Offset_X(G.Scale_Factor)
 Y% = Offset_Y(G.Scale_Factor)
 _PUTIMAGE (X% + (16 * G.Scale_Factor * 4.5), Y% + (16 * G.Scale_Factor * 4))-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(3), (290, 256)-STEP(15, 15)
 _PUTIMAGE (X% + (16 * G.Scale_Factor * 10.5), Y% + (16 * G.Scale_Factor * 4))-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(3), (290, 256)-STEP(15, 15)
 IF Frame%% THEN
  _PUTIMAGE (X% + (16 * G.Scale_Factor * 4.5), Y% + (16 * G.Scale_Factor * 4))-STEP(G.Scale_X, G.Scale_Y), Layer(17), Layer(3), (52, 11)-STEP(15, 15)
  _PUTIMAGE (X% + (16 * G.Scale_Factor * 10.5), Y% + (16 * G.Scale_Factor * 4))-STEP(G.Scale_X, G.Scale_Y), Layer(17), Layer(3), (52, 11)-STEP(15, 15)
 ELSE
  _PUTIMAGE (X% + (16 * G.Scale_Factor * 5.5), Y% + (16 * G.Scale_Factor * 4))-STEP(-G.Scale_X, G.Scale_Y), Layer(17), Layer(3), (52, 11)-STEP(15, 15)
  _PUTIMAGE (X% + (16 * G.Scale_Factor * 11.5), Y% + (16 * G.Scale_Factor * 4))-STEP(-G.Scale_X, G.Scale_Y), Layer(17), Layer(3), (52, 11)-STEP(15, 15)
 END IF
 Tick%% = Tick%% + 1
 IF Tick%% = 8 THEN Frame%% = NOT Frame%%: Tick%% = 0
END SUB
 
FUNCTION Get_Input%% ()
 Result%% = TRUE '-1 for no input
 SELECT CASE G.ControlType
  CASE TRUE 'Keyboard input
   IF _KEYDOWN(C.KBCon_Up) THEN Result%% = Up
   IF _KEYDOWN(C.KBCon_Down) THEN Result%% = Down
   IF _KEYDOWN(C.KBCon_Left) THEN Result%% = Left
   IF _KEYDOWN(C.KBCon_Right) THEN Result%% = Right
   IF _KEYDOWN(C.KBCon_Select) THEN Result%% = SELECT_BUTTON: ' DO: LOOP WHILE _KEYDOWN(C.KBCon_Select)
   IF _KEYDOWN(C.KBCon_Start) THEN Result%% = START_BUTTON: ' DO: LOOP WHILE _KEYDOWN(C.KBCon_Start)
   IF _KEYDOWN(C.KBCon_A_Button) THEN Result%% = BUTTON_A: ' DO: LOOP WHILE _KEYDOWN(C.KBCon_A_Button)
   IF _KEYDOWN(C.KBCon_B_Button) THEN Result%% = BUTTON_B: ' DO: LOOP WHILE _KEYDOWN(C.KBCon_B_Button)
  CASE FALSE 'joystick input
   IF C.Control_Pad THEN
    DO: LOOP WHILE _DEVICEINPUT(C.Control_Pad)
    IF NOT C.BAD_Pad THEN
     nul%% = AxisPower(CJR%%, CJL%%, CJU%%, CJD%%) 'read directional axis values
     IF CJU%% THEN Result%% = Up
     IF CJD%% THEN Result%% = Down
     IF CJL%% THEN Result%% = Left
     IF CJR%% THEN Result%% = Right
    ELSE
     IF _BUTTON(C.Joy_Button_Up) THEN Result%% = Up ': Joy_Lock_Button (C.Joy_Button_Up)
     IF _BUTTON(C.Joy_Button_Down) THEN Result%% = Down ': Joy_Lock_Button (C.Joy_Button_Down)
     IF _BUTTON(C.Joy_Button_Left) THEN Result%% = Left ': Joy_Lock_Button (C.Joy_Button_Left)
     IF _BUTTON(C.Joy_Button_Right) THEN Result%% = Right ': Joy_Lock_Button (C.Joy_Button_Right)
    END IF
    IF _BUTTON(C.Joy_Select) THEN Result%% = SELECT_BUTTON ': Joy_Lock_Button (C.Joy_Select)
    IF _BUTTON(C.Joy_Start) THEN Result%% = START_BUTTON ': Joy_Lock_Button (C.Joy_Start)
    IF _BUTTON(C.Joy_A_Button) THEN Result%% = BUTTON_A ': Joy_Lock_Button (C.Joy_A_Button)
    IF _BUTTON(C.Joy_B_Button) THEN Result%% = BUTTON_B ': Joy_Lock_Button (C.Joy_B_Button)
   END IF
 END SELECT
 Get_Input = Result%%
END FUNCTION
 
SUB Impact (X%, Y%)
 STATIC Frame AS _BYTE, Fstp AS _BYTE, Xloc(3) AS INTEGER, Yloc(3) AS INTEGER
 IF Frame = -1 OR Xloc(2) = 0 THEN
  Fstp = 0
  FOR i%% = 0 TO 3: Xloc(i%%) = X% + 8 * G.Scale_Factor: Yloc(i%%) = Y% + 8 * G.Scale_Factor: NEXT i%%
 END IF
 Xloc(0) = Xloc(0) - G.Scale_Factor: Yloc(0) = Yloc(0) - G.Scale_Factor
 Xloc(1) = Xloc(1) + G.Scale_Factor: Yloc(1) = Yloc(1) - G.Scale_Factor
 Xloc(2) = Xloc(2) + G.Scale_Factor: Yloc(2) = Yloc(2) + G.Scale_Factor
 Xloc(3) = Xloc(3) - G.Scale_Factor: Yloc(3) = Yloc(3) + G.Scale_Factor
 FOR i%% = 0 TO 3
  SELECT CASE i%%
   CASE 0
    _PUTIMAGE (Xloc(i%%) - 16, Yloc(i%%) - 16)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (205 + 17 * Frame, 205)-STEP(15, 15)
   CASE 1
    _PUTIMAGE (Xloc(i%%) + 16, Yloc(i%%) - 16)-STEP(-G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (205 + 17 * Frame, 205)-STEP(15, 15)
   CASE 2
    _PUTIMAGE (Xloc(i%%) + 16, Yloc(i%%) + 16)-STEP(-G.Scale_X, -G.Scale_Y), Layer(7), Layer(1), (205 + 17 * Frame, 205)-STEP(15, 15)
   CASE 3
    _PUTIMAGE (Xloc(i%%) - 16, Yloc(i%%) + 16)-STEP(G.Scale_X, -G.Scale_Y), Layer(7), Layer(1), (205 + 17 * Frame, 205)-STEP(15, 15)
  END SELECT
 NEXT i%%
 Fstp = Fstp + 1
 Frame = Frame + 1
 IF Frame = 4 THEN Frame = 0
 IF Fstp = 16 THEN Frame = -1: G.Impactflag = FALSE
END SUB
 
SUB Kill_Item (I%%)
 Drop(I%%) = Drop(17) 'erase data in this drop(#17 is always blank)
 FOR j%% = I%% TO G.ItemCount
  SWAP Drop(j%%), Drop(I%%)
 NEXT j%%
END SUB
 
SUB Link_Attack
 SELECT CASE Link.Direction
  CASE Up
   Ox%% = 0: Oy%% = -14 * G.Scale_Factor
  CASE Down
   Ox%% = 0: Oy%% = 14 * G.Scale_Factor
  CASE Left
   Ox%% = -14 * G.Scale_Factor + G.Aframe * (4 * G.Scale_Factor): Oy%% = 0
  CASE Right
   Ox%% = 14 * G.Scale_Factor - G.Aframe * (4 * G.Scale_Factor): Oy%% = 0
 END SELECT
 SELECT CASE G.Aframe
  CASE 0
   _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 17 * (Link.Direction + 8), 137)-STEP(15, 15)
  CASE 1
   _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 17 * (Link.Direction + 8), 137)-STEP(15, 15)
   _PUTIMAGE (Link.Screen_X + Ox%%, Link.Screen_Y + Oy%%)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 51 * Link.Weapon, 171 + 17 * Link.Direction)-STEP(15, 15)
  CASE 2
   _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 34 * Link.Direction + 17, 137)-STEP(15, 15)
   _PUTIMAGE (Link.Screen_X + Ox%%, Link.Screen_Y + Oy%%)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 51 * Link.Weapon + 17, 171 + 17 * Link.Direction)-STEP(15, 15)
  CASE 3
   _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 34 * Link.Direction + 0, 137)-STEP(15, 15)
   _PUTIMAGE (Link.Screen_X + Ox%%, Link.Screen_Y + Oy%%)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 51 * Link.Weapon + 34, 171 + 17 * Link.Direction)-STEP(15, 15)
  CASE ELSE 'attack animation finished
   G.Atime = 0: G.Aframe = 0: Link.Action = None
   _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 34 * Link.Direction + 17 * Frame%%, 137)-STEP(15, 15)
 END SELECT
 _KEYCLEAR
END SUB
 
FUNCTION Link_Collision%% (Dir%%)
 Result%% = FALSE 'start at no collision
 SELECT CASE Link.World
  CASE OverWorld
   'get links center point x\y tile position to check for collision
   Ax% = Link.World_X * 16 * (16 * G.Scale_Factor) 'gets the Left most pixel point for the current map screen
   Ay% = Link.World_Y * 11 * (16 * G.Scale_Factor) 'gets the Top most pixel point for the current map screen
   'we now have the tile that Links center pixel is in!
   SELECT CASE Dir%%
    CASE Up
     Tx~%% = (Ax% + Link.Screen_X - Offset_X(G.Scale_Factor) + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent x-offset+50% sprite size
     Ty%% = (Ay% + Link.Screen_Y - Offset_Y(G.Scale_Factor) - 2 + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent y-offset+50% sprite size
     IF NOT Hyrule(Tx~%%, Ty%%).Walkable THEN Result%% = TRUE
    CASE Down
     Tx~%% = (Ax% + Link.Screen_X - Offset_X(G.Scale_Factor) + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent x-offset+50% sprite size
     Ty%% = (2 + Ay% + Link.Screen_Y - Offset_Y(G.Scale_Factor) + 2 * G.Scale_Factor + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent y-offset+50% sprite size
     IF NOT Hyrule(Tx~%%, Ty%%).Walkable THEN Result%% = TRUE
    CASE Left
     Tx~%% = (Ax% + Link.Screen_X - Offset_X(G.Scale_Factor) - 2 + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent x-offset+50% sprite size
     Ty%% = (Ay% + Link.Screen_Y - Offset_Y(G.Scale_Factor) + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent y-offset+50% sprite size
     IF NOT Hyrule(Tx~%%, Ty%%).Walkable THEN Result%% = TRUE
    CASE Right
     Tx~%% = (2 + Ax% + Link.Screen_X - Offset_X(G.Scale_Factor) + 2 * G.Scale_Factor + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent x-offset+50% sprite size
     Ty%% = (Ay% + Link.Screen_Y - Offset_Y(G.Scale_Factor) + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent y-offset+50% sprite size
     IF NOT Hyrule(Tx~%%, Ty%%).Walkable THEN Result%% = TRUE
   END SELECT
   Link.Tile_X = Tx~%%
   Link.Tile_Y = Ty%%
  CASE UnderWorld
   'get links center point x\y tile position to check for collision
   Ax% = 0 'Link.World_X * 16 * (16 * G.Scale_Factor) 'gets the Left most pixel point for the current map screen
   Ay% = 0 'Link.World_Y * 11 * (16 * G.Scale_Factor) 'gets the Top most pixel point for the current map screen
   'we now have the tile that Links center pixel is in!
   SELECT CASE Dir%%
    CASE Up
     Tx~%% = (Ax% + Link.Screen_X - Offset_X(G.Scale_Factor) + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent x-offset+50% sprite size
     Ty%% = (Ay% + Link.Screen_Y - Offset_Y(G.Scale_Factor) - 2 + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent y-offset+50% sprite size
     IF NOT Cave(Tx~%%, Ty%%).Walkable THEN Result%% = TRUE
    CASE Down
     Tx~%% = (Ax% + Link.Screen_X - Offset_X(G.Scale_Factor) + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent x-offset+50% sprite size
     Ty%% = (2 + Ay% + Link.Screen_Y - Offset_Y(G.Scale_Factor) + 2 * G.Scale_Factor + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent y-offset+50% sprite size
     IF NOT Cave(Tx~%%, Ty%%).Walkable THEN Result%% = TRUE
    CASE Left
     Tx~%% = (Ax% + Link.Screen_X - Offset_X(G.Scale_Factor) - 2 + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent x-offset+50% sprite size
     Ty%% = (Ay% + Link.Screen_Y - Offset_Y(G.Scale_Factor) + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent y-offset+50% sprite size
     IF NOT Cave(Tx~%%, Ty%%).Walkable THEN Result%% = TRUE
    CASE Right
     Tx~%% = (2 + Ax% + Link.Screen_X - Offset_X(G.Scale_Factor) + 2 * G.Scale_Factor + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent x-offset+50% sprite size
     Ty%% = (Ay% + Link.Screen_Y - Offset_Y(G.Scale_Factor) + (16 * G.Scale_Factor \ 2)) \ 16 * G.Scale_Factor 'now add curent y-offset+50% sprite size
     IF NOT Cave(Tx~%%, Ty%%).Walkable THEN Result%% = TRUE
   END SELECT
 END SELECT
 Link_Collision = Result%%
END FUNCTION
 
FUNCTION Link_Object_Collision%%
 Result%% = FALSE
 FOR y%% = 0 TO 8 * G.Scale_Factor
  FOR x%% = 0 TO 8 * G.Scale_Factor
   IF _RED32(POINT(x%% + Link.Screen_X + 4 * G.Scale_Factor, y%% + Link.Screen_Y + 4 * G.Scale_Factor)) <> 0 THEN
    G.Collected = _RED32(POINT(x%% + Link.Screen_X + 4 * G.Scale_Factor, y%% + Link.Screen_Y + 4 * G.Scale_Factor)) - 1
    Result%% = TRUE
    x%% = 8 * G.Scale_Factor + 1: y%% = 8 * G.Scale_Factor + 1
   END IF
  NEXT x%%
 NEXT y%%
 _PRINTSTRING (0, 0), STR$(G.Collected), Layer(3)
 Link_Object_Collision = Result%%
END FUNCTION
 
SUB Move_Link
 SELECT CASE Link.Direction
  CASE Up
   IF NOT Link_Collision(Up) THEN 'nothing blocking Link
    IF Link.Screen_Y > Offset_Y(G.Scale_Factor) THEN 'Link is not at the edge of the screen
     Link.Screen_Y = Link.Screen_Y - 2 * G.Scale_Factor
    ELSE 'player is at edge of screen to shift to next one.
     G.NextScreen = Up
     Shift_New_Map_Screen
    END IF
   END IF
  CASE Down
   IF NOT Link_Collision(Down) THEN 'nothing blocking Link
    IF Link.Screen_Y < (Offset_Y(G.Scale_Factor) + (16 * G.Scale_Factor * 10)) THEN 'Link is not at the edge of the screen
     Link.Screen_Y = Link.Screen_Y + 2 * G.Scale_Factor
    ELSEIF Link.World = OverWorld THEN 'player is at edge of screen to shift to next one.
     G.NextScreen = Down
     Shift_New_Map_Screen
    ELSE 'link is in the underworld
     Walk_InOut GO_OUT
    END IF
   END IF
  CASE Left
   IF NOT Link_Collision(Left) THEN 'nothing blocking Link
    IF Link.Screen_X > Offset_X(G.Scale_Factor) THEN 'Link is not at the edge of the screen
     Link.Screen_X = Link.Screen_X - 2 * G.Scale_Factor
    ELSE 'player is at edge of screen to shift to next one.
     G.NextScreen = Left
     Shift_New_Map_Screen
    END IF
   END IF
  CASE Right
   IF NOT Link_Collision(Right) THEN 'nothing blocking Link
    IF Link.Screen_X < (Offset_X(G.Scale_Factor) + (16 * G.Scale_Factor * 15)) THEN 'Link is not at the edge of the screen
     Link.Screen_X = Link.Screen_X + 2 * G.Scale_Factor
    ELSE 'player is at edge of screen to shift to next one.
     G.NextScreen = Right
     Shift_New_Map_Screen
    END IF
   END IF
 END SELECT
 
END SUB
 
SUB Move_Sword_Shot
 STATIC Xloc AS INTEGER, Yloc AS INTEGER, Direction AS _BYTE, Fstp AS _BYTE, Frame AS _BYTE
 IF Direction = -1 OR Xloc = 0 THEN 'if no direction assigned then assign one
  Direction = Link.Direction
  Xloc = Link.Screen_X
  Yloc = Link.Screen_Y
 END IF
 SELECT CASE Direction
  CASE Up
   Yloc = Yloc - 4 * G.Scale_Factor
  CASE Down
   Yloc = Yloc + 4 * G.Scale_Factor
  CASE Left
   Xloc = Xloc - 4 * G.Scale_Factor
  CASE Right
   Xloc = Xloc + 4 * G.Scale_Factor
 END SELECT
 _PUTIMAGE (Xloc, Yloc)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 17 * Frame + 68 * Direction, 239)-STEP(15, 15)
 SELECT CASE G.Scale_Factor
  CASE 1
   IF Xloc <= 272 OR Xloc >= 514 OR Yloc <= 212 OR Yloc >= 372 THEN Done%% = TRUE
  CASE 2
   IF Xloc <= 140 OR Xloc >= 630 OR Yloc <= 100 OR Yloc >= 430 THEN Done%% = TRUE
  CASE 3
   IF Xloc <= 16 OR Xloc >= 744 OR Yloc <= 96 OR Yloc >= 559 THEN Done%% = TRUE
 END SELECT
 IF Done%% THEN Link.Shot = FALSE: G.Impactflag = TRUE: Impact Xloc, Yloc: Direction = -1: Remove_Projectile Sword, Player
 Fstp = Fstp + 1
 IF Fstp = 2 THEN Fstp = 0: Frame = Frame + 1
 IF Frame = 4 THEN Frame = 0
END SUB
 
SUB Pickup_Item (Id%%)
 X% = Offset_X(G.Scale_Factor)
 Y% = Offset_Y(G.Scale_Factor)
 IF Drop(Id%%).Is_Special THEN _SNDPLAY SFX(Items): Link.Action = GetItem
 SELECT CASE Drop(Id%%).ID
  CASE 1, 2, 3 'Swords
   Link.Sword = Drop(Id%%).ID
  CASE 4 'bow
   Link.Has_Bow = TRUE
  CASE 5 'wand
   Link.Has_Wand = TRUE
  CASE 6 'Bait
   Link.Has_Bait = TRUE
  CASE 7, 8 'arrows
   Link.Has_Arrow = Drop(Id%%).ID - 6 '1-arrow, 2-Silver arrow
  CASE 9, 10 'boomerang
   Link.Has_Boomerang = Drop(Id%%).ID - 8 '1-wood boomerang, 2-magic boomerang
  CASE 11 'bombs
   IF Drop(Id%%).Is_Special OR Drop(Id%%).Death = TRUE THEN '
    Link.Max_Bombs = Link.Max_Bombs + 4
   ELSE
    Link.Has_Bombs = Link.Has_Bombs + 4
    IF Link.Has_Bombs > Link.Max_Bombs THEN Link.Has_Bombs = Link.Max_Bombs
   END IF
  CASE 12, 13, 14 'letter, Blue and Red potions
   Link.Has_Letter = Drop(Id%%).ID - 11
  CASE 15 'dungeon maps
  CASE 16 'magic book
   Link.Has_Book = TRUE
  CASE 17 'raft
   Link.Has_Raft = TRUE
  CASE 18
   Link.Has_Ladder = TRUE
  CASE 19, 20 'hearts
   Link.Hearts = Link.Hearts + 2
   IF Link.Hearts > Link.Containers * 2 THEN Link.Hearts = Link.Containers * 2
  CASE 21 'heart container
   Link.Containers = Link.Containers + 1
  CASE 22, 23 'fairy
  CASE 24 'stop watch
  CASE 25 'Ruby x1
   IF Link.Ruby + 1 <= 255 THEN Link.Ruby = Link.Ruby + 1
  CASE 26 'Ruby x5
   test% = Link.Ruby + 5
   IF test% > 255 THEN Link.Ruby = 255 ELSE Link.Ruby = Link.Ruby + 5
  CASE 27, 28 'Blue, Red Candle
   Link.Has_Candle = Drop(Id%%).ID - 26
  CASE 29, 30
   Link.Has_Ring = Drop(Id%%).ID - 28
  CASE 31
   Link.Has_Shield = TRUE
  CASE 32
   Link.Has_Bracelet = TRUE
  CASE 33
   IF Link.Keys < 8 THEN Link.Keys = Link.Keys + 1
  CASE 34
   Link.Has_MagicKey = TRUE
  CASE 35 'compass
  CASE 36, 37 'triforce
 END SELECT
 Kill_Item G.Collected 'remove the item from the Drop array
 IF NOT _SNDPLAYING(SFX(Items)) THEN G.Collected = -1
 G.ItemCount = G.ItemCount - 1
 Build_Item_Collision_layer
 IF Link.World = UnderWorld THEN
  X% = Offset_X(G.Scale_Factor)
  Y% = Offset_Y(G.Scale_Factor)
  _PUTIMAGE (X% + 16 * G.Scale_Factor + 64, Y% + 16 * G.Scale_Factor + 48)-STEP(352, 48), Layer(7), Layer(3), (290, 256)-STEP(15, 15)
  _PUTIMAGE (X% + (16 * G.Scale_Factor * 7.5), Y% + (16 * G.Scale_Factor * 4))-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(3), (290, 256)-STEP(15, 15)
 END IF
END SUB
 
SUB Place_Link
 STATIC Ftime AS _BYTE, Frame AS _BYTE
 IF Link.Action = Walking THEN 'while Link is moving
  G.Wtime = G.Wtime + 1 'Increment frame time
  IF G.Wtime = 8 THEN
   IF G.Wframe THEN G.Wframe = 0 ELSE G.Wframe = 1 'change frame
   G.Wtime = 0 'reset frame time
  END IF
  _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 34 * Link.Direction + 17 * G.Wframe, 137)-STEP(15, 15)
 ELSEIF Link.Action = Useing THEN 'when Link uses an item
  Ftime = Ftime + 1 'Increment frame time
  IF Ftime = 32 THEN Link.Action = None: Ftime = 0 'action is done
  _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 17 * (Link.Direction + 8), 137)-STEP(15, 15)
 ELSEIF Link.Action = GetItem THEN 'When Link gets a sword\item or buys something
  'Held while music plays
  _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 17 * 12, 137)-STEP(15, 15)
 ELSEIF Link.Action = GetTriforce THEN 'When Link recovers a Triforce piece
  'Held while music plays
  _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 17 * 13, 137)-STEP(15, 15)
 ELSEIF Link.Action = Attack THEN
  G.Atime = G.Atime + 1 'Increment frame time
  IF G.Atime = 4 THEN G.Aframe = G.Aframe + 1: G.Atime = 0 'change frame:reset frame time
  Link_Attack
 ELSE 'Link is standing Still(Action=None)
  G.Atime = 0: G.Aframe = 0
  G.Wtime = 0: G.Wframe = 0
  _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 34 * Link.Direction + 17 * Frame%%, 137)-STEP(15, 15)
 END IF
END SUB
 
SUB Place_Player_Record (I%%, Where%)
 SELECT CASE Where%
  CASE 0
   IF Records(I%% + 1).Beaten THEN _PUTIMAGE (260, 228 + 48 * I%%)-STEP(15, 31), Layer(12), Layer(16), (64, 247)-STEP(7, 15) 'Player 1 Sword
   _PUTIMAGE (236, 234 + 48 * I%%)-STEP(31, 31), Layer(12), Layer(16), (1 + 17 * Records(I%% + 1).Ring, 230)-STEP(15, 15) 'Player 1 Link (green)
   _PRINTSTRING (284, 232 + 48 * I%%), RTRIM$(Nick(I%% + 1)), Layer(16) 'player 1 name
   _PRINTSTRING (284, 248 + 48 * I%%), LEFT$("   ", 3 - LEN(LTRIM$(RTRIM$(STR$(Records(I%% + 1).Played))))) + LTRIM$(STR$(Records(I%% + 1).Played)), Layer(16) 'player 1 tries
   FOR j%% = 1 TO Records(I%% + 1).Containers
    IF j%% < 4 THEN 'first 3 hearts are red
     _PUTIMAGE (428 + 16 * j%%, 232 + 48 * I%%)-STEP(15, 15), Layer(12), Layer(16), (52, 230)-STEP(7, 7) 'Player 1 hearts red
    ELSE
     IF j%% < 9 THEN
      _PUTIMAGE (428 + 16 * j%%, 232 + 48 * I%%)-STEP(15, 15), Layer(12), Layer(16), (73, 267)-STEP(7, 7) 'Player 1 hearts white
     ELSE
      _PUTIMAGE (428 + 16 * (j%% - 8), 232 + 64 * I%%)-STEP(15, 15), Layer(12), Layer(16), (73, 267)-STEP(7, 7) 'Player 1 hearts white
     END IF
    END IF
   NEXT j%%
  CASE 1
   IF Records(I%% + 1).Beaten THEN _PUTIMAGE (326, 148 + 48 * (I%% - 1))-STEP(15, 31), Layer(12), Layer(16), (64, 247)-STEP(7, 15) 'Player 1 Sword
   _PUTIMAGE (300, 154 + 48 * (I%%))-STEP(31, 31), Layer(12), Layer(16), (1 + 17 * Records(I%% + 1).Ring, 230)-STEP(15, 15) 'Player 1 Link (green)
   _PRINTSTRING (364, 152 + 48 * (I%%)), RTRIM$(Nick(I%% + 1)), Layer(1)
 
 END SELECT
END SUB
 
SUB Place_Tile_On_Screen (X%, Y%, Tile~%%, L&)
 Gy% = 17 * (Tile~%% \ 20) 'get which row it comes from
 Gx% = 17 * (Tile~%% MOD 20) 'which column position
 _PUTIMAGE (Offset_X(G.Scale_Factor) + X%, Offset_Y(G.Scale_Factor) + Y%)-STEP(G.Scale_X, G.Scale_Y), Layer(7), L&, (1 + Gx%, 1 + Gy%)-STEP(15, 15)
END SUB
 
SUB Scroll_Screen_II (Dir%%)
 Cx% = Offset_X(G.Scale_Factor) 'top left corner location of map displayed
 Cy% = Offset_Y(G.Scale_Factor)
 Sfx% = 16 * 16 * G.Scale_Factor 'size of the map display
 Sfy% = 11 * 16 * G.Scale_Factor
 Lwx% = 16 * 16 * G.Scale_Factor * Link.World_X 'map area link is in
 Lwy% = 11 * 16 * G.Scale_Factor * Link.World_Y
 SELECT CASE Dir%%
  CASE Up
   FOR y% = 0 TO Sfy% STEP 2 * G.Scale_Factor
    _PUTIMAGE (Cx%, Cy%)-STEP(Sfx%, Sfy%), Layer(6), Layer(1), (Lwx%, Lwy% - y%)-STEP(Sfx%, Sfy%)
    IF y% > 16 * G.Scale_Factor THEN Link.Screen_Y = Link.Screen_Y + 2 * G.Scale_Factor
    Place_Link
    _LIMIT 60
    _PUTIMAGE , Layer(1), Layer(0)
   NEXT
   Link.World_Y = Link.World_Y - 1
  CASE Down
   FOR y% = 0 TO Sfy% STEP 2 * G.Scale_Factor
    _PUTIMAGE (Cx%, Cy%)-STEP(Sfx%, Sfy%), Layer(6), Layer(1), (Lwx%, Lwy% + y%)-STEP(Sfx%, Sfy%)
    IF y% > 16 * G.Scale_Factor THEN Link.Screen_Y = Link.Screen_Y - 2 * G.Scale_Factor
    Place_Link
    _LIMIT 60
    _PUTIMAGE , Layer(1), Layer(0)
   NEXT
   Link.World_Y = Link.World_Y + 1
  CASE Left
   FOR x% = 0 TO Sfx% STEP 2 * G.Scale_Factor
    _PUTIMAGE (Cx%, Cy%)-STEP(Sfx%, Sfy%), Layer(6), Layer(1), (Lwx% - x%, Lwy%)-STEP(Sfx%, Sfy%)
    IF x% > 16 * G.Scale_Factor THEN Link.Screen_X = Link.Screen_X + 2 * G.Scale_Factor
    Place_Link
    _LIMIT 60
    _PUTIMAGE , Layer(1), Layer(0)
   NEXT
   Link.World_X = Link.World_X - 1
  CASE Right
   FOR x% = 0 TO Sfx% STEP 2 * G.Scale_Factor
    _PUTIMAGE (Cx%, Cy%)-STEP(Sfx%, Sfy%), Layer(6), Layer(1), (Lwx% + x%, Lwy%)-STEP(Sfx%, Sfy%)
    IF x% > 16 * G.Scale_Factor THEN Link.Screen_X = Link.Screen_X - 2 * G.Scale_Factor
    Place_Link
    _LIMIT 60
    _PUTIMAGE , Layer(1), Layer(0)
   NEXT
   Link.World_X = Link.World_X + 1
 END SELECT
 Place_Link
 Lwx% = 16 * 16 * G.Scale_Factor * Link.World_X
 Lwy% = 11 * 16 * G.Scale_Factor * Link.World_Y
 _PUTIMAGE (Cx%, Cy%)-STEP(Sfx%, Sfy%), Layer(6), Layer(3), (Lwx%, Lwy%)-STEP(Sfx%, Sfy%) 'move new screen to layer(3)
END SUB
 
SUB Shift_New_Map_Screen
 SELECT CASE G.NextScreen
  CASE Up
   Scroll_Screen_II Up
  CASE Down
   Scroll_Screen_II Down
  CASE Left
   Scroll_Screen_II Left
  CASE Right
   Scroll_Screen_II Right
 END SELECT
 G.NextScreen = -1
END SUB
 
SUB Title_Screen
 _CLEARCOLOR _RGB32(21), Layer(9)
 _CLEARCOLOR _RGB32(21), Layer(10)
 _SNDVOL BGM(0), .33
 _SNDLOOP BGM(0)
 DO
  F%% = 0: F% = 0: ExitFlag%% = FALSE
  DO: _LIMIT 60: LOOP WHILE _SNDGETPOS(BGM(0)) > 10
  DO
   _PUTIMAGE ((800 - 512) \ 2, (600 - 448) \ 2)-STEP(511, 447), Layer(9), Layer(1), (0, 0)-STEP(255, 223)
   SELECT CASE F%%
    CASE 12 TO 18
     _PUTIMAGE (400 - 74, 300 - 128)-STEP(143, 143), Layer(9), Layer(1), (289, 0)-STEP(71, 71)
    CASE 19 TO 24
     _PUTIMAGE (400 - 74, 300 - 128)-STEP(143, 143), Layer(9), Layer(1), (289, 0 + 72)-STEP(71, 71)
    CASE 25 TO 36
     _PUTIMAGE (400 - 74, 300 - 128)-STEP(143, 143), Layer(9), Layer(1), (289, 0 + 144)-STEP(71, 71)
    CASE 37 TO 52
     _PUTIMAGE (400 - 74, 300 - 128)-STEP(143, 143), Layer(9), Layer(1), (289, 0 + 72)-STEP(71, 71)
    CASE 53 TO 59
     _PUTIMAGE (400 - 74, 300 - 128)-STEP(143, 143), Layer(9), Layer(1), (289, 0 + 0)-STEP(71, 71)
   END SELECT
   _PUTIMAGE (304, 523 - 112), Layer(10), Layer(1), (0 + 64 * wave%%, 0)-STEP(63, 111)
   _PUTIMAGE , Layer(1), Layer(0)
   _LIMIT 90
   F%% = F%% + 1
   IF F%% = 60 THEN F%% = 0
   IF F%% MOD 2 = 0 THEN wave%% = wave%% + 1
   IF wave%% = 16 THEN wave%% = 0
   IF Get_Input = START_BUTTON THEN ExitFlag%% = TRUE
  LOOP UNTIL _SNDGETPOS(BGM(0)) > 8.4 OR ExitFlag%%
 
  IF NOT ExitFlag%% THEN
   'start the title fade
   _DEST Layer(1)
   F%% = 0
   DO
    SELECT CASE F%
     CASE 0 TO 13
      LINE (144, 76)-STEP(511, 447), _RGB32(202, 241, 159), BF
      _PUTIMAGE ((800 - 512) \ 2, (600 - 448) \ 2)-STEP(511, 447), Layer(9), Layer(1), (361, 0)-STEP(255, 223)
     CASE 13 TO 24
      LINE (144, 76)-STEP(511, 447), _RGB32(182, 216, 255), BF
      _PUTIMAGE ((800 - 512) \ 2, (600 - 448) \ 2)-STEP(511, 447), Layer(9), Layer(1), (361, 0)-STEP(255, 223)
     CASE 25 TO 34
      LINE (144, 76)-STEP(511, 447), _RGB32(166, 229, 255), BF
      _PUTIMAGE ((800 - 512) \ 2, (600 - 448) \ 2)-STEP(511, 447), Layer(9), Layer(1), (361, 0)-STEP(255, 223)
     CASE 35 TO 42
      LINE (144, 76)-STEP(511, 447), _RGB32(165, 238, 223), BF
      _PUTIMAGE ((800 - 512) \ 2, (600 - 448) \ 2)-STEP(511, 447), Layer(9), Layer(1), (617, 0)-STEP(255, 223)
     CASE 43 TO 48
      LINE (144, 76)-STEP(511, 447), _RGB32(37, 190, 255), BF
      _PUTIMAGE ((800 - 512) \ 2, (600 - 448) \ 2)-STEP(511, 447), Layer(9), Layer(1), (617, 0)-STEP(255, 223)
     CASE 49 TO 52
      LINE (144, 76)-STEP(511, 447), _RGB32(0, 109, 181), BF
      _PUTIMAGE ((800 - 512) \ 2, (600 - 448) \ 2)-STEP(511, 447), Layer(9), Layer(1), (617, 0)-STEP(255, 223)
     CASE 53 TO 57
      _PUTIMAGE ((800 - 512) \ 2, (600 - 448) \ 2)-STEP(511, 447), Layer(9), Layer(1), (873, 0)-STEP(255, 223)
      Wf% = 112
     CASE 58 TO 61
      _PUTIMAGE ((800 - 512) \ 2, (600 - 448) \ 2)-STEP(511, 447), Layer(9), Layer(1), (1129, 0)-STEP(255, 223)
      Wf% = 224
     CASE 62 TO 363
      _PUTIMAGE ((800 - 512) \ 2, (600 - 448) \ 2)-STEP(511, 447), Layer(9), Layer(1), (1385, 0)-STEP(255, 223)
      Wf% = 336
     CASE 364 TO 385
      _PUTIMAGE ((800 - 512) \ 2, (600 - 448) \ 2)-STEP(511, 447), Layer(9), Layer(1), (1641, 0)-STEP(255, 223)
      Wf% = 448
     CASE 386 TO 393
      _PUTIMAGE ((800 - 512) \ 2, (600 - 448) \ 2)-STEP(511, 447), Layer(9), Layer(1), (1897, 0)-STEP(255, 223)
      Wf% = 560
    END SELECT
    _PUTIMAGE (304, 523 - 112), Layer(10), Layer(1), (0 + 64 * wave%%, 0 + Wf%)-STEP(63, 111)
    _PUTIMAGE , Layer(1), Layer(0)
    _LIMIT 90
    F% = F% + 1
    IF F% = 394 THEN ExitFlag%% = TRUE
    IF F% MOD 2 = 0 THEN wave%% = wave%% + 1
    IF wave%% = 16 THEN wave%% = 0
    IF Get_Input = START_BUTTON THEN ExitFlag%% = TRUE
   LOOP UNTIL ExitFlag%%
   ExitFlag%% = FALSE
  END IF
  ClearLayer Layer(0)
  ClearLayer Layer(1)
  IF NOT ExitFlag%% THEN
   'Title scroll
   DO: _LIMIT 60: IF Get_Input = START_BUTTON THEN ExitFlag%% = TRUE
   LOOP UNTIL _SNDGETPOS(BGM(0)) > 16 OR ExitFlag%%
   F% = 0
   IF NOT ExitFlag%% THEN
    DO
     SELECT CASE F%
      CASE 0 TO 223
       _PUTIMAGE (144, 76)-STEP(511, 447), Layer(11), Layer(1), (0, -223 + F%)-STEP(255, 223)
      CASE IS >= 354
       IF blink% THEN
        _PUTIMAGE (72, 332)-STEP(7, 15), Layer(7), Layer(11), (247, 154)-STEP(7, 15) 'heart
        _PUTIMAGE (72, 464)-STEP(7, 15), Layer(7), Layer(11), (213, 171)-STEP(7, 15) 'Ruby
        _PUTIMAGE (120, 1432)-STEP(15, 15), Layer(7), Layer(11), (239, 188)-STEP(15, 15) 'Triforce
       ELSE
        _PUTIMAGE (72, 332)-STEP(7, 15), Layer(7), Layer(11), (239, 154)-STEP(7, 15) 'heart
        _PUTIMAGE (72, 464)-STEP(7, 15), Layer(7), Layer(11), (205, 171)-STEP(7, 15) 'Ruby
        _PUTIMAGE (120, 1432)-STEP(15, 15), Layer(7), Layer(11), (222, 188)-STEP(15, 15) 'Triforce
       END IF
       IF Fblink% THEN
        _PUTIMAGE (72, 400)-STEP(7, 15), Layer(7), Layer(11), (256, 188)-STEP(7, 15) 'fairy blank
        _PUTIMAGE (72, 400)-STEP(7, 15), Layer(7), Layer(11), (281, 154)-STEP(7, 15) 'fairy
       ELSE
        _PUTIMAGE (72, 400)-STEP(7, 15), Layer(7), Layer(11), (256, 188)-STEP(7, 15) 'fairy blank
        _PUTIMAGE (72, 400)-STEP(7, 15), Layer(7), Layer(11), (273, 154)-STEP(7, 15) 'fairy
       END IF
       _PUTIMAGE (144, 76)-STEP(511, 447), Layer(11), Layer(1), (0, F% - 354)-STEP(255, 223)
     END SELECT
     _PUTIMAGE , Layer(1), Layer(0)
     _LIMIT 30
     F% = F% + 1
     IF F% = 1762 THEN F% = F% - 1 'ExitFlag%% = TRUE
     B% = B% + 1
     IF B% = 4 THEN blink% = NOT blink%: B% = 0
     IF B% MOD 2 = 0 THEN Fblink% = NOT Fblink%
     IF Get_Input = START_BUTTON THEN ExitFlag%% = TRUE
    LOOP UNTIL _SNDGETPOS(BGM(0)) >= 79.75 OR ExitFlag%%
    ExitFlag%% = FALSE
   END IF
  END IF
 
 LOOP UNTIL ExitFlag%%
 _DEST Layer(0)
 _SNDSTOP BGM(0)
 DO: LOOP UNTIL Get_Input%% = -1
 
END SUB
 
FUNCTION Projectile_Collision%%
 Result%% = FALSE
 FOR i%% = 0 TO G.Projectile_Count
 NEXT
 Projectile_Collision = Result%%
END FUNCTION
 
 
SUB Walk_InOut (Which%%)
 STATIC Shrink%%, Entry_X, Entry_Y
 SELECT CASE G.Scale_Factor
  CASE 1
   MoveY%% = 2
  CASE 2
   MoveY%% = 5
  CASE 3
   MoveY%% = 8
 END SELECT
 
 SELECT CASE Which%%
  CASE GO_IN
   Link.Screen_X = 16 * G.Scale_Factor * (Link.Tile_X - Link.World_X * 16) + Offset_X(G.Scale_Factor)
   FOR y% = 0 TO MoveY%% 'move link into the cave opening
    _PUTIMAGE , Layer(3), Layer(1) 'place map image
    G.Wtime = G.Wtime + 1 'Increment frame time
    IF G.Wtime >= 2 THEN
     IF G.Wframe THEN G.Wframe = 0 ELSE G.Wframe = 1 'change frame
     G.Wtime = 0 'reset frame time
    END IF
    Link.Screen_Y = Link.Screen_Y - 2
    _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 34 * Link.Direction + 17 * G.Wframe, 137)-STEP(15, 15)
    _PUTIMAGE , Layer(1), Layer(0)
    _DELAY .033
   NEXT y%
 
   _SNDPLAY SFX(Stairs)
   DO 'have link walk `down` into the cave
    _PUTIMAGE , Layer(3), Layer(1) 'place map image
 
    G.Wtime = G.Wtime + 1 'Increment frame time
    IF G.Wtime = 8 THEN
     Shrink%% = Shrink%% + 2
     Link.Screen_Y = Link.Screen_Y + 2 * G.Scale_Factor
     IF G.Wframe THEN G.Wframe = 0 ELSE G.Wframe = 1 'change frame
     G.Wtime = 0 'reset frame time
    END IF
    _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y - Shrink%% * G.Scale_Factor), Layer(7), Layer(1), (1 + 34 * Link.Direction + 17 * G.Wframe, 137)-STEP(15, 15 - Shrink%%)
    _PUTIMAGE , Layer(1), Layer(0)
    _LIMIT 45
   LOOP WHILE _SNDPLAYING(SFX(Stairs))
   Entry_X = Link.Screen_X
   Entry_Y = Link.Screen_Y
   Link.Screen_X = Offset_X(G.Scale_Factor) + 16 * G.Scale_Factor * 7.5
   Link.Screen_Y = Offset_Y(G.Scale_Factor) + 16 * G.Scale_Factor * 9
   TIMER(TFX(0)) ON
  CASE GO_OUT
   TIMER(TFX(0)) OFF
   Build_Map_Screen 16 * Link.World_X, 11 * Link.World_Y
   Link.Screen_X = Entry_X 'Offset_X(G.Scale_Factor) + 16 * G.Scale_Factor * (Link.Tile_X - Link.World_X * 16)
   Link.Screen_Y = Entry_Y 'Offset_Y(G.Scale_Factor) + 16 * G.Scale_Factor * (Link.Tile_Y - Link.World_Y * 11)
   _SNDPLAY SFX(Stairs)
   DO 'have link walk `down` into the cave
    _PUTIMAGE , Layer(3), Layer(1) 'place map image
 
    G.Wtime = G.Wtime + 1 'Increment frame time
    IF G.Wtime = 8 THEN
     Shrink%% = Shrink%% - 2
     Link.Screen_Y = Link.Screen_Y - 2 * G.Scale_Factor
     IF G.Wframe THEN G.Wframe = 0 ELSE G.Wframe = 1 'change frame
     G.Wtime = 0 'reset frame time
    END IF
    _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y - Shrink%% * G.Scale_Factor), Layer(7), Layer(1), (1 + 34 * Link.Direction + 17 * G.Wframe, 137)-STEP(15, 15 - Shrink%%)
 
    _PUTIMAGE , Layer(1), Layer(0)
    _LIMIT 45
   LOOP WHILE _SNDPLAYING(SFX(Stairs))
 
   FOR y% = 0 TO 16 'move link into the cave opening
    _PUTIMAGE , Layer(3), Layer(1) 'place map image
    G.Wtime = G.Wtime + 1 'Increment frame time
    IF G.Wtime >= 2 THEN
     IF G.Wframe THEN G.Wframe = 0 ELSE G.Wframe = 1 'change frame
     G.Wtime = 0 'reset frame time
    END IF
    Link.Screen_Y = Link.Screen_Y + 2
    _PUTIMAGE (Link.Screen_X, Link.Screen_Y)-STEP(G.Scale_X, G.Scale_Y), Layer(7), Layer(1), (1 + 34 * Link.Direction + 17 * G.Wframe, 137)-STEP(15, 15)
    _PUTIMAGE , Layer(1), Layer(0)
    _DELAY .016
   NEXT y%
 
   Link.World = OverWorld
   Link.Tile_Y = Link.Tile_Y + 1
   Shrink%% = 0
 END SELECT
END SUB
 
SUB Build_Custom_Control_Screen (L&())
 'setup custom controls screen
 _PUTIMAGE (120, 72), Layer(18), L&(2)
 _DEST L&(2)
 'up arrow
 LINE (208, 168)-(112, 172), _RGB32(255, 127, 0), BF
 LINE (112, 172)-(116, 500), _RGB32(255, 127, 0), BF
 LINE (112, 500)-(292, 504), _RGB32(255, 127, 0), BF
 'left arrow
 LINE (172, 200)-(128, 204), _RGB32(92, 192, 0), BF
 LINE (128, 204)-(132, 456), _RGB32(92, 192, 0), BF
 LINE (128, 456)-(320, 460), _RGB32(92, 192, 0), BF
 'down arrow
 LINE (208, 252)-(144, 256), _RGB32(0, 127, 255), BF
 LINE (144, 256)-(148, 412), _RGB32(0, 127, 255), BF
 LINE (144, 412)-(336, 416), _RGB32(0, 127, 255), BF
 'right arrow
 LINE (256, 224)-(260, 280), _RGB32(0, 64, 160), BF
 LINE (160, 280)-(260, 284), _RGB32(0, 64, 160), BF
 LINE (160, 284)-(164, 366), _RGB32(0, 64, 160), BF
 LINE (160, 366)-(340, 370), _RGB32(0, 64, 160), BF
 'select
 LINE (344, 252)-(348, 500), _RGB32(255, 64, 0), BF
 LINE (344, 500)-(516, 504), _RGB32(255, 64, 0), BF
 'start
 LINE (408, 252)-(412, 456), _RGB32(212, 0, 16), BF
 LINE (408, 456)-(576, 460), _RGB32(212, 0, 16), BF
 'B Button
 LINE (506, 248)-(510, 296), _RGB32(64, 92, 212), BF
 LINE (420, 296)-(510, 300), _RGB32(64, 92, 212), BF
 LINE (420, 300)-(424, 416), _RGB32(64, 92, 212), BF
 LINE (420, 412)-(576, 416), _RGB32(64, 92, 212), BF
 'A Button
 LINE (576, 248)-(580, 312), _RGB32(80, 64, 180), BF
 LINE (436, 312)-(580, 316), _RGB32(80, 64, 180), BF
 LINE (436, 312)-(440, 368), _RGB32(80, 64, 180), BF
 LINE (436, 368)-(608, 372), _RGB32(80, 64, 180), BF
 'setup click layer  40,32 offset
 _DEST L&(3)
 LINE (200, 164)-STEP(35, 30), _RGB(1, 0, 0), BF 'up
 LINE (200, 230)-STEP(35, 30), _RGB(2, 0, 0), BF 'down
 LINE (168, 198)-STEP(35, 30), _RGB(3, 0, 0), BF 'left
 LINE (236, 198)-STEP(35, 30), _RGB(4, 0, 0), BF 'right
 
 LINE (318, 232)-STEP(45, 20), _RGB(5, 0, 0), BF 'Select
 LINE (388, 232)-STEP(45, 20), _RGB(6, 0, 0), BF 'Start
 
 LINE (478, 212)-STEP(58, 60), _RGB(7, 0, 0), BF 'Button A
 LINE (548, 212)-STEP(58, 60), _RGB(8, 0, 0), BF 'Button B
 
 _PRINTSTRING (96, 0), "Click on the controller button you wish to customize, Press the new key.", L&(2)
 _PRINTSTRING (144, 16), "Tab to switch Control type. When done click EXIT when done.", L&(2)
 _PRINTSTRING (96, 32), "With a JOYPAD: TYPE I-use axis for movement, TYPE II-use buttons to move.", L&(2)
 _DEST L&(0)
END SUB
 
SUB Custom_Controls
 OldD& = _DEST
 OldS& = _SOURCE
 DIM Clayer(4) AS LONG
 Clayer(0) = _DISPLAY
 Clayer(1) = _NEWIMAGE(800, 600, 32)
 Clayer(2) = _NEWIMAGE(800, 600, 32)
 Clayer(3) = _NEWIMAGE(800, 600, 32)
 ClearLayer Clayer(2)
 ClearLayerTrans Clayer(4)
 Build_Custom_Control_Screen Clayer()
 _FONT FFX(0), Clayer(1)
 _FONT FFX(0), Clayer(4)
 _DEST Clayer(1)
 _PRINTMODE _KEEPBACKGROUND , Clayer(1)
 _SOURCE Clayer(3)
 DO
 
  KBD& = _KEYHIT
  IF KBD& < 0 THEN KBD& = 0 'handle button up `-` codes
 
  IF (NOT G.ControlType) AND Master%% THEN
   Nul%% = _DEVICEINPUT(C.Control_Pad)
   IF NOT C.BAD_Pad THEN
    IF Master%% > 4 THEN
     FOR i%% = 1 TO _LASTBUTTON(C.Control_Pad)
      IF _BUTTON(i%%) THEN Bselect%% = i%%: i%% = _LASTBUTTON(C.Control_Pad) + 1
     NEXT i%%
    ELSE
     FOR i%% = 1 TO _LASTAXIS(C.Control_Pad)
      test%% = _AXIS(i%%)
      IF test%% THEN Aselect%% = i%%: i%% = _LASTAXIS(C.Control_Pad)
     NEXT i%%
    END IF
   ELSE
    FOR i%% = 1 TO _LASTBUTTON(C.Control_Pad)
     IF _BUTTON(i%%) THEN Bselect%% = i%%: i%% = _LASTBUTTON(C.Control_Pad) + 1
    NEXT i%%
   END IF
  END IF
 
  _PUTIMAGE , Clayer(2), Clayer(1)
  Nul%% = _MOUSEINPUT
  X% = _MOUSEX: Y% = _MOUSEY
  Selection%% = _RED32(POINT(X%, Y%)) 'is mouse over anything?
 
  IF Master%% THEN Selection%% = Master%% 'keep selection locked until key press
 
  IF _MOUSEBUTTON(1) THEN
   IF NOT Master%% THEN Master%% = Selection%% 'if no Master selection set then set it.
   IF ExitSet%% THEN ExitFlag%% = TRUE
   IF X% > 640 AND X% < 770 AND Y% > 440 AND Y% < 475 THEN C.BAD_Pad = NOT C.BAD_Pad 'toggle controller directional type
   DO: nul% = _MOUSEINPUT: LOOP WHILE _MOUSEBUTTON(1)
  END IF
 
  IF Master%% AND G.ControlType THEN 'once player clicks and controller is Keyboard
   IF KBD& <> ESC_Key THEN
    Set_KeyBoard_Control Master%%, KBD&
   END IF
  ELSEIF Master%% AND (NOT G.ControlType) THEN 'once player clicks and controller is Joy Pad
   SELECT CASE Master%%
    CASE 1 'Up arrow
     IF Aselect%% THEN
      C.Joy_Up = Aselect%%
      IF test%% < 0 THEN C.Joy_Up_Val = TRUE ELSE C.Joy_Up_Val = 1
      Master%% = FALSE 'unlock selection with button press
      Aselect%% = 0
     ELSEIF Bselect%% AND C.BAD_Pad THEN
      C.Joy_Button_Up = Bselect%%
      Master%% = FALSE 'unlock selection with button press
      Bselect%% = 0
     END IF
    CASE 2 'Down arrow
     IF Aselect%% THEN
      C.Joy_Down = Aselect%%
      IF test%% < 0 THEN C.Joy_Down_Val = TRUE ELSE C.Joy_Down_Val = 1
      Master%% = FALSE 'unlock selection with button press
      Aselect%% = 0
     ELSEIF Bselect%% AND C.BAD_Pad THEN
      C.Joy_Button_Down = Bselect%%
      Master%% = FALSE 'unlock selection with button press
      Bselect%% = 0
     END IF
    CASE 3 'left arrow
     IF Aselect%% THEN
      C.Joy_Left = Aselect%%
      IF test%% < 0 THEN C.Joy_Left_Val = TRUE ELSE C.Joy_Left_Val = 1
      Master%% = FALSE 'unlock selection with button press
      Aselect%% = 0
     ELSEIF Bselect%% AND C.BAD_Pad THEN
      C.Joy_Button_Left = Bselect%%
      Master%% = FALSE 'unlock selection with button press
      Bselect%% = 0
     END IF
    CASE 4 'right arrow
     IF Aselect%% THEN
      C.Joy_Right = Aselect%%
      IF test%% < 0 THEN C.Joy_Right_Val = TRUE ELSE C.Joy_Right_Val = 1
      Master%% = FALSE 'unlock selection with button press
      Aselect%% = 0
     ELSEIF Bselect%% AND C.BAD_Pad THEN
      C.Joy_Button_Right = Bselect%%
      Master%% = FALSE 'unlock selection with button press
      Bselect%% = 0
     END IF
    CASE 5 'select
     IF Bselect%% THEN C.Joy_Select = Bselect%%: Master%% = FALSE 'unlock selection with button press
     Bselect%% = 0
    CASE 6 'start
     IF Bselect%% THEN C.Joy_Start = Bselect%%: Master%% = FALSE 'unlock selection with button press
     Bselect%% = 0
    CASE 7 'b
     IF Bselect%% THEN C.Joy_B_Button = Bselect%%: Master%% = FALSE 'unlock selection with button press
     Bselect%% = 0
    CASE 8 'a
     IF Bselect%% THEN C.Joy_A_Button = Bselect%%: Master%% = FALSE 'unlock selection with button press
     Bselect%% = 0
   END SELECT
 
  END IF
 
  IF KBD& = 9 THEN G.ControlType = NOT G.ControlType ': LINE (128, 350)-STEP(496, 160), _RGB32(0), BF
  IF (NOT G.ControlType) AND C.Control_Pad = 0 THEN 'setup joy pad
   IF G.Device_Count <= 2 THEN 'is there a joy pad to use?
    _PUTIMAGE (188, 100)-STEP(384, 48), Layer(12), Clayer(0), (86, 240)-STEP(7, 7) 'black out name
    _PRINTSTRING (192, 108), " NO OTHER DEVICE FOUND", Clayer(0)
    _PRINTSTRING (288, 126), " PRESS TAB", Clayer(0)
    _KEYCLEAR
    DO: _LIMIT 30: LOOP UNTIL INKEY$ = CHR$(9)
    _KEYCLEAR
    G.ControlType = TRUE
   ELSE
    Select_Device
   END IF
  END IF
 
  'Screen Updating
  Display_Keys G.ControlType
  Highlite_Select Selection%%
  ExitSet%% = Display_Exit_Controls(X%, Y%)
  IF NOT G.ControlType THEN Display_BAD_Controller_Option
  '---------------------------------------------------------------------------------------------------------
  '  _PUTIMAGE , Clayer(4), Clayer(1)
  _PUTIMAGE , Clayer(1), Clayer(0)
  _LIMIT 30
  DO: LOOP WHILE _MOUSEINPUT
  IF (NOT G.ControlType) THEN DO: LOOP WHILE _DEVICEINPUT(C.Control_Pad)
 
 LOOP UNTIL ExitFlag%%
 
 _DEST OldD&
 _SOURCE OldS&
END SUB
 
SUB Select_Device
 'removing the first 2 devices, assuming keyboard=1 and mouse=2
 IF G.Device_Count > 3 THEN
  DO
   KBD$ = INKEY$
   _PUTIMAGE , Layer(16), Layer(1)
   '   Draw_Window 4, 7, 30, 1 + (G.Device_Count - 2) * 2, Layer(1)
   FOR i%% = 3 TO G.Device_Count
    temp$ = Device_Name$(i%%)
    _PRINTSTRING (16 * 12 - LEN(temp$) \ 2, 16 * (8 + (i%% - 3))), LTRIM$(STR$(i%%)) + "-" + temp$
   NEXT i%%
   _PRINTSTRING (16 * 6 + 8, 16 * (8 + (i%% - 3)) + 2), "Press Number of controller"
   _PUTIMAGE , Layer(1), Layer(0)
   _LIMIT 30
   IF VAL(KBD$) > 2 AND VAL(KBD$) <= G.Device_Count THEN C.Control_Pad = VAL(KBD$): ExitFlag%% = TRUE
   IF KBD$ = CHR$(27) THEN CLOSE: END
  LOOP UNTIL ExitFlag%%
 ELSE 'if there is only 1 control device to choose from auto assign
  C.Control_Pad = 3
 END IF
END SUB
 
 
SUB Display_Keys (ID%%)
 IF ID%% THEN
  _PRINTSTRING (312, 116), "Keyboard"
  _PRINTSTRING (144, 480), ControlName(C.KBCon_Up)
  _PRINTSTRING (176, 392), ControlName(C.KBCon_Down)
  _PRINTSTRING (160, 436), ControlName(C.KBCon_Left)
  _PRINTSTRING (192, 348), ControlName(C.KBCon_Right)
  _PRINTSTRING (468, 348), ControlName(C.KBCon_A_Button)
  _PRINTSTRING (450, 392), ControlName(C.KBCon_B_Button)
  _PRINTSTRING (376, 480), ControlName(C.KBCon_Select)
  _PRINTSTRING (444, 436), ControlName(C.KBCon_Start)
 ELSE
  _PRINTSTRING (312, 116), "JoyPad-" + LTRIM$(STR$(C.Control_Pad))
  IF NOT C.BAD_Pad THEN
   IF C.Joy_Up = -22 THEN
    _PRINTSTRING (144, 480), "UnDefined"
   ELSE
    IF C.Joy_Up_Val < 0 THEN a$ = " -" ELSE a$ = " +"
    _PRINTSTRING (144, 480), "Axis:" + STR$(C.Joy_Up) + a$
   END IF
   IF C.Joy_Down = -22 THEN
    _PRINTSTRING (176, 392), "UnDefined"
   ELSE
    IF C.Joy_Down_Val < 0 THEN a$ = " -" ELSE a$ = " +"
    _PRINTSTRING (176, 392), "Axis:" + STR$(C.Joy_Down) + a$
   END IF
   IF C.Joy_Left = -22 THEN
    _PRINTSTRING (160, 436), "UnDefined"
   ELSE
    IF C.Joy_Left_Val < 0 THEN a$ = " -" ELSE a$ = " +"
    _PRINTSTRING (160, 436), "Axis:" + STR$(C.Joy_Left) + a$
   END IF
   IF C.Joy_Right = -22 THEN
    _PRINTSTRING (192, 348), "UnDefined"
   ELSE
    IF C.Joy_Right_Val < 0 THEN a$ = " -" ELSE a$ = " +"
    _PRINTSTRING (192, 348), "Axis:" + STR$(C.Joy_Right) + a$
   END IF
  ELSE
   IF C.Joy_Button_Up = -22 THEN
    _PRINTSTRING (144, 480), "UnDefined"
   ELSE
    _PRINTSTRING (144, 480), "Button:" + STR$(C.Joy_Button_Up) + a$
   END IF
   IF C.Joy_Button_Down = -22 THEN
    _PRINTSTRING (176, 392), "UnDefined"
   ELSE
    _PRINTSTRING (176, 392), "Button:" + STR$(C.Joy_Button_Down) + a$
   END IF
   IF C.Joy_Button_Left = -22 THEN
    _PRINTSTRING (160, 436), "UnDefined"
   ELSE
    _PRINTSTRING (160, 436), "Button:" + STR$(C.Joy_Button_Left) + a$
   END IF
   IF C.Joy_Button_Right = -22 THEN
    _PRINTSTRING (192, 348), "UnDefined"
   ELSE
    _PRINTSTRING (192, 348), "Button:" + STR$(C.Joy_Button_Right) + a$
   END IF
  END IF
  IF C.Joy_Select = -22 THEN _PRINTSTRING (376, 480), "UnDefined" ELSE _PRINTSTRING (376, 480), "Button:" + STR$(C.Joy_Select)
  IF C.Joy_Start = -22 THEN _PRINTSTRING (444, 436), "UnDefined" ELSE _PRINTSTRING (444, 436), "Button:" + STR$(C.Joy_Start)
  IF C.Joy_A_Button = -22 THEN _PRINTSTRING (468, 348), "UnDefined" ELSE _PRINTSTRING (468, 348), "Button:" + STR$(C.Joy_A_Button)
  IF C.Joy_B_Button = -22 THEN _PRINTSTRING (450, 392), "UnDefined" ELSE _PRINTSTRING (450, 392), "Button:" + STR$(C.Joy_B_Button)
 END IF
END SUB
 
FUNCTION Display_Exit_Controls%% (X%, Y%)
 IF X% > 640 AND X% < 720 AND Y% > 390 AND Y% < 425 THEN
  LINE (640, 390)-STEP(80, 35), _RGB32(255, 32, 8), BF
  _PRINTSTRING (650, 400), "EXIT"
  Result%% = TRUE
 ELSE
  LINE (640, 390)-STEP(80, 35), _RGB32(160, 72, 16), BF
  _PRINTSTRING (650, 400), "EXIT"
  Result%% = FALSE
 END IF
 Display_Exit_Controls = Result%%
END FUNCTION
 
SUB Set_KeyBoard_Control (Master%%, KBD&)
 SELECT CASE Master%%
  CASE 1 'Up arrow
   IF KBD& THEN C.KBCon_Up = KBD&: Master%% = FALSE 'unlock selection with key press
  CASE 2 'down arrow
   IF KBD& THEN C.KBCon_Down = KBD&: Master%% = FALSE 'unlock selection with key press
  CASE 3 'left arrow
   IF KBD& THEN C.KBCon_Left = KBD&: Master%% = FALSE 'unlock selection with key press
  CASE 4 'right arrow
   IF KBD& THEN C.KBCon_Right = KBD&: Master%% = FALSE 'unlock selection with key press
  CASE 5 'select
   IF KBD& THEN C.KBCon_Select = KBD&: Master%% = FALSE 'unlock selection with key press
  CASE 6 'start
   IF KBD& THEN C.KBCon_Start = KBD&: Master%% = FALSE 'unlock selection with key press
  CASE 7 'b
   IF KBD& THEN C.KBCon_B_Button = KBD&: Master%% = FALSE 'unlock selection with key press
  CASE 8 'a
   IF KBD& THEN C.KBCon_A_Button = KBD&: Master%% = FALSE 'unlock selection with key press
 END SELECT
END SUB
 
SUB Highlite_Select (ID%%)
 STATIC Factor%%
 IF ID%% THEN Factor%% = Factor%% + 16 'mouse over highlight color shift
 IF Factor%% >= 120 THEN Factor%% = 0
 SELECT CASE ID%% 'highlight which control mouse is over.
  CASE 1 'up
   LINE (112, 500)-(292, 504), _RGB32(255 - Factor%%, 127 + Factor%%, 0 + Factor%%), BF
  CASE 2 'down
   LINE (144, 412)-(336, 416), _RGB32(0 + Factor%%, 127 - Factor%%, 255 - Factor%%), BF
  CASE 3 'left
   LINE (128, 456)-(320, 460), _RGB32(92 + Factor%%, 192 - Factor%%, 0 + Factor%%), BF
  CASE 4 'right
   LINE (160, 366)-(340, 370), _RGB32(0 + Factor%%, 64 + Factor%%, 160 - Factor%%), BF
  CASE 5 'select
   LINE (344, 500)-(496, 504), _RGB32(255 - Factor%%, 64 + Factor%%, 0 - Factor%%), BF
  CASE 6 'start
   LINE (408, 456)-(576, 460), _RGB32(212 - Factor%%, 0 + Factor%%, 16 + Factor%%), BF
  CASE 7 'B
   LINE (420, 412)-(576, 416), _RGB32(64 + Factor%%, 92 + Factor%%, 212 - Factor%%), BF
  CASE 8 'A
   LINE (436, 368)-(608, 372), _RGB32(80 + Factor%%, 64 + Factor%%, 180 - Factor%%), BF
 END SELECT
END SUB
 
SUB Get_JoyPads
 'load input device details Max:16
 G.Device_Count = _DEVICES
 IF G.Device_Count > 16 THEN G.Device_Count = 16 'limit total devices to 16
 FOR I%% = 1 TO G.Device_Count
  DeviceData(I%%).Buttons = _LASTBUTTON(I%%) ' number of buttons on the device
  DeviceData(I%%).Axis_p = _LASTAXIS(I%%) 'number of axis on the device
 NEXT I%%
 IF G.Device_Count < 3 THEN G.ControlType = TRUE 'no joypads detected
END SUB
 
SUB Display_BAD_Controller_Option
 IF C.BAD_Pad THEN
  LINE (640, 440)-STEP(130, 35), _RGB32(255, 16, 8), BF
  _PRINTSTRING (650, 450), "TYPE II"
  Result%% = TRUE
 ELSE
  LINE (640, 440)-STEP(130, 35), _RGB32(16, 72, 240), BF
  _PRINTSTRING (660, 450), "TYPE I"
  Result%% = FALSE
 END IF
END SUB
 
FUNCTION ControlName$ (id&)
 Result$ = "#ERROR#"
 FOR i~%% = 0 TO 133
  IF KeyCodes(i~%%).Value = id& THEN Result$ = KeyCodes(i~%%).Nam: i~%% = 135
 NEXT i~%%
 IF i~%% = 134 THEN Result$ = "Unknown#"
 ControlName = Result$
END FUNCTION
 
FUNCTION AxisPower%% (CJR%%, CJL%%, CJU%%, CJD%%)
 CJR%% = _AXIS(C.Joy_Right)
 CJL%% = _AXIS(C.Joy_Left)
 CJU%% = _AXIS(C.Joy_Up)
 CJD%% = _AXIS(C.Joy_Down)
 IF CJR%% = C.Joy_Right_Val THEN CJL%% = 0: CJR%% = TRUE ELSE CJR%% = 0
 IF CJD%% = C.Joy_Down_Val THEN CJU%% = 0: CJD%% = TRUE ELSE CJD%% = 0
 AxisPower = nul%%
END FUNCTION
 
SUB Save_Config
 IF _FILEEXISTS("DW1CS.CFG") THEN KILL "DW1CS.CFG"
 CF = FREEFILE
 OPEN "DW1CS.CFG" FOR BINARY AS #CF
 Ver~& = CurrentVer
 PUT #CF, , Ver~&
 PUT #CF, , C
 PUT #CF, , G.ControlType
 ' PUT #CF, , G.TextClick
 PUT #CF, , G.BGM_vol
 PUT #CF, , G.SFX_Vol
 ' PUT #CF, , G.SkipIntro
 CLOSE #CF
END SUB
 
SUB MFI_Loader (FN$)
 DIM Size(128) AS LONG, FOffset(128) AS LONG
 OPEN FN$ FOR BINARY AS #1
 GET #1, , c~%% 'retrieve number of files
 FOR I~%% = 1 TO c~%%
  GET #1, , FOffset(I~%%)
  GET #1, , Size(I~%%)
  FOffset&(I~%%) = FOffset&(I~%%) + 1
 NEXT I~%%
 Layer(7) = LoadGFX(FOffset(1), Size(1)) '_LOADIMAGE("overworldtiles.bmp", 32)
 Layer(9) = LoadGFX(FOffset(2), Size(2)) '_LOADIMAGE("TitleScreen.bmp", 32)
 Layer(10) = LoadGFX(FOffset(3), Size(3)) '_LOADIMAGE("Titlefalls.bmp", 32)
 Layer(11) = LoadGFX(FOffset(4), Size(4)) '_LOADIMAGE("Titlescroll.bmp", 32)
 Layer(12) = LoadGFX(FOffset(5), Size(5)) '_LOADIMAGE("selectionscreen.bmp", 32)
 Layer(18) = LoadGFX(FOffset(13), Size(13)) '_LOADIMAGE("gfx\png\controller.png", 32)
 Layer(17) = LoadGFX(FOffset(14), Size(14)) '_LOADIMAGE("gfx\png\21189.png", 32)
 
 SFX(0) = LoadSFX(FOffset(6), Size(6))
 SFX(1) = LoadSFX(FOffset(7), Size(7))
 SFX(2) = LoadSFX(FOffset(8), Size(8))
 SFX(3) = LoadSFX(FOffset(9), Size(9))
 BGM(0) = LoadSFX(FOffset(10), Size(10))
 FFX(0) = LoadFFX(FOffset(11), Size(11), 16)
 LoadData FOffset(12), Size(12)
 
 CLOSE #1
 IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
END SUB
 
FUNCTION LoadGFX& (Foff&, Size&)
 IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
 OPEN "temp.dat" FOR BINARY AS #3
 dat$ = SPACE$(Size&)
 GET #1, Foff&, dat$
 PUT #3, , dat$
 CLOSE #3
 LoadGFX& = _LOADIMAGE("temp.dat", 32)
END FUNCTION
 
FUNCTION LoadFFX& (Foff&, Size&, Fize%%)
 IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
 OPEN "temp.dat" FOR BINARY AS #3
 dat$ = SPACE$(Size&)
 GET #1, Foff&, dat$
 PUT #3, , dat$
 CLOSE #3
 LoadFFX& = _LOADFONT("temp.dat", Fize%%, "monospace")
END FUNCTION
 
FUNCTION LoadSFX& (Foff&, Size&)
 IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
 OPEN "temp.dat" FOR BINARY AS #3
 dat$ = SPACE$(Size&)
 GET #1, Foff&, dat$
 PUT #3, , dat$
 CLOSE #3
 LoadSFX& = _SNDOPEN("temp.dat")
END FUNCTION
 
SUB LoadData (Foff&, Size&)
 IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
 OPEN "temp.dat" FOR BINARY AS #3
 dat$ = SPACE$(Size&)
 GET #1, Foff&, dat$
 PUT #3, , dat$
 CLOSE #3
 
 F1 = FREEFILE
 OPEN "temp.dat" FOR BINARY AS #F1
 GET #F1, , Hyrule()
 GET #F1, , Link
 GET #F1, , C
 GET #F1, , G
 GET #F1, , Offset_X()
 GET #F1, , Offset_Y()
 FOR I%% = 1 TO 44
  GET #F1, , Letter(I%%)
 NEXT I%%
 GET #F1, , KeyCodes()
 GET #F1, , Cave()
 GET #F1, , Item()
 GET #F1, , Shop()
 CLOSE #F1
END SUB
 
SUB Select_Screen
 ClearLayer Layer(16)
 IF _FILEEXISTS("Zelda.MSF") THEN 'load saved data
  OPEN "Zelda.MSF" FOR BINARY AS #1
  FOR I%% = 1 TO 3 'load all 3 records
   GET #1, , Nick(I%%)
   GET #1, , Records(I%%)
   IF Selection%% = 0 THEN IF RTRIM$(Nick(I%%)) <> "" THEN Selection%% = I%%
  NEXT I%%
  CLOSE #1
 ELSE 'file doesn't exist so make it.
  Reset_Record 1
  Reset_Record 2
  Reset_Record 3
  Save_Records
 END IF
 _PUTIMAGE (140, 72)-STEP(511, 447), Layer(12), Layer(16), (1, 1)-STEP(255, 223) 'background
 FOR I%% = 1 TO 3
  IF RTRIM$(Nick(I%%)) <> "" THEN Place_Player_Record I%% - 1, 0
 NEXT I%%
 IF Record_Count%% = 0 THEN Selection%% = 4 ELSE Selection%% = 1
 Selection%% = Find_First_Available(0, 1)
 
 DO
  _PUTIMAGE , Layer(16), Layer(1)
  SELECT CASE Get_Input%%
   CASE START_BUTTON
    SELECT CASE Selection%%
     CASE 1 TO 3
      Link = Records(Selection%%)
      Exitflag%% = TRUE
     CASE 4
      DO: LOOP UNTIL Get_Input%% = -1
      nul%% = Register(nul%%)
      OPEN "Zelda.MSF" FOR BINARY AS #1 'update records
      FOR I%% = 1 TO 3
       PUT #1, , Nick(I%%)
       PUT #1, , Link
       IF RTRIM$(Nick(I%%)) <> "" THEN Place_Player_Record I%% - 1, 0
      NEXT I%%
      CLOSE #1
     CASE 5
      DO: LOOP UNTIL Get_Input%% = -1
      Elimination_Mode
      nul%% = Register(nul%%) 'go straight to register mode after elimination
     CASE 6 'options screen
      DO: LOOP UNTIL Get_Input%% = -1
      Options
    END SELECT
   CASE SELECT_BUTTON
    Selection%% = Selection%% + 1
    IF Selection%% = 7 THEN Selection%% = 1
    Selection%% = Find_First_Available(0, Selection%%)
    DO: LOOP UNTIL Get_Input%% = -1
   CASE ELSE
    _PRINTSTRING (0, 20), STR$(SELECT_BUTTON), Layer(1)
  END SELECT
 
  SELECT CASE Selection%%
   CASE 1
    _PUTIMAGE (220, 242)-STEP(15, 15), Layer(12), Layer(1), (73, 247)-STEP(7, 7) 'Player 1
   CASE 2
    _PUTIMAGE (220, 290)-STEP(15, 15), Layer(12), Layer(1), (73, 247)-STEP(7, 7) 'Player 2
   CASE 3
    _PUTIMAGE (220, 338)-STEP(15, 15), Layer(12), Layer(1), (73, 247)-STEP(7, 7) 'Player 3
   CASE 4
    _PUTIMAGE (220, 394)-STEP(15, 15), Layer(12), Layer(1), (73, 247)-STEP(7, 7) 'register
   CASE 5
    _PUTIMAGE (220, 426)-STEP(15, 15), Layer(12), Layer(1), (73, 247)-STEP(7, 7) 'Elimination
   CASE 6
    _PUTIMAGE (220, 458)-STEP(15, 15), Layer(12), Layer(1), (73, 247)-STEP(7, 7) 'Options
  END SELECT
  _PRINTSTRING (0, 0), STR$(Selection%%), Layer(1)
  _PUTIMAGE , Layer(1), Layer(0)
  _LIMIT 60
  IF INKEY$ = CHR$(27) THEN Exitflag%% = TRUE
 LOOP UNTIL Exitflag%%
END SUB
 
FUNCTION Register%% (Records%%)
 DIM Names(2, 8) AS STRING * 1
 Result%% = Records%%
 Tmp& = _COPYIMAGE(Layer(16))
 ClearLayer Layer(16)
 ClearLayer Layer(1)
 _PUTIMAGE (140, 72)-STEP(511, 447), Layer(12), Layer(16), (258, 1)-STEP(255, 223) 'background
 FOR i%% = 1 TO 3
  IF RTRIM$(Nick(i%%)) <> "" THEN Place_Player_Record i%% - 1, 1
 NEXT i%%
 IF i%% > 0 THEN Selection%% = i%% ELSE Selection%% = 1
 FOR i%% = 1 TO 3
  IF RTRIM$(Nick(i%%)) = "" THEN _PUTIMAGE (300, 154 + 48 * (i%% - 1))-STEP(31, 31), Layer(12), Layer(16), (1, 230)-STEP(15, 15) 'Player 1 Link (green)
 NEXT i%%
 _CLEARCOLOR _RGB32(0), Layer(16)
 _PUTIMAGE , Layer(16), Layer(1)
 _DEST Layer(1)
 _PRINTMODE _KEEPBACKGROUND , Layer(1)
 Current_Letter%% = 1
 Selection%% = Find_First_Available(1, 1)
 DO
 
  SELECT CASE Get_Input%%
   CASE Up
    _PUTIMAGE (236 + 32 * Lx%, 328 + 32 * Ly%)-STEP(15, 15), Layer(12), Layer(1), (86, 240)-STEP(7, 7) 'Current selected Letter
    Ly% = Ly% - 1
    IF Ly% = -1 THEN Ly% = 3
    Current_Letter%% = Current_Letter%% - 11
    IF Current_Letter%% < 0 THEN Current_Letter%% = 44 - ABS(Current_Letter%%)
   CASE Down
    _PUTIMAGE (236 + 32 * Lx%, 328 + 32 * Ly%)-STEP(15, 15), Layer(12), Layer(1), (86, 240)-STEP(7, 7) 'Current selected Letter
    Ly% = Ly% + 1
    IF Ly% = 4 THEN Ly% = 0
    Current_Letter%% = Current_Letter%% + 11
    IF Current_Letter%% > 44 THEN Current_Letter%% = Current_Letter%% - 44
   CASE Left
    _PUTIMAGE (236 + 32 * Lx%, 328 + 32 * Ly%)-STEP(15, 15), Layer(12), Layer(1), (86, 240)-STEP(7, 7) 'Current selected Letter
    Lx% = Lx% - 1
    IF Lx% = -1 THEN Lx% = 10: Ly% = Ly% - 1: IF Ly% = -1 THEN Ly% = 3
    Current_Letter%% = Current_Letter%% - 1
    IF Current_Letter%% = 0 THEN Current_Letter%% = 44
   CASE Right
    _PUTIMAGE (236 + 32 * Lx%, 328 + 32 * Ly%)-STEP(15, 15), Layer(12), Layer(1), (86, 240)-STEP(7, 7) 'Current selected Letter
    Lx% = Lx% + 1
    IF Lx% = 11 THEN Lx% = 0: Ly% = Ly% + 1: IF Ly% = 4 THEN Ly% = 0
    Current_Letter%% = Current_Letter%% + 1
    IF Current_Letter%% = 45 THEN Current_Letter%% = 1
   CASE BUTTON_A OR BUTTON_B
    IF Selection%% <> 4 THEN 'only allow buttons if valid name entry selection
     _PUTIMAGE (364 + 16 * Length%%, 152 + 48 * (Selection%% - 1))-STEP(15, 15), Layer(12), Layer(1), (86, 240)-STEP(7, 7) 'Current Nick Letter
     Names(Selection%% - 1, Length%%) = Letter(Current_Letter%%)
     Length%% = Length%% + 1
     IF Length%% = 8 THEN Length%% = 0
    END IF
   CASE START_BUTTON
    SELECT CASE Selection%%
     CASE 4 'end
      FOR j%% = 0 TO 2
       a$ = ""
       IF RTRIM$(Nick(j%% + 1)) = "" THEN
        FOR i%% = 0 TO 7
         IF ASC(Names(j%%, i%%)) > 31 THEN a$ = a$ + Names(j%%, i%%)
        NEXT
        Nick(j%% + 1) = a$
       END IF
      NEXT
      ExitFlag%% = TRUE
    END SELECT
   CASE SELECT_BUTTON 'Change to different name or end registration
    _PUTIMAGE (364 + 16 * Length%%, 152 + 48 * (Selection%% - 1))-STEP(15, 15), Layer(12), Layer(1), (86, 240)-STEP(7, 7) 'Current Nick Letter
    _PUTIMAGE (274, 152 + 48 * (Selection%% - 1))-STEP(15, 15), Layer(12), Layer(1), (86, 240)-STEP(7, 7) 'heart selection
    Selection%% = Selection%% + 1: Length%% = 0 'reset the name position when changing.
    IF Selection%% = 5 THEN Selection%% = 1
    _PRINTSTRING (0, 0), STR$(Selection%%), Layer(1)
    Selection%% = Find_First_Available(1, Selection%%)
   CASE ELSE
    LINE (0, 0)-STEP(160, 40), _RGB32(0), BF
    _PRINTSTRING (0, 20), STR$(Selection%%), Layer(1)
  END SELECT
  DO: LOOP UNTIL Get_Input%% = -1
 
  _PUTIMAGE (274, 152 + 48 * (Selection%% - 1))-STEP(15, 15), Layer(12), Layer(1), (73, 247)-STEP(7, 7) 'heart selection
  IF Selection%% <> 4 THEN
   FOR j%% = 0 TO 8
    IF Names(Selection%% - 1, j%%) > CHR$(31) THEN _PRINTSTRING (364 + 16 * j%%, 152 + 48 * (Selection%% - 1)), Names(Selection%% - 1, j%%), Layer(1)
   NEXT j%%
  END IF
  _PUTIMAGE , Layer(1), Layer(0)
  IF blink%% AND Selection%% <> 4 THEN
   _PUTIMAGE (364 + 16 * Length%%, 152 + 48 * (Selection%% - 1))-STEP(15, 15), Layer(12), Layer(1), (61, 230)-STEP(7, 7) 'Current Nick Letter
   _PUTIMAGE (236 + 32 * Lx%, 328 + 32 * Ly%)-STEP(15, 15), Layer(12), Layer(1), (61, 230)-STEP(7, 7) 'Current selected Letter
  ELSE
   _PUTIMAGE (364 + 16 * Length%%, 152 + 48 * (Selection%% - 1))-STEP(15, 15), Layer(12), Layer(1), (86, 240)-STEP(7, 7) 'Current Nick Letter
   _PUTIMAGE (236 + 32 * Lx%, 328 + 32 * Ly%)-STEP(15, 15), Layer(12), Layer(1), (86, 240)-STEP(7, 7) 'Current selected Letter
  END IF
  _PUTIMAGE , Layer(16), Layer(1)
  b%% = b%% + 1
  IF b%% = 8 THEN blink%% = NOT blink%%: b%% = 0
  _LIMIT 60
  IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
 LOOP UNTIL ExitFlag%%
 ClearLayer Layer(16)
 _PUTIMAGE , Tmp&, Layer(16)
 _FREEIMAGE Tmp&
 Save_Records
 FOR i%% = 1 TO 3
  IF RTRIM$(Nick(i%%)) <> "" THEN Place_Player_Record i%% - 1, 0
 NEXT i%%
 Register = Result%%
END FUNCTION
 
SUB Elimination_Mode
 Tmp& = _COPYIMAGE(Layer(16))
 ClearLayer Layer(16)
 ClearLayer Layer(1)
 _PUTIMAGE (140, 72)-STEP(511, 447), Layer(12), Layer(16), (515, 1)-STEP(255, 223) 'background
 FOR i%% = 1 TO 3
  IF RTRIM$(Nick(i%%)) <> "" THEN Place_Player_Record i%% - 1, 1
 NEXT i%%
 _PUTIMAGE , Layer(16), Layer(0)
 IF i%% > 0 THEN Selection%% = i%% ELSE Selection%% = 1
 FOR i%% = 1 TO 3 'remove the erased game from the background screens
  IF RTRIM$(Nick(i%%)) = "" THEN _PUTIMAGE (300, 154 + 48 * (i%% - 1))-STEP(31, 31), Layer(12), Layer(16), (1, 230)-STEP(15, 15) 'Player 1 Link (green)
 NEXT i%%
 _CLEARCOLOR _RGB32(0), Layer(16)
 _PUTIMAGE , Layer(16), Layer(1)
 _DEST Layer(1)
 _PRINTMODE _KEEPBACKGROUND , Layer(1)
 Current_Letter%% = 1
 Selection%% = 1
 DO
  _PUTIMAGE , Layer(16), Layer(1)
  SELECT CASE Get_Input%%
   CASE START_BUTTON
    SELECT CASE Selection%%
     CASE 1 TO 3
      Nick(Selection%%) = ""
      Reset_Record Selection%%
      _PUTIMAGE (364, 152 + 48 * (Selection%% - 1))-STEP(159, 31), Layer(12), Layer(16), (86, 240)-STEP(7, 7) 'black out
      _PUTIMAGE (236, 232 + 48 * (Selection%% - 1))-STEP(159, 33), Layer(12), Tmp&, (86, 240)-STEP(7, 7) 'black out name
      _PUTIMAGE (428, 232 + 48 * (Selection%% - 1))-STEP(127, 31), Layer(12), Tmp&, (86, 240)-STEP(7, 7) 'black out hearts
     CASE 4
      ExitFlag%% = TRUE
    END SELECT
   CASE SELECT_BUTTON
    _PUTIMAGE (274, 152 + 48 * (Selection%% - 1))-STEP(15, 15), Layer(12), Layer(1), (86, 240)-STEP(7, 7) 'heart selection black out
    Selection%% = Selection%% + 1
    IF Selection%% = 5 THEN Selection%% = 1
   CASE ELSE
    _PRINTSTRING (0, 20), STR$(SELECT_BUTTON), Layer(1)
  END SELECT
  DO: LOOP UNTIL Get_Input%% = -1
  _PUTIMAGE (274, 152 + 48 * (Selection%% - 1))-STEP(15, 15), Layer(12), Layer(1), (73, 267)-STEP(7, 7) 'heart selection
  _PUTIMAGE , Layer(1), Layer(0)
  _LIMIT 60
  IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
 LOOP UNTIL ExitFlag%%
 ClearLayer Layer(16)
 _PUTIMAGE , Tmp&, Layer(16)
 _FREEIMAGE Tmp&
END SUB
 
SUB Reset_Record (Which%%)
 Records(Which%%) = Reset_Link
END SUB
 
SUB Save_Records
 OPEN "Zelda.MSF" FOR BINARY AS #1
 FOR I%% = 1 TO 3
  PUT #1, , Nick(I%%)
  PUT #1, , Records(I%%)
 NEXT I%%
 CLOSE #1
END SUB
 
SUB Options
 STATIC BGMV AS SINGLE, SFXV AS SINGLE, MSTR AS SINGLE
 Selection%% = 1
 MSTR = G.MSTR_Vol / 100
 BGMV = G.BGM_vol / 100
 SFXV = G.SFX_Vol / 100
 
 Tmp& = _COPYIMAGE(Layer(16))
 ClearLayer Layer(16)
 ClearLayer Layer(1)
 _PUTIMAGE (140, 72)-STEP(511, 447), Layer(12), Layer(16), (772, 1)-STEP(255, 223) 'background
 _PRINTSTRING (128, 144), "Master Volume:", Layer(16)
 _PRINTSTRING (128, 176), "Music  Volume:", Layer(16)
 _PRINTSTRING (128, 208), "Sounds Volume:", Layer(16)
 _PRINTSTRING (128, 256), "Scale Factor :", Layer(16)
 _PRINTSTRING (128, 352), "Controler Setup", Layer(16)
 _PRINTSTRING (128, 384), "OPTIONS EXIT", Layer(16)
 _DEST Layer(1)
 DO
  _PUTIMAGE , Layer(16), Layer(1)
 
  SELECT CASE Get_Input%%
   CASE START_BUTTON
    SELECT CASE Selection%%
     CASE 1
      DO: LOOP UNTIL Get_Input%% = -1
      Custom_Controls
     CASE 2
      ExitFlag%% = TRUE
    END SELECT
   CASE SELECT_BUTTON
    _PUTIMAGE (112, 352 + 32 * (Selection%% - 1))-STEP(15, 15), Layer(12), Layer(1), (86, 240)-STEP(7, 7) 'heart selection black out
    Selection%% = Selection%% + 1
    IF Selection%% = 3 THEN Selection%% = 1
   CASE ELSE
  END SELECT
  DO: LOOP UNTIL Get_Input%% = -1
 
  IF _MOUSEBUTTON(1) THEN
   IF Locked%% = 0 THEN 'player just clicked mouse
    X% = _MOUSEX: y% = _MOUSEY
    IF X% > 359 AND X% < 617 THEN 'mouse is in the volume slider area
     IF y% > 143 AND y% < 160 THEN Locked%% = 1 'master volume slider selected
     IF y% > 175 AND y% < 192 THEN Locked%% = 2 'Music volume slider selected
     IF y% > 207 AND y% < 224 THEN Locked%% = 3 'Sounds volume slider selected
     IF y% > 255 AND y% < 272 THEN Locked%% = 4 'Scale slider selected
    END IF
   ELSE 'player has a selected volume slider
    X% = _MOUSEX
    IF X% > 359 AND X% < 617 THEN 'mouse is in the volume slider area
     NewVol! = (X% - 359) / 256
     SELECT CASE Locked%%
      CASE 1 'set new master volume
       MSTR = NewVol!
      CASE 2 'set new Music volume
       BGMV = NewVol!
      CASE 3 'set new sounds volume
       SFXV = NewVol!
      CASE 4 'set new scale
       SELECT CASE NewVol!
        CASE 0 TO .33 '1x scale
         G.Scale_Factor = 1
        CASE .34 TO .66 '2x scale
         G.Scale_Factor = 2
        CASE .67 TO 1 '3x scale
         G.Scale_Factor = 3
       END SELECT
     END SELECT
    END IF
   END IF
  ELSEIF Locked%% THEN 'player released the mouse button
   Locked%% = FALSE
  END IF
  Update_Volume_Bars MSTR, BGMV, SFXV
  _PUTIMAGE (112, 352 + 32 * (Selection%% - 1))-STEP(15, 15), Layer(12), Layer(1), (73, 247)-STEP(7, 7) 'heart selection
  _PUTIMAGE , Layer(1), Layer(0)
  _LIMIT 60
  IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE
  DO: LOOP WHILE _MOUSEINPUT
 LOOP UNTIL ExitFlag%%
 '------Make the changes final-----
 G.MSTR_Vol = INT(MSTR * 100)
 G.BGM_vol = INT(BGMV * MSTR * 100)
 G.SFX_Vol = INT(SFXV * MSTR * 100)
 G.Scale_X = 16 * G.Scale_Factor - 1
 G.Scale_Y = 16 * G.Scale_Factor - 1
 Link.Screen_X = Offset_X(G.Scale_Factor) + (16 * G.Scale_Factor * 7) + 8 * G.Scale_Factor '392
 Link.Screen_Y = Offset_Y(G.Scale_Factor) + (16 * G.Scale_Factor * 5) '292
 '---------------------------------
 ClearLayer Layer(16)
 _PUTIMAGE , Tmp&, Layer(16)
 _FREEIMAGE Tmp&
END SUB
 
SUB Update_Volume_Bars (M!, B!, S!)
 LINE (360, 144)-STEP(16 * 16, 16), _RGB32(0 + INT(255 * M!), 255 - INT(255 * M!), 0), BF
 LINE (360, 176)-STEP(16 * 16, 16), _RGB32(0 + INT(255 * (B! * M!)), 255 - INT(255 * (B! * M!)), 0), BF
 LINE (360, 208)-STEP(16 * 16, 16), _RGB32(0 + INT(255 * (S! * M!)), 255 - INT(255 * (S! * M!)), 0), BF
 LINE (360, 256)-STEP(16 * 16, 16), _RGB32(0 + 128 * (G.Scale_Factor - 1), 255 - 128 * (G.Scale_Factor - 1), 0), BF
 LINE (360 + (256 * M!), 144)-STEP(1, 20), _RGB32(224, 224, 224), B
 LINE (360 + (256 * B!), 176)-STEP(1, 20), _RGB32(224, 224, 224), B
 LINE (360 + (256 * S!), 208)-STEP(1, 20), _RGB32(224, 224, 224), B
 LINE (360 + 128 * (G.Scale_Factor - 1), 256)-STEP(1, 20), _RGB32(224, 224, 224), B
 _PRINTSTRING (640, 144), LTRIM$(STR$(INT(M! * 100))) + "%"
 _PRINTSTRING (640, 176), LTRIM$(STR$(INT((B! * M!) * 100))) + "%"
 _PRINTSTRING (640, 208), LTRIM$(STR$(INT((S! * M!) * 100))) + "%"
 _PRINTSTRING (640, 256), LTRIM$(STR$(G.Scale_Factor)) + "x"
 a$ = LTRIM$(STR$(256 * G.Scale_Factor)) + "x" + LTRIM$(STR$(224 * G.Scale_Factor))
 _PRINTSTRING (440, 276), a$
END SUB
 

madscijr · « **Reply #2 on:** January 06, 2022, 10:39:03 pm »

Slight update, where I fixed the keyboard input and the joysticks now all have continuous movement.
Now the only problem is STOPPING the continuous movement when you want it stopped.
Particularly, if you hold down the fire button, it shouldn't work again until you release it first.
I have variables to compare, and the button should only register if previous value was FALSE (not pressed):

Code: QB64: [Select]

if m_arrPlayer(iPlayer).lastButton1 <> TRUE then

but for some reason, no workie!

Apart from that, it's all working now. Here is the latest:

Code: QB64: [Select]

' ################################################################################################################################################################
' #TOP
 
' Game Input Mapping Test
' Version 0.90 by madscijr
 
' BASED ON CODE BY SMcNeill FROM:
'     Simple Joystick Detection and Interaction  (Read 316 times)
'     https://www.qb64.org/forum/index.php?topic=2160.msg129051#msg129051
'     https://qb64forum.alephc.xyz/index.php?topic=2160.msg129083#msg129083
' and others (sources cited throughout).
 
' ################################################################################################################################################################
' #CONSTANTS = GLOBAL CONSTANTS
 
' boolean constants:
Const FALSE = 0
Const TRUE = Not FALSE
 
' BEGIN GAME CONTROLLER MAPPING CONSTANTS
Const cInputNone = 0
Const cInputKey = 1
Const cInputButton = 2
Const cInputAxis = 3
 
Const cMaxButtons = 12
Const cMaxAxis = 8
Const cMaxControllers = 8
Const cMaxPlayers = 8
 
' Use as index for array of ControlInputType
Const cInputUp = 1
Const cInputDown = 2
Const cInputLeft = 3
Const cInputRight = 4
Const cInputButton1 = 5
Const cInputButton2 = 6
Const cInputButton3 = 7
Const cInputButton4 = 8
 
Const c_iKeyDown_F10 = 17408
Const c_iKeyHit_AltLeft = -30764
Const c_iKeyHit_AltRight = -30765
' END GAME CONTROLLER MAPPING CONSTANTS
 
' ################################################################################################################################################################
' #UDT #TYPES = USER DEFINED TYPES
 
' UDT TO HOLD THE INFO FOR A PLAYER
Type PlayerType
    x As Integer ' player x position
    y As Integer ' player y position
    c As Integer ' character to display on screen
    xOld As Integer
    yOld As Integer
 
    ' control buffer + previous move
    moveX As Integer
    lastMoveX As Integer
    moveY As Integer
    lastMoveY As Integer
    button1 As Integer
    lastButton1 As Integer
    button2 As Integer
    lastButton2 As Integer
    button3 As Integer
    lastButton3 As Integer
    button4 As Integer
    lastButton4 As Integer
End Type ' PlayerType
 
' UDT TO HOLD THE INFO FOR A GAME CONTROLLER
Type ControllerType
    buttonCount As Integer
    axisCount As Integer
End Type ' ControllerType
 
' UDT TO HOLD THE INFO FOR A GAME CONTROLLER
Type ControlInputType
    device As Integer
    typ As Integer ' cInputKey, cInputButton, cInputAxis
    code As Integer
    value As Integer
End Type ' ControlInputType
 
' ################################################################################################################################################################
' #VARS = GLOBAL VARIABLES
 
' ENABLE / DISABLE DEBUG CONSOLE
Dim Shared m_bTesting As Integer: m_bTesting = TRUE
 
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
 
' GAME CONTROLLER MAPPING
Dim Shared m_ControlMapFileName$: m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
ReDim Shared m_arrControlMap(1 To 8, 1 To 8) As ControlInputType ' holds control mapping for each player (player #, direction)
ReDim Shared m_arrController(1 To 8) As ControllerType ' holds info for each game controller
ReDim Shared m_arrButtonCode(1 To 99) As Integer ' Long
ReDim Shared m_arrButtonKey(1 To 99) As String
ReDim Shared m_arrButtonKeyDesc(0 To 512) As String
 
' VARIABLES FOR GRAPHIC PRINTING ROUTINES
Dim Shared m_NumColumns As Integer: m_NumColumns = 1
Dim Shared m_PrintRow As Integer: m_PrintRow = 0
Dim Shared m_PrintCol As Integer: m_PrintCol = 0
Dim Shared m_StartRow As Integer: m_StartRow = 0
Dim Shared m_EndRow As Integer: m_EndRow = 0
Dim Shared m_StartCol As Integer: m_StartCol = 0
Dim Shared m_EndCol As Integer: m_EndCol = 0
 
' DEMO GAME / TESTING
ReDim Shared m_arrPlayer(1 To 8) As PlayerType ' holds info for each player
 
' =============================================================================
' LOCAL VARIABLES
Dim in$
 
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
If m_bTesting = TRUE Then
    $Console
    _Delay 4
    _Console On
    _Echo "Started " + m_ProgramName$
    _Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
 
' =============================================================================
' START THE MAIN ROUTINE
main
 
' =============================================================================
' FINISH
Screen 0
Print m_ProgramName$ + " finished."
Input "Press <ENTER> to continue", in$
 
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bTesting = TRUE Then
    _Console Off
End If
' ****************************************************************************************************************************************************************
 
System ' return control to the operating system
End
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub main
    Dim RoutineName As String: RoutineName = "main"
    Dim in$
    Dim result$: result$ = ""
 
    ' SET UP SCREEN
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
 
    Do
        If Len(result$) = 0 Then
            Cls
        Else
            Print
        End If
 
        Print m_ProgramName$
        Print
        Print "Game Input Mapping Test"
        Print "v0.90, by Softintheheadware (Jan, 2022)"
        Print
 
        Print "1. Basic controller test"
        Print "2. Load controller mapping"
        Print "3. View controller mapping"
        Print "4. Edit  controller mapping for 1 or more players"
        Print "   Note: not tested yet"
        Print "5. Reset controller mapping for 1 or more players"
        Print "6. Map controllers for 1 or more players"
        Print "7. Test controller mappings to move around screen"
        Print "   Issue #1: Keyboard input not working yet"
        Print "   Issue #2: Digital joysticks don't allow continuous movement"
        Print "   Issue #3: Need analog joystick sensitivity adjustment option"
        Print "8. Save controller mappings"
        Print
        Print "What to do? ('q' to exit)"
 
        Input in$: in$ = LCase$(Left$(in$, 1))
 
        If in$ = "1" Then
            result$ = TestJoysticks$
        ElseIf in$ = "2" Then
            result$ = LoadMappings$
            If Len(result$) = 0 Then result$ = "Loaded mappings."
        ElseIf in$ = "3" Then
            result$ = ViewMappings$
        ElseIf in$ = "4" Then
            result$ = EditMappings$
        ElseIf in$ = "5" Then
            result$ = ResetMapping$
        ElseIf in$ = "6" Then
            result$ = MapInput$
        ElseIf in$ = "7" Then
            result$ = TestMappings$
        ElseIf in$ = "8" Then
            result$ = SaveMappings$
        End If
 
        If Len(result$) > 0 Then
            Print result$
        End If
 
    Loop Until in$ = "q"
 
    ' RETURN TO TEXT SCREEN
    Screen 0
 
End Sub ' main
 
' /////////////////////////////////////////////////////////////////////////////
' TODO: get keyboard input working
' TODO: get continuous movement working for digital joysticks
' TODO: adjust analog joystick sensitivity
 
Function TestMappings$
    Dim iDeviceCount As Integer
    Dim iDevice As Integer
    Dim iNumControllers As Integer
    Dim iController As Integer
    Dim iValue As Integer
    Dim iWhichInput As Integer
 
    Dim arrButton(32, 16) As Integer ' number of buttons on the joystick
    Dim arrButtonNew(32, 16) As Integer ' tracks when to initialize values
    Dim arrAxis(32, 16) As Double ' number of axis on the joystick
    Dim arrAxisNew(32, 16) As Integer ' tracks when to initialize values
 
    Dim iCols As Integer
    Dim iRows As Integer
 
    Dim iPlayer As Integer
    Dim iNextY As Integer
    Dim iNextX As Integer
    Dim iNextC As Integer
 
    Dim iMinX As Integer
    Dim iMaxX As Integer
    Dim iMinY As Integer
    Dim iMaxY As Integer
 
    Dim sError As String: sError = ""
    Dim bHaveInput As Integer
    Dim bFinished As Integer
    Dim bFoundWho As Integer
 
    Dim in$
 
    ' INITIALIZE
    Cls
    iCols = _Width(0) \ _FontWidth
    iRows = _Height(0) \ _FontHeight
    iMinX = 0: iMaxX = iCols
    iMinY = 0: iMaxY = iRows
 
    ' INITIALIZE PLAYER COORDINATES AND SCREEN CHARACTERS
    iNextY = 1
    iNextX = -3
    iNextC = 64
    For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
        iNextX = iNextX + 4
        If iNextX >= iMaxX Then
            iNextX = iMinX
            iNextY = iNextY + 4
            If iNextY > iMaxY Then
                iNextY = iMinY
            End If
        End If
        iNextC = iNextC + 1
        m_arrPlayer(iPlayer).x = iNextX
        m_arrPlayer(iPlayer).y = iNextY
        m_arrPlayer(iPlayer).c = iNextC
        m_arrPlayer(iPlayer).xOld = iNextX
        m_arrPlayer(iPlayer).yOld = iNextY
 
        m_arrPlayer(iPlayer).moveX = 0
        m_arrPlayer(iPlayer).lastMoveX = 0
        m_arrPlayer(iPlayer).moveY = 0
        m_arrPlayer(iPlayer).lastMoveY = 0
        m_arrPlayer(iPlayer).button1 = 0
        m_arrPlayer(iPlayer).lastButton1 = 0
        m_arrPlayer(iPlayer).button2 = 0
        m_arrPlayer(iPlayer).lastButton2 = 0
        m_arrPlayer(iPlayer).button3 = 0
        m_arrPlayer(iPlayer).lastButton3 = 0
        m_arrPlayer(iPlayer).button4 = 0
        m_arrPlayer(iPlayer).lastButton4 = 0
    Next iPlayer
 
    ' COUNT # OF JOYSTICKS
    ' TODO: find out the right way to count joysticks
    If Len(sError) = 0 Then
        ' D= _DEVICES ' MUST be read in order for other 2 device functions to work!
        iDeviceCount = _Devices ' Find the number of devices on someone's system
 
        If iDeviceCount > 2 Then
            ' LIMIT # OF DEVICES, IF THERE IS A LIMIT DEFINED
            iNumControllers = iDeviceCount - 2
            If cMaxControllers > 0 Then
                If iNumControllers > cMaxControllers Then
                    iNumControllers = cMaxControllers
                End If
            End If
        Else
            ' ONLY 2 FOUND (KEYBOARD, MOUSE)
            'sError = "No game controllers found."
            iNumControllers = 0
        End If
    End If
 
    ' INITIALIZE CONTROLLER DATA
    If Len(sError) = 0 Then
        For iController = 1 To iNumControllers
            m_arrController(iController).buttonCount = cMaxButtons
            m_arrController(iController).axisCount = cMaxAxis
            For iLoop = 1 To cMaxButtons
                arrButtonNew(iController, iLoop) = TRUE
            Next iLoop
            For iLoop = 1 To cMaxAxis
                arrAxisNew(iController, iLoop) = TRUE
            Next iLoop
        Next iController
    End If
 
    ' INITIALIZE CONTROLLER INPUT
    If Len(sError) = 0 Then
        _KeyClear: _Delay 1
        For iController = 1 To iNumControllers
            iDevice = iController + 2
            While _DeviceInput(iDevice) ' clear and update the device buffer
                For iLoop = 1 To _LastButton(iDevice)
                    If (iLoop > cMaxButtons) Then Exit For
                    m_arrController(iController).buttonCount = iLoop
                    arrButton(iController, iLoop) = FALSE
                Next iLoop
                For iLoop = 1 To _LastAxis(iDevice) ' this loop checks all my axis
                    If (iLoop > cMaxAxis) Then Exit For
                    m_arrController(iController).axisCount = iLoop
                    arrAxis(iController, iLoop) = 0
                Next iLoop
            Wend ' clear and update the device buffer
        Next iController
    End If
 
    ' GET INPUT AND MOVE PLAYERS AROUND ON SCREEN
    _KeyClear: _Delay 1
    bFinished = FALSE
    Do
        ' Clear control buffer for players
        For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
            m_arrPlayer(iPlayer).lastMoveX = m_arrPlayer(iPlayer).moveX
            m_arrPlayer(iPlayer).moveX = 0
            m_arrPlayer(iPlayer).lastMoveY = m_arrPlayer(iPlayer).moveY
            m_arrPlayer(iPlayer).moveY = 0
            m_arrPlayer(iPlayer).lastButton1 = m_arrPlayer(iPlayer).button1
            m_arrPlayer(iPlayer).button1 = 0
            m_arrPlayer(iPlayer).lastButton2 = m_arrPlayer(iPlayer).button2
            m_arrPlayer(iPlayer).button2 = 0
            m_arrPlayer(iPlayer).lastButton3 = m_arrPlayer(iPlayer).button3
            m_arrPlayer(iPlayer).button3 = 0
            m_arrPlayer(iPlayer).lastButton4 = m_arrPlayer(iPlayer).button4
            m_arrPlayer(iPlayer).button4 = 0
        Next iPlayer
 
        ' -----------------------------------------------------------------------------
        ' BEGIN CHECK FOR CONTROLLER INPUT
        If iNumControllers > 0 Then
            For iController = 1 To iNumControllers
                iDevice = iController + 2
 
                ' Check all devices
                While _DeviceInput(iDevice)
                Wend ' clear and update the device buffer
 
                ' Check each button
                For iLoop = 1 To _LastButton(iDevice)
                    If (iLoop > cMaxButtons) Then Exit For
 
                    ' update button array to indicate if a button is up or down currently.
                    'if TRUE=TRUE then
                    If _ButtonChange(iLoop) Then
                        iValue = _Button(iLoop)
                        If iValue <> arrButton(iController, iLoop) Then
                            ' *****************************************************************************
                            ' PRESSED BUTTON
 
                            ' BEGIN find who this is mapped for
                            bFoundWho = FALSE
                            For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
                                For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                                    If m_arrControlMap(iPlayer, iWhichInput).device = iDevice Then
                                        If m_arrControlMap(iPlayer, iWhichInput).typ = cInputButton Then
                                            If m_arrControlMap(iPlayer, iWhichInput).code = iLoop Then
                                                'if m_arrControlMap(iPlayer, iWhichInput).value = iValue then
                                                bFoundWho = TRUE
                                                Select Case iWhichInput
                                                    Case cInputUp:
                                                        m_arrPlayer(iPlayer).moveY = -1
                                                    Case cInputDown:
                                                        m_arrPlayer(iPlayer).moveY = 1
                                                    Case cInputLeft:
                                                        m_arrPlayer(iPlayer).moveX = -1
                                                    Case cInputRight:
                                                        m_arrPlayer(iPlayer).moveX = 1
                                                    Case cInputButton1:
                                                        If m_arrPlayer(iPlayer).lastButton1 <> TRUE Then
                                                            m_arrPlayer(iPlayer).button1 = TRUE
                                                        End If
                                                    Case cInputButton2:
                                                        If m_arrPlayer(iPlayer).lastButton2 <> TRUE Then
                                                            m_arrPlayer(iPlayer).button2 = TRUE
                                                        End If
                                                    Case cInputButton3:
                                                        If m_arrPlayer(iPlayer).lastButton3 <> TRUE Then
                                                            m_arrPlayer(iPlayer).button3 = TRUE
                                                        End If
                                                    Case cInputButton4:
                                                        If m_arrPlayer(iPlayer).lastButton4 <> TRUE Then
                                                            m_arrPlayer(iPlayer).button4 = TRUE
                                                        End If
                                                    Case Else:
                                                        '(IGNORE)
                                                End Select
                                                Exit For
                                                'end if
                                            End If
                                        End If
                                    End If
                                Next iWhichInput
                                If bFoundWho = TRUE Then Exit For
                            Next iPlayer
                            ' END find who this is mapped for
 
                        End If
                    End If
                Next iLoop
 
                ' Check each axis
                For iLoop = 1 To _LastAxis(iDevice)
                    If (iLoop > cMaxAxis) Then Exit For
                    dblNextAxis = _Axis(iLoop)
                    dblNextAxis = RoundUpDouble#(dblNextAxis, 3)
 
                    ' I like to give a little "jiggle" resistance to my controls, as I have an old joystick
                    ' which is prone to always give minute values and never really center on true 0.
                    ' A value of 1 means my axis is pushed fully in one direction.
                    ' A value greater than 0.1 means it's been partially pushed in a direction (such as at a 45 degree diagional angle).
                    ' A value of less than 0.1 means we count it as being centered. (As if it was 0.)
 
                    ' Set sensitivity:
                    'These are way too sensitive for analog:
                    'IF ABS(_AXIS(iLoop)) <= 1 AND ABS(_AXIS(iLoop)) >= .1 THEN
                    'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .01 THEN
                    'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .001 THEN
                    ''For digital input, we'll use a big picture:
                    'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= 0.75 THEN
                    If Abs(dblNextAxis) <= 1 And Abs(dblNextAxis) >= 0.5 Then
 
                        ' WE WANT CONTINUOUS MOVEMENT (DISABLE FOR NOT)
                        'if TRUE=TRUE then
                        If dblNextAxis <> arrAxis(iController, iLoop) Then
                            ' *****************************************************************************
                            ' MOVED STICK
 
                            ' convert to a digital value
                            If dblNextAxis < 0 Then
                                iValue = -1
                            Else
                                iValue = 1
                            End If
 
                            ' BEGIN find who this is mapped for
                            bFoundWho = FALSE
                            For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
                                For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                                    If m_arrControlMap(iPlayer, iWhichInput).device = iDevice Then
                                        If m_arrControlMap(iPlayer, iWhichInput).typ = cInputAxis Then
                                            If m_arrControlMap(iPlayer, iWhichInput).code = iLoop Then
                                                If m_arrControlMap(iPlayer, iWhichInput).value = iValue Then
                                                    bFoundWho = TRUE
                                                    Select Case iWhichInput
                                                        Case cInputUp:
                                                            m_arrPlayer(iPlayer).moveY = -1
                                                        Case cInputDown:
                                                            m_arrPlayer(iPlayer).moveY = 1
                                                        Case cInputLeft:
                                                            m_arrPlayer(iPlayer).moveX = -1
                                                        Case cInputRight:
                                                            m_arrPlayer(iPlayer).moveX = 1
                                                        Case cInputButton1:
                                                            If m_arrPlayer(iPlayer).lastButton1 <> TRUE Then
                                                                m_arrPlayer(iPlayer).button1 = TRUE
                                                            End If
                                                        Case cInputButton2:
                                                            If m_arrPlayer(iPlayer).lastButton2 <> TRUE Then
                                                                m_arrPlayer(iPlayer).button2 = TRUE
                                                            End If
                                                        Case cInputButton3:
                                                            If m_arrPlayer(iPlayer).lastButton3 <> TRUE Then
                                                                m_arrPlayer(iPlayer).button3 = TRUE
                                                            End If
                                                        Case cInputButton4:
                                                            If m_arrPlayer(iPlayer).lastButton4 <> TRUE Then
                                                                m_arrPlayer(iPlayer).button4 = TRUE
                                                            End If
                                                        Case Else:
                                                            '(IGNORE)
                                                    End Select
                                                    Exit For
                                                End If
                                            End If
                                        End If
                                    End If
                                Next iWhichInput
                                If bFoundWho = TRUE Then Exit For
                            Next iPlayer
                            ' END find who this is mapped for
 
                        End If
                    End If
                Next iLoop
 
            Next iController
        End If
        ' END CHECK FOR CONTROLLER INPUT
        ' -----------------------------------------------------------------------------
 
        ' -----------------------------------------------------------------------------
        ' BEGIN CHECK FOR KEYBOARD INPUT #1
        '_KEYCLEAR: _DELAY 1
        While _DeviceInput(1): Wend ' clear and update the keyboard buffer
 
        ' Detect changed key state
        iDevice = 1 ' keyboard
        For iLoop = LBound(m_arrButtonCode) To UBound(m_arrButtonCode)
            iCode = m_arrButtonCode(iLoop)
            If _Button(iCode) <> FALSE Then
                ' *****************************************************************************
                ' PRESSED KEYBOARD
                'PRINT "PRESSED " + m_arrButtonKey(iLoop)
 
                ' BEGIN find who this is mapped for
                bFoundWho = FALSE
                For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
                    For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                        If m_arrControlMap(iPlayer, iWhichInput).device = iDevice Then
                            If m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey Then
                                'if m_arrControlMap(iPlayer, iWhichInput).code = iLoop then
                                If m_arrControlMap(iPlayer, iWhichInput).code = iCode Then
                                    'if m_arrControlMap(iPlayer, iWhichInput).value = iValue then
                                    bFoundWho = TRUE
                                    Select Case iWhichInput
                                        Case cInputUp:
                                            m_arrPlayer(iPlayer).moveY = -1
                                        Case cInputDown:
                                            m_arrPlayer(iPlayer).moveY = 1
                                        Case cInputLeft:
                                            m_arrPlayer(iPlayer).moveX = -1
                                        Case cInputRight:
                                            m_arrPlayer(iPlayer).moveX = 1
                                        Case cInputButton1:
                                            If m_arrPlayer(iPlayer).lastButton1 <> TRUE Then
                                                m_arrPlayer(iPlayer).button1 = TRUE
                                            End If
                                        Case cInputButton2:
                                            If m_arrPlayer(iPlayer).lastButton2 <> TRUE Then
                                                m_arrPlayer(iPlayer).button2 = TRUE
                                            End If
                                        Case cInputButton3:
                                            If m_arrPlayer(iPlayer).lastButton3 <> TRUE Then
                                                m_arrPlayer(iPlayer).button3 = TRUE
                                            End If
                                        Case cInputButton4:
                                            If m_arrPlayer(iPlayer).lastButton4 <> TRUE Then
                                                m_arrPlayer(iPlayer).button4 = TRUE
                                            End If
                                        Case Else:
                                            '(IGNORE)
                                    End Select
                                    Exit For
                                    'end if
                                End If
                            End If
                        End If
                    Next iWhichInput
                    If bFoundWho = TRUE Then Exit For
                Next iPlayer
                ' END find who this is mapped for
 
            End If
        Next iLoop
        ' END CHECK FOR KEYBOARD INPUT #1
        ' -----------------------------------------------------------------------------
 
 
 
        ' NOW DRAW PLAYERS ON SCREEN
        For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
 
            ' MOVE RIGHT/LEFT
            m_arrPlayer(iPlayer).x = m_arrPlayer(iPlayer).x + m_arrPlayer(iPlayer).moveX
            If m_arrPlayer(iPlayer).x < iMinX Then
                m_arrPlayer(iPlayer).x = m_arrPlayer(iPlayer).xOld ' iMinX
            ElseIf m_arrPlayer(iPlayer).x > iMaxX Then
                m_arrPlayer(iPlayer).x = m_arrPlayer(iPlayer).xOld ' iMaxX
            End If
 
            ' MOVE UP/DOWN
            m_arrPlayer(iPlayer).y = m_arrPlayer(iPlayer).y + m_arrPlayer(iPlayer).moveY
            If m_arrPlayer(iPlayer).y < iMinY Then
                m_arrPlayer(iPlayer).y = m_arrPlayer(iPlayer).yOld ' iMinY
            ElseIf m_arrPlayer(iPlayer).y > iMaxY Then
                m_arrPlayer(iPlayer).y = m_arrPlayer(iPlayer).yOld ' iMaxY
            End If
 
            ' UPDATE SCREEN
            '_PRINTSTRING (m_arrPlayer(iPlayer).xOld, m_arrPlayer(iPlayer).yOld), " "
            '_PRINTSTRING (m_arrPlayer(iPlayer).x, m_arrPlayer(iPlayer).y), CHR$(m_arrPlayer(iPlayer).c)
            PrintString m_arrPlayer(iPlayer).xOld, m_arrPlayer(iPlayer).yOld, " "
            PrintString m_arrPlayer(iPlayer).x, m_arrPlayer(iPlayer).y, Chr$(m_arrPlayer(iPlayer).c)
            m_arrPlayer(iPlayer).xOld = m_arrPlayer(iPlayer).x
            m_arrPlayer(iPlayer).yOld = m_arrPlayer(iPlayer).y
 
            ' BUTTON ACTIONS
            If m_arrPlayer(iPlayer).button1 = TRUE Then
                MakeSound iPlayer, 1
            End If
 
            If m_arrPlayer(iPlayer).button2 = TRUE Then
                MakeSound iPlayer, 2
            End If
 
            If m_arrPlayer(iPlayer).button3 = TRUE Then
                MakeSound iPlayer, 3
            End If
 
            If m_arrPlayer(iPlayer).button4 = TRUE Then
                MakeSound iPlayer, 4
            End If
        Next iPlayer
 
        _Limit 30
    Loop Until _KeyHit = 27 ' ESCAPE to quit
 
    _KeyClear: _Delay 1
 
End Function ' TestMappings$
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub MakeSound (iPlayer As Integer, iButton As Integer)
    Dim note%
    If iPlayer < 1 Then
        iPlayer = 1
    ElseIf iPlayer > 8 Then
        iPlayer = 8
    End If
    If iButton < 1 Then
        iButton = 1
    ElseIf iButton > 4 Then
        iButton = 4
    End If
 
    note% = iPlayer * 100 + (iButton * 25)
    If note% > 4186 Then
        note% = 4186
    End If
    Sound note%, .75
End Sub ' MakeSound
 
' /////////////////////////////////////////////////////////////////////////////
' V2 prints in 2 columns.
 
Sub PrintControllerMap2
    Dim RoutineName As String:: RoutineName = "PrintControllerMap2"
    Dim iPlayer As Integer
    Dim iWhichInput As Integer
    Dim iCount As Integer
    Dim sLine As String
    Dim iHalf As Integer
    Dim sColumn1 As String: sColumn1 = ""
    Dim sColumn2 As String: sColumn2 = ""
    ReDim arrColumn1(-1) As String
    ReDim arrColumn2(-1) As String
    Dim iLoop As Integer
    Dim iColWidth As Integer: iColWidth = 65
    Dim sValue As String
    Dim in$
 
    ' INITIALIZE
    InitKeyboardButtonCodes
 
    ' START OUTPUT
    Print "Controller mapping:"
    'Print "Player#  Input      Device#  Type     Code              Value"
    '       1        button #2  x        unknown  x                 x
    '       9        11         9        9        18                9
    '       12345678912345678901123456789123456789123456789012345678123456789
    '       12345678901234567890123456789012345678901234567890123456789012345678901234567890
    '       00000000011111111112222222222333333333344444444445555555555666666666677777777778
 
    ' THIS IS A LAZY WAY TO GET 2 COLUMNS!
    iHalf = UBound(m_arrControlMap, 1) / 2
 
    sLine = "Player#  Input      Device#  Type     Code              Value"
    sColumn1 = sColumn1 + StrPadRight$(sLine, iColWidth) + Chr$(13)
    sLine = "-------------------------------------------------------------"
    sColumn1 = sColumn1 + StrPadRight$(sLine, iColWidth) + Chr$(13)
    For iPlayer = LBound(m_arrControlMap, 1) To iHalf
        iCount = 0
        For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
            If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
                iCount = iCount + 1
            End If
        Next iWhichInput
        If iCount > 0 Then
            For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
                    sLine = IntPadRight$(iPlayer, 9)
                    sLine = sLine + StrPadRight$(InputToString$(iWhichInput), 11)
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).device, 9)
                    sLine = sLine + StrPadRight$(InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ), 9)
 
                    'sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 9)
                    If m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey Then
                        sValue = GetKeyboardButtonCodeText$(m_arrControlMap(iPlayer, iWhichInput).code)
                        sValue = StrPadRight$(sValue, 18)
                    Else
                        sValue = IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 18)
                    End If
                    sLine = sLine + sValue
 
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).value, 9)
                    'Print sLine
                    sLine = StrPadRight$(sLine, iColWidth)
                    sColumn1 = sColumn1 + sLine + Chr$(13)
                End If
            Next iWhichInput
        Else
            sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
            'Print sLine
            sLine = StrPadRight$(sLine, iColWidth)
            sColumn1 = sColumn1 + sLine + Chr$(13)
        End If
    Next iPlayer
 
    sLine = "Player#  Input      Device#  Type     Code              Value"
    sColumn2 = sColumn2 + StrPadRight$(sLine, iColWidth) + Chr$(13)
    sLine = "-------------------------------------------------------------"
    sColumn2 = sColumn2 + StrPadRight$(sLine, iColWidth) + Chr$(13)
    For iPlayer = iHalf + 1 To UBound(m_arrControlMap, 1)
        iCount = 0
        For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
            If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
                iCount = iCount + 1
            End If
        Next iWhichInput
        If iCount > 0 Then
            For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
                    sLine = IntPadRight$(iPlayer, 9)
                    sLine = sLine + StrPadRight$(InputToString$(iWhichInput), 11)
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).device, 9)
                    sLine = sLine + StrPadRight$(InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ), 9)
 
                    'sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 9)
                    If m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey Then
                        sValue = GetKeyboardButtonCodeText$(m_arrControlMap(iPlayer, iWhichInput).code)
                        sValue = StrPadRight$(sValue, 18)
                    Else
                        sValue = IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 18)
                    End If
                    sLine = sLine + sValue
 
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).value, 9)
                    'Print sLine
                    sLine = StrPadRight$(sLine, iColWidth)
                    sColumn2 = sColumn2 + sLine + Chr$(13)
                End If
            Next iWhichInput
        Else
            sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
            'Print sLine
            sLine = StrPadRight$(sLine, iColWidth)
            sColumn2 = sColumn2 + sLine + Chr$(13)
        End If
    Next iPlayer
 
    split sColumn1, Chr$(13), arrColumn1()
    split sColumn2, Chr$(13), arrColumn2()
    If UBound(arrColumn1) > UBound(arrColumn2) Then
        iCount = UBound(arrColumn1)
    Else
        iCount = UBound(arrColumn2)
    End If
    For iLoop = 0 To iCount
        sLine = ""
        If UBound(arrColumn1) >= iLoop Then
            sLine = sLine + arrColumn1(iLoop)
        Else
            sLine = sLine + String$(iColWidth, " ")
        End If
        sLine = sLine + "     "
        If UBound(arrColumn2) >= iLoop Then
            sLine = sLine + arrColumn2(iLoop)
        Else
            sLine = sLine + String$(iColWidth, " ")
        End If
        Print sLine
    Next iLoop
End Sub ' PrintControllerMap2
 
' /////////////////////////////////////////////////////////////////////////////
' Original (simple) routine
 
Sub PrintControllerMap1
    Dim RoutineName As String:: RoutineName = "PrintControllerMap1"
    Dim iPlayer As Integer
    Dim iWhichInput As Integer
    Dim sLine As String
    Dim iCount As Integer
    Dim in$
 
    ' INITIALIZE
    InitKeyboardButtonCodes
 
    ' OUTPUT MAPPING
    Print "Controller mapping:"
    Print "Player#  Input      Device#  Type     Code     Value"
    '      1        button #2  x        unknown  x        x
    '      9        11         9        9        9        9
    '      12345678912345678901123456789123456789123456789123456789
    '      12345678901234567890123456789012345678901234567890123456789012345678901234567890
    For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
        iCount = 0
        For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
            If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
                iCount = iCount + 1
            End If
        Next iWhichInput
        If iCount > 0 Then
            For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
                    sLine = IntPadRight$(iPlayer, 9)
                    sLine = sLine + StrPadRight$(InputToString$(iWhichInput), 11)
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).device, 9)
                    sLine = sLine + StrPadRight$(InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ), 9)
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 9)
                    sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).value, 9)
                    Print sLine
                End If
            Next iWhichInput
        Else
            sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
            Print sLine
        End If
    Next iPlayer
End Sub ' PrintControllerMap1
 
' /////////////////////////////////////////////////////////////////////////////
 
Function LoadMappings$
    Dim sResult As String: sResult = ""
 
    ' INITIALIZE
    InitKeyboardButtonCodes
 
    ' Try loading map
    sResult = LoadControllerMap$
 
    LoadMappings$ = sResult
End Function ' LoadMappings$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function SaveMappings$
    Dim sResult As String: sResult = ""
    Dim sError As String: sError = ""
 
    ' INITIALIZE
    InitKeyboardButtonCodes
 
    ' Try saving map
    sResult = SaveControllerMap$
 
    SaveMappings$ = sResult
End Function ' SaveMappings$
 
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ViewMappings$
    ' INITIALIZE
    InitKeyboardButtonCodes
 
    PrintControllerMap2
    Print
    Input "PRESS <ENTER> TO CONTINUE", in$
    Print
    ViewMappings$ = ""
End Function ' ViewMappings$
 
' /////////////////////////////////////////////////////////////////////////////
' TODO: test this
 
Function EditMappings$
    Dim RoutineName As String: RoutineName = "EditMappings$"
    Dim in$
    Dim iPlayer As Integer
    Dim iWhichInput As Integer
    Dim iDevice As Integer
    Dim iType As Integer
    Dim iCode As Integer
    Dim iValue As Integer
    Dim iItem As Integer
    Dim sResult As String: sResult = ""
    Dim bContinue1 As Integer: bContinue1 = TRUE
    Dim bContinue2 As Integer: bContinue2 = TRUE
    Dim bContinue3 As Integer: bContinue3 = TRUE
    Dim bContinue4 As Integer: bContinue4 = TRUE
 
    ' INITIALIZE
    InitKeyboardButtonCodes
 
    ' EDIT
    Do
        PrintControllerMap2
        Print "To edit a mapping, enter a player number: " _
            "1-" + cstr$(cMaxPlayers) + ", " + _
            cstr$(cMaxPlayers+1) + ") or 0 to exit."
        Input "Edit mapping for player? "; iPlayer
        If iPlayer > 0 And iPlayer <= cMaxPlayers Then
            bContinue2 = TRUE
            Do
                Print "Editing mappings for player " + cstr$(iPlayer) + "."
                For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                    Print Right$("  " + cstr$(iWhichInput), 2) + ". " + InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ)
                Next iWhichInput
                Input "Type # of control to edit or q to quit editing player."; in$
                If IsNum%(in$) Then
                    iWhichInput = Val(in$)
                    If iWhichInput >= LBound(m_arrControlMap, 2) And m_arrControlMap <= UBound(m_arrControlMap, 2) Then
                        bContinue3 = TRUE
                        Do
                            Print "Settings for " + Chr$(34) + InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) + Chr$(34) + ":"
                            Print "1. Device #   : " + cstr$(m_arrControlMap(iPlayer, iWhichInput).device)
                            Print "2. Device type: " + InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ)
                            Print "3. Input code : " + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).code))
                            Print "4. Input value: " + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).value))
                            Input "Change item? (1-4 or q to quit editing control)"; in$
                            If IsNum%(in$) Then
                                iItem = Val(in$)
                                Select Case iItem
                                    Case 1:
                                        Print "Change the device number."
                                        Input "Type a new device #, 0 for none, or blank to leave it unchanged"; in$
                                        If IsNum%(in$) Then
                                            iDevice = Val(in$)
                                            m_arrControlMap(iPlayer, iWhichInput).device = iDevice
                                            Print "Updated device number. Remember to save mappings when done."
                                        Else
                                            Print "(No change.)"
                                        End If
                                    Case 2:
                                        bContinue4 = TRUE
                                        Do
                                            Print "Change the device type."
                                            Print cstr$(cInputKey) + "=keyboard"
                                            Print cstr$(cInputButton) + "=game controller button"
                                            Print cstr$(cInputAxis) + "=game controller joystick/axis"
                                            Print cstr$(cInputNone) + "=none"
                                            Input "Device type or blank to leave it unchanged"; in$
                                            If IsNum%(in$) Then
                                                iType = Val(in$)
                                                if iType=cInputKey or iType=cInputButton or _
                                                    iType=cInputAxis or iType=cInputNone then
 
                                                    m_arrControlMap(iPlayer, iWhichInput).typ = iType
                                                    Print "Updated device type. Remember to save mappings when done."
                                                    bContinue4 = FALSE: Exit Do
                                                Else
                                                    Print "Please choose one of the listed values."
                                                End If
                                            Else
                                                Print "(No change.)"
                                                bContinue4 = FALSE: Exit Do
                                            End If
                                        Loop Until bContinue4 = FALSE
                                    Case 3:
                                        Print "Change the input code."
                                        Input "Type a new input code, or blank to leave it unchanged"; in$
                                        If IsNum%(in$) Then
                                            iCode = Val(in$)
                                            m_arrControlMap(iPlayer, iWhichInput).code = iCode
                                            Print "Updated input code. Remember to save mappings when done."
                                        Else
                                            Print "(No change.)"
                                        End If
                                    Case 4:
                                        Print "Change the input value."
                                        Input "Type a new input value, or blank to leave it unchanged"; in$
                                        If IsNum%(in$) Then
                                            iValue = Val(in$)
                                            m_arrControlMap(iPlayer, iWhichInput).value = value
                                            Print "Updated input value. Remember to save mappings when done."
                                        Else
                                            Print "(No change.)"
                                        End If
                                    Case Else:
                                        Print "Please choose a number between 1 and 4."
                                End Select
                            Else
                                bContinue3 = FALSE: Exit Do
                            End If
                        Loop Until bContinue3 = FALSE
                    Else
                        Print "Please choose a number between " + cstr$(LBound(m_arrControlMap, 2)) + " and " + cstr$(UBound(m_arrControlMap, 2)) + "."
                    End If
                Else
                    bContinue2 = FALSE: Exit Do
                End If
            Loop Until bContinue2 = FALSE
            If bContinue1 = FALSE Then Exit Do
        Else
            If Len(sResult) = 0 Then sResult = "(Cancelled.)"
            bContinue1 = FALSE: Exit Do
        End If
    Loop Until bContinue1 = FALSE
 
    _KeyClear: _Delay 1
 
    EditMappings$ = sResult
End Function ' EditMappings$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function ResetMapping$
    Dim RoutineName As String: RoutineName = "ResetMapping$"
    Dim in$
    Dim iPlayer As Integer
    Dim sResult As String: sResult = ""
 
    ' INITIALIZE
    InitKeyboardButtonCodes
 
    ' RESET
    Do
        PrintControllerMap2
 
        Print "To delete mapping, enter a player number: " _
            "1-" + cstr$(cMaxPlayers) + ", " + _
            cstr$(cMaxPlayers+1) + " for all, or 0 to exit."
        Input "Delete mapping for player? "; iPlayer
 
        If iPlayer > 0 And iPlayer <= cMaxPlayers Then
            Print "Delete mappings for player " + cstr$(iPlayer) + "."
            Input "Delete (y/n)"; in$: in$ = LCase$(_Trim$(in$))
            If in$ = "y" Then
                For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                    If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
                        m_arrControlMap(iPlayer, iWhichInput).device = 0
                        m_arrControlMap(iPlayer, iWhichInput).typ = 0
                        m_arrControlMap(iPlayer, iWhichInput).code = 0
                        m_arrControlMap(iPlayer, iWhichInput).value = 0
                    End If
                Next iWhichInput
                sResult = "Mappings deleted for player " + cstr$(iPlayer) + "."
                Print sResult
            End If
        ElseIf iPlayer = (cMaxPlayers + 1) Then
            Input "Delete all mappings (y/n)"; in$: in$ = LCase$(_Trim$(in$))
            If in$ = "y" Then
                For iPlayer = 1 To cMaxPlayers
                    For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
                        If InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) <> "unknown" Then
                            m_arrControlMap(iPlayer, iWhichInput).device = 0
                            m_arrControlMap(iPlayer, iWhichInput).typ = 0
                            m_arrControlMap(iPlayer, iWhichInput).code = 0
                            m_arrControlMap(iPlayer, iWhichInput).value = 0
                        End If
                    Next iWhichInput
                Next iPlayer
                sResult = "All mappings deleted."
                Print sResult
            End If
        Else
            If Len(sResult) = 0 Then sResult = "(Cancelled.)"
            Exit Do
        End If
    Loop
    ResetMapping$ = sResult
End Function ' ResetMapping$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function MapInput$
    Dim RoutineName As String: RoutineName = "MapInput$"
    Dim in$
    Dim iDeviceCount As Integer
    Dim iPlayer As Integer
    Dim sResult As String
    Dim sError As String
 
    ' INITIALIZE
    InitKeyboardButtonCodes
 
    ' SET UP SCREEN
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
 
    ' MAKE SURE WE HAVE DEVICES
    ' 1 is the keyboard
    ' 2 is the mouse
    ' 3 is the joystick
    ' unless someone has a strange setup with multiple mice/keyboards/ect...
    ' In that case, you can use _DEVICE$(i) to look for "KEYBOARD", "MOUSE", "JOYSTICK", if necessary.
    ' I've never actually found it necessary, but I figure it's worth mentioning, just in case...
    iDeviceCount = _Devices ' Find the number of devices on someone's system
    If iDeviceCount > 2 Then
        '' Try loading map
        'sError = LoadControllerMap$
        'if len(sError) = 0 then
        '    print "Previous controller mapping loaded."
        'else
        '    print "*******************************************************************************"
        '    print "There were errors loading the controller mapping file:"
        '    print sError
        '    print
        '    print "Try remapping - a new file will be created."
        '    print "*******************************************************************************"
        'end if
        Do
            PrintControllerMap2
            Print "To edit mapping, enter a player number (1-" + cstr$(cMaxPlayers) + ") or 0 to exit."
            Input "Get input for player? "; iPlayer
            If iPlayer > 0 And iPlayer <= cMaxPlayers Then
                sResult = MapInput1$(iPlayer)
                If Len(sResult) = 0 Then
                    Print "Remember to save mappings when done."
                Else
                    Print sResult
                End If
            Else
                sResult = "(Cancelled.)"
                Exit Do
            End If
        Loop
    Else
        sResult = "No controller devices found."
        Input "PRESS <ENTER> TO CONTINUE", in$
    End If
    MapInput$ = sResult
 
End Function ' MapInput$
 
' /////////////////////////////////////////////////////////////////////////////
' Detect controls
' THIS VERSION SUPPORTS UPTO 8 JOYSTICKS, WITH UPTO 2 BUTTONS AND 2 AXES EACH
' (THIS IS FOR ATARI 2600 JOYSTICKS)
 
' The following shared arrays must be declared:
'     ReDim Shared m_arrButtonCode(1 To 99) As Long
'     ReDim Shared m_arrButtonKey(1 To 99) As String
 
Function MapInput1$ (iPlayer As Integer)
    Dim RoutineName As String:: RoutineName = "MapInput1$"
    Dim sResult As String: sResult = ""
    Dim sError As String: sError = ""
 
    Dim in$
 
    Dim iDeviceCount As Integer
    Dim iDevice As Integer
    Dim iNumControllers As Integer
    Dim iController As Integer
 
    Dim iLoop As Integer
    Dim strValue As String
    Dim strAxis As String
    Dim dblNextAxis
    Dim iCount As Long
    Dim iValue As Integer
    Dim iCode As Integer
 
    Dim arrButton(32, 16) As Integer ' number of buttons on the joystick
    Dim arrButtonNew(32, 16) As Integer ' tracks when to initialize values
    Dim arrAxis(32, 16) As Double ' number of axis on the joystick
    Dim arrAxisNew(32, 16) As Integer ' tracks when to initialize values
 
    'Dim arrInput(1 To 8) As ControlInputType
    Dim iWhichInput As Integer
    Dim bFinished As Integer
    Dim bHaveInput As Integer
    Dim bMoveNext As Integer
    Dim bCancel As Integer
    Dim iNextInput As Integer
 
    ' FOR PRINTING OUTPUT
    Dim iDigits As Integer ' # digits to display (values are truncated to this length)
    Dim iColCount As Integer
    Dim iGroupCount As Integer
    Dim sLine As String
    Dim iCols As Integer
    Dim iRows As Integer
    Dim iMaxCols As Integer
 
    ' INITIALIZE
    If Len(sError) = 0 Then
        iDigits = 4 ' 11
        iColCount = 3
        iGroupCount = 0 ' re-initialized at the top of every loop
        iCols = _Width(0) \ _FontWidth
        iRows = _Height(0) \ _FontHeight
    End If
 
    ' COUNT # OF JOYSTICKS
    ' TODO: find out the right way to count joysticks
    If Len(sError) = 0 Then
        ' D= _DEVICES ' MUST be read in order for other 2 device functions to work!
        iDeviceCount = _Devices ' Find the number of devices on someone's system
 
        If iDeviceCount > 2 Then
            ' LIMIT # OF DEVICES, IF THERE IS A LIMIT DEFINED
            iNumControllers = iDeviceCount - 2
            If cMaxControllers > 0 Then
                If iNumControllers > cMaxControllers Then
                    iNumControllers = cMaxControllers
                End If
            End If
        Else
            ' ONLY 2 FOUND (KEYBOARD, MOUSE)
            sError = "No game controllers found."
        End If
    End If
 
    ' INITIALIZE CONTROLLER DATA
    If Len(sError) = 0 Then
        For iController = 1 To iNumControllers
            m_arrController(iController).buttonCount = cMaxButtons
            m_arrController(iController).axisCount = cMaxAxis
            For iLoop = 1 To cMaxButtons
                arrButtonNew(iController, iLoop) = TRUE
            Next iLoop
            For iLoop = 1 To cMaxAxis
                arrAxisNew(iController, iLoop) = TRUE
            Next iLoop
        Next iController
    End If
 
    ' INITIALIZE CONTROLLER INPUT
    If Len(sError) = 0 Then
        Cls
        Print "We will now detect controllers."
        Print "Do not touch any keys or game controllers during detection."
        Input "Press <ENTER> to begin"; in$
        _KeyClear: Print
        sLine = "Initializing controllers": Print sLine;
        iMaxCols = (iCols - Len(sLine)) - 1
        iCount = 0
        Do
            iCount = iCount + 1
            If iCount < iMaxCols Then
                Print ".";
            Else
                Print ".": Print sLine: iCount = 0
            End If
            For iController = 1 To iNumControllers
                iDevice = iController + 2
                While _DeviceInput(iDevice) ' clear and update the device buffer
                    For iLoop = 1 To _LastButton(iDevice)
                        If (iLoop > cMaxButtons) Then Exit For
                        m_arrController(iController).buttonCount = iLoop
                        'IF _BUTTONCHANGE(iLoop) THEN
                        '    arrButton(iController, iLoop) = _BUTTON(iLoop)
                        'END IF
                        arrButton(iController, iLoop) = FALSE
                    Next iLoop
                    For iLoop = 1 To _LastAxis(iDevice) ' this loop checks all my axis
                        If (iLoop > cMaxAxis) Then Exit For
                        m_arrController(iController).axisCount = iLoop
                        arrAxis(iController, iLoop) = 0
                    Next iLoop
                Wend ' clear and update the device buffer
            Next iController
            _Limit 30
        Loop Until iCount > 60 ' quit after 2 seconds
        Print: Print
    End If
 
    ' WAIT FOR INPUT
    If Len(sError) = 0 Then
        Cls
        Print "Press <ESCAPE> to cancel at any time."
        Print
 
        _KeyClear: _Delay 1
        bCancel = FALSE
        bFinished = FALSE
        iLastPressed = 0
        For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
            'print "iWhichInput=" + cstr$(iWhichInput)
            Print "Player #" + cstr$(iPlayer) + " press control for " + InputToString$(iWhichInput) + " or ESC to skip: ";
 
            ' =============================================================================
            ' BEGIN LOOK FOR NEXT INPUT
            bMoveNext = FALSE
            Do
                ' -----------------------------------------------------------------------------
                ' BEGIN CHECK FOR CONTROLLER INPUT
                For iController = 1 To iNumControllers
                    iDevice = iController + 2
 
                    ' Check all devices
                    While _DeviceInput(iDevice)
 
                        ' Check each button
                        If bMoveNext = FALSE Then
                            For iLoop = 1 To _LastButton(iDevice)
                                If (iLoop > cMaxButtons) Then Exit For
                                'm_arrController(iController).buttonCount = iLoop
 
                                ' update button array to indicate if a button is up or down currently.
                                If _ButtonChange(iLoop) Then
                                    iValue = _Button(iLoop)
                                    If iValue <> arrButton(iController, iLoop) Then
                                        ' *****************************************************************************
                                        ' PRESSED BUTTON
 
                                        ' make sure this isn't already mapped
                                        bHaveInput = TRUE
                                        If iWhichInput > LBound(m_arrControlMap, 2) Then
                                            ' is input unique?
                                            For iNextInput = LBound(m_arrControlMap, 2) To iWhichInput - 1
                                                If m_arrControlMap(iPlayer, iNextInput).device = iDevice Then
                                                    If m_arrControlMap(iPlayer, iNextInput).typ = cInputButton Then
                                                        If m_arrControlMap(iPlayer, iNextInput).code = iLoop Then
                                                            If m_arrControlMap(iPlayer, iNextInput).value = iValue Then
                                                                bHaveInput = FALSE
                                                            End If
                                                        End If
                                                    End If
                                                End If
                                            Next iNextInput
                                        End If
 
                                        If bHaveInput Then
                                            m_arrControlMap(iPlayer, iWhichInput).device = iDevice
                                            m_arrControlMap(iPlayer, iWhichInput).typ = cInputButton
                                            m_arrControlMap(iPlayer, iWhichInput).code = iLoop
                                            m_arrControlMap(iPlayer, iWhichInput).value = iValue
                                            bMoveNext = TRUE
                                        End If
 
                                    End If
                                End If
                            Next iLoop
                        End If
 
                        ' Check each axis
                        If bMoveNext = FALSE Then
                            For iLoop = 1 To _LastAxis(iDevice)
                                If (iLoop > cMaxAxis) Then Exit For
                                'm_arrController(iController).axisCount = iLoop
 
                                dblNextAxis = _Axis(iLoop)
                                dblNextAxis = RoundUpDouble#(dblNextAxis, 3)
 
                                ' I like to give a little "jiggle" resistance to my controls, as I have an old joystick
                                ' which is prone to always give minute values and never really center on true 0.
                                ' A value of 1 means my axis is pushed fully in one direction.
                                ' A value greater than 0.1 means it's been partially pushed in a direction (such as at a 45 degree diagional angle).
                                ' A value of less than 0.1 means we count it as being centered. (As if it was 0.)
 
                                'These are way too sensitive for analog:
                                'IF ABS(_AXIS(iLoop)) <= 1 AND ABS(_AXIS(iLoop)) >= .1 THEN
                                'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .01 THEN
                                'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .001 THEN
 
                                'For digital input, we'll use a big picture:
                                If Abs(dblNextAxis) <= 1 And Abs(dblNextAxis) >= 0.75 Then
                                    If dblNextAxis <> arrAxis(iController, iLoop) Then
                                        ' *****************************************************************************
                                        ' MOVED STICK
 
                                        ' convert to a digital value
                                        If dblNextAxis < 0 Then
                                            iValue = -1
                                        Else
                                            iValue = 1
                                        End If
 
                                        ' make sure this isn't already mapped
                                        bHaveInput = TRUE
                                        If iWhichInput > LBound(m_arrControlMap, 2) Then
                                            ' is input unique?
                                            For iNextInput = LBound(m_arrControlMap, 2) To iWhichInput - 1
                                                If m_arrControlMap(iPlayer, iNextInput).device = iDevice Then
                                                    If m_arrControlMap(iPlayer, iNextInput).typ = cInputAxis Then
                                                        If m_arrControlMap(iPlayer, iNextInput).code = iLoop Then
                                                            If m_arrControlMap(iPlayer, iNextInput).value = iValue Then
                                                                bHaveInput = FALSE
                                                            End If
                                                        End If
                                                    End If
                                                End If
                                            Next iNextInput
                                        End If
 
                                        If bHaveInput Then
                                            m_arrControlMap(iPlayer, iWhichInput).device = iDevice
                                            m_arrControlMap(iPlayer, iWhichInput).typ = cInputAxis
                                            m_arrControlMap(iPlayer, iWhichInput).code = iLoop
                                            m_arrControlMap(iPlayer, iWhichInput).value = iValue
                                            bMoveNext = TRUE
                                        End If
 
                                    End If
                                End If
                            Next iLoop
                        End If
 
                    Wend ' clear and update the device buffer
 
                Next iController
                ' END CHECK FOR CONTROLLER INPUT
                ' -----------------------------------------------------------------------------
 
                ' -----------------------------------------------------------------------------
                ' BEGIN CHECK FOR KEYBOARD INPUT #1
                If bMoveNext = FALSE Then
                    '_KEYCLEAR: _DELAY 1
                    While _DeviceInput(1): Wend ' clear and update the keyboard buffer
 
                    ' Detect changed key state
                    For iLoop = LBound(m_arrButtonCode) To UBound(m_arrButtonCode)
                        iCode = m_arrButtonCode(iLoop)
                        If _Button(iCode) <> FALSE Then
                            ' *****************************************************************************
                            ' PRESSED KEYBOARD
                            'PRINT "PRESSED " + m_arrButtonKey(iLoop)
 
                            ' make sure this isn't already mapped
                            bHaveInput = TRUE
                            If iWhichInput > LBound(m_arrControlMap, 2) Then
                                ' is input unique?
                                For iNextInput = LBound(m_arrControlMap, 2) To iWhichInput - 1
                                    If m_arrControlMap(iPlayer, iNextInput).device = 1 Then ' .device 1 = keyboard
                                        If m_arrControlMap(iPlayer, iNextInput).typ = cInputKey Then
                                            If m_arrControlMap(iPlayer, iNextInput).code = iCode Then
                                                'if m_arrControlMap(iPlayer, iNextInput).value = TRUE then
                                                bHaveInput = FALSE
                                                'end if
                                            End If
                                        End If
                                    End If
                                Next iNextInput
                            End If
 
                            If bHaveInput Then
                                m_arrControlMap(iPlayer, iWhichInput).device = 1 ' .device 1 = keyboard
                                m_arrControlMap(iPlayer, iWhichInput).typ = cInputKey
                                m_arrControlMap(iPlayer, iWhichInput).code = iCode
                                m_arrControlMap(iPlayer, iWhichInput).value = TRUE
                                bMoveNext = TRUE
                            End If
 
                        End If
                    Next iLoop
                End If
                ' END CHECK FOR KEYBOARD INPUT #1
                ' -----------------------------------------------------------------------------
 
                If bMoveNext = TRUE Then Exit Do
                _Limit 30
            Loop Until _KeyHit = 27 ' ESCAPE to quit
            ' END LOOK FOR NEXT INPUT
            ' =============================================================================
 
            If bMoveNext = TRUE Then
                Print "Device #" + cstr$(m_arrControlMap(iPlayer, iWhichInput).device) + " " + _
                    InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ) + " " + _
                    cstr$(m_arrControlMap(iPlayer, iWhichInput).code) + " = " + _
                    cstr$(m_arrControlMap(iPlayer, iWhichInput).value)
            Else
                Print "(Skipped)"
                bCancel = TRUE
                bFinished = TRUE
            End If
 
            If bFinished = TRUE Then Exit For
        Next iWhichInput
    End If
 
    If Len(sError) > 0 Then
        sResult = "ERRORS: " + sError
    End If
 
    _KeyClear: _Delay 1
    MapInput1$ = sResult
End Function ' MapInput1$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function InputToString$ (iCode As Integer)
    Select Case iCode
        Case cInputUp:
            InputToString$ = "up"
        Case cInputDown:
            InputToString$ = "down"
        Case cInputLeft:
            InputToString$ = "left"
        Case cInputRight:
            InputToString$ = "right"
        Case cInputButton1:
            InputToString$ = "button #1"
        Case cInputButton2:
            InputToString$ = "button #2"
        Case cInputButton3:
            InputToString$ = "button #3"
        Case cInputButton4:
            InputToString$ = "button #4"
        Case Else:
            InputToString$ = "unknown"
    End Select
End Function ' InputToString$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function InputTypeToString$ (iCode As Integer)
    Select Case iCode
        Case cInputNone:
            InputTypeToString$ = "none"
        Case cInputKey:
            InputTypeToString$ = "key"
        Case cInputButton:
            InputTypeToString$ = "button"
        Case cInputAxis:
            InputTypeToString$ = "axis"
        Case Else:
            InputTypeToString$ = "unknown"
    End Select
End Function ' InputTypeToString$
 
' /////////////////////////////////////////////////////////////////////////////
' METHOD v2 = faster
 
Function GetKeyboardButtonCodeText$ (iCode As Integer)
    Dim sResult As String: sResult = ""
    If LBound(m_arrButtonKeyDesc) <= iCode Then
        If UBound(m_arrButtonKeyDesc) >= iCode Then
            sResult = m_arrButtonKeyDesc(iCode)
        End If
    End If
    If Len(sResult) = 0 Then
        sResult = _Trim$(Str$(iCode)) + " (?)"
    End If
    GetKeyboardButtonCodeText$ = sResult
End Function ' GetKeyboardButtonCodeText$
 
' /////////////////////////////////////////////////////////////////////////////
' METHOD v2
' Faster lookup - a dictionary with a hash lookup would be best
' but this is a quick way to do it since the values never change.
 
' The following shared arrays must be declared:
'     ReDim Shared m_arrButtonCode(1 To 99) As Long
'     ReDim Shared m_arrButtonKey(1 To 99) As String
'     ReDim Shared m_arrButtonKeyDesc(0 To 512) As String
 
Sub InitKeyboardButtonCodes ()
    Dim iLoop As Integer
 
    ' CODE(S) DETECTED WITH _BUTTON:
    m_arrButtonCode(1) = 2: m_arrButtonKey(1) = "Esc"
    m_arrButtonCode(2) = 60: m_arrButtonKey(2) = "F1"
    m_arrButtonCode(3) = 61: m_arrButtonKey(3) = "F2"
    m_arrButtonCode(4) = 62: m_arrButtonKey(4) = "F3"
    m_arrButtonCode(5) = 63: m_arrButtonKey(5) = "F4"
    m_arrButtonCode(6) = 64: m_arrButtonKey(6) = "F5"
    m_arrButtonCode(7) = 65: m_arrButtonKey(7) = "F6"
    m_arrButtonCode(8) = 66: m_arrButtonKey(8) = "F7"
    m_arrButtonCode(9) = 67: m_arrButtonKey(9) = "F8"
    m_arrButtonCode(10) = 68: m_arrButtonKey(10) = "F9"
    m_arrButtonCode(11) = 88: m_arrButtonKey(11) = "F11"
    m_arrButtonCode(12) = 89: m_arrButtonKey(12) = "F12"
    m_arrButtonCode(13) = 42: m_arrButtonKey(13) = "Tilde"
    m_arrButtonCode(14) = 3: m_arrButtonKey(14) = "1"
    m_arrButtonCode(15) = 4: m_arrButtonKey(15) = "2"
    m_arrButtonCode(16) = 5: m_arrButtonKey(16) = "3"
    m_arrButtonCode(17) = 6: m_arrButtonKey(17) = "4"
    m_arrButtonCode(18) = 7: m_arrButtonKey(18) = "5"
    m_arrButtonCode(19) = 8: m_arrButtonKey(19) = "6"
    m_arrButtonCode(20) = 9: m_arrButtonKey(20) = "7"
    m_arrButtonCode(21) = 10: m_arrButtonKey(21) = "8"
    m_arrButtonCode(22) = 11: m_arrButtonKey(22) = "9"
    m_arrButtonCode(23) = 12: m_arrButtonKey(23) = "0"
    m_arrButtonCode(24) = 13: m_arrButtonKey(24) = "Minus"
    m_arrButtonCode(25) = 14: m_arrButtonKey(25) = "Equal"
    m_arrButtonCode(26) = 15: m_arrButtonKey(26) = "BkSp"
    m_arrButtonCode(27) = 16: m_arrButtonKey(27) = "Tab"
    m_arrButtonCode(28) = 17: m_arrButtonKey(28) = "Q"
    m_arrButtonCode(29) = 18: m_arrButtonKey(29) = "W"
    m_arrButtonCode(30) = 19: m_arrButtonKey(30) = "E"
    m_arrButtonCode(31) = 20: m_arrButtonKey(31) = "R"
    m_arrButtonCode(32) = 21: m_arrButtonKey(32) = "T"
    m_arrButtonCode(33) = 22: m_arrButtonKey(33) = "Y"
    m_arrButtonCode(34) = 23: m_arrButtonKey(34) = "U"
    m_arrButtonCode(35) = 24: m_arrButtonKey(35) = "I"
    m_arrButtonCode(36) = 25: m_arrButtonKey(36) = "O"
    m_arrButtonCode(37) = 26: m_arrButtonKey(37) = "P"
    m_arrButtonCode(38) = 27: m_arrButtonKey(38) = "BracketLeft"
    m_arrButtonCode(39) = 28: m_arrButtonKey(39) = "BracketRight"
    m_arrButtonCode(40) = 44: m_arrButtonKey(40) = "Backslash"
    m_arrButtonCode(41) = 59: m_arrButtonKey(41) = "CapsLock"
    m_arrButtonCode(42) = 31: m_arrButtonKey(42) = "A"
    m_arrButtonCode(43) = 32: m_arrButtonKey(43) = "S"
    m_arrButtonCode(44) = 33: m_arrButtonKey(44) = "D"
    m_arrButtonCode(45) = 34: m_arrButtonKey(45) = "F"
    m_arrButtonCode(46) = 35: m_arrButtonKey(46) = "G"
    m_arrButtonCode(47) = 36: m_arrButtonKey(47) = "H"
    m_arrButtonCode(48) = 37: m_arrButtonKey(48) = "J"
    m_arrButtonCode(49) = 38: m_arrButtonKey(49) = "K"
    m_arrButtonCode(50) = 39: m_arrButtonKey(50) = "L"
    m_arrButtonCode(51) = 40: m_arrButtonKey(51) = "Semicolon"
    m_arrButtonCode(52) = 41: m_arrButtonKey(52) = "Apostrophe"
    m_arrButtonCode(53) = 29: m_arrButtonKey(53) = "Enter"
    m_arrButtonCode(54) = 43: m_arrButtonKey(54) = "ShiftLeft"
    m_arrButtonCode(55) = 45: m_arrButtonKey(55) = "Z"
    m_arrButtonCode(56) = 46: m_arrButtonKey(56) = "X"
    m_arrButtonCode(57) = 47: m_arrButtonKey(57) = "C"
    m_arrButtonCode(58) = 48: m_arrButtonKey(58) = "V"
    m_arrButtonCode(59) = 49: m_arrButtonKey(59) = "B"
    m_arrButtonCode(60) = 50: m_arrButtonKey(60) = "N"
    m_arrButtonCode(61) = 51: m_arrButtonKey(61) = "M"
    m_arrButtonCode(62) = 52: m_arrButtonKey(62) = "Comma"
    m_arrButtonCode(63) = 53: m_arrButtonKey(63) = "Period"
    m_arrButtonCode(64) = 54: m_arrButtonKey(64) = "Slash"
    m_arrButtonCode(65) = 55: m_arrButtonKey(65) = "ShiftRight"
    m_arrButtonCode(66) = 30: m_arrButtonKey(66) = "CtrlLeft"
    m_arrButtonCode(67) = 348: m_arrButtonKey(67) = "WinLeft"
    m_arrButtonCode(68) = 58: m_arrButtonKey(68) = "Spacebar"
    m_arrButtonCode(69) = 349: m_arrButtonKey(69) = "WinRight"
    m_arrButtonCode(70) = 350: m_arrButtonKey(70) = "Menu"
    m_arrButtonCode(71) = 286: m_arrButtonKey(71) = "CtrlRight"
    m_arrButtonCode(72) = 339: m_arrButtonKey(72) = "Ins"
    m_arrButtonCode(73) = 328: m_arrButtonKey(73) = "Home"
    m_arrButtonCode(74) = 330: m_arrButtonKey(74) = "PgUp"
    m_arrButtonCode(75) = 340: m_arrButtonKey(75) = "Del"
    m_arrButtonCode(76) = 336: m_arrButtonKey(76) = "End"
    m_arrButtonCode(77) = 338: m_arrButtonKey(77) = "PgDn"
    m_arrButtonCode(78) = 329: m_arrButtonKey(78) = "Up"
    m_arrButtonCode(79) = 332: m_arrButtonKey(79) = "Left"
    m_arrButtonCode(80) = 337: m_arrButtonKey(80) = "Down"
    m_arrButtonCode(81) = 334: m_arrButtonKey(81) = "Right"
    m_arrButtonCode(82) = 71: m_arrButtonKey(82) = "ScrollLock"
    m_arrButtonCode(83) = 326: m_arrButtonKey(83) = "NumLock"
    m_arrButtonCode(84) = 310: m_arrButtonKey(84) = "KeypadSlash"
    m_arrButtonCode(85) = 56: m_arrButtonKey(85) = "KeypadMultiply"
    m_arrButtonCode(86) = 75: m_arrButtonKey(86) = "KeypadMinus"
    m_arrButtonCode(87) = 72: m_arrButtonKey(87) = "Keypad7Home"
    m_arrButtonCode(88) = 73: m_arrButtonKey(88) = "Keypad8Up"
    m_arrButtonCode(89) = 74: m_arrButtonKey(89) = "Keypad9PgUp"
    m_arrButtonCode(90) = 79: m_arrButtonKey(90) = "KeypadPlus"
    m_arrButtonCode(91) = 76: m_arrButtonKey(91) = "Keypad4Left"
    m_arrButtonCode(92) = 77: m_arrButtonKey(92) = "Keypad5"
    m_arrButtonCode(93) = 78: m_arrButtonKey(93) = "Keypad6Right"
    m_arrButtonCode(94) = 80: m_arrButtonKey(94) = "Keypad1End"
    m_arrButtonCode(95) = 81: m_arrButtonKey(95) = "Keypad2Down"
    m_arrButtonCode(96) = 82: m_arrButtonKey(96) = "Keypad3PgDn"
    m_arrButtonCode(97) = 285: m_arrButtonKey(97) = "KeypadEnter"
    m_arrButtonCode(98) = 83: m_arrButtonKey(98) = "Keypad0Ins"
    m_arrButtonCode(99) = 84: m_arrButtonKey(99) = "KeypadPeriodDel"
 
    ' not sure if this works:
    '' CODE(S) DETECTED WITH _KEYDOWN:
    'm_arrButtonCode(100) = -1 : m_arrButtonCode(100) = "F10"
 
    ' not sure if this works:
    '' CODE(S) DETECTED WITH _KEYHIT:
    'm_arrButtonCode(101) = -2 : m_arrButtonCode(101) = "AltLeft"
    'm_arrButtonCode(102) = -3 : m_arrButtonCode(102) = "AltRight"
 
    ' DESCRIPTIONS BY KEYCODE
    For iLoop = LBound(m_arrButtonKeyDesc) To UBound(m_arrButtonKeyDesc)
        m_arrButtonKeyDesc(iLoop) = ""
    Next iLoop
    m_arrButtonKeyDesc(2) = "Esc"
    m_arrButtonKeyDesc(60) = "F1"
    m_arrButtonKeyDesc(61) = "F2"
    m_arrButtonKeyDesc(62) = "F3"
    m_arrButtonKeyDesc(63) = "F4"
    m_arrButtonKeyDesc(64) = "F5"
    m_arrButtonKeyDesc(65) = "F6"
    m_arrButtonKeyDesc(66) = "F7"
    m_arrButtonKeyDesc(67) = "F8"
    m_arrButtonKeyDesc(68) = "F9"
    m_arrButtonKeyDesc(88) = "F11"
    m_arrButtonKeyDesc(89) = "F12"
    m_arrButtonKeyDesc(42) = "Tilde"
    m_arrButtonKeyDesc(3) = "1"
    m_arrButtonKeyDesc(4) = "2"
    m_arrButtonKeyDesc(5) = "3"
    m_arrButtonKeyDesc(6) = "4"
    m_arrButtonKeyDesc(7) = "5"
    m_arrButtonKeyDesc(8) = "6"
    m_arrButtonKeyDesc(9) = "7"
    m_arrButtonKeyDesc(10) = "8"
    m_arrButtonKeyDesc(11) = "9"
    m_arrButtonKeyDesc(12) = "0"
    m_arrButtonKeyDesc(13) = "Minus"
    m_arrButtonKeyDesc(14) = "Equal"
    m_arrButtonKeyDesc(15) = "BkSp"
    m_arrButtonKeyDesc(16) = "Tab"
    m_arrButtonKeyDesc(17) = "Q"
    m_arrButtonKeyDesc(18) = "W"
    m_arrButtonKeyDesc(19) = "E"
    m_arrButtonKeyDesc(20) = "R"
    m_arrButtonKeyDesc(21) = "T"
    m_arrButtonKeyDesc(22) = "Y"
    m_arrButtonKeyDesc(23) = "U"
    m_arrButtonKeyDesc(24) = "I"
    m_arrButtonKeyDesc(25) = "O"
    m_arrButtonKeyDesc(26) = "P"
    m_arrButtonKeyDesc(27) = "BracketLeft"
    m_arrButtonKeyDesc(28) = "BracketRight"
    m_arrButtonKeyDesc(44) = "Backslash"
    m_arrButtonKeyDesc(59) = "CapsLock"
    m_arrButtonKeyDesc(31) = "A"
    m_arrButtonKeyDesc(32) = "S"
    m_arrButtonKeyDesc(33) = "D"
    m_arrButtonKeyDesc(34) = "F"
    m_arrButtonKeyDesc(35) = "G"
    m_arrButtonKeyDesc(36) = "H"
    m_arrButtonKeyDesc(37) = "J"
    m_arrButtonKeyDesc(38) = "K"
    m_arrButtonKeyDesc(39) = "L"
    m_arrButtonKeyDesc(40) = "Semicolon"
    m_arrButtonKeyDesc(41) = "Apostrophe"
    m_arrButtonKeyDesc(29) = "Enter"
    m_arrButtonKeyDesc(43) = "ShiftLeft"
    m_arrButtonKeyDesc(45) = "Z"
    m_arrButtonKeyDesc(46) = "X"
    m_arrButtonKeyDesc(47) = "C"
    m_arrButtonKeyDesc(48) = "V"
    m_arrButtonKeyDesc(49) = "B"
    m_arrButtonKeyDesc(50) = "N"
    m_arrButtonKeyDesc(51) = "M"
    m_arrButtonKeyDesc(52) = "Comma"
    m_arrButtonKeyDesc(53) = "Period"
    m_arrButtonKeyDesc(54) = "Slash"
    m_arrButtonKeyDesc(55) = "ShiftRight"
    m_arrButtonKeyDesc(30) = "CtrlLeft"
    m_arrButtonKeyDesc(348) = "WinLeft"
    m_arrButtonKeyDesc(58) = "Spacebar"
    m_arrButtonKeyDesc(349) = "WinRight"
    m_arrButtonKeyDesc(350) = "Menu"
    m_arrButtonKeyDesc(286) = "CtrlRight"
    m_arrButtonKeyDesc(339) = "Ins"
    m_arrButtonKeyDesc(328) = "Home"
    m_arrButtonKeyDesc(330) = "PgUp"
    m_arrButtonKeyDesc(340) = "Del"
    m_arrButtonKeyDesc(336) = "End"
    m_arrButtonKeyDesc(338) = "PgDn"
    m_arrButtonKeyDesc(329) = "Up"
    m_arrButtonKeyDesc(332) = "Left"
    m_arrButtonKeyDesc(337) = "Down"
    m_arrButtonKeyDesc(334) = "Right"
    m_arrButtonKeyDesc(71) = "ScrollLock"
    m_arrButtonKeyDesc(326) = "NumLock"
    m_arrButtonKeyDesc(310) = "KeypadSlash"
    m_arrButtonKeyDesc(56) = "KeypadMultiply"
    m_arrButtonKeyDesc(75) = "KeypadMinus"
    m_arrButtonKeyDesc(72) = "Keypad7Home"
    m_arrButtonKeyDesc(73) = "Keypad8Up"
    m_arrButtonKeyDesc(74) = "Keypad9PgUp"
    m_arrButtonKeyDesc(79) = "KeypadPlus"
    m_arrButtonKeyDesc(76) = "Keypad4Left"
    m_arrButtonKeyDesc(77) = "Keypad5"
    m_arrButtonKeyDesc(78) = "Keypad6Right"
    m_arrButtonKeyDesc(80) = "Keypad1End"
    m_arrButtonKeyDesc(81) = "Keypad2Down"
    m_arrButtonKeyDesc(82) = "Keypad3PgDn"
    m_arrButtonKeyDesc(285) = "KeypadEnter"
    m_arrButtonKeyDesc(83) = "Keypad0Ins"
    m_arrButtonKeyDesc(84) = "KeypadPeriodDel"
End Sub ' InitKeyboardButtonCodes
 
' /////////////////////////////////////////////////////////////////////////////
' not sure if this works
 
' Returns TRUE if the F10 key is held down.
' We use _KEYDOWN for this because _BUTTON doesn't detect F10.
 
' Constant must be declared globally:
' Const c_iKeyDown_F10 = 17408
 
Function KeydownF10%
    Dim iCode As Long
    '_KEYCLEAR: _DELAY 1
    If _KeyDown(c_iKeyDown_F10) = TRUE Then
        KeydownF10% = TRUE
    Else
        KeydownF10% = FALSE
    End If
    '_KEYCLEAR
End Function ' KeydownF10%
 
' /////////////////////////////////////////////////////////////////////////////
' not sure if this works
 
' Returns TRUE if the left ALT key is held down.
' We use _KEYHIT for this because _BUTTON doesn't detect ALT.
 
' Constant must be declared globally:
' Const c_iKeyHit_AltLeft = -30764
 
Function KeyhitAltLeft%
    '_KEYCLEAR: _DELAY 1
    If _KeyHit = c_iKeyHit_AltLeft Then
        KeyhitAltLeft% = TRUE
    Else
        KeyhitAltLeft% = FALSE
    End If
    '_KEYCLEAR
End Function ' KeyhitAltLeft%
 
' /////////////////////////////////////////////////////////////////////////////
' not sure if this works
 
' Returns TRUE if the right ALT key is held down.
' We use _KEYHIT for this because _BUTTON doesn't detect ALT.
 
' Constant must be declared globally:
' Const c_iKeyHit_AltRight = -30765
 
Function KeyhitAltRight%
    '_KEYCLEAR: _DELAY 1
    If _KeyHit = c_iKeyHit_AltRight Then
        KeyhitAltRight% = TRUE
    Else
        KeyhitAltRight% = FALSE
    End If
    '_KEYCLEAR
End Function ' KeyhitAltRight%
 
' /////////////////////////////////////////////////////////////////////////////
' DEVICES Button
' _LASTBUTTON(1) keyboards will normally return 512 buttons. One button is read per loop through all numbers.
' _BUTTONCHANGE(number) returns -1 when pressed, 1 when released and 0 when there is no event since the last read.
' _BUTTON(number) returns -1 when a button is pressed and 0 when released
 
' Detects most keys (where the codes are documented?)
 
' However, does not seem to detect:
' Key             Use
' ---             ---
' F10             Function KeydownF10%
' Left Alt        Function KeyhitAltLeft%
' Right Alt       Function KeyhitAltRight%
' Print Screen    (system API call?)
' Pause/Break     (system API call?)
 
Function KeyPressed% (iCode As Integer)
    '_KEYCLEAR: _DELAY 1
    While _DeviceInput(1): Wend ' clear and update the keyboard buffer
    If _Button(iCode) <> FALSE Then
        KeyPressed% = TRUE
    Else
        KeyPressed% = FALSE
    End If
    '_KEYCLEAR
End Function ' KeyPressed%
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TestJoysticks$
    Dim RoutineName As String: RoutineName = "TestJoysticks$"
    Dim iDeviceCount As Integer
    Dim sResult As String
 
    ' 1 is the keyboard
    ' 2 is the mouse
    ' 3 is the joystick
    ' unless someone has a strange setup with multiple mice/keyboards/ect...
    ' In that case, you can use _DEVICE$(i) to look for "KEYBOARD", "MOUSE", "JOYSTICK", if necessary.
    ' I've never actually found it necessary, but I figure it's worth mentioning, just in case...
 
    iDeviceCount = _Devices ' Find the number of devices on someone's system
    If iDeviceCount > 2 Then
        TestJoysticks1
        sResult = ""
    Else
        sResult = "No joysticks found."
    End If
 
    _KeyClear
 
    TestJoysticks$ = sResult
End Function ' TestJoysticks$
 
' /////////////////////////////////////////////////////////////////////////////
' Reads controllers and displays values on screen.
 
' Currently this is set up to support up to 8 joysticks,
' with upto 4 buttons and 2 axes each
' Testing with an old USB Logitech RumblePad 2
' and Atari 2600 joysticks plugged into using
' iCode Atari Joystick, Paddle, Driving to USB Adapter 4 ports
 
Sub TestJoysticks1 ()
    Dim RoutineName As String:: RoutineName = "TestJoysticks1"
 
    Dim in$
    Dim iDeviceCount As Integer
    Dim iDevice As Integer
 
    Dim arrButton(32, 16) As Integer ' number of buttons on the joystick
    Dim arrButtonMin(32, 16) As Integer ' stores the minimum value read
    Dim arrButtonMax(32, 16) As Integer ' stores the maximum value read
    Dim arrAxis(32, 16) As Double ' number of axis on the joystick
    Dim arrAxisMin(32, 16) As Double ' stores the minimum value read
    Dim arrAxisMax(32, 16) As Double ' stores the maximum value read
    Dim arrAxisAvg(32, 16) As Double ' stores the average value read in the last few measurements
    Dim arrButtonNew(32, 16) As Integer ' tracks when to initialize values
    Dim arrAxisNew(32, 16) As Integer ' tracks when to initialize values
 
    Dim arrController(8) As ControllerType ' holds info for each player
    Dim iNumControllers As Integer
    Dim iController As Integer
    Dim iNextY As Integer
    Dim iNextX As Integer
    Dim iNextC As Integer
    Dim iLoop As Integer
    Dim iDigits As Integer ' # digits to display (values are truncated to this length)
    Dim strValue As String
    Dim strAxis As String
    Dim dblNextAxis
    'DIM iMeasureCount AS INTEGER
    Dim dblAverage As Double
    Dim sngAverage As Single
    Dim sLine As String
    Dim iX As Integer
    Dim iY As Integer
 
    Dim iCol As Integer
    Dim iRow As Integer
    Dim iCols As Integer
    Dim iRows As Integer
    Dim iColWidth As Integer
    Dim iColCount As Integer
    Dim iGroupCount As Integer
 
    ' SET UP SCREEN
    Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
 
    ' INITIALIZE
    iDigits = 4 ' 11
    iColCount = 3
    iCols = _Width(0) \ _FontWidth
    iRows = _Height(0) \ _FontHeight
    iColWidth = iCols \ iColCount
 
    ' COUNT # OF JOYSTICKS
    ' D= _DEVICES ' MUST be read in order for other 2 device functions to work!
    iDeviceCount = _Devices ' Find the number of devices on someone's system
    If iDeviceCount < 3 Then
        Cls
        Print "NO JOYSTICKS FOUND, EXITING..."
        Input "PRESS <ENTER>"; in$
        Exit Sub
    End If
 
    ' BASE # OF PLAYERS ON HOW MANY CONTROLLERS FOUND
    iNumControllers = iDeviceCount - 2 ' TODO: find out the right way to count joysticks
    If iNumControllers > cMaxControllers Then
        iNumControllers = cMaxControllers
    End If
 
    ' INITIALIZE PLAYER COORDINATES AND SCREEN CHARACTERS
    iNextY = 1
    iNextX = -3
    iNextC = 64
    For iController = 1 To iNumControllers
        iNextX = iNextX + 4
        If iNextX > 80 Then
            iNextX = 1
            iNextY = iNextY + 4
        End If
        iNextC = iNextC + 1
        arrController(iController).buttonCount = cMaxButtons
        arrController(iController).axisCount = cMaxAxis
 
        For iLoop = 1 To cMaxButtons
            arrButtonNew(iController, iLoop) = TRUE
        Next iLoop
        For iLoop = 1 To cMaxAxis
            arrAxisNew(iController, iLoop) = TRUE
            arrAxisAvg(iController, iLoop) = 0
        Next iLoop
    Next iController
 
    ' CLEAR THE SCREEN
    'iMeasureCount = 0
    Do
        For iController = 1 To iNumControllers
            iDevice = iController + 2
 
            While _DeviceInput(iDevice) ' clear and update the device buffer
                ''IF _DEVICEINPUT = 3 THEN ' this says we only care about joystick input values
 
                ' check all the buttons
                For iLoop = 1 To _LastButton(iDevice)
                    If (iLoop > cMaxButtons) Then
                        Exit For
                    End If
                    arrController(iController).buttonCount = iLoop
 
                    ' update button array to indicate if a button is up or down currently.
                    If _ButtonChange(iLoop) Then
                        '' _BUTTON(number) returns -1 when a button is pressed and 0 when released.
                        ''arrButton(iLoop) = NOT arrButton(iLoop)
                        arrButton(iController, iLoop) = _Button(iLoop)
                    End If
 
                    '' SAVE MINIMUM VALUE
                    'if arrButton(iController, iLoop) < arrButtonMin(iController, iLoop) then
                    '    arrButtonMin(iController, iLoop) = arrButton(iController, iLoop)
                    '
                    '    ' INITIALIZE THE MAX TO THE MINIMUM VALUE
                    '    IF arrButtonNew(iController, iLoop) = TRUE THEN
                    '        arrButtonMax(iController, iLoop) = arrButtonMin(iController, iLoop)
                    '        arrButtonNew(iController, iLoop) = FALSE
                    '    END IF
                    'end if
                    '
                    '' SAVE MAXIMUM VALUE
                    'if arrButton(iController, iLoop) > arrButtonMax(iController, iLoop) then
                    '    arrButtonMax(iController, iLoop) = arrButton(iController, iLoop)
                    'end if
 
                Next iLoop
 
                For iLoop = 1 To _LastAxis(iDevice) ' this loop checks all my axis
                    If (iLoop > cMaxAxis) Then
                        Exit For
                    End If
                    arrController(iController).axisCount = iLoop
 
                    ' I like to give a little "jiggle" resistance to my controls, as I have an old joystick
                    ' which is prone to always give minute values and never really center on true 0.
                    ' A value of 1 means my axis is pushed fully in one direction.
                    ' A value greater than 0.1 means it's been partially pushed in a direction (such as at a 45 degree diagional angle).
                    ' A value of less than 0.1 means we count it as being centered. (As if it was 0.)
                    'IF ABS(_AXIS(iLoop)) <= 1 AND ABS(_AXIS(iLoop)) >= .1 THEN
 
                    dblNextAxis = _Axis(iLoop)
                    dblNextAxis = RoundUpDouble#(dblNextAxis, 3)
                    'IF ABS(dblNextAxis) <= 1 AND ABS(dblNextAxis) >= .01 THEN
                    If Abs(dblNextAxis) <= 1 And Abs(dblNextAxis) >= .001 Then
                        arrAxis(iController, iLoop) = dblNextAxis
                    Else
                        arrAxis(iController, iLoop) = 0
                    End If
 
                    '' SAVE MINIMUM VALUE
                    'if arrAxis(iController, iLoop) < arrAxisMin(iController, iLoop) then
                    '    arrAxisMin(iController, iLoop) = arrAxis(iController, iLoop)
                    '
                    '    ' INITIALIZE THE MAX TO THE MINIMUM VALUE
                    '    IF arrAxisNew(iController, iLoop) = TRUE THEN
                    '        arrAxisMax(iController, iLoop) = arrAxisMin(iController, iLoop)
                    '        arrAxisNew(iController, iLoop) = FALSE
                    '    END IF
                    'end if
                    '
                    '' SAVE MAXIMUM VALUE
                    'if arrAxis(iController, iLoop) > arrAxisMax(iController, iLoop) then
                    '    arrAxisMax(iController, iLoop) = arrAxis(iController, iLoop)
                    'end if
                    '
                    '' ADD CURRENT VALUE TO AVERAGE SUM
                    'arrAxisAvg(iController, iLoop) = arrAxisAvg(iController, iLoop) + arrAxis(iController, iLoop)
 
                Next iLoop
            Wend ' clear and update the device buffer
 
        Next iController
 
        'PRINT "*** iNumControllers=" + cstr$(iNumControllers) + " ***"
        'iMeasureCount = iMeasureCount + 1
        'if iMeasureCount = 10 then
        'iMeasureCount = 0
 
        ' And below here is just the simple display routine which displays our values.
        ' If this was for a game, I'd choose something like arrAxis(1) = -1 for a left arrow style input,
        ' arrAxis(1) = 1 for a right arrow style input, rather than just using _KEYHIT or INKEY$.
 
        InitColumns iColCount
        m_StartRow = 6
        m_EndRow = iRows - 2
        'm_StartCol
        'm_EndCol
 
        Cls
        PrintString 1, 1, "Game controller test program."
        PrintString 1, 2, "This program is free to use and distribute per GNU GPLv3 license."
        PrintString 1, 3, "Tests up to 4 controllers with 2 axes / 2 buttons each."
        PrintString 1, 4, "Plug in controllers and move them & press buttons."
        PrintString 1, 5, "-------------------------------------------------------------------------------"
 
        iGroupCount = 0
 
        For iController = 1 To iNumControllers
            For iLoop = 1 To arrController(iController).axisCount ' A loop for each axis
                strAxis = Right$("  " + cstr$(iLoop), 2)
 
                sLine = ""
 
                ' display their status to the screen
                sLine = sLine + "Player " + cstr$(iController)
 
                strValue = FormatNumber$(arrAxis(iController, iLoop), iDigits)
                sLine = sLine + ",   Axis #" + strAxis + " = " + strValue
 
                'strValue = FormatNumber$(arrAxisMin(iController, iLoop), iDigits)
                'sLine = sLine + ", Min=" + strValue
                '
                'strValue = FormatNumber$(arrAxisMax(iController, iLoop), iDigits)
                'sLine = sLine + ", Max=" + strValue
                '
                '' COMPUTE AVERAGE
                'dblAverage = arrAxisAvg(iController, iLoop) / 10
                'dblAverage = RoundUpDouble# (dblAverage, 3)
                'strValue = FormatNumber$(dblAverage, iDigits)
                'sLine = sLine + ", Avg=" + strValue
                '
                '' CLEAR THE AVERAGE
                'arrAxisAvg(iController, iLoop) = 0
 
                PrintColumn sLine
            Next iLoop
            For iLoop = 1 To arrController(iController).buttonCount ' A loop for each button
                strAxis = Right$("  " + cstr$(iLoop), 2)
 
                sLine = ""
 
                ' display their status to the screen
                sLine = sLine + "Player " + cstr$(iController)
 
                strValue = FormatNumber$(arrButton(iController, iLoop), iDigits)
                sLine = sLine + ", Button #" + strAxis + " = " + strValue
 
                'strValue = FormatNumber$(arrButtonMin(iController, iLoop), iDigits)
                'sLine = sLine + ", Min=" + strValue
                '
                'strValue = FormatNumber$(arrButtonMax(iController, iLoop), iDigits)
                'sLine = sLine + ", Max=" + strValue
 
                PrintColumn sLine
            Next iLoop
 
            iGroupCount = iGroupCount + 1
            If iGroupCount = 2 Then
                ColumnBreak
                iGroupCount = 0
            End If
 
        Next iController
 
        PrintString 1, iRows - 1, "-------------------------------------------------------------------------------"
        PrintString 1, iRows - 0, "PRESS <ESC> TO EXIT"
 
        'end if
 
        _Limit 30
    Loop Until _KeyHit = 27 ' ESCAPE to quit
 
    ' RETURN TO TEXT SCREEN
    Screen 0
End Sub ' TestJoysticks1
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN FILE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
' File format is comma-delimited
' containing controller info for one action per line
' where each line contains the following in this order:
 
' TAB ORDER   INFO             TYPE      DESCRIPTION
' 1           {player #}       Integer   player # this mapping is for
' 2           {which action}   Integer   which action this mapping is for (up/down/right/left/button 1/button 2, etc.)
' 3           {device #}       Integer   number of the device this is mapped to
' 4           {type}           Integer   type of input (one of: cInputKey, cInputButton, cInputAxis)
' 5           {which}          Integer   if button the _BUTTON #, if axis the _AXIS #, if keyboard the _BUTTON #
' 6           {value}          Integer   if axis, the value (-1 or 1), else can be ignored
 
' These need to be declared globally and populated:
'     ReDim Shared m_arrControlMap(1 To 8, 1 To 8) As ControlInputType
'     Dim Shared m_ControlMapFileName$: m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
 
' If there is an error, returns error message,
' else returns blank string.
 
Function SaveControllerMap$
    Dim RoutineName As String:: RoutineName = "SaveControllerMap$"
    Dim sResult As String: sResult = ""
    Dim sError As String: sError = ""
    Dim sFile As String
    Dim in$
    Dim iPlayer As Integer
    Dim iWhichInput As Integer
    Dim sLine As String
    Dim iCount As Long: iCount = 0
    'Dim iError As Long: iError = 0
    Dim sDelim As String: sDelim = "," ' CHR$(9)
 
    DebugPrint "--------------------------------------------------------------------------------"
    DebugPrint "Started " + RoutineName
    DebugPrint "--------------------------------------------------------------------------------"
 
    ' Get file name
    If Len(m_ControlMapFileName$) = 0 Then
        m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
    End If
    sFile = Mid$(m_ControlMapFileName$, _InStrRev(m_ControlMapFileName$, "\") + 1)
 
    '_KeyClear
    'Cls
    'Print "SAVE CONTROLLER MAPPING:"
    'Print "Default file name is " + Chr$(34) + m_ControlMapFileName$ + Chr$(34) + "."
    'Input "Type save file name, or blank for default: ", in$
    'in$ = _Trim$(in$)
    'If Len(in$) > 0 Then
    '    m_ControlMapFileName$ = in$
    'End If
    'sFile = m_ProgramPath$ + m_ControlMapFileName$
 
    DebugPrint "m_ControlMapFileName$=" + Chr$(34) + m_ControlMapFileName$ + Chr$(34)
 
    ' Save mapping to file
    Open m_ControlMapFileName$ For Output As #1
 
    For iPlayer = LBound(m_arrControlMap, 1) To UBound(m_arrControlMap, 1)
        For iWhichInput = LBound(m_arrControlMap, 2) To UBound(m_arrControlMap, 2)
            sLine = ""
 
            sLine = sLine + _Trim$(Str$(iPlayer))
            sLine = sLine + sDelim
 
            sLine = sLine + _Trim$(Str$(iWhichInput))
            sLine = sLine + sDelim
 
            sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).device))
            sLine = sLine + sDelim
 
            sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).typ))
            sLine = sLine + sDelim
 
            sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).code))
            sLine = sLine + sDelim
 
            sLine = sLine + _Trim$(Str$(m_arrControlMap(iPlayer, iWhichInput).value))
 
            Print #1, sLine
            iCount = iCount + 1
        Next iWhichInput
    Next iPlayer
 
    Close #1
 
    DebugPrint "Wrote   " + _Trim$(Str$(iCount)) + " lines."
    'Print "Skipped " + _Trim$(Str$(iError)) + " lines."
    DebugPrint ""
    'Input "PRESS <ENTER> TO CONTINUE", in$
 
    If Len(sError) = 0 Then
        sResult = "Saved mapping file " + Chr$(34) + sFile + Chr$(34) + "."
    Else
        sResult = "ERRORS: " + sError
    End If
 
    SaveControllerMap$ = sResult
End Function ' SaveControllerMap$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function LoadControllerMap$
    Dim RoutineName As String:: RoutineName = "LoadControllerMap$"
    Dim sResult As String: sResult = ""
    Dim sError As String: sError = ""
    Dim sNextErr As String
 
    Dim sFile As String
    Dim sText As String
    Dim iTotal As Long: iTotal = 0
 
    Dim iRead As Long: iRead = 0
    Dim iValid As Long: iValid = 0
    Dim iBad As Long: iBad = 0
    Dim iBlank As Long: iBlank = 0
 
    Dim sLine As String
    ReDim arrNextLine(-1) As String
    Dim iNumValues As Integer
    Dim iAdjust As Integer
 
    Dim iPlayer As Integer
    Dim iWhichInput As Integer
    Dim iDevice As Integer
    Dim iType As Integer
    Dim iCode As Integer
    Dim iValue As Integer
 
    'Dim sDebugLine As String
 
    DebugPrint "--------------------------------------------------------------------------------"
    DebugPrint "Started " + RoutineName
    DebugPrint "--------------------------------------------------------------------------------"
 
    ' Get file name
    If Len(sError) = 0 Then
        If Len(m_ControlMapFileName$) = 0 Then
            m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
        End If
        sFile = Mid$(m_ControlMapFileName$, _InStrRev(m_ControlMapFileName$, "\") + 1)
    End If
 
    '' Get file name
    'If Len(sError) = 0 Then
    '    Cls
    '    If Len(m_ControlMapFileName$) = 0 Then
    '        m_ControlMapFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "map.txt"
    '    End If
    '    Print "LOAD CONTROLLER MAPPING:"
    '    Print "Default file name is " + Chr$(34) + m_ControlMapFileName$ + Chr$(34) + "."
    '    Input "Type name of file to open, or blank for default: ", in$
    '    in$ = _Trim$(in$)
    '    If Len(in$) > 0 Then
    '        m_ControlMapFileName$ = in$
    '    End If
    '    sFile = m_ProgramPath$ + m_ControlMapFileName$
    'End If
 
    ' Make sure file exists
    If Len(sError) = 0 Then
        If _FileExists(m_ControlMapFileName$) = FALSE Then
            sError = "File not found: " + Chr$(34) + m_ControlMapFileName$ + Chr$(34)
        Else
            DebugPrint "Found file: " + Chr$(34) + m_ControlMapFileName$ + Chr$(34)
        End If
    End If
 
    ' Read data from file
    If Len(sError) = 0 Then
        DebugPrint "OPEN m_ControlMapFileName$ FOR BINARY AS #1"
 
        Open m_ControlMapFileName$ For Binary As #1
        sText = Space$(LOF(1))
        Get #1, , sText
        Close #1
        iTotal = Len(sText) - Len(Replace$(sText, Chr$(13), ""))
        sText = ""
 
        Open m_ControlMapFileName$ For Input As #1
        While Not EOF(1)
            'INPUT #1, sLine
            Line Input #1, sLine ' read entire text file line
 
            iRead = iRead + 1
            DebugPrint "Parsing line " + _Trim$(Str$(iRead)) + _
                " of " + _Trim$(Str$(iTotal))
 
            sLine = Replace$(sLine, " ", "") ' Remove spaces
            sLine = Replace$(sLine, Chr$(9), "") ' Remove tabs
            sLine = Replace$(sLine, Chr$(10), "") ' Remove line breaks
            sLine = Replace$(sLine, Chr$(13), "") ' Remove carriage returns
            DebugPrint "    Trimmed=" + Chr$(34) + sLine + Chr$(34)
 
            If Len(sLine) > 0 Then
                split sLine, ",", arrNextLine()
                DebugPrint "split into arrNextLine()"
                DebugPrint "    lbound =" + _Trim$(Str$(LBound(arrNextLine))) '+ CHR$(10)
                DebugPrint "    ubound =" + _Trim$(Str$(UBound(arrNextLine))) '+ CHR$(10)
 
                iNumValues = (UBound(arrNextLine) - LBound(arrNextLine)) + 1
                If iNumValues > 5 Then
                    iAdjust = -1 '- lbound(arrNextLine)
 
                    If Len(sNextErr) = 0 Then
                        If IsNum%(arrNextLine(1 + iAdjust)) = TRUE Then
                            iPlayer = Val(arrNextLine(1 + iAdjust))
                        Else
                            sNextErr = "Error on line " + cstr$(iRead) + ", value 1: not a number"
                        End If
                    End If
 
                    If Len(sNextErr) = 0 Then
                        If IsNum%(arrNextLine(2 + iAdjust)) = TRUE Then
                            iWhichInput = Val(arrNextLine(2 + iAdjust))
                        Else
                            sNextErr = "Error on line " + cstr$(iRead) + ", value 2: not a number"
                        End If
                    End If
 
                    If Len(sNextErr) = 0 Then
                        If IsNum%(arrNextLine(3 + iAdjust)) = TRUE Then
                            iDevice = Val(arrNextLine(3 + iAdjust))
                        Else
                            sNextErr = "Error on line " + cstr$(iRead) + ", value 3: not a number"
                        End If
                    End If
 
                    If Len(sNextErr) = 0 Then
                        If IsNum%(arrNextLine(4 + iAdjust)) = TRUE Then
                            iType = Val(arrNextLine(4 + iAdjust))
                        Else
                            sNextErr = "Error on line " + cstr$(iRead) + ", value 4: not a number"
                        End If
                    End If
 
                    If Len(sNextErr) = 0 Then
                        If IsNum%(arrNextLine(5 + iAdjust)) = TRUE Then
                            iCode = Val(arrNextLine(5 + iAdjust))
                        Else
                            sNextErr = "Error on line " + cstr$(iRead) + ", value 5: not a number"
                        End If
                    End If
 
                    If Len(sNextErr) = 0 Then
                        If IsNum%(arrNextLine(6 + iAdjust)) = TRUE Then
                            iValue = Val(arrNextLine(6 + iAdjust))
                        Else
                            sNextErr = "Error on line " + cstr$(iRead) + ", value 6: not a number"
                        End If
                    End If
 
                    ' validate iPlayer
                    If Len(sNextErr) = 0 Then
                        If iPlayer < LBound(m_arrControlMap, 1) Then
                            sNextErr = "Player value " + _Trim$(Str$(iPlayer)) + _
                                " is outside lbound(m_arrControlMap, 1) " + _
                                " which is " + _Trim$(Str$(lbound(m_arrControlMap, 1))) + "."
                        ElseIf iPlayer > UBound(m_arrControlMap, 1) Then
                            sNextErr = "Player value " + _Trim$(Str$(iPlayer)) + _
                                " is outside ubound(m_arrControlMap, 1) " + _
                                " which is " + _Trim$(Str$(ubound(m_arrControlMap, 1))) + "."
                        End If
                    End If
 
                    ' validate iWhichInput
                    If Len(sNextErr) = 0 Then
                        If iWhichInput < LBound(m_arrControlMap, 2) Then
                            sNextErr = "WhichInput value " + _Trim$(Str$(iWhichInput)) + _
                                " is outside lbound(m_arrControlMap, 2) " + _
                                " which is " + _Trim$(Str$(lbound(m_arrControlMap, 2))) + "."
                        ElseIf iWhichInput > UBound(m_arrControlMap, 2) Then
                            sNextErr = "WhichInput value " + _Trim$(Str$(iWhichInput)) + _
                                " is outside ubound(m_arrControlMap, 2) " + _
                                " which is " + _Trim$(Str$(ubound(m_arrControlMap, 2))) + "."
                        End If
                    End If
 
                Else
                    sNextErr = "Error on line " + cstr$(iRead) + ": detected " + cstr$(iNumValues) + " values, expected 6."
                End If
 
                If Len(sNextErr) = 0 Then
                    iValid = iValid + 1
                    m_arrControlMap(iPlayer, iWhichInput).device = iDevice
                    m_arrControlMap(iPlayer, iWhichInput).typ = iType
                    m_arrControlMap(iPlayer, iWhichInput).code = iCode
                    m_arrControlMap(iPlayer, iWhichInput).value = iValue
                Else
                    iBad = iBad + 1
                    DebugPrint sNextErr
                End If
            Else
                DebugPrint "    Line is blank: skipped"
                iBlank = iBlank + 1
            End If ' LEN(sLine) > 0
 
        Wend
        Close #1
    End If
 
    DebugPrint ""
    DebugPrint "Lines read: " + _Trim$(Str$(iRead))
    DebugPrint "Valid     : " + _Trim$(Str$(iValid))
    DebugPrint "Invalid   : " + _Trim$(Str$(iErrors))
    DebugPrint "Blank     : " + _Trim$(Str$(iBlank))
    DebugPrint ""
    'Input "PRESS <ENTER> TO CONTINUE", in$
 
    If Len(sError) = 0 Then
        sResult = "Loaded mapping file " + Chr$(34) + sFile + Chr$(34) + "."
    Else
        sResult = "ERRORS: " + sError
    End If
 
    LoadControllerMap$ = sResult
End Function ' LoadControllerMap$
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END FILE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GRAPHIC PRINTING ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
' Eliminates the math.
 
' Text resolution:
'  648 x  480:  80 x 30
'  720 x  480:  90 x 30
'  800 x  600: 100 x 37
' 1024 x  768: 128 x 48
' 1280 x 1024: 160 x 64
' 1920 x 1080: 240 x 67
' 2048 x 1152: 256 x 72 (truncated after 70 rows, 255 columns)
' 3840 x 2160: 480 x135 (truncated after 133 rows, 479 columns)
 
Sub PrintString (iCol As Integer, iRow As Integer, MyString As String)
    Dim iCols As Integer
    Dim iRows As Integer
    Dim iX As Integer
    Dim iY As Integer
    iCols = _Width(0) \ _FontWidth
    iRows = _Height(0) \ _FontHeight
    iX = _FontWidth * (iCol - 1)
    iY = _FontHeight * (iRow - 1)
    _PrintString (iX, iY), MyString
End Sub ' PrintString
 
' /////////////////////////////////////////////////////////////////////////////
' A way to automatically print to columns.
 
' Depends on the following shared variables:
'     Dim Shared m_NumColumns As Integer : m_NumColumns = 1
'     Dim Shared m_PrintRow As Integer : m_PrintRow = 0
'     Dim Shared m_PrintCol As Integer : m_PrintCol = 0
'     Dim Shared m_StartRow As Integer : m_StartRow = 0
'     Dim Shared m_EndRow As Integer : m_EndRow = 0
'     Dim Shared m_StartCol As Integer : m_StartCol = 0
'     Dim Shared m_EndCol As Integer : m_EndCol = 0
 
' InitColumns 2
' m_PrintRow = 5
' m_PrintCol = 2
' PrintColumn "Col 2, Row 5"
' PrintColumn "m_NumColumns=" + cstr$(m_NumColumns)
 
Sub PrintColumn (MyString As String)
    Dim iCols As Integer
    Dim iRows As Integer
    Dim iX As Integer
    Dim iY As Integer
 
    ReDim arrLines(-1) As String
    Dim iRow As Integer
    Dim iCol As Integer
    Dim sChar As String
    Dim sLine As String
    Dim iColWidth As Integer
 
    iCols = _Width(0) \ _FontWidth
    iRows = _Height(0) \ _FontHeight
 
    If m_NumColumns < 1 Or m_NumColumns > iCols Then
        m_NumColumns = 1
    End If
 
    If m_StartRow < 1 Or m_StartRow > iRows Then
        m_StartRow = 1
    End If
    If m_EndRow < m_StartRow Or m_EndRow > iRows Then
        m_EndRow = iRows
    End If
    If m_StartCol < 1 Or m_StartCol > m_NumColumns Then
        m_StartCol = 1
    End If
    If m_EndCol < m_StartCol Or m_EndCol > m_NumColumns Then
        m_EndCol = m_NumColumns
    End If
 
    If m_PrintRow < m_StartRow Then
        m_PrintRow = m_StartRow
    End If
    If m_PrintCol < m_StartCol Then
        m_PrintCol = m_StartCol
    End If
 
    iColWidth = iCols \ m_NumColumns
 
    If m_PrintRow <= m_EndRow Then
        If m_PrintCol <= m_EndCol Then
            split MyString, Chr$(13), arrLines()
            For iRow = 0 To UBound(arrlines)
                sLine = Left$(arrLines(iRow), iColWidth)
                'TODO: wrap remaining text
                iX = _FontWidth * ((m_PrintCol - 1) * iColWidth)
                iY = _FontHeight * (m_PrintRow - 1)
                _PrintString (iX, iY), sLine
 
                m_PrintRow = m_PrintRow + 1
                If m_PrintRow > m_EndRow Then
                    m_PrintRow = m_StartRow
                    m_PrintCol = m_PrintCol + 1
                    If m_PrintCol > m_NumColumns Then
                        'TODO: options for when we reach the bottom of the last column (stop printing, wrap around)
                        m_PrintCol = 1
                    End If
                End If
            Next iRow
        End If
    End If
End Sub ' PrintColumn
 
' /////////////////////////////////////////////////////////////////////////////
' A way to automatically print to columns.
 
Sub ColumnBreak ()
    m_PrintRow = m_StartRow
    m_PrintCol = m_PrintCol + 1
    If m_PrintCol > m_NumColumns Then
        'TODO: options for when we go past the last column (stop printing, wrap around)
    End If
End Sub ' ColumnBreak
 
' /////////////////////////////////////////////////////////////////////////////
' A way to automatically print to columns.
 
Sub InitColumns (iNumColumns As Integer)
    Dim iCols As Integer
    Dim iRows As Integer
    iCols = _Width(0) \ _FontWidth
    iRows = _Height(0) \ _FontHeight
    If iNumColumns < 1 Or iNumColumns > iCols Then
        m_NumColumns = 1
    Else
        m_NumColumns = iNumColumns
    End If
 
    If m_StartRow < 1 Or m_StartRow > iRows Then
        m_StartRow = 1
    End If
    If m_EndRow < m_StartRow Or m_EndRow > iRows Then
        m_EndRow = iRows
    End If
    If m_StartCol < 1 Or m_StartCol > m_NumColumns Then
        m_StartCol = 1
    End If
    If m_EndCol < m_StartCol Or m_EndCol > m_NumColumns Then
        m_EndCol = m_NumColumns
    End If
 
    m_PrintRow = 1
    m_PrintCol = 1
End Sub ' InitColumns
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GRAPHIC PRINTING ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DEBUGGING ROUTINES #DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub DebugPrint (s$)
    If m_bTesting = TRUE Then
        _Echo s$
        'ReDim arrLines$(0)
        'dim delim$ : delim$ = Chr$(13)
        'split MyString, delim$, arrLines$()
    End If
End Sub ' DebugPrint
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DEBUGGING ROUTINES @DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE ROUTINES #GEN
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
' Convert a value to string and trim it (because normal Str$ adds spaces)
 
Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
 
' /////////////////////////////////////////////////////////////////////////////
' Convert a Long value to string and trim it (because normal Str$ adds spaces)
 
Function cstrl$ (myValue As Long)
    cstrl$ = _Trim$(Str$(myValue))
End Function ' cstrl$
 
' /////////////////////////////////////////////////////////////////////////////
' Convert a Single value to string and trim it (because normal Str$ adds spaces)
 
Function cstrs$ (myValue As Single)
    ''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstrs$ = _Trim$(Str$(myValue))
End Function ' cstrs$
 
' /////////////////////////////////////////////////////////////////////////////
' Convert an unsigned Long value to string and trim it (because normal Str$ adds spaces)
 
Function cstrul$ (myValue As _Unsigned Long)
    cstrul$ = _Trim$(Str$(myValue))
End Function ' cstrul$
 
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
 
' Example: A string function that displays extremely small or large exponential decimal values.
 
Function DblToStr$ (n#)
    value$ = UCase$(LTrim$(Str$(n#)))
    Xpos% = InStr(value$, "D") + InStr(value$, "E") 'only D or E can be present
    If Xpos% Then
        expo% = Val(Mid$(value$, Xpos% + 1))
        If Val(value$) < 0 Then
            sign$ = "-": valu$ = Mid$(value$, 2, Xpos% - 2)
        Else valu$ = Mid$(value$, 1, Xpos% - 1)
        End If
        dot% = InStr(valu$, "."): L% = Len(valu$)
        If expo% > 0 Then add$ = String$(expo% - (L% - dot%), "0")
        If expo% < 0 Then min$ = String$(Abs(expo%) - (dot% - 1), "0"): DP$ = "."
        For n = 1 To L%
            If Mid$(valu$, n, 1) <> "." Then num$ = num$ + Mid$(valu$, n, 1)
        Next
    Else DblToStr$ = value$: Exit Function
    End If
    DblToStr$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
End Function ' DblToStr$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function FormatNumber$ (myValue, iDigits As Integer)
    Dim strValue As String
    strValue = DblToStr$(myValue) + String$(iDigits, " ")
    If myValue < 1 Then
        If myValue < 0 Then
            strValue = Replace$(strValue, "-.", "-0.")
        ElseIf myValue > 0 Then
            strValue = "0" + strValue
        End If
    End If
    FormatNumber$ = Left$(strValue, iDigits)
End Function ' FormatNumber$
 
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
 
' Returns the 8-bit binary representation
' of an integer iInput where 0 <= iInput <= 255
 
Function GetBinary$ (iInput1 As Integer)
    Dim sResult As String
    Dim iLoop As Integer
    Dim iInput As Integer: iInput = iInput1
 
    sResult = ""
 
    If iInput >= 0 And iInput <= 255 Then
        For iLoop = 1 To 8
            sResult = LTrim$(RTrim$(Str$(iInput Mod 2))) + sResult
            iInput = iInput \ 2
            'If iLoop = 4 Then sResult = " " + sResult
        Next iLoop
    End If
 
    GetBinary$ = sResult
End Function ' GetBinary$
 
' /////////////////////////////////////////////////////////////////////////////
' wonderfully inefficient way to read if a bit is set
' ival = GetBit256%(int we are comparing, int containing the bits we want to read)
 
' See also: GetBit256%, SetBit256%
 
Function GetBit256% (iNum1 As Integer, iBit1 As Integer)
    Dim iResult As Integer
    Dim sNum As String
    Dim sBit As String
    Dim iLoop As Integer
    Dim bContinue As Integer
    'DIM iTemp AS INTEGER
    Dim iNum As Integer: iNum = iNum1
    Dim iBit As Integer: iBit = iBit1
 
    iResult = FALSE
    bContinue = TRUE
 
    If iNum < 256 And iBit <= 128 Then
        sNum = GetBinary$(iNum)
        sBit = GetBinary$(iBit)
        For iLoop = 1 To 8
            If Mid$(sBit, iLoop, 1) = "1" Then
                'if any of the bits in iBit are false, return false
                If Mid$(sNum, iLoop, 1) = "0" Then
                    iResult = FALSE
                    bContinue = FALSE
                    Exit For
                End If
            End If
        Next iLoop
        If bContinue = TRUE Then
            iResult = TRUE
        End If
    End If
 
    GetBit256% = iResult
End Function ' GetBit256%
 
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
 
' Returns the integer that corresponds to a binary string of length 8
 
Function GetIntegerFromBinary% (sBinary1 As String)
    Dim iResult As Integer
    Dim iLoop As Integer
    Dim strBinary As String
    Dim sBinary As String: sBinary = sBinary1
 
    iResult = 0
    strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
    For iLoop = 0 To Len(strBinary) - 1
        iResult = iResult + 2 ^ iLoop * Val(Mid$(strBinary, Len(strBinary) - iLoop, 1))
    Next iLoop
 
    GetIntegerFromBinary% = iResult
End Function ' GetIntegerFromBinary%
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsEven% (n)
    If n Mod 2 = 0 Then
        IsEven% = TRUE
    Else
        IsEven% = FALSE
    End If
End Function ' IsEven%
 
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
 
Function IsOdd% (n)
    If n Mod 2 = 1 Then
        IsOdd% = TRUE
    Else
        IsOdd% = FALSE
    End If
End Function ' IsOdd%
 
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
 
Function IsNum% (text$)
    Dim a$
    Dim b$
    a$ = _Trim$(text$)
    b$ = _Trim$(Str$(Val(text$)))
    If a$ = b$ Then
        IsNum% = TRUE
    Else
        IsNum% = FALSE
    End If
End Function ' IsNum%
 
' /////////////////////////////////////////////////////////////////////////////
' Re: Does a Is Number function exist in QB64?
' https://www.qb64.org/forum/index.php?topic=896.15
 
' MWheatley
' « Reply #18 on: January 01, 2019, 11:24:30 AM »
 
' returns 1 if string is an integer, 0 if not
Function IsNumber (text$)
    Dim i As Integer
 
    IsNumber = 1
    For i = 1 To Len(text$)
        If Asc(Mid$(text$, i, 1)) < 45 Or Asc(Mid$(text$, i, 1)) >= 58 Then
            IsNumber = 0
            Exit For
        ElseIf Asc(Mid$(text$, i, 1)) = 47 Then
            IsNumber = 0
            Exit For
        End If
    Next i
End Function ' IsNumber
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
 
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
 
Function join$ (in$(), delimiter$)
    Dim result$
    Dim i As Long
    result$ = in$(LBound(in$))
    For i = LBound(in$) + 1 To UBound(in$)
        result$ = result$ + delimiter$ + in$(i)
    Next i
    join$ = result$
End Function ' join$
 
' /////////////////////////////////////////////////////////////////////////////
' ABS was returning strange values with type LONG
' so I created this which does not.
 
Function LongABS& (lngValue As Long)
    If Sgn(lngValue) = -1 Then
        LongABS& = 0 - lngValue
    Else
        LongABS& = lngValue
    End If
End Function ' LongABS&
 
' /////////////////////////////////////////////////////////////////////////////
' Writes sText to a debug file in the EXE folder.
' Debug file is named the same thing as the program EXE name with ".txt" at the end.
' For example the program "C:\QB64\MyProgram.BAS" running as
' "C:\QB64\MyProgram.EXE" would have an output file "C:\QB64\MyProgram.EXE.txt".
' If the file doesn't exist, it is created, otherwise it is appended to.
 
Sub DebugPrintFile (sText As String)
    Dim sFileName As String
    Dim sError As String
    Dim sOut As String
 
    sFileName = ProgramPath$ + ProgramName$ + ".txt"
    sError = ""
    If _FileExists(sFileName) = FALSE Then
        sOut = ""
        sOut = sOut + "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + Chr$(13) + Chr$(10)
        sOut = sOut + "PROGRAM : " + ProgramName$ + Chr$(13) + Chr$(10)
        sOut = sOut + "RUN DATE: " + CurrentDateTime$ + Chr$(13) + Chr$(10)
        sOut = sOut + "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + Chr$(13) + Chr$(10)
        sError = PrintFile$(sFileName, sOut, FALSE)
    End If
    If Len(sError) = 0 Then
        sError = PrintFile$(sFileName, sText, TRUE)
    End If
    If Len(sError) <> 0 Then
        Print CurrentDateTime$ + " DebugPrintFile FAILED: " + sError
    End If
End Sub ' DebugPrintFile
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IntPadRight$ (iValue As Integer, iWidth As Integer)
    IntPadRight$ = Left$(_Trim$(Str$(iValue)) + String$(iWidth, " "), iWidth)
End Function ' IntPadRight$
 
' /////////////////////////////////////////////////////////////////////////////
' Returns blank if successful else returns error message.
 
Function PrintFile$ (sFileName As String, sText As String, bAppend As Integer)
    'x = 1: y = 2: z$ = "Three"
 
    Dim sError As String: sError = ""
 
    If Len(sError) = 0 Then
        If (bAppend = TRUE) Then
            If _FileExists(sFileName) Then
                Open sFileName For Append As #1 ' opens an existing file for appending
            Else
                sError = "Error in PrintFile$ : File not found. Cannot append."
            End If
        Else
            Open sFileName For Output As #1 ' opens and clears an existing file or creates new empty file
        End If
    End If
    If Len(sError) = 0 Then
        ' WRITE places text in quotes in the file
        'WRITE #1, x, y, z$
        'WRITE #1, sText
 
        ' PRINT does not put text inside quotes
        Print #1, sText
 
        Close #1
 
        'PRINT "File created with data. Press a key!"
        'K$ = INPUT$(1) 'press a key
 
        'OPEN sFileName FOR INPUT AS #2 ' opens a file to read it
        'INPUT #2, a, b, c$
        'CLOSE #2
 
        'PRINT a, b, c$
        'WRITE a, b, c$
    End If
 
    PrintFile$ = sError
End Function ' PrintFile$
 
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
Function RandomNumber% (Min%, Max%)
    Dim NumSpread%
 
    ' SET RANDOM SEED
    'Randomize ' Initialize random-number generator.
    Randomize Timer
 
    ' GET RANDOM # Min%-Max%
    'RandomNumber = Int((Max * Rnd) + Min) ' generate number
 
    NumSpread% = (Max% - Min%) + 1
 
    RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
 
End Function ' RandomNumber%
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub RandomNumberTest
    Dim iCols As Integer: iCols = 10
    Dim iRows As Integer: iRows = 20
    Dim iLoop As Integer
    Dim iX As Integer
    Dim iY As Integer
    Dim sError As String
    Dim sFileName As String
    Dim sText As String
    Dim bAppend As Integer
    Dim iMin As Integer
    Dim iMax As Integer
    Dim iNum As Integer
    Dim iErrorCount As Integer
    Dim sInput$
 
    sFileName = "c:\temp\maze_test_1.txt"
    sText = "Count" + Chr$(9) + "Min" + Chr$(9) + "Max" + Chr$(9) + "Random"
    bAppend = FALSE
    sError = PrintFile$(sFileName, sText, bAppend)
    If Len(sError) = 0 Then
        bAppend = TRUE
        iErrorCount = 0
 
        iMin = 0
        iMax = iCols - 1
        For iLoop = 1 To 100
            iNum = RandomNumber%(iMin, iMax)
            sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
            sError = PrintFile$(sFileName, sText, bAppend)
            If Len(sError) > 0 Then
                iErrorCount = iErrorCount + 1
                Print Str$(iLoop) + ". ERROR"
                Print "    " + "iMin=" + Str$(iMin)
                Print "    " + "iMax=" + Str$(iMax)
                Print "    " + "iNum=" + Str$(iNum)
                Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
                Print "    " + sError
            End If
        Next iLoop
 
        iMin = 0
        iMax = iRows - 1
        For iLoop = 1 To 100
            iNum = RandomNumber%(iMin, iMax)
            sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
            sError = PrintFile$(sFileName, sText, bAppend)
            If Len(sError) > 0 Then
                iErrorCount = iErrorCount + 1
                Print Str$(iLoop) + ". ERROR"
                Print "    " + "iMin=" + Str$(iMin)
                Print "    " + "iMax=" + Str$(iMax)
                Print "    " + "iNum=" + Str$(iNum)
                Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
                Print "    " + sError
            End If
        Next iLoop
 
        Print "Finished generating numbers. Errors: " + Str$(iErrorCount)
    Else
        Print "Error creating file " + Chr$(34) + sFileName + Chr$(34) + "."
        Print sError
    End If
 
    Input "Press <ENTER> to continue", sInput$
End Sub ' RandomNumberTest
 
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' found at abandoned, outdated and now likely malicious qb64 dot net website
' http://www.qb64.[net]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.qb64.org)
'   Revision: 1.6
'   Updated:  5/28/2012
 
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
 
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.
 
    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1
 
    lngLocation = InStr(1, Text2, Find2)
 
    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)
 
        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
 
        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter
 
        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)
 
        ' Next instance of [Find2]...
    Wend
 
    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub ReplaceTest
    Dim in$
 
    Print "-------------------------------------------------------------------------------"
    Print "ReplaceTest"
    Print
 
    Print "Original value"
    in$ = "Thiz iz a teZt."
    Print "in$ = " + Chr$(34) + in$ + Chr$(34)
    Print
 
    Print "Replacing lowercase " + Chr$(34) + "z" + Chr$(34) + " with " + Chr$(34) + "s" + Chr$(34) + "..."
    in$ = Replace$(in$, "z", "s")
    Print "in$ = " + Chr$(34) + in$ + Chr$(34)
    Print
 
    Print "Replacing uppercase " + Chr$(34) + "Z" + Chr$(34) + " with " + Chr$(34) + "s" + Chr$(34) + "..."
    in$ = Replace$(in$, "Z", "s")
    Print "in$ = " + Chr$(34) + in$ + Chr$(34)
    Print
 
    Print "ReplaceTest finished."
End Sub ' ReplaceTest
 
' /////////////////////////////////////////////////////////////////////////////
' https://www.qb64.org/forum/index.php?topic=3605.0
' Quote from: SMcNeill on Today at 03:53:48 PM
'
' Sometimes, you guys make things entirely too  complicated.
' There ya go!  Three functions to either round naturally,
' always round down, or always round up, to whatever number of digits you desire.
' EDIT:  Modified to add another option to round scientific,
' since you had it's description included in your example.
 
Function Round## (num##, digits%)
    Round## = Int(num## * 10 ^ digits% + .5) / 10 ^ digits%
End Function
 
Function RoundUp## (num##, digits%)
    RoundUp## = _Ceil(num## * 10 ^ digits%) / 10 ^ digits%
End Function
 
Function RoundDown## (num##, digits%)
    RoundDown## = Int(num## * 10 ^ digits%) / 10 ^ digits%
End Function
 
Function Round_Scientific## (num##, digits%)
    Round_Scientific## = _Round(num## * 10 ^ digits%) / 10 ^ digits%
End Function
 
Function RoundUpDouble# (num#, digits%)
    RoundUpDouble# = _Ceil(num# * 10 ^ digits%) / 10 ^ digits%
End Function
 
Function RoundUpSingle! (num!, digits%)
    RoundUpSingle! = _Ceil(num! * 10 ^ digits%) / 10 ^ digits%
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' fantastically inefficient way to set a bit
 
' example use: arrMaze(iX, iY) = SetBit256%(arrMaze(iX, iY), cS, FALSE)
 
' See also: GetBit256%, SetBit256%
 
' newint=SetBit256%(oldint, int containing the bits we want to set, value to set them to)
Function SetBit256% (iNum1 As Integer, iBit1 As Integer, bVal1 As Integer)
    Dim sNum As String
    Dim sBit As String
    Dim sVal As String
    Dim iLoop As Integer
    Dim strResult As String
    Dim iResult As Integer
    Dim iNum As Integer: iNum = iNum1
    Dim iBit As Integer: iBit = iBit1
    Dim bVal As Integer: bVal = bVal1
 
    If iNum < 256 And iBit <= 128 Then
        sNum = GetBinary$(iNum)
        sBit = GetBinary$(iBit)
        If bVal = TRUE Then
            sVal = "1"
        Else
            sVal = "0"
        End If
        strResult = ""
        For iLoop = 1 To 8
            If Mid$(sBit, iLoop, 1) = "1" Then
                strResult = strResult + sVal
            Else
                strResult = strResult + Mid$(sNum, iLoop, 1)
            End If
        Next iLoop
        iResult = GetIntegerFromBinary%(strResult)
    Else
        iResult = iNum
    End If
 
    SetBit256% = iResult
End Function ' SetBit256%
 
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
 
' Example: A string function that displays extremely small or large exponential decimal values.
 
Function SngToStr$ (n!)
    value$ = UCase$(LTrim$(Str$(n!)))
    Xpos% = InStr(value$, "D") + InStr(value$, "E") 'only D or E can be present
    If Xpos% Then
        expo% = Val(Mid$(value$, Xpos% + 1))
        If Val(value$) < 0 Then
            sign$ = "-": valu$ = Mid$(value$, 2, Xpos% - 2)
        Else valu$ = Mid$(value$, 1, Xpos% - 1)
        End If
        dot% = InStr(valu$, "."): L% = Len(valu$)
        If expo% > 0 Then add$ = String$(expo% - (L% - dot%), "0")
        If expo% < 0 Then min$ = String$(Abs(expo%) - (dot% - 1), "0"): DP$ = "."
        For n = 1 To L%
            If Mid$(valu$, n, 1) <> "." Then num$ = num$ + Mid$(valu$, n, 1)
        Next
    Else SngToStr$ = value$: Exit Function
    End If
    SngToStr$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
End Function ' SngToStr$
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM »
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
 
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
 
' Modified to handle multi-character delimiters
 
Sub split (in$, delimiter$, result$())
    Dim start As Integer
    Dim finish As Integer
    Dim iDelimLen As Integer
    ReDim result$(-1)
 
    iDelimLen = Len(delimiter$)
 
    start = 1
    Do
        'While Mid$(in$, start, 1) = delimiter$
        While Mid$(in$, start, iDelimLen) = delimiter$
            'start = start + 1
            start = start + iDelimLen
            If start > Len(in$) Then
                Exit Sub
            End If
        Wend
        finish = InStr(start, in$, delimiter$)
        If finish = 0 Then
            finish = Len(in$) + 1
        End If
 
        ReDim _Preserve result$(0 To UBound(result$) + 1)
 
        result$(UBound(result$)) = Mid$(in$, start, finish - start)
        start = finish + 1
    Loop While start <= Len(in$)
End Sub ' split
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub SplitTest
    Dim in$
    Dim delim$
    ReDim arrTest$(0)
    Dim iLoop%
 
    delim$ = Chr$(10)
    in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
    Print "in$ = " + Chr$(34) + in$ + Chr$(34)
    Print "delim$ = " + Chr$(34) + delim$ + Chr$(34)
    split in$, delim$, arrTest$()
 
    For iLoop% = LBound(arrTest$) To UBound(arrTest$)
        Print "arrTest$(" + LTrim$(RTrim$(Str$(iLoop%))) + ") = " + Chr$(34) + arrTest$(iLoop%) + Chr$(34)
    Next iLoop%
    Print
    Print "Split test finished."
End Sub ' SplitTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub SplitAndReplaceTest
    Dim in$
    Dim out$
    Dim iLoop%
    ReDim arrTest$(0)
 
    Print "-------------------------------------------------------------------------------"
    Print "SplitAndReplaceTest"
    Print
 
    Print "Original value"
    in$ = "This line 1 " + Chr$(13) + Chr$(10) + "and line 2" + Chr$(10) + "and line 3 " + Chr$(13) + "finally THE END."
    out$ = in$
    out$ = Replace$(out$, Chr$(13), "\r")
    out$ = Replace$(out$, Chr$(10), "\n")
    out$ = Replace$(out$, Chr$(9), "\t")
    Print "in$ = " + Chr$(34) + out$ + Chr$(34)
    Print
 
    Print "Fixing linebreaks..."
    in$ = Replace$(in$, Chr$(13) + Chr$(10), Chr$(13))
    in$ = Replace$(in$, Chr$(10), Chr$(13))
    out$ = in$
    out$ = Replace$(out$, Chr$(13), "\r")
    out$ = Replace$(out$, Chr$(10), "\n")
    out$ = Replace$(out$, Chr$(9), "\t")
    Print "in$ = " + Chr$(34) + out$ + Chr$(34)
    Print
 
    Print "Splitting up..."
    split in$, Chr$(13), arrTest$()
 
    For iLoop% = LBound(arrTest$) To UBound(arrTest$)
        out$ = arrTest$(iLoop%)
        out$ = Replace$(out$, Chr$(13), "\r")
        out$ = Replace$(out$, Chr$(10), "\n")
        out$ = Replace$(out$, Chr$(9), "\t")
        Print "arrTest$(" + cstr$(iLoop%) + ") = " + Chr$(34) + out$ + Chr$(34)
    Next iLoop%
    Print
 
    Print "SplitAndReplaceTest finished."
End Sub ' SplitAndReplaceTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Function StrPadRight$ (sValue As String, iWidth As Integer)
    StrPadRight$ = Left$(sValue + String$(iWidth, " "), iWidth)
End Function ' StrPadRight$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function TrueFalse$ (myValue)
    If myValue = TRUE Then
        TrueFalse$ = "TRUE"
    Else
        TrueFalse$ = "FALSE"
    End If
End Function ' TrueFalse$
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' #END
' ################################################################################################################################################################
 

madscijr · « **Reply #3 on:** January 06, 2022, 10:40:41 pm »

Quote from: Cobalt on January 06, 2022, 10:12:58 pm

If you don't get these figured out soon, perhaps take a look at my Zelda clone work.

I did get those issues figured out, but another one popped up.
I will definitely give your code a look, thanks for your help!

madscijr · « **Reply #4 on:** January 06, 2022, 11:30:58 pm »

Quote from: Cobalt on January 06, 2022, 10:12:58 pm

This is the last update of this version of my Zelda clone, as I messed the data structure up and cant get certain effects and extras to work. Also at some point I broke the ability to shoot the sword,(you still can but it throws some errors you have to OK though).

How about just rolling back to the last stable version, and merging the updates back in a little at a time until you get the bugs worked out? Beyond Compare makes it easy.
It looks like you put a lot of work into this and it would be a shame to let it go to waste!

News:

Author Topic: WIP: game input mapping for gamepad, keyboard, v0.90 (Read 3667 times)

madscijr

WIP: game input mapping for gamepad, keyboard, v0.90

Cobalt

Re: WIP: game input mapping for gamepad, keyboard, v0.90

madscijr

Re: WIP: game input mapping for gamepad, keyboard, v0.90

madscijr

Re: WIP: game input mapping for gamepad, keyboard, v0.90

madscijr

Re: WIP: game input mapping for gamepad, keyboard, v0.90