1
1
Fork 0
mirror of https://github.com/QB64Official/qb64.git synced 2024-05-12 12:00:14 +00:00
qb64/source/ide/ide_methods.bas
Cory Smith 72d05300d7 Improved IdeMessageBox.
- Modified the welcome screen to get rid of the "scary" (and most likely invalid) message - at the very least it is never good advice to encourage people to disable anti-virus.
- Updated IdeMessageBox so that the horizontal bar that is in QB is now included.
- Modified the About dialog to match new Welcome dialog.
- Removed build.bat (.gitignore'd).
2022-11-07 20:56:54 -06:00

20178 lines
798 KiB
QBasic

FUNCTION ide (ignore)
'Note: ide is a function which optimizes the interaction between the IDE and compiler (ide2)
' by avoiding unnecessary bloat associated with entering the main IDE function 'ide2'
ignore = ignore 'just to clear warnings of unused variables
IF idecommand$ <> "" THEN cmd = ASC(idecommand$)
IF cmd = 3 THEN 'request next line (compiler->ide)
IF idecompiledline < iden THEN
IF idecompiledline < idesy OR idecompiledline > idesy + (idewy - 9) THEN 'off screen?
IF _EXIT AND 1 THEN ideexit = 1
IF ideexit = 0 THEN
GetInput 'check for new input
IF iCHANGED = 0 AND mB = 0 THEN
'-------------------- layout considerations --------------------
'previous line was OK, so use layout if available
IF ideautolayout <> 0 OR ideautoindent <> 0 THEN
IF LEN(layout$) THEN
'calculate recommended indent level
l = LEN(layout$)
FOR i = 1 TO l
IF ASC(layout$, i) <> 32 OR i = l THEN
IF ASC(layout$, i) = 32 THEN
layout$ = "": indent = i
ELSE
indent = i - 1
layout$ = RIGHT$(layout$, LEN(layout$) - i + 1)
END IF
EXIT FOR
END IF
NEXT
IF ideautolayout THEN
layout2$ = layout$: i2 = 1
ignoresp = 0
FOR i = 1 TO LEN(layout$)
a = ASC(layout$, i)
IF a = 34 THEN
ignoresp = ignoresp + 1: IF ignoresp = 2 THEN ignoresp = 0
END IF
IF ignoresp = 0 THEN
IF a = sp_asc THEN ASC(layout2$, i2) = 32: i2 = i2 + 1: GOTO skipchar
IF a = sp2_asc THEN GOTO skipchar
END IF
ASC(layout2$, i2) = a: i2 = i2 + 1
skipchar:
NEXT
layout$ = LEFT$(layout2$, i2 - 1)
END IF
IF ideautoindent = 0 THEN
'note: can assume auto-format
'calculate old indent (if any)
indent = 0
l = LEN(idecompiledline$)
FOR i = 1 TO l
IF ASC(idecompiledline$, i) <> 32 OR i = l THEN
indent = i - 1
EXIT FOR
END IF
NEXT
indent$ = SPACE$(indent)
ELSE
indent$ = SPACE$(indent * ideautoindentsize)
END IF
IF ideautolayout = 0 THEN
'note: can assume auto-indent
l = LEN(idecompiledline$)
layout$ = ""
FOR i = 1 TO l
IF ASC(idecompiledline$, i) <> 32 OR i = l THEN
layout$ = RIGHT$(idecompiledline$, l - i + 1)
EXIT FOR
END IF
NEXT
END IF
IF LEN(layout$) THEN
layout$ = indent$ + layout$
IF idecompiledline$ <> layout$ THEN
idesetline idecompiledline, layout$
END IF
END IF 'len(layout$) after modification
END IF 'len(layout$)
END IF 'using layout/indent
'---------------------------------------------------------------
idecompiledline = idecompiledline + 1
idecompiledline$ = idegetline(idecompiledline)
ide = 4
idereturn$ = idecompiledline$
'Update compilation progress on the status bar
IF ideautorun <> 0 THEN
IF prepass THEN
status.progress$ = str2$(INT((idecompiledline * 100) / (iden * 2)))
status.progress$ = STRING$(3 - LEN(status.progress$), 32) + status.progress$ + "%"
ELSE
status.progress$ = str2$(INT(((iden + idecompiledline) * 100) / (iden * 2)))
status.progress$ = STRING$(3 - LEN(status.progress$), 32) + status.progress$ + "%"
END IF
IdeInfo = CHR$(0) + status.progress$
'ELSE
' STATIC p AS _BYTE, lastUpdateDots AS SINGLE
' IF TIMER - lastUpdateDots > .5 THEN
' lastUpdateDots = TIMER
' p = p + 1
' temp$ = STRING$(3, 250) '"..."
' IF p > 3 THEN p = 1
' ASC(temp$, p) = 254
' COLOR 7, 1
' _PRINTSTRING (2, idewy - 3), temp$ 'compilation progress indicator
' END IF
END IF
UpdateIdeInfo
EXIT FUNCTION
END IF
IF iCHANGED THEN iCHECKLATER = 1
END IF 'ideexit
END IF 'not on screen
ELSE
IF IdeSystem <> 3 OR LEFT$(IdeInfo, 19) <> "Selection length = " THEN IdeInfo = ""
UpdateIdeInfo
END IF 'idecompiledline<iden
END IF
ide = ide2(0)
END FUNCTION
FUNCTION ide2 (ignore)
STATIC MenuLocations AS STRING
STATIC idesystem2.issel AS _BYTE
STATIC idesystem2.sx1 AS LONG
STATIC idesystem2.v1 AS LONG
STATIC AttemptToLoadRecent AS _BYTE
STATIC old.mX, old.mY
STATIC last.TBclick#, wholeword.select AS _BYTE
STATIC wholeword.selectx1, wholeword.idecx
STATIC wholeword.selecty1, wholeword.idecy
STATIC ForceResize, IDECompilationRequested AS _BYTE
STATIC QuickNavHover AS _BYTE, FindFieldHover AS _BYTE
STATIC VersionInfoHover AS _BYTE, LineNumberHover AS _BYTE
STATIC waitingForVarList AS _BYTE
ignore = ignore 'just to clear warnings of unused variables
char.sep$ = CHR$(34) + " =<>+-/\^:;,*()."
c$ = idecommand$
debugnextline = 0
IDEerrorMessage:
'report any IDE errors which have occurred
IF ideerror THEN
IF IdeDebugMode THEN
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
END IF
mustdisplay = 1
IF ideerror = 1 THEN errorat$ = "Internal IDE error"
IF ideerror = 2 THEN errorat$ = "File not found"
IF ideerror = 3 THEN errorat$ = "File access error": CLOSE #150
IF ideerror = 4 THEN errorat$ = "Path not found"
IF ideerror = 5 THEN errorat$ = "Cannot create folder"
IF ideerror = 6 THEN errorat$ = "Cannot save file"
IF ideerror = -1 THEN GOTO errorReportDone 'fail quietly - like ON ERROR RESUME NEXT
qberrorcode = ERR
IF qberrorcode THEN
ideerrormessageTITLE$ = "Error " + str2$(qberrorcode)
ELSE
ideerrormessageTITLE$ = "Error"
END IF
IF (ideerror > 1) THEN
'Don't show too much detail if user just tried loading an invalid file
ideerrormessageTITLE$ = ideerrormessageTITLE$ + " ("
IF _ERRORLINE > 0 OR _INCLERRORLINE > 0 THEN
ideerrormessageTITLE$ = ideerrormessageTITLE$ + str2$(_ERRORLINE) + "-" + str2$(_INCLERRORLINE)
END IF
IF LEN(AutoBuildMsg$) THEN ideerrormessageTITLE$ = ideerrormessageTITLE$ + "-" + MID$(AutoBuildMsg$, 10)
ideerrormessageTITLE$ = ideerrormessageTITLE$ + ")"
IF ideerrormessageTITLE$ = "Error ()" THEN ideerrormessageTITLE$ = "Error"
IF AttemptToLoadRecent = -1 THEN
'Offer to cleanup recent file list, removing invalid entries
PCOPY 2, 0
result = idemessagebox(ideerrormessageTITLE$, errorat$ + "." + CHR$(10) + CHR$(10) + "Remove broken links from recent files?", "#Yes;#No")
IF result = 1 THEN
GOSUB CleanUpRecentList
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO errorReportDone
END IF
ELSE
'a more serious error; let's report something that'll help bug reporting
inclerrorline = _INCLERRORLINE
IF inclerrorline THEN
errorat$ = errorat$ + CHR$(10) + " " + CHR$(10) + "(module: " + _
RemoveFileExtension$(LEFT$(_INCLERRORFILE$, 60))
errorat$ = errorat$ + ", on line: " + str2$(inclerrorline)
IF LEN(AutoBuildMsg$) THEN errorat$ = errorat$ + ", " + MID$(AutoBuildMsg$, 10)
errorat$ = errorat$ + ")"
ELSE
errorat$ = errorat$ + CHR$(10) + " " + CHR$(10) + "(on line: " + str2$(_ERRORLINE)
IF LEN(AutoBuildMsg$) THEN errorat$ = errorat$ + ", " + MID$(AutoBuildMsg$, 10)
errorat$ = errorat$ + ")"
END IF
END IF
PCOPY 3, 0
result = idemessagebox(ideerrormessageTITLE$, errorat$, "")
errorReportDone:
END IF
ideerror = 1 'unknown IDE error
AttemptToLoadRecent = 0
IF LEFT$(c$, 1) = CHR$(12) THEN
f$ = RIGHT$(c$, LEN(c$) - 1)
LOCATE , , 0
clearStatusWindow 0
dummy = DarkenFGBG(1)
BkpIdeSystem = IdeSystem: IdeSystem = 2: UpdateTitleOfMainWindow: IdeSystem = BkpIdeSystem
COLOR 1, 7: _PRINTSTRING ((idewx - 8) / 2, idewy - 4), " Status "
COLOR 15, 1
IF os$ = "WIN" THEN
_PRINTSTRING (2, idewy - 3), "Creating .EXE file named " + CHR$(34) + f$ + extension$ + CHR$(34) + "..."
ELSE
_PRINTSTRING (2, idewy - 3), "Creating executable file named " + CHR$(34) + f$ + extension$ + CHR$(34) + "..."
END IF
PCOPY 3, 0
ide2 = 9: idereturn$ = f$
EXIT FUNCTION
END IF
IF c$ = CHR$(100) THEN 'special call for next line (usually for the purpose of line continuation)
idecompiledline = idecompiledline + 1 'must increment (to trigger no more lines avail. message later)
IF idecompiledline < iden THEN
idecompiledline$ = idegetline(idecompiledline)
idereturn$ = idecompiledline$
ELSE
idecompiledline$ = ""
idereturn$ = idecompiledline$ 'no more lines
END IF
EXIT FUNCTION
END IF
IF idelaunched = 0 THEN
idelaunched = 1
WIDTH idewx, idewy
IF IDE_UseFont8 THEN _FONT 8 ELSE _FONT 16
'change codepage
IF idecpindex THEN
FOR x = 128 TO 255
u = VAL("&H" + MID$(idecp(idecpindex), x * 8 + 1, 8) + "&")
IF u = 0 THEN u = 9744
_MAPUNICODE u TO x
NEXT
END IF
IF idecustomfont THEN
idecustomfonthandle = _LOADFONT(idecustomfontfile$, idecustomfontheight, "MONOSPACE")
IF idecustomfonthandle = -1 THEN
'failed! - revert to default settings
idecustomfont = 0: idecustomfontfile$ = "C:\Windows\Fonts\lucon.ttf": idecustomfontheight = 21
ELSE
_FONT idecustomfonthandle
END IF
END IF
m = 1: i = 0
IdeMakeFileMenu
m = m + 1: i = 0
ideeditmenuID = m
IdeMakeEditMenu
m = m + 1: i = 0: ViewMenuID = m
menu$(m, i) = "View": i = i + 1
menu$(m, i) = "#SUBs... F2": i = i + 1
menuDesc$(m, i - 1) = "Displays a list of SUB/FUNCTION procedures"
menu$(m, i) = "#Line Numbers " + CHR$(16): i = i + 1
menuDesc$(m, i - 1) = "Toggles and customizes line numbers (side bar)"
menu$(m, i) = "-": i = i + 1
ViewMenuCompilerWarnings = i
menu$(ViewMenuID, ViewMenuCompilerWarnings) = "Compiler #Warnings... Ctrl+W": i = i + 1
menuDesc$(m, i - 1) = "Displays a list of recent code warnings"
menusize(m) = i - 1
m = m + 1: i = 0: SearchMenuID = m
menu$(m, i) = "Search": i = i + 1
menu$(m, i) = "#Find... Ctrl+F3": i = i + 1
menuDesc$(m, i - 1) = "Finds specified text"
menu$(m, i) = "#Repeat Last Find (Shift+) F3": i = i + 1
menuDesc$(m, i - 1) = "Finds next occurrence of text specified in previous search"
menu$(m, i) = "#Change... Alt+F3": i = i + 1
menuDesc$(m, i - 1) = "Finds and changes specified text"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "Clear Search #History...": i = i + 1
menuDesc$(m, i - 1) = "Clears history of searched text items"
menu$(m, i) = "-": i = i + 1
SearchMenuEnableQuickNav = i
menu$(m, i) = "#Quick Navigation": i = i + 1
menuDesc$(m, i - 1) = "Toggles Quick Navigation (back arrow)"
IF EnableQuickNav THEN
menu$(SearchMenuID, SearchMenuEnableQuickNav) = CHR$(7) + menu$(SearchMenuID, SearchMenuEnableQuickNav)
END IF
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "Add/Remove #Bookmark Alt+Left": i = i + 1
menuDesc$(m, i - 1) = "Toggles a bookmark in the current line"
menu$(m, i) = "#Next Bookmark Alt+Down": i = i + 1
menuDesc$(m, i - 1) = "Navigates to the next bookmark"
menu$(m, i) = "#Previous Bookmark Alt+Up": i = i + 1
menuDesc$(m, i - 1) = "Navigates to the previous bookmark"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "#Go To Line... Ctrl+G": i = i + 1
menuDesc$(m, i - 1) = "Jumps to the specified line number"
menusize(m) = i - 1
m = m + 1: i = 0: RunMenuID = m
menu$(m, i) = "Run": i = i + 1
menu$(m, i) = "#Start F5": i = i + 1
menuDesc$(m, i - 1) = "Compiles current program and runs it"
menu$(m, i) = "Modify #COMMAND$...": i = i + 1
menuDesc$(m, i - 1) = "Sets string returned by COMMAND$ function"
menu$(m, i) = "-": i = i + 1
RunMenuSaveExeWithSource = i
menu$(m, i) = "Output EXE to Source #Folder": i = i + 1
menuDesc$(m, i - 1) = "Toggles compiling program to QB64's folder or to source folder"
IF SaveExeWithSource THEN
menu$(RunMenuID, RunMenuSaveExeWithSource) = CHR$(7) + menu$(RunMenuID, RunMenuSaveExeWithSource)
END IF
menu$(m, i) = "-": i = i + 1
IF os$ = "LNX" THEN
menu$(m, i) = "Make E#xecutable Only F11": i = i + 1
ELSE
menu$(m, i) = "Make E#XE Only F11": i = i + 1
END IF
menuDesc$(m, i - 1) = "Compiles current program without running it"
menusize(m) = i - 1
m = m + 1: i = 0: DebugMenuID = m
menu$(m, i) = "Debug": i = i + 1
menu$(m, i) = "Start #Paused F7 or F8": i = i + 1
menuDesc$(m, i - 1) = "Compiles current program and starts it in pause mode"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "Toggle #Breakpoint F9": i = i + 1
menuDesc$(m, i - 1) = "Sets/clears breakpoint at cursor location"
menu$(m, i) = "#Clear All Breakpoints F10": i = i + 1
menuDesc$(m, i - 1) = "Removes all breakpoints"
menu$(m, i) = "Toggle #Skip Line Ctrl+P": i = i + 1
menuDesc$(m, i - 1) = "Sets/clears flag to skip line"
menu$(m, i) = "#Unskip All Lines Ctrl+F10": i = i + 1
menuDesc$(m, i - 1) = "Removes all line skip flags"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "#Watch List... F4": i = i + 1
menuDesc$(m, i - 1) = "Adds variables to watch list"
DebugMenuCallStack = i
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
DebugMenuAutoAddCommand = i
menu$(m, i) = "Auto-add $#Debug Metacommand": i = i + 1
menuDesc$(m, i - 1) = "Toggles whether the IDE will auto-add the $Debug metacommand as required"
IF AutoAddDebugCommand THEN
menu$(DebugMenuID, DebugMenuAutoAddCommand) = CHR$(7) + menu$(DebugMenuID, DebugMenuAutoAddCommand)
END IF
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
menuDesc$(m, i - 1) = "Enables embedding C++ debug information into compiled program"
menu$(m, i) = "Purge C++ #Libraries": i = i + 1
menuDesc$(m, i - 1) = "Purges all pre-compiled content"
menusize(m) = i - 1
m = m + 1: i = 0: OptionsMenuID = m
menu$(m, i) = "Options": i = i + 1
menu$(m, i) = "#Display...": i = i + 1
menuDesc$(m, i - 1) = "Changes screen size and font"
menu$(m, i) = "IDE C#olors...": i = i + 1
menuDesc$(m, i - 1) = "Changes or customizes IDE color scheme"
menu$(m, i) = "#Code Layout...": i = i + 1
menuDesc$(m, i - 1) = "Changes auto-format features"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "#Language...": i = i + 1
menuDesc$(m, i - 1) = "Changes code page to use with TTF fonts"
menu$(m, i) = "#Backup/Undo...": i = i + 1
menuDesc$(m, i - 1) = "Sets size of backup/undo buffer"
menu$(m, i) = "-": i = i + 1
OptionsMenuDisableSyntax = i
menu$(m, i) = "Syntax #Highlighter": i = i + 1
menuDesc$(m, i - 1) = "Toggles syntax highlighter"
IF NOT DisableSyntaxHighlighter THEN
menu$(OptionsMenuID, OptionsMenuDisableSyntax) = CHR$(7) + menu$(OptionsMenuID, OptionsMenuDisableSyntax)
END IF
OptionsMenuSwapMouse = i
menu$(m, i) = "#Swap Mouse Buttons": i = i + 1
menuDesc$(m, i - 1) = "Swaps functionality of left/right mouse buttons"
IF MouseButtonSwapped THEN
menu$(OptionsMenuID, OptionsMenuSwapMouse) = CHR$(7) + menu$(OptionsMenuID, OptionsMenuSwapMouse)
END IF
OptionsMenuPasteCursor = i
menu$(m, i) = "Cursor After #Paste": i = i + 1
menuDesc$(m, i - 1) = "Toggles placing the cursor before/after the pasted content"
IF PasteCursorAtEnd THEN
menu$(OptionsMenuID, OptionsMenuPasteCursor) = CHR$(7) + menu$(OptionsMenuID, OptionsMenuPasteCursor)
END IF
OptionsMenuShowErrorsImmediately = i
menu$(m, i) = "Syntax Ch#ecker": i = i + 1
menuDesc$(m, i - 1) = "Toggles instant syntax checker (status area)"
IF IDEShowErrorsImmediately THEN
menu$(OptionsMenuID, OptionsMenuShowErrorsImmediately) = CHR$(7) + menu$(OptionsMenuID, OptionsMenuShowErrorsImmediately)
END IF
OptionsMenuIgnoreWarnings = i
menu$(m, i) = "Ignore #Warnings": i = i + 1
menuDesc$(m, i - 1) = "Toggles display of warning messages (unused variables, etc)"
IF IgnoreWarnings THEN menu$(OptionsMenuID, OptionsMenuIgnoreWarnings) = CHR$(7) + "Ignore #Warnings"
'OptionsMenuAutoComplete = i
'menu$(m, i) = "Code Suggest#ions": i = i + 1
'menuDesc$(m, i - 1) = "Toggles code suggestions/auto-complete"
'IF IdeAutoComplete THEN menu$(OptionsMenuID, OptionsMenuAutoComplete) = CHR$(7) + "Code Suggest#ions"
menusize(m) = i - 1
m = m + 1: i = 0
menu$(m, i) = "Tools": i = i + 1
menu$(m, i) = "#ASCII Chart...": i = i + 1
menuDesc$(m, i - 1) = "Displays ASCII characters and allows inserting in current program"
menu$(m, i) = "Insert Quick #Keycode Ctrl+K": i = i + 1
menuDesc$(m, i - 1) = "Captures key codes and inserts in current program"
menu$(m, i) = "#Math Evaluator...": i = i + 1
menuDesc$(m, i - 1) = "Displays the math evaluator dialog"
menu$(m, i) = "#RGB Color Mixer...": i = i + 1
menuDesc$(m, i - 1) = "Allows mixing colors to edit/insert _RGB statements"
menusize(m) = i - 1
m = m + 1: i = 0
menu$(m, i) = "Help": i = i + 1
menu$(m, i) = "#View Shift+F1": i = i + 1
menuDesc$(m, i - 1) = "Displays help window"
menu$(m, i) = "#Contents Page": i = i + 1
menuDesc$(m, i - 1) = "Displays help contents page"
menu$(m, i) = "Keyword #Index": i = i + 1
menuDesc$(m, i - 1) = "Displays keyword index page"
menu$(m, i) = "#Keywords By Usage": i = i + 1
menuDesc$(m, i - 1) = "Displays keywords index by usage"
if 1=0 then ' removing the "View on Wiki" - @dualbrain
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "#Update Current Page": i = i + 1
menuDesc$(m, i - 1) = "Downloads the latest version of an article from the wiki"
menu$(m, i) = "Update All #Pages...": i = i + 1
menuDesc$(m, i - 1) = "Downloads the latest version of all articles from the wiki"
menu$(m, i) = "View Current Page On #Wiki": i = i + 1
menuDesc$(m, i - 1) = "Launches the default browser and navigates to the current article on the wiki"
end if
menu$(m, i) = "-": i = i + 1
'menu$(m, i) = "Check for #Newer Version...": i = i + 1
'menuDesc$(m, i - 1) = "Displays the current version of QB64"
menu$(m, i) = "#About...": i = i + 1
menuDesc$(m, i - 1) = "Displays the current version of QB64"
menusize(m) = i - 1
menus = m
'Hidden contextual menu (ID is retrieved for later use; allows expansion of the original menu system above):
m = m + 1
idecontextualmenuID = m
'View Menu sub menu for Line Numbers options
m = m + 1: i = 0
menu$(m, i) = "ViewMenuShowLineNumbersSubMenu": i = i + 1
ViewMenuShowLineNumbersSubMenuID = m
IF ShowLineNumbers THEN menu$(m, i) = "#Hide Line Numbers" ELSE menu$(m, i) = "#Show Line Numbers"
menuDesc$(m, i) = "Toggles displaying line numbers (side bar)"
i = i + 1
menu$(m, i) = "#Background Color": IF ShowLineNumbersUseBG THEN menu$(m, i) = CHR$(7) + menu$(m, i)
menuDesc$(m, i) = "Toggles displaying a different background (side bar)"
ViewMenuShowBGID = i
IF ShowLineNumbers = 0 THEN menu$(m, i) = "~" + menu$(m, i)
i = i + 1
menu$(m, i) = "Sho#w Separator": IF ShowLineNumbersSeparator THEN menu$(m, i) = CHR$(7) + menu$(m, i)
menuDesc$(m, i) = "Toggles showing a separator line (side bar)"
ViewMenuShowSeparatorID = i
IF ShowLineNumbers = 0 THEN menu$(m, i) = "~" + menu$(m, i)
i = i + 1
menusize(m) = i - 1
IF os$ = "WIN" THEN
idepathsep$ = "\"
END IF
IF os$ = "LNX" THEN
idepathsep$ = "/"
END IF
ideroot$ = idezgetroot$
idepath$ = _STARTDIR$
'new blank text field
idet$ = MKL$(0) + MKL$(0): idel = 1: ideli = 1: iden = 1: IdeBmkN = 0
REDIM IdeBreakpoints(iden) AS _BYTE
REDIM IdeSkipLines(iden) AS _BYTE
variableWatchList$ = ""
backupVariableWatchList$ = "": REDIM backupUsedVariableList(1000) AS usedVarList
backupTypeDefinitions$ = ""
watchpointList$ = ""
callstacklist$ = "": callStackLength = 0
ideunsaved = -1
idechangemade = 1
startPausedPending = 0
redraweverything:
ideselect = 0
idesx = 1
idesy = 1
idecx = 1
idecy = 1
redraweverything2:
GOSUB redrawItAll
IF retval = 1 THEN GOTO skipload
'restore autosave?
'undo/redo
OPEN tmpdir$ + "autosave.bin" FOR BINARY AS #150
IF LOF(150) = 1 THEN
CLOSE #150
r$ = iderestore$
PCOPY 3, 0: SCREEN , , 3, 0
IF r$ = "Y" THEN
'restore
OPEN tmpdir$ + "undo2.bin" FOR BINARY AS #150
IF LOF(150) THEN
ideunsaved = 1
h$ = SPACE$(12): GET #150, , h$: p1 = CVL(MID$(h$, 1, 4)): p2 = CVL(MID$(h$, 5, 4)): plast = CVL(MID$(h$, 9, 4))
'get backup
SEEK #150, p2
GET #150, , l&
GET #150, , idesx: GET #150, , idesy
GET #150, , idecx: GET #150, , idecy
GET #150, , ideselect: GET #150, , ideselectx1: GET #150, , ideselecty1
GET #150, , iden
GET #150, , idel
GET #150, , ideli
'bookmark info [v2]
GET #150, , IdeBmkN: REDIM IdeBmk(IdeBmkN + 1) AS IdeBmkType
FOR bi = 1 TO IdeBmkN: GET #150, , IdeBmk(bi).y: GET #150, , IdeBmk(bi).x: NEXT
GET #150, , x&: idet$ = SPACE$(x&): GET #150, , idet$
END IF
CLOSE #150
END IF
ELSE
CLOSE #150
END IF
IF ideunsaved <> 1 THEN 'no file restored (takes priority over loading file from command line)
IF LEFT$(c$, 1) = CHR$(1) THEN 'load file
f$ = RIGHT$(c$, LEN(c$) - 1)
IF FileHasExtension(f$) = 0 THEN f$ = f$ + ".bas"
path$ = idezgetfilepath$(ideroot$, f$)
IF ideerror > 1 THEN PCOPY 3, 0: SCREEN , , 3, 0: GOTO IDEerrorMessage
'(copied from ideopen)
ideerror = 2
IF _FILEEXISTS(path$ + idepathsep$ + f$) = 0 THEN GOTO IDEerrorMessage
PCOPY 3, 0
IF BinaryFormatCheck%(path$, idepathsep$, f$) > 0 THEN GOTO skipload
ideerror = 3
idepath$ = path$
lineinput3load path$ + idepathsep$ + f$
idet$ = SPACE$(LEN(lineinput3buffer) * 8)
i2 = 1
n = 0
chrtab$ = CHR$(9)
space1$ = " ": space2$ = " ": space3$ = " ": space4$ = " "
chr7$ = CHR$(7): chr11$ = CHR$(11): chr12$ = CHR$(12): chr28$ = CHR$(28): chr29$ = CHR$(29): chr30$ = CHR$(30): chr31$ = CHR$(31)
DO
a$ = lineinput3$
l = LEN(a$)
IF l THEN asca = ASC(a$) ELSE asca = -1
IF asca <> 13 THEN
IF asca <> -1 THEN
'fix tabs
ideopenfixtabsx:
x = INSTR(a$, chrtab$)
IF x THEN
x2 = (x - 1) MOD 4
IF x2 = 0 THEN a$ = LEFT$(a$, x - 1) + space4$ + RIGHT$(a$, l - x): l = l + 3: GOTO ideopenfixtabsx
IF x2 = 1 THEN a$ = LEFT$(a$, x - 1) + space3$ + RIGHT$(a$, l - x): l = l + 2: GOTO ideopenfixtabsx
IF x2 = 2 THEN a$ = LEFT$(a$, x - 1) + space2$ + RIGHT$(a$, l - x): l = l + 1: GOTO ideopenfixtabsx
IF x2 = 3 THEN a$ = LEFT$(a$, x - 1) + space1$ + RIGHT$(a$, l - x): GOTO ideopenfixtabsx
END IF
END IF 'asca<>-1
MID$(idet$, i2, l + 8) = MKL$(l) + a$ + MKL$(l): i2 = i2 + l + 8: n = n + 1
END IF
LOOP UNTIL asca = 13
lineinput3buffer = ""
iden = n: IF n = 0 THEN idet$ = MKL$(0) + MKL$(0): iden = 1 ELSE idet$ = LEFT$(idet$, i2 - 1)
REDIM IdeBreakpoints(iden) AS _BYTE
REDIM IdeSkipLines(iden) AS _BYTE
variableWatchList$ = ""
backupVariableWatchList$ = "": REDIM backupUsedVariableList(1000) AS usedVarList
backupTypeDefinitions$ = ""
watchpointList$ = ""
callstacklist$ = "": callStackLength = 0
IF ideStartAtLine > 0 AND ideStartAtLine <= iden THEN
idecy = ideStartAtLine
IF idecy - 10 >= 1 THEN idesy = idecy - 10
idegotobox_LastLineNum = ideStartAtLine
ideStartAtLine = 0
END IF
IdeBmkN = 0
ideerror = 1
ideprogname = f$: _TITLE ideprogname + " - " + WindowTitle
IdeImportBookmarks idepath$ + idepathsep$ + ideprogname$
IdeAddRecent idepath$ + idepathsep$ + ideprogname$
END IF 'message 1
END IF 'no restore
skipload:
END IF 'idelaunched
IF c$ = CHR$(3) THEN
skipdisplay = 1 'assume .../starting already displayed
sendnextline = 1
'previous line was OK, so use layout if available
IF ideautolayout = 0 AND ideautoindent = 0 THEN
layout$ = ""
idelayoutallow = 0
ELSE
IF LEN(layout$) THEN
'calculate recommended indent level
FOR i = 1 TO LEN(layout$)
IF ASC(layout$, i) <> 32 OR i = LEN(layout$) THEN
indent = i - 1
layout$ = RIGHT$(layout$, LEN(layout$) - i + 1)
EXIT FOR
END IF
NEXT
IF ideautolayout THEN
spacelayout:
ignoresp = 0
FOR i = 1 TO LEN(layout$)
IF ASC(layout$, i) = 34 THEN
ignoresp = ignoresp + 1: IF ignoresp = 2 THEN ignoresp = 0
END IF
IF ignoresp = 0 THEN
IF MID$(layout$, i, 1) = sp THEN MID$(layout$, i, 1) = " "
IF MID$(layout$, i, 1) = sp2 THEN layout$ = LEFT$(layout$, i - 1) + RIGHT$(layout$, LEN(layout$) - i): GOTO spacelayout
END IF
NEXT
END IF
IF ideautoindent = 0 THEN
'note: can assume auto-format
'calculate old indent (if any)
a$ = idecompiledline$
indent = 0
FOR i = 1 TO LEN(a$)
IF ASC(a$, i) <> 32 OR i = LEN(a$) THEN
indent = i - 1
EXIT FOR
END IF
NEXT
indent$ = SPACE$(indent)
ELSE
indent$ = SPACE$(indent * ideautoindentsize)
END IF
IF ideautolayout = 0 THEN
'note: can assume auto-indent
a$ = idecompiledline$
layout$ = ""
FOR i = 1 TO LEN(a$)
IF ASC(a$, i) <> 32 OR i = LEN(a$) THEN
layout$ = RIGHT$(a$, LEN(a$) - i + 1)
EXIT FOR
END IF
NEXT
END IF
layout$ = indent$ + layout$
IF idecy <> idecompiledline OR idelayoutallow <> 0 THEN
idelayoutallow = 0
IF idecompiledline$ <> layout$ THEN
idesetline idecompiledline, layout$
IF idecompiledline >= idesy AND idecompiledline <= (idesy + 16) THEN skipdisplay = 0
END IF
ELSE
IF idecompiledline$ <> layout$ THEN
idecurrentlinelayout = layout$
idecurrentlinelayouti = idecy
END IF
END IF
END IF 'len(layout$)
END IF 'using layout/indent
END IF '3
IF c$ = CHR$(6) THEN
idecompiling = 0
ready = 1
IF ideautorun THEN ideautorun = 0: GOTO idemrunspecial
END IF
STATIC AS _BYTE attemptToHost, changingTcpPort
IF vWatchOn = 1 AND attemptToHost = 0 THEN
IF host& = 0 THEN
hostport$ = _TRIM$(STR$(idebaseTcpPort + tempfolderindex))
ENVIRON "QB64DEBUGPORT=" + hostport$
host& = _OPENHOST("TCP/IP:" + hostport$)
attemptToHost = -1
END IF
IF changingTcpPort AND (host& = 0) THEN
result = idemessagebox("$DEBUG MODE", "Cannot receive connections on port" + STR$(idebaseTcpPort) + ".\nCheck your firewall permissions.", "")
PCOPY 3, 0: SCREEN , , 3, 0
END IF
changingTcpPort = 0
END IF
IF IdeDebugMode THEN
idecompiling = 0
ready = 1
GOSUB redrawItAll
GOTO ExitDebugMode 'IdeDebugMode must be 0 here, if not, DebugMode errored.
END IF
IF c$ = CHR$(254) THEN
'$DEBUG mode on
IdeDebugMode = 1
REDIM vWatchReceivedData$(1 TO UBOUND(vWatchReceivedData$)) 'empty data array
EnterDebugMode:
IF idehelp THEN
idewy = idewy + idesubwindow
idehelp = 0
idesubwindow = 0
skipdisplay = 0
IdeSystem = 1
retval = 1
END IF
GOSUB redrawItAll
idecompiling = 0
ready = 1
_RESIZE OFF
DebugMode
ExitDebugMode:
IF WatchListToConsole THEN _CONSOLE OFF
UpdateMenuHelpLine ""
SELECT CASE IdeDebugMode
CASE 1 'clean exit
IdeDebugMode = 0
idefocusline = 0
debugnextline = 0
CASE 2 'right-click detected; invoke contextual menu
PCOPY 3, 0
IdeMakeContextualMenu
idecontextualmenu = 1
GOTO showmenu
END SELECT
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
IF idesubwindow <> 0 THEN _RESIZE OFF ELSE _RESIZE ON
GOTO ideloop
END IF
IF c$ = CHR$(11) THEN
idecompiling = 0
ready = 1
ideautorun = 0
showexecreated = 1
END IF
IF c$ = CHR$(7) THEN
skipdisplay = 1 'assume .../starting already displayed
idecompiledline = 0
sendnextline = 1
END IF
IF LEFT$(c$, 1) = CHR$(8) THEN
idecompiling = 0
failed = 1
ideautorun = 0
END IF
passback = 0
IF LEFT$(c$, 1) = CHR$(10) THEN 'passback
skipdisplay = 1 'assume .../starting already displayed
sendnextline = 1
idecompiledline = idecompiledline - 1
passback = 1
passback$ = RIGHT$(c$, LEN(c$) - 1)
END IF
IF mustdisplay THEN skipdisplay = 0
IF skipdisplay = 0 THEN
LOCATE , , 0
'note: menu bar shouldn't need repairing!
'COLOR 0, 7: _PRINTSTRING (1, 1), menubar$ 'repair menu bar
IF c$ <> CHR$(3) THEN
clearStatusWindow 0
IF ready THEN
IF IDEShowErrorsImmediately THEN
_PRINTSTRING (2, idewy - 3), "OK" 'report OK status
statusarealink = 0
IF totalWarnings > 0 AND showexecreated = 0 THEN
COLOR 11, 1
msg$ = " (" + LTRIM$(STR$(totalWarnings)) + " warning"
IF totalWarnings > 1 THEN msg$ = msg$ + "s"
msg$ = msg$ + " - click here or Ctrl+W to view)"
_PRINTSTRING (4, idewy - 3), msg$
statusarealink = 4
END IF
IF waitingForVarList THEN GOSUB showVarListReady
END IF
END IF
IF showexecreated THEN
showexecreated = 0
IF os$ = "LNX" THEN
_PRINTSTRING (2, idewy - 3), "Executable file created"
ELSE
_PRINTSTRING (2, idewy - 3), ".EXE file created"
END IF
IF SaveExeWithSource THEN
COLOR 11, 1
location$ = lastBinaryGenerated$
IF path.exe$ = "" THEN location$ = _STARTDIR$ + pathsep$ + location$
msg$ = "Location: " + location$
IF 2 + LEN(msg$) > idewx THEN
msg$ = "Location: " + STRING$(3, 250) + RIGHT$(location$, idewx - 15)
END IF
_PRINTSTRING (2, idewy - 2), msg$
statusarealink = 3
END IF
END IF
END IF
END IF 'skipdisplay
idefocusline = 0
'main loop
DO
ideloop:
IF ShowLineNumbers THEN maxLineNumberLength = LEN(STR$(iden)) + 1 ELSE maxLineNumberLength = 0
idecontextualmenu = 0
idedeltxt 'removes temporary strings (typically created by guibox commands) by setting an index to 0
IF idesubwindow <> 0 THEN _RESIZE OFF ELSE _RESIZE ON
IF (_RESIZE OR ForceResize) AND timeElapsedSince(QB64_uptime!) > 1.5 THEN
IF idesubwindow <> 0 THEN 'If there's a subwindow up, don't resize as it screws all sorts of things up.
ForceResize = -1
ELSE
retval = 0
ForceResize = 0
DO
tooSmall%% = 0
v% = _RESIZEWIDTH \ _FONTWIDTH: IF v% < 80 OR v% > 1000 THEN v% = 80: tooSmall%% = -1
IF v% <> idewx THEN retval = 1: idewx = v%
v% = _RESIZEHEIGHT \ _FONTHEIGHT: IF v% < 25 OR v% > 1000 THEN v% = 25: tooSmall%% = -1
IF v% <> idewy THEN retval = 1: idewy = v%
tempf& = _FONT
WIDTH idewx, idewy
_FONT tempf&
_PALETTECOLOR 1, IDEBackgroundColor, 0
_PALETTECOLOR 2, _RGB32(84, 84, 84), 0 'dark gray - help system and interface details
_PALETTECOLOR 5, IDEBracketHighlightColor, 0
_PALETTECOLOR 6, IDEBackgroundColor2, 0
_PALETTECOLOR 7, IDEChromaColor, 0
_PALETTECOLOR 8, IDENumbersColor, 0
_PALETTECOLOR 10, IDEMetaCommandColor, 0
_PALETTECOLOR 11, IDECommentColor, 0
_PALETTECOLOR 12, IDEKeywordColor, 0
_PALETTECOLOR 13, IDETextColor, 0
_PALETTECOLOR 14, IDEQuoteColor, 0
SCREEN , , 3, 0
'static background
COLOR 0, 7
_PRINTSTRING (1, 1), SPACE$(idewx)
_PRINTSTRING (1, 1), LEFT$(menubar$, idewx)
COLOR 7, 1: idebox 1, 2, idewx, idewy - 5
COLOR 7, 1: idebox 1, idewy - 4, idewx, 5
'edit corners
COLOR 7, 1: _PRINTSTRING (1, idewy - 4), CHR$(195): _PRINTSTRING (idewx, idewy - 4), CHR$(180)
GOSUB UpdateSearchBar
'status bar
COLOR 0, 3: _PRINTSTRING (1, idewy + idesubwindow), SPACE$(idewx)
UpdateIdeInfo
q = idevbar(idewx, idewy - 3, 3, 1, 1)
q = idevbar(idewx, 3, idewy - 8, 1, 1)
q = idehbar(2, idewy - 5, idewx - 2, 1, 1)
UpdateTitleOfMainWindow
COLOR 7, 1
_PRINTSTRING (2, idewy - 3), "Resizing..."
IF tooSmall%% THEN
COLOR 14, 1
_PRINTSTRING (2, 3), "ERROR: Minimum window size is 80x25"
ELSE
ideshowtext
END IF
PCOPY 3, 0
_DISPLAY
_LIMIT 15
LOOP WHILE _RESIZE
IF retval = 1 THEN 'screen dimensions have changed and everything must be redrawn/reapplied
WriteConfigSetting windowSettingsSection$, "IDE_Width", STR$(idewx)
WriteConfigSetting windowSettingsSection$, "IDE_Height", STR$(idewy)
END IF
retval = 1
_AUTODISPLAY
GOSUB redrawItAll
END IF
ELSE
_AUTODISPLAY
END IF
IF skipdisplay = 0 THEN
LOCATE , , 0
'update title of main window
UpdateTitleOfMainWindow
'Draw navigation buttons (QuickNav)
IF EnableQuickNav THEN GOSUB DrawQuickNav
'update search bar
GOSUB UpdateSearchBar
'alter cursor style to match insert mode
IF ideinsert THEN LOCATE , , , 0, 31 ELSE LOCATE , , , IDENormalCursorStart, IDENormalCursorEnd
'display error message (if necessary)
IF failed THEN
IF IDEShowErrorsImmediately <> 0 OR IDECompilationRequested <> 0 OR compfailed <> 0 THEN
IF LEFT$(IdeInfo, 19) <> "Selection length = " THEN IdeInfo = ""
UpdateIdeInfo
clearStatusWindow 0
'scrolling unavailable, but may span multiple lines
IF compfailed THEN
a$ = MID$(c$, 2, LEN(c$) - 5)
x = 2
y = idewy - 3
printWrapStatus x, y, x, a$
statusarealink = 1
ELSE
a$ = MID$(c$, 2, LEN(c$) - 5)
l = CVL(RIGHT$(c$, 4)): IF l <> 0 THEN idefocusline = l
x = 2
y = idewy - 3
IF l <> 0 AND idecy = l THEN onCurrentLine = LEN(a$): a$ = a$ + CHR$(1) + " on current line"
hasReference = INSTR(a$, " - Reference: ")
IF hasReference THEN
hasReference = hasReference + 13
a$ = LEFT$(a$, hasReference) + CHR$(2) + MID$(a$, hasReference + 1)
ELSE
hasReference = INSTR(a$, "Expected ")
IF hasReference THEN
hasReference = hasReference + 8
a$ = LEFT$(a$, hasReference) + CHR$(2) + MID$(a$, hasReference + 1)
END IF
END IF
printWrapStatus x, y, x, a$
IF l <> 0 AND idecy <> l THEN
a$ = " on line" + STR$(l) + " (click here or Ctrl+Shift+G to jump there)"
COLOR 11, 1
printWrapStatus POS(0), CSRLIN, 2, a$
statusarealink = 2
END IF
y = CSRLIN
IF y < idewy - 1 AND linefragment <> "[INFORMATION UNAVAILABLE]" THEN
temp$ = linefragment
FOR i = 1 TO LEN(temp$)
IF MID$(temp$, i, 1) = sp$ THEN MID$(temp$, i, 1) = " "
NEXT
temp$ = _TRIM$(temp$)
IF LEN(temp$) THEN
y = y + 1: x = 1
temp$ = "Caused by (or after): " + CHR$(1) + temp$
COLOR 7, 1
FOR i = 1 TO LEN(temp$)
x = x + 1: IF x = idewx THEN x = 2: y = y + 1
IF y > idewy - 1 THEN EXIT FOR
IF ASC(temp$, i) = 1 THEN i = i + 1: COLOR 11, 1
_PRINTSTRING (x, y), CHR$(ASC(temp$, i))
NEXT
END IF
END IF
END IF
END IF
END IF
IF idechangemade THEN
IF IDEShowErrorsImmediately OR IDECompilationRequested THEN
clearStatusWindow 0
IdeInfo = ""
_PRINTSTRING (2, idewy - 3), STRING$(3, 250) 'assume new compilation will begin "..."
END IF
END IF
ideshowtext
IF idehelp THEN
Help_ShowText
q = idehbar(2, idewy + idesubwindow - 1, idewx - 2, Help_cx, help_w + 1)
q = idevbar(idewx, idewy + 1, idesubwindow - 2, Help_cy, help_h + 1)
'COLOR 0, 7: LOCATE idewy, (idewx - 6) / 2: PRINT " Help "
'create and draw back string
GOSUB HelpAreaShowBackLinks
'Help_Search_Str
IF IdeSystem = 3 AND LEFT$(IdeInfo, 1) <> CHR$(0) THEN
a$ = ""
IF LEN(Help_Search_Str) THEN
a$ = Help_Search_Str
IF LEN(a$) > 20 THEN a$ = STRING$(3, 250) + RIGHT$(a$, 17)
a$ = "[" + a$ + "] (TAB=next)"
IdeInfo = a$
ELSE
IdeInfo = "Start typing to search for text in this help page"
END IF
UpdateIdeInfo
END IF
ELSE
Help_Search_Str = ""
END IF
IF IdeSystem = 2 THEN 'override cursor position
SCREEN , , 0, 0
tx = idesystem2.v1
IF LEN(idefindtext) > idesystem2.w THEN
IF idesystem2.v1 > idesystem2.w THEN
tx = idesystem2.w
ELSE
tx = idesystem2.v1
END IF
END IF
LOCATE idewy - 4, idewx - (idesystem2.w + 8) + 4 + tx
SCREEN , , 3, 0
END IF
IF IdeSystem = 3 THEN 'override cursor position
SCREEN , , 0, 0
LOCATE Help_cy - Help_sy + Help_wy1, Help_cx - Help_sx + Help_wx1
SCREEN , , 3, 0
END IF
LOCATE , , 1
PCOPY 3, 0
END IF 'skipdisplay
IF WhiteListQB64FirstTimeMsg = 0 THEN
'IF INSTR(_OS$, "WIN") THEN whiteListProcess$ = "and the process 'qb64.exe' " ELSE whiteListProcess$ = ""
result = idemessagebox("", "Welcome to QB64.com's QB64" + CHR$(10) + _
CHR$(10) + _
"Copyright (C) The QB64.com Community, 2007-2022." + CHR$(10) + _
"All rights reserved.", "#OK;#Don't show this again")
PCOPY 3, 0: SCREEN , , 3, 0
IF result = 2 THEN
WriteConfigSetting generalSettingsSection$, "WhiteListQB64FirstTimeMsg", "True"
END IF
WhiteListQB64FirstTimeMsg = -1
END IF
IF idechangemade THEN
IF idelayoutallow THEN idelayoutallow = idelayoutallow - 1
watchpointList$ = ""
idecurrentlinelayouti = 0 'invalidate
idefocusline = 0
idechangemade = 0
IDECompilationRequested = 0
compfailed = 0
IF ideunsaved = -1 THEN ideunsaved = 0 ELSE ideunsaved = 1
IF idenoundo = 0 THEN
'undo/redo
'build data so it can be written in a single write (a backup requirement)
a$ = ""
a$ = a$ + MKL$(idesx) + MKL$(idesy) 'screen position
a$ = a$ + MKL$(idecx) + MKL$(idecy) 'cursor position
a$ = a$ + MKL$(ideselect) + MKL$(ideselectx1) + MKL$(ideselecty1) 'selection state & position
a$ = a$ + MKL$(iden) 'number of lines
a$ = a$ + MKL$(idel) 'selected line in buffer
a$ = a$ + MKL$(ideli) 'selected line offset in buffer
'bookmark info [v2]
a$ = a$ + MKL$(IdeBmkN)
FOR bi = 1 TO IdeBmkN: a$ = a$ + MKL$(IdeBmk(bi).y) + MKL$(IdeBmk(bi).x): NEXT
l& = LEN(idet$)
a$ = a$ + MKL$(l&) 'data size
a$ = MKL$(l& + LEN(a$)) + a$ + idet$ + MKL$(l& + LEN(a$)) 'header, data & encapsulation (reverse navigatable list)
'add undo event
OPEN tmpdir$ + "undo2.bin" FOR BINARY AS #150
'[oldest state entry][newest state entry][top-most entry(ignore if no wrapping required)]
h$ = SPACE$(12): GET #150, , h$: p1 = CVL(MID$(h$, 1, 4)): p2 = CVL(MID$(h$, 5, 4)): plast = CVL(MID$(h$, 9, 4))
IF idemergeundo THEN
idemergeundo = 0
IF p2 <> p1 THEN 'can it be moved back?
IF p2 = 13 THEN
p2 = plast
ELSE
'get offset of previous message
GET #150, p2 - 4, pp2l
p2 = p2 - 4 - pp2l - 4
END IF
END IF
END IF
IF p1 = 0 THEN 'not init
p1 = 13: p2 = 13
ELSE
IF p2 >= p1 THEN
'no wrap
'should we extend?
IF p2 >= idebackupsize * 1000000 THEN
'can't extend
'set p2 as top-most
plast = p2
p2 = 13
'can new state (a$) fit before p1?
DO WHILE (p2 + LEN(a$) - 1) >= p1
IF p1 = ideundobase THEN ideundobase = -1
'no, so move p1 to next entry
'note: it can be assumed that p1, being near/at beginning, won't have to wrap when being moved forward
GET #150, p1, p1l
p1 = p1 + 4 + p1l + 4
LOOP
'p1 & p2 ready
ELSE
'extend
'find size of p2 event
GET #150, p2, p2l
p2 = p2 + 4 + p2l + 4
'p1 & p2 ready
END IF
ELSE
'wrap
'find size of p2 event
GET #150, p2, p2l
op2 = p2
p2 = p2 + 4 + p2l + 4
'can new state (a$) fit before p1?
DO WHILE (p2 + LEN(a$) - 1) >= p1
IF p1 = ideundobase THEN ideundobase = -1
'no, so move p1 to next entry
IF p1 = plast THEN
p1 = 13
EXIT DO
ELSE
GET #150, p1, p1l
p1 = p1 + 4 + p1l + 4
END IF
LOOP
'should we extend?
IF p2 >= idebackupsize * 1000000 THEN
'can't extend
'set op2 as top-most
plast = op2
p2 = 13
'can new state (a$) fit before p1?
DO WHILE (p2 + LEN(a$) - 1) >= p1
IF p1 = ideundobase THEN ideundobase = -1
'no, so move p1 to next entry
'note: it can be assumed that p1, being near/at beginning, won't have to wrap when being moved forward
GET #150, p1, p1l
p1 = p1 + 4 + p1l + 4
LOOP
END IF
'p1 & p2 ready
END IF
END IF
'update p1,p2,plast
h$ = MKL$(p1) + MKL$(p2) + MKL$(plast)
PUT #150, 1, h$
'add new state
PUT #150, p2, a$
CLOSE #150
ideundopos = p2
IF ideundobase = 0 THEN ideundobase = ideundopos
'set undo flag once
IF ideundoflag = 0 THEN
ideundoflag = 1
OPEN tmpdir$ + "autosave.bin" FOR BINARY AS #150: a$ = CHR$(1): PUT #150, , a$: CLOSE #150 'set flag
END IF
ELSE
idenoundo = 0
END IF
'begin new compilation
IF IDEBuildModeChanged = 0 THEN
ideautorun = 0
END IF
IDEBuildModeChanged = 0
idecompiling = 1
ide2 = 2
idecompiledline$ = idegetline(1)
idereturn$ = idecompiledline$
idecompiledline = 1
EXIT FUNCTION
END IF 'idechangemade
change = 0
waitforinput:
IF startPausedPending THEN GOTO idemrun
IF idecurrentlinelayouti THEN
IF idecy <> idecurrentlinelayouti THEN
idesetline idecurrentlinelayouti, idecurrentlinelayout$
idecurrentlinelayouti = 0
change = 1 'simulate a change to force a screen update
END IF
END IF
exitvalue = _EXIT
IF (exitvalue AND 1) <> 0 OR ideexit <> 0 THEN ideexit = 0: GOTO quickexit
GetInput
IF iCHANGED THEN
STATIC mox, moy
IF (mX <> mox OR mY <> moy) AND mB <> 0 THEN 'dragging mouse
mox = mX
moy = mY
change = 1
END IF
IF mB <> mOB THEN change = 1 'button changed
IF mB2 <> mOB2 THEN change = 1 'button changed
IF mCLICK <> 0 OR mCLICK2 <> 0 THEN change = 1
IF mWHEEL THEN change = 1
IF KB THEN change = 1
IF KSTATECHANGED THEN change = 1
END IF
IF mB <> 0 AND idembmonitor = 1 THEN change = 1
IF mB = 0 THEN idemouseselect = 0: idembmonitor = 0: wholeword.select = 0
IF _RESIZE THEN
ForceResize = -1: skipdisplay = 0: GOTO ideloop
END IF
IF IDE_AutoPosition THEN
IF IDE_TopPosition <> _SCREENY OR IDE_LeftPosition <> _SCREENX THEN
IF _SCREENY >= -_HEIGHT * _FONTHEIGHT AND _SCREENX >= -_WIDTH * _FONTWIDTH THEN 'Don't record the position if it's off the screen, past the point where we can drag it back into a different position.
WriteConfigSetting windowSettingsSection$, "IDE_TopPosition", STR$(_SCREENY)
WriteConfigSetting windowSettingsSection$, "IDE_LeftPosition", STR$(_SCREENX)
IDE_TopPosition = _SCREENY: IDE_LeftPosition = _SCREENX
END IF
END IF
END IF
IF _TOTALDROPPEDFILES > 0 THEN
IF _FILEEXISTS(_DROPPEDFILE$(1)) THEN
IdeOpenFile$ = _DROPPEDFILE$(1)
_FINISHDROP
GOTO ctrlOpen
END IF
_FINISHDROP
END IF
'Hover/click (QuickNav, "Find" field, version number, line number)
updateHover = 0
IF QuickNavTotal > 0 THEN
DO UNTIL QuickNavHistory(QuickNavTotal).idecy <= iden
'make sure that the line number in history still exists
QuickNavTotal = QuickNavTotal - 1
IF QuickNavTotal = 0 THEN EXIT DO
LOOP
END IF
IF IdeSystem = 1 AND QuickNavTotal > 0 AND EnableQuickNav THEN
IF mY = 2 THEN
IF mX >= 4 AND mX <= 6 THEN
IF QuickNavHover = 0 THEN
QuickNavHover = -1
COLOR 15, 3
popup$ = " " + CHR$(17) + " back to line " + str2$(QuickNavHistory(QuickNavTotal).idecy) + " "
_PRINTSTRING (4, 2), popup$
'shadow
COLOR 2, 0
FOR x2 = 6 TO 4 + LEN(popup$)
_PRINTSTRING (x2, 3), CHR$(SCREEN(3, x2))
NEXT
updateHover = -1
END IF
IF mCLICK THEN
ideselect = 0
idecy = QuickNavHistory(QuickNavTotal).idecy
idecx = QuickNavHistory(QuickNavTotal).idecx
idesx = QuickNavHistory(QuickNavTotal).idesx
idecentercurrentline
QuickNavTotal = QuickNavTotal - 1
GOTO ideloop
END IF
ELSE
GOTO RestoreBGQuickNav
END IF
ELSE
RestoreBGQuickNav:
IF QuickNavHover = -1 THEN
QuickNavHover = 0
UpdateTitleOfMainWindow
GOSUB DrawQuickNav
ideshowtext
updateHover = -1
END IF
END IF
END IF
IF mY = idewy - 4 AND mX > idewx - (idesystem2.w + 10) AND mX <= idewx - (idesystem2.w + 8) + 2 THEN '"Find" button
IF FindFieldHover = 0 THEN
'Highlight "Find"
COLOR 1, 3
_PRINTSTRING (idewx - (idesystem2.w + 9), idewy - 4), "Find"
updateHover = -1
FindFieldHover = -1
END IF
ELSE
IF FindFieldHover = -1 THEN
'Restore "Find" bg
FindFieldHover = 0
COLOR 3, 1
_PRINTSTRING (idewx - (idesystem2.w + 9), idewy - 4), "Find"
updateHover = -1
END IF
END IF
IF mY = idewy + idesubwindow AND mX >= idewx - 21 - LEN(versionStringStatus$) AND mX < idewx - 21 THEN
'Highlight Version Number
IF VersionInfoHover = 0 THEN
COLOR 13, 6
_PRINTSTRING (idewx - 21 - LEN(versionStringStatus$), idewy + idesubwindow), versionStringStatus$
updateHover = -1
VersionInfoHover = -1
END IF
IF mCLICK THEN PCOPY 0, 2: GOTO helpabout
ELSE
IF VersionInfoHover = -1 THEN
'Restore "Find" bg
VersionInfoHover = 0
COLOR 2, 3
_PRINTSTRING (idewx - 21 - LEN(versionStringStatus$), idewy + idesubwindow), versionStringStatus$
updateHover = -1
END IF
END IF
IF mY = idewy + idesubwindow AND mX >= idewx - 20 AND mX =< idewx THEN
'Highlight line number
IF LineNumberHover = 0 THEN
COLOR 13, 6
_PRINTSTRING (idewx - 20, idewy + idesubwindow), lineNumberStatus$
LineNumberHover = -1
updateHover = -1
END IF
IF mCLICK THEN
PCOPY 0, 2
idegotobox
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
ELSE
IF LineNumberHover = -1 THEN
'Restore "Find" bg
LineNumberHover = 0
COLOR 0, 3
_PRINTSTRING (idewx - 20, idewy + idesubwindow), lineNumberStatus$
updateHover = -1
END IF
END IF
IF os$ = "WIN" OR MacOSX = 1 THEN
IF _WINDOWHASFOCUS THEN
LOCATE , , 1
_PALETTECOLOR 5, IDEBracketHighlightColor, 0
_PALETTECOLOR 6, IDEBackgroundColor2, 0
ELSE
LOCATE , , 0
_PALETTECOLOR 5, IDEBackgroundColor, 0
_PALETTECOLOR 6, IDEBackgroundColor, 0
END IF
END IF
IF KALT THEN 'alt held
IF idealthighlight = 0 AND KALTPRESS = -1 AND NOT KCTRL THEN
'highlist first letter of each menu item
idealthighlight = 1
LOCATE , , 0: COLOR 15, 7: x = 4
FOR i = 1 TO menus
_PRINTSTRING (x, 1), LEFT$(menu$(i, 0), 1)
x = x + LEN(menu$(i, 0)) + 2
IF i = menus - 1 THEN x = idewx - LEN(menu$(menus, 0)) - 1
NEXT
ideentermenu = 1 'alt has just been pressed, so any next keystroke could enter a menu)
'IF change = 0 THEN
skipdisplay = 0: GOTO ideloop 'force update so cursor will be restored to correct position
END IF
ELSE 'alt not held
IF idealthighlight = 1 THEN
'remove highlight
idealthighlight = 0
LOCATE , , 0: COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
IF ideentermenu = 1 AND KCONTROL = 0 THEN 'alt was pressed then released
IF _WINDOWHASFOCUS OR os$ = "LNX" THEN
LOCATE , , , IDENormalCursorStart, IDENormalCursorEnd
skipdisplay = 0
ideentermenu = 0
GOTO startmenu
ELSE
GOTO ideloop
END IF
END IF
END IF
END IF 'alt not held
IF updateHover THEN PCOPY 3, 0
IF change = 0 THEN
'continue compilation?
IF idecompiling THEN
IF sendnextline THEN
IF idecompiledline < iden THEN
idecompiledline = idecompiledline + 1
ide2 = 4
IF passback THEN
idecompiledline$ = passback$
idereturn$ = idecompiledline$
ELSE
idecompiledline$ = idegetline(idecompiledline)
idereturn$ = idecompiledline$
END IF
EXIT FUNCTION
ELSE
'finished compilation
ide2 = 5 'end of program reached, what next?
'could return:
'i) 6 code ready for export/run
'ii) 7 repass required (if so send data from the beginning again)
EXIT FUNCTION
END IF
END IF
END IF
_LIMIT 16
GOTO waitforinput
END IF 'change=0
ideentermenu = 0
ideundocombo = ideundocombo - 1
IF ideundocombo < 0 THEN ideundocombo = 0
skipdisplay = 0
'IdeSystem independent routines
IF mCLICK THEN
IF mX >= 2 AND mX <= idewx AND mY >= idewy - 3 AND mY <= idewy - 1 THEN
IF SCREEN(mY, mX, 1) = 11 + 1 * 16 THEN 'if the text clicked is in COLOR 11 it's a link
'Status area links
SELECT CASE statusarealink
CASE 1
'1- Link to compilelog.txt:
IF INSTR(_OS$, "WIN") THEN
SHELL _DONTWAIT QuotedFilename$(compilelog$)
ELSEIF INSTR(_OS$, "MAC") THEN
SHELL _DONTWAIT "open " + QuotedFilename$(compilelog$)
ELSE
SHELL _DONTWAIT "xdg-open " + QuotedFilename$(compilelog$)
END IF
GOTO specialchar
CASE 2
'2- Link to the line that has a compiler error:
idecx = 1
AddQuickNavHistory
idecy = idefocusline
ideselect = 0
GOTO specialchar
CASE 3
'3- Link to the output folder when "Output EXE to source #folder" is checked:
IF INSTR(_OS$, "WIN") THEN
SHELL _DONTWAIT "explorer /select," + QuotedFilename$(lastBinaryGenerated$)
ELSEIF INSTR(_OS$, "MAC") THEN
SHELL _DONTWAIT "open " + QuotedFilename$(path.exe$)
ELSE
SHELL _DONTWAIT "xdg-open " + QuotedFilename$(path.exe$)
END IF
GOTO specialchar
CASE 4
'4- Link to Warnings dialog:
retval = idewarningbox
'retval is ignored
PCOPY 3, 0: SCREEN , , 3, 0
GOTO specialchar
END SELECT
END IF
END IF
END IF
IF KB = KEY_F7 OR KB = KEY_F8 THEN
GOTO startPausedMenuHandler
END IF
IF KB = KEY_F9 THEN 'toggle breakpoint
GOTO toggleBreakpoint
END IF
IF KB = KEY_F10 THEN 'clear all breakpoints
IF KCTRL THEN
GOTO unskipAllLines
ELSE
GOTO clearAllBreakpoints
END IF
END IF
IF KB = KEY_F11 THEN 'make exe only
idemexe:
iderunmode = 2
GOTO idemrunspecial
END IF
IF KB = KEY_F12 THEN 'show call stack
IF callStackLength > 0 THEN
GOTO showCallStackDialog
ELSE
result = idemessagebox("$DEBUG MODE", "No call stack log available.", "")
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
IF KB = KEY_F4 THEN 'variable watch
GOTO showWatchList
END IF
IF KB = KEY_F5 THEN 'Note: F5 or SHIFT+F5 accepted
IF LEN(ideprogname) = 0 THEN
NoExeSaved = -1
END IF
startPaused = 0
idemrun:
startPausedPending = 0
iderunmode = 1 'run detached; = 0 'standard run
idemrunspecial:
IDECompilationRequested = -1
IF ExeToSourceFolderFirstTimeMsg = 0 THEN
IF SaveExeWithSource THEN
result = idemessagebox("Run", "Your program will be compiled to the same folder where your" + CHR$(10) + _
"source code is saved. You can change that by unchecking the" + CHR$(10) + _
"option 'Output EXE to Source Folder' in the Run menu.", "#OK;#Don't show this again;#Cancel")
ELSE
result = idemessagebox("Run", "Your program will be compiled to your QB64 folder. You can" + CHR$(10) + _
"change that by checking the option 'Output EXE to Source" + CHR$(10) + _
"Folder' in the Run menu.", "#OK;#Don't show this again;#Cancel")
END IF
IF result = 2 THEN
WriteConfigSetting generalSettingsSection$, "ExeToSourceFolderFirstTimeMsg", "True"
ExeToSourceFolderFirstTimeMsg = -1
ELSEIF result = 3 THEN
PCOPY 3, 0: SCREEN , , 3, 0
LOCATE , , 0
clearStatusWindow 0
_PRINTSTRING (2, idewy - 3), "Compilation request canceled."
GOTO specialchar
END IF
END IF
PCOPY 3, 0: SCREEN , , 3, 0
'run program
IF ready <> 0 AND idechangemade = 0 THEN
LOCATE , , 0
clearStatusWindow 0
If NoExeSaved then idecompiled = 0: GOTO mustGenerateExe
IF idecompiled THEN
IF iderunmode = 2 AND _FILEEXISTS(lastBinaryGenerated$) THEN
IF os$ = "LNX" THEN
_PRINTSTRING (2, idewy - 3), "Already created executable file!"
ELSE
_PRINTSTRING (2, idewy - 3), "Already created .EXE file!"
END IF
COLOR 11, 1
location$ = lastBinaryGenerated$
IF path.exe$ = "" THEN location$ = _STARTDIR$ + pathsep$ + location$
msg$ = "Location: " + location$
IF 2 + LEN(msg$) > idewx THEN
msg$ = "Location: " + STRING$(3, 250) + RIGHT$(location$, idewx - 15)
END IF
_PRINTSTRING (2, idewy - 2), msg$
statusarealink = 3
GOTO specialchar
ELSEIF _FILEEXISTS(lastBinaryGenerated$) = 0 THEN
idecompiled = 0
GOTO mustGenerateExe
END IF
dummy = DarkenFGBG(1)
BkpIdeSystem = IdeSystem: IdeSystem = 2: UpdateTitleOfMainWindow: IdeSystem = BkpIdeSystem
COLOR 1, 7: _PRINTSTRING ((idewx - 8) / 2, idewy - 4), " Status "
COLOR 15, 1
_PRINTSTRING (2, idewy - 3), "Starting program..."
ELSE
mustGenerateExe:
dummy = DarkenFGBG(1)
BkpIdeSystem = IdeSystem: IdeSystem = 2: UpdateTitleOfMainWindow: IdeSystem = BkpIdeSystem
COLOR 1, 7: _PRINTSTRING ((idewx - 8) / 2, idewy - 4), " Status "
COLOR 15, 1
IF os$ = "LNX" THEN
_PRINTSTRING (2, idewy - 3), "Creating executable file..."
ELSE
_PRINTSTRING (2, idewy - 3), "Creating .EXE file..."
END IF
END IF
PCOPY 3, 0
'send run request
'prepare name
IF ideprogname$ = "" THEN
f$ = "untitled" + tempfolderindexstr$
ELSE
f$ = ideprogname$
f$ = RemoveFileExtension$(f$)
END IF
ide2 = 9: idereturn$ = f$
EXIT FUNCTION
END IF
'not ready!
IF failed = 1 THEN GOTO specialchar
'assume still compiling ...
ideautorun = 1
'correct status message
LOCATE , , 0
clearStatusWindow 0
_PRINTSTRING (2, idewy - 3), "Checking program... (editing program will cancel request)"
'must move the cursor back to its correct location
ideshowtext
LOCATE , , 1
PCOPY 3, 0
GOTO specialchar
END IF
LOCATE , , 0
LOCATE , , , IDENormalCursorStart, IDENormalCursorEnd
IF (mCLICK OR mCLICK2) AND idemouseselect = 0 THEN
IF mY = 1 THEN
x = 3
FOR i = 1 TO menus
x2 = LEN(menu$(i, 0)) + 2
IF mX >= x AND mX < x + x2 THEN
m = i
GOTO showmenu
END IF
x = x + x2
IF i = menus - 1 THEN x = idewx - LEN(menu$(menus, 0)) - 2
NEXT
END IF
END IF
FOR i = 1 TO menus
a$ = UCASE$(LEFT$(menu$(i, 0), 1))
IF KALT AND UCASE$(K$) = a$ THEN
m = i
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
PCOPY 3, 0
GOTO showmenu
END IF
NEXT
IF KCTRL AND UCASE$(K$) = "F" THEN
K$ = ""
IdeSystem = 2
IF LEN(idefindtext) THEN idesystem2.issel = -1: idesystem2.sx1 = 0: idesystem2.v1 = LEN(idefindtext)
GOTO specialchar
END IF
IF KCTRL AND UCASE$(K$) = "K" THEN
K$ = ""
GOTO ideQuickKeycode
END IF
IF KCTRL AND KB = KEY_F3 THEN
IF IdeSystem = 3 THEN IdeSystem = 1
GOTO idefindjmp
END IF
IF KALT AND KB = KEY_F3 THEN
IF IdeSystem = 3 THEN IdeSystem = 1
GOTO idefindchangejmp
END IF
IF KB = KEY_F3 OR K$ = CHR$(28) THEN
IF IdeSystem = 3 THEN IdeSystem = 1
idemf3:
IF idefindtext <> "" THEN
IF IdeSystem = 2 THEN
idesystem2.sx1 = 0
idesystem2.v1 = LEN(idefindtext)
idesystem2.issel = -1
END IF
GOSUB UpdateSearchBar
IF KSHIFT THEN idefindinvert = 1
IdeAddSearched idefindtext
idefindagain -1
ELSE
GOTO idefindjmp
END IF
GOTO specialchar
END IF
IF KSHIFT AND KB = KEY_F1 THEN
IF idehelp = 0 THEN
idesubwindow = idewy \ 2: idewy = idewy - idesubwindow
Help_wx1 = 2: Help_wy1 = idewy + 1: Help_wx2 = idewx - 1: Help_wy2 = idewy + idesubwindow - 2: Help_ww = Help_wx2 - Help_wx1 + 1: Help_wh = Help_wy2 - Help_wy1 + 1
idehelp = 1
skipdisplay = 0
IdeSystem = 3
retval = 1: GOSUB redrawItAll
END IF
IdeSystem = 3
GOTO specialchar
END IF
'Scroll bar code goes here
STATIC Help_Scrollbar, Help_Scrollbar_Method
'1=arrow less, 2=arrow more, 3=dragging 'bit', 4=clicking in space
IF mB = 0 THEN Help_Scrollbar = 0
IF idehelp THEN
IF IdeSystem = 3 THEN
'q = idehbar(2, idewy + idesubwindow - 1, idewx - 2, Help_cx, help_w + 1)
'q = idevbar(idewx, idewy + 1, idesubwindow - 2, Help_cy, help_h + 1)
IF mCLICK THEN
IF mX >= 2 AND mX <= idewx - 1 AND mY = idewy + idesubwindow - 1 THEN
Help_Scrollbar = 1
v = idehbar(2, idewy + idesubwindow - 1, idewx - 2, Help_cx, help_w + 1)
IF v <> mX THEN Help_Scrollbar_Method = 3 ELSE Help_Scrollbar_Method = 4
IF mX = 2 THEN Help_Scrollbar_Method = 1
IF mX = idewx - 1 THEN Help_Scrollbar_Method = 2
END IF
IF mY >= idewy + 1 AND mY <= idewy + idesubwindow - 2 AND mX = idewx THEN
Help_Scrollbar = 2
v = idevbar(idewx, idewy + 1, idesubwindow - 2, Help_cy, help_h + 1)
IF v <> mY THEN Help_Scrollbar_Method = 3 ELSE Help_Scrollbar_Method = 4
IF mY = idewy + 1 THEN Help_Scrollbar_Method = 1
IF mY = idewy + idesubwindow - 2 THEN Help_Scrollbar_Method = 2
END IF
END IF 'mclick
IF Help_Scrollbar THEN
idembmonitor = 1
IF Help_Scrollbar_Method = 1 THEN
IF Help_Scrollbar = 1 THEN KB = KEY_LEFT: idewait 'fall through...
IF Help_Scrollbar = 2 THEN KB = KEY_UP: idewait 'fall through...
END IF
IF Help_Scrollbar_Method = 2 THEN
IF Help_Scrollbar = 1 THEN KB = KEY_RIGHT: idewait 'fall through...
IF Help_Scrollbar = 2 THEN KB = KEY_DOWN: idewait 'fall through...
END IF
IF Help_Scrollbar_Method = 3 THEN
IF Help_Scrollbar = 1 THEN
v = idehbar(2, idewy + idesubwindow - 1, idewx - 2, Help_cx, help_w + 1)
IF mX < v THEN
Help_cx = Help_cx - 8
IF Help_cx < 1 THEN Help_cx = 1
IF Help_sx > Help_cx THEN Help_sx = Help_cx
idewait
END IF
IF mX > v THEN
Help_cx = Help_cx + 8
IF Help_cx > help_w + 1 THEN Help_cx = help_w + 1
idewait
END IF
END IF
IF Help_Scrollbar = 2 THEN
v = idevbar(idewx, idewy + 1, idesubwindow - 2, Help_cy, help_h + 1)
IF mY < v THEN KB = KEY_PAGEUP: idewait 'fall through...
IF mY > v THEN KB = KEY_PAGEDOWN: idewait 'fall through...
END IF
END IF
IF Help_Scrollbar_Method = 4 THEN
IF Help_Scrollbar = 1 THEN
IF help_w > 1 THEN
IF mX <= 3 THEN
Help_sx = 1: Help_cx = 1
ELSEIF mX >= idewx - 2 THEN
Help_sx = help_w + 1: Help_cx = help_w + 1
ELSE
x = mX
p! = x - 4 + .5 '4 (the min pos) becomes .5
p! = p! / (idewx - 3 - 3)
i = p! * (help_w) + 1
Help_sx = i: Help_cx = i
END IF
END IF
END IF
IF Help_Scrollbar = 2 THEN
IF help_h > 1 THEN
IF mY <= idewy + 2 THEN
Help_cy = 1
ELSEIF mY >= idewy + idesubwindow - 3 THEN
Help_cy = help_h + 1
ELSE
y = mY
p! = y - idewy - 3 + .5
p! = p! / (idesubwindow - 3 - 3)
i = p! * (help_h) + 1
Help_cy = i
END IF
'fix cursor
IF Help_cx < 1 THEN Help_cx = 1
IF Help_cx > help_w + 1 THEN Help_cx = help_w + 1
IF Help_cy < 1 THEN Help_cy = 1
IF Help_cy > help_h + 1 THEN Help_cy = help_h + 1
'screen follows cursor
IF Help_cx < Help_sx THEN Help_sx = Help_cx
IF Help_cx >= Help_sx + Help_ww THEN Help_sx = Help_cx - Help_ww + 1
IF Help_cy < Help_sy THEN Help_sy = Help_cy
IF Help_cy >= Help_sy + Help_wh THEN Help_sy = Help_cy - Help_wh + 1
'fix screen
IF Help_sx < 1 THEN Help_sx = 1
IF Help_sy < 1 THEN Help_sy = 1
END IF
END IF
END IF
'IF mB AND idemouseselect = 2 THEN
' 'move vbar scroller (idecy) to appropriate position
' IF iden > 1 THEN
' IF mY <= 4 THEN idecy = 1
' IF mY >= idewy - 7 THEN idecy = iden
' IF mY > 4 AND mY < idewy - 7 THEN
' y = mY
' p! = y - 3 - 2 + .5
' p! = p! / ((idewy - 8) - 4)
' i = p! * (iden - 1) + 1
' idecy = i
' END IF
' END IF
'END IF
IF mCLICK THEN mCLICK = 0
END IF
END IF 'system=3
END IF 'idehelp
'IdeSystem specific code goes here
IF mCLICK THEN 'Find [...] search field (IdeSystem = 2)
IF mY = idewy - 4 AND mX > idewx - (idesystem2.w + 10) AND mX < idewx - 1 THEN 'inside text box
IF mX <= idewx - (idesystem2.w + 8) + 2 THEN
IF LEN(idefindtext) = 0 THEN
IdeSystem = 2 'no search string, so begin editing
idesystem2.issel = 0: idesystem2.v1 = 0
ELSE
IdeAddSearched idefindtext
IdeSystem = 1: GOTO idemf3 'F3 functionality
END IF
ELSE
IF mX = idewx - 3 THEN
showrecentlysearchedbox:
PCOPY 0, 3
GOSUB UpdateSearchBar
f$ = idesearchedbox
IF LEN(f$) THEN idefindtext = f$
PCOPY 3, 0: SCREEN , , 3, 0
idealthighlight = 0
LOCATE , , 0: COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
IdeSystem = 1
IF LEN(f$) THEN GOTO idemf3 'F3 functionality
GOTO ideloop
ELSE
IF IdeSystem = 2 THEN
IF idesystem2.issel THEN idesystem2.issel = 0
IF LEN(idefindtext) <= idesystem2.w THEN
idesystem2.v1 = mX - (idewx - (idesystem2.w + 4))
ELSE
IF idesystem2.v1 > idesystem2.w THEN
idesystem2.v1 = (mX - (idewx - (idesystem2.w + 4))) + (idesystem2.v1 - idesystem2.w)
ELSE
idesystem2.v1 = mX - (idewx - (idesystem2.w + 4))
END IF
END IF
ELSE
IdeSystem = 2
IF LEN(idefindtext) THEN idesystem2.issel = -1: idesystem2.sx1 = 0: idesystem2.v1 = LEN(idefindtext)
END IF
END IF
END IF
END IF
END IF
'IdeSystem
IF KB = KEY_F6 THEN 'switch windows
IF idehelp = 1 THEN
IF IdeSystem = 3 THEN
IdeSystem = 1
ELSE
IdeSystem = 3
END IF
END IF
END IF
IF idehelp = 1 THEN 'switch windows?
IF mCLICK OR mCLICK2 THEN
IF IdeSystem = 3 THEN
IF mY >= 2 AND mY < idewy THEN
IdeSystem = 1
END IF
ELSE
IF mY >= idewy AND mY < idewy + idesubwindow THEN
IdeSystem = 3
END IF
END IF
IF mCLICK2 THEN
GOTO invokecontextualmenu
END IF
END IF
END IF
IF IdeSystem = 2 THEN 'certain keys transfer control
z = 0
IF (KALT AND KB = KEY_UP) OR (KALT AND KB = KEY_DOWN) THEN GOTO showrecentlysearchedbox
IF KB = KEY_UP THEN z = 1
IF KB = KEY_DOWN THEN z = 1
IF KB = KEY_PAGEUP THEN z = 1
IF KB = KEY_PAGEDOWN THEN z = 1
IF mWHEEL THEN z = 1
IF z = 1 THEN IdeSystem = 1
END IF
IF IdeSystem = 2 THEN
a$ = idefindtext
IF LEN(K$) = 1 OR (KB = KEY_INSERT OR KB = KEY_DELETE) THEN
IF LEN(K$) = 1 THEN k = ASC(K$)
IF (KSHIFT AND KB = KEY_INSERT) OR (KCONTROL AND UCASE$(K$) = "V") THEN 'paste from clipboard
pasteIntoSearchField:
clip$ = _CLIPBOARD$ 'read clipboard
x = INSTR(clip$, CHR$(13))
IF x THEN clip$ = LEFT$(clip$, x - 1)
x = INSTR(clip$, CHR$(10))
IF x THEN clip$ = LEFT$(clip$, x - 1)
IF LEN(clip$) THEN
IF idesystem2.issel THEN
sx1 = idesystem2.sx1: sx2 = idesystem2.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN
a$ = LEFT$(a$, sx1) + clip$ + RIGHT$(a$, LEN(a$) - sx2)
idesystem2.v1 = sx1
IF PasteCursorAtEnd THEN
idesystem2.v1 = sx1 + LEN(clip$)
END IF
idesystem2.issel = 0
END IF
ELSE
a$ = LEFT$(a$, idesystem2.v1) + clip$ + RIGHT$(a$, LEN(a$) - idesystem2.v1)
IF PasteCursorAtEnd THEN idesystem2.v1 = idesystem2.v1 + LEN(clip$)
END IF
END IF
k = 255
END IF
IF (KCONTROL AND UCASE$(K$) = "A") THEN 'select all
selectAllInSearchField:
IF LEN(a$) > 0 THEN
idesystem2.issel = -1
idesystem2.sx1 = 0
idesystem2.v1 = LEN(a$)
END IF
k = 255
END IF
IF ((KCTRL AND KB = KEY_INSERT) OR (KCONTROL AND UCASE$(K$) = "C")) THEN 'copy to clipboard
copysearchterm2clip:
IF idesystem2.issel THEN
sx1 = idesystem2.sx1: sx2 = idesystem2.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN _CLIPBOARD$ = MID$(a$, sx1 + 1, sx2 - sx1)
END IF
k = 255
END IF
IF ((KSHIFT AND KB = KEY_DELETE) OR (KCONTROL AND UCASE$(K$) = "X")) THEN 'cut to clipboard
cutToClipboardSearchField:
IF idesystem2.issel THEN
sx1 = idesystem2.sx1: sx2 = idesystem2.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN
_CLIPBOARD$ = MID$(a$, sx1 + 1, sx2 - sx1)
'delete selection
a$ = LEFT$(a$, sx1) + RIGHT$(a$, LEN(a$) - sx2)
idesystem2.v1 = sx1
idesystem2.issel = 0
END IF
END IF
k = 255
END IF
IF k = 8 THEN
IF idesystem2.issel THEN
sx1 = idesystem2.sx1: sx2 = idesystem2.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN
'delete selection
a$ = LEFT$(a$, sx1) + RIGHT$(a$, LEN(a$) - sx2)
idefindtext = a$
idesystem2.v1 = sx1
idesystem2.issel = 0
END IF
ELSEIF idesystem2.v1 > 0 THEN
a1$ = LEFT$(a$, idesystem2.v1 - 1)
IF idesystem2.v1 <= LEN(a$) THEN a2$ = RIGHT$(a$, LEN(a$) - idesystem2.v1) ELSE a2$ = ""
a$ = a1$ + a2$: idesystem2.v1 = idesystem2.v1 - 1
idefindtext = a$
END IF
END IF
IF k = 27 THEN
IdeSystem = 1
GOTO specialchar
END IF
IF k = 9 THEN
IdeSystem = 1
GOTO specialchar
END IF
IF k = 13 THEN
IF LEN(idefindtext) THEN
IdeAddSearched idefindtext
GOTO idemf3 'F3 functionality
END IF
GOTO specialchar
END IF
IF k <> 8 AND k <> 9 AND k <> 0 AND k <> 10 AND k <> 13 AND k <> 26 AND k <> 255 THEN
IF idesystem2.issel THEN
sx1 = idesystem2.sx1: sx2 = idesystem2.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN
'replace selection
a$ = LEFT$(a$, sx1) + RIGHT$(a$, LEN(a$) - sx2)
idefindtext = a$
idesystem2.issel = 0
idesystem2.v1 = sx1
END IF
END IF
IF idesystem2.v1 > 0 THEN a1$ = LEFT$(a$, idesystem2.v1) ELSE a1$ = ""
IF idesystem2.v1 <= LEN(a$) THEN a2$ = RIGHT$(a$, LEN(a$) - idesystem2.v1) ELSE a2$ = ""
a$ = a1$ + K$ + a2$: idesystem2.v1 = idesystem2.v1 + 1
END IF
idefindtext = a$
END IF
IF K$ = CHR$(0) + CHR$(60) THEN 'F2
IdeSystem = 1
GOTO idesubsjmp
END IF
IF K$ = CHR$(0) + "S" THEN 'DEL
deleteSelectionSearchField:
IF idesystem2.issel THEN
sx1 = idesystem2.sx1: sx2 = idesystem2.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN
'delete selection
a$ = LEFT$(a$, sx1) + RIGHT$(a$, LEN(a$) - sx2)
idefindtext = a$
idesystem2.v1 = sx1
idesystem2.issel = 0
END IF
ELSE
IF idesystem2.v1 > 0 THEN a1$ = LEFT$(a$, idesystem2.v1) ELSE a1$ = ""
IF idesystem2.v1 < LEN(a$) THEN a2$ = RIGHT$(a$, LEN(a$) - idesystem2.v1 - 1) ELSE a2$ = ""
a$ = a1$ + a2$
idefindtext = a$
END IF
END IF
'cursor control
IF K$ = CHR$(0) + "K" THEN GOSUB selectcheck: idesystem2.v1 = idesystem2.v1 - 1
IF K$ = CHR$(0) + "M" THEN GOSUB selectcheck: idesystem2.v1 = idesystem2.v1 + 1
IF K$ = CHR$(0) + "G" THEN GOSUB selectcheck: idesystem2.v1 = 0
IF K$ = CHR$(0) + "O" THEN GOSUB selectcheck: idesystem2.v1 = LEN(a$)
IF idesystem2.v1 < 0 THEN idesystem2.v1 = 0
IF idesystem2.v1 > LEN(a$) THEN idesystem2.v1 = LEN(a$)
IF idesystem2.v1 = idesystem2.sx1 THEN idesystem2.issel = 0
IF mCLICK OR mCLICK2 THEN
IF mX > 1 AND mX < idewx AND mY > 2 AND mY < (idewy - 5) THEN 'inside text box
IdeSystem = 1
IF mCLICK2 THEN GOTO invokecontextualmenu ELSE GOTO ideloop
ELSEIF mY >= idewy AND mY < idewy + idesubwindow THEN 'inside help
IdeSystem = 3
IF mCLICK2 THEN GOTO invokecontextualmenu ELSE GOTO ideloop
END IF
END IF
GOTO specialchar
END IF
IF IdeSystem = 3 THEN
IF mCLICK OR K$ = CHR$(27) THEN
' The X in the Help pane.
IF (mY = idewy AND (mX >= idewx - 4 AND mX <= idewx - 1)) OR K$ = CHR$(27) THEN 'close help
closeHelp:
idewy = idewy + idesubwindow
idehelp = 0
idesubwindow = 0
skipdisplay = 0
IdeSystem = 1
retval = 1: GOSUB redrawItAll
END IF
END IF
IF mCLICK THEN
' removing the "View on Wiki" - @dualbrain
IF 1=0 AND (mY = idewy AND (mX >= idewx - 17 AND mX <= idewx - 4)) THEN 'view on wiki
launchWiki:
url$ = wikiBaseAddress$ + "/" + Back$(Help_Back_Pos)
url$ = StrReplace$(url$, " ", "%20"): url$ = StrReplace$(url$, "&", "%26")
url$ = StrReplace$(url$, "+", "%2B")
IF INSTR(_OS$, "WIN") = 0 THEN
url$ = StrReplace$(url$, "$", "\$")
url$ = StrReplace$(url$, "&", "\&")
url$ = StrReplace$(url$, "(", "\(")
url$ = StrReplace$(url$, ")", "\)")
END IF
IF INSTR(_OS$, "WIN") THEN
SHELL _HIDE _DONTWAIT "start " + url$
ELSEIF INSTR(_OS$, "MAC") THEN
SHELL _HIDE _DONTWAIT "open " + url$
ELSE
SHELL _HIDE _DONTWAIT "xdg-open " + url$
END IF
GOTO specialchar
END IF
' removing the help "breadcrumb" - @dualbrain
IF 1=0 AND mY = idewy THEN
sx = 2
FOR x = Back_Str_Pos TO Back_Str_Pos + idewx - 6
IF mX = sx THEN
i = CVL(MID$(Back_Str_I$, (x - 1) * 4 + 1, 4))
a = ASC(Back_Str$, x)
IF a <> 0 AND i <> Help_Back_Pos THEN
Help_Back(Help_Back_Pos).sx = Help_sx 'update position
Help_Back(Help_Back_Pos).sy = Help_sy
Help_Back(Help_Back_Pos).cx = Help_cx
Help_Back(Help_Back_Pos).cy = Help_cy
Help_Back_Pos = i
Help_Select = 0: Help_MSelect = 0
Help_sx = Help_Back(Help_Back_Pos).sx
Help_sy = Help_Back(Help_Back_Pos).sy
Help_cx = Help_Back(Help_Back_Pos).cx
Help_cy = Help_Back(Help_Back_Pos).cy
a$ = Wiki$(Back$(Help_Back_Pos))
WikiParse a$
GOTO newpageparsed
END IF
END IF
sx = sx + 1
NEXT
'LOCATE idewy, 2
'FOR x = Back_Str_Pos TO Back_Str_Pos + idewx - 5
' i = CVL(MID$(Back_Str_I$, (x - 1) * 4 + 1, 4))
' a = ASC(Back_Str$, x)
' IF a THEN
' COLOR 0, 7
' IF i < Help_Back_Pos THEN COLOR 9, 7
' IF i > Help_Back_Pos THEN COLOR 9, 7
' PRINT CHR$(a);
' ELSE
' COLOR 7, 0
' PRINT chr$(196);
' END IF
'NEXT
END IF
END IF
IF KCONTROL AND UCASE$(K$) = "A" THEN 'select all
selectAllInHelp:
IF help_h THEN
Help_Select = 2
Help_SelX1 = 1
Help_SelY1 = 1
Help_SelX2 = 10000000
Help_SelY2 = help_h
Help_cx = 1: Help_cy = help_h + 1
GOTO keep_select
END IF
END IF
IF ((KCTRL AND KB = KEY_INSERT) OR (KCONTROL AND UCASE$(K$) = "C")) AND Help_Select = 2 THEN 'copy to clipboard
copyhelp2clip:
ideerror = -1 'if it fails, just carry on
clip$ = ""
FOR y = Help_SelY1 TO Help_SelY2
IF y <> Help_SelY1 THEN clip$ = clip$ + CHR$(13) + CHR$(10)
a$ = ""
IF y <= help_h THEN
l = CVL(MID$(Help_Line$, (y - 1) * 4 + 1, 4))
x = l
x3 = 1
c = ASC(Help_Txt$, x)
DO UNTIL c = 13
IF Help_Select = 2 THEN
IF y >= Help_SelY1 AND y <= Help_SelY2 THEN
IF x3 >= Help_SelX1 AND x3 <= Help_SelX2 THEN
a$ = a$ + CHR$(c)
END IF
END IF
END IF
x3 = x3 + 1: x = x + 4: c = ASC(Help_Txt$, x)
LOOP
END IF
clip$ = clip$ + a$
NEXT
IF Help_SelY1 = Help_SelY2 AND Help_cy > Help_cy1 THEN clip$ = clip$ + CHR$(13) + CHR$(10)
IF clip$ <> "" THEN _CLIPBOARD$ = clip$
ideerror = 1
GOTO keep_select
END IF
IF mX >= Help_wx1 AND mY >= Help_wy1 AND mX <= Help_wx2 AND mY <= Help_wy2 THEN
IF mCLICK THEN
Help_cx = Help_sx + (mX - Help_wx1)
Help_cy = Help_sy + (mY - Help_wy1)
Help_Select = 1
Help_MSelect = 1
Help_cx1 = Help_cx: Help_cy1 = Help_cy
GOTO keep_select
END IF
IF (mB AND Help_Scrollbar = 0) THEN
Help_cx = Help_sx + (mX - Help_wx1)
Help_cy = Help_sy + (mY - Help_wy1)
IF Help_Select THEN GOTO keep_select
END IF
ELSE
'outside field
IF (mB AND Help_Scrollbar = 0) AND Help_MSelect = 1 AND Help_Select = 2 THEN
IF mX < Help_wx1 THEN Help_cx = Help_cx - 1
IF mX > Help_wx2 THEN Help_cx = Help_cx + 1
IF mY < Help_wy1 THEN Help_cy = Help_cy - 1
IF mY > Help_wy2 THEN Help_cy = Help_cy + 1
GOTO keep_select
END IF
END IF
IF KSHIFT THEN
IF Help_Select = 0 THEN
Help_Select = 1
Help_MSelect = 0
Help_cx1 = Help_cx: Help_cy1 = Help_cy
END IF
ELSE
IF (KB > 0 OR mWHEEL <> 0) AND KSTATECHANGED = 0 THEN Help_Select = 0
END IF
keep_select:
IF KB = 9 THEN
IF LEN(Help_Search_Str) THEN norep = 1: GOTO delsrchagain
END IF
IF LEN(K$) = 1 AND KCONTROL = 0 THEN
k = ASC(K$)
IF alphanumeric(k) OR k = 36 OR k = 32 THEN
norep = 0
t# = TIMER(0.001)
oldk = 0: IF LEN(Help_Search_Str) THEN oldk = ASC(Help_Search_Str, LEN(Help_Search_Str))
IF t# > Help_Search_Time + 1 OR t# < Help_Search_Time OR (k = oldk AND LEN(Help_Search_Str) = 1) THEN
IF k = oldk THEN norep = 1
Help_Search_Str = K$
ELSE
Help_Search_Str = Help_Search_Str + K$
END IF
Help_Search_Time = t#
'search for next appropriate link
delsrchagain:
ox = Help_cx
oy = Help_cy
IF oy > help_h THEN oy = 1
cy = oy
cx = ox
IF norep = 1 THEN cx = cx + 1
looped = 0
DO
'build the line
l = CVL(MID$(Help_Line$, (cy - 1) * 4 + 1, 4))
x = l
a$ = ""
c = ASC(Help_Txt$, x)
DO UNTIL c = 13
lnk = CVI(MID$(Help_Txt$, x + 2, 2))
IF lnk THEN a$ = a$ + CHR$(c) ELSE a$ = a$ + CHR$(0) 'only add text with links
x = x + 4: c = ASC(Help_Txt$, x)
LOOP
helpscanrow:
px = INSTR(cx, UCASE$(a$), UCASE$(Help_Search_Str))
px2 = INSTR(cx, UCASE$(a$), UCASE$("_" + Help_Search_Str))
IF px2 < px AND px2 <> 0 AND LEFT$(Help_Search_Str, 1) <> "_" THEN px = px2
IF looped = 1 AND cy = oy AND px = 0 THEN GOTO strnotfound
IF px THEN
'isolate and REVERSE select link
l = CVL(MID$(Help_Line$, (cy - 1) * 4 + 1, 4))
x = l
x2 = 1
a$ = ""
c = ASC(Help_Txt$, x)
oldlnk = 0
lnkx1 = 0: lnkx2 = 0
DO UNTIL c = 13
lnk = CVI(MID$(Help_Txt$, x + 2, 2))
IF lnkx1 = 0 AND lnk <> 0 AND oldlnk = 0 AND px = x2 THEN lnkx1 = x2
IF lnkx1 <> 0 AND lnk = 0 AND lnkx2 = 0 THEN lnkx2 = x2 - 1
x = x + 4: c = ASC(Help_Txt$, x)
x2 = x2 + 1
oldlnk = lnk
LOOP
IF Back_Name$(Help_Back_Pos) = "Alphabetical" OR Back_Name$(Help_Back_Pos) = "By Usage" THEN
IF lnkx1 <> 3 THEN
cx = px + 1
GOTO helpscanrow
END IF
END IF
IF lnkx1 THEN
IF lnkx2 = 0 THEN lnkx2 = x2 - 1
Help_Select = 2
Help_cx1 = lnkx2 + 1
Help_cx = lnkx1
Help_cy = cy
Help_cy1 = cy
GOTO foundsstr
END IF
cx = px + 1
GOTO helpscanrow
END IF
cx = 1
cy = cy + 1
IF cy > help_h THEN cy = 1: looped = 1
LOOP
END IF
END IF
foundsstr:
strnotfound:
IF KB = KEY_HOME AND KCONTROL THEN
Help_cx = 1: Help_cy = 1
END IF
IF KB = KEY_END AND KCONTROL THEN
Help_cx = 1: Help_cy = help_h + 1
END IF
IF KB = KEY_HOME AND KCONTROL = 0 THEN Help_cx = 1
IF KB = KEY_END AND KCONTROL = 0 THEN
Help_cx = Help_LineLen(Help_cy - Help_sy) + 1
END IF
IF KB = KEY_PAGEUP THEN
Help_cy = Help_cy - (Help_wh - 1)
END IF
IF KB = KEY_PAGEDOWN THEN
Help_cy = Help_cy + (Help_wh - 1)
END IF
IF KB = KEY_DOWN THEN Help_cy = Help_cy + 1
IF KB = KEY_UP THEN Help_cy = Help_cy - 1
IF KB = KEY_LEFT THEN Help_cx = Help_cx - 1
IF KB = KEY_RIGHT THEN Help_cx = Help_cx + 1
'move relative to top/bottom
IF mWHEEL < 0 THEN Help_cy = Help_sy
IF mWHEEL > 0 THEN Help_cy = Help_sy + (Help_wh - 1)
Help_cy = Help_cy + mWHEEL * 3
'fix cursor
IF Help_cx < 1 THEN Help_cx = 1
IF Help_cx > help_w + 1 THEN Help_cx = help_w + 1
IF Help_cy < 1 THEN Help_cy = 1
IF Help_cy > help_h + 1 THEN Help_cy = help_h + 1
'screen follows cursor
IF Help_cx < Help_sx THEN Help_sx = Help_cx
IF Help_cx >= Help_sx + Help_ww THEN Help_sx = Help_cx - Help_ww + 1
IF Help_cy < Help_sy THEN Help_sy = Help_cy
IF Help_cy >= Help_sy + Help_wh THEN Help_sy = Help_cy - Help_wh + 1
'fix screen
IF Help_sx < 1 THEN Help_sx = 1
IF Help_sy < 1 THEN Help_sy = 1
IF K$ = CHR$(8) THEN
IF Help_Back_Pos > 1 THEN
Help_Back(Help_Back_Pos).sx = Help_sx 'update position
Help_Back(Help_Back_Pos).sy = Help_sy
Help_Back(Help_Back_Pos).cx = Help_cx
Help_Back(Help_Back_Pos).cy = Help_cy
Help_Back_Pos = Help_Back_Pos - 1
Help_Select = 0: Help_MSelect = 0
Help_sx = Help_Back(Help_Back_Pos).sx
Help_sy = Help_Back(Help_Back_Pos).sy
Help_cx = Help_Back(Help_Back_Pos).cx
Help_cy = Help_Back(Help_Back_Pos).cy
a$ = Wiki$(Back$(Help_Back_Pos))
WikiParse a$
GOTO newpageparsed
END IF
END IF
IF Help_cy >= 1 AND Help_cy <= help_h THEN
l = CVL(MID$(Help_Line$, (Help_cy - 1) * 4 + 1, 4))
x = l
x2 = 1
c = ASC(Help_Txt$, x)
DO UNTIL c = 13
IF x2 = Help_cx THEN
lnk = CVI(MID$(Help_Txt$, x + 2, 2))
IF lnk THEN
'retrieve lnk info
l1 = 1
FOR lx = 1 TO lnk - 1
l1 = INSTR(l1, Help_Link$, Help_Link_Sep$) + 1
NEXT
l2 = INSTR(l1, Help_Link$, Help_Link_Sep$) - 1
l$ = MID$(Help_Link$, l1, l2 - l1 + 1)
IF mCLICK OR K$ = CHR$(13) THEN
mCLICK = 0
IF LEFT$(l$, 5) = "EXTL:" THEN
IF (K$ = CHR$(13)) OR (mY = Help_cy - Help_sy + Help_wy1 AND mX = Help_cx - Help_sx + Help_wx1) THEN
l$ = RIGHT$(l$, LEN(l$) - 5)
l$ = StrReplace$(l$, " ", "%20")
l$ = StrReplace$(l$, "&", "%26")
IF INSTR(_OS$, "WIN") = 0 THEN
l$ = StrReplace$(l$, "$", "\$")
l$ = StrReplace$(l$, "&", "\&")
l$ = StrReplace$(l$, "(", "\(")
l$ = StrReplace$(l$, ")", "\)")
END IF
IF INSTR(_OS$, "WIN") THEN
SHELL _HIDE _DONTWAIT "start " + l$
ELSEIF INSTR(_OS$, "MAC") THEN
SHELL _HIDE _DONTWAIT "open " + l$
ELSE
SHELL _HIDE _DONTWAIT "xdg-open " + l$
END IF
END IF
GOTO specialchar
ELSEIF LEFT$(l$, 5) = "PAGE:" THEN
l$ = RIGHT$(l$, LEN(l$) - 5)
IF Back$(Help_Back_Pos) <> l$ THEN
Help_Select = 0: Help_MSelect = 0
'COLOR 7, 0
Help_Back(Help_Back_Pos).sx = Help_sx 'update position
Help_Back(Help_Back_Pos).sy = Help_sy
Help_Back(Help_Back_Pos).cx = Help_cx
Help_Back(Help_Back_Pos).cy = Help_cy
top = UBOUND(back$)
IF Help_Back_Pos < top THEN
IF Back$(Help_Back_Pos + 1) = l$ THEN
GOTO usenextentry
END IF
END IF
top = top + 1
REDIM _PRESERVE Back(top) AS STRING
REDIM _PRESERVE Help_Back(top) AS Help_Back_Type
REDIM _PRESERVE Back_Name(top) AS STRING
'Shuffle array upwards after current pos
FOR x = top - 1 TO Help_Back_Pos + 1 STEP -1
Back_Name$(x + 1) = Back_Name$(x)
Back$(x + 1) = Back$(x)
Help_Back(x + 1).sx = Help_Back(x).sx
Help_Back(x + 1).sy = Help_Back(x).sy
Help_Back(x + 1).cx = Help_Back(x).cx
Help_Back(x + 1).cy = Help_Back(x).cy
NEXT
usenextentry:
Help_Back_Pos = Help_Back_Pos + 1
Back$(Help_Back_Pos) = l$
Back_Name$(Help_Back_Pos) = Back2BackName$(l$)
Help_Back(Help_Back_Pos).sx = 1
Help_Back(Help_Back_Pos).sy = 1
Help_Back(Help_Back_Pos).cx = 1
Help_Back(Help_Back_Pos).cy = 1
Help_sx = 1: Help_sy = 1: Help_cx = 1: Help_cy = 1
a$ = Wiki$(l$)
WikiParse a$
GOTO newpageparsed
END IF
END IF
END IF
END IF
END IF
x = x + 4: c = ASC(Help_Txt$, x)
x2 = x2 + 1
LOOP
END IF
IF Help_Select THEN
Help_Select = 1 'revert to non-selected if cursor moved to neutral pos
IF Help_cx <> Help_cx1 OR Help_cy <> Help_cy1 THEN Help_Select = 2
END IF
'Determine the exact region selected
IF Help_Select = 2 THEN
IF Help_cy = Help_cy1 THEN
Help_SelY1 = Help_cy: Help_SelY2 = Help_cy
IF Help_cx > Help_cx1 THEN
Help_SelX1 = Help_cx1: Help_SelX2 = Help_cx - 1
ELSE
Help_SelX1 = Help_cx: Help_SelX2 = Help_cx1 - 1
END IF
ELSE
Help_SelX1 = 1: Help_SelX2 = 10000000
IF Help_cy > Help_cy1 THEN
Help_SelY1 = Help_cy1: Help_SelY2 = Help_cy
IF Help_cx = 1 THEN Help_SelY2 = Help_cy - 1
ELSE
Help_SelY1 = Help_cy: Help_SelY2 = Help_cy1
END IF
END IF
END IF
newpageparsed:
GOTO specialchar
END IF
IF KB = KEY_F1 THEN
contextualhelp:
IdeContextHelpSF = 0
'identify word or character at current cursor position
a2$ = UCASE$(getWordAtCursor$)
lnks = 0
lnks$ = findHelpTopic$(a2$, lnks, 0)
IF lnks THEN
lnks$ = MID$(lnks$, 2, LEN(lnks$) - 2)
lnk$ = lnks$
IF lnks > 1 THEN
'clarify context
lnk$ = idef1box$(lnks$, lnks)
IF lnk$ = "C" THEN GOTO ideloop
END IF
IF INSTR(UCASE$(lnk$), "PARENTHESIS") THEN GOTO ideloop
OpenHelpLnk:
Help_Back(Help_Back_Pos).sx = Help_sx 'update position
Help_Back(Help_Back_Pos).sy = Help_sy
Help_Back(Help_Back_Pos).cx = Help_cx
Help_Back(Help_Back_Pos).cy = Help_cy
top = UBOUND(back$)
IF Back$(Help_Back_Pos) = lnk$ THEN Help_Back_Pos = Help_Back_Pos - 1: GOTO usenextentry2
IF Help_Back_Pos < top THEN
IF Back$(Help_Back_Pos + 1) = lnk$ THEN
GOTO usenextentry2
END IF
END IF
top = top + 1
REDIM _PRESERVE Back(top) AS STRING
REDIM _PRESERVE Help_Back(top) AS Help_Back_Type
REDIM _PRESERVE Back_Name(top) AS STRING
'Shuffle array upwards after current pos
FOR x = top - 1 TO Help_Back_Pos + 1 STEP -1
Back_Name$(x + 1) = Back_Name$(x)
Back$(x + 1) = Back$(x)
Help_Back(x + 1).sx = Help_Back(x).sx
Help_Back(x + 1).sy = Help_Back(x).sy
Help_Back(x + 1).cx = Help_Back(x).cx
Help_Back(x + 1).cy = Help_Back(x).cy
NEXT
usenextentry2:
Help_Back_Pos = Help_Back_Pos + 1
Back$(Help_Back_Pos) = lnk$
Back_Name$(Help_Back_Pos) = Back2BackName$(lnk$)
Help_Back(Help_Back_Pos).sx = 1
Help_Back(Help_Back_Pos).sy = 1
Help_Back(Help_Back_Pos).cx = 1
Help_Back(Help_Back_Pos).cy = 1
Help_sx = 1: Help_sy = 1: Help_cx = 1: Help_cy = 1
a$ = Wiki$(lnk$)
IF idehelp = 0 THEN
IF idesubwindow THEN PCOPY 3, 0: SCREEN , , 3, 0: GOTO ideloop
idesubwindow = idewy \ 2: idewy = idewy - idesubwindow
Help_wx1 = 2: Help_wy1 = idewy + 1: Help_wx2 = idewx - 1: Help_wy2 = idewy + idesubwindow - 2: Help_ww = Help_wx2 - Help_wx1 + 1: Help_wh = Help_wy2 - Help_wy1 + 1
WikiParse a$
idehelp = 1
skipdisplay = 0
IdeSystem = 3
retval = 1
ELSE
WikiParse a$
IdeSystem = 3
END IF
GOSUB redrawitall
GOTO specialchar
ELSE
'No help found; Does the user want help for a SUB or FUNCTION?
a2$ = LTRIM$(RTRIM$(a2$))
IF LEN(a2$) THEN
DO UNTIL alphanumeric(ASC(RIGHT$(a2$, 1)))
a2$ = LEFT$(a2$, LEN(a2$) - 1) 'removes sigil, if any
IF LEN(a2$) = 0 THEN GOTO NoKeywordFound
LOOP
FOR y = 1 TO iden
a$ = idegetline(y)
a$ = LTRIM$(RTRIM$(a$))
sf = 0
nca$ = UCASE$(a$)
IF LEFT$(nca$, 4) = "SUB " THEN sf = 1: sf$ = "SUB "
IF LEFT$(nca$, 9) = "FUNCTION " THEN sf = 2: sf$ = "FUNCTION "
IF sf THEN
IF RIGHT$(nca$, 7) = " STATIC" THEN
a$ = RTRIM$(LEFT$(a$, LEN(a$) - 7))
END IF
IF sf = 1 THEN
a$ = RIGHT$(a$, LEN(a$) - 4)
ELSE
a$ = RIGHT$(a$, LEN(a$) - 9)
END IF
a$ = LTRIM$(RTRIM$(a$))
x = INSTR(a$, "(")
IF x THEN
n$ = RTRIM$(LEFT$(a$, x - 1))
args$ = RIGHT$(a$, LEN(a$) - x + 1)
x = INSTR(args$, ")"): IF x THEN args$ = LEFT$(args$, x)
ELSE
n$ = a$
args$ = ""
cleanSubName n$
END IF
backupn$ = n$
DO UNTIL alphanumeric(ASC(RIGHT$(n$, 1)))
n$ = LEFT$(n$, LEN(n$) - 1) 'removes sigil, if any
LOOP
IF UCASE$(n$) = a2$ THEN
a$ = "{{DISPLAYTITLE:agp@" + backupn$ + "}}" + CHR$(10)
a$ = a$ + "This is a subroutine or function that is used in your program as follows:" + CHR$(10)
a$ = a$ + CHR$(10) + CHR$(10) + "{{PageSyntax}}" + CHR$(10)
a$ = a$ + ": [[" + LEFT$(sf$, LEN(sf$) - 1) + "]] '''" + backupn$ + "''' " + args$ + CHR$(10)
a$ = a$ + CHR$(10) + CHR$(10) + "{{PageSeeAlso}}" + CHR$(10)
a$ = a$ + "* [[Sub (explanatory)]]" + CHR$(10)
a$ = a$ + "* [[Function (explanatory)]]" + CHR$(10)
IdeContextHelpSF = -1
IF idehelp = 0 THEN
IF idesubwindow THEN PCOPY 3, 0: SCREEN , , 3, 0: GOTO ideloop
idesubwindow = idewy \ 2: idewy = idewy - idesubwindow
Help_wx1 = 2: Help_wy1 = idewy + 1: Help_wx2 = idewx - 1: Help_wy2 = idewy + idesubwindow - 2: Help_ww = Help_wx2 - Help_wx1 + 1: Help_wh = Help_wy2 - Help_wy1 + 1
WikiParse a$
idehelp = 1
skipdisplay = 0
IdeSystem = 3
retval = 1
END IF
WikiParse a$
IdeSystem = 3
GOSUB redrawItAll
GOTO specialchar
EXIT FOR
END IF
END IF
NEXT
END IF
NoKeywordFound:
END IF 'lnks
GOTO specialchar
END IF
IF KALT AND KB = KEY_LEFT THEN
bmkremoved = 0
bmkremove:
FOR b = 1 TO IdeBmkN
IF IdeBmk(b).y = idecy THEN
FOR b2 = b TO IdeBmkN - 1
IdeBmk(b2) = IdeBmk(b2 + 1)
NEXT
IdeBmkN = IdeBmkN - 1
bmkremoved = 1
ideunsaved = 1
GOTO bmkremove
END IF
NEXT
IF bmkremoved = 0 THEN
IdeBmkN = IdeBmkN + 1
IF IdeBmkN > UBOUND(IdeBmk) THEN x = UBOUND(IdeBmk) * 2: REDIM _PRESERVE IdeBmk(x) AS IdeBmkType
IdeBmk(IdeBmkN).y = idecy
IdeBmk(IdeBmkN).x = idecx
IdeBmk(IdeBmkN).reserved = 0: IdeBmk(IdeBmkN).reserved2 = 0
ideunsaved = 1
END IF
GOTO specialchar
END IF
IF KALT AND (KB = KEY_DOWN OR KB = KEY_UP) THEN
IF IdeBmkN = 0 THEN
result = idemessagebox("Bookmarks", "No bookmarks exist (Use Alt+Left to create a bookmark)", "")
SCREEN , , 3, 0
idealthighlight = 0
LOCATE , , 0: COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
GOTO specialchar
END IF
IF IdeBmkN = 1 THEN
IF idecy = IdeBmk(1).y THEN
result = idemessagebox("Bookmarks", "No other bookmarks exist", "")
SCREEN , , 3, 0
idealthighlight = 0
LOCATE , , 0: COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
GOTO specialchar
END IF
END IF
l = idecy
DO
IF KB = KEY_DOWN THEN l = l + 1 ELSE l = l - 1
IF l < 1 THEN l = iden
IF l > iden THEN l = 1
FOR b = 1 TO IdeBmkN
IF IdeBmk(b).y = l THEN EXIT DO
NEXT
LOOP
AddQuickNavHistory
idecy = l
idecx = IdeBmk(b).x
ideselect = 0
idecentercurrentline
GOTO specialchar
END IF
IF KALT AND KB = KEY_RIGHT THEN
'***RESERVED***
GOTO specialchar
END IF
IF KALT AND KB >= 48 AND KB <= 57 THEN GOTO specialchar ' Steve Edit on 07-04-2014 to add support for ALT-numkey combos to produce ASCII codes
IF ideselect = 1 AND wholeword.select < 0 AND mY = old.mY THEN
'Mouse button has been held down since the last double-click word selection
'and the user has moved the mouse only horizontally. Attempt to keep
'selecting words to the left or right.
IF wholeword.select = -2 THEN
'we had a snap selection but moved up or down.
'now we're back in the same line.
wholeword.select = -1
idemouseselect = 0
ideselectx1 = wholeword.selectx1
idecx = wholeword.idecx
ideselecty1 = wholeword.selecty1
idecy = wholeword.idecy
END IF
newposition = (mX - 1 + idesx - 1) - maxLineNumberLength
a$ = idegetline$(idecy)
IF newposition > LEN(a$) THEN idecx = newposition: GOTO DoneWholeWord
IF newposition = 1 THEN ideselectx1 = 1: GOTO DoneWholeWord
char.clicked$ = MID$(a$, newposition, 1)
IF LEN(char.clicked$) > 0 THEN
IF newposition < wholeword.idecx THEN
'To the left, to the left.
FOR i = newposition TO 1 STEP -1
IF INSTR(char.sep$, MID$(a$, i, 1)) THEN EXIT FOR
NEXT i
ideselectx1 = i + 1
ELSEIF newposition > wholeword.selectx1 THEN
'To the right.
FOR i = newposition TO LEN(a$)
IF INSTR(char.sep$, MID$(a$, i, 1)) THEN EXIT FOR
NEXT i
idecx = i
END IF
END IF
ELSEIF ideselect = 1 AND wholeword.select = -1 AND mY <> old.mY THEN
idemouseselect = 1
wholeword.select = -2
END IF
IF mCLICK THEN
IF mX > 1 + maxLineNumberLength AND mX < idewx AND mY > 2 AND mY < (idewy - 5) THEN 'inside text box
IF old.mX = mX AND old.mY = mY THEN
IF timeElapsedSince(last.TBclick#) > .5 THEN GOTO regularTextBox_click
'Double-click on text box: attempt to select "word" clicked
idecx = (mX - 1 + idesx - 1) - maxLineNumberLength
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN
GOTO regularTextBox_click
ELSEIF ActiveINCLUDELink > 0 THEN
'Double-click on an $INCLUDE statement launches that file in
'a separate instance of QB64:
p$ = idepath$ + pathsep$
f$ = p$ + ActiveINCLUDELinkFile
IF _FILEEXISTS(f$) = 0 THEN f$ = ActiveINCLUDELinkFile
IF _FILEEXISTS(f$) THEN
backupIncludeFile = FREEFILE
OPEN f$ FOR BINARY AS #backupIncludeFile
tempInclude1$ = SPACE$(LOF(backupIncludeFile))
GET #backupIncludeFile, 1, tempInclude1$
CLOSE #backupIncludeFile
SCREEN , , 3, 0
clearStatusWindow 0
COLOR 15, 1
_PRINTSTRING (2, idewy - 3), "Editing $INCLUDE file..."
dummy = DarkenFGBG(1)
PCOPY 3, 0
_DELAY .2
p$ = QuotedFilename$(COMMAND$(0)) + " " + QuotedFilename$(f$)
IF errorLineInInclude > 0 AND idefocusline = idecy THEN
p$ = p$ + " -l:" + str2$(errorLineInInclude)
ELSEIF warningInIncludeLine > 0 AND warningInInclude = idecy THEN
p$ = p$ + " -l:" + str2$(warningInIncludeLine)
END IF
SHELL p$
OPEN f$ FOR BINARY AS #backupIncludeFile
tempInclude2$ = SPACE$(LOF(backupIncludeFile))
GET #backupIncludeFile, 1, tempInclude2$
CLOSE #backupIncludeFile
dummy = DarkenFGBG(0)
clearStatusWindow 0
IF tempInclude1$ = tempInclude2$ THEN
IF IDEShowErrorsImmediately THEN
IF idecompiling = 1 THEN
_PRINTSTRING (2, idewy - 3), STRING$(3, 250) '"..."
ELSE
_PRINTSTRING (2, idewy - 3), "OK" 'report OK status
statusarealink = 0
IF totalWarnings > 0 THEN
COLOR 11, 1
msg$ = " (" + LTRIM$(STR$(totalWarnings)) + " warning"
IF totalWarnings > 1 THEN msg$ = msg$ + "s"
msg$ = msg$ + " - click here or Ctrl+W to view)"
_PRINTSTRING (4, idewy - 3), msg$
statusarealink = 4
END IF
IF waitingForVarList THEN GOSUB showVarListReady
END IF
END IF
ELSE
idechangemade = 1
startPausedPending = 0
END IF
PCOPY 3, 0
tempInclude1$ = ""
tempInclude2$ = ""
END IF
ELSE
a$ = idegetline$(idecy)
IF LEN(a$) = 0 THEN GOTO regularTextBox_click
char.clicked$ = MID$(a$, idecx, 1)
ideselect = 1
ideselecty1 = idecy
IF LEN(char.clicked$) > 0 AND char.clicked$ <> CHR$(32) THEN
FOR i = idecx TO 1 STEP -1
IF INSTR(char.sep$, MID$(a$, i, 1)) THEN EXIT FOR
NEXT i
ideselectx1 = i + 1
wholeword.selectx1 = ideselectx1
FOR i = idecx TO LEN(a$)
IF INSTR(char.sep$, MID$(a$, i, 1)) THEN EXIT FOR
NEXT i
idecx = i
wholeword.idecx = idecx
wholeword.select = -1
wholeword.idecy = idecy
wholeword.selecty1 = ideselecty1
END IF
END IF
ELSE
regularTextBox_click:
old.mX = mX: old.mY = mY: last.TBclick# = TIMER
ideselect = 1
idecx = (mX - 1 + idesx - 1) - maxLineNumberLength
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN idecy = iden
ideselect = 1
IF (NOT KSHIFT) THEN ideselectx1 = idecx: ideselecty1 = idecy
idemouseselect = 1
wholeword.select = 0
END IF
ELSEIF (mX > 1 AND mX <= 1 + maxLineNumberLength AND mY > 2 AND mY < (idewy - 5) AND ShowLineNumbers) OR _
(mX = 1 AND mY > 2 AND mY < (idewy - 5) AND ShowLineNumbers = 0) THEN
'line numbers are visible and have been clicked or
'line numbers are hidden and the left border has been clicked
IF AutoAddDebugCommand <> 0 OR vWatchOn <> 0 THEN
ideselect = 0
idecytemp = mY - 2 + idesy - 1
IF idecytemp =< iden THEN
idecy = idecytemp
IF _KEYDOWN(100304) OR _KEYDOWN(100303) THEN
GOTO toggleSkipLine
ELSE
GOTO toggleBreakpoint
END IF
END IF
ELSE
ideselect = 1
idecy = mY - 2 + idesy - 1
IF idecy < iden THEN
IF (NOT KSHIFT) THEN ideselectx1 = 1: ideselecty1 = idecy
idecy = idecy + 1
idecx = 1
ELSEIF idecy = iden THEN
a$ = idegetline$(idecy)
IF (NOT KSHIFT) THEN ideselectx1 = 1: ideselecty1 = idecy
idecx = LEN(a$) + 1
ELSEIF idecy > iden THEN
idecy = iden
ideselect = 0
idecx = 1
END IF
wholeword.select = 0
idemouseselect = 0
END IF
END IF
END IF
DoneWholeWord:
IF mCLICK2 THEN 'Second mouse button pressed.
invokecontextualmenu:
IF mX > 1 + maxLineNumberLength AND mX < idewx AND mY > 2 AND mY < (idewy - 5) THEN 'inside text box
IdeSystem = 1
IF ideselect = 0 THEN 'Right click only positions the cursor if no selection is active
idecx = (mX - 1 + idesx - 1) - maxLineNumberLength
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN idecy = iden
ELSE 'A selection is reported but it may be that the user only clicked the screen. Let's check:
IF ideselecty1 = idecy THEN 'single line selected
a$ = idegetline(idecy)
a2$ = ""
sx1 = ideselectx1: sx2 = idecx
IF sx2 < sx1 THEN SWAP sx1, sx2
FOR x = sx1 TO sx2 - 1
IF x <= LEN(a$) THEN a2$ = a2$ + MID$(a$, x, 1) ELSE a2$ = a2$ + " "
NEXT
IF a2$ = "" THEN
'Told ya.
ideselect = 0
idecx = (mX - 1 + idesx - 1) - maxLineNumberLength
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN idecy = iden
ELSE
'Ok, there is a selection. But we'll override it if the click was outside it
IF (mX - 1 + idesx - 1) - maxLineNumberLength < sx1 OR (mX - 1 + idesx - 1) - maxLineNumberLength > sx2 THEN
ideselect = 0
idecx = (mX - 1 + idesx - 1) - maxLineNumberLength
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN idecy = iden
END IF
IF mY - 2 + idesy - 1 < idecy OR mY - 2 + idesy - 1 > idecy THEN
ideselect = 0
idecx = (mX - 1 + idesx - 1) - maxLineNumberLength
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN idecy = iden
END IF
END IF
ELSE 'Multiple lines selected
'We'll override the selection if the click was outside it
sy1 = ideselecty1
sy2 = idecy
IF sy1 > sy2 THEN SWAP sy1, sy2
IF mY - 2 + idesy - 1 < sy1 OR mY - 2 + idesy - 1 > sy2 THEN
ideselect = 0
idecx = (mX - 1 + idesx - 1) - maxLineNumberLength
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN idecy = iden
END IF
END IF
END IF
ideshowtext
PCOPY 3, 0
IdeMakeContextualMenu
idecontextualmenu = 1
GOTO showmenu
ELSEIF idehelp = 1 AND mY >= idewy AND mY < idewy + idesubwindow THEN 'inside help area
IdeSystem = 3
ideshowtext
PCOPY 3, 0
IdeMakeContextualMenu
idecontextualmenu = 1
GOTO showmenu
END IF
END IF
IF mCLICK THEN
IF mX = idewx THEN
IF iden > 1 THEN 'take no action if not slider available
y = idevbar(idewx, 3, idewy - 8, idecy, iden)
IF y = mY THEN
idemouseselect = 2
ideselect = 0
END IF
END IF
END IF
END IF
IF mCLICK THEN
IF mY = idewy - 5 THEN
x = idehbar(2, idewy - 5, idewx - 2, idesx, 608)
IF x = mX THEN
idemouseselect = 3
ideselect = 0
END IF
END IF
END IF
IF mB AND idemouseselect = 0 THEN
IF mX = idewx AND mY > 2 AND mY < idewy - 5 THEN 'inside vbar
ideselect = 0
IF mY = 3 THEN KB = KEY_UP: idewait: idembmonitor = 1
IF mY = idewy - 6 THEN KB = KEY_DOWN: idewait: idembmonitor = 1
IF mY > 3 AND mY < (idewy - 6) THEN
'assume not on slider
IF iden > 1 THEN 'take no action if not slider available
y = idevbar(idewx, 3, idewy - 8, idecy, iden)
IF y <> mY THEN
IF mY < y THEN
KB = KEY_PAGEUP: idewait: idembmonitor = 1
ELSE
KB = KEY_PAGEDOWN: idewait: idembmonitor = 1
END IF
END IF
END IF
END IF
END IF
END IF
IF mB AND idemouseselect = 0 THEN
IF mY = idewy - 5 AND mX > 1 AND mX < idewx THEN 'inside hbar
ideselect = 0
IF mX = 2 THEN KB = KEY_LEFT: idewait: idembmonitor = 1
IF mX = idewx - 1 THEN KB = KEY_RIGHT: idewait: idembmonitor = 1
IF mX > 2 AND mX < idewx - 1 THEN
'assume not on slider
x = idehbar(2, idewy - 5, idewx - 2, idesx, 608)
IF x <> mX THEN
IF mX < x THEN
idecx = idecx - 8
IF idecx < 1 THEN idecx = 1
idewait: idembmonitor = 1
ELSE
idecx = idecx + 8
idewait: idembmonitor = 1
END IF
END IF
END IF
END IF
END IF
IF mB AND idemouseselect = 2 THEN
'move vbar scroller (idecy) to appropriate position
IF iden > 1 THEN
IF mY <= 4 THEN idecy = 1
IF mY >= idewy - 7 THEN idecy = iden
IF mY > 4 AND mY < idewy - 7 THEN
y = mY
p! = y - 3 - 2 + .5
p! = p! / ((idewy - 8) - 4)
i = p! * (iden - 1) + 1
idecy = i
END IF
END IF
END IF
IF mB AND idemouseselect = 3 THEN
'move hbar scroller (idecx) to appropriate position
IF mX <= 3 THEN idesx = 1: idecx = idesx
IF mX >= idewx - 2 THEN idesx = 608: idecx = idesx
IF mX > 3 AND mX < idewx - 2 THEN
x = mX
p! = x - 2 - 2 + .5
p! = p! / ((idewx - 2) - 4)
i = p! * (608 - 1) + 1
idesx = i
idecx = idesx
END IF
END IF
IF mB AND idemouseselect <= 1 THEN
IF mX > 1 + maxLineNumberLength AND mX < idewx AND mY > 2 AND mY < idewy - 5 THEN 'inside text box
IF idemouseselect = 1 THEN
idecx = (mX - 1 + idesx - 1) - maxLineNumberLength
IF idecx < 1 THEN idecx = 1
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN idecy = iden
END IF
END IF
END IF
IF mB THEN
IF ((mX = 1 AND ShowLineNumbers = 0) OR (mX <= 1 + maxLineNumberLength AND ShowLineNumbers)) OR mX = idewx OR mY <= 2 OR mY >= idewy - 5 THEN 'off text window area
IF idemouseselect = 1 THEN
'scroll window
IF mY >= idewy - 5 THEN idecy = idecy + 1: IF idecy > iden THEN idecy = iden
IF mY <= 2 THEN idecy = idecy - 1: IF idecy < 1 THEN idecy = 1
IF ((mX = 1 AND ShowLineNumbers = 0) OR (mX <= 1 + maxLineNumberLength AND ShowLineNumbers)) THEN idecx = idecx - 1: IF idecx < 1 THEN idecx = 1
IF mX = idewx THEN idecx = idecx + 1
idewait
END IF
END IF
END IF
IF KCONTROL AND UCASE$(K$) = "A" THEN 'select all
idemselectall:
ideselect = 1: ideselectx1 = 1: ideselecty1 = 1
idecy = iden
a$ = idegetline(idecy)
idecx = LEN(a$) + 1
GOTO specialchar
END IF
IF KCONTROL AND UCASE$(K$) = "G" THEN 'goto line
IF KSHIFT AND idefocusline > 0 THEN
idecx = 1
AddQuickNavHistory
idecy = idefocusline
ideselect = 0
ELSE
idegotobox
'retval is ignored
PCOPY 3, 0: SCREEN , , 3, 0
END IF
GOTO specialchar
END IF
IF KCONTROL AND UCASE$(K$) = "N" THEN 'File -> #New
GOTO ctrlNew
END IF
IF KCONTROL AND UCASE$(K$) = "O" THEN 'File -> #Open
IdeOpenFile$ = ""
GOTO ctrlOpen
END IF
IF KCONTROL AND UCASE$(K$) = "P" THEN 'Debug -> Toggle Skip Line
GOTO toggleSkipLine
END IF
IF (NOT KSHIFT) AND KCONTROL AND UCASE$(K$) = "R" THEN 'Comment (add ') - R for REMark
GOTO ctrlAddComment
END IF
IF (NOT KSHIFT) AND KCONTROL AND UCASE$(K$) = "T" THEN 'Toggle comment
GOTO ctrlToggleComment
END IF
IF KSHIFT AND KCONTROL AND UCASE$(K$) = "R" THEN 'uncomment (remove ')
GOTO ctrlRemoveComment
END IF
IF KCONTROL AND UCASE$(K$) = "S" THEN 'File -> #Save
IF ideprogname = "" THEN
ProposedTitle$ = FindProposedTitle$
IF ProposedTitle$ = "" THEN
a$ = idefiledialog$("untitled" + tempfolderindexstr$ + ".bas", 2)
ELSE
a$ = idefiledialog$(ProposedTitle$ + ".bas", 2)
END IF
IF ideerror > 1 THEN PCOPY 3, 0: SCREEN , , 3, 0: GOTO IDEerrorMessage
ELSE
idesave idepath$ + idepathsep$ + ideprogname$
END IF
PCOPY 3, 0: SCREEN , , 3, 0: GOTO ideloop
END IF
IF K$ = CHR$(0) + CHR$(60) THEN 'F2
IF KCONTROL THEN
IF QuickNavTotal > 0 THEN
ideselect = 0
idecy = QuickNavHistory(QuickNavTotal).idecy
idecx = QuickNavHistory(QuickNavTotal).idecx
idesy = QuickNavHistory(QuickNavTotal).idesy
idesx = QuickNavHistory(QuickNavTotal).idesx
QuickNavTotal = QuickNavTotal - 1
GOTO ideloop
END IF
ELSE
GOTO idesubsjmp
END IF
END IF
IF KCONTROL AND UCASE$(K$) = "W" THEN 'goto line
IF totalWarnings > 0 THEN
retval = idewarningbox
'retval is ignored
PCOPY 3, 0: SCREEN , , 3, 0
GOTO specialchar
ELSE
result = idemessagebox("Compilation status", "No warnings to display.", "")
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
IF KCONTROL AND UCASE$(K$) = "Z" THEN 'undo (CTRL+Z)
idemundo:
IF ideundopos THEN
OPEN tmpdir$ + "undo2.bin" FOR BINARY AS #150
h$ = SPACE$(12): GET #150, , h$: p1 = CVL(MID$(h$, 1, 4)): p2 = CVL(MID$(h$, 5, 4)): plast = CVL(MID$(h$, 9, 4))
'does something exist to undo?
u = 0
IF p2 >= p1 THEN
'linear
IF ideundopos > p1 THEN
GET #150, ideundopos - 4, upl
u = ideundopos - 4 - upl - 4
END IF
ELSE
'wrapped
IF ideundopos > p1 THEN
GET #150, ideundopos - 4, upl
u = ideundopos - 4 - upl - 4
END IF
IF ideundopos <= p2 THEN
IF ideundopos = 13 THEN
u = plast
ELSE
GET #150, ideundopos - 4, upl
u = ideundopos - 4 - upl - 4
END IF
END IF
END IF
IF u THEN
IF ideundopos = ideundobase THEN
'if not untitled, then we MUST switch to a special state
'warn
PCOPY 3, 0
what$ = ideyesnobox("Undo", "Undo through previous program content?")
PCOPY 3, 0: SCREEN , , 3, 0
IF what$ = "N" THEN
CLOSE #150
GOTO skipundo
END IF
IF ideunsaved = 1 AND ideprogname <> "" THEN
PCOPY 3, 0
r$ = IdeSaveNow$
PCOPY 3, 0: SCREEN , , 3, 0
IF r$ = "C" OR r$ = "H" THEN CLOSE #150: GOTO skipundo
IF r$ = "Y" THEN
idesave idepath$ + idepathsep$ + ideprogname$
END IF
END IF
ideunsaved = 1
ideprogname$ = ""
_TITLE WindowTitle
ideundobase = -1 'release base restriction
END IF
ideundopos = u 'set new current state
'get backup
SEEK #150, u
GET #150, , l2& 'should be the same as l&
GET #150, , idesx: GET #150, , idesy
GET #150, , idecx: GET #150, , idecy
GET #150, , ideselect: GET #150, , ideselectx1: GET #150, , ideselecty1
GET #150, , iden
GET #150, , idel
GET #150, , ideli
'bookmark info [v2]
GET #150, , IdeBmkN: REDIM IdeBmk(IdeBmkN + 1) AS IdeBmkType
FOR bi = 1 TO IdeBmkN: GET #150, , IdeBmk(bi).y: GET #150, , IdeBmk(bi).x: NEXT
GET #150, , x&: idet$ = SPACE$(x&): GET #150, , idet$
idechangemade = 1: idenoundo = 1: startPausedPending = 0
END IF 'u
skipundo:
CLOSE #150
END IF
GOTO specialchar
END IF
IF KCONTROL AND UCASE$(K$) = "Y" THEN 'redo (CTRL+Y)
idemredo:
IF ideundopos THEN
OPEN tmpdir$ + "undo2.bin" FOR BINARY AS #150
h$ = SPACE$(12): GET #150, , h$: p1 = CVL(MID$(h$, 1, 4)): p2 = CVL(MID$(h$, 5, 4)): plast = CVL(MID$(h$, 9, 4))
'does something exist to redo?
u = 0
IF p2 >= p1 THEN
'linear
IF ideundopos < p2 THEN
GET #150, ideundopos, upl
u = ideundopos + 4 + upl + 4
END IF
ELSE
'wrapped
IF ideundopos >= p1 THEN
IF ideundopos = plast THEN
u = 13
ELSE
GET #150, ideundopos, upl
u = ideundopos + 4 + upl + 4
END IF
ELSE
IF ideundopos < p2 THEN
GET #150, ideundopos, upl
u = ideundopos + 4 + upl + 4
END IF
END IF
END IF
IF u THEN
ideundopos = u 'set new current state
'get backup
SEEK #150, u
GET #150, , l2& 'should be the same as l&
GET #150, , idesx: GET #150, , idesy
GET #150, , idecx: GET #150, , idecy
GET #150, , ideselect: GET #150, , ideselectx1: GET #150, , ideselecty1
GET #150, , iden
GET #150, , idel
GET #150, , ideli
'bookmark info [v2]
GET #150, , IdeBmkN: REDIM IdeBmk(IdeBmkN + 1) AS IdeBmkType
FOR bi = 1 TO IdeBmkN: GET #150, , IdeBmk(bi).y: GET #150, , IdeBmk(bi).x: NEXT
GET #150, , x&: idet$ = SPACE$(x&): GET #150, , idet$
idechangemade = 1: idenoundo = 1: startPausedPending = 0
END IF 'u
CLOSE #150
END IF
GOTO specialchar
END IF
IF ((KSHIFT AND KB = KEY_DELETE) OR (KCONTROL AND UCASE$(K$) = "X")) AND ideselect = 1 THEN 'cut to clipboard
idemcut:
idechangemade = 1
startPausedPending = 0
GOTO copy2clip
END IF
IF (KB = KEY_DELETE OR KB = 8) AND ideselect = 1 THEN 'delete selection
IF ideselecty1 <> idecy OR ideselectx1 <> idecx THEN
idechangemade = 1
startPausedPending = 0
delselect
GOTO specialchar
ELSE
ideselect = 0
END IF
END IF
IF (KSHIFT AND KB = KEY_INSERT) OR (KCONTROL AND UCASE$(K$) = "V") THEN 'paste from clipboard
idempaste:
clip$ = _CLIPBOARD$ 'read clipboard
IF LEN(clip$) THEN
IF INSTR(clip$, CHR$(13)) OR INSTR(clip$, CHR$(10)) THEN
'full lines paste
IF ideselect THEN delselect
idelayoutallow = 2
a$ = clip$
x3 = 1 'scan from position
i = 0 'lines counter
fullpastenextline:
x = INSTR(x3, a$, CHR$(13))
x2 = INSTR(x3, a$, CHR$(10))
IF x = 0 THEN x = x2
IF x2 = 0 THEN x2 = x
IF x2 < x THEN SWAP x, x2
IF x2 > x + 1 THEN x2 = x 'if seperated by more than one character, they are seperate line terminators
'x to x2 is the range of the next line terminator (1 or 2 characters)
IF x THEN
ideinsline idecy + i, converttabs$(MID$(a$, x3, x - x3))
i = i + 1
x3 = x2 + 1
ELSE
ideinsline idecy + i, converttabs$(MID$(a$, x3, LEN(a$) - x3 + 1))
i = i + 1
x3 = LEN(a$) + 1
END IF
IF x3 <= LEN(a$) GOTO fullpastenextline
IF PasteCursorAtEnd THEN
'Place the cursor at the end of the pasted content:
idecy = idecy + i - 1
idecx = LEN(idegetline(idecy)) + 1
IF RIGHT$(clip$, 1) = CHR$(10) THEN
idecy = idecy + 1
idecx = 1
END IF
END IF
ELSE
'insert single line paste
insertAtCursor clip$
END IF
idechangemade = 1
startPausedPending = 0
END IF
GOTO specialchar
END IF
IF ((KCTRL AND KB = KEY_INSERT) OR (KCONTROL AND UCASE$(K$) = "C")) AND ideselect = 1 THEN 'copy to clipboard
copy2clip:
clip$ = getSelectedText$(-1)
IF clip$ <> "" THEN _CLIPBOARD$ = clip$
IF (K$ = CHR$(0) + "S") OR (KSHIFT AND KB = KEY_DELETE) OR (KCONTROL AND UCASE$(K$) = "X") THEN delselect
GOTO specialchar
END IF
IF KB = KEY_INSERT THEN 'toggle INSERT mode
ideinsert = ideinsert + 1
IF ideinsert = 2 THEN ideinsert = 0
END IF
IF KB = KEY_UP THEN
IF KCONTROL THEN 'scroll the window, instead of moving the cursor
idesy = idesy - 1
IF idesy < 1 THEN idesy = 1
IF idecy > idesy + (idewy - 9) THEN idecy = idesy + (idewy - 9)
ELSE
GOSUB selectcheck
idecy = idecy - 1
IF idecy < 1 THEN idecy = 1
GOTO specialchar
END IF
END IF
IF KB = KEY_DOWN THEN
IF KCONTROL THEN 'scroll the window, instead of moving the cursor
idesy = idesy + 1
IF idesy > iden THEN idesy = iden
IF idecy < idesy THEN idecy = idesy
ELSE
GOSUB selectcheck
idecy = idecy + 1
IF idecy > iden THEN idecy = iden
GOTO specialchar
END IF
END IF
IF mWHEEL THEN
GOSUB selectcheck
'move relative to top/bottom
IF mWHEEL < 0 THEN idecy = idesy
IF mWHEEL > 0 THEN idecy = idesy + (idewy - 9)
idecy = idecy + mWHEEL * 3
IF idecy < 1 THEN idecy = 1
IF idecy > iden THEN idecy = iden
GOTO specialchar
END IF
IF KB = KEY_LEFT THEN
GOSUB selectcheck
IF KCONTROL THEN 'move forward to next beginning alphanumeric
a$ = idegetline(idecy)
IF idecx > LEN(a$) THEN idecx = LEN(a$) + 1
skipping = 1
DO
'move
idecx = idecx - 1
'latch onto prev character
IF idecx < 1 THEN
DO
IF idecy = 1 THEN idecx = 1: GOTO specialchar
idecy = idecy - 1
a$ = idegetline(idecy)
idecx = LEN(a$) + 1
LOOP UNTIL LEN(a$)
GOTO specialchar 'stop at the end of the previous line
END IF
'check character
IF alphanumeric(ASC(a$, idecx)) THEN
IF idecx = 1 THEN GOTO specialchar
x = idecx: y = idecy
skipping = 0
ELSE
IF skipping = 0 THEN idecx = x: idecy = y: GOTO specialchar
END IF
LOOP
ELSE
idecx = idecx - 1
IF idecx < 1 THEN idecx = 1
END IF
GOTO specialchar
END IF
IF KB = KEY_RIGHT THEN
GOSUB selectcheck
IF KCONTROL THEN 'move forward to next beginning alphanumeric
a$ = idegetline(idecy)
skipping = 0
first = 1
DO
'move
IF first = 0 THEN idecx = idecx + 1
'latch onto next character
IF first = 0 AND idecx = LEN(a$) + 1 THEN GOTO specialchar 'stop at the end of the line
IF idecx > LEN(a$) THEN
DO
IF idecy = iden THEN GOTO specialchar
idecy = idecy + 1: idecx = 1
a$ = idegetline(idecy)
LOOP UNTIL LEN(a$)
skipping = 0
first = 0
END IF
'check character
IF alphanumeric(ASC(a$, idecx)) THEN
IF first THEN
skipping = 1
ELSE
IF skipping = 0 THEN GOTO specialchar
END IF
ELSE
skipping = 0
END IF
first = 0
LOOP
ELSE
idecx = idecx + 1
END IF
GOTO specialchar
END IF
IF KCONTROL AND KB = KEY_HOME THEN
GOSUB selectcheck
idecx = 1
idecy = 1
GOTO specialchar
END IF
IF KCONTROL AND KB = KEY_END THEN
GOSUB selectcheck
idecy = iden
a$ = idegetline(idecy)
idecx = LEN(a$) + 1
GOTO specialchar
END IF
IF KB = KEY_HOME THEN
GOSUB selectcheck
IF idecx <> 1 THEN
idecx = 1
ELSE
a$ = idegetline(idecy)
idecx = 1
FOR x = 1 TO LEN(a$)
IF ASC(a$, x) <> 32 THEN idecx = x: EXIT FOR
NEXT
END IF
GOTO specialchar
END IF
IF KB = KEY_END THEN
GOSUB selectcheck
a$ = idegetline(idecy)
idecx = LEN(a$) + 1
GOTO specialchar
END IF
IF KB = KEY_PAGEUP THEN
GOSUB selectcheck
idecy = idecy - (idewy - 9)
IF idecy < 1 THEN idecy = 1
GOTO specialchar
END IF
IF KB = KEY_PAGEDOWN THEN
GOSUB selectcheck
idecy = idecy + (idewy - 9)
IF idecy > iden THEN idecy = iden
GOTO specialchar
END IF
GOTO skipgosubs
selectcheck:
IF IdeSystem = 1 THEN
IF KSHIFT AND ideselect = 0 THEN ideselect = 1: ideselectx1 = idecx: ideselecty1 = idecy
IF KSHIFT = 0 THEN ideselect = 0
ELSEIF IdeSystem = 2 THEN
IF KSHIFT AND idesystem2.issel = 0 THEN idesystem2.issel = -1: idesystem2.sx1 = idesystem2.v1
IF KSHIFT = 0 THEN idesystem2.issel = 0
END IF
RETURN
skipgosubs:
IF K$ = CHR$(13) THEN
IF KSHIFT THEN
retval$ = ""
a$ = idegetline(idecy)
IF EnteringRGB THEN 'The "Shift+ENTER" message is being shown
oldkeywordHighlight = keywordHighlight
keywordHighlight = 0
HideBracketHighlight
keywordHighlight = oldkeywordHighlight
retval$ = idergbmixer$(0)
ELSE
IF ideselect THEN
IF ideselecty1 <> idecy THEN GOTO specialchar 'multi line selected
END IF
Found_RGB = 0
Found_RGB = Found_RGB + INSTR(UCASE$(a$), "RGB(")
Found_RGB = Found_RGB + INSTR(UCASE$(a$), "RGB32(")
Found_RGB = Found_RGB + INSTR(UCASE$(a$), "RGBA(")
Found_RGB = Found_RGB + INSTR(UCASE$(a$), "RGBA32(")
IF Found_RGB THEN
oldkeywordHighlight = keywordHighlight
keywordHighlight = 0
HideBracketHighlight
keywordHighlight = oldkeywordHighlight
retval$ = idergbmixer$(-1)
ELSE
GOTO RegularEnter
END IF
END IF
IF LEN(retval$) THEN
'the mixer dialog could not insert the value, so let's do it here
IF EnteringRGB THEN
insertAtCursor MID$(retval$, INSTR(retval$, "(") + 1)
ELSE
insertAtCursor retval$
END IF
END IF
GOTO specialchar
ELSE
a$ = idegetline(idecy)
RegularEnter:
ideselect = 0
desiredcolumn = 1
idechangemade = 1
startPausedPending = 0
IF idecx > LEN(a$) THEN
ideinsline idecy + 1, ""
IF LEN(a$) = 0 THEN
desiredcolumn = idecx
ELSE
desiredcolumn = LEN(a$) - LEN(LTRIM$(a$)) + 1
END IF
ELSE
a2$ = LEFT$(a$, idecx - 1)
idesetline idecy, a2$
IF LEN(LTRIM$(a2$)) > 0 THEN
IF idecx > 1 THEN desiredcolumn = LEN(a$) - LEN(LTRIM$(a$)) ELSE desiredcolumn = 0
ideinsline idecy + 1, SPACE$(desiredcolumn) + RIGHT$(a$, LEN(a$) - idecx + 1)
IF desiredcolumn = 0 THEN desiredcolumn = 1 ELSE desiredcolumn = desiredcolumn + 1
ELSE
desiredcolumn = idecx
ideinsline idecy + 1, SPACE$(desiredcolumn - 1) + RIGHT$(a$, LEN(a$) - idecx + 1)
END IF
END IF
IF idecx = 1 THEN
FOR b = 1 TO IdeBmkN
IF IdeBmk(b).y = idecy THEN IdeBmk(b).y = IdeBmk(b).y + 1
NEXT
END IF
idecy = idecy + 1
idecx = desiredcolumn
GOTO specialchar
END IF
END IF
IF KB = KEY_DELETE AND KCONTROL = 0 THEN
idechangemade = 1
startPausedPending = 0
a$ = idegetline(idecy)
IF idecx <= LEN(a$) THEN
a$ = LEFT$(a$, idecx - 1) + RIGHT$(a$, LEN(a$) - idecx)
idesetline idecy, a$
ELSE
a$ = a$ + SPACE$(idecx - LEN(a$) - 1)
a$ = a$ + LTRIM$(idegetline(idecy + 1))
idesetline idecy, a$
idedelline idecy + 1
END IF
GOTO specialchar
END IF
'Ctrl+Backspace erases a word at a time
'In Windows it's currently reported as Control+Delete;
'In Mac it's properly delivered as Control+Backspace.
'Key combo not yet supported in Linux.
IF (INSTR(_OS$, "WIN") > 0 AND KCONTROL AND K$ = CHR$(0) + CHR$(83)) OR _
(INSTR(_OS$, "MAC") > 0 AND K$ = CHR$(8) AND KCONTROL) THEN
ideselect = 0
idechangemade = 1
startPausedPending = 0
'undocombos
IF ideundocombochr <> 8 THEN
ideundocombo = 2
ELSE
ideundocombo = ideundocombo + 1
IF ideundocombo = 2 THEN idemergeundo = 1
END IF
ideundocombochr = 8
'Attempt to go back erasing a "word" at a time
a$ = idegetline(idecy)
IF idecx = 1 THEN GOTO RegularBackspaceIdecx1
IF idecx > LEN(a$) + 2 THEN
idecx = LEN(a$) + 1
GOTO specialchar
ELSEIF idecx = LEN(a$) + 2 THEN
idecx = LEN(a$) + 1
END IF
IF LEN(RTRIM$(MID$(a$, 1, idecx - 1))) = 0 THEN
'Erase all spaces behind at once if no text before the cursor
a$ = MID$(a$, idecx)
idesetline idecy, a$
idecx = 1
GOTO specialchar
END IF
'Go back in a$ and find the first non blank char
i = idecx
DO
i = i - 1
FirstChar$ = MID$(a$, i, 1)
IF FirstChar$ <> CHR$(32) THEN EXIT DO
LOOP
IF INSTR(char.sep$, FirstChar$) THEN
DO
IF i = 0 THEN EXIT DO
IF MID$(a$, i, 1) <> FirstChar$ THEN EXIT DO
i = i - 1
LOOP
ELSE
DO
IF i = 0 THEN EXIT DO
i = i - 1
IF INSTR(char.sep$, MID$(a$, i, 1)) THEN EXIT DO
LOOP
END IF
a$ = LEFT$(a$, i) + MID$(a$, idecx)
idecx = i + 1
idesetline idecy, a$
GOTO specialchar
END IF
IF K$ = CHR$(8) THEN 'Regular Backspace
ideselect = 0
idechangemade = 1
startPausedPending = 0
'undocombos
IF ideundocombochr <> 8 THEN
ideundocombo = 2
ELSE
ideundocombo = ideundocombo + 1
IF ideundocombo = 2 THEN idemergeundo = 1
END IF
ideundocombochr = 8
a$ = idegetline(idecy)
IF idecx = 1 THEN
RegularBackspaceIdecx1:
IF idecy > 1 THEN
a2$ = idegetline(idecy - 1)
IF LEN(a2$) > 0 THEN
'If the previous line has any content, let's just append this line to it
RegularBackupToPrevLine:
idesetline idecy - 1, a2$ + a$
idedelline idecy
idecx = LEN(a2$) + 1
idecy = idecy - 1
ELSE
'Or else, if it's an empty line, let's try to follow the
'next line's indentation.
'First, get indentation level of next line, if any.
IF idecy < iden THEN
a3$ = idegetline(idecy + 1)
desiredcolumn = LEN(a3$) - LEN(LTRIM$(a3$))
idesetline idecy - 1, SPACE$(desiredcolumn) + a$
idedelline idecy
idecx = desiredcolumn + 1
idecy = idecy - 1
ELSE
GOTO RegularBackupToPrevLine
END IF
END IF
END IF
GOTO specialchar
END IF
IF idecx > LEN(a$) + 1 THEN
idecx = LEN(a$) + 1
ELSE
CheckSpacesBehind:
IF LEN(RTRIM$(MID$(a$, 1, idecx - 1))) = 0 THEN
'Only spaces behind. If we're on a tab stop, let's go back in tabs.
x = 4
IF ideautoindentsize <> 0 THEN x = ideautoindentsize
check.tabstop! = (idecx - 1) / x
IF check.tabstop! = FIX(check.tabstop!) THEN
IF idecx - x < 1 THEN x = idecx - 1
a$ = LEFT$(a$, idecx - (x + 1)) + RIGHT$(a$, LEN(a$) - idecx + 1)
idesetline idecy, a$
idecx = idecx - x
ELSE
GOTO onebackspace
END IF
ELSE
onebackspace:
a$ = LEFT$(a$, idecx - 2) + RIGHT$(a$, LEN(a$) - idecx + 1)
idesetline idecy, a$
idecx = idecx - 1
END IF
END IF
GOTO specialchar
END IF
'patch#1
IF LEN(K$) <> 1 THEN GOTO specialchar
IF K$ = CHR$(9) THEN GOTO ideforceinput
IF block_chr(ASC(K$)) THEN GOTO specialchar
ideforceinput:
IF K$ = CHR$(9) OR (K$ = CHR$(25) AND INSTR(_OS$, "MAC") > 0) THEN
IF ideselect THEN
'Block indentation code copied/adapted from block comment/uncomment:
IF KSHIFT OR K$ = CHR$(25) THEN
IdeBlockDecreaseIndent:
BlockIndentLevel = 4
IF ideautoindentsize <> 0 THEN BlockIndentLevel = ideautoindentsize
y1 = idecy
y2 = ideselecty1
IF y1 = y2 THEN 'single line selected
a$ = idegetline(idecy)
a2$ = ""
sx1 = ideselectx1: sx2 = idecx
IF sx2 < sx1 THEN SWAP sx1, sx2
FOR x = sx1 TO sx2 - 1
IF x <= LEN(a$) THEN a2$ = a2$ + MID$(a$, x, 1) ELSE a2$ = a2$ + " "
NEXT
IF a2$ = "" THEN
GOTO SkipBlockIndent
END IF
END IF
IF y1 > y2 THEN SWAP y1, y2
IF idecy > ideselecty1 AND idecx = 1 THEN y2 = y2 - 1
'calculate lhs
lhs = 10000000
FOR y = y1 TO y2
a$ = idegetline(y)
IF LEN(a$) THEN
ta$ = LTRIM$(a$)
t = LEN(a$) - LEN(ta$)
IF t < lhs THEN lhs = t
END IF
NEXT
'edit lines
'Unless any of the block lines already starts at the beginning of the line
IF lhs > 0 THEN
IF lhs < BlockIndentLevel THEN BlockIndentLevel = lhs
FOR y = y1 TO y2
a$ = idegetline(y)
IF LEN(a$) THEN
a$ = RIGHT$(a$, LEN(a$) - BlockIndentLevel)
idesetline y, a$
idechangemade = 1
startPausedPending = 0
END IF
NEXT
END IF
IF (y1 = y2) AND idechangemade THEN
ideselectx1 = ideselectx1 - BlockIndentLevel
idecx = idecx - BlockIndentLevel
IF idecx < 1 THEN idecx = 1: ideselectx1 = idecx
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
ELSE
IdeBlockIncreaseIndent:
BlockIndentLevel = 4
IF ideautoindentsize <> 0 THEN BlockIndentLevel = ideautoindentsize
y1 = idecy
y2 = ideselecty1
IF y1 = y2 THEN 'single line selected
a$ = idegetline(idecy)
a2$ = ""
sx1 = ideselectx1: sx2 = idecx
IF sx2 < sx1 THEN SWAP sx1, sx2
FOR x = sx1 TO sx2 - 1
IF x <= LEN(a$) THEN a2$ = a2$ + MID$(a$, x, 1) ELSE a2$ = a2$ + " "
NEXT
IF a2$ = "" THEN
GOTO SkipBlockIndent
END IF
END IF
IF y1 > y2 THEN SWAP y1, y2
IF idecy > ideselecty1 AND idecx = 1 THEN y2 = y2 - 1
'calculate lhs
lhs = 10000000
FOR y = y1 TO y2
a$ = idegetline(y)
IF LEN(a$) THEN
ta$ = LTRIM$(a$)
t = LEN(a$) - LEN(ta$)
IF t < lhs THEN lhs = t
END IF
NEXT
'edit lines
FOR y = y1 TO y2
a$ = idegetline(y)
IF LEN(a$) THEN
a$ = LEFT$(a$, lhs) + SPACE$(BlockIndentLevel) + RIGHT$(a$, LEN(a$) - lhs)
idesetline y, a$
idechangemade = 1
startPausedPending = 0
END IF
NEXT
IF (y1 = y2) AND idechangemade THEN
ideselectx1 = ideselectx1 + BlockIndentLevel
idecx = idecx + BlockIndentLevel
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
ELSE
SkipBlockIndent:
IF KSHIFT = 0 THEN
x = 4
IF ideautoindentsize <> 0 THEN x = ideautoindentsize
K$ = SPACE$(x - ((idecx - 1) MOD x))
ELSE
K$ = ""
END IF
END IF
END IF
IF K$ = CHR$(27) AND NOT AltSpecial THEN GOTO specialchar 'Steve edit 07-04-2014 to stop ESC from printing chr$(27) in the IDE
'alt and ctrl combos have already been processed, so skip inserting
'K$ if these are still held down:
IF KCTRL AND NOT KALT THEN GOTO specialchar
IF KALT AND NOT KCTRL AND NOT AltSpecial THEN GOTO specialchar
'standard character
IF ideselect THEN delselect
idechangemade = 1
startPausedPending = 0
'undocombos
IF LEN(K$) = 1 THEN
asck = ASC(K$)
IF alphanumeric(asck) OR ideundocombochr = asck THEN
IF ideundocombochr = 8 THEN ideundocombo = 0
IF ideundocombo = 0 THEN
ideundocombo = 2
ELSE
ideundocombo = ideundocombo + 1
IF ideundocombo = 2 THEN idemergeundo = 1
END IF
END IF
ideundocombochr = asck
END IF
a$ = idegetline(idecy)
IF LEN(a$) < idecx - 1 THEN a$ = a$ + SPACE$(idecx - 1 - LEN(a$))
IF ideinsert THEN
a2$ = RIGHT$(a$, LEN(a$) - idecx + 1)
IF LEN(a2$) THEN a2$ = RIGHT$(a$, LEN(a$) - idecx)
a$ = LEFT$(a$, idecx - 1) + K$ + a2$
ELSE
a$ = LEFT$(a$, idecx - 1) + K$ + RIGHT$(a$, LEN(a$) - idecx + 1)
END IF
idesetline idecy, a$
idecx = idecx + LEN(K$)
specialchar:
'In case there is a selection, let's show the number of
'selected characters on the status bar:
IF (IdeInfo = "" OR LEFT$(IdeInfo, 19) = "Selection length = ") THEN
IF idecy = ideselecty1 THEN 'selection is in only one line
sx1 = ideselectx1: sx2 = idecx
IF sx1 > sx2 THEN SWAP sx1, sx2
IF ideselect = 1 AND (sx2 - sx1) > 0 THEN
IF sx2 - sx1 > 0 THEN
a$ = idegetline(idecy)
ideCurrentSingleLineSelection = MID$(a$, sx1, sx2 - sx1)
FOR i = 1 TO LEN(ideCurrentSingleLineSelection)
IF INSTR(char.sep$, MID$(ideCurrentSingleLineSelection, i, 1)) > 0 THEN
'separators in selection don't trigger multi-highlight
IF MID$(ideCurrentSingleLineSelection, i, 1) <> "." THEN
ideCurrentSingleLineSelection = ""
EXIT FOR
END IF
END IF
NEXT i
END IF
IdeInfo = "Selection length = " + str2$(sx2 - sx1) + " character" + LEFT$("s", ABS(sx2 - sx1 > 1))
UpdateIdeInfo
ELSE
IdeInfo = ""
ideCurrentSingleLineSelection = ""
UpdateIdeInfo
END IF
ELSE
IF ideselect THEN
sy1 = ideselecty1
sy2 = idecy
IF sy1 > sy2 OR idecx > 1 THEN
IdeInfo = "Selection length = " + str2$(ABS(sy2 - sy1) + 1) + " line" + LEFT$("s", ABS((ABS(sy2 - sy1) + 1) > 1))
ELSE
IdeInfo = "Selection length = " + str2$(sy2 - sy1) + " line" + LEFT$("s", ABS(sy2 - sy1 > 1))
END IF
ELSE
IdeInfo = ""
END IF
ideCurrentSingleLineSelection = ""
UpdateIdeInfo
END IF
END IF
IF AltSpecial THEN
AltSpecial = 0
ideentermenu = 0
KALT = 0
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
END IF
LOOP
'--------------------------------------------------------------------------------
startmenu:
m = 1
oldmx = mX: oldmy = mY
startmenu2:
altheld = 1
IF IdeSystem = 2 THEN IdeSystem = 1: GOSUB UpdateSearchBar
DO
LOCATE 1, 3
FOR i = 1 TO menus
IF m = i THEN COLOR 15, 0 ELSE COLOR 15, 7
PRINT " " + LEFT$(menu$(i, 0), 1);
IF m = i THEN COLOR 7, 0 ELSE COLOR 0, 7
PRINT RIGHT$(menu$(i, 0), LEN(menu$(i, 0)) - 1) + " ";
IF i = menus - 1 THEN LOCATE 1, idewx - LEN(menu$(menus, 0)) - 2
NEXT
PCOPY 3, 0
DO
lastaltheld = altheld
GetInput
IF oldmx <> mX OR oldmy <> mY THEN
IF mY = 1 AND idecontextualmenu <> 1 THEN 'Check if we're hovering on menu bar
lastm = m
FOR i = 1 TO menus
x = CVI(MID$(MenuLocations, i * 2 - 1, 2))
x2 = CVI(MID$(MenuLocations, i * 2 - 1, 2)) + LEN(menu$(i, 0))
IF mX >= x AND mX < x2 THEN
m = i
IF m <> lastm THEN EXIT DO 'Update the menu bar to reflect the current mouse hover
END IF
NEXT
END IF
oldmx = mX: oldmy = mY
END IF
IF iCHANGED = 0 THEN _LIMIT 100
IF KALT THEN altheld = 1 ELSE altheld = 0
IF altheld <> 0 AND lastaltheld = 0 THEN
DO
_LIMIT 100
GetInput
IF _WINDOWHASFOCUS = 0 AND (os$ = "WIN" OR MacOSX = 1) THEN
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
SCREEN , , 3, 0: PCOPY 3, 0
GOTO ideloop
END IF
IF _RESIZE THEN
ForceResize = -1: skipdisplay = 0: GOTO ideloop
END IF
LOOP UNTIL KALT = 0
KB = KEY_ESC
END IF
IF _WINDOWHASFOCUS = 0 AND (os$ = "WIN" OR MacOSX = 1) THEN
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
SCREEN , , 3, 0: PCOPY 3, 0
GOTO ideloop
END IF
IF _RESIZE THEN
ForceResize = -1: skipdisplay = 0: GOTO ideloop
END IF
IF mCLICK OR mCLICK2 THEN
IF mY = 1 THEN
FOR i = 1 TO menus
x = CVI(MID$(MenuLocations, i * 2 - 1, 2))
x2 = CVI(MID$(MenuLocations, i * 2 - 1, 2)) + LEN(menu$(i, 0))
IF mX >= x AND mX < x2 THEN
m = i
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
PCOPY 3, 0
GOTO showmenu
END IF
NEXT
END IF 'my=1
KB = KEY_ESC 'exit menu selection
END IF
IF _EXIT THEN ideexit = 1: KB = KEY_ESC
LOOP UNTIL KB
K$ = UCASE$(K$)
IF LEN(K$) > 0 AND KCTRL THEN
'ctrl+key combos are not valid while a menu is active
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
SCREEN , , 3, 0: PCOPY 3, 0
GOTO ideloop
END IF
FOR i = 1 TO menus
a$ = UCASE$(LEFT$(menu$(i, 0), 1))
IF K$ = a$ THEN
m = i
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
PCOPY 3, 0
GOTO showmenu
END IF
NEXT
IF KB = KEY_LEFT THEN m = m - 1
IF KB = KEY_RIGHT THEN m = m + 1
IF KB = KEY_ESC THEN
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
IdeInfo = ""
GOTO ideloop
END IF
IF m < 1 THEN m = menus
IF m > menus AND idecontextualmenu = 0 THEN m = 1
IF KB = KEY_UP OR KB = KEY_DOWN OR KB = KEY_ENTER THEN
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
PCOPY 3, 0
GOTO showmenu
END IF
'possible ALT+??? code?
IF KB > 0 AND KB <= 255 THEN
IF KALT = 0 THEN
iCHECKLATER = 1
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
GOTO ideloop
END IF
END IF
LOOP
'--------------------------------------------------------------------------------
showmenu:
altheld = 1
IF IdeSystem = 2 THEN IdeSystem = 1: GOSUB UpdateSearchBar
PCOPY 0, 2
SCREEN , , 1, 0
parentMenuR = r
r = 1
s = 0
parentMenu = 0
parentMenuSetup%% = 0
SELECT CASE idecontextualmenu
CASE 1
'right-click on text area
idectxmenuX = mX
idectxmenuY = mY
m = idecontextualmenuID
CASE 2
'line numbers menu item in View menu
idectxmenuX = xx + w + 3
idectxmenuY = yy + r
parentMenu = m
m = ViewMenuShowLineNumbersSubMenuID
END SELECT
IdeMakeEditMenu
IF totalWarnings = 0 THEN
menu$(ViewMenuID, ViewMenuCompilerWarnings) = "~Compiler #Warnings... Ctrl+W"
ELSE
menu$(ViewMenuID, ViewMenuCompilerWarnings) = "Compiler #Warnings... Ctrl+W"
END IF
IF callStackLength = 0 THEN
menu$(DebugMenuID, DebugMenuCallStack) = "~Call #Stack... F12"
ELSE
menu$(DebugMenuID, DebugMenuCallStack) = "Call #Stack... F12"
END IF
oldmy = mY: oldmx = mX
DO
PCOPY 2, 1
IF idecontextualmenu = 0 THEN
'find pos of menu m
x = 4: FOR i = 1 TO m - 1: x = x + LEN(menu$(i, 0)) + 2
IF i = menus - 1 THEN x = idewx - LEN(menu$(menus, 0)) - 1
NEXT: xx = x
COLOR 7, 0: _PRINTSTRING (xx - 1, 1), " " + menu$(m, 0) + " "
ELSE
IF parentMenu > 0 AND parentMenuSetup%% = 0 THEN
parentMenuSetup%% = -1
backToParent.x1 = xx - 1
backToParent.x2 = xx + w
backToParent.y1 = 3
backToParent.y2 = backToParent.y1 + menusize(parentMenu)
END IF
END IF
'calculate menu width
w = 0
FOR i = 1 TO menusize(m)
m$ = menu$(m, i)
l = LEN(m$)
IF INSTR(m$, "#") THEN l = l - 1
IF LEFT$(m$, 1) = "~" THEN l = l - 1
IF LEFT$(m$, 1) = CHR$(7) THEN l = l - 1
IF INSTR(m$, " ") THEN l = l + 2 'min 4 spacing
IF l > w THEN w = l
NEXT
yy = 2
IF idecontextualmenu > 0 THEN
actual.idewy = idewy
IF idesubwindow <> 0 THEN
actual.idewy = idewy + idesubwindow
END IF
xx = idectxmenuX
IF xx < 3 THEN xx = 3
yy = idectxmenuY
IF yy + menusize(m) + 2 > actual.idewy THEN yy = actual.idewy - 2 - menusize(m)
END IF
IF xx > idewx - w - 3 THEN xx = idewx - w - 3
UpdateMenuHelpLine menuDesc$(m, r)
COLOR 0, 7
ideboxshadow xx - 2, yy, w + 4, menusize(m) + 2
'draw menu items
FOR i = 1 TO menusize(m)
m$ = menu$(m, i)
IF m$ = "-" THEN
COLOR 0, 7: _PRINTSTRING (xx - 2, i + yy), CHR$(195) + STRING$(w + 2, CHR$(196)) + CHR$(180)
ELSEIF LEFT$(m$, 1) = "~" THEN
m$ = RIGHT$(m$, LEN(m$) - 1) 'Remove the tilde before printing
IF r = i THEN COLOR 7, 0: _PRINTSTRING (xx - 1, i + yy), SPACE$(w + 2)
IF LEFT$(m$, 1) = CHR$(7) THEN LOCATE i + yy, xx - 1 ELSE LOCATE i + yy, xx
h = -1: x = INSTR(m$, "#"): IF x THEN h = x: m$ = LEFT$(m$, x - 1) + RIGHT$(m$, LEN(m$) - x)
x = INSTR(m$, " "): IF x THEN m1$ = LEFT$(m$, x - 1): m2$ = RIGHT$(m$, LEN(m$) - x - 1): m$ = m1$ + SPACE$(w - LEN(m1$) - LEN(m2$)) + m2$
FOR x = 1 TO LEN(m$)
IF r = i THEN COLOR 2, 0 ELSE COLOR 2, 7
PRINT MID$(m$, x, 1);
NEXT
ELSE
IF r = i THEN COLOR 7, 0: _PRINTSTRING (xx - 1, i + yy), SPACE$(w + 2)
IF LEFT$(m$, 1) = CHR$(7) THEN LOCATE i + yy, xx - 1 ELSE LOCATE i + yy, xx
h = -1: x = INSTR(m$, "#"): IF x THEN h = x: m$ = LEFT$(m$, x - 1) + RIGHT$(m$, LEN(m$) - x)
x = INSTR(m$, " "): IF x THEN m1$ = LEFT$(m$, x - 1): m2$ = RIGHT$(m$, LEN(m$) - x - 1): m$ = m1$ + SPACE$(w - LEN(m1$) - LEN(m2$)) + m2$
FOR x = 1 TO LEN(m$)
IF x = h THEN
IF r = i THEN COLOR 15, 0 ELSE COLOR 15, 7
ELSE
IF r = i THEN COLOR 7, 0 ELSE COLOR 0, 7
END IF
PRINT MID$(m$, x, 1);
NEXT
END IF
NEXT
PCOPY 1, 0
IF s THEN GOTO menuChoiceMade
updateMenuPanel%% = 0
change = 0
DO
mousedown = 0: mouseup = 0
GetInput
lastaltheld = altheld: IF KALT THEN altheld = 1 ELSE altheld = 0
IF iCHANGED THEN
IF KB THEN change = 1
IF mCLICK THEN change = 1: mousedown = 1
IF mCLICK2 THEN change = 1
IF mRELEASE THEN change = 1: mouseup = 1
IF mWHEEL THEN change = 1
IF mX THEN change = 1
IF mY THEN change = 1
END IF
IF mB THEN change = 1
'revert to previous menuwhen alt pressed again
IF altheld <> 0 AND lastaltheld = 0 THEN
DO
_LIMIT 100
GetInput
IF _WINDOWHASFOCUS = 0 AND (os$ = "WIN" OR MacOSX = 1) THEN
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF (_RESIZE <> 0) AND IdeDebugMode <> 2 THEN
ForceResize = -1: skipdisplay = 0: GOTO ideloop
END IF
LOOP UNTIL KALT = 0 'wait till alt is released
PCOPY 3, 0: SCREEN , , 3, 0
GOTO startmenu2
END IF
IF _EXIT THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 9: GOTO EnterDebugMode
ELSE
ideexit = 1: GOTO ideloop
END IF
END IF
IF _WINDOWHASFOCUS = 0 AND (os$ = "WIN" OR MacOSX = 1) THEN
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeDebugMode = 2 THEN GOTO EnterDebugMode
GOTO ideloop
END IF
IF (_RESIZE <> 0) AND IdeDebugMode <> 2 THEN
ForceResize = -1: skipdisplay = 0: GOTO ideloop
END IF
_LIMIT 100
LOOP UNTIL change
s = 0
IF mWHEEL THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeDebugMode = 2 THEN GOTO EnterDebugMode
GOTO ideloop
END IF
IF mCLICK2 AND idecontextualmenu = 1 THEN 'A new right click in the text area repositions the contextual menu
IF (mX > 1 AND mX < idewx AND mY > 2 AND mY < (idewy - 5)) OR _
(mY >= idewy AND mY < idewy + idesubwindow) THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeDebugMode = 2 THEN
bkpidecy = idecy
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN idecy = iden
IF bkpidecy <> idecy THEN
ideshowtext
PCOPY 3, 0
END IF
GOTO showmenu
END IF
GOTO invokecontextualmenu
ELSE
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
'mouse selection
IF mouseup THEN
IF mX >= xx - 2 AND mX < xx - 2 + w + 4 THEN
IF mY > yy AND mY <= menusize(m) + yy THEN
y = mY - yy
IF menu$(m, y) <> "-" AND LEFT$(menu$(m, y), 1) <> "~" THEN
s = r
END IF
END IF
END IF
IF parentMenu > 0 AND _
mX >= backToParent.x1 AND mX =< backToParent.x2 AND _
mY >= backToParent.y1 AND mY =< backToParent.y2 THEN
m = parentMenu
r = parentMenuR
parentMenu = 0
parentMenuR = 0
idecontextualmenu = 0
PCOPY 3, 2
_CONTINUE
END IF
IF mX < xx - 2 OR mX >= xx - 2 + w + 4 OR mY > yy + menusize(m) + 1 OR (mY < yy AND idecontextualmenu = 1) THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeDebugMode = 2 THEN GOTO EnterDebugMode
GOTO ideloop
END IF
END IF
IF NOT mouseup AND NOT mousedown THEN 'Check if we're hovering on menu options
IF parentMenu > 0 AND oldmy <> mY AND oldmx <> mX AND _
mX >= backToParent.x1 AND mX =< backToParent.x2 AND _
mY >= backToParent.y1 AND mY =< backToParent.y2 THEN
m = parentMenu
r = parentMenuR
parentMenu = 0
parentMenuR = 0
idecontextualmenu = 0
PCOPY 3, 2
_CONTINUE
END IF
IF oldmy <> mY THEN
IF mX >= xx - 2 AND mX < xx - 2 + w + 4 THEN
IF mY > yy AND mY <= menusize(m) + yy THEN
y = mY - yy
IF menu$(m, y) <> "-" THEN
r = y
END IF
END IF
ELSE
IF mY = 1 THEN GOTO checkmenubarhover
END IF
oldmy = mY
END IF
IF oldmx <> mX THEN
checkmenubarhover:
IF IdeDebugMode <> 2 AND mY = 1 AND idecontextualmenu <> 1 THEN 'Check if we're hovering on menu bar
lastm = m
FOR i = 1 TO menus
x = CVI(MID$(MenuLocations, i * 2 - 1, 2))
x2 = CVI(MID$(MenuLocations, i * 2 - 1, 2)) + LEN(menu$(i, 0))
IF mX >= x AND mX < x2 THEN
m = i
r = 1
parentMenuR = 0
parentMenu = 0
IF idecontextualmenu > 1 THEN idecontextualmenu = 0: PCOPY 3, 2
EXIT FOR
END IF
NEXT
END IF
oldmx = mX
END IF
END IF
IF mB THEN
'top row
IF mY = 1 AND IdeDebugMode <> 2 THEN
lastm = m
x = 3
FOR i = 1 TO menus
x2 = LEN(menu$(i, 0)) + 2
IF mX >= x AND mX < x + x2 THEN
m = i
r = 1
IF lastm = m AND mousedown = 1 THEN PCOPY 3, 0: SCREEN , , 3, 0: GOTO ideloop
idecontextualmenu = 0
EXIT FOR
END IF
x = x + x2
IF i = menus - 1 THEN x = idewx - LEN(menu$(menus, 0)) - 2
NEXT
END IF
'uses pre-calc xx & w
IF mX >= xx - 2 AND mX < xx - 2 + w + 4 THEN
IF mY > yy AND mY <= menusize(m) + yy THEN
y = mY - yy
IF menu$(m, y) <> "-" THEN r = y
END IF
END IF
END IF 'mb
IF KB = KEY_LEFT AND idecontextualmenu = 0 THEN
m = m - 1: r = 1
ELSEIF KB = KEY_LEFT AND idecontextualmenu > 1 THEN
idecontextualmenu = 0
PCOPY 3, 2
m = parentMenu
r = parentMenuR
parentMenu = 0
END IF
IF KB = KEY_RIGHT AND idecontextualmenu = 0 THEN
IF RIGHT$(menu$(m, r), 1) = CHR$(16) THEN
SELECT CASE LEFT$(menu$(m, r), LEN(menu$(m, r)) - 3)
CASE "#Line Numbers"
idecontextualmenu = 2
GOTO showmenu
END SELECT
ELSE
m = m + 1: r = 1
END IF
ELSEIF KB = KEY_RIGHT AND idecontextualmenu > 1 THEN
idecontextualmenu = 0
PCOPY 3, 2
m = parentMenu + 1
r = 1
END IF
IF m < 1 THEN m = menus
IF m > menus AND idecontextualmenu = 0 THEN m = 1
IF KB = KEY_ESC THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeDebugMode = 2 THEN GOTO EnterDebugMode
GOTO ideloop
END IF
IF KB = KEY_DOWN THEN
r = r + 1
IF menu$(m, r) = "-" THEN r = r + 1
IF r > menusize(m) THEN r = 1
END IF
IF KB = KEY_UP THEN
r = r - 1
IF menu$(m, r) = "-" THEN r = r - 1
IF r < 1 THEN r = menusize(m)
END IF
'select?
'with enter
IF KB = KEY_ENTER THEN
IF LEFT$(menu$(m, r), 1) <> "~" THEN s = r
END IF
'with hotkey
K$ = UCASE$(K$)
IF LEN(K$) > 0 AND NOT KCTRL THEN
FOR r2 = 1 TO menusize(m)
x = INSTR(menu$(m, r2), "#")
IF x THEN
a$ = UCASE$(MID$(menu$(m, r2), x + 1, 1))
IF K$ = a$ AND LEFT$(menu$(m, r2), 1) <> "~" THEN
s = r2
updateMenuPanel%% = -1
EXIT FOR
ELSEIF K$ = a$ AND LEFT$(menu$(m, r2), 1) = "~" THEN
updateMenuPanel%% = -1
EXIT FOR
END IF
END IF
NEXT
IF updateMenuPanel%% THEN r = r2: _CONTINUE
END IF
IF s THEN
menuChoiceMade:
IF KALT THEN idehl = 1 ELSE idehl = 0 'set idehl, a shared variable used by various dialogue boxes
IF menu$(m, s) = "Add Co#mment (') Ctrl+R" THEN
ctrlAddComment:
y1 = idecy: y2 = y1
IF ideselect = 1 THEN
y1 = ideselecty1
IF idecy > ideselecty1 AND idecx = 1 THEN y2 = y2 - 1
IF y1 > y2 THEN SWAP y1, y2
END IF
'calculate lhs
lhs = 10000000
FOR y = y1 TO y2
a$ = idegetline(y)
IF LEN(a$) THEN
ta$ = LTRIM$(a$)
t = LEN(a$) - LEN(ta$)
IF t < lhs THEN lhs = t
END IF
NEXT
'edit lines
FOR y = y1 TO y2
a$ = idegetline(y)
IF LEN(a$) THEN
a$ = LEFT$(a$, lhs) + "'" + RIGHT$(a$, LEN(a$) - lhs)
idesetline y, a$
idechangemade = 1
startPausedPending = 0
END IF
NEXT
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "Remove Comme#nt (') Ctrl+Shift+R" THEN
ctrlRemoveComment:
PCOPY 3, 0: SCREEN , , 3, 0
y1 = idecy: y2 = y1
IF ideselect = 1 THEN
y1 = ideselecty1
IF idecy > ideselecty1 AND idecx = 1 THEN y2 = y2 - 1
IF y1 > y2 THEN SWAP y1, y2
END IF
'edit lines
FOR y = y1 TO y2
a$ = idegetline(y)
IF LEN(a$) THEN
a2$ = LTRIM$(a$)
IF LEN(a2$) THEN
IF ASC(a2$, 1) = 39 THEN
a$ = SPACE$(LEN(a$) - LEN(a2$)) + RIGHT$(a2$, LEN(a2$) - 1)
idesetline y, a$
idechangemade = 1
startPausedPending = 0
END IF
END IF
END IF
NEXT
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "To#ggle Comment Ctrl+T" THEN
ctrlToggleComment:
PCOPY 3, 0: SCREEN , , 3, 0
y1 = idecy: y2 = y1
IF ideselect = 1 THEN
y1 = ideselecty1
IF idecy > ideselecty1 AND idecx = 1 THEN y2 = y2 - 1
IF y1 > y2 THEN SWAP y1, y2
END IF
'calculate lhs
lhs = 10000000
FOR y = y1 TO y2
a$ = idegetline(y)
IF LEN(a$) THEN
ta$ = LTRIM$(a$)
t = LEN(a$) - LEN(ta$)
IF t < lhs THEN lhs = t
END IF
NEXT
'edit lines
FOR y = y1 TO y2
a$ = idegetline(y)
IF LEN(a$) THEN
a2$ = LTRIM$(a$)
IF LEN(a2$) THEN
IF ASC(a2$, 1) = 39 THEN
a$ = SPACE$(LEN(a$) - LEN(a2$)) + RIGHT$(a2$, LEN(a2$) - 1)
idesetline y, a$
idechangemade = 1
startPausedPending = 0
ELSE
a$ = LEFT$(a$, lhs) + "'" + RIGHT$(a$, LEN(a$) - lhs)
idesetline y, a$
idechangemade = 1
startPausedPending = 0
END IF
END IF
END IF
NEXT
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Increase Indent TAB" THEN
IF ideselect THEN GOTO IdeBlockIncreaseIndent
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF LEFT$(menu$(m, s), 16) = "#Decrease Indent" THEN
IF ideselect THEN GOTO IdeBlockDecreaseIndent
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Language..." THEN
PCOPY 2, 0
retval = idelanguagebox
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Display..." THEN
PCOPY 2, 0
IF idehelp = 0 THEN
retval = idedisplaybox
IF retval = 1 THEN
'screen dimensions have changed and everything must be redrawn/reapplied
WIDTH idewx, idewy + idesubwindow
IF idecustomfont THEN
_FONT idecustomfonthandle
ELSE
IF IDE_UseFont8 THEN _FONT 8 ELSE _FONT 16
END IF
skipdisplay = 0
GOSUB redrawItAll
END IF
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "IDE C#olors..." THEN
PCOPY 2, 0
HideBracketHighlight
retval = idechoosecolorsbox 'retval is ignored
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#RGB Color Mixer..." THEN
PCOPY 2, 0
oldkeywordHighlight = keywordHighlight
keywordHighlight = 0
HideBracketHighlight
keywordHighlight = oldkeywordHighlight
retval$ = idergbmixer$(-1) 'retval is ignored
IF LEN(retval$) THEN insertAtCursor retval$
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Advanced (C++)..." THEN
PCOPY 2, 0
retval = ideadvancedbox
'retval is ignored
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "Purge C++ #Libraries" THEN
PCOPY 2, 0
purgeprecompiledcontent
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF RIGHT$(menu$(m, s), 19) = "#Swap Mouse Buttons" THEN
PCOPY 2, 0
MouseButtonSwapped = NOT MouseButtonSwapped
IF MouseButtonSwapped THEN
WriteConfigSetting mouseSettingsSection$, "SwapMouseButton", "True"
menu$(OptionsMenuID, OptionsMenuSwapMouse) = CHR$(7) + "#Swap Mouse Buttons"
ELSE
WriteConfigSetting mouseSettingsSection$, "SwapMouseButton", "False"
menu$(OptionsMenuID, OptionsMenuSwapMouse) = "#Swap Mouse Buttons"
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF RIGHT$(menu$(m, s), 19) = "Syntax #Highlighter" THEN
PCOPY 2, 0
DisableSyntaxHighlighter = NOT DisableSyntaxHighlighter
IF DisableSyntaxHighlighter THEN
WriteConfigSetting generalSettingsSection$, "DisableSyntaxHighlighter", "True"
menu$(OptionsMenuID, OptionsMenuDisableSyntax) = "Syntax #Highlighter"
ELSE
WriteConfigSetting generalSettingsSection$, "DisableSyntaxHighlighter", "False"
menu$(OptionsMenuID, OptionsMenuDisableSyntax) = CHR$(7) + "Syntax #Highlighter"
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF RIGHT$(menu$(m, s), 19) = "Cursor After #Paste" THEN
PCOPY 2, 0
PasteCursorAtEnd = NOT PasteCursorAtEnd
IF PasteCursorAtEnd THEN
WriteConfigSetting generalSettingsSection$, "PasteCursorAtEnd", "True"
menu$(OptionsMenuID, OptionsMenuPasteCursor) = CHR$(7) + "Cursor After #Paste"
ELSE
WriteConfigSetting generalSettingsSection$, "PasteCursorAtEnd", "False"
menu$(OptionsMenuID, OptionsMenuPasteCursor) = "Cursor After #Paste"
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF RIGHT$(menu$(m, s), 15) = "Syntax Ch#ecker" THEN
PCOPY 2, 0
IDEShowErrorsImmediately = NOT IDEShowErrorsImmediately
IF IDEShowErrorsImmediately THEN
WriteConfigSetting generalSettingsSection$, "ShowErrorsImmediately", "True"
menu$(OptionsMenuID, OptionsMenuShowErrorsImmediately) = CHR$(7) + "Syntax Ch#ecker"
ELSE
WriteConfigSetting generalSettingsSection$, "ShowErrorsImmediately", "False"
menu$(OptionsMenuID, OptionsMenuShowErrorsImmediately) = "Syntax Ch#ecker"
END IF
idechangemade = 1
startPausedPending = 0
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF RIGHT$(menu$(m, s), 16) = "Ignore #Warnings" THEN
PCOPY 2, 0
IF IgnoreWarnings = 0 THEN
IgnoreWarnings = -1
WriteConfigSetting generalSettingsSection$, "IgnoreWarnings", "True"
menu$(OptionsMenuID, OptionsMenuIgnoreWarnings) = CHR$(7) + "Ignore #Warnings"
ELSE
IgnoreWarnings = 0
WriteConfigSetting generalSettingsSection$, "IgnoreWarnings", "False"
menu$(OptionsMenuID, OptionsMenuIgnoreWarnings) = "Ignore #Warnings"
END IF
idechangemade = 1
startPausedPending = 0
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
IF SaveExeWithSource THEN
WriteConfigSetting generalSettingsSection$, "SaveExeWithSource", "True"
menu$(RunMenuID, RunMenuSaveExeWithSource) = CHR$(7) + "Output EXE to Source #Folder"
ELSE
WriteConfigSetting generalSettingsSection$, "SaveExeWithSource", "False"
menu$(RunMenuID, RunMenuSaveExeWithSource) = "Output EXE to Source #Folder"
END IF
PCOPY 3, 0: SCREEN , , 3, 0
idecompiled = 0
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 RIGHT$(menu$(m, s), 28) = "Auto-add $#Debug Metacommand" THEN
PCOPY 2, 0
AutoAddDebugCommand = NOT AutoAddDebugCommand
IF AutoAddDebugCommand THEN
WriteConfigSetting debugSettingsSection$, "AutoAddDebugCommand", "True"
menu$(DebugMenuID, DebugMenuAutoAddCommand) = CHR$(7) + "Auto-add $#Debug Metacommand"
ELSE
WriteConfigSetting debugSettingsSection$, "AutoAddDebugCommand", "False"
menu$(DebugMenuID, DebugMenuAutoAddCommand) = "Auto-add $#Debug Metacommand"
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
IF EnableQuickNav THEN
WriteConfigSetting generalSettingsSection$, "EnableQuickNav", "True"
menu$(SearchMenuID, SearchMenuEnableQuickNav) = CHR$(7) + "#Quick Navigation"
ELSE
WriteConfigSetting generalSettingsSection$, "EnableQuickNav", "False"
menu$(SearchMenuID, SearchMenuEnableQuickNav) = "#Quick Navigation"
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Code Layout..." THEN
PCOPY 2, 0
retval = idelayoutbox
IF retval THEN idechangemade = 1: idelayoutallow = 2: startPausedPending = 0 'recompile if options changed
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "Add/Remove #Bookmark Alt+Left" THEN
PCOPY 2, 0
bmkremoved = 0
bmkremoveb:
FOR b = 1 TO IdeBmkN
IF IdeBmk(b).y = idecy THEN
FOR b2 = b TO IdeBmkN - 1
IdeBmk(b2) = IdeBmk(b2 + 1)
NEXT
IdeBmkN = IdeBmkN - 1
bmkremoved = 1
ideunsaved = 1
GOTO bmkremoveb
END IF
NEXT
IF bmkremoved = 0 THEN
IdeBmkN = IdeBmkN + 1
IF IdeBmkN > UBOUND(IdeBmk) THEN x = UBOUND(IdeBmk) * 2: REDIM _PRESERVE IdeBmk(x) AS IdeBmkType
IdeBmk(IdeBmkN).y = idecy
IdeBmk(IdeBmkN).x = idecx
ideunsaved = 1
END IF
SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Next Bookmark Alt+Down" OR menu$(m, s) = "#Previous Bookmark Alt+Up" THEN
PCOPY 2, 0
IF IdeBmkN = 0 THEN
result = idemessagebox("Bookmarks", "No bookmarks exist (Use Alt+Left to create a bookmark)", "")
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF IdeBmkN = 1 THEN
IF idecy = IdeBmk(1).y THEN
result = idemessagebox("Bookmarks", "No other bookmarks exist", "")
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
l = idecy
z = 0: IF menu$(m, s) = "#Next Bookmark Alt+Down" THEN z = 1
DO
IF z = 1 THEN l = l + 1 ELSE l = l - 1
IF l < 1 THEN l = iden
IF l > iden THEN l = 1
FOR b = 1 TO IdeBmkN
IF IdeBmk(b).y = l THEN EXIT DO
NEXT
LOOP
AddQuickNavHistory
idecy = l
idecx = IdeBmk(b).x
ideselect = 0
SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Go To Line... Ctrl+G" THEN
PCOPY 2, 0
idegotobox
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Backup/Undo..." THEN
PCOPY 2, 0
retval = idebackupbox
'retval is ignored
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
'IF menu$(m, s) = "Check for #Newer Version..." THEN
' PCOPY 2, 0
' idecheckupdates
' PCOPY 3, 0: SCREEN , , 3, 0
' GOTO ideloop
'END IF
IF menu$(m, s) = "#About..." THEN
helpabout:
PCOPY 2, 0
'm$ = "QB64 Version " + Version$ '+ CHR$(10) + DevChannel$
m$ = "QB64.com's QB64" + CHR$(10) + _
"Version " + Version$ + CHR$(10) + _
"Copyright (C) The QB64.com Community, 2007-2022."
'IF LEN(AutoBuildMsg$) THEN
' m$ = m$ + CHR$(10) + AutoBuildMsg$
'ELSE
' m$ = m$ + CHR$(10) + DevChannel$
'END IF
'result = idemessagebox("About", m$, "")
result = idemessagebox("", m$, "")
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#ASCII Chart..." THEN
PCOPY 2, 0
relaunch = 0
DO
retval$ = ideASCIIbox$(relaunch)
IF LEN(retval$) THEN insertAtCursor retval$
PCOPY 3, 0: SCREEN , , 3, 0
GOSUB redrawItAll
ideshowtext
PCOPY 3, 0
LOOP WHILE relaunch
retval = 1
GOTO ideloop
END IF
IF menu$(m, s) = "Insert Quick #Keycode Ctrl+K" THEN
PCOPY 3, 0: SCREEN , , 3, 0
ideQuickKeycode:
dummy = DarkenFGBG(1)
clearStatusWindow 0
COLOR 15, 1
_PRINTSTRING (2, idewy - 3), "Press any key to insert its _KEYHIT/_KEYDOWN code..."
PCOPY 3, 0
tempk$ = ""
DO: tempk = _KEYHIT: _LIMIT 30: LOOP UNTIL tempk = 0 'wait for key release
DO 'get the next key hit
tempk = _KEYHIT
IF tempk > 0 THEN tempk$ = STR$(tempk)
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN GOTO bypassCtrlK
_LIMIT 30
LOOP UNTIL tempk > 0
IF tempk = 100303 OR tempk = 100304 THEN 'shift key
DO 'get the next key hit
tempk = _KEYHIT 'see what the next key is, and use it
IF tempk <> 0 THEN tempk$ = STR$(ABS(tempk)) 'if it's the SHFT UP code, then return the value for shift
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN GOTO bypassCtrlK
_LIMIT 30
LOOP UNTIL tempk <> 0
END IF
tempk$ = LTRIM$(tempk$)
'insert
insertAtCursor tempk$
bypassCtrlK:
dummy = DarkenFGBG(0)
PCOPY 3, 0: SCREEN , , 3, 0
retval = 1
KCTRL = 0: KCONTROL = 0
GOSUB redrawItAll
GOTO ideloop
END IF
IF LEFT$(menu$(m, s), 10) = "#Help On '" THEN 'Contextual menu Help
PCOPY 3, 0: SCREEN , , 3, 0
GOTO contextualhelp
END IF
IF LEFT$(menu$(m, s), 10) = "#Go To SUB" OR LEFT$(menu$(m, s), 15) = "#Go To FUNCTION" THEN 'Contextual menu Goto
PCOPY 3, 0: SCREEN , , 3, 0
AddQuickNavHistory
idecy = CVL(MID$(SubFuncLIST(1), 1, 4))
idesy = idecy
idecx = 1
idesx = 1
ideselect = 0
GOTO ideloop
END IF
IF LEFT$(menu$(m, s), 12) = "Go To #Label" THEN 'Contextual menu Goto label
PCOPY 3, 0: SCREEN , , 3, 0
AddQuickNavHistory
idecy = CVL(MID$(SubFuncLIST(UBOUND(SubFuncLIST)), 1, 4))
idesy = idecy
idecx = 1
idesx = 1
ideselect = 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Contents Page" THEN
PCOPY 3, 0: SCREEN , , 3, 0
lnk$ = "QB64 Help Menu"
GOTO OpenHelpLnk
END IF
IF menu$(m, s) = "Keyword #Index" THEN
PCOPY 3, 0: SCREEN , , 3, 0
lnk$ = "Keyword Reference - Alphabetical"
GOTO OpenHelpLnk
END IF
IF menu$(m, s) = "#Keywords By Usage" THEN
PCOPY 3, 0: SCREEN , , 3, 0
lnk$ = "Keyword Reference - By Usage"
GOTO OpenHelpLnk
END IF
IF menu$(m, s) = "#View Shift+F1" THEN
IF idehelp = 0 THEN
IF idesubwindow THEN PCOPY 3, 0: SCREEN , , 3, 0: GOTO ideloop
idesubwindow = idewy \ 2: idewy = idewy - idesubwindow
Help_wx1 = 2: Help_wy1 = idewy + 1: Help_wx2 = idewx - 1: Help_wy2 = idewy + idesubwindow - 2: Help_ww = Help_wx2 - Help_wx1 + 1: Help_wh = Help_wy2 - Help_wy1 + 1
idehelp = 1
skipdisplay = 0
IdeSystem = 3
retval = 1: GOSUB redrawItAll
END IF
GOTO ideloop
END IF
' removing the "View on Wiki" - @dualbrain
IF 1=0 AND menu$(m, s) = "View Current Page On #Wiki" THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF idehelp THEN GOTO launchWiki
GOTO ideloop
END IF
' removing the "View on Wiki" - @dualbrain
IF 1=0 AND menu$(m, s) = "#Update Current Page" THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF idehelp THEN
Help_IgnoreCache = 1
a$ = Wiki$(Back$(Help_Back_Pos))
WikiParse a$ 'reparse updated page incl. plugin templates
Help_IgnoreCache = 0
END IF
GOTO ideloop
END IF
IF menu$(m, s) = "#Math Evaluator..." THEN
STATIC mathEvalExpr$
'build initial name if word selected
IF ideselect THEN
IF ideselecty1 = idecy THEN 'single line selected
a$ = idegetline(idecy)
a2$ = ""
sx1 = ideselectx1: sx2 = idecx
IF sx2 < sx1 THEN SWAP sx1, sx2
FOR x = sx1 TO sx2 - 1
IF x <= LEN(a$) THEN a2$ = a2$ + MID$(a$, x, 1) ELSE EXIT FOR
NEXT
a2$ = _TRIM$(a2$)
IF LEN(a2$) THEN mathEvalExpr$ = a2$
END IF
END IF
DO
PCOPY 2, 0
retval$ = ideinputbox$("Math Evaluator", "#Enter expression", mathEvalExpr$, "", 60, 0, 0)
result = 0
IF LEN(retval$) THEN
mathEvalExpr$ = retval$
ev0$ = Evaluate_Expression$(retval$)
ev$ = ev0$
mathEvalError%% = INSTR(ev$, "ERROR") > 0
IF mathEvalError%% = 0 AND mathEvalHEX%% THEN ev$ = "&H" + HEX$(VAL(ev$))
DO
b1$ = "#Insert;"
IF mathEvalHEX%% THEN b2$ = "#Decimal;" ELSE b2$ = "#HEX$;"
IF mathEvalError%% = 0 AND mathEvalComment%% THEN
mathMsg$ = ev$ + " '" + retval$
b3$ = "#Uncomment;"
ELSE
mathMsg$ = ev$
b3$ = "Co#mment;"
END IF
IF mathEvalError%% THEN b1$ = "": b2$ = "": b3$ = ""
PCOPY 2, 0
result = idemessagebox("Math Evaluator - Result", mathMsg$, b1$ + b2$ + b3$ + "#Redo;#Cancel")
IF mathEvalError%% = 0 THEN
SELECT CASE result
CASE 1, 4, 5
EXIT DO
CASE 2
mathEvalHEX%% = NOT mathEvalHEX%%
IF mathEvalHEX%% THEN ev$ = "&H" + HEX$(VAL(ev$)) ELSE ev$ = ev0$
CASE 3
mathEvalComment%% = NOT mathEvalComment%%
END SELECT
ELSE
EXIT DO
END IF
LOOP
IF mathEvalError%% AND result = 2 THEN EXIT DO
IF mathEvalError%% = 0 AND (result = 1 OR result = 5) THEN EXIT DO
ELSE
EXIT DO
END IF
LOOP
IF mathEvalError%% = 0 AND result = 1 THEN
insertAtCursor mathMsg$
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
' removing the "View on Wiki" - @dualbrain
IF 1=0 AND menu$(m, s) = "Update All #Pages..." THEN
PCOPY 2, 0
q$ = ideyesnobox("Update Help", "This can take up to 20 minutes.\nRedownload all cached help content from the wiki?")
PCOPY 2, 0
IF q$ = "Y" THEN
Help_Recaching = 1: Help_IgnoreCache = 1
uerr = ideupdatehelpbox
Help_Recaching = 0: Help_IgnoreCache = 0
PCOPY 3, 0: SCREEN , , 3, 0
IF uerr THEN
lnk$ = "Update All"
GOTO OpenHelpLnk
END IF
END IF
GOTO ideloop
END IF
IF LEFT$(menu$(m, s), 8) = "New #SUB" THEN
PCOPY 2, 0
idenewsf "SUB"
ideselect = 0
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF LEFT$(menu$(m, s), 13) = "New #FUNCTION" THEN
PCOPY 2, 0
idenewsf "FUNCTION"
ideselect = 0
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#SUBs... F2" OR menu$(m, s) = "SUBs... F2" THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 14
GOTO EnterDebugMode
ELSE
PCOPY 2, 0
idesubsjmp:
r$ = idesubs
IF r$ <> "C" THEN ideselect = 0
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "#Line Numbers " + CHR$(16) THEN
idecontextualmenu = 2
GOTO showmenu
END IF
IF menu$(m, s) = "#Show Line Numbers" THEN
PCOPY 2, 0
ShowLineNumbers = -1
WriteConfigSetting generalSettingsSection$, "ShowLineNumbers", "True"
menu$(m, s) = "#Hide Line Numbers"
menu$(m, ViewMenuShowBGID) = MID$(menu$(m, ViewMenuShowBGID), 2)
menu$(m, ViewMenuShowSeparatorID) = MID$(menu$(m, ViewMenuShowSeparatorID), 2)
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Hide Line Numbers" THEN
PCOPY 2, 0
ShowLineNumbers = 0
WriteConfigSetting generalSettingsSection$, "ShowLineNumbers", "False"
menu$(m, s) = "#Show Line Numbers"
menu$(m, ViewMenuShowBGID) = "~" + menu$(m, ViewMenuShowBGID)
menu$(m, ViewMenuShowSeparatorID) = "~" + menu$(m, ViewMenuShowSeparatorID)
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF RIGHT$(menu$(m, s), 17) = "#Background Color" THEN
IF LEFT$(menu$(m, s), 1) <> "~" THEN
PCOPY 2, 0
ShowLineNumbersUseBG = NOT ShowLineNumbersUseBG
IF ShowLineNumbersUseBG THEN
WriteConfigSetting generalSettingsSection$, "ShowLineNumbersUseBG", "True"
menu$(m, s) = CHR$(7) + "#Background Color"
ELSE
WriteConfigSetting generalSettingsSection$, "ShowLineNumbersUseBG", "False"
menu$(m, s) = "#Background Color"
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
IF RIGHT$(menu$(m, s), 15) = "Sho#w Separator" THEN
IF LEFT$(menu$(m, s), 1) <> "~" THEN
PCOPY 2, 0
ShowLineNumbersSeparator = NOT ShowLineNumbersSeparator
IF ShowLineNumbersSeparator THEN
WriteConfigSetting generalSettingsSection$, "ShowLineNumbersSeparator", "True"
menu$(m, s) = CHR$(7) + "Sho#w Separator"
ELSE
WriteConfigSetting generalSettingsSection$, "ShowLineNumbersSeparator", "False"
menu$(m, s) = "Sho#w Separator"
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "Compiler #Warnings... Ctrl+W" THEN
PCOPY 2, 0
retval = idewarningbox
'retval is ignored
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Find... Ctrl+F3" THEN
PCOPY 2, 0
idefindjmp:
r$ = idefind
PCOPY 3, 0: SCREEN , , 3, 0
'...
GOTO ideloop
END IF
IF LEFT$(menu$(m, s), 6) = "Find '" THEN 'Contextual menu Find
idefindtext = idecontextualSearch$
IdeAddSearched idefindtext
PCOPY 3, 0: SCREEN , , 3, 0
GOTO idemf3
END IF
IF menu$(m, s) = "#Change... Alt+F3" THEN
PCOPY 2, 0
idefindchangejmp:
r$ = idechange
PCOPY 3, 0: SCREEN , , 3, 0
idealthighlight = 0
LOCATE , , 0: COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
IF r$ = "C" OR r$ = "" THEN GOTO ideloop
'assume "V", verify changes
IdeAddSearched idefindtext
oldcx = idecx: oldcy = idecy
found = 0: looped = 0
changed = 0
s$ = idefindtext$
IF idefindcasesens = 0 THEN s$ = UCASE$(s$)
start = idecy: y = start
startx = idecx: x1 = startx
first = 1
idefindnext2:
l$ = idegetline(y)
IF idefindcasesens = 0 THEN l$ = UCASE$(l$)
IF first = 1 THEN
first = 0
ELSE
x1 = 1
IF idefindbackwards THEN
x1 = LEN(l$) - LEN(s$) + 1
END IF
END IF
IF x1 < 0 THEN x1 = 0
idefindagain2:
IF idefindbackwards THEN
x = 0
FOR xx = x1 TO 1 STEP -1
IF ASC(l$, xx) = ASC(s$) THEN 'first char
xxo = xx - 1
FOR xx2 = xx TO xx + LEN(s$) - 1
IF ASC(l$, xx2) <> ASC(s$, xx2 - xxo) THEN EXIT FOR
NEXT
IF xx2 = xx + LEN(s$) THEN
'matched!
x = xx
EXIT FOR
END IF
END IF 'first char
NEXT
IF y = start AND looped = 1 AND x <= startx THEN x = 0
ELSE
x = INSTR(x1, l$, s$)
IF y = start AND looped = 1 AND x >= startx THEN x = 0
END IF
IF x THEN
IF idefindwholeword THEN
whole = 1
IF x > 1 THEN
c = ASC(UCASE$(MID$(l$, x - 1, 1)))
IF c >= 65 AND c <= 90 THEN whole = 0
IF c >= 48 AND c <= 57 THEN whole = 0
END IF
IF x + LEN(s$) <= LEN(l$) THEN
c = ASC(UCASE$(MID$(l$, x + LEN(s$), 1)))
IF c >= 65 AND c <= 90 THEN whole = 0
IF c >= 48 AND c <= 57 THEN whole = 0
END IF
IF whole = 0 THEN
x1 = x + 1: IF idefindbackwards THEN x1 = x - 1
x = 0
IF x1 > 0 AND x1 <= LEN(l$) THEN GOTO idefindagain2
END IF
END IF
END IF
DIM comment AS _BYTE, quote AS _BYTE
IF x THEN
FindQuoteComment l$, x, comment, quote
IF idefindnocomments <> 0 AND comment THEN x = 0
IF idefindnostrings <> 0 AND quote THEN x = 0
IF idefindonlycomments <> 0 AND comment = 0 THEN x = 0
IF idefindonlystrings <> 0 AND quote = 0 THEN x = 0
END IF
IF x THEN
ideselect = 1
idecx = x: idecy = y
idecentercurrentline
ideselectx1 = x + LEN(s$): ideselecty1 = y
found = 1
ideshowtext
SCREEN , , 0, 0: LOCATE , , 1: SCREEN , , 3, 0
PCOPY 3, 0
r$ = idechangeit
idedeltxt
PCOPY 3, 0: SCREEN , , 3, 0
ideselect = 0
IF r$ = "C" THEN
idecx = oldcx: idecy = oldcy
IF changed THEN
ideshowtext
SCREEN , , 0, 0: LOCATE , , 1: SCREEN , , 3, 0
PCOPY 3, 0
idechanged changed
END IF
GOTO ideloop
END IF
IF r$ = "Y" THEN
l$ = idegetline(idecy)
idechangemade = 1
startPausedPending = 0
IF LEN(l$) >= ideselectx1 THEN
l$ = LEFT$(l$, idecx - 1) + idechangeto$ + RIGHT$(l$, LEN(l$) - ideselectx1 + 1)
ELSE
l$ = LEFT$(l$, idecx - 1) + idechangeto$
END IF
idesetline idecy, l$
changed = changed + 1
IF idefindcasesens = 0 THEN l$ = UCASE$(l$)
IF idefindbackwards THEN
IF x <= startx AND y = start THEN startx = startx - LEN(s$) + LEN(idechangeto$) 'move startx according to the difference
ELSE
IF x <= startx AND y = start AND looped = 1 THEN startx = startx - LEN(s$) + LEN(idechangeto$) 'move startx according to the difference
x = x + LEN(idechangeto$) - 1 'skip changed portion
END IF
ELSE
'"N"
'(no action)
END IF
IF idefindbackwards THEN x1 = x - 1 ELSE x1 = x + 1
GOTO idefindagain2
END IF
IF idefindbackwards THEN
y = y - 1
IF y = start - 1 AND looped = 1 THEN
GOTO finishedchange
END IF
IF y < 1 THEN y = iden: looped = 1
GOTO idefindnext2
ELSE
y = y + 1
IF y = start + 1 AND looped = 1 THEN
GOTO finishedchange
END IF
IF y > iden THEN y = 1: looped = 1
GOTO idefindnext2
END IF
'-------------------------------------------------
finishedchange:
idecx = oldcx: idecy = oldcy
IF changed THEN
ideshowtext
SCREEN , , 0, 0: LOCATE , , 1: SCREEN , , 3, 0
PCOPY 3, 0
idechanged changed
ELSEIF found THEN
ideshowtext
SCREEN , , 0, 0: LOCATE , , 1: SCREEN , , 3, 0
PCOPY 3, 0
result = idemessagebox("Search complete", "No changes made.", "")
ELSE
idenomatch -1
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF '#Change...
IF menu$(m, s) = "Clear Search #History..." THEN
PCOPY 2, 0
r$ = ideclearhistory$("SEARCH")
IF r$ = "Y" THEN
fh = FREEFILE
OPEN ".\internal\temp\searched.bin" FOR OUTPUT AS #fh: CLOSE #fh
idefindtext = ""
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Repeat Last Find (Shift+) F3" THEN
PCOPY 3, 0: SCREEN , , 3, 0
GOTO idemf3
END IF
IF menu$(m, s) = "Cl#ear Del" THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeSystem = 1 AND ideselect = 1 THEN
idechangemade = 1
startPausedPending = 0
delselect
ELSEIF IdeSystem = 2 THEN
GOTO deleteSelectionSearchField
END IF
GOTO ideloop
END IF
IF menu$(m, s) = "#Paste Shift+Ins or Ctrl+V" THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeSystem = 1 THEN GOTO idempaste
IF IdeSystem = 2 THEN GOTO pasteIntoSearchField
END IF
IF menu$(m, s) = "#Copy Ctrl+Ins or Ctrl+C" THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeSystem = 1 AND ideselect = 1 THEN GOTO copy2clip
IF IdeSystem = 2 THEN GOTO copysearchterm2clip
IF IdeSystem = 3 AND Help_Select = 2 THEN GOTO copyhelp2clip
GOTO ideloop
END IF
IF menu$(m, s) = "Cu#t Shift+Del or Ctrl+X" THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeSystem = 1 AND ideselect = 1 THEN
K$ = CHR$(0) + "S" 'tricks handler into del after copy
GOTO idemcut
ELSEIF IdeSystem = 2 THEN
GOTO cutToClipboardSearchField
END IF
GOTO ideloop
END IF
IF menu$(m, s) = "#Undo Ctrl+Z" THEN
PCOPY 3, 0: SCREEN , , 3, 0
GOTO idemundo
END IF
IF menu$(m, s) = "#Redo Ctrl+Y" THEN
PCOPY 3, 0: SCREEN , , 3, 0
GOTO idemredo
END IF
IF menu$(m, s) = "Select #All Ctrl+A" THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeSystem = 1 THEN GOTO idemselectall
IF IdeSystem = 2 THEN GOTO selectAllInSearchField
IF IdeSystem = 3 THEN GOTO selectAllInHelp
END IF
IF menu$(m, s) = "Clo#se Help ESC" THEN
PCOPY 3, 0: SCREEN , , 3, 0
GOTO closeHelp
END IF
IF menu$(m, s) = "#Start F5" THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF LEN(ideprogname) = 0 THEN
NoExeSaved = -1
END IF
startPaused = 0
GOTO idemrun
END IF
IF menu$(m, s) = "Modify #COMMAND$..." THEN
PCOPY 2, 0
ModifyCOMMAND$ = " " + ideinputbox$("Modify COMMAND$", "#Enter text for COMMAND$", _TRIM$(ModifyCOMMAND$), "", 60, 0, 0)
IF _TRIM$(ModifyCOMMAND$) = "" THEN ModifyCOMMAND$ = ""
'retval is ignored
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "Make E#XE Only F11" OR menu$(m, s) = "Make E#xecutable Only F11" THEN
PCOPY 3, 0: SCREEN , , 3, 0
GOTO idemexe
END IF
IF menu$(m, s) = "Start #Paused F7 or F8" THEN
PCOPY 3, 0: SCREEN , , 3, 0
startPausedMenuHandler:
IF vWatchOn = 0 THEN
IF AutoAddDebugCommand = 0 THEN
SCREEN , , 3, 0
clearStatusWindow 2
COLOR 14, 1
x = 2
y = idewy - 2
printWrapStatus x, y, x, "$DEBUG metacommand is required to start paused."
PCOPY 3, 0
GOTO ideloop
END IF
result = idemessagebox("Start Paused", "Insert $DEBUG metacommand?", "#Yes;#No;#Don't show this again")
IF result = 1 THEN
ideselect = 0
ideinsline 1, SCase$("$Debug")
idecy = idecy + 1
idechangemade = 1
startPaused = -1
startPausedPending = -1
GOTO specialchar
ELSEIF result = 3 THEN
result = idemessagebox("Debug", "You can reenable the 'Auto-add $Debug Metacommand' feature\nin the Debug menu.", "#OK")
AutoAddDebugCommand = 0
WriteConfigSetting debugSettingsSection$, "AutoAddDebugCommand", "False"
menu$(DebugMenuID, DebugMenuAutoAddCommand) = "Auto-add $#Debug Metacommand"
END IF
GOTO ideloop
ELSE
startPausedPending = 0
startPaused = -1
GOTO idemrun
END IF
END IF
IF menu$(m, s) = "#Watch List... F4" THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 16
GOTO EnterDebugMode
ELSE
PCOPY 2, 0
showWatchList:
IF vWatchOn = 0 THEN
IF AutoAddDebugCommand = 0 THEN
SCREEN , , 3, 0
clearStatusWindow 2
COLOR 14, 1
x = 2
y = idewy - 2
printWrapStatus x, y, x, "$DEBUG metacommand is required for Watch List functionality."
PCOPY 3, 0
GOTO ideloop
END IF
result = idemessagebox("Watch List", "Insert $DEBUG metacommand?", "#Yes;#No;#Don't show this again")
IF result = 1 THEN
ideselect = 0
ideinsline 1, SCase$("$Debug")
idecy = idecy + 1
idechangemade = 1
ELSEIF result = 3 THEN
result = idemessagebox("Debug", "You can reenable the 'Auto-add $Debug Metacommand' feature\nin the Debug menu.", "#OK")
AutoAddDebugCommand = 0
WriteConfigSetting debugSettingsSection$, "AutoAddDebugCommand", "False"
menu$(DebugMenuID, DebugMenuAutoAddCommand) = "Auto-add $#Debug Metacommand"
END IF
GOTO ideloop
ELSE
IF idecompiling = 1 THEN
SCREEN , , 3, 0
COLOR 14, 1
x = 2
y = idewy - 2
printWrapStatus x, y, x, "Variable List will be available after syntax checking is done..."
waitingForVarList = 1
PCOPY 3, 0
GOTO ideloop
ELSE
result$ = idevariablewatchbox$("", "", 0, 0)
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "Call #Stack... F12" OR menu$(m, s) = "Call Stack... F12" THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 3
GOTO EnterDebugMode
ELSE
PCOPY 2, 0
showCallStackDialog:
retval = idecallstackbox
'retval is ignored
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "#Continue F5" THEN
IdeDebugMode = 4
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "Step O#ut F6" THEN
IdeDebugMode = 5
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "Ste#p Into F7" THEN
IdeDebugMode = 7
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "Step #Over F8" THEN
IdeDebugMode = 6
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "#Run To This Line Ctrl+Shift+G" THEN
IdeDebugMode = 8
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "#Exit $DEBUG mode ESC" THEN
IdeDebugMode = 9
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "Toggle #Breakpoint F9" THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 10
GOTO EnterDebugMode
ELSE
PCOPY 3, 0: SCREEN , , 3, 0
toggleBreakpoint:
IF vWatchOn = 0 THEN
IF AutoAddDebugCommand = 0 THEN
SCREEN , , 3, 0
clearStatusWindow 2
COLOR 14, 1
x = 2
y = idewy - 2
printWrapStatus x, y, x, "$DEBUG metacommand is required to enable breakpoints."
PCOPY 3, 0
GOTO ideloop
END IF
result = idemessagebox("Toggle Breakpoint", "Insert $DEBUG metacommand?", "#Yes;#No;#Don't show this again")
IF result = 1 THEN
ideselect = 0
ideinsline 1, SCase$("$Debug")
idecy = idecy + 1
idechangemade = 1
IdeBreakpoints(idecy) = NOT IdeBreakpoints(idecy)
ELSEIF result = 3 THEN
result = idemessagebox("Debug", "You can reenable the 'Auto-add $Debug Metacommand' feature\nin the Debug menu.", "#OK")
AutoAddDebugCommand = 0
WriteConfigSetting debugSettingsSection$, "AutoAddDebugCommand", "False"
menu$(DebugMenuID, DebugMenuAutoAddCommand) = "Auto-add $#Debug Metacommand"
END IF
ELSE
IdeBreakpoints(idecy) = NOT IdeBreakpoints(idecy)
END IF
IF IdeBreakpoints(idecy) THEN IdeSkipLines(idecy) = 0
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "#Clear All Breakpoints F10" OR menu$(m, s) = "Clear All Breakpoints F10" THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 11
GOTO EnterDebugMode
ELSE
PCOPY 3, 0: SCREEN , , 3, 0
clearAllBreakpoints:
REDIM IdeBreakpoints(iden) AS _BYTE
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "Toggle #Skip Line Ctrl+P" THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 12
GOTO EnterDebugMode
ELSE
PCOPY 3, 0: SCREEN , , 3, 0
toggleSkipLine:
IF vWatchOn = 0 THEN
IF AutoAddDebugCommand = 0 THEN
SCREEN , , 3, 0
clearStatusWindow 2
COLOR 14, 1
x = 2
y = idewy - 2
printWrapStatus x, y, x, "$DEBUG metacommand is required to enable line skipping."
PCOPY 3, 0
GOTO ideloop
END IF
result = idemessagebox("Toggle Skip Line", "Insert $DEBUG metacommand?", "#Yes;#No;#Don't show this again")
IF result = 1 THEN
ideselect = 0
ideinsline 1, SCase$("$Debug")
idecy = idecy + 1
idechangemade = 1
IdeSkipLines(idecy) = NOT IdeSkipLines(idecy)
ELSEIF result = 3 THEN
result = idemessagebox("Debug", "You can reenable the 'Auto-add $Debug Metacommand' feature\nin the Debug menu.", "#OK")
AutoAddDebugCommand = 0
WriteConfigSetting debugSettingsSection$, "AutoAddDebugCommand", "False"
menu$(DebugMenuID, DebugMenuAutoAddCommand) = "Auto-add $#Debug Metacommand"
END IF
ELSE
IdeSkipLines(idecy) = NOT IdeSkipLines(idecy)
END IF
IF IdeSkipLines(idecy) THEN IdeBreakpoints(idecy) = 0
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "#Unskip All Lines Ctrl+F10" THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 15
GOTO EnterDebugMode
ELSE
PCOPY 3, 0: SCREEN , , 3, 0
unskipAllLines:
REDIM IdeSkipLines(iden) AS _BYTE
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "Set Base #TCP/IP Port Number..." THEN
PCOPY 2, 0
bkpidebaseTcpPort = idebaseTcpPort
ideSetTCPPortBox
IF bkpidebaseTcpPort <> idebaseTcpPort THEN
IF host& <> 0 THEN CLOSE host&: host& = 0
attemptToHost = 0
changingTcpPort = -1
idechangemade = 1
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "Set #Next Line Ctrl+G" THEN
IdeDebugMode = 13
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "E#xit" THEN
PCOPY 2, 0
quickexit:
IF ideunsaved = 1 THEN
r$ = IdeSaveNow$
PCOPY 3, 0: SCREEN , , 3, 0
IF r$ = "C" OR r$ = "H" THEN GOTO ideloop
IF r$ = "Y" THEN
IF ideprogname = "" THEN
ProposedTitle$ = FindProposedTitle$
IF ProposedTitle$ = "" THEN
r$ = idefiledialog$("untitled" + tempfolderindexstr$ + ".bas", 2)
ELSE
r$ = idefiledialog$(ProposedTitle$ + ".bas", 2)
END IF
PCOPY 3, 0: SCREEN , , 3, 0
IF ideerror > 1 THEN GOTO IDEerrorMessage
IF r$ = "C" THEN GOTO ideloop
ELSE
idesave idepath$ + idepathsep$ + ideprogname$
END IF
END IF
END IF
fh = FREEFILE: OPEN tmpdir$ + "autosave.bin" FOR OUTPUT AS #fh: CLOSE #fh
SYSTEM
END IF
IF menu$(m, s) = "#New Ctrl+N" THEN
PCOPY 2, 0
ctrlNew:
IF ideunsaved = 1 THEN
r$ = IdeSaveNow$
PCOPY 3, 0: SCREEN , , 3, 0
IF r$ = "C" OR r$ = "H" THEN GOTO ideloop
IF r$ = "Y" THEN
IF ideprogname = "" THEN
ProposedTitle$ = FindProposedTitle$
IF ProposedTitle$ = "" THEN
r$ = idefiledialog$("untitled" + tempfolderindexstr$ + ".bas", 2)
ELSE
r$ = idefiledialog$(ProposedTitle$ + ".bas", 2)
END IF
PCOPY 3, 0: SCREEN , , 3, 0
IF ideerror > 1 THEN GOTO IDEerrorMessage
IF r$ = "C" THEN GOTO ideloop
ELSE
idesave idepath$ + idepathsep$ + ideprogname$
END IF
END IF
END IF
ideunsaved = -1
'new blank text field
REDIM IdeBreakpoints(1) AS _BYTE
REDIM IdeSkipLines(1) AS _BYTE
variableWatchList$ = ""
backupVariableWatchList$ = "": REDIM backupUsedVariableList(1000) AS usedVarList
backupTypeDefinitions$ = ""
watchpointList$ = ""
callstacklist$ = "": callStackLength = 0
idet$ = MKL$(0) + MKL$(0): idel = 1: ideli = 1: iden = 1: IdeBmkN = 0
idesx = 1
idesy = 1
idecx = 1
idecy = 1
ideselect = 0
ideprogname$ = ""
listOfCustomKeywords$ = LEFT$(listOfCustomKeywords$, customKeywordsLength)
QuickNavTotal = 0
ModifyCOMMAND$ = ""
_TITLE WindowTitle
startPausedPending = 0
idechangemade = 1
idefocusline = 0
ideundobase = 0 'reset
GOTO ideloop
END IF
AttemptToLoadRecent = 0
FOR ml = 1 TO UBOUND(IdeRecentLink, 1)
IF LEN(IdeRecentLink(ml, 1)) THEN
IF menu$(m, s) = IdeRecentLink(ml, 1) THEN
IdeOpenFile$ = IdeRecentLink(ml, 2)
AttemptToLoadRecent = -1
GOTO directopen
END IF
END IF
NEXT
IF menu$(m, s) = "#Recent..." THEN
PCOPY 2, 0
ideshowrecentbox:
f$ = iderecentbox
IF f$ = "<C>" THEN
f$ = ""
r$ = ideclearhistory$("FILES")
IF r$ = "Y" THEN
fh = FREEFILE
OPEN ".\internal\temp\recent.bin" FOR OUTPUT AS #fh: CLOSE #fh
IdeMakeFileMenu
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
ELSE
GOTO ideshowrecentbox
END IF
ELSEIF f$ = "<R>" THEN
GOSUB CleanUpRecentList
GOTO ideshowrecentbox
END IF
IF LEN(f$) THEN
IdeOpenFile$ = f$
AttemptToLoadRecent = -1
GOTO directopen
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Clear Recent..." THEN
PCOPY 2, 0
r$ = ideclearhistory$("FILES")
IF r$ = "Y" THEN
fh = FREEFILE
OPEN ".\internal\temp\recent.bin" FOR OUTPUT AS #fh: CLOSE #fh
IdeMakeFileMenu
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Open... Ctrl+O" THEN
IdeOpenFile$ = ""
directopen:
PCOPY 2, 0
ctrlOpen:
IF ideunsaved THEN
r$ = IdeSaveNow$
PCOPY 3, 0: SCREEN , , 3, 0
IF r$ = "C" OR r$ = "H" THEN GOTO ideloop
IF r$ = "Y" THEN
IF ideprogname = "" THEN
ProposedTitle$ = FindProposedTitle$
IF ProposedTitle$ = "" THEN
r$ = idefiledialog$("untitled" + tempfolderindexstr$ + ".bas", 2)
ELSE
r$ = idefiledialog$(ProposedTitle$ + ".bas", 2)
END IF
IF ideerror > 1 THEN PCOPY 3, 0: SCREEN , , 3, 0: GOTO IDEerrorMessage
IF r$ = "C" THEN GOTO ideloop
ELSE
idesave idepath$ + idepathsep$ + ideprogname$
END IF
PCOPY 3, 0: SCREEN , , 3, 0
END IF '"Y"
END IF 'unsaved
r$ = idefiledialog$("", 1)
IF ideerror > 1 THEN PCOPY 3, 0: SCREEN , , 3, 0: GOTO IDEerrorMessage
IF r$ <> "C" THEN ideunsaved = -1: idechangemade = 1: idelayoutallow = 2: ideundobase = 0: QuickNavTotal = 0: ModifyCOMMAND$ = "": idefocusline = 0: startPausedPending = 0
PCOPY 3, 0: SCREEN , , 3, 0
GOSUB redrawItAll: GOTO ideloop
END IF
IF menu$(m, s) = "#Save Ctrl+S" THEN '"#Save Ctrl+S" THEN
PCOPY 2, 0
IF ideprogname = "" THEN
ProposedTitle$ = FindProposedTitle$
IF ProposedTitle$ = "" THEN
a$ = idefiledialog$("untitled" + tempfolderindexstr$ + ".bas", 2)
ELSE
a$ = idefiledialog$(ProposedTitle$ + ".bas", 2)
END IF
IF ideerror > 1 THEN PCOPY 3, 0: SCREEN , , 3, 0: GOTO IDEerrorMessage
ELSE
idesave idepath$ + idepathsep$ + ideprogname$
END IF
PCOPY 3, 0: SCREEN , , 3, 0: GOTO ideloop
END IF
IF menu$(m, s) = "Save #As..." THEN
PCOPY 2, 0
IF ideprogname = "" THEN
ProposedTitle$ = FindProposedTitle$
IF ProposedTitle$ = "" THEN
a$ = idefiledialog$("untitled" + tempfolderindexstr$ + ".bas", 2)
ELSE
a$ = idefiledialog$(ProposedTitle$ + ".bas", 2)
END IF
ELSE
a$ = idefiledialog$(ideprogname$, 2)
END IF
PCOPY 3, 0: SCREEN , , 3, 0
IF ideerror > 1 THEN GOTO IDEerrorMessage
GOTO ideloop
END IF
IF LEFT$(menu$(m, s), 1) = "~" THEN 'Ignore disabled items (starting with "~")
_CONTINUE
END IF
SCREEN , , 0, 0
CLS: PRINT "MENU ITEM [" + menu$(m, s) + "] NOT IMPLEMENTED!": END
END IF
_LIMIT 100
LOOP
'--------------------------------------------------------------------------------
EXIT FUNCTION
DrawQuickNav:
IF IdeSystem = 1 AND QuickNavTotal > 0 THEN
COLOR 15, 7
_PRINTSTRING (4, 2), " " + CHR$(17) + " "
ELSE
COLOR 7, 1
_PRINTSTRING (4, 2), STRING$(3, 196)
END IF
RETURN
UpdateSearchBar:
COLOR 7, 1: _PRINTSTRING (idewx - (idesystem2.w + 10), idewy - 4), CHR$(180)
COLOR 3, 1
_PRINTSTRING (1 + idewx - (idesystem2.w + 10), idewy - 4), "Find[" + SPACE$(idesystem2.w + 1) + CHR$(18) + "]"
COLOR 7, 1: _PRINTSTRING (idewx - 2, idewy - 4), CHR$(195)
'add status title
COLOR 7, 1
a$ = STRING$(14, 196)
_PRINTSTRING ((idewx - LEN(a$)) / 2, idewy - 4), a$
IF IdeDebugMode THEN
COLOR 1, 7
a$ = " $DEBUG MODE "
ELSE
IF IdeSystem = 2 THEN COLOR 1, 7 ELSE COLOR 7, 1
a$ = " Status "
END IF
_PRINTSTRING ((idewx - LEN(a$)) / 2, idewy - 4), a$
a$ = idefindtext
tx = 1
IF LEN(a$) > idesystem2.w THEN
IF IdeSystem = 2 THEN
tx = idesystem2.v1 - idesystem2.w + 1
IF tx < 1 THEN tx = 1
a$ = MID$(a$, tx, idesystem2.w)
ELSE
a$ = LEFT$(a$, idesystem2.w)
END IF
END IF
sx1 = idesystem2.sx1: sx2 = idesystem2.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
x = x + 2
'apply selection color change if necessary
IF idesystem2.issel = 0 OR IdeSystem <> 2 THEN
COLOR 3, 1
_PRINTSTRING (idewx - (idesystem2.w + 8) + 4, idewy - 4), a$
ELSE
FOR ColorCHAR = 1 TO LEN(a$)
IF ColorCHAR + tx - 2 >= sx1 AND ColorCHAR + tx - 2 < sx2 THEN COLOR 1, 3 ELSE COLOR 3, 1
_PRINTSTRING (idewx - (idesystem2.w + 8) + 4 - 1 + ColorCHAR, idewy - 4), MID$(a$, ColorCHAR, 1)
NEXT
END IF
RETURN
CleanUpRecentList:
l$ = "": ln = 0
REDIM RecentFilesList(0) AS STRING
fh = FREEFILE
OPEN ".\internal\temp\recent.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$
CLOSE #fh
a$ = RIGHT$(a$, LEN(a$) - 2)
FoundBrokenLink = 0
DO WHILE LEN(a$)
ai = INSTR(a$, CRLF)
IF ai THEN
f$ = LEFT$(a$, ai - 1): IF ai = LEN(a$) - 1 THEN a$ = "" ELSE a$ = RIGHT$(a$, LEN(a$) - ai - 3)
IF _FILEEXISTS(f$) THEN
ln = ln + 1
REDIM _PRESERVE RecentFilesList(1 TO ln)
RecentFilesList(ln) = f$
ELSE
FoundBrokenLink = -1
END IF
END IF
LOOP
IF NOT FoundBrokenLink THEN
result = idemessagebox("Remove Broken Links", "All files in the list are accessible.", "#OK")
END IF
IF ln > 0 AND FoundBrokenLink THEN
fh = FREEFILE
OPEN ".\internal\temp\recent.bin" FOR OUTPUT AS #fh: CLOSE #fh
f$ = ""
FOR ln = 1 TO UBOUND(RecentFilesList)
f$ = f$ + CRLF + RecentFilesList(ln) + CRLF
NEXT
fh = FREEFILE
OPEN ".\internal\temp\recent.bin" FOR BINARY AS #fh
PUT #fh, 1, f$
CLOSE #fh
END IF
ERASE RecentFilesList
IdeMakeFileMenu
RETURN
redrawItAll:
menubar$ = " "
MenuLocations = ""
FOR i = 1 TO menus - 1
MenuLocations = MenuLocations + MKI$(LEN(menubar$))
menubar$ = menubar$ + menu$(i, 0) + " "
NEXT
menubar$ = menubar$ + SPACE$(idewx - LEN(menubar$) - LEN(menu$(i, 0)) - 2)
MenuLocations = MenuLocations + MKI$(LEN(menubar$))
menubar$ = menubar$ + menu$(i, 0) + " "
SCREEN , , 3, 0
VIEW PRINT 1 TO idewy + idesubwindow
'VIEW PRINT 1 TO _HEIGHT(0)
LOCATE , , , IDENormalCursorStart, IDENormalCursorEnd
'static background
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
COLOR 7, 1: idebox 1, 2, idewx, idewy - 5
COLOR 7, 1: idebox 1, idewy - 4, idewx, 5
'edit corners
COLOR 7, 1: _PRINTSTRING (1, idewy - 4), CHR$(195): _PRINTSTRING (idewx, idewy - 4), CHR$(180)
IF idehelp = 1 THEN
COLOR 7, 0: idebox 1, idewy, idewx, idesubwindow + 1
COLOR 7, 0: _PRINTSTRING (1, idewy), CHR$(195): _PRINTSTRING (idewx, idewy), CHR$(180)
' The "X" in the Help pane.
COLOR 7, 0: _PRINTSTRING (idewx - 4, idewy), CHR$(180)
Color 0, 7: _PRINTSTRING (idewx - 3, idewy), CHR$(25)
COLOR 7, 0: _PRINTSTRING (idewx - 2, idewy), CHR$(195)
END IF
GOSUB UpdateSearchBar
'status bar
COLOR 0, 3: _PRINTSTRING (1, idewy + idesubwindow), SPACE$(idewx)
q = idevbar(idewx, idewy - 3, 3, 1, 1)
q = idevbar(idewx, 3, idewy - 8, 1, 1)
q = idehbar(2, idewy - 5, idewx - 2, 1, 1)
UpdateIdeInfo
UpdateTitleOfMainWindow
DEF SEG = 0
ideshowtext
IF idehelp THEN
Help_ShowText
q = idehbar(2, idewy + idesubwindow - 1, idewx - 2, Help_cx, help_w + 1)
q = idevbar(idewx, idewy + 1, idesubwindow - 2, Help_cy, help_h + 1)
GOSUB HelpAreaShowBackLinks
END IF
IF IDEShowErrorsImmediately OR IDECompilationRequested THEN
clearStatusWindow 0
IdeInfo = ""
IF idecompiling = 1 THEN
_PRINTSTRING (2, idewy - 3), STRING$(3, 250) '"..."
ELSE
IF idefocusline THEN
_PRINTSTRING (2, idewy - 3), STRING$(3, 250) '"..."
ELSE
_PRINTSTRING (2, idewy - 3), "OK" 'report OK status
END IF
statusarealink = 0
IF totalWarnings > 0 THEN
COLOR 11, 1
msg$ = " (" + LTRIM$(STR$(totalWarnings)) + " warning"
IF totalWarnings > 1 THEN msg$ = msg$ + "s"
msg$ = msg$ + " - click here or Ctrl+W to view)"
_PRINTSTRING (4, idewy - 3), msg$
statusarealink = 4
END IF
IF waitingForVarList THEN GOSUB showVarListReady
END IF
END IF
RETURN
HelpAreaShowBackLinks:
IF 1=0 THEN ' removing the help "breadcrumb" - @dualbrain
Back_Str$ = STRING$(1000, 0)
Back_Str_I$ = STRING$(4000, 0)
top = UBOUND(back$)
FOR x = 1 TO top
n$ = Back_Name$(x)
IF x = Help_Back_Pos THEN p = LEN(Back_Str$)
Back_Str$ = Back_Str$ + " "
Back_Str_I$ = Back_Str_I$ + MKL$(x)
FOR x2 = 1 TO LEN(n$)
Back_Str$ = Back_Str$ + CHR$(ASC(n$, x2))
Back_Str_I$ = Back_Str_I$ + MKL$(x)
NEXT
Back_Str$ = Back_Str$ + " "
Back_Str_I$ = Back_Str_I$ + MKL$(x)
IF x <> top THEN
Back_Str$ = Back_Str$ + CHR$(0)
Back_Str_I$ = Back_Str_I$ + MKL$(0)
END IF
NEXT
Back_Str$ = Back_Str$ + STRING$(1000, 0)
Back_Str_I$ = Back_Str_I$ + STRING$(4000, 0)
Back_Str_Pos = p - idewx \ 2 + (LEN(Back_Name$(Help_Back_Pos)) + 2) \ 2 + 3
'COLOR 1, 2
'LOCATE idewy, 2: PRINT MID$(Back_Str$, Back_Str_Pos, idewx - 5)
LOCATE idewy, 2
FOR x = Back_Str_Pos TO Back_Str_Pos + idewx - 6
i = CVL(MID$(Back_Str_I$, (x - 1) * 4 + 1, 4))
a = ASC(Back_Str$, x)
IF a THEN
IF IdeSystem = 3 THEN COLOR 0, 7 ELSE COLOR 7, 0
IF i < Help_Back_Pos THEN COLOR 9
IF i > Help_Back_Pos THEN COLOR 9
PRINT CHR$(a);
ELSE
COLOR 7, 0
PRINT CHR$(196);
END IF
NEXT
ELSE
COLOR 7, 0
FOR lineCol = 2 TO idewx - 6
LOCATE idewy, lineCol: PRINT CHR$(196);
NEXT
COLOR 0, 7
Document_Title$ = Back$(Help_Back_Pos)
LOCATE idewy, (idewx - (LEN(Document_Title$) + 8)) \ 2 : PRINT " HELP: " + Document_Title$ + " "
END IF
IF 1=0 THEN ' removing the "View on Wiki" - @dualbrain
COLOR 7, 0: _PRINTSTRING (idewx - 18, idewy), CHR$(180)
COLOR 15, 3: _PRINTSTRING (idewx - 17, idewy), " View on Wiki "
END IF
RETURN
showVarListReady:
waitingForVarList = 0
COLOR 14, 1
_PRINTSTRING (2, idewy - 2), "Variable List is now available (F4 to see it)"
RETURN
END FUNCTION
SUB UpdateTitleOfMainWindow
sfname$ = FindCurrentSF$(idecy)
cleanSubName sfname$
COLOR 7, 1: _PRINTSTRING (2, 2), STRING$(idewx - 2, CHR$(196))
IF LEN(ideprogname) THEN a$ = ideprogname ELSE a$ = "Untitled" + tempfolderindexstr$
a$ = " " + a$
IF ideunsaved THEN a$ = a$ + "*"
IF LEN(sfname$) > 0 THEN a$ = a$ + ":" + sfname$
a$ = a$ + " "
IF LEN(a$) > idewx - 5 THEN a$ = LEFT$(a$, idewx - 11) + STRING$(3, 250) + " "
IF IdeSystem = 1 THEN COLOR 1, 7 ELSE COLOR 7, 1
_PRINTSTRING (((idewx / 2) - 1) - (LEN(a$) - 1) \ 2, 2), a$
END SUB
SUB DebugMode
STATIC AS _BYTE PauseMode, noFocusMessage, EnteredInput
STATIC buffer$
STATIC currentSub$
STATIC debuggeehwnd AS _OFFSET
STATIC panelActive AS _BYTE
DECLARE LIBRARY
SUB set_foreground_window (BYVAL hwnd AS _OFFSET)
END DECLARE
timeout = 10
_KEYCLEAR
SCREEN , , 3, 0
COLOR 15, 3: _PRINTSTRING (1, 1), SPACE$(LEN(menubar$))
m$ = "$DEBUG MODE ACTIVE"
_PRINTSTRING ((idewx - LEN(m$)) \ 2, 1), m$
TYPE vWatchPanelType
AS INTEGER x, y, w, h, firstVisible, hPos, vBarThumb, hBarThumb
AS INTEGER draggingVBar, draggingHBar, mX, mY
AS LONG contentWidth, tempIndex
AS _BYTE draggingPanel, resizingPanel, closingPanel, clicked
END TYPE
STATIC vWatchPanel AS vWatchPanelType
TYPE ui
AS INTEGER x, y, w, h
AS STRING caption
END TYPE
DIM Button(1 TO 8) AS ui
i = 0
i = i + 1: Button(i).Caption = "<F4 = Add Watch>"
i = i + 1: Button(i).Caption = "<F5 = Run>"
i = i + 1: Button(i).Caption = "<F6 = Step Out>"
i = i + 1: Button(i).Caption = "<F7 = Step Into>"
i = i + 1: Button(i).Caption = "<F8 = Step Over>"
i = i + 1: Button(i).Caption = "<F9 = Toggle Breakpoint>"
i = i + 1: Button(i).Caption = "<F10 = Clear all breakpoints>"
i = i + 1: Button(i).Caption = "<F12 = Call Stack>"
y = (idewy - 4) + 2
x = 2
FOR i = 1 TO UBOUND(Button)
Button(i).x = x
Button(i).y = y
Button(i).w = LEN(Button(i).Caption)
IF i < UBOUND(Button) THEN
x = x + Button(i).w + 1
IF x + LEN(Button(i + 1).Caption) > idewx - 1 THEN
y = y + 1
x = 2
END IF
END IF
NEXT
SELECT EVERYCASE IdeDebugMode
CASE 1
PauseMode = 0
callStackLength = 0
callstacklist$ = ""
buffer$ = ""
debugClient& = 0
debuggeepid = 0
panelActive = -1
showvWatchPanel vWatchPanel, "", 1
IF LEN(variableWatchList$) = 0 THEN
totalVisibleVariables = 0
vWatchPanel.h = 5
ELSE
'between edits, variables may have been deleted;
'next line assures we don't try to fetch values
'for ghost variables
result$ = idevariablewatchbox$("", "", -1, 0)
END IF
watchpointList$ = ""
vWatchPanel.w = 40
vWatchPanel.x = idewx - vWatchPanel.w - 6
vWatchPanel.y = 4
vWatchPanel.firstVisible = 1
x = VAL(ReadSetting$(".\internal\temp\debug.ini", "settings", "vWatchPanel.w"))
IF x THEN vWatchPanel.w = x
x = VAL(ReadSetting$(".\internal\temp\debug.ini", "settings", "vWatchPanel.h"))
IF x THEN vWatchPanel.h = x
x = VAL(ReadSetting$(".\internal\temp\debug.ini", "settings", "vWatchPanel.x"))
IF x THEN vWatchPanel.x = x
x = VAL(ReadSetting$(".\internal\temp\debug.ini", "settings", "vWatchPanel.y"))
IF x THEN vWatchPanel.y = x
GOSUB checkvWatchPanelSize
CASE IS > 1
noFocusMessage = NOT noFocusMessage
GOSUB UpdateStatusArea
clearStatusWindow 1
setStatusMessage 1, "Paused.", 2
CASE 2: IdeDebugMode = 1: GOTO returnFromContextMenu
CASE 3: IdeDebugMode = 1: GOTO requestCallStack
CASE 4: IdeDebugMode = 1: GOTO requestContinue
CASE 5: IdeDebugMode = 1: GOTO requestStepOut
CASE 6: IdeDebugMode = 1: GOTO requestStepOver
CASE 7: IdeDebugMode = 1: GOTO requestStepInto
CASE 8
IdeDebugMode = 1
result = idecy
GOTO requestRunToThisLine
CASE 9: IdeDebugMode = 1: GOTO requestQuit
CASE 10: IdeDebugMode = 1: GOTO requestToggleBreakpoint
CASE 11: IdeDebugMode = 1: GOTO requestClearBreakpoints
CASE 12
IdeDebugMode = 1
result = idecy
GOTO requestToggleSkipLine
CASE 13
IdeDebugMode = 1
result = idecy
GOTO requestSetNextLine
CASE 14: IdeDebugMode = 1: GOTO requestSubsDialog
CASE 15: IdeDebugMode = 1: GOTO requestUnskipAllLines
CASE 16: IdeDebugMode = 1: GOTO requestVariableWatch
END SELECT
dummy = DarkenFGBG(1)
clearStatusWindow 0
setStatusMessage 1, "Entering $DEBUG mode (ESC to abort)...", 15
IF host& = 0 THEN
host& = _OPENHOST("TCP/IP:" + hostport$)
IF host& = 0 THEN
dummy = DarkenFGBG(0)
clearStatusWindow 1
setStatusMessage 1, "Failed to initiate debug session.", 7
setStatusMessage 2, "Cannot receive connections on port" + STR$(idebaseTcpPort) + ". Check your firewall permissions.", 2
WHILE _MOUSEINPUT: WEND
EXIT SUB
END IF
END IF
'wait for client to connect
start! = TIMER
DO
debugClient& = _OPENCONNECTION(host&)
IF debugClient& THEN EXIT DO
k& = _KEYHIT
IF k& = 27 OR TIMER - start! > timeout THEN
dummy = DarkenFGBG(0)
clearStatusWindow 0
setStatusMessage 1, temp$ + "Debug session aborted.", 7
IF k& <> 27 THEN
setStatusMessage 2, "Connection timeout.", 2
END IF
_KEYCLEAR
WHILE _MOUSEINPUT: WEND
EXIT SUB
END IF
_LIMIT 100
LOOP
ideselect = 0
clearStatusWindow 1
setStatusMessage 1, "Handshaking...", 15
start! = TIMER
DO
k& = _KEYHIT
IF k& = 27 OR TIMER - start! > timeout THEN
dummy = DarkenFGBG(0)
clearStatusWindow 0
setStatusMessage 1, temp$ + "Debug session aborted.", 7
IF k& <> 27 THEN
setStatusMessage 2, "Connection timeout.", 2
END IF
_KEYCLEAR
WHILE _MOUSEINPUT: WEND
EXIT SUB
END IF
GOSUB GetCommand
SELECT CASE cmd$
CASE "me"
program$ = value$
expected$ = lastBinaryGenerated$
p$ = ideztakepath$(program$)
p$ = ideztakepath$(expected$)
IF program$ <> expected$ THEN
dummy = DarkenFGBG(0)
clearStatusWindow 1
setStatusMessage 1, "Failed to initiate debug session.", 7
setStatusMessage 2, LEFT$("Expected: " + expected$, idewx - 2), 2
setStatusMessage 3, LEFT$("Received: " + program$, idewx - 2), 2
cmd$ = "vwatch:file mismatch"
GOSUB SendCommand
CLOSE #debugClient&
WHILE _MOUSEINPUT: WEND
EXIT SUB
END IF
EXIT DO
END SELECT
LOOP
cmd$ = "vwatch:ok"
GOSUB SendCommand
cmd$ = "hwnd:" + _MK$(_OFFSET, _WINDOWHANDLE)
GOSUB SendCommand
cmd$ = "line count:" + MKL$(iden)
GOSUB SendCommand
breakpointCount = 0
breakpointList$ = ""
FOR i = 1 TO UBOUND(IdeBreakpoints)
IF IdeBreakpoints(i) THEN
breakpointCount = breakpointCount + 1
breakpointList$ = breakpointList$ + MKL$(i)
END IF
NEXT
IF breakpointCount THEN
cmd$ = "breakpoint count:" + MKL$(breakpointCount)
GOSUB SendCommand
cmd$ = "breakpoint list:" + breakpointList$
GOSUB SendCommand
END IF
skipCount = 0
skipList$ = ""
FOR i = 1 TO UBOUND(IdeSkipLines)
IF IdeSkipLines(i) THEN
skipCount = skipCount + 1
skipList$ = skipList$ + MKL$(i)
END IF
NEXT
IF skipCount THEN
cmd$ = "skip count:" + MKL$(skipCount)
GOSUB SendCommand
cmd$ = "skip list:" + skipList$
GOSUB SendCommand
END IF
clearStatusWindow 1
IF startPaused THEN
cmd$ = "break"
PauseMode = -1
setStatusMessage 1, "Paused.", 2
ELSE
cmd$ = "run"
PauseMode = 0
setStatusMessage 1, "Running...", 10
END IF
GOSUB SendCommand
clearStatusWindow 2
setStatusMessage 2, "$DEBUG MODE: Set focus to the IDE to control execution", 15
noFocusMessage = -1
DO 'main loop
IF _EXIT THEN ideexit = 1: GOTO requestQuit
bkpidecy = idecy
bkpPanelFirstVisible = vWatchPanel.firstVisible
WHILE _MOUSEINPUT
mX = _MOUSEX
mY = _MOUSEY
vWatchPanel.mX = mX
vWatchPanel.mY = mY
IF LEN(variableWatchList$) > 0 AND _
(mX >= vWatchPanel.x AND mX <= vWatchPanel.x + vWatchPanel.w) AND _
(mY >= vWatchPanel.y AND mY <= vWatchPanel.y + vWatchPanel.h) THEN
vWatchPanel.firstVisible = vWatchPanel.firstVisible + _MOUSEWHEEL * 3
IF vWatchPanel.firstVisible < 1 THEN vWatchPanel.firstVisible = 1
IF vWatchPanel.firstVisible > totalVisibleVariables - (vWatchPanel.h - 2) + 1 THEN
vWatchPanel.firstVisible = totalVisibleVariables - (vWatchPanel.h - 2) + 1
END IF
ELSE
idecy = idecy + _MOUSEWHEEL * 3
END IF
WEND
IF idecy < 1 THEN idecy = 1
IF idecy > iden THEN idecy = iden
IF idecy <> bkpidecy OR bkpPanelFirstVisible <> vWatchPanel.firstVisible OR _
(LEN(variableWatchList$) > 0 AND _
(mX >= vWatchPanel.x AND mX <= vWatchPanel.x + vWatchPanel.w) AND _
(mY >= vWatchPanel.y AND mY <= vWatchPanel.y + vWatchPanel.h)) THEN
ideselect = 0: GOSUB UpdateDisplay
END IF
mB = _MOUSEBUTTON(1)
mB2 = _MOUSEBUTTON(2)
IF mB2 THEN
IF mouseDown2 = 0 THEN
mouseDown2 = -1
mouseDownOnX2 = mX
mouseDownOnY2 = mY
ELSE
END IF
ELSE
IF mouseDown2 THEN
IF mouseDownOnX2 = mX AND mouseDownOnY2 = mY THEN
'right-click on watch panel?
IF (LEN(variableWatchList$) > 0 AND _
(mX >= vWatchPanel.x AND mX <= vWatchPanel.x + vWatchPanel.w) AND _
(mY >= vWatchPanel.y AND mY <= vWatchPanel.y + vWatchPanel.h)) THEN
GOTO requestVariableWatch
END IF
'right-click on code area?
IF (mX > 1 AND mX <= 1 + maxLineNumberLength AND mY > 2 AND mY < (idewy - 5) AND ShowLineNumbers) OR _
(mX = 1 AND mY > 2 AND mY < (idewy - 5) AND ShowLineNumbers = 0) OR _
(mX > 1 + maxLineNumberLength AND mX < idewx AND mY > 2 AND mY < (idewy - 5)) THEN
bkpidecy = idecy
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN idecy = iden
IF bkpidecy <> idecy THEN ideselect = 0: GOSUB UpdateDisplay
IdeDebugMode = 2
IF PauseMode = 0 THEN GOSUB requestPause: dummy = DarkenFGBG(0)
EXIT SUB
returnFromContextMenu:
GOSUB UpdateDisplay
END IF
END IF
END IF
mouseDown2 = 0
END IF
IF mB THEN
IF mouseDown = 0 THEN
mouseDown = -1
mouseDownOnX = mX
mouseDownOnY = mY
IF LEN(variableWatchList$) > 0 AND _
(mX >= vWatchPanel.x + vWatchPanel.w - 3) AND (mX <= vWatchPanel.x + vWatchPanel.w - 1) AND _
(mY = vWatchPanel.y) THEN
vWatchPanel.closingPanel = -1
ELSEIF LEN(variableWatchList$) > 0 AND vWatchPanel.vBarThumb > 0 AND _
(mX = vWatchPanel.x + vWatchPanel.w - 1) AND _
(mY = vWatchPanel.vBarThumb) THEN
vWatchPanel.draggingVBar = 1 'thumb
ELSEIF LEN(variableWatchList$) > 0 AND vWatchPanel.vBarThumb > 0 AND _
(mX = vWatchPanel.x + vWatchPanel.w - 1) AND _
(mY = vWatchPanel.y + 1) THEN
vWatchPanel.draggingVBar = 2 'up arrow
ELSEIF LEN(variableWatchList$) > 0 AND vWatchPanel.vBarThumb > 0 AND _
(mX = vWatchPanel.x + vWatchPanel.w - 1) AND _
(mY = vWatchPanel.y + vWatchPanel.h - 2) THEN
vWatchPanel.draggingVBar = 3 'down arrow
ELSEIF LEN(variableWatchList$) > 0 AND vWatchPanel.hBarThumb > 0 AND _
(mX = vWatchPanel.hBarThumb) AND _
(mY = vWatchPanel.y + vWatchPanel.h - 1) THEN
vWatchPanel.draggingHBar = 1 'thumb
ELSEIF LEN(variableWatchList$) > 0 AND vWatchPanel.hBarThumb > 0 AND _
(mX = vWatchPanel.x) AND _
(mY = vWatchPanel.y + vWatchPanel.h - 1) THEN
vWatchPanel.draggingHBar = 2 'left arrow
ELSEIF LEN(variableWatchList$) > 0 AND vWatchPanel.hBarThumb > 0 AND _
(mX = vWatchPanel.x + vWatchPanel.w - 2) AND _
(mY = vWatchPanel.y + vWatchPanel.h - 1) THEN
vWatchPanel.draggingHBar = 3 'right arrow
ELSEIF LEN(variableWatchList$) > 0 AND _
(mX = vWatchPanel.x + vWatchPanel.w - 1) AND _
(mY = vWatchPanel.y + vWatchPanel.h - 1) THEN
vWatchPanel.resizingPanel = -1
ELSEIF LEN(variableWatchList$) > 0 AND _
(mX >= vWatchPanel.x AND mX <= vWatchPanel.x + vWatchPanel.w) AND _
(mY >= vWatchPanel.y AND mY <= vWatchPanel.y + vWatchPanel.h) THEN
vWatchPanel.draggingPanel = -1
vWatchPanel.clicked = 1
IF timeElapsedSince(lastPanelClick!) < .3 THEN
'Double-click on watch list
vWatchPanel.draggingPanel = 0
mouseDown = 0
GOTO requestVariableWatch
END IF
lastPanelClick! = TIMER
ELSE
vWatchPanel.draggingPanel = 0
vWatchPanel.resizingPanel = 0
vWatchPanel.closingPanel = 0
vWatchPanel.draggingVBar = 0
vWatchPanel.draggingHBar = 0
vWatchPanel.clicked = 0
END IF
IF mX = idewx THEN
IF mY = idevbar(idewx, 3, idewy - 8, idecy, iden) THEN
draggingVThumb = -1
ELSE
draggingVThumb = 0
END IF
ELSE
draggingVThumb = 0
END IF
IF mY = idewy - 5 THEN
IF mX = idehbar(2, idewy - 5, idewx - 2, idesx, 608) THEN
draggingHThumb = -1
ELSE
draggingHThumb = 0
END IF
ELSE
draggingHThumb = 0
END IF
mouseDownOnButton = 0
FOR i = 1 TO UBOUND(Button)
IF mY = Button(i).y AND mX >= Button(i).x AND mX <= Button(i).x + Button(i).w AND _
vWatchPanel.draggingPanel = 0 AND vWatchPanel.resizingPanel = 0 THEN
mouseDownOnButton = i
EXIT FOR
END IF
NEXT
ELSE
'drag
IF draggingVThumb = -1 THEN
IF mouseDownOnY <> mY THEN
mouseDownOnY = mY
IF iden > 1 THEN
IF mY <= 4 THEN idecy = 1
IF mY >= idewy - 7 THEN idecy = iden
IF mY > 4 AND mY < idewy - 7 THEN
y = mY
p! = y - 3 - 2 + .5
p! = p! / ((idewy - 8) - 4)
i = p! * (iden - 1) + 1
idecy = i
END IF
END IF
ideselect = 0: GOSUB UpdateDisplay
END IF
END IF
IF draggingHThumb = -1 THEN
IF mouseDownOnX <> mX THEN
mouseDownOnX = mX
IF mX <= 3 THEN idesx = 1: idecx = idesx
IF mX >= idewx - 2 THEN idesx = 608: idecx = idesx
IF mX > 3 AND mX < idewx - 2 THEN
x = mX
p! = x - 2 - 2 + .5
p! = p! / ((idewx - 2) - 4)
i = p! * (608 - 1) + 1
idesx = i
idecx = idesx
END IF
GOSUB UpdateDisplay
END IF
END IF
vWatchPanelLimit = idewy - 6
IF vWatchPanel.draggingPanel THEN
vWatchPanel.x = vWatchPanel.x - (mouseDownOnX - mX)
vWatchPanel.y = vWatchPanel.y - (mouseDownOnY - mY)
IF vWatchPanel.x < 2 THEN vWatchPanel.x = 2
IF vWatchPanel.x + vWatchPanel.w > idewx - 1 THEN vWatchPanel.x = idewx - vWatchPanel.w - 1
IF vWatchPanel.y < 3 THEN vWatchPanel.y = 3
IF vWatchPanel.y > vWatchPanelLimit - (vWatchPanel.h - 1) THEN vWatchPanel.y = vWatchPanelLimit - (vWatchPanel.h - 1)
IF mouseDownOnX <> mX THEN vWatchPanel.clicked = 0
mouseDownOnX = mX
IF mouseDownOnY <> mY THEN vWatchPanel.clicked = 0
mouseDownOnY = mY
GOSUB UpdateDisplay
ELSEIF vWatchPanel.resizingPanel THEN
vWatchPanel.w = vWatchPanel.w + (mX - mouseDownOnX)
vWatchPanel.h = vWatchPanel.h + (mY - mouseDownOnY)
GOSUB checkvWatchPanelSize
IF vWatchPanel.vBarThumb > 0 AND vWatchPanel.firstVisible > totalVisibleVariables - (vWatchPanel.h - 2) + 1 THEN
vWatchPanel.firstVisible = totalVisibleVariables - (vWatchPanel.h - 2) + 1
END IF
IF vWatchPanel.hBarThumb > 0 AND vWatchPanel.hPos > vWatchPanel.contentWidth - (vWatchPanel.w - 4) + 1 THEN
vWatchPanel.hPos = vWatchPanel.contentWidth - (vWatchPanel.w - 4) + 1
END IF
mouseDownOnX = mX
mouseDownOnY = mY
GOSUB UpdateDisplay
ELSEIF vWatchPanel.draggingVBar = 1 THEN
vWatchPanel.firstVisible = INT(map(mY, vWatchPanel.y + 2, vWatchPanel.y + vWatchPanel.h - 2, 1, totalVisibleVariables - (vWatchPanel.h - 2) + 1))
IF vWatchPanel.firstVisible < 1 THEN vWatchPanel.firstVisible = 1
IF vWatchPanel.firstVisible > totalVisibleVariables - (vWatchPanel.h - 2) + 1 THEN
vWatchPanel.firstVisible = totalVisibleVariables - (vWatchPanel.h - 2) + 1
END IF
GOSUB UpdateDisplay
ELSEIF vWatchPanel.draggingHBar = 1 THEN
vWatchPanel.hPos = INT(map(mX, vWatchPanel.x, vWatchPanel.x + vWatchPanel.w - 2, 1, vWatchPanel.contentWidth - (vWatchPanel.w - 4) + 1))
IF vWatchPanel.hPos < 1 THEN vWatchPanel.hPos = 1
IF vWatchPanel.hPos > vWatchPanel.contentWidth - (vWatchPanel.w - 4) + 1 THEN
vWatchPanel.hPos = vWatchPanel.contentWidth - (vWatchPanel.w - 4) + 1
END IF
GOSUB UpdateDisplay
END IF
END IF
ELSE 'mouse button released
IF vWatchPanel.clicked = 1 THEN
vWatchPanel.clicked = 2
'panel was clicked but not dragged, so register a click (= 2)
'which will be handled by showvWatchPanel()
END IF
IF vWatchPanel.draggingPanel THEN
vWatchPanel.draggingPanel = 0: mouseDown = 0
WriteSetting ".\internal\temp\debug.ini", "settings", "vWatchPanel.x", str2$(vWatchPanel.x)
WriteSetting ".\internal\temp\debug.ini", "settings", "vWatchPanel.y", str2$(vWatchPanel.y)
END IF
IF vWatchPanel.resizingPanel THEN
vWatchPanel.resizingPanel = 0: mouseDown = 0
WriteSetting ".\internal\temp\debug.ini", "settings", "vWatchPanel.w", str2$(vWatchPanel.w)
WriteSetting ".\internal\temp\debug.ini", "settings", "vWatchPanel.h", str2$(vWatchPanel.h)
END IF
IF vWatchPanel.closingPanel AND (mX = mouseDownOnX AND mY = mouseDownOnY) THEN
vWatchPanel.closingPanel = 0
mouseDown = 0
panelActive = 0
result = idemessagebox("$DEBUG MODE", "Close Watch Panel", "#Keep Variables;#Clear List")
IF result = 2 THEN
variableWatchList$ = ""
backupVariableWatchList$ = "": REDIM backupUsedVariableList(1000) AS usedVarList
backupTypeDefinitions$ = ""
FOR i = 1 TO totalVariablesCreated
usedVariableList(i).watch = 0
NEXT
'Reset panel position in debug settings
WriteSetting ".\internal\temp\debug.ini", "settings", "vWatchPanel.x", "0"
WriteSetting ".\internal\temp\debug.ini", "settings", "vWatchPanel.y", "0"
WriteSetting ".\internal\temp\debug.ini", "settings", "vWatchPanel.w", "0"
WriteSetting ".\internal\temp\debug.ini", "settings", "vWatchPanel.h", "0"
END IF
PCOPY 3, 0: SCREEN , , 3, 0
WHILE _MOUSEINPUT: WEND
GOSUB UpdateDisplay
END IF
IF vWatchPanel.draggingVBar THEN
IF vWatchPanel.draggingVBar = 2 THEN
vWatchPanel.firstVisible = vWatchPanel.firstVisible - 1
IF vWatchPanel.firstVisible < 1 THEN vWatchPanel.firstVisible = 1
GOSUB UpdateDisplay
ELSEIF vWatchPanel.draggingVBar = 3 THEN
vWatchPanel.firstVisible = vWatchPanel.firstVisible + 1
IF vWatchPanel.firstVisible > totalVisibleVariables - (vWatchPanel.h - 2) + 1 THEN
vWatchPanel.firstVisible = totalVisibleVariables - (vWatchPanel.h - 2) + 1
END IF
GOSUB UpdateDisplay
END IF
vWatchPanel.draggingVBar = 0: mouseDown = 0
END IF
IF vWatchPanel.draggingHBar THEN
IF vWatchPanel.draggingHBar = 2 THEN
vWatchPanel.hPos = vWatchPanel.hPos - 1
IF vWatchPanel.hPos < 1 THEN vWatchPanel.hPos = 1
GOSUB UpdateDisplay
ELSEIF vWatchPanel.draggingHBar = 3 THEN
vWatchPanel.hPos = vWatchPanel.hPos + 1
IF vWatchPanel.hPos > vWatchPanel.contentWidth - (vWatchPanel.w - 4) + 1 THEN
vWatchPanel.hPos = vWatchPanel.contentWidth - (vWatchPanel.w - 4) + 1
END IF
GOSUB UpdateDisplay
END IF
vWatchPanel.draggingHBar = 0: mouseDown = 0
END IF
IF mouseDown THEN
mouseDown = 0
draggingVThumb = 0
draggingHThumb = 0
IF mouseDownOnButton > 0 AND mX = mouseDownOnX AND mY = mouseDownOnY THEN
SELECT CASE mouseDownOnButton
CASE 1: mouseDownOnButton = 0: mouseDown = 0: GOTO F4
CASE 2: mouseDownOnButton = 0: mouseDown = 0: GOTO F5
CASE 3: mouseDownOnButton = 0: mouseDown = 0: GOTO F6
CASE 4: mouseDownOnButton = 0: mouseDown = 0: GOTO F7
CASE 5: mouseDownOnButton = 0: mouseDown = 0: GOTO F8
CASE 6: mouseDownOnButton = 0: mouseDown = 0: GOTO F9
CASE 7: mouseDownOnButton = 0: mouseDown = 0: GOTO F10
CASE 8: mouseDownOnButton = 0: mouseDown = 0: GOTO F12
END SELECT
END IF
IF (mX > 1 AND mX <= 1 + maxLineNumberLength AND mY > 2 AND mY < (idewy - 5) AND ShowLineNumbers) OR _
(mX = 1 AND mY > 2 AND mY < (idewy - 5) AND ShowLineNumbers = 0) THEN
'Inside the editor/line numbers
IF mouseDownOnX = mX AND mouseDownOnY = mY THEN
ideselect = 0
idecytemp = mY - 2 + idesy - 1
IF idecytemp <= iden THEN
IF _KEYDOWN(100304) OR _KEYDOWN(100303) THEN
IF IdeSkipLines(idecytemp) = -1 THEN
IdeSkipLines(idecytemp) = 0
cmd$ = "clear skip line:" + MKL$(idecytemp)
ELSE
IdeSkipLines(idecytemp) = -1
IdeBreakpoints(idecytemp) = 0
cmd$ = "set skip line:" + MKL$(idecytemp)
END IF
ELSE
IF IdeBreakpoints(idecytemp) THEN
IdeBreakpoints(idecytemp) = 0
cmd$ = "clear breakpoint:"
ELSE
IdeBreakpoints(idecytemp) = -1
IdeSkipLines(idecytemp) = 0
cmd$ = "set breakpoint:"
END IF
cmd$ = cmd$ + MKL$(idecytemp)
END IF
GOSUB SendCommand
GOSUB UpdateDisplay
END IF
END IF
ELSEIF mX > 1 + maxLineNumberLength AND mX < idewx AND mY > 2 AND mY < (idewy - 5) THEN
'inside text box
bkpidecy = idecy
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN idecy = iden
IF bkpidecy <> idecy THEN ideselect = 0: GOSUB UpdateDisplay
ELSEIF mX = idewx AND mY > 2 AND mY < idewy - 5 THEN
'inside vbar
IF mouseDownOnX = mX AND mouseDownOnY = mY THEN
IF mY = 3 THEN GOTO keyUp
IF mY = idewy - 6 THEN GOTO keyDown
IF mY > 3 AND mY < (idewy - 6) THEN
'assume not on slider
IF iden > 1 THEN 'take no action if not slider available
y = idevbar(idewx, 3, idewy - 8, idecy, iden)
IF y <> mY THEN
IF mY < y THEN
GOTO pageUp
ELSE
GOTO pageDown
END IF
END IF
END IF
END IF
END IF
ELSEIF mY = idewy - 4 AND mX > idewx - (idesystem2.w + 10) AND mX < idewx - 1 THEN
'inside "Find" box
GOTO findjmp
END IF
ELSE
mouseDown = 0
draggingVThumb = 0
draggingHThumb = 0
vWatchPanel.draggingPanel = 0
vWatchPanel.resizingPanel = 0
vWatchPanel.closingPanel = 0
vWatchPanel.draggingVBar = 0
vWatchPanel.draggingHBar = 0
END IF
END IF
UpdateStatusArea:
IF _WINDOWHASFOCUS THEN
IF noFocusMessage THEN
UpdateMenuHelpLine "Right-click for options; ESC to abort."
GOSUB printVersion
GOSUB UpdateButtons
noFocusMessage = 0
END IF
ELSE
IF noFocusMessage = 0 THEN
clearStatusWindow 2
clearStatusWindow 3
setStatusMessage 2, "Set focus to the IDE to control execution", 15
noFocusMessage = -1
END IF
END IF
IF IdeDebugMode > 1 THEN RETURN
k& = _KEYHIT
SELECT CASE k&
CASE 18432 'Up arrow
keyUp:
bkpidecy = idecy: bkpidesy = idesy
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN 'scroll the window, instead of moving the cursor
idesy = idesy - 1
IF idesy < 1 THEN idesy = 1
IF idecy > idesy + (idewy - 9) THEN idecy = idesy + (idewy - 9)
ELSE
idecy = idecy - 1
IF idecy < 1 THEN idecy = 1
END IF
IF bkpidecy <> idecy OR bkpidesy <> idesy THEN ideselect = 0: GOSUB UpdateDisplay
CASE 20480 'Down arrow
keyDown:
bkpidecy = idecy: bkpidesy = idesy
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN 'scroll the window, instead of moving the cursor
idesy = idesy + 1
IF idesy > iden THEN idesy = iden
IF idecy < idesy THEN idecy = idesy
ELSE
idecy = idecy + 1
IF idecy > iden THEN idecy = iden
END IF
IF bkpidecy <> idecy OR bkpidesy <> idesy THEN ideselect = 0: GOSUB UpdateDisplay
CASE 18688 'Page up
pageUp:
bkpidecy = idecy: bkpidesy = idesy
idecy = idecy - (idewy - 9)
IF idecy < 1 THEN idecy = 1
IF bkpidecy <> idecy OR bkpidesy <> idesy THEN ideselect = 0: GOSUB UpdateDisplay
CASE 20736 'Page down
pageDown:
bkpidecy = idecy: bkpidesy = idesy
idecy = idecy + (idewy - 9)
IF idecy > iden THEN idecy = iden
IF bkpidecy <> idecy OR bkpidesy <> idesy THEN ideselect = 0: GOSUB UpdateDisplay
CASE 18176 'Home
bkpidecy = idecy: bkpidesy = idesy
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN idecy = 1
IF bkpidecy <> idecy OR bkpidesy <> idesy THEN ideselect = 0: GOSUB UpdateDisplay
CASE 20224 'End
bkpidecy = idecy: bkpidesy = idesy
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN idecy = iden
IF bkpidecy <> idecy OR bkpidesy <> idesy THEN ideselect = 0: GOSUB UpdateDisplay
CASE 27
requestQuit:
cmd$ = "free"
GOSUB SendCommand
CLOSE #debugClient&
dummy = DarkenFGBG(0)
clearStatusWindow 0
setStatusMessage 1, "Debug session aborted.", 7
WHILE _MOUSEINPUT: WEND
_KEYCLEAR
EXIT SUB
CASE 15360 'F2
requestSubsDialog:
bkpidecy = idecy: bkpidesy = idesy
r$ = idesubs
IF bkpidecy <> idecy OR bkpidesy <> idesy THEN ideselect = 0: GOSUB UpdateDisplay
PCOPY 3, 0: SCREEN , , 3, 0
GOSUB UpdateDisplay
WHILE _MOUSEINPUT: WEND
CASE 102, 70 'f, F
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN GOTO findjmp
CASE 15616 'F3
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN GOTO findjmp
IF idefindtext <> "" THEN
'UpdateSearchBar:
COLOR 7, 1: _PRINTSTRING (idewx - (idesystem2.w + 10), idewy - 4), CHR$(180)
COLOR 3, 1
_PRINTSTRING (1 + idewx - (idesystem2.w + 10), idewy - 4), "Find[" + SPACE$(idesystem2.w + 1) + CHR$(18) + "]"
a$ = LEFT$(idefindtext, idesystem2.w)
_PRINTSTRING (idewx - (idesystem2.w + 8) + 4, idewy - 4), a$
COLOR 7, 1: _PRINTSTRING (idewx - 2, idewy - 4), CHR$(195)
IF _KEYDOWN(100304) OR _KEYDOWN(100303) THEN idefindinvert = 1
IdeAddSearched idefindtext
idefindagain -1
ELSE
findjmp:
r$ = idefind
PCOPY 3, 0: SCREEN , , 3, 0
WHILE _MOUSEINPUT: WEND
END IF
GOSUB UpdateDisplay
CASE 15872 'F4
F4:
IF PauseMode = 0 THEN
cmd$ = "break"
PauseMode = -1
GOSUB SendCommand
estabilishingScope = -1
ELSE
requestVariableWatch:
hidePanel = -1
GOSUB UpdateDisplay
selectVar = 1
filter$ = ""
DO
result$ = idevariablewatchbox$(currentSub$, filter$, selectVar, returnAction)
temp$ = GetBytes$("", 0) 'reset buffer
IF returnAction = 1 THEN
'set address
tempIndex& = CVL(GetBytes$(result$, 4))
tempIsArray& = _CV(_BYTE, GetBytes$(result$, 1))
temp$ = GetBytes$(result$, 4) 'skip original line number
tempLocalIndex& = CVL(GetBytes$(result$, 4))
tempArrayIndex& = CVL(GetBytes$(result$, 4))
tempArrayIndexes$ = MKL$(tempArrayIndex&) + GetBytes$(result$, tempArrayIndex&)
tempArrayElementSize& = CVL(GetBytes$(result$, 4))
tempIsUDT& = CVL(GetBytes$(result$, 4))
temp$ = GetBytes$(result$, 4) 'skip element number
tempElementOffset& = CVL(GetBytes$(result$, 4))
temp$ = GetBytes$(result$, 4) 'skip var size
tempStorage& = CVL(GetBytes$(result$, 4))
i = CVI(GetBytes$(result$, 2))
tempScope$ = GetBytes$(result$, i)
i = CVI(GetBytes$(result$, 2))
varType$ = GetBytes$(result$, i)
i = CVI(GetBytes$(result$, 2))
value$ = GetBytes$(result$, i)
IF LEN(usedVariableList(tempIndex&).subfunc) = 0 THEN
cmd$ = "set global address:"
ELSE
cmd$ = "set local address:"
END IF
findVarSize:
tempVarType$ = varType$
fixedVarSize& = 0
IF INSTR(varType$, "STRING *") THEN
tempVarType$ = "STRING"
fixedVarSize& = VAL(MID$(varType$, _INSTRREV(varType$, "* ") + 2))
END IF
IF INSTR(varType$, "BIT *") THEN tempVarType$ = "_BIT"
IF tempVarType$ = "_BIT" AND INSTR(varType$, "UNSIGNED") > 0 THEN
tempVarType$ = "_UNSIGNED _BIT"
END IF
SELECT CASE tempVarType$
CASE "_BIT", "_UNSIGNED _BIT"
value$ = MKL$(VAL(value$))
varSize& = LEN(dummy&)
result$ = STR$(CVL(value$))
CASE "_BYTE", "_UNSIGNED _BYTE", "BYTE", "UNSIGNED BYTE"
value$ = _MK$(_BYTE, VAL(value$))
varSize& = LEN(dummy%%)
IF INSTR(tempVarType$, "UNSIGNED") > 0 THEN
result$ = STR$(_CV(_UNSIGNED _BYTE, value$))
ELSE
result$ = STR$(_CV(_BYTE, value$))
END IF
CASE "INTEGER", "_UNSIGNED INTEGER", "UNSIGNED INTEGER"
value$ = MKI$(VAL(value$))
varSize& = LEN(dummy%)
IF INSTR(tempVarType$, "UNSIGNED") > 0 THEN
result$ = STR$(_CV(_UNSIGNED INTEGER, value$))
ELSE
result$ = STR$(_CV(INTEGER, value$))
END IF
CASE "LONG", "_UNSIGNED LONG", "UNSIGNED LONG"
value$ = MKL$(VAL(value$))
varSize& = LEN(dummy&)
IF INSTR(tempVarType$, "UNSIGNED") > 0 THEN
result$ = STR$(_CV(_UNSIGNED LONG, value$))
ELSE
result$ = STR$(_CV(LONG, value$))
END IF
CASE "_INTEGER64", "INTEGER64", "_UNSIGNED _INTEGER64", "UNSIGNED INTEGER64"
value$ = _MK$(_INTEGER64, VAL(value$))
varSize& = LEN(dummy&&)
IF INSTR(tempVarType$, "UNSIGNED") > 0 THEN
result$ = STR$(_CV(_UNSIGNED _INTEGER64, value$))
ELSE
result$ = STR$(_CV(_INTEGER64, value$))
END IF
CASE "SINGLE"
value$ = MKS$(VAL(value$))
varSize& = LEN(dummy!)
result$ = STR$(CVS(value$))
CASE "DOUBLE"
value$ = MKD$(VAL(value$))
varSize& = LEN(dummy#)
result$ = STR$(CVD(value$))
CASE "_FLOAT", "FLOAT"
value$ = _MK$(_FLOAT, VAL(value$))
varSize& = LEN(dummy##)
result$ = STR$(_CV(_FLOAT, value$))
CASE "_OFFSET", "_UNSIGNED _OFFSET", "OFFSET", "UNSIGNED OFFSET"
value$ = _MK$(_OFFSET, VAL(value$))
varSize& = LEN(dummy%&)
IF INSTR(tempVarType$, "UNSIGNED") > 0 THEN
result$ = STR$(_CV(_UNSIGNED _OFFSET, value$))
ELSE
result$ = STR$(_CV(_OFFSET, value$))
END IF
CASE "STRING"
varSize& = LEN(value$)
result$ = value$
IF fixedVarSize& THEN
varSize& = fixedVarSize&
result$ = LEFT$(result$, fixedVarSize&)
END IF
END SELECT
IF returnAction = 2 OR returnAction = 3 THEN RETURN
cmd$ = cmd$ + MKL$(tempIndex&)
cmd$ = cmd$ + _MK$(_BYTE, tempIsArray& <> 0)
cmd$ = cmd$ + MKL$(0)
cmd$ = cmd$ + MKL$(tempLocalIndex&)
cmd$ = cmd$ + tempArrayIndexes$
cmd$ = cmd$ + MKL$(tempArrayElementSize&)
cmd$ = cmd$ + MKL$(tempIsUDT&)
cmd$ = cmd$ + MKL$(0)
cmd$ = cmd$ + MKL$(tempElementOffset&)
cmd$ = cmd$ + MKL$(varSize&)
cmd$ = cmd$ + MKL$(tempStorage&)
cmd$ = cmd$ + MKI$(LEN(tempScope$)) + tempScope$
cmd$ = cmd$ + MKI$(LEN(varType$)) + varType$
cmd$ = cmd$ + MKI$(LEN(value$)) + value$
GOSUB SendCommand
IF tempStorage& > 0 THEN
vWatchReceivedData$(tempStorage&) = result$
END IF
PCOPY 3, 0: SCREEN , , 3, 0
WHILE _MOUSEINPUT: WEND
hidePanel = -1
GOSUB UpdateDisplay
ELSEIF returnAction = 2 OR returnAction = 3 THEN
'send watchpoint data
tempIndex& = CVL(GetBytes$(result$, 4))
tempIsArray& = _CV(_BYTE, GetBytes$(result$, 1)) <> 0
temp$ = GetBytes$(result$, 4) 'skip original line number
tempLocalIndex& = CVL(GetBytes$(result$, 4))
tempArrayIndex& = CVL(GetBytes$(result$, 4))
tempArrayIndexes$ = MKL$(tempArrayIndex&) + GetBytes$(result$, tempArrayIndex&)
tempArrayElementSize& = CVL(GetBytes$(result$, 4))
tempIsUDT& = CVL(GetBytes$(result$, 4))
tempElement& = CVL(GetBytes$(result$, 4))
tempElementOffset& = CVL(GetBytes$(result$, 4))
temp$ = GetBytes$(result$, 4) 'skip var size
tempStorage& = CVL(GetBytes$(result$, 4))
i = CVI(GetBytes$(result$, 2))
tempScope$ = GetBytes$(result$, i)
i = CVI(GetBytes$(result$, 2))
varType$ = GetBytes$(result$, i)
i = CVI(GetBytes$(result$, 2))
value$ = GetBytes$(result$, i)
IF returnAction = 2 THEN
temp$ = "set "
ELSE
'clear watchpoint data
temp$ = "clear "
END IF
IF LEN(usedVariableList(tempIndex&).subfunc) = 0 THEN
cmd$ = temp$ + "global watchpoint:"
ELSE
cmd$ = temp$ + "local watchpoint:"
END IF
temp$ = value$
IF INSTR(varType$, "STRING") = 0 THEN
GOSUB findVarSize
ELSE
IF INSTR(varType$, " * ") > 0 AND (tempIsUDT& <> 0 OR tempIsArray& <> 0) THEN
varSize& = VAL(_TRIM$(MID$(varType$, INSTR(varType$, "STRING *") + 8)))
ELSE
varSize& = LEN(dummy%&) + LEN(dummy&)
END IF
END IF
cmd$ = cmd$ + MKL$(tempIndex&)
cmd$ = cmd$ + _MK$(_BYTE, tempIsArray& <> 0)
cmd$ = cmd$ + MKL$(usedVariableList(tempIndex&).linenumber)
cmd$ = cmd$ + MKL$(tempLocalIndex&)
cmd$ = cmd$ + tempArrayIndexes$
cmd$ = cmd$ + MKL$(tempArrayElementSize&)
cmd$ = cmd$ + MKL$(tempIsUDT&)
cmd$ = cmd$ + MKL$(tempElement&)
cmd$ = cmd$ + MKL$(tempElementOffset&)
cmd$ = cmd$ + MKL$(varSize&)
cmd$ = cmd$ + MKL$(tempStorage&)
cmd$ = cmd$ + MKI$(LEN(tempScope$)) + tempScope$
cmd$ = cmd$ + MKI$(LEN(varType$)) + varType$
cmd$ = cmd$ + MKI$(LEN(temp$)) + temp$
GOSUB SendCommand
PCOPY 3, 0: SCREEN , , 3, 0
WHILE _MOUSEINPUT: WEND
hidePanel = -1
GOSUB UpdateDisplay
_CONTINUE
ELSEIF returnAction = -1 THEN
PCOPY 3, 0: SCREEN , , 3, 0
WHILE _MOUSEINPUT: WEND
hidePanel = -1
GOSUB UpdateDisplay
_CONTINUE
ELSE
EXIT DO
END IF
LOOP
PCOPY 3, 0: SCREEN , , 3, 0
WHILE _MOUSEINPUT: WEND
GOSUB UpdateDisplay
IF LEN(variableWatchList$) THEN
panelActive = -1
GOTO requestVariableValues
END IF
END IF
CASE 16128 'F5
F5:
requestContinue:
PauseMode = 0
debugnextline = 0
cmd$ = "run"
GOSUB SendCommand
clearStatusWindow 1
setStatusMessage 1, "Running...", 10
GOSUB UpdateDisplay
dummy = DarkenFGBG(1)
set_foreground_window debuggeehwnd
CASE 16384 'F6
F6:
requestStepOut:
IF PauseMode THEN
IF LEN(currentSub$) > 0 THEN
PauseMode = 0
cmd$ = "step out"
GOSUB SendCommand
clearStatusWindow 1
setStatusMessage 1, "Running...", 10
dummy = DarkenFGBG(1)
GOSUB UpdateDisplay
ELSE
clearStatusWindow 0
setStatusMessage 1, "Not inside a sub/function.", 4
GOSUB UpdateDisplay
END IF
END IF
CASE 16640 'F7
F7:
requestStepInto:
IF PauseMode = 0 THEN
cmd$ = "break"
PauseMode = -1
GOSUB SendCommand
ELSE
cmd$ = "step"
PauseMode = -1
GOSUB SendCommand
END IF
clearStatusWindow 1
IF EnteredInput THEN
setStatusMessage 1, "Execution will be paused after SLEEP/INPUT/LINE INPUT finishes running...", 2
set_foreground_window debuggeehwnd
ELSE
setStatusMessage 1, "Paused.", 2
END IF
IF IdeDebugMode = 2 THEN RETURN
CASE 16896 'F8
F8:
requestStepOver:
IF PauseMode THEN
cmd$ = "step over"
PauseMode = 0
GOSUB SendCommand
clearStatusWindow 1
setStatusMessage 1, "Running...", 10
dummy = DarkenFGBG(1)
ELSE
requestPause:
cmd$ = "break"
PauseMode = -1
GOSUB SendCommand
clearStatusWindow 1
setStatusMessage 1, "Paused.", 2
IF IdeDebugMode = 2 THEN RETURN
END IF
CASE 17152 'F9
F9:
requestToggleBreakpoint:
IF PauseMode THEN
IdeBreakpoints(idecy) = NOT IdeBreakpoints(idecy)
IF IdeBreakpoints(idecy) THEN
IdeSkipLines(idecy) = 0
cmd$ = "set breakpoint:"
ELSE
cmd$ = "clear breakpoint:"
END IF
cmd$ = cmd$ + MKL$(idecy)
GOSUB SendCommand
GOSUB UpdateDisplay
END IF
CASE 17408 'F10
F10:
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN
requestUnskipAllLines:
REDIM IdeSkipLines(iden) AS _BYTE
cmd$ = "clear all skips"
GOSUB SendCommand
ELSE
requestClearBreakpoints:
REDIM IdeBreakpoints(iden) AS _BYTE
cmd$ = "clear all breakpoints"
GOSUB SendCommand
END IF
GOSUB UpdateDisplay
CASE 34304 'F12
F12:
IF PauseMode THEN
requestCallStack:
cmd$ = "call stack"
GOSUB SendCommand
IF BypassRequestCallStack THEN GOTO ShowCallStack
dummy = DarkenFGBG(0)
clearStatusWindow 0
setStatusMessage 1, "Requesting call stack...", 7
start! = TIMER
callStackLength = -1
DO
GOSUB GetCommand
IF cmd$ = "call stack size" THEN
callStackLength = CVL(value$)
IF callStackLength = 0 THEN EXIT DO
END IF
_LIMIT 100
LOOP UNTIL cmd$ = "call stack" OR TIMER - start! > timeout
IF cmd$ = "call stack" THEN
'display call stack
callstacklist$ = value$
ShowCallStack:
clearStatusWindow 0
setStatusMessage 1, "Paused.", 2
retval = idecallstackbox
SCREEN , , 3, 0
GOSUB UpdateDisplay
WHILE _MOUSEINPUT: WEND
ELSE
IF callStackLength = -1 THEN
callStackLength = 0
clearStatusWindow 0
setStatusMessage 1, "Error retrieving call stack.", 4
ELSEIF callStackLength = 0 THEN
clearStatusWindow 0
setStatusMessage 1, "No call stack log available.", 4
END IF
END IF
noFocusMessage = NOT noFocusMessage
END IF
CASE 103, 71 'g, G
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN
IF _KEYDOWN(100304) OR _KEYDOWN(100303) THEN
result = idegetlinenumberbox("Run To Line", idecy)
PCOPY 3, 0: SCREEN , , 3, 0
WHILE _MOUSEINPUT: WEND
requestRunToThisLine:
IF result > 0 AND result <= iden THEN
PauseMode = 0
debugnextline = 0
cmd$ = "run to line:" + MKL$(result)
GOSUB SendCommand
clearStatusWindow 1
setStatusMessage 1, "Running...", 10
GOSUB UpdateDisplay
dummy = DarkenFGBG(1)
END IF
ELSE
result = idegetlinenumberbox("Set Next Line", idecy)
PCOPY 3, 0: SCREEN , , 3, 0
WHILE _MOUSEINPUT: WEND
requestSetNextLine:
IF result > 0 AND result <= iden THEN
cmd$ = "set next line:" + MKL$(result)
GOSUB SendCommand
END IF
END IF
END IF
CASE 112, 80 'p, P
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN
result = idegetlinenumberbox("Skip Line", idecy)
PCOPY 3, 0: SCREEN , , 3, 0
WHILE _MOUSEINPUT: WEND
requestToggleSkipLine:
IF result > 0 AND result <= iden THEN
IdeSkipLines(result) = NOT IdeSkipLines(result)
cmd$ = "set skip line:"
IF IdeSkipLines(result) = 0 THEN cmd$ = "clear skip line:"
cmd$ = cmd$ + MKL$(result)
GOSUB SendCommand
GOSUB UpdateDisplay
END IF
END IF
END SELECT
GOSUB GetCommand
SELECT CASE cmd$
CASE "breakpoint", "line number", "watchpoint"
BypassRequestCallStack = 0
IF cmd$ = "watchpoint" THEN
temp$ = GetBytes$("", 0) 'reset buffer
tempIndex& = CVL(GetBytes$(value$, 4))
latestWatchpointMet& = tempIndex&
tempArrayIndexes$ = GetBytes$(value$, 4)
tempArrayIndexes$ = tempArrayIndexes$ + GetBytes$(value$, CVL(tempArrayIndexes$))
tempElementOffset$ = GetBytes$(value$, 4)
i = CVI(GetBytes$(value$, 2))
temp$ = usedVariableList(tempIndex&).name + " " + GetBytes$(value$, i)
result = idemessagebox("Watchpoint condition met", temp$, "#OK;#Clear Watchpoint")
IF result = 2 THEN
'find existing watchpoint for the same variable/index/element
temp$ = MKL$(tempIndex&) + tempArrayIndexes$ + tempElementOffset$
i = 0
i = INSTR(i + 1, watchpointList$, MKL$(-1))
DO WHILE i
IF MID$(watchpointList$, i + 8, LEN(temp$)) = temp$ THEN EXIT DO
i = INSTR(i + 1, watchpointList$, MKL$(-1))
LOOP
IF i > 0 THEN
'remove it
j = CVL(MID$(watchpointList$, i + 4, 4))
watchpointList$ = LEFT$(watchpointList$, i - 1) + MID$(watchpointList$, i + j + 8)
END IF
cmd$ = "clear last watchpoint"
GOSUB SendCommand
END IF
value$ = RIGHT$(value$, 4)
ELSE
latestWatchpointMet& = 0
END IF
PCOPY 3, 0: SCREEN , , 3, 0
WHILE _MOUSEINPUT: WEND
l = CVL(value$)
idecy = l
ideselect = 0
debugnextline = l
idefocusline = 0
idecentercurrentline
clearStatusWindow 1
IF cmd$ = "breakpoint" THEN
setStatusMessage 1, "Breakpoint reached on line" + STR$(l), 2
ELSEIF cmd$ = "watchpoint" THEN
setStatusMessage 1, "Watchpoint condition met (" + temp$ + ")", 2
ELSE
setStatusMessage 1, "Paused.", 2
END IF
PauseMode = -1
GOSUB UpdateDisplay
'request variables addresses
IF LEN(variableWatchList$) > 0 AND panelActive THEN
requestVariableValues:
temp$ = GetBytes$("", 0) 'reset buffer
temp$ = MID$(variableWatchList$, 9) 'skip longest var name and total visible vars
DO
temp2$ = GetBytes$(temp$, 4)
IF temp2$ <> MKL$(-1) THEN EXIT DO 'no more variables in list
tempIndex& = CVL(GetBytes$(temp$, 4))
tempArrayIndexes$ = GetBytes$(temp$, 4)
i = CVL(tempArrayIndexes$)
IF i > 0 THEN
tempArrayIndexes$ = tempArrayIndexes$ + GetBytes$(temp$, i)
END IF
tempElement& = CVL(GetBytes$(temp$, 4))
tempElementOffset& = CVL(GetBytes$(temp$, 4))
tempStorage& = CVL(GetBytes$(temp$, 4))
IF LEN(usedVariableList(tempIndex&).subfunc) = 0 THEN
cmd$ = "get global var:"
ELSE
cmd$ = "get local var:"
END IF
GOSUB GetVarSize
IF varSize& THEN
cmd$ = cmd$ + MKL$(tempIndex&)
cmd$ = cmd$ + _MK$(_BYTE, usedVariableList(tempIndex&).isarray)
cmd$ = cmd$ + MKL$(usedVariableList(tempIndex&).linenumber)
cmd$ = cmd$ + MKL$(usedVariableList(tempIndex&).localIndex)
cmd$ = cmd$ + tempArrayIndexes$
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(varType$)) + varType$
GOSUB SendCommand
ELSE
cmd$ = ""
END IF
LOOP
END IF
CASE "hwnd"
debuggeehwnd = _CV(_OFFSET, value$)
CASE "address read"
tempIndex& = CVL(LEFT$(value$, 4))
tempArrayIndex& = CVL(MID$(value$, 5, 4))
tempElement& = CVL(MID$(value$, 9, 4))
tempStorage& = CVL(MID$(value$, 13, 4))
recvData$ = MID$(value$, 17)
GOSUB GetVarSize
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$))
CASE "_UNSIGNED INTEGER", "UNSIGNED INTEGER": recvData$ = STR$(_CV(_UNSIGNED INTEGER, recvData$))
CASE "LONG": recvData$ = STR$(_CV(LONG, recvData$))
CASE "_UNSIGNED LONG", "UNSIGNED LONG": recvData$ = STR$(_CV(_UNSIGNED LONG, recvData$))
CASE "_INTEGER64", "INTEGER64": recvData$ = STR$(_CV(_INTEGER64, recvData$))
CASE "_UNSIGNED _INTEGER64", "UNSIGNED INTEGER64": recvData$ = STR$(_CV(_UNSIGNED _INTEGER64, recvData$))
CASE "SINGLE": recvData$ = STR$(_CV(SINGLE, recvData$))
CASE "DOUBLE": recvData$ = STR$(_CV(DOUBLE, recvData$))
CASE "_FLOAT", "FLOAT": recvData$ = STR$(_CV(_FLOAT, recvData$))
CASE "_OFFSET", "OFFSET": recvData$ = STR$(_CV(_OFFSET, recvData$))
CASE "_UNSIGNED _OFFSET", "UNSIGNED OFFSET": recvData$ = STR$(_CV(_UNSIGNED _OFFSET, recvData$))
'CASE "STRING": 'no conversion required
END SELECT
vWatchReceivedData$(tempStorage&) = recvData$
IF PauseMode THEN GOSUB UpdateDisplay
CASE "current sub"
currentSub$ = value$
IF estabilishingScope THEN
estabilishingScope = 0
GOSUB UpdateDisplay
GOTO requestVariableWatch
END IF
CASE "quit"
CLOSE #debugClient&
dummy = DarkenFGBG(0)
clearStatusWindow 0
setStatusMessage 1, "Debug session aborted.", 15
IF LEN(value$) THEN
setStatusMessage 2, value$, 7
END IF
WHILE _MOUSEINPUT: WEND
_KEYCLEAR
EXIT SUB
CASE "error"
l = CVL(value$)
idecy = l
ideselect = 0
idefocusline = l
GOSUB UpdateDisplay
clearStatusWindow 1
COLOR , 4
setStatusMessage 1, "Error occurred on line" + STR$(l), 15
BypassRequestCallStack = -1
PauseMode = -1
CASE "enter input"
EnteredInput = -1
l = CVL(value$)
idecy = l
debugnextline = l
ideselect = 0
GOSUB UpdateDisplay
dummy = DarkenFGBG(1)
clearStatusWindow 1
setStatusMessage 1, "SLEEP/INPUT/LINE INPUT active in your program...", 10
set_foreground_window debuggeehwnd
CASE "leave input"
EnteredInput = 0
clearStatusWindow 1
IF PauseMode THEN
setStatusMessage 1, "Paused.", 2
dummy = DarkenFGBG(0)
ELSE
setStatusMessage 1, "Running...", 10
END IF
CASE "call stack size"
'call stack is only received without having been
'requested when the program is about to quit or
'when an error just occurred
callStackLength = CVL(value$)
IF callStackLength THEN
start! = TIMER
DO
GOSUB GetCommand
_LIMIT 100
LOOP UNTIL cmd$ = "call stack" OR TIMER - start! > timeout
IF cmd$ = "call stack" THEN
'store call stack
callstacklist$ = value$
END IF
ELSE
callstacklist$ = ""
END IF
END SELECT
IF _WINDOWHASFOCUS THEN GOSUB UpdateButtons
_LIMIT 100
LOOP
WHILE _MOUSEINPUT: WEND
_KEYCLEAR
EXIT SUB
GetCommand:
GET #debugClient&, , temp$
IF os$ = "WIN" AND _CONNECTED(debugClient&) = 0 THEN
clearStatusWindow 0
setStatusMessage 1, "Debug session aborted.", 7
setStatusMessage 2, "Disconnected.", 2
WHILE _MOUSEINPUT: WEND
_KEYCLEAR
EXIT SUB
END IF
buffer$ = buffer$ + temp$
IF LEN(buffer$) >= 4 THEN cmdsize = CVL(LEFT$(buffer$, 4)) ELSE cmdsize = 0
IF cmdsize > 0 AND LEN(buffer$) >= cmdsize THEN
cmd$ = MID$(buffer$, 5, cmdsize)
buffer$ = MID$(buffer$, 5 + cmdsize)
IF INSTR(cmd$, ":") THEN
value$ = MID$(cmd$, INSTR(cmd$, ":") + 1)
cmd$ = LEFT$(cmd$, INSTR(cmd$, ":") - 1)
ELSE
value$ = ""
END IF
ELSE
cmd$ = "": value$ = ""
END IF
RETURN
SendCommand:
cmd$ = MKL$(LEN(cmd$)) + cmd$
PUT #debugClient&, , cmd$
IF os$ = "WIN" AND _CONNECTED(debugClient&) = 0 THEN
clearStatusWindow 0
setStatusMessage 1, "Debug session aborted.", 7
setStatusMessage 2, "Disconnected.", 2
WHILE _MOUSEINPUT: WEND
_KEYCLEAR
EXIT SUB
END IF
cmd$ = ""
RETURN
UpdateDisplay:
IF PauseMode = 0 THEN ideshowtextBypassColorRestore = -1
ideshowtext
UpdateTitleOfMainWindow
GOSUB printVersion
IF PauseMode <> 0 AND LEN(variableWatchList$) > 0 THEN
IF WatchListToConsole THEN _CONSOLE ON
totalVisibleVariables = CVL(MID$(variableWatchList$, 5, 4))
IF hidePanel = 0 AND panelActive = -1 THEN showvWatchPanel vWatchPanel, currentSub$, 0
hidePanel = 0
END IF
PCOPY 3, 0
RETURN
UpdateButtons:
FOR i = 1 TO UBOUND(Button)
IF mY = Button(i).y AND mX >= Button(i).x AND mX <= Button(i).x + Button(i).w AND _
vWatchPanel.draggingPanel = 0 AND vWatchPanel.resizingPanel = 0 THEN
COLOR 0, 7
temp$ = ""
ELSE
COLOR 13, 1
temp$ = " "
END IF
_PRINTSTRING (Button(i).x, Button(i).y), Button(i).Caption + temp$
NEXT
PCOPY 3, 0
RETURN
GetVarSize:
varSize& = 0
varType$ = usedVariableList(tempIndex&).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(varType$, "UNSIGNED") THEN tempVarType$ = "_UNSIGNED _INTEGER64"
ELSE
tempVarType$ = "LONG"
IF INSTR(varType$, "UNSIGNED") THEN tempVarType$ = "_UNSIGNED LONG"
END IF
ELSEIF INSTR("@_BIT@BIT@_UNSIGNED _BIT@UNSIGNED BIT@", "@" + tempVarType$ + "@") THEN
tempVarType$ = "LONG"
IF INSTR(varType$, "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&)
CASE "_INTEGER64", "_UNSIGNED _INTEGER64", "INTEGER64", "UNSIGNED INTEGER64": varSize& = LEN(dummy&&)
CASE "SINGLE": varSize& = LEN(dummy!)
CASE "DOUBLE": varSize& = LEN(dummy#)
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 INSTR(varType$, "STRING *") THEN
'Request exactly the amount of bytes specified for fixed strings in UDTs
varSize& = VAL(_TRIM$(MID$(varType$, INSTR(varType$, "STRING *") + 8)))
RETURN
END IF
IF LEN(varType$) THEN GOTO checkVarType
END SELECT
RETURN
printVersion:
'print version in the status bar
IF LEN(versionStringStatus$) = 0 THEN
versionStringStatus$ = " v" + Version$
IF LEN(AutoBuildMsg$) THEN versionStringStatus$ = versionStringStatus$ + MID$(AutoBuildMsg$, _INSTRREV(AutoBuildMsg$, " "))
versionStringStatus$ = versionStringStatus$ + " "
END IF
COLOR 2, 3
_PRINTSTRING (idewx - 21 - LEN(versionStringStatus$), idewy + idesubwindow), versionStringStatus$
RETURN
checkvWatchPanelSize:
IF vWatchPanel.w < 40 THEN vWatchPanel.w = 40
IF vWatchPanel.w > idewx - 12 THEN vWatchPanel.w = idewx - 12
IF vWatchPanel.x + vWatchPanel.w > idewx - 1 THEN
vWatchPanel.w = (idewx - 1) - vWatchPanel.x
END IF
IF vWatchPanel.y + vWatchPanel.h > vWatchPanelLimit THEN
vWatchPanel.h = vWatchPanelLimit - (vWatchPanel.y - 1)
END IF
IF vWatchPanel.h < 5 THEN vWatchPanel.h = 5
IF vWatchPanel.h > idewy - 10 THEN vWatchPanel.h = idewy - 10
RETURN
END SUB
Function map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
End Function
SUB showvWatchPanel (this AS vWatchPanelType, currentScope$, action as _BYTE)
STATIC previousVariableWatchList$
STATIC longestVarName, totalVisibleVariables
IF action = 1 THEN previousVariableWatchList$ = "": EXIT SUB 'reset
IF previousVariableWatchList$ <> variableWatchList$ THEN
'new setup
previousVariableWatchList$ = variableWatchList$
longestVarName = CVL(LEFT$(variableWatchList$, 4))
totalVisibleVariables = CVL(MID$(variableWatchList$, 5, 4))
this.h = totalVisibleVariables + 2
IF this.h > idewy - 10 THEN this.h = idewy - 10
IF this.h < 5 THEN this.h = 5
END IF
fg = 0: bg = 7
title$ = "Watch List"
IF LEN(currentScope$) THEN title$ = title$ + " - " + currentScope$
IF this.w < LEN(title$) + 4 THEN
this.w = LEN(title$) + 4
IF this.x + this.w + 2 > idewx THEN this.x = idewx - (this.w + 2)
END IF
IF WatchListToConsole = 0 THEN
vWatchPanelLimit = idewy - 6
IF this.x < 2 THEN this.x = 2
IF this.x + this.w > idewx - 1 THEN this.x = idewx - this.w - 1
IF this.y < 3 THEN this.y = 3
IF this.y > vWatchPanelLimit - (this.h - 1) THEN this.y = vWatchPanelLimit - (this.h - 1)
IF this.w < 40 THEN this.w = 40
IF this.w > idewx - 12 THEN this.w = idewx - 12
IF this.x + this.w > idewx - 1 THEN
this.w = (idewx - 1) - this.x
END IF
IF this.y + this.h > vWatchPanelLimit THEN
this.h = vWatchPanelLimit - (this.y - 1)
END IF
IF this.h < 5 THEN this.h = 5
IF this.h > idewy - 10 THEN this.h = idewy - 10
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
ELSE
_ECHO "-------- " + title$
END IF
y = 0
i = 0
shadowX = 0
shadowY = 0
shadowLength = 0
this.contentWidth = 0
IF this.hPos = 0 THEN this.hPos = 1
temp$ = GetBytes$("", 0) 'reset buffer
temp$ = MID$(variableWatchList$, 9)
actualLongestVarName = 0
displayFormatButton = 0
DO
temp2$ = GetBytes$(temp$, 4)
IF temp2$ <> MKL$(-1) THEN EXIT DO 'no more variables in list
tempIndex& = CVL(GetBytes$(temp$, 4))
tempTotalArrayIndexes& = CVL(GetBytes$(temp$, 4))
tempArrayIndexes$ = GetBytes$(temp$, tempTotalArrayIndexes&)
tempElement& = CVL(GetBytes$(temp$, 4))
tempElementOffset& = CVL(GetBytes$(temp$, 4))
tempStorage& = CVL(GetBytes$(temp$, 4))
i = i + 1
IF this.firstVisible > i AND WatchListToConsole = 0 THEN _CONTINUE
y = y + 1
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)
tempTotalArrayIndexes& = tempTotalArrayIndexes& \ 4
FOR j = 1 TO tempTotalArrayIndexes&
thisName$ = thisName$ + LTRIM$(STR$(CVL(MID$(tempArrayIndexes$, j * 4 - 3, 4))))
IF j < tempTotalArrayIndexes& THEN thisName$ = thisName$ + ", "
NEXT
thisName$ = thisName$ + ")"
END IF
IF tempElement& THEN
tempElementList$ = MID$(usedVariableList(tempIndex&).elements, 5)
thisName$ = thisName$ + getelement$(tempElementList$, tempElement&)
END IF
IF LEN(thisName$) > actualLongestVarName THEN actualLongestVarName = LEN(thisName$)
item$ = thisName$ + SPACE$(longestVarName - LEN(thisName$)) + " = "
IF usedVariableList(tempIndex&).subfunc = currentScope$ OR usedVariableList(tempIndex&).subfunc = "" THEN
IF tempElement& THEN
tempVarType$ = getelement$(usedVariableList(tempIndex&).elementTypes, tempElement&)
ELSE
tempVarType$ = usedVariableList(tempIndex&).varType
END IF
thisIsAString = (INSTR(tempVarType$, "STRING *") > 0 OR tempVarType$ = "STRING")
tempValue$ = StrReplace$(vWatchReceivedData$(tempStorage&), CHR$(0), " ")
IF thisIsAString THEN
item$ = item$ + CHR$(34) + tempValue$ + CHR$(34)
IF displayFormatButton > 0 THEN displayFormatButton = 0
ELSE
IF displayFormatButton = 0 AND this.mY = this.y + y THEN displayFormatButton = LEN(item$) + 2
IF WatchListToConsole THEN displayFormatButton = 0
SELECT CASE usedVariableList(tempIndex&).displayFormat
'displayFormat: 0=DEC;1=HEX;2=BIN;3=OCT
CASE 1: tempValue$ = "&H" + HEX$(VAL(tempValue$))
CASE 2: tempValue$ = "&B" + _BIN$(VAL(tempValue$))
CASE 3: tempValue$ = "&O" + OCT$(VAL(tempValue$))
END SELECT
item$ = item$ + tempValue$
END IF
COLOR fg
ELSE
item$ = item$ + "<out of scope>"
IF WatchListToConsole = 0 THEN COLOR 2
END IF
IF LEN(item$) > this.contentWidth THEN this.contentWidth = LEN(item$)
IF WatchListToConsole = 0 THEN
temp2$ = MID$(item$, this.hPos)
_PRINTSTRING (this.x + 2, this.y + y), LEFT$(temp2$, this.w - 4)
IF this.x + 2 + LEN(temp2$) > this.x + this.w - 2 THEN
_PRINTSTRING (this.x + this.w - 2, this.y + y), CHR$(26)
END IF
'show/highlight .displayFormat button
IF displayFormatButton > 0 AND displayFormatButton >= this.hPos AND _
this.x + displayFormatButton - this.hPos < this.x + this.w - 4 AND _
this.x + displayFormatButton - this.hPos > this.x + 1 THEN
COLOR 15
IF this.mY = this.y + y AND this.mX = this.x + displayFormatButton - this.hPos THEN
COLOR , 3
IF this.clicked = 2 THEN
this.clicked = 0 'indicate we handled the click here
usedVariableList(tempIndex&).displayFormat = usedVariableList(tempIndex&).displayFormat + 1
IF usedVariableList(tempIndex&).displayFormat > 3 THEN usedVariableList(tempIndex&).displayFormat = 0
END IF
END IF
_PRINTSTRING (this.x + displayFormatButton - this.hPos, this.mY), CHR$(29)
COLOR fg, bg
displayFormatButton = -1 'mark done
END IF
'find existing watchpoint for this variable/index/element
temp2$ = MKL$(tempIndex&) + MKL$(tempTotalArrayIndexes& * 4) + tempArrayIndexes$ + MKL$(tempElementOffset&)
j = 0
j = INSTR(j + 1, watchpointList$, MKL$(-1))
DO WHILE j
IF MID$(watchpointList$, j + 8, LEN(temp2$)) = temp2$ THEN EXIT DO
j = INSTR(j + 1, watchpointList$, MKL$(-1))
LOOP
IF j > 0 THEN
IF latestWatchpointMet& = tempIndex& THEN COLOR 15 ELSE COLOR 4
_PRINTSTRING (this.x + 1, this.y + y), CHR$(7) 'watchpoint bullet indicator
IF this.mX = this.x + 1 AND this.mY = this.y + y THEN
COLOR 15, 3
k = CVL(MID$(watchpointList$, j + 4, 4))
temp3$ = MID$(watchpointList$, j + 8, k)
k = CVI(RIGHT$(temp3$, 2))
condition$ = " Watchpoint: " + thisName$ + " " + MID$(temp3$, LEN(temp3$) - (2 + k) + 1, k) + " "
IF LEN(condition$) > idewx - 8 THEN
condition$ = LEFT$(condition$, idewx - 13) + STRING$(3, 250) + " "
END IF
k = this.x + 2
IF k + LEN(condition$) > idewx THEN k = idewx - (LEN(condition$) + 2)
_PRINTSTRING (k, this.y + y), condition$
shadowX = k
shadowY = this.y + y + 1
shadowLength = LEN(condition$)
END IF
COLOR fg, bg
END IF
ELSE
_ECHO item$
END IF
LOOP
longestVarName = actualLongestVarName 'if these are different, next time it'll be fixed
IF WatchListToConsole = 0 THEN
IF shadowLength THEN
'shadow for watchpoint popup
COLOR 2, 0
FOR x2 = shadowX + 2 TO shadowX + shadowLength
_PRINTSTRING (x2, shadowY), CHR$(SCREEN(shadowY, x2))
NEXT
END IF
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
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
END IF
IF this.clicked = 2 THEN this.clicked = 0 'discard unhandled click
END SUB
FUNCTION multiSearch (__fullText$, __searchString$)
'Returns -1 if all of the search items in SearchString can be found
'in FullText$. Returns 0 if any of the search terms cannot be found.
'Multiple items in SearchString$ must be in the format "term1+term2+..."
'Not case-sensitive.
fullText$ = _TRIM$(UCASE$(__fullText$))
searchString$ = _TRIM$(UCASE$(__searchString$))
IF LEN(fullText$) = 0 THEN EXIT FUNCTION
IF LEN(searchString$) = 0 THEN EXIT FUNCTION
multiSearch = -1
findPlus = INSTR(searchString$, "+")
WHILE findPlus
thisTerm$ = LEFT$(searchString$, findPlus - 1)
searchString$ = MID$(searchString$, findPlus + 1)
IF INSTR(fullText$, thisTerm$) = 0 THEN multiSearch = 0: EXIT FUNCTION
findPlus = INSTR(searchString$, "+")
WEND
IF LEN(searchString$) THEN
IF INSTR(fullText$, searchString$) = 0 THEN multiSearch = 0
END IF
END FUNCTION
FUNCTION idevariablewatchbox$(currentScope$, filter$, selectVar, returnAction)
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
returnAction = 0
mainmodule$ = "GLOBAL"
maxModuleNameLen = LEN(mainmodule$)
maxTypeLen = LEN("Type")
variableNameColor = 3
typeColumnColor = 15
selectedBG = 2
TYPE varDlgList
AS LONG index, bgColorFlag, colorFlag, colorFlag2, indicator, indicator2
AS _BYTE selected
AS STRING varType
END TYPE
REDIM varDlgList(1 TO totalVariablesCreated) AS varDlgList
'calculate longest module name, longest var name, longest type name
FOR x = 1 TO totalVariablesCreated
IF usedVariableList(x).includedLine THEN _CONTINUE 'don't deal with variables in $INCLUDEs
IF LEN(usedVariableList(x).subfunc) > maxModuleNameLen THEN
maxModuleNameLen = LEN(usedVariableList(x).subfunc)
END IF
IF LEN(usedVariableList(x).varType) > maxTypeLen THEN maxTypeLen = LEN(usedVariableList(x).varType)
NEXT
searchTerm$ = filter$
firstRun = -1
GOSUB buildList
firstRun = 0
dialogHeight = (totalMainVariablesCreated) + 7
listBuilt:
IF selectVar = -1 THEN GOTO generateVariableWatchList
i = 0
IF dialogHeight < lastUsedDialogHeight THEN dialogHeight = lastUsedDialogHeight
IF dialogHeight > idewy + idesubwindow - 6 THEN
dialogHeight = idewy + idesubwindow - 6
END IF
IF dialogHeight < 9 THEN dialogHeight = 9
dialogWidth = 6 + maxModuleNameLen + maxVarLen + maxTypeLen
IF IdeDebugMode > 0 THEN dialogWidth = dialogWidth + 40 'make room for "= values"
IF dialogWidth < 70 THEN dialogWidth = 70
IF dialogWidth > idewx - 8 THEN dialogWidth = idewx - 8
idepar p, dialogWidth, dialogHeight, "Add Watch - Variable List"
i = i + 1: filterBox = i
PrevFocus = 1
o(i).typ = 1
o(i).y = 2
IF o(i).nam = 0 THEN o(i).nam = idenewtxt("#Filter (multiple+terms+accepted)")
IF o(i).txt = 0 THEN o(i).txt = idenewtxt(filter$)
i = i + 1: varListBox = i
o(varListBox).typ = 2
o(varListBox).y = 5
o(varListBox).w = dialogWidth - 4: o(i).h = dialogHeight - 7
IF o(varListBox).txt = 0 THEN o(varListBox).txt = idenewtxt(l$) ELSE idetxt(o(varListBox).txt) = l$
IF selectVar = 0 THEN selectVar = 1 ELSE focus = varListBox
o(varListBox).sel = selectVar
IF LEN(searchTerm$) THEN temp$ = ", filtered" ELSE temp$ = ""
idetxt(p.nam) = "Add Watch - Variable List (" + LTRIM$(STR$(totalVisibleVariables)) + temp$ + ")"
i = i + 1: buttonSet = i
o(buttonSet).typ = 3
o(buttonSet).y = dialogHeight
IF IdeDebugMode > 0 AND o(buttonSet).txt = 0 THEN
o(buttonSet).txt = idenewtxt("#Add All" + sep + "#Remove All" + sep + "#Send Value" + sep + "Add #Watchpoint" + sep + "#Close")
ELSE
o(buttonSet).txt = idenewtxt("#Add All" + sep + "#Remove All" + sep + "#Close")
END IF
lastUsedDialogHeight = dialogHeight
'-------- 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 --------
dlgUpdate:
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
LOCATE p.y + 4, p.x + 2
PRINT "Double-click on an item to add it to the watch list:"
IF doubleClickThreshold > 0 AND doubleClickThreshold < p.w AND IdeDebugMode > 0 THEN
_PRINTSTRING (p.x + doubleClickThreshold, p.y + 5), CHR$(194)
_PRINTSTRING (p.x + doubleClickThreshold, p.y + p.h - 1), CHR$(193)
IF focus = varListBox AND o(varListBox).sel > 0 THEN
y = o(varListBox).sel
IF usedVariableList(varDlgList(y).index).watch <> 0 AND _
INSTR(usedVariableList(varDlgList(y).index).varType, "STRING *") = 0 AND _
usedVariableList(varDlgList(y).index).varType <> "STRING" THEN
COLOR 15, 3
y = o(varListBox).selY
_PRINTSTRING (p.x + doubleClickThreshold - 1, y), CHR$(29)
COLOR fg, bg
END IF
END IF
END IF
'-------- 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
IF quickDlgUpdate THEN quickDlgUpdate = 0: RETURN
'-------- 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 <> PrevFocus THEN
'Always start with TextBox values selected upon getting focus
PrevFocus = focus
IF focus = filterBox THEN
o(focus).v1 = LEN(idetxt(o(focus).txt))
IF o(focus).v1 > 0 THEN o(focus).issel = -1
o(focus).sx1 = 0
END IF
END IF
IF (focus = 3 AND info <> 0) THEN 'add all
FOR y = 1 TO totalVisibleVariables
varType$ = usedVariableList(varDlgList(y).index).varType
IF INSTR(varType$, "STRING *") THEN varType$ = "STRING"
IF INSTR(varType$, "BIT *") THEN varType$ = "_BIT"
IF (usedVariableList(varDlgList(y).index).isarray AND LEN(usedVariableList(varDlgList(y).index).watchRange) = 0) OR _
INSTR(nativeDataTypes$, varType$) = 0 THEN _CONTINUE
usedVariableList(varDlgList(y).index).watch = -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 '+
NEXT
focus = filterBox
_CONTINUE
END IF
IF (focus = 4 AND info <> 0) THEN 'remove all
FOR y = 1 TO totalVisibleVariables
usedVariableList(varDlgList(y).index).watch = 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
focus = filterBox
_CONTINUE
END IF
IF (IdeDebugMode > 0 AND focus = 5 AND info <> 0) OR _
(IdeDebugMode > 0 AND focus = 6 AND info <> 0) THEN
'set address/add watchpoint
sendValue:
SELECT CASE focus
CASE 5
dlgTitle$ = "Change Value"
dlgPrompt$ = "#Index to change"
dlgPrompt2$ = "#New value"
thisReturnAction = 1
CASE 6
dlgTitle$ = "Add Watchpoint"
dlgPrompt$ = "#Index to monitor"
dlgPrompt2$ = "#Condition"
thisReturnAction = 2
END SELECT
y = ABS(o(varListBox).sel)
IF y >= 1 AND y <= totalVisibleVariables THEN
o(varListBox).sel = y
quickDlgUpdate = -1: GOSUB dlgUpdate
tempIndex& = varDlgList(y).index
IF (focus = 5 AND (usedVariableList(tempIndex&).subfunc = currentScope$ OR usedVariableList(tempIndex&).subfunc = "")) OR focus = 6 THEN
'scope is valid (or we're setting a watchpoint)
tempArrayIndex& = 0
tempArrayIndexes$ = MKL$(0)
tempStorage& = 0
IF LEN(usedVariableList(tempIndex&).storage) = 4 THEN
tempStorage& = CVL(usedVariableList(tempIndex&).storage)
ELSEIF LEN(usedVariableList(tempIndex&).storage) > 4 THEN
i = 4
DO
i = INSTR(i + 1, variableWatchList$, MKL$(-1) + MKL$(tempIndex&) + tempArrayIndexes$)
IF i = 0 THEN EXIT DO
IF MID$(variableWatchList$, i + 8 + LEN(tempArrayIndexes$), 4) = tempElementOffset$ THEN
'we found where this element's value is being stored
tempStorage& = CVL(MID$(variableWatchList$, i + 16 + LEN(tempArrayIndexes$), 4))
EXIT DO
END IF
LOOP
END IF
tempIsUDT& = 0
tempElementOffset$ = MKL$(0)
IF usedVariableList(tempIndex&).isarray THEN
setArrayRange3:
v$ = ideinputbox$(dlgTitle$, dlgPrompt$, temp$, "01234567890,", 45, 0, ok)
_KEYCLEAR
IF ok THEN
IF LEN(v$) > 0 THEN
WHILE RIGHT$(v$, 1) = ",": v$ = LEFT$(v$, LEN(v$) - 1): WEND
temp$ = lineformat$(v$)
i = countelements(temp$)
IF i <> ABS(ids(usedVariableList(tempIndex&).id).arrayelements) THEN
result = idemessagebox("Error", "Array has" + STR$(ABS(ids(usedVariableList(tempIndex&).id).arrayelements)) + " dimension(s).", "#OK")
_KEYCLEAR
temp$ = _TRIM$(v$)
GOTO setArrayRange3
END IF
tempArrayIndexes$ = MKL$(i * 4)
WHILE i
foundComma = INSTR(v$, ",")
IF foundComma THEN
temp$ = LEFT$(v$, foundComma - 1)
v$ = MID$(v$, foundComma + 1)
ELSE
temp$ = v$
END IF
tempArrayIndexes$ = tempArrayIndexes$ + MKL$(VAL(temp$))
i = i - 1
WEND
ELSE
_CONTINUE
END IF
ELSE
_CONTINUE
END IF
END IF
varType$ = usedVariableList(tempIndex&).varType
tempVarType$ = varType$
IF INSTR(varType$, "STRING *") THEN tempVarType$ = "STRING"
IF INSTR(varType$, "BIT *") THEN tempVarType$ = "_BIT"
IF INSTR(nativeDataTypes$, tempVarType$) = 0 THEN
'It's a UDT
tempIsUDT& = -1
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(tempIndex&).name + ".", elementIndexes$, 0, -1, ok)
_KEYCLEAR
PCOPY 2, 0
PCOPY 2, 1
SCREEN , , 1, 0
IF ok = -2 THEN
getid usedVariableList(tempIndex&).id
IF id.t = 0 THEN
typ = id.arraytype AND 511
IF id.arraytype AND ISINCONVENTIONALMEMORY THEN
typ = typ - ISINCONVENTIONALMEMORY
END IF
usedVariableList(tempIndex&).arrayElementSize = udtxsize(typ)
IF udtxbytealign(typ) THEN
IF usedVariableList(tempIndex&).arrayElementSize MOD 8 THEN usedVariableList(tempIndex&).arrayElementSize = usedVariableList(tempIndex&).arrayElementSize + (8 - (usedVariableList(tempIndex&).arrayElementSize MOD 8)) 'round up to nearest byte
usedVariableList(tempIndex&).arrayElementSize = usedVariableList(tempIndex&).arrayElementSize \ 8
END IF
ELSE
usedVariableList(tempIndex&).arrayElementSize = 0
END IF
temp$ = v$
IF numelements(temp$) <> 1 THEN
'shouldn't ever happen
result = idemessagebox("Error", "Only one UDT element can be selected at a time", "#OK")
_KEYCLEAR
_CONTINUE
END IF
v$ = getelement$(temp$, 1)
'-------
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")
_KEYCLEAR
_CONTINUE
ELSE
typ = typ - ISUDT
typ = typ - ISREFERENCE
IF typ AND ISINCONVENTIONALMEMORY THEN typ = typ - ISINCONVENTIONALMEMORY
SELECT CASE typ
CASE BYTETYPE
varType$ = "_BYTE"
CASE UBYTETYPE
varType$ = "_UNSIGNED _BYTE"
CASE INTEGERTYPE
varType$ = "INTEGER"
CASE UINTEGERTYPE
varType$ = "_UNSIGNED INTEGER"
CASE LONGTYPE
varType$ = "LONG"
CASE ULONGTYPE
varType$ = "_UNSIGNED LONG"
CASE INTEGER64TYPE
varType$ = "_INTEGER64"
CASE UINTEGER64TYPE
varType$ = "_UNSIGNED _INTEGER64"
CASE SINGLETYPE
varType$ = "SINGLE"
CASE DOUBLETYPE
varType$ = "DOUBLE"
CASE FLOATTYPE
varType$ = "_FLOAT"
CASE OFFSETTYPE
varType$ = "_OFFSET"
CASE UOFFSETTYPE
varType$ = "_UNSIGNED _OFFSET"
CASE ELSE
IF typ AND ISSTRING THEN
IF (typ AND ISFIXEDLENGTH) = 0 THEN
varType$ = "STRING"
ELSE
'E contains the UDT element index at this point
varType$ = "STRING *" + STR$(udtetypesize(E))
END IF
ELSE
'shouldn't ever happen
result = idemessagebox("Error", "Cannot select full UDT", "#OK")
_KEYCLEAR
GOTO dlgLoop
END IF
END SELECT
tempElementOffset$ = MKL$(VAL(MID$(result$, _INSTRREV(result$, sp3) + 1)))
END IF
'-------
ELSE
_CONTINUE
END IF
END IF
storageSlot& = 0
IF LEN(usedVariableList(tempIndex&).storage) = 4 THEN
storageSlot& = CVL(usedVariableList(tempIndex&).storage)
ELSEIF LEN(usedVariableList(tempIndex&).storage) > 4 THEN
i = 4
DO
i = INSTR(i + 1, variableWatchList$, MKL$(-1) + MKL$(tempIndex&) + tempArrayIndexes$)
IF i = 0 THEN EXIT DO
IF MID$(variableWatchList$, i + 8 + LEN(tempArrayIndexes$), 4) = tempElementOffset$ THEN
'we found where this element's value is being stored
storageSlot& = CVL(MID$(variableWatchList$, i + 16 + LEN(tempArrayIndexes$), 4))
EXIT DO
END IF
LOOP
END IF
a2$ = ""
IF storageSlot& > 0 AND focus = 5 THEN
a2$ = vWatchReceivedData$(storageSlot&)
ELSEIF focus = 6 THEN
'find existing watchpoint for this variable/index/element
temp$ = MKL$(tempIndex&) + tempArrayIndexes$ + tempElementOffset$
i = 0
i = INSTR(i + 1, watchpointList$, MKL$(-1))
DO WHILE i
IF MID$(watchpointList$, i + 8, LEN(temp$)) = temp$ THEN EXIT DO
i = INSTR(i + 1, watchpointList$, MKL$(-1))
LOOP
IF i > 0 THEN
j = CVL(MID$(watchpointList$, i + 4, 4))
temp$ = MID$(watchpointList$, i + 8, j)
j = CVI(RIGHT$(temp$, 2))
a2$ = MID$(temp$, LEN(temp$) - (2 + j) + 1, j)
END IF
END IF
IF INSTR(varType$, "STRING") THEN
thisWidth = idewx - 20
ELSE
thisWidth = 45
SELECT CASE usedVariableList(tempIndex&).displayFormat
CASE 1: a2$ = "&H" + HEX$(VAL(a2$))
CASE 2: a2$ = "&B" + _BIN$(VAL(a2$))
CASE 3: a2$ = "&O" + OCT$(VAL(a2$))
END SELECT
END IF
getNewValueInput:
v$ = ideinputbox$(dlgTitle$, dlgPrompt2$, a2$, "", thisWidth, 0, ok)
_KEYCLEAR
IF ok THEN
IF focus = 6 THEN
'validate condition string first
v$ = LTRIM$(v$)
IF LEN(v$) < 2 THEN
result = idemessagebox(dlgTitle$, "Watchpoint cleared.", "#OK")
_KEYCLEAR
v$ = ""
thisReturnAction = 3 'remove watchpoint for this variable
ELSE
StartWatchPointEval:
op1$ = LEFT$(v$, 1)
op2$ = MID$(v$, 2, 1)
SELECT CASE op1$
CASE "="
IF op2$ = "<" OR op2$ = ">" THEN
MID$(v$, 1, 2) = op2$ + "="
GOTO StartWatchPointEval
END IF
op$ = "="
actualValue$ = _TRIM$(MID$(v$, 2))
CASE ">"
IF op2$ = "<" OR op2$ = ">" THEN
result = idemessagebox(dlgTitle$, "Invalid expression.\nYou can use =, <>, >, >=, <, <=, and a literal value", "#OK")
_KEYCLEAR
GOTO getNewValueInput
END IF
IF op2$ = "=" THEN
op$ = ">="
actualValue$ = _TRIM$(MID$(v$, 3))
ELSE
op$ = ">"
actualValue$ = _TRIM$(MID$(v$, 2))
END IF
CASE "<"
IF op2$ = ">" OR op2$ = "=" THEN
op$ = "<" + op2$
actualValue$ = _TRIM$(MID$(v$, 3))
ELSE
op$ = "<"
actualValue$ = _TRIM$(MID$(v$, 2))
END IF
CASE ELSE
result = idemessagebox(dlgTitle$, "Invalid expression.\nYou can use =, <>, >, >=, <, <=, and a literal value", "#OK")
_KEYCLEAR
GOTO getNewValueInput
END SELECT
END IF
IF thisReturnAction <> 3 THEN
IF INSTR(varType$, "STRING") = 0 THEN
v$ = op$ + actualValue$
IF v$ <> op$ + LTRIM$(STR$(VAL(actualValue$))) THEN
result = idemessagebox(dlgTitle$, "Invalid expression.\nYou can use =, <>, >, >=, <, <=, and a literal value\n(scientific notation not allowed).", "#OK")
_KEYCLEAR
GOTO getNewValueInput
END IF
END IF
v$ = op$ + " " + actualValue$ 'just to prettify it
END IF
END IF
cmd$ = ""
cmd$ = cmd$ + MKL$(tempIndex&)
cmd$ = cmd$ + _MK$(_BYTE, usedVariableList(tempIndex&).isarray)
cmd$ = cmd$ + MKL$(usedVariableList(tempIndex&).linenumber)
cmd$ = cmd$ + MKL$(usedVariableList(tempIndex&).localIndex)
cmd$ = cmd$ + tempArrayIndexes$
cmd$ = cmd$ + MKL$(usedVariableList(tempIndex&).arrayElementSize)
cmd$ = cmd$ + MKL$(tempIsUDT&)
cmd$ = cmd$ + MKL$(tempElement&)
cmd$ = cmd$ + tempElementOffset$
cmd$ = cmd$ + MKL$(0)
cmd$ = cmd$ + MKL$(tempStorage&)
cmd$ = cmd$ + MKI$(LEN(usedVariableList(tempIndex&).subfunc))
cmd$ = cmd$ + usedVariableList(tempIndex&).subfunc
cmd$ = cmd$ + MKI$(LEN(varType$)) + varType$
cmd$ = cmd$ + MKI$(LEN(v$)) + v$
idevariablewatchbox$ = cmd$
IF thisReturnAction = 2 OR thisReturnAction = 3 THEN
'find existing watchpoint for the same variable/index/element
temp$ = MKL$(tempIndex&) + tempArrayIndexes$ + tempElementOffset$
i = 0
i = INSTR(i + 1, watchpointList$, MKL$(-1))
DO WHILE i
IF MID$(watchpointList$, i + 8, LEN(temp$)) = temp$ THEN EXIT DO
i = INSTR(i + 1, watchpointList$, MKL$(-1))
LOOP
IF i > 0 THEN
'remove it
j = CVL(MID$(watchpointList$, i + 4, 4))
watchpointList$ = LEFT$(watchpointList$, i - 1) + MID$(watchpointList$, i + j + 8)
END IF
END IF
IF thisReturnAction = 2 THEN
'add watchpoint
temp$ = temp$ + v$ + MKI$(LEN(v$))
watchpointList$ = watchpointList$ + MKL$(-1) + MKL$(LEN(temp$)) + temp$
END IF
returnAction = thisReturnAction 'actually send command
ELSE
returnAction = -1 'redraw and carry on
END IF
selectVar = y
EXIT FUNCTION
ELSE
result = idemessagebox(dlgTitle$, "Variable is out of scope.", "#OK")
_KEYCLEAR
END IF
ELSE
result = idemessagebox(dlgTitle$, "Select a variable first.", "#OK")
_KEYCLEAR
END IF
focus = filterBox
_CONTINUE
END IF
IF K$ = CHR$(27) OR (IdeDebugMode = 0 AND focus = 5 AND info <> 0) OR _
(IdeDebugMode > 0 AND focus = 7 AND info <> 0) THEN
generateVariableWatchList:
variableWatchList$ = ""
backupVariableWatchList$ = "" 'used in case this program is edited in the same session
backupTypeDefinitions$ = typeDefinitions$ 'store current TYPE definitions for later comparison
longestVarName = 0
nextvWatchDataSlot = 0
totalVisibleVariables = 0
totalSelectedVariables = 0
msg$ = ""
FOR y = 1 TO totalVariablesCreated
IF selectVar = -1 THEN
IF msg$ = "" THEN
msg$ = "Analyzing Variable List..."
idepar p, 60, 1, msg$
END IF
idedrawpar p
COLOR 0, 7
c = totalVariablesCreated
n = y
maxprogresswidth = 52 'arbitrary
percentage = INT(n / c * 100)
percentagechars = INT(maxprogresswidth * n / c)
percentageMsg$ = STRING$(percentagechars, 219) + STRING$(maxprogresswidth - percentagechars, 176) + STR$(percentage) + "%"
_PRINTSTRING (p.x + (p.w \ 2 - LEN(percentageMsg$) \ 2) + 1, p.y + 1), percentageMsg$
PCOPY 1, 0
END IF
IF usedVariableList(y).includedLine THEN _CONTINUE 'don't deal with variables in $INCLUDEs
totalSelectedVariables = totalSelectedVariables + 1
backupVariableWatchList$ = backupVariableWatchList$ + MKL$(-1)
backupVariableWatchList$ = backupVariableWatchList$ + MKL$(LEN(usedVariableList(y).cname)) + usedVariableList(y).cname
backupVariableWatchList$ = backupVariableWatchList$ + MKL$(totalSelectedVariables)
WHILE totalSelectedVariables > UBOUND(backupUsedVariableList)
REDIM _PRESERVE backupUsedVariableList(totalSelectedVariables + 999) AS usedVarList
WEND
backupUsedVariableList(totalSelectedVariables) = usedVariableList(y)
usedVariableList(y).storage = ""
IF usedVariableList(y).watch THEN
thisLen = LEN(usedVariableList(y).name)
IF usedVariableList(y).isarray THEN
thisLen = thisLen + LEN(usedVariableList(y).watchRange)
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$(8)
MID$(variableWatchList$, 1, 4) = MKL$(longestVarName)
END IF
IF usedVariableList(y).isarray <> 0 AND LEN(usedVariableList(y).elements) = 0 THEN
'array of native data type
temp$ = GetBytes$("", 0) 'reset buffer
temp$ = expandArray$(usedVariableList(y).indexes, "")
DO
temp2$ = GetBytes$(temp$, 4)
IF LEN(temp2$) <> 4 THEN EXIT DO 'no more items
length = CVL(temp2$)
temp2$ = MKL$(length) + GetBytes$(temp$, length)
nextvWatchDataSlot = nextvWatchDataSlot + 1
WHILE nextvWatchDataSlot > UBOUND(vWatchReceivedData$)
REDIM _PRESERVE vWatchReceivedData$(1 TO UBOUND(vWatchReceivedData$) + 999)
WEND
variableWatchList$ = variableWatchList$ + MKL$(-1) + MKL$(y) + temp2$ + MKL$(0) + MKL$(0) + MKL$(nextvWatchDataSlot)
totalVisibleVariables = totalVisibleVariables + 1
usedVariableList(y).storage = usedVariableList(y).storage + MKL$(nextvWatchDataSlot)
vWatchReceivedData$(nextvWatchDataSlot) = ""
LOOP
ELSEIF usedVariableList(y).isarray <> 0 AND LEN(usedVariableList(y).elements) > 0 THEN
'array of UDT
temp$ = GetBytes$("", 0)
temp$ = expandArray$(usedVariableList(y).indexes, "")
DO
temp2$ = GetBytes$(temp$, 4)
IF LEN(temp2$) <> 4 THEN EXIT DO 'no more items
length = CVL(temp2$)
temp2$ = MKL$(length) + GetBytes$(temp$, length)
thisTempElement$ = MKL$(-1) + MKL$(y) + temp2$
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
tempElementOffset& = CVL(MID$(usedVariableList(y).elementOffset, i * 4 - 3, 4))
variableWatchList$ = variableWatchList$ + thisTempElement$ + MKL$(i) + MKL$(tempElementOffset&) + MKL$(nextvWatchDataSlot)
totalVisibleVariables = totalVisibleVariables + 1
usedVariableList(y).storage = usedVariableList(y).storage + MKL$(nextvWatchDataSlot)
vWatchReceivedData$(nextvWatchDataSlot) = ""
LOOP
LOOP
ELSEIF usedVariableList(y).isarray = 0 AND LEN(usedVariableList(y).elements) > 0 THEN
'single variable of UDT
thisTempElement$ = MKL$(-1) + 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
tempElementOffset& = CVL(MID$(usedVariableList(y).elementOffset, i * 4 - 3, 4))
variableWatchList$ = variableWatchList$ + thisTempElement$ + MKL$(i) + MKL$(tempElementOffset&) + MKL$(nextvWatchDataSlot)
totalVisibleVariables = totalVisibleVariables + 1
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$(-1) + MKL$(y) + MKL$(0) + MKL$(0) + MKL$(0) + MKL$(nextvWatchDataSlot)
totalVisibleVariables = totalVisibleVariables + 1
usedVariableList(y).storage = MKL$(nextvWatchDataSlot)
END IF
END IF
NEXT
IF LEN(variableWatchList$) THEN MID$(variableWatchList$, 5, 4) = MKL$(totalVisibleVariables)
ClearMouse
EXIT FUNCTION
END IF
IF mCLICK AND focus = 2 THEN 'list click
IF timeElapsedSince(lastClick!) < .3 AND clickedItem = o(varListBox).sel THEN
IF doubleClickThreshold > 0 AND mX >= p.x + doubleClickThreshold AND IdeDebugMode > 0 THEN
focus = 5
GOTO sendValue
ELSEIF (doubleClickThreshold > 0 AND mX < p.x + doubleClickThreshold - 1 AND IdeDebugMode > 0) OR _
IdeDebugMode = 0 THEN
GOTO toggleWatch
END IF
ELSEIF clickedItem = o(varListBox).sel THEN
IF doubleClickThreshold > 0 AND mX = p.x + doubleClickThreshold - 1 AND IdeDebugMode > 0 THEN
y = ABS(o(varListBox).sel)
IF INSTR(usedVariableList(varDlgList(y).index).varType, "STRING *") = 0 AND usedVariableList(varDlgList(y).index).varType <> "STRING" THEN
usedVariableList(varDlgList(y).index).displayFormat = usedVariableList(varDlgList(y).index).displayFormat + 1
IF usedVariableList(varDlgList(y).index).displayFormat > 3 THEN
usedVariableList(varDlgList(y).index).displayFormat = 0
END IF
GOSUB buildList
idetxt(o(varListBox).txt) = l$
END IF
END IF
END IF
lastClick! = TIMER
IF o(varListBox).sel > 0 THEN clickedItem = o(varListBox).sel
_CONTINUE
END IF
IF (K$ = CHR$(13) AND focus = 2) THEN
K$ = ""
toggleWatch:
y = ABS(o(varListBox).sel)
IF y >= 1 AND y <= totalVisibleVariables THEN
o(varListBox).sel = y
quickDlgUpdate = -1: GOSUB dlgUpdate
y = o(varListBox).sel 'reset y, as it may get messed up in the GOSUB above
IF usedVariableList(varDlgList(y).index).watch <> 0 AND usedVariableList(varDlgList(y).index).isarray THEN
GOTO setArrayRange
END IF
usedVariableList(varDlgList(y).index).watch = NOT usedVariableList(varDlgList(y).index).watch
IF usedVariableList(varDlgList(y).index).watch THEN
IF usedVariableList(varDlgList(y).index).isarray THEN
setArrayRange:
temp$ = ""
IF LEN(usedVariableList(varDlgList(y).index).indexes) THEN
temp$ = usedVariableList(varDlgList(y).index).watchRange
END IF
setArrayRange2:
v$ = ideinputbox$("Watch Array", "#Indexes" + tempPrompt$, temp$, "01234567890,-; TOto", 45, 0, ok)
IF ok THEN
IF LEN(v$) > 0 THEN
v$ = UCASE$(v$)
v$ = StrReplace$(v$, " TO ", "-")
WHILE RIGHT$(v$, 1) = ",": v$ = LEFT$(v$, LEN(v$) - 1): WEND
temp$ = lineformat$(v$)
i = countelements(temp$)
IF i <> ABS(ids(usedVariableList(varDlgList(y).index).id).arrayelements) THEN
result = idemessagebox("Error", "Array has" + STR$(ABS(ids(usedVariableList(varDlgList(y).index).id).arrayelements)) + " dimension(s).", "#OK")
temp$ = _TRIM$(v$)
GOTO setArrayRange2
END IF
usedVariableList(varDlgList(y).index).indexes = ""
usedVariableList(varDlgList(y).index).watchRange = ""
WHILE i
foundComma = INSTR(v$, ",")
IF foundComma THEN
temp$ = LEFT$(v$, foundComma - 1)
v$ = MID$(v$, foundComma + 1)
ELSE
temp$ = v$
END IF
temp$ = parseRange$(temp$)
usedVariableList(varDlgList(y).index).indexes = usedVariableList(varDlgList(y).index).indexes + MKL$(LEN(temp$)) + temp$
temp$ = formatRange$(temp$)
usedVariableList(varDlgList(y).index).watchRange = usedVariableList(varDlgList(y).index).watchRange + temp$
i = i - 1
IF i THEN usedVariableList(varDlgList(y).index).watchRange = usedVariableList(varDlgList(y).index).watchRange + ","
WEND
ELSE
usedVariableList(varDlgList(y).index).watch = 0
GOSUB buildList
idetxt(o(varListBox).txt) = l$
GOTO unWatch
END IF
GOSUB buildList
idetxt(o(varListBox).txt) = l$
ELSE
usedVariableList(varDlgList(y).index).watch = 0
GOTO unWatch
END IF
END IF
varType$ = usedVariableList(varDlgList(y).index).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
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, 0, ok)
PCOPY 2, 0
PCOPY 2, 1
SCREEN , , 1, 0
IF ok THEN
longestElementName = 0
usedVariableList(varDlgList(y).index).elements = ""
usedVariableList(varDlgList(y).index).elementTypes = ""
usedVariableList(varDlgList(y).index).elementOffset = ""
getid usedVariableList(varDlgList(y).index).id
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
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
GOTO unWatch
END IF
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
unWatch:
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
'focus = filterBox
_CONTINUE
END IF
IF focus = 2 AND (UCASE$(K$) = "C" AND KCTRL <> 0) THEN
GOSUB copyList
_CONTINUE
END IF
IF focus = varListBox AND (K$ >= " " AND K$ <= CHR$(126)) THEN
focus = filterBox
PrevFocus = focus
idetxt(o(focus).txt) = K$
o(focus).v1 = LEN(idetxt(o(focus).txt))
o(focus).issel = 0
searchTerm$ = ""
_CONTINUE
END IF
IF focus = filterBox AND (KB = 18432 OR KB = 20480) THEN 'up/down arrow
focus = varListBox
_CONTINUE
END IF
IF focus = filterBox AND idetxt(o(filterBox).txt) <> searchTerm$ THEN
filter$ = idetxt(o(filterBox).txt)
searchTerm$ = UCASE$(filter$)
'rebuild filtered list
GOSUB buildList
idetxt(o(varListBox).txt) = l$
o(varListBox).sel = 0 'reset visible list to the first item
IF LEN(searchTerm$) THEN temp$ = ", filtered" ELSE temp$ = ""
idetxt(p.nam) = "Add Watch - Variable List (" + LTRIM$(STR$(totalVisibleVariables)) + temp$ + ")"
END IF
dlgLoop:
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
idevariablewatchbox$ = ""
EXIT FUNCTION
copyList:
temp$ = ""
IF ideprogname = "" THEN
ProposedTitle$ = FindProposedTitle$
IF ProposedTitle$ = "" THEN
temp$ = "QB64 - Variable List Report: untitled" + tempfolderindexstr$ + ".bas" + CHR$(10)
ELSE
temp$ = "QB64 - Variable List Report: " + ProposedTitle$ + ".bas" + CHR$(10)
END IF
ELSE
temp$ = "QB64 - Variable List Report: " + ideprogname$ + CHR$(10)
END IF
FOR x = 1 TO totalVariablesCreated
IF usedVariableList(x).includedLine THEN _CONTINUE 'don't add variables in $INCLUDEs
IF LEN(searchTerm$) THEN
thisScope$ = usedVariableList(x).subfunc
IF thisScope$ = "" THEN thisScope$ = mainmodule$
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
END IF
temp$ = temp$ + usedVariableList(x).name + " "
temp$ = temp$ + SPACE$(maxVarLen - LEN(usedVariableList(x).name))
temp$ = temp$ + " " + usedVariableList(x).varType + SPACE$(maxTypeLen - LEN(usedVariableList(x).varType))
l3$ = SPACE$(2)
IF LEN(usedVariableList(x).subfunc) > 0 THEN
l3$ = l3$ + usedVariableList(x).subfunc + SPACE$(maxModuleNameLen - LEN(usedVariableList(x).subfunc)) + CHR$(10)
ELSE
l3$ = l3$ + mainmodule$ + SPACE$(maxModuleNameLen - LEN(mainmodule$)) + CHR$(10)
END IF
temp$ = temp$ + l3$
NEXT
_CLIPBOARD$ = temp$
RETURN
buildList:
maxVarLen = LEN("Variable")
FOR x = 1 TO totalVariablesCreated
IF usedVariableList(x).includedLine THEN _CONTINUE 'don't deal with variables in $INCLUDEs
thisLen = LEN(usedVariableList(x).name) + 3 'extra room for the eventual bullet
IF LEN(usedVariableList(x).watchRange) > 0 THEN
thisLen = thisLen + LEN(usedVariableList(x).watchRange)
END IF
IF thisLen > maxVarLen THEN maxVarLen = thisLen
NEXT
IF firstRun THEN
msg$ = "Building Variable List..."
IF selectVar = -1 THEN msg$ = "Analyzing Variable List..."
idepar p, 60, 1, msg$
END IF
l$ = ""
totalVisibleVariables = 0
FOR x = 1 TO totalVariablesCreated
IF firstRun THEN
idedrawpar p
COLOR 0, 7
c = totalVariablesCreated
n = x
maxprogresswidth = 52 'arbitrary
percentage = INT(n / c * 100)
percentagechars = INT(maxprogresswidth * n / c)
percentageMsg$ = STRING$(percentagechars, 219) + STRING$(maxprogresswidth - percentagechars, 176) + STR$(percentage) + "%"
_PRINTSTRING (p.x + (p.w \ 2 - LEN(percentageMsg$) \ 2) + 1, p.y + 1), percentageMsg$
PCOPY 1, 0
END IF
IF usedVariableList(x).includedLine THEN _CONTINUE 'don't add variables in $INCLUDEs
IF LEN(searchTerm$) THEN
thisScope$ = usedVariableList(x).subfunc
IF thisScope$ = "" THEN thisScope$ = mainmodule$
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$ + StrReplace$(vWatchReceivedData$(CVL(usedVariableList(x).storage)), CHR$(0), " ")
END IF
IF multiSearch(item$, searchTerm$) = 0 THEN
_CONTINUE 'skip variable if no field matches the search
END IF
END IF
totalVisibleVariables = totalVisibleVariables + 1
WHILE totalVisibleVariables > UBOUND(varDlgList)
REDIM _PRESERVE varDlgList(1 TO totalVariablesCreated + 100) AS varDlgList
WEND
l$ = l$ + CHR$(17)
varDlgList(totalVisibleVariables).bgColorFlag = LEN(l$) + 1
IF usedVariableList(x).watch THEN
l$ = l$ + CHR$(selectedBG)
ELSE
l$ = l$ + CHR$(17)
END IF
l$ = l$ + CHR$(16)
varDlgList(totalVisibleVariables).index = x
IF itemToSelect > 0 AND x = itemToSelect THEN itemToSelect = 0: o(varListBox).sel = totalVisibleVariables
varDlgList(totalVisibleVariables).colorFlag = LEN(l$) + 1
varDlgList(totalVisibleVariables).indicator = LEN(l$) + 2
IF usedVariableList(x).watch THEN
l$ = l$ + CHR$(variableNameColor) + "+"
ELSE
l$ = l$ + CHR$(16) + " "
END IF
thisName$ = usedVariableList(x).name
IF LEN(usedVariableList(x).watchRange) THEN
thisName$ = LEFT$(thisName$, LEN(thisName$) - 1) + usedVariableList(x).watchRange + ")"
END IF
'find existing watchpoint for this variable/index/element
temp$ = MKL$(x)
i = 0
i = INSTR(i + 1, watchpointList$, MKL$(-1))
DO WHILE i
IF MID$(watchpointList$, i + 8, LEN(temp$)) = temp$ THEN EXIT DO
i = INSTR(i + 1, watchpointList$, MKL$(-1))
LOOP
IF i > 0 THEN
thisName$ = thisName$ + CHR$(16) + CHR$(4) + CHR$(7) 'red bullet to indicate watchpoint
ELSE
thisName$ = thisName$ + CHR$(16) + CHR$(16) + " "
END IF
text$ = thisName$ + CHR$(16)
varDlgList(totalVisibleVariables).colorFlag2 = LEN(l$) + LEN(text$) + 1
IF usedVariableList(x).watch THEN
text$ = text$ + CHR$(typeColumnColor) + " "
ELSE
text$ = text$ + CHR$(2) + " "
END IF
text$ = text$ + SPACE$(maxVarLen - LEN(thisName$))
text$ = text$ + " " + usedVariableList(x).varType + SPACE$(maxTypeLen - LEN(usedVariableList(x).varType))
l3$ = SPACE$(2)
IF LEN(usedVariableList(x).subfunc) > 0 THEN
l3$ = l3$ + usedVariableList(x).subfunc + SPACE$(maxModuleNameLen - LEN(usedVariableList(x).subfunc)) + CHR$(16) + CHR$(16)
ELSE
l3$ = l3$ + mainmodule$ + SPACE$(maxModuleNameLen - LEN(mainmodule$)) + CHR$(16) + CHR$(16)
END IF
l$ = l$ + text$ + l3$
IF x = 1 THEN doubleClickThreshold = LEN(l$) - 3
IF IdeDebugMode > 0 THEN
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 <> 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)
tempValue$ = StrReplace$(vWatchReceivedData$(storageSlot&), CHR$(0), " ")
IF thisIsAString THEN
l$ = l$ + CHR$(34)
ELSE
SELECT CASE usedVariableList(x).displayFormat
'displayFormat: 0=DEC;1=HEX;2=BIN;3=OCT
CASE 1: tempValue$ = "&H" + HEX$(VAL(tempValue$))
CASE 2: tempValue$ = "&B" + _BIN$(VAL(tempValue$))
CASE 3: tempValue$ = "&O" + OCT$(VAL(tempValue$))
END SELECT
END IF
l$ = l$ + tempValue$
IF thisIsAString THEN l$ = l$ + CHR$(34)
IF LEN(temp$) THEN l$ = l$ + ","
LOOP
IF LEN(usedVariableList(x).storage) THEN l$ = l$ + "}"
ELSEIF usedVariableList(x).isarray = 0 AND LEN(usedVariableList(x).elements) = 0 THEN
'simple variable
IF LEN(usedVariableList(x).storage) = 4 THEN
storageSlot& = CVL(usedVariableList(x).storage)
l$ = l$ + " = " + CHR$(16) + CHR$(variableNameColor)
tempValue$ = StrReplace$(vWatchReceivedData$(storageSlot&), CHR$(0), " ")
IF thisIsAString THEN
l$ = l$ + CHR$(34)
ELSE
SELECT CASE usedVariableList(x).displayFormat
'displayFormat: 0=DEC;1=HEX;2=BIN;3=OCT
CASE 1: tempValue$ = "&H" + HEX$(VAL(tempValue$))
CASE 2: tempValue$ = "&B" + _BIN$(VAL(tempValue$))
CASE 3: tempValue$ = "&O" + OCT$(VAL(tempValue$))
END SELECT
END IF
l$ = l$ + tempValue$
IF thisIsAString THEN l$ = l$ + CHR$(34)
END IF
ELSE
l$ = l$ + " = " + CHR$(16) + CHR$(variableNameColor)
l$ = l$ + "<multiple values>"
END IF
END IF
ELSE
l$ = l$ + " <out of scope>"
END IF
END IF
IF x < totalVariablesCreated THEN l$ = l$ + sep
NEXT
itemToSelect = 0
RETURN
END FUNCTION
FUNCTION ideelementwatchbox$(currentPath$, elementIndexes$, level, singleElementSelection, 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
title$ = "Add UDT Elements"
IF singleElementSelection THEN title$ = "Choose UDT Element"
idepar p, dialogWidth, dialogHeight, title$
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
IF singleElementSelection THEN
o(buttonSet).txt = idenewtxt("#OK" + sep + "#Cancel" + sep + "#Up One Level")
ELSE
o(buttonSet).txt = idenewtxt("#Add All" + sep + "#Remove All" + sep + "#Close")
END IF
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
IF singleElementSelection THEN
'ok
y = ABS(o(varListBox).sel)
IF y >= 1 AND y <= totalElements THEN
toggleAndReturn = -1: GOSUB toggleWatch: toggleAndReturn = 0
GOTO buildListToReturn
END IF
ELSE
'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
END IF
_CONTINUE
END IF
IF (focus = 3 AND info <> 0) THEN
IF singleElementSelection THEN
'cancel
ok = -3
EXIT FUNCTION
ELSE
'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
END IF
_CONTINUE
END IF
IF K$ = CHR$(27) OR (focus = 4 AND info <> 0) THEN
IF singleElementSelection THEN
ok = -4
EXIT FUNCTION
ELSE
'build element list to return
buildListToReturn:
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
IF singleElementSelection THEN
IF LEN(returnList$) > 0 THEN
ok = -2 'different return so selection can be done with
ELSE
ok = 0
END IF
ELSE
ok = LEN(returnList$) > 0
END IF
IF level = 0 THEN returnList$ = StrReplace$(returnList$, currentPath$, ".")
ideelementwatchbox$ = returnList$
END IF
ClearMouse
EXIT FUNCTION
END IF
IF mCLICK AND focus = 1 THEN 'list click
IF timeElapsedSince(lastClick!) < .3 AND clickedItem = o(varListBox).sel THEN
IF singleElementSelection = 0 THEN
GOTO toggleWatch
ELSE
y = ABS(o(varListBox).sel)
IF y >= 1 AND y <= totalElements THEN
toggleAndReturn = -1: GOSUB toggleWatch: toggleAndReturn = 0
y = ABS(o(varListBox).sel)
GOTO buildListToReturn
END IF
END IF
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
IF singleElementSelection THEN
varDlgList(y).selected = -1
ELSE
varDlgList(y).selected = NOT varDlgList(y).selected
END IF
IF varDlgList(y).selected THEN
IF singleElementSelection THEN
FOR i = 1 TO totalElements
IF i = y THEN _CONTINUE
varDlgList(i).selected = 0
ASC(idetxt(o(varListBox).txt), varDlgList(i).colorFlag) = 16
ASC(idetxt(o(varListBox).txt), varDlgList(i).colorFlag2) = 2
ASC(idetxt(o(varListBox).txt), varDlgList(i).bgColorFlag) = 17
ASC(idetxt(o(varListBox).txt), varDlgList(i).indicator) = 32 'space
NEXT
END IF
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, singleElementSelection, ok2)
ok = ok2
IF ok2 = -2 THEN
'single selection
GOTO buildListToReturn
ELSEIF ok2 = -3 THEN
'single selection canceled
EXIT FUNCTION
ELSEIF ok2 = -4 THEN
i = y
varDlgList(i).selected = 0
ASC(idetxt(o(varListBox).txt), varDlgList(i).colorFlag) = 16
ASC(idetxt(o(varListBox).txt), varDlgList(i).colorFlag2) = 2
ASC(idetxt(o(varListBox).txt), varDlgList(i).bgColorFlag) = 17
ASC(idetxt(o(varListBox).txt), varDlgList(i).indicator) = 32 'space
_CONTINUE
END IF
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
IF toggleAndReturn THEN RETURN
_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
varDlgList(x).selected = 0
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$
v1 = -1
v2 = -1
FOR i = 1 TO LEN(temp$) \ 4
v = CVL(MID$(temp$, i * 4 - 3, 4))
IF v1 = -1 THEN
v1 = v
ELSE
IF v = v1 + 1 OR v = v2 + 1 THEN
v2 = v
ELSE
IF v2 = -1 THEN
a2$ = a2$ + LTRIM$(STR$(v1)) + ";"
v1 = v
ELSE
a2$ = a2$ + LTRIM$(STR$(v1)) + "-" + LTRIM$(STR$(v2)) + ";"
v1 = v
v2 = -1
END IF
END IF
END IF
NEXT
IF v1 <> -1 AND v2 = -1 THEN a2$ = a2$ + LTRIM$(STR$(v1))
IF v1 <> -1 AND v2 <> -1 THEN a2$ = a2$ + LTRIM$(STR$(v1)) + "-" + LTRIM$(STR$(v2))
formatRange$ = a2$
END FUNCTION
FUNCTION expandArray$ (__indexes$, __path$)
STATIC thisLevel AS LONG, returnValue$
IF thisLevel = 0 THEN
returnValue$ = ""
END IF
thisLevel = thisLevel + 1
totalIndexes = CVL(LEFT$(__indexes$, 4))
indexes$ = MID$(__indexes$, 5, totalIndexes)
remainingIndexes$ = MID$(__indexes$, 5 + totalIndexes)
totalIndexes = totalIndexes \ 4
FOR i = 1 TO totalIndexes
temp$ = __path$ + MID$(indexes$, i * 4 - 3, 4)
IF LEN(remainingIndexes$) THEN
temp$ = expandArray$(remainingIndexes$, temp$)
END IF
IF LEN(temp$) THEN
returnValue$ = returnValue$ + MKL$(LEN(temp$)) + temp$
END IF
NEXT
thisLevel = thisLevel - 1
IF thisLevel = 0 THEN
expandArray$ = returnValue$
END IF
END FUNCTION
FUNCTION parseRange$(__text$)
'__text$ must contain a valid numeric string (####),
'a valid interval (####-####) or comma-separated values.
'Only positive values >= 0 considered.
'Returns MKL$(value1) + MKL$(value2)... in order
IF LEN(_TRIM$(__text$)) = 0 THEN EXIT FUNCTION
DIM zeroIncluded AS _BYTE
Filter$ = _TRIM$(__text$)
j = INSTR(Filter$, "-") + INSTR(Filter$, ";")
temp$ = SPACE$(1000)
IF j = 0 THEN 'Single number passed
parseRange$ = MKL$(VAL(Filter$))
EXIT FUNCTION
END IF
Reading = 1
FOR j = 1 TO LEN(Filter$)
v = ASC(Filter$, j)
SELECT CASE v
CASE 59 ';
Reading = 1
GOSUB parseIt
CASE 45 'hyphen
IF PrevChar <> 45 THEN
Reading = Reading + 1
IF Reading = 2 THEN
IF j = LEN(Filter$) THEN GOSUB parseIt
END IF
END IF
CASE 48 TO 57 '0 to 9
IF Reading = 1 THEN
v1$ = v1$ + CHR$(v)
ELSEIF Reading = 2 THEN
v2$ = v2$ + CHR$(v)
END IF
IF j = LEN(Filter$) THEN GOSUB parseIt
END SELECT
PrevChar = v
NEXT j
returnValue$ = ""
IF zeroIncluded THEN returnValue$ = MKL$(0)
FOR i = 1 TO LEN(temp$)
IF ASC(temp$, i) = 1 THEN returnValue$ = returnValue$ + MKL$(i)
NEXT
parseRange$ = returnValue$
EXIT FUNCTION
parseIt:
v1 = VAL(v1$)
v2 = VAL(v2$)
IF LEN(v2$) > 0 THEN
IF LEN(v1$) > 0 THEN
IF v1 > v2 THEN SWAP v1, v2
IF v2 > LEN(temp$) THEN temp$ = temp$ + SPACE$(v2 - LEN(temp$))
IF v1 = 0 THEN zeroIncluded = -1: v1 = 1
FOR i = v1 TO v2
ASC(temp$, i) = 1
NEXT
END IF
ELSE
IF v1 > LEN(temp$) THEN temp$ = temp$ + SPACE$(v1 - LEN(temp$))
IF v1 = 0 THEN
zeroIncluded = -1
ELSE
ASC(temp$, v1) = 1
END IF
END IF
v1$ = ""
v2$ = ""
RETURN
END FUNCTION
FUNCTION idecallstackbox
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
dialogHeight = callStackLength + 4
IF dialogHeight > idewy + idesubwindow - 6 THEN
dialogHeight = idewy + idesubwindow - 6
END IF
dialogWidth = 52
temp$ = callstacklist$
DO
i = INSTR(temp$, sep)
IF i THEN
temp2$ = LEFT$(temp$, i - 1)
temp$ = MID$(temp$, i + 1)
IF LEN(temp2$) + 6 > dialogWidth THEN dialogWidth = LEN(temp2$) + 6
ELSE
IF LEN(temp$) + 6 > dialogWidth THEN dialogWidth = LEN(temp$) + 6
EXIT DO
END IF
LOOP
IF dialogWidth > idewx - 8 THEN dialogWidth = idewx - 8
idepar p, dialogWidth, dialogHeight, "$DEBUG MODE"
i = 0
i = i + 1
o(i).typ = 2
o(i).y = 2
o(i).w = dialogWidth - 4: o(i).h = dialogHeight - 4
o(i).txt = idenewtxt(callstacklist$)
o(i).sel = callStackLength
o(i).nam = idenewtxt("Call Stack")
i = i + 1
o(i).typ = 3
o(i).y = dialogHeight
o(i).txt = idenewtxt("#Go To Line" + sep + "#Close" + sep + "Co#py")
o(i).dft = 1
'-------- 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: _PRINTSTRING (p.x + 2, p.y + 1), "Most recent sub/function calls in your program:"
'-------- 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 mCLICK AND focus = 1 THEN 'list click
IF timeElapsedSince(lastClick!) < .3 AND clickedItem = o(1).sel THEN
GOTO setIDEcy
END IF
lastClick! = TIMER
IF o(1).sel > 0 THEN clickedItem = o(1).sel
_CONTINUE
END IF
IF (focus = 1 AND K$ = CHR$(13)) OR (focus = 2 AND info <> 0)THEN
setIDEcy:
y = ABS(o(1).sel)
IF y >= 1 AND y <= callStackLength THEN
temp$ = idetxt(o(1).stx)
idegotobox_LastLineNum = VAL(MID$(temp$, _INSTRREV(temp$, " ") + 1))
idecy = idegotobox_LastLineNum
idecentercurrentline
ideselect = 0
ClearMouse
EXIT FUNCTION
END IF
END IF
IF K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN
EXIT FUNCTION
END IF
IF K$ = CHR$(13) OR (focus = 3 AND info <> 0) THEN
EXIT FUNCTION
END IF
IF K$ = CHR$(13) OR (focus = 4 AND info <> 0) OR (UCASE$(K$) = "C" AND KCTRL <> 0) THEN
_CLIPBOARD$ = StrReplace$(callstacklist$, sep, CHR$(10))
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
idecallstackbox = 0
END FUNCTION
SUB idebox (x, y, w, h)
_PRINTSTRING (x, y), CHR$(218) + STRING$(w - 2, 196) + CHR$(191)
FOR y2 = y + 1 TO y + h - 2
_PRINTSTRING (x, y2), CHR$(179) + SPACE$(w - 2) + CHR$(179)
NEXT
_PRINTSTRING (x, y + h - 1), CHR$(192) + STRING$(w - 2, 196) + CHR$(217)
END SUB
SUB ideboxshadow (x, y, w, h)
idebox x, y, w, h
'shadow
COLOR 2, 0
FOR y2 = y + 1 TO y + h - 1
FOR x2 = x + w TO x + w + 1
IF x2 <= idewx AND y2 <= idewy + idesubwindow THEN
_PRINTSTRING (x2, y2), CHR$(SCREEN(y2, x2))
END IF
NEXT
NEXT
y2 = y + h
IF y2 <= idewy + idesubwindow THEN
FOR x2 = x + 2 TO x + w + 1
IF x2 <= idewx THEN
_PRINTSTRING (x2, y2), CHR$(SCREEN(y2, x2))
END IF
NEXT
END IF
END SUB
FUNCTION idechange$
REDIM SearchHistory(0) AS STRING
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
'built initial search strings
IF ideselect THEN
IF ideselecty1 = idecy THEN 'single line selected
a$ = idegetline(idecy)
a2$ = ""
sx1 = ideselectx1: sx2 = idecx
IF sx2 < sx1 THEN SWAP sx1, sx2
FOR x = sx1 TO sx2 - 1
IF x <= LEN(a$) THEN a2$ = a2$ + MID$(a$, x, 1) ELSE a2$ = a2$ + " "
NEXT
END IF
END IF
IF a2$ = "" THEN
a2$ = idefindtext
END IF
RetrieveSearchHistory SearchHistory()
i = 0
idepar p, 60, 14, "Change"
i = i + 1
PrevFocus = 1
o(i).typ = 1
o(i).y = 2
o(i).nam = idenewtxt("#Find What")
o(i).txt = idenewtxt(a2$)
IF LEN(a2$) > 0 THEN
o(i).issel = -1
o(i).sx1 = 0
END IF
o(i).v1 = LEN(a2$)
i = i + 1
o(i).typ = 1
o(i).y = 5
o(i).nam = idenewtxt("Change #To")
o(i).txt = idenewtxt(idechangeto)
IF LEN(idechangeto) > 0 THEN
o(i).issel = -1
o(i).sx1 = 0
END IF
o(i).v1 = LEN(idechangeto)
i = i + 1
o(i).typ = 4 'check box
o(i).y = 8
o(i).nam = idenewtxt("#Match Upper/Lowercase")
o(i).sel = idefindcasesens
i = i + 1
o(i).typ = 4 'check box
o(i).y = 9
o(i).nam = idenewtxt("#Whole Word")
o(i).sel = idefindwholeword
i = i + 1
o(i).typ = 4 'check box
o(i).y = 10
o(i).nam = idenewtxt("#Search Backwards")
o(i).sel = idefindbackwards
i = i + 1
o(i).typ = 4 'check box
o(i).y = 11
o(i).nam = idenewtxt("#Ignore 'comments")
o(i).sel = idefindnocomments
i = i + 1
o(i).typ = 4 'check box
o(i).x = 29
o(i).y = 11
o(i).nam = idenewtxt("#Look only in 'comments")
o(i).sel = idefindonlycomments
i = i + 1
o(i).typ = 4 'check box
o(i).y = 12
o(i).nam = idenewtxt("Ignore " + CHR$(34) + "#strings" + CHR$(34))
o(i).sel = idefindnostrings
i = i + 1
o(i).typ = 4 'check box
o(i).x = 29
o(i).y = 12
o(i).nam = idenewtxt("Look only in " + CHR$(34) + "st#rings" + CHR$(34))
o(i).sel = idefindonlystrings
i = i + 1
ButtonsID = i
o(i).typ = 3
o(i).y = 14
o(i).txt = idenewtxt("Find and #Verify" + sep + "#Change All" + sep + "Cancel")
o(i).dft = 1
'-------- 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 --------
GOSUB displayDialog
lastfocus = f - 1
'-------- end of generic display dialog box & objects --------
'-------- custom display changes --------
'-------- 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 --------
'specific post controls
IF focus <> PrevFocus THEN
'Always start with TextBox values selected upon getting focus
PrevFocus = focus
IF focus = 1 OR focus = 2 THEN
o(focus).v1 = LEN(idetxt(o(focus).txt))
IF o(focus).v1 > 0 THEN o(focus).issel = -1
o(focus).sx1 = 0
END IF
END IF
'mutually exclusive options
IF focus = 6 AND o(6).sel = 1 THEN
o(7).sel = 0
ELSEIF focus = 7 AND o(7).sel = 1 THEN
o(6).sel = 0
o(8).sel = 0
o(9).sel = 0
ELSEIF focus = 8 AND o(8).sel = 1 THEN
o(9).sel = 0
ELSEIF focus = 9 AND o(9).sel = 1 THEN
o(6).sel = 0
o(7).sel = 0
o(8).sel = 0
END IF
IF K$ = CHR$(27) OR (focus = 12 AND info <> 0) THEN
idechange$ = "C"
EXIT FUNCTION
END IF
IF UBOUND(SearchHistory) > 0 THEN
IF K$ = CHR$(0) + CHR$(72) AND focus = 1 THEN 'Up
IF ln < UBOUND(SearchHistory) THEN
ln = ln + 1
END IF
idetxt(o(1).txt) = SearchHistory(ln)
o(1).issel = -1: o(1).sx1 = 0: o(1).v1 = LEN(idetxt(o(1).txt))
END IF
IF K$ = CHR$(0) + CHR$(80) AND focus = 1 THEN 'Down
IF ln > 1 THEN
ln = ln - 1
ELSE
ln = 1
END IF
idetxt(o(1).txt) = SearchHistory(ln)
o(1).issel = -1: o(1).sx1 = 0: o(1).v1 = LEN(idetxt(o(1).txt))
END IF
END IF
IF focus = 11 AND info <> 0 THEN 'change all
idefindcasesens = o(3).sel
idefindwholeword = o(4).sel
idefindbackwards = o(5).sel
idefindnocomments = o(6).sel
idefindonlycomments = o(7).sel
idefindnostrings = o(8).sel
idefindonlystrings = o(9).sel
s$ = idetxt(o(1).txt)
idefindtext$ = s$
idechangeto$ = idetxt(o(2).txt)
IdeAddSearched idefindtext
changed = 0
s$ = idefindtext$
IF idefindcasesens = 0 THEN s$ = UCASE$(s$)
FOR y = 1 TO iden
COLOR 0, 7
maxprogresswidth = p.w - 4
percentage = INT(y / iden * 100)
percentagechars = INT(maxprogresswidth * y / iden)
percentageMsg$ = STRING$(percentagechars, 219) + STRING$(maxprogresswidth - percentagechars, 176)
_PRINTSTRING (p.x + 2, p.y + 7), percentageMsg$
PCOPY 1, 0
l$ = idegetline(y)
l2$ = ""
x1 = 1
idechangeall:
IF idefindcasesens = 0 THEN l3$ = UCASE$(l$) ELSE l3$ = l$
x = INSTR(x1, l3$, s$)
IF x THEN
IF idefindwholeword THEN
whole = 1
IF x > 1 THEN
c = ASC(UCASE$(MID$(l$, x - 1, 1)))
IF c >= 65 AND c <= 90 THEN whole = 0
IF c >= 48 AND c <= 57 THEN whole = 0
END IF
IF x + LEN(s$) <= LEN(l$) THEN
c = ASC(UCASE$(MID$(l$, x + LEN(s$), 1)))
IF c >= 65 AND c <= 90 THEN whole = 0
IF c >= 48 AND c <= 57 THEN whole = 0
END IF
IF whole = 0 THEN
IF x1 <= LEN(l$) THEN
l2$ = l2$ + MID$(l$, x1, x - x1 + 1)
x1 = x + 1
GOTO idechangeall
END IF
x = 0
END IF
END IF
END IF
DIM comment AS _BYTE, quote AS _BYTE
IF x THEN
FindQuoteComment l$, x, comment, quote
IF idefindnocomments <> 0 AND comment THEN x = 0
IF idefindnostrings <> 0 AND quote THEN x = 0
IF idefindonlycomments <> 0 AND comment = 0 THEN x = 0
IF idefindonlystrings <> 0 AND quote = 0 THEN x = 0
END IF
IF x THEN
l2$ = l2$ + MID$(l$, x1, x - x1) + idechangeto$
changed = changed + 1
x1 = x + LEN(s$)
IF x1 <= LEN(l$) THEN GOTO idechangeall
END IF
l2$ = l2$ + MID$(l$, x1, LEN(l$) - x1 + 1)
IF l2$ <> l$ THEN idesetline y, l2$
NEXT
SCREEN , , 3, 0
clearStatusWindow 0
idefocusline = 0
ideshowtext
PCOPY 3, 0
PCOPY 0, 2
PCOPY 0, 1
SCREEN , , 1, 0
GOSUB displayDialog
PCOPY 1, 0
IF changed = 0 THEN
idenomatch 0
ELSE
idechanged changed: idechangemade = 1: startPausedPending = 0
END IF
idetxt(o(ButtonsID).txt) = "Find and #Verify" + sep + "#Change All" + sep + "Close"
END IF 'change all
IF (focus = 10 AND info <> 0) OR K$ = CHR$(13) THEN
idefindcasesens = o(3).sel
idefindwholeword = o(4).sel
idefindbackwards = o(5).sel
idefindnocomments = o(6).sel
idefindonlycomments = o(7).sel
idefindnostrings = o(8).sel
idefindonlystrings = o(9).sel
idefindtext$ = idetxt(o(1).txt)
idechangeto$ = idetxt(o(2).txt)
idechange$ = "V"
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
EXIT FUNCTION
displayDialog:
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
RETURN
END FUNCTION
SUB FindQuoteComment (text$, __cursor AS LONG, c AS _BYTE, q AS _BYTE)
c = 0: q = 0
cursor = __cursor
IF cursor > LEN(text$) THEN cursor = LEN(text$)
FOR find_k = 1 TO cursor
SELECT CASE MID$(text$, find_k, 1)
CASE CHR$(34): q = NOT q
CASE "'": IF q = 0 THEN c = -1: EXIT FOR
CASE "R", "r"
IF q = 0 THEN
IF UCASE$(MID$(text$, find_k - 1, 5)) = " REM " OR _
UCASE$(MID$(text$, find_k - 1, 5)) = ":REM " OR _
(find_k + 2 = LEN(text$) AND UCASE$(MID$(text$, find_k - 1, 4)) = " REM") OR _
(find_k + 2 = LEN(text$) AND UCASE$(MID$(text$, find_k - 1, 4)) = ":REM") OR _
(find_k = 1 AND UCASE$(LEFT$(text$, 4)) = "REM ") OR _
(find_k = 1 AND UCASE$(text$) = "REM") THEN
c = -1: EXIT FOR
END IF
END IF
END SELECT
NEXT find_k
END SUB
SUB idechanged (totalChanges AS LONG)
IF totalChanges > 1 THEN pl$ = "s"
result = idemessagebox("Change Complete", LTRIM$(STR$(totalChanges)) + " substitution" + pl$ + ".", "")
END SUB
FUNCTION idechangeit$
'-------- generic dialog box header --------
PCOPY 3, 0
PCOPY 0, 2
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 --------
i = 0
w = 45
p.x = 40 - w \ 2
p.y = idewy - 4
p.w = w
p.h = 2
p.nam = idenewtxt("Change")
i = i + 1
o(i).typ = 3
o(i).y = 2
o(i).txt = idenewtxt("#Change" + sep + "#Skip" + sep + "Cancel")
o(i).dft = 1
'-------- 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 --------
'-------- 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 --------
IF UCASE$(K$) = "C" THEN altletter$ = "C"
IF UCASE$(K$) = "S" THEN altletter$ = "S"
'-------- 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 K$ = CHR$(27) THEN
idechangeit$ = "C"
EXIT FUNCTION
END IF
IF info THEN
IF info = 1 THEN idechangeit$ = "Y"
IF info = 2 THEN idechangeit$ = "N"
IF info = 3 THEN idechangeit$ = "C"
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
SUB idedelline (i)
FOR b = 1 TO IdeBmkN
IF IdeBmk(b).y >= i THEN
y = IdeBmk(b).y - 1: IF y = 0 THEN y = 1
IdeBmk(b).y = y
END IF
NEXT
IF vWatchOn THEN
IF iden > UBOUND(IdeBreakpoints) OR iden > UBOUND(IdeSkipLines) THEN
REDIM _PRESERVE IdeBreakpoints(iden) AS _BYTE
REDIM _PRESERVE IdeSkipLines(iden) AS _BYTE
END IF
FOR b = i TO iden - 1
SWAP IdeBreakpoints(b), IdeBreakpoints(b + 1)
NEXT
REDIM _PRESERVE IdeBreakpoints(iden - 1) AS _BYTE
FOR b = i TO iden - 1
SWAP IdeSkipLines(b), IdeSkipLines(b - 1)
NEXT
REDIM _PRESERVE IdeSkipLines(iden - 1) AS _BYTE
END IF
idegotoline i
textlen = CVL(MID$(idet$, ideli, 4))
idet$ = LEFT$(idet$, ideli - 1) + RIGHT$(idet$, LEN(idet$) - ideli + 1 - 8 - textlen)
iden = iden - 1
IF i > iden THEN idegotoline iden '[2013] if last line was removed, move to previous line
END SUB
SUB idedeltxt
idetxtlast = 0
END SUB
SUB idedrawobj (o AS idedbotype, f)
DIM sep AS STRING * 1
sep = CHR$(0)
'#1: SINGLE LINE TEXT INPUT BOX
IF o.typ = 1 THEN
IF o.x = 0 THEN o.x = 2
x = o.par.x + o.x: y = o.par.y + o.y
COLOR 0, 7
IF o.nam THEN
a$ = idetxt(o.nam)
LOCATE y, x: idehPRINT a$ + ":"
x = x + idehlen(a$) + 2
END IF
IF o.w = 0 THEN x2 = o.par.x + o.par.w - 1: o.w = x2 - x - 3
idebox x, y - 1, o.w + 4, 3
IF o.txt = 0 THEN o.txt = idenewtxt("")
a$ = idetxt(o.txt)
IF o.v1 > LEN(a$) THEN o.v1 = LEN(a$) 'new
cx = o.v1
tx = 1
IF LEN(a$) > o.w THEN
IF o.foc = 0 THEN
tx = o.v1 - o.w + 1
IF tx < 1 THEN tx = 1
a$ = MID$(a$, tx, o.w)
cx = cx - tx + 1
ELSE
a$ = LEFT$(a$, o.w)
END IF
END IF
sx1 = o.sx1: sx2 = o.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
x = x + 2
'apply selection color change if necessary
IF o.issel = 0 OR o.foc <> 0 THEN
_PRINTSTRING (x, y), a$
ELSE
FOR ColorCHAR = 1 TO LEN(a$)
IF ColorCHAR + tx - 2 >= sx1 AND ColorCHAR + tx - 2 < sx2 THEN COLOR 7, 0 ELSE COLOR 0, 7
_PRINTSTRING (x - 1 + ColorCHAR, y), MID$(a$, ColorCHAR, 1)
NEXT
END IF
IF o.foc = 0 THEN o.cx = x + cx: o.cy = y
f = f + 1
END IF '#1
'#2: VERTICAL SCROLLING SELECTION BOX
IF o.typ = 2 THEN
IF o.x = 0 THEN o.x = 2
IF o.w = 0 THEN o.w = o.par.w - 2 - o.x
IF o.h = 0 THEN o.h = o.par.h - 1 - o.y
x = o.par.x + o.x: y = o.par.y + o.y
COLOR 0, 7
idebox x, y, o.w + 2, o.h + 2
IF o.nam THEN
a$ = idetxt(o.nam)
w = o.w + 2
m = w \ 2: IF w AND 1 THEN m = m + 1
LOCATE y, x + m - 1 - ((idehlen(a$) + 2) - 1) \ 2: idehPRINT " " + a$ + " "
END IF 'nam
'display list items
IF o.sel = 0 THEN o.sel = -1
IF o.txt = 0 THEN o.txt = idenewtxt("")
IF o.stx = 0 THEN o.stx = idenewtxt("")
IF o.v1 = 0 THEN o.v1 = 1
s = ABS(o.sel)
IF s >= o.v1 + o.h THEN o.v1 = s - o.h + 1
IF s < o.v1 THEN o.v1 = s
IF o.foc <> 0 AND o.sel > 0 THEN o.sel = -o.sel
a$ = idetxt(o.txt)
n = 1
y = 1
v1 = o.v1
a3$ = ""
FOR i2 = 1 TO LEN(a$)
a2$ = MID$(a$, i2, 1)
IF a2$ <> sep THEN a3$ = a3$ + a2$
IF a2$ = sep OR i2 = LEN(a$) THEN
IF n < v1 THEN
'skip
ELSE
IF y <= o.h THEN
a3$ = " " + RTRIM$(a3$)
IF o.sel = n THEN
COLOR 7, 0
o.selY = o.par.y + o.y + y
ELSE
COLOR 0, 7
END IF
IF (o.sel = n OR -o.sel = n) AND o.foc = 0 THEN
o.cx = o.par.x + o.x + 2: o.cy = o.par.y + o.y + y
IF LEFT$(a3$, 2) = CHR$(32) + CHR$(195) OR LEFT$(a3$, 2) = CHR$(32) + CHR$(192) THEN
o.cx = o.cx + 2
END IF
END IF
LOCATE o.par.y + o.y + y, o.par.x + o.x + 1
IF INSTR(a3$, CHR$(16)) THEN
'color formatting: CHR$(16) + CHR$(color)
' CHR$(16) + CHR$(16) restores default
' CHR$(17) + CHR$(bg color)
' CHR$(17) + CHR$(17) restores default
character = 0
rightSideLimit = POS(1) + o.w - 1
cf = POS(1)
DO
character = character + 1
IF character > LEN(a3$) THEN
PRINT SPACE$(o.w - (POS(1) - (o.par.x + o.x)) + 1);
EXIT DO
END IF
IF ASC(a3$, character) = 16 AND character < LEN(a3$) THEN
IF ASC(a3$, character + 1) >= 0 AND ASC(a3$, character + 1) <= 15 THEN
COLOR ASC(a3$, character + 1)
character = character + 1
_CONTINUE
ELSEIF ASC(a3$, character + 1) = 16 THEN
IF o.sel = n THEN COLOR 7 ELSE COLOR 0
character = character + 1
_CONTINUE
END IF
ELSEIF ASC(a3$, character) = 17 AND character < LEN(a3$) THEN
IF ASC(a3$, character + 1) >= 0 AND ASC(a3$, character + 1) <= 15 THEN
IF o.sel <> n THEN COLOR , ASC(a3$, character + 1)
character = character + 1
_CONTINUE
ELSEIF ASC(a3$, character + 1) = 17 THEN
IF o.sel = n THEN COLOR , 0 ELSE COLOR , 7
character = character + 1
_CONTINUE
END IF
ELSEIF character = 1 AND (LEFT$(a3$, 2) = CHR$(32) + CHR$(195) OR LEFT$(a3$, 2) = CHR$(32) + CHR$(192)) THEN
COLOR 0, 7
PRINT LEFT$(a3$, 3);
IF o.sel = n THEN COLOR 7, 0 ELSE COLOR 0, 7
character = 3
cf = cf + 3
_CONTINUE
END IF
PRINT MID$(a3$, character, 1);
cf = cf + 1
LOOP UNTIL cf > rightSideLimit
IF character < LEN(a3$) THEN _PRINTSTRING (rightSideLimit, CSRLIN), CHR$(26)
IF POS(1) < rightSideLimit THEN
PRINT SPACE$(rightSideLimit - POS(1));
END IF
ELSE
IF LEN(a3$) > o.w THEN MID$(a3$, o.w, 1) = CHR$(26)
a3$ = a3$ + SPACE$(o.w)
a3$ = LEFT$(a3$, o.w)
'customization specific for the SUBs list, due to the tree characters:
IF LEFT$(a3$, 2) = CHR$(32) + CHR$(195) OR LEFT$(a3$, 2) = CHR$(32) + CHR$(192) THEN
COLOR 0, 7
PRINT LEFT$(a3$, 3);
IF o.sel = n THEN COLOR 7, 0 ELSE COLOR 0, 7
PRINT MID$(a3$, 4);
ELSE
PRINT a3$;
END IF
END IF
'customization specific for the SUBs list, when there are external procedures:
IF INSTR(a3$, CHR$(196) + "*") > 0 THEN
IF o.sel = n THEN COLOR 2, 0 ELSE COLOR 2, 7
_PRINTSTRING (o.par.x + o.x + 4, o.par.y + o.y + y), "*"
END IF
y = y + 1
END IF
END IF
n = n + 1
a3$ = ""
END IF
NEXT
o.num = n - 1
tnum = o.num
tsel = ABS(o.sel)
q = idevbar(o.par.x + o.x + o.w + 1, o.par.y + o.y + 1, o.h, tsel, tnum)
f = f + 1
END IF '#2
'#3: ACTION BUTTONS
IF o.typ = 3 THEN
IF o.x = 0 THEN o.x = 2
IF o.w = 0 THEN o.w = o.par.w - o.x 'spanable width
IF o.txt = 0 THEN o.txt = idenewtxt("#OK")
a$ = idetxt(o.txt)
n = 1
c = 0
FOR i2 = 1 TO LEN(a$)
a2$ = MID$(a$, i2, 1)
IF a2$ = CHR$(0) THEN
n = n + 1
ELSE
IF a$ <> "#" THEN c = c + 1
END IF
NEXT
w = o.w
c = c + n * 4 'add characters for bracing < > buttons
whitespace = w - c
spacing = whitespace \ (n + 1)
f2 = o.foc + 1
IF f2 < 1 OR f2 > n THEN
IF o.dft THEN f2 = o.dft
END IF
n2 = 1
a3$ = ""
LOCATE o.par.y + o.y, o.par.x + o.x
x = o.par.x + o.x
COLOR 0, 7
FOR i2 = 1 TO LEN(a$)
a2$ = MID$(a$, i2, 1)
IF a2$ <> CHR$(0) THEN a3$ = a3$ + a2$
IF a2$ = CHR$(0) OR i2 = LEN(a$) THEN
PRINT SPACE$(spacing);
x = x + spacing
IF f2 = n2 THEN COLOR 15, 7 ELSE COLOR 0, 7
PRINT "< ";
COLOR 0, 7: idehPRINT a3$
IF f2 = n2 THEN COLOR 15, 7 ELSE COLOR 0, 7
IF n2 = o.foc + 1 THEN
o.cx = x + 2: o.cy = o.par.y + o.y
END IF
PRINT " >";
COLOR 0, 7
x = x + idehlen(a3$) + 4
a3$ = ""
n2 = n2 + 1
END IF
NEXT
f = f + n
END IF '#3
'#4: CHECK BOX
IF o.typ = 4 THEN
IF o.x = 0 THEN o.x = 2
x = o.par.x + o.x: y = o.par.y + o.y
LOCATE y, x
COLOR 0, 7
IF o.sel THEN
PRINT "[X] ";
ELSE
PRINT "[ ] ";
END IF
IF o.nam THEN
a$ = idetxt(o.nam)
idehPRINT a$
END IF
IF o.foc = 0 THEN o.cx = x + 1: o.cy = y
f = f + 1
END IF '#4
END SUB
SUB idedrawpar (p AS idedbptype)
COLOR 0, 7: ideboxshadow p.x, p.y, p.w + 2, p.h + 2
IF p.nam THEN
x = LEN(idetxt(p.nam)) + 2
COLOR 0, 7: _PRINTSTRING (p.x + (p.w \ 2) - (x - 1) \ 2, p.y), " " + idetxt(p.nam) + " "
END IF
END SUB
FUNCTION idefileexists$(f$)
l = LEN(f$)
DO
IF l < LEN(f$) THEN
m$ = "File " + CHR$(34) + STRING$(3, 250) + RIGHT$(f$, l) + CHR$(34) + " already exists. Overwrite?"
ELSE
m$ = "File " + CHR$(34) + f$ + CHR$(34) + " already exists. Overwrite?"
END IF
l = l - 1
LOOP UNTIL LEN(m$) + 4 < (idewx - 6)
result = idemessagebox("Save", m$, "#Yes;#No")
IF result = 1 THEN idefileexists$ = "Y" ELSE idefileexists$ = "N"
END FUNCTION
FUNCTION idefind$
REDIM SearchHistory(0) AS STRING
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
'built initial search string
IF ideselect THEN
IF ideselecty1 = idecy THEN 'single line selected
a$ = idegetline(idecy)
a2$ = ""
sx1 = ideselectx1: sx2 = idecx
IF sx2 < sx1 THEN SWAP sx1, sx2
FOR x = sx1 TO sx2 - 1
IF x <= LEN(a$) THEN a2$ = a2$ + MID$(a$, x, 1) ELSE a2$ = a2$ + " "
NEXT
END IF
END IF
IF a2$ = "" THEN
a2$ = idefindtext
END IF
RetrieveSearchHistory SearchHistory()
i = 0
idepar p, 60, 11, "Find"
i = i + 1
PrevFocus = 1
o(i).typ = 1
o(i).y = 2
o(i).nam = idenewtxt("#Find What")
o(i).txt = idenewtxt(a2$)
IF LEN(a2$) > 0 THEN
o(i).issel = -1
o(i).sx1 = 0
END IF
o(i).v1 = LEN(a2$)
i = i + 1
o(i).typ = 4 'check box
o(i).y = 5
o(i).nam = idenewtxt("#Match Upper/Lowercase")
o(i).sel = idefindcasesens
i = i + 1
o(i).typ = 4 'check box
o(i).y = 6
o(i).nam = idenewtxt("#Whole Word")
o(i).sel = idefindwholeword
i = i + 1
o(i).typ = 4 'check box
o(i).y = 7
o(i).nam = idenewtxt("#Search Backwards")
o(i).sel = idefindbackwards
i = i + 1
o(i).typ = 4 'check box
o(i).y = 8
o(i).nam = idenewtxt("#Ignore 'comments")
o(i).sel = idefindnocomments
i = i + 1
o(i).typ = 4 'check box
o(i).x = 29
o(i).y = 8
o(i).nam = idenewtxt("#Look only in 'comments")
o(i).sel = idefindonlycomments
i = i + 1
o(i).typ = 4 'check box
o(i).y = 9
o(i).nam = idenewtxt("Ignore " + CHR$(34) + "s#trings" + CHR$(34))
o(i).sel = idefindnostrings
i = i + 1
o(i).typ = 4 'check box
o(i).x = 29
o(i).y = 9
o(i).nam = idenewtxt("Look only in " + CHR$(34) + "st#rings" + CHR$(34))
o(i).sel = idefindonlystrings
i = i + 1
o(i).typ = 3
o(i).y = 11
o(i).txt = idenewtxt("#OK" + sep + "#Cancel")
o(i).dft = 1
'-------- 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 --------
'-------- 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 --------
'specific post controls
IF focus <> PrevFocus THEN
'Always start with TextBox values selected upon getting focus
PrevFocus = focus
IF focus = 1 THEN
o(focus).v1 = LEN(idetxt(o(focus).txt))
IF o(focus).v1 > 0 THEN o(focus).issel = -1
o(focus).sx1 = 0
END IF
END IF
IF K$ = CHR$(27) OR (focus = 10 AND info <> 0) THEN
idefind$ = "C"
EXIT FUNCTION
END IF
'mutually exclusive options
IF focus = 5 AND o(5).sel = 1 THEN
o(6).sel = 0
ELSEIF focus = 6 AND o(6).sel = 1 THEN
o(5).sel = 0
o(7).sel = 0
o(8).sel = 0
ELSEIF focus = 7 AND o(7).sel = 1 THEN
o(8).sel = 0
ELSEIF focus = 8 AND o(8).sel = 1 THEN
o(5).sel = 0
o(6).sel = 0
o(7).sel = 0
END IF
IF K$ = CHR$(13) OR (focus = 9 AND info <> 0) THEN
idefindcasesens = o(2).sel
idefindwholeword = o(3).sel
idefindbackwards = o(4).sel
idefindnocomments = o(5).sel
idefindonlycomments = o(6).sel
idefindnostrings = o(7).sel
idefindonlystrings = o(8).sel
s$ = idetxt(o(1).txt)
idefindtext$ = s$
IdeAddSearched idefindtext
idefindagain 0
EXIT FUNCTION
END IF
IF UBOUND(SearchHistory) > 0 THEN
IF K$ = CHR$(0) + CHR$(72) AND focus = 1 THEN 'Up
IF ln < UBOUND(SearchHistory) THEN
ln = ln + 1
END IF
idetxt(o(1).txt) = SearchHistory(ln)
o(1).issel = -1: o(1).sx1 = 0: o(1).v1 = LEN(idetxt(o(1).txt))
END IF
IF K$ = CHR$(0) + CHR$(80) AND focus = 1 THEN 'Down
IF ln > 1 THEN
ln = ln - 1
ELSE
ln = 1
END IF
idetxt(o(1).txt) = SearchHistory(ln)
o(1).issel = -1: o(1).sx1 = 0: o(1).v1 = LEN(idetxt(o(1).txt))
END IF
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
SUB idefindagain (showFlags AS _BYTE)
DIM comment AS _BYTE, quote AS _BYTE
IF idefindinvert THEN
IF idefindbackwards = 0 THEN idefindbackwards = 1 ELSE idefindbackwards = 0
END IF
s$ = idefindtext$
IF idefindcasesens = 0 THEN s$ = UCASE$(s$)
start = idecy
y = start
idefindnext2:
l$ = idegetline(y)
IF idefindcasesens = 0 THEN l$ = UCASE$(l$)
IF y = start THEN
'retrieve the unscanned portion of this line only
IF looped = 1 THEN
IF idefindbackwards THEN
IF LEN(l$) > idecx THEN l$ = STRING$(idecx, 255) + RIGHT$(l$, LEN(l$) - idecx) ELSE l$ = ""
ELSE
IF LEN(l$) > idecx THEN l$ = LEFT$(l$, idecx)
END IF
ELSE
IF idefindbackwards THEN
IF LEN(l$) > idecx THEN l$ = LEFT$(l$, idecx - 1 + (LEN(s$) - 1))
ELSE
IF LEN(l$) > idecx THEN l$ = STRING$(idecx, 255) + RIGHT$(l$, LEN(l$) - idecx) ELSE l$ = ""
END IF
END IF
END IF
x1 = 1
IF idefindbackwards THEN
x1 = LEN(l$) - LEN(s$) + 1
IF x1 < 0 THEN x1 = 0
END IF
idefindagain2:
IF idefindbackwards THEN
x = 0
FOR xx = x1 TO 1 STEP -1
IF ASC(l$, xx) = ASC(s$) THEN 'first char
xxo = xx - 1
FOR xx2 = xx TO xx + LEN(s$) - 1
IF ASC(l$, xx2) <> ASC(s$, xx2 - xxo) THEN EXIT FOR
NEXT
IF xx2 = xx + LEN(s$) THEN
'matched!
x = xx
EXIT FOR
END IF
END IF 'first char
NEXT
ELSE
x = INSTR(x1, l$, s$)
END IF
IF x THEN
IF idefindwholeword THEN
whole = 1
IF x > 1 THEN
c = ASC(UCASE$(MID$(l$, x - 1, 1)))
IF c >= 65 AND c <= 90 THEN whole = 0
IF c >= 48 AND c <= 57 THEN whole = 0
END IF
IF x + LEN(s$) <= LEN(l$) THEN
c = ASC(UCASE$(MID$(l$, x + LEN(s$), 1)))
IF c >= 65 AND c <= 90 THEN whole = 0
IF c >= 48 AND c <= 57 THEN whole = 0
END IF
IF whole = 0 THEN
x1 = x + 1: IF idefindbackwards THEN x1 = x - 1
x = 0
IF x1 > 0 AND x1 <= LEN(l$) THEN GOTO idefindagain2
END IF
END IF
END IF
IF x THEN
FindQuoteComment l$, x, comment, quote
IF idefindnocomments <> 0 AND comment THEN x = 0
IF idefindnostrings <> 0 AND quote THEN x = 0
IF idefindonlycomments <> 0 AND comment = 0 THEN x = 0
IF idefindonlystrings <> 0 AND quote = 0 THEN x = 0
END IF
IF x THEN
ideselect = 1
idecx = x: idecy = y
searchStringFoundOn = idecy
ideselectx1 = x + LEN(s$): ideselecty1 = y
IF idefindinvert THEN
IF idefindbackwards = 0 THEN idefindbackwards = 1 ELSE idefindbackwards = 0
idefindinvert = 0
END IF
idecentercurrentline
EXIT SUB
END IF
IF idefindbackwards THEN
y = y - 1
IF y = start - 1 AND looped = 1 THEN
idenomatch showFlags
IF idefindinvert THEN
IF idefindbackwards = 0 THEN idefindbackwards = 1 ELSE idefindbackwards = 0
idefindinvert = 0
END IF
EXIT SUB
END IF
IF y < 1 THEN y = iden: looped = 1
GOTO idefindnext2
ELSE
y = y + 1
IF y = start + 1 AND looped = 1 THEN
idenomatch showFlags
IF idefindinvert THEN
IF idefindbackwards = 0 THEN idefindbackwards = 1 ELSE idefindbackwards = 0
idefindinvert = 0
END IF
EXIT SUB
END IF
IF y > iden THEN y = 1: looped = 1
GOTO idefindnext2
END IF
END SUB
FUNCTION idegetline$ (i)
IF i <> -1 THEN idegotoline i
idegetline$ = MID$(idet$, ideli + 4, CVL(MID$(idet$, ideli, 4)))
END FUNCTION
SUB idecentercurrentline
IF iden <= idewy - 8 THEN EXIT SUB
idesy = idecy - (idewy - 8) \ 2
IF idesy < 1 THEN idesy = 1
END SUB
SUB idegotoline (i)
IF idel = i THEN EXIT SUB
IF i < 1 THEN i = 1
'scan backwards
IF i < idel THEN
DO
idel = idel - 1
ideli = ideli - CVL(MID$(idet$, ideli - 4, 4)) - 8
LOOP UNTIL idel = i
EXIT SUB
END IF
'assume scan forwards
DO
IF idel = iden THEN idet$ = idet$ + MKL$(0) + MKL$(0): iden = iden + 1 'insert blank line at end?
idel = idel + 1
ideli = ideli + CVL(MID$(idet$, ideli, 4)) + 8
LOOP UNTIL idel = i
END SUB
FUNCTION idehbar (x, y, h, i2, n2)
i = i2: n = n2
'COLOR 0, 7
'LOCATE y, x: PRINT CHR$(27);
'LOCATE y, x + w - 1: PRINT CHR$(26);
'FOR x2 = x + 1 TO x + w - 2
'LOCATE y, x2: PRINT chr$(176);
'NEXT
'IF w > 3 THEN
'p2! = w - 2 - .00001
'x2 = x + 1 + INT(p2! * p!)
'LOCATE y, x2: PRINT chr$(219);
'END IF
'h is size in characters (inc. arrows)
'draw background & arrows
COLOR 0, 7
_PRINTSTRING (x, y), CHR$(27)
_PRINTSTRING (x + h - 1, y), CHR$(26)
FOR x2 = x + 1 TO x + h - 2
_PRINTSTRING (x2, y), CHR$(176)
NEXT
'draw slider
IF n < 1 THEN n = 1
IF i < 1 THEN i = 1
IF i > n THEN i = n
IF h = 2 THEN
idehbar = x 'not position for slider exists
EXIT FUNCTION
END IF
IF h = 3 THEN
idehbar = x + 1 'dummy value
'no slider
EXIT FUNCTION
END IF
IF h = 4 THEN
IF n = 1 THEN
idehbar = x + 1 'dummy value
'no slider required for 1 item
EXIT FUNCTION
ELSE
'show whichever is closer of the two positions
p! = (i - 1) / (n - 1)
IF p! < .5 THEN x2 = x + 1 ELSE x2 = x + 2
_PRINTSTRING (x2, y), CHR$(219)
idehbar = x2
EXIT FUNCTION
END IF
END IF
IF h > 4 THEN
IF n = 1 THEN
idehbar = x + h \ 4 'dummy value
'no slider required for 1 item
EXIT FUNCTION
END IF
IF i = 1 THEN
x2 = x + 1
_PRINTSTRING (x2, y), CHR$(219)
idehbar = x2
EXIT FUNCTION
END IF
IF i = n THEN
x2 = x + h - 2
_PRINTSTRING (x2, y), CHR$(219)
idehbar = x2
EXIT FUNCTION
END IF
'between i=1 and i=n
p! = (i - 1) / (n - 1)
p! = p! * (h - 4)
x2 = x + 2 + INT(p!)
_PRINTSTRING (x2, y), CHR$(219)
idehbar = x2
EXIT FUNCTION
END IF
END FUNCTION
FUNCTION idehlen (a$)
IF INSTR(a$, "#") THEN idehlen = LEN(a$) - 1 ELSE idehlen = LEN(a$)
END FUNCTION
SUB idehPRINT (a$)
COLOR 0, 7
FOR i = 1 TO LEN(a$)
c$ = MID$(a$, i, 1)
IF c$ = "#" THEN
IF idehl THEN COLOR 15, 7
ELSE
PRINT c$;: COLOR 0, 7
END IF
NEXT
END SUB
SUB ideinsline (i, text$)
'note: cursor remains on line i
FOR b = 1 TO IdeBmkN
IF IdeBmk(b).y >= i THEN
y = IdeBmk(b).y + 1
IdeBmk(b).y = y
END IF
NEXT
IF vWatchOn THEN
REDIM _PRESERVE IdeBreakpoints(iden + 1) AS _BYTE
FOR b = iden + 1 TO i STEP -1
SWAP IdeBreakpoints(b), IdeBreakpoints(b - 1)
NEXT
IdeBreakpoints(i) = 0
REDIM _PRESERVE IdeSkipLines(iden + 1) AS _BYTE
FOR b = iden + 1 TO i STEP -1
SWAP IdeSkipLines(b), IdeSkipLines(b - 1)
NEXT
IdeSkipLines(i) = 0
END IF
text$ = RTRIM$(text$)
IF i = -1 THEN i = idel
'if at end, use idesetline
IF i > iden THEN
idesetline i, text$
EXIT SUB
END IF
idegotoline i
'insert line
textlen = LEN(text$)
idet$ = LEFT$(idet$, ideli - 1) + MKL$(textlen) + text$ + MKL$(textlen) + RIGHT$(idet$, LEN(idet$) - ideli + 1)
iden = iden + 1
END SUB
FUNCTION ideinputbox$(title$, caption$, initialvalue$, validinput$, boxwidth, maxlength, ok)
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
i = 0
ok = 0 'will be set to true if "OK" or Enter are used to close the dialog
idepar p, boxwidth, 5, title$
i = i + 1
PrevFocus = 1
o(i).typ = 1
o(i).y = 2
o(i).nam = idenewtxt(caption$)
o(i).txt = idenewtxt(initialvalue$)
IF LEN(initialvalue$) > 0 THEN o(i).issel = -1
o(i).sx1 = 0
o(i).v1 = LEN(initialvalue$)
i = i + 1
o(i).typ = 3
o(i).y = 5
o(i).txt = idenewtxt("#OK" + sep + "#Cancel")
o(i).dft = 1
'-------- 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 --------
'-------- 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 --------
'specific post controls
IF focus <> PrevFocus THEN
'Always start with TextBox values selected upon getting focus
PrevFocus = focus
IF focus = 1 THEN
o(focus).v1 = LEN(idetxt(o(focus).txt))
IF o(focus).v1 > 0 THEN o(focus).issel = -1
o(focus).sx1 = 0
END IF
END IF
IF LEN(validinput$) THEN
a$ = idetxt(o(1).txt)
tempA$ = ""
FOR i = 1 TO LEN(a$)
IF INSTR(validinput$, MID$(a$, i, 1)) > 0 THEN
tempA$ = tempA$ + MID$(a$, i, 1)
END IF
NEXT
idetxt(o(1).txt) = tempA$
END IF
IF maxlength THEN
idetxt(o(1).txt) = LEFT$(idetxt(o(1).txt), maxlength)
END IF
IF K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN
ClearMouse
EXIT FUNCTION
END IF
IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) THEN
ideinputbox$ = idetxt(o(1).txt)
ok = -1
ClearMouse
_KEYCLEAR
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
SUB idenewsf (sf AS STRING)
'build initial name if word selected
IF ideselect THEN
IF ideselecty1 = idecy THEN 'single line selected
a$ = idegetline(idecy)
a2$ = ""
sx1 = ideselectx1: sx2 = idecx
IF sx2 < sx1 THEN SWAP sx1, sx2
FOR x = sx1 TO sx2 - 1
IF x <= LEN(a$) THEN a2$ = a2$ + MID$(a$, x, 1) ELSE a2$ = a2$ + " "
NEXT
END IF
END IF
newSF$ = ideinputbox$("New " + sf$, "#Name", a2$, "", 60, 40, 0)
IF LEN(newSF$) THEN
y = iden
y = y + 1: idesetline y, ""
y = y + 1: idesetline y, sf$ + " " + newSF$
idesy = y
y = y + 1: idesetline y, ""
idecy = y
y = y + 1: idesetline y, "END " + sf$
idecx = 1: idesx = 1
idechangemade = 1
startPausedPending = 0
END IF
END SUB
FUNCTION idenewfolder$(thispath$)
newfolder$ = ideinputbox$("New Folder", "#Name", "", "", 60, 0, 0)
IF LEN(newfolder$) THEN
IF _DIREXISTS(thispath$ + idepathsep$ + newfolder$) THEN
idenewfolder$ = newfolder$
EXIT SUB
END IF
ideerror = 5
MKDIR thispath$ + idepathsep$ + newfolder$
ideerror = 1
idenewfolder$ = newfolder$
END IF
END SUB
FUNCTION idenewtxt (a$)
idetxtlast = idetxtlast + 1
idetxt$(idetxtlast) = a$
idenewtxt = idetxtlast
END FUNCTION
SUB idenomatch (showFlags AS _BYTE)
msg$ = "Match not found."
c$ = ", "
IF showFlags THEN
IF idefindcasesens THEN flags$ = flags$ + "match case": flagset = flagset + 1
IF idefindwholeword THEN flags$ = flags$ + LEFT$(c$, ABS(flagset) * 2) + "whole word": flagset = flagset + 1
IF idefindnocomments THEN flags$ = flags$ + LEFT$(c$, ABS(flagset) * 2) + "no comments": flagset = flagset + 1
IF idefindonlycomments THEN flags$ = flags$ + LEFT$(c$, ABS(flagset) * 2) + "only comments": flagset = flagset + 1
IF idefindnostrings THEN flags$ = flags$ + LEFT$(c$, ABS(flagset) * 2) + "no strings": flagset = flagset + 1
IF idefindonlystrings THEN flags$ = flags$ + LEFT$(c$, ABS(flagset) * 2) + "only strings": flagset = flagset + 1
IF flagset > 1 THEN pl$ = "s"
IF flagset THEN msg$ = msg$ + "\n(Flag" + pl$ + ": " + flags$ + ")"
END IF
result = idemessagebox("Search complete", msg$, "")
END SUB
FUNCTION idefiledialog$(programname$, mode AS _BYTE)
STATIC AllFiles
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
path$ = idepath$
filelist$ = idezfilelist$(path$, AllFiles, "")
pathlist$ = idezpathlist$(path$)
i = 0
IF mode = 1 THEN
idepar p, 70, idewy + idesubwindow - 7, "Open"
ELSEIF mode = 2 THEN
idepar p, 70, idewy + idesubwindow - 7, "Save As"
END IF
i = i + 1
PrevFocus = 1
o(i).typ = 1
o(i).y = 2
o(i).nam = idenewtxt("File #Name")
IF mode = 2 THEN
o(i).txt = idenewtxt(programname$)
o(i).issel = -1
o(i).sx1 = 0
o(i).v1 = LEN(programname$)
END IF
i = i + 1
o(i).typ = 2
o(i).y = 5
o(i).w = 32: o(i).h = idewy + idesubwindow - 14
o(i).nam = idenewtxt("#Files")
o(i).txt = idenewtxt(filelist$): filelist$ = ""
i = i + 1
o(i).typ = 2
o(i).x = 37: o(i).y = 5
o(i).w = 31: o(i).h = idewy + idesubwindow - 16
o(i).nam = idenewtxt("#Paths")
o(i).txt = idenewtxt(pathlist$): pathlist$ = ""
i = i + 1
o(i).typ = 4 'check box
o(i).x = 37
o(i).y = idewy + idesubwindow - 9
o(i).nam = idenewtxt(".#BAS Only")
IF AllFiles THEN o(i).sel = 0 ELSE o(i).sel = 1
prevBASOnly = o(i).sel
i = i + 1
o(i).typ = 3
o(i).x = 56
o(i).y = idewy + idesubwindow - 9
o(i).txt = idenewtxt("Ne#w Folder")
i = i + 1
o(i).typ = 3
o(i).y = idewy + idesubwindow - 7
o(i).txt = idenewtxt("#OK" + sep + "#Cancel")
o(i).dft = 1
'-------- end of init --------
'-------- generic init --------
FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects
'-------- end of generic init --------
IF mode = 1 AND LEN(IdeOpenFile) > 0 THEN f$ = IdeOpenFile: GOTO DirectLoad
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: _PRINTSTRING (p.x + 2, p.y + 4), "Path: "
a$ = path$
IF LEN(a$) = 2 AND RIGHT$(a$, 1) = ":" THEN a$ = a$ + "\"
w = p.w - 8
IF LEN(a$) > w - 3 THEN a$ = STRING$(3, 250) + RIGHT$(a$, w - 3)
_PRINTSTRING (p.x + 2 + 6, p.y + 4), a$
'-------- 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
IF mode = 1 THEN
IF _TOTALDROPPEDFILES > 0 THEN
idetxt(o(1).txt) = _DROPPEDFILE$(1)
o(1).v1 = LEN(idetxt(o(1).txt))
focus = 1
_FINISHDROP
change = 1
END IF
END IF
_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 --------
'specific post controls
IF focus <> PrevFocus THEN
'Always start with TextBox values selected upon getting focus
PrevFocus = focus
IF focus = 1 THEN
o(focus).v1 = LEN(idetxt(o(focus).txt))
IF o(focus).v1 > 0 THEN o(focus).issel = -1
o(focus).sx1 = 0
END IF
END IF
IF o(4).sel <> prevBASOnly THEN
prevBASOnly = o(4).sel
IF o(4).sel = 0 THEN AllFiles = 1 ELSE AllFiles = 0
idetxt(o(2).txt) = idezfilelist$(path$, AllFiles, "")
o(2).sel = -1
GOTO ideopenloop
END IF
IF focus = 5 AND info <> 0 THEN
'create new folder
newpath$ = idenewfolder(path$)
IF LEN(newpath$) THEN
f$ = removeDoubleSlashes$(newpath$)
GOTO changepath
ELSE
GOTO ideopenloop
END IF
END IF
IF K$ = CHR$(27) OR (focus = 7 AND info <> 0) THEN
idefiledialog$ = "C"
EXIT FUNCTION
END IF
IF focus = 2 AND o(2).sel <> prevFileBoxSel THEN
prevFileBoxSel = o(2).sel
idetxt(o(1).txt) = idetxt(o(2).stx)
o(1).issel = 0
END IF
IF focus = 3 THEN
IF (K$ = CHR$(13) OR info = 1) AND o(3).sel >= 1 THEN
newpath$ = removeDoubleSlashes$(idetxt(o(3).stx))
IF newpath$ = "" THEN
newpath$ = ".."
f$ = newpath$
GOTO changepath
ELSE
path$ = removeDoubleSlashes$(idezchangepath(path$, newpath$))
idetxt(o(2).txt) = idezfilelist$(path$, AllFiles, "")
idetxt(o(3).txt) = idezpathlist$(path$)
o(2).sel = -1
o(3).sel = 1
IF info = 1 THEN o(3).sel = -1
GOTO ideopenloop
END IF
END IF
END IF
'load or save file
IF K$ = CHR$(13) OR (info = 1 AND focus = 2) OR (focus = 6 AND info <> 0) THEN
f$ = idetxt(o(1).txt)
IF _FILEEXISTS(f$) THEN GOTO DirectLoad
IF f$ = "" AND focus = 1 AND K$ = CHR$(13) THEN
'reset filters
idetxt(o(2).txt) = idezfilelist$(path$, AllFiles, "")
o(2).sel = -1
GOTO ideopenloop
ELSEIF f$ = "" AND focus = 6 AND info <> 0 THEN
GOTO ideopenloop
END IF
'change path?
changepath:
IF _DIREXISTS(path$ + idepathsep$ + f$) THEN
'check/acquire file path
path$ = removeDoubleSlashes$(idezgetfilepath$(path$, f$ + idepathsep$)) 'note: path ending with pathsep needn't contain a file
IF ideerror > 1 THEN EXIT FUNCTION
IF LEN(newpath$) = 0 THEN
idetxt(o(1).txt) = ""
focus = 1
ELSE
newpath$ = ""
END IF
idetxt(o(2).txt) = idezfilelist$(path$, AllFiles, "")
o(2).sel = -1
idetxt(o(3).txt) = idezpathlist$(path$)
o(3).sel = -1
GOTO ideopenloop
END IF
'wildcards search
IF INSTR(f$, "?") > 0 OR INSTR(f$, "*") > 0 THEN
IF INSTR(f$, "/") > 0 OR INSTR(f$, "\") > 0 THEN
'path + wildcards
path$ = removeDoubleSlashes$(idezgetfilepath$(path$, f$)) 'note: path ending with pathsep needn't contain a file
IF ideerror > 1 THEN EXIT FUNCTION
idetxt(o(3).txt) = idezpathlist$(path$)
o(3).sel = -1
END IF
idetxt(o(1).txt) = f$
idetxt(o(2).txt) = idezfilelist$(path$, 2, f$)
o(2).sel = -1
o(1).v1 = LEN(idetxt(o(1).txt))
o(1).issel = -1
o(1).sx1 = 0
IF LCASE$(RIGHT$(f$, 4)) <> ".bas" THEN
AllFiles = 0
o(4).sel = 0
prevBASOnly = o(4).sel
END IF
GOTO ideopenloop
END IF
DirectLoad:
path$ = removeDoubleSlashes$(idezgetfilepath$(path$, f$)) 'repeat in case of DirectLoad
IF ideerror > 1 THEN EXIT FUNCTION
IF mode = 1 THEN
IF _FILEEXISTS(path$ + idepathsep$ + f$) = 0 THEN
'add .bas if not given
IF (LCASE$(RIGHT$(f$, 4)) <> ".bas") AND AllFiles = 0 THEN f$ = f$ + ".bas"
END IF
'check file exists
ideerror = 2
IF _FILEEXISTS(path$ + idepathsep$ + f$) = 0 THEN EXIT FUNCTION
IF BinaryFormatCheck%(path$, idepathsep$, f$) > 0 THEN
IF LEN(IdeOpenFile) THEN
idefiledialog$ = "C"
EXIT FUNCTION
ELSE
info = 0: GOTO ideopenloop
END IF
END IF
'load file
ideerror = 3
idet$ = MKL$(0) + MKL$(0): idel = 1: ideli = 1: iden = 1: IdeBmkN = 0
idesx = 1
idesy = 1
idecx = 1
idecy = 1
ideselect = 0
idefocusline = 0
lineinput3load path$ + idepathsep$ + f$
idet$ = SPACE$(LEN(lineinput3buffer) * 8)
i2 = 1
n = 0
chrtab$ = CHR$(9)
space1$ = " ": space2$ = " ": space3$ = " ": space4$ = " "
chr7$ = CHR$(7): chr11$ = CHR$(11): chr12$ = CHR$(12): chr28$ = CHR$(28): chr29$ = CHR$(29): chr30$ = CHR$(30): chr31$ = CHR$(31)
DO
a$ = lineinput3$
l = LEN(a$)
IF l THEN asca = ASC(a$) ELSE asca = -1
IF asca <> 13 THEN
IF asca <> -1 THEN
'fix tabs
ideopenfixtabs:
x = INSTR(a$, chrtab$)
IF x THEN
x2 = (x - 1) MOD 4
IF x2 = 0 THEN a$ = LEFT$(a$, x - 1) + space4$ + RIGHT$(a$, l - x): l = l + 3: GOTO ideopenfixtabs
IF x2 = 1 THEN a$ = LEFT$(a$, x - 1) + space3$ + RIGHT$(a$, l - x): l = l + 2: GOTO ideopenfixtabs
IF x2 = 2 THEN a$ = LEFT$(a$, x - 1) + space2$ + RIGHT$(a$, l - x): l = l + 1: GOTO ideopenfixtabs
IF x2 = 3 THEN a$ = LEFT$(a$, x - 1) + space1$ + RIGHT$(a$, l - x): GOTO ideopenfixtabs
END IF
END IF 'asca<>-1
MID$(idet$, i2, l + 8) = MKL$(l) + a$ + MKL$(l): i2 = i2 + l + 8: n = n + 1
END IF
LOOP UNTIL asca = 13
lineinput3buffer = ""
iden = n: IF n = 0 THEN idet$ = MKL$(0) + MKL$(0): iden = 1 ELSE idet$ = LEFT$(idet$, i2 - 1)
REDIM IdeBreakpoints(iden) AS _BYTE
REDIM IdeSkipLines(iden) AS _BYTE
variableWatchList$ = ""
backupVariableWatchList$ = "": REDIM backupUsedVariableList(1000) AS usedVarList
backupTypeDefinitions$ = ""
callstacklist$ = "": callStackLength = 0
ideerror = 1
ideprogname = f$: _TITLE ideprogname + " - " + WindowTitle
listOfCustomKeywords$ = LEFT$(listOfCustomKeywords$, customKeywordsLength)
idepath$ = path$
IdeAddRecent idepath$ + idepathsep$ + ideprogname$
IdeImportBookmarks idepath$ + idepathsep$ + ideprogname$
EXIT FUNCTION
ELSEIF mode = 2 THEN
IF FileHasExtension(f$) = 0 THEN f$ = f$ + ".bas"
ideerror = 3
OPEN path$ + idepathsep$ + f$ FOR BINARY AS #150
ideerror = 1
IF LOF(150) THEN
CLOSE #150
a$ = idefileexists(f$)
IF a$ = "N" THEN
idefiledialog$ = "C"
EXIT FUNCTION 'user didn't agree to overwrite
END IF
ELSE
CLOSE #150
END IF
ideprogname$ = f$: _TITLE ideprogname + " - " + WindowTitle
idesave path$ + idepathsep$ + f$
idepath$ = path$
IdeAddRecent idepath$ + idepathsep$ + ideprogname$
IdeSaveBookmarks idepath$ + idepathsep$ + ideprogname$
EXIT FUNCTION
END IF
END IF
ideopenloop:
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
SUB idepar (par AS idedbptype, w, h, title$)
par.x = (idewx \ 2) - w \ 2
par.y = ((idewy + idesubwindow) \ 2) - h \ 2
par.w = w
par.h = h
IF LEN(title$) THEN par.nam = idenewtxt(title$)
_RESIZE OFF
END SUB
FUNCTION iderestore$
PCOPY 3, 0
PCOPY 0, 2
PCOPY 0, 1
SCREEN , , 1, 0
result = idemessagebox("Backup found", "Recover program from auto-saved backup?", "#Yes;#No")
IF result = 1 THEN iderestore$ = "Y" ELSE iderestore$ = "N"
END FUNCTION
FUNCTION ideclearhistory$ (WhichHistory$)
SELECT CASE WhichHistory$
CASE "SEARCH": t$ = "Clear search history": m$ = "This cannot be undone. Proceed?"
CASE "FILES": t$ = "Clear recent files": m$ = "This cannot be undone. Proceed?"
END SELECT
result = idemessagebox(t$, m$, "#Yes;#No")
IF result = 1 THEN ideclearhistory$ = "Y" ELSE ideclearhistory$ = "N"
END FUNCTION
SUB idesave (f$)
ideerror = 6
OPEN f$ FOR OUTPUT AS #151
ideerror = 1
FOR i = 1 TO iden
a$ = idegetline(i)
PRINT #151, a$
NEXT
CLOSE #151
IdeSaveBookmarks f$
ideunsaved = 0
END SUB
FUNCTION IdeSaveNow$
SELECT CASE IdeMessageBox("", "Loaded file is not saved. Save it now?", "#Yes;#No;#Cancel") ' "#Yes;#No;#Cancel;#Help"
CASE 1: IdeSaveNow$ = "Y"
CASE 2: IdeSaveNow$ = "N"
'CASE 4: IdeSaveNow$ = "H"
CASE ELSE: IdeSaveNow$ = "C"
END SELECT
END FUNCTION
SUB idesetline (i, text$)
text$ = RTRIM$(text$)
IF i <> -1 THEN idegotoline i
textlen = LEN(text$)
idet$ = LEFT$(idet$, ideli - 1) + MKL$(textlen) + text$ + MKL$(textlen) + RIGHT$(idet$, LEN(idet$) - ideli + 1 - CVL(MID$(idet$, ideli, 4)) - 8)
END SUB
FUNCTION timeElapsedSince! (startTime!)
IF startTime! > TIMER THEN startTime! = startTime! - 86400
timeElapsedSince! = TIMER - startTime!
END FUNCTION
SUB ideshowtext
IF ideshowtextBypassColorRestore = 0 THEN
_PALETTECOLOR 1, IDEBackgroundColor, 0
_PALETTECOLOR 2, _RGB32(84, 84, 84), 0 'dark gray - help system and interface details
_PALETTECOLOR 5, IDEBracketHighlightColor, 0
_PALETTECOLOR 6, IDEBackgroundColor2, 0
_PALETTECOLOR 7, IDEChromaColor, 0
_PALETTECOLOR 8, IDENumbersColor, 0
_PALETTECOLOR 10, IDEMetaCommandColor, 0
_PALETTECOLOR 11, IDECommentColor, 0
_PALETTECOLOR 12, IDEKeywordColor, 0
_PALETTECOLOR 13, IDETextColor, 0
_PALETTECOLOR 14, IDEQuoteColor, 0
END IF
ideshowtextBypassColorRestore = 0
char.sep$ = CHR$(34) + " =<>+-/\^:;,*()'"
initialNum.char$ = "0123456789-.&"
num.char$ = "0123456789EDed+-.`%&!#~HBOhboACFacf"
DIM ideshowtext_comment AS _BYTE, ideshowtext_quote AS _BYTE
STATIC prevListOfCustomWords$, manualList AS _BYTE
DIM startTime AS SINGLE
startTime = TIMER
IF NOT DisableSyntaxHighlighter THEN
IF idefocusline <> 0 THEN
'there's an error and compilation is halted,
'so we'll build the list of subs/functions
'for proper highlighting:
IF idechangemade THEN manualList = 0
IF manualList = 0 THEN
manualList = -1
listOfCustomKeywords$ = LEFT$(listOfCustomKeywords$, customKeywordsLength)
FOR y = 1 TO iden
a$ = UCASE$(_TRIM$(idegetline(y)))
sf = 0
IF LEFT$(a$, 4) = "SUB " THEN sf = 1
IF LEFT$(a$, 9) = "FUNCTION " THEN sf = 2
IF sf THEN
IF RIGHT$(a$, 7) = " STATIC" THEN
a$ = RTRIM$(LEFT$(a$, LEN(a$) - 7))
END IF
IF sf = 1 THEN
a$ = MID$(a$, 5)
ELSE
a$ = MID$(a$, 10)
END IF
a$ = LTRIM$(RTRIM$(a$))
x = INSTR(a$, "(")
IF x THEN
a$ = RTRIM$(LEFT$(a$, x - 1))
ELSE
cleanSubName a$
END IF
listOfCustomKeywords$ = listOfCustomKeywords$ + "@" + removesymbol2$(a$) + "@"
END IF
NEXT
END IF
ELSE
manualList = 0
END IF
IF prevListOfCustomWords$ <> listOfCustomKeywords$ THEN
IF manualList = 0 THEN
DO
atSign = INSTR(atSign + 1, listOfCustomKeywords$, "@")
nextAt = INSTR(atSign + 1, listOfCustomKeywords$, "@")
IF nextAt = 0 THEN EXIT DO
IF atSign > customKeywordsLength THEN
checkKeyword$ = removesymbol2$(MID$(listOfCustomKeywords$, atSign + 1, (nextAt - atSign) - 1))
IF LEN(checkKeyword$) THEN
hashchkflags = HASHFLAG_RESERVED + HASHFLAG_CONSTANT
hashchkflags = hashchkflags + HASHFLAG_FUNCTION
hashres1 = HashFind(checkKeyword$, hashchkflags, hashresflags, hashresref)
IF hashres1 <> 0 THEN hashres1 = 1
hashchkflags = HASHFLAG_RESERVED + HASHFLAG_CONSTANT
hashchkflags = hashchkflags + HASHFLAG_SUB
hashres2 = HashFind(checkKeyword$, hashchkflags, hashresflags, hashresref)
IF hashres2 <> 0 THEN hashres2 = 1
IF hashres1 + hashres2 = 0 THEN
'remove this custom keyword if not registered
MID$(listOfCustomKeywords$, atSign + 1, (nextAt - atSign) - 1) = STRING$(LEN(checkKeyword$), "@")
END IF
END IF
END IF
LOOP
END IF
FOR i = 1 TO LEN(listOfCustomKeywords$)
checkChar = ASC(listOfCustomKeywords$, i)
IF checkChar = 64 THEN
IF RIGHT$(tempList$, 1) <> "@" THEN tempList$ = tempList$ + "@"
ELSE
tempList$ = tempList$ + CHR$(checkChar)
END IF
NEXT
listOfCustomKeywords$ = tempList$
DO WHILE INSTR(listOfCustomKeywords$, fix046$)
x = INSTR(listOfCustomKeywords$, fix046$)
listOfCustomKeywords$ = LEFT$(listOfCustomKeywords$, x - 1) + "." + RIGHT$(listOfCustomKeywords$, LEN(listOfCustomKeywords$) - x + 1 - LEN(fix046$))
LOOP
prevListOfCustomWords$ = listOfCustomKeywords$
END IF
END IF
cc = -1
IF idecx < idesx THEN idesx = idecx
IF idecy < idesy THEN idesy = idecy
IF (idecx + maxLineNumberLength) - idesx >= (idewx - 2) THEN idesx = (idecx + maxLineNumberLength) - (idewx - 3)
IF idecy - idesy >= (idewy - 8) THEN idesy = idecy - (idewy - 9)
sy1 = ideselecty1
sy2 = idecy
IF sy1 > sy2 THEN SWAP sy1, sy2
sx1 = ideselectx1
sx2 = idecx
IF sx1 > sx2 THEN SWAP sx1, sx2
l = idesy
EnteringRGB = 0
IF NOT DisableSyntaxHighlighter THEN
idecy_multilinestart = 0
idecy_multilineend = 0
a$ = idegetline(idecy)
FindQuoteComment a$, LEN(a$), ideshowtext_comment, ideshowtext_quote
IF RIGHT$(a$, 1) = "_" AND ideshowtext_comment = 0 THEN
'Find the beginning of the multiline
FOR idecy_i = idecy - 1 TO 1 STEP -1
b$ = idegetline(idecy_i)
FindQuoteComment b$, LEN(b$), ideshowtext_comment, ideshowtext_quote
IF RIGHT$(b$, 1) <> "_" OR ideshowtext_comment = -1 THEN idecy_multilinestart = idecy_i + 1: EXIT FOR
NEXT
IF idecy_multilinestart = 0 THEN idecy_multilinestart = 1
'Find the end of the multiline
FOR idecy_i = idecy + 1 TO iden
b$ = idegetline(idecy_i)
FindQuoteComment b$, LEN(b$), ideshowtext_comment, ideshowtext_quote
IF RIGHT$(b$, 1) <> "_" OR ideshowtext_comment = -1 THEN idecy_multilineend = idecy_i: EXIT FOR
NEXT
IF idecy_multilineend = 0 THEN idecy_multilinestart = iden
ELSE
IF idecy > 1 THEN b$ = idegetline(idecy - 1) ELSE b$ = ""
FindQuoteComment b$, LEN(b$), ideshowtext_comment, ideshowtext_quote
IF RIGHT$(b$, 1) = "_" AND ideshowtext_comment = 0 THEN
idecy_multilineend = idecy
'Find the beginning of the multiline
FOR idecy_i = idecy - 1 TO 1 STEP -1
b$ = idegetline(idecy_i)
FindQuoteComment b$, LEN(b$), ideshowtext_comment, ideshowtext_quote
IF RIGHT$(b$, 1) <> "_" OR ideshowtext_comment = -1 THEN idecy_multilinestart = idecy_i + 1: EXIT FOR
NEXT
IF idecy_multilinestart = 0 THEN idecy_multilinestart = 1
END IF
END IF
IF idecy > 1 THEN b$ = idegetline(idecy - 1) ELSE b$ = ""
ActiveINCLUDELink = 0
FOR y = 0 TO (idewy - 9)
COLOR 7, 1
_PRINTSTRING (1, y + 3), CHR$(179) 'clear prev bookmarks from lhs
GOSUB ShowLineNumber
IF (l = idefocusline AND idecy <> l AND IdeDebugMode = 0) OR (l = idefocusline AND idecy = l AND IdeDebugMode <> 0) THEN
COLOR 7, 4 'Line with error gets a red background
ELSEIF idecy = l OR (l >= idecy_multilinestart AND l <= idecy_multilineend) THEN
IF HideCurrentLineHighlight = 0 AND IdeSystem = 1 THEN COLOR 7, 6 'Highlight the current line
ELSE
COLOR 7, 1 'Regular text color
END IF
IF l <= iden THEN
DO UNTIL l < UBOUND(InValidLine) 'make certain we have enough InValidLine elements to cover us in case someone scrolls QB64
REDIM _PRESERVE InValidLine(UBOUND(InValidLine) + 1000) AS _BYTE ' to the end of a program before the IDE has finished
LOOP ' verifying the code and growing the array during the IDE passes.
a$ = idegetline(l)
link_idecx = 0
shiftEnter_idecx = 0
IF l = idecy THEN
IF idecx <= LEN(a$) AND idecx >= 1 THEN
cc = ASC(a$, idecx)
IF cc = 32 THEN
IF LTRIM$(LEFT$(a$, idecx)) = "" THEN cc = -1
END IF
END IF
'Check if the cursor is positioned inside a comment or
'quotation marks:
FindQuoteComment a$, idecx, ideshowtext_comment, ideshowtext_quote
idecx_comment = ideshowtext_comment
idecx_quote = ideshowtext_quote
'Check if we're on a bracket, to highlight it and its match
brackets = 0
bracket1 = 0
bracket2 = 0
IF idecx_comment + idecx_quote = 0 AND brackethighlight = -1 THEN
inquote = 0
comment = 0
IF MID$(a$, idecx, 1) = "(" THEN
brackets = 1
bracket1 = idecx
ScanBracket2:
FOR k = bracket1 + 1 TO LEN(a$)
SELECT CASE MID$(a$, k, 1)
CASE CHR$(34)
inquote = NOT inquote
CASE "'"
IF inquote = 0 THEN comment = -1: EXIT FOR
END SELECT
IF MID$(a$, k, 1) = ")" AND inquote = 0 THEN
brackets = brackets - 1
IF brackets = 0 THEN bracket2 = k: EXIT FOR
ELSEIF MID$(a$, k, 1) = "(" AND inquote = 0 THEN
brackets = brackets + 1
END IF
NEXT
ELSEIF MID$(a$, idecx - 1, 1) = "(" AND MID$(a$, idecx, 1) <> CHR$(34) THEN
brackets = 1
bracket1 = idecx - 1
GOTO ScanBracket2
ELSEIF MID$(a$, idecx, 1) = ")" THEN
brackets = 1
bracket2 = idecx
ScanBracket1:
FOR k = bracket2 - 1 TO 1 STEP -1
SELECT CASE MID$(a$, k, 1)
CASE CHR$(34)
inquote = NOT inquote
END SELECT
IF MID$(a$, k, 1) = "(" AND inquote = 0 THEN
brackets = brackets - 1
IF brackets = 0 THEN bracket1 = k: EXIT FOR
ELSEIF MID$(a$, k, 1) = ")" AND inquote = 0 THEN
brackets = brackets + 1
END IF
NEXT
ELSEIF MID$(a$, idecx - 1, 1) = ")" AND MID$(a$, idecx, 1) <> CHR$(34) THEN
brackets = 1
bracket2 = idecx - 1
GOTO ScanBracket1
END IF
END IF
'If the user is typing on the current line and has just inserted
'an _RGB(, _RGB32(, _RGBA( or _RGBA32(, we'll offer the RGB
'color mixer.
a2$ = UCASE$(a$)
'IF IdeAutoComplete AND idecx = LEN(a$) + 1 AND idecx_comment + idecx_quote = 0 THEN
IF idecx = LEN(a$) + 1 AND idecx_comment + idecx_quote = 0 THEN
IF (RIGHT$(a2$, 5) = "_RGB(" OR _
RIGHT$(a2$, 7) = "_RGB32(" OR _
RIGHT$(a2$, 6) = "_RGBA(" OR _
RIGHT$(a2$, 8) = "_RGBA32(") OR _
((RIGHT$(a2$, 4) = "RGB(" OR _
RIGHT$(a2$, 6) = "RGB32(" OR _
RIGHT$(a2$, 5) = "RGBA(" OR _
RIGHT$(a2$, 7) = "RGBA32(") AND qb64prefix_set = 1) THEN
shiftEnter_idecx = LEN(a$)
a$ = a$ + " --> Shift+ENTER to open the RGB mixer"
EnteringRGB = -1
END IF
ELSEIF idecx_comment + idecx_quote = 0 THEN
IF (MID$(a2$, idecx - 5, 5) = "_RGB(" OR _
MID$(a2$, idecx - 7, 7) = "_RGB32(" OR _
MID$(a2$, idecx - 6, 6) = "_RGBA(" OR _
MID$(a2$, idecx - 8, 8) = "_RGBA32(") OR _
((MID$(a2$, idecx - 4, 4) = "RGB(" OR _
MID$(a2$, idecx - 6, 6) = "RGB32(" OR _
MID$(a2$, idecx - 5, 5) = "RGBA(" OR _
MID$(a2$, idecx - 7, 7) = "RGBA32(") AND qb64prefix_set = 1) THEN
IF INSTR("0123456789", MID$(a2$, idecx, 1)) = 0 THEN EnteringRGB = -1
END IF
END IF
FindInclude = _INSTRREV(a2$, "$INCLUDE")
IF FindInclude > 0 THEN
link_idecx = LEN(a$)
FindApostrophe1 = INSTR(FindInclude + 8, a2$, "'")
FindApostrophe2 = INSTR(FindApostrophe1 + 1, a2$, "'")
ActiveINCLUDELinkFile = MID$(a$, FindApostrophe1 + 1, FindApostrophe2 - FindApostrophe1 - 1)
p$ = idepath$ + pathsep$
f$ = p$ + ActiveINCLUDELinkFile
IF _FILEEXISTS(f$) OR _FILEEXISTS(ActiveINCLUDELinkFile) THEN
a$ = a$ + " --> Double-click to open": ActiveINCLUDELink = idecy
END IF
END IF
END IF 'l = idecy
a2$ = SPACE$(idesx + (idewx - 3))
MID$(a2$, 1) = a$
ELSE
a2$ = SPACE$((idewx - 2))
END IF
'Syntax highlighter
inquote = 0
metacommand = 0
comment = 0
isKeyword = 0: oldChar$ = ""
isCustomKeyword = 0
multiHighlightLength = 0
prevBG% = _BACKGROUNDCOLOR
FOR m = 1 TO LEN(a2$) 'print to the screen while checking required color changes
IF timeElapsedSince(startTime) > 1 THEN
result = idemessagebox("Syntax Highlighter Disabled", "Syntax Highlighter has been disabled to avoid slowing down the IDE.\nYou can reenable the Highlighter in the 'Options' menu.", "")
DisableSyntaxHighlighter = -1
WriteConfigSetting generalSettingsSection$, "DisableSyntaxHighlighter", "True"
menu$(OptionsMenuID, OptionsMenuDisableSyntax) = "Syntax #Highlighter"
GOTO noSyntaxHighlighting
END IF
IF m > idesx + idewx - 2 THEN EXIT FOR 'stop printing when off screen
IF ideselect = 1 AND LEN(ideCurrentSingleLineSelection) > 0 AND multiHighlightLength = 0 AND multihighlight = -1 THEN
IF LCASE$(MID$(a2$, m, LEN(ideCurrentSingleLineSelection))) = LCASE$(ideCurrentSingleLineSelection) THEN
'the current selection was found at this spot. Multi-highlight takes place:
IF m > 1 THEN
IF INSTR(char.sep$, MID$(a2$, m - 1, 1)) > 0 THEN
IF m + LEN(ideCurrentSingleLineSelection) < LEN(a2$) AND _
(INSTR(char.sep$, MID$(a2$, m + LEN(ideCurrentSingleLineSelection), 1)) > 0 OR _
MID$(a2$, m + LEN(ideCurrentSingleLineSelection), 1) = ".") THEN
multiHighlightLength = LEN(ideCurrentSingleLineSelection)
ELSEIF m + LEN(ideCurrentSingleLineSelection) >= LEN(a2$) THEN
multiHighlightLength = LEN(ideCurrentSingleLineSelection)
END IF
END IF
ELSE
IF m + LEN(ideCurrentSingleLineSelection) < LEN(a2$) AND _
(INSTR(char.sep$, MID$(a2$, m + LEN(ideCurrentSingleLineSelection), 1)) > 0 OR _
MID$(a2$, m + LEN(ideCurrentSingleLineSelection), 1) = ".") THEN
multiHighlightLength = LEN(ideCurrentSingleLineSelection)
ELSEIF m + LEN(ideCurrentSingleLineSelection) >= LEN(a2$) THEN
multiHighlightLength = LEN(ideCurrentSingleLineSelection)
END IF
END IF
END IF
END IF
thisChar$ = MID$(a2$, m, 1)
IF comment = 0 THEN
SELECT CASE thisChar$
CASE CHR$(34): inquote = NOT inquote
CASE "'": IF inquote = 0 THEN comment = -1
END SELECT
END IF
COLOR 13
IF InValidLine(l) THEN COLOR 7: GOTO SkipSyntaxHighlighter
IF (LEN(oldChar$) > 0 OR m = 1) AND inquote = 0 AND isKeyword = 0 THEN
IF INSTR(initialNum.char$, thisChar$) > 0 AND oldChar$ <> ")" AND (INSTR(char.sep$, oldChar$) > 0 OR oldChar$ = "?") THEN
'a number literal
checkKeyword$ = ""
is_Number = 0
FOR i = m TO LEN(a2$)
IF INSTR(num.char$, MID$(a2$, i, 1)) = 0 THEN EXIT FOR
checkKeyword$ = checkKeyword$ + MID$(a2$, i, 1)
NEXT
IF checkKeyword$ = "-" OR checkKeyword$ = "." OR checkKeyword$ = "&" THEN
checkKeyword$ = ""
ELSE
IF isnumber(checkKeyword$) THEN
is_Number = -1
isKeyword = LEN(checkKeyword$)
ELSEIF INSTR(UserDefineList$, "@" + UCASE$(checkKeyword$)) > 0 THEN
'keep checking
FOR i = i TO LEN(a2$)
IF INSTR(char.sep$, MID$(a2$, i, 1)) > 0 THEN right.sep$ = MID$(a2$, i, 1): GOTO keywordAcquired
checkKeyword$ = checkKeyword$ + MID$(a2$, i, 1)
NEXT
GOTO keywordAcquired
END IF
END IF
GOTO setOldChar
END IF
IF (INSTR(char.sep$, oldChar$) > 0 OR oldChar$ = "?") AND INSTR(char.sep$, thisChar$) = 0 THEN
'a new "word" begins; check if it's an internal keyword
checkKeyword$ = ""
right.sep$ = ""
FOR i = m TO LEN(a2$)
IF INSTR(char.sep$, MID$(a2$, i, 1)) > 0 THEN right.sep$ = MID$(a2$, i, 1): EXIT FOR
checkKeyword$ = checkKeyword$ + MID$(a2$, i, 1)
NEXT
IF comment = 0 AND LEFT$(checkKeyword$, 1) = "?" THEN isKeyword = 1: GOTO setOldChar
keywordAcquired:
checkKeyword$ = UCASE$(checkKeyword$)
IF INSTR(listOfKeywords$, "@" + checkKeyword$ + "@") > 0 OR _
(qb64prefix_set = 1 AND INSTR(listOfKeywords$, "@_" + checkKeyword$ + "@") > 0) THEN
'special cases
IF checkKeyword$ = "$END" THEN
IF UCASE$(MID$(a2$, m, 7)) = "$END IF" THEN checkKeyword$ = "$END IF"
ELSEIF checkKeyword$ = "THEN" AND _
(UCASE$(LEFT$(LTRIM$(a2$), 3)) = "$IF" OR _
UCASE$(LEFT$(LTRIM$(a2$), 7)) = "$ELSEIF") THEN
metacommand = -1
ELSEIF checkKeyword$ = "$ASSERTS" THEN
IF UCASE$(_TRIM$(a2$)) = "$ASSERTS:CONSOLE" THEN
checkKeyword$ = "$ASSERTS:CONSOLE"
END IF
END IF
isKeyword = LEN(checkKeyword$)
ELSEIF INSTR(listOfCustomKeywords$, "@" + removesymbol2$(checkKeyword$) + "@") > 0 THEN
isCustomKeyword = -1
isKeyword = LEN(checkKeyword$)
ELSEIF INSTR(UserDefineList$, "@" + checkKeyword$ + "@") > 0 AND _
(UCASE$(LEFT$(LTRIM$(a2$), 3)) = "$IF" OR _
UCASE$(LEFT$(LTRIM$(a2$), 7)) = "$ELSEIF") THEN
isCustomKeyword = -1
isKeyword = LEN(checkKeyword$)
END IF
END IF
END IF
setOldChar:
oldChar$ = thisChar$
IF isKeyword > 0 AND keywordHighlight THEN
IF is_Number THEN
COLOR 8
ELSEIF isCustomKeyword THEN
COLOR 10
ELSE
COLOR 12
END IF
IF LEFT$(checkKeyword$, 1) = "$" THEN metacommand = -1
END IF
IF comment THEN
COLOR 11
IF metacommand THEN
SELECT CASE checkKeyword$
CASE "$INCLUDE"
IF INSTR(m + 1, UCASE$(a2$), checkKeyword$) = 0 THEN COLOR 10
CASE "$DYNAMIC", "$STATIC"
IF INSTR(m + 1, UCASE$(a2$), "$DYNAMIC") = 0 AND INSTR(m + 1, UCASE$(a2$), "$STATIC") = 0 THEN COLOR 10
END SELECT
END IF
ELSEIF metacommand THEN
COLOR 10
ELSEIF inquote OR thisChar$ = CHR$(34) THEN
COLOR 14
END IF
SkipSyntaxHighlighter:
IF l = idecy AND (link_idecx > 0 AND m > link_idecx) THEN COLOR 10
IF (shiftEnter_idecx > 0 AND m > shiftEnter_idecx) THEN COLOR 10
IF l = idecy AND (m = bracket1 OR m = bracket2) THEN
COLOR , 5
ELSEIF multiHighlightLength > 0 AND multihighlight = -1 THEN
multiHighlightLength = multiHighlightLength - 1
COLOR , 5
ELSE
COLOR , prevBG%
END IF
IF ShowLineNumbers THEN
IF (2 + m - idesx) + maxLineNumberLength >= 2 + maxLineNumberLength AND (2 + m - idesx) + maxLineNumberLength < idewx THEN
_PRINTSTRING ((2 + m - idesx) + maxLineNumberLength, y + 3), thisChar$
END IF
ELSE
IF 2 + m - idesx >= 2 AND 2 + m - idesx < idewx THEN
_PRINTSTRING (2 + m - idesx, y + 3), thisChar$
END IF
END IF
'Restore BG color in case a matching bracket was printed with different BG
IF l = idecy THEN COLOR , 6
IF isKeyword > 0 THEN isKeyword = isKeyword - 1
IF isKeyword = 0 AND checkKeyword$ = "REM" THEN comment = -1
IF isKeyword = 0 THEN checkKeyword$ = "": metacommand = 0: is_Number = 0: isCustomKeyword = 0
NEXT m
'apply selection color change if necessary
IF (IdeSystem = 1 OR IdeSystem = 2) AND ideselect <> 0 THEN
IF l >= sy1 AND l <= sy2 THEN
IF sy1 = sy2 THEN 'single line select
COLOR 1, 7
x2 = idesx
FOR x = 2 + maxLineNumberLength TO (idewx - 1)
IF x2 >= sx1 AND x2 < sx2 THEN
a = SCREEN(y + 3, x)
IF a = 63 THEN '"?"
c = SCREEN(y + 3, x, 1)
ELSE
c = 1
END IF
IF (c AND 15) = 0 THEN 'black background
COLOR 0, 7
_PRINTSTRING (x, y + 3), "?"
COLOR 1, 7
ELSE
_PRINTSTRING (x, y + 3), CHR$(a)
END IF
END IF
x2 = x2 + 1
NEXT
COLOR 7, 1
ELSE 'multiline select
IF idecx = 1 AND l = sy2 AND idecy > sy1 THEN GOTO nofinalselect
LOCATE y + 3, 2 + maxLineNumberLength
COLOR 1, 7
FOR x = idesx TO idesx + idewx - (2 + maxLineNumberLength)
PRINT MID$(a2$, x, 1);
NEXT
COLOR 7, 1
nofinalselect:
END IF
END IF
END IF
l = l + 1
NEXT
ELSE
noSyntaxHighlighting:
'original SUB ideshowtext routine:
COLOR 13, 1
l = idesy
FOR y = 0 TO (idewy - 9)
COLOR 7, 1
_PRINTSTRING (1, y + 3), CHR$(179) 'clear prev bookmarks from lhs
GOSUB ShowLineNumber
IF l = idefocusline AND idecy <> l THEN COLOR 13, 4 ELSE COLOR 13, 1
IF l <= iden THEN
a$ = idegetline(l)
a2$ = SPACE$(idesx + (idewx - 3) - maxLineNumberLength)
MID$(a2$, 1) = a$
a2$ = RIGHT$(a2$, (idewx - 2) - maxLineNumberLength)
ELSE
a2$ = SPACE$((idewx - 2) - maxLineNumberLength)
END IF
_PRINTSTRING (2 + maxLineNumberLength, y + 3), a2$
IF l = idecy THEN
IF idecx <= LEN(a$) AND idecx >= 1 THEN
cc = ASC(a$, idecx)
IF cc = 32 THEN
IF LTRIM$(LEFT$(a$, idecx)) = "" THEN cc = -1
END IF
END IF
END IF
'apply selection color change if necessary
IF ideselect THEN
IF l >= sy1 AND l <= sy2 THEN
IF sy1 = sy2 THEN 'single line select
COLOR 1, 7
x2 = idesx
FOR x = 2 + maxLineNumberLength TO (idewx - 1)
IF x2 >= sx1 AND x2 < sx2 THEN
a = SCREEN(y + 3, x): _PRINTSTRING (x, y + 3), CHR$(a)
END IF
x2 = x2 + 1
NEXT
COLOR 7, 1
ELSE 'multiline select
IF idecx = 1 AND l = sy2 AND idecy > sy1 THEN GOTO nofinalselect0
COLOR 1, 7: _PRINTSTRING (2 + maxLineNumberLength, y + 3), a2$
COLOR 7, 1
nofinalselect0:
END IF
END IF
END IF
l = l + 1
NEXT
END IF
COLOR 7, 1
FOR b = 1 TO IdeBmkN
y = IdeBmk(b).y
IF y >= idesy AND y <= idesy + (idewy - 9) THEN
_PRINTSTRING (1, 3 + y - idesy), CHR$(197)
END IF
NEXT
q = idevbar(idewx, 3, (idewy - 8), idecy, iden)
q = idehbar(2, (idewy - 5), (idewx - 2), idesx, 608)
'update cursor pos in status bar
COLOR 0, 3
a$ = SPACE$(10)
b$ = ""
RSET a$ = LTRIM$(STR$(idecy))
IF idecx < 100000 THEN
b$ = SPACE$(10)
c$ = LTRIM$(STR$(idecx))
IF cc <> -1 THEN c$ = c$ + "(" + str2$(cc) + ")"
LSET b$ = c$
END IF
lineNumberStatus$ = a$ + ":" + b$
'_PRINTSTRING (idewx - 21, idewy + idesubwindow), CHR$(179)
_PRINTSTRING (idewx - 20, idewy + idesubwindow), lineNumberStatus$
SCREEN , , 0, 0: LOCATE idecy - idesy + 3, maxLineNumberLength + idecx - idesx + 2: SCREEN , , 3, 0
EXIT SUB
ShowLineNumber:
DO WHILE l > UBOUND(IdeBreakpoints)
REDIM _PRESERVE IdeBreakpoints(UBOUND(IdeBreakpoints) + 100) AS _BYTE
LOOP
DO WHILE l > UBOUND(IdeSkipLines)
REDIM _PRESERVE IdeSkipLines(UBOUND(IdeSkipLines) + 100) AS _BYTE
LOOP
IF ShowLineNumbers THEN
IF ShowLineNumbersUseBG THEN COLOR , 6
IF (searchStringFoundOn > 0 AND searchStringFoundOn = l) OR (l = debugnextline AND vWatchOn = 1) THEN
COLOR 13, 5
IF searchStringFoundOn > 0 AND searchStringFoundOn = l THEN searchStringFoundOn = 0
END IF
IF vWatchOn = 1 AND IdeBreakpoints(l) <> 0 THEN COLOR , 4
IF vWatchOn = 1 AND IdeSkipLines(l) <> 0 THEN COLOR 14
_PRINTSTRING (2, y + 3), SPACE$(maxLineNumberLength)
IF l <= iden THEN
l2$ = STR$(l)
IF 2 + maxLineNumberLength - (LEN(l2$) + 1) >= 2 THEN
_PRINTSTRING (2 + maxLineNumberLength - (LEN(l2$) + 1), y + 3), l2$
IF vWatchOn THEN
IF IdeBreakpoints(l) <> 0 THEN
_PRINTSTRING (2, y + 3), CHR$(7)
ELSEIF IdeSkipLines(l) <> 0 THEN
_PRINTSTRING (2, y + 3), "!"
END IF
END IF
END IF
END IF
IF ShowLineNumbersSeparator THEN
IF l = debugnextline THEN
COLOR 10
_PRINTSTRING (1 + maxLineNumberLength, y + 3), CHR$(16)
ELSE
_PRINTSTRING (1 + maxLineNumberLength, y + 3), CHR$(179)
END IF
ELSE
IF l = debugnextline THEN
COLOR 10
_PRINTSTRING (1 + maxLineNumberLength, y + 3), CHR$(16)
END IF
END IF
COLOR , 1
ELSE
IF vWatchOn = 1 AND (IdeBreakpoints(l) <> 0 OR IdeSkipLines(l) <> 0) THEN
COLOR 7, 4
IF l = debugnextline THEN
COLOR 10
_PRINTSTRING (1, y + 3), CHR$(16)
ELSEIF IdeSkipLines(l) <> 0 THEN
COLOR 14, 1
_PRINTSTRING (1, y + 3), "!"
ELSE
_PRINTSTRING (1, y + 3), CHR$(7)
END IF
ELSEIF vWatchOn = 1 AND l = debugnextline THEN
COLOR 10
_PRINTSTRING (1, y + 3), CHR$(16)
END IF
END IF
RETURN
END SUB
FUNCTION idesubs$
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
'------- identify word or character at current cursor position
a2$ = UCASE$(getWordAtCursor$)
IF LEN(a2$) > 1 THEN
DO UNTIL alphanumeric(ASC(RIGHT$(a2$, 1)))
a2$ = LEFT$(a2$, LEN(a2$) - 1) 'removes sigil, if any
IF LEN(a2$) = 0 THEN EXIT DO
LOOP
END IF
'-------- init --------
l$ = ideprogname$
IF l$ = "" THEN l$ = "Untitled" + tempfolderindexstr$
IF idewx < 100 THEN
moduleNameLenLimit = 20
ELSE
moduleNameLenLimit = 42
END IF
maxModuleNameLen = LEN(l$)
IF maxModuleNameLen > moduleNameLenLimit + 2 THEN
l$ = LEFT$(l$, moduleNameLenLimit - 1) + STRING$(3, 250)
maxModuleNameLen = moduleNameLenLimit
ELSEIF maxModuleNameLen < 10 THEN
maxModuleNameLen = 10
END IF
ly$ = MKL$(1)
lySorted$ = ly$
CurrentlyViewingWhichSUBFUNC = 1
PreferCurrentCursorSUBFUNC = 0
InsideDECLARE = 0
FoundExternalSUBFUNC = 0
maxLineCount = 0
REDIM SortedSubsList(1 TO 100) AS STRING * 998
REDIM CaseBkpSubsList(1 TO 100) AS STRING * 998
REDIM TotalLines(0 TO 100) AS LONG
REDIM SubNames(0 TO 100) AS STRING
REDIM SubLines(0 TO 100) AS LONG
REDIM Args(0 TO 100) AS STRING
REDIM SF(0 TO 100) AS STRING
TotalSUBs = 0
ModuleSize = 0 'in lines
SortedSubsFlag = idesortsubs
SubClosed = 0
FOR y = 1 TO iden
a$ = idegetline(y)
IF SubClosed = 0 THEN ModuleSize = ModuleSize + 1
a$ = LTRIM$(RTRIM$(a$))
sf = 0
nca$ = UCASE$(a$)
IF LEFT$(nca$, 8) = "DECLARE " AND INSTR(nca$, " LIBRARY") > 0 THEN InsideDECLARE = -1
IF LEFT$(nca$, 11) = "END DECLARE" THEN InsideDECLARE = 0
IF LEFT$(nca$, 4) = "SUB " THEN sf = 1: sf$ = "SUB "
IF LEFT$(nca$, 9) = "FUNCTION " THEN sf = 2: sf$ = "FUNC "
IF sf THEN
'Resize SortedSubsList() and helper arrays
TotalSUBs = TotalSUBs + 1
IF NOT InsideDECLARE THEN LastOpenSUB = TotalSUBs
IF TotalSUBs > UBOUND(SortedSubsList) THEN
REDIM _PRESERVE SortedSubsList(1 TO TotalSUBs + 99) AS STRING * 998
REDIM _PRESERVE CaseBkpSubsList(1 TO TotalSUBs + 99) AS STRING * 998
REDIM _PRESERVE TotalLines(0 TO TotalSUBs + 99) AS LONG
REDIM _PRESERVE SubNames(0 TO TotalSUBs + 99) AS STRING
REDIM _PRESERVE SubLines(0 TO TotalSUBs + 99) AS LONG
REDIM _PRESERVE Args(0 TO TotalSUBs + 99) AS STRING
REDIM _PRESERVE SF(0 TO TotalSUBs + 99) AS STRING
END IF
IF RIGHT$(nca$, 7) = " STATIC" THEN
a$ = RTRIM$(LEFT$(a$, LEN(a$) - 7))
END IF
'Store line number
ly$ = ly$ + MKL$(y)
'Check if the cursor is currently inside this SUB/FUNCTION to position the
'selection properly in the list.
IF idecy >= y AND NOT InsideDECLARE THEN
CurrentlyViewingWhichSUBFUNC = (LEN(ly$) / 4)
END IF
'End of current SUB/FUNCTION check
IF sf = 1 THEN
a$ = RIGHT$(a$, LEN(a$) - 4)
ELSE
a$ = RIGHT$(a$, LEN(a$) - 9)
END IF
a$ = LTRIM$(RTRIM$(a$))
x = INSTR(a$, "(")
DIM comment AS _BYTE, quote AS _BYTE
IF x THEN FindQuoteComment a$, x, comment, quote
IF x > 0 AND comment = 0 AND quote = 0 THEN
n$ = RTRIM$(LEFT$(a$, x - 1))
args$ = RIGHT$(a$, LEN(a$) - x + 1)
x = 1
FOR i = 2 TO LEN(args$)
IF ASC(args$, i) = 40 THEN x = x + 1
IF ASC(args$, i) = 41 THEN x = x - 1
IF x = 0 THEN args$ = LEFT$(args$, i): EXIT FOR
NEXT
ELSE
n$ = a$
args$ = "()"
END IF
cleanSubName n$
IF LEN(n$) > maxModuleNameLen THEN maxModuleNameLen = LEN(n$)
IF maxModuleNameLen > moduleNameLenLimit THEN maxModuleNameLen = moduleNameLenLimit
'If the user currently has the cursor over a SUB/FUNC name, let's highlight it
'instead of the currently in edition, for a quick link functionality:
n2$ = n$
IF LEN(n2$) > 1 THEN
DO UNTIL alphanumeric(ASC(RIGHT$(n2$, 1)))
n2$ = LEFT$(n$, LEN(n2$) - 1) 'removes sigil, if any
LOOP
END IF
IF a2$ = UCASE$(n2$) THEN PreferCurrentCursorSUBFUNC = (LEN(ly$) / 4)
IF InsideDECLARE = -1 THEN
n$ = "*" + n$
FoundExternalSUBFUNC = -1
ELSE
IF SubClosed = 0 THEN ModuleSize = 0: GOSUB AddLineCount
SubClosed = 0
ModuleSize = 0
END IF
'Populate arrays
SubNames(TotalSUBs) = n$
SubLines(TotalSUBs) = y
Args(TotalSUBs) = args$
SF(TotalSUBs) = sf$
ELSE 'no sf
'remove double spaces
i = INSTR(nca$, " ")
DO WHILE i > 0
nca$ = LEFT$(nca$, i) + MID$(nca$, i + 2)
i = INSTR(i, nca$, " ")
LOOP
cursor = 0
LookForENDSUB:
sf = INSTR(cursor + 1, nca$, "END SUB")
IF sf = 0 THEN sf = INSTR(cursor + 1, nca$, "END FUNCTION")
IF sf THEN
FindQuoteComment nca$, sf, comment, quote
IF comment OR quote THEN cursor = sf: GOTO LookForENDSUB
GOSUB AddLineCount
END IF
END IF
NEXT
IF SubClosed = 0 THEN GOSUB AddLineCount
'fix arrays to remove empty items
IF TotalSUBs > 0 AND TotalSUBs < UBOUND(SortedSubsList) THEN
REDIM _PRESERVE SortedSubsList(1 TO TotalSUBs) AS STRING * 998
REDIM _PRESERVE CaseBkpSubsList(1 TO TotalSUBs) AS STRING * 998
REDIM _PRESERVE TotalLines(0 TO TotalSUBs) AS LONG
REDIM _PRESERVE SubNames(0 TO TotalSUBs) AS STRING
REDIM _PRESERVE SubLines(0 TO TotalSUBs) AS LONG
REDIM _PRESERVE Args(0 TO TotalSUBs) AS STRING
REDIM _PRESERVE SF(0 TO TotalSUBs) AS STRING
END IF
'build headers (normal, sorted, normal with line count, sorted with line count)
IF TotalSUBs > 0 THEN
IF LEN(LTRIM$(STR$(maxLineCount))) <= 10 THEN
maxLineCountSpace = 10
linesHeader$ = "Line count"
external$ = "external"
END IF
IF LEN(LTRIM$(STR$(maxLineCount))) <= 5 THEN
maxLineCountSpace = 5
linesHeader$ = "Lines"
external$ = CHR$(196)
END IF
l$ = l$ + SPACE$((maxModuleNameLen + 2) - LEN(l$))
lSized$ = l$
lSortedSized$ = l$
l$ = l$ + " Type Arguments"
lSorted$ = l$
lSorted$ = l$
lSized$ = lSized$ + " " + linesHeader$ + " Type Arguments" + sep
lSortedSized$ = lSortedSized$ + " " + linesHeader$ + " Type Arguments"
ELSE
l$ = ideprogname$
IF l$ = "" THEN l$ = "Untitled" + tempfolderindexstr$
lSized$ = l$
END IF
'build lists
dialogWidth = 50
argsLength = 2
FOR x = 1 TO TotalSUBs
n$ = SubNames(x)
IF LEN(n$) > maxModuleNameLen THEN
n$ = LEFT$(n$, maxModuleNameLen - 3) + STRING$(3, 250)
ELSE
n$ = n$ + SPACE$(maxModuleNameLen - LEN(n$))
END IF
args$ = Args(x)
IF LEN(args$) > argsLength THEN argsLength = LEN(args$)
IF LEN(args$) <= (idewx - 41) THEN
args$ = args$ + SPACE$((idewx - 41) - LEN(args$))
ELSE
args$ = LEFT$(args$, (idewx - 44)) + STRING$(3, 250)
END IF
sf$ = SF(x)
l$ = l$ + sep + CHR$(195) + CHR$(196) + n$ + " " + CHR$(16) + CHR$(2) + _
sf$ + CHR$(16) + CHR$(16) + args$
IF TotalLines(x) = 0 THEN num$ = external$ ELSE num$ = LTRIM$(STR$(TotalLines(x)))
lSized$ = lSized$ + CHR$(195) + CHR$(196) + n$ + " " + _
CHR$(16) + CHR$(2) + SPACE$(maxLineCountSpace - LEN(num$)) + num$ + " " _
+ sf$ + CHR$(16) + CHR$(16) + args$ + sep
listItem$ = n$ + " " + CHR$(1) + CHR$(16) + CHR$(2) + sf$ + CHR$(16) + CHR$(16) + args$
ListItemLength = LEN(listItem$)
SortedSubsList(x) = UCASE$(listItem$)
CaseBkpSubsList(x) = listItem$
MID$(CaseBkpSubsList(x), 992, 6) = MKL$(SubLines(x)) + MKI$(ListItemLength)
MID$(SortedSubsList(x), 992, 6) = MKL$(SubLines(x)) + MKI$(ListItemLength)
NEXT
MID$(l$, _INSTRREV(l$, CHR$(195)), 1) = CHR$(192)
MID$(lSized$, _INSTRREV(lSized$, CHR$(195)), 1) = CHR$(192)
IF TotalSUBs > 1 THEN
sort SortedSubsList()
FOR x = 1 TO TotalSUBs
ListItemLength = CVI(MID$(SortedSubsList(x), LEN(SortedSubsList(x)) - 2, 2))
lySorted$ = lySorted$ + MID$(SortedSubsList(x), LEN(SortedSubsList(x)) - 6, 4)
FOR RestoreCaseBkp = 1 TO TotalSUBs
IF MID$(SortedSubsList(x), LEN(SortedSubsList(x)) - 6, 4) = MID$(CaseBkpSubsList(RestoreCaseBkp), LEN(CaseBkpSubsList(RestoreCaseBkp)) - 6, 4) THEN
lSorted$ = lSorted$ + sep + CHR$(195) + CHR$(196)
temp$ = LEFT$(CaseBkpSubsList(RestoreCaseBkp), ListItemLength)
lSorted$ = lSorted$ + LEFT$(temp$, INSTR(temp$, CHR$(1)) - 1) + _
MID$(temp$, INSTR(temp$, CHR$(1)) + 1)
num$ = LTRIM$(STR$(TotalLines(RestoreCaseBkp)))
IF LEFT$(temp$, 1) = "*" THEN num$ = external$
lSortedSized$ = lSortedSized$ + sep + CHR$(195) + CHR$(196)
lSortedSized$ = lSortedSized$ + LEFT$(temp$, INSTR(temp$, CHR$(1)) - 1) + _
SPACE$(maxLineCountSpace - LEN(num$)) + CHR$(16) + CHR$(2) + num$ + " " + _
MID$(temp$, INSTR(temp$, CHR$(1)) + 1)
EXIT FOR
END IF
NEXT
NEXT
MID$(lSorted$, _INSTRREV(lSorted$, CHR$(195)), 1) = CHR$(192)
MID$(lSortedSized$, _INSTRREV(lSortedSized$, CHR$(195)), 1) = CHR$(192)
SortedSubsFlag = idesortsubs
ELSE
SortedSubsFlag = 0 'Override idesortsubs if the current program doesn't have more than 1 subprocedure
END IF
'72,19
i = 0
dialogHeight = TotalSUBs + 4
IF dialogHeight > idewy + idesubwindow - 6 THEN
dialogHeight = idewy + idesubwindow - 6
END IF
IF argsLength + maxModuleNameLen + maxLineCountSpace + 20 > dialogWidth THEN dialogWidth = argsLength + maxModuleNameLen + maxLineCountSpace + 20
IF dialogWidth > idewx - 8 THEN dialogWidth = idewx - 8
idepar p, dialogWidth, dialogHeight, "SUBs"
i = i + 1
o(i).typ = 2
o(i).y = 1
'68
o(i).w = dialogWidth - 4: o(i).h = dialogHeight - 3
IF SortedSubsFlag = 0 THEN
IF IDESubsLength THEN
o(i).txt = idenewtxt(lSized$)
ELSE
o(i).txt = idenewtxt(l$)
END IF
IF PreferCurrentCursorSUBFUNC <> 0 THEN
o(i).sel = PreferCurrentCursorSUBFUNC
ELSE
o(i).sel = CurrentlyViewingWhichSUBFUNC
END IF
ELSE
idetxt(o(i).txt) = lSorted$
IF IDESubsLength THEN
o(i).txt = idenewtxt(lSortedSized$)
ELSE
o(i).txt = idenewtxt(lSorted$)
END IF
IF PreferCurrentCursorSUBFUNC <> 0 THEN
FOR x = 1 TO TotalSUBs
IF MID$(ly$, PreferCurrentCursorSUBFUNC * 4 - 3, 4) = MID$(SortedSubsList(x), LEN(SortedSubsList(x)) - 6, 4) THEN
o(i).sel = x + 1 'The sorted list items array doesn't contain the first line (ideprogname$)
EXIT FOR
END IF
NEXT
ELSE
FOR x = 1 TO TotalSUBs
IF MID$(ly$, CurrentlyViewingWhichSUBFUNC * 4 - 3, 4) = MID$(SortedSubsList(x), LEN(SortedSubsList(x)) - 6, 4) THEN
o(i).sel = x + 1 'The sorted list items array doesn't contain the first line (ideprogname$)
EXIT FOR
END IF
NEXT
END IF
END IF
o(i).nam = idenewtxt("Program Items")
i = i + 1
o(i).typ = 4 'check box
o(i).x = 2
o(i).y = dialogHeight
o(i).nam = idenewtxt("#Line Count")
o(i).sel = IDESubsLength
i = i + 1
o(i).typ = 4 'check box
o(i).x = 18
o(i).y = dialogHeight
o(i).nam = idenewtxt("#Sort")
o(i).sel = SortedSubsFlag
i = i + 1
o(i).typ = 3
o(i).w = 26
o(i).x = dialogWidth - 22
o(i).y = dialogHeight
IF IdeDebugMode = 0 THEN
o(i).txt = idenewtxt("#Edit" + sep + "#Cancel")
ELSE
o(i).txt = idenewtxt("#View" + sep + "#Cancel")
END IF
o(i).dft = 1
'-------- 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 --------
IF FoundExternalSUBFUNC THEN
COLOR 2, 7
_PRINTSTRING (p.x + p.w - 32, p.y + p.h), "* external"
END IF
'-------- 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 K$ = CHR$(27) OR (focus = 5 AND info <> 0) THEN
idesubs$ = "C"
GOSUB SaveSortSettings
ClearMouse
EXIT FUNCTION
END IF
IF K$ = CHR$(13) OR (focus = 4 AND info <> 0) OR (info = 1 AND focus = 1) THEN
y = o(1).sel
IF y < 1 THEN y = -y
AddQuickNavHistory
IF SortedSubsFlag = 0 THEN
idecy = CVL(MID$(ly$, y * 4 - 3, 4))
ELSE
idecy = CVL(MID$(lySorted$, y * 4 - 3, 4))
END IF
idesy = idecy
idecx = 1
idesx = 1
GOSUB SaveSortSettings
ClearMouse
EXIT FUNCTION
END IF
IF o(2).sel <> IDESubsLength THEN
IDESubsLength = o(2).sel
IF IDESubsLength THEN
IF o(3).sel THEN
idetxt(o(1).txt) = lSortedSized$
ELSE
idetxt(o(1).txt) = lSized$
END IF
ELSE
IF o(3).sel THEN
idetxt(o(1).txt) = lSorted$
ELSE
idetxt(o(1).txt) = l$
END IF
END IF
focus = 1
END IF
IF TotalSUBs > 1 THEN
IF o(3).sel <> SortedSubsFlag THEN
SortedSubsFlag = o(3).sel
IF SortedSubsFlag = 0 THEN
'Replace list contents with unsorted version while mantaining current selection.
PreviousSelection = -1
IF o(1).sel > 0 THEN
TargetSourceLine$ = MID$(lySorted$, o(1).sel * 4 - 3, 4)
FOR x = 1 TO TotalSUBs
IF MID$(ly$, x * 4 - 3, 4) = TargetSourceLine$ THEN
PreviousSelection = x
END IF
NEXT
END IF
IF IDESubsLength THEN
idetxt(o(1).txt) = lSized$
ELSE
idetxt(o(1).txt) = l$
END IF
o(1).sel = PreviousSelection
focus = 1
ELSE
'Replace list contents with sorted version while mantaining current selection.
PreviousSelection = -1
IF o(1).sel > 0 THEN
TargetSourceLine$ = MID$(ly$, o(1).sel * 4 - 3, 4)
FOR x = 1 TO TotalSUBs
IF MID$(lySorted$, x * 4 - 3, 4) = TargetSourceLine$ THEN
PreviousSelection = x
END IF
NEXT
END IF
IF IDESubsLength THEN
idetxt(o(1).txt) = lSortedSized$
ELSE
idetxt(o(1).txt) = lSorted$
END IF
o(1).sel = PreviousSelection
focus = 1
END IF
END IF
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
EXIT FUNCTION
SaveSortSettings:
idesortsubs = SortedSubsFlag
IF idesortsubs THEN
WriteConfigSetting displaySettingsSection$, "IDE_SortSUBs", "True"
ELSE
WriteConfigSetting displaySettingsSection$, "IDE_SortSUBs", "False"
END IF
IF IDESubsLength THEN
WriteConfigSetting displaySettingsSection$, "IDE_SUBsLength", "True"
ELSE
WriteConfigSetting displaySettingsSection$, "IDE_SUBsLength", "False"
END IF
RETURN
AddLineCount:
ModuleSize = ModuleSize + 1
TotalLines(LastOpenSUB) = ModuleSize
IF ModuleSize > maxLineCount THEN maxLineCount = ModuleSize
SubClosed = -1
RETURN
END FUNCTION
FUNCTION idelanguagebox
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
'generate list of available code pages
l$ = idecpname(1)
dialogWidth = LEN(l$)
FOR x = 2 TO idecpnum
l$ = l$ + sep + idecpname(x)
IF LEN(idecpname(x)) > dialogWidth THEN dialogWidth = LEN(idecpname(x))
NEXT
l$ = UCASE$(l$)
i = 0
dialogHeight = idecpnum + 5
IF dialogHeight > idewy + idesubwindow - 6 THEN
dialogHeight = idewy + idesubwindow - 6
END IF
IF dialogWidth < 60 THEN dialogWidth = 60
IF dialogWidth > idewx - 8 THEN dialogWidth = idewx - 8
idepar p, dialogWidth, dialogHeight, "Language"
i = i + 1
o(i).typ = 2
o(i).y = 3
o(i).w = dialogWidth - 4: o(i).h = dialogheight - 5
o(i).txt = idenewtxt(l$)
o(i).sel = 1: IF idecpindex THEN o(i).sel = idecpindex
o(i).nam = idenewtxt("Code Pages")
i = i + 1
o(i).typ = 3
o(i).y = dialogheight
o(i).txt = idenewtxt("#OK" + sep + "#Cancel")
o(i).dft = 1
'-------- 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
_PRINTSTRING (p.x + 2, p.y + 1), "Code-page for ASCII-UNICODE mapping (Default = CP437):"
COLOR 2, 7
_PRINTSTRING (p.x + 2, p.y + 2), "(affects the display of TTF fonts set in Options-Display)"
'-------- 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 K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN
' idesubs$ = "C"
EXIT FUNCTION
END IF
IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) OR (info = 1 AND focus = 1) THEN
y = o(1).sel
IF y < 1 THEN y = -y
FOR x = 128 TO 255
u = VAL("&H" + MID$(idecp(y), x * 8 + 1, 8) + "&")
IF u = 0 THEN u = 9744
_MAPUNICODE u TO x
NEXT
'save changes
v% = y: idecpindex = v%
WriteConfigSetting displaySettingsSection$, "IDE_CodePage", STR$(idecpindex)
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
idelanguagebox = 0
END FUNCTION
FUNCTION idewarningbox
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
IF LEN(ideprogname) THEN thisprog$ = ideprogname ELSE thisprog$ = "Untitled" + tempfolderindexstr$
maxModuleNameLen = LEN(thisprog$)
'calculate longest module name
FOR x = 1 TO warningListItems
IF warningLines(x) = 0 THEN _CONTINUE
IF warningIncLines(x) > 0 THEN
IF LEN(warningIncFiles(x)) > maxModuleNameLen THEN
maxModuleNameLen = LEN(warningIncFiles(x))
END IF
END IF
NEXT
'build list
dialogWidth = 60
FOR x = 1 TO warningListItems
IF warningLines(x) = 0 THEN
l$ = l$ + warning$(x)
IF x > 1 AND treeConnection > 0 THEN ASC(l$, treeConnection) = 192
ELSE
l3$ = CHR$(16) + CHR$(2) 'dark grey
IF warningIncLines(x) > 0 THEN
num$ = SPACE$(LEN(STR$(maxLineNumber)) + 1)
RSET num$ = str2$(warningIncLines(x))
l3$ = l3$ + warningIncFiles(x) + SPACE$(maxModuleNameLen - LEN(warningIncFiles(x))) + ":" + CHR$(16) + CHR$(16) + num$
ELSE
num$ = SPACE$(LEN(STR$(maxLineNumber)) + 1)
RSET num$ = str2$(warningLines(x))
l3$ = l3$ + thisprog$ + SPACE$(maxModuleNameLen - LEN(thisprog$)) + ":" + CHR$(16) + CHR$(16) + num$
END IF
treeConnection = LEN(l$) + 1
text$ = warning$(x)
IF LEN(l3$ + text$) + 6 > dialogWidth THEN dialogWidth = LEN(l3$ + text$) + 6
IF LEN(text$) THEN
l$ = l$ + CHR$(195) + CHR$(196) + l3$ + ": " + text$
ELSE
l$ = l$ + CHR$(195) + CHR$(196) + l3$
END IF
END IF
IF x < warningListItems THEN l$ = l$ + sep
NEXT
IF warningLines(warningListItems) > 0 THEN
ASC(l$, treeConnection) = 192
END IF
i = 0
dialogHeight = warningListItems + 4
IF dialogHeight > idewy + idesubwindow - 6 THEN
dialogHeight = idewy + idesubwindow - 6
END IF
IF dialogWidth > idewx - 8 THEN dialogWidth = idewx - 8
idepar p, dialogWidth, dialogHeight, "Compilation status"
i = i + 1
o(i).typ = 2
o(i).y = 2
o(i).w = dialogWidth - 4: o(i).h = dialogHeight - 4
o(i).txt = idenewtxt(l$)
o(i).sel = 1
o(i).nam = idenewtxt("Warnings (" + LTRIM$(STR$(totalWarnings)) + ")")
i = i + 1
o(i).typ = 3
o(i).y = dialogHeight
o(i).txt = idenewtxt("#Go to" + sep + "#Close")
o(i).dft = 1
'-------- 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: _PRINTSTRING (p.x + 2, p.y + 1), "Double-click on an item to jump to the line indicated"
'-------- 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 K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN
EXIT FUNCTION
END IF
IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) OR (info = 1 AND focus = 1) THEN
y = ABS(o(1).sel)
IF y >= 1 AND y <= warningListItems AND warningLines(y) > 0 THEN
idegotobox_LastLineNum = warningLines(y)
AddQuickNavHistory
idecy = idegotobox_LastLineNum
idecentercurrentline
IF warningIncLines(y) > 0 THEN
warningInInclude = idecy
warningInIncludeLine = warningIncLines(y)
END IF
ideselect = 0
EXIT FUNCTION
END IF
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
idewarningbox = 0
END FUNCTION
SUB ideobjupdate (o AS idedbotype, focus, f, focusoffset, kk$, altletter$, mb, mousedown, mouseup, mx, my, info, mw)
STATIC LastKeybInput AS SINGLE
DIM sep AS STRING * 1
sep = CHR$(0)
t = o.typ
mouseup = mouseup 'just to clear warnings of unused variables
IF t = 1 THEN 'text field
IF mousedown THEN
x1 = o.par.x + o.x: y = o.par.y + o.y
x2 = x1
IF o.nam THEN
x2 = x2 + idehlen(idetxt(o.nam)) + 2
END IF
IF my >= y - 1 AND my <= y + 1 THEN
IF mx >= x1 AND mx <= x2 + o.w + 3 THEN
focus = f
'change cursor location?
IF my = y THEN
IF mx > x2 + 1 AND mx < x2 + o.w + 2 THEN
a$ = idetxt(o.txt)
x = mx - x2 - 2 '0-?
IF x = o.v1 AND x <> LEN(a$) THEN 'dbl-click text=clear field text
a$ = ""
idetxt(o.txt) = a$
o.v1 = 0
ELSE
IF x <= LEN(a$) THEN o.v1 = x ELSE o.v1 = LEN(a$)
o.issel = 0
END IF
END IF
END IF
END IF
END IF
END IF 'mousedown
a$ = idetxt(o.txt)
IF focusoffset = 0 THEN
IF LEN(kk$) = 1 OR KB <> 0 THEN
IF LEN(kk$) = 1 THEN k = ASC(kk$)
IF (KSHIFT AND KB = KEY_INSERT) OR (KCONTROL AND UCASE$(kk$) = "V") THEN 'paste from clipboard
clip$ = _CLIPBOARD$ 'read clipboard
x = INSTR(clip$, CHR$(13))
IF x THEN clip$ = LEFT$(clip$, x - 1)
x = INSTR(clip$, CHR$(10))
IF x THEN clip$ = LEFT$(clip$, x - 1)
IF LEN(clip$) THEN
IF o.issel THEN
sx1 = o.sx1: sx2 = o.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN
a$ = LEFT$(a$, sx1) + clip$ + RIGHT$(a$, LEN(a$) - sx2)
o.v1 = sx1
IF PasteCursorAtEnd THEN o.v1 = sx1 + LEN(clip$)
o.issel = 0
END IF
ELSE
a$ = LEFT$(a$, o.v1) + clip$ + RIGHT$(a$, LEN(a$) - o.v1)
IF PasteCursorAtEnd THEN o.v1 = o.v1 + LEN(clip$)
END IF
END IF
k = 255
END IF
IF (KCONTROL AND UCASE$(kk$) = "A") THEN 'select all
IF LEN(a$) > 0 THEN
o.issel = -1
o.sx1 = 0
o.v1 = LEN(a$)
END IF
k = 255
END IF
IF ((KCTRL AND KB = KEY_INSERT) OR (KCONTROL AND UCASE$(kk$) = "C")) THEN 'copy to clipboard
IF o.issel THEN
sx1 = o.sx1: sx2 = o.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN _CLIPBOARD$ = MID$(a$, sx1 + 1, sx2 - sx1)
END IF
k = 255
END IF
IF ((KSHIFT AND KB = KEY_DELETE) OR (KCONTROL AND UCASE$(kk$) = "X")) THEN 'cut to clipboard
IF o.issel THEN
sx1 = o.sx1: sx2 = o.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN
_CLIPBOARD$ = MID$(a$, sx1 + 1, sx2 - sx1)
'delete selection
a$ = LEFT$(a$, sx1) + RIGHT$(a$, LEN(a$) - sx2)
o.v1 = sx1
o.issel = 0
END IF
END IF
k = 255
END IF
IF k = 8 AND o.v1 > 0 THEN
IF o.issel THEN
sx1 = o.sx1: sx2 = o.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN
'delete selection
a$ = LEFT$(a$, sx1) + RIGHT$(a$, LEN(a$) - sx2)
o.issel = 0
END IF
ELSE
a1$ = LEFT$(a$, o.v1 - 1)
IF o.v1 <= LEN(a$) THEN a2$ = RIGHT$(a$, LEN(a$) - o.v1) ELSE a2$ = ""
a$ = a1$ + a2$: o.v1 = o.v1 - 1
END IF
ELSEIF k = 8 AND o.issel THEN
sx1 = o.sx1: sx2 = o.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN
'delete selection
a$ = LEFT$(a$, sx1) + RIGHT$(a$, LEN(a$) - sx2)
o.issel = 0
END IF
END IF
IF k <> 8 AND k <> 9 AND k <> 0 AND k <> 10 AND k <> 13 AND k <> 26 AND k <> 255 AND ((KALT = 0 AND KCTRL = 0) OR (KALT = -1 AND KCTRL = -1)) THEN
IF o.issel THEN
sx1 = o.sx1: sx2 = o.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN
'replace selection
a$ = LEFT$(a$, sx1) + RIGHT$(a$, LEN(a$) - sx2)
idetxt(o.txt) = a$
o.issel = 0
o.v1 = sx1
END IF
END IF
IF o.v1 > 0 THEN a1$ = LEFT$(a$, o.v1) ELSE a1$ = ""
IF o.v1 <= LEN(a$) THEN a2$ = RIGHT$(a$, LEN(a$) - o.v1) ELSE a2$ = ""
a$ = a1$ + kk$ + a2$: o.v1 = o.v1 + 1
END IF
idetxt(o.txt) = a$
END IF
IF kk$ = CHR$(0) + "S" THEN 'DEL
IF o.issel THEN
sx1 = o.sx1: sx2 = o.v1
IF sx1 > sx2 THEN SWAP sx1, sx2
IF sx2 - sx1 > 0 THEN
'delete selection
a$ = LEFT$(a$, sx1) + RIGHT$(a$, LEN(a$) - sx2)
idetxt(o.txt) = a$
o.v1 = sx1
o.issel = 0
END IF
ELSE
IF o.v1 > 0 THEN a1$ = LEFT$(a$, o.v1) ELSE a1$ = ""
IF o.v1 < LEN(a$) THEN a2$ = RIGHT$(a$, LEN(a$) - o.v1 - 1) ELSE a2$ = ""
a$ = a1$ + a2$
idetxt(o.txt) = a$
END IF
END IF
'cursor control
IF kk$ = CHR$(0) + "K" THEN GOSUB selectcheck: o.v1 = o.v1 - 1
IF kk$ = CHR$(0) + "M" THEN GOSUB selectcheck: o.v1 = o.v1 + 1
IF kk$ = CHR$(0) + "G" THEN GOSUB selectcheck: o.v1 = 0
IF kk$ = CHR$(0) + "O" THEN GOSUB selectcheck: o.v1 = LEN(a$)
IF o.v1 < 0 THEN o.v1 = 0
IF o.v1 > LEN(a$) THEN o.v1 = LEN(a$)
IF o.v1 = o.sx1 THEN o.issel = 0
END IF
'hot-key focus
IF LEN(altletter$) THEN
IF o.nam THEN
x = INSTR(idetxt(o.nam), "#")
IF x THEN
IF UCASE$(MID$(idetxt(o.nam), x + 1, 1)) = altletter$ THEN focus = f
END IF
END IF
END IF
f = f + 1
END IF '1
IF t = 2 THEN 'list box
idetxt(o.stx) = ""
'Populate ListBoxITEMS:
a$ = idetxt(o.txt)
REDIM ListBoxITEMS(0) AS STRING
REDIM OriginalListBoxITEMS(0) AS STRING
IF LEN(a$) > 0 THEN
n = 0: x = 1
DO
x2 = INSTR(x, a$, sep)
IF x2 > 0 THEN
n = n + 1
IF n > UBOUND(ListBoxITEMS) THEN
REDIM _PRESERVE ListBoxITEMS(1 TO n + 999) AS STRING
REDIM _PRESERVE OriginalListBoxITEMS(1 TO n + 999) AS STRING
END IF
ListBoxITEMS(n) = _TRIM$(MID$(a$, x, x2 - x))
OriginalListBoxITEMS(n) = MID$(a$, x, x2 - x)
IF LEN(ListBoxITEMS(n)) THEN
DO WHILE ASC(ListBoxITEMS(n)) < 32 OR ASC(ListBoxITEMS(n)) > 126
ListBoxITEMS(n) = MID$(ListBoxITEMS(n), 2)
IF LEN(ListBoxITEMS(n)) = 0 THEN EXIT DO
LOOP
END IF
ELSE
n = n + 1
IF n > UBOUND(ListBoxITEMS) THEN
REDIM _PRESERVE ListBoxITEMS(1 TO n + 999) AS STRING
REDIM _PRESERVE OriginalListBoxITEMS(1 TO n + 999) AS STRING
END IF
ListBoxITEMS(n) = _TRIM$(RIGHT$(a$, LEN(a$) - x + 1))
OriginalListBoxITEMS(n) = RIGHT$(a$, LEN(a$) - x + 1)
IF LEN(ListBoxITEMS(n)) THEN
DO WHILE ASC(ListBoxITEMS(n)) < 32 OR ASC(ListBoxITEMS(n)) > 126
ListBoxITEMS(n) = MID$(ListBoxITEMS(n), 2)
IF LEN(ListBoxITEMS(n)) = 0 THEN EXIT DO
LOOP
END IF
EXIT DO
END IF
x = x2 + 1
LOOP
REDIM _PRESERVE ListBoxITEMS(1 TO n) AS STRING
REDIM _PRESERVE OriginalListBoxITEMS(1 TO n) AS STRING
END IF
IF mousedown THEN
x1 = o.par.x + o.x: y1 = o.par.y + o.y
x2 = x1 + o.w + 1: y2 = y1 + o.h + 1
IF mx >= x1 AND mx <= x2 AND my >= y1 AND my <= y2 THEN
focus = f
IF mx > x1 AND mx < x2 AND my > y1 AND my < y2 THEN
y = my - y1 - 1
y = y + o.v1
IF o.sel = y THEN info = 1
o.sel = y
IF o.sel > o.num THEN o.sel = -o.num
END IF
END IF
END IF 'mousedown
IF mb THEN
IF focusoffset = 0 THEN
x1 = o.par.x + o.x: y1 = o.par.y + o.y
x2 = x1 + o.w + 1: y2 = y1 + o.h + 1
IF mx >= x1 AND mx <= x2 AND my >= y1 AND my <= y2 THEN
IF mx = x2 AND my > y1 + 1 AND my < y2 - 1 THEN
tsel = ABS(o.sel)
tnum = o.num
q = idevbar(x2, y1 + 1, o.h, tsel, tnum)
IF my < q THEN
kk$ = CHR$(0) + CHR$(73)
idewait
END IF
IF my > q THEN
kk$ = CHR$(0) + CHR$(81)
idewait
END IF
END IF
IF mx = x2 AND my = y1 + 1 THEN
kk$ = CHR$(0) + CHR$(72)
idewait
END IF
IF mx = x2 AND my = y2 - 1 THEN
kk$ = CHR$(0) + CHR$(80)
idewait
END IF
END IF
END IF
END IF 'mb
IF focusoffset = 0 THEN
IF mw THEN
'move to top or bottom
IF mw < 0 THEN
IF o.sel > o.v1 THEN o.sel = o.v1
ELSE
o.sel = o.v1 + o.h - 1
END IF
o.sel = o.sel + mw * 3
IF o.sel < 1 THEN o.sel = 1
IF o.sel > o.num THEN o.sel = o.num
END IF
IF kk$ = CHR$(0) + CHR$(72) THEN
IF o.sel < 0 THEN
o.sel = -o.sel
ELSE
o.sel = o.sel - 1
IF o.sel < 1 THEN o.sel = 1
END IF
END IF
IF kk$ = CHR$(0) + CHR$(80) THEN
IF o.sel < 0 THEN
o.sel = -o.sel
ELSE
o.sel = o.sel + 1
IF o.sel > o.num THEN o.sel = o.num
END IF
END IF
IF kk$ = CHR$(0) + CHR$(73) THEN
IF o.sel < 0 THEN
o.sel = -o.sel
END IF
o.sel = o.sel - o.h + 1
IF o.sel < 1 THEN o.sel = 1
END IF
IF kk$ = CHR$(0) + CHR$(81) THEN
IF o.sel < 0 THEN
o.sel = -o.sel
END IF
o.sel = o.sel + o.h - 1
IF o.sel > o.num THEN o.sel = o.num
END IF
IF kk$ = CHR$(0) + "w" THEN
o.sel = 1
END IF
IF kk$ = CHR$(0) + "u" THEN
o.sel = o.num
END IF
IF LEN(kk$) = 1 THEN
ResetKeybTimer = 0
IF timeElapsedSince(LastKeybInput) > 1 THEN fileDlgSearchTerm$ = "": ResetKeybTimer = -1
LastKeybInput = TIMER
k = ASC(UCASE$(kk$))
IF k < 32 OR k > 126 THEN
GOTO selected 'Search is not performed if kk$ isn't a printable character
END IF
fileDlgSearchTerm$ = fileDlgSearchTerm$ + UCASE$(kk$)
IF LEN(fileDlgSearchTerm$) = 2 AND LEFT$(fileDlgSearchTerm$, 1) = RIGHT$(fileDlgSearchTerm$, 1) THEN
'if the user is pressing the same letter again, we deduce the search
'is only for the initials
ResetKeybTimer = -1
fileDlgSearchTerm$ = UCASE$(kk$)
END IF
SearchPass = 1
IF NOT ResetKeybTimer THEN StartSearch = ABS(o.sel) ELSE StartSearch = ABS(o.sel) + 1
IF StartSearch < 1 OR StartSearch > n THEN StartSearch = 1
retryfind:
IF SearchPass > 2 THEN GOTO selected
FOR findMatch = StartSearch TO n
IF UCASE$(LEFT$(ListBoxITEMS(findMatch), LEN(fileDlgSearchTerm$))) = UCASE$(fileDlgSearchTerm$) THEN
o.sel = findMatch
idetxt(o.stx) = OriginalListBoxITEMS(findMatch)
GOTO selected
END IF
NEXT findMatch
'No match, try again:
StartSearch = 1
SearchPass = SearchPass + 1
GOTO retryfind
selected:
END IF
END IF
IF o.sel > 0 AND o.sel <= UBOUND(OriginalListBoxITEMS) THEN idetxt(o.stx) = OriginalListBoxITEMS(o.sel)
'hot-key focus
IF LEN(altletter$) THEN
IF o.nam THEN
x = INSTR(idetxt(o.nam), "#")
IF x THEN
IF UCASE$(MID$(idetxt(o.nam), x + 1, 1)) = altletter$ THEN focus = f
END IF
END IF
END IF
f = f + 1
END IF '2
IF t = 3 THEN 'buttons (eg. OK, Cancel)
'count buttons & check for hotkey(s)
a$ = idetxt(o.txt)
n = 1
x = 0
FOR i2 = 1 TO LEN(a$)
a2$ = MID$(a$, i2, 1)
IF a2$ = CHR$(0) THEN n = n + 1
IF x = 1 THEN
IF UCASE$(a2$) = altletter$ THEN
focus = f + n - 1
info = n
END IF
END IF
IF a2$ = "#" THEN x = 1 ELSE x = 0
NEXT
'check for mouse click on button(s)
IF mousedown THEN
IF my = o.par.y + o.y THEN
a$ = idetxt(o.txt)
n = 1
c = 0
FOR i2 = 1 TO LEN(a$)
a2$ = MID$(a$, i2, 1)
IF a2$ = CHR$(0) THEN
n = n + 1
ELSE
IF a$ <> "#" THEN c = c + 1
END IF
NEXT
w = o.w
c = c + n * 4 'add characters for bracing < > buttons
whitespace = w - c
spacing = whitespace \ (n + 1)
'f2 = o.foc + 1
'IF f2 < 1 OR f2 > n THEN
'IF o.dft THEN f2 = o.dft
'END IF
n2 = 1
a3$ = ""
'LOCATE o.par.y + o.y, o.par.x + o.x
x = o.par.x + o.x
'COLOR 0, 7
FOR i2 = 1 TO LEN(a$)
a2$ = MID$(a$, i2, 1)
IF a2$ <> CHR$(0) THEN a3$ = a3$ + a2$
IF a2$ = CHR$(0) OR i2 = LEN(a$) THEN
'PRINT SPACE$(spacing);
x = x + spacing
'IF f2 = n2 THEN COLOR 15, 7 ELSE COLOR 0, 7
'PRINT "< ";
'COLOR 0, 7: idehPRINT a3$
'IF f2 = n2 THEN COLOR 15, 7 ELSE COLOR 0, 7
'IF n2 = o.foc + 1 THEN
'o.cx = x + 2: o.cy = o.par.y + o.y
'END IF
'PRINT " >";
'COLOR 0, 7
x2 = idehlen(a3$) + 4
IF mx >= x AND mx < x + x2 THEN info = n2: focus = f + n2 - 1
x = x + x2
a3$ = ""
n2 = n2 + 1
END IF
NEXT
END IF 'my
END IF 'mousedown
IF focusoffset >= 0 AND focusoffset < n THEN
f2 = f + focusoffset
IF kk$ = CHR$(13) OR kk$ = " " THEN
info = focusoffset + 1
END IF
END IF
f = f + n
END IF '3
IF t = 4 THEN 'checkbox
IF mousedown THEN
y = o.par.y + o.y
x1 = o.par.x + o.x: x2 = x1 + 2
IF o.nam THEN
x2 = x2 + 1 + idehlen(idetxt(o.nam))
END IF
IF my = y THEN
IF mx >= x1 AND mx <= x2 THEN
focus = f
o.sel = o.sel + 1: IF o.sel > 1 THEN o.sel = 0 'toggle
END IF
END IF
END IF 'mousedown
IF focusoffset = 0 THEN
'a$ = idetxt(o.txt)
'IF LEN(kk$) = 1 THEN
'k = ASC(kk$)
'IF k = 8 AND o.v1 > 0 THEN
'a1$ = LEFT$(a$, o.v1 - 1)
'IF o.v1 <= LEN(a$) THEN a2$ = RIGHT$(a$, LEN(a$) - o.v1) ELSE a2$ = ""
'a$ = a1$ + a2$: o.v1 = o.v1 - 1
'END IF
'IF k >= 32 AND k <= 126 THEN
'IF o.v1 > 0 THEN a1$ = LEFT$(a$, o.v1) ELSE a1$ = ""
'IF o.v1 <= LEN(a$) THEN a2$ = RIGHT$(a$, LEN(a$) - o.v1) ELSE a2$ = ""
'a$ = a1$ + kk$ + a2$: o.v1 = o.v1 + 1
'END IF
'idetxt(o.txt) = a$
'END IF
'IF kk$ = CHR$(0) + "S" THEN 'DEL
'IF o.v1 > 0 THEN a1$ = LEFT$(a$, o.v1) ELSE a1$ = ""
'IF o.v1 < LEN(a$) THEN a2$ = RIGHT$(a$, LEN(a$) - o.v1 - 1) ELSE a2$ = ""
'a$ = a1$ + a2$
'idetxt(o.txt) = a$
'END IF
''cursor control
'IF kk$ = CHR$(0) + "K" THEN o.v1 = o.v1 - 1
'IF kk$ = CHR$(0) + "M" THEN o.v1 = o.v1 + 1
'IF kk$ = CHR$(0) + "G" THEN o.v1 = 0
'IF kk$ = CHR$(0) + "O" THEN o.v1 = LEN(a$)
'IF o.v1 < 0 THEN o.v1 = 0
'IF o.v1 > LEN(a$) THEN o.v1 = LEN(a$)
IF kk$ = CHR$(0) + "H" THEN o.sel = 1
IF kk$ = CHR$(0) + "P" THEN o.sel = 0
IF kk$ = " " THEN
o.sel = o.sel + 1: IF o.sel > 1 THEN o.sel = 0 'toggle
END IF
END IF 'in focus
'hot-key focus
IF LEN(altletter$) THEN
IF o.nam THEN
x = INSTR(idetxt(o.nam), "#")
IF x THEN
IF UCASE$(MID$(idetxt(o.nam), x + 1, 1)) = altletter$ THEN focus = f
END IF
END IF
END IF
f = f + 1
END IF '4
EXIT SUB
selectcheck:
IF KSHIFT AND o.issel = 0 THEN o.issel = -1: o.sx1 = o.v1
IF KSHIFT = 0 THEN o.issel = 0
RETURN
END SUB
FUNCTION idevbar (x, y, h, i2, n2)
i = i2: n = n2
'h is height in charatcers (inc. arrows)
'draw background & arrows
COLOR 0, 7
_PRINTSTRING (x, y), CHR$(24)
_PRINTSTRING (x, y + h - 1), CHR$(25)
FOR y2 = y + 1 TO y + h - 2
_PRINTSTRING (x, y2), CHR$(176)
NEXT
'draw slider
IF n < 1 THEN n = 1
IF i < 1 THEN i = 1
IF i > n THEN i = n
IF h = 2 THEN
idevbar = y 'not position for slider exists
EXIT FUNCTION
END IF
IF h = 3 THEN
idevbar = y + 1 'dummy value
'no slider
EXIT FUNCTION
END IF
IF h = 4 THEN
IF n = 1 THEN
idevbar = y + 1 'dummy value
'no slider required for 1 item
EXIT FUNCTION
ELSE
'show whichever is closer of the two positions
p! = (i - 1) / (n - 1)
IF p! < .5 THEN y2 = y + 1 ELSE y2 = y + 2
_PRINTSTRING (x, y2), CHR$(219)
idevbar = y2
EXIT FUNCTION
END IF
END IF
IF h > 4 THEN
IF n = 1 THEN
idevbar = y + h \ 4 'dummy value
'no slider required for 1 item
EXIT FUNCTION
END IF
IF i = 1 THEN
y2 = y + 1
_PRINTSTRING (x, y2), CHR$(219)
idevbar = y2
EXIT FUNCTION
END IF
IF i = n THEN
y2 = y + h - 2
_PRINTSTRING (x, y2), CHR$(219)
idevbar = y2
EXIT FUNCTION
END IF
'between i=1 and i=n
p! = (i - 1) / (n - 1)
p! = p! * (h - 4)
y2 = y + 2 + INT(p!)
_PRINTSTRING (x, y2), CHR$(219)
idevbar = y2
EXIT FUNCTION
END IF
END FUNCTION
SUB idewait
_DELAY 0.1
END SUB
FUNCTION idezchangepath$ (path$, newpath$)
idezchangepath$ = path$ 'default (for unsuccessful cases)
IF os$ = "WIN" THEN
'go back a path
IF newpath$ = ".." THEN
FOR x = LEN(path$) TO 1 STEP -1
a$ = MID$(path$, x, 1)
IF a$ = "\" THEN
idezchangepath$ = LEFT$(path$, x - 1)
EXIT FOR
END IF
NEXT
EXIT FUNCTION
END IF
'change drive
IF LEN(newpath$) = 2 AND RIGHT$(newpath$, 1) = ":" THEN
idezchangepath$ = newpath$
EXIT FUNCTION
END IF
idezchangepath$ = path$ + "\" + newpath$
EXIT FUNCTION
END IF
IF os$ = "LNX" THEN
'go back a path
IF newpath$ = ".." THEN
FOR x = LEN(path$) TO 1 STEP -1
a$ = MID$(path$, x, 1)
IF a$ = "/" THEN
idezchangepath$ = LEFT$(path$, x - 1)
IF x = 1 THEN idezchangepath$ = "/" 'root path cannot be ""
EXIT FOR
END IF
NEXT
EXIT FUNCTION
END IF
IF path$ = "/" THEN idezchangepath$ = "/" + newpath$ ELSE idezchangepath$ = path$ + "/" + newpath$
EXIT FUNCTION
END IF
END FUNCTION
FUNCTION idezfilelist$ (path$, method, mask$) 'method0=*.bas, method1=*.*, method2=custom mask
DIM sep AS STRING * 1
sep = CHR$(0)
IF os$ = "WIN" THEN
OPEN ".\internal\temp\files.txt" FOR OUTPUT AS #150: CLOSE #150
IF method = 0 THEN SHELL _HIDE "dir /b /ON /A-D " + QuotedFilename$(path$) + "\*.bas >.\internal\temp\files.txt"
IF method = 1 THEN SHELL _HIDE "dir /b /ON /A-D " + QuotedFilename$(path$) + "\*.* >.\internal\temp\files.txt"
IF method = 2 THEN SHELL _HIDE "dir /b /ON /A-D " + QuotedFilename$(path$) + "\" + QuotedFilename$(mask$) + " >.\internal\temp\files.txt"
filelist$ = ""
OPEN ".\internal\temp\files.txt" FOR INPUT AS #150
DO UNTIL EOF(150)
LINE INPUT #150, a$
IF LEN(a$) THEN 'skip blank entries
IF path$ = "internal/help" THEN a$ = LEFT$(a$, (LEN(a$) - 5) \ 2) + ".txt" 'remove spelling label
IF filelist$ = "" THEN filelist$ = a$ ELSE filelist$ = filelist$ + sep + a$
END IF
LOOP
CLOSE #150
idezfilelist$ = filelist$
EXIT FUNCTION
END IF
IF os$ = "LNX" THEN
filelist$ = ""
IF method = 0 THEN
FOR i = 1 TO 2
OPEN "./internal/temp/files.txt" FOR OUTPUT AS #150: CLOSE #150
IF i = 1 THEN SHELL _HIDE "find " + QuotedFilename$(path$) + " -maxdepth 1 -type f -name " + CHR$(34) + "*.bas" + CHR$(34) + " | sort >./internal/temp/files.txt"
IF i = 2 THEN SHELL _HIDE "find " + QuotedFilename$(path$) + " -maxdepth 1 -type f -name " + CHR$(34) + "*.BAS" + CHR$(34) + " | sort >./internal/temp/files.txt"
GOSUB AddToList
NEXT
ELSEIF method = 1 THEN
SHELL _HIDE "find " + QuotedFilename$(path$) + " -maxdepth 1 -type f -name " + CHR$(34) + "*" + CHR$(34) + " | sort >./internal/temp/files.txt"
GOSUB AddToList
ELSEIF method = 2 THEN
SHELL _HIDE "find " + QuotedFilename$(path$) + " -maxdepth 1 -type f -name " + CHR$(34) + mask$ + CHR$(34) + " | sort >./internal/temp/files.txt"
GOSUB AddToList
END IF
idezfilelist$ = filelist$
EXIT FUNCTION
AddToList:
OPEN "./internal/temp/files.txt" FOR INPUT AS #150
DO UNTIL EOF(150)
LINE INPUT #150, a$
IF LEN(a$) = 0 THEN EXIT DO
FOR x = LEN(a$) TO 1 STEP -1
a2$ = MID$(a$, x, 1)
IF a2$ = "/" THEN
a$ = RIGHT$(a$, LEN(a$) - x)
EXIT FOR
END IF
NEXT
IF path$ = "internal/help" THEN a$ = LEFT$(a$, (LEN(a$) - 5) \ 2) + ".txt" 'remove spelling label
IF filelist$ = "" THEN filelist$ = a$ ELSE filelist$ = filelist$ + sep + a$
LOOP
CLOSE #150
RETURN
END IF
END FUNCTION
FUNCTION idezgetroot$
'note: does NOT including a trailing / or \ on the right
IF os$ = "WIN" THEN
SHELL _HIDE "cd >.\internal\temp\root.txt"
OPEN ".\internal\temp\root.txt" FOR INPUT AS #150
LINE INPUT #150, a$
idezgetroot$ = a$
CLOSE #150
EXIT FUNCTION
ELSE
SHELL _HIDE "pwd >./internal/temp/root.txt"
OPEN "./internal/temp/root.txt" FOR INPUT AS #150
LINE INPUT #150, a$
idezgetroot$ = a$
CLOSE #150
EXIT FUNCTION
END IF
END FUNCTION
FUNCTION idezpathlist$ (path$)
DIM sep AS STRING * 1
sep = CHR$(0)
IF os$ = "WIN" THEN
OPEN ".\internal\temp\paths.txt" FOR OUTPUT AS #150: CLOSE #150
a$ = "": IF RIGHT$(path$, 1) = ":" THEN a$ = "\" 'use a \ after a drive letter
SHELL _HIDE "dir /b /ON /AD " + QuotedFilename$(path$ + a$) + " >.\internal\temp\paths.txt"
pathlist$ = ""
OPEN ".\internal\temp\paths.txt" FOR INPUT AS #150
DO UNTIL EOF(150)
LINE INPUT #150, a$
IF pathlist$ = "" THEN pathlist$ = a$ ELSE pathlist$ = pathlist$ + sep + a$
LOOP
CLOSE #150
'count instances of / or \
c = 0
FOR x = 1 TO LEN(path$)
b$ = MID$(path$, x, 1)
IF b$ = idepathsep$ THEN c = c + 1
NEXT
IF c >= 1 THEN
IF LEN(pathlist$) THEN pathlist$ = ".." + sep + pathlist$ ELSE pathlist$ = ".."
END IF
'add drive paths
DECLARE LIBRARY
FUNCTION logical_drives& ()
END DECLARE
d = logical_drives&
FOR i = 0 TO 25
IF RIGHT$(pathlist$, 1) <> sep AND LEN(pathlist$) > 0 THEN pathlist$ = pathlist$ + sep
IF _READBIT(d, i) THEN
pathlist$ = pathlist$ + CHR$(65 + i) + ":"
END IF
NEXT
idezpathlist$ = pathlist$
EXIT FUNCTION
END IF
IF os$ = "LNX" THEN
pathlist$ = ""
OPEN "./internal/temp/paths.txt" FOR OUTPUT AS #150: CLOSE #150
SHELL _HIDE "find " + QuotedFilename$(path$) + " -maxdepth 1 -mindepth 1 -type d >./internal/temp/paths.txt"
OPEN "./internal/temp/paths.txt" FOR INPUT AS #150
DO UNTIL EOF(150)
LINE INPUT #150, a$
IF LEN(a$) = 0 THEN EXIT DO
FOR x = LEN(a$) TO 1 STEP -1
a2$ = MID$(a$, x, 1)
IF a2$ = "/" THEN
a$ = RIGHT$(a$, LEN(a$) - x)
EXIT FOR
END IF
NEXT
IF pathlist$ = "" THEN pathlist$ = a$ ELSE pathlist$ = pathlist$ + sep + a$
LOOP
CLOSE #150
IF path$ <> "/" THEN
a$ = ".."
IF pathlist$ = "" THEN pathlist$ = a$ ELSE pathlist$ = a$ + sep + pathlist$
END IF
idezpathlist$ = pathlist$
EXIT FUNCTION
END IF
END FUNCTION
FUNCTION ideztakepath$ (f$) 'assume f$ contains a filename with an optional path
p$ = ""
FOR i = LEN(f$) TO 1 STEP -1
a$ = MID$(f$, i, 1)
IF a$ = "\" OR a$ = "/" THEN
p$ = LEFT$(f$, i - 1)
f$ = RIGHT$(f$, LEN(f$) - i)
EXIT FOR
END IF
NEXT
ideztakepath$ = p$
EXIT FUNCTION
END FUNCTION
'file f$ exists, and may contain a path
'return the FULL path (even if it was passed as a relative path)
'f$ is altered to only contain the name of the actual file
'root$ is the path to apply relative paths to
FUNCTION idezgetfilepath$ (root$, f$)
'step #1: seperate file's name from its path (if any)
p$ = ideztakepath$(f$) 'note: this is a simple seperation of the string
'step #2: if path was undefined, set it to root
IF LEN(p$) = 0 THEN p$ = root$
'step #3: if path is relative, make it relative to root$
IF _DIREXISTS(root$ + idepathsep$ + p$) THEN p$ = root$ + idepathsep$ + p$
'step #4: attempt a CHDIR to the path to (i) validate its existance
' & (ii) allow listing the paths full name
ideerror = 4 'path not found
p2$ = p$
IF os$ = "WIN" THEN
IF RIGHT$(p2$, 1) = ":" THEN p2$ = p2$ + "\" 'force change to root of drive
END IF
IF _DIREXISTS(p2$) = 0 THEN EXIT FUNCTION
CHDIR p2$
ideerror = 1
'step #5: get the path's full name (assume success)
p$ = _CWD$
'step #6: restore root path (assume success)
CHDIR ideroot$
'important: no validation of f$ necessary
idezgetfilepath$ = p$
END FUNCTION
FUNCTION idelayoutbox
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
i = 0
idepar p, 60, 9, "Code Layout"
i = i + 1
ideautolayoutid = i
o(i).typ = 4 'check box
o(i).y = 2
o(i).nam = idenewtxt("#Auto Spacing & Upper/Lowercase Formatting")
o(i).sel = ideautolayout
i = i + 1
ideautolayoutkwcapitalsid = i
o(i).typ = 4 'check box
o(i).y = 3
o(i).x = 6
o(i).nam = idenewtxt("#Keywords in CAPITALS")
o(i).sel = ideautolayoutkwcapitals
i = i + 1
ideautoindentID = i
o(i).typ = 4 'check box
o(i).y = 5
o(i).nam = idenewtxt("Auto #Indent -")
o(i).sel = ideautoindent
a2$ = str2$(ideautoindentsize)
i = i + 1
ideautoindentsizeid = i
o(i).typ = 1
o(i).x = 20
o(i).y = 5
o(i).nam = idenewtxt("#Spacing")
o(i).txt = idenewtxt(a2$)
o(i).v1 = LEN(a2$)
i = i + 1
ideindentsubsid = i
o(i).typ = 4
o(i).x = 6
o(i).y = 7
o(i).nam = idenewtxt("Indent SUBs and #FUNCTIONs")
o(i).sel = ideindentsubs
i = i + 1
buttonsid = i
o(i).typ = 3
o(i).y = 9
o(i).txt = idenewtxt("#OK" + sep + "#Cancel")
o(i).dft = 1
'-------- 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 --------
'-------- 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 --------
'specific post controls
IF focus <> PrevFocus THEN
'Always start with TextBox values selected upon getting focus
PrevFocus = focus
IF o(focus).typ = 1 THEN
o(focus).v1 = LEN(idetxt(o(focus).txt))
IF o(focus).v1 > 0 THEN o(focus).issel = -1
o(focus).sx1 = 0
END IF
END IF
a$ = idetxt(o(ideautoindentsizeid).txt)
IF LEN(a$) > 2 THEN a$ = LEFT$(a$, 2) '2 character limit
FOR i = 1 TO LEN(a$)
a = ASC(a$, i)
IF i = 2 AND ASC(a$, 1) = 48 THEN a$ = "0": EXIT FOR
IF a < 48 OR a > 57 THEN a$ = "": EXIT FOR
NEXT
IF LEN(a$) THEN
a = VAL(a$)
IF a > 64 THEN a$ = "64"
END IF
idetxt(o(ideautoindentsizeid).txt) = a$
IF focus = ideautolayoutkwcapitalsid AND o(ideautolayoutkwcapitalsid).sel = 1 THEN
o(ideautolayoutid).sel = 1
END IF
IF focus = ideindentsubsid AND o(ideindentsubsid).sel = 1 THEN
o(ideautoindentID).sel = 1
END IF
IF o(ideautolayoutid).sel = 0 THEN o(ideautolayoutkwcapitalsid).sel = 0
IF o(ideautoindentID).sel = 0 THEN o(ideindentsubsid).sel = 0
IF K$ = CHR$(27) OR (focus = buttonsid + 1 AND info <> 0) THEN EXIT FUNCTION 'cancel
IF K$ = CHR$(13) OR (focus = buttonsid AND info <> 0) THEN 'ok
'save changes
v% = o(ideautolayoutid).sel: IF v% <> 0 THEN v% = 1 'ideautolayout
IF ideautolayout <> v% THEN ideautolayout = v%: idelayoutbox = 1
v% = o(ideautolayoutkwcapitalsid).sel: IF v% <> 0 THEN v% = 1 'ideautolayoutkwcapitals
IF ideautolayoutkwcapitals <> v% THEN ideautolayoutkwcapitals = v%: idelayoutbox = 1
v% = o(ideautoindentid).sel: IF v% <> 0 THEN v% = 1 'ideautoindent
IF ideautoindent <> v% THEN ideautoindent = v%: idelayoutbox = 1
v$ = idetxt(o(ideautoindentsizeid).txt) 'ideautoindentsize
IF v$ = "" THEN v$ = "4"
v% = VAL(v$)
IF v% < 0 OR v% > 64 THEN v% = 4
IF ideautoindentsize <> v% THEN
ideautoindentsize = v%
IF ideautoindent <> 0 THEN idelayoutbox = 1
END IF
v% = o(ideindentsubsid).sel: IF v% <> 0 THEN v% = 1 'ideindentsubs
IF ideindentsubs <> v% THEN ideindentsubs = v%: idelayoutbox = 1
IF ideautolayout THEN
WriteConfigSetting displaySettingsSection$, "IDE_AutoFormat", "True"
ELSE
WriteConfigSetting displaySettingsSection$, "IDE_AutoFormat", "False"
END IF
IF ideautolayoutkwcapitals THEN
WriteConfigSetting displaySettingsSection$, "IDE_KeywordCapital", "True"
ELSE
WriteConfigSetting displaySettingsSection$, "IDE_KeywordCapital", "False"
END IF
IF ideautoindent THEN
WriteConfigSetting displaySettingsSection$, "IDE_AutoIndent", "True"
ELSE
WriteConfigSetting displaySettingsSection$, "IDE_AutoIndent", "False"
END IF
WriteConfigSetting displaySettingsSection$, "IDE_IndentSize", STR$(ideautoindentsize)
IF ideindentsubs THEN
WriteConfigSetting displaySettingsSection$, "IDE_IndentSUBs", "True"
ELSE
WriteConfigSetting displaySettingsSection$, "IDE_IndentSUBs", "False"
END IF
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
FUNCTION idebackupbox
a2$ = str2$(idebackupsize)
v$ = ideinputbox$("Backup/Undo", "#Undo buffer limit (10-2000MB)", a2$, "0123456789", 50, 4, 0)
IF v$ = "" THEN EXIT FUNCTION
'save changes
v& = VAL(v$)
IF v& < 10 THEN v& = 10
IF v& > 2000 THEN v& = 2000
IF v& < idebackupsize THEN
OPEN tmpdir$ + "undo2.bin" FOR OUTPUT AS #151: CLOSE #151
ideundobase = 0
ideundopos = 0
END IF
idebackupsize = v&
WriteConfigSetting generalSettingsSection$, "BackupSize", STR$(v&) + " 'in MB"
idebackupbox = 1
END FUNCTION
SUB idegotobox
IF idegotobox_LastLineNum > 0 THEN a2$ = str2$(idegotobox_LastLineNum) ELSE a2$ = ""
v$ = ideinputbox$("Go To Line", "#Line", a2$, "0123456789", 30, 8, 0)
IF v$ = "" THEN EXIT SUB
v& = VAL(v$)
IF v& < 1 THEN v& = 1
IF v& > iden THEN v& = iden
idegotobox_LastLineNum = v&
AddQuickNavHistory
idecy = v&
idecentercurrentline
ideselect = 0
END SUB
SUB ideSetTCPPortBox
a2$ = str2$(idebaseTcpPort)
v$ = ideinputbox$("Base TCP/IP Port Number", "#Port number for $DEBUG mode", a2$, "0123456789", 45, 5, 0)
IF v$ = "" THEN EXIT SUB
idebaseTcpPort = VAL(v$)
IF idebaseTcpPort = 0 THEN idebaseTcpPort = 9000
WriteConfigSetting debugSettingsSection$, "BaseTCPPort", str2$(idebaseTcpPort)
END SUB
FUNCTION idegetlinenumberbox(title$, initialValue&)
a2$ = str2$(initialValue&)
IF a2$ = "0" THEN a2$ = ""
v$ = ideinputbox$(title$, "#Line", a2$, "0123456789", 30, 8, 0)
IF v$ = "" THEN EXIT FUNCTION
v& = VAL(v$)
IF v& < 1 THEN v& = 1
IF v& > iden THEN v& = iden
idegetlinenumberbox = v&
END FUNCTION
FUNCTION ideadvancedbox
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
DIM Direct_Text$(100)
i = 0
i = i + 1
o(i).typ = 3 '
'o(i).y = y
o(i).txt = idenewtxt("#OK" + sep + "#Cancel")
o(i).dft = 1
y = 2 '2nd blank line
i = i + 1
o(i).typ = 4 'check box --- focus=3
o(i).y = y
o(i).nam = idenewtxt("Embed C++ debug information into executable")
o(i).sel = idedebuginfo
y = y + 1: Direct_Text$(y) = " " + CHR$(254) + " This setting is not required for $DEBUG mode"
y = y + 1: Direct_Text$(y) = " " + CHR$(254) + " Use it to investigate crashes/freezes at C++ (not QB64) code level"
y = y + 1: Direct_Text$(y) = " " + CHR$(254) + " Use internal/temp/debug batch file to debug your executable"
y = y + 1: Direct_Text$(y) = " " + CHR$(254) + " Increases executable size"
y = y + 1: Direct_Text$(y) = " " + CHR$(254) + " Makes public the names of variables in your program's code"
y = y + 1: Direct_Text$(y) = " " + CHR$(254) + " QB64 libraries will be purged then rebuilt"
y = y + 1: Direct_Text$(y) = " " + CHR$(254) + " This setting also affects command line compilation"
y = y + 2
o(1).y = y 'close button
'-------- end of init --------
idepar p, 75, y, "Advanced Options"
'-------- 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 --------
FOR y = 1 TO 100
IF LEN(Direct_Text$(y)) THEN
COLOR 0, 7: _PRINTSTRING (p.x + 1, p.y + y), Direct_Text$(y)
END IF
NEXT
'-------- 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 --------
'specific post controls
IF K$ = CHR$(27) OR (focus = 2 AND info <> 0) THEN EXIT FUNCTION
IF K$ = CHR$(13) OR (focus = 1 AND info <> 0) THEN 'close
'save changes
'update idedebuginfo?
v% = o(2).sel: IF v% <> 0 THEN v% = 1
IF v% <> idedebuginfo THEN
idedebuginfo = v%
IF idedebuginfo THEN
WriteConfigSetting generalSettingsSection$, "DebugInfo", "True" + DebugInfoIniWarning$
ELSE
WriteConfigSetting generalSettingsSection$, "DebugInfo", "False" + DebugInfoIniWarning$
END IF
Include_GDB_Debugging_Info = idedebuginfo
purgeprecompiledcontent
idechangemade = 1 'force recompilation
startPausedPending = 0
END IF
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
ideadvancedbox = 0
END FUNCTION
FUNCTION IdeMessageBox (titleStr$, messageStr$, buttons$)
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
messagestr$ = StrReplace$(messagestr$, "\n", CHR$(10))
MessageLines = 1
DIM FullMessage$(1 TO 8)
PrevScan = 1
DO
NextScan = INSTR(NextScan + 1, messagestr$, CHR$(10))
IF NextScan > 0 THEN
FullMessage$(MessageLines) = MID$(messagestr$, PrevScan, NextScan - PrevScan)
tw = LEN(FullMessage$(MessageLines)) + 2
IF tw > w THEN w = tw
PrevScan = NextScan + 1
MessageLines = MessageLines + 1
IF MessageLines > UBOUND(FullMessage$) THEN EXIT DO
ELSE
FullMessage$(MessageLines) = MID$(messagestr$, PrevScan)
tw = LEN(FullMessage$(MessageLines)) + 2
IF tw > w THEN w = tw
EXIT DO
END IF
LOOP
IF buttons$ = "" THEN buttons$ = "#OK"
totalButtons = 1
FOR i = 1 TO LEN(buttons$)
IF ASC(buttons$, i) = 59 THEN totalButtons = totalButtons + 1
NEXT
buttonsLen = LEN(buttons$) + totalButtons * 6
i = 0
w2 = LEN(titlestr$) + 4
IF w < w2 THEN w = w2
IF w < buttonsLen THEN w = buttonsLen
IF w > idewx - 4 THEN w = idewx - 4
idepar p, w, 4 + MessageLines, titlestr$
i = i + 1
o(i).typ = 3
o(i).y = 4 + MessageLines
o(i).txt = idenewtxt(StrReplace$(buttons$, ";", sep))
o(i).dft = 1
'-------- 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
COLOR 0, 7: _PRINTSTRING (p.x, p.y + p.h - 1), CHR$(195) + STRING$(p.w, 196) + CHR$(180)
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
FOR i = 1 TO MessageLines
IF LEN(FullMessage$(i)) > p.w - 2 THEN
FullMessage$(i) = LEFT$(FullMessage$(i), p.w - 5) + STRING$(3, 250)
END IF
_PRINTSTRING (p.x + (w \ 2 - LEN(FullMessage$(i)) \ 2) + 1, p.y + 1 + i), FullMessage$(i)
NEXT i
'-------- 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 UCASE$(K$) >= "A" AND UCASE$(K$) <= "Z" THEN altletter$ = UCASE$(K$)
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 --------
'specific post controls
IF K$ = CHR$(27) THEN EXIT FUNCTION
IF K$ = CHR$(13) OR (info <> 0) THEN
idemessagebox = focus
ClearMouse
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
FUNCTION ideyesnobox$ (titlestr$, messagestr$) 'returns "Y" or "N"
result = idemessagebox(titlestr$, messagestr$, "#Yes;#No")
IF result = 1 THEN ideyesnobox$ = "Y" ELSE ideyesnobox$ = "N"
END FUNCTION 'yes/no box
'SUB idecheckupdates
' FOR i = 1 TO 3
' SELECT CASE i
' CASE 1
' remoteFile$ = "www.qb64.org/getver.php"
' lookFor$ = "Version$ = "
' m$ = "Connecting to qb64.org...\n" + STRING$(10, 219) + STRING$(20, 176) + "\n"
' m$ = m$ + "Checking stable version (1/3)"
' temp$ = ideactivitybox$("setup", "Check for Newer Version", m$, "#Cancel", "")
' CASE 2
' remoteFile$ = "www.qb64.org/getdevver.php"
' lookFor$ = "Version$ = "
' m$ = "Connecting to qb64.org...\n" + STRING$(20, 219) + STRING$(10, 176) + "\n"
' m$ = m$ + "Checking development version (2/3)"
' temp$ = ideactivitybox$("setup", "Check for Newer Version", m$, "#Cancel", "")
' CASE 3
' remoteFile$ = "www.qb64.org/devbuilds2.php"
' lookFor$ = "document.getElementById('gitlink').innerHTML = "
' m$ = "Connecting to qb64.org...\n" + STRING$(30, 219) + "\n"
' m$ = m$ + "Checking development build (3/3)"
' temp$ = ideactivitybox$("setup", "Check for Newer Version", m$, "#Cancel", "")
' END SELECT
' DO
' temp$ = ideactivitybox$("update", "", "", "", "")
' IF LEN(temp$) THEN
' 'either ESC or click means "cancel" for this dialog in particular
' Result$ = Download$("", "", "", 0)
' EXIT SUB
' END IF
' Result$ = Download$(remoteFile$, contents$, lookFor$, 30)
' SELECT CASE CVI(LEFT$(Result$, 2))
' CASE 1 'Success
' found = CVL(MID$(Result$, 3, 4))
' SELECT CASE i
' CASE 1
' remoteVersion$ = MID$(contents$, found + LEN(lookFor$) + 1)
' remoteVersion$ = LEFT$(remoteVersion$, INSTR(remoteVersion$, CHR$(34)) - 1)
' CASE 2
' remoteDevVersion$ = MID$(contents$, found + LEN(lookFor$) + 1)
' remoteDevVersion$ = LEFT$(remoteDevVersion$, INSTR(remoteDevVersion$, CHR$(34)) - 1)
' CASE 3
' remoteDevBuild$ = MID$(contents$, found + LEN(lookFor$) + 1)
' remoteDevBuild$ = LEFT$(remoteDevBuild$, INSTR(remoteDevBuild$, CHR$(34)) - 1)
' END SELECT
' EXIT DO
' CASE 2, 3 'Can't reach server; Timeout
' EXIT DO
' END SELECT
' _LIMIT 100
' LOOP
' Result$ = Download$("", "", "", 0)
' NEXT
' m$ = "Current version: " + Version$ + " " + DevChannel$
' IF LEN(AutoBuildMsg$) THEN m$ = m$ + ", " + AutoBuildMsg$
' m$ = m$ + ".\n"
' DIM button$(1 TO 3)
' button$(3) = "#Close"
' IF LEN(remoteVersion$) THEN
' button$(1) = "Get #Stable Release"
' IF INSTR(remoteVersion$, "Cannot") = 0 THEN
' IF remoteVersion$ > Version$ THEN
' 'higher version number in the stable release is newer than current version
' 'regardless of this being a dev build
' m$ = m$ + "\n- A new stable version is available: v" + remoteVersion$ + ";"
' ELSE
' IF INSTR(DevChannel$, "Development") = 0 THEN
' 'if remoteVersion$ is not higher than current and this is not
' 'a dev build, we're all good.
' m$ = m$ + "\n- You have the latest stable version: v" + Version$ + ";"
' button$(1) = "#OK"
' ELSE
' IF remoteVersion$ = Version$ THEN
' 'if this is a dev build and version numbers match, that probably means
' 'a stable version based on this dev build was released
' m$ = m$ + "\n- A new stable version is available: v" + remoteVersion$ + ";"
' ELSE
' 'if remoteVersion$ is not higher than current and this is not
' 'a dev build, we're all good.
' m$ = m$ + "\n- No new stable version available;"
' button$(1) = "#OK"
' END IF
' END IF
' END IF
' END IF
' ELSE
' m$ = m$ + "\n- Failed to check for updates. Try again later."
' button$(1) = "#OK"
' END IF
' IF LEN(remoteDevVersion$) THEN
' button$(2) = "Get #Dev Build"
' IF INSTR(remoteDevVersion$, "error: ") = 0 THEN
' IF INSTR(DevChannel$, "Development") = 0 THEN
' 'if this is not a dev build, it'll be offered
' m$ = m$ + "\n- Development build available: v" + remoteDevVersion$
' IF LEN(remoteDevBuild$) THEN m$ = m$ + ", " + remoteDevBuild$
' m$ = m$ + ";"
' ELSE
' IF remoteDevVersion$ >= Version$ THEN
' 'this is a dev build and remote version is same or higher
' m$ = m$ + "\n- Latest dev build available: v" + remoteDevVersion$
' IF LEN(remoteDevBuild$) THEN m$ = m$ + ", " + remoteDevBuild$
' m$ = m$ + ";"
' END IF
' END IF
' END IF
' ELSE
' m$ = m$ + "\n- Failed to check for dev builds. Try again later."
' button$(2) = "#Close"
' IF button$(1) = "#OK" THEN button$(2) = ""
' button$(3) = ""
' END IF
' buttons$ = ""
' FOR i = 1 TO 3
' IF LEN(button$(i)) THEN
' IF LEN(buttons$) THEN buttons$ = buttons$ + ";"
' buttons$ = buttons$ + button$(i)
' END IF
' NEXT
' result = idemessagebox("Check for Newer Version", m$, buttons$)
' IF result = 0 THEN EXIT SUB
' url$ = ""
' SELECT CASE button$(result)
' CASE "Get #Dev Build"
' url$ = "https://www.qb64.org/portal/development-build/"
' CASE "Get #Stable Release"
' url$ = "https://github.com/QB64Team/qb64/releases/latest"
' END SELECT
' IF LEN(url$) = 0 THEN EXIT SUB
' IF INSTR(_OS$, "WIN") THEN
' SHELL _HIDE _DONTWAIT "start " + url$
' ELSEIF INSTR(_OS$, "MAC") THEN
' SHELL _HIDE _DONTWAIT "open " + url$
' ELSE
' SHELL _HIDE _DONTWAIT "xdg-open " + url$
' END IF
'END SUB
FUNCTION ideactivitybox$ (action$, titlestr$, messagestr$, buttons$) STATIC
SELECT CASE LCASE$(action$)
CASE "setup"
'-------- generic dialog box header --------
PCOPY 0, 2
PCOPY 0, 1
SCREEN , , 1, 0
focus = 1
REDIM p AS idedbptype
REDIM o(1 TO 100) AS idedbotype
REDIM sep AS STRING * 1
sep = CHR$(0)
'-------- end of generic dialog box header --------
'-------- init --------
messagestr$ = StrReplace$(messagestr$, "\n", CHR$(10))
MessageLines = 1
REDIM FullMessage$(1 TO 8)
PrevScan = 1
DO
NextScan = INSTR(NextScan + 1, messagestr$, CHR$(10))
IF NextScan > 0 THEN
FullMessage$(MessageLines) = MID$(messagestr$, PrevScan, NextScan - PrevScan)
tw = LEN(FullMessage$(MessageLines)) + 2
IF tw > w THEN w = tw
PrevScan = NextScan + 1
MessageLines = MessageLines + 1
IF MessageLines > UBOUND(FullMessage$) THEN EXIT DO
ELSE
FullMessage$(MessageLines) = MID$(messagestr$, PrevScan)
tw = LEN(FullMessage$(MessageLines)) + 2
IF tw > w THEN w = tw
EXIT DO
END IF
LOOP
IF buttons$ = "" THEN buttons$ = "#OK"
totalButtons = 1
FOR i = 1 TO LEN(buttons$)
IF ASC(buttons$, i) = 59 THEN totalButtons = totalButtons + 1
NEXT
buttonsLen = LEN(buttons$) + totalButtons * 6
i = 0
w2 = LEN(titlestr$) + 4
IF w < w2 THEN w = w2
IF w < buttonsLen THEN w = buttonsLen
IF w > idewx - 4 THEN w = idewx - 4
idepar p, w, 3 + MessageLines, titlestr$
i = i + 1
o(i).typ = 3
o(i).y = 3 + MessageLines
o(i).txt = idenewtxt(StrReplace$(buttons$, ";", sep))
o(i).dft = 1
'-------- end of init --------
'-------- generic init --------
FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects
'-------- end of generic init --------
CASE "update"
'-------- 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
FOR i = 1 TO MessageLines
IF LEN(FullMessage$(i)) > p.w - 2 THEN
FullMessage$(i) = LEFT$(FullMessage$(i), p.w - 5) + STRING$(3, 250)
END IF
_PRINTSTRING (p.x + (w \ 2 - LEN(FullMessage$(i)) \ 2) + 1, p.y + 1 + i), FullMessage$(i)
NEXT i
'-------- 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
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
IF change THEN
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 UCASE$(K$) >= "A" AND UCASE$(K$) <= "Z" THEN altletter$ = UCASE$(K$)
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 --------
'specific post controls
IF K$ = CHR$(27) THEN ideactivitybox$ = MKI$(0)
IF K$ = CHR$(13) OR (info <> 0) THEN
ideactivitybox$ = MKI$(1) + MKL$(focus)
ClearMouse
END IF
'end of custom controls
mousedown = 0
mouseup = 0
END IF
END SELECT
END FUNCTION
FUNCTION idedisplaybox
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
i = 0
'note: manually set window position in case display is set too large by accident
p.w = 60
p.h = 18
p.x = (80 \ 2) - p.w \ 2
p.y = (25 \ 2) - p.h \ 2
p.nam = idenewtxt("Display")
a2$ = str2$(idewx)
i = i + 1
PrevFocus = 1
o(i).typ = 1
o(i).x = 3
o(i).y = 2
o(i).w = 10
o(i).nam = idenewtxt("Window #width")
o(i).txt = idenewtxt(a2$)
o(i).v1 = LEN(a2$)
IF o(i).v1 > 0 THEN
o(i).issel = -1
o(i).sx1 = 0
END IF
a2$ = str2$(idewy + idesubwindow)
i = i + 1
o(i).typ = 1
o(i).x = 2
o(i).y = 5
o(i).w = 10
o(i).nam = idenewtxt("Window #height")
o(i).txt = idenewtxt(a2$)
o(i).v1 = LEN(a2$)
i = i + 1
o(i).typ = 4 'check box
o(i).y = 7
IF INSTR(_OS$, "WIN") > 0 OR INSTR(_OS$, "MAC") > 0 THEN
o(i).nam = idenewtxt("#Remember position + size")
ELSE
o(i).nam = idenewtxt("#Remember size")
END IF
IF IDE_AutoPosition THEN o(i).sel = 1
i = i + 1
tmpNormalCursorStart = IDENormalCursorStart
o(i).typ = 1
o(i).x = 33
o(i).y = 2
o(i).nam = idenewtxt("Cursor #start")
o(i).txt = idenewtxt(str2$(IDENormalCursorStart))
o(i).v1 = LEN(a2$)
i = i + 1
tmpNormalCursorEnd = IDENormalCursorEnd
o(i).typ = 1
o(i).x = 35
o(i).y = 5
o(i).nam = idenewtxt("Cursor #end")
o(i).txt = idenewtxt(str2$(IDENormalCursorEnd))
o(i).v1 = LEN(a2$)
i = i + 1
o(i).typ = 4 'check box
o(i).y = 9
o(i).nam = idenewtxt("#Use _FONT 8")
o(i).sel = IDE_UseFont8
prevFont8Setting = o(i).sel
i = i + 1
o(i).typ = 4 'check box
o(i).y = 10
o(i).nam = idenewtxt("Use monospace #TTF font:")
o(i).sel = idecustomfont
prevCustomFontSetting = o(i).sel
a2$ = idecustomfontfile$
prevFontFile$ = a2$
i = i + 1
o(i).typ = 1
o(i).x = 10
o(i).y = 12
o(i).nam = idenewtxt("#Font file")
o(i).txt = idenewtxt(a2$)
o(i).v1 = LEN(a2$)
a2$ = str2$(idecustomfontheight)
prevFontSize$ = a2$
i = i + 1
o(i).typ = 1
o(i).x = 10
o(i).y = 15
o(i).nam = idenewtxt("Font size in #pixels")
o(i).txt = idenewtxt(a2$)
o(i).v1 = LEN(a2$)
i = i + 1
o(i).typ = 3
o(i).y = p.h
o(i).txt = idenewtxt("#OK" + sep + "#Cancel")
o(i).dft = 1
'-------- 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 --------
LOCATE , , , tmpNormalCursorStart, tmpNormalCursorEnd
'-------- 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 --------
'specific post controls
IF focus <> PrevFocus THEN
'Always start with TextBox values selected upon getting focus
PrevFocus = focus
IF o(focus).typ = 1 THEN
o(focus).v1 = LEN(idetxt(o(focus).txt))
IF o(focus).v1 > 0 THEN o(focus).issel = -1
o(focus).sx1 = 0
END IF
END IF
'width
a$ = idetxt(o(1).txt)
IF LEN(a$) > 3 THEN a$ = LEFT$(a$, 3) '3 character limit
FOR i = 1 TO LEN(a$)
a = ASC(a$, i)
IF a < 48 OR a > 57 THEN a$ = "": EXIT FOR
IF i = 2 AND ASC(a$, 1) = 48 THEN a$ = "0": EXIT FOR
NEXT
IF focus <> 1 THEN
IF LEN(a$) THEN a = VAL(a$) ELSE a = 0
IF a < 80 THEN a$ = "80"
END IF
idetxt(o(1).txt) = a$
'height
a$ = idetxt(o(2).txt)
IF LEN(a$) > 3 THEN a$ = LEFT$(a$, 3) '3 character limit
FOR i = 1 TO LEN(a$)
a = ASC(a$, i)
IF a < 48 OR a > 57 THEN a$ = "": EXIT FOR
IF i = 2 AND ASC(a$, 1) = 48 THEN a$ = "0": EXIT FOR
NEXT
IF focus <> 2 THEN
IF LEN(a$) THEN a = VAL(a$) ELSE a = 0
IF a < 25 THEN a$ = "25"
END IF
idetxt(o(2).txt) = a$
'cursor start
a$ = idetxt(o(4).txt)
IF LEN(a$) > 2 THEN a$ = LEFT$(a$, 2) '2 character limit
FOR i = 1 TO LEN(a$)
a = ASC(a$, i)
IF a < 48 OR a > 57 THEN a$ = "": EXIT FOR
IF i = 2 AND ASC(a$, 1) = 48 THEN a$ = "0": EXIT FOR
NEXT
IF LEN(a$) THEN a = VAL(a$) ELSE a = 0
IF focus <> 4 THEN
IF a < 0 THEN a$ = "0"
IF a > 31 THEN a$ = "31"
tmpNormalCursorStart = VAL(a$)
ELSE
IF a < 0 THEN a = 0
IF a > 31 THEN a = 31
tmpNormalCursorStart = a
END IF
idetxt(o(4).txt) = a$
'cursor end
a$ = idetxt(o(5).txt)
IF LEN(a$) > 2 THEN a$ = LEFT$(a$, 2) '2 character limit
FOR i = 1 TO LEN(a$)
a = ASC(a$, i)
IF a < 48 OR a > 57 THEN a$ = "": EXIT FOR
IF i = 2 AND ASC(a$, 1) = 48 THEN a$ = "0": EXIT FOR
NEXT
IF LEN(a$) THEN a = VAL(a$) ELSE a = 0
IF focus <> 5 THEN
IF a < 0 THEN a$ = "0"
IF a > 31 THEN a$ = "31"
tmpNormalCursorEnd = VAL(a$)
ELSE
IF a < 0 THEN a = 0
IF a > 31 THEN a = 31
tmpNormalCursorEnd = a
END IF
idetxt(o(5).txt) = a$
IF prevFont8Setting <> o(6).sel THEN
prevFont8Setting = o(6).sel
IF o(6).sel THEN o(7).sel = 0: prevCustomFontSetting = 0
END IF
IF prevCustomFontSetting <> o(7).sel THEN
prevCustomFontSetting = o(7).sel
IF o(7).sel THEN o(6).sel = 0: prevFont8Setting = 0
END IF
a$ = idetxt(o(8).txt)
IF LEN(a$) > 1024 THEN a$ = LEFT$(a$, 1024)
idetxt(o(8).txt) = a$
IF a$ <> prevFontFile$ THEN
prevFontFile$ = a$
IF o(7).sel = 0 THEN
o(6).sel = 0: prevFont8Setting = 0
o(7).sel = 1: prevCustomFontSetting = 1
END IF
END IF
a$ = idetxt(o(9).txt)
IF LEN(a$) > 2 THEN a$ = LEFT$(a$, 2) '2 character limit
FOR i = 1 TO LEN(a$)
a = ASC(a$, i)
IF a < 48 OR a > 57 THEN a$ = "": EXIT FOR
IF i = 2 AND ASC(a$, 1) = 48 THEN a$ = "0": EXIT FOR
NEXT
IF focus <> 9 THEN
IF LEN(a$) THEN a = VAL(a$) ELSE a = 0
IF a < 8 THEN a$ = "8"
END IF
idetxt(o(9).txt) = a$
IF a$ <> prevFontSize$ THEN
prevFontSize$ = a$
IF o(7).sel = 0 THEN
o(6).sel = 0: prevFont8Setting = 0
o(7).sel = 1: prevCustomFontSetting = 1
END IF
END IF
IF K$ = CHR$(27) OR (focus = 11 AND info <> 0) THEN EXIT FUNCTION
IF K$ = CHR$(13) OR (focus = 10 AND info <> 0) THEN
x = 0 'change to custom font
'get size in v%
v$ = idetxt(o(9).txt): IF v$ = "" THEN v$ = "0"
v% = VAL(v$)
IF v% < 8 THEN v% = 8
IF v% > 99 THEN v% = 99
IF v% <> idecustomfontheight THEN x = 1
IF o(6).sel <> IDE_UseFont8 THEN
IDE_UseFont8 = o(6).sel
idedisplaybox = 1
END IF
IF o(7).sel <> idecustomfont THEN
IF o(7).sel = 0 THEN
IF IDE_UseFont8 THEN _FONT 8 ELSE _FONT 16
_FREEFONT idecustomfonthandle
ELSE
x = 1
END IF
END IF
v$ = idetxt(o(8).txt): IF v$ <> idecustomfontfile$ THEN x = 1
IF o(7).sel = 1 AND x = 1 THEN
oldhandle = idecustomfonthandle
idecustomfonthandle = _LOADFONT(v$, v%, "MONOSPACE")
IF idecustomfonthandle = -1 THEN
'failed! - revert to default settings
o(7).sel = 0: idetxt(o(8).txt) = "C:\Windows\Fonts\lucon.ttf": idetxt(o(9).txt) = "21": IF IDE_UseFont8 THEN _FONT 8 ELSE _FONT 16
ELSE
_FONT idecustomfonthandle
END IF
IF idecustomfont = 1 THEN _FREEFONT oldhandle
END IF
'save changes
v$ = idetxt(o(1).txt): IF v$ = "" THEN v$ = "0"
v% = VAL(v$)
IF v% < 80 THEN v% = 80
IF v% > 999 THEN v% = 999
IF v% <> idewx THEN idedisplaybox = 1
idewx = v%
v$ = idetxt(o(2).txt): IF v$ = "" THEN v$ = "0"
v% = VAL(v$)
IF v% < 25 THEN v% = 25
IF v% > 999 THEN v% = 999
IF v% <> idewy THEN idedisplaybox = 1
idewy = v% - idesubwindow
v% = o(3).sel
IF v% <> 0 THEN v% = -1
IDE_AutoPosition = v%
v% = o(7).sel
IF v% <> 0 THEN v% = 1
idecustomfont = v%
v$ = idetxt(o(8).txt)
IF LEN(v$) > 1024 THEN v$ = LEFT$(v$, 1024)
idecustomfontfile$ = v$
v$ = v$ + SPACE$(1024 - LEN(v$))
v$ = idetxt(o(9).txt): IF v$ = "" THEN v$ = "0"
v% = VAL(v$)
IF v% < 8 THEN v% = 8
IF v% > 99 THEN v% = 99
idecustomfontheight = v%
WriteConfigSetting windowSettingsSection$, "IDE_Width", STR$(idewx)
WriteConfigSetting windowSettingsSection$, "IDE_Height", STR$(idewy)
IF idecustomfont THEN
WriteConfigSetting displaySettingsSection$, "IDE_CustomFont", "True"
ELSE
WriteConfigSetting displaySettingsSection$, "IDE_CustomFont", "False"
END IF
IF IDE_UseFont8 THEN
WriteConfigSetting displaySettingsSection$, "IDE_UseFont8", "True"
ELSE
WriteConfigSetting displaySettingsSection$, "IDE_UseFont8", "False"
END IF
IF IDE_AutoPosition THEN
WriteConfigSetting displaySettingsSection$, "IDE_AutoPosition", "True"
ELSE
WriteConfigSetting displaySettingsSection$, "IDE_AutoPosition", "False"
END IF
WriteConfigSetting displaySettingsSection$, "IDE_CustomFont$", idecustomfontfile$
WriteConfigSetting displaySettingsSection$, "IDE_CustomFontSize", STR$(idecustomfontheight)
IDENormalCursorStart = tmpNormalCursorStart
WriteConfigSetting displaySettingsSection$, "IDE_NormalCursorStart", str2$(IDENormalCursorStart)
IDENormalCursorEnd = tmpNormalCursorEnd
WriteConfigSetting displaySettingsSection$, "IDE_NormalCursorEnd", str2$(IDENormalCursorEnd)
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
FUNCTION idechoosecolorsbox
DIM bkpIDECommentColor AS _UNSIGNED LONG, bkpIDEMetaCommandColor AS _UNSIGNED LONG
DIM bkpIDEQuoteColor AS _UNSIGNED LONG, bkpIDETextColor AS _UNSIGNED LONG
DIM bkpIDEBackgroundColor AS _UNSIGNED LONG, bkpIDEKeywordColor AS _UNSIGNED LONG
DIM bkpIDEBackgroundColor2 AS _UNSIGNED LONG, bkpIDENumbersColor AS _UNSIGNED LONG
DIM bkpIDEBracketHighlightColor AS _UNSIGNED LONG, bkpIDEChromaColor AS _UNSIGNED LONG
TotalItems = 10
DIM SelectionIndicator$(1 TO TotalItems)
bkpIDECommentColor = IDECommentColor
bkpIDEMetaCommandColor = IDEMetaCommandColor
bkpIDEQuoteColor = IDEQuoteColor
bkpIDETextColor = IDETextColor
bkpIDEKeywordColor = IDEKeywordColor
bkpIDENumbersColor = IDENumbersColor
bkpIDEBackgroundColor = IDEBackgroundColor
bkpIDEBackgroundColor2 = IDEBackgroundColor2
bkpIDEBracketHighlightColor = IDEBracketHighlightColor
bkpIDEChromaColor = IDEChromaColor
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
LoadColorSchemes
_PALETTECOLOR 5, &HFF00A800, 0 'Original green may have been changed by the Help System, so 5 is now green
i = 0
idepar p, 73, 20, "IDE Colors"
l$ = CHR$(16) + "Normal Text"
l$ = l$ + sep + " Keywords"
l$ = l$ + sep + " Numbers"
l$ = l$ + sep + " Strings"
l$ = l$ + sep + " Metacommand/custom keywords"
l$ = l$ + sep + " Comments"
l$ = l$ + sep + " Background"
l$ = l$ + sep + " Current line background"
l$ = l$ + sep + " Bracket/selection highlight"
l$ = l$ + sep + " Menus and dialogs"
i = i + 1
o(i).typ = 2
o(i).y = 4
o(i).w = 30: o(i).h = 10
o(i).txt = idenewtxt(l$)
o(i).sel = 1
SelectedITEM = 1
PrevFocus = 1
o(i).nam = idenewtxt("#Item:")
a2$ = str2$(_RED32(IDETextColor))
i = i + 1
o(i).typ = 1
o(i).x = 66
o(i).y = 5
o(i).txt = idenewtxt(a2$)
o(i).v1 = LEN(a2$)
o(i).issel = -1
o(i).sx1 = 0
a2$ = str2$(_GREEN32(IDETextColor))
i = i + 1
o(i).typ = 1
o(i).x = 66
o(i).y = 8
o(i).txt = idenewtxt(a2$)
o(i).v1 = LEN(a2$)
o(i).issel = -1
o(i).sx1 = 0
a2$ = str2$(_BLUE32(IDETextColor))
i = i + 1
o(i).typ = 1
o(i).x = 66
o(i).y = 11
o(i).txt = idenewtxt(a2$)
o(i).v1 = LEN(a2$)
o(i).issel = -1
o(i).sx1 = 0
i = i + 1
o(i).typ = 4 'check box
o(i).y = 16
o(i).nam = idenewtxt("#Highlight brackets")
IF brackethighlight THEN o(i).sel = 1
i = i + 1
o(i).typ = 4 'check box
o(i).y = 17
o(i).nam = idenewtxt("#Multi-highlight (selection)")
IF multihighlight THEN o(i).sel = 1
i = i + 1
o(i).typ = 4 'check box
o(i).y = 18
o(i).nam = idenewtxt("Highlight #keywords and numbers")
IF keywordHighlight THEN o(i).sel = 1
i = i + 1
o(i).typ = 3
o(i).y = 20
o(i).txt = idenewtxt("#OK" + sep + "Restore #Defaults" + sep + "#Cancel")
o(i).dft = 1
result = ReadConfigSetting(colorSettingsSection$, "SchemeID", value$)
SchemeID = VAL(value$)
IF SchemeID > TotalColorSchemes THEN SchemeID = 0
IF SchemeID = 0 THEN
a2$ = "User-defined"
ELSE
'Validate this scheme first
FoundPipe = INSTR(ColorSchemes$(SchemeID), "|")
IF FoundPipe > 0 THEN
IF LEN(MID$(ColorSchemes$(SchemeID), FoundPipe + 1)) = 90 THEN
a2$ = LEFT$(ColorSchemes$(SchemeID), FoundPipe - 1)
ELSE
SchemeID = 0
a2$ = "User-defined"
END IF
ELSE
SchemeID = 0
a2$ = "User-defined"
END IF
END IF
i = i + 1
o(i).typ = 1
o(i).x = 9
o(i).y = 2
o(i).w = 38
o(i).nam = idenewtxt("#Scheme")
o(i).txt = idenewtxt(a2$)
o(i).v1 = LEN(a2$)
'-------- 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 scheme selection arrows:
LOCATE p.y + 2, p.x + 2
IF mY = p.y + 2 AND mX >= p.x + 2 AND mX <= p.x + 4 THEN COLOR 15, 0 ELSE COLOR 15, 2
IF SchemeID <= 1 THEN COLOR 7, 2
PRINT " " + CHR$(17) + " ";
IF mY = p.y + 2 AND mX >= p.x + 5 AND mX <= p.x + 7 THEN COLOR 15, 0 ELSE COLOR 15, 2
IF SchemeID = LastValidColorScheme THEN COLOR 7, 2
PRINT " " + CHR$(16) + " ";
'Color scheme Save and Erase buttons:
LOCATE p.y + 2, p.x + 60
IF mY = p.y + 2 AND mX >= p.x + 60 AND mX <= p.x + 65 THEN COLOR 15, 0 ELSE COLOR 15, 2
IF SchemeID > 0 AND SchemeID <= PresetColorSchemes THEN COLOR 7, 2 'Disable if preset scheme
PRINT " Save ";
IF mY = p.y + 2 AND mX >= p.x + 66 AND mX <= p.x + 72 THEN COLOR 15, 0 ELSE COLOR 15, 2
IF SchemeID <= PresetColorSchemes THEN COLOR 7, 2 'Disable if preset scheme or unsaved user-defined
PRINT " Erase ";
COLOR , 7
_PALETTECOLOR 1, IDEBackgroundColor, 0
_PALETTECOLOR 2, _RGB32(84, 84, 84), 0 'dark gray - help system and interface details
_PALETTECOLOR 6, IDEBackgroundColor2, 0
_PALETTECOLOR 7, IDEChromaColor, 0
_PALETTECOLOR 8, IDENumbersColor, 0
_PALETTECOLOR 10, IDEMetaCommandColor, 0
_PALETTECOLOR 11, IDECommentColor, 0
_PALETTECOLOR 12, IDEKeywordColor, 0
_PALETTECOLOR 13, IDETextColor, 0
_PALETTECOLOR 14, IDEQuoteColor, 0
COLOR 0: LOCATE p.y + 5, p.x + 36: PRINT "R: ";
COLOR 4: PRINT STRING$(26, 196);
slider$ = CHR$(197)
T = VAL(idetxt(o(2).txt)): r = ((T / 255) * 26)
IF T = 0 THEN slider$ = CHR$(195)
IF T = 255 THEN slider$ = CHR$(180)
_PRINTSTRING (p.x + 39 + r, p.y + 5), slider$
COLOR 0: LOCATE p.y + 8, p.x + 36: PRINT "G: ";
COLOR 5: PRINT STRING$(26, 196);
slider$ = CHR$(197)
T = VAL(idetxt(o(3).txt)): r = ((T / 255) * 26)
IF T = 0 THEN slider$ = CHR$(195)
IF T = 255 THEN slider$ = CHR$(180)
_PRINTSTRING (p.x + 39 + r, p.y + 8), slider$
COLOR 0: LOCATE p.y + 11, p.x + 36: PRINT "B: ";
COLOR 9: PRINT STRING$(26, 196);
slider$ = CHR$(197)
T = VAL(idetxt(o(4).txt)): r = ((T / 255) * 26)
IF T = 0 THEN slider$ = CHR$(195)
IF T = 255 THEN slider$ = CHR$(180)
_PRINTSTRING (p.x + 39 + r, p.y + 11), slider$
SELECT EVERYCASE SelectedITEM
CASE 1 TO 9
COLOR 7, 1
_PRINTSTRING (p.x + 39, p.y + 13), CHR$(218) + STRING$(25, 196)
_PRINTSTRING (p.x + 39, p.y + 14), CHR$(179) + SPACE$(25)
_PRINTSTRING (p.x + 39, p.y + 15), CHR$(179) + SPACE$(25)
CASE 1: COLOR 13, 1: SampleText$ = "myVar% = " 'Normal text
CASE 2: COLOR 12, 1: SampleText$ = "CLS: PRINT" 'Keywords
CASE 3: COLOR 13, 1: SampleText$ = "myVar% = " 'Normal text
CASE 4: COLOR 14, 1: SampleText$ = SPACE$(6) + CHR$(34) + "Hello, world!" + CHR$(34) 'Strings
CASE 5: COLOR 10, 1: SampleText$ = "'$DYNAMIC" 'Metacommands
CASE 6: COLOR 11, 1: SampleText$ = "'TODO: review this block" 'Comments
CASE 7: COLOR 1, 1: SampleText$ = "" 'Background
CASE 8: COLOR 6, 6: SampleText$ = SPACE$(25) 'Current line background
CASE 9
COLOR 6, 6: SampleText$ = "" 'Bracket highlight
_PALETTECOLOR 6, IDEBracketHighlightColor, 0
CASE 10
COLOR 0, 7
_PRINTSTRING (p.x + 39, p.y + 13), CHR$(218) + STRING$(24, 196) + CHR$(191)
_PRINTSTRING (p.x + 39, p.y + 14), CHR$(179) + SPACE$(24) + CHR$(179)
_PRINTSTRING (p.x + 39, p.y + 15), CHR$(192) + STRING$(24, 196) + CHR$(217)
SampleText$ = " Open... Ctrl+O "
END SELECT
_PRINTSTRING (p.x + 40, p.y + 14), SampleText$
IF SelectedITEM = 1 OR SelectedITEM = 3 THEN
COLOR 8, 1
_PRINTSTRING (p.x + 49, p.y + 14), "5"
ELSEIF SelectedITEM = 2 THEN
COLOR 13, 1
_PRINTSTRING (p.x + 51, p.y + 14), "myVar%"
ELSEIF SelectedITEM = 4 THEN
COLOR 12, 1
_PRINTSTRING (p.x + 40, p.y + 14), "PRINT"
ELSEIF SelectedITEM = 5 THEN
COLOR 11, 1
_PRINTSTRING (p.x + 40, p.y + 14), "'"
ELSEIF SelectedITEM = 9 THEN
LOCATE p.y + 14, p.x + 40
COLOR 13, 1: PRINT "myVar% = ";
COLOR 12: PRINT "INT RND";
LOCATE p.y + 14, p.x + 52
COLOR 13, 6: PRINT "(";
LOCATE p.y + 14, p.x + 56
PRINT ")";
ELSEIF SelectedITEM = 10 THEN
COLOR 15, 7
_PRINTSTRING (p.x + 41, p.y + 14), "O"
END IF
'-------- 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
IF mX <> prev.mX OR mY <> prev.mY THEN change = 1: prev.mX = mX: prev.mY = mY
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 --------
'specific post controls
IF focus <> PrevFocus THEN
'Always start with RGB values AND scheme name selected upon getting focus
PrevFocus = focus
IF (focus >= 2 AND focus <= 4) OR focus = 11 THEN
IF focus = 11 THEN tfocus = 9 ELSE tfocus = focus
o(tfocus).v1 = LEN(idetxt(o(tfocus).txt))
IF o(tfocus).v1 > 0 THEN o(tfocus).issel = -1
o(tfocus).sx1 = 0
IF (tfocus >= 2 AND tfocus <= 4) THEN prevTB.value$ = idetxt(o(tfocus).txt)
END IF
ELSEIF focus = PrevFocus THEN
'Check if new values have been entered into textboxes
IF focus >= 2 AND focus <= 4 THEN
IF prevTB.value$ <> idetxt(o(focus).txt) THEN
GOSUB NewUserScheme
prevTB.value$ = idetxt(o(focus).txt)
END IF
END IF
END IF
'Save and Erase color scheme (Buttons):
IF (SchemeID = 0 OR SchemeID > PresetColorSchemes) AND mCLICK THEN
IF mY = p.y + 2 AND mX >= p.x + 60 AND mX <= p.x + 65 THEN
'Save
IF SchemeID = 0 THEN
SaveNew:
SchemeString$ = LTRIM$(RTRIM$(idetxt(o(9).txt)))
IF LEN(SchemeString$) = 0 THEN SchemeString$ = "User-defined"
'Find the next free scheme index
i = 0
DO
i = i + 1
result = ReadConfigSetting(colorSchemesSection$, "Scheme" + str2$(i) + "$", value$)
IF value$ = "" OR value$ = "0" THEN EXIT DO
LOOP
'Build scheme string
SchemeString$ = SchemeString$ + "|"
FOR j = 1 TO 10
SELECT CASE j
CASE 1: CurrentColor~& = IDETextColor
CASE 2: CurrentColor~& = IDEKeywordColor
CASE 3: CurrentColor~& = IDENumbersColor
CASE 4: CurrentColor~& = IDEQuoteColor
CASE 5: CurrentColor~& = IDEMetaCommandColor
CASE 6: CurrentColor~& = IDECommentColor
CASE 7: CurrentColor~& = IDEBackgroundColor
CASE 8: CurrentColor~& = IDEBackgroundColor2
CASE 9: CurrentColor~& = IDEBracketHighlightColor
CASE 10: CurrentColor~& = IDEChromaColor
END SELECT
r$ = str2$(_RED32(CurrentColor~&)): r$ = STRING$(3 - LEN(r$), "0") + r$
g$ = str2$(_GREEN32(CurrentColor~&)): g$ = STRING$(3 - LEN(g$), "0") + g$
b$ = str2$(_BLUE32(CurrentColor~&)): b$ = STRING$(3 - LEN(b$), "0") + b$
SchemeString$ = SchemeString$ + r$ + g$ + b$
NEXT j
'Save user scheme
WriteConfigSetting colorSchemesSection$, "Scheme" + str2$(i) + "$", SchemeString$
LoadColorSchemes
SchemeID = PresetColorSchemes + i
ChangedScheme = -1
GOTO ApplyScheme
ELSE
FoundPipe = INSTR(ColorSchemes$(SchemeID), "|")
SchemeString$ = LEFT$(ColorSchemes$(SchemeID), FoundPipe - 1)
IF SchemeString$ <> LTRIM$(RTRIM$(idetxt(o(9).txt))) THEN
'User wants to save the current SchemeID under a different name
GOTO SaveNew
END IF
i = SchemeID - PresetColorSchemes
SchemeString$ = SchemeString$ + "|"
'Build scheme string
FOR j = 1 TO 10
SELECT CASE j
CASE 1: CurrentColor~& = IDETextColor
CASE 2: CurrentColor~& = IDEKeywordColor
CASE 3: CurrentColor~& = IDENumbersColor
CASE 4: CurrentColor~& = IDEQuoteColor
CASE 5: CurrentColor~& = IDEMetaCommandColor
CASE 6: CurrentColor~& = IDECommentColor
CASE 7: CurrentColor~& = IDEBackgroundColor
CASE 8: CurrentColor~& = IDEBackgroundColor2
CASE 9: CurrentColor~& = IDEBracketHighlightColor
CASE 10: CurrentColor~& = IDEChromaColor
END SELECT
r$ = str2$(_RED32(CurrentColor~&)): r$ = STRING$(3 - LEN(r$), "0") + r$
g$ = str2$(_GREEN32(CurrentColor~&)): g$ = STRING$(3 - LEN(g$), "0") + g$
b$ = str2$(_BLUE32(CurrentColor~&)): b$ = STRING$(3 - LEN(b$), "0") + b$
SchemeString$ = SchemeString$ + r$ + g$ + b$
NEXT j
'Save user scheme
WriteConfigSetting colorSchemesSection$, "Scheme" + str2$(i) + "$", SchemeString$
LoadColorSchemes
SchemeID = PresetColorSchemes + i
ChangedScheme = -1
GOTO ApplyScheme
END IF
o(9).v1 = LEN(idetxt(o(9).txt))
o(9).issel = -1
o(9).sx1 = 0
ELSEIF mY = p.y + 2 AND mX >= p.x + 66 AND mX <= p.x + 72 THEN
'Erase
IF SchemeID > PresetColorSchemes THEN
what$ = ideyesnobox("Erase color scheme", "This cannot be undone. Erase scheme?")
K$ = ""
IF what$ = "Y" THEN
i = SchemeID - PresetColorSchemes
WriteConfigSetting colorSchemesSection$, "Scheme" + str2$(i) + "$", "0"
LoadColorSchemes
SchemeID = SchemeID - 1
ChangedScheme = -1
SchemeArrow = -1
GOTO ValidateScheme
END IF
END IF
END IF
END IF
'Scheme selection arrows:
ChangedScheme = 0
SchemeArrow = 0
IF (mCLICK AND mY = p.y + 2 AND mX >= p.x + 2 AND mX <= p.x + 4) OR _
(K$ = CHR$(0) + CHR$(75) AND (focus = 1)) THEN
SchemeArrow = -1
IF SchemeID = 0 THEN
ChangedScheme = -1
GOTO LoadDefaultScheme
ELSE
IF SchemeID > 1 THEN SchemeID = SchemeID - 1: ChangedScheme = -1
END IF
ELSEIF (mCLICK AND mY = p.y + 2 AND mX >= p.x + 5 AND mX <= p.x + 7) OR _
(K$ = CHR$(0) + CHR$(77) AND (focus = 1)) THEN
SchemeArrow = 1
IF SchemeID = 0 THEN
ChangedScheme = -1
GOTO LoadDefaultScheme
ELSE
IF SchemeID < TotalColorSchemes THEN SchemeID = SchemeID + 1: ChangedScheme = -1
END IF
END IF
IF ChangedScheme THEN
'Validate this scheme first
IF SchemeArrow = 0 THEN SchemeArrow = 1
ValidateScheme:
FoundPipe = INSTR(ColorSchemes$(SchemeID), "|")
IF FoundPipe > 0 THEN
IF LEN(MID$(ColorSchemes$(SchemeID), FoundPipe + 1)) = 90 THEN
a2$ = LEFT$(ColorSchemes$(SchemeID), FoundPipe - 1)
ELSE
SchemeID = SchemeID + SchemeArrow
IF SchemeID > TotalColorSchemes THEN SchemeID = TotalColorSchemes: SchemeArrow = -1
IF SchemeID < 1 THEN SchemeID = 1
GOTO ValidateScheme
END IF
ELSE
SchemeID = SchemeID + SchemeArrow
IF SchemeID > TotalColorSchemes THEN SchemeID = TotalColorSchemes: SchemeArrow = -1
IF SchemeID < 1 THEN SchemeID = 1
GOTO ValidateScheme
END IF
ApplyScheme:
FoundPipe = INSTR(ColorSchemes$(SchemeID), "|")
idetxt(o(9).txt) = LEFT$(ColorSchemes$(SchemeID), FoundPipe - 1)
o(9).v1 = LEN(idetxt(o(9).txt))
o(9).issel = -1
o(9).sx1 = 0
ColorData$ = RIGHT$(ColorSchemes$(SchemeID), 90)
i = 1
r$ = MID$(ColorData$, i, 3): i = i + 3: g$ = MID$(ColorData$, i, 3): i = i + 3: b$ = MID$(ColorData$, i, 3): i = i + 3
IDETextColor = _RGB32(VAL(r$), VAL(g$), VAL(b$))
r$ = MID$(ColorData$, i, 3): i = i + 3: g$ = MID$(ColorData$, i, 3): i = i + 3: b$ = MID$(ColorData$, i, 3): i = i + 3
IDEKeywordColor = _RGB32(VAL(r$), VAL(g$), VAL(b$))
r$ = MID$(ColorData$, i, 3): i = i + 3: g$ = MID$(ColorData$, i, 3): i = i + 3: b$ = MID$(ColorData$, i, 3): i = i + 3
IDENumbersColor = _RGB32(VAL(r$), VAL(g$), VAL(b$))
r$ = MID$(ColorData$, i, 3): i = i + 3: g$ = MID$(ColorData$, i, 3): i = i + 3: b$ = MID$(ColorData$, i, 3): i = i + 3
IDEQuoteColor = _RGB32(VAL(r$), VAL(g$), VAL(b$))
r$ = MID$(ColorData$, i, 3): i = i + 3: g$ = MID$(ColorData$, i, 3): i = i + 3: b$ = MID$(ColorData$, i, 3): i = i + 3
IDEMetaCommandColor = _RGB32(VAL(r$), VAL(g$), VAL(b$))
r$ = MID$(ColorData$, i, 3): i = i + 3: g$ = MID$(ColorData$, i, 3): i = i + 3: b$ = MID$(ColorData$, i, 3): i = i + 3
IDECommentColor = _RGB32(VAL(r$), VAL(g$), VAL(b$))
r$ = MID$(ColorData$, i, 3): i = i + 3: g$ = MID$(ColorData$, i, 3): i = i + 3: b$ = MID$(ColorData$, i, 3): i = i + 3
IDEBackgroundColor = _RGB32(VAL(r$), VAL(g$), VAL(b$))
r$ = MID$(ColorData$, i, 3): i = i + 3: g$ = MID$(ColorData$, i, 3): i = i + 3: b$ = MID$(ColorData$, i, 3): i = i + 3
IDEBackgroundColor2 = _RGB32(VAL(r$), VAL(g$), VAL(b$))
r$ = MID$(ColorData$, i, 3): i = i + 3: g$ = MID$(ColorData$, i, 3): i = i + 3: b$ = MID$(ColorData$, i, 3): i = i + 3
IDEBracketHighlightColor = _RGB32(VAL(r$), VAL(g$), VAL(b$))
r$ = MID$(ColorData$, i, 3): i = i + 3: g$ = MID$(ColorData$, i, 3): i = i + 3: b$ = MID$(ColorData$, i, 3): i = i + 3
IDEChromaColor = _RGB32(VAL(r$), VAL(g$), VAL(b$))
GOTO ChangeTextBoxes
END IF
IF mB AND mY = p.y + 5 AND mX >= p.x + 39 AND mX <= p.x + 39 + 26 THEN
newValue = (mX - p.x - 39) * (255 / 26)
idetxt(o(2).txt) = str2$(newValue)
IF _KEYDOWN(100305) OR _KEYDOWN(100306) THEN
idetxt(o(3).txt) = str2$(newValue)
idetxt(o(4).txt) = str2$(newValue)
END IF
focus = 2
o(focus).v1 = LEN(idetxt(o(focus).txt))
o(focus).issel = -1
o(focus).sx1 = 0
GOSUB NewUserScheme
END IF
IF mB AND mY = p.y + 8 AND mX >= p.x + 39 AND mX <= p.x + 39 + 26 THEN
newValue = (mX - p.x - 39) * (255 / 26)
idetxt(o(3).txt) = str2$(newValue)
IF _KEYDOWN(100305) OR _KEYDOWN(100306) THEN
idetxt(o(2).txt) = str2$(newValue)
idetxt(o(4).txt) = str2$(newValue)
END IF
focus = 3
o(focus).v1 = LEN(idetxt(o(focus).txt))
o(focus).issel = -1
o(focus).sx1 = 0
GOSUB NewUserScheme
END IF
IF mB AND mY = p.y + 11 AND mX >= p.x + 39 AND mX <= p.x + 39 + 26 THEN
newValue = (mX - p.x - 39) * (255 / 26)
idetxt(o(4).txt) = str2$(newValue)
IF _KEYDOWN(100305) OR _KEYDOWN(100306) THEN
idetxt(o(2).txt) = str2$(newValue)
idetxt(o(3).txt) = str2$(newValue)
END IF
focus = 4
o(focus).v1 = LEN(idetxt(o(focus).txt))
o(focus).issel = -1
o(focus).sx1 = 0
GOSUB NewUserScheme
END IF
ChangedWithKeys = 0
IF K$ = CHR$(0) + CHR$(72) AND (focus = 2 OR focus = 3 OR focus = 4) THEN 'Up
idetxt(o(focus).txt) = str2$(VAL(idetxt(o(focus).txt)) + 1)
o(focus).issel = -1: o(focus).sx1 = 0: o(focus).v1 = LEN(idetxt(o(focus).txt))
ChangedWithKeys = -1
GOSUB NewUserScheme
END IF
IF K$ = CHR$(0) + CHR$(80) AND (focus = 2 OR focus = 3 OR focus = 4) THEN 'Down
idetxt(o(focus).txt) = str2$(VAL(idetxt(o(focus).txt)) - 1)
o(focus).issel = -1: o(focus).sx1 = 0: o(focus).v1 = LEN(idetxt(o(focus).txt))
ChangedWithKeys = -1
GOSUB NewUserScheme
END IF
IF SelectedITEM <> o(1).sel AND o(1).sel > 0 THEN
SelectedITEM = o(1).sel
FOR i = 1 TO 10: SelectionIndicator$(i) = " ": NEXT i
SelectionIndicator$(SelectedITEM) = CHR$(16)
i = 0
i = i + 1: l$ = SelectionIndicator$(i) + "Normal Text"
i = i + 1: l$ = l$ + sep + SelectionIndicator$(i) + "Keywords"
i = i + 1: l$ = l$ + sep + SelectionIndicator$(i) + "Numbers"
i = i + 1: l$ = l$ + sep + SelectionIndicator$(i) + "Strings"
i = i + 1: l$ = l$ + sep + SelectionIndicator$(i) + "Metacommand/custom keywords"
i = i + 1: l$ = l$ + sep + SelectionIndicator$(i) + "Comments"
i = i + 1: l$ = l$ + sep + SelectionIndicator$(i) + "Background"
i = i + 1: l$ = l$ + sep + SelectionIndicator$(i) + "Current line background"
i = i + 1: l$ = l$ + sep + SelectionIndicator$(i) + "Bracket/selection highlight"
i = i + 1: l$ = l$ + sep + SelectionIndicator$(i) + "Menus and dialogs"
idetxt(o(1).txt) = l$
ChangeTextBoxes:
SELECT CASE SelectedITEM
CASE 1: CurrentColor~& = IDETextColor
CASE 2: CurrentColor~& = IDEKeywordColor
CASE 3: CurrentColor~& = IDENumbersColor
CASE 4: CurrentColor~& = IDEQuoteColor
CASE 5: CurrentColor~& = IDEMetaCommandColor
CASE 6: CurrentColor~& = IDECommentColor
CASE 7: CurrentColor~& = IDEBackgroundColor
CASE 8: CurrentColor~& = IDEBackgroundColor2
CASE 9: CurrentColor~& = IDEBracketHighlightColor
CASE 10: CurrentColor~& = IDEChromaColor
END SELECT
idetxt(o(2).txt) = str2$(_RED32(CurrentColor~&))
idetxt(o(3).txt) = str2$(_GREEN32(CurrentColor~&))
idetxt(o(4).txt) = str2$(_BLUE32(CurrentColor~&))
IF focus >= 2 AND focus <= 4 AND ChangedScheme THEN
prevTB.value$ = idetxt(o(focus).txt)
END IF
END IF
'Check RGB values range (0-255)
FOR checkRGB = 2 TO 4
a$ = idetxt(o(checkRGB).txt)
IF LEN(a$) > 3 THEN a$ = LEFT$(a$, 3) '3 character limit
FOR i = 1 TO LEN(a$)
a = ASC(a$, i)
IF i = 2 AND ASC(a$, 1) = 48 THEN a$ = "0": EXIT FOR
IF a < 48 OR a > 57 THEN a$ = "": EXIT FOR
NEXT
IF LEN(a$) THEN
a = VAL(a$)
IF a > 255 THEN a$ = "255"
IF a < 0 THEN a$ = "0"
ELSE
IF ChangedWithKeys = -1 THEN a$ = "0"
END IF
idetxt(o(checkRGB).txt) = a$
NEXT checkRGB
'Check for valid scheme name
FoundPipe = INSTR(idetxt(o(9).txt), "|")
IF FoundPipe > 0 THEN
a2$ = LEFT$(idetxt(o(9).txt), FoundPipe - 1) + MID$(idetxt(o(9).txt), FoundPipe + 1)
idetxt(o(9).txt) = a2$
IF o(9).v1 >= FoundPipe THEN o(9).v1 = o(9).v1 - 1
END IF
IF SchemeID > 0 THEN
FoundPipe = INSTR(ColorSchemes$(SchemeID), "|")
IF RTRIM$(LTRIM$(idetxt(o(9).txt))) <> LEFT$(ColorSchemes$(SchemeID), FoundPipe - 1) THEN
'A different scheme name is the beginning of editing a new one
SchemeID = 0
END IF
END IF
CurrentColor~& = _RGB32(VAL(idetxt(o(2).txt)), VAL(idetxt(o(3).txt)), VAL(idetxt(o(4).txt)))
SELECT CASE SelectedITEM
CASE 1: IDETextColor = CurrentColor~& 'Normal text
CASE 2: IDEKeywordColor = CurrentColor~& 'Keywords
CASE 3: IDENumbersColor = CurrentColor~& 'Numbers
CASE 4: IDEQuoteColor = CurrentColor~& 'Strings
CASE 5: IDEMetaCommandColor = CurrentColor~& 'Metacommands
CASE 6: IDECommentColor = CurrentColor~& 'Comments
CASE 7: IDEBackgroundColor = CurrentColor~& 'Background
CASE 8: IDEBackgroundColor2 = CurrentColor~& 'Current line background
CASE 9: IDEBracketHighlightColor = CurrentColor~& 'Bracket highlight
CASE 10: IDEChromaColor = CurrentColor~&
END SELECT
IF K$ = CHR$(27) OR (focus = 10 AND info <> 0) THEN
IDECommentColor = bkpIDECommentColor
IDEMetaCommandColor = bkpIDEMetaCommandColor
IDEQuoteColor = bkpIDEQuoteColor
IDETextColor = bkpIDETextColor
IDEKeywordColor = bkpIDEKeywordColor
IDENumbersColor = bkpIDENumbersColor
IDEBackgroundColor = bkpIDEBackgroundColor
IDEBackgroundColor2 = bkpIDEBackgroundColor2
IDEBracketHighlightColor = bkpIDEBracketHighlightColor
IDEChromaColor = bkpIDEChromaColor
EXIT FUNCTION
END IF
IF (focus = 9 AND info <> 0) THEN
LoadDefaultScheme:
GOSUB enableHighlighter
SchemeID = 1
FoundPipe = INSTR(ColorSchemes$(SchemeID), "|")
idetxt(o(9).txt) = LEFT$(ColorSchemes$(SchemeID), FoundPipe - 1)
info = 0
GOTO ApplyScheme
END IF
IF (focus = 8 AND info <> 0) OR _
(focus = 1 AND K$ = CHR$(13)) OR _
(focus = 2 AND K$ = CHR$(13)) OR _
(focus = 3 AND K$ = CHR$(13)) OR _
(focus = 4 AND K$ = CHR$(13)) OR _
(focus = 5 AND K$ = CHR$(13)) OR _
(focus = 6 AND K$ = CHR$(13)) OR _
(focus = 7 AND K$ = CHR$(13)) OR _
(focus = 11 AND K$ = CHR$(13)) THEN
'save changes
GOSUB enableHighlighter
WriteConfigSetting colorSettingsSection$, "SchemeID", str2$(SchemeID)
FOR i = 1 TO 10
SELECT CASE i
CASE 1: CurrentColor~& = IDETextColor: colorid$ = "TextColor"
CASE 2: CurrentColor~& = IDEKeywordColor: colorid$ = "KeywordColor"
CASE 3: CurrentColor~& = IDENumbersColor: colorid$ = "NumbersColor"
CASE 4: CurrentColor~& = IDEQuoteColor: colorid$ = "QuoteColor"
CASE 5: CurrentColor~& = IDEMetaCommandColor: colorid$ = "MetaCommandColor"
CASE 6: CurrentColor~& = IDECommentColor: colorid$ = "CommentColor"
CASE 7: CurrentColor~& = IDEBackgroundColor: colorid$ = "BackgroundColor"
CASE 8: CurrentColor~& = IDEBackgroundColor2: colorid$ = "BackgroundColor2"
CASE 9: CurrentColor~& = IDEBracketHighlightColor: colorid$ = "HighlightColor"
CASE 10: CurrentColor~& = IDEChromaColor: colorid$ = "ChromaColor"
END SELECT
WriteConfigSetting colorSettingsSection$, colorid$, rgbs$(CurrentColor~&)
NEXT i
v% = o(5).sel
IF v% <> 0 THEN v% = -1
brackethighlight = v%
IF brackethighlight THEN
WriteConfigSetting generalSettingsSection$, "BracketHighlight", "True"
ELSE
WriteConfigSetting generalSettingsSection$, "BracketHighlight", "False"
END IF
v% = o(6).sel
IF v% <> 0 THEN v% = -1
multihighlight = v%
IF multihighlight THEN
WriteConfigSetting generalSettingsSection$, "MultiHighlight", "True"
ELSE
WriteConfigSetting generalSettingsSection$, "MultiHighlight", "False"
END IF
v% = o(7).sel
IF v% <> 0 THEN v% = -1
keywordHighlight = v%
IF keywordHighlight THEN
WriteConfigSetting generalSettingsSection$, "KeywordHighlight", "True"
ELSE
WriteConfigSetting generalSettingsSection$, "KeywordHighlight", "False"
END IF
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
idechoosecolorsbox = 0
EXIT FUNCTION
NewUserScheme:
IF SchemeID > 0 AND SchemeID <= PresetColorSchemes THEN
'If one of the preset schemes is currently selected,
'create a new one. User-defined types can be freely
'edited.
SchemeID = 0
idetxt(o(9).txt) = "User-defined"
END IF
RETURN
enableHighlighter:
IF DisableSyntaxHighlighter THEN
DisableSyntaxHighlighter = 0
WriteConfigSetting generalSettingsSection$, "DisableSyntaxHighlighter", "False"
menu$(OptionsMenuID, OptionsMenuDisableSyntax) = CHR$(7) + "Syntax #Highlighter"
END IF
RETURN
END FUNCTION
FUNCTION idergbmixer$ (editing)
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
i = 0
idepar p, 70, 11, "RGB Color Mixer"
a2$ = "127"
i = i + 1
o(i).typ = 1
o(i).x = 63
o(i).y = 2
o(i).txt = idenewtxt(a2$)
o(i).v1 = LEN(a2$)
o(i).issel = -1
o(i).sx1 = 0
a2$ = "127"
i = i + 1
o(i).typ = 1
o(i).x = 63
o(i).y = 5
o(i).txt = idenewtxt(a2$)
o(i).v1 = LEN(a2$)
o(i).issel = -1
o(i).sx1 = 0
a2$ = "127"
i = i + 1
o(i).typ = 1
o(i).x = 63
o(i).y = 8
o(i).txt = idenewtxt(a2$)
o(i).v1 = LEN(a2$)
o(i).issel = -1
o(i).sx1 = 0
i = i + 1
o(i).typ = 3
o(i).y = 11
o(i).txt = idenewtxt("#Insert" + sep + "C#opy" + sep + "#Cancel")
o(i).dft = 1
prev.ideselect = ideselect
IF editing THEN
'Parse selection for RGB values:
a$ = ""
a2$ = ""
IF ideselect THEN
IF ideselecty1 = idecy THEN 'single line selected
a$ = idegetline(idecy)
sx1 = ideselectx1: sx2 = idecx
IF sx2 < sx1 THEN SWAP sx1, sx2
FOR x = sx1 TO sx2 - 1
IF x <= LEN(a$) THEN a2$ = a2$ + MID$(a$, x, 1) ELSE EXIT FOR
NEXT
END IF
END IF
a2$ = UCASE$(LTRIM$(RTRIM$(a2$)))
IF LEN(a2$) = 0 THEN
RGB_Lookup:
'No selection found. Let's look for RGB values in the current line
All_RGB$ = ""
CurrentLine$ = idegetline(idecy)
a$ = UCASE$(CurrentLine$)
'In case there are multiple RGB values, we'll stick to the
'one closer to the cursor.
Found_RGB = 0
DO
Found_RGB = INSTR(Found_RGB + 1, a$, "RGB")
IF Found_RGB = 0 THEN EXIT DO
FindBracket1 = INSTR(Found_RGB, a$, "(")
FindBracket2 = INSTR(FindBracket1, a$, ")")
IF FindBracket1 > 0 AND FindBracket2 > 0 THEN
All_RGB$ = All_RGB$ + MKI$(Found_RGB)
END IF
LOOP
IF LEN(All_RGB$) = 0 THEN GOTO NoRGBFound
IF LEN(All_RGB$) = 2 THEN
'IF only one RGB reference was found in the current line, then this is it
a2$ = MID$(a$, CVI(All_RGB$))
InsertRGBAt = CVI(All_RGB$)
ELSE
Check_RGB = 1
DO
IF idecx >= CVI(MID$(All_RGB$, (Check_RGB + 1) * 2 - 1, 2)) THEN
Check_RGB = Check_RGB + 1
IF Check_RGB = LEN(All_RGB$) \ 2 THEN EXIT DO
ELSE
EXIT DO
END IF
LOOP
a2$ = MID$(a$, CVI(MID$(All_RGB$, Check_RGB * 2 - 1, 2)))
InsertRGBAt = CVI(MID$(All_RGB$, Check_RGB * 2 - 1, 2))
END IF
END IF
'Read RGB values and fill the textboxes
DIM newSyntax AS _BYTE
IF LEFT$(a2$, 4) = "RGB(" OR _
LEFT$(a2$, 6) = "RGB32(" OR _
LEFT$(a2$, 5) = "RGBA(" OR _
LEFT$(a2$, 7) = "RGBA32(" THEN
IF LEFT$(a2$, 6) = "RGB32(" THEN newSyntax = -1
IF InsertRGBAt = 0 THEN InsertRGBAt = sx1
FindComma1 = INSTR(a2$, ",")
IF FindComma1 > 0 THEN
FindComma2 = INSTR(FindComma1 + 1, a2$, ",")
IF FindComma2 > 0 THEN
r$ = "": g$ = "": b$ = ""
FOR i = FindComma1 - 1 TO 1 STEP -1
IF ASC(a2$, i) >= 48 AND ASC(a2$, i) <= 57 THEN
r$ = MID$(a2$, i, 1) + r$
ELSE
EXIT FOR
END IF
NEXT i
FOR i = FindComma1 + 1 TO FindComma2 - 1
IF ASC(a2$, i) = 32 OR (ASC(a2$, i) >= 48 AND ASC(a2$, i) <= 57) THEN
g$ = g$ + MID$(a2$, i, 1)
ELSE
EXIT FOR
END IF
NEXT i
FOR i = FindComma2 + 1 TO LEN(a2$)
IF ASC(a2$, i) = 32 OR (ASC(a2$, i) >= 48 AND ASC(a2$, i) <= 57) THEN
b$ = b$ + MID$(a2$, i, 1)
ELSE
EXIT FOR
END IF
NEXT i
r = VAL(r$): IF r < 0 THEN r = 0
IF r > 255 THEN r = 255
g = VAL(g$): IF g < 0 THEN g = 0
IF g > 255 THEN g = 255
b = VAL(b$): IF b < 0 THEN b = 0
IF b > 255 THEN b = 255
idetxt(o(1).txt) = str2$(r)
idetxt(o(2).txt) = str2$(g)
idetxt(o(3).txt) = str2$(b)
FOR i = 1 TO 3
o(i).sx1 = 0
o(i).v1 = LEN(idetxt(o(i).txt))
IF o(i).v1 > 0 THEN o(i).issel = -1
NEXT i
ELSEIF newSyntax THEN 'in case it's _RGB32(intensity, alpha)
r$ = ""
FOR i = FindComma1 - 1 TO 1 STEP -1
IF ASC(a2$, i) >= 48 AND ASC(a2$, i) <= 57 THEN
r$ = MID$(a2$, i, 1) + r$
ELSE
EXIT FOR
END IF
NEXT i
r = VAL(r$): IF r < 0 THEN r = 0
IF r > 255 THEN r = 255
g = r
b = r
idetxt(o(1).txt) = str2$(r)
idetxt(o(2).txt) = str2$(g)
idetxt(o(3).txt) = str2$(b)
FOR i = 1 TO 3
o(i).sx1 = 0
o(i).v1 = LEN(idetxt(o(i).txt))
IF o(i).v1 > 0 THEN o(i).issel = -1
NEXT i
END IF
ELSEIF newSyntax THEN
'_RGB32(intensity)?
FindComma1 = INSTR(a2$, ")")
IF FindComma1 THEN
r$ = ""
FOR i = FindComma1 - 1 TO 1 STEP -1
IF ASC(a2$, i) >= 48 AND ASC(a2$, i) <= 57 THEN
r$ = MID$(a2$, i, 1) + r$
ELSE
EXIT FOR
END IF
NEXT i
r = VAL(r$): IF r < 0 THEN r = 0
IF r > 255 THEN r = 255
g = r
b = r
idetxt(o(1).txt) = str2$(r)
idetxt(o(2).txt) = str2$(g)
idetxt(o(3).txt) = str2$(b)
FOR i = 1 TO 3
o(i).sx1 = 0
o(i).v1 = LEN(idetxt(o(i).txt))
IF o(i).v1 > 0 THEN o(i).issel = -1
NEXT i
END IF
END IF
ELSE
'If a selection is present, it spans only one line, but
'no _RGB is selected, let's try to find some _RGB around.
IF ideselect AND ideselecty1 = idecy THEN
ideselect = 0
GOTO RGB_Lookup
END IF
END IF
END IF
NoRGBFound:
CurrentColor~& = _RGB32(VAL(idetxt(o(1).txt)), VAL(idetxt(o(2).txt)), VAL(idetxt(o(3).txt)))
_PALETTECOLOR 12, CurrentColor~&, 0
_PALETTECOLOR 5, &HFF00A800, 0 'Original green may have been changed by the Help System, so 5 is now green
'-------- 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 --------
LOCATE p.y + 2, p.x + 13: PRINT "R: ";
COLOR 4: PRINT STRING$(46, 196);
slider$ = CHR$(197)
T = VAL(idetxt(o(1).txt)): r = ((T / 255) * 46)
IF T = 0 THEN slider$ = CHR$(195)
IF T = 255 THEN slider$ = CHR$(180)
_PRINTSTRING (p.x + 15 + r, p.y + 2), slider$
COLOR 0: LOCATE p.y + 5, p.x + 13: PRINT "G: ";
COLOR 5: PRINT STRING$(46, 196);
slider$ = CHR$(197)
T = VAL(idetxt(o(2).txt)): r = ((T / 255) * 46)
IF T = 0 THEN slider$ = CHR$(195)
IF T = 255 THEN slider$ = CHR$(180)
_PRINTSTRING (p.x + 15 + r, p.y + 5), slider$
COLOR 0: LOCATE p.y + 8, p.x + 13: PRINT "B: ";
COLOR 9: PRINT STRING$(46, 196);
slider$ = CHR$(197)
T = VAL(idetxt(o(3).txt)): r = ((T / 255) * 46)
IF T = 0 THEN slider$ = CHR$(195)
IF T = 255 THEN slider$ = CHR$(180)
_PRINTSTRING (p.x + 15 + r, p.y + 8), slider$
COLOR 0: _PRINTSTRING (p.x + 19, p.y + 9), "Hold CTRL to drag all sliders at once."
COLOR 12
FOR i = 2 TO 8
_PRINTSTRING (p.x + 2, p.y + i), STRING$(10, 219)
NEXT i
'-------- 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 --------
'specific post controls
IF focus <> PrevFocus THEN
'Always start with RGB values selected upon getting focus
PrevFocus = focus
IF focus >= 1 AND focus <= 3 THEN
o(focus).v1 = LEN(idetxt(o(focus).txt))
IF o(focus).v1 > 0 THEN o(focus).issel = -1
o(focus).sx1 = 0
END IF
END IF
IF mB AND mY = p.y + 2 AND mX >= p.x + 15 AND mX <= p.x + 15 + 46 THEN
newValue = (mX - p.x - 15) * (255 / 46)
idetxt(o(1).txt) = str2$(newValue)
IF _KEYDOWN(100305) OR _KEYDOWN(100306) THEN
idetxt(o(2).txt) = str2$(newValue)
idetxt(o(3).txt) = str2$(newValue)
END IF
focus = 1
o(focus).v1 = LEN(idetxt(o(focus).txt))
o(focus).issel = -1
o(focus).sx1 = 0
END IF
IF mB AND mY = p.y + 5 AND mX >= p.x + 15 AND mX <= p.x + 15 + 46 THEN
newValue = (mX - p.x - 15) * (255 / 46)
idetxt(o(2).txt) = str2$(newValue)
IF _KEYDOWN(100305) OR _KEYDOWN(100306) THEN
idetxt(o(1).txt) = str2$(newValue)
idetxt(o(3).txt) = str2$(newValue)
END IF
focus = 2
o(focus).v1 = LEN(idetxt(o(focus).txt))
o(focus).issel = -1
o(focus).sx1 = 0
END IF
IF mB AND mY = p.y + 8 AND mX >= p.x + 15 AND mX <= p.x + 15 + 46 THEN
newValue = (mX - p.x - 15) * (255 / 46)
idetxt(o(3).txt) = str2$(newValue)
IF _KEYDOWN(100305) OR _KEYDOWN(100306) THEN
idetxt(o(1).txt) = str2$(newValue)
idetxt(o(2).txt) = str2$(newValue)
END IF
focus = 3
o(focus).v1 = LEN(idetxt(o(focus).txt))
o(focus).issel = -1
o(focus).sx1 = 0
END IF
ChangedWithKeys = 0
IF K$ = CHR$(0) + CHR$(72) AND (focus = 1 OR focus = 2 OR focus = 3) THEN 'Up
idetxt(o(focus).txt) = str2$(VAL(idetxt(o(focus).txt)) + 1)
o(focus).issel = -1: o(focus).sx1 = 0: o(focus).v1 = LEN(idetxt(o(focus).txt))
ChangedWithKeys = -1
END IF
IF K$ = CHR$(0) + CHR$(80) AND (focus = 1 OR focus = 2 OR focus = 3) THEN 'Down
idetxt(o(focus).txt) = str2$(VAL(idetxt(o(focus).txt)) - 1)
o(focus).issel = -1: o(focus).sx1 = 0: o(focus).v1 = LEN(idetxt(o(focus).txt))
ChangedWithKeys = -1
END IF
'Check RGB values range (0-255)
FOR checkRGB = 1 TO 3
a$ = idetxt(o(checkRGB).txt)
IF LEN(a$) > 3 THEN a$ = LEFT$(a$, 3) '3 character limit
FOR i = 1 TO LEN(a$)
a = ASC(a$, i)
IF i = 2 AND ASC(a$, 1) = 48 THEN a$ = "0": EXIT FOR
IF a < 48 OR a > 57 THEN a$ = "": EXIT FOR
NEXT
IF LEN(a$) THEN
a = VAL(a$)
IF a > 255 THEN a$ = "255"
IF a < 0 THEN a$ = "0"
ELSE
IF ChangedWithKeys = -1 THEN a$ = "0"
END IF
idetxt(o(checkRGB).txt) = a$
NEXT checkRGB
CurrentColor~& = _RGB32(VAL(idetxt(o(1).txt)), VAL(idetxt(o(2).txt)), VAL(idetxt(o(3).txt)))
IF newSyntax AND (idetxt(o(1).txt) = idetxt(o(2).txt) AND idetxt(o(2).txt) = idetxt(o(3).txt)) THEN
CurrentRGB$ = idetxt(o(1).txt)
ELSE
CurrentRGB$ = idetxt(o(1).txt) + ", " + idetxt(o(2).txt) + ", " + idetxt(o(3).txt)
END IF
_PALETTECOLOR 12, CurrentColor~&, 0
IF K$ = CHR$(27) OR (focus = 6 AND info <> 0) THEN
ideselect = prev.ideselect
EXIT FUNCTION
END IF
IF (focus = 5 AND info <> 0) THEN
'Return the current RGB string
IF (idetxt(o(1).txt) = idetxt(o(2).txt) AND idetxt(o(2).txt) = idetxt(o(3).txt)) THEN
CurrentRGB$ = "_RGB32(" + idetxt(o(1).txt) + ")"
ELSE
CurrentRGB$ = "_RGB32(" + idetxt(o(1).txt) + ", " + idetxt(o(2).txt) + ", " + idetxt(o(3).txt) + ")"
END IF
_CLIPBOARD$ = CurrentRGB$
ideselect = prev.ideselect
EXIT FUNCTION
END IF
IF (focus = 4 AND info <> 0) OR _
(focus = 1 AND K$ = CHR$(13)) OR _
(focus = 2 AND K$ = CHR$(13)) OR _
(focus = 3 AND K$ = CHR$(13)) OR _
(focus = 4 AND K$ = CHR$(13)) THEN
IF CurrentLine$ = "" THEN CurrentLine$ = idegetline(idecy)
IF editing THEN
'If we're changing an existing statement, let's insert the values
IF InsertRGBAt > 0 THEN
FindBracket1 = INSTR(InsertRGBAt, CurrentLine$, "(")
FindBracket2 = INSTR(FindBracket1, CurrentLine$, ")")
OldRGB$ = MID$(CurrentLine$, FindBracket1, FindBracket2 - FindBracket1 + 1)
IF (newSyntax AND CountItems(OldRGB$, ",") = 1) OR CountItems(OldRGB$, ",") = 3 THEN 'If the current statement has the ALPHA parameter
FOR i = FindBracket2 TO FindBracket1 STEP -1
IF ASC(CurrentLine$, i) = 44 THEN FindBracket2 = i: EXIT FOR
NEXT i
END IF
NewLine$ = LEFT$(CurrentLine$, FindBracket1)
IF FindBracket2 = 0 THEN FindBracket2 = FindBracket1
NewLine$ = NewLine$ + CurrentRGB$
NewLine$ = NewLine$ + MID$(CurrentLine$, FindBracket2)
idechangemade = 1
startPausedPending = 0
idesetline idecy, NewLine$
'Select the inserted bit
ideselectx1 = FindBracket1 + 1
idecx = ideselectx1 + LEN(CurrentRGB$)
ideselecty1 = idecy
prev.ideselect = 1
CurrentRGB$ = "" 'return nothing since we've already inserted it above
END IF
END IF
IF LEN(CurrentRGB$) THEN
'Return the current RGB string
IF (idetxt(o(1).txt) = idetxt(o(2).txt) AND idetxt(o(2).txt) = idetxt(o(3).txt)) THEN
CurrentRGB$ = "_RGB32(" + idetxt(o(1).txt) + ")"
ELSE
CurrentRGB$ = "_RGB32(" + idetxt(o(1).txt) + ", " + idetxt(o(2).txt) + ", " + idetxt(o(3).txt) + ")"
END IF
END IF
idergbmixer$ = CurrentRGB$
ideselect = prev.ideselect
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
FUNCTION CountItems (SearchString$, Item$)
DO
Found = INSTR(Found + 1, SearchString$, Item$)
IF Found = 0 THEN EXIT DO
Total = Total + 1
LOOP
CountItems = Total
END FUNCTION
SUB iderestrict417 (p417)
x = 0
IF p417 AND 4 THEN x = x + 1
IF p417 AND 8 THEN x = x + 1
IF x > 1 THEN p417 = p417 AND 243
END SUB
FUNCTION CTRL2
IF MacOSX THEN
IF _KEYDOWN(100309) THEN CTRL2 = 1
IF _KEYDOWN(100310) THEN CTRL2 = 1
END IF
END FUNCTION
SUB GetInput
STATIC ASCvalue$
IF iCHECKLATER THEN iCHECKLATER = 0: EXIT SUB
'Clear/Update immediate return values
iCHANGED = 0
KSTATECHANGED = 0
mCLICK = 0: mCLICK2 = 0: mRELEASE = 0: mRELEASE2 = 0
mWHEEL = 0
K$ = "": KB = 0
mOB = mB: mOB2 = mB2
KOALT = KALT: KALTPRESS = 0: KALTRELEASE = 0
'Flush INKEY$ buffer (for good measure)
DO: LOOP UNTIL INKEY$ = ""
'Keyboard event?
k = _KEYHIT
'Steve Edit on 07-04-2014 to add extended ASCII creation with ALT-plus numkeys
IF (_KEYDOWN(100307) OR _KEYDOWN(100308)) AND (k >= -57 AND k <= -48) THEN
ASCvalue$ = ASCvalue$ + CHR$(-k)
END IF
IF NOT _KEYDOWN(100307) AND NOT _KEYDOWN(100308) THEN
IF LEN(ASCvalue$) THEN
KB = VAL(RIGHT$(ASCvalue$, 3))
IF KB > 0 AND KB < 256 THEN
K$ = CHR$(KB)
k = KB
iCHANGED = -1
AltSpecial = -1
END IF
ASCvalue$ = ""
EXIT SUB
END IF
END IF
'End of Edit
IF k THEN
IF k < 0 THEN k = -k: release = 1
'modifiers
IF k = KEY_LSHIFT OR k = KEY_RSHIFT THEN
IF release = 1 THEN KSHIFT = 0 ELSE KSHIFT = -1
iCHANGED = -1: KSTATECHANGED = -1
END IF
IF k = KEY_LALT OR k = KEY_RALT THEN
IF release = 1 THEN
KALT = 0: KALTRELEASE = -1
ELSE
KALT = -1: KALTPRESS = -1
END IF
iCHANGED = -1: KSTATECHANGED = -1
END IF
IF k = KEY_LCTRL OR k = KEY_RCTRL THEN
IF release = 1 THEN KCTRL = 0: KCONTROL = 0 ELSE KCTRL = -1: KCONTROL = -1
iCHANGED = -1: KSTATECHANGED = -1
END IF
IF k = KEY_LAPPLE OR k = KEY_RAPPLE THEN
IF release = 1 THEN KCONTROL = 0 ELSE KCONTROL = -1
iCHANGED = -1: KSTATECHANGED = -1
END IF
'presses
IF release = 0 THEN
iCHANGED = -1
IF k <= 255 THEN K$ = CHR$(k)
IF k >= 256 AND k <= 65535 AND ((k AND 255) = 0) THEN K$ = CHR$(0) + CHR$(k \ 256)
KB = k
END IF
IF iCHANGED THEN EXIT SUB
END IF
DO WHILE _MOUSEINPUT
iCHANGED = 1
IF MouseButtonSwapped THEN
mB = _MOUSEBUTTON(2): mB2 = _MOUSEBUTTON(1)
ELSE
mB = _MOUSEBUTTON(1): mB2 = _MOUSEBUTTON(2)
END IF
mWHEEL = mWHEEL + _MOUSEWHEEL
mX = _MOUSEX: mY = _MOUSEY
IF mB <> 0 AND mOB = 0 THEN mCLICK = -1: EXIT SUB
IF mB2 <> 0 AND mOB2 = 0 THEN mCLICK2 = -1: EXIT SUB
IF mB = 0 AND mOB <> 0 THEN mRELEASE = -1: EXIT SUB
IF mB2 = 0 AND mOB2 <> 0 THEN mRELEASE2 = -1: EXIT SUB
LOOP
END SUB
SUB ClearMouse
iCHANGED = 0
mB = 0
mB2 = 0
mCLICK = 0
mRELEASE = 0
DO WHILE _MOUSEBUTTON(1) OR _MOUSEBUTTON(2)
i = _MOUSEINPUT
LOOP
END SUB
SUB Help_ShowText
STATIC setup
IF setup = 0 AND UBOUND(back$) = 1 THEN
setup = 1
IF IdeContextHelpSF = 0 THEN
a$ = Wiki$(Back$(1))
WikiParse a$
END IF
END IF
REDIM Help_LineLen(Help_wh)
COLOR 7, 0
'CLS
'FOR y = Help_wy1 - 1 TO Help_wy2 + 1
' FOR x = Help_wx1 - 1 TO Help_wx2 + 1
' LOCATE y, x: PRINT chr$(219);
' NEXT
'NEXT
sy = Help_wy1
FOR y = Help_sy TO Help_sy + Help_wh - 1
IF y <= help_h THEN
'PRINT CVL(MID$(Help_Line$, (y - 1) * 4 + 1, 4)), LEN(Help_Txt$)
l = CVL(MID$(Help_Line$, (y - 1) * 4 + 1, 4))
x = l
x3 = 1
sx = Help_wx1
c = ASC(Help_Txt$, x): col = ASC(Help_Txt$, x + 1)
LOCATE sy, sx
DO UNTIL c = 13
COLOR col AND 15, col \ 16
IF IdeSystem = 3 AND Help_Select = 2 THEN
IF y >= Help_SelY1 AND y <= Help_SelY2 THEN
IF x3 >= Help_SelX1 AND x3 <= Help_SelX2 THEN
COLOR 0, 7
END IF
END IF
END IF
IF x3 >= Help_sx THEN
IF sx <= Help_wx2 THEN
PRINT CHR$(c);
sx = sx + 1
END IF
END IF
x3 = x3 + 1: x = x + 4: c = ASC(Help_Txt$, x): col = ASC(Help_Txt$, x + 1)
LOOP
Help_LineLen(y - Help_sy) = x3 - 1
FOR x4 = 1 TO Help_wx2 - POS(0) + 1
IF col = 0 THEN col = 7
COLOR col AND 15, col \ 16
IF IdeSystem = 3 AND Help_Select = 2 THEN
IF y >= Help_SelY1 AND y <= Help_SelY2 THEN
IF x3 >= Help_SelX1 AND x3 <= Help_SelX2 THEN
COLOR 0, 7
END IF
END IF
END IF
PRINT " ";
x3 = x3 + 1
NEXT
ELSE
sx = Help_wx1
LOCATE sy, sx
x3 = Help_sx
FOR x4 = 1 TO Help_ww
COLOR 7, 0
IF IdeSystem = 3 AND Help_Select = 2 THEN
IF y >= Help_SelY1 AND y <= Help_SelY2 THEN
IF x3 >= Help_SelX1 AND x3 <= Help_SelX2 THEN
COLOR 0, 7
END IF
END IF
END IF
PRINT " ";
x3 = x3 + 1
NEXT
Help_LineLen(y - Help_sy) = 0
END IF
sy = sy + 1
NEXT
'LOCATE Help_cy - Help_sy + Help_wy1, Help_cx - Help_sx + Help_wx1
'COLOR 15, 4
'PRINT CHR$(SCREEN(CSRLIN, POS(0)));
'c = 0
'DO
' old_kcontrol = KCONTROL
' GetInput
' IF KB > 0 THEN c = 1
' IF mCLICK THEN c = 1
' IF mWHEEL THEN c = 1
' IF KCONTROL AND old_kcontrol = 0 THEN c = 0
' IF mB THEN c = 1
'LOOP UNTIL c
END SUB
FUNCTION idesearchedbox$
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
ln = 0
l$ = ""
REDIM SearchHistory(0) AS STRING
RetrieveSearchHistory SearchHistory()
FOR i = 1 to UBOUND(SearchHistory)
l$ = SearchHistory(i) + sep + l$
NEXT
'72,19
h = idewy + idesubwindow - 9
IF ln < h THEN h = ln
IF h < 3 THEN h = 3
i = 0
idepar p, 20, h, ""
p.x = idewx - 24
p.y = idewy - 6 - h
IF p.y < 3 THEN
p.h = p.h - abs(3 - p.y)
h = p.h
p.y = 3
END IF
i = i + 1
o(i).typ = 2
o(i).x = -1: o(i).y = 0
o(i).w = 22: o(i).h = h
o(i).txt = idenewtxt(l$)
o(i).sel = 1
o(i).nam = idenewtxt("Find")
'i = i + 1
'o(i).typ = 3
'o(i).y = idewy - 6
'o(i).txt = idenewtxt("#OK" + sep + "#Cancel")
'o(i).dft = 1
'-------- 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 --------
'-------- 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 --------
'quick exit
IF mCLICK THEN
IF mX < p.x - 1 OR mY < p.y OR mX > p.x + p.w + 2 OR mY > p.y + p.h + 1 THEN
idesearchedbox$ = ""
EXIT FUNCTION
END IF
END IF
IF K$ = CHR$(27) THEN
idesearchedbox$ = ""
EXIT FUNCTION
END IF
IF mCLICK THEN
IF mX > p.x - 1 AND mY > p.y AND mX < p.x + p.w + 2 AND mY < p.y + p.h + 1 THEN
f$ = idetxt(o(1).stx)
idesearchedbox$ = f$
EXIT FUNCTION
END IF
END IF
IF K$ = CHR$(13) OR (info = 1 AND focus = 1) THEN
f$ = idetxt(o(1).stx)
idesearchedbox$ = f$
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
SUB IdeImportBookmarks (f2$)
IdeBmkN = 0
f$ = CRLF + f2$ + CRLF
fh = FREEFILE: OPEN ".\internal\temp\bookmarks.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$: CLOSE #fh
x = INSTR(UCASE$(a$), UCASE$(f$))
IF x THEN 'retrieve bookmark data
l = CVL(MID$(a$, x + LEN(f$), 4))
x1 = x + LEN(f$) + 4
d$ = MID$(a$, x1, l)
n = l \ 16
FOR i = 1 TO n
by = CVL(MID$(d$, (i - 1) * 16 + 1, 4))
bx = CVL(MID$(d$, (i - 1) * 16 + 1 + 4, 4))
IF by <= iden THEN
IdeBmkN = IdeBmkN + 1
IF IdeBmkN > UBOUND(IdeBmk) THEN x = UBOUND(IdeBmk) * 2: REDIM _PRESERVE IdeBmk(x) AS IdeBmkType
IdeBmk(IdeBmkN).y = by
IdeBmk(IdeBmkN).x = bx
IdeBmk(IdeBmkN).reserved = 0: IdeBmk(IdeBmkN).reserved2 = 0
END IF
NEXT
END IF
'at the same time, import breakpoint and skip line data
x = VAL(ReadSetting$(".\internal\temp\debug.ini", f2$, "total breakpoints"))
IF x THEN
FOR i = 1 TO x
j = VAL(ReadSetting$(".\internal\temp\debug.ini", f2$, "breakpoint" + STR$(i)))
IF j > UBOUND(IdeBreakpoints) THEN EXIT FOR
IdeBreakpoints(j) = -1
NEXT
END IF
x = VAL(ReadSetting$(".\internal\temp\debug.ini", f2$, "total skips"))
IF x THEN
FOR i = 1 TO x
j = VAL(ReadSetting$(".\internal\temp\debug.ini", f2$, "skip" + STR$(i)))
IF j > UBOUND(IdeSkipLines) THEN EXIT FOR
IdeSkipLines(j) = -1
NEXT
END IF
END SUB
SUB IdeSaveBookmarks (f2$)
f$ = CRLF + f2$ + CRLF
fh = FREEFILE: OPEN ".\internal\temp\bookmarks.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$: CLOSE #fh
x = INSTR(UCASE$(a$), UCASE$(f$))
IF x THEN 'remove any old bookmark data
l = CVL(MID$(a$, x + LEN(f$), 4))
x2 = x + LEN(f$) + 4 + l - 1
a$ = LEFT$(a$, x - 1) + RIGHT$(a$, LEN(a$) - x2)
END IF
'add new bookmark data
'build bookmark data
d$ = ""
FOR i = 1 TO IdeBmkN
d$ = d$ + MKL$(IdeBmk(i).y) + MKL$(IdeBmk(i).x) + MKL$(IdeBmk(i).reserved) + MKL$(IdeBmk(i).reserved2)
NEXT
a$ = f$ + MKL$(LEN(d$)) + d$ + a$
fh = FREEFILE: OPEN ".\internal\temp\bookmarks.bin" FOR OUTPUT AS #fh: CLOSE #fh
fh = FREEFILE: OPEN ".\internal\temp\bookmarks.bin" FOR BINARY AS #fh: PUT #fh, , a$: CLOSE #fh
'at the same time, save breakpoint and skip line data
IF vWatchOn THEN
WriteSetting ".\internal\temp\debug.ini", f2$, "total breakpoints", "0"
WriteSetting ".\internal\temp\debug.ini", f2$, "total skips", "0"
x = 0
FOR i = 1 TO UBOUND(IdeBreakpoints)
IF IdeBreakpoints(i) THEN
x = x + 1
WriteSetting ".\internal\temp\debug.ini", f2$, "breakpoint" + STR$(x), str2$(i)
END IF
NEXT
WriteSetting ".\internal\temp\debug.ini", f2$, "total breakpoints", str2$(x)
x = 0
FOR i = 1 TO UBOUND(IdeSkipLines)
IF IdeSkipLines(i) THEN
x = x + 1
WriteSetting ".\internal\temp\debug.ini", f2$, "skip" + STR$(x), str2$(i)
END IF
NEXT
WriteSetting ".\internal\temp\debug.ini", f2$, "total skips", str2$(x)
END IF
END SUB
FUNCTION iderecentbox$
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
l$ = ""
dialogWidth = 72
totalRecent = 0
fh = FREEFILE
OPEN ".\internal\temp\recent.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$
a$ = RIGHT$(a$, LEN(a$) - 2)
REDIM tempList$(100)
DO WHILE LEN(a$)
ai = INSTR(a$, CRLF)
IF ai THEN
f$ = LEFT$(a$, ai - 1): IF ai = LEN(a$) - 1 THEN a$ = "" ELSE a$ = RIGHT$(a$, LEN(a$) - ai - 3)
IF LEN(f$) + 6 > dialogWidth THEN dialogWidth = LEN(f$) + 6
totalRecent = totalRecent + 1
IF totalRecent > UBOUND(tempList$) THEN
REDIM _PRESERVE tempList$(UBOUND(tempList$) + 100)
END IF
tempList$(totalRecent) = f$
IF LEN(l$) THEN l$ = l$ + sep + f$ ELSE l$ = f$
END IF
LOOP
CLOSE #fh
'72,19
i = 0
dialogHeight = (totalRecent) + 3
IF dialogHeight > idewy + idesubwindow - 6 THEN
dialogHeight = idewy + idesubwindow - 6
END IF
IF dialogWidth > idewx - 8 THEN dialogWidth = idewx - 8
idepar p, dialogWidth, dialogHeight, "Open"
i = i + 1
o(i).typ = 2
o(i).y = 1
'68
o(i).w = dialogWidth - 4: o(i).h = dialogHeight - 3
o(i).txt = idenewtxt(l$)
o(i).sel = 1
o(i).nam = idenewtxt("Recent Programs")
i = i + 1
o(i).typ = 3
o(i).y = dialogHeight
o(i).txt = idenewtxt("#Open" + sep + "#Cancel" + sep + "Clear #list" + sep + "#Remove broken links")
o(i).dft = 1
'-------- 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 --------
'-------- 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 K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN
iderecentbox$ = ""
EXIT FUNCTION
END IF
IF (K$ = CHR$(13) AND focus = 1) OR (focus = 2 AND info <> 0) OR (info = 1 AND focus = 1) THEN
f$ = tempList$(ABS(o(1).sel))
iderecentbox$ = f$
EXIT FUNCTION
END IF
IF (K$ = CHR$(13) AND focus = 4) OR (focus = 4 AND info <> 0) OR (info = 1 AND focus = 4) THEN
iderecentbox$ = "<C>"
EXIT FUNCTION
END IF
IF (K$ = CHR$(13) AND focus = 5) OR (focus = 5 AND info <> 0) OR (info = 1 AND focus = 5) THEN
iderecentbox$ = "<R>"
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
SUB IdeMakeFileMenu
m = 1: i = 0
IF 1=1 THEN
menu$(m, i) = "File": i = i + 1
menu$(m, i) = "#New Ctrl+N": i = i + 1
menuDesc$(m, i - 1) = "Closes current program and starts a blank one"
menu$(m, i) = "#Open... Ctrl+O": i = i + 1
menuDesc$(m, i - 1) = "Loads a program into memory"
menu$(m, i) = "#Save Ctrl+S": i = i + 1
menuDesc$(m, i - 1) = "Writes current program to a file on disk"
menu$(m, i) = "Save #As...": i = i + 1
menuDesc$(m, i - 1) = "Saves current program with specified name"
ELSE
menu$(m, i) = "File": i = i + 1
menu$(m, i) = "#New Program Ctrl+N": i = i + 1 '"#New Ctrl+N"
menuDesc$(m, i - 1) = "Removes currently loaded program from memory"
menu$(m, i) = "#Open Program... Ctrl+O": i = i + 1 '"#Open... Ctrl+O"
menuDesc$(m, i - 1) = "Loads new program into memory"
menu$(m, i) = "~#Merge...": i = i + 1
menuDesc$(m, i - 1) = "Inserts specified file into current module"
menu$(m, i) = "#Save Ctrl+S": i = i + 1 '"#Save Ctrl+S"
menuDesc$(m, i - 1) = "Writes current module to file on disk"
menu$(m, i) = "Save #As...": i = i + 1
menuDesc$(m, i - 1) = "Saves current module with specified name and format"
menu$(m, i) = "~Sa#ve All": i = i + 1
menuDesc$(m, i - 1) = "Writes all currently loaded modules to files on disk"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "~#Print...": i = i + 1
menuDesc$(m, i - 1) = "Prints specified text or module"
menu$(m, i) = "~#DOS Shell...": i = i + 1
menuDesc$(m, i - 1) = "Invokes DOS shell"
END IF
fh = FREEFILE
OPEN ".\internal\temp\recent.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$
a$ = RIGHT$(a$, LEN(a$) - 2)
maxRecentInFileMenu = UBOUND(IdeRecentLink, 1)
maxLengthRecentFiles = 35
FOR r = 1 TO maxRecentInFileMenu + 1
IF r <= maxRecentInFileMenu THEN IdeRecentLink(r, 1) = ""
ai = INSTR(a$, CRLF)
IF ai THEN
IF r = 1 THEN menu$(m, i) = "-": i = i + 1
f$ = LEFT$(a$, ai - 1): IF ai = LEN(a$) - 1 THEN a$ = "" ELSE a$ = RIGHT$(a$, LEN(a$) - ai - 3)
IF r <= maxRecentInFileMenu THEN IdeRecentLink(r, 2) = f$
'f$ = MID$(f$, _INSTRREV(f$, pathsep$) + 1)
IF LEN(f$) > maxLengthRecentFiles THEN f$ = STRING$(3, 250) + RIGHT$(f$, maxLengthRecentFiles - 3)
f$ = "#" + str2$(r) + " " + f$
IF r = maxRecentInFileMenu + 1 THEN f$ = "#Recent..."
menu$(m, i) = f$
IF r <= maxRecentInFileMenu THEN
IdeRecentLink(r, 1) = f$
f$ = "Open '" + IdeRecentLink(r, 2) + "'"
ai = 3
DO UNTIL LEN(f$) <= idewx - 2
ai = ai + 1
f$ = "Open '" + STRING$(3, 250) + MID$(IdeRecentLink(r, 2), ai) + "'"
LOOP
menuDesc$(m, i) = f$
END IF
i = i + 1
END IF
NEXT
CLOSE #fh
IF menu$(m, i - 1) <> "#Recent..." AND menu$(m, i - 1) <> "Save #As..." THEN
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "#Clear Recent...": i = i + 1
menuDesc$(m, i - 1) = "Clears list of recently loaded files"
ELSE
menuDesc$(m, i - 1) = "Displays a complete list of recently loaded files"
END IF
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "E#xit": i = i + 1
menuDesc$(m, i - 1) = "Exits QB64"
menusize(m) = i - 1
END SUB
SUB IdeMakeContextualMenu
REDIM SubFuncLIST(0) AS STRING
DIM Selection$
m = idecontextualmenuID: i = 0
menu$(m, i) = "Contextual": i = i + 1
IF IdeDebugMode = 2 THEN
menu$(m, i) = "#Continue F5": i = i + 1
menuDesc$(m, i - 1) = "Runs until the end of the current procedure is reached"
menu$(m, i) = "Step O#ut F6": i = i + 1
menuDesc$(m, i - 1) = "Runs until the end of the current procedure is reached"
menu$(m, i) = "Ste#p Into F7": i = i + 1
menuDesc$(m, i - 1) = "Runs the next line of code and pauses execution"
menu$(m, i) = "Step #Over F8": i = i + 1
menuDesc$(m, i - 1) = "Runs the next line of code without entering subs/functions"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "Set #Next Line Ctrl+G": i = i + 1
menuDesc$(m, i - 1) = "Jumps to the selected line before continuing execution"
menu$(m, i) = "#Run To This Line Ctrl+Shift+G": i = i + 1
menuDesc$(m, i - 1) = "Runs until the selected line is reached"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "Toggle #Breakpoint F9": i = i + 1
menuDesc$(m, i - 1) = "Sets/clears breakpoint at cursor location"
menu$(m, i) = "Clear All Breakpoints F10": i = i + 1
menuDesc$(m, i - 1) = "Removes all breakpoints"
menu$(m, i) = "Toggle #Skip Line Ctrl+P": i = i + 1
menuDesc$(m, i - 1) = "Sets/clears flag to skip line"
menu$(m, i) = "#Unskip All Lines Ctrl+F10": i = i + 1
menuDesc$(m, i - 1) = "Removes all line skip flags"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "SUBs... F2": i = i + 1
menuDesc$(m, i - 1) = "Displays a list of SUB/FUNCTION procedures"
menu$(m, i) = "#Watch List... F4": i = i + 1
menuDesc$(m, i - 1) = "Adds variables to watch list"
menu$(m, i) = "Call Stack... F12": i = i + 1
menuDesc$(m, i - 1) = "Displays the call stack of the current program's execution"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "#Exit $DEBUG mode ESC": i = i + 1
menuDesc$(m, i - 1) = "Disconnects from the running program and returns control to the IDE"
ELSE
IF IdeSystem = 1 OR IdeSystem = 2 THEN
'Figure out if the user wants to search for a selected term
Selection$ = getSelectedText$(0)
sela2$ = Selection$
IF LEN(Selection$) > 0 THEN
idecontextualSearch$ = Selection$
IF LEN(sela2$) > 22 THEN
sela2$ = LEFT$(sela2$, 19) + STRING$(3, 250)
END IF
menu$(m, i) = "Find '" + sela2$ + "'": i = i + 1
menuDesc$(m, i - 1) = "Searches for the text currently selected"
END IF
'build SUB/FUNCTION list:
TotalSF = 0
FOR y = 1 TO iden
a$ = idegetline(y)
a$ = LTRIM$(RTRIM$(a$))
sf = 0
nca$ = UCASE$(a$)
IF LEFT$(nca$, 4) = "SUB " THEN sf = 1: sf$ = "SUB "
IF LEFT$(nca$, 9) = "FUNCTION " THEN sf = 2: sf$ = "FUNC "
IF sf THEN
IF RIGHT$(nca$, 7) = " STATIC" THEN
a$ = RTRIM$(LEFT$(a$, LEN(a$) - 7))
END IF
IF sf = 1 THEN
a$ = RIGHT$(a$, LEN(a$) - 4)
ELSE
a$ = RIGHT$(a$, LEN(a$) - 9)
END IF
a$ = LTRIM$(RTRIM$(a$))
x = INSTR(a$, "(")
IF x THEN
n$ = RTRIM$(LEFT$(a$, x - 1))
ELSE
n$ = a$
cleanSubName n$
END IF
n2$ = n$
IF LEN(n2$) > 1 THEN
DO UNTIL alphanumeric(ASC(RIGHT$(n2$, 1)))
n2$ = LEFT$(n$, LEN(n2$) - 1) 'removes sigil, if any
LOOP
END IF
'Populate SubFuncLIST()
TotalSF = TotalSF + 1
REDIM _PRESERVE SubFuncLIST(1 TO TotalSF) AS STRING
SubFuncLIST(TotalSF) = MKL$(y) + CHR$(sf) + n2$
END IF
NEXT
'identify if word or character at current cursor position is in the help system OR a sub/func
a2$ = UCASE$(getWordAtCursor$)
'check if cursor is on sub/func/label name
IF LEN(LTRIM$(RTRIM$(Selection$))) > 0 THEN
DO UNTIL alphanumeric(ASC(RIGHT$(Selection$, 1)))
Selection$ = LEFT$(Selection$, LEN(Selection$) - 1) 'removes sigil, if any
IF LEN(Selection$) = 0 THEN EXIT DO
LOOP
Selection$ = LTRIM$(RTRIM$(Selection$))
END IF
IF RIGHT$(a2$, 1) = "$" THEN a3$ = LEFT$(a2$, LEN(a2$) - 1) ELSE a3$ = a2$ 'creates a new version without $
IF LEN(a3$) > 0 OR LEN(Selection$) > 0 THEN
FOR CheckSF = 1 TO TotalSF
IF a3$ = UCASE$(MID$(SubFuncLIST(CheckSF), 6)) OR UCASE$(Selection$) = UCASE$(MID$(SubFuncLIST(CheckSF), 6)) THEN
CurrSF$ = FindCurrentSF$(idecy)
IF LEN(CurrSF$) = 0 THEN GOTO SkipCheckCurrSF
DO UNTIL alphanumeric(ASC(RIGHT$(CurrSF$, 1)))
CurrSF$ = LEFT$(CurrSF$, LEN(CurrSF$) - 1) 'removes sigil, if any
IF LEN(CurrSF$) = 0 THEN EXIT DO
LOOP
CurrSF$ = UCASE$(CurrSF$)
SkipCheckCurrSF:
IF ASC(SubFuncLIST(CheckSF), 5) = 1 THEN
CursorSF$ = "SUB "
ELSE
CursorSF$ = "FUNCTION "
END IF
CursorSF$ = CursorSF$ + MID$(SubFuncLIST(CheckSF), 6)
IF UCASE$(CursorSF$) = CurrSF$ THEN
EXIT FOR
ELSE
menu$(m, i) = "#Go To " + CursorSF$: i = i + 1
menuDesc$(m, i - 1) = "Jumps to procedure definition"
SubFuncLIST(1) = SubFuncLIST(CheckSF)
EXIT FOR
END IF
END IF
NEXT CheckSF
v = 0
CurrSF$ = FindCurrentSF$(idecy)
IF validname(a2$) THEN v = HashFind(a2$, HASHFLAG_LABEL, ignore, r)
CheckThisLabel:
IF v THEN
LabelLineNumber = Labels(r).SourceLineNumber
ThisLabelScope$ = FindCurrentSF$(LabelLineNumber)
IF ThisLabelScope$ <> CurrSF$ AND v = 2 THEN
v = HashFindCont(ignore, r)
GOTO CheckThisLabel
END IF
IF LabelLineNumber > 0 AND LabelLineNumber <> idecy THEN
menu$(m, i) = "Go To #Label " + RTRIM$(Labels(r).cn): i = i + 1
menuDesc$(m, i - 1) = "Jumps to label"
REDIM _PRESERVE SubFuncLIST(1 TO UBOUND(SubFuncLIST) + 1) AS STRING
SubFuncLIST(UBOUND(SubFuncLIST)) = MKL$(Labels(r).SourceLineNumber)
END IF
END IF
END IF
IF LEN(a2$) > 0 THEN
'check if a2$ is in help links
lnks = 0
l2$ = findHelpTopic$(a2$, lnks, -1)
IF lnks THEN
IF LEN(l2$) > 15 THEN
l2$ = LEFT$(l2$, 12) + STRING$(3, 250)
END IF
IF INSTR(l2$, "PARENTHESIS") = 0 THEN
menu$(m, i) = "#Help On '" + l2$ + "'": i = i + 1
menuDesc$(m, i - 1) = "Opens help article on the selected term"
END IF
END IF
END IF
IF i > 1 THEN
menu$(m, i) = "-": i = i + 1
END IF
'--------- Check if _RGB mixer should be offered: -----------------------------------------
a$ = idegetline(idecy)
IF ideselect THEN
IF ideselecty1 <> idecy THEN GOTO NoRGBFound 'multi line selected
END IF
Found_RGB = 0
Found_RGB = Found_RGB + INSTR(UCASE$(a$), "RGB(")
Found_RGB = Found_RGB + INSTR(UCASE$(a$), "RGB32(")
Found_RGB = Found_RGB + INSTR(UCASE$(a$), "RGBA(")
Found_RGB = Found_RGB + INSTR(UCASE$(a$), "RGBA32(")
IF Found_RGB THEN
menu$(m, i) = "#RGB Color Mixer...": i = i + 1
menuDesc$(m, i - 1) = "Allows mixing colors to edit/insert _RGB statements"
menu$(m, i) = "-": i = i + 1
END IF
NoRGBFound:
'--------- _RGB mixer check done. --------------------------------------------
IF (ideselect <> 0) THEN
menu$(m, i) = "Cu#t Shift+Del or Ctrl+X": i = i + 1
menuDesc$(m, i - 1) = "Deletes selected text and copies it to clipboard"
menu$(m, i) = "#Copy Ctrl+Ins or Ctrl+C": i = i + 1
menuDesc$(m, i - 1) = "Copies selected text to clipboard"
END IF
clip$ = _CLIPBOARD$ 'read clipboard
IF LEN(clip$) THEN
menu$(m, i) = "#Paste Shift+Ins or Ctrl+V": i = i + 1
menuDesc$(m, i - 1) = "Inserts clipboard contents at current location"
END IF
IF ideselect THEN
menu$(m, i) = "Cl#ear Del": i = i + 1
menuDesc$(m, i - 1) = "Deletes selected text"
END IF
menu$(m, i) = "Select #All Ctrl+A": i = i + 1
menuDesc$(m, i - 1) = "Selects all contents of current program"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "To#ggle Comment Ctrl+T": i = i + 1
menuDesc$(m, i - 1) = "Toggles comment (') on the current selection"
menu$(m, i) = "Add Co#mment (') Ctrl+R": i = i + 1
menuDesc$(m, i - 1) = "Adds comment marker (') to the current selection"
menu$(m, i) = "Remove Comme#nt (') Ctrl+Shift+R": i = i + 1
menuDesc$(m, i - 1) = "Removes comment marker (') from the current selection"
IF ideselect THEN
y1 = idecy
y2 = ideselecty1
IF y1 = y2 THEN 'single line selected
a$ = idegetline(idecy)
a2$ = ""
sx1 = ideselectx1: sx2 = idecx
IF sx2 < sx1 THEN SWAP sx1, sx2
FOR x = sx1 TO sx2 - 1
IF x <= LEN(a$) THEN a2$ = a2$ + MID$(a$, x, 1) ELSE a2$ = a2$ + " "
NEXT
IF a2$ <> "" THEN
menu$(m, i) = "#Increase Indent TAB": i = i + 1
menuDesc$(m, i - 1) = "Increases indentation of the current selection"
menu$(m, i) = "#Decrease Indent"
menuDesc$(m, i) = "Decreases indentation of the current selection"
IF INSTR(_OS$, "WIN") OR INSTR(_OS$, "MAC") THEN menu$(m, i) = menu$(m, i) + " Shift+TAB"
i = i + 1
menu$(m, i) = "-": i = i + 1
END IF
ELSE
menu$(m, i) = "#Increase Indent TAB": i = i + 1
menuDesc$(m, i - 1) = "Increases indentation of the current selection"
menu$(m, i) = "#Decrease Indent"
menuDesc$(m, i) = "Decreases indentation of the current selection"
IF INSTR(_OS$, "WIN") OR INSTR(_OS$, "MAC") THEN menu$(m, i) = menu$(m, i) + " Shift+TAB"
i = i + 1
menu$(m, i) = "-": i = i + 1
END IF
ELSE
menu$(m, i) = "-": i = i + 1
END IF
menu$(m, i) = "New #SUB...": i = i + 1
menuDesc$(m, i - 1) = "Creates a new subprocedure at the end of the current program"
menu$(m, i) = "New #FUNCTION...": i = i + 1
menuDesc$(m, i - 1) = "Creates a new function at the end of the current program"
ELSEIF IdeSystem = 3 THEN
IF (Help_Select = 2) THEN
menu$(m, i) = "#Copy Ctrl+Ins or Ctrl+C": i = i + 1
menuDesc$(m, i - 1) = "Copies selected text to clipboard"
END IF
menu$(m, i) = "Select #All Ctrl+A": i = i + 1
menuDesc$(m, i - 1) = "Selects all contents of current article"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "#Contents Page": i = i + 1
menuDesc$(m, i - 1) = "Displays help contents page"
menu$(m, i) = "Keyword #Index": i = i + 1
menuDesc$(m, i - 1) = "Displays keyword index page"
menu$(m, i) = "#Keywords By Usage": i = i + 1
menuDesc$(m, i - 1) = "Displays keywords index by usage"
if 1=0 then ' removing the "View on Wiki" - @dualbrain
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "#Update Current Page": i = i + 1
menuDesc$(m, i - 1) = "Downloads the latest version of this article from the wiki"
menu$(m, i) = "Update All #Pages...": i = i + 1
menuDesc$(m, i - 1) = "Downloads the latest version of all articles from the wiki"
menu$(m, i) = "View Current Page On #Wiki": i = i + 1
menuDesc$(m, i - 1) = "Launches the default browser and navigates to the current article on the wiki"
end if
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "Clo#se Help ESC": i = i + 1
menuDesc$(m, i - 1) = "Closes help window"
END IF
END IF
menusize(m) = i - 1
END SUB
SUB IdeMakeEditMenu
m = ideeditmenuID: i = 0
menu$(m, i) = "Edit": i = i + 1
IF IdeSystem = 1 THEN
menu$(m, i) = "#Undo Ctrl+Z": i = i + 1
menuDesc$(m, i - 1) = "Restores program state before last edit"
menu$(m, i) = "#Redo Ctrl+Y": i = i + 1
menuDesc$(m, i - 1) = "Redoes latest undo action"
ELSE
menu$(m, i) = "~#Undo Ctrl+Z": i = i + 1
menuDesc$(m, i - 1) = "Restores program state before last edit"
menu$(m, i) = "~#Redo Ctrl+Y": i = i + 1
menuDesc$(m, i - 1) = "Redoes latest undo action"
END IF
menu$(m, i) = "-": i = i + 1
IF (IdeSystem = 1 AND ideselect = 1) OR IdeSystem = 2 THEN
menu$(m, i) = "Cu#t Shift+Del or Ctrl+X": i = i + 1
menuDesc$(m, i - 1) = "Deletes selected text and copies it to clipboard"
menu$(m, i) = "#Copy Ctrl+Ins or Ctrl+C": i = i + 1
menuDesc$(m, i - 1) = "Copies selected text to clipboard"
ELSEIF (IdeSystem = 3 AND Help_Select = 2) THEN
menu$(m, i) = "~Cu#t Shift+Del or Ctrl+X": i = i + 1
menuDesc$(m, i - 1) = "Deletes selected text and copies it to clipboard"
menu$(m, i) = "#Copy Ctrl+Ins or Ctrl+C": i = i + 1
menuDesc$(m, i - 1) = "Copies selected text to clipboard"
ELSE
menu$(m, i) = "~Cu#t Shift+Del or Ctrl+X": i = i + 1
menuDesc$(m, i - 1) = "Deletes selected text and copies it to clipboard"
menu$(m, i) = "~#Copy Ctrl+Ins or Ctrl+C": i = i + 1
menuDesc$(m, i - 1) = "Copies selected text to clipboard"
END IF
clip$ = _CLIPBOARD$ 'read clipboard
IF (LEN(clip$) > 0 AND IdeSystem = 1) OR IdeSystem = 2 THEN
menu$(m, i) = "#Paste Shift+Ins or Ctrl+V": i = i + 1
menuDesc$(m, i - 1) = "Inserts clipboard contents at current location"
ELSE
menu$(m, i) = "~#Paste Shift+Ins or Ctrl+V": i = i + 1
menuDesc$(m, i - 1) = "Inserts clipboard contents at current location"
END IF
IF (IdeSystem = 1 AND ideselect = 1) OR IdeSystem = 2 THEN
menu$(m, i) = "Cl#ear Del": i = i + 1
menuDesc$(m, i - 1) = "Deletes selected text"
ELSE
menu$(m, i) = "~Cl#ear Del": i = i + 1
menuDesc$(m, i - 1) = "Deletes selected text"
END IF
menu$(m, i) = "Select #All Ctrl+A": i = i + 1
menuDesc$(m, i - 1) = "Selects all contents of current program"
IF IdeSystem = 1 THEN
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "To#ggle Comment Ctrl+T": i = i + 1
menuDesc$(m, i - 1) = "Toggles comment (') on the current selection"
menu$(m, i) = "Add Co#mment (') Ctrl+R": i = i + 1
menuDesc$(m, i - 1) = "Adds comment marker (') to the current selection"
menu$(m, i) = "Remove Comme#nt (') Ctrl+Shift+R": i = i + 1
menuDesc$(m, i - 1) = "Removes comment marker (') from the current selection"
IF ideselect THEN
y1 = idecy
y2 = ideselecty1
IF y1 = y2 THEN 'single line selected
a$ = idegetline(idecy)
a2$ = ""
sx1 = ideselectx1: sx2 = idecx
IF sx2 < sx1 THEN SWAP sx1, sx2
FOR x = sx1 TO sx2 - 1
IF x <= LEN(a$) THEN a2$ = a2$ + MID$(a$, x, 1) ELSE a2$ = a2$ + " "
NEXT
IF a2$ = "" THEN
menu$(m, i) = "~#Increase Indent TAB": i = i + 1
menuDesc$(m, i - 1) = "Increases indentation of the current selection"
menu$(m, i) = "~#Decrease Indent"
menuDesc$(m, i) = "Decreases indentation of the current selection"
IF INSTR(_OS$, "WIN") OR INSTR(_OS$, "MAC") THEN menu$(m, i) = menu$(m, i) + " Shift+TAB"
i = i + 1
ELSE
menu$(m, i) = "#Increase Indent TAB": i = i + 1
menuDesc$(m, i - 1) = "Increases indentation of the current selection"
menu$(m, i) = "#Decrease Indent"
menuDesc$(m, i) = "Decreases indentation of the current selection"
IF INSTR(_OS$, "WIN") OR INSTR(_OS$, "MAC") THEN menu$(m, i) = menu$(m, i) + " Shift+TAB"
i = i + 1
END IF
ELSE
menu$(m, i) = "#Increase Indent TAB": i = i + 1
menuDesc$(m, i - 1) = "Increases indentation of the current selection"
menu$(m, i) = "#Decrease Indent"
menuDesc$(m, i) = "Decreases indentation of the current selection"
IF INSTR(_OS$, "WIN") OR INSTR(_OS$, "MAC") THEN menu$(m, i) = menu$(m, i) + " Shift+TAB"
i = i + 1
END IF
ELSE
menu$(m, i) = "~#Increase Indent TAB": i = i + 1
menuDesc$(m, i - 1) = "Increases indentation of the current selection"
menu$(m, i) = "~#Decrease Indent"
menuDesc$(m, i) = "Decreases indentation of the current selection"
IF INSTR(_OS$, "WIN") OR INSTR(_OS$, "MAC") THEN menu$(m, i) = menu$(m, i) + " Shift+TAB"
i = i + 1
END IF
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "New #SUB...": i = i + 1
menuDesc$(m, i - 1) = "Creates a new subprocedure at the end of the current program"
menu$(m, i) = "New #FUNCTION...": i = i + 1
menuDesc$(m, i - 1) = "Creates a new function at the end of the current program"
ELSE
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "~To#ggle Comment Ctrl+T": i = i + 1
menuDesc$(m, i - 1) = "Toggles comment (') on the current selection"
menu$(m, i) = "~Add Co#mment (') Ctrl+R": i = i + 1
menuDesc$(m, i - 1) = "Adds comment marker (') to the current selection"
menu$(m, i) = "~Remove Comme#nt (') Ctrl+Shift+R": i = i + 1
menuDesc$(m, i - 1) = "Removes comment marker (') from the current selection"
menu$(m, i) = "~#Increase Indent TAB": i = i + 1
menuDesc$(m, i - 1) = "Increases indentation of the current selection"
menu$(m, i) = "~#Decrease Indent"
menuDesc$(m, i) = "Decreases indentation of the current selection"
IF INSTR(_OS$, "WIN") OR INSTR(_OS$, "MAC") THEN menu$(m, i) = menu$(m, i) + " Shift+TAB"
i = i + 1
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "~New #SUB...": i = i + 1
menuDesc$(m, i - 1) = "Creates a new subprocedure at the end of the current program"
menu$(m, i) = "~New #FUNCTION...": i = i + 1
menuDesc$(m, i - 1) = "Creates a new function at the end of the current program"
END IF
menusize(m) = i - 1
END SUB
SUB IdeAddRecent (f2$)
f$ = f2$
f$ = removeDoubleSlashes(f$)
f$ = CRLF + f$ + CRLF
fh = FREEFILE
OPEN ".\internal\temp\recent.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$
x = INSTR(UCASE$(a$), UCASE$(f$))
IF x THEN
a$ = f$ + LEFT$(a$, x - 1) + RIGHT$(a$, LEN(a$) - (x + LEN(f$) - 1))
ELSE
a$ = f$ + a$
END IF
PUT #fh, 1, a$
CLOSE #fh
IdeMakeFileMenu
END SUB
FUNCTION removeDoubleSlashes$(f$)
x = INSTR(f$, "//")
DO WHILE x
f$ = LEFT$(f$, x - 1) + MID$(f$, x + 1)
x = INSTR(f$, "//")
LOOP
x = INSTR(f$, "\\")
DO WHILE x
f$ = LEFT$(f$, x - 1) + MID$(f$, x + 1)
x = INSTR(f$, "\\")
LOOP
removeDoubleSlashes$ = f$
END FUNCTION
SUB IdeAddSearched (s2$)
s$ = s2$ + CRLF
fh = FREEFILE
OPEN ".\internal\temp\searched.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$
x = INSTR(UCASE$(a$), UCASE$(s$))
IF x THEN
a$ = s$ + LEFT$(a$, x - 1) + RIGHT$(a$, LEN(a$) - (x + LEN(s$) - 1))
ELSE
a$ = s$ + a$
END IF
PUT #fh, 1, a$
CLOSE #fh
END SUB
FUNCTION ideupdatehelpbox
ideupdatehelpbox = 0 'all good, getting 1 on error
IF Help_Recaching = 2 THEN
DIM FullMessage$(1 TO 2)
UpdateStep = 1
Help_ww = 78
GOTO startMainLoop
END IF
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
IF idehelp = 0 THEN
old_idesubwindow = idesubwindow: old_idewy = idewy
idesubwindow = idewy \ 2: idewy = idewy - idesubwindow
Help_wx1 = 2: Help_wy1 = idewy + 1: Help_wx2 = idewx - 1: Help_wy2 = idewy + idesubwindow - 2: Help_ww = Help_wx2 - Help_wx1 + 1: Help_wh = Help_wy2 - Help_wy1 + 1
idesubwindow = old_idesubwindow: idewy = old_idewy
END IF
MessageLines = 2
DIM FullMessage$(1 TO 2)
UpdateStep = 1
i = 0
w2 = LEN(titlestr$) + 4
IF w < w2 THEN w = w2
IF w > idewx - 4 THEN w = idewx - 4
idepar p, 60, 6, "Update Help"
i = i + 1
ButtonID = i
o(i).typ = 3
o(i).y = 6
o(i).txt = idenewtxt("#Cancel")
o(i).dft = 1
'-------- end of init --------
'-------- generic init --------
FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects
'-------- end of generic init --------
startMainLoop:
DO 'main loop
IF Help_Recaching = 2 GOTO updateRoutine
'-------- 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 --------
'update steps
SELECT CASE UpdateStep
CASE 1
FullMessage$(2) = "Generating list of cached content..."
CASE 2
FullMessage$(2) = "Adding core help pages to list..."
CASE 3
FullMessage$(2) = "Regenerating keyword list..."
CASE 4
FullMessage$(2) = "Building download queue..."
CASE 5
FullMessage$(1) = "Updating help content file " + str2$(n) + "/" + str2$(c) +"..."
END SELECT
FOR i = 1 TO MessageLines
IF i = 1 THEN COLOR 0, 7 ELSE COLOR 2, 7
IF LEN(FullMessage$(i)) > p.w - 2 THEN
FullMessage$(i) = LEFT$(FullMessage$(i), p.w - 5) + STRING$(3, 250)
END IF
_PRINTSTRING (p.x + (p.w \ 2 - LEN(FullMessage$(i)) \ 2) + 1, p.y + 1 + i), FullMessage$(i)
NEXT i
COLOR 0, 7
IF UpdateStep = 5 THEN
maxprogresswidth = 52 'arbitrary
percentage = INT(n / c * 100)
percentagechars = INT(maxprogresswidth * n / c)
'percentageMsg$ = "[" + STRING$(percentagechars, 254) + SPACE$(maxprogresswidth - percentagechars) + "]" + STR$(percentage) + "%"
percentageMsg$ = STRING$(percentagechars, 219) + STRING$(maxprogresswidth - percentagechars, 176) + STR$(percentage) + "%"
_PRINTSTRING (p.x + (p.w \ 2 - LEN(percentageMsg$) \ 2) + 1, p.y + 4), percentageMsg$
ELSEIF UpdateStep = 6 THEN
percentageMsg$ = STRING$(maxprogresswidth, 219) + " 100%"
_PRINTSTRING (p.x + (p.w \ 2 - LEN(percentageMsg$) \ 2) + 1, p.y + 4), percentageMsg$
END IF
'-------- 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 --------
GetInput
IF mCLICK THEN mousedown = 1
IF mRELEASE THEN mouseup = 1
alt = KALT
oldalt = alt
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 UCASE$(K$) = "C" THEN altletter$ = UCASE$(K$)
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 --------
'specific post controls
IF K$ = CHR$(27) OR K$ = CHR$(13) OR (info <> 0) THEN
IF UpdateStep < 6 THEN q$ = ideyesnobox("", "Cancel download?") ELSE q$ = "Y"
IF q$ = "Y" THEN EXIT FUNCTION
END IF
'end of custom controls
updateRoutine:
'-------- update routine -------------------------------------
SELECT CASE UpdateStep
CASE 1
'Create a list of all files to be recached
IF Help_Recaching < 2 THEN
f$ = CHR$(0) + idezfilelist$("internal/help", 2, "*.txt") + CHR$(0)
IF LEN(f$) = 2 THEN f$ = CHR$(0)
ELSE
f$ = CHR$(0) 'no dir scan for 'qb64 -u' (build time update)
END IF
'Prepend core pages to list
f$ = CHR$(0) + "Keyword_Reference_-_By_usage.txt" + f$
f$ = CHR$(0) + "QB64_Help_Menu.txt" + f$
f$ = CHR$(0) + "QB64_FAQ.txt" + f$
UpdateStep = UpdateStep + 1
CASE 2
UpdateStep = UpdateStep + 1
CASE 3
'Download and PARSE alphabetical index to build required F1 help links
FullMessage$(1) = "Regenerating keyword list..."
a$ = Wiki$("Keyword Reference - Alphabetical")
IF INSTR(a$, "{{PageInternalError}}") > 0 THEN ideupdatehelpbox = 1: EXIT DO
WikiParse a$ 'update links.bin and check for plugin templates
UpdateStep = UpdateStep + 1
CASE 4
'Add all linked pages to download list (if not already in list)
fh = FREEFILE
OPEN "internal\help\links.bin" FOR INPUT AS #fh
DO UNTIL EOF(fh)
LINE INPUT #fh, l$
IF LEN(l$) THEN
c = INSTR(l$, ","): l$ = RIGHT$(l$, LEN(l$) - c)
IF Help_Recaching < 2 OR LEFT$(l$, 3) <> "_gl" THEN 'ignore _GL pages for 'qb64 -u' (build time update)
'Escape all invalid and other critical chars in filenames
PageName2$ = ""
FOR i = 1 TO LEN(l$)
c = ASC(l$, i)
SELECT CASE c
CASE 32 ' '(space)
PageName2$ = PageName2$ + "_"
CASE 34, 36, 38, 42, 43, 47, 58, 60, 62, 63, 92, 124 '("$&*+/:<>?\|)
PageName2$ = PageName2$ + "%" + HEX$(c)
CASE ELSE
PageName2$ = PageName2$ + CHR$(c)
END SELECT
NEXT
PageName2$ = PageName2$ + ".txt"
IF INSTR(f$, CHR$(0) + PageName2$ + CHR$(0)) = 0 THEN
f$ = f$ + PageName2$ + CHR$(0)
END IF
END IF
END IF
LOOP
CLOSE #fh
'Redownload all listed files
IF f$ <> CHR$(0) THEN
c = 0 'count files to download
FOR x = 2 TO LEN(f$)
IF ASC(f$, x) = 0 THEN c = c + 1
NEXT
c = c - 1
f$ = RIGHT$(f$, LEN(f$) - 1)
z$ = CHR$(0)
n = 0
ELSE
GOTO stoprecache
END IF
FullMessage$(2) = ""
UpdateStep = UpdateStep + 1
CASE 5
IF LEN(f$) > 0 THEN
x2 = INSTR(f$, z$)
f2$ = LEFT$(f$, x2 - 1): f$ = RIGHT$(f$, LEN(f$) - x2)
IF RIGHT$(f2$, 4) = ".txt" THEN
f2$ = LEFT$(f2$, LEN(f2$) - 4)
n = n + 1
FullMessage$(2) = "Page title: " + f2$
ignore$ = Wiki$(f2$)
WikiParse ignore$ 'just check for plugin templates
END IF
ELSE
UpdateStep = UpdateStep + 1
END IF
CASE 6
stoprecache:
IF Help_Recaching = 2 THEN EXIT DO
FullMessage$(1) = "All pages updated."
FullMessage$(2) = ""
idetxt(o(ButtonID).txt) = "#Close"
_LIMIT 20
END SELECT
'-------- end of update routine ------------------------------
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
FUNCTION ideASCIIbox$(relaunch)
'-------- generic dialog box header --------
PCOPY 0, 2
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 ASCIIWarningShown
relaunch = 0
i = 0
idepar p, 56, 21, "ASCII Chart"
i = i + 1
o(i).typ = 1 'hidden text box to give focus to the chart
o(i).y = 3
o(i).x = 5
o(i).w = 5
TYPE position
x AS INTEGER
y AS INTEGER
caption AS STRING
END TYPE
DIM asciiTable(1 TO 255) AS position
a = 0
x = 5
y = 2
FOR i = 0 TO 15
FOR j = 0 TO 15
a = a + 1
IF a > 255 THEN EXIT FOR
asciiTable(a).x = p.x + x
asciiTable(a).y = p.y + y
asciiTable(a).caption = " " + CHR$(a) + " "
x = x + 3
NEXT
IF a > 255 THEN EXIT FOR
x = 5
y = y + 1
NEXT
i = i + 1
o(i).typ = 3
o(i).y = 21
o(i).txt = idenewtxt("#Insert character" + sep + "Insert C#HR$" + sep + "#Close")
o(i).dft = 1
Selected = 1
'-------- 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 --------
IF focus = 1 THEN
idebox p.x + 4, p.y + 1, 50, 18
END IF
Hover = 0
FOR i = 1 TO 255
IF mX >= asciiTable(i).x AND mX <= asciiTable(i).x + 2 AND mY = asciiTable(i).y THEN
IF mouseMoved THEN Hover = i: COLOR 7, 0
IF mCLICK THEN
Selected = i
focus = 1
IF timeElapsedSince(lastClick!) <= .3 and lastClickOn = i THEN
'double click on chart
relaunch = -1
GOTO insertChar
END IF
lastClick! = TIMER
lastClickOn = i
END IF
ELSE
COLOR 2, 7
END IF
IF Selected = i THEN COLOR 15, 0
_PRINTSTRING (asciiTable(i).x, asciiTable(i).y), asciiTable(i).caption
NEXT
COLOR 0, 7
IF Selected > 0 THEN
_PRINTSTRING (p.x + 5, p.y + 19), "Selected:" + STR$(Selected)
END IF
COLOR 2, 7
IF Hover > 0 AND Hover <> Selected THEN
_PRINTSTRING (p.x + 5, p.y + 20), "Hovered: " + STR$(Hover)
END IF
'-------- end of custom display changes --------
'update visual page and cursor position
PCOPY 1, 0
IF cx THEN
SCREEN , , 0, 0
IF focus = 1 THEN
IF Selected THEN
LOCATE asciiTable(Selected).y, asciiTable(Selected).x + 1, 1
END IF
ELSE
LOCATE cy, cx, 1
END IF
SCREEN , , 1, 0
END IF
'-------- read input --------
change = 0
mouseMoved = 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
IF mX <> prev.mX OR mY <> prev.mY THEN change = 1: prev.mX = mX: prev.mY = mY: mouseMoved = -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 mY > p.y AND mY < p.y + p.h AND mX > p.x AND mX < p.x + p.w THEN
IF Hover = 0 AND mCLICK THEN focus = 1
END IF
IF (K$ = CHR$(13) AND focus = 1) THEN
GOTO insertChar
END IF
IF focus = 2 AND (K$ = CHR$(13) OR info <> 0) THEN
insertChar:
IF Selected < 32 AND ASCIIWarningShown = 0 THEN
ASCIIWarningShown = -1
result = idemessagebox("Control Characters", "Inserting ASCII control characters (1-32) may cause\nunexpected IDE behavior. Consider inserting CHR$ instead.\nProceed anyway?", "#Yes;#No;#Cancel")
IF result = 2 THEN EXIT FUNCTION
IF result = 3 THEN GOTO dlgLoop
END IF
ideASCIIbox$ = CHR$(Selected)
EXIT FUNCTION
END IF
IF (focus = 3 AND (info <> 0 OR K$ = CHR$(13))) THEN
ideASCIIbox$ = "CHR$(" + str2$(Selected) + ")"
EXIT FUNCTION
END IF
'Cancel:
IF (info <> 0 OR K$ = CHR$(13)) AND focus = 4 THEN EXIT FUNCTION
IF K$ = CHR$(27) THEN EXIT FUNCTION
IF focus = 1 THEN 'chart control (keyboard)
KCTRL = _KEYDOWN(100305) OR _KEYDOWN(100306)
SELECT CASE KB
CASE 18176: Selected = 1 'Home
CASE 20224: Selected = 255 'End
CASE 19712 'Right
IF KCTRL AND Selected > 0 THEN
DO UNTIL Selected MOD 16 = 0 OR Selected = 255
Selected = Selected + 1
LOOP
ELSE
Selected = Selected + 1
END IF
IF Selected > 255 THEN Selected = 1
CASE 19200 'Left
IF KCTRL AND Selected > 0 THEN
DO UNTIL Selected MOD 16 = 1
Selected = Selected - 1
LOOP
ELSE
Selected = Selected - 1
END IF
IF Selected < 1 THEN Selected = 255
CASE 20480 'Down
IF KCTRL AND Selected > 0 THEN
IF Selected = 240 THEN
Selected = 255
ELSE
DO UNTIL Selected >= 240
Selected = Selected + 16
LOOP
END IF
IF Selected > 255 THEN Selected = 255
ELSE
IF Selected = 240 THEN
'corner case
Selected = 255
ELSEIF Selected + 16 <= 255 THEN
Selected = Selected + 16
ELSE
Selected = Selected + 16 - 256
END IF
END IF
CASE 18432 'Up
IF KCTRL AND Selected > 0 THEN
DO UNTIL Selected <= 16
Selected = Selected - 16
LOOP
IF Selected < 1 THEN Selected = 1
ELSE
IF Selected = 16 THEN
'corner case
Selected = 240
ELSEIF Selected - 16 >= 1 THEN
Selected = Selected - 16
ELSE
Selected = Selected - 16 + 256
END IF
END IF
END SELECT
END IF
'end of custom controls
mousedown = 0
mouseup = 0
dlgLoop:
LOOP
END FUNCTION
FUNCTION idef1box$ (lnks$, lnks)
'-------- generic dialog box header --------
PCOPY 0, 2
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 --------
'72,19
i = 0
idepar p, 40, lnks + 3, "Contextual help"
i = i + 1
o(i).typ = 2
o(i).y = 1
'68
o(i).w = 36: o(i).h = lnks
o(i).txt = idenewtxt(lnks$)
o(i).sel = 1
o(i).nam = idenewtxt("Which?")
i = i + 1
o(i).typ = 3
o(i).y = lnks + 3
o(i).txt = idenewtxt("#OK")
o(i).dft = 1
'-------- 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 --------
'-------- 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 K$ = CHR$(13) OR (focus = 2 AND info <> 0) OR (info = 1 AND focus = 1) THEN
f$ = idetxt(o(1).stx)
idef1box$ = f$
EXIT FUNCTION
ELSEIF K$ = CHR$(27) THEN
idef1box$ = "C"
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END FUNCTION
'After Cormen, Leiserson, Rivest & Stein "Introduction To Algoritms" via Wikipedia
SUB sort (arr() AS STRING * 998)
FOR i& = LBOUND(arr) + 1 TO UBOUND(arr)
x$ = arr(i&)
j& = i& - 1
WHILE j& >= LBOUND(arr)
IF arr(j&) <= x$ THEN EXIT WHILE
arr$(j& + 1) = arr$(j&)
j& = j& - 1
WEND
arr$(j& + 1) = x$
NEXT i&
END SUB
FUNCTION FindProposedTitle$
'Finds the first occurence of _TITLE to suggest a file name
'when saving for the first time or saving as.
DIM c AS _BYTE, q AS _BYTE, i
FOR i = 1 TO iden
thisline$ = idegetline(i)
thisline$ = LTRIM$(RTRIM$(thisline$))
found_TITLE = INSTR(UCASE$(thisline$), "_TITLE " + CHR$(34))
IF found_TITLE > 0 THEN
FindQuoteComment thisline$, found_TITLE, c, q
IF NOT q THEN
Find_ClosingQuote = INSTR(found_TITLE + 8, thisline$, CHR$(34))
IF Find_ClosingQuote > 0 THEN
TempFound_TITLE$ = MID$(thisline$, found_TITLE + 8, (Find_ClosingQuote - found_TITLE) - 8)
END IF
EXIT FOR
END IF
END IF
NEXT
InvalidChars$ = ":/\?*><|" + CHR$(34)
FOR i = 1 TO LEN(TempFound_TITLE$)
ThisChar$ = MID$(TempFound_TITLE$, i, 1)
IF INSTR(InvalidChars$, ThisChar$) = 0 THEN
Found_TITLE$ = Found_TITLE$ + ThisChar$
END IF
NEXT i
FindProposedTitle$ = LTRIM$(RTRIM$(Found_TITLE$))
END FUNCTION
FUNCTION FindCurrentSF$ (whichline)
'Get the SUB/FUNCTION name 'whichline' is in.
'The FOR...NEXT loop goes backwards from 'whichline' to the start of the program
'to see if we're inside a SUB/FUNCTION. EXITs FOR once that is figured.
sfname$ = ""
IF whichline > 0 THEN
FOR currSF_CHECK = whichline TO 1 STEP -1
thisline$ = idegetline(currSF_CHECK)
thisline$ = LTRIM$(RTRIM$(thisline$))
isSF = 0
ncthisline$ = UCASE$(thisline$)
IF LEFT$(ncthisline$, 4) = "SUB " THEN isSF = 1
IF LEFT$(ncthisline$, 9) = "FUNCTION " THEN isSF = 2
IF LEFT$(ncthisline$, 7) = "END SUB" AND currSF_CHECK < whichline THEN EXIT FOR
IF LEFT$(ncthisline$, 12) = "END FUNCTION" AND currSF_CHECK < whichline THEN EXIT FOR
IF isSF THEN
IF RIGHT$(ncthisline$, 7) = " STATIC" THEN
thisline$ = RTRIM$(LEFT$(thisline$, LEN(thisline$) - 7))
END IF
IF isSF = 1 THEN
thisline$ = RIGHT$(thisline$, LEN(thisline$) - 4)
ELSE
thisline$ = RIGHT$(thisline$, LEN(thisline$) - 9)
END IF
thisline$ = LTRIM$(RTRIM$(thisline$))
checkargs = INSTR(thisline$, "(")
IF checkargs THEN
sfname$ = RTRIM$(LEFT$(thisline$, checkargs - 1))
ELSE
sfname$ = thisline$
END IF
'It could be that SUB or FUNCTION is inside a DECLARE LIBRARY.
'In such case, it must be ignored:
InsideDECLARE = 0
FOR declib_CHECK = currSF_CHECK TO 1 STEP -1
thisline$ = idegetline(declib_CHECK)
thisline$ = LTRIM$(RTRIM$(thisline$))
ncthisline$ = UCASE$(thisline$)
IF LEFT$(ncthisline$, 8) = "DECLARE " AND INSTR(ncthisline$, " LIBRARY") > 0 THEN InsideDECLARE = -1: EXIT FOR
IF LEFT$(ncthisline$, 11) = "END DECLARE" THEN EXIT FOR
NEXT
IF InsideDECLARE = -1 THEN
sfname$ = ""
ELSE
'Ok, we're not inside a DECLARE LIBRARY block.
'But what if we're past the end of this module's SUBs and FUNCTIONs,
'and all that's left is a bunch of comments or $INCLUDES?
'We'll also check for that:
endedSF = 0
FOR endSF_CHECK = whichline TO iden
thisline$ = idegetline(endSF_CHECK)
thisline$ = LTRIM$(RTRIM$(thisline$))
ncthisline$ = UCASE$(thisline$)
IF LEFT$(ncthisline$, 7) = "END SUB" THEN endedSF = 1: EXIT FOR
IF LEFT$(ncthisline$, 12) = "END FUNCTION" THEN endedSF = 2: EXIT FOR
IF LEFT$(ncthisline$, 4) = "SUB " AND endSF_CHECK = whichline THEN endedSF = 1: EXIT FOR
IF LEFT$(ncthisline$, 9) = "FUNCTION " AND endSF_CHECK = whichline THEN endedSF = 2: EXIT FOR
IF LEFT$(ncthisline$, 4) = "SUB " AND InsideDECLARE = 0 THEN EXIT FOR
IF LEFT$(ncthisline$, 9) = "FUNCTION " AND InsideDECLARE = 0 THEN EXIT FOR
IF LEFT$(ncthisline$, 8) = "DECLARE " AND INSTR(ncthisline$, " LIBRARY") > 0 THEN InsideDECLARE = -1
IF LEFT$(ncthisline$, 11) = "END DECLARE" THEN InsideDECLARE = 0
NEXT
IF endedSF = 0 THEN sfname$ = "" ELSE EXIT FOR
END IF
END IF
NEXT
END IF
FindCurrentSF$ = sfname$
END FUNCTION
SUB AddQuickNavHistory
IF QuickNavTotal > 0 THEN
IF QuickNavHistory(QuickNavTotal).idecy = idecy THEN EXIT SUB
END IF
QuickNavTotal = QuickNavTotal + 1
REDIM _PRESERVE QuickNavHistory(1 TO QuickNavTotal) AS QuickNavType
QuickNavHistory(QuickNavTotal).idecy = idecy
QuickNavHistory(QuickNavTotal).idecx = idecx
QuickNavHistory(QuickNavTotal).idesy = idesy
QuickNavHistory(QuickNavTotal).idesx = idesx
END SUB
SUB UpdateIdeInfo
'show info message (if any)
IF LEN(IdeInfo) THEN
IF ASC(IdeInfo, 1) = 0 THEN
'Show progress bar
IdeInfo = MID$(IdeInfo, 2)
Percentage% = VAL(MID$(IdeInfo, 1, 3))
COLOR 13, 1
_PRINTSTRING (2, idewy - 1), STRING$(((idewx - 2) * Percentage%) / 100, "_")
END IF
END IF
a$ = IdeInfo
IF LEN(a$) > (idewx - 20) THEN a$ = LEFT$(a$, (idewx - 23)) + STRING$(3, 250)
IF LEN(a$) < (idewx - 20) THEN a$ = a$ + SPACE$((idewx - 20) - LEN(a$))
COLOR 0, 3
_PRINTSTRING (2, idewy + idesubwindow), a$
IF LEN(versionStringStatus$) = 0 THEN
versionStringStatus$ = " v" + Version$
IF LEN(AutoBuildMsg$) THEN versionStringStatus$ = versionStringStatus$ + MID$(AutoBuildMsg$, _INSTRREV(AutoBuildMsg$, " "))
versionStringStatus$ = versionStringStatus$ + " "
END IF
'_PRINTSTRING (idewx - 22 - LEN(versionStringStatus$), idewy + idesubwindow), CHR$(179)
COLOR 2, 3
_PRINTSTRING (idewx - 21 - LEN(versionStringStatus$), idewy + idesubwindow), versionStringStatus$
PCOPY 3, 0
END SUB
SUB UpdateMenuHelpLine (a$)
IF LEN(a$) > (idewx - 2) THEN a$ = LEFT$(a$, (idewx - 4)) + STRING$(3, 250)
COLOR 0, 3
_PRINTSTRING (1, idewy + idesubwindow), SPACE$(idewx)
_PRINTSTRING (2, idewy + idesubwindow), a$
END SUB
FUNCTION DarkenFGBG (Action AS _BYTE)
'Darken the interface while compilation is taking place,
'to give a sense of temporary unavailability:
IF Action = 1 THEN
TempDarkerBGColor~& = _RGB32(_RED32(IDEBackgroundColor) * .5, _GREEN32(IDEBackgroundColor) * .5, _BLUE32(IDEBackgroundColor) * .5)
TempDarkerBG2Color~& = _RGB32(_RED32(IDEBackgroundColor2) * .5, _GREEN32(IDEBackgroundColor2) * .5, _BLUE32(IDEBackgroundColor2) * .5)
TempDarkerFGColor~& = _RGB32(_RED32(IDETextColor) * .5, _GREEN32(IDETextColor) * .5, _BLUE32(IDETextColor) * .5)
TempDarkerKWColor~& = _RGB32(_RED32(IDEKeywordColor) * .5, _GREEN32(IDEKeywordColor) * .5, _BLUE32(IDEKeywordColor) * .5)
TempDarkerNumColor~& = _RGB32(_RED32(IDENumbersColor) * .5, _GREEN32(IDENumbersColor) * .5, _BLUE32(IDENumbersColor) * .5)
TempDarkerCommentColor~& = _RGB32(_RED32(IDECommentColor) * .5, _GREEN32(IDECommentColor) * .5, _BLUE32(IDECommentColor) * .5)
TempDarkerIDEChromaColor~& = _RGB32(_RED32(IDEChromaColor) * .5, _GREEN32(IDEChromaColor) * .5, _BLUE32(IDEChromaColor) * .5)
TempDarkerMetaColor~& = _RGB32(_RED32(IDEMetaCommandColor) * .5, _GREEN32(IDEMetaCommandColor) * .5, _BLUE32(IDEMetaCommandColor) * .5)
TempDarkerQuoteColor~& = _RGB32(_RED32(IDEQuoteColor) * .5, _GREEN32(IDEQuoteColor) * .5, _BLUE32(IDEQuoteColor) * .5)
_PALETTECOLOR 1, TempDarkerBGColor~&, 0
_PALETTECOLOR 5, TempDarkerBGColor~&, 0
_PALETTECOLOR 6, TempDarkerBG2Color~&, 0
_PALETTECOLOR 7, TempDarkerIDEChromaColor~&, 0
_PALETTECOLOR 8, TempDarkerNumColor~&, 0
_PALETTECOLOR 10, TempDarkerMetaColor~&, 0
_PALETTECOLOR 11, TempDarkerCommentColor~&, 0
_PALETTECOLOR 12, TempDarkerKWColor~&, 0
_PALETTECOLOR 13, TempDarkerFGColor~&, 0
_PALETTECOLOR 14, TempDarkerQuoteColor~&, 0
ELSE
_PALETTECOLOR 1, IDEBackgroundColor, 0
_PALETTECOLOR 5, IDEBracketHighlightColor, 0
_PALETTECOLOR 6, IDEBackgroundColor2, 0
_PALETTECOLOR 7, IDEChromaColor, 0
_PALETTECOLOR 8, IDENumbersColor, 0
_PALETTECOLOR 10, IDEMetaCommandColor, 0
_PALETTECOLOR 11, IDECommentColor, 0
_PALETTECOLOR 12, IDEKeywordColor, 0
_PALETTECOLOR 13, IDETextColor, 0
_PALETTECOLOR 14, IDEQuoteColor, 0
END IF
DarkenFGBG = 0
END SUB
SUB HideBracketHighlight
'Restore the screen and hide any bracket highlights
'as we're limited to 16 colors and the highlight
'color will be used differently in this dialog.
oldBracketHighlightSetting = brackethighlight
oldMultiHighlightSetting = multihighlight
oldShowLineNumbersUseBG = ShowLineNumbersUseBG
brackethighlight = 0
multihighlight = 0
ShowLineNumbersUseBG = 0
SCREEN , , 0
HideCurrentLineHighlight = -1
ideshowtext
HideCurrentLineHighlight = 0
brackethighlight = oldBracketHighlightSetting
multihighlight = oldMultiHighlightSetting
ShowLineNumbersUseBG = oldShowLineNumbersUseBG
END SUB
SUB LoadColorSchemes
DIM i AS LONG
'Preset built-in schemes
PresetColorSchemes = 10
REDIM ColorSchemes$(1 TO PresetColorSchemes): i = 0
i = i + 1: ColorSchemes$(i) = "Super dark blue|216216216069118147216098078255167000085206085098098098000000039000049078000088108170170170"
i = i + 1: ColorSchemes$(i) = "Dark blue|226226226069147216245128177255177000085255085049196196000000069000068108000147177170170170"
i = i + 1: ColorSchemes$(i) = "QB64 Original|226226226147196235245128177255255085085255085085255255000000170000108177000147177170170170"
i = i + 1: ColorSchemes$(i) = "Classic QB4.5|177177177177177177177177177177177177177177177177177177000000170000000170000147177170170170"
i = i + 1: ColorSchemes$(i) = "CF Dark|226226226115222227255043138255178034185237049157118137043045037010000020088088088170170170"
i = i + 1: ColorSchemes$(i) = "Dark side|255255255206206000245010098000177000085255085049186245011022029100100100000147177170170170"
i = i + 1: ColorSchemes$(i) = "Camouflage|196196196255255255245128177255177000137177147147137020000039029098069020000147177170170170"
i = i + 1: ColorSchemes$(i) = "Plum|186186186255255255245128177255108000085186078085186255059000059088088128000147177170170170"
i = i + 1: ColorSchemes$(i) = "Light green|051051051000000216245128177255157255147177093206206206234255234206255206000147177170170170"
i = i + 1: ColorSchemes$(i) = "All white|051051051000000216245128177206147000059177000206206206255255255245245245000147177170170170"
TotalColorSchemes = PresetColorSchemes
LastValidColorScheme = TotalColorSchemes
'Load user color schemes
i = 0
DO
i = i + 1
result = ReadConfigSetting(colorSchemesSection$, "Scheme" + str2$(i) + "$", value$)
IF result THEN
TotalColorSchemes = TotalColorSchemes + 1
IF TotalColorSchemes > UBOUND(ColorSchemes$) THEN
REDIM _PRESERVE ColorSchemes$(1 TO UBOUND(ColorSchemes$) + 10)
END IF
ColorSchemes$(TotalColorSchemes) = value$
FoundPipe = INSTR(value$, "|")
IF FoundPipe > 0 THEN
IF LEN(MID$(value$, FoundPipe + 1)) = 81 THEN
'Extended schemes (9 colors):
LastValidColorScheme = TotalColorSchemes
value$ = value$ + "170170170"
WriteConfigSetting colorSchemesSection$, "Scheme" + str2$(i) + "$", value$
ColorSchemes$(TotalColorSchemes) = value$
ELSEIF LEN(MID$(value$, FoundPipe + 1)) = 90 THEN
'Extended schemes (10 colors):
LastValidColorScheme = TotalColorSchemes
ELSEIF LEN(MID$(value$, FoundPipe + 1)) = 54 THEN
'Version 1.1 schemes (only 6 colors)
'Convert to extended scheme:
temp$ = LEFT$(value$, FoundPipe)
temp$ = temp$ + MID$(value$, FoundPipe + 1, 9) + "069147216245128177"
temp$ = temp$ + MID$(value$, FoundPipe + 10) + "000147177170170170"
ColorSchemes$(TotalColorSchemes) = temp$
WriteConfigSetting colorSchemesSection$, "Scheme" + str2$(i) + "$", temp$
LastValidColorScheme = TotalColorSchemes
ELSE
GOTO DiscardInvalid
END IF
ELSE
DiscardInvalid:
ColorSchemes$(TotalColorSchemes) = "0"
END IF
ELSE
'No more schemes found
EXIT DO
END IF
LOOP
'End of color schemes
END SUB
FUNCTION BinaryFormatCheck% (pathToCheck$, pathSepToCheck$, fileToCheck$)
file$ = pathToCheck$ + pathSepToCheck$ + fileToCheck$
fh = FREEFILE
OPEN file$ FOR BINARY AS #fh
a$ = SPACE$(LOF(fh))
GET #fh, 1, a$
IF INSTR(a$, CHR$(0)) = 0 THEN CLOSE #fh: EXIT FUNCTION 'not a binary file
a$ = ""
GET #fh, 1, Format%
GET #fh, , Version%
CLOSE #fh
SELECT CASE Format%
CASE 2300 'VBDOS
result = idemessagebox("Invalid format", "VBDOS binary format not supported.", "")
BinaryFormatCheck% = 1
CASE 764 'QBX 7.1
result = idemessagebox("Invalid format", "QBX 7.1 binary format not supported.", "")
BinaryFormatCheck% = 1
CASE 252 'QuickBASIC 4.5
IF INSTR(_OS$, "WIN") THEN
convertUtility$ = "internal\utilities\QB45BIN.exe"
ELSE
convertUtility$ = "./internal/utilities/QB45BIN"
END IF
IF _FILEEXISTS(convertUtility$) THEN
what$ = ideyesnobox("Binary format", "QuickBASIC 4.5 binary format detected. Convert to plain text?")
IF what$ = "Y" THEN
ConvertIt:
IF FileHasExtension(file$) THEN
FOR i = LEN(file$) TO 1 STEP -1
IF ASC(file$, i) = 46 THEN
'keep previous extension
ofile$ = LEFT$(file$, i - 1) + " (converted)" + MID$(file$, i)
EXIT FOR
END IF
NEXT
ELSE
ofile$ = file$ + " (converted).bas"
END IF
SCREEN , , 3, 0
dummy = DarkenFGBG(1)
clearStatusWindow 0
COLOR 15, 1
_PRINTSTRING (2, idewy - 3), "Converting... "
PCOPY 3, 0
convertLine$ = convertUtility$ + " " + QuotedFilename$(file$) + " -o " + QuotedFilename$(ofile$)
SHELL _HIDE convertLine$
clearStatusWindow 0
dummy = DarkenFGBG(0)
PCOPY 3, 0
IF _FILEEXISTS(ofile$) = 0 THEN
result = idemessagebox("Binary format", "Conversion failed.", "")
BinaryFormatCheck% = 2 'conversion failed
ELSE
pathToCheck$ = getfilepath$(ofile$)
IF LEN(pathToCheck$) THEN
fileToCheck$ = MID$(ofile$, LEN(pathToCheck$) + 1)
pathToCheck$ = LEFT$(pathToCheck$, LEN(pathToCheck$) - 1) 'remove path separator
ELSE
fileToCheck$ = ofile$
END IF
END IF
ELSE
BinaryFormatCheck% = 1
END IF
ELSE
IF _FILEEXISTS("internal/support/converter/QB45BIN.bas") = 0 THEN
result = idemessagebox("Binary format", "Conversion utility not found. Cannot open QuickBASIC 4.5 binary format.", "")
BinaryFormatCheck% = 1
EXIT FUNCTION
END IF
what$ = ideyesnobox("Binary format", "QuickBASIC 4.5 binary format detected. Convert to plain text?")
IF what$ = "Y" THEN
'Compile the utility first, then convert the file
IF _DIREXISTS("./internal/utilities") = 0 THEN MKDIR "./internal/utilities"
PCOPY 3, 0
SCREEN , , 3, 0
dummy = DarkenFGBG(1)
clearStatusWindow 0
COLOR 15, 1
_PRINTSTRING (2, idewy - 3), "Preparing to convert..."
PCOPY 3, 0
IF INSTR(_OS$, "WIN") THEN
SHELL _HIDE "qb64 -x internal/support/converter/QB45BIN.bas -o internal/utilities/QB45BIN"
ELSE
SHELL _HIDE "./qb64 -x ./internal/support/converter/QB45BIN.bas -o ./internal/utilities/QB45BIN"
END IF
IF _FILEEXISTS(convertUtility$) THEN GOTO ConvertIt
clearStatusWindow 0
dummy = DarkenFGBG(0)
PCOPY 3, 0
result = idemessagebox("Binary format", "Error launching conversion utility.", "")
END IF
BinaryFormatCheck% = 1
END IF
END SELECT
END FUNCTION
FUNCTION removesymbol2$ (varname$)
i = INSTR(varname$, "~"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "`"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "%"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "&"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "!"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "#"): IF i THEN GOTO foundsymbol
i = INSTR(varname$, "$"): IF i THEN GOTO foundsymbol
removesymbol2$ = varname$
EXIT FUNCTION
foundsymbol:
IF i = 1 THEN removesymbol2$ = varname$: EXIT FUNCTION
removesymbol2$ = LEFT$(varname$, i - 1)
END FUNCTION
SUB cleanSubName (n$)
x = INSTR(n$, "'"): IF x THEN n$ = LEFT$(n$, x - 1)
x = INSTR(n$, ":"): IF x THEN n$ = LEFT$(n$, x - 1)
x = INSTR(n$, " "): IF x THEN n$ = LEFT$(n$, x - 1)
END SUB
SUB clearStatusWindow(whichLine)
COLOR 7, 1
IF whichLine = 0 THEN
FOR whichLine = 1 TO 3
_PRINTSTRING (2, (idewy - 4) + whichLine), SPACE$(idewx - 2)
NEXT
ELSE
_PRINTSTRING (2, (idewy - 4) + whichLine), SPACE$(idewx - 2)
END IF
END SUB
SUB setStatusMessage(row, text$, fg)
COLOR fg
_PRINTSTRING (2, (idewy - 4) + row), text$
PCOPY 3, 0
END SUB
FUNCTION getWordAtCursor$
a$ = idegetline(idecy)
x = idecx
IF x <= LEN(a$) THEN
IF ASC(a$, x) = 32 AND x > 1 THEN
IF ASC(a$, x - 1) <> 32 THEN x = x - 1
END IF
try:
IF alphanumeric(ASC(a$, x)) THEN
x1 = x
DO WHILE x1 > 1
IF alphanumeric(ASC(a$, x1 - 1)) OR ASC(a$, x1 - 1) = 36 THEN x1 = x1 - 1 ELSE EXIT DO
LOOP
x2 = x
DO WHILE x2 < LEN(a$)
IF alphanumeric(ASC(a$, x2 + 1)) OR ASC(a$, x2 + 1) = 36 THEN x2 = x2 + 1 ELSE EXIT DO
LOOP
a2$ = MID$(a$, x1, x2 - x1 + 1)
ELSE
symbol$ = CHR$(ASC(a$, x))
IF symbol$ = CHR$(32) THEN EXIT FUNCTION
IF symbol$ = "~" THEN getWordAtCursor$ = "~": EXIT FUNCTION
IF symbol$ = "`" THEN getWordAtCursor$ = "`": EXIT FUNCTION
IF symbol$ = "%" AND MID$(a$, x + 1) = "&" THEN getWordAtCursor$ = "%&": EXIT FUNCTION
IF symbol$ = "&" AND MID$(a$, x - 1) = "%" THEN getWordAtCursor$ = "%&": EXIT FUNCTION
x1 = x
DO WHILE x1 > 1
IF MID$(a$, x1 - 1, 1) = symbol$ THEN x1 = x1 - 1 ELSE EXIT DO
LOOP
x2 = x
DO WHILE x2 < LEN(a$)
IF MID$(a$, x2 + 1, 1) = symbol$ THEN x2 = x2 + 1 ELSE EXIT DO
LOOP
a2$ = MID$(a$, x1, x2 - x1 + 1)
END IF
getWordAtCursor$ = a2$ 'a2$ now holds the word or character at current cursor position
ELSEIF x = LEN(a$) + 1 AND x > 1 THEN
IF ASC(a$, x - 1) <> 32 THEN x = x - 1: GOTO try
END IF
END FUNCTION
FUNCTION getSelectedText$(multiline AS _BYTE)
IF ideselect THEN
sy1 = ideselecty1
sy2 = idecy
IF sy1 > sy2 THEN SWAP sy1, sy2
sx1 = ideselectx1
sx2 = idecx
IF sx1 > sx2 THEN SWAP sx1, sx2
FOR y = sy1 TO sy2
IF y <= iden THEN
a$ = idegetline(y)
IF sy1 = sy2 THEN 'single line select
FOR x = sx1 TO sx2 - 1
IF x <= LEN(a$) THEN clip$ = clip$ + MID$(a$, x, 1) ELSE clip$ = clip$ + " "
NEXT
ELSE 'multiline select
IF NOT multiline THEN EXIT FUNCTION
IF idecx = 1 AND y = sy2 AND idecy > sy1 THEN GOTO nofinalcopy
clip$ = clip$ + a$ + CHR$(13) + CHR$(10)
nofinalcopy:
IF y = sy2 AND idecx > 1 AND LEN(a$) > 0 THEN clip$ = LEFT$(clip$, LEN(clip$) - 2)
END IF
END IF
NEXT
getSelectedText$ = clip$
END IF
END FUNCTION
SUB delselect
sy1 = ideselecty1
sy2 = idecy
IF sy1 > sy2 THEN SWAP sy1, sy2
sx1 = ideselectx1
sx2 = idecx
IF sx1 > sx2 THEN SWAP sx1, sx2
nolastlinedel = 0
IF sy1 <> sy2 AND idecx = 1 AND idecy > sy1 THEN sy2 = sy2 - 1: nolastlinedel = 1 'ignore last line of multi-line select?
FOR y = sy2 TO sy1 STEP -1
IF sy1 = sy2 AND nolastlinedel = 0 THEN 'single line select
a$ = idegetline(y)
a2$ = ""
IF sx1 <= LEN(a$) THEN a2$ = LEFT$(a$, sx1 - 1) ELSE a2$ = a$
IF sx2 <= LEN(a$) THEN a2$ = a2$ + RIGHT$(a$, LEN(a$) - sx2 + 1)
idesetline y, a2$
ELSE 'multiline select
IF iden = 1 AND y = 1 THEN idesetline y, "" ELSE idedelline y
END IF
NEXT
idecx = sx1: IF sy1 <> sy2 OR nolastlinedel = 1 THEN idecx = 1
idecy = sy1
ideselect = 0
END SUB
SUB insertAtCursor (tempk$)
'insert
IF ideselect THEN delselect
a$ = idegetline(idecy)
IF LEN(a$) < idecx - 1 THEN a$ = a$ + SPACE$(idecx - 1 - LEN(a$))
a$ = LEFT$(a$, idecx - 1) + tempk$ + RIGHT$(a$, LEN(a$) - idecx + 1)
idesetline idecy, converttabs$(a$)
IF PasteCursorAtEnd THEN
'Place the cursor at the end of the inserted content:
idecx = idecx + LEN(tempk$)
END IF
idechangemade = 1
startPausedPending = 0
END SUB
FUNCTION findHelpTopic$(topic$, lnks, firstOnly AS _BYTE)
'check if topic$ is in help links
' - returns a list of help links separated by CHR$(0)
' - returns the total number of links found by changing 'lnks'
lnks = 0: lnks$ = CHR$(0)
fh = FREEFILE
'----------
linksFileExist = _FILEEXISTS("internal\help\links.bin")
IF linksFileExist THEN
OPEN "internal\help\links.bin" FOR INPUT AS #fh
linksFileEmpty = (LOF(fh) = 0): CLOSE #fh
END IF
IF (NOT linksFileExist) OR linksFileEmpty THEN
q$ = ideyesnobox("Help problem", "The help system is not yet initialized,\ndo it now? (Make sure you're online.)")
PCOPY 3, 0: SCREEN , , 3, 0
IF q$ = "N" GOTO noLinksFile
Help_IgnoreCache = 1
a$ = Wiki$("Keyword Reference - Alphabetical")
Help_IgnoreCache = 0
IF INSTR(a$, "{{PageInternalError}}") THEN
lnks = 1: lnks$ = lnks$ + "Initialize" + CHR$(0)
GOTO noLinksFile
END IF
Help_ww = 78: WikiParse a$ 'assume standard IDE width for parsing
END IF
'----------
a2$ = UCASE$(topic$)
OPEN "internal\help\links.bin" FOR INPUT AS #fh
DO UNTIL EOF(fh)
LINE INPUT #fh, l$
c = INSTR(l$, ","): l1$ = LEFT$(l$, c - 1): l2$ = RIGHT$(l$, LEN(l$) - c)
IF a2$ = UCASE$(l1$) OR (qb64prefix_set = 1 AND LEFT$(l1$, 1) = "_" AND a2$ = MID$(l1$, 2)) THEN
IF INSTR(lnks$, CHR$(0) + l2$ + CHR$(0)) = 0 THEN
lnks = lnks + 1
IF firstOnly THEN findHelpTopic$ = l2$: CLOSE #fh: EXIT FUNCTION
IF l2$ = l1$ THEN
lnks$ = CHR$(0) + l2$ + lnks$
ELSE
lnks$ = lnks$ + l2$ + CHR$(0)
END IF
END IF
END IF
LOOP
CLOSE #fh
noLinksFile:
findHelpTopic$ = lnks$
END FUNCTION
FUNCTION isnumber (__a$)
a$ = UCASE$(__a$)
IF LEN(a$) = 0 THEN EXIT FUNCTION
IF INSTR("@&H@&O@&B@", "@" + LEFT$(a$, 2) + "@") THEN isnumber = 1: EXIT FUNCTION
i = INSTR(a$, "~"): IF i THEN GOTO foundsymbol
i = INSTR(a$, "`"): IF i THEN GOTO foundsymbol
i = INSTR(a$, "%"): IF i THEN GOTO foundsymbol
i = INSTR(a$, "&"): IF i THEN GOTO foundsymbol
i = INSTR(a$, "!"): IF i THEN GOTO foundsymbol
i = INSTR(a$, "#"): IF i THEN GOTO foundsymbol
i = INSTR(a$, "$"): IF i THEN GOTO foundsymbol
GOTO proceedWithoutSymbol
foundsymbol:
IF i = 1 THEN EXIT FUNCTION
symbol$ = RIGHT$(a$, LEN(a$) - i + 1)
IF symboltype(symbol$) = 0 THEN EXIT FUNCTION
a$ = LEFT$(a$, i - 1)
proceedWithoutSymbol:
ff = 0
ee = 0
dd = 0
neg = 0
FOR i = 1 TO LEN(a$)
a = ASC(a$, i)
IF a = 45 THEN
IF (i = 1 AND LEN(a$) > 1) OR (i > 1 AND ((dd > 0 AND dd = i - 1) OR (ee > 0 AND ee = i - 1) OR (ff > 0 AND ff = i - 1))) THEN neg = (i = 1): _CONTINUE
EXIT FUNCTION
END IF
IF a = 46 THEN
IF dp = 1 THEN EXIT FUNCTION
dp = 1
_CONTINUE
END IF
IF a = 68 THEN 'dD
IF dd > 0 OR ee > 0 OR ff > 0 THEN EXIT FUNCTION
dd = i
IF neg <> 0 AND dd = 2 THEN EXIT FUNCTION
_CONTINUE
END IF
IF a = 69 THEN 'eE
IF dd > 0 OR ee > 0 OR ff > 0 THEN EXIT FUNCTION
ee = i
IF neg <> 0 AND ee = 2 THEN EXIT FUNCTION
_CONTINUE
END IF
IF a = 70 THEN 'fF
IF dd > 0 OR ee > 0 OR ff > 0 THEN EXIT FUNCTION
ff = i
IF neg <> 0 AND ff = 2 THEN EXIT FUNCTION
_CONTINUE
END IF
IF a = 43 THEN '+
IF (dd > 0 AND dd = i - 1) OR (ee > 0 AND ee = i - 1) OR (ff > 0 AND ff = i - 1) THEN _CONTINUE
EXIT FUNCTION
END IF
IF a >= 48 AND a <= 57 THEN _CONTINUE
EXIT FUNCTION
NEXT
isnumber = 1
END FUNCTION
'$INCLUDE:'wiki\wiki_methods.bas'
SUB purgeprecompiledcontent
IF os$ = "WIN" THEN
CHDIR "internal\c"
SHELL _HIDE "cmd /c purge_all_precompiled_content_win.bat"
CHDIR "..\.."
END IF
IF os$ = "LNX" THEN
CHDIR "./internal/c"
IF INSTR(_OS$, "[MACOSX]") THEN
SHELL _HIDE "./purge_all_precompiled_content_osx.command"
ELSE
SHELL _HIDE "./purge_all_precompiled_content_lnx.sh"
END IF
CHDIR "../.."
END IF
END SUB
SUB printWrapStatus (x AS INTEGER, y AS INTEGER, initialX AS INTEGER, __text$)
DIM text$, nextWord$
DIM AS INTEGER i, findSep, findColorMarker, changeColor, changeColorAfter
text$ = __text$
LOCATE y, x
DO WHILE LEN(_TRIM$(text$))
findSep = INSTR(text$, " ")
IF findSep THEN
nextWord$ = LEFT$(text$, findSep)
ELSE
findSep = LEN(text$)
nextWord$ = text$
END IF
text$ = MID$(text$, findSep + 1)
IF POS(0) + LEN(nextWord$) > _WIDTH THEN
IF CSRLIN + 1 <= (idewy - 4) + 3 THEN
LOCATE CSRLIN + 1, initialX
ELSE
'no more room for printing
EXIT SUB
END IF
END IF
changeColor = 0
changeColorAfter = 0
skipSpace = 0
FOR i = 0 TO 2
findColorMarker = INSTR(nextWord$, CHR$(i))
IF findColorMarker = 1 THEN
nextWord$ = MID$(nextWord$, 2)
changeColor = i + 1
GOSUB applyColorChange
ELSEIF findColorMarker > 0 THEN
nextWord$ = LEFT$(nextWord$, findColorMarker - 1) + MID$(nextWord$, findColorMarker + 1)
IF RIGHT$(nextWord$, 1) = " " THEN
nextWord$ = RTRIM$(nextWord$)
skipSpace = -1
END IF
changeColorAfter = i + 1
END IF
NEXT
PRINT nextWord$;
IF changeColorAfter THEN
changeColor = changeColorAfter
GOSUB applyColorChange
IF skipSpace THEN LOCATE , POS(0) + 1
END IF
LOOP
EXIT SUB
applyColorChange:
SELECT EVERYCASE changeColor
CASE 1
IF _DEFAULTCOLOR <> 11 THEN COLOR 11 ELSE COLOR 7
CASE 2
COLOR 7, 1
CASE 3
COLOR 12, 6
END SELECT
RETURN
END SUB
FUNCTION GetBytes$(__value$, numberOfBytes&)
STATIC previousValue$, getBytesPosition&
value$ = __value$
IF value$ <> previousValue$ THEN
previousValue$ = value$
getBytesPosition& = 1
END IF
IF numberOfBytes& = 0 THEN EXIT FUNCTION
GetBytes$ = MID$(value$, getBytesPosition&, numberOfBytes&)
getBytesPosition& = getBytesPosition& + numberOfBytes&
END FUNCTION
SUB RetrieveSearchHistory (SearchHistory() AS STRING)
fh = FREEFILE
OPEN ".\internal\temp\searched.bin" FOR BINARY AS #fh
REDIM _PRESERVE SearchHistory(1 to 10000) AS STRING
IF LOF(fh) THEN
Do UNTIL EOF(fh)
ln = ln + 1
IF ln > UBOUND(SearchHistory) THEN REDIM _PRESERVE SearchHistory(1 to ln + 10000) AS STRING
LINE INPUT #fh, SearchHistory(ln)
Loop
REDIM _PRESERVE SearchHistory(1 TO ln) AS STRING
ELSE
REDIM SearchHistory(1) AS STRING
SearchHistory(1) = ""
END IF
CLOSE #fh
END SUB
'FUNCTION Download$ (url$, outputVar$, lookFor$, timelimit) STATIC
' 'as seen on http://www.qb64.org/wiki/Downloading_Files
' 'adapted for use in the IDE
' DIM theClient AS LONG, l AS LONG
' DIM prevUrl$, prevUrl2$, url2$, x AS LONG
' DIM e$, url3$, x$, t!, a2$, a$, i AS LONG
' DIM i2 AS LONG, i3 AS LONG, d$, fh AS LONG
' IF url$ <> prevUrl$ OR url$ = "" THEN
' prevUrl$ = url$
' IF url$ = "" THEN
' prevUrl2$ = ""
' IF theClient THEN CLOSE theClient: theClient = 0
' EXIT FUNCTION
' END IF
' url2$ = url$
' x = INSTR(url2$, "/")
' IF x THEN url2$ = LEFT$(url$, x - 1)
' IF url2$ <> prevUrl2$ THEN
' prevUrl2$ = url2$
' IF theClient THEN CLOSE theClient: theClient = 0
' theClient = _OPENCLIENT("TCP/IP:80:" + url2$)
' IF theClient = 0 THEN Download = MKI$(2): prevUrl$ = "": EXIT FUNCTION
' END IF
' e$ = CHR$(13) + CHR$(10) ' end of line characters
' url3$ = RIGHT$(url$, LEN(url$) - x + 1)
' x$ = "GET " + url3$ + " HTTP/1.1" + e$
' x$ = x$ + "Host: " + url2$ + e$ + e$
' PUT #theClient, , x$
' t! = TIMER ' start time
' END IF
' GET #theClient, , a2$
' a$ = a$ + a2$
' i = INSTR(a$, lookFor$)
' IF i THEN
' outputVar$ = a$
' Download = MKI$(1) + MKL$(i) 'indicates download was successful
' prevUrl$ = ""
' prevUrl2$ = ""
' a$ = ""
' CLOSE theClient
' theClient = 0
' EXIT FUNCTION
' END IF ' i
' IF TIMER > t! + timelimit THEN CLOSE theClient: theClient = 0: Download = MKI$(3): prevUrl$ = "": EXIT FUNCTION
' Download = MKI$(0) 'still working
'END FUNCTION