QB64/QB64-PE
QB64/QB64-PE
1
1
Fork 0
mirror of https://github.com/QB64-Phoenix-Edition/QB64pe.git synced 2024-06-30 05:10:37 +00:00
Code Issues Releases Wiki Activity

Merge pull request #179 from QB64Team/var-export

Browse source 
Var export
This commit is contained in:
Fellippe Heitor 2021-08-24 04:01:26 -03:00 committed by GitHub
parent cc92a8f868 28661bbf36
commit d98b2203f3
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
5 changed files with 674 additions and 165 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
internal/support/vwatch/vwatch.bm
View file

@ -7,7 +7,8 @@ SUB vwatch (globalVariables AS _OFFSET, localVariables AS _OFFSET)
STATIC AS _OFFSET vw_idehwnd
STATIC vw_buffer$
DIM AS LONG vw_i, vw_tempIndex, vw_localIndex, vw_varSize, vw_cmdsize
DIM AS _OFFSET vw_address, vw_elementoffset, vw_lbound, vw_ubound
DIM AS LONG vw_arrayelementsize, vw_element, vw_elementoffset, vw_storage
DIM AS _OFFSET vw_address, vw_lbound, vw_ubound
DIM AS _MEM vw_m, vw_m2
DIM AS _BYTE vw_isarray
DIM vw_start!, vw_temp$, vw_cmd$, vw_value$, vw_k&, vw_buf$, vw_scope$, vw_varType$
@ -259,15 +260,19 @@ SUB vwatch (globalVariables AS _OFFSET, localVariables AS _OFFSET)
vw_isarray = _CV(_BYTE, MID$(vw_value$, 5, 1))
vw_localIndex = CVL(MID$(vw_value$, 6, 4))
vw_arrayIndex = CVL(MID$(vw_value$, 10, 4))
vw_elementoffset = _CV(_OFFSET, MID$(vw_value$, 14, LEN(vw_elementoffset)))
vw_varSize = CVL(MID$(vw_value$, 14 + LEN(vw_elementoffset), 4))
vw_i = CVI(MID$(vw_value$, 18 + LEN(vw_elementoffset), 2))
vw_arrayelementsize = CVL(MID$(vw_value$, 14, 4))
vw_element = CVL(MID$(vw_value$, 18, 4))
vw_elementoffset = CVL(MID$(vw_value$, 22, 4))
vw_varSize = CVL(MID$(vw_value$, 26, 4))
IF vw_varSize = 0 THEN GOTO cmdProcessingDone
vw_storage = CVL(MID$(vw_value$, 30, 4))
vw_i = CVI(MID$(vw_value$, 34, 2))
IF vw_i THEN
vw_scope$ = MID$(vw_value$, 20 + LEN(vw_elementoffset), vw_i)
vw_i = CVI(MID$(vw_value$, 20 + LEN(vw_elementoffset) + vw_i, 2))
vw_scope$ = MID$(vw_value$, 36, vw_i)
vw_i = CVI(MID$(vw_value$, 36 + vw_i, 2))
vw_varType$ = RIGHT$(vw_value$, vw_i)
ELSE
vw_i = CVI(MID$(vw_value$, 20 + LEN(vw_elementoffset), 2))
vw_i = CVI(MID$(vw_value$, 36, 2))
vw_varType$ = RIGHT$(vw_value$, vw_i)
END IF
IF vw_cmd$ = "get global var" THEN
@ -281,7 +286,6 @@ SUB vwatch (globalVariables AS _OFFSET, localVariables AS _OFFSET)
END IF
vw_address = _MEMGET(vw_m, vw_address, _OFFSET) 'first resolve pass
vw_address = _MEMGET(vw_m, vw_address, _OFFSET) 'second resolve pass
vw_address = vw_address + vw_elementoffset
IF vw_isarray THEN
vw_lbound = check_lbound%&(vw_address)
@ -312,19 +316,24 @@ SUB vwatch (globalVariables AS _OFFSET, localVariables AS _OFFSET)
END IF
'this is where we calculate the actual element position in memory
vw_address = vw_address + ((vw_arrayIndex - vw_lbound) * vw_varSize)
IF vw_arrayelementsize = 0 THEN
vw_address = vw_address + ((vw_arrayIndex - vw_lbound) * vw_varSize)
ELSE
vw_address = vw_address + ((vw_arrayIndex - vw_lbound) * vw_arrayelementsize)
END IF
END IF
'vw_address now points to the actual data
vw_address = vw_address + vw_elementoffset
vw_buf$ = SPACE$(vw_varSize)
vw_m = _MEM(vw_address, vw_varSize)
vw_m2 = _MEM(_OFFSET(vw_buf$), vw_varSize)
_MEMCOPY vw_m, vw_m.OFFSET, vw_m.SIZE TO vw_m2, vw_m2.OFFSET
IF INSTR(vw_varType$, "STRING *") > 0 AND vw_isarray <> 0 THEN
IF INSTR(vw_varType$, "STRING *") > 0 AND (vw_isarray <> 0 OR vw_elementoffset > 0) THEN
'actual data already fetched; nothing else to do
ELSEIF INSTR(vw_varType$, "STRING") THEN
IF vw_isarray THEN
IF vw_isarray <> 0 OR vw_elementoffset > 0 THEN
'First pass
vw_varSize = LEN(vw_dummy%&)
vw_buf$ = SPACE$(vw_varSize)
@ -361,7 +370,7 @@ SUB vwatch (globalVariables AS _OFFSET, localVariables AS _OFFSET)
_MEMCOPY vw_m, vw_m.OFFSET, vw_m.SIZE TO vw_m2, vw_m2.OFFSET
END IF
vw_cmd$ = "address read:" + MKL$(vw_tempIndex) + MKL$(vw_arrayIndex) + vw_buf$
vw_cmd$ = "address read:" + MKL$(vw_tempIndex) + MKL$(vw_arrayIndex) + MKL$(vw_element) + MKL$(vw_storage) + vw_buf$
GOSUB SendCommand
CASE "set global address", "set local address"
vw_localIndex = CVL(LEFT$(vw_value$, 4))

35
source/global/IDEsettings.bas
View file

