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' IF ASC(idecommand$) = 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$ 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 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$) '(copied from ideopen) ideerror = 2 OPEN path$ + idepathsep$ + f$ FOR INPUT AS #150: CLOSE #150 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) IdeBmkN = 0 ideerror = 1 ideprogname = f$: _TITLE ideprogname + " - QB64" 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 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: LOCATE 1, 1: PRINT menubar$; 'repair menu bar IF c$ <> CHR$(3) THEN COLOR 7, 1: LOCATE idewy - 3, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 2, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 1, 2: PRINT SPACE$(idewx - 2); 'clear status window IF ready THEN LOCATE idewy - 3, 2: PRINT "OK"; 'report OK status IF showexecreated THEN showexecreated = 0 LOCATE idewy - 3, 2 IF MakeAndroid THEN PRINT "Project [programs\android\" + file$ + "] created"; ELSE IF os$ = "LNX" THEN PRINT "Executable file created"; ELSE PRINT ".EXE file created"; END IF IF SaveExeWithSource THEN LOCATE idewy - 2, 2 PRINT "Location: "; COLOR 11, 1 IF path.exe$ = "" THEN path.exe$ = getfilepath$(COMMAND$(0)) IF RIGHT$(path.exe$, 1) <> pathsep$ THEN path.exe$ = path.exe$ + pathsep$ IF POS(0) + LEN(path.exe$) > idewx THEN PRINT "..."; RIGHT$(path.exe$, idewx - 15); ELSE PRINT path.exe$; END IF END IF END IF END IF END IF END IF 'skipdisplay idefocusline = 0 'main loop DO ideloop: idecontextualmenu = 0 idedeltxt 'removes temporary strings (typically created by guibox commands) by setting an index to 0 STATIC ForceResize if IDE_AutoPosition then 'if _SCreenhide = 0 then 'Screenhide currently does not work in Linux, so we need a different check 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 "'[IDE DISPLAY SETTINGS]", "IDE_TopPosition" , str$(_SCREENY) WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_LeftPosition" , str$(_SCREENX) IDE_TopPosition = _SCREENY: IDE_LeftPosition = _SCREENX END IF END IF 'end if end if IF _RESIZE or ForceResize 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 ForceResize = 0 v% = _RESIZEWIDTH \ _FONTWIDTH: IF v% < 80 OR v% > 1000 THEN v% = 80 IF v% <> idewx THEN retval = 1: idewx = v% v% = _RESIZEHEIGHT \ _FONTHEIGHT: IF v% < 25 OR v% > 1000 THEN v% = 25 IF v% <> idewy THEN retval = 1: idewy = v% IF retval = 1 THEN 'screen dimensions have changed and everything must be redrawn/reapplied WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_Width", str$(idewx) WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_Height", str$(idewy) tempf& = _font WIDTH idewx, idewy + idesubwindow _font tempf& GOTO redraweverything END IF END IF END IF IF skipdisplay = 0 THEN LOCATE , , 0 'Get the currently being edited SUB/FUNCTION name to show after the main window title '(standard QB4.5 behavior). The FOR...NEXT loop was taken and adapted from FUNCTION 'idesubs$, but it goes backwards from the current line to the start of the program 'to see if we're inside a SUB/FUNCTION. EXITs FOR once that is figured. sfname$ = "" FOR currSF_CHECK = idecy 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 < idecy THEN EXIT FOR IF LEFT$(ncthisline$, 12) = "END FUNCTION" and currSF_CHECK < idecy 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. '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 = idecy 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 = idecy THEN endedSF = 1: EXIT FOR IF LEFT$(ncthisline$, 9) = "FUNCTION " AND endSF_CHECK = idecy 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 'attempt to cleanse sfname$, just in case there are any comments or other unwanted stuff for CleanseSFNAME = 1 to len(sfname$) select case mid$(sfname$, CleanseSFNAME, 1) case " ", "'", ":" sfname$ = left$(sfname$, CleanseSFNAME - 1) exit for end select next 'update title of main window GOSUB UpdateTitleOfMainWindow 'Draw navigation buttons (QuickNav) GOSUB DrawQuickNav 'update search bar GOSUB UpdateSearchBar 'alter cursor style to match insert mode IF ideinsert THEN LOCATE , , , 0, 31 ELSE LOCATE , , , 8, 8 'display error message (if necessary) IF failed THEN IF LEFT$(IdeInfo, 19) <> "Selection length = " THEN IdeInfo = "" UpdateIdeInfo COLOR 7, 1: LOCATE idewy - 3, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 2, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 1, 2: PRINT SPACE$(idewx - 2); 'clear status window 'scrolling unavailable, but may span multiple lines a$ = MID$(c$, 2, LEN(c$) - 5) l = CVL(RIGHT$(c$, 4)): IF l <> 0 THEN idefocusline = l x = 1 y = idewy - 3 IF l <> 0 AND idecy = l THEN a$ = a$ + " on current line" FOR i = 1 TO LEN(a$) x = x + 1: IF x = idewx THEN x = 2: y = y + 1 IF y > idewy - 1 THEN EXIT FOR LOCATE y, x PRINT CHR$(ASC(a$, i)); NEXT IF l <> 0 AND idecy <> l THEN a$ = " on line" + STR$(l) COLOR 11, 1 FOR i = 1 TO LEN(a$) x = x + 1: IF x = idewx THEN x = 2: y = y + 1 IF y > idewy - 1 THEN EXIT FOR LOCATE y, x PRINT CHR$(ASC(a$, i)); NEXT END IF END IF IF idechangemade THEN COLOR 7, 1: LOCATE idewy - 3, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 2, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 1, 2: PRINT SPACE$(idewx - 2); 'clear status window IdeInfo = "" LOCATE idewy - 3, 2: PRINT "..."; 'assume new compilation will begin 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 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 '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$ + "](DELETE=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 _PALETTECOLOR 2, _RGB32(24, 24, 24) 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 idechangemade THEN IF idelayoutallow THEN idelayoutallow = idelayoutallow - 1 idecurrentlinelayouti = 0 'invalidate idechangemade = 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 IF MakeAndroid THEN 'Cleanup excess files in temp folder SHELL _HIDE "cmd /c del /q " + tmpdir$ + "ret*.txt " + tmpdir$ + "data*.txt " + tmpdir$ + "free*.txt" END IF idecompiling = 1 ide2 = 2 idecompiledline$ = idegetline(1) idereturn$ = idecompiledline$ idecompiledline = 1 EXIT FUNCTION END IF 'idechangemade change = 0 waitforinput: 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 IF (mX <> mox OR mY <> moy) AND mB <> 0 THEN change = 1 'dragging mouse 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 'Hover/click (QuickNav) IF IdeSystem = 1 AND QuickNavTotal > 0 THEN IF mY = 2 THEN IF mX >= 4 AND mX <= 6 THEN QuickNavHover = -1 LOCATE 2, 4 COLOR 15, 3 PRINT " " + CHR$(17) + " back to line "; str2$(QuickNavHistory(QuickNavTotal)); " "; PCOPY 3, 0 IF mB THEN ideselect = 0 idecy = QuickNavHistory(QuickNavTotal) QuickNavTotal = QuickNavTotal - 1 _DELAY .2 GOTO waitforinput END IF ELSE IF QuickNavHover = -1 THEN QuickNavHover = 0 GOSUB UpdateTitleOfMainWindow GOSUB DrawQuickNav PCOPY 3, 0 END IF END IF ELSE IF QuickNavHover = -1 THEN QuickNavHover = 0 GOSUB UpdateTitleOfMainWindow GOSUB DrawQuickNav PCOPY 3, 0 END IF END IF END IF IF KALT THEN 'alt held IF idealthighlight = 0 AND KALTPRESS = -1 THEN 'highlist first letter of each menu item idealthighlight = 1 LOCATE , , 0: COLOR 15, 7: x = 4 FOR i = 1 TO menus LOCATE 1, x: PRINT 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: LOCATE 1, 1: PRINT menubar$; IF ideentermenu = 1 AND KCONTROL = 0 THEN 'alt was pressed then released LOCATE , , , 8, 8: skipdisplay = 0: ideentermenu = 0: GOTO startmenu END IF END IF END IF 'alt not held 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 idefocusline THEN idecx = 1: AddQuickNavHistory idecy: idecy = idefocusline: ideselect = 0: GOTO specialchar IF INSTR(_OS$, "WIN") THEN SHELL _DONTWAIT "explorer /select," + QuotedFilename$(path.exe$ + file$ + extension$) ELSEIF INSTR(_OS$, "MAC") THEN SHELL _DONTWAIT "open " + QuotedFilename$(path.exe$) ELSE SHELL _DONTWAIT "xdg-open " + QuotedFilename$(path.exe$) END IF END IF END IF END IF IF KB = KEY_F5 AND KCTRL THEN 'run detached UseAndroid 0 idemdetached: iderunmode = 1 GOTO idemrunspecial END IF IF KB = KEY_F11 THEN 'make exe only UseAndroid 0 idemexe: iderunmode = 2 GOTO idemrunspecial END IF IF KB = KEY_F5 THEN 'Note: F5 or SHIFT+F5 accepted UseAndroid 0 idemrun: iderunmode = 0 'standard run idemrunspecial: 'run program IF ready <> 0 AND idechangemade = 0 THEN LOCATE , , 0 COLOR 7, 1: LOCATE idewy - 3, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 2, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 1, 2: PRINT SPACE$(idewx - 2); 'clear status window IF idecompiled THEN IF iderunmode = 2 THEN LOCATE idewy - 3, 2 IF os$ = "LNX" THEN PRINT "Already created executable file!"; ELSE PRINT "Already created .EXE file!"; END IF GOTO specialchar END IF DarkenFGBG -1 COLOR 5 LOCATE idewy - 3, 2: PRINT "Starting program..."; ELSE DarkenFGBG -1 color 5 IF os$ = "LNX" THEN LOCATE idewy - 3, 2: PRINT "Creating executable file..."; ELSE LOCATE idewy - 3, 2: PRINT "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 COLOR 7, 1: LOCATE idewy - 3, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 2, 2: PRINT SPACE$(idewx - 2);: LOCATE idewy - 1, 2: PRINT SPACE$(idewx - 2); 'clear status window LOCATE idewy - 3, 2: PRINT "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 , , , 8, 8 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 LOCATE 1, 1: COLOR 0, 7: PRINT 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) END IF IF KCTRL AND KB = KEY_F3 THEN IF IdeSystem = 3 THEN IdeSystem = 1 GOTO idefindjmp END IF IF KB = KEY_F3 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 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: GOTO redraweverything2 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: idewait4mous: idewait4alt idealthighlight = 0 LOCATE , , 0: COLOR 0, 7: LOCATE 1, 1: PRINT 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 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 THEN k = ASC(K$) IF (KSHIFT AND KB = KEY_INSERT) OR (KCONTROL AND UCASE$(K$) = "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 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 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 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 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) + "S" THEN 'DEL 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 END IF END IF GOTO specialchar END IF IF IdeSystem = 3 THEN IF mCLICK OR K$ = CHR$(27) THEN IF (mY = idewy AND mX = idewx - 2) OR K$ = CHR$(27) THEN 'close help 'IF idesubwindow THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt: GOTO ideloop 'idesubwindow = idewy \ 2: idewy = idewy - idesubwindow idewy = idewy + idesubwindow idehelp = 0 idesubwindow = 0 skipdisplay = 0 IdeSystem = 1 retval = 1: GOTO redraweverything2 END IF END IF IF mCLICK THEN IF 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 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 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$ 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 = KEY_DELETE 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) 'assume PAGE l$ = RIGHT$(l$, LEN(l$) - 5) IF mCLICK OR K$ = CHR$(13) THEN mCLICK = 0 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 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: 'identify word or character at current cursor position a$ = idegetline(idecy) x = idecx IF x <= LEN(a$) THEN 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 a2$ = CHR$(ASC(a$, x)) END IF a2$ = UCASE$(a2$) 'check if F1 is in help links fh = FREEFILE OPEN "internal\help\links.bin" FOR INPUT AS #fh lnks = 0: lnks$ = CHR$(0) 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$) THEN IF INSTR(lnks$, CHR$(0) + l2$ + CHR$(0)) = 0 THEN lnks = lnks + 1 IF l2$ = l1$ THEN lnks$ = CHR$(0) + l2$ + lnks$ ELSE lnks$ = lnks$ + l2$ + CHR$(0) END IF END IF END IF LOOP CLOSE #fh 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 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: idewait4mous: idewait4alt: 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 'Standard qb45 behaviour. Allows for quick peek at help then ESC. retval = 1: GOTO redraweverything2 END IF WikiParse a$ IdeSystem = 3 'Standard qb45 behaviour. Allows for quick peek at help then ESC. GOTO specialchar END IF 'lnks END IF 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 idemessagebox "Bookmarks", "No bookmarks exist (Use Alt+Left to create a bookmark)" SCREEN , , 3, 0: idewait4mous: idewait4alt idealthighlight = 0 LOCATE , , 0: COLOR 0, 7: LOCATE 1, 1: PRINT menubar$; GOTO specialchar END IF IF IdeBmkN = 1 THEN IF idecy = IdeBmk(1).y THEN idemessagebox "Bookmarks", "No other bookmarks exist" SCREEN , , 3, 0: idewait4mous: idewait4alt idealthighlight = 0 LOCATE , , 0: COLOR 0, 7: LOCATE 1, 1: PRINT 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 idecy = l idecx = IdeBmk(b).x ideselect = 0 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 char.sep$ = chr$(34) + " =<>+-/\^:;,*()." 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 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 AND mX < idewx AND mY > 2 AND mY < (idewy - 5) THEN 'inside text box if old.mX = mX AND old.mY = mY THEN IF TIMER - last.TBclick# > .5 then GOTO regularTextBox_click 'Double-click on text box: attempt to select "word" clicked idecx = mX - 1 + idesx - 1 idecy = mY - 2 + idesy - 1 IF idecy > iden THEN GOTO regularTextBox_click 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 idecy = mY - 2 + idesy - 1 IF idecy > iden THEN idecy = iden ideselect = 1: ideselectx1 = idecx: ideselecty1 = idecy idemouseselect = 1 wholeword.select = 0 end if END IF END IF DoneWholeWord: IF mCLICK2 THEN 'Second mouse button pressed. invokecontextualmenu: IF mX > 1 AND mX < idewx AND mY > 2 AND mY < (idewy - 5) THEN 'inside text box if ideselect = 0 then 'Right click only positions the cursor if no selection is active idecx = mX - 1 + idesx - 1 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 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 < sx1 OR mX - 1 + idesx - 1 > sx2 THEN ideselect = 0 idecx = mX - 1 + idesx - 1 idecy = mY - 2 + idesy - 1 IF idecy > iden THEN idecy = iden ideshowtext PCOPY 3, 0 END IF IF mY - 2 + idesy - 1 < idecy OR mY - 2 + idesy - 1 > idecy THEN ideselect = 0 idecx = mX - 1 + idesx - 1 idecy = mY - 2 + idesy - 1 IF idecy > iden THEN idecy = iden ideshowtext PCOPY 3, 0 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 idecy = mY - 2 + idesy - 1 IF idecy > iden THEN idecy = iden ideshowtext PCOPY 3, 0 END IF END IF end if idecontextualmenu = 1 IdeMakeContextualMenu 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 AND mX < idewx AND mY > 2 AND mY < idewy - 5 THEN 'inside text box IF idemouseselect = 1 THEN idecx = mX - 1 + idesx - 1 idecy = mY - 2 + idesy - 1 IF idecy > iden THEN idecy = iden END IF END IF END IF IF mB THEN IF mX = 1 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 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 retval = idegotobox 'retval is ignored PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO specialchar END IF IF K$ = CHR$(0) + CHR$(60) THEN 'F2 GOTO idesubsjmp 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: idewait4mous: idewait4alt 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: idewait4mous: idewait4alt IF r$ = "C" THEN CLOSE #150: GOTO skipundo IF r$ = "Y" THEN idesave idepath$ + idepathsep$ + ideprogname$ END IF END IF ideunsaved = 1 ideprogname$ = "" _TITLE "QB64" 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 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 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 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 GOSUB 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 ideselect THEN GOSUB delselect IF INSTR(clip$, CHR$(13)) OR INSTR(clip$, CHR$(10)) THEN 'full lines paste 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 END IF ELSE 'insert single line paste a$ = idegetline(idecy) IF LEN(a$) < idecx - 1 THEN a$ = a$ + SPACE$(idecx - 1 - LEN(a$)) a$ = LEFT$(a$, idecx - 1) + clip$ + RIGHT$(a$, LEN(a$) - idecx + 1) idesetline idecy, converttabs$(a$) IF PasteCursorAtEnd THEN 'Place the cursor at the end of the pasted content: idecx = idecx + len(clip$) END IF END IF idechangemade = 1 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$ = "" 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 idecx = 1 AND y = sy2 AND idecy > sy1 THEN clip$ = clip$ + CHR$(13) + CHR$(10): GOTO nofinalcopy IF clip$ = "" THEN clip$ = a$ ELSE clip$ = clip$ + CHR$(13) + CHR$(10) + a$ nofinalcopy: END IF END IF NEXT IF clip$ <> "" THEN _CLIPBOARD$ = clip$ IF (K$ = CHR$(0) + "S") OR (KSHIFT AND KB = KEY_DELETE) OR (KCONTROL AND UCASE$(K$) = "X") THEN GOSUB 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$) LOOP UNTIL LEN(a$) 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 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 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 RETURN skipgosubs: IF K$ = CHR$(13) THEN IF KSHIFT THEN IF EnteringRGB THEN 'The "Hit Shift+ENTER" message is being shown retval$ = idecolorpicker$(0) ELSE IF ideselect THEN IF ideselecty1 <> idecy THEN GOTO specialchar 'multi line selected END IF a$ = idegetline(idecy) 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 retval$ = idecolorpicker$(-1) END IF GOTO specialchar ELSE ideselect = 0 desiredcolumn = 1 idechangemade = 1 a$ = idegetline(idecy) 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 THEN idechangemade = 1 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$ + idegetline(idecy + 1) idesetline idecy, a$ idedelline idecy + 1 END IF GOTO specialchar END IF IF K$ = CHR$(8) THEN ideselect = 0 idechangemade = 1 '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 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 IF LEN(LTRIM$(RTRIM$(a$))) > 0 THEN idecx = LEN(a$) + 1 ELSE GOTO CheckSpacesBehind END IF 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 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: idewait4mous: idewait4alt 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 END IF NEXT if (y1 = y2) AND idechangemade then ideselectx1 = ideselectx1 + BlockIndentLevel idecx = idecx + BlockIndentLevel end if PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt 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 'standard character IF ideselect THEN GOSUB delselect idechangemade = 1 '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 IdeInfo = "Selection length = " + str2$(sx2 - sx1) UpdateIdeInfo ELSE IdeInfo = "" UpdateIdeInfo END IF ELSE IdeInfo = "" UpdateIdeInfo END IF END IF IF AltSpecial THEN AltSpecial = 0 ideentermenu = 0 KALT = 0 LOCATE 1, 1: COLOR 0, 7: PRINT menubar$ END IF LOOP '-------------------------------------------------------------------------------- startmenu: m = 1 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 = 0 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 1000: GetInput: LOOP UNTIL KALT = 0 KB = KEY_ESC 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 LOCATE 1, 1: COLOR 0, 7: PRINT 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$) FOR i = 1 TO menus a$ = UCASE$(LEFT$(menu$(i, 0), 1)) IF K$ = a$ THEN m = i LOCATE 1, 1: COLOR 0, 7: PRINT 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 LOCATE 1, 1: COLOR 0, 7: PRINT menubar$; 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 LOCATE 1, 1: COLOR 0, 7: PRINT menubar$; PCOPY 3, 0 GOTO showmenu END IF 'possible ALT+??? code? IF KB > 0 AND KB <= 255 THEN IF KALT = 0 THEN iCHECKLATER = 1 LOCATE 1, 1: COLOR 0, 7: PRINT 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 r = 1 IF idecontextualmenu = 1 THEN idectxmenuX = mX: idectxmenuY = mY: m = idecontextualmenuID IdeMakeEditMenu 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 LOCATE 1, xx - 1: COLOR 7, 0: PRINT " " + menu$(m, 0) + " " END IF COLOR 0, 7 '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 = 1 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 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: LOCATE i + yy, xx - 2: PRINT 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 LOCATE i + yy, xx - 1: COLOR 7, 0: PRINT SPACE$(w + 2); 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 8, 0 ELSE COLOR 8, 7 PRINT MID$(m$, x, 1); NEXT ELSE IF r = i THEN LOCATE i + yy, xx - 1: COLOR 7, 0: PRINT 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 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 1000: GetInput: LOOP UNTIL KALT = 0 'wait till alt is released PCOPY 3, 0: SCREEN , , 3, 0 GOTO startmenu2 END IF IF _EXIT THEN ideexit = 1: GOTO ideloop _LIMIT 100 LOOP UNTIL change s = 0 IF mWHEEL THEN PCOPY 3, 0: SCREEN , , 3, 0 GOTO ideloop END IF IF mCLICK2 AND idecontextualmenu 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) THEN PCOPY 3, 0: SCREEN , , 3, 0 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) <> "-" THEN s = r END IF END IF END IF IF mX < xx - 2 OR mX >= xx - 2 + w + 4 OR mY > yy + menusize(m) + 1 or (mY < yy and idecontextualmenu) THEN PCOPY 3, 0: SCREEN , , 3, 0 GOTO ideloop END IF END IF IF not mouseup and not mousedown THEN 'Check if we're hovering on menu options 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 mY = 1 and idecontextualmenu = 0 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 EXIT FOR END IF NEXT END IF oldmx = mX end if END IF IF mB THEN 'top row IF mY = 1 THEN idecontextualmenu = 0 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: idewait4mous: GOTO ideloop 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 IF KB = KEY_RIGHT AND idecontextualmenu = 0 THEN m = m + 1: r = 1 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 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 s = r END IF 'with hotkey K$ = UCASE$(K$) 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$ THEN s = r2: EXIT FOR END IF NEXT IF s THEN IF KALT THEN idehl = 1 ELSE idehl = 0 'set idehl, a shared variable used by various dialogue boxes IF menu$(m, s) = "Comment (add ')" THEN 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 END IF NEXT PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "Uncomment (remove ')" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt 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 END IF END IF END IF NEXT PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "Increase indent TAB" THEN IF ideselect AND ideautoindent = 0 THEN GOTO IdeBlockIncreaseIndent END IF IF LEFT$(menu$(m, s), 15) = "Decrease indent" THEN IF ideselect AND ideautoindent = 0 THEN GOTO IdeBlockDecreaseIndent END IF IF LEFT$(menu$(m, s), 16) = "~Decrease indent" OR menu$(m, s) = "~Increase indent TAB" THEN IF ideautoindent <> 0 THEN ideerrormessage "Not available when auto indent is active (Options/Code Layout)." PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop ELSE PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF END IF IF menu$(m, s) = "#Language..." THEN PCOPY 2, 0 retval = idelanguagebox PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "#Google Android..." THEN PCOPY 2, 0 retval = ideandroidbox 'retval is ignored PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt 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 _FONT 16 END IF skipdisplay = 0 GOTO redraweverything END IF END IF PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "IDE C#olors..." THEN PCOPY 2, 0 retval = idechoosecolorsbox 'retval is ignored PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "Open _RGB color mi#xer" THEN PCOPY 2, 0 retval$ = idecolorpicker$(-1) 'retval is ignored PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "#Advanced..." THEN PCOPY 2, 0 retval = ideadvancedbox 'retval is ignored PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF RIGHT$(menu$(m, s), 19) = "#Swap Mouse Buttons" THEN PCOPY 2, 0 MouseButtonSwapped = NOT MouseButtonSwapped if MouseButtonSwapped then WriteConfigSetting "'[MOUSE SETTINGS]", "SwapMouseButton", "TRUE" menu$(OptionsMenuID, OptionsMenuSwapMouse) = CHR$(7) + "#Swap Mouse Buttons" else WriteConfigSetting "'[MOUSE SETTINGS]", "SwapMouseButton", "FALSE" menu$(OptionsMenuID, OptionsMenuSwapMouse) = "#Swap Mouse Buttons" end if PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF RIGHT$(menu$(m, s), 28) = "Cursor after #pasted content" THEN PCOPY 2, 0 PasteCursorAtEnd = NOT PasteCursorAtEnd if PasteCursorAtEnd then WriteConfigSetting "'[GENERAL SETTINGS]", "PasteCursorAtEnd", "TRUE" menu$(OptionsMenuID, OptionsMenuPasteCursor) = CHR$(7) + "Cursor after #pasted content" else WriteConfigSetting "'[GENERAL SETTINGS]", "PasteCursorAtEnd", "FALSE" menu$(OptionsMenuID, OptionsMenuPasteCursor) = "Cursor after #pasted content" end if PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF RIGHT$(menu$(m, s), 30) = "Save EXE in the source #folder" THEN PCOPY 2, 0 SaveExeWithSource = NOT SaveExeWithSource if SaveExeWithSource then WriteConfigSetting "'[GENERAL SETTINGS]", "SaveExeWithSource", "TRUE" menu$(RunMenuID, RunMenuSaveExeWithSource) = CHR$(7) + "Save EXE in the source #folder" else WriteConfigSetting "'[GENERAL SETTINGS]", "SaveExeWithSource", "FALSE" menu$(RunMenuID, RunMenuSaveExeWithSource) = "Save EXE in the source #folder" end if PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "#Code layout..." THEN PCOPY 2, 0 retval = idelayoutbox IF retval THEN idechangemade = 1: idelayoutallow = 2 'recompile if options changed PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt 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: idewait4mous: idewait4alt 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 idemessagebox "Bookmarks", "No bookmarks exist (Use Alt+Left to create a bookmark)" PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF IdeBmkN = 1 THEN IF idecy = IdeBmk(1).y THEN idemessagebox "Bookmarks", "No other bookmarks exist" PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt 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 idecy = l idecx = IdeBmk(b).x ideselect = 0 SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "#Go to line... Ctrl+G" THEN PCOPY 2, 0 retval = idegotobox 'retval is ignored PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt 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: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "#About..." THEN PCOPY 2, 0 idemessagebox "About", "QB64 Version " + Version$ + " (" + BuildNum$ + ")" PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "ASCII c#hart" THEN PCOPY 2, 0 ideASCIIbox PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt retval = 1 GOTO redraweverything2 GOTO ideloop END IF IF left$(menu$(m, s), 10) = "#Help on '" THEN 'Contextual menu Help PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt 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: idewait4mous: idewait4alt AddQuickNavHistory idecy 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: idewait4mous: idewait4alt AddQuickNavHistory idecy 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: idewait4mous: idewait4alt lnk$ = "QB64 Help Menu" GOTO OpenHelpLnk END IF IF menu$(m, s) = "Keyword #index" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt lnk$ = "Keyword Reference - Alphabetical" GOTO OpenHelpLnk END IF IF menu$(m, s) = "#Keywords by usage" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt 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: idewait4mous: idewait4alt: 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: GOTO redraweverything2 END IF GOTO ideloop END IF IF menu$(m, s) = "#Update current page" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt IF idehelp THEN Help_IgnoreCache = 1 a$ = Wiki$(Back$(Help_Back_Pos)) Help_IgnoreCache = 0 WikiParse a$ END IF GOTO ideloop END IF IF menu$(m, s) = "#Math" THEN Mathbox PCOPY 3, 0: SCREEN , , 3, 0 GOTO ideloop END IF IF menu$(m, s) = "Update all #pages" THEN PCOPY 2, 0 q$ = ideyesnobox("Update Help", "Redownload all cached help content? (~10 min)") PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt IF q$ = "Y" THEN 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 SCREEN , , 4, 4 COLOR 7, 1 CLS PRINT "Generating list of cached content..." 'Create a list of all files to be recached f$ = CHR$(0) + idezfilelist$("internal/help", 1) + CHR$(0) IF LEN(f$) = 2 THEN f$ = CHR$(0) '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$ PRINT "Adding core help pages added to list..." 'Download and PARSE alphabetical index to build required F1 help links PRINT "Regenerating keyword list..." Help_Recaching = 1: Help_IgnoreCache = 1 a$ = Wiki$("Keyword Reference - Alphabetical") Help_Recaching = 0: Help_IgnoreCache = 0 WikiParse a$ '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$, ","): PageName2$ = RIGHT$(l$, LEN(l$) - c) DO WHILE INSTR(PageName2$, " ") ASC(PageName2$, INSTR(PageName2$, " ")) = 95 LOOP DO WHILE INSTR(PageName2$, "&") i = INSTR(PageName2$, "&") PageName2$ = LEFT$(PageName2$, i - 1) + "%26" + RIGHT$(PageName2$, LEN(PageName2$) - i) LOOP DO WHILE INSTR(PageName2$, "/") i = INSTR(PageName2$, "/") PageName2$ = LEFT$(PageName2$, i - 1) + "%2F" + RIGHT$(PageName2$, LEN(PageName2$) - i) LOOP PageName2$ = PageName2$ + ".txt" IF INSTR(f$, CHR$(0) + PageName2$ + CHR$(0)) = 0 THEN f$ = f$ + PageName2$ + CHR$(0) 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 PRINT "Updating"; c; "help content files: (Press ESC to cancel)" f$ = RIGHT$(f$, LEN(f$) - 1) z$ = CHR$(0) n = 0 DO UNTIL LEN(f$) = 0 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 PRINT "(" + str2$(n) + "/" + str2$(c) + ") " + f2$ Help_IgnoreCache = 1: Help_Recaching = 1: ignore$ = Wiki(f2$): Help_Recaching = 0: Help_IgnoreCache = 0 END IF GetInput DO WHILE iCHANGED IF K$ = CHR$(27) THEN GOTO stoprecache GetInput LOOP LOOP END IF stoprecache: PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt 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: idewait4mous: idewait4alt 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: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "#SUBs... F2" THEN PCOPY 2, 0 idesubsjmp: r$ = idesubs IF r$ <> "C" THEN ideselect = 0 PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "#Find... Ctrl+F3" THEN PCOPY 2, 0 idefindjmp: r$ = idefind PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt '... 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: idewait4mous: idewait4alt GOTO idemf3 END IF IF menu$(m, s) = "#Change..." THEN PCOPY 2, 0 r$ = idechange PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt IF r$ = "C" OR r$ = "" THEN GOTO ideloop 'assume "V", verify changes IdeAddSearched idefindtext oldcx = idecx: oldcy = idecy found = 0: looped = 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 IF x THEN ideselect = 1 idecx = x: idecy = y 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: idewait4mous: idewait4alt ideselect = 0 IF r$ = "C" THEN idecx = oldcx: idecy = oldcy: GOTO ideloop IF r$ = "Y" THEN l$ = idegetline(idecy) idechangemade = 1 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$ 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 found THEN ideshowtext SCREEN , , 0, 0: LOCATE , , 1: SCREEN , , 3, 0 PCOPY 3, 0 idechanged ELSE idenomatch END IF PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt 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: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "#Repeat Last Find (Shift+) F3" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO idemf3 END IF IF menu$(m, s) = "Cl#ear Del" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt IF ideselect = 1 THEN idechangemade = 1 GOSUB delselect END IF GOTO ideloop END IF IF menu$(m, s) = "#Paste Shift+Ins or Ctrl+V" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO idempaste END IF IF menu$(m, s) = "#Copy Ctrl+Ins or Ctrl+C" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt IF ideselect = 1 THEN GOTO copy2clip GOTO ideloop END IF IF menu$(m, s) = "Cu#t Shift+Del or Ctrl+X" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt IF ideselect = 1 THEN K$ = CHR$(0) + "S" 'tricks handler into del after copy GOTO idemcut END IF GOTO ideloop END IF IF menu$(m, s) = "#Undo Ctrl+Z" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO idemundo END IF IF menu$(m, s) = "#Redo Ctrl+Y" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO idemredo END IF IF menu$(m, s) = "Select #All Ctrl+A" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO idemselectall END IF menu$(m, i) = "Select #All Ctrl+A": i = i + 1 IF menu$(m, s) = "#Start F5" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt UseAndroid 0 GOTO idemrun END IF IF menu$(m, s) = "Modify #COMMAND$..." THEN PCOPY 2, 0 retval = idemodifycommandbox 'retval is ignored PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "Make #Android Project" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt UseAndroid 1 GOTO idemrun END IF IF menu$(m, s) = "Start (#Detached) Ctrl+F5" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt UseAndroid 0 GOTO idemdetached 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: idewait4mous: idewait4alt UseAndroid 0 GOTO idemexe 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: idewait4mous: idewait4alt IF r$ = "C" THEN GOTO ideloop IF r$ = "Y" THEN IF ideprogname = "" THEN ProposedTitle$ = FindProposedTitle$ IF ProposedTitle$ = "" THEN r$ = idesaveas$("untitled" + tempfolderindexstr$ + ".bas") ELSE r$ = idesaveas$(ProposedTitle$ + ".bas") END IF IF r$ = "C" THEN PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt: GOTO ideloop END IF 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" THEN PCOPY 2, 0 IF ideunsaved = 1 THEN r$ = idesavenow PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt IF r$ = "C" THEN GOTO ideloop IF r$ = "Y" THEN IF ideprogname = "" THEN ProposedTitle$ = FindProposedTitle$ IF ProposedTitle$ = "" THEN r$ = idesaveas$("untitled" + tempfolderindexstr$ + ".bas") ELSE r$ = idesaveas$(ProposedTitle$ + ".bas") END IF PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt IF r$ = "C" THEN GOTO ideloop ELSE idesave idepath$ + idepathsep$ + ideprogname$ END IF END IF END IF ideunsaved = -1 'new blank text field idet$ = MKL$(0) + MKL$(0): idel = 1: ideli = 1: iden = 1: IdeBmkN = 0 idesx = 1 idesy = 1 idecx = 1 idecy = 1 ideselect = 0 ideprogname$ = "" QuickNavTotal = 0 ModifyCOMMAND$ = "" _TITLE "QB64" idechangemade = 1 ideundobase = 0 'reset GOTO ideloop END IF AttemptToLoadRecent = 0 FOR ml = 1 TO 4 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$ = "" 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: idewait4mous: idewait4alt GOTO ideloop ELSE goto ideshowrecentbox END IF ELSEIF f$ = "" 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: idewait4mous: idewait4alt 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: idewait4mous: idewait4alt GOTO ideloop END IF PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF IF menu$(m, s) = "#Open..." THEN IdeOpenFile$ = "" directopen: PCOPY 2, 0 IF ideunsaved THEN r$ = idesavenow PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt IF r$ = "C" THEN GOTO ideloop IF r$ = "Y" THEN IF ideprogname = "" THEN ProposedTitle$ = FindProposedTitle$ IF ProposedTitle$ = "" THEN r$ = idesaveas$("untitled" + tempfolderindexstr$ + ".bas") ELSE r$ = idesaveas$(ProposedTitle$ + ".bas") END IF IF r$ = "C" THEN GOTO ideloop ELSE idesave idepath$ + idepathsep$ + ideprogname$ END IF PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt END IF '"Y" END IF 'unsaved r$ = ideopen IF r$ <> "C" THEN ideunsaved = -1: idechangemade = 1: idelayoutallow = 2: ideundobase = 0: QuickNavTotal = 0: ModifyCOMMAND$ = "" PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt: GOTO ideloop END IF IF menu$(m, s) = "#Save" THEN PCOPY 2, 0 IF ideprogname = "" THEN ProposedTitle$ = FindProposedTitle$ IF ProposedTitle$ = "" THEN a$ = idesaveas$("untitled" + tempfolderindexstr$ + ".bas") ELSE a$ = idesaveas$(ProposedTitle$ + ".bas") END IF ELSE idesave idepath$ + idepathsep$ + ideprogname$ END IF PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt: GOTO ideloop END IF IF menu$(m, s) = "Save #As..." THEN PCOPY 2, 0 IF ideprogname = "" THEN ProposedTitle$ = FindProposedTitle$ IF ProposedTitle$ = "" THEN a$ = idesaveas$("untitled" + tempfolderindexstr$ + ".bas") ELSE a$ = idesaveas$(ProposedTitle$ + ".bas") END IF ELSE a$ = idesaveas$(ideprogname$) END IF PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt: GOTO ideloop END IF IF left$(menu$(m, s),1) = "~" THEN 'Ignore disabled items (starting with "~") PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt: GOTO ideloop END IF SCREEN , , 0, 0 CLS: PRINT "MENU ITEM [" + menu$(m, s) + "] NOT IMPLEMENTED!": END END IF _LIMIT 100 LOOP '-------------------------------------------------------------------------------- EXIT FUNCTION UpdateTitleOfMainWindow: COLOR 7, 1: LOCATE 2, 2: PRINT STRING$(idewx - 2, chr$(196)); IF LEN(ideprogname) THEN a$ = ideprogname ELSE a$ = "Untitled" + tempfolderindexstr$ 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 LOCATE 2, ((idewx / 2) - 1) - (LEN(a$) - 1) \ 2: PRINT a$; RETURN DrawQuickNav: IF IdeSystem = 1 AND QuickNavTotal > 0 THEN LOCATE 2, 4 COLOR 15, 7 PRINT " " + CHR$(17) + " "; ELSE COLOR 7, 1 LOCATE 2, 4 PRINT STRING$(3, 196); END IF RETURN UpdateSearchBar: LOCATE idewy - 4, idewx - (idesystem2.w + 10) COLOR 7, 1: PRINT chr$(180); IF IdeSystem = 2 THEN COLOR 1, 3 ELSE COLOR 3, 1 PRINT "Find"; COLOR 3, 1 PRINT "[" + SPACE$(idesystem2.w + 1) + chr$(18) + "]"; COLOR 7, 1: PRINT chr$(195); 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 LOCATE idewy - 4, idewx - (idesystem2.w + 8) + 4: PRINT 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 LOCATE idewy - 4, idewx - (idesystem2.w + 8) + 4 - 1 + ColorCHAR PRINT 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 ideerrormessage "All files in the list are accessible." 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 END FUNCTION SUB idebox (x, y, w, h) LOCATE y, x: PRINT chr$(218) + STRING$(w - 2, 196) + chr$(191); FOR y2 = y + 1 TO y + h - 2 LOCATE y2, x: PRINT chr$(179) + SPACE$(w - 2) + chr$(179); NEXT LOCATE y + h - 1, x: PRINT chr$(192) + STRING$(w - 2, 196) + chr$(217); END SUB SUB ideboxshadow (x, y, w, h) LOCATE y, x: PRINT chr$(218) + STRING$(w - 2, 196) + chr$(191); FOR y2 = y + 1 TO y + h - 2 LOCATE y2, x: PRINT chr$(179) + SPACE$(w - 2) + chr$(179); NEXT LOCATE y + h - 1, x: PRINT chr$(192) + STRING$(w - 2, 196) + chr$(217); 'shadow COLOR 8, 0 FOR y2 = y + 1 TO y + h - 1 FOR x2 = x + w TO x + w + 1 IF x2 <= idewx AND y2 <= idewy THEN LOCATE y2, x2: PRINT CHR$(SCREEN(y2, x2)); END IF NEXT NEXT y2 = y + h IF y2 <= idewy THEN FOR x2 = x + 2 TO x + w + 1 IF x2 <= idewx THEN LOCATE y2, x2: PRINT 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 oo 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 'retrieve search history ln = 0 fh = FREEFILE OPEN ".\internal\temp\searched.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$ CLOSE #fh a$ = RIGHT$(a$, LEN(a$) - 2) 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) ln = ln + 1 REDIM _PRESERVE SearchHistory(1 to ln) SearchHistory(ln) = f$ END IF LOOP ln = 0 i = 0 idepar p, 60, 12, "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 = 3 o(i).y = 12 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 -------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 IF K$ = CHR$(27) OR (focus = 8 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 = 7 AND info <> 0 THEN 'change all idefindcasesens = o(3).sel idefindwholeword = o(4).sel idefindbackwards = o(5).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 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 IF x THEN l2$ = l2$ + MID$(l$, x1, x - x1) + idechangeto$ 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$: changed = 1 NEXT IF changed = 0 THEN idenomatch ELSE idechanged: idechangemade = 1 EXIT FUNCTION END IF 'change all IF (focus = 6 AND info <> 0) OR K$ = CHR$(13) THEN idefindcasesens = o(3).sel idefindwholeword = o(4).sel idefindbackwards = o(5).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 END FUNCTION SUB idechanged '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 idepar p, 19, 4, "" i = i + 1 o(i).typ = 3 o(i).y = 4 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 -------- COLOR 0, 7: LOCATE p.y + 2, p.x + 3: PRINT "Change Complete"; '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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$) = "Y" THEN altletter$ = "Y" IF UCASE$(K$) = "N" THEN altletter$ = "N" '-------- 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 EXIT SUB END IF IF info THEN EXIT SUB END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP 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 oo 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 = 21 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 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 LOCATE y, x: PRINT 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 LOCATE y, x - 1 + ColorCHAR PRINT 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 IF o.sel = n THEN COLOR 7, 0 ELSE COLOR 0, 7 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 LOCATE o.par.y + o.y + y, o.par.x + o.x + 1 a3$ = " " + a3$ + SPACE$(o.w) a3$ = LEFT$(a3$, o.w) PRINT a3$; 'customization specific for the SUBs list, when there are external procedures: if instr(a3$, chr$(196)+"*") > 0 THEN IF o.sel = n THEN COLOR 8, 0 ELSE COLOR 8, 7 LOCATE o.par.y + o.y + y, o.par.x + o.x + 4 PRINT "*"; 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: LOCATE p.y, p.x + (p.w \ 2) - (x - 1) \ 2: PRINT " " + idetxt(p.nam) + " "; END IF END SUB SUB ideerrormessage (mess$) '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 idepar p, LEN(mess$) + 4, 4, "" i = i + 1 o(i).typ = 3 o(i).y = 4 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 -------- COLOR 0, 7: LOCATE p.y + 2, p.x + 3: PRINT mess$; '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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$) = "Y" THEN altletter$ = "Y" IF UCASE$(K$) = "N" THEN altletter$ = "N" '-------- 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 EXIT SUB END IF IF info THEN EXIT SUB END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END SUB FUNCTION idefileexists$ '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 'idepar p, 30, 6, "File already exists. Overwrite?" idepar p, 35, 4, "" i = i + 1 o(i).typ = 3 o(i).y = 4 o(i).txt = idenewtxt("#Yes" + sep + "#No") 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: LOCATE p.y + 2, p.x + 3: PRINT "File already exists. Overwrite?"; '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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$) = "Y" THEN altletter$ = "Y" IF UCASE$(K$) = "N" THEN altletter$ = "N" '-------- 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 idefileexists$ = "N" EXIT FUNCTION END IF IF info THEN IF info = 1 THEN idefileexists$ = "Y" ELSE idefileexists$ = "N" EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP 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 oo 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 'retrieve search history ln = 0 fh = FREEFILE OPEN ".\internal\temp\searched.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$ CLOSE #fh a$ = RIGHT$(a$, LEN(a$) - 2) 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) ln = ln + 1 REDIM _PRESERVE SearchHistory(1 to ln) SearchHistory(ln) = f$ END IF LOOP ln = 0 i = 0 idepar p, 60, 9, "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 = 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 = 6 AND info <> 0) THEN idefind$ = "C" EXIT FUNCTION END IF IF K$ = CHR$(13) OR (focus = 5 AND info <> 0) THEN idefindcasesens = o(2).sel idefindwholeword = o(3).sel idefindbackwards = o(4).sel s$ = idetxt(o(1).txt) idefindtext$ = s$ IdeAddSearched idefindtext idefindagain 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 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 ideselect = 1 idecx = x: idecy = y ideselectx1 = x + LEN(s$): ideselecty1 = y IF idefindinvert THEN IF idefindbackwards = 0 THEN idefindbackwards = 1 ELSE idefindbackwards = 0 idefindinvert = 0 END IF EXIT SUB END IF IF idefindbackwards THEN y = y - 1 IF y = start - 1 AND looped = 1 THEN idenomatch 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 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 idegotoline (i) IF idel = i THEN EXIT SUB IF i < 1 THEN ERROR 5 '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 LOCATE y, x: PRINT CHR$(27); LOCATE y, x + h - 1: PRINT CHR$(26); FOR x2 = x + 1 TO x + h - 2 LOCATE y, x2: PRINT 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 LOCATE y, x2: PRINT 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 LOCATE y, x2: PRINT chr$(219); idehbar = x2 EXIT FUNCTION END IF IF i = n THEN x2 = x + h - 2 LOCATE y, x2: PRINT 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!) LOCATE y, x2: PRINT 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 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 SUB idenewsf (sf 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- 'built 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 i = 0 idepar p, 60, 5, "New " + sf$ i = i + 1 PrevFocus = 1 o(i).typ = 1 o(i).y = 2 o(i).nam = idenewtxt("#Name") o(i).txt = idenewtxt(a2$) if len(a2$) > 0 then o(i).issel = -1 o(i).sx1 = 0 o(i).v1 = LEN(a2$) 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 = 3 AND info <> 0) THEN EXIT SUB END IF IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) THEN y = iden y = y + 1: idesetline y, "" y = y + 1: idesetline y, sf$ + " " + idetxt(o(1).txt) idesy = y y = y + 1: idesetline y, "" idecy = y y = y + 1: idesetline y, "END " + sf$ idecx = 1: idesx = 1 idechangemade = 1 EXIT SUB END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END SUB FUNCTION idenewtxt (a$) idetxtlast = idetxtlast + 1 idetxt$(idetxtlast) = a$ idenewtxt = idetxtlast END FUNCTION SUB idenomatch '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 idepar p, 19, 4, "" i = i + 1 o(i).typ = 3 o(i).y = 4 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 -------- COLOR 0, 7: LOCATE p.y + 2, p.x + 3: PRINT "Match not found"; '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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$) = "Y" THEN altletter$ = "Y" IF UCASE$(K$) = "N" THEN altletter$ = "N" '-------- 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 EXIT SUB END IF IF info THEN EXIT SUB END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END SUB FUNCTION ideopen$ 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 oo 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 idepar p, 70, idewy + idesubwindow - 7, "Open" i = i + 1 PrevFocus = 1 o(i).typ = 1 o(i).y = 2 o(i).nam = idenewtxt("File #Name") 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 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 LEN(IdeOpenFile) 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: LOCATE p.y + 4, p.x + 2: PRINT "Path: "; a$ = path$ w = p.w - 8 IF LEN(a$) > w - 3 THEN a$ = string$(3, 250) + RIGHT$(a$, w - 3) PRINT 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 _LIMIT 100 LOOP UNTIL change IF alt THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 AllFiles = 1 AND o(4).sel <> 0 THEN AllFiles = 0 idetxt(o(2).txt) = idezfilelist$(path$, AllFiles) o(2).sel = -1 GOTO ideopenloop END IF IF AllFiles = 0 AND o(4).sel = 0 THEN AllFiles = 1 idetxt(o(2).txt) = idezfilelist$(path$, AllFiles) o(2).sel = -1 GOTO ideopenloop END IF IF K$ = CHR$(27) OR (focus = 6 AND info <> 0) THEN ideopen$ = "C" EXIT FUNCTION END IF IF idetxt(o(2).stx) <> "" THEN idetxt(o(1).txt) = idetxt(o(2).stx) o(1).v1 = LEN(idetxt(o(1).txt)) END IF IF focus = 3 THEN IF K$ = CHR$(13) OR info = 1 THEN path$ = idezchangepath(path$, idetxt(o(3).stx)) 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 'load file IF K$ = CHR$(13) OR (info = 1 AND focus = 2) OR (focus = 5 AND info <> 0) THEN f$ = idetxt(o(1).txt) 'change path? IF f$ = ".." OR f$ = "." THEN f$ = f$ + idepathsep$ IF RIGHT$(f$, 1) = idepathsep$ THEN path$ = idezgetfilepath$(path$, f$) 'note: path ending with pathsep needn't contain a file idetxt(o(1).txt) = "" 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 'add .bas if not given IF (LCASE$(RIGHT$(f$, 4)) <> ".bas") AND AllFiles = 0 THEN f$ = f$ + ".bas" DirectLoad: 'check/acquire file path path$ = idezgetfilepath$(path$, f$) 'check file exists ideerror = 2 OPEN path$ + idepathsep$ + f$ FOR INPUT AS #150: CLOSE #150 '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 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) ideerror = 1 ideprogname = f$: _TITLE ideprogname + " - QB64" idepath$ = path$ IdeAddRecent idepath$ + idepathsep$ + ideprogname$ IdeImportBookmarks idepath$ + idepathsep$ + ideprogname$ EXIT FUNCTION 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$) END SUB FUNCTION iderestore$ '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 'idepar p, 30, 6, "File already exists. Overwrite?" idepar p, 43, 4, "" i = i + 1 o(i).typ = 3 o(i).y = 4 o(i).txt = idenewtxt("#Yes" + sep + "#No") 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: LOCATE p.y + 2, p.x + 3: PRINT "Recover program from auto-saved backup?"; '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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$) = "Y" THEN altletter$ = "Y" IF UCASE$(K$) = "N" THEN altletter$ = "N" '-------- 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 info THEN IF info = 1 THEN iderestore$ = "Y" ELSE iderestore$ = "N" EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END FUNCTION FUNCTION ideclearhistory$(WhichHistory$) '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 'idepar p, 30, 6, "File already exists. Overwrite?" idepar p, 48, 4, "" i = i + 1 o(i).typ = 3 o(i).y = 4 o(i).txt = idenewtxt("#Yes" + sep + "#No") 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: LOCATE p.y + 2, p.x + 3 SELECT CASE WhichHistory$ CASE "SEARCH": PRINT "This cannot be undone. Clear search history?"; CASE "FILES": PRINT " This cannot be undone. Clear recent files?"; CASE "INVALID": PRINT " Remove broken links from recent files?"; END SELECT '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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$) = "Y" THEN altletter$ = "Y" IF UCASE$(K$) = "N" THEN altletter$ = "N" '-------- 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 info THEN IF info = 1 THEN ideclearhistory$ = "Y" ELSE ideclearhistory$ = "N" EXIT FUNCTION END IF IF K$ = CHR$(27) THEN ideclearhistory$ = "N" EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END FUNCTION SUB idesave (f$) OPEN f$ FOR OUTPUT AS #151 FOR i = 1 TO iden a$ = idegetline(i) PRINT #151, a$ NEXT CLOSE #151 IdeSaveBookmarks f$ ideunsaved = 0 END SUB FUNCTION idesaveas$ (programname$) '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- path$ = idepath$ pathlist$ = idezpathlist$(path$) i = 0 idepar p, 48, idewy + idesubwindow - 7, "Save As" i = i + 1 PrevFocus = 1 o(i).typ = 1 o(i).y = 2 o(i).nam = idenewtxt("File #Name") o(i).txt = idenewtxt(programname$) o(i).issel = -1 o(i).sx1 = 0 o(i).v1 = LEN(programname$) 'i = i + 1 'o(i).typ = 2 'o(i).y = 5 'o(i).w = 32: o(i).h = 11 'o(i).nam = idenewtxt("#Files") 'o(i).txt = idenewtxt(filelist$): filelist$ = "" i = i + 1 o(i).typ = 2 'o(i).x = 10: o(i).y = 5 o(i).w = 44: o(i).h = idewy + idesubwindow - 14 o(i).nam = idenewtxt("#Paths") o(i).txt = idenewtxt(pathlist$): pathlist$ = "" 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 -------- 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: LOCATE p.y + 4, p.x + 2: PRINT "Path: "; a$ = path$ w = p.w - 8 IF LEN(a$) > w - 3 THEN a$ = string$(3, 250) + RIGHT$(a$, w - 3) PRINT 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 _LIMIT 100 LOOP UNTIL change IF alt THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 = 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 = 4 AND info <> 0) THEN idesaveas$ = "C" EXIT FUNCTION END IF IF focus = 2 THEN IF K$ = CHR$(13) OR info = 1 THEN path$ = idezchangepath(path$, idetxt(o(2).stx)) idetxt(o(2).txt) = idezpathlist$(path$) o(2).sel = 1 IF info = 1 THEN o(2).sel = -1 END IF END IF IF (K$ = CHR$(13) AND focus <> 2) OR (focus = 3 AND info <> 0) THEN f$ = idetxt(o(1).txt) 'change path? IF f$ = ".." OR f$ = "." THEN f$ = f$ + idepathsep$ IF RIGHT$(f$, 1) = idepathsep$ THEN path$ = idezgetfilepath$(path$, f$) 'note: path ending with pathsep needn't contain a file idetxt(o(1).txt) = "" idetxt(o(2).txt) = idezpathlist$(path$) o(2).sel = -1 GOTO idesaveasloop END IF IF FileHasExtension(f$) = 0 THEN f$ = f$ + ".bas" path$ = idezgetfilepath$(path$, f$) ideerror = 3 OPEN path$ + idepathsep$ + f$ FOR BINARY AS #150 ideerror = 1 IF LOF(150) THEN CLOSE #150 a$ = idefileexists IF a$ = "N" THEN idesaveas$ = "C" EXIT FUNCTION 'user didn't agree to overwrite END IF ELSE CLOSE #150 END IF ideprogname$ = f$: _TITLE ideprogname + " - QB64" idesave path$ + idepathsep$ + f$ idepath$ = path$ IdeAddRecent idepath$ + idepathsep$ + ideprogname$ IdeSaveBookmarks idepath$ + idepathsep$ + ideprogname$ EXIT FUNCTION END IF idesaveasloop: 'end of custom controls mousedown = 0 mouseup = 0 LOOP END FUNCTION FUNCTION idesavenow$ '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 idepar p, 40, 4, "" i = i + 1 o(i).typ = 3 o(i).y = 4 o(i).txt = idenewtxt("#Yes" + sep + "#No" + 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: LOCATE p.y + 2, p.x + 4: PRINT "Program is not saved. Save it now?"; '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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$) = "Y" THEN altletter$ = "Y" IF UCASE$(K$) = "N" THEN altletter$ = "N" IF UCASE$(K$) = "C" THEN altletter$ = "C" '-------- 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 idesavenow$ = "C" EXIT FUNCTION END IF IF info THEN IF info = 1 THEN idesavenow$ = "Y" IF info = 2 THEN idesavenow$ = "N" IF info = 3 THEN idesavenow$ = "C" EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP 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 SUB ideshowtext _palettecolor 1, IDEBackgroundColor, 0 _palettecolor 6, IDEBackgroundColor2, 0 _palettecolor 11, IDECommentColor, 0 _palettecolor 10, IDEMetaCommandColor, 0 _palettecolor 14, IDEQuoteColor, 0 _palettecolor 13, IDETextColor, 0 cc = -1 IF idecx < idesx THEN idesx = idecx IF idecy < idesy THEN idesy = idecy IF idecx - idesx >= (idewx - 2) THEN idesx = idecx - (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 idecy_multilinestart = 0 idecy_multilineend = 0 a$ = idegetline(idecy) IF RIGHT$(a$, 1) = "_" THEN 'Find the beginning of the multiline FOR idecy_i = idecy - 1 TO 1 STEP -1 b$ = idegetline(idecy_i) IF RIGHT$(b$, 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) IF RIGHT$(b$, 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$ = "" IF RIGHT$(b$, 1) = "_" THEN idecy_multilineend = idecy 'Find the beginning of the multiline FOR idecy_i = idecy - 1 TO 1 STEP -1 b$ = idegetline(idecy_i) IF RIGHT$(b$, 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$ = "" FOR y = 0 TO (idewy - 9) LOCATE y + 3, 1 COLOR 7, 1 PRINT CHR$(179); 'clear prev bookmarks from lhs IF l = idefocusline AND idecy <> l THEN COLOR 7, 4 'Line with error gets a red background ELSEIF idecy = l OR (l >= idecy_multilinestart AND l <= idecy_multilineend) THEN COLOR 7, 6 'Highlight the current line ELSE COLOR 7, 1 'Regular text color END IF IF l <= iden THEN a$ = idegetline(l) IF l = idecy THEN IF idecx <= LEN(a$) 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: idecx_comment = 0 idecx_quote = 0 FOR k = 1 TO idecx SELECT CASE MID$(a$, k, 1) CASE CHR$(34) idecx_quote = NOT idecx_quote CASE "'" IF idecx_quote = 0 THEN idecx_comment = -1: EXIT FOR END SELECT NEXT k '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 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(" THEN a$ = a$ + " 'Hit 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(" THEN IF INSTR("0123456789", MID$(a2$, idecx, 1)) = 0 THEN EnteringRGB = -1 END IF END IF END IF 'l = idecy a2$ = SPACE$(idesx + (idewx - 3)) MID$(a2$, 1) = a$ a2$ = RIGHT$(a2$, (idewx - 2)) ELSE a2$ = SPACE$((idewx - 2)) END IF ' ### STEVE EDIT TO MAKE QUOTES AND COMMENTS STAND OUT WITH MINOR COLOR ADJUSTMENTS ### 'FOR x = 1 TO LEN(a2$) ' PRINT CHR$(ASC(a2$, x)); 'NEXT inquote = 0 comment = 0 metacommand = 0 FOR k = 1 TO idesx 'First check the part of the line that's off screen to the left SELECT CASE MID$(a$, k, 1) CASE CHR$(34) inquote = NOT inquote CASE "'" IF inquote = 0 THEN comment = -1 END SELECT NEXT k FOR m = 1 TO LEN(a2$) 'continue checking, while printing to the screen SELECT CASE MID$(a$, m + idesx - 1, 1) CASE CHR$(34): inquote = NOT inquote CASE "'": IF inquote = 0 THEN comment = -1 END SELECT IF left$(ltrim$(a$),2) = "'$" or left$(ltrim$(a$),1) = "$" THEN metacommand = -1 : comment = 0 COLOR 13 IF comment THEN COLOR 11 ELSEIF metacommand THEN COLOR 10 ELSEIF inquote OR MID$(a2$, m, 1) = CHR$(34) THEN COLOR 14 END IF 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 _BIT ' to the end of a program before the IDE has finished LOOP ' verifying the code and growing the array during the IDE passes. If InValidLine(l) and 1 then color 7 LOCATE y + 3, 2 + m - 1 PRINT MID$(a2$, m, 1); NEXT m '### END OF STEVE EDIT '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 TO (idewx - 2) 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 LOCATE y + 3, x: PRINT "?"; COLOR 1, 7 ELSE LOCATE y + 3, x: PRINT 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 COLOR 1, 7 FOR x = 1 TO LEN(a2$) PRINT CHR$(ASC(a2$, x)); NEXT COLOR 7, 1 nofinalselect: END IF END IF END IF l = l + 1 NEXT COLOR 7, 1 FOR b = 1 TO IdeBmkN y = IdeBmk(b).y IF y >= idesy AND y <= idesy + (idewy - 9) THEN LOCATE 3 + y - idesy, 1: PRINT 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 LOCATE idewy + idesubwindow, idewx - 20: PRINT " : "; IF idecx < 100000 THEN LOCATE idewy + idesubwindow, idewx - 9 a$ = LTRIM$(STR$(idecx)) PRINT a$; IF cc <> -1 THEN PRINT "(" + str2$(cc) + ")"; END IF a$ = LTRIM$(STR$(idecy)) LOCATE idewy + idesubwindow, (idewx - 10) - LEN(a$) PRINT a$; SCREEN , , 0, 0: LOCATE idecy - idesy + 3, idecx - idesx + 2: SCREEN , , 3, 0 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '------- identify word or character at current cursor position - copied/adapted from FUNCTION ide2: a$ = idegetline(idecy) x = idecx IF x <= LEN(a$) THEN 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 a2$ = CHR$(ASC(a$, x)) END IF a2$ = UCASE$(a2$) 'a2$ now holds the word or character at current cursor position if len(a2$) > 1 then do until alphanumeric(asc(right$(a2$, 1))) a2$ = left$(a2$, len(a2$) - 1) 'removes sigil, if any loop end if END IF '-------- init -------- ly$ = MKL$(1) lySorted$ = ly$ CurrentlyViewingWhichSUBFUNC = 1 PreferCurrentCursorSUBFUNC = 0 InsideDECLARE = 0 FoundExternalSUBFUNC = 0 l$ = ideprogname$ IF l$ = "" THEN l$ = "Untitled" + tempfolderindexstr$ lSorted$ = l$ TotalSUBs = 0 SortedSubsFlag = idesortsubs FOR y = 1 TO iden a$ = idegetline(y) 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 IF RIGHT$(nca$, 7) = " STATIC" THEN a$ = RTRIM$(LEFT$(a$, LEN(a$) - 7)) END IF 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$, "(") IF x THEN n$ = RTRIM$(LEFT$(a$, x - 1)) args$ = RIGHT$(a$, LEN(a$) - x + 1) ELSE n$ = a$ args$ = "" END IF 'attempt to cleanse n$, just in case there are any comments or other unwanted stuff for CleanseN = 1 to len(n$) select case mid$(n$, CleanseN, 1) case " ", "'", ":" n$ = left$(n$, CleanseN - 1) exit for end select next '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 IF LEN(n$) <= 20 THEN n$ = n$ + SPACE$(20 - LEN(n$)) ELSE n$ = LEFT$(n$, 17) + string$(3, 250) END IF IF LEN(args$) <= (idewx - 41) THEN args$ = args$ + SPACE$((idewx - 41) - LEN(args$)) ELSE args$ = LEFT$(args$, (idewx - 44)) + string$(3, 250) END IF l$ = l$ + sep + chr$(195) + chr$(196) + n$ + " " + sf$ + args$ 'Populate SortedSubsList() TotalSUBs = TotalSUBs + 1 ListItemLength = LEN(n$ + " " + sf$ + args$) REDIM _PRESERVE SortedSubsList(1 to TotalSUBs) as string * 998 REDIM _PRESERVE CaseBkpSubsList(1 to TotalSUBs) as string * 998 CaseBkpSubsList(TotalSUBs) = n$ + " " + sf$ + args$ SortedSubsList(TotalSUBs) = UCASE$(CaseBkpSubsList(TotalSUBs)) MID$(CaseBkpSubsList(TotalSUBs), 992, 6) = MKL$(y) + MKI$(ListItemLength) MID$(SortedSubsList(TotalSUBs), 992, 6) = MKL$(y) + MKI$(ListItemLength) END IF NEXT FOR x = LEN(l$) TO 1 STEP -1 a$ = MID$(l$, x, 1) IF a$ = chr$(195) THEN MID$(l$, x, 1) = chr$(192): EXIT FOR NEXT if TotalSUBs > 1 then DIM m as _MEM m = _MEM(SortedSubsList()) IF INSTR(_OS$, "64BIT") = 0 THEN Sort m 'Steve's sorting routine 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) + left$(CaseBkpSubsList(RestoreCaseBkp), ListItemLength) EXIT FOR END IF next NEXT FOR x = LEN(lSorted$) TO 1 STEP -1 a$ = MID$(lSorted$, x, 1) IF a$ = chr$(195) THEN MID$(lSorted$, x, 1) = chr$(192): EXIT FOR NEXT SortedSubsFlag = idesortsubs else SortedSubsFlag = 0 'Override idesortsubs if the current program doesn't have more than 1 subprocedure end if '72,19 i = 0 idepar p, idewx - 8, idewy + idesubwindow - 6, "SUBs" i = i + 1 o(i).typ = 2 o(i).y = 1 '68 o(i).w = idewx - 12: o(i).h = idewy + idesubwindow - 9 o(i).txt = idenewtxt(l$) IF SortedSubsFlag = 0 THEN IF PreferCurrentCursorSUBFUNC <> 0 THEN o(i).sel = PreferCurrentCursorSUBFUNC ELSE o(i).sel = CurrentlyViewingWhichSUBFUNC END IF ELSE idetxt(o(i).txt) = lSorted$ 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 = 3 o(i).y = idewy + idesubwindow - 6 o(i).txt = idenewtxt("#Edit" + sep + "#Cancel") o(i).dft = 1 If TotalSUBs > 1 AND INSTR(_OS$, "64BIT") = 0 then i = i + 1 o(i).typ = 4 'check box o(i).x = idewx - 22 o(i).y = idewy + idesubwindow - 6 o(i).nam = idenewtxt("#Sorted A-Z") o(i).sel = SortedSubsFLAG 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 -------- IF FoundExternalSUBFUNC = -1 THEN COLOR 8, 7: LOCATE idewy + idesubwindow - 3, p.x + 2: PRINT "* 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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" GOSUB SaveSortSettings 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 AddQuickNavHistory idecy 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 EXIT FUNCTION 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 idetxt(o(1).txt) = l$ 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 idetxt(o(1).txt) = lSorted$ o(1).sel = PreviousSelection focus = 1 END IF end if end if 'end of custom controls mousedown = 0 mouseup = 0 LOOP EXIT FUNCTION SaveSortSettings: If TotalSUBs > 1 and idesortsubs <> SortedSubsFLAG THEN idesortsubs = SortedSubsFLAG if idesortsubs then WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_SortSUBs", "TRUE" else WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_SortSUBs", "FALSE" end if END IF 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 oo 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) FOR x = 2 TO idecpnum l$ = l$ + sep + idecpname(x) NEXT l$ = UCASE$(l$) i = 0 idepar p, idewx - 8, idewy + idesubwindow - 6, "Language" i = i + 1 o(i).typ = 2 o(i).y = 2 o(i).w = idewx - 12: o(i).h = idewy + idesubwindow - 10 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 = idewy + idesubwindow - 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 -------- COLOR 0, 7: LOCATE p.y + 1, p.x + 2: PRINT "Code-page for ASCII-UNICODE mapping: (Default: CP437)" '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 "'[IDE DISPLAY SETTINGS]", "IDE_CodePage", str$(idecpindex) EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END FUNCTION SUB ideobjupdate (o AS idedbotype, focus, f, focusoffset, kk$, altletter$, mb, mousedown, mouseup, mx, my, info, mw) STATIC SearchTerm$, LastKeybInput as single DIM sep AS STRING * 1 sep = CHR$(0) t = o.typ 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 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 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) = "" 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 TIMER - LastKeybInput > 1 THEN SearchTerm$ = "": ResetKeybTimer = -1 LastKeybInput = TIMER k = ASC(UCASE$(kk$)): IF k < 32 OR k > 126 THEN k = 255 'Populate ListBoxITEMS: a$ = idetxt(o.txt) redim ListBoxITEMS(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 redim _preserve ListBoxITEMS(1 to n) as string ListBoxITEMS(n) = mid$(a$, x, x2 - x) else n = n + 1 redim _preserve ListBoxITEMS(1 to n) as string ListBoxITEMS(n) = right$(a$, len(a$) - x + 1) exit do end if x = x2 + 1 loop end if if k = 255 then if o.sel > 0 then idetxt(o.stx) = ListBoxITEMS(o.sel) goto selected 'Search is not performed if kk$ isn't a printable character else SearchTerm$ = SearchTerm$ + UCASE$(kk$) END IF if len(SearchTerm$) = 2 and left$(SearchTerm$, 1) = right$(SearchTerm$, 1) then 'if the user is pressing the same letter again, we deduce the search 'is only for the initials ResetKeybTimer = -1 SearchTerm$ = 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 validCHARS$ = "" FOR ai = 1 TO LEN(ListBoxITEMS(FindMatch)) aa = ASC(ucase$(ListBoxITEMS(findMatch)), ai) IF aa > 126 OR (k <> 95 AND aa = 95) OR (k <> 42 AND aa = 42) THEN 'ignore ELSE validCHARS$ = validCHARS$ + CHR$(aa) END IF NEXT if findMatch = o.sel then idetxt(o.stx) = ListBoxITEMS(FindMatch) IF left$(validCHARS$, len(SearchTerm$)) = SearchTerm$ THEN o.sel = findMatch GOTO selected end if next findMatch 'No match, try again: StartSearch = 1 SearchPass = SearchPass + 1 goto retryfind selected: END IF 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 '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 LOCATE y, x: PRINT CHR$(24); LOCATE y + h - 1, x: PRINT CHR$(25); FOR y2 = y + 1 TO y + h - 2 LOCATE y2, x: PRINT 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 LOCATE y2, x: PRINT 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 LOCATE y2, x: PRINT chr$(219); idevbar = y2 EXIT FUNCTION END IF IF i = n THEN y2 = y + h - 2 LOCATE y2, x: PRINT 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!) LOCATE y2, x: PRINT chr$(219); idevbar = y2 EXIT FUNCTION END IF END FUNCTION SUB idewait _DELAY 0.1 END SUB SUB idewait4alt 'stub END SUB SUB idewait4mous 'stub 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) 'method0=*.bas, method1=*.* 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" 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 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$ = "" FOR i = 1 TO 2 - method OPEN "./internal/temp/files.txt" FOR OUTPUT AS #150: CLOSE #150 IF method = 0 THEN IF i = 1 THEN SHELL _HIDE "find " + QuotedFilename$(path$) + " -maxdepth 1 -type f -name " + CHR$(34) + "*.bas" + CHR$(34) + " >./internal/temp/files.txt" IF i = 2 THEN SHELL _HIDE "find " + QuotedFilename$(path$) + " -maxdepth 1 -type f -name " + CHR$(34) + "*.BAS" + CHR$(34) + " >./internal/temp/files.txt" END IF IF method = 1 THEN IF i = 1 THEN SHELL _HIDE "find " + QuotedFilename$(path$) + " -maxdepth 1 -type f -name " + CHR$(34) + "*" + CHR$(34) + " >./internal/temp/files.txt" END IF 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 filelist$ = "" THEN filelist$ = a$ ELSE filelist$ = filelist$ + sep + a$ LOOP CLOSE #150 NEXT idezfilelist$ = filelist$ EXIT FUNCTION 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 END IF IF os$ = "LNX" THEN 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 FOR i = 0 TO 25 IF LEN(pathlist$) THEN pathlist$ = pathlist$ + sep pathlist$ = pathlist$ + CHR$(65 + i) + ":" 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$ = "" IF os$ = "WIN" THEN FOR i = LEN(f$) TO 1 STEP -1 a$ = MID$(f$, i, 1) IF a$ = "\" THEN p$ = LEFT$(f$, i - 1) f$ = RIGHT$(f$, LEN(f$) - i) EXIT FOR END IF NEXT ideztakepath$ = p$ EXIT FUNCTION END IF IF os$ = "LNX" THEN FOR i = LEN(f$) TO 1 STEP -1 a$ = MID$(f$, i, 1) IF a$ = "/" THEN p$ = LEFT$(f$, i - 1) f$ = RIGHT$(f$, LEN(f$) - i) EXIT FOR END IF NEXT ideztakepath$ = p$ EXIT FUNCTION END IF 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 LEFT$(p$, 1) = "." 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 CHDIR p2$ ideerror = 1 'step #5: get the path's full name (assume success) IF os$ = "WIN" THEN SHELL _HIDE "cd >" + QuotedFilename$(ideroot$) + "\internal\temp\root.txt" OPEN ideroot$ + "\internal\temp\root.txt" FOR INPUT AS #150 LINE INPUT #150, p$ IF RIGHT$(p$, 1) = "\" THEN p$ = LEFT$(p$, LEN(p$) - 1) 'strip trailing \ after root drive path CLOSE #150 END IF IF os$ = "LNX" THEN SHELL _HIDE "pwd >" + QuotedFilename$(ideroot$) + "/internal/temp/root.txt" OPEN ideroot$ + "/internal/temp/root.txt" FOR INPUT AS #150 LINE INPUT #150, p$ CLOSE #150 END IF 'step #6: restore root path (assume success) CHDIR ideroot$ 'important: no validation of f$ necessary idezgetfilepath$ = p$ END FUNCTION SUB initmouse _MOUSESHOW END SUB 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 idepar p, 60, 8, "Code Layout" i = i + 1 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 o(i).typ = 4 'check box o(i).y = 4 o(i).nam = idenewtxt("Auto #Indent -") o(i).sel = ideautoindent a2$ = str2$(ideautoindentsize) i = i + 1 o(i).typ = 1 o(i).x = 20 o(i).y = 4 o(i).nam = idenewtxt("#Spacing") o(i).txt = idenewtxt(a2$) o(i).v1 = LEN(a2$) i = i + 1 o(i).typ = 4 o(i).y = 6 o(i).nam = idenewtxt("Indent #SUBs and FUNCTIONs") o(i).sel = ideindentsubs i = i + 1 o(i).typ = 3 o(i).y = 8 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 = 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 a$ = idetxt(o(3).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(3).txt) = a$ IF K$ = CHR$(27) OR (focus = 6 AND info <> 0) THEN EXIT FUNCTION IF K$ = CHR$(13) OR (focus = 5 AND info <> 0) THEN 'save changes v% = o(1).sel: IF v% <> 0 THEN v% = 1 'ideautolayout IF ideautolayout <> v% THEN ideautolayout = v%: idelayoutbox = 1 v% = o(2).sel: IF v% <> 0 THEN v% = 1 'ideautoindent IF ideautoindent <> v% THEN ideautoindent = v%: idelayoutbox = 1 v$ = idetxt(o(3).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(4).sel: IF v% <> 0 THEN v% = 1 'ideindentsubs IF ideindentsubs <> v% THEN ideindentsubs = v%: idelayoutbox = 1 if ideautolayout then WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_AutoFormat", "TRUE" else WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_AutoFormat", "FALSE" end if if ideautoindent then WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_AutoIndent", "TRUE" else WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_AutoIndent", "FALSE" end if WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_IndentSize", str$(ideautoindentsize) if ideindentsubs then WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_IndentSUBs", "TRUE" else WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_IndentSUBs", "FALSE" end if EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END FUNCTION FUNCTION idebackupbox '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 idepar p, 50, 5, "Backup/Undo" a2$ = str2$(idebackupsize) i = i + 1 PrevFocus = 1 o(i).typ = 1 o(i).y = 2 o(i).nam = idenewtxt("#Undo buffer limit (10-2000MB)") 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 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 a$ = idetxt(o(1).txt) IF LEN(a$) > 4 THEN a$ = LEFT$(a$, 4) '4 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$ = LEFT$(a$, i - 1): EXIT FOR NEXT IF focus <> 1 THEN a = VAL(a$) IF a < 10 THEN a$ = "10" IF a > 2000 THEN a$ = "2000" END IF idetxt(o(1).txt) = a$ IF K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN EXIT FUNCTION IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) THEN 'save changes v$ = idetxt(o(1).txt) 'idebackupsize 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 "'[GENERAL SETTINGS]", "BackupSize", str$(v&) + " 'in MB" idebackupbox = 1 EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END FUNCTION FUNCTION idemodifycommandbox '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 idepar p, 65, 5, "Modify COMMAND$" a2$ = ModifyCOMMAND$ if len(a2$) > 0 then a2$ = MID$(a2$, 2) i = i + 1 PrevFocus = 1 o(i).typ = 1 o(i).y = 2 o(i).nam = idenewtxt("#Enter text for COMMAND$") 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 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 = 3 AND info <> 0) THEN EXIT FUNCTION IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) THEN ModifyCOMMAND$ = " " + idetxt(o(1).txt) IF LTRIM$(RTRIM$(ModifyCOMMAND$)) = "" THEN ModifyCOMMAND$ = "" EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END FUNCTION FUNCTION idegotobox STATIC idegotobox_LastLineNum AS LONG '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 idepar p, 30, 5, "Go To Line" IF idegotobox_LastLineNum > 0 THEN a2$ = str2$(idegotobox_LastLineNum) ELSE a2$ = "" i = i + 1 PrevFocus = 1 o(i).typ = 1 o(i).y = 2 o(i).nam = idenewtxt("#Line") 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 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 a$ = idetxt(o(1).txt) IF LEN(a$) > 8 THEN a$ = LEFT$(a$, 8) '8 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$ = LEFT$(a$, i - 1): EXIT FOR NEXT IF focus <> 1 THEN a = VAL(a$) IF a < 1 THEN a$ = "1" END IF idetxt(o(1).txt) = a$ IF K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN EXIT FUNCTION IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) THEN v$ = idetxt(o(1).txt) v& = VAL(v$) IF v& < 1 THEN v& = 1 IF v& > iden THEN v& = iden idegotobox_LastLineNum = v& AddQuickNavHistory idecy idecy = v& ideselect = 0 EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP 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 oo 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) + " 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: LOCATE p.y + y, p.x + 1: PRINT 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 "'[GENERAL SETTINGS]", "DebugInfo", "TRUE 'INTERNAL VARIABLE USE ONLY!! DO NOT MANUALLY CHANGE!" else WriteConfigSetting "'[GENERAL SETTINGS]", "DebugInfo", "FALSE 'INTERNAL VARIABLE USE ONLY!! DO NOT MANUALLY CHANGE!" end if Include_GDB_Debugging_Info = idedebuginfo 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 idechangemade = 1 'force recompilation END IF '... EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END FUNCTION SUB idemessagebox (titlestr$, messagestr$) '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- MessageLines = 1 DIM FullMessage$(1 TO 4) 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 i = 0 w2 = LEN(titlestr$) + 4 IF w < w2 THEN w = w2 idepar p, w, 3 + MessageLines, titlestr$ i = i + 1 o(i).typ = 3 o(i).y = 3 + MessageLines 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 -------- COLOR 0, 7 FOR i = 1 TO MessageLines LOCATE p.y + 1 + i, p.x + (w \ 2 - LEN(FullMessage$(i)) \ 2) + 1 PRINT 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 K$ = CHR$(13) OR (focus = 1 AND info <> 0) THEN EXIT SUB 'end of custom controls mousedown = 0 mouseup = 0 LOOP END SUB FUNCTION ideyesnobox$ (titlestr$, messagestr$) 'returns "Y" or "N" '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 w = LEN(messagestr$) + 2 w2 = LEN(titlestr$) + 4 IF w < w2 THEN w = w2 idepar p, w, 4, titlestr$ i = i + 1 o(i).typ = 3 o(i).y = 4 o(i).txt = idenewtxt("#Yes" + sep + "#No") 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: LOCATE p.y + 2, p.x + 2: PRINT messagestr$; '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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$) = "Y" THEN altletter$ = "Y" IF UCASE$(K$) = "N" THEN altletter$ = "N" '-------- 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 ideyesnobox$ = "N" EXIT FUNCTION END IF IF info THEN IF info = 1 THEN ideyesnobox$ = "Y" ELSE ideyesnobox$ = "N" EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END FUNCTION 'yes/no box FUNCTION ideandroidbox '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 idepar p, 75, 15 - 4 - 4, "Google Android Options" i = i + 1 o(i).typ = 4 'check box o(i).y = 2 o(i).nam = idenewtxt("Enable #Run Menu Commands") o(i).sel = IdeAndroidMenu 'a2$ = IdeAndroidStartScript 'IF a2$ = "" THEN a2$ = "programs\android\start_android.bat" 'i = i + 1 'o(i).typ = 1 'o(i).y = 7 'o(i).nam = idenewtxt(CHR$(34) + "Start Android Project" + CHR$(34) + " Script") 'o(i).txt = idenewtxt(a2$) 'o(i).v1 = LEN(a2$) 'a2$ = IdeAndroidMakeScript 'IF a2$ = "" THEN a2$ = "programs\android\make_android.bat" 'i = i + 1 'o(i).typ = 1 'o(i).y = 11 - 4 'o(i).nam = idenewtxt(CHR$(34) + "Make Android Project Only" + CHR$(34) + " Script") 'o(i).txt = idenewtxt(a2$) 'o(i).v1 = LEN(a2$) i = i + 1 o(i).typ = 3 o(i).y = 15 - 4 - 4 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 8, 7: LOCATE p.y + 3, p.x + 4: PRINT "Projects are created at:"; COLOR 8, 7: LOCATE p.y + 4, p.x + 6: PRINT "qb64\programs\android\"; COLOR 9, 7 PRINT "bas_file_name_without_extension"; COLOR 8, 7: PRINT "\"; ' COLOR 8, 7: LOCATE p.y + 9, p.x + 4: PRINT "Script file is launched from within project's folder"; 'COLOR 8, 7: LOCATE p.y + 13 - 4, p.x + 4: PRINT "Script file is launched from within project's folder"; '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 a$ = idetxt(o(2).txt) IF LEN(a$) > 256 THEN a$ = LEFT$(a$, 256) idetxt(o(2).txt) = a$ a$ = idetxt(o(3).txt) IF LEN(a$) > 256 THEN a$ = LEFT$(a$, 256) idetxt(o(3).txt) = a$ IF K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN EXIT FUNCTION IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) THEN v% = o(1).sel IF v% < IdeAndroidMenu THEN menusize(5) = menusize(5) - 2 END IF IF v% > IdeAndroidMenu THEN menusize(5) = menusize(5) + 2 END IF if v% then WriteConfigSetting "'[ANDROID MENU]", "IDE_AndroidMenu", "TRUE" ELSE WriteConfigSetting "'[ANDROID MENU]", "IDE_AndroidMenu", "FALSE" end if 'v$ = "" 'IF LEN(v$) > 256 THEN v$ = LEFT$(v$, 256) 'IF LEN(v$) < 256 THEN v$ = v$ + SPACE$(256 - LEN(v$)) 'v3$ = idetxt(o(3 - 1).txt) 'IF LEN(v3$) > 256 THEN v3$ = LEFT$(v3$, 256) 'IF LEN(v3$) < 256 THEN v3$ = v3$ + SPACE$(256 - LEN(v3$)) ' WriteConfigSetting "'[ANDROID MENU]", "IDE_AndroidMakeScript$", v3$ ' WriteConfigSetting "'[ANDROID MENU]", "IDE_AndroidStartScript$", v$ IdeAndroidMenu = o(1).sel 'IdeAndroidStartScript = "" 'idetxt(o(2).txt) 'IdeAndroidMakeScript = idetxt(o(3 - 1).txt) EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- i = 0 'idepar p, 60, 16, "Display" 'note: manually set window position in case display to set too large by accident p.x = (80 \ 2) - 60 \ 2 p.y = (25 \ 2) - 16 \ 2 p.w = 60 p.h = 18 p.nam = idenewtxt("Display") a2$ = str2$(idewx) i = i + 1 PrevFocus = 1 o(i).typ = 1 o(i).x = 16 o(i).y = 2 o(i).nam = idenewtxt("#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 = 15 o(i).y = 5 o(i).nam = idenewtxt("#Height") o(i).txt = idenewtxt(a2$) o(i).v1 = LEN(a2$) i = i + 1 o(i).typ = 4 'check box o(i).y = 8 o(i).nam = idenewtxt("Restore window #position at startup") if IDE_AutoPosition then o(i).sel = 1 i = i + 1 o(i).typ = 4 'check box o(i).y = 10 o(i).nam = idenewtxt("Custom #Font:") o(i).sel = idecustomfont a2$ = idecustomfontfile$ i = i + 1 o(i).typ = 1 o(i).x = 10 o(i).y = 12 o(i).nam = idenewtxt("File #Name") o(i).txt = idenewtxt(a2$) o(i).v1 = LEN(a2$) a2$ = str2$(idecustomfontheight) i = i + 1 o(i).typ = 1 o(i).x = 10 o(i).y = 15 o(i).nam = idenewtxt("#Row Height (Pixels)") o(i).txt = idenewtxt(a2$) o(i).v1 = LEN(a2$) i = i + 1 o(i).typ = 3 o(i).y = 18 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: LOCATE p.y + 2, p.x + 2: PRINT "Window Size -"; COLOR 0, 7: LOCATE p.y + 10, p.x + 29: PRINT " Monospace TTF Font "; '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 or focus = 5 or focus = 6 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(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$ 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$ a$ = idetxt(o(5).txt) IF LEN(a$) > 1024 THEN a$ = LEFT$(a$, 1024) idetxt(o(5).txt) = a$ a$ = idetxt(o(6).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 <> 5 THEN IF LEN(a$) THEN a = VAL(a$) ELSE a = 0 IF a < 8 THEN a$ = "8" END IF idetxt(o(6).txt) = a$ IF K$ = CHR$(27) OR (focus = 8 AND info <> 0) THEN EXIT FUNCTION IF K$ = CHR$(13) OR (focus = 7 AND info <> 0) THEN x = 0 'change to custom font 'get size in v% v$ = idetxt(o(6).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(4).sel <> idecustomfont THEN IF o(4).sel = 0 THEN _FONT 16 _FREEFONT idecustomfonthandle ELSE x = 1 END IF END IF v$ = idetxt(o(5).txt): IF v$ <> idecustomfontfile$ THEN x = 1 IF o(4).sel = 1 AND x = 1 THEN oldhandle = idecustomfonthandle idecustomfonthandle = _LOADFONT(v$, v%, "MONOSPACE") IF idecustomfonthandle = -1 THEN 'failed! - revert to default settings o(4).sel = 0: idetxt(o(5).txt) = "c:\windows\fonts\lucon.ttf": idetxt(o(6).txt) = "21": _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(4).sel IF v% <> 0 THEN v% = 1 idecustomfont = v% v$ = idetxt(o(5).txt) IF LEN(v$) > 1024 THEN v$ = LEFT$(v$, 1024) idecustomfontfile$ = v$ v$ = v$ + SPACE$(1024 - LEN(v$)) v$ = idetxt(o(6).txt): IF v$ = "" THEN v$ = "0" v% = VAL(v$) IF v% < 8 THEN v% = 8 IF v% > 99 THEN v% = 99 idecustomfontheight = v% WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_Width", str$(idewx) WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_Height", str$(idewy) IF idecustomfont THEN WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_CustomFont", "TRUE" ELSE WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_CustomFont", "FALSE" END IF IF IDE_AutoPosition THEN WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_AutoPosition", "TRUE" ELSE WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_AutoPosition", "FALSE" END IF WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_CustomFont$", idecustomfontfile$ WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_CustomFontSize", str$(idecustomfontheight) 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 DIM bkpIDEBackgroundColor2 AS _UNSIGNED LONG DIM SelectionIndicator$(1 to 6) bkpIDECommentColor = IDECommentColor bkpIDEMetaCommandColor = IDEMetaCommandColor bkpIDEQuoteColor = IDEQuoteColor bkpIDETextColor = IDETextColor bkpIDEBackgroundColor = IDEBackgroundColor bkpIDEBackgroundColor2 = IDEBackgroundColor2 clipBefore$ = _CLIPBOARD$ '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- _palettecolor 5, &HFF00A800, 0 'Original green may have been changed by the Help System, so 5 is now green i = 0 idepar p, 70, 13, "IDE Colors" l$ = CHR$(16) + "Normal Text" l$ = l$ + sep + " Strings" l$ = l$ + sep + " Metacommands" l$ = l$ + sep + " Comments" l$ = l$ + sep + " Background" l$ = l$ + sep + " Current line background" i = i + 1 o(i).typ = 2 o(i).y = 1 o(i).w = 27: o(i).h = 7 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 = 63 o(i).y = 2 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 = 63 o(i).y = 5 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 = 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 = 13 o(i).txt = idenewtxt("#OK" + sep + "Restore #defaults" + 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 -------- _palettecolor 1, IDEBackgroundColor, 0 _palettecolor 6, IDEBackgroundColor2, 0 _palettecolor 11, IDECommentColor, 0 _palettecolor 10, IDEMetaCommandColor, 0 _palettecolor 14, IDEQuoteColor, 0 _palettecolor 13, IDETextColor, 0 LOCATE p.y + 2, p.x + 33: 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) LOCATE p.y + 2, p.x + 35 + r: PRINT slider$; COLOR 0: LOCATE p.y + 5, p.x + 33: 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) LOCATE p.y + 5, p.x + 35 + r: PRINT slider$; COLOR 0: LOCATE p.y + 8, p.x + 33: 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) LOCATE p.y + 8, p.x + 35 + r: PRINT slider$; SELECT CASE SelectedITEM CASE 1: COLOR 13, 1 'Normal text CASE 2: COLOR 14, 1 'Strings CASE 3: COLOR 10, 1 'Metacommands CASE 4: COLOR 11, 1 'Comments CASE 5: COLOR 1, 1 'Background CASE 6: COLOR 6, 6 'Current line background END SELECT LOCATE p.y + 11, p.x + p.w \ 2 - 17: PRINT " Enter new RGB values for the item "; '-------- 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 'Monitor _CLIPBOARD$; If a new RGB value is copied to memory in a format 'like (0, 0, 0) it'll be used for the current item (useful for copying 'from color pickers elsewhere, like http://www.w3schools.com/colors/colors_picker.asp) clipNow$ = _CLIPBOARD$ IF clipNow$ <> clipBefore$ THEN clipBefore$ = clipNow$ 'Parse new clipboard contents for ###, ###, ### FindComma1 = INSTR(clipNow$, ",") IF FindComma1 > 0 THEN FindComma2 = INSTR(FindComma1 + 1, clipNow$, ",") IF FindComma2 > 0 THEN r$ = "": g$ = "": b$ = "" FOR i = FindComma1 - 1 TO 1 STEP -1 IF ASC(clipNow$, i) >= 48 AND ASC(clipNow$, i) <= 57 THEN r$ = MID$(clipNow$, i, 1) + r$ ELSE EXIT FOR END IF NEXT i FOR i = FindComma1 + 1 TO FindComma2 - 1 IF ASC(clipNow$, i) = 32 OR (ASC(clipNow$, i) >= 48 AND ASC(clipNow$, i) <= 57) THEN g$ = g$ + MID$(clipNow$, i, 1) ELSE EXIT FOR END IF NEXT i FOR i = FindComma2 + 1 TO LEN(clipNow$) IF ASC(clipNow$, i) = 32 OR (ASC(clipNow$, i) >= 48 AND ASC(clipNow$, i) <= 57) THEN b$ = b$ + MID$(clipNow$, i, 1) ELSE EXIT FOR END IF NEXT i idetxt(o(2).txt) = str2$(VAL(r$)) idetxt(o(3).txt) = str2$(VAL(g$)) idetxt(o(4).txt) = str2$(VAL(b$)) change = 1 END IF END IF END IF _LIMIT 100 LOOP UNTIL change IF alt THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 >= 2 AND focus <= 4 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 + 35 AND mX <= p.x + 35 + 26 THEN newValue = (mX - p.x - 35) * (255 / 26) idetxt(o(2).txt) = str2$(newValue) 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 + 5 AND mX >= p.x + 35 AND mX <= p.x + 35 + 26 THEN newValue = (mX - p.x - 35) * (255 / 26) idetxt(o(3).txt) = str2$(newValue) focus = 3 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 + 35 AND mX <= p.x + 35 + 26 THEN newValue = (mX - p.x - 35) * (255 / 26) idetxt(o(4).txt) = str2$(newValue) focus = 4 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 = 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 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 END IF IF SelectedITEM <> o(1).sel AND o(1).sel > 0 THEN SelectedITEM = o(1).sel FOR i = 1 to 6: 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) + "Strings" i = i + 1: l$ = l$ + sep + SelectionIndicator$(i) + "Metacommands" 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" idetxt(o(1).txt) = l$ ChangeTextBoxes: SELECT CASE SelectedITEM CASE 1: CurrentColor~& = IDETextColor CASE 2: CurrentColor~& = IDEQuoteColor CASE 3: CurrentColor~& = IDEMetaCommandColor CASE 4: CurrentColor~& = IDECommentColor CASE 5: CurrentColor~& = IDEBackgroundColor CASE 6: CurrentColor~& = IDEBackgroundColor2 END SELECT idetxt(o(2).txt) = str2$(_RED32(CurrentColor~&)) idetxt(o(3).txt) = str2$(_GREEN32(CurrentColor~&)) idetxt(o(4).txt) = str2$(_BLUE32(CurrentColor~&)) 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 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: IDEQuoteColor = CurrentColor~& 'Strings CASE 3: IDEMetaCommandColor = CurrentColor~& 'Metacommands CASE 4: IDECommentColor = CurrentColor~& 'Comments CASE 5: IDEBackgroundColor = CurrentColor~& 'Background CASE 6: IDEBackgroundColor2 = CurrentColor~& 'Current line background END SELECT IF K$ = CHR$(27) OR (focus = 7 AND info <> 0) THEN IDECommentColor = bkpIDECommentColor IDEMetaCommandColor = bkpIDEMetaCommandColor IDEQuoteColor = bkpIDEQuoteColor IDETextColor = bkpIDETextColor IDEBackgroundColor = bkpIDEBackgroundColor IDEBackgroundColor2 = bkpIDEBackgroundColor2 EXIT FUNCTION END IF IF (focus = 6 AND info <> 0) THEN IDECommentColor = _RGB32(85, 255, 255) IDEMetaCommandColor = _RGB32(85, 255, 85) IDEQuoteColor = _RGB32(255, 255, 85) IDETextColor = _RGB32(255, 255, 255) IDEBackgroundColor = _RGB32(0, 0, 170) IDEBackgroundColor2 = _RGB32(0, 0, 128) info = 0 GOTO ChangeTextBoxes END IF IF (focus = 5 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)) THEN 'save changes FOR i = 1 TO 6 SELECT CASE i CASE 1: CurrentColor~& = IDETextColor: colorid$ = "TextColor" CASE 2: CurrentColor~& = IDEQuoteColor: colorid$ = "QuoteColor" CASE 3: CurrentColor~& = IDEMetaCommandColor: colorid$ = "MetaCommandColor" CASE 4: CurrentColor~& = IDECommentColor: colorid$ = "CommentColor" CASE 5: CurrentColor~& = IDEBackgroundColor: colorid$ = "BackgroundColor" CASE 6: CurrentColor~& = IDEBackgroundColor2: colorid$ = "BackgroundColor2" END SELECT r$ = str2$(_RED32(CurrentColor~&)) g$ = str2$(_GREEN32(CurrentColor~&)) b$ = str2$(_BLUE32(CurrentColor~&)) RGBString$ = "_RGB32(" + r$ + "," + g$ + "," + b$ + ")" WriteConfigSetting "'[IDE COLOR SETTINGS]", colorid$, RGBString$ NEXT i EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END FUNCTION FUNCTION idecolorpicker$(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 oo 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 'Check the number of commas in the brackets. '2 or 3 are accepted. RGBArgs$ = MID$(a$, FindBracket1 + 1, FindBracket2 - FindBracket1 - 1) TotalCommas = CountItems(RGBArgs$, ",") IF TotalCommas = 2 OR TotalCommas = 3 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 IF LEFT$(a2$, 5) = "_RGB(" OR _ LEFT$(a2$, 7) = "_RGB32(" OR _ LEFT$(a2$, 6) = "_RGBA(" OR _ LEFT$(a2$, 8) = "_RGBA32(" THEN 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 END IF END IF ELSE 'If a selection if 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) LOCATE p.y + 2, p.x + 15 + r: PRINT 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) LOCATE p.y + 5, p.x + 15 + r: PRINT 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) LOCATE p.y + 8, p.x + 15 + r: PRINT slider$; COLOR 12 FOR i = 2 TO 8 LOCATE p.y + i, p.x + 2 PRINT 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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) 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) 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) 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))) CurrentRGB$ = idetxt(o(1).txt) + ", "+ idetxt(o(2).txt) + ", " + idetxt(o(3).txt) _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 _CLIPBOARD$ = CurrentRGB$ idecolorpicker$ = 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 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 idesetline idecy, NewLine$ 'Select the inserted bit ideselectx1 = FindBracket1 + 1 idecx = ideselectx1 + LEN(CurrentRGB$) ideselecty1 = idecy prev.ideselect = 1 ELSE detail$ = "no _RGB statement found" IF ideselect AND ideselecty1 <> idecy THEN detail$ = "can't insert - multiple lines" END IF _CLIPBOARD$ = CurrentRGB$ ideerrormessage "Copied to the clipboard (" + detail$ + ")." END IF ELSE IF ideselect THEN IF ideselecty1 <> idecy THEN _CLIPBOARD$ = CurrentRGB$ ideerrormessage "Copied to the clipboard (can't insert - multiple lines)." ELSE 'Delete selection and insert current RGB values sx1 = ideselectx1: sx2 = idecx if sx1 > sx2 THEN SWAP sx1, sx2 NewLine$ = LEFT$(CurrentLine$, sx1 - 1) NewLine$ = NewLine$ + CurrentRGB$ NewLine$ = NewLine$ + MID$(CurrentLine$, sx2) idechangemade = 1 idesetline idecy, NewLine$ 'Select the inserted bit ideselectx1 = sx1 idecx = ideselectx1 + LEN(CurrentRGB$) ideselecty1 = idecy prev.ideselect = 1 END IF ELSE 'Insert current RGB values at the cursor NewLine$ = LEFT$(CurrentLine$, idecx - 1) NewLine$ = NewLine$ + CurrentRGB$ NewLine$ = NewLine$ + MID$(CurrentLine$, idecx) idechangemade = 1 idesetline idecy, NewLine$ idecx = idecx + LEN(CurrentRGB$) prev.ideselect = 0 END IF END IF 'Return the current RGB string idecolorpicker$ = 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 Help_ShowText STATIC setup IF setup = 0 AND UBOUND(back$) = 1 THEN setup = 1 a$ = Wiki(Back$(1)) WikiParse a$ 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 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 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 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- ln = 0 l$ = "" fh = FREEFILE OPEN ".\internal\temp\searched.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$ a$ = RIGHT$(a$, LEN(a$) - 2) 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(l$) THEN l$ = l$ + sep + f$ ELSE l$ = f$ ln = ln + 1 END IF LOOP CLOSE #fh if ln = 0 then l$ = sep end if '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 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 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 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- '-------- init -------- l$ = "" fh = FREEFILE OPEN ".\internal\temp\recent.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$ a$ = RIGHT$(a$, LEN(a$) - 2) 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(l$) THEN l$ = l$ + sep + f$ ELSE l$ = f$ END IF LOOP CLOSE #fh '72,19 i = 0 idepar p, idewx - 8, idewy + idesubwindow - 6, "Open" i = i + 1 o(i).typ = 2 o(i).y = 1 '68 o(i).w = idewx - 12: o(i).h = idewy + idesubwindow - 9 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 = idewy + idesubwindow - 6 o(i).txt = idenewtxt("#OK" + sep + "#Cancel" + sep + "Clea#r 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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$ = idetxt(o(1).stx) 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$ = "" 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$ = "" EXIT FUNCTION END IF 'end of custom controls mousedown = 0 mouseup = 0 LOOP END FUNCTION SUB IdeMakeFileMenu m = 1: i = 0 menu$(m, i) = "File": i = i + 1 menu$(m, i) = "#New": i = i + 1 menu$(m, i) = "#Open...": i = i + 1 menu$(m, i) = "#Save": i = i + 1 menu$(m, i) = "Save #As...": i = i + 1 fh = FREEFILE OPEN ".\internal\temp\recent.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$ a$ = RIGHT$(a$, LEN(a$) - 2) FOR r = 1 TO 5 IF r <= 4 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 <= 4 THEN IdeRecentLink(r, 2) = f$ IF r = 5 THEN f$ = "#Recent..." IF LEN(f$) > 25 THEN f$ = string$(3, 250) + RIGHT$(f$, 22) IF r <= 4 THEN IdeRecentLink(r, 1) = f$ menu$(m, i) = f$: 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) = "Clear #recent...": i = i + 1 END IF menu$(m, i) = "-": i = i + 1 menu$(m, i) = "E#xit": i = i + 1 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 'Figure out if the user wants to search for a selected term -- copied from idefind$ 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 IF len(a2$) > 0 THEN sela2$ = ucase$(a2$) idecontextualSearch$ = a2$ IF LEN(a2$) > 22 THEN a2$ = LEFT$(a2$, 19) + string$(3, 250) END IF menu$(m, i) = "Find '" + a2$ + "'": i = i + 1 Selection$ = a2$ END IF 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$ END IF 'attempt to cleanse n$, just in case there are any comments or other unwanted stuff for CleanseN = 1 to len(n$) select case mid$(n$, CleanseN, 1) case " ", "'", ":" n$ = left$(n$, CleanseN - 1) exit for end select next 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 '(copied/adapted from ide2) a$ = idegetline(idecy) a2$ = "" x = idecx IF x <= LEN(a$) THEN 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 a2$ = CHR$(ASC(a$, x)) END IF a2$ = UCASE$(a2$) END IF '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 SubFuncLIST(1) = SubFuncLIST(CheckSF) exit for end if end if next CheckSF v = 0 CurrSF$ = FindCurrentSF$(idecy) if not Error_Happened 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 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 F1 is in help links fh = FREEFILE OPEN "internal\help\links.bin" FOR INPUT AS #fh lnks = 0: lnks$ = CHR$(0) 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$) THEN IF INSTR(lnks$, CHR$(0) + l2$ + CHR$(0)) = 0 THEN lnks = lnks + 1 EXIT DO END IF END IF LOOP CLOSE #fh 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 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) = "Open _RGB color mi#xer": i = i + 1 menu$(m, i) = "-": i = i + 1 END IF NoRGBFound: '--------- _RGB mixer check done. -------------------------------------------- if ideselect then menu$(m, i) = "Cu#t Shift+Del or Ctrl+X": i = i + 1 if ideselect then menu$(m, i) = "#Copy Ctrl+Ins or Ctrl+C": i = i + 1 clip$ = _CLIPBOARD$ 'read clipboard IF LEN(clip$) THEN menu$(m, i) = "#Paste Shift+Ins or Ctrl+V": i = i + 1 if ideselect then menu$(m, i) = "Cl#ear Del": i = i + 1 menu$(m, i) = "Select #All Ctrl+A": i = i + 1 menu$(m, i) = "-": i = i + 1 menu$(m, i) = "Comment (add ')": i = i + 1 menu$(m, i) = "Uncomment (remove ')": i = i + 1 IF ideselect AND ideautoindent = 0 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 menu$(m, i) = "Decrease indent" 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 menu$(m, i) = "Decrease indent" 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 menu$(m, i) = "New #FUNCTION...": i = i + 1 menusize(m) = i - 1 END SUB SUB IdeMakeEditMenu m = ideeditmenuID: i = 0 menu$(m, i) = "Edit": i = i + 1 menu$(m, i) = "#Undo Ctrl+Z": i = i + 1 menu$(m, i) = "#Redo Ctrl+Y": i = i + 1 menu$(m, i) = "-": i = i + 1 if ideselect then menu$(m, i) = "Cu#t Shift+Del or Ctrl+X": i = i + 1 menu$(m, i) = "#Copy Ctrl+Ins or Ctrl+C": i = i + 1 else menu$(m, i) = "~Cu#t Shift+Del or Ctrl+X": i = i + 1 menu$(m, i) = "~#Copy Ctrl+Ins or Ctrl+C": i = i + 1 end if clip$ = _CLIPBOARD$ 'read clipboard IF LEN(clip$) THEN menu$(m, i) = "#Paste Shift+Ins or Ctrl+V": i = i + 1 else menu$(m, i) = "~#Paste Shift+Ins or Ctrl+V": i = i + 1 end if if ideselect then menu$(m, i) = "Cl#ear Del": i = i + 1 else menu$(m, i) = "~Cl#ear Del": i = i + 1 end if menu$(m, i) = "Select #All Ctrl+A": i = i + 1 menu$(m, i) = "-": i = i + 1 menu$(m, i) = "Comment (add ')": i = i + 1 menu$(m, i) = "Uncomment (remove ')": i = i + 1 IF ideselect AND ideautoindent = 0 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 menu$(m, i) = "~Decrease indent" 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 menu$(m, i) = "Decrease indent" 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 menu$(m, i) = "Decrease indent" 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 menu$(m, i) = "~Decrease indent" 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 menu$(m, i) = "New #FUNCTION...": i = i + 1 menusize(m) = i - 1 END SUB SUB IdeAddRecent (f2$) f$ = CRLF + f2$ + 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 SUB IdeAddSearched (s2$) s$ = CRLF + 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 SUB ideASCIIbox 'IF INSTR(_OS$, "WIN") THEN ret% = SHELL("internal\ASCII-Picker.exe") ELSE ret% = SHELL("internal/ASCII-Picker") '(code to fix font and arrow keys also written by Steve) w = _WIDTH: h = _HEIGHT font = _FONT temp = _NEWIMAGE(640, 480, 32) temp1 = _NEWIMAGE(640, 480, 32) ws = _NEWIMAGE(640, 480, 32) SCREEN temp DIM CurrentASC(1 TO 16, 1 TO 16) DIM CurrentOne AS INTEGER CLS , _RGB(0, 0, 170) COLOR , _RGB(0, 0, 170) FOR y = 1 TO 16 FOR x = 1 TO 16 LINE (x * 40, 0)-(x * 40, 480), _RGB32(255, 255, 0) LINE (0, y * 30)-(640, y * 30), _RGB32(255, 255, 0) IF counter THEN _PRINTSTRING (x * 40 - 28, y * 30 - 23), CHR$(counter) counter = counter + 1 NEXT NEXT _DEST temp1 CLS , _RGB(0, 0, 170) COLOR , _RGB(0, 0, 170) counter = 0 FOR y = 1 TO 16 FOR x = 1 TO 16 LINE (x * 40, 0)-(x * 40, 480), _RGB32(255, 255, 0) LINE (0, y * 30)-(640, y * 30), _RGB32(255, 255, 0) text$ = LTRIM$(STR$(counter)) IF counter THEN _PRINTSTRING (x * 40 - 24 - (LEN(text$)) * 4, y * 30 - 23), text$ counter = counter + 1 NEXT NEXT _DEST temp x = 1: y = 1 _PUTIMAGE , temp, ws DO: LOOP WHILE _MOUSEINPUT 'clear the mouse input buffer oldmousex = _MOUSEX: oldmousey = _MOUSEY DO _LIMIT 60 DO: LOOP WHILE _MOUSEINPUT if oldx <> _mousex and oldy <> _mousey then x = _MOUSEX \ 40 + 1 'If mouse moved, where are we now? y = _MOUSEY \ 30 + 1 end if oldx = _mousex: oldy = _mousey num = (y - 1) * 16 + x - 1 IF num = 0 THEN text$ = "" ELSE flashcounter = flashcounter + 1 IF flashcounter > 30 THEN COLOR _RGB32(255, 255, 255), _RGB(0, 0, 170) text$ = CHR$(num) IF LEN(text$) = 1 THEN text$ = " " + text$ + " " ELSE COLOR _RGB32(255, 255, 255), _RGB(0, 0, 170) text$ = RTRIM$(LTRIM$(STR$(num))) END IF END IF IF flashcounter = 60 THEN flashcounter = 1 CLS IF toggle THEN _PUTIMAGE , temp1, temp ELSE _PUTIMAGE , ws, temp _PRINTSTRING (x * 40 - 24 - (LEN(text$)) * 4, y * 30 - 23), text$ LINE (x * 40 - 40, y * 30 - 30)-(x * 40, y * 30), _RGBA32(255, 255, 255, 150), BF k1 = _KEYHIT MouseClick = 0: MouseExit = 0 if MouseButtonSwapped then mouseclick = _mousebutton(2): mouseexit = _mousebutton(1) else mouseclick = _mousebutton(1): mouseexit = _mousebutton(2) end if SELECT CASE k1 CASE 13: EXIT DO CASE 27 _AUTODISPLAY SCREEN 0: WIDTH w, h: _FONT font: _DEST 0: _DELAY .2 IF _RESIZE THEN donothing = atall EXIT SUB CASE 32: toggle = NOT toggle CASE 18432: y = y - 1 CASE 19200: x = x - 1 CASE 20480: y = y + 1 CASE 19712: x = x + 1 END SELECT IF x < 1 THEN x = 1 IF x > 16 THEN x = 16 IF y < 1 THEN y = 1 IF y > 16 THEN y = 16 _DISPLAY Ex = _EXIT IF Ex THEN _AUTODISPLAY SCREEN 0: WIDTH w, h: _FONT font: _DEST 0: _DELAY .2 IF _RESIZE THEN donothing = atall EXIT FUNCTION END IF IF MouseExit THEN _AUTODISPLAY SCREEN 0: WIDTH w, h: _FONT font: _DEST 0: _DELAY .2 IF _RESIZE THEN donothing = atall EXIT FUNCTION END IF LOOP UNTIL mouseclick ret% = (y - 1) * 16 + x - 1 IF ret% > 0 AND ret% < 255 THEN l = idecy a$ = idegetline(l) l$ = LEFT$(a$, idecx - 1): r$ = RIGHT$(a$, LEN(a$) - idecx + 1) text$ = l$ + CHR$(ret%) + r$ textlen = LEN(text$) l$ = LEFT$(idet$, ideli - 1) m$ = MKL$(textlen) + text$ + MKL$(textlen) r$ = RIGHT$(idet$, LEN(idet$) - ideli - LEN(a$) - 7) idet$ = l$ + m$ + r$ idecx = idecx + 1 END IF _AUTODISPLAY SCREEN 0: WIDTH w, h _FONT font _DEST 0: _DELAY .2 IF _RESIZE THEN donothing = atall 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 oo 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, "F1" 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 SUB Mathbox 'Draw a box '-------- 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 oo AS idedbotype DIM sep AS STRING * 1 sep = CHR$(0) '-------- end of generic dialog box header -------- DoAnother: titlestr$ = " Give me a Math Equation " messagestr$ = "" '-------- init -------- i = 0 w = LEN(messagestr$) + 2 w2 = LEN(titlestr$) + 4 IF w < w2 THEN w = w2 idepar p, w, 4, titlestr$ i = i + 1 o(i).typ = 3 o(i).y = 4 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 -------- COLOR 0, 7: LOCATE p.y + 2, p.x + 2: PRINT messagestr$; '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt THEN IF LEN(K$) = 1 THEN k = ASC(UCASE$(K$)) IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k) IF K$ = CHR$(27) THEN EXIT SUB 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 IF K$ > CHR$(31) AND K$ < CHR$(123) THEN messagestr$ = messagestr$ + K$ IF K$ = CHR$(8) THEN messagestr$ = LEFT$(messagestr$, LEN(messagestr$) - 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 (focus = 1 AND info <> 0) THEN EXIT DO 'end of custom controls mousedown = 0 mouseup = 0 LOOP temp$ = messagestr$ 'Make a back up of our user return titlestr$ = "(H)ex/(D)ec (U)n(C)omment (ESC)ape/(R)edo" ev$ = Evaluate_Expression$(messagestr$) messagestr$ = ev$ '-------- init -------- i = 0 w = LEN(messagestr$) + 2 w2 = LEN(titlestr$) + 4 IF w < w2 THEN w = w2 idepar p, w, 4, titlestr$ i = i + 1 o(i).typ = 3 o(i).y = 4 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 -------- COLOR 0, 7: LOCATE p.y + 2, p.x + 2: PRINT messagestr$; '-------- 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 THEN idehl = 1 ELSE idehl = 0 'convert "alt+letter" scancode to letter's ASCII character altletter$ = "" IF alt 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 IF K$ = "H" OR K$ = "h" THEN ev$ = "&H" + HEX$(VAL(ev$)) IF K$ = "D" OR K$ = "d" THEN ev$ = STR$(VAL(ev$)) IF K$ = "U" OR K$ = "u" THEN comment = 0 IF K$ = "C" OR K$ = "c" THEN comment = -1 IF K$ = "R" OR K$ = "r" THEN GOTO DoAnother IF K$ = CHR$(27) THEN EXIT SUB IF comment THEN messagestr$ = ev$ + " ' " + temp$ ELSE messagestr$ = ev$ 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 (focus = 1 AND info <> 0) THEN EXIT DO 'end of custom controls mousedown = 0 mouseup = 0 LOOP IF INSTR(messagestr$, " LINES INSERTED") THEN EXIT SUB l = idecy a$ = idegetline(l) l$ = LEFT$(a$, idecx - 1): r$ = RIGHT$(a$, LEN(a$) - idecx + 1) text$ = l$ + messagestr$ + r$ textlen = LEN(text$) l$ = LEFT$(idet$, ideli - 1) m$ = MKL$(textlen) + text$ + MKL$(textlen) r$ = RIGHT$(idet$, LEN(idet$) - ideli - LEN(a$) - 7) idet$ = l$ + m$ + r$ idecx = idecx + LEN(messagestr$) END SUB SUB Sort (m AS _MEM) 'Provided by Steve McNeill DIM t AS LONG: t = m.TYPE DIM i AS _UNSIGNED LONG DIM ES AS LONG, EC AS LONG IF NOT t AND 65536 THEN EXIT SUB 'We won't work without an array IF t AND 1024 THEN DataType = 10 IF t AND 1 THEN DataType = DataType + 1 IF t AND 2 THEN DataType = DataType + 2 IF t AND 4 THEN IF t AND 128 THEN DataType = DataType + 4 ELSE DataType = 3 IF t AND 8 THEN IF t AND 128 THEN DataType = DataType + 8 ELSE DataType = 5 IF t AND 32 THEN DataType = 6 IF t AND 512 THEN DataType = 7 'Convert our offset data over to something we can work with DIM m1 AS _MEM: m1 = _MEMNEW(8) _MEMPUT m1, m1.OFFSET, m.ELEMENTSIZE: _MEMGET m1, m1.OFFSET, ES 'Element Size _MEMPUT m1, m1.OFFSET, m.SIZE: _MEMGET m1, m1.OFFSET, EC 'Element Count will temporily hold the WHOLE array size _MEMFREE m1 EC = EC / ES - 1 'Now we take the whole element size / the size of the elements and get our actual element count. We subtract 1 so our arrays start at 0 and not 1. 'And work with it! DIM o AS _OFFSET, o1 AS _OFFSET, counter AS _UNSIGNED LONG SELECT CASE DataType CASE 1 'BYTE DIM temp1(-128 TO 127) AS _UNSIGNED LONG DIM t1 AS _BYTE i = 0 DO _MEMGET m, m.OFFSET + i, t1 temp1(t1) = temp1(t1) + 1 i = i + 1 LOOP UNTIL i > EC i1 = -128 DO DO UNTIL temp1(i1) = 0 _MEMPUT m, m.OFFSET + counter, i1 AS _BYTE counter = counter + 1 temp1(i1) = temp1(i1) - 1 IF counter > EC THEN EXIT SUB LOOP i1 = i1 + 1 LOOP UNTIL i1 > 127 CASE 2: 'INTEGER DIM temp2(-32768 TO 32767) AS _UNSIGNED LONG DIM t2 AS INTEGER i = 0 DO _MEMGET m, m.OFFSET + i * 2, t2 temp2(t2) = temp2(t2) + 1 i = i + 1 LOOP UNTIL i > EC i1 = -32768 DO DO UNTIL temp2(i1) = 0 _MEMPUT m, m.OFFSET + counter * 2, i1 AS INTEGER counter = counter + 1 temp2(i1) = temp2(i1) - 1 IF counter > EC THEN EXIT SUB LOOP i1 = i1 + 1 LOOP UNTIL i1 > 32767 CASE 3 'SINGLE DIM T3a AS SINGLE, T3b AS SINGLE gap = EC DO gap = 10 * gap \ 13 IF gap < 1 THEN gap = 1 i = 0 swapped = 0 DO o = m.OFFSET + i * 4 o1 = m.OFFSET + (i + gap) * 4 IF _MEMGET(m, o, SINGLE) > _MEMGET(m, o1, SINGLE) THEN _MEMGET m, o1, T3a _MEMGET m, o, T3b _MEMPUT m, o1, T3b _MEMPUT m, o, T3a swapped = -1 END IF i = i + 1 LOOP UNTIL i + gap > EC LOOP UNTIL gap = 1 AND swapped = 0 CASE 4 'LONG DIM T4a AS LONG, T4b AS LONG gap = EC DO gap = 10 * gap \ 13 IF gap < 1 THEN gap = 1 i = 0 swapped = 0 DO o = m.OFFSET + i * 4 o1 = m.OFFSET + (i + gap) * 4 IF _MEMGET(m, o, LONG) > _MEMGET(m, o1, LONG) THEN _MEMGET m, o1, T4a _MEMGET m, o, T4b _MEMPUT m, o1, T4b _MEMPUT m, o, T4a swapped = -1 END IF i = i + 1 LOOP UNTIL i + gap > EC LOOP UNTIL gap = 1 AND swapped = 0 CASE 5 'DOUBLE DIM T5a AS DOUBLE, T5b AS DOUBLE gap = EC DO gap = 10 * gap \ 13 IF gap < 1 THEN gap = 1 i = 0 swapped = 0 DO o = m.OFFSET + i * 8 o1 = m.OFFSET + (i + gap) * 8 IF _MEMGET(m, o, DOUBLE) > _MEMGET(m, o1, DOUBLE) THEN _MEMGET m, o1, T5a _MEMGET m, o, T5b _MEMPUT m, o1, T5b _MEMPUT m, o, T5a swapped = -1 END IF i = i + 1 LOOP UNTIL i + gap > EC LOOP UNTIL gap = 1 AND swapped = 0 CASE 6 ' _FLOAT DIM T6a AS _FLOAT, T6b AS _FLOAT gap = EC DO gap = 10 * gap \ 13 IF gap < 1 THEN gap = 1 i = 0 swapped = 0 DO o = m.OFFSET + i * 32 o1 = m.OFFSET + (i + gap) * 32 IF _MEMGET(m, o, _FLOAT) > _MEMGET(m, o1, _FLOAT) THEN _MEMGET m, o1, T6a _MEMGET m, o, T6b _MEMPUT m, o1, T6b _MEMPUT m, o, T6a swapped = -1 END IF i = i + 1 LOOP UNTIL i + gap > EC LOOP UNTIL gap = 1 AND swapped = 0 CASE 7 'String DIM T7a AS STRING, T7b AS STRING, T7c AS STRING T7a = SPACE$(ES): T7b = SPACE$(ES): T7c = SPACE$(ES) gap = EC DO gap = INT(gap / 1.247330950103979) IF gap < 1 THEN gap = 1 i = 0 swapped = 0 DO o = m.OFFSET + i * ES o1 = m.OFFSET + (i + gap) * ES _MEMGET m, o, T7a _MEMGET m, o1, T7b IF T7a > T7b THEN T7c = T7b _MEMPUT m, o1, T7a _MEMPUT m, o, T7c swapped = -1 END IF i = i + 1 LOOP UNTIL i + gap > EC LOOP UNTIL gap = 1 AND swapped = false CASE 8 '_INTEGER64 DIM T8a AS _INTEGER64, T8b AS _INTEGER64 gap = EC DO gap = 10 * gap \ 13 IF gap < 1 THEN gap = 1 i = 0 swapped = 0 DO o = m.OFFSET + i * 8 o1 = m.OFFSET + (i + gap) * 8 IF _MEMGET(m, o, _INTEGER64) > _MEMGET(m, o1, _INTEGER64) THEN _MEMGET m, o1, T8a _MEMGET m, o, T8b _MEMPUT m, o1, T8b _MEMPUT m, o, T8a swapped = -1 END IF i = i + 1 LOOP UNTIL i + gap > EC LOOP UNTIL gap = 1 AND swapped = 0 CASE 11: '_UNSIGNED _BYTE DIM temp11(0 TO 255) AS _UNSIGNED LONG DIM t11 AS _UNSIGNED _BYTE i = 0 DO _MEMGET m, m.OFFSET + i, t11 temp11(t11) = temp11(t11) + 1 i = i + 1 LOOP UNTIL i > EC i1 = 0 DO DO UNTIL temp11(i1) = 0 _MEMPUT m, m.OFFSET + counter, i1 AS _UNSIGNED _BYTE counter = counter + 1 temp11(i1) = temp11(i1) - 1 IF counter > EC THEN EXIT SUB LOOP i1 = i1 + 1 LOOP UNTIL i1 > 255 CASE 12 '_UNSIGNED INTEGER DIM temp12(0 TO 65535) AS _UNSIGNED LONG DIM t12 AS _UNSIGNED INTEGER i = 0 DO _MEMGET m, m.OFFSET + i * 2, t12 temp12(t12) = temp12(t12) + 1 i = i + 1 LOOP UNTIL i > EC i1 = 0 DO DO UNTIL temp12(i1) = 0 _MEMPUT m, m.OFFSET + counter * 2, i1 AS _UNSIGNED INTEGER counter = counter + 1 temp12(i1) = temp12(i1) - 1 IF counter > EC THEN EXIT SUB LOOP i1 = i1 + 1 LOOP UNTIL i1 > 65535 CASE 14 '_UNSIGNED LONG DIM T14a AS _UNSIGNED LONG, T14b AS _UNSIGNED LONG gap = EC DO gap = 10 * gap \ 13 IF gap < 1 THEN gap = 1 i = 0 swapped = 0 DO o = m.OFFSET + i * 4 o1 = m.OFFSET + (i + gap) * 4 IF _MEMGET(m, o, _UNSIGNED LONG) > _MEMGET(m, o1, _UNSIGNED LONG) THEN _MEMGET m, o1, T14a _MEMGET m, o, T14b _MEMPUT m, o1, T14b _MEMPUT m, o, T14a swapped = -1 END IF i = i + 1 LOOP UNTIL i + gap > EC LOOP UNTIL gap = 1 AND swapped = 0 CASE 18: '_UNSIGNED _INTEGER64 DIM T18a AS _UNSIGNED _INTEGER64, T18b AS _UNSIGNED _INTEGER64 gap = EC DO gap = 10 * gap \ 13 IF gap < 1 THEN gap = 1 i = 0 swapped = 0 DO o = m.OFFSET + i * 8 o1 = m.OFFSET + (i + gap) * 8 IF _MEMGET(m, o, _UNSIGNED _INTEGER64) > _MEMGET(m, o1, _UNSIGNED _INTEGER64) THEN _MEMGET m, o1, T18a _MEMGET m, o, T18b _MEMPUT m, o1, T18b _MEMPUT m, o, T18a swapped = -1 END IF i = i + 1 LOOP UNTIL i + gap > EC LOOP UNTIL gap = 1 AND swapped = 0 END SELECT END SUB FUNCTION FindProposedTitle$ 'Finds the first occurence of _TITLE to suggest a file name 'when saving for the first time or saving as. FOR find_TITLE = 1 TO iden thisline$ = idegetline(find_TITLE) thisline$ = LTRIM$(RTRIM$(thisline$)) found_TITLE = INSTR(UCASE$(thisline$), "_TITLE " + CHR$(34)) IF found_TITLE > 0 THEN InQuote%% = 0 FOR check_quotes = 1 to found_TITLE IF MID$(thisline$, check_quotes, 1) = CHR$(34) THEN InQuote%% = NOT InQuote%% NEXT check_quotes IF NOT InQuote%% 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 wipe_INVALID = 1 to LEN(TempFound_TITLE$) ThisChar$ = MID$(TempFound_TITLE$, wipe_INVALID, 1) IF INSTR(InvalidChars$, ThisChar$) = 0 THEN Found_TITLE$ = Found_TITLE$ + ThisChar$ END IF NEXT wipe_INVALID FindProposedTitle$ = LTRIM$(RTRIM$(Found_TITLE$)) END FUNCTION FUNCTION FindCurrentSF$(whichline) 'Get the name of the SUB/FUNCTION whichline is in. 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 isSF > 0 THEN IF RIGHT$(ncthisline$, 7) = " STATIC" THEN thisline$ = RTRIM$(LEFT$(thisline$, LEN(thisline$) - 7)) END IF thisline$ = RTRIM$(LTRIM$(thisline$)) checkargs = INSTR(thisline$, "(") IF checkargs > 0 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$ = rtrim$(lTRIM$(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$ = "" END IF EXIT FOR END IF NEXT END IF FindCurrentSF$ = sfname$ END FUNCTION SUB AddQuickNavHistory(LineNumber&) IF QuickNavTotal > 0 THEN IF QuickNavHistory(QuickNavTotal) = LineNumber& THEN EXIT SUB END IF QuickNavTotal = QuickNavTotal + 1 REDIM _PRESERVE QuickNavHistory(1 TO QuickNavTotal) AS LONG QuickNavHistory(QuickNavTotal) = LineNumber& 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 LOCATE idewy - 1, 2 PRINT STRING$(((idewx - 2) * Percentage%) / 100, "_"); END IF END IF a$ = IdeInfo IF LEN(a$) > 60 THEN a$ = LEFT$(a$, 57) + string$(3, 250) IF LEN(a$) < 60 THEN a$ = a$ + SPACE$(60 - LEN(a$)) COLOR 0, 3: LOCATE idewy + idesubwindow, 2 PRINT a$; PCOPY 3, 0 END SUB SUB 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) TempDarkerCommentColor~& = _RGB32(_RED32(IDECommentColor) * .5, _GREEN32(IDECommentColor) * .5, _BLUE32(IDECommentColor) * .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 13, TempDarkerFGColor~&, 0 _PALETTECOLOR 6, TempDarkerBG2Color~&, 0 _PALETTECOLOR 11, TempDarkerCommentColor~&, 0 _PALETTECOLOR 10, TempDarkerMetaColor~&, 0 _PALETTECOLOR 14, TempDarkerQuoteColor~&, 0 _PALETTECOLOR 5, _RGB32(255, 255, 255), 0 ELSE _PALETTECOLOR 1, IDEBackgroundColor, 0 _PALETTECOLOR 6, IDEBackgroundColor2, 0 _PALETTECOLOR 11, IDECommentColor, 0 _PALETTECOLOR 10, IDEMetaCommandColor, 0 _PALETTECOLOR 14, IDEQuoteColor, 0 _PALETTECOLOR 13, IDETextColor, 0 ENDIF END SUB '$INCLUDE:'wiki\wiki_methods.bas'