' ################################################################################################################################################################
' #TOP
' Basic Input Mapper, Barebones Octo edition.
' Version 2.00 by madscijr
' CHANGE LOG:
' Date Who What
' 12/16/2020 madscijr detect keys 0.70
' 02/17/2021 madscijr basic game controller test
' 01/08/2022 madscijr input mapping v1.0
' keyboard + game controllers
' text menu driven (no GUI)
' 01/21/2022 madscijr input mapping v2.0 with simple GUI
' DESCRIPTION:
' A way to map input controls (gamepad + keyboard)
' load/save mapping to a file, and read the input,
' that you can use in your own games.
' ################################################################################################################################################################
' BASIC SETTINGS
' ################################################################################################################################################################
' #CONSTANTS = GLOBAL CONSTANTS
' boolean constants:
' BEGIN GAME CONTROLLER MAPPING CONSTANTS
Const cMaxControllers
= 8
' Use as index for array of ControlInputType
Const c_iKeyDown_F10
= 17408 Const c_iKeyHit_AltLeft
= -30764 Const c_iKeyHit_AltRight
= -30765 ' END GAME CONTROLLER MAPPING CONSTANTS
' BEGIN TEXT GUI CONSTANTS
Const cTextGuiSection
= 1 Const cTextGuiUnknown
= 0
Const cJustifyUnknown
= 0
' END TEXT GUI CONSTANTS
' ################################################################################################################################################################
' #UDT #TYPES = USER DEFINED TYPES
' UDT TO HOLD THE INFO FOR A PLAYER
c
As Integer ' character to display on screen
' control buffer
' control previous move
'lastMoveX As Integer
'lastMoveY As Integer
'repeat As Integer
' UDT TO HOLD THE INFO FOR A GAME CONTROLLER
' UDT TO HOLD THE INFO FOR A GAME CONTROLLER
typ
As Integer ' cInputKey, cInputButton, cInputAxis
' UDT TO HOLD COLOR CODE INFO
' UDT TO HOLD TEXT GUI
typ
As Integer ' cTextGuiSection, cTextGuiButton 'index as integer
' DEFINES CLICKABLE BUTTON BOUNDARIES
typ
As Integer ' cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4 'index as integer
' DEFINES TEXT LABELS
item
As String ' "Section", "Up", "Down" name As String ' "caption", "type", "device", "code", "repeat", "value" row
As Integer ' row (relative to section y1) column
As Integer ' column (relative to section x1) justify
As Integer ' cJustifyLeft, cJustifyRight, cJustifyCenter, cJustifyUnknown caption
As String ' holds the label text 'index as integer
' DEFINES TEXT FIELDS
item
As String ' "Section", "Up", "Down" name As String ' "caption", "type", "device", "code", "repeat", "value" row
As Integer ' row (relative to section y1) column
As Integer ' column (relative to section x1) justify
As Integer ' cJustifyLeft, cJustifyRight, cJustifyCenter, cJustifyUnknown value
As String ' holds the formatted value as text 'index as integer
' FOR TEXT SCREEN
' ################################################################################################################################################################
' #VARS = GLOBAL VARIABLES
' ENABLE / DISABLE DEBUG CONSOLE
' BASIC PROGRAM METADATA
Dim Shared m_VersionInfo$: m_VersionInfo$
= "2.00"
' 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
' USE TO GLOBALLY ENABLE/DISABLE REPEATING INPUT PER FUNCTION
' To enable override set m_bRepeatOverride=TRUE,
' otherwise this can be configured for each individual controller
' when you map the functions.
' VARIABLES FOR GRAPHIC PRINTING ROUTINES
' VARIABLES FOR TEXT GUI
' DEMO GAME / TESTING
ReDim Shared m_arrPlayer
(1 To 8) As PlayerType
' holds info for each player
' =============================================================================
' LOCAL VARIABLES
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
_Echo "Started " + m_ProgramName$
' ****************************************************************************************************************************************************************
' =============================================================================
' START THE MAIN ROUTINE
main
' =============================================================================
' FINISH
Print m_ProgramName$
+ " finished." Input "Press <ENTER> to continue", in$
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
' ****************************************************************************************************************************************************************
System ' return control to the operating system
' /////////////////////////////////////////////////////////////////////////////
Dim result$: result$
= ""
' SET UP SCREEN
Print "Game Input Mapping Test " + m_VersionInfo$
Print "by Softintheheadware (Jan, 2022)"
Print "1. Basic controller test" Print "2. Load controller mapping" Print "3. View controller mapping" Print "4. Dump controller mappings to console window" Print "5. Edit controller mapping for 1 or more players" Print "6. Reset controller mapping for 1 or more players" Print "7. Map controllers for 1-8 players (no GUI)" Print "8. Map / edit controllers for 1-8 players (GUI)" Print "9. Test controller mappings to move around screen" Print "10. Save controller mappings"
Print "What to do? ('q' to exit)"
Input in$: in$
= _Trim$(in$
) ' in$ = LCase$(Left$(in$, 1))
result$ = TestJoysticks1$
result$ = LoadMappings1$
If Len(result$
) = 0 Then result$
= "Loaded mappings." result$ = ViewMappings2$
DumpControllerMap1
result$ = EditMappings1$
result$ = ResetMapping1$
result$ = MapInput1$
result$ = MapInput2$
result$ = TestMappings1$
result$ = SaveMappings1$
' RETURN TO TEXT SCREEN
' /////////////////////////////////////////////////////////////////////////////
' Just a little test to verify _DEFAULTCOLOR and _BACKGROUNDCOLOR work.
' INITIALIZE
'AddColors arrColor()
'StringToArray ScreenArray(), GetMap$
arrColor
(UBound(arrColor
)).value
= cRed
arrColor
(UBound(arrColor
)).value
= cWhite
arrColor
(UBound(arrColor
)).value
= cBlue
' GET LEN
iMaxLen = 0
iMaxLen
= len(arrColor
(iLoop1
).
name)
' SET UP SCREEN
'Screen _NewImage(1024, 768, 32): _ScreenMove 0, 0
' DISPLAY GRAPHICALLY
'For iY = LBound(ScreenArray, 1) To UBound(ScreenArray, 1)
' For iX = LBound(ScreenArray, 2) To UBound(ScreenArray, 2)
' iRow = iY - 1: iCol = iX - 1
' Color cRed, cBlack
' PrintString iRow, iCol, ScreenArray(iY, iX)
' Next iX
'Next iY
iRow = 0
iCol = 0
iCol = 0
iForeColor = arrColor(iLoop1).value
iBackColor = arrColor(iLoop2).value
'sInfo = "Color " + _Trim$(Str$(iForeColor)) + ", " + _Trim$(Str$(iBackColor))
sInfo = "Color " + _
GetColorName$
(arrColor
(), iForeColor
, _Trim$(Str$(iForeColor
))) + _
", " + _
GetColorName$
(arrColor
(), iBackColor
, _Trim$(Str$(iBackColor
))) Color cWhite
, cBlack : PrintString iRow
, iCol
, sInfo
sValue1
= arrColor
(iLoop1
).
name + string$(iMaxLen
, " ") sValue1
= left$(svalue1
, iMaxLen
) sValue2
= arrColor
(iLoop2
).
name + string$(iMaxLen
, " ") sValue2
= left$(svalue2
, iMaxLen
) sNext = sValue1 + " on " + sValue2
Color iForeColor
, iBackColor: PrintString iRow
, iCol
, sNext
'sData = "_DEFAULTCOLOR = " + _Trim$(Str$(_DEFAULTCOLOR)) + ", " + "_BACKGROUNDCOLOR = " + _Trim$(Str$(_BACKGROUNDCOLOR))
'sTest = "_DEFAULTCOLOR " + IIFSTR$(_DEFAULTCOLOR = arrColor(iLoop1).value, "=", "!=") + " fgcolor" + _
' ", " + _
' "_BACKGROUNDCOLOR " + IIFSTR$(_BACKGROUNDCOLOR = arrColor(iLoop2).value, "=", "!=") + " bgcolor"
'iCol = iCol + len(sNext) + 1
'Color cWhite, cBlack : PrintString iRow, iCol, sData
'iCol = iCol + len(sData) + 1
'Color cWhite, cBlack : PrintString iRow, iCol, sTest
sData = "_DEFAULTCOLOR = " + _
", " + _
"_BACKGROUNDCOLOR = " + _
iCol
= iCol
+ len(sNext
) + 1 Color cWhite
, cBlack : PrintString iRow
, iCol
, sData
iRow = iRow + 1
'' Get color
'iForeColor = _DEFAULTCOLOR
'iBackColor = _BACKGROUNDCOLOR
' Show results
'Cls
'print "Color cRed, cBlack"
'print "Color " + _Trim$(Str$(cRed)) + ", " + _Trim$(Str$(cBlack))
'print "_DEFAULTCOLOR=" + _Trim$(Str$(iForeColor))
'print "_BACKGROUNDCOLOR=" + _Trim$(Str$(iBackColor))
Input "PRESS <ENTER> TO CONTINUE"; in$
' RETURN RESULT
DetectColor1$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' sName = GetColorName$(arrColor(), ColorValue, DefaultName)
sResult = DefaultName
If arrColor
(iLoop
).value
= ColorValue
Then sResult
= arrColor
(iLoop
).
name GetColorName$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' TODO: get keyboard input working
' TODO: get continuous movement working for digital joysticks
' TODO: adjust analog joystick sensitivity
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
' MAKE SURE WE HAVE MAPPING
' INITIALIZE
InitKeyboardButtonCodes
iMinX = 1: iMaxX = iCols
iMinY = 1: iMaxY = iRows
PrintStringCR1 10, 20, "Test control mapping:"
PrintStringCR1 10, 22, "1. Directional controls move letters around screen."
PrintStringCR1 10, 23, "2. Buttons make sounds."
PrintStringCR1 10, 25, "Press <ESC> to exit."
' INITIALIZE PLAYER COORDINATES AND SCREEN CHARACTERS
iNextY = 1
iNextX = -3
iNextC = 64
iNextX = iNextX + 4
iNextX = iMinX
iNextY = iNextY + 4
iNextY = iMinY
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).moveY = 0
m_arrPlayer(iPlayer).moveUp = FALSE
m_arrPlayer(iPlayer).moveDown = FALSE
m_arrPlayer(iPlayer).moveLeft = FALSE
m_arrPlayer(iPlayer).moveRight = FALSE
m_arrPlayer(iPlayer).button1 = FALSE
m_arrPlayer(iPlayer).button2 = FALSE
m_arrPlayer(iPlayer).button3 = FALSE
m_arrPlayer(iPlayer).button4 = FALSE
m_arrPlayer(iPlayer).lastMoveUp = FALSE
m_arrPlayer(iPlayer).lastMoveDown = FALSE
m_arrPlayer(iPlayer).lastMoveLeft = FALSE
m_arrPlayer(iPlayer).lastMoveRight = FALSE
m_arrPlayer(iPlayer).lastButton1 = FALSE
m_arrPlayer(iPlayer).lastButton2 = FALSE
m_arrPlayer(iPlayer).lastButton3 = FALSE
m_arrPlayer(iPlayer).lastButton4 = FALSE
' COUNT # OF JOYSTICKS
' TODO: find out the right way to count 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
' LIMIT # OF DEVICES, IF THERE IS A LIMIT DEFINED
iNumControllers = iDeviceCount - 2
If iNumControllers
> cMaxControllers
Then iNumControllers = cMaxControllers
' ONLY 2 FOUND (KEYBOARD, MOUSE)
'sError = "No game controllers found."
iNumControllers = 0
' INITIALIZE CONTROLLER DATA
For iController
= 1 To iNumControllers
m_arrController(iController).buttonCount = cMaxButtons
m_arrController(iController).axisCount = cMaxAxis
For iLoop
= 1 To cMaxButtons
arrButtonNew(iController, iLoop) = TRUE
For iLoop
= 1 To cMaxAxis
arrAxisNew(iController, iLoop) = TRUE
' INITIALIZE CONTROLLER INPUT
For iController
= 1 To iNumControllers
iDevice = iController + 2
m_arrController(iController).buttonCount = iLoop
arrButton(iController, iLoop) = FALSE
m_arrController(iController).axisCount = iLoop
arrAxis(iController, iLoop) = 0
Wend ' clear and update the device buffer
' GET INPUT AND MOVE PLAYERS AROUND ON SCREEN
bFinished = FALSE
' Clear control buffer for players
m_arrPlayer(iPlayer).moveUp = FALSE
m_arrPlayer(iPlayer).moveDown = FALSE
m_arrPlayer(iPlayer).moveLeft = FALSE
m_arrPlayer(iPlayer).moveRight = FALSE
m_arrPlayer(iPlayer).button1 = FALSE
m_arrPlayer(iPlayer).button2 = FALSE
m_arrPlayer(iPlayer).button3 = FALSE
m_arrPlayer(iPlayer).button4 = FALSE
' -----------------------------------------------------------------------------
' BEGIN CHECK FOR CONTROLLER INPUT
For iController
= 1 To iNumControllers
iDevice = iController + 2
' Check all devices
Wend ' clear and update the device buffer
' Check each button
' update button array to indicate if a button is up or down currently.
'if TRUE=TRUE then
If iValue
<> arrButton
(iController
, iLoop
) Then ' *****************************************************************************
' PRESSED BUTTON
' BEGIN find who this is mapped for
bFoundWho = FALSE
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
m_arrPlayer(iPlayer).moveUp = TRUE
m_arrPlayer(iPlayer).moveDown = TRUE
m_arrPlayer(iPlayer).moveLeft = TRUE
m_arrPlayer(iPlayer).moveRight = TRUE
m_arrPlayer(iPlayer).button1 = TRUE
m_arrPlayer(iPlayer).button2 = TRUE
m_arrPlayer(iPlayer).button3 = TRUE
m_arrPlayer(iPlayer).button4 = TRUE
'(IGNORE)
'end if
' END find who this is mapped for
' Check each axis
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
' WE WANT CONTINUOUS MOVEMENT (DISABLE FOR NOT)
'if TRUE=TRUE then
If dblNextAxis
<> arrAxis
(iController
, iLoop
) Then ' *****************************************************************************
' MOVED STICK
' convert to a digital value
iValue = -1
iValue = 1
' BEGIN find who this is mapped for
bFoundWho = FALSE
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
m_arrPlayer(iPlayer).moveUp = TRUE
m_arrPlayer(iPlayer).moveDown = TRUE
m_arrPlayer(iPlayer).moveLeft = TRUE
m_arrPlayer(iPlayer).moveRight = TRUE
m_arrPlayer(iPlayer).button1 = TRUE
m_arrPlayer(iPlayer).button2 = TRUE
m_arrPlayer(iPlayer).button3 = TRUE
m_arrPlayer(iPlayer).button4 = TRUE
'(IGNORE)
' END find who this is mapped for
' END CHECK FOR CONTROLLER INPUT
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN CHECK FOR KEYBOARD INPUT #1
'_KEYCLEAR: _DELAY 1
' Detect changed key state
iDevice = 1 ' keyboard
iCode = m_arrButtonCode(iLoop)
' *****************************************************************************
' PRESSED KEYBOARD
'PRINT "PRESSED " + m_arrButtonKey(iLoop)
' BEGIN find who this is mapped for
bFoundWho = FALSE
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
m_arrPlayer(iPlayer).moveUp = TRUE
m_arrPlayer(iPlayer).moveDown = TRUE
m_arrPlayer(iPlayer).moveLeft = TRUE
m_arrPlayer(iPlayer).moveRight = TRUE
m_arrPlayer(iPlayer).button1 = TRUE
m_arrPlayer(iPlayer).button2 = TRUE
m_arrPlayer(iPlayer).button3 = TRUE
m_arrPlayer(iPlayer).button4 = TRUE
'(IGNORE)
'end if
' END find who this is mapped for
' END CHECK FOR KEYBOARD INPUT #1
' -----------------------------------------------------------------------------
' NOW DRAW PLAYERS ON SCREEN
' -----------------------------------------------------------------------------
' BEGIN UPDATE MOVEMENT CONTROL STATES
' If repeating keys are disabled then
' disable until the key has been released
If m_arrControlMap
(iPlayer
, cInputUp
).repeat
= FALSE
Then If m_arrPlayer
(iPlayer
).moveUp
= TRUE
Then If m_arrPlayer
(iPlayer
).lastMoveUp
= TRUE
Then m_arrPlayer(iPlayer).moveUp = FALSE
m_arrPlayer(iPlayer).lastMoveUp = FALSE
If m_arrControlMap
(iPlayer
, cInputDown
).repeat
= FALSE
Then If m_arrPlayer
(iPlayer
).moveDown
= TRUE
Then If m_arrPlayer
(iPlayer
).lastMoveDown
= TRUE
Then m_arrPlayer(iPlayer).moveDown = FALSE
m_arrPlayer(iPlayer).lastMoveDown = FALSE
If m_arrControlMap
(iPlayer
, cInputLeft
).repeat
= FALSE
Then If m_arrPlayer
(iPlayer
).moveLeft
= TRUE
Then If m_arrPlayer
(iPlayer
).lastMoveLeft
= TRUE
Then m_arrPlayer(iPlayer).moveLeft = FALSE
m_arrPlayer(iPlayer).lastMoveLeft = FALSE
If m_arrControlMap
(iPlayer
, cInputRight
).repeat
= FALSE
Then If m_arrPlayer
(iPlayer
).moveRight
= TRUE
Then If m_arrPlayer
(iPlayer
).lastMoveRight
= TRUE
Then m_arrPlayer(iPlayer).moveRight = FALSE
m_arrPlayer(iPlayer).lastMoveRight = FALSE
' END UPDATE MOVEMENT CONTROL STATES
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN MOVEMENT ACTIONS
m_arrPlayer(iPlayer).moveY = 0
m_arrPlayer(iPlayer).moveX = 0
If m_arrPlayer
(iPlayer
).moveUp
= TRUE
Then m_arrPlayer(iPlayer).moveY = -1
m_arrPlayer(iPlayer).lastMoveUp = TRUE
If m_arrPlayer
(iPlayer
).moveDown
= TRUE
Then m_arrPlayer(iPlayer).moveY = 1
m_arrPlayer(iPlayer).lastMoveDown = TRUE
If m_arrPlayer
(iPlayer
).moveLeft
= TRUE
Then m_arrPlayer(iPlayer).moveX = -1
m_arrPlayer(iPlayer).lastMoveLeft = TRUE
If m_arrPlayer
(iPlayer
).moveRight
= TRUE
Then m_arrPlayer(iPlayer).moveX = 1
m_arrPlayer(iPlayer).lastMoveRight = TRUE
' END MOVEMENT ACTIONS
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN MOVEMENT
' 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
m_arrPlayer(iPlayer).x = m_arrPlayer(iPlayer).xOld ' iMaxX
' 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
m_arrPlayer(iPlayer).y = m_arrPlayer(iPlayer).yOld ' iMaxY
' 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)
PrintStringCR1 m_arrPlayer(iPlayer).xOld, m_arrPlayer(iPlayer).yOld, " "
PrintStringCR1 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
' END MOVEMENT
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN UPDATE BUTTON STATES
' If repeating keys are disabled then
' disable until the key has been released
'if m_bRepeatButton1 = FALSE then
If m_arrControlMap
(iPlayer
, cInputButton1
).repeat
= FALSE
Then If m_arrPlayer
(iPlayer
).button1
= TRUE
Then If m_arrPlayer
(iPlayer
).lastButton1
= TRUE
Then m_arrPlayer(iPlayer).button1 = FALSE
m_arrPlayer(iPlayer).lastButton1 = FALSE
If m_arrControlMap
(iPlayer
, cInputButton2
).repeat
= FALSE
Then If m_arrPlayer
(iPlayer
).button2
= TRUE
Then If m_arrPlayer
(iPlayer
).lastButton2
= TRUE
Then m_arrPlayer(iPlayer).button2 = FALSE
m_arrPlayer(iPlayer).lastButton2 = FALSE
If m_arrControlMap
(iPlayer
, cInputButton3
).repeat
= FALSE
Then If m_arrPlayer
(iPlayer
).button3
= TRUE
Then If m_arrPlayer
(iPlayer
).lastButton3
= TRUE
Then m_arrPlayer(iPlayer).button3 = FALSE
m_arrPlayer(iPlayer).lastButton3 = FALSE
If m_arrControlMap
(iPlayer
, cInputButton4
).repeat
= FALSE
Then If m_arrPlayer
(iPlayer
).button4
= TRUE
Then If m_arrPlayer
(iPlayer
).lastButton4
= TRUE
Then m_arrPlayer(iPlayer).button4 = FALSE
m_arrPlayer(iPlayer).lastButton4 = FALSE
' END UPDATE BUTTON STATES
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN BUTTON ACTIONS
If m_arrPlayer
(iPlayer
).button1
= TRUE
Then MakeSound iPlayer, 1
m_arrPlayer(iPlayer).lastButton1 = TRUE
If m_arrPlayer
(iPlayer
).button2
= TRUE
Then MakeSound iPlayer, 2
m_arrPlayer(iPlayer).lastButton2 = TRUE
If m_arrPlayer
(iPlayer
).button3
= TRUE
Then MakeSound iPlayer, 3
m_arrPlayer(iPlayer).lastButton3 = TRUE
If m_arrPlayer
(iPlayer
).button4
= TRUE
Then MakeSound iPlayer, 4
m_arrPlayer(iPlayer).lastButton4 = TRUE
' END BUTTON ACTIONS
' -----------------------------------------------------------------------------
sResult = sError
sResult = "No mapping loaded. Please load a mapping or map keys."
TestMappings1$ = sResult
' /////////////////////////////////////////////////////////////////////////////
iPlayer = 1
iPlayer = 8
iButton = 1
iButton = 4
note% = iPlayer * 100 + (iButton * 25)
note% = 4186
' /////////////////////////////////////////////////////////////////////////////
' V2 prints in 2 columns.
' A total kludge!
Dim RoutineName
As String:: RoutineName
= "PrintControllerMap2"
' 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 Rep"
sColumn1
= sColumn1
+ StrPadRight$
(sLine
, iColWidth
) + Chr$(13) sLine = "----------------------------------------------------------"
sColumn1
= sColumn1
+ StrPadRight$
(sLine
, iColWidth
) + Chr$(13) iCount = 0
If InputTypeToString$
(m_arrControlMap
(iPlayer
, iWhichInput
).typ
) <> "unknown" Then iCount = iCount + 1
If InputTypeToString$
(m_arrControlMap
(iPlayer
, iWhichInput
).typ
) <> "unknown" Then sLine = IntPadRight$(iPlayer, 8)
sLine = sLine + StrPadRight$(InputToString$(iWhichInput), 10)
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 = GetKeyboardButtonCodeShortText$(m_arrControlMap(iPlayer, iWhichInput).code)
sValue = StrPadRight$(sValue, 13)
sValue = IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 13)
sLine = sLine + sValue
sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).value, 6)
'sValue = TrueFalse$(m_arrControlMap(iPlayer, iWhichInput).repeat)
sValue = IIFSTR$ (m_arrControlMap(iPlayer, iWhichInput).repeat, "Y", "N")
sLine = sLine + StrPadRight$(sValue, 3)
'Print sLine
sLine = StrPadRight$(sLine, iColWidth)
sColumn1
= sColumn1
+ sLine
+ Chr$(13) sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
'Print sLine
sLine = StrPadRight$(sLine, iColWidth)
sColumn1
= sColumn1
+ sLine
+ Chr$(13)
'sLine = "Player# Input Device# Type Code Value"
sLine = "Player Input Device# Type Code Value Rep"
sColumn2
= sColumn2
+ StrPadRight$
(sLine
, iColWidth
) + Chr$(13) sLine = "----------------------------------------------------------"
sColumn2
= sColumn2
+ StrPadRight$
(sLine
, iColWidth
) + Chr$(13) iCount = 0
If InputTypeToString$
(m_arrControlMap
(iPlayer
, iWhichInput
).typ
) <> "unknown" Then iCount = iCount + 1
If InputTypeToString$
(m_arrControlMap
(iPlayer
, iWhichInput
).typ
) <> "unknown" Then sLine = IntPadRight$(iPlayer, 8)
sLine = sLine + StrPadRight$(InputToString$(iWhichInput), 10)
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 = GetKeyboardButtonCodeShortText$(m_arrControlMap(iPlayer, iWhichInput).code)
sValue = StrPadRight$(sValue, 13)
sValue = IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).code, 13)
sLine = sLine + sValue
sLine = sLine + IntPadRight$(m_arrControlMap(iPlayer, iWhichInput).value, 6)
'sValue = TrueFalse$(m_arrControlMap(iPlayer, iWhichInput).repeat)
sValue = IIFSTR$ (m_arrControlMap(iPlayer, iWhichInput).repeat, "Y", "N")
sLine = sLine + StrPadRight$(sValue, 3)
'Print sLine
sLine = StrPadRight$(sLine, iColWidth)
sColumn2
= sColumn2
+ sLine
+ Chr$(13) sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
'Print sLine
sLine = StrPadRight$(sLine, iColWidth)
sColumn2
= sColumn2
+ sLine
+ Chr$(13)
split sColumn1
, Chr$(13), arrColumn1
() split sColumn2
, Chr$(13), arrColumn2
() sLine = ""
sLine = sLine + arrColumn1(iLoop)
sLine
= sLine
+ String$(iColWidth
, " ") sLine = sLine + " "
sLine = sLine + arrColumn2(iLoop)
sLine
= sLine
+ String$(iColWidth
, " ") Print "No mapping loaded. Please load a mapping or map keys."
' /////////////////////////////////////////////////////////////////////////////
' Original (simple) routine
Dim RoutineName
As String:: RoutineName
= "PrintControllerMap1"
' 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
iCount = 0
If InputTypeToString$
(m_arrControlMap
(iPlayer
, iWhichInput
).typ
) <> "unknown" Then iCount = iCount + 1
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)
sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
' /////////////////////////////////////////////////////////////////////////////
' Simple routine
' enables debugging, prints to debug window
' when done disables debugging (if it was disabled to begin with)
Dim RoutineName
As String:: RoutineName
= "DumpControllerMap1"
' ENABLE DEEBUGGING (IF NOT ENABLED)
bTesting = m_bTesting
' ACTIVATE DEBUGGING WINDOW (IF NOT ACTIVATED)
m_bTesting = TRUE
_Echo "Started " + m_ProgramName$
' INITIALIZE
InitKeyboardButtonCodes
' OUTPUT MAPPING
DebugPrint "Controller mapping:"
DebugPrint "Player# Input Device# Type Code Value"
' 1 button #2 x unknown x x
' 9 11 9 9 9 9
' 12345678912345678901123456789123456789123456789123456789
' 12345678901234567890123456789012345678901234567890123456789012345678901234567890
iCount = 0
If InputTypeToString$
(m_arrControlMap
(iPlayer
, iWhichInput
).typ
) <> "unknown" Then iCount = iCount + 1
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)
DebugPrint sLine
sLine = IntPadRight$(iPlayer, 9) + "(NONE)"
DebugPrint sLine
' WAIT FOR USER
Print "Controller mapping written to console window." Input "PRESS <ENTER> TO CONTINUE"; in$
' DEACTIVATE DEBUGGING WINDOW (IF IT WAS NOT ACTIVATED BEFORE)
m_bTesting = FALSE
' /////////////////////////////////////////////////////////////////////////////
' INITIALIZE
InitKeyboardButtonCodes
' Try loading map
sResult = LoadControllerMap1$
LoadMappings1$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' INITIALIZE
InitKeyboardButtonCodes
' Try saving map
sResult = SaveControllerMap1$
SaveMappings1$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' INITIALIZE
InitKeyboardButtonCodes
PrintControllerMap2
Input "PRESS <ENTER> TO CONTINUE", in$
ViewMappings2$ = ""
' /////////////////////////////////////////////////////////////////////////////
' TODO: test this
Dim RoutineName
As String: RoutineName
= "EditMappings1$"
' INITIALIZE
InitKeyboardButtonCodes
' EDIT
PrintControllerMap2
Print "To edit a mapping, enter a player number: " _
"1-" + cstr$(cMaxPlayers) + ", " + _
cstr$(cMaxPlayers+1) + ") or q to exit."
Input "Edit mapping for player"; in$
If iPlayer
> 0 And iPlayer
<= cMaxPlayers
Then bContinue2 = TRUE
Print "Editing mappings for player " + cstr$
(iPlayer
) + "." 'Print right$(" " + cstr$(iWhichInput), 2) + ". " + InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ)
Print Right$(" " + cstr$
(iWhichInput
), 2) + ". " + InputToString$
(iWhichInput
) Input "Type # of control to edit or q to quit editing player"; in$
bContinue3 = TRUE
Print "Settings for " + InputToString$
(iWhichInput
) + ":" Print "1. Device # : " + cstr$
(m_arrControlMap
(iPlayer
, iWhichInput
).device
) Print "2. Device type : " + InputTypeToString$
(m_arrControlMap
(iPlayer
, iWhichInput
).typ
)
If m_arrControlMap
(iPlayer
, iWhichInput
).typ
= cInputKey
Then Print "3. Input code : " + GetKeyboardButtonCodeText$
(m_arrControlMap
(iPlayer
, iWhichInput
).code
) + _
" (" + _Trim$(Str$(m_arrControlMap
(iPlayer
, iWhichInput
).code
)) + ")" Print "3. Input code : " + _Trim$(Str$(m_arrControlMap
(iPlayer
, iWhichInput
).code
))
Print "4. Input value : " + _Trim$(Str$(m_arrControlMap
(iPlayer
, iWhichInput
).value
)) Print "5. Enable repeat: " + TrueFalse$
(m_arrControlMap
(iPlayer
, iWhichInput
).repeat
) Input "Change item? (1-5 or q to quit editing control)"; in$
Print "Change the device number." Input "Type a new device #, 0 for none (disabled), or blank to leave it unchanged"; in$
m_arrControlMap(iPlayer, iWhichInput).device = iDevice
Print "Updated device number. Remember to save mappings when done." bContinue4 = TRUE
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 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." Print "Please choose one of the listed values." Print "Change the input code." Input "Type a new input code, or blank to leave it unchanged"; in$
m_arrControlMap(iPlayer, iWhichInput).code = iCode
Print "Updated input code. Remember to save mappings when done." Print "Change the input value." Input "Type a new input value, or blank to leave it unchanged"; in$
m_arrControlMap(iPlayer, iWhichInput).value = iValue
Print "Updated input value. Remember to save mappings when done." Print "Change the repeat setting." Input "Type 1 to enable or 0 to disable, or blank to leave it unchanged"; in$
m_arrControlMap(iPlayer, iWhichInput).repeat = FALSE
Print "Repeat disabled. Remember to save mappings when done." m_arrControlMap(iPlayer, iWhichInput).repeat = TRUE
Print "Repeat enabled. Remember to save mappings when done." Print "Please choose a number between 1 and 4." Print "Please choose a number between " + cstr$
(LBound(m_arrControlMap
, 2)) + " and " + cstr$
(UBound(m_arrControlMap
, 2)) + "." Print "Please choose a number between 1 and " + cstr$
(cMaxPlayers
) + "." If Len(sResult
) = 0 Then sResult
= "(Cancelled.)"
EditMappings1$ = sResult
' /////////////////////////////////////////////////////////////////////////////
Dim RoutineName
As String: RoutineName
= "ResetMapping1$"
' INITIALIZE
InitKeyboardButtonCodes
' RESET
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
) + "." 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
m_arrControlMap(iPlayer, iWhichInput).repeat = 0 ' GetGlobalInputRepeatSetting%(iWhichInput)
sResult = "Mappings deleted for player " + cstr$(iPlayer) + "."
For iPlayer
= 1 To cMaxPlayers
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
m_arrControlMap(iPlayer, iWhichInput).repeat = 0 ' GetGlobalInputRepeatSetting%(iWhichInput)
sResult = "All mappings deleted."
If Len(sResult
) = 0 Then sResult
= "(Cancelled.)" ResetMapping1$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' Usage:
' Dim StringArray(1 To 48, 1 To 128) As String
' StringToArray StringArray(), GetMap$
' version 2 with indexed array(row, columm)
split MyString, sDelim, arrLines()
sChar
= Mid$(arrLines
(iRow
), iCol
, 1)
sChar = "."
iIndex1 = iRow + iDim1
iIndex2 = (iCol - 1) + iDim2
MyArray(iIndex1, iIndex2) = sChar
'DebugPrint "MyArray(" + cstr$(iIndex1) + ", " + cstr$(iIndex2) + " = " + chr$(34) + sChar + chr$(34)
' Exit if out of bounds
' Exit if out of bounds
' /////////////////////////////////////////////////////////////////////////////
' Size of array:
'
' Resolution Cols Rows
' 1024 x 768 128 48
' 48 total available # of rows
' -2 rows for title
' -1 row for headings
' -1 for player #1 info
' -1 for player #2 info
' -1 for player #3 info
' -1 for player #4 info
' -- --------------------------
' 41 rows available
m$ = ""
' 11111111111111111111111111111
' 11111111112222222222333333333344444444445555555555666666666677777777778888888888999999999900000000001111111111222222222
' 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
m$
= m$
+ " CONTROLLER #1 # # # X" + Chr$(13) ' 1 m$
= m$
+ " UP # # # #" + Chr$(13) ' 2 m$
= m$
+ " button dev 10 # # # #" + Chr$(13) ' 3 m$
= m$
+ " code 329 rep=Y # # # #" + Chr$(13) ' 4 m$
= m$
+ " value -1 # # # #" + Chr$(13) ' 5 m$
= m$
+ " LEFT RIGHT # # # #" + Chr$(13) ' 6 m$
= m$
+ " button dev 10 button dev 10 # # # #" + Chr$(13) ' 7 m$
= m$
+ " code 332 rep=N code 334 rep=N # # # #" + Chr$(13) ' 8 m$
= m$
+ " value -1 value -1 # # # #" + Chr$(13) ' 9 m$
= m$
+ " DOWN # # # #" + Chr$(13) ' 10 m$
= m$
+ " button dev= 10 # # # #" + Chr$(13) ' 11 m$
= m$
+ " code 337 rep=Y # # # #" + Chr$(13) ' 12 m$
= m$
+ " value= -1 # # # #" + Chr$(13) ' 13 m$
= m$
+ " # # # #" + Chr$(13) ' 14 m$
= m$
+ " BUTTON #1 BUTTON #3 # # # #" + Chr$(13) ' 15 m$
= m$
+ " button dev 1 none dev 0 # # # #" + Chr$(13) ' 16 m$
= m$
+ " code 286 rep=N code rep=N # # # #" + Chr$(13) ' 17 m$
= m$
+ " value -1 value 0 # # # #" + Chr$(13) ' 18 m$
= m$
+ " # # # #" + Chr$(13) ' 19 m$
= m$
+ " BUTTON #2 BUTTON #4 # # # #" + Chr$(13) ' 20 m$
= m$
+ " none dev 0 none dev 0 # # # #" + Chr$(13) ' 21 m$
= m$
+ " code rep=N code rep=N # # # #" + Chr$(13) ' 22 m$
= m$
+ " value 0 value 0 # # # #" + Chr$(13) ' 23 m$
= m$
+ "################################################################################################################################" + Chr$(13) ' 24 m$
= m$
+ " # # # #" + Chr$(13) ' 25 m$
= m$
+ " # # # #" + Chr$(13) ' 26 m$
= m$
+ " # # # #" + Chr$(13) ' 27 m$
= m$
+ " # # # #" + Chr$(13) ' 28 m$
= m$
+ " # # # #" + Chr$(13) ' 29 m$
= m$
+ " # # # #" + Chr$(13) ' 30 m$
= m$
+ " # # # #" + Chr$(13) ' 31 m$
= m$
+ " # # # #" + Chr$(13) ' 32 m$
= m$
+ " # # # #" + Chr$(13) ' 33 m$
= m$
+ " # # # #" + Chr$(13) ' 34 m$
= m$
+ " # # # #" + Chr$(13) ' 35 m$
= m$
+ " # # # #" + Chr$(13) ' 36 m$
= m$
+ " # # # #" + Chr$(13) ' 37 m$
= m$
+ " # # # #" + Chr$(13) ' 38 m$
= m$
+ " # # # #" + Chr$(13) ' 39 m$
= m$
+ " # # # #" + Chr$(13) ' 40 m$
= m$
+ " # # # #" + Chr$(13) ' 41 m$
= m$
+ " # # # #" + Chr$(13) ' 42 m$
= m$
+ " # # # #" + Chr$(13) ' 43 m$
= m$
+ " # # # #" + Chr$(13) ' 44 m$
= m$
+ " # # # #" + Chr$(13) ' 45 m$
= m$
+ " # # # #" + Chr$(13) ' 46 m$
= m$
+ "c # # # #" + Chr$(13) ' 47 m$
= m$
+ "################################################################################################################################" + Chr$(13) ' 48 ' 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 11111111112222222222333333333344444444445555555555666666666677777777778888888888999999999900000000001111111111222222222
' 11111111111111111111111111111
GetMap$ = m$
m$ = ""
' 11111111111111111111111111111
' 11111111112222222222333333333344444444445555555555666666666677777777778888888888999999999900000000001111111111222222222
' 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
m$
= m$
+ " CONTROLLER #1 # # # #" + Chr$(13) ' 1 m$
= m$
+ " UP # # # #" + Chr$(13) ' 2 m$
= m$
+ " button dev 10 # # # #" + Chr$(13) ' 3 m$
= m$
+ " code 329 rep=Y # # # #" + Chr$(13) ' 4 m$
= m$
+ " value -1 # # # #" + Chr$(13) ' 5 m$
= m$
+ " LEFT RIGHT # # # #" + Chr$(13) ' 6 m$
= m$
+ " button dev 10 button dev 10 # # # #" + Chr$(13) ' 7 m$
= m$
+ " code 332 rep=N code 334 rep=N # # # #" + Chr$(13) ' 8 m$
= m$
+ " value -1 value -1 # # # #" + Chr$(13) ' 9 m$
= m$
+ " DOWN # # # #" + Chr$(13) ' 10 m$
= m$
+ " button dev= 10 # # # #" + Chr$(13) ' 11 m$
= m$
+ " code 337 rep=Y # # # #" + Chr$(13) ' 12 m$
= m$
+ " value= -1 # # # #" + Chr$(13) ' 13 m$
= m$
+ " # # # #" + Chr$(13) ' 14 m$
= m$
+ " BUTTON #1 BUTTON #3 # # # #" + Chr$(13) ' 15 m$
= m$
+ " button dev 1 none dev 0 # # # #" + Chr$(13) ' 16 m$
= m$
+ " code 286 rep=N code rep=N # # # #" + Chr$(13) ' 17 m$
= m$
+ " value -1 value 0 # # # #" + Chr$(13) ' 18 m$
= m$
+ " # # # #" + Chr$(13) ' 19 m$
= m$
+ " BUTTON #2 BUTTON #4 # # # #" + Chr$(13) ' 20 m$
= m$
+ " none dev 0 none dev 0 # # # #" + Chr$(13) ' 21 m$
= m$
+ " code rep=N code rep=N # # # #" + Chr$(13) ' 22 m$
= m$
+ " value 0 value 0 # # # #" + Chr$(13) ' 23 m$
= m$
+ "################################################################################################################################" + Chr$(13) ' 24 m$
= m$
+ " # # # #" + Chr$(13) ' 25 m$
= m$
+ " # # # #" + Chr$(13) ' 26 m$
= m$
+ " # # # #" + Chr$(13) ' 27 m$
= m$
+ " # # # #" + Chr$(13) ' 28 m$
= m$
+ " # # # #" + Chr$(13) ' 29 m$
= m$
+ " # # # #" + Chr$(13) ' 30 m$
= m$
+ " # # # #" + Chr$(13) ' 31 m$
= m$
+ " # # # #" + Chr$(13) ' 32 m$
= m$
+ " # # # #" + Chr$(13) ' 33 m$
= m$
+ " # # # #" + Chr$(13) ' 34 m$
= m$
+ " # # # #" + Chr$(13) ' 35 m$
= m$
+ " # # # #" + Chr$(13) ' 36 m$
= m$
+ " # # # #" + Chr$(13) ' 37 m$
= m$
+ " # # # #" + Chr$(13) ' 38 m$
= m$
+ " # # # #" + Chr$(13) ' 39 m$
= m$
+ " # # # #" + Chr$(13) ' 40 m$
= m$
+ " # # # #" + Chr$(13) ' 41 m$
= m$
+ " # # # #" + Chr$(13) ' 42 m$
= m$
+ " # # # #" + Chr$(13) ' 43 m$
= m$
+ " # # # #" + Chr$(13) ' 44 m$
= m$
+ " # # # #" + Chr$(13) ' 45 m$
= m$
+ " # # # #" + Chr$(13) ' 46 m$
= m$
+ " # # # #" + Chr$(13) ' 47 m$
= m$
+ "################################################################################################################################" + Chr$(13) ' 48 ' 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 11111111112222222222333333333344444444445555555555666666666677777777778888888888999999999900000000001111111111222222222
' 11111111111111111111111111111
GetMap2$ = m$
m$ = ""
' 11111111111111111111111111111
' 11111111112222222222333333333344444444445555555555666666666677777777778888888888999999999900000000001111111111222222222
' 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
m$
= m$
+ ".........CONTROLLER.#1.........#...............................#...............................#...............................#" + Chr$(13) ' 1 m$
= m$
+ ".............UP................#...............................#...............................#...............................#" + Chr$(13) ' 2 m$
= m$
+ "......button.dev..10...........#...............................#...............................#...............................#" + Chr$(13) ' 3 m$
= m$
+ "......code.329.rep=Y...........#...............................#...............................#...............................#" + Chr$(13) ' 4 m$
= m$
+ "......value.......-1...........#...............................#...............................#...............................#" + Chr$(13) ' 5 m$
= m$
+ ".LEFT...........RIGHT..........#...............................#...............................#...............................#" + Chr$(13) ' 6 m$
= m$
+ ".button.dev..10.button.dev..10.#...............................#...............................#...............................#" + Chr$(13) ' 7 m$
= m$
+ ".code.332.rep=N.code.334.rep=N.#...............................#...............................#...............................#" + Chr$(13) ' 8 m$
= m$
+ ".value.......-1.value.......-1.#...............................#...............................#...............................#" + Chr$(13) ' 9 m$
= m$
+ "............DOWN...............#...............................#...............................#...............................#" + Chr$(13) ' 10 m$
= m$
+ "......button.dev=.10...........#...............................#...............................#...............................#" + Chr$(13) ' 11 m$
= m$
+ "......code.337.rep=Y...........#...............................#...............................#...............................#" + Chr$(13) ' 12 m$
= m$
+ "......value=......-1...........#...............................#...............................#...............................#" + Chr$(13) ' 13 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 14 m$
= m$
+ ".BUTTON.#1......BUTTON.#3......#...............................#...............................#...............................#" + Chr$(13) ' 15 m$
= m$
+ ".button.dev...1.none...dev...0.#...............................#...............................#...............................#" + Chr$(13) ' 16 m$
= m$
+ ".code.286.rep=N.code.....rep=N.#...............................#...............................#...............................#" + Chr$(13) ' 17 m$
= m$
+ ".value.......-1.value........0.#...............................#...............................#...............................#" + Chr$(13) ' 18 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 19 m$
= m$
+ ".BUTTON.#2......BUTTON.#4......#...............................#...............................#...............................#" + Chr$(13) ' 20 m$
= m$
+ ".none...dev...0.none...dev...0.#...............................#...............................#...............................#" + Chr$(13) ' 21 m$
= m$
+ ".code.....rep=N.code.....rep=N.#...............................#...............................#...............................#" + Chr$(13) ' 22 m$
= m$
+ ".value........0.value........0.#...............................#...............................#...............................#" + Chr$(13) ' 23 m$
= m$
+ "################################################################################################################################" + Chr$(13) ' 24 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 25 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 26 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 27 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 28 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 29 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 30 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 31 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 32 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 33 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 34 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 35 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 36 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 37 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 38 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 39 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 40 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 41 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 42 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 43 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 44 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 45 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 46 m$
= m$
+ "...............................#...............................#...............................#...............................#" + Chr$(13) ' 47 m$
= m$
+ "################################################################################################################################" + Chr$(13) ' 48 ' 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678
' 11111111112222222222333333333344444444445555555555666666666677777777778888888888999999999900000000001111111111222222222
' 11111111111111111111111111111
GetMap1$ = m$
' /////////////////////////////////////////////////////////////////////////////
MyString = ""
sLine = ""
sLine = sLine + MyArray(iY, iX)
MyString
= MyString
+ sLine
+ Chr$(13) ArrayToString$ = MyString
' /////////////////////////////////////////////////////////////////////////////
MyString = ""
MyString
= MyString
+ " 11111111112222222222333" + Chr$(13) MyString
= MyString
+ " 12345678901234567890123456789012" + Chr$(13) sLine = ""
sLine
= sLine
+ Right$(" " + cstr$
(iY
), 2) sLine = sLine + MyArray(iY, iX)
sLine
= sLine
+ Right$(" " + cstr$
(iY
), 2) MyString
= MyString
+ sLine
+ Chr$(13) MyString
= MyString
+ " 12345678901234567890123456789012" + Chr$(13) MyString
= MyString
+ " 11111111112222222222333" + Chr$(13) ArrayToStringTest$ = MyString
' /////////////////////////////////////////////////////////////////////////////
Sub AddScreenArea
(NewValue
As ScreenAreaType
, MyArray
() As ScreenAreaType
) MyArray
(UBound(MyArray
)).item
= NewValue.item
MyArray
(UBound(MyArray
)).typ
= NewValue.typ
MyArray
(UBound(MyArray
)).player
= NewValue.player
MyArray
(UBound(MyArray
)).x1
= NewValue.x1
MyArray
(UBound(MyArray
)).y1
= NewValue.y1
MyArray
(UBound(MyArray
)).x2
= NewValue.x2
MyArray
(UBound(MyArray
)).y2
= NewValue.y2
'MyArray(ubound(MyArray)).index = NewValue.index
' /////////////////////////////////////////////////////////////////////////////
Sub AddTextButton
(NewValue
As TextButtonType
, MyArray
() As TextButtonType
) MyArray
(UBound(MyArray
)).item
= NewValue.item
MyArray
(UBound(MyArray
)).typ
= NewValue.typ
MyArray
(UBound(MyArray
)).x1
= NewValue.x1
MyArray
(UBound(MyArray
)).y1
= NewValue.y1
MyArray
(UBound(MyArray
)).x2
= NewValue.x2
MyArray
(UBound(MyArray
)).y2
= NewValue.y2
'MyArray(ubound(MyArray)).index = NewValue.index
' /////////////////////////////////////////////////////////////////////////////
Sub AddTextLabel
(NewValue
As TextLabelType
, MyArray
() As TextLabelType
) MyArray
(UBound(MyArray
)).item
= NewValue.item
MyArray
(UBound(MyArray
)).row
= NewValue.row
MyArray
(UBound(MyArray
)).column
= NewValue.column
MyArray
(UBound(MyArray
)).justify
= NewValue.justify
MyArray
(UBound(MyArray
)).caption
= NewValue.caption
MyArray
(UBound(MyArray
)).fgcolor
= NewValue.fgcolor
MyArray
(UBound(MyArray
)).bgcolor
= NewValue.bgcolor
'MyArray(ubound(MyArray)).index = NewValue.index
' /////////////////////////////////////////////////////////////////////////////
Sub AddTextField
(NewValue
As TextFieldType
, MyArray
() As TextFieldType
) MyArray
(UBound(MyArray
)).item
= NewValue.item
MyArray
(UBound(MyArray
)).row
= NewValue.row
MyArray
(UBound(MyArray
)).column
= NewValue.column
MyArray
(UBound(MyArray
)).justify
= NewValue.justify
MyArray
(UBound(MyArray
)).value
= NewValue.value
MyArray
(UBound(MyArray
)).fgcolor
= NewValue.fgcolor
MyArray
(UBound(MyArray
)).bgcolor
= NewValue.bgcolor
'MyArray(ubound(MyArray)).index = NewValue.index
' /////////////////////////////////////////////////////////////////////////////
Dim NewScreenArea
As ScreenAreaType
x1 = 1
y1 = 1
NewScreenArea.item = "Control1"
NewScreenArea.
name = "Controller #1" NewScreenArea.typ = cTextGuiSection
NewScreenArea.player = 1
NewScreenArea.x1 = x1
NewScreenArea.y1 = y1
NewScreenArea.x2 = x1 + 30
NewScreenArea.y2 = y1 + 22
AddScreenArea NewScreenArea, m_arrScreenArea()
x1 = x1 + 32
NewScreenArea.item = "Control2"
NewScreenArea.
name = "Controller #2" NewScreenArea.typ = cTextGuiSection
NewScreenArea.player = 2
NewScreenArea.x1 = x1
NewScreenArea.y1 = y1
NewScreenArea.x2 = x1 + 30
NewScreenArea.y2 = y1 + 22
AddScreenArea NewScreenArea, m_arrScreenArea()
x1 = x1 + 32
NewScreenArea.item = "Control3"
NewScreenArea.
name = "Controller #3" NewScreenArea.typ = cTextGuiSection
NewScreenArea.player = 3
NewScreenArea.x1 = x1
NewScreenArea.y1 = y1
NewScreenArea.x2 = x1 + 30
NewScreenArea.y2 = y1 + 22
AddScreenArea NewScreenArea, m_arrScreenArea()
x1 = x1 + 32
NewScreenArea.item = "Control4"
NewScreenArea.
name = "Controller #4" NewScreenArea.typ = cTextGuiSection
NewScreenArea.player = 4
NewScreenArea.x1 = x1
NewScreenArea.y1 = y1
NewScreenArea.x2 = x1 + 30
NewScreenArea.y2 = y1 + 22
AddScreenArea NewScreenArea, m_arrScreenArea()
x1 = 1
y1 = y1 + 24
NewScreenArea.item = "Control5"
NewScreenArea.
name = "Controller #5" NewScreenArea.typ = cTextGuiSection
NewScreenArea.player = 5
NewScreenArea.x1 = x1
NewScreenArea.y1 = y1
NewScreenArea.x2 = x1 + 30
NewScreenArea.y2 = y1 + 22
AddScreenArea NewScreenArea, m_arrScreenArea()
x1 = x1 + 32
NewScreenArea.item = "Control6"
NewScreenArea.
name = "Controller #6" NewScreenArea.typ = cTextGuiSection
NewScreenArea.player = 6
NewScreenArea.x1 = x1
NewScreenArea.y1 = y1
NewScreenArea.x2 = x1 + 30
NewScreenArea.y2 = y1 + 22
AddScreenArea NewScreenArea, m_arrScreenArea()
x1 = x1 + 32
NewScreenArea.item = "Control7"
NewScreenArea.
name = "Controller #7" NewScreenArea.typ = cTextGuiSection
NewScreenArea.player = 7
NewScreenArea.x1 = x1
NewScreenArea.y1 = y1
NewScreenArea.x2 = x1 + 30
NewScreenArea.y2 = y1 + 22
AddScreenArea NewScreenArea, m_arrScreenArea()
x1 = x1 + 32
NewScreenArea.item = "Control8"
NewScreenArea.
name = "Controller #8" NewScreenArea.typ = cTextGuiSection
NewScreenArea.player = 8
NewScreenArea.x1 = x1
NewScreenArea.y1 = y1
NewScreenArea.x2 = x1 + 30
NewScreenArea.y2 = y1 + 22
AddScreenArea NewScreenArea, m_arrScreenArea()
' /////////////////////////////////////////////////////////////////////////////
Dim NewTextButton
As TextButtonType
NewTextButton.item = "Up"
NewTextButton.typ = cInputUp ' cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4
NewTextButton.x1 = 9
NewTextButton.y1 = 2
NewTextButton.x2 = 22
NewTextButton.y2 = 5
AddTextButton NewTextButton, m_arrButton()
NewTextButton.item = "Down"
NewTextButton.typ = cInputDown ' cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4
NewTextButton.x1 = 9
NewTextButton.y1 = 10
NewTextButton.x2 = 22
NewTextButton.y2 = 13
AddTextButton NewTextButton, m_arrButton()
NewTextButton.item = "Left"
NewTextButton.typ = cInputLeft ' cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4
NewTextButton.x1 = 2
NewTextButton.y1 = 6
NewTextButton.x2 = 15
NewTextButton.y2 = 9
AddTextButton NewTextButton, m_arrButton()
NewTextButton.item = "Right"
NewTextButton.typ = cInputRight ' cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4
NewTextButton.x1 = 17
NewTextButton.y1 = 6
NewTextButton.x2 = 30
NewTextButton.y2 = 9
AddTextButton NewTextButton, m_arrButton()
NewTextButton.item = "Button1"
NewTextButton.typ = cInputButton1 ' cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4
NewTextButton.x1 = 2
NewTextButton.y1 = 15
NewTextButton.x2 = 15
NewTextButton.y2 = 18
AddTextButton NewTextButton, m_arrButton()
NewTextButton.item = "Button2"
NewTextButton.typ = cInputButton2 ' cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4
NewTextButton.x1 = 2
NewTextButton.y1 = 20
NewTextButton.x2 = 15
NewTextButton.y2 = 23
AddTextButton NewTextButton, m_arrButton()
NewTextButton.item = "Button3"
NewTextButton.typ = cInputButton3 ' cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4
NewTextButton.x1 = 17
NewTextButton.y1 = 15
NewTextButton.x2 = 30
NewTextButton.y2 = 18
AddTextButton NewTextButton, m_arrButton()
NewTextButton.item = "Button4"
NewTextButton.typ = cInputButton4 ' cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4
NewTextButton.x1 = 17
NewTextButton.y1 = 20
NewTextButton.x2 = 30
NewTextButton.y2 = 23
AddTextButton NewTextButton, m_arrButton()
' /////////////////////////////////////////////////////////////////////////////
Dim NewLabel
As TextLabelType
' -----------------------------------------------------------------------------
NewLabel.item = "Section"
NewLabel.
name = "caption" NewLabel.row = 1
NewLabel.column = 1
NewLabel.justify = cJustifyCenter
NewLabel.caption = "CONTROLLER #{p}"
NewLabel.fgcolor = cCyan
NewLabel.bgcolor = cBlack
AddTextLabel NewLabel, m_arrTextLabel()
' -----------------------------------------------------------------------------
NewLabel.item = "Up"
NewLabel.
name = "caption" NewLabel.row = 2
NewLabel.column = 9
NewLabel.justify = cJustifyCenter
NewLabel.caption = "UP"
NewLabel.fgcolor = cYellow
NewLabel.bgcolor = cRed
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Up"
NewLabel.row = 3
NewLabel.column = 0
NewLabel.justify = cJustifyLeft
NewLabel.caption = ""
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cRed
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Up"
NewLabel.row = 3
NewLabel.column = 16
NewLabel.justify = cJustifyLeft
NewLabel.caption = "dev "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cRed
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Up"
NewLabel.row = 4
NewLabel.column = 9
NewLabel.justify = cJustifyLeft
NewLabel.caption = "code "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cRed
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Up"
NewLabel.row = 4
NewLabel.column = 17
NewLabel.justify = cJustifyNone
NewLabel.caption = " rep="
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cRed
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Up"
NewLabel.row = 5
NewLabel.column = 9
NewLabel.justify = cJustifyNone
NewLabel.caption = "value "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cRed
AddTextLabel NewLabel, m_arrTextLabel()
' -----------------------------------------------------------------------------
NewLabel.item = "Down"
NewLabel.
name = "caption" NewLabel.row = 10
NewLabel.column = 9
NewLabel.justify = cJustifyCenter
NewLabel.caption = "DOWN"
NewLabel.fgcolor = cYellow
NewLabel.bgcolor = cGreen
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Down"
NewLabel.row = 11
NewLabel.column = 0
NewLabel.justify = cJustifyLeft
NewLabel.caption = ""
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cGreen
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Down"
NewLabel.row = 11
NewLabel.column = 16
NewLabel.justify = cJustifyLeft
NewLabel.caption = "dev "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cGreen
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Down"
NewLabel.row = 12
NewLabel.column = 9
NewLabel.justify = cJustifyLeft
NewLabel.caption = "code "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cGreen
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Down"
NewLabel.row = 12
NewLabel.column = 17
NewLabel.justify = cJustifyLeft
NewLabel.caption = " rep="
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cGreen
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Down"
NewLabel.row = 13
NewLabel.column = 9
NewLabel.justify = cJustifyLeft
NewLabel.caption = "value "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cGreen
AddTextLabel NewLabel, m_arrTextLabel()
' -----------------------------------------------------------------------------
NewLabel.item = "Left"
NewLabel.
name = "caption" NewLabel.row = 6
NewLabel.column = 2
NewLabel.justify = cJustifyCenter
NewLabel.caption = "LEFT"
NewLabel.fgcolor = cYellow
NewLabel.bgcolor = cBlue
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Left"
NewLabel.row = 7
NewLabel.column = 0
NewLabel.justify = cJustifyLeft
NewLabel.caption = ""
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cBlue
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Left"
NewLabel.row = 7
NewLabel.column = 9
NewLabel.justify = cJustifyLeft
NewLabel.caption = "dev "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cBlue
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Left"
NewLabel.row = 8
NewLabel.column = 2
NewLabel.justify = cJustifyLeft
NewLabel.caption = "code "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cBlue
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Left"
NewLabel.row = 8
NewLabel.column = 10
NewLabel.justify = cJustifyLeft
NewLabel.caption = " rep="
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cBlue
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Left"
NewLabel.row = 9
NewLabel.column = 2
NewLabel.justify = cJustifyLeft
NewLabel.caption = "value "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cBlue
AddTextLabel NewLabel, m_arrTextLabel()
' -----------------------------------------------------------------------------
NewLabel.item = "Right"
NewLabel.
name = "caption" NewLabel.row = 6
NewLabel.column = 17
NewLabel.justify = cJustifyCenter
NewLabel.caption = "RIGHT"
NewLabel.fgcolor = cYellow
NewLabel.bgcolor = cOrange
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Right"
NewLabel.row = 7
NewLabel.column = 0
NewLabel.justify = cJustifyLeft
NewLabel.caption = ""
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cOrange
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Right"
NewLabel.row = 7
NewLabel.column = 24
NewLabel.justify = cJustifyLeft
NewLabel.caption = "dev "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cOrange
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Right"
NewLabel.row = 8
NewLabel.column = 17
NewLabel.justify = cJustifyLeft
NewLabel.caption = "code "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cOrange
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Right"
NewLabel.row = 8
NewLabel.column = 25
NewLabel.justify = cJustifyLeft
NewLabel.caption = " rep="
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cOrange
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Right"
NewLabel.row = 9
NewLabel.column = 17
NewLabel.justify = cJustifyLeft
NewLabel.caption = "value "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cOrange
AddTextLabel NewLabel, m_arrTextLabel()
' -----------------------------------------------------------------------------
NewLabel.item = "Button1"
NewLabel.
name = "caption" NewLabel.row = 15
NewLabel.column = 2
NewLabel.justify = cJustifyCenter
NewLabel.caption = "BUTTON #1"
NewLabel.fgcolor = cYellow
NewLabel.bgcolor = cRed
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button1"
NewLabel.row = 16
NewLabel.column = 0
NewLabel.justify = cJustifyLeft
NewLabel.caption = ""
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cRed
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button1"
NewLabel.row = 16
NewLabel.column = 9
NewLabel.justify = cJustifyLeft
NewLabel.caption = "dev "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cRed
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button1"
NewLabel.row = 17
NewLabel.column = 2
NewLabel.justify = cJustifyLeft
NewLabel.caption = "code "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cRed
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button1"
NewLabel.row = 17
NewLabel.column = 10
NewLabel.justify = cJustifyLeft
NewLabel.caption = " rep="
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cRed
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button1"
NewLabel.row = 18
NewLabel.column = 2
NewLabel.justify = cJustifyLeft
NewLabel.caption = "value "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cRed
AddTextLabel NewLabel, m_arrTextLabel()
' -----------------------------------------------------------------------------
NewLabel.item = "Button2"
NewLabel.
name = "caption" NewLabel.row = 20
NewLabel.column = 2
NewLabel.justify = cJustifyCenter
NewLabel.caption = "BUTTON #2"
NewLabel.fgcolor = cYellow
NewLabel.bgcolor = cGreen
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button2"
NewLabel.row = 21
NewLabel.column = 0
NewLabel.justify = cJustifyLeft
NewLabel.caption = ""
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cGreen
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button2"
NewLabel.row = 21
NewLabel.column = 9
NewLabel.justify = cJustifyLeft
NewLabel.caption = "dev "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cGreen
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button2"
NewLabel.row = 22
NewLabel.column = 2
NewLabel.justify = cJustifyLeft
NewLabel.caption = "code "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cGreen
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button2"
NewLabel.row = 22
NewLabel.column = 10
NewLabel.justify = cJustifyLeft
NewLabel.caption = " rep="
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cGreen
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button2"
NewLabel.row = 23
NewLabel.column = 2
NewLabel.justify = cJustifyLeft
NewLabel.caption = "value "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cGreen
AddTextLabel NewLabel, m_arrTextLabel()
' -----------------------------------------------------------------------------
NewLabel.item = "Button3"
NewLabel.
name = "caption" NewLabel.row = 15
NewLabel.column = 17
NewLabel.justify = cJustifyCenter
NewLabel.caption = "BUTTON #3"
NewLabel.fgcolor = cYellow
NewLabel.bgcolor = cBlue
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button3"
NewLabel.row = 16
NewLabel.column = 0
NewLabel.justify = cJustifyLeft
NewLabel.caption = ""
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cBlue
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button3"
NewLabel.row = 16
NewLabel.column = 24
NewLabel.justify = cJustifyLeft
NewLabel.caption = "dev "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cBlue
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button3"
NewLabel.row = 17
NewLabel.column = 17
NewLabel.justify = cJustifyLeft
NewLabel.caption = "code "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cBlue
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button3"
NewLabel.row = 17
NewLabel.column = 25
NewLabel.justify = cJustifyLeft
NewLabel.caption = " rep="
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cBlue
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button3"
NewLabel.row = 18
NewLabel.column = 17
NewLabel.justify = cJustifyLeft
NewLabel.caption = "value "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cBlue
AddTextLabel NewLabel, m_arrTextLabel()
' -----------------------------------------------------------------------------
NewLabel.item = "Button4"
NewLabel.
name = "caption" NewLabel.row = 20
NewLabel.column = 17
NewLabel.justify = cJustifyCenter
NewLabel.caption = "BUTTON #4"
NewLabel.fgcolor = cYellow
NewLabel.bgcolor = cOrange
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button4"
NewLabel.row = 21
NewLabel.column = 0
NewLabel.justify = cJustifyLeft
NewLabel.caption = ""
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cOrange
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button4"
NewLabel.row = 21
NewLabel.column = 24
NewLabel.justify = cJustifyLeft
NewLabel.caption = "dev "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cOrange
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button4"
NewLabel.row = 22
NewLabel.column = 17
NewLabel.justify = cJustifyLeft
NewLabel.caption = "code "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cOrange
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button4"
NewLabel.row = 22
NewLabel.column = 25
NewLabel.justify = cJustifyLeft
NewLabel.caption = " rep="
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cOrange
AddTextLabel NewLabel, m_arrTextLabel()
NewLabel.item = "Button4"
NewLabel.row = 23
NewLabel.column = 17
NewLabel.justify = cJustifyLeft
NewLabel.caption = "value "
NewLabel.fgcolor = cBlack
NewLabel.bgcolor = cOrange
AddTextLabel NewLabel, m_arrTextLabel()
' /////////////////////////////////////////////////////////////////////////////
Dim NewField
As TextFieldType
' -----------------------------------------------------------------------------
NewField.item = "Up"
NewField.row = 3
NewField.column = 9
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cRed
AddTextField NewField, m_arrTextField()
NewField.item = "Up"
NewField.row = 3
NewField.column = 20
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cRed
AddTextField NewField, m_arrTextField()
NewField.item = "Up"
NewField.row = 4
NewField.column = 14
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cRed
AddTextField NewField, m_arrTextField()
NewField.item = "Up"
NewField.row = 4
NewField.column = 22
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cRed
AddTextField NewField, m_arrTextField()
NewField.item = "Up"
NewField.row = 5
NewField.column = 16
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cRed
AddTextField NewField, m_arrTextField()
' -----------------------------------------------------------------------------
NewField.item = "Down"
NewField.row = 11
NewField.column = 9
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cGreen
AddTextField NewField, m_arrTextField()
NewField.item = "Down"
NewField.row = 11
NewField.column = 20
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cGreen
AddTextField NewField, m_arrTextField()
NewField.item = "Down"
NewField.row = 12
NewField.column = 14
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cGreen
AddTextField NewField, m_arrTextField()
NewField.item = "Down"
NewField.row = 12
NewField.column = 22
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cGreen
AddTextField NewField, m_arrTextField()
NewField.item = "Down"
NewField.row = 13
NewField.column = 16
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cGreen
AddTextField NewField, m_arrTextField()
' -----------------------------------------------------------------------------
NewField.item = "Left"
NewField.row = 7
NewField.column = 2
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cBlue
AddTextField NewField, m_arrTextField()
NewField.item = "Left"
NewField.row = 7
NewField.column = 13
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cBlue
AddTextField NewField, m_arrTextField()
NewField.item = "Left"
NewField.row = 8
NewField.column = 7
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cBlue
AddTextField NewField, m_arrTextField()
NewField.item = "Left"
NewField.row = 8
NewField.column = 15
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cBlue
AddTextField NewField, m_arrTextField()
NewField.item = "Left"
NewField.row = 9
NewField.column = 9
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cBlue
AddTextField NewField, m_arrTextField()
' -----------------------------------------------------------------------------
NewField.item = "Right"
NewField.row = 7
NewField.column = 17
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cOrange
AddTextField NewField, m_arrTextField()
NewField.item = "Right"
NewField.row = 7
NewField.column = 28
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cOrange
AddTextField NewField, m_arrTextField()
NewField.item = "Right"
NewField.row = 8
NewField.column = 22
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cOrange
AddTextField NewField, m_arrTextField()
NewField.item = "Right"
NewField.row = 8
NewField.column = 30
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cOrange
AddTextField NewField, m_arrTextField()
NewField.item = "Right"
NewField.row = 9
NewField.column = 24
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cOrange
AddTextField NewField, m_arrTextField()
' -----------------------------------------------------------------------------
NewField.item = "Button1"
NewField.row = 16
NewField.column = 2
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cRed
AddTextField NewField, m_arrTextField()
NewField.item = "Button1"
NewField.row = 16
NewField.column = 13
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cRed
AddTextField NewField, m_arrTextField()
NewField.item = "Button1"
NewField.row = 17
NewField.column = 7
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cRed
AddTextField NewField, m_arrTextField()
NewField.item = "Button1"
NewField.row = 17
NewField.column = 15
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cRed
AddTextField NewField, m_arrTextField()
NewField.item = "Button1"
NewField.row = 18
NewField.column = 9
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cRed
AddTextField NewField, m_arrTextField()
' -----------------------------------------------------------------------------
NewField.item = "Button2"
NewField.row = 21
NewField.column = 2
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cGreen
AddTextField NewField, m_arrTextField()
NewField.item = "Button2"
NewField.row = 21
NewField.column = 13
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cGreen
AddTextField NewField, m_arrTextField()
NewField.item = "Button2"
NewField.row = 22
NewField.column = 7
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cGreen
AddTextField NewField, m_arrTextField()
NewField.item = "Button2"
NewField.row = 22
NewField.column = 15
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cGreen
AddTextField NewField, m_arrTextField()
NewField.item = "Button2"
NewField.row = 23
NewField.column = 9
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cGreen
AddTextField NewField, m_arrTextField()
' -----------------------------------------------------------------------------
NewField.item = "Button3"
NewField.row = 16
NewField.column = 17
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cBlue
AddTextField NewField, m_arrTextField()
NewField.item = "Button3"
NewField.row = 16
NewField.column = 28
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cBlue
AddTextField NewField, m_arrTextField()
NewField.item = "Button3"
NewField.row = 17
NewField.column = 22
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cBlue
AddTextField NewField, m_arrTextField()
NewField.item = "Button3"
NewField.row = 17
NewField.column = 30
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cBlue
AddTextField NewField, m_arrTextField()
NewField.item = "Button3"
NewField.row = 18
NewField.column = 24
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cBlue
AddTextField NewField, m_arrTextField()
' -----------------------------------------------------------------------------
NewField.item = "Button4"
NewField.row = 21
NewField.column = 17
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cOrange
AddTextField NewField, m_arrTextField()
NewField.item = "Button4"
NewField.row = 21
NewField.column = 28
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cOrange
AddTextField NewField, m_arrTextField()
NewField.item = "Button4"
NewField.row = 22
NewField.column = 22
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cOrange
AddTextField NewField, m_arrTextField()
NewField.item = "Button4"
NewField.row = 22
NewField.column = 30
NewField.justify = cJustifyLeft
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cOrange
AddTextField NewField, m_arrTextField()
NewField.item = "Button4"
NewField.row = 23
NewField.column = 24
NewField.justify = cJustifyRight
NewField.value = ""
NewField.fgcolor = cWhite
NewField.bgcolor = cOrange
AddTextField NewField, m_arrTextField()
' /////////////////////////////////////////////////////////////////////////////
' Looks in MyArray for the first element
' whose .item matches sItem and .name matches sName
' and returns the index, or MyArray's lbound-1 if not found.
If MyArray
(iLoop
).item
= sItem
Then iResult = iLoop
GetTextLabel% = iResult
' /////////////////////////////////////////////////////////////////////////////
' Looks in MyArray for the first element
' whose .item matches sItem and .name matches sName
' and returns the index, or MyArray's lbound-1 if not found.
If MyArray
(iLoop
).item
= sItem
Then iResult = iLoop
GetTextField% = iResult
' /////////////////////////////////////////////////////////////////////////////
' The following must be initialized and populated before calling:
' ReDim arrColor(-1) As ColorType
' Dim MapArray(1 To 48, 1 To 128) As String ' FOR SCREEN 1024 x 768: 128 x 48
' ReDim ScreenArray(1 To 48, 1 To 128) As TextCellType ' FOR SCREEN 1024 x 768: 128 x 48
' This was an experiment in rolling your own "GUI",
' - what a pain it turned out to be
' - next time maybe we would use InForm and be done with it!
' TODO:
' * clean up and remove all the variable definitions left over
' from the main routine MapInput2$ this was moved out of.
Sub UpdateDisplayMapInput2
( _
arrColor
() As ColorType
, _
ScreenArray
() As TextCellType _
)
Dim RoutineName
As String: RoutineName
= "UpdateDisplayMapInput2"
Dim iDeviceCount
As Integer ' count # of devices connected to system (keyboard, mouse, game controllers) Dim iPlayer
As Integer ' same as iController, which of the 8 controllers Dim iWhichInput
As Integer ' one of: cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4
' MOUSE VARIABLES
Dim sZone1
As String ' text description of which controller Dim iMapPlayer
As Integer ' like iController, which of the 8 controllers
' WHICH PORTION OF THE SCREEN USER CLICKED ON
' BOUNDARIES OF BUTTON CLICKED ON
' FOR MAPPING CONTROLLER INPUT
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 iPlayer As Integer
'Dim iLoop As Integer
'Dim iWhichInput As Integer
' DISPLAY BORDERS
PrintString2 iRow, iCol, MapArray(iRow, iCol), ScreenArray()
' DISPLAY CONTROL MAPPINGS
' Get top left screen coordinates for this controller
iStartX = m_arrScreenArea(iPlayer).x1
iStartY = m_arrScreenArea(iPlayer).y1
iEndX = m_arrScreenArea(iPlayer).x2
iEndY = m_arrScreenArea(iPlayer).y2
iWidth = (iEndX - iStartX) + 1
sItem = "Section"
iIndex = GetTextLabel%(m_arrTextLabel(), sItem, "caption")
iRow = (iStartY + m_arrTextLabel(iIndex).row) - 1
iCol = (iStartX + m_arrTextLabel(iIndex).column) - 1
sValue = m_arrTextLabel(iIndex).caption
sValue = Replace$(sValue, "{p}", cstr$(iPlayer))
iNextWidth
= m_arrTextLabel
(iIndex
).
width sValue = StrJustifyLeft$(sValue, iNextWidth)
sValue = StrJustifyRight$(sValue, iNextWidth)
sValue = StrJustifyCenter$(sValue, iNextWidth)
' (DO NOTHING)
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
' (IGNORE)
' POPULATE EACH INPUT FOR THIS PLAYER/CONTROLLER:
' up,down,left,right,button #1,button #2,button #3,button #4
' iWhichInput is one of: cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN ITEM
' get value to match against m_arrTextField(iField).item
sItem = InputToItem$(iWhichInput)
'InputToString$(iWhichInput) returns up,down,left,right,button #1,button #2,button #3,button #4
' find the layout for each field for this input
' m_arrTextField(iField).name = type,device,code,repeat,value
' END ITEM
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN CAPTION
' LABEL
iIndex = GetTextLabel%(m_arrTextLabel(), sItem, "caption")
iRow = (iStartY + m_arrTextLabel(iIndex).row) - 1
iCol = (iStartX + m_arrTextLabel(iIndex).column) - 1
sValue = m_arrTextLabel(iIndex).caption
sValue = Replace$(sValue, "{p}", cstr$(iPlayer))
iNextWidth
= m_arrTextLabel
(iIndex
).
width sValue = StrJustifyLeft$(sValue, iNextWidth)
sValue = StrJustifyRight$(sValue, iNextWidth)
sValue = StrJustifyCenter$(sValue, iNextWidth)
' (DO NOTHING)
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
' (IGNORE)
' END CAPTION
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN TYPE
' values are cInputNone,cInputKey,cInputButton,cInputAxis
' InputTypeToString$ returns none,key,button,axis,unknown
' VALUE
iIndex = GetTextField%(m_arrTextField(), sItem, "type")
iRow = (iStartY + m_arrTextField(iIndex).row) - 1
iCol = (iStartX + m_arrTextField(iIndex).column) - 1
sValue = InputTypeToString$(m_arrControlMap(iPlayer, iWhichInput).typ)
iNextWidth
= m_arrTextField
(iIndex
).
width sValue = StrJustifyLeft$(sValue, iNextWidth)
sValue = StrJustifyRight$(sValue, iNextWidth)
sValue = StrJustifyCenter$(sValue, iNextWidth)
' (DO NOTHING)
Color m_arrTextField
(iIndex
).fgcolor
, m_arrTextField
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
' LABEL
iIndex = GetTextLabel%(m_arrTextLabel(), sItem, "type")
iRow = (iStartY + m_arrTextLabel(iIndex).row) - 1
iCol = (iStartX + m_arrTextLabel(iIndex).column) - 1
sValue = m_arrTextLabel(iIndex).caption
sValue = Replace$(sValue, "{p}", cstr$(iPlayer))
iNextWidth
= m_arrTextLabel
(iIndex
).
width sValue = StrJustifyLeft$(sValue, iNextWidth)
sValue = StrJustifyRight$(sValue, iNextWidth)
sValue = StrJustifyCenter$(sValue, iNextWidth)
' (DO NOTHING)
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
' (IGNORE)
' END TYPE
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DEVICE
' VALUE
iIndex = GetTextField%(m_arrTextField(), sItem, "device")
iRow = (iStartY + m_arrTextField(iIndex).row) - 1
iCol = (iStartX + m_arrTextField(iIndex).column) - 1
sValue = cstr$(m_arrControlMap(iPlayer, iWhichInput).device)
iNextWidth
= m_arrTextField
(iIndex
).
width sValue = StrJustifyLeft$(sValue, iNextWidth)
sValue = StrJustifyRight$(sValue, iNextWidth)
sValue = StrJustifyCenter$(sValue, iNextWidth)
' (DO NOTHING)
Color m_arrTextField
(iIndex
).fgcolor
, m_arrTextField
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
' LABEL
iIndex = GetTextLabel%(m_arrTextLabel(), sItem, "device")
iRow = (iStartY + m_arrTextLabel(iIndex).row) - 1
iCol = (iStartX + m_arrTextLabel(iIndex).column) - 1
sValue = m_arrTextLabel(iIndex).caption
sValue = Replace$(sValue, "{p}", cstr$(iPlayer))
iNextWidth
= m_arrTextLabel
(iIndex
).
width sValue = StrJustifyLeft$(sValue, iNextWidth)
sValue = StrJustifyRight$(sValue, iNextWidth)
sValue = StrJustifyCenter$(sValue, iNextWidth)
' (DO NOTHING)
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
' (IGNORE)
' END DEVICE
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN CODE
' VALUE
iIndex = GetTextField%(m_arrTextField(), sItem, "code")
iRow = (iStartY + m_arrTextField(iIndex).row) - 1
iCol = (iStartX + m_arrTextField(iIndex).column) - 1
If m_arrControlMap
(iPlayer
, iWhichInput
).typ
= cInputKey
Then sValue = GetKeyboardButtonCodeText$(m_arrControlMap(iPlayer, iWhichInput).code)
sValue = cstr$(m_arrControlMap(iPlayer, iWhichInput).code)
iNextWidth
= m_arrTextField
(iIndex
).
width sValue = StrJustifyLeft$(sValue, iNextWidth)
sValue = StrJustifyRight$(sValue, iNextWidth)
sValue = StrJustifyCenter$(sValue, iNextWidth)
' (DO NOTHING)
Color m_arrTextField
(iIndex
).fgcolor
, m_arrTextField
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
' LABEL
iIndex = GetTextLabel%(m_arrTextLabel(), sItem, "code")
iRow = (iStartY + m_arrTextLabel(iIndex).row) - 1
iCol = (iStartX + m_arrTextLabel(iIndex).column) - 1
sValue = m_arrTextLabel(iIndex).caption
sValue = Replace$(sValue, "{p}", cstr$(iPlayer))
iNextWidth
= m_arrTextLabel
(iIndex
).
width sValue = StrJustifyLeft$(sValue, iNextWidth)
sValue = StrJustifyRight$(sValue, iNextWidth)
sValue = StrJustifyCenter$(sValue, iNextWidth)
' (DO NOTHING)
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
' (IGNORE)
' END CODE
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN VALUE
' VALUE
iIndex = GetTextField%(m_arrTextField(), sItem, "value")
iRow = (iStartY + m_arrTextField(iIndex).row) - 1
iCol = (iStartX + m_arrTextField(iIndex).column) - 1
sValue = cstr$(m_arrControlMap(iPlayer, iWhichInput).value)
iNextWidth
= m_arrTextField
(iIndex
).
width sValue = StrJustifyLeft$(sValue, iNextWidth)
sValue = StrJustifyRight$(sValue, iNextWidth)
sValue = StrJustifyCenter$(sValue, iNextWidth)
' (DO NOTHING)
Color m_arrTextField
(iIndex
).fgcolor
, m_arrTextField
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
' LABEL
iIndex = GetTextLabel%(m_arrTextLabel(), sItem, "value")
iRow = (iStartY + m_arrTextLabel(iIndex).row) - 1
iCol = (iStartX + m_arrTextLabel(iIndex).column) - 1
sValue = m_arrTextLabel(iIndex).caption
sValue = Replace$(sValue, "{p}", cstr$(iPlayer))
iNextWidth
= m_arrTextLabel
(iIndex
).
width sValue = StrJustifyLeft$(sValue, iNextWidth)
sValue = StrJustifyRight$(sValue, iNextWidth)
sValue = StrJustifyCenter$(sValue, iNextWidth)
' (DO NOTHING)
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
' (IGNORE)
' END VALUE
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN REPEAT
' VALUE
iIndex = GetTextField%(m_arrTextField(), sItem, "repeat")
iRow = (iStartY + m_arrTextField(iIndex).row) - 1
iCol = (iStartX + m_arrTextField(iIndex).column) - 1
sValue = IIFSTR$(m_arrControlMap(iPlayer, iWhichInput).repeat, "Y", "N")
iNextWidth
= m_arrTextField
(iIndex
).
width sValue = StrJustifyLeft$(sValue, iNextWidth)
sValue = StrJustifyRight$(sValue, iNextWidth)
sValue = StrJustifyCenter$(sValue, iNextWidth)
' (DO NOTHING)
Color m_arrTextField
(iIndex
).fgcolor
, m_arrTextField
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
' LABEL
iIndex = GetTextLabel%(m_arrTextLabel(), sItem, "repeat")
iRow = (iStartY + m_arrTextLabel(iIndex).row) - 1
iCol = (iStartX + m_arrTextLabel(iIndex).column) - 1
sValue = m_arrTextLabel(iIndex).caption
sValue = Replace$(sValue, "{p}", cstr$(iPlayer))
iNextWidth
= m_arrTextLabel
(iIndex
).
width sValue = StrJustifyLeft$(sValue, iNextWidth)
sValue = StrJustifyRight$(sValue, iNextWidth)
sValue = StrJustifyCenter$(sValue, iNextWidth)
' (DO NOTHING)
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
Color m_arrTextLabel
(iIndex
).fgcolor
, m_arrTextLabel
(iIndex
).bgcolor
PrintString2 iRow, iCol, sValue, ScreenArray()
' (IGNORE)
' END REPEAT
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ADD CLOSE BUTTON
ExitY = 1 ' _Height(0) \ _FontHeight
PrintString2 ExitY, ExitX+0, "C", ScreenArray()
PrintString2 ExitY, ExitX+1, "L", ScreenArray()
PrintString2 ExitY, ExitX+2, "O", ScreenArray()
PrintString2 ExitY, ExitX+3, "S", ScreenArray()
PrintString2 ExitY, ExitX+4, "E", ScreenArray()
End Sub ' UpdateDisplayMapInput2
' /////////////////////////////////////////////////////////////////////////////
Dim iDeviceCount
As Integer ' count # of devices connected to system (keyboard, mouse, game controllers) Dim iPlayer
As Integer ' same as iController, which of the 8 controllers Dim iWhichInput
As Integer ' one of: cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4
' VARIABLES FOR SCREEN
' 1024 x 768: 128 x 48
' MOUSE VARIABLES
Dim sZone1
As String ' text description of which controller Dim iMapPlayer
As Integer ' like iController, which of the 8 controllers
' WHICH PORTION OF THE SCREEN USER CLICKED ON
' BOUNDARIES OF BUTTON CLICKED ON
' FOR MAPPING CONTROLLER INPUT
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 iPlayer As Integer
'Dim iLoop As Integer
'Dim iWhichInput As Integer
Dim bMapMode
As Integer ' if TRUE then look for control mapping input
' =============================================================================
' INITIALIZE
InitKeyboardButtonCodes
AddColors arrColor()
StringToArray MapArray(), GetMap$
SetupScreenAreas
SetupButtons
SetupTextLabels
SetupTextFields
' =============================================================================
' 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 < 3 Then
sError = "Enough devices not found."
' =============================================================================
' COUNT # OF JOYSTICKS
' TODO: find out the right way to count 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
' LIMIT # OF DEVICES, IF THERE IS A LIMIT DEFINED
iNumControllers = iDeviceCount - 2
If iNumControllers
> cMaxControllers
Then iNumControllers = cMaxControllers
' ONLY 2 FOUND (KEYBOARD, MOUSE)
'sError = "No game controllers found."
iNumControllers = 0
' =============================================================================
' INITIALIZE CONTROLLER DATA
For iController
= 1 To iNumControllers
m_arrController(iController).buttonCount = cMaxButtons
m_arrController(iController).axisCount = cMaxAxis
For iLoop
= 1 To cMaxButtons
arrButtonNew(iController, iLoop) = TRUE
For iLoop
= 1 To cMaxAxis
arrAxisNew(iController, iLoop) = TRUE
' =============================================================================
' INITIALIZE CONTROLLER INPUT
For iController
= 1 To iNumControllers
iDevice = iController + 2
m_arrController(iController).buttonCount = iLoop
arrButton(iController, iLoop) = FALSE
m_arrController(iController).axisCount = iLoop
arrAxis(iController, iLoop) = 0
Wend ' clear and update the device buffer
' =============================================================================
' INIT SCREEN
UpdateDisplayMapInput2 arrColor(), MapArray(), ScreenArray()
' =============================================================================
' MAIN LOOP
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN MOUSE #MOUSE
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
bFinished = FALSE
bHitEsc = FALSE
bHitEnter = FALSE
bMapMode = FALSE
CloseX = 0
CloseY = 0
ExitY = 1 ' _Height(0) \ _FontHeight
' READ MOUSE
' ERASE CURSOR
Color ScreenArray
(iTextY
, iTextX
).fgColor
, ScreenArray
(iTextY
, iTextX
).bgColor
PrintString1 iTextY, iTextX, ScreenArray(iTextY, iTextX).value
' SAVE OLD POSITION
iOldY1 = iY1
iOldX1 = iX1
' GET NEW POSITION
' DRAW CURSOR
PrintString1 iTextY, iTextX, " "
' LEFT CLICK
' (CLICK ACTION HERE)
' IS SELECTING A CONTROL TO MAP, OR MAPPING A CONTROL?
' DID THEY CLOSE?
If (iTextY
= ExitY
) And (iTextX
>= ExitX
) Then ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' USER CLICKED EXIT SCREEN
bFinished = True
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' BEGIN USER IS SELECTING A CONTROL TO MAP
' WHICH CONTROLLER?
if iTextY
>= m_arrScreenArea
(iIndex
).y1
then if iTextY
<= m_arrScreenArea
(iIndex
).y2
then if iTextX
>= m_arrScreenArea
(iIndex
).x1
then if iTextX
<= m_arrScreenArea
(iIndex
).x2
then iMapPlayer = m_arrScreenArea(iIndex).player
sZone1 = m_arrScreenArea(iIndex).item
iOffsetX = m_arrScreenArea(iIndex).x1 - 1
iOffsetY = m_arrScreenArea(iIndex).y1 - 1
' WHICH BUTTON?
if iTextY
>= m_arrButton
(iIndex
).y1
+iOffsetY
then if iTextY
<= m_arrButton
(iIndex
).y2
+iOffsetY
then if iTextX
>= m_arrButton
(iIndex
).x1
+iOffsetX
then if iTextX
<= m_arrButton
(iIndex
).x2
+iOffsetX
then
iWhichInput = m_arrButton(iIndex).typ ' cInputUp, cInputDown, cInputLeft, cInputRight, cInputButton1, cInputButton2, cInputButton3, cInputButton4
sZone2 = m_arrButton(iIndex).item
DebugPrint "clicked " + sZone1 + ", " + sZone2
'iMapX1 = m_arrButton(iIndex).x1+iOffsetX
'iMapX2 = m_arrButton(iIndex).x2+iOffsetX
'iMapY1 = m_arrButton(iIndex).y1+iOffsetY
'iMapY2 = m_arrButton(iIndex).y2+iOffsetY
'
'sPrompt = ""
'sPrompt = sPrompt + "Move control" + chr$(13)
'sPrompt = sPrompt + "or press key " + chr$(13)
'sPrompt = sPrompt + "for " + InputToString$(iWhichInput) + chr$(13)
'sPrompt = sPrompt + "<ESC> + <ENTER>" + chr$(13)
'sPrompt = sPrompt + "to cancel."
'MapInputPrompt sPrompt, iMapX1, iMapX2, iMapY1, iMapY2, cBlack, cWhite
sCaption = "Map " + InputToString$(iWhichInput) + " for " + cstr$(iMapPlayer)
sPrompt = ""
sPrompt
= sPrompt
+ "Move controller or press key" + chr$(13) sPrompt = sPrompt + "or click close 'x' to cancel."
MapInputPopup sCaption, cWhite, cGray, sPrompt, cBlack, cWhite, CloseX, CloseY, ScreenArray()
' END USER IS SELECTING A CONTROL TO MAP
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' BEGIN USER CLICKED TO CANCEL MAP MODE
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' USER CLICKED EXIT SCREEN
bFinished = True
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' USER CLICKED "CANCEL"
' EXIT MAP MODE
CloseX = 0
CloseY = 0
' REFRESH SCREEN
UpdateDisplayMapInput2 arrColor(), MapArray(), ScreenArray()
' END USER CLICKED TO CANCEL MAP MODE
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
bOldLeftClick = TRUE
' USER RELEASED MOUSE BUTTON
bOldLeftClick = FALSE
sZone1 = ""
sZone2 = ""
iOffsetX = 0
iOffsetY = 0
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' BEGIN LOOK FOR MAPPING INPUT
' =============================================================================
' BEGIN LOOK FOR NEXT INPUT
bMoveNext = FALSE
' -----------------------------------------------------------------------------
' BEGIN CHECK FOR CONTROLLER INPUT
For iController
= 1 To iNumControllers
iDevice = iController + 2
' Check all devices
' Check each button
'm_arrController(iController).buttonCount = iLoop
' update button array to indicate if a button is up or down currently.
If iValue
<> arrButton
(iController
, iLoop
) Then ' *****************************************************************************
' PRESSED BUTTON
' make sure this isn't already mapped
bHaveInput = TRUE
' is input unique?
For iNextInput
= LBound(m_arrControlMap
, 2) To iWhichInput
- 1 If m_arrControlMap
(iMapPlayer
, iNextInput
).device
= iDevice
Then If m_arrControlMap
(iMapPlayer
, iNextInput
).typ
= cInputButton
Then If m_arrControlMap
(iMapPlayer
, iNextInput
).code
= iLoop
Then If m_arrControlMap
(iMapPlayer
, iNextInput
).value
= iValue
Then bHaveInput = FALSE
m_arrControlMap(iMapPlayer, iWhichInput).device = iDevice
m_arrControlMap(iMapPlayer, iWhichInput).typ = cInputButton
m_arrControlMap(iMapPlayer, iWhichInput).code = iLoop
m_arrControlMap(iMapPlayer, iWhichInput).value = iValue
bMoveNext = TRUE
' Check each axis
'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 dblNextAxis
<> arrAxis
(iController
, iLoop
) Then ' *****************************************************************************
' MOVED STICK
' convert to a digital value
iValue = -1
iValue = 1
' make sure this isn't already mapped
bHaveInput = TRUE
' is input unique?
For iNextInput
= LBound(m_arrControlMap
, 2) To iWhichInput
- 1 If m_arrControlMap
(iMapPlayer
, iNextInput
).device
= iDevice
Then If m_arrControlMap
(iMapPlayer
, iNextInput
).typ
= cInputAxis
Then If m_arrControlMap
(iMapPlayer
, iNextInput
).code
= iLoop
Then If m_arrControlMap
(iMapPlayer
, iNextInput
).value
= iValue
Then bHaveInput = FALSE
m_arrControlMap(iMapPlayer, iWhichInput).device = iDevice
m_arrControlMap(iMapPlayer, iWhichInput).typ = cInputAxis
m_arrControlMap(iMapPlayer, iWhichInput).code = iLoop
m_arrControlMap(iMapPlayer, iWhichInput).value = iValue
bMoveNext = TRUE
Wend ' clear and update the device buffer
' END CHECK FOR CONTROLLER INPUT
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN CHECK FOR KEYBOARD INPUT #1
'_KEYCLEAR: _DELAY 1
' Detect changed key state
iCode = m_arrButtonCode(iLoop)
' *****************************************************************************
' PRESSED KEYBOARD
'PRINT "PRESSED " + m_arrButtonKey(iLoop)
' make sure this isn't already mapped
bHaveInput = TRUE
' is input unique?
For iNextInput
= LBound(m_arrControlMap
, 2) To iWhichInput
- 1 If m_arrControlMap
(iMapPlayer
, iNextInput
).device
= 1 Then ' .device 1 = keyboard If m_arrControlMap
(iMapPlayer
, iNextInput
).typ
= cInputKey
Then If m_arrControlMap
(iMapPlayer
, iNextInput
).code
= iCode
Then 'if m_arrControlMap(iMapPlayer, iNextInput).value = TRUE then
bHaveInput = FALSE
'end if
m_arrControlMap(iMapPlayer, iWhichInput).device = 1 ' .device 1 = keyboard
m_arrControlMap(iMapPlayer, iWhichInput).typ = cInputKey
m_arrControlMap(iMapPlayer, iWhichInput).code = iCode
m_arrControlMap(iMapPlayer, iWhichInput).value = TRUE
bMoveNext = TRUE
' CLEAR KEYBOARD BUFFER
' END CHECK FOR KEYBOARD INPUT #1
' -----------------------------------------------------------------------------
' WE HAVE MAPPED SOMETHING
m_bHaveMapping = TRUE
' EXIT MAPPING MODE
CloseX = 0
CloseY = 0
iOffsetX = 0
iOffsetY = 0
' REFRESH SCREEN
UpdateDisplayMapInput2 arrColor(), MapArray(), ScreenArray()
' END LOOK FOR NEXT INPUT
' =============================================================================
' END LOOK FOR MAPPING INPUT
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END MOUSE @MOUSE
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' CLEAR KEYBOARD BUFFER
' CLEAR SCREEN
' DONE
MapInput2$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' Displays a popup with a close button "X" in the upper right,
' with text in MyString.
' Returns the x,y position of the close button in parameters CloseX, CloseY.
' Resolution Cols Rows
' 1024 x 768 128 48
' MapInputPopup sCaption, cBlack, cGray, sText, cBlack, cWhite, CloseX, CloseY
)
' Figure out window size
sCaption = sCaption2
iColCount
= len(sCaption
)+1 iRowCount = 0
split sText
, chr$(13), arrLines
() iRowCount = iRowCount + 1
iColCount
= len(arrLines
(iLoopRows
))
' Draw window as long as there is text
' Make sure popup is not wider than screen
If iColCount
> iCols
Then iColCount
= iCols
If iRowCount
> iRows
Then iRowCount
= iRows
' Center the popup
x1 = (iCols - iColCount) \ 2
y1 = (iRows - iRowCount) \ 2
x2 = x1 + (iColCount - 1)
y2 = y1 + (iRowCount - 1)
' Draw the caption
Color fgCaptionColor
, bgCaptionColor
'PrintString1 y1, x1, left$(sCaption + string$(iColCount, " "), iColCount)
PrintString2 y1
, x1
, left$(sCaption
+ string$(iColCount
, " "), iColCount
), ScreenArray
()
' Draw the close button
Color fgTextColor
, bgTextColor
'PrintString1 y1, x2, "X"
PrintString2 y1, x2, "X", ScreenArray()
CloseX = x2 :CloseY = y1
' Get width
iWidth = (x2 - x1) + 1
' Draw the popup
iY = y1
Color fgTextColor
, bgTextColor
PrintString2 iY
, x1
, left$(arrLines
(iLoopRows
) + String$(iWidth
, " "), iWidth
), ScreenArray
() 'PrintString1 iY, x1, String$(iColCount, " ")
PrintString2 iLoopRows
, x1
, String$(iWidth
, " "), ScreenArray
() CloseX = 0 : CloseY = 0
' /////////////////////////////////////////////////////////////////////////////
' MapInputPrompt MyString, iMapX1, iMapX2, iMapY1, iMapY2, cBlack, cWhite
iMaxLen = (x2 - x1)+1
split MyString
, chr$(13), arrLines
() iLine = 0
iY = y1
PrintString1 iY
, x1
, left$(arrLines
(iLoopRows
), iMaxLen
) PrintString1 iY
, x1
, left$(arrLines
(iLoopRows
) + String$(iMaxLen
, " "), iMaxLen
) iY = iY + 1
PrintString1 iY
, x1
, String$(iMaxLen
, " ")
' /////////////////////////////////////////////////////////////////////////////
PrintString iRow
, iColumn
, String$(128, " ")
PrintString iRow, iColumn, sPrompt
'_KEYCLEAR: _DELAY 1
'DO
'LOOP UNTIL _KEYDOWN(13) ' leave loop when ENTER key pressed
'_KEYCLEAR: _DELAY 1
' /////////////////////////////////////////////////////////////////////////////
PrintString iRow
, iColumn
, String$(128, " ") PrintString iRow, iColumn, sPrompt
' /////////////////////////////////////////////////////////////////////////////
Dim RoutineName
As String: RoutineName
= "TestMouseXYButton$"
PrintString 0, 0, "_MOUSEX ="
PrintString 1, 0, "_MOUSEY ="
PrintString 2, 0, "_MOUSEBUTTON(1)="
PrintString 3, 0, "_MOUSEBUTTON(2)="
PrintString 4, 0, "_MOUSEBUTTON(3)="
PrintString 5, 0, "_MOUSEWHEEL X ="
PrintString 6, 0, "_MOUSEWHEEL Y ="
PrintString 8, 0, "PRESS <ESC> TO EXIT"
PrintString
0, 16, Left$(cstr$
(iX1
) + " ", 5) PrintString
1, 16, Left$(cstr$
(iY1
) + " ", 5) PrintString
2, 16, Left$(TrueFalse$
(bLeftClick
) + " ", 5) PrintString
3, 16, Left$(TrueFalse$
(bRightClick
) + " ", 5) PrintString
4, 16, Left$(TrueFalse$
(bMiddleClick
) + " ", 5) PrintString
5, 16, Left$(cstr$
(iX2
) + " ", 5) PrintString
6, 16, Left$(cstr$
(iY2
) + " ", 5)
iOldX1 = iX1: iOldY1 = iY1
iOldX2 = iX2: iOldY2 = iY2
iColor1 = cRed
iColor1 = cMagenta
iColor1 = cOrangeRed
bOldLeftClick = TRUE
bOldLeftClick = FALSE
If bOldRightClick
= FALSE
Then iColor2 = cLime
iColor2 = cYellow
iColor2 = cBlue
bOldRightClick = TRUE
bOldRightClick = FALSE
TestMouseXYButton$ = ""
' /////////////////////////////////////////////////////////////////////////////
' INITIALIZE
InitKeyboardButtonCodes
' SET UP SCREEN
' 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 '' Try loading map
'sError = LoadControllerMap1$
'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
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 = MapInput1b$(iPlayer)
Print "Remember to save mappings when done." sResult = "(Cancelled.)"
sResult = "No controller devices found."
Input "PRESS <ENTER> TO CONTINUE", in$
MapInput1$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' 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
Dim RoutineName
As String:: RoutineName
= "MapInput1b$"
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
' FOR PRINTING OUTPUT
Dim iDigits
As Integer ' # digits to display (values are truncated to this length)
' INITIALIZE
iDigits = 4 ' 11
iColCount = 3
iGroupCount = 0 ' re-initialized at the top of every loop
' COUNT # OF JOYSTICKS
' TODO: find out the right way to count 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
' LIMIT # OF DEVICES, IF THERE IS A LIMIT DEFINED
iNumControllers = iDeviceCount - 2
If iNumControllers
> cMaxControllers
Then iNumControllers = cMaxControllers
' ONLY 2 FOUND (KEYBOARD, MOUSE)
sError = "No game controllers found."
' INITIALIZE CONTROLLER DATA
For iController
= 1 To iNumControllers
m_arrController(iController).buttonCount = cMaxButtons
m_arrController(iController).axisCount = cMaxAxis
For iLoop
= 1 To cMaxButtons
arrButtonNew(iController, iLoop) = TRUE
For iLoop
= 1 To cMaxAxis
arrAxisNew(iController, iLoop) = TRUE
' INITIALIZE CONTROLLER INPUT
Print "We will now detect controllers." Print "Do not touch any keys or game controllers during detection." Input "Press <ENTER> to begin"; in$
sLine
= "Initializing controllers":
Print sLine;
iMaxCols
= (iCols
- Len(sLine
)) - 1 iCount = 0
iCount = iCount + 1
For iController
= 1 To iNumControllers
iDevice = iController + 2
m_arrController(iController).buttonCount = iLoop
'IF _BUTTONCHANGE(iLoop) THEN
' arrButton(iController, iLoop) = _BUTTON(iLoop)
'END IF
arrButton(iController, iLoop) = FALSE
m_arrController(iController).axisCount = iLoop
arrAxis(iController, iLoop) = 0
Wend ' clear and update the device buffer Loop Until iCount
> 60 ' quit after 2 seconds
' WAIT FOR INPUT
Print "Press <ESCAPE> to cancel at any time."
bCancel = FALSE
bFinished = FALSE
iLastPressed = 0
'print "iWhichInput=" + cstr$(iWhichInput)
Print "Player #" + cstr$
(iPlayer
) + " press control for " + InputToString$
(iWhichInput
) + " or ESC to skip: ";
' =============================================================================
' BEGIN LOOK FOR NEXT INPUT
bMoveNext = FALSE
' -----------------------------------------------------------------------------
' BEGIN CHECK FOR CONTROLLER INPUT
For iController
= 1 To iNumControllers
iDevice = iController + 2
' Check all devices
' Check each button
'm_arrController(iController).buttonCount = iLoop
' update button array to indicate if a button is up or down currently.
If iValue
<> arrButton
(iController
, iLoop
) Then ' *****************************************************************************
' PRESSED BUTTON
' make sure this isn't already mapped
bHaveInput = TRUE
' 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
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
' Check each axis
'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 dblNextAxis
<> arrAxis
(iController
, iLoop
) Then ' *****************************************************************************
' MOVED STICK
' convert to a digital value
iValue = -1
iValue = 1
' make sure this isn't already mapped
bHaveInput = TRUE
' 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
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
Wend ' clear and update the device buffer
' END CHECK FOR CONTROLLER INPUT
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN CHECK FOR KEYBOARD INPUT #1
'_KEYCLEAR: _DELAY 1
' Detect changed key state
iCode = m_arrButtonCode(iLoop)
' *****************************************************************************
' PRESSED KEYBOARD
'PRINT "PRESSED " + m_arrButtonKey(iLoop)
' make sure this isn't already mapped
bHaveInput = TRUE
' 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
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 CHECK FOR KEYBOARD INPUT #1
' -----------------------------------------------------------------------------
' END LOOK FOR NEXT INPUT
' =============================================================================
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)
' Only ask user to select repeat if no override.
If m_bRepeatOverride
= FALSE
Then m_arrControlMap(iPlayer, iWhichInput).repeat = TRUE
m_arrControlMap(iPlayer, iWhichInput).repeat = FALSE
m_arrControlMap(iPlayer, iWhichInput).repeat = GetGlobalInputRepeatSetting%(iWhichInput)
bCancel = TRUE
bFinished = TRUE
m_bHaveMapping = TRUE
sResult = "ERRORS: " + sError
MapInput1b$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' Receives which input contstant and returns a text description
InputToString$ = "up"
InputToString$ = "down"
InputToString$ = "left"
InputToString$ = "right"
InputToString$ = "button #1"
InputToString$ = "button #2"
InputToString$ = "button #3"
InputToString$ = "button #4"
InputToString$ = "unknown"
' /////////////////////////////////////////////////////////////////////////////
' Receives which input contstant and returns a text description
' that matches the TextFieldType and TextLabelType ".item" member.
InputToItem$ = "Up"
InputToItem$ = "Down"
InputToItem$ = "Left"
InputToItem$ = "Right"
InputToItem$ = "Button1"
InputToItem$ = "Button2"
InputToItem$ = "Button3"
InputToItem$ = "Button4"
InputToItem$ = ""
' /////////////////////////////////////////////////////////////////////////////
' Receives which input contstant and returns its global "repeat" setting
' usage:
' m_arrControlMap(iPlayer, iWhichInput).repeat = GetGlobalInputRepeatSetting%(cInputUp)
GetGlobalInputRepeatSetting% = m_bRepeatUp
GetGlobalInputRepeatSetting% = m_bRepeatDown
GetGlobalInputRepeatSetting% = m_bRepeatLeft
GetGlobalInputRepeatSetting% = m_bRepeatRight
GetGlobalInputRepeatSetting% = m_bRepeatButton1
GetGlobalInputRepeatSetting% = m_bRepeatButton2
GetGlobalInputRepeatSetting% = m_bRepeatButton3
GetGlobalInputRepeatSetting% = m_bRepeatButton4
GetGlobalInputRepeatSetting% = FALSE
' /////////////////////////////////////////////////////////////////////////////
InputTypeToString$ = "none"
InputTypeToString$ = "key"
InputTypeToString$ = "button"
InputTypeToString$ = "axis"
InputTypeToString$ = "unknown"
' /////////////////////////////////////////////////////////////////////////////
' METHOD v2 = faster
sResult = m_arrButtonKeyDesc(iCode)
GetKeyboardButtonCodeText$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' METHOD v2 = faster
sResult = m_arrButtonKeyDesc(iCode)
GetKeyboardButtonCodeShortText$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' 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
' ReDim Shared m_arrButtonKeyShortDesc(0 To 512) As String
Sub InitKeyboardButtonCodes
()
If m_bInitialized
= FALSE
Then ' 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
m_arrButtonKeyDesc(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"
' SHORT DESCRIPTIONS BY KEYCODE
m_arrButtonKeyShortDesc(iLoop) = ""
m_arrButtonKeyShortDesc(2) = "Esc"
m_arrButtonKeyShortDesc(60) = "F1"
m_arrButtonKeyShortDesc(61) = "F2"
m_arrButtonKeyShortDesc(62) = "F3"
m_arrButtonKeyShortDesc(63) = "F4"
m_arrButtonKeyShortDesc(64) = "F5"
m_arrButtonKeyShortDesc(65) = "F6"
m_arrButtonKeyShortDesc(66) = "F7"
m_arrButtonKeyShortDesc(67) = "F8"
m_arrButtonKeyShortDesc(68) = "F9"
m_arrButtonKeyShortDesc(88) = "F11"
m_arrButtonKeyShortDesc(89) = "F12"
m_arrButtonKeyShortDesc(42) = "Tilde"
m_arrButtonKeyShortDesc(3) = "1"
m_arrButtonKeyShortDesc(4) = "2"
m_arrButtonKeyShortDesc(5) = "3"
m_arrButtonKeyShortDesc(6) = "4"
m_arrButtonKeyShortDesc(7) = "5"
m_arrButtonKeyShortDesc(8) = "6"
m_arrButtonKeyShortDesc(9) = "7"
m_arrButtonKeyShortDesc(10) = "8"
m_arrButtonKeyShortDesc(11) = "9"
m_arrButtonKeyShortDesc(12) = "0"
m_arrButtonKeyShortDesc(13) = "Minus"
m_arrButtonKeyShortDesc(14) = "Equal"
m_arrButtonKeyShortDesc(15) = "BkSp"
m_arrButtonKeyShortDesc(16) = "Tab"
m_arrButtonKeyShortDesc(17) = "Q"
m_arrButtonKeyShortDesc(18) = "W"
m_arrButtonKeyShortDesc(19) = "E"
m_arrButtonKeyShortDesc(20) = "R"
m_arrButtonKeyShortDesc(21) = "T"
m_arrButtonKeyShortDesc(22) = "Y"
m_arrButtonKeyShortDesc(23) = "U"
m_arrButtonKeyShortDesc(24) = "I"
m_arrButtonKeyShortDesc(25) = "O"
m_arrButtonKeyShortDesc(26) = "P"
m_arrButtonKeyShortDesc(27) = "BrktLeft"
m_arrButtonKeyShortDesc(28) = "BrktRight"
m_arrButtonKeyShortDesc(44) = "Backslash"
m_arrButtonKeyShortDesc(59) = "CapsLock"
m_arrButtonKeyShortDesc(31) = "A"
m_arrButtonKeyShortDesc(32) = "S"
m_arrButtonKeyShortDesc(33) = "D"
m_arrButtonKeyShortDesc(34) = "F"
m_arrButtonKeyShortDesc(35) = "G"
m_arrButtonKeyShortDesc(36) = "H"
m_arrButtonKeyShortDesc(37) = "J"
m_arrButtonKeyShortDesc(38) = "K"
m_arrButtonKeyShortDesc(39) = "L"
m_arrButtonKeyShortDesc(40) = "Semicolon"
m_arrButtonKeyShortDesc(41) = "Apostrophe"
m_arrButtonKeyShortDesc(29) = "Enter"
m_arrButtonKeyShortDesc(43) = "ShiftLeft"
m_arrButtonKeyShortDesc(45) = "Z"
m_arrButtonKeyShortDesc(46) = "X"
m_arrButtonKeyShortDesc(47) = "C"
m_arrButtonKeyShortDesc(48) = "V"
m_arrButtonKeyShortDesc(49) = "B"
m_arrButtonKeyShortDesc(50) = "N"
m_arrButtonKeyShortDesc(51) = "M"
m_arrButtonKeyShortDesc(52) = "Comma"
m_arrButtonKeyShortDesc(53) = "Period"
m_arrButtonKeyShortDesc(54) = "Slash"
m_arrButtonKeyShortDesc(55) = "ShiftRight"
m_arrButtonKeyShortDesc(30) = "CtrlLeft"
m_arrButtonKeyShortDesc(348) = "WinLeft"
m_arrButtonKeyShortDesc(58) = "Spacebar"
m_arrButtonKeyShortDesc(349) = "WinRight"
m_arrButtonKeyShortDesc(350) = "Menu"
m_arrButtonKeyShortDesc(286) = "CtrlRight"
m_arrButtonKeyShortDesc(339) = "Ins"
m_arrButtonKeyShortDesc(328) = "Home"
m_arrButtonKeyShortDesc(330) = "PgUp"
m_arrButtonKeyShortDesc(340) = "Del"
m_arrButtonKeyShortDesc(336) = "End"
m_arrButtonKeyShortDesc(338) = "PgDn"
m_arrButtonKeyShortDesc(329) = "Up"
m_arrButtonKeyShortDesc(332) = "Left"
m_arrButtonKeyShortDesc(337) = "Down"
m_arrButtonKeyShortDesc(334) = "Right"
m_arrButtonKeyShortDesc(71) = "ScrollLock"
m_arrButtonKeyShortDesc(326) = "NumLock"
m_arrButtonKeyShortDesc(310) = "KeypadSlash"
m_arrButtonKeyShortDesc(56) = "KeypadMult"
m_arrButtonKeyShortDesc(75) = "KeypadMinus"
m_arrButtonKeyShortDesc(72) = "Keypad7Home"
m_arrButtonKeyShortDesc(73) = "Keypad8Up"
m_arrButtonKeyShortDesc(74) = "Keypad9PgUp"
m_arrButtonKeyShortDesc(79) = "KeypadPlus"
m_arrButtonKeyShortDesc(76) = "Keypad4Lf"
m_arrButtonKeyShortDesc(77) = "Keypad5"
m_arrButtonKeyShortDesc(78) = "Keypad6Rt"
m_arrButtonKeyShortDesc(80) = "Keypad1End"
m_arrButtonKeyShortDesc(81) = "Keypad2Dn"
m_arrButtonKeyShortDesc(82) = "Keypad3PgDn"
m_arrButtonKeyShortDesc(285) = "KeypadEnter"
m_arrButtonKeyShortDesc(83) = "Keypad0Ins"
m_arrButtonKeyShortDesc(84) = "KeypadPerDel"
m_bInitialized = TRUE
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
'_KEYCLEAR: _DELAY 1
KeydownF10% = TRUE
KeydownF10% = FALSE
'_KEYCLEAR
' /////////////////////////////////////////////////////////////////////////////
' 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
'_KEYCLEAR: _DELAY 1
KeyhitAltLeft% = TRUE
KeyhitAltLeft% = FALSE
'_KEYCLEAR
' /////////////////////////////////////////////////////////////////////////////
' 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
'_KEYCLEAR: _DELAY 1
KeyhitAltRight% = TRUE
KeyhitAltRight% = FALSE
'_KEYCLEAR
' /////////////////////////////////////////////////////////////////////////////
' 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?)
'_KEYCLEAR: _DELAY 1
KeyPressed% = TRUE
KeyPressed% = FALSE
'_KEYCLEAR
' /////////////////////////////////////////////////////////////////////////////
Dim RoutineName
As String: RoutineName
= "TestJoysticks1$"
' 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 TestJoysticks1b
sResult = ""
sResult = "No joysticks found."
TestJoysticks1$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' 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
' 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
Dim RoutineName
As String:: RoutineName
= "TestJoysticks1b"
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 iDigits
As Integer ' # digits to display (values are truncated to this length) 'DIM iMeasureCount AS INTEGER
' SET UP SCREEN
' INITIALIZE
iDigits = 4 ' 11
iColCount = 3
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 Print "NO JOYSTICKS FOUND, EXITING..." Input "PRESS <ENTER>"; in$
' 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
' INITIALIZE PLAYER COORDINATES AND SCREEN CHARACTERS
iNextY = 1
iNextX = -3
iNextC = 64
For iController
= 1 To iNumControllers
iNextX = iNextX + 4
iNextX = 1
iNextY = iNextY + 4
iNextC = iNextC + 1
arrController(iController).buttonCount = cMaxButtons
arrController(iController).axisCount = cMaxAxis
For iLoop
= 1 To cMaxButtons
arrButtonNew(iController, iLoop) = TRUE
For iLoop
= 1 To cMaxAxis
arrAxisNew(iController, iLoop) = TRUE
arrAxisAvg(iController, iLoop) = 0
' CLEAR THE SCREEN
'iMeasureCount = 0
For iController
= 1 To iNumControllers
iDevice = iController + 2
''IF _DEVICEINPUT = 3 THEN ' this says we only care about joystick input values
' check all the buttons
arrController(iController).buttonCount = iLoop
' update button array to indicate if a button is up or down currently.
'' _BUTTON(number) returns -1 when a button is pressed and 0 when released.
''arrButton(iLoop) = NOT arrButton(iLoop)
arrButton
(iController
, iLoop
) = _Button(iLoop
)
'' 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
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
arrAxis(iController, iLoop) = dblNextAxis
arrAxis(iController, iLoop) = 0
'' 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)
Wend ' clear and update the device buffer
'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
PrintStringCR1 1, 1, "Game controller test program."
PrintStringCR1 1, 2, "This program is free to use and distribute per GNU GPLv3 license."
PrintStringCR1 1, 3, "Tests up to 4 controllers with 2 axes / 2 buttons each."
PrintStringCR1 1, 4, "Plug in controllers and move them & press buttons."
PrintStringCR1 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
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
iGroupCount = iGroupCount + 1
ColumnBreak
iGroupCount = 0
PrintStringCR1 1, iRows - 1, "-------------------------------------------------------------------------------"
PrintStringCR1 1, iRows - 0, "PRESS <ESC> TO EXIT"
'end if
' RETURN TO TEXT SCREEN
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 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 {code} 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
' 7 {repeat} Integer if TRUE, and repeating keys not controlled by global values (when m_bRepeatOverride=TRUE), controls repeating keys for this control
' 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"
' Dim Shared m_bRepeatOverride As Integer
' If there is an error, returns error message,
' else returns blank string.
Dim RoutineName
As String:: RoutineName
= "SaveControllerMap1$" 'Dim iError As Long: iError = 0
'DebugPrint "--------------------------------------------------------------------------------"
'DebugPrint "Started " + RoutineName
'DebugPrint "--------------------------------------------------------------------------------"
' Get file name
m_ControlMapFileName$
= Left$(m_ProgramName$
, _InStrRev(m_ProgramName$
, ".")) + "map.txt" 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
sLine = ""
sLine = sLine + sDelim
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
)) sLine = sLine + sDelim
sLine
= sLine
+ _Trim$(Str$(m_arrControlMap
(iPlayer
, iWhichInput
).repeat
))
iCount = iCount + 1
'DebugPrint "Wrote " + _Trim$(Str$(iCount)) + " lines."
'Print "Skipped " + _Trim$(Str$(iError)) + " lines."
'DebugPrint ""
'Input "PRESS <ENTER> TO CONTINUE", in$
sResult
= "Saved mapping file " + Chr$(34) + sFile
+ Chr$(34) + "." sResult = "ERRORS: " + sError
SaveControllerMap1$ = sResult
' /////////////////////////////////////////////////////////////////////////////
Dim RoutineName
As String:: RoutineName
= "LoadControllerMap1$"
'Dim sDebugLine As String
'DebugPrint "--------------------------------------------------------------------------------"
'DebugPrint "Started " + RoutineName
'DebugPrint "--------------------------------------------------------------------------------"
' Get file name
m_ControlMapFileName$
= Left$(m_ProgramName$
, _InStrRev(m_ProgramName$
, ".")) + "map.txt" sFile
= Mid$(m_ControlMapFileName$
, _InStrRev(m_ControlMapFileName$
, "\") + 1)
'' 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
sError
= "File not found: " + Chr$(34) + m_ControlMapFileName$
+ Chr$(34) 'DebugPrint "Found file: " + chr$(34) + m_ControlMapFileName$ + chr$(34)
' Read data from file
'DebugPrint "OPEN m_ControlMapFileName$ FOR BINARY AS #1"
iTotal
= Len(sText
) - Len(Replace$
(sText
, Chr$(13), "")) sText = ""
'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)
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 iAdjust = -1 '- lbound(arrNextLine)
If IsNum%
(arrNextLine
(1 + iAdjust
)) = TRUE
Then iPlayer
= Val(arrNextLine
(1 + iAdjust
)) sNextErr = "Error on line " + cstr$(iRead) + ", value 1: not a number"
If IsNum%
(arrNextLine
(2 + iAdjust
)) = TRUE
Then iWhichInput
= Val(arrNextLine
(2 + iAdjust
)) sNextErr = "Error on line " + cstr$(iRead) + ", value 2: not a number"
If IsNum%
(arrNextLine
(3 + iAdjust
)) = TRUE
Then iDevice
= Val(arrNextLine
(3 + iAdjust
)) sNextErr = "Error on line " + cstr$(iRead) + ", value 3: not a number"
If IsNum%
(arrNextLine
(4 + iAdjust
)) = TRUE
Then iType
= Val(arrNextLine
(4 + iAdjust
)) sNextErr = "Error on line " + cstr$(iRead) + ", value 4: not a number"
If IsNum%
(arrNextLine
(5 + iAdjust
)) = TRUE
Then iCode
= Val(arrNextLine
(5 + iAdjust
)) sNextErr = "Error on line " + cstr$(iRead) + ", value 5: not a number"
If IsNum%
(arrNextLine
(6 + iAdjust
)) = TRUE
Then iValue
= Val(arrNextLine
(6 + iAdjust
)) sNextErr = "Error on line " + cstr$(iRead) + ", value 6: not a number"
' validate iPlayer
sNextErr
= "Player value " + _Trim$(Str$(iPlayer
)) + _
" is outside lbound(m_arrControlMap, 1) " + _
sNextErr
= "Player value " + _Trim$(Str$(iPlayer
)) + _
" is outside ubound(m_arrControlMap, 1) " + _
' validate iWhichInput
sNextErr
= "WhichInput value " + _Trim$(Str$(iWhichInput
)) + _
" is outside lbound(m_arrControlMap, 2) " + _
sNextErr
= "WhichInput value " + _Trim$(Str$(iWhichInput
)) + _
" is outside ubound(m_arrControlMap, 2) " + _
' validate repeat setting
If IsNum%
(arrNextLine
(7 + iAdjust
)) = TRUE
Then bRepeat
= Val(arrNextLine
(7 + iAdjust
)) sNextErr = "Error on line " + cstr$(iRead) + ", value 7: not a number"
' get values from global
'if m_bRepeatOverride = TRUE then
bRepeat = GetGlobalInputRepeatSetting%(iWhichInput)
'end if
sNextErr = "Error on line " + cstr$(iRead) + ": detected " + cstr$(iNumValues) + " values, expected 6."
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
m_arrControlMap(iPlayer, iWhichInput).repeat = bRepeat
iBad = iBad + 1
DebugPrint sNextErr
'DebugPrint " Line is blank: skipped"
iBlank = iBlank + 1
'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$
sResult
= "Loaded mapping file " + Chr$(34) + sFile
+ Chr$(34) + "." m_bHaveMapping = TRUE
sResult = "ERRORS: " + sError
LoadControllerMap1$ = sResult
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END FILE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GRAPHIC PRINTING ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' A way to automatically print to columns.
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)
' /////////////////////////////////////////////////////////////////////////////
' A way to automatically print to columns.
If iNumColumns
< 1 Or iNumColumns
> iCols
Then m_NumColumns = 1
m_NumColumns = iNumColumns
If m_StartRow
< 1 Or m_StartRow
> iRows
Then m_StartRow = 1
If m_EndRow
< m_StartRow
Or m_EndRow
> iRows
Then m_EndRow = iRows
If m_StartCol
< 1 Or m_StartCol
> m_NumColumns
Then m_StartCol = 1
If m_EndCol
< m_StartCol
Or m_EndCol
> m_NumColumns
Then m_EndCol = m_NumColumns
m_PrintRow = 1
m_PrintCol = 1
' /////////////////////////////////////////////////////////////////////////////
' 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)
If m_NumColumns
< 1 Or m_NumColumns
> iCols
Then m_NumColumns = 1
If m_StartRow
< 1 Or m_StartRow
> iRows
Then m_StartRow = 1
If m_EndRow
< m_StartRow
Or m_EndRow
> iRows
Then m_EndRow = iRows
If m_StartCol
< 1 Or m_StartCol
> m_NumColumns
Then m_StartCol = 1
If m_EndCol
< m_StartCol
Or m_EndCol
> m_NumColumns
Then m_EndCol = m_NumColumns
If m_PrintRow
< m_StartRow
Then m_PrintRow = m_StartRow
If m_PrintCol
< m_StartCol
Then m_PrintCol = m_StartCol
iColWidth = iCols \ m_NumColumns
If m_PrintRow
<= m_EndRow
Then If m_PrintCol
<= m_EndCol
Then split MyString
, Chr$(13), arrLines
() sLine
= Left$(arrLines
(iRow
), iColWidth
) 'TODO: wrap remaining text
m_PrintRow = m_PrintRow + 1
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
' /////////////////////////////////////////////////////////////////////////////
' 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)
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GRAPHIC PRINTING ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DEBUGGING ROUTINES #DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'ReDim arrLines$(0)
'dim delim$ : delim$ = Chr$(13)
'split MyString, delim$, arrLines$()
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DEBUGGING ROUTINES @DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE ROUTINES #GEN
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Convert a value to string and trim it (because normal Str$ adds spaces)
'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
' /////////////////////////////////////////////////////////////////////////////
' Convert a Long value to string and trim it (because normal Str$ adds spaces)
' /////////////////////////////////////////////////////////////////////////////
' Convert a Single value to string and trim it (because normal Str$ adds spaces)
''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
' /////////////////////////////////////////////////////////////////////////////
' Convert an unsigned Long value to string and trim it (because normal Str$ adds spaces)
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Xpos%
= InStr(value$
, "D") + InStr(value$
, "E") 'only D or E can be present expo%
= Val(Mid$(value$
, Xpos%
+ 1)) sign$
= "-": valu$
= Mid$(value$
, 2, Xpos%
- 2) dot%
= InStr(valu$
, "."): L%
= Len(valu$
) DblToStr$
= _Trim$(sign$
+ DP$
+ min$
+ num$
+ add$
)
' /////////////////////////////////////////////////////////////////////////////
strValue
= DblToStr$
(myValue
) + String$(iDigits
, " ") strValue = Replace$(strValue, "-.", "-0.")
strValue = "0" + strValue
FormatNumber$
= Left$(strValue
, iDigits
)
' /////////////////////////////////////////////////////////////////////////////
' 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
sResult = ""
iInput = iInput \ 2
'If iLoop = 4 Then sResult = " " + sResult
GetBinary$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' 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%
'DIM iTemp AS INTEGER
iResult = FALSE
bContinue = TRUE
sNum = GetBinary$(iNum)
sBit = GetBinary$(iBit)
'if any of the bits in iBit are false, return false
iResult = FALSE
bContinue = FALSE
iResult = TRUE
GetBit256% = iResult
' /////////////////////////////////////////////////////////////////////////////
' 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
iResult = 0
strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
iResult
= iResult
+ 2 ^ iLoop
* Val(Mid$(strBinary
, Len(strBinary
) - iLoop
, 1))
GetIntegerFromBinary% = iResult
' /////////////////////////////////////////////////////////////////////////////
Function IIF
(Condition
, IfTrue
, IfFalse
)
' /////////////////////////////////////////////////////////////////////////////
Function IIFSTR$
(Condition
, IfTrue$
, IfFalse$
) If Condition
Then IIFSTR$
= IfTrue$
Else IIFSTR$
= IfFalse$
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
IsEven% = TRUE
IsEven% = FALSE
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
IsOdd% = TRUE
IsOdd% = FALSE
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
IsNum% = TRUE
IsNum% = FALSE
' /////////////////////////////////////////////////////////////////////////////
' 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
IsNumber = 1
IsNumber = 0
IsNumber = 0
' /////////////////////////////////////////////////////////////////////////////
' 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.
result$ = result$ + delimiter$ + in$(i)
join$ = result$
' /////////////////////////////////////////////////////////////////////////////
' ABS was returning strange values with type LONG
' so I created this which does not.
LongABS& = 0 - lngValue
LongABS& = lngValue
' /////////////////////////////////////////////////////////////////////////////
' 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.
sFileName = ProgramPath$ + ProgramName$ + ".txt"
sError = ""
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)
sError = PrintFile$(sFileName, sText, TRUE)
Print CurrentDateTime$
+ " DebugPrintFile FAILED: " + sError
' /////////////////////////////////////////////////////////////////////////////
' /////////////////////////////////////////////////////////////////////////////
' Returns blank if successful else returns error message.
'x = 1: y = 2: z$ = "Three"
sError = "Error in PrintFile$ : File not found. Cannot append."
Open sFileName
For Output As #1 ' opens and clears an existing file or creates new empty file ' WRITE places text in quotes in the file
'WRITE #1, x, y, z$
'WRITE #1, sText
' PRINT does not put text inside quotes
'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$
PrintFile$ = sError
' /////////////////////////////////////////////////////////////////////////////
' Does a _PrintString at the specified row+column.
' iRow and iCol are 0-based.
' /////////////////////////////////////////////////////////////////////////////
' Does a _PrintString at the specified row+column.
' iRow and iCol are 1-based.
' /////////////////////////////////////////////////////////////////////////////
' Does a _PrintString at the specified row+column,
' and saves value and color info to ScreenArray.
' PrintString2 iRow, iCol, MyString, ScreenArray()
' iRow and iCol are 1-based.
iX = iCol
iY = iRow
ScreenArray
(iY
, iX
).value
= mid$(MyString
, iLoop
, 1) iX = iX + 1
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
' SET RANDOM SEED
'Randomize ' Initialize random-number generator.
' 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%
' /////////////////////////////////////////////////////////////////////////////
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)
bAppend = TRUE
iErrorCount = 0
iMin = 0
iMax = iCols - 1
iNum = RandomNumber%(iMin, iMax)
sError = PrintFile$(sFileName, sText, bAppend)
iErrorCount = iErrorCount + 1
Print " " + "Could not write to file " + Chr$(34) + sFileName
+ Chr$(34) + "."
iMin = 0
iMax = iRows - 1
iNum = RandomNumber%(iMin, iMax)
sError = PrintFile$(sFileName, sText, bAppend)
iErrorCount = iErrorCount + 1
Print " " + "Could not write to file " + Chr$(34) + sFileName
+ Chr$(34) + "."
Print "Finished generating numbers. Errors: " + Str$(iErrorCount
) Print "Error creating file " + Chr$(34) + sFileName
+ Chr$(34) + "."
Input "Press <ENTER> to continue", sInput$
' /////////////////////////////////////////////////////////////////////////////
' 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.
' VARIABLES:
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]...
' 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]...
' OUTPUT:
Replace$ = Text2
' /////////////////////////////////////////////////////////////////////////////
Print "-------------------------------------------------------------------------------"
in$ = "Thiz iz a teZt."
in$ = Replace$(in$, "z", "s")
in$ = Replace$(in$, "Z", "s")
Print "ReplaceTest finished."
' /////////////////////////////////////////////////////////////////////////////
' 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.
Round##
= Int(num##
* 10 ^ digits%
+ .5) / 10 ^ digits%
RoundUp##
= _Ceil(num##
* 10 ^ digits%
) / 10 ^ digits%
RoundDown##
= Int(num##
* 10 ^ digits%
) / 10 ^ digits%
Function Round_Scientific##
(num##
, digits%
) Round_Scientific##
= _Round(num##
* 10 ^ digits%
) / 10 ^ digits%
RoundUpDouble#
= _Ceil(num#
* 10 ^ digits%
) / 10 ^ digits%
RoundUpSingle!
= _Ceil(num!
* 10 ^ digits%
) / 10 ^ digits%
' /////////////////////////////////////////////////////////////////////////////
' 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)
sNum = GetBinary$(iNum)
sBit = GetBinary$(iBit)
sVal = "1"
sVal = "0"
strResult = ""
strResult = strResult + sVal
strResult
= strResult
+ Mid$(sNum
, iLoop
, 1) iResult = GetIntegerFromBinary%(strResult)
iResult = iNum
SetBit256% = iResult
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Xpos%
= InStr(value$
, "D") + InStr(value$
, "E") 'only D or E can be present expo%
= Val(Mid$(value$
, Xpos%
+ 1)) sign$
= "-": valu$
= Mid$(value$
, 2, Xpos%
- 2) dot%
= InStr(valu$
, "."): L%
= Len(valu$
) SngToStr$
= _Trim$(sign$
+ DP$
+ min$
+ num$
+ add$
)
' /////////////////////////////////////////////////////////////////////////////
' 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$
())
iDelimLen
= Len(delimiter$
)
start = 1
'While Mid$(in$, start, 1) = delimiter$
While Mid$(in$
, start
, iDelimLen
) = delimiter$
'start = start + 1
start = start + iDelimLen
finish
= InStr(start
, in$
, delimiter$
)
result$
(UBound(result$
)) = Mid$(in$
, start
, finish
- start
) start = finish + 1
' /////////////////////////////////////////////////////////////////////////////
in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
split in$, delim$, arrTest$()
Print "Split test finished."
' /////////////////////////////////////////////////////////////////////////////
Print "-------------------------------------------------------------------------------" Print "SplitAndReplaceTest"
in$
= "This line 1 " + Chr$(13) + Chr$(10) + "and line 2" + Chr$(10) + "and line 3 " + Chr$(13) + "finally THE END."
Print "Fixing linebreaks..."
split in$
, Chr$(13), arrTest$
()
Print "SplitAndReplaceTest finished."
' /////////////////////////////////////////////////////////////////////////////
' /////////////////////////////////////////////////////////////////////////////
' /////////////////////////////////////////////////////////////////////////////
' /////////////////////////////////////////////////////////////////////////////
StrJustifyLeft$
= Left$(sValue
+ String$(iWidth
, " "), iWidth
)
' /////////////////////////////////////////////////////////////////////////////
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
' no extra space: return unchanged
StrJustifyCenter$ = sValue
iWidth = iWidth - 1
' center
iExtra = iWidth - iLen0
iLen1 = iExtra \ 2
iLen2
= iLen1
+ (iExtra
Mod 2) StrJustifyCenter$
= String$(iLen1
, " ") + sValue
+ String$(iLen2
, " ") ' string is too long: truncate
StrJustifyCenter$
= Left$(sValue
, iWidth
)
' /////////////////////////////////////////////////////////////////////////////
TrueFalse$ = "TRUE"
TrueFalse$ = "FALSE"
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR ARRAY FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
arrColor
(UBound(arrColor
)).value
= ColorValue
' /////////////////////////////////////////////////////////////////////////////
Sub AddColors
(arrColor
() As ColorType
) AddColor cBlack, "cBlack", arrColor()
''AddColor cDarkGray, "cDarkGray", arrColor()
''AddColor cDimGray, "cDimGray", arrColor()
AddColor cGray, "cGray", arrColor()
AddColor cSilver, "cSilver", arrColor()
''AddColor cLightGray, "cLightGray", arrColor()
AddColor cWhite, "cWhite", arrColor()
AddColor cRed, "cRed", arrColor()
AddColor cOrangeRed, "cOrangeRed", arrColor()
'AddColor cDarkOrange, "cDarkOrange", arrColor()
'AddColor cOrange, "cOrange", arrColor()
'AddColor cGold, "cGold", arrColor()
AddColor cYellow, "cYellow", arrColor()
'AddColor cOliveDrab1, "cOliveDrab1", arrColor()
AddColor cLime, "cLime", arrColor()
'AddColor cMediumSpringGreen, "cMediumSpringGreen", arrColor()
AddColor cCyan, "cCyan", arrColor()
'AddColor cDeepSkyBlue, "cDeepSkyBlue", arrColor()
AddColor cDodgerBlue, "cDodgerBlue", arrColor()
'AddColor cSeaBlue, "cSeaBlue", arrColor()
AddColor cBlue, "cBlue", arrColor()
'AddColor cBluePurple, "cBluePurple", arrColor()
AddColor cDeepPurple, "cDeepPurple", arrColor()
'AddColor cPurple, "cPurple", arrColor()
'AddColor cPurpleRed, "cPurpleRed", arrColor()
''AddColor cGainsboro, "cGainsboro", arrColor()
''AddColor cWhiteSmoke, "cWhiteSmoke", arrColor()
'AddColor cDarkRed, "cDarkRed", arrColor()
''AddColor cBrickRed, "cBrickRed", arrColor()
AddColor cDarkGreen, "cDarkGreen", arrColor()
'AddColor cGreen, "cGreen", arrColor()
''AddColor cOliveDrab, "cOliveDrab", arrColor()
''AddColor cLightPink, "cLightPink", arrColor()
AddColor cMagenta, "cMagenta", arrColor()
AddColor cHotPink, "cHotPink", arrColor()
'AddColor cDeepPink, "cDeepPink", arrColor()
AddColor cDarkBrown, "cDarkBrown", arrColor()
'AddColor cLightBrown, "cLightBrown", arrColor()
'AddColor cKhaki, "cKhaki", arrColor()
AddColor cEmpty, "cEmpty", arrColor()
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR ARRAY FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' NOTE: these are mostly negative numbers
' and have to be forced to positive
' when stored in the dictionary
' (only cEmpty should be negative)
cOrangeRed
= _RGB32(255, 69, 0)
cDarkOrange
= _RGB32(255, 140, 0)
' LONG-HAIRED FRIENDS OF JESUS OR NOT,
' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)
' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:
cChartreuse
= _RGB32(127, 255, 0)
' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:
cOliveDrab1
= _RGB32(192, 255, 62)
cMediumSpringGreen
= _RGB32(0, 250, 154)
cDeepSkyBlue
= _RGB32(0, 191, 255)
cDodgerBlue
= _RGB32(30, 144, 255)
cBluePurple
= _RGB32(64, 0, 255)
cDeepPurple
= _RGB32(96, 0, 255)
cPurpleRed
= _RGB32(128, 0, 192)
cBrickRed
= _RGB32(192, 0, 32)
cDarkGreen
= _RGB32(0, 100, 0)
cOliveDrab
= _RGB32(107, 142, 35)
cLightPink
= _RGB32(255, 182, 193)
cHotPink
= _RGB32(255, 105, 180)
cDeepPink
= _RGB32(255, 20, 147)
cMagenta
= _RGB32(255, 0, 255)
cDimGray
= _RGB32(105, 105, 105)
cDarkGray
= _RGB32(169, 169, 169)
cSilver
= _RGB32(192, 192, 192)
cLightGray
= _RGB32(211, 211, 211)
cGainsboro
= _RGB32(220, 220, 220)
cWhiteSmoke
= _RGB32(245, 245, 245)
cWhite
= _RGB32(255, 255, 255) 'cWhite = _RGB32(254, 254, 254)
cDarkBrown
= _RGB32(128, 64, 0)
cLightBrown
= _RGB32(196, 96, 0)
cKhaki
= _RGB32(240, 230, 140)
'cEmpty~& = -1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' #END
' ################################################################################################################################################################