@ -14,10 +14,10 @@ DIM SHARED ShowLineNumbersSeparator AS _BYTE, ShowLineNumbersUseBG AS _BYTE
DIM SHARED IgnoreWarnings AS _BYTE, qb64versionprinted AS _BYTE
DIM SHARED DisableSyntaxHighlighter AS _BYTE, ExeToSourceFolderFirstTimeMsg AS _BYTE
DIM SHARED WhiteListQB64FirstTimeMsg AS _BYTE, ideautolayoutkwcapitals AS _BYTE
'DIM SHARED IdeAutoComplete AS _BYTE
DIM SHARED WatchListToConsole AS _BYTE
DIM SHARED windowSettingsSection$, colorSettingsSection$, customDictionarySection$
DIM SHARED mouseSettingsSection$, generalSettingsSection$, displaySettingsSection$
DIM SHARED colorSchemesSection$, iniFolderIndex$, DebugInfoIniWarning$, ConfigFile$
DIM SHARED colorSchemesSection$, debugSettingsSection$, iniFolderIndex$, DebugInfoIniWarning$, ConfigFile$
DIM SHARED idebaseTcpPort AS LONG
windowSettingsSection$ = "IDE WINDOW"
@ -27,6 +27,7 @@ customDictionarySection$ = "CUSTOM DICTIONARIES"
mouseSettingsSection$ = "MOUSE SETTINGS"
generalSettingsSection$ = "GENERAL SETTINGS"
displaySettingsSection$ = "IDE DISPLAY SETTINGS"
debugSettingsSection$ = "DEBUG SETTINGS"
ConfigFile$ = "internal/config.ini"
iniFolderIndex$ = STR$(tempfolderindex)
@ -203,26 +204,10 @@ ELSE
WriteConfigSetting generalSettingsSection$, "IgnoreWarnings", "False"
END IF
'IF ReadConfigSetting(generalSettingsSection$, "IdeAutoComplete", value$) THEN
' IF UCASE$(value$) = "TRUE" OR ABS(VAL(value$)) = 1 THEN
' IdeAutoComplete = -1
' ELSE
' IdeAutoComplete = 0
' WriteConfigSetting generalSettingsSection$, "IdeAutoComplete", "False"
' END IF
'ELSE
' IdeAutoComplete = -1
' WriteConfigSetting generalSettingsSection$, "IdeAutoComplete", "True"
'END IF
result = ReadConfigSetting(generalSettingsSection$, "BackupSize", value$)
idebackupsize = VAL(value$)
IF idebackupsize < 10 OR idebackupsize > 2000 THEN idebackupsize = 100: WriteConfigSetting generalSettingsSection$, "BackupSize", "100 'in MB"
result = ReadConfigSetting(generalSettingsSection$, "BaseTCPPort", value$)
idebaseTcpPort = VAL(value$)
IF idebaseTcpPort = 0 THEN idebaseTcpPort = 9000: WriteConfigSetting generalSettingsSection$, "BaseTCPPort", "9000"
result = ReadConfigSetting(generalSettingsSection$, "DebugInfo", value$)
idedebuginfo = VAL(value$)
IF UCASE$(LEFT$(value$, 4)) = "TRUE" THEN idedebuginfo = 1
@ -242,6 +227,20 @@ ELSE
WriteConfigSetting mouseSettingsSection$, "SwapMouseButton", "False"
END IF
'Debug settings ---------------------------------------------------------------
result = ReadConfigSetting(debugSettingsSection$, "BaseTCPPort", value$)
idebaseTcpPort = VAL(value$)
IF idebaseTcpPort = 0 THEN idebaseTcpPort = 9000: WriteConfigSetting debugSettingsSection$, "BaseTCPPort", "9000"
result = ReadConfigSetting(debugSettingsSection$, "WatchListToConsole", value$)
IF UCASE$(value$) = "TRUE" OR VAL(value$) = -1 THEN
WatchListToConsole = -1
WriteConfigSetting debugSettingsSection$, "WatchListToConsole", "True"
ELSE
WatchListToConsole = 0
WriteConfigSetting debugSettingsSection$, "WatchListToConsole", "False"
END IF
'Display settings -------------------------------------------------------------
IF ReadConfigSetting(displaySettingsSection$, "IDE_SortSUBs", value$) THEN
IF UCASE$(value$) = "TRUE" OR VAL(value$) = -1 THEN

4
source/ide/ide_global.bas
View file

@ -12,7 +12,7 @@ DIM SHARED IdeInfo AS STRING
DIM SHARED IdeContextHelpSF AS _BYTE
DIM SHARED host&, debugClient&, hostport$, variableWatchList$
DIM SHARED vWatchArrayReceivedData$(1 TO 1000), nextvWatchArraySlot
DIM SHARED vWatchReceivedData$(1 TO 1000), nextvWatchDataSlot
DIM SHARED startPausedPending AS _BYTE
DIM SHARED IdeSystem AS LONG
@ -221,7 +221,7 @@ DIM SHARED ViewMenuID AS INTEGER, ViewMenuShowLineNumbersSubMenuID AS INTEGER
DIM SHARED ViewMenuShowSeparatorID AS INTEGER, ViewMenuShowBGID AS INTEGER
DIM SHARED ViewMenuCompilerWarnings AS INTEGER
DIM SHARED RunMenuID AS INTEGER, RunMenuSaveExeWithSource AS INTEGER, brackethighlight AS INTEGER
DIM SHARED DebugMenuID AS INTEGER, DebugMenuCallStack AS INTEGER
DIM SHARED DebugMenuID AS INTEGER, DebugMenuCallStack AS INTEGER, DebugMenuWatchListToConsole AS INTEGER
DIM SHARED multihighlight AS INTEGER, keywordHighlight AS INTEGER
DIM SHARED PresetColorSchemes AS INTEGER, TotalColorSchemes AS INTEGER, ColorSchemes$(0)
DIM SHARED LastValidColorScheme AS INTEGER

743
source/ide/ide_methods.bas
View file

@ -357,6 +357,12 @@ FUNCTION ide2 (ignore)
menu$(DebugMenuID, DebugMenuCallStack) = "Call #Stack... F12": i = i + 1
menuDesc$(m, i - 1) = "Displays the call stack of the current program's last execution"
menu$(m, i) = "-": i = i + 1
DebugMenuWatchListToConsole = i
menu$(m, i) = "#Output Watch List to Console": i = i + 1
menuDesc$(m, i - 1) = "Toggles directing the output of the watch list to the console window"
IF WatchListToConsole THEN
menu$(DebugMenuID, DebugMenuWatchListToConsole) = CHR$(7) + menu$(DebugMenuID, DebugMenuWatchListToConsole)
END IF
menu$(m, i) = "Set Base #TCP/IP Port Number...": i = i + 1
menuDesc$(m, i - 1) = "Sets the initial port number for TCP/IP communication with the debuggee"
menu$(m, i) = "#Advanced (C++)...": i = i + 1
@ -736,9 +742,7 @@ FUNCTION ide2 (ignore)
'$DEBUG mode on
IdeDebugMode = 1
FOR x = 1 TO totalVariablesCreated
usedVariableList(x).mostRecentValue = ""
NEXT
REDIM vWatchReceivedData$(1 TO UBOUND(vWatchReceivedData$)) 'empty data array
EnterDebugMode:
IF idehelp THEN
@ -755,6 +759,7 @@ FUNCTION ide2 (ignore)
ready = 1
_RESIZE OFF
DebugMode
IF WatchListToConsole THEN _CONSOLE OFF
UpdateMenuHelpLine ""
SELECT CASE IdeDebugMode
CASE 1 'clean exit
@ -4954,22 +4959,6 @@ FUNCTION ide2 (ignore)
GOTO ideloop
END IF
'IF RIGHT$(menu$(m, s), 17) = "Code Suggest#ions" THEN
' PCOPY 2, 0
' IF IdeAutoComplete = 0 THEN
' IdeAutoComplete = -1
' WriteConfigSetting generalSettingsSection$, "IdeAutoComplete", "True"
' menu$(OptionsMenuID, OptionsMenuAutoComplete) = CHR$(7) + "Code Suggest#ions"
' ELSE
' IdeAutoComplete = 0
' WriteConfigSetting generalSettingsSection$, "IdeAutoComplete", "False"
' menu$(OptionsMenuID, OptionsMenuAutoComplete) = "Code Suggest#ions"
' END IF
' idechangemade = 1
' PCOPY 3, 0: SCREEN , , 3, 0
' GOTO ideloop
'END IF
IF RIGHT$(menu$(m, s), 28) = "Output EXE to Source #Folder" THEN
PCOPY 2, 0
SaveExeWithSource = NOT SaveExeWithSource
@ -4985,6 +4974,21 @@ FUNCTION ide2 (ignore)
GOTO ideloop
END IF
IF RIGHT$(menu$(m, s), 29) = "#Output Watch List to Console" THEN
PCOPY 2, 0
WatchListToConsole = NOT WatchListToConsole
IF WatchListToConsole THEN
WriteConfigSetting debugSettingsSection$, "WatchListToConsole", "True"
menu$(DebugMenuID, DebugMenuWatchListToConsole) = CHR$(7) + "#Output Watch List to Console"
ELSE
WriteConfigSetting debugSettingsSection$, "WatchListToConsole", "False"
menu$(DebugMenuID, DebugMenuWatchListToConsole) = "#Output Watch List to Console"
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF MID$(menu$(m, s), 1, 17) = "#Quick Navigation" OR MID$(menu$(m, s), 2, 17) = "#Quick Navigation" THEN
PCOPY 2, 0
EnableQuickNav = NOT EnableQuickNav
@ -7138,7 +7142,7 @@ SUB DebugMode
END IF
cmd$ = cmd$ + MKL$(usedVariableList(tempIndex&).localIndex) + MKL$(varSize&) + value$
GOSUB SendCommand
usedVariableList(tempIndex&).mostRecentValue = MID$(result$, 5)
'usedVariableList(tempIndex&).mostRecentValue = MID$(result$, 5)
PCOPY 3, 0: SCREEN , , 3, 0
WHILE _MOUSEINPUT: WEND
GOSUB UpdateDisplay
@ -7146,7 +7150,7 @@ SUB DebugMode
END SELECT
cmd$ = cmd$ + MKL$(usedVariableList(tempIndex&).localIndex) + MKL$(varSize&) + value$
GOSUB SendCommand
usedVariableList(tempIndex&).mostRecentValue = result$
'usedVariableList(tempIndex&).mostRecentValue = result$
PCOPY 3, 0: SCREEN , , 3, 0
WHILE _MOUSEINPUT: WEND
@ -7381,17 +7385,36 @@ SUB DebugMode
DO WHILE LEN(temp$)
tempIndex& = CVL(LEFT$(temp$, 4))
tempArrayIndex& = CVL(MID$(temp$, 5, 4))
temp$ = MID$(temp$, 9)
cmd$ = ""
tempElement& = CVL(MID$(temp$, 9, 4))
tempStorage& = CVL(MID$(temp$, 13, 4))
temp$ = MID$(temp$, 17)
IF LEN(usedVariableList(tempIndex&).subfunc) = 0 THEN
cmd$ = "get global var:"
ELSE
cmd$ = "get local var:"
END IF
GOSUB GetVarSize
IF LEN(cmd$) THEN
cmd$ = cmd$ + MKL$(tempIndex&) + _MK$(_BYTE, usedVariableList(tempIndex&).isarray) + MKL$(usedVariableList(tempIndex&).localIndex) + MKL$(tempArrayIndex&) + _MK$(_OFFSET, usedVariableList(tempIndex&).elementOffset) + MKL$(varSize&) + MKI$(LEN(usedVariableList(tempIndex&).subfunc)) + usedVariableList(tempIndex&).subfunc + MKI$(LEN(usedVariableList(tempIndex&).varType)) + usedVariableList(tempIndex&).varType
IF varSize& THEN
cmd$ = cmd$ + MKL$(tempIndex&)
cmd$ = cmd$ + _MK$(_BYTE, usedVariableList(tempIndex&).isarray)
cmd$ = cmd$ + MKL$(usedVariableList(tempIndex&).localIndex)
cmd$ = cmd$ + MKL$(tempArrayIndex&)
cmd$ = cmd$ + MKL$(usedVariableList(tempIndex&).arrayElementSize)
cmd$ = cmd$ + MKL$(tempElement&)
IF tempElement& THEN
tempElementOffset& = CVL(MID$(usedVariableList(tempIndex&).elementOffset, tempElement& * 4 - 3, 4))
ELSE
tempElementOffset& = 0
END IF
cmd$ = cmd$ + MKL$(tempElementOffset&)
cmd$ = cmd$ + MKL$(varSize&)
cmd$ = cmd$ + MKL$(tempStorage&)
cmd$ = cmd$ + MKI$(LEN(usedVariableList(tempIndex&).subfunc))
cmd$ = cmd$ + usedVariableList(tempIndex&).subfunc
cmd$ = cmd$ + MKI$(LEN(tempVarType$)) + tempVarType$
GOSUB SendCommand
ELSE
cmd$ = ""
END IF
LOOP
END IF
@ -7400,9 +7423,11 @@ SUB DebugMode
CASE "address read"
tempIndex& = CVL(LEFT$(value$, 4))
tempArrayIndex& = CVL(MID$(value$, 5, 4))
recvData$ = MID$(value$, 9)
tempElement& = CVL(MID$(value$, 9, 4))
tempStorage& = CVL(MID$(value$, 13, 4))
recvData$ = MID$(value$, 17)
GOSUB GetVarSize
SELECT CASE varType$
SELECT CASE tempVarType$
CASE "_BYTE", "BYTE": recvData$ = STR$(_CV(_BYTE, recvData$))
CASE "_UNSIGNED _BYTE", "UNSIGNED BYTE": recvData$ = STR$(_CV(_UNSIGNED _BYTE, recvData$))
CASE "INTEGER": recvData$ = STR$(_CV(INTEGER, recvData$))
@ -7418,15 +7443,7 @@ SUB DebugMode
CASE "_UNSIGNED _OFFSET", "UNSIGNED OFFSET": recvData$ = STR$(_CV(_UNSIGNED _OFFSET, recvData$))
'CASE "STRING": 'no conversion required
END SELECT
IF usedVariableList(tempIndex&).isarray THEN
seqIndex& = INSTR(usedVariableList(tempIndex&).indexes, MKL$(tempArrayIndex&))
IF seqIndex& <= LEN(usedVariableList(tempIndex&).mostRecentValue) - 3 THEN
storageSlot& = CVL(MID$(usedVariableList(tempIndex&).mostRecentValue, seqIndex&, 4))
vWatchArrayReceivedData$(storageSlot&) = recvData$
END IF
ELSE
usedVariableList(tempIndex&).mostRecentValue = recvData$
END IF
vWatchReceivedData$(tempStorage&) = recvData$
IF PauseMode THEN GOSUB UpdateDisplay
CASE "current sub"
currentSub$ = value$
@ -7553,7 +7570,10 @@ SUB DebugMode
ideshowtext
UpdateTitleOfMainWindow
IF PauseMode <> 0 AND LEN(variableWatchList$) > 0 THEN showvWatchPanel vWatchPanel, currentSub$, totalVisibleVariables
IF PauseMode <> 0 AND LEN(variableWatchList$) > 0 THEN
IF WatchListToConsole THEN _CONSOLE ON
showvWatchPanel vWatchPanel, currentSub$, totalVisibleVariables
END IF
PCOPY 3, 0
RETURN
@ -7574,9 +7594,24 @@ SUB DebugMode
RETURN
GetVarSize:
varSize& = 0
varType$ = usedVariableList(tempIndex&).varType
IF INSTR(varType$, "STRING *") THEN varType$ = "STRING"
SELECT CASE varType$
checkVarType:
tempVarType$ = varType$
IF INSTR(tempVarType$, "STRING *") THEN tempVarType$ = "STRING"
IF INSTR(tempVarType$, "BIT *") THEN
IF VAL(MID$(tempVarType$, _INSTRREV(tempVarType$, " ") + 1)) > 32 THEN
tempVarType$ = "_INTEGER64"
IF INSTR(tempVarType$, "UNSIGNED") THEN tempVarType$ = "_UNSIGNED _INTEGER64"
ELSE
tempVarType$ = "LONG"
IF INSTR(tempVarType$, "UNSIGNED") THEN tempVarType$ = "_UNSIGNED LONG"
END IF
ELSEIF INSTR("@_BIT@BIT@_UNSIGNED _BIT@UNSIGNED BIT@", "@" + tempVarType$ + "@") THEN
tempVarType$ = "LONG"
IF INSTR(tempVarType$, "UNSIGNED") THEN tempVarType$ = "_UNSIGNED LONG"
END IF
SELECT CASE tempVarType$
CASE "_BYTE", "_UNSIGNED _BYTE", "BYTE", "UNSIGNED BYTE": varSize& = LEN(dummy%%)
CASE "INTEGER", "_UNSIGNED INTEGER", "UNSIGNED INTEGER": varSize& = LEN(dummy%)
CASE "LONG", "_UNSIGNED LONG", "UNSIGNED LONG": varSize& = LEN(dummy&)
@ -7586,6 +7621,9 @@ SUB DebugMode
CASE "_FLOAT", "FLOAT": varSize& = LEN(dummy##)
CASE "_OFFSET", "_UNSIGNED _OFFSET", "OFFSET", "UNSIGNED OFFSET": varSize& = LEN(dummy%&)
CASE "STRING": varSize& = LEN(dummy%&) + LEN(dummy&)
CASE ELSE 'UDT?
varType$ = getelement(usedVariableList(tempIndex&).elementTypes, tempElement&)
IF LEN(varType$) THEN GOTO checkVarType
END SELECT
RETURN
END SUB
@ -7602,7 +7640,7 @@ SUB showvWatchPanel (this AS vWatchPanelType, currentScope$, totalVisibleVariabl
'new setup
previousVariableWatchList$ = variableWatchList$
longestVarName = CVL(LEFT$(variableWatchList$, 4))
totalVisibleVariables = (LEN(variableWatchList$) - 4) \ 8
totalVisibleVariables = (LEN(variableWatchList$) - 4) \ 16
this.h = totalVisibleVariables + 2
IF this.h > idewy - 10 THEN this.h = idewy - 10
IF this.h < 5 THEN this.h = 5
@ -7617,17 +7655,21 @@ SUB showvWatchPanel (this AS vWatchPanelType, currentScope$, totalVisibleVariabl
IF this.x + this.w + 2 > idewx THEN this.x = idewx - (this.w + 2)
END IF
COLOR fg, bg
ideboxshadow this.x, this.y, this.w, this.h
COLOR 15, bg
_PRINTSTRING (this.x + this.w - 1, this.y + this.h - 1), CHR$(254) 'resize handle
IF WatchListToConsole = 0 THEN
COLOR fg, bg
ideboxshadow this.x, this.y, this.w, this.h
COLOR 15, bg
_PRINTSTRING (this.x + this.w - 1, this.y + this.h - 1), CHR$(254) 'resize handle
x = LEN(title$) + 2
COLOR fg, bg
_PRINTSTRING (this.x + (this.w \ 2) - (x - 1) \ 2, this.y), " " + title$ + " "
COLOR 15, 4
_PRINTSTRING (this.x + this.w - 3, this.y), " x " 'close button
COLOR , bg
x = LEN(title$) + 2
COLOR fg, bg
_PRINTSTRING (this.x + (this.w \ 2) - (x - 1) \ 2, this.y), " " + title$ + " "
COLOR 15, 4
_PRINTSTRING (this.x + this.w - 3, this.y), " x " 'close button
COLOR , bg
ELSE
_ECHO "-------- " + title$
END IF
y = 0
i = 0
@ -7637,31 +7679,32 @@ SUB showvWatchPanel (this AS vWatchPanelType, currentScope$, totalVisibleVariabl
DO WHILE LEN(temp$)
tempIndex& = CVL(LEFT$(temp$, 4))
tempArrayIndex& = CVL(MID$(temp$, 5, 4))
temp$ = MID$(temp$, 9)
tempElement& = CVL(MID$(temp$, 9, 4))
tempStorage& = CVL(MID$(temp$, 13, 4))
temp$ = MID$(temp$, 17)
i = i + 1
IF this.firstVisible > i THEN _CONTINUE
IF this.firstVisible > i AND WatchListToConsole <> 0 THEN _CONTINUE
y = y + 1
IF y > this.h - 2 THEN EXIT DO
IF y > this.h - 2 AND WatchListToConsole <> 0 THEN EXIT DO
thisName$ = usedVariableList(tempIndex&).name
IF usedVariableList(tempIndex&).isarray THEN
thisName$ = LEFT$(thisName$, LEN(thisName$) - 1) + _
LTRIM$(STR$(tempArrayIndex&)) + ")"
END IF
thisName$ = thisName$ + usedVariableList(tempIndex&).elements
IF tempElement& THEN
tempElementList$ = MID$(usedVariableList(tempIndex&).elements, 5)
thisName$ = thisName$ + getelement$(tempElementList$, tempElement&)
END IF
item$ = thisName$ + SPACE$(longestVarName - LEN(thisName$)) + " = "
IF usedVariableList(tempIndex&).subfunc = currentScope$ OR usedVariableList(tempIndex&).subfunc = "" THEN
thisIsAString = (INSTR(usedVariableList(tempIndex&).varType, "STRING *") > 0 OR usedVariableList(tempIndex&).varType = "STRING")
IF usedVariableList(tempIndex&).isarray THEN
seqIndex& = INSTR(usedVariableList(tempIndex&).indexes, MKL$(tempArrayIndex&))
IF seqIndex& <= LEN(usedVariableList(tempIndex&).mostRecentValue) - 3 THEN
storageSlot& = CVL(MID$(usedVariableList(tempIndex&).mostRecentValue, seqIndex&, 4))
tempValue$ = vWatchArrayReceivedData$(storageSlot&)
END IF
IF tempElement& THEN
tempVarType$ = getelement$(usedVariableList(tempIndex&).elementTypes, tempElement&)
ELSE
tempValue$ = usedVariableList(tempIndex&).mostRecentValue
tempVarType$ = usedVariableList(tempIndex&).varType
END IF
thisIsAString = (INSTR(tempVarType$, "STRING *") > 0 OR tempVarType$ = "STRING")
tempValue$ = vWatchReceivedData$(tempStorage&)
IF thisIsAString THEN
item$ = item$ + CHR$(34) + tempValue$ + CHR$(34)
ELSE
@ -7670,30 +7713,36 @@ SUB showvWatchPanel (this AS vWatchPanelType, currentScope$, totalVisibleVariabl
COLOR fg
ELSE
item$ = item$ + "<out of scope>"
COLOR 2
IF WatchListToConsole = 0 THEN COLOR 2
END IF
IF LEN(item$) > this.contentWidth THEN this.contentWidth = LEN(item$)
_PRINTSTRING (this.x + 2, this.y + y), MID$(item$, this.hPos, this.w - 4)
IF WatchListToConsole = 0 THEN
_PRINTSTRING (this.x + 2, this.y + y), MID$(item$, this.hPos, this.w - 4)
ELSE
_ECHO item$
END IF
LOOP
IF totalVisibleVariables > this.h - 2 THEN
y = idevbar(this.x + this.w - 1, this.y + 1, this.h - 2, this.firstVisible, totalVisibleVariables - (this.h - 2) + 1)
IF this.draggingVBar = 0 THEN
this.vBarThumb = y
IF WatchListToConsole = 0 THEN
IF totalVisibleVariables > this.h - 2 THEN
y = idevbar(this.x + this.w - 1, this.y + 1, this.h - 2, this.firstVisible, totalVisibleVariables - (this.h - 2) + 1)
IF this.draggingVBar = 0 THEN
this.vBarThumb = y
END IF
ELSE
this.vBarThumb = 0
this.firstVisible = 1
END IF
ELSE
this.vBarThumb = 0
this.firstVisible = 1
END IF
IF this.contentWidth > this.w - 4 THEN
x = idehbar(this.x, this.y + this.h - 1, this.w - 1, this.hPos, this.contentWidth - (this.w - 4) + 1)
IF this.draggingHBar = 0 THEN
this.hBarThumb = x
IF this.contentWidth > this.w - 4 THEN
x = idehbar(this.x, this.y + this.h - 1, this.w - 1, this.hPos, this.contentWidth - (this.w - 4) + 1)
IF this.draggingHBar = 0 THEN
this.hBarThumb = x
END IF
ELSE
this.hBarThumb = 0
this.hPos = 1
END IF
ELSE
this.hBarThumb = 0
this.hPos = 1
END IF
END SUB
@ -7748,6 +7797,7 @@ FUNCTION idevariablewatchbox$(currentScope$, filter$, selectVar, returnAction)
TYPE varDlgList
AS LONG index, bgColorFlag, colorFlag, colorFlag2, indicator
AS _BYTE selected
AS STRING varType
END TYPE
REDIM varDlgList(1 TO totalVariablesCreated) AS varDlgList
@ -7930,7 +7980,7 @@ FUNCTION idevariablewatchbox$(currentScope$, filter$, selectVar, returnAction)
i = o(varListBox).sel
IF usedVariableList(varDlgList(i).index).subfunc = currentScope$ OR usedVariableList(varDlgList(i).index).subfunc = "" THEN
'scope is valid
a2$ = usedVariableList(varDlgList(i).index).mostRecentValue
'a2$ = usedVariableList(varDlgList(i).index).mostRecentValue
IF INSTR(usedVariableList(varDlgList(i).index).varType, "STRING") THEN
thisWidth = idewx - 20
ELSE
@ -7959,34 +8009,85 @@ FUNCTION idevariablewatchbox$(currentScope$, filter$, selectVar, returnAction)
(IdeDebugMode > 0 AND focus = 6 AND info <> 0) THEN
variableWatchList$ = ""
longestVarName = 0
nextvWatchArraySlot = 0
nextvWatchDataSlot = 0
FOR y = 1 TO totalVariablesCreated
usedVariableList(y).mostRecentValue = ""
IF usedVariableList(y).watch THEN
thisLen = LEN(usedVariableList(y).name) + LEN(usedVariableList(y).elements)
thisLen = LEN(usedVariableList(y).name)
IF usedVariableList(y).isarray THEN
thisLen = thisLen + LEN(STR$(CVL(RIGHT$(usedVariableList(y).indexes, 4)))) - 1
END IF
IF LEN(usedVariableList(y).elements) THEN
thisLen = thisLen + CVL(LEFT$(usedVariableList(y).elements, 4))
END IF
IF thisLen > longestVarName THEN
longestVarName = thisLen
IF variableWatchList$ = "" THEN variableWatchList$ = SPACE$(4)
MID$(variableWatchList$, 1, 4) = MKL$(longestVarName)
END IF
IF usedVariableList(y).isarray THEN
IF usedVariableList(y).isarray <> 0 AND LEN(usedVariableList(y).elements) = 0 THEN
'array of native data type
temp$ = usedVariableList(y).indexes
DO WHILE LEN(temp$)
variableWatchList$ = variableWatchList$ + MKL$(y) + LEFT$(temp$, 4)
nextvWatchArraySlot = nextvWatchArraySlot + 1
WHILE nextvWatchArraySlot > UBOUND(vWatchArrayReceivedData$)
REDIM _PRESERVE vWatchArrayReceivedData$(1 TO UBOUND(vWatchArrayReceivedData$) + 999)
nextvWatchDataSlot = nextvWatchDataSlot + 1
WHILE nextvWatchDataSlot > UBOUND(vWatchReceivedData$)
REDIM _PRESERVE vWatchReceivedData$(1 TO UBOUND(vWatchReceivedData$) + 999)
WEND
usedVariableList(y).mostRecentValue = usedVariableList(y).mostRecentValue + MKL$(nextvWatchArraySlot)
vWatchArrayReceivedData$(nextvWatchArraySlot) = ""
variableWatchList$ = variableWatchList$ + MKL$(y) + LEFT$(temp$, 4) + MKL$(0) + MKL$(nextvWatchDataSlot)
usedVariableList(y).storage = usedVariableList(y).storage + MKL$(nextvWatchDataSlot)
vWatchReceivedData$(nextvWatchDataSlot) = ""
temp$ = MID$(temp$, 5)
LOOP
ELSE
variableWatchList$ = variableWatchList$ + MKL$(y) + MKL$(0)
ELSEIF usedVariableList(y).isarray <> 0 AND LEN(usedVariableList(y).elements) > 0 THEN
'array of UDT
temp$ = usedVariableList(y).indexes
DO WHILE LEN(temp$)
thisTempElement$ = MKL$(y) + LEFT$(temp$, 4)
thisElementList$ = MID$(usedVariableList(y).elements, 5)
i = 0
DO
i = i + 1
temp2$ = getelement$(thisElementList$, i)
IF temp2$ = "" THEN EXIT DO
nextvWatchDataSlot = nextvWatchDataSlot + 1
WHILE nextvWatchDataSlot > UBOUND(vWatchReceivedData$)
REDIM _PRESERVE vWatchReceivedData$(1 TO UBOUND(vWatchReceivedData$) + 999)
WEND
variableWatchList$ = variableWatchList$ + thisTempElement$ + MKL$(i) + MKL$(nextvWatchDataSlot)
usedVariableList(y).storage = usedVariableList(y).storage + MKL$(nextvWatchDataSlot)
vWatchReceivedData$(nextvWatchDataSlot) = ""
LOOP
temp$ = MID$(temp$, 5)
LOOP
ELSEIF usedVariableList(y).isarray = 0 AND LEN(usedVariableList(y).elements) > 0 THEN
'single variable of UDT
thisTempElement$ = MKL$(y) + MKL$(0)
thisElementList$ = MID$(usedVariableList(y).elements, 5)
i = 0
DO
i = i + 1
temp2$ = getelement$(thisElementList$, i)
IF temp2$ = "" THEN EXIT DO
nextvWatchDataSlot = nextvWatchDataSlot + 1
WHILE nextvWatchDataSlot > UBOUND(vWatchReceivedData$)
REDIM _PRESERVE vWatchReceivedData$(1 TO UBOUND(vWatchReceivedData$) + 999)
WEND
variableWatchList$ = variableWatchList$ + thisTempElement$ + MKL$(i) + MKL$(nextvWatchDataSlot)
usedVariableList(y).storage = usedVariableList(y).storage + MKL$(nextvWatchDataSlot)
vWatchReceivedData$(nextvWatchDataSlot) = ""
LOOP
ELSEIF usedVariableList(y).isarray = 0 AND LEN(usedVariableList(y).elements) = 0 THEN
'single variable
nextvWatchDataSlot = nextvWatchDataSlot + 1
WHILE nextvWatchDataSlot > UBOUND(vWatchReceivedData$)
REDIM _PRESERVE vWatchReceivedData$(1 TO UBOUND(vWatchReceivedData$) + 999)
WEND
variableWatchList$ = variableWatchList$ + MKL$(y) + MKL$(0) + MKL$(0) + MKL$(nextvWatchDataSlot)
usedVariableList(y).storage = MKL$(nextvWatchDataSlot)
END IF
END IF
NEXT
@ -8036,9 +8137,6 @@ FUNCTION idevariablewatchbox$(currentScope$, filter$, selectVar, returnAction)
temp$ = parseRange$(v$)
usedVariableList(varDlgList(y).index).indexes = temp$
temp$ = formatRange$(temp$)
IF usedVariableList(varDlgList(y).index).watchRange <> temp$ THEN
usedVariableList(x).mostRecentValue = ""
END IF
usedVariableList(varDlgList(y).index).watchRange = temp$
ELSE
usedVariableList(varDlgList(y).index).indexes = ""
@ -8058,33 +8156,134 @@ FUNCTION idevariablewatchbox$(currentScope$, filter$, selectVar, returnAction)
varType$ = usedVariableList(varDlgList(y).index).varType
IF INSTR(varType$, "STRING *") THEN varType$ = "STRING"
nativeDataTypes$ = "@_BYTE@_UNSIGNED _BYTE@BYTE@UNSIGNED BYTE@INTEGER@_UNSIGNED INTEGER@UNSIGNED INTEGER@LONG@_UNSIGNED LONG@UNSIGNED LONG@_INTEGER64@INTEGER64@_UNSIGNED _INTEGER64@UNSIGNED INTEGER64@SINGLE@DOUBLE@_FLOAT@FLOAT@STRING@"
IF INSTR(varType$, "_BIT *") THEN varType$ = "_BIT"
IF INSTR(nativeDataTypes$, varType$) = 0 THEN
'It's a UDT
temp$ = usedVariableList(varDlgList(y).index).name + "."
v$ = ideinputbox$("Watch UDT", temp$, "", "", 45, 0, ok)
elementIndexes$ = ""
thisUDT = 0
E = 0
FOR i = 1 TO lasttype
IF RTRIM$(udtxcname(i)) = varType$ THEN thisUDT = i: EXIT FOR
NEXT
i = 0
DO
IF E = 0 THEN E = udtxnext(thisUDT) ELSE E = udtenext(E)
IF E = 0 THEN EXIT DO
elementIndexes$ = elementIndexes$ + MKL$(E)
i = i + 1
LOOP
PCOPY 0, 4
v$ = ideelementwatchbox$(usedVariableList(varDlgList(y).index).name + ".", elementIndexes$, 0, ok)
PCOPY 2, 0
PCOPY 2, 1
SCREEN , , 1, 0
IF ok THEN
IF LEFT$(v$, 1) <> "." THEN v$ = "." + v$
usedVariableList(varDlgList(y).index).elements = v$
v$ = lineformat$(UCASE$(v$))
longestElementName = 0
usedVariableList(varDlgList(y).index).elements = ""
usedVariableList(varDlgList(y).index).elementTypes = ""
usedVariableList(varDlgList(y).index).elementOffset = ""
getid usedVariableList(varDlgList(y).index).id
Error_Happened = 0
result$ = udtreference$("", v$, typ)
IF Error_Happened THEN
Error_Happened = 0
result = idemessagebox("Error", Error_Message, "#OK")
usedVariableList(varDlgList(y).index).watch = 0
usedVariableList(varDlgList(y).index).elements = ""
usedVariableList(varDlgList(y).index).elementOffset = 0
GOTO unWatch
IF id.t = 0 THEN
typ = id.arraytype AND 511
IF id.arraytype AND ISINCONVENTIONALMEMORY THEN
typ = typ - ISINCONVENTIONALMEMORY
END IF
usedVariableList(varDlgList(y).index).arrayElementSize = udtxsize(typ)
IF udtxbytealign(typ) THEN
IF usedVariableList(varDlgList(y).index).arrayElementSize MOD 8 THEN usedVariableList(varDlgList(y).index).arrayElementSize = usedVariableList(varDlgList(y).index).arrayElementSize + (8 - (usedVariableList(varDlgList(y).index).arrayElementSize MOD 8)) 'round up to nearest byte
usedVariableList(varDlgList(y).index).arrayElementSize = usedVariableList(varDlgList(y).index).arrayElementSize \ 8
END IF
ELSE
'result = idemessagebox("Result", v$ + "\n" + result$ + "\n" + STR$(typ), "#OK")
usedVariableList(varDlgList(y).index).elementOffset = VAL(MID$(result$, _INSTRREV(result$, sp3) + 1))
usedVariableList(varDlgList(y).index).arrayElementSize = 0
END IF
temp$ = v$
i = 0
DO
i = i + 1
v$ = getelement$(temp$, i)
IF LEN(v$) = 0 THEN EXIT DO
'-------
IF LEN(v$) > longestElementName THEN longestElementName = LEN(v$)
IF LEN(usedVariableList(varDlgList(y).index).elements) = 0 THEN
usedVariableList(varDlgList(y).index).elements = MKL$(longestElementName)
ELSE
MID$(usedVariableList(varDlgList(y).index).elements, 1, 4) = MKL$(longestElementName)
END IF
usedVariableList(varDlgList(y).index).elements = usedVariableList(varDlgList(y).index).elements + v$ + sp
v$ = lineformat$(UCASE$(v$))
Error_Happened = 0
result$ = udtreference$("", v$, typ)
IF Error_Happened THEN
'shouldn't ever happen
Error_Happened = 0
result = idemessagebox("Error", Error_Message, "#OK")
usedVariableList(varDlgList(y).index).watch = 0
usedVariableList(varDlgList(y).index).elements = ""
usedVariableList(varDlgList(y).index).elementTypes = ""
usedVariableList(varDlgList(y).index).elementOffset = ""
GOTO unWatch
ELSE
typ = typ - ISUDT
typ = typ - ISREFERENCE
IF typ AND ISINCONVENTIONALMEMORY THEN typ = typ - ISINCONVENTIONALMEMORY
SELECT CASE typ
CASE BYTETYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "_BYTE" + sp
CASE UBYTETYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "_UNSIGNED _BYTE" + sp
CASE INTEGERTYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "INTEGER" + sp
CASE UINTEGERTYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "_UNSIGNED INTEGER" + sp
CASE LONGTYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "LONG" + sp
CASE ULONGTYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "_UNSIGNED LONG" + sp
CASE INTEGER64TYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "_INTEGER64" + sp
CASE UINTEGER64TYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "_UNSIGNED _INTEGER64" + sp
CASE SINGLETYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "SINGLE" + sp
CASE DOUBLETYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "DOUBLE" + sp
CASE FLOATTYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "_FLOAT" + sp
CASE OFFSETTYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "_OFFSET" + sp
CASE UOFFSETTYPE
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "_UNSIGNED _OFFSET" + sp
CASE ELSE
IF typ AND ISSTRING THEN
IF (typ AND ISFIXEDLENGTH) = 0 THEN
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "STRING" + sp
ELSE
'E contains the UDT element index at this point
usedVariableList(varDlgList(y).index).elementTypes = usedVariableList(varDlgList(y).index).elementTypes + "STRING *" + STR$(udtetypesize(E)) + sp
END IF
ELSE
'shouldn't ever happen
usedVariableList(varDlgList(y).index).watch = 0
usedVariableList(varDlgList(y).index).elements = ""
usedVariableList(varDlgList(y).index).elementTypes = ""
usedVariableList(varDlgList(y).index).elementOffset = ""
result = idemessagebox("Error", "Cannot add full UDT to Watch List", "#OK")
GOTO unWatch
END IF
END SELECT
usedVariableList(varDlgList(y).index).elementOffset = usedVariableList(varDlgList(y).index).elementOffset + MKL$(VAL(MID$(result$, _INSTRREV(result$, sp3) + 1)))
END IF
'-------
LOOP
'remove trailing sp:
usedVariableList(varDlgList(y).index).elements = LEFT$(usedVariableList(varDlgList(y).index).elements, LEN(usedVariableList(varDlgList(y).index).elements) - 1)
usedVariableList(varDlgList(y).index).elementTypes = LEFT$(usedVariableList(varDlgList(y).index).elementTypes, LEN(usedVariableList(varDlgList(y).index).elementTypes) - 1)
ELSE
usedVariableList(varDlgList(y).index).watch = 0
usedVariableList(varDlgList(y).index).elements = ""
usedVariableList(varDlgList(y).index).elementOffset = 0
GOTO unWatch
END IF
END IF
@ -8157,7 +8356,7 @@ FUNCTION idevariablewatchbox$(currentScope$, filter$, selectVar, returnAction)
IF LEN(searchTerm$) THEN
thisScope$ = usedVariableList(x).subfunc
IF thisScope$ = "" THEN thisScope$ = mainmodule$
item$ = usedVariableList(x).name + usedVariableList(x).varType + thisScope$ + usedVariableList(x).mostRecentValue
item$ = usedVariableList(x).name + usedVariableList(x).varType + thisScope$
IF multiSearch(item$, searchTerm$) = 0 THEN
_CONTINUE 'skip variable if no field matches the search
END IF
@ -8197,13 +8396,17 @@ FUNCTION idevariablewatchbox$(currentScope$, filter$, selectVar, returnAction)
IF usedVariableList(x).subfunc = currentScope$ OR usedVariableList(x).subfunc = "" THEN
'it's ok
ELSE
usedVariableList(x).mostRecentValue = ""
'usedVariableList(x).mostRecentValue = ""
END IF
IF LEN(searchTerm$) THEN
thisScope$ = usedVariableList(x).subfunc
IF thisScope$ = "" THEN thisScope$ = mainmodule$
item$ = usedVariableList(x).name + usedVariableList(x).varType + thisScope$ + usedVariableList(x).mostRecentValue
item$ = usedVariableList(x).name + usedVariableList(x).varType + thisScope$
IF IdeDebugMode > 0 AND usedVariableList(x).isarray = 0 AND LEN(usedVariableList(x).elements) = 0 AND LEN(usedVariableList(x).storage) = 4 THEN
'single var
item$ = item$ + vWatchReceivedData$(CVL(usedVariableList(x).storage))
END IF
IF multiSearch(item$, searchTerm$) = 0 THEN
_CONTINUE 'skip variable if no field matches the search
END IF
@ -8261,22 +8464,24 @@ FUNCTION idevariablewatchbox$(currentScope$, filter$, selectVar, returnAction)
IF usedVariableList(x).subfunc = currentScope$ OR usedVariableList(x).subfunc = "" THEN
IF usedVariableList(x).watch THEN
thisIsAString = (INSTR(usedVariableList(x).varType, "STRING *") > 0 OR usedVariableList(x).varType = "STRING")
IF usedVariableList(x).isarray THEN
temp$ = usedVariableList(x).mostRecentValue
IF usedVariableList(x).isarray <> 0 AND LEN(usedVariableList(x).elements) = 0 THEN
'array of native data type
temp$ = usedVariableList(x).storage
IF LEN(temp$) THEN l$ = l$ + " = " + CHR$(16) + CHR$(variableNameColor) + "{"
DO WHILE LEN(temp$)
storageSlot& = CVL(LEFT$(temp$, 4))
temp$ = MID$(temp$, 5)
IF thisIsAString THEN l$ = l$ + CHR$(34)
l$ = l$ + StrReplace$(vWatchArrayReceivedData$(storageSlot&), CHR$(0), " ")
l$ = l$ + StrReplace$(vWatchReceivedData$(storageSlot&), CHR$(0), " ")
IF thisIsAString THEN l$ = l$ + CHR$(34)
IF LEN(temp$) THEN l$ = l$ + ","
LOOP
IF LEN(usedVariableList(x).mostRecentValue) THEN l$ = l$ + "}"
ELSE
IF LEN(usedVariableList(x).storage) THEN l$ = l$ + "}"
ELSEIF usedVariableList(x).isarray = 0 AND LEN(usedVariableList(x).elements) = 0 THEN
storageSlot& = CVL(usedVariableList(x).storage)
l$ = l$ + " = " + CHR$(16) + CHR$(variableNameColor)
IF thisIsAString THEN l$ = l$ + CHR$(34)
l$ = l$ + StrReplace$(usedVariableList(x).mostRecentValue, CHR$(0), " ")
l$ = l$ + StrReplace$(vWatchReceivedData$(storageSlot&), CHR$(0), " ")
IF thisIsAString THEN l$ = l$ + CHR$(34)
END IF
END IF
@ -8290,6 +8495,294 @@ FUNCTION idevariablewatchbox$(currentScope$, filter$, selectVar, returnAction)
RETURN
END FUNCTION
FUNCTION ideelementwatchbox$(currentPath$, elementIndexes$, level, ok)
'-------- generic dialog box header --------
PCOPY 4, 0
PCOPY 0, 1
SCREEN , , 1, 0
focus = 1
DIM p AS idedbptype
DIM o(1 TO 100) AS idedbotype
DIM sep AS STRING * 1
sep = CHR$(0)
'-------- end of generic dialog box header --------
'-------- init --------
STATIC returnList$
IF level = 0 THEN returnList$ = ""
ok = 0
variableNameColor = 3
typeColumnColor = 15
selectedBG = 2
totalElements = LEN(elementIndexes$) \ 4
REDIM varDlgList(1 TO totalElements) AS varDlgList
dialogHeight = (totalElements) + 4
i = 0
IF dialogHeight > idewy + idesubwindow - 6 THEN
dialogHeight = idewy + idesubwindow - 6
END IF
IF dialogHeight < 5 THEN dialogHeight = 5
GOSUB buildList
dialogWidth = 6 + longestName + maxTypeLen
IF dialogWidth < 40 THEN dialogWidth = 40
IF dialogWidth > idewx - 8 THEN dialogWidth = idewx - 8
idepar p, dialogWidth, dialogHeight, "Add UDT Elements"
i = i + 1: varListBox = i
o(varListBox).typ = 2
o(varListBox).y = 2
o(varListBox).w = dialogWidth - 4: o(i).h = dialogHeight - 4
IF o(varListBox).txt = 0 THEN o(varListBox).txt = idenewtxt(l$) ELSE idetxt(o(varListBox).txt) = l$
i = i + 1: buttonSet = i
o(buttonSet).typ = 3
o(buttonSet).y = dialogHeight
IF o(buttonSet).txt = 0 THEN
o(buttonSet).txt = idenewtxt("#Add All" + sep + "#Remove All" + sep + "#Close")
END IF
'-------- end of init --------
'-------- generic init --------
FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects
'-------- end of generic init --------
DO 'main loop
'-------- generic display dialog box & objects --------
idedrawpar p
f = 1: cx = 0: cy = 0
FOR i = 1 TO 100
IF o(i).typ THEN
'prepare object
o(i).foc = focus - f 'focus offset
o(i).cx = 0: o(i).cy = 0
idedrawobj o(i), f 'display object
IF o(i).cx THEN cx = o(i).cx: cy = o(i).cy
END IF
NEXT i
lastfocus = f - 1
'-------- end of generic display dialog box & objects --------
'-------- custom display changes --------
COLOR 0, 7
temp$ = currentPath$
IF LEN(temp$) > p.w - 4 THEN temp$ = STRING$(3, 250) + RIGHT$(temp$, p.w - 7)
_PRINTSTRING (p.x + 2, p.y + 1), temp$
'-------- end of custom display changes --------
'update visual page and cursor position
PCOPY 1, 0
IF cx THEN SCREEN , , 0, 0: LOCATE cy, cx, 1: SCREEN , , 1, 0
'-------- read input --------
change = 0
DO
GetInput
IF mWHEEL THEN change = 1
IF KB THEN change = 1
IF mCLICK THEN mousedown = 1: change = 1
IF mRELEASE THEN mouseup = 1: change = 1
IF mB THEN change = 1
alt = KALT: IF alt <> oldalt THEN change = 1
oldalt = alt
_LIMIT 100
LOOP UNTIL change
IF alt AND NOT KCTRL THEN idehl = 1 ELSE idehl = 0
'convert "alt+letter" scancode to letter's ASCII character
altletter$ = ""
IF alt AND NOT KCTRL THEN
IF LEN(K$) = 1 THEN
k = ASC(UCASE$(K$))
IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k)
END IF
END IF
SCREEN , , 0, 0: LOCATE , , 0: SCREEN , , 1, 0
'-------- end of read input --------
'-------- generic input response --------
info = 0
IF K$ = "" THEN K$ = CHR$(255)
IF KSHIFT = 0 AND K$ = CHR$(9) THEN focus = focus + 1
IF (KSHIFT AND K$ = CHR$(9)) OR (INSTR(_OS$, "MAC") AND K$ = CHR$(25)) THEN focus = focus - 1: K$ = ""
IF focus < 1 THEN focus = lastfocus
IF focus > lastfocus THEN focus = 1
f = 1
FOR i = 1 TO 100
t = o(i).typ
IF t THEN
focusoffset = focus - f
ideobjupdate o(i), focus, f, focusoffset, K$, altletter$, mB, mousedown, mouseup, mX, mY, info, mWHEEL
END IF
NEXT
'-------- end of generic input response --------
IF (focus = 2 AND info <> 0) THEN 'add all
FOR y = 1 TO totalElements
varType$ = varDlgList(y).varType
IF INSTR(varType$, "STRING *") THEN varType$ = "STRING"
IF INSTR(varType$, "BIT *") THEN varType$ = "_BIT"
IF INSTR(nativeDataTypes$, varType$) > 0 THEN
varDlgList(y).selected = -1
ASC(idetxt(o(varListBox).txt), varDlgList(y).colorFlag) = variableNameColor
ASC(idetxt(o(varListBox).txt), varDlgList(y).colorFlag2) = typeColumnColor
ASC(idetxt(o(varListBox).txt), varDlgList(y).bgColorFlag) = selectedBG
ASC(idetxt(o(varListBox).txt), varDlgList(y).indicator) = 43 '+
END IF
NEXT
_CONTINUE
END IF
IF (focus = 3 AND info <> 0) THEN 'remove all
FOR y = 1 TO totalElements
varDlgList(y).selected = 0
ASC(idetxt(o(varListBox).txt), varDlgList(y).colorFlag) = 16
ASC(idetxt(o(varListBox).txt), varDlgList(y).colorFlag2) = 2
ASC(idetxt(o(varListBox).txt), varDlgList(y).bgColorFlag) = 17
ASC(idetxt(o(varListBox).txt), varDlgList(y).indicator) = 32 'space
NEXT
_CONTINUE
END IF
IF K$ = CHR$(27) OR (focus = 4 AND info <> 0) THEN
'build element list to return
FOR y = 1 TO totalElements
IF varDlgList(y).selected THEN
varType$ = varDlgList(y).varType
IF INSTR(varType$, "STRING *") THEN varType$ = "STRING"
IF INSTR(varType$, "BIT *") THEN varType$ = "_BIT"
IF INSTR(nativeDataTypes$, varType$) > 0 THEN
'non-native data types will have already been added to the return list
thisName$ = RTRIM$(udtecname(varDlgList(y).index))
IF LEN(returnList$) THEN returnList$ = returnList$ + sp
returnList$ = returnList$ + currentPath$ + thisName$
END IF
END IF
NEXT
ok = LEN(returnList$) > 0
IF level = 0 THEN returnList$ = StrReplace$(returnList$, currentPath$, ".")
ideelementwatchbox$ = returnList$
IF mousedown THEN
DO
GetInput
_LIMIT 100
LOOP UNTIL mRELEASE
END IF
EXIT FUNCTION
END IF
IF mCLICK AND focus = 1 THEN 'list click
IF timeElapsedSince(lastClick!) < .3 AND clickedItem = o(varListBox).sel THEN
GOTO toggleWatch
END IF
lastClick! = TIMER
IF o(varListBox).sel > 0 THEN clickedItem = o(varListBox).sel
_CONTINUE
END IF
IF (K$ = CHR$(13) AND focus = 1) THEN
K$ = ""
toggleWatch:
y = ABS(o(varListBox).sel)
IF y >= 1 AND y <= totalElements THEN
varDlgList(y).selected = NOT varDlgList(y).selected
IF varDlgList(y).selected THEN
varType$ = varDlgList(y).varType
IF INSTR(varType$, "STRING *") THEN varType$ = "STRING"
IF INSTR(varType$, "BIT *") THEN varType$ = "_BIT"
IF INSTR(nativeDataTypes$, varType$) = 0 THEN
'It's a UDT
elementIndexes2$ = ""
thisUDT = 0
E = 0
FOR i = 1 TO lasttype
IF RTRIM$(udtxcname(i)) = varType$ THEN thisUDT = i: EXIT FOR
NEXT
i = 0
DO
IF E = 0 THEN E = udtxnext(thisUDT) ELSE E = udtenext(E)
IF E = 0 THEN EXIT DO
elementIndexes2$ = elementIndexes2$ + MKL$(E)
i = i + 1
LOOP
v$ = ideelementwatchbox$(currentPath$ + RTRIM$(udtecname(varDlgList(y).index)) + ".", elementIndexes2$, level + 1, ok2)
END IF
ASC(idetxt(o(varListBox).txt), varDlgList(y).colorFlag) = variableNameColor
ASC(idetxt(o(varListBox).txt), varDlgList(y).colorFlag2) = typeColumnColor
ASC(idetxt(o(varListBox).txt), varDlgList(y).bgColorFlag) = selectedBG
ASC(idetxt(o(varListBox).txt), varDlgList(y).indicator) = 43 '+
ELSE
ASC(idetxt(o(varListBox).txt), varDlgList(y).colorFlag) = 16
ASC(idetxt(o(varListBox).txt), varDlgList(y).colorFlag2) = 2
ASC(idetxt(o(varListBox).txt), varDlgList(y).bgColorFlag) = 17
ASC(idetxt(o(varListBox).txt), varDlgList(y).indicator) = 32 'space
END IF
END IF
_CONTINUE
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
EXIT FUNCTION
buildList:
maxTypeLen = 0
FOR x = 1 TO totalElements
thisType = CVL(MID$(elementIndexes$, x * 4 - 3, 4))
IF LEN(RTRIM$(udtecname(thisType))) > longestName THEN longestName = LEN(RTRIM$(udtecname(thisType)))
varDlgList(x).index = thisType
id.t = udtetype(thisType)
id.tsize = udtesize(thisType)
IF id.t AND ISFIXEDLENGTH THEN
id.tsize = udtetypesize(thisType)
END IF
varDlgList(x).varType = id2fulltypename$
thisLen = LEN(varDlgList(x).varType)
IF thisLen > maxTypeLen THEN maxTypeLen = thisLen
NEXT
l$ = ""
FOR x = 1 TO totalElements
thisElement = varDlgList(x).index
l$ = l$ + CHR$(17)
varDlgList(x).bgColorFlag = LEN(l$) + 1
l$ = l$ + CHR$(17)
l$ = l$ + CHR$(16)
varDlgList(x).colorFlag = LEN(l$) + 1
varDlgList(x).indicator = LEN(l$) + 2
l$ = l$ + CHR$(16) + " "
thisName$ = RTRIM$(udtecname(thisElement))
text$ = thisName$ + CHR$(16)
varDlgList(x).colorFlag2 = LEN(l$) + LEN(text$) + 1
text$ = text$ + CHR$(2) + " "
text$ = text$ + SPACE$(longestName - LEN(thisName$))
text$ = text$ + " " + varDlgList(x).varType + SPACE$(maxTypeLen - LEN(varDlgList(x).varType))
l$ = l$ + text$
IF x < totalElements THEN l$ = l$ + sep
NEXT
RETURN
END FUNCTION
FUNCTION formatRange$(__text$)
'__text$ is a series of MKL$(values) concatenated
temp$ = __text$
@ -13444,7 +13937,7 @@ SUB ideSetTCPPortBox
idebaseTcpPort = VAL(v$)
IF idebaseTcpPort = 0 THEN idebaseTcpPort = 9000
WriteConfigSetting generalSettingsSection$, "BaseTCPPort", str2$(idebaseTcpPort)
WriteConfigSetting debugSettingsSection$, "BaseTCPPort", str2$(idebaseTcpPort)
END SUB
FUNCTION idegetlinenumberbox(title$, initialValue&)

24
source/qb64.bas
View file

@ -33,6 +33,9 @@ vWatchVariableExclusions$ = "@__LONG_VWATCH_LINENUMBER@__LONG_VWATCH_SUBLEVEL@__
"@__STRING_VWATCH_SUBNAME@__STRING_VWATCH_CALLSTACK@__ARRAY_BYTE_VWATCH_BREAKPOINTS" + _
"@__ARRAY_BYTE_VWATCH_SKIPLINES@__STRING_VWATCH_INTERNALSUBNAME@__ARRAY_STRING_VWATCH_STACK@"
DIM SHARED nativeDataTypes$
nativeDataTypes$ = "@_BIT@_BYTE@_UNSIGNED _BYTE@BYTE@UNSIGNED BYTE@INTEGER@_UNSIGNED INTEGER@UNSIGNED INTEGER@LONG@_UNSIGNED LONG@UNSIGNED LONG@_INTEGER64@INTEGER64@_UNSIGNED _INTEGER64@UNSIGNED INTEGER64@SINGLE@DOUBLE@_FLOAT@FLOAT@STRING@"
DIM SHARED qb64prefix_set_recompileAttempts, qb64prefix_set_desiredState
DIM SHARED opex_recompileAttempts, opex_desiredState
DIM SHARED opexarray_recompileAttempts, opexarray_desiredState
@ -110,10 +113,11 @@ DIM SHARED MonochromeLoggingMode AS _BYTE
TYPE usedVarList
AS LONG id, linenumber, includeLevel, includedLine, scope, localIndex
AS LONG arrayElementSize
AS _BYTE used, watch, isarray
AS STRING name, cname, varType, includedFile, subfunc, mostRecentValue
AS STRING watchRange, indexes, elements 'for Arrays and UDTs
AS _OFFSET elementOffset
AS STRING name, cname, varType, includedFile, subfunc
AS STRING watchRange, indexes, elements, elementTypes 'for Arrays and UDTs
AS STRING elementOffset, storage
END TYPE
DIM SHARED totalVariablesCreated AS LONG
@ -4986,8 +4990,9 @@ DO
IF typ AND ISUDT THEN
IF RTRIM$(udtxcname(typ AND 511)) = "_MEM" AND UCASE$(t3$) = "MEM" AND qb64prefix_set = 1 THEN
t3$ = MID$(RTRIM$(udtxcname(typ AND 511)), 2)
ELSE
t3$ = RTRIM$(udtxcname(typ AND 511))
END IF
t3$ = RTRIM$(udtxcname(typ AND 511))
l$ = l$ + sp + t3$
ELSE
FOR t3i = 1 TO LEN(t3$)
@ -25954,7 +25959,7 @@ SUB manageVariableList (__name$, __cname$, localIndex AS LONG, action AS _BYTE)
usedVariableList(i).id = currentid
usedVariableList(i).used = 0
usedVariableList(i).watch = 0
usedVariableList(i).mostRecentValue = ""
usedVariableList(i).storage = ""
usedVariableList(i).linenumber = linenumber
usedVariableList(i).includeLevel = inclevel
IF inclevel > 0 THEN
@ -25981,10 +25986,13 @@ SUB manageVariableList (__name$, __cname$, localIndex AS LONG, action AS _BYTE)
usedVariableList(i).name = usedVariableList(i).name + "()"
ELSE
usedVariableList(i).isarray = 0
usedVariableList(i).watchRange = ""
usedVariableList(i).indexes = ""
usedVariableList(i).elements = ""
END IF
usedVariableList(i).watchRange = ""
usedVariableList(i).arrayElementSize = 0
usedVariableList(i).indexes = ""
usedVariableList(i).elements = ""
usedVariableList(i).elementTypes = ""
usedVariableList(i).elementOffset = ""
totalVariablesCreated = totalVariablesCreated + 1
END IF
CASE ELSE 'find and mark as used