diff --git a/internal/support/addprefix/addprefix.bas b/internal/support/addprefix/addprefix.bas new file mode 100644 index 000000000..6c9a8bdd4 --- /dev/null +++ b/internal/support/addprefix/addprefix.bas @@ -0,0 +1,785 @@ +option _explicit +$screenhide +$console +deflng a-z + +'Removed leading @ +'Line continutation formatting +'Removed all non-underscore items +'Removed all metacommands +'Removed _ALL, _ANTICLOCKWISE, _AUTO, _BEHIND, _CLEAR, _CLIP, _CLOCKWISE, _DONTWAIT, +' _EXPLICITARRAY, _HARDWARE, _HARDWARE1, _HIDE, _MIDDLE, _NONE, _OFF (OFF apears to be just as valid) +' _ONLY, _ONTOP, _SEAMLESS, _SHOW, _SMOOTHSHRUNK, _SMOOTHSTRETCHED, _SOFTWARE, _SQUAREPIXELS, _STRETCH, _TOGGLE +const KEYWORDS = "_ACCEPTFILEDROP@_ACOS@_ACOSH@_ADLER32@_ALLOWFULLSCREEN@_ALPHA@_ALPHA32@_ANDALSO@_ARCCOT@_ARCCSC@_ARCSEC@_ASIN@_ASINH@_ASSERT@_ATAN2@_ATANH@_AUTODISPLAY@_AXIS@"+_ +"_BACKGROUNDCOLOR@_BIN$@_BIT@_BLEND@_BLINK@_BLUE@_BLUE32@_BUTTON@_BUTTONCHANGE@_BYTE@"+_ +"_CAPSLOCK@_CEIL@_CINP@_CLEARCOLOR@_CLIPBOARD$@_CLIPBOARDIMAGE@_COLORCHOOSERDIALOG@_COMMANDCOUNT@_CONNECTED@_CONNECTIONADDRESS@_CONNECTIONADDRESS$@_CONSOLE@_CONSOLECURSOR@_CONSOLEFONT@_CONSOLEINPUT@_CONSOLETITLE@_CONTINUE@_CONTROLCHR@_COPYIMAGE@_COPYPALETTE@_COSH@_COT@_COTH@_CRC32@_CSC@_CSCH@_CV@_CWD$@"+_ +"_D2G@_D2R@_DEFAULTCOLOR@_DEFINE@_DEFLATE$@_DELAY@_DEPTHBUFFER@_DESKTOPHEIGHT@_DESKTOPWIDTH@_DEST@_DEVICE$@_DEVICEINPUT@_DEVICES@_DIR$@_DIREXISTS@_DISPLAY@_DISPLAYORDER@_DONTBLEND@_DROPPEDFILE@_DROPPEDFILE$@"+_ +"_ECHO@_EMBEDDED$@_ENVIRONCOUNT@_ERRORLINE@_ERRORMESSAGE$@_EXIT@_EXPLICIT@"+_ +"_FILEEXISTS@_FILES$@_FILLBACKGROUND@_FINISHDROP@_FLOAT@_FONT@_FONTHEIGHT@_FONTWIDTH@_FPS@_FREEFONT@_FREEIMAGE@_FREETIMER@_FULLPATH$@_FULLSCREEN@"+_ +"_G2D@_G2R@"+_ +"_GLACCUM@_GLALPHAFUNC@_GLARETEXTURESRESIDENT@_GLARRAYELEMENT@"+_ +"_GLBEGIN@_GLBINDTEXTURE@_GLBITMAP@_GLBLENDFUNC@"+_ +"_GLCALLLIST@_GLCALLLISTS@_GLCLEAR@_GLCLEARACCUM@_GLCLEARCOLOR@_GLCLEARDEPTH@_GLCLEARINDEX@_GLCLEARSTENCIL@_GLCLIPPLANE@_GLCOLOR3B@_GLCOLOR3BV@_GLCOLOR3D@_GLCOLOR3DV@_GLCOLOR3F@_GLCOLOR3FV@_GLCOLOR3I@_GLCOLOR3IV@_GLCOLOR3S@_GLCOLOR3SV@_GLCOLOR3UB@_GLCOLOR3UBV@_GLCOLOR3UI@_GLCOLOR3UIV@_GLCOLOR3US@_GLCOLOR3USV@_GLCOLOR4B@_GLCOLOR4BV@_GLCOLOR4D@_GLCOLOR4DV@_GLCOLOR4F@_GLCOLOR4FV@_GLCOLOR4I@_GLCOLOR4IV@_GLCOLOR4S@_GLCOLOR4SV@_GLCOLOR4UB@_GLCOLOR4UBV@_GLCOLOR4UI@_GLCOLOR4UIV@_GLCOLOR4US@_GLCOLOR4USV@_GLCOLORMASK@_GLCOLORMATERIAL@_GLCOLORPOINTER@_GLCOPYPIXELS@_GLCOPYTEXIMAGE1D@_GLCOPYTEXIMAGE2D@_GLCOPYTEXSUBIMAGE1D@_GLCOPYTEXSUBIMAGE2D@_GLCULLFACE@"+_ +"_GLDELETELISTS@_GLDELETETEXTURES@_GLDEPTHFUNC@_GLDEPTHMASK@_GLDEPTHRANGE@_GLDISABLE@_GLDISABLECLIENTSTATE@_GLDRAWARRAYS@_GLDRAWBUFFER@_GLDRAWELEMENTS@_GLDRAWPIXELS@"+_ +"_GLEDGEFLAG@_GLEDGEFLAGPOINTER@_GLEDGEFLAGV@_GLENABLE@_GLENABLECLIENTSTATE@_GLEND@_GLENDLIST@_GLEVALCOORD1D@_GLEVALCOORD1DV@_GLEVALCOORD1F@_GLEVALCOORD1FV@_GLEVALCOORD2D@_GLEVALCOORD2DV@_GLEVALCOORD2F@_GLEVALCOORD2FV@_GLEVALMESH1@_GLEVALMESH2@_GLEVALPOINT1@_GLEVALPOINT2@"+_ +"_GLFEEDBACKBUFFER@_GLFINISH@_GLFLUSH@_GLFOGF@_GLFOGFV@_GLFOGI@_GLFOGIV@_GLFRONTFACE@_GLFRUSTUM@"+_ +"_GLGENLISTS@_GLGENTEXTURES@_GLGETBOOLEANV@_GLGETCLIPPLANE@_GLGETDOUBLEV@_GLGETERROR@_GLGETFLOATV@_GLGETINTEGERV@_GLGETLIGHTFV@_GLGETLIGHTIV@_GLGETMAPDV@_GLGETMAPFV@_GLGETMAPIV@_GLGETMATERIALFV@_GLGETMATERIALIV@_GLGETPIXELMAPFV@_GLGETPIXELMAPUIV@_GLGETPIXELMAPUSV@_GLGETPOINTERV@_GLGETPOLYGONSTIPPLE@_GLGETSTRING@_GLGETTEXENVFV@_GLGETTEXENVIV@_GLGETTEXGENDV@_GLGETTEXGENFV@_GLGETTEXGENIV@_GLGETTEXIMAGE@_GLGETTEXLEVELPARAMETERFV@_GLGETTEXLEVELPARAMETERIV@_GLGETTEXPARAMETERFV@_GLGETTEXPARAMETERIV@"+_ +"_GLHINT@"+_ +"_GLINDEXD@_GLINDEXDV@_GLINDEXF@_GLINDEXFV@_GLINDEXI@_GLINDEXIV@_GLINDEXMASK@_GLINDEXPOINTER@_GLINDEXS@_GLINDEXSV@_GLINDEXUB@_GLINDEXUBV@_GLINITNAMES@_GLINTERLEAVEDARRAYS@_GLISENABLED@"+_ +"_GLISLIST@_GLISTEXTURE@_GLLIGHTF@_GLLIGHTFV@_GLLIGHTI@_GLLIGHTIV@_GLLIGHTMODELF@_GLLIGHTMODELFV@_GLLIGHTMODELI@_GLLIGHTMODELIV@_GLLINESTIPPLE@_GLLINEWIDTH@_GLLISTBASE@_GLLOADIDENTITY@_GLLOADMATRIXD@_GLLOADMATRIXF@_GLLOADNAME@_GLLOGICOP@"+_ +"_GLMAP1D@_GLMAP1F@_GLMAP2D@_GLMAP2F@_GLMAPGRID1D@_GLMAPGRID1F@_GLMAPGRID2D@_GLMAPGRID2F@_GLMATERIALF@_GLMATERIALFV@_GLMATERIALI@_GLMATERIALIV@_GLMATRIXMODE@_GLMULTMATRIXD@_GLMULTMATRIXF@"+_ +"_GLNEWLIST@_GLNORMAL3B@_GLNORMAL3BV@_GLNORMAL3D@_GLNORMAL3DV@_GLNORMAL3F@_GLNORMAL3FV@_GLNORMAL3I@_GLNORMAL3IV@_GLNORMAL3S@_GLNORMAL3SV@_GLNORMALPOINTER@"+_ +"_GLORTHO@"+_ +"_GLPASSTHROUGH@_GLPIXELMAPFV@_GLPIXELMAPUIV@_GLPIXELMAPUSV@_GLPIXELSTOREF@_GLPIXELSTOREI@_GLPIXELTRANSFERF@_GLPIXELTRANSFERI@_GLPIXELZOOM@_GLPOINTSIZE@_GLPOLYGONMODE@_GLPOLYGONOFFSET@_GLPOLYGONSTIPPLE@_GLPOPATTRIB@_GLPOPCLIENTATTRIB@_GLPOPMATRIX@_GLPOPNAME@_GLPRIORITIZETEXTURES@_GLPUSHATTRIB@_GLPUSHCLIENTATTRIB@_GLPUSHMATRIX@_GLPUSHNAME@"+_ +"_GLRASTERPOS2D@_GLRASTERPOS2DV@_GLRASTERPOS2F@_GLRASTERPOS2FV@_GLRASTERPOS2I@_GLRASTERPOS2IV@_GLRASTERPOS2S@_GLRASTERPOS2SV@_GLRASTERPOS3D@_GLRASTERPOS3DV@_GLRASTERPOS3F@_GLRASTERPOS3FV@_GLRASTERPOS3I@_GLRASTERPOS3IV@_GLRASTERPOS3S@_GLRASTERPOS3SV@_GLRASTERPOS4D@_GLRASTERPOS4DV@_GLRASTERPOS4F@_GLRASTERPOS4FV@_GLRASTERPOS4I@_GLRASTERPOS4IV@_GLRASTERPOS4S@_GLRASTERPOS4SV@_GLREADBUFFER@_GLREADPIXELS@_GLRECTD@_GLRECTDV@_GLRECTF@_GLRECTFV@_GLRECTI@_GLRECTIV@_GLRECTS@_GLRECTSV@_GLRENDER@_GLRENDERMODE@_GLROTATED@_GLROTATEF@"+_ +"_GLSCALED@_GLSCALEF@_GLSCISSOR@_GLSELECTBUFFER@_GLSHADEMODEL@_GLSTENCILFUNC@_GLSTENCILMASK@_GLSTENCILOP@"+_ +"_GLTEXCOORD1D@_GLTEXCOORD1DV@_GLTEXCOORD1F@_GLTEXCOORD1FV@_GLTEXCOORD1I@_GLTEXCOORD1IV@_GLTEXCOORD1S@_GLTEXCOORD1SV@_GLTEXCOORD2D@_GLTEXCOORD2DV@_GLTEXCOORD2F@_GLTEXCOORD2FV@_GLTEXCOORD2I@_GLTEXCOORD2IV@_GLTEXCOORD2S@_GLTEXCOORD2SV@_GLTEXCOORD3D@_GLTEXCOORD3DV@_GLTEXCOORD3F@_GLTEXCOORD3FV@_GLTEXCOORD3I@_GLTEXCOORD3IV@_GLTEXCOORD3S@_GLTEXCOORD3SV@_GLTEXCOORD4D@_GLTEXCOORD4DV@_GLTEXCOORD4F@_GLTEXCOORD4FV@_GLTEXCOORD4I@_GLTEXCOORD4IV@_GLTEXCOORD4S@_GLTEXCOORD4SV@_GLTEXCOORDPOINTER@_GLTEXENVF@_GLTEXENVFV@_GLTEXENVI@_GLTEXENVIV@_GLTEXGEND@_GLTEXGENDV@_GLTEXGENF@_GLTEXGENFV@_GLTEXGENI@_GLTEXGENIV@_GLTEXIMAGE1D@_GLTEXIMAGE2D@_GLTEXPARAMETERF@_GLTEXPARAMETERFV@_GLTEXPARAMETERI@_GLTEXPARAMETERIV@_GLTEXSUBIMAGE1D@_GLTEXSUBIMAGE2D@_GLTRANSLATED@_GLTRANSLATEF@"+_ +"_GLUPERSPECTIVE@"+_ +"_GLVERTEX2D@_GLVERTEX2DV@_GLVERTEX2F@_GLVERTEX2FV@_GLVERTEX2I@_GLVERTEX2IV@_GLVERTEX2S@_GLVERTEX2SV@_GLVERTEX3D@_GLVERTEX3DV@_GLVERTEX3F@_GLVERTEX3FV@_GLVERTEX3I@_GLVERTEX3IV@_GLVERTEX3S@_GLVERTEX3SV@_GLVERTEX4D@_GLVERTEX4DV@_GLVERTEX4F@_GLVERTEX4FV@_GLVERTEX4I@_GLVERTEX4IV@_GLVERTEX4S@_GLVERTEX4SV@_GLVERTEXPOINTER@_GLVIEWPORT@"+_ +"_GREEN@_GREEN32@"+_ +"_HEIGHT@_HYPOT@"+_ +"_ICON@_INCLERRORFILE$@_INCLERRORLINE@_INFLATE$@_INPUTBOX$@_INSTRREV@_INTEGER64@"+_ +"_KEEPBACKGROUND@_KEYCLEAR@_KEYDOWN@_KEYHIT@"+_ +"_LASTAXIS@_LASTBUTTON@_LASTHANDLER@_LASTWHEEL@_LIMIT@_LOADFONT@_LOADIMAGE@"+_ +"_MAPTRIANGLE@_MAPUNICODE@_MD5$@_MEM@_MEMCOPY@_MEMELEMENT@_MEMEXISTS@_MEMFILL@_MEMFREE@_MEMGET@_MEMIMAGE@_MEMNEW@_MEMPUT@_MEMSOUND@_MESSAGEBOX@_MIDISOUNDBANK@_MK$@_MOUSEBUTTON@_MOUSEHIDE@_MOUSEINPUT@_MOUSEMOVE@_MOUSEMOVEMENTX@_MOUSEMOVEMENTY@_MOUSEPIPEOPEN@_MOUSESHOW@_MOUSEWHEEL@_MOUSEX@_MOUSEY@"+_ +"_NEGATE@_NEWHANDLER@_NEWIMAGE@_NOTIFYPOPUP@_NUMLOCK@"+_ +"_OFFSET@_ONLYBACKGROUND@_OPENCLIENT@_OPENCONNECTION@_OPENFILEDIALOG$@_OPENHOST@_ORELSE@_OS$@"+_ +"_PALETTECOLOR@_PI@_PIXELSIZE@_PRESERVE@_PRINTIMAGE@_PRINTMODE@_PRINTSTRING@_PRINTWIDTH@_PUTIMAGE@"+_ +"_R2D@_R2G@_READBIT@_READFILE$@_RED@_RED32@_RESETBIT@_RESIZE@_RESIZEHEIGHT@_RESIZEWIDTH@_RGB@_RGB32@_RGBA@_RGBA32@_ROL@_ROR@_ROUND@"+_ +"_SAVEFILEDIALOG$@_SAVEIMAGE@_SCALEDHEIGHT@_SCALEDWIDTH@_SCREENCLICK@_SCREENEXISTS@_SCREENHIDE@_SCREENICON@_SCREENIMAGE@_SCREENMOVE@_SCREENPRINT@_SCREENSHOW@_SCREENX@_SCREENY@_SCROLLLOCK@_SEC@_SECH@_SELECTFOLDERDIALOG$@_SETALPHA@_SETBIT@_SHELLHIDE@_SHL@_SHR@_SINH@_SMOOTH@_SNDBAL@_SNDCLOSE@_SNDCOPY@_SNDGETPOS@_SNDLEN@_SNDLIMIT@_SNDLOOP@_SNDNEW@_SNDOPEN@_SNDOPENRAW@_SNDPAUSE@_SNDPAUSED@_SNDPLAY@_SNDPLAYCOPY@_SNDPLAYFILE@_SNDPLAYING@_SNDRATE@_SNDRAW@_SNDRAWDONE@_SNDRAWLEN@_SNDSETPOS@_SNDSTOP@_SNDVOL@_SOURCE@_STARTDIR$@_STATUSCODE@_STRCMP@_STRICMP@"+_ +"_TANH@_TITLE@_TITLE$@_TOGGLEBIT@_TOTALDROPPEDFILES@_TRIM$@"+_ +"_UCHARPOS@_UFONTHEIGHT@_ULINESPACING@_UNSIGNED@_UPRINTSTRING@_UPRINTWIDTH@"+_ +"_WHEEL@_WIDTH@_WINDOWHANDLE@_WINDOWHASFOCUS@_WRITEFILE@" + +const FALSE = 0, TRUE = -1 + +const ASCII_TAB = 9 +const ASCII_LF = 10 +const ASCII_VTAB = 11 +const ASCII_FF = 12 +const ASCII_CR = 13 +const ASCII_EOF = 0 'Prefer NUL over ^Z for this purpose as some people embed ^Z in their programs +const ASCII_QUOTE = 34 + +const TOK_EOF = 1 +const TOK_NEWLINE = 2 +const TOK_WORD = 3 +const TOK_METACMD = 6 +const TOK_COMMENT = 7 +const TOK_STRING = 8 +const TOK_DATA = 9 +const TOK_PUNCTUATION = 11 +const TOK_COLON = 15 + +const STATE_BEGIN = 1 +const STATE_METACMD = 3 +const STATE_WORD = 4 +const STATE_COMMENT = 5 +const STATE_STRING = 6 +const STATE_DATA = 7 +const STATE_NEWLINE = 12 +const STATE_NEWLINE_WIN = 13 + +type token_t + t as long 'TOK_ type + c as string 'Content + uc as string 'Content in UPPERCASE for comparisons + spaces as string 'Any whitespace characters detected before the content +end type +dim shared token as token_t + +redim shared prefix_keywords$(1) 'Stored without the prefix +redim shared prefix_colors$(0) +redim shared include_queue$(0) +dim shared exedir$ +dim shared input_content$, current_include +dim shared line_count, column_count +dim shared next_chr_idx, tk_state +dim shared noprefix_detected +dim shared in_udt, in_declare_library + +exedir$ = _cwd$ +chdir _startdir$ + +build_keyword_list + +if _commandcount = 0 then + _screenshow + print "$NOPREFIX remover" + print "Files will be backed up before conversion." + print "Run this program with a file as a command-line argument or enter a file now" + print "File name: "; + line input include_queue$(0) +else + _dest _console + include_queue$(0) = command$(1) +end if + +do + load_prepass_file include_queue$(current_include) + prepass + current_include = current_include + 1 +loop while current_include <= ubound(include_queue$) +if not noprefix_detected then + print "Program does not use $NOPREFIX, no changes made" + if _commandcount = 0 then end else system +end if + +print "Found"; ubound(include_queue$); "$INCLUDE file(s)" +current_include = 0 +do + load_file include_queue$(current_include) + do + process_logical_line + loop while token.t <> TOK_EOF + close #2 + current_include = current_include + 1 +loop while current_include <= ubound(include_queue$) +print "Conversion complete" +if _commandcount = 0 then end else system + +sub load_prepass_file (filename$) + print "Analysing " + filename$ + input_content$ = _readfile$(filename$) + chr$(ASCII_EOF) + rewind +end sub + +sub prepass + do + next_token_raw + select case token.t + case TOK_METACMD + select case token.uc + case "$NOPREFIX" + noprefix_detected = TRUE + case "$COLOR:0" + build_color0_list + case "$COLOR:32" + build_color32_list + end select + case TOK_WORD + select case token.uc + case "DATA" + tk_state = STATE_DATA + case "REM" + tk_state = STATE_COMMENT + end select + case TOK_COMMENT + process_maybe_include + case TOK_NEWLINE + line_count = line_count + 1 + column_count = 0 + case TOK_EOF + exit do + end select + loop +end sub + +sub load_file (filename$) + dim ext, backup$ + ext = _instrrev(filename$, ".") + if ext > 0 then + backup$ = left$(filename$, ext - 1) + "-noprefix" + mid$(filename$, ext) + else + backup$ = filename$ + "-noprefix" + end if + name filename$ as backup$ + print "Moved " + filename$ + " to backup " + backup$ + print "Converting " + filename$ + input_content$ = _readfile$(backup$) + chr$(ASCII_EOF) + open filename$ for binary as #2 + rewind +end sub + +sub process_maybe_include + dim s$, path$, open_quote, close_quote + s$ = token.c + if left$(s$, 1) = "'" then s$ = mid$(s$, 2) + s$ = ltrim$(s$) + if ucase$(left$(s$, 8)) <> "$INCLUDE" then exit sub + open_quote = instr(s$, "'") + close_quote = instr(open_quote + 1, s$, "'") + path$ = mid$(s$, open_quote + 1, close_quote - open_quote - 1) + queue_include path$ +end sub + +sub queue_include (given_path$) + dim current_path$, path$, i + if is_absolute_path(given_path$) then + if not _fileexists(given_path$) then + print "WARNING: cannot locate included file '" + given_path$ + "'" + exit sub + end if + path$ = given_path$ + else + current_path$ = dir_name$(include_queue$(current_include)) + 'First check relative to path of current file + if _fileexists(current_path$ + "/" + given_path$) then + path$ = current_path$ + "/" + given_path$ + 'Next try relative to converter TODO: Change to relative to compiler + elseif _fileexists(exedir$ + "/" + given_path$) then + path$ = exedir$ + "/" + given_path$ + else + print "WARNING: cannot locate included file '" + given_path$ + "'" + exit sub + end if + end if + for i = 0 to ubound(include_queue$) + if include_queue$(i) = path$ then exit sub + next i + i = ubound(include_queue$) + redim _preserve include_queue$(i + 1) + include_queue$(i + 1) = path$ +end sub + +sub rewind + line_count = 1 + column_count = 0 + next_chr_idx = 1 + tk_state = STATE_BEGIN + token.t = 0 + token.c = "" + token.uc = "" +end sub + +sub build_keyword_list + dim i, j, keyword$ + i = 1 + for j = 1 to len(KEYWORDS) + if asc(KEYWORDS, j) = asc("@") then + if asc(keyword$) = asc("_") then + if i > ubound(prefix_keywords$) then redim _preserve prefix_keywords$(ubound(prefix_keywords$) * 2) + prefix_keywords$(i) = mid$(keyword$, 2) + if i > 1 and _strcmp(prefix_keywords$(i), prefix_keywords$(i - 1)) <> 1 then + print "Internal error: " + keyword$ + " out of order" + end + end if + i = i + 1 + end if + keyword$ = "" + else + keyword$ = keyword$ + mid$(KEYWORDS, j, 1) + end if + next j + redim _preserve prefix_keywords$(i - 1) +end sub + +sub build_color0_list + redim prefix_colors$(4) + prefix_colors$(1) = "NP_BLUE" + prefix_colors$(2) = "NP_GREEN" + prefix_colors$(3) = "NP_RED" + prefix_colors$(4) = "NP_BLINK" +end sub + +sub build_color32_list + redim prefix_colors$(3) + prefix_colors$(1) = "NP_BLUE" + prefix_colors$(2) = "NP_GREEN" + prefix_colors$(3) = "NP_RED" +end sub + +sub process_logical_line + next_token + select case token.t + case TOK_METACMD + select case token.uc + case "$NOPREFIX" + 'Keep remenant of $noprefix so line numbers are not changed + token.c = "'" + token.c + " removed here" + end select + case TOK_WORD + if in_udt and token.uc = "END" then + in_udt = FALSE + in_declare_library = FALSE + elseif in_udt then + 'In a UDT definition the field name is never a keyword + next_token + else + select case token.uc + case "SUB", "FUNCTION" + if in_declare_library then process_declare_library_def + case "TYPE" + in_udt = TRUE + case "DATA" + tk_state = STATE_DATA + case "DECLARE" + process_declare + case "PUT" + process_put + case "SCREENMOVE", "_SCREENMOVE" + process_screenmove + case "OPTION" + process_option + case "FULLSCREEN", "_FULLSCREEN" + process_fullscreen + case "ALLOWFULLSCREEN", "_ALLOWFULLSCREEN" + process_allowfullscreen + case "RESIZE", "_RESIZE" + process_resize + case "GLRENDER", "_GLRENDER" + process_glrender + case "DISPLAYORDER", "_DISPLAYORDER" + process_displayorder + case "EXIT" + next_token 'in statement position this is EXIT SUB etc. + case "FPS", "_FPS" + process_fps + case "CLEARCOLOR", "_CLEARCOLOR" + process_clearcolor + case "MAPTRIANGLE", "_MAPTRIANGLE" + process_maptriangle + case "DEPTHBUFFER", "_DEPTHBUFFER" + process_depthbuffer + case "WIDTH" + next_token 'in statement position this is the set-columns command + case "SHELL" + process_shell + case "CAPSLOCK", "_CAPSLOCK", "SCROLLLOCK", "_SCROLLLOCK", "NUMLOCK", "_NUMLOCK" + process_keylock + case "CONSOLECURSOR", "_CONSOLECURSOR" + process_consolecursor + end select + end if + end select + process_rest_of_line +end sub + +sub process_declare + next_token + if token.uc = "SUB" or token.uc = "FUNCTION" then + while not line_end + next_token + wend + elseif token.uc = "LIBRARY" then + in_declare_library = TRUE + end if +end sub + +sub process_declare_library_def + next_token + while token.uc <> "(" and not line_end + next_token + wend + while token.uc <> ")" and not line_end + next_token + if token.uc = "BYVAL" then next_token + next_token 'Skip argument name + skip_expr + wend +end sub + +sub process_put + next_token + if token.uc = "STEP" then next_token + if token.c = "(" then + skip_parens 'Coordinates + next_token ' , + next_token 'Array name + if line_end then exit sub + skip_parens 'Array index + if line_end then exit sub + next_token ' , + if line_end then exit sub + if token.uc = "CLIP" then add_prefix + end if +end sub + +sub process_screenmove + add_prefix + next_token + if line_end then exit sub + if token.uc = "MIDDLE" then add_prefix +end sub + +sub process_option + next_token + if token.uc = "EXPLICITARRAY" then add_prefix +end sub + +sub process_fullscreen + add_prefix + next_token + if line_end then exit sub + if token.c <> "," then + add_prefix + next_token + if line_end then exit sub + end if + next_token ' , + add_prefix +end sub + +sub process_allowfullscreen + add_prefix + next_token + if line_end then exit sub + if token.c <> "," then + add_prefix + next_token + if line_end then exit sub + end if + next_token ' , + add_prefix +end sub + +sub process_resize + add_prefix + next_token + if token.c = "(" or line_end then exit sub + if token.c <> "," then next_token + if line_end then exit sub + next_token + add_prefix +end sub + +sub process_glrender + add_prefix + next_token + add_prefix +end sub + +sub process_displayorder + add_prefix + next_token + while not line_end + if token.c <> "," then add_prefix + next_token + wend +end sub + +sub process_fps + add_prefix + next_token + if token.uc = "AUTO" then add_prefix +end sub + +sub process_clearcolor + add_prefix + next_token + if token.uc = "NONE" then add_prefix +end sub + +sub process_maptriangle + add_prefix + next_token + if token.uc = "CLOCKWISE" or token.uc = "ANTICLOCKWISE" then add_prefix + if token.uc = "_CLOCKWISE" or token.uc = "_ANTICLOCKWISE" then next_token + if token.uc = "SEAMLESS" then add_prefix + if token.uc = "_SEAMLESS" then next_token + do + maybe_add_prefix + next_token + loop while token.uc <> "TO" + next_token + skip_parens + next_token ' - + skip_parens + next_token ' - + skip_parens + if line_end then exit sub + next_token ' , + skip_expr + if line_end then exit sub + next_token ' , + add_prefix +end sub + +sub process_depthbuffer + add_prefix + next_token + if token.uc = "CLEAR" then add_prefix +end sub + +sub process_shell + next_token + if line_end then exit sub + if token.uc = "DONTWAIT" or token.uc = "HIDE" then + add_prefix + next_token + end if + if line_end then exit sub + if token.uc = "DONTWAIT" or token.uc = "HIDE" then add_prefix +end sub + +sub process_keylock + add_prefix + next_token + if token.uc = "TOGGLE" then add_prefix +end sub + +sub process_consolecursor + add_prefix + next_token + if line_end then exit sub + if token.uc = "SHOW" or token.uc = "HIDE" then add_prefix +end sub + +sub skip_parens + dim balance + do + if token.c = "(" then balance = balance + 1 + if token.c = ")" then balance = balance - 1 + maybe_add_prefix + next_token + loop until balance = 0 +end sub + +sub skip_expr + dim balance + do until balance <= 0 and (token.c = "," or line_end) + if token.c = "(" then balance = balance + 1 + if token.c = ")" then balance = balance - 1 + maybe_add_prefix + next_token + loop +end sub + +sub add_prefix + if asc(token.c) <> asc("_") then + token.c = "_" + token.c + token.uc = "_" + token.uc + end if +end sub + +sub maybe_add_prefix + if noprefix_detected and token.t = TOK_WORD and asc(token.uc) <> asc("_") _andalso is_underscored(token.c) then add_prefix +end sub + +function line_end + select case token.t + case TOK_WORD + line_end = (token.uc = "REM") + case TOK_COLON, TOK_COMMENT, TOK_NEWLINE + line_end = TRUE + end select +end function + +function is_underscored(s$) + dim i + for i = 1 to ubound(prefix_keywords$) + if token.uc = prefix_keywords$(i) then + is_underscored = TRUE + exit function + end if + next i +end function + +sub process_rest_of_line + dim i, base_word$ + do + select case token.t + case TOK_WORD + select case token.uc + case "REM" + tk_state = STATE_COMMENT + case "THEN" + exit sub + case else + if noprefix_detected and left$(token.uc, 3) = "NP_" then + base_word$ = make_base_word$(token.uc) + for i = 1 to ubound(prefix_colors$) + if base_word$ = prefix_colors$(i) then + token.c = mid$(token.c, 4) + token.uc = mid$(token.uc, 4) + exit for + end if + next i + exit select + end if + maybe_add_prefix + end select + case TOK_COLON + exit sub + case TOK_NEWLINE + line_count = line_count + 1 + column_count = 0 + exit sub + case TOK_EOF + put_out + exit sub + case else + end select + next_token + loop +end sub + +sub put_out + put #2, , token.spaces + put #2, , token.c +end sub + +function make_base_word$(s$) + dim i + for i = 1 to len(s$) + select case asc(s$, i) + case asc("A") to asc("Z"), asc("a") to asc("z"), asc("0") to asc("9"), asc("_") + case else + exit for + end select + next i + make_base_word$ = left$(s$, i - 1) +end function + +sub next_token + if token.t > 0 then put_out + next_token_raw + while token.t = TOK_WORD and token.c = "_" + put_out + next_token_raw + if token.t <> TOK_NEWLINE then exit sub + line_count = line_count + 1 + column_count = 0 + put_out + next_token_raw + wend +end sub + +sub next_token_raw + dim c, return_token, token_content$, spaces$, unread + do + c = asc(input_content$, next_chr_idx) + next_chr_idx = next_chr_idx + 1 + column_count = column_count + 1 + select case tk_state + case STATE_BEGIN + select case c + case asc("A") to asc("Z"), asc("a") to asc("z"), asc("_"), asc("0") to asc("9"), _ + asc("&"), asc("."), asc("?") + tk_state = STATE_WORD + case asc("$") + tk_state = STATE_METACMD + case asc(":") + return_token = TOK_COLON + case asc("^"), asc("*"), asc("-"), asc("+"), asc("="), asc("\"), asc("#"), _ + asc(";"), asc("<"), asc(">"), asc("/"), asc("("), asc(")"), asc(",") + return_token = TOK_PUNCTUATION + case ASCII_QUOTE + tk_state = STATE_STRING + case asc("'") + tk_state = STATE_COMMENT + case asc(" "), ASCII_TAB, ASCII_VTAB + spaces$ = spaces$ + chr$(c) + _continue + case ASCII_CR, ASCII_LF, ASCII_EOF + tk_state = STATE_NEWLINE + unread = TRUE + case else + 'Likely non-ascii special character + syntax_warning chr$(c) + tk_state = STATE_WORD + end select + case STATE_METACMD + select case c + case ASCII_CR, ASCII_LF, ASCII_EOF + tk_state = STATE_NEWLINE + return_token = TOK_METACMD + unread = TRUE + end select + case STATE_WORD + select case c + case asc("A") to asc("Z"), asc("a") to asc("z"), asc("_"), asc("0") to asc("9"), _ + asc("`"), asc("~"), asc("!"), asc("#"), asc("$"), asc("%"), asc("&"), asc("."), asc("?") + 'Continue + case else + tk_state = STATE_BEGIN + return_token = TOK_WORD + unread = TRUE + end select + case STATE_COMMENT + select case c + case ASCII_CR, ASCII_LF, ASCII_EOF + tk_state = STATE_NEWLINE + return_token = TOK_COMMENT + unread = TRUE + end select + case STATE_STRING + select case c + case ASCII_QUOTE + tk_state = STATE_BEGIN + return_token = TOK_STRING + case ASCII_CR, ASCII_LF, ASCII_EOF + tk_state = STATE_NEWLINE + return_token = TOK_STRING + unread = TRUE + end select + case STATE_DATA + select case c + case ASCII_CR, ASCII_LF, ASCII_EOF + tk_state = STATE_NEWLINE + return_token = TOK_DATA + unread = TRUE + end select + case STATE_NEWLINE + select case c + case ASCII_LF + tk_state = STATE_BEGIN + return_token = TOK_NEWLINE + case ASCII_CR + tk_state = STATE_NEWLINE_WIN + case ASCII_EOF + return_token = TOK_EOF + unread = TRUE 'Do not insert EOF character + case else + 'Should never happen + syntax_warning chr$(c) + tk_state = STATE_BEGIN + return_token = TOK_NEWLINE + unread = TRUE + end select + case STATE_NEWLINE_WIN + select case c + case ASCII_LF + tk_state = STATE_BEGIN + return_token = TOK_NEWLINE + case else + tk_state = STATE_BEGIN + return_token = TOK_NEWLINE + unread = TRUE + end select + end select + + if unread then + next_chr_idx = next_chr_idx - 1 + unread = FALSE + else + token_content$ = token_content$ + chr$(c) + end if + + if return_token then + token.t = return_token + token.c = token_content$ + token.uc = ucase$(token_content$) + token.spaces = spaces$ + exit function + end if + loop +end function + +sub syntax_warning(unexpected$) + print "WARNING: Line"; line_count; "column"; column_count; + print "State"; tk_state; + print "Unexpected "; unexpected$ +end sub + +'Get the directory component of a path +function dir_name$(path$) + dim s1, s2 + s1 = _instrrev(path$, "/") + s2 = _instrrev(path$, "\") + if s1 > s2 then + dir_name$ = left$(path$, s1 - 1) + elseif s2 > s1 then + dir_name$ = left$(path$, s2 - 1) + else + dir_name$ = "." + end if +end function + +function is_absolute_path(path$) + if instr(_os$, "WIN") then + is_absolute_path = (mid$(path$, 2, 1) = ":" or left$(path$, 1) = "\" or left$(path$, 1) = "/") + else + is_absolute_path = left$(path$, 1) = "/" + end if +end function diff --git a/source/ide/file_converters.bas b/source/ide/file_converters.bas new file mode 100644 index 000000000..5aebcc9a1 --- /dev/null +++ b/source/ide/file_converters.bas @@ -0,0 +1,141 @@ +'Old QuickBasic "quick load" format +FUNCTION BinaryFormatCheck% (pathToCheck$, pathSepToCheck$, fileToCheck$) + + file$ = pathToCheck$ + pathSepToCheck$ + fileToCheck$ + + fh = FREEFILE + OPEN file$ FOR BINARY AS #fh + a$ = SPACE$(LOF(fh)) + GET #fh, 1, a$ + IF INSTR(a$, CHR$(0)) = 0 THEN CLOSE #fh: EXIT FUNCTION 'not a binary file + a$ = "" + GET #fh, 1, Format% + GET #fh, , Version% + CLOSE #fh + + SELECT CASE Format% + CASE 2300 'VBDOS + result = idemessagebox("Invalid format", "VBDOS binary format not supported.", "") + BinaryFormatCheck% = 1 + CASE 764 'QBX 7.1 + result = idemessagebox("Invalid format", "QBX 7.1 binary format not supported.", "") + BinaryFormatCheck% = 1 + CASE 252 'QuickBASIC 4.5 + IF INSTR(_OS$, "WIN") THEN + convertUtility$ = "internal\utilities\QB45BIN.exe" + ELSE + convertUtility$ = "./internal/utilities/QB45BIN" + END IF + IF _FILEEXISTS(convertUtility$) THEN + what$ = ideyesnobox("Binary format", "QuickBASIC 4.5 binary format detected. Convert to plain text?") + IF what$ = "Y" THEN + ConvertIt: + IF FileHasExtension(file$) THEN + FOR i = LEN(file$) TO 1 STEP -1 + IF ASC(file$, i) = 46 THEN + 'keep previous extension + ofile$ = LEFT$(file$, i - 1) + " (converted)" + MID$(file$, i) + EXIT FOR + END IF + NEXT + ELSE + ofile$ = file$ + " (converted).bas" + END IF + + SCREEN , , 3, 0 + dummy = DarkenFGBG(1) + clearStatusWindow 0 + COLOR 15, 1 + _PRINTSTRING (2, idewy - 3), "Converting... " + PCOPY 3, 0 + + convertLine$ = convertUtility$ + " " + QuotedFilename$(file$) + " -o " + QuotedFilename$(ofile$) + SHELL _HIDE convertLine$ + + clearStatusWindow 0 + dummy = DarkenFGBG(0) + PCOPY 3, 0 + + IF _FILEEXISTS(ofile$) = 0 THEN + result = idemessagebox("Binary format", "Conversion failed.", "") + BinaryFormatCheck% = 2 'conversion failed + ELSE + pathToCheck$ = getfilepath$(ofile$) + IF LEN(pathToCheck$) THEN + fileToCheck$ = MID$(ofile$, LEN(pathToCheck$) + 1) + pathToCheck$ = LEFT$(pathToCheck$, LEN(pathToCheck$) - 1) 'remove path separator + ELSE + fileToCheck$ = ofile$ + END IF + END IF + ELSE + BinaryFormatCheck% = 1 + END IF + ELSE + IF _FILEEXISTS("internal/support/converter/QB45BIN.bas") = 0 THEN + result = idemessagebox("Binary format", "Conversion utility not found. Cannot open QuickBASIC 4.5 binary format.", "") + BinaryFormatCheck% = 1 + EXIT FUNCTION + END IF + what$ = ideyesnobox("Binary format", "QuickBASIC 4.5 binary format detected. Convert to plain text?") + IF what$ = "Y" THEN + 'Compile the utility first, then convert the file + IF _DIREXISTS("./internal/utilities") = 0 THEN MKDIR "./internal/utilities" + PCOPY 3, 0 + SCREEN , , 3, 0 + dummy = DarkenFGBG(1) + clearStatusWindow 0 + COLOR 15, 1 + _PRINTSTRING (2, idewy - 3), "Preparing to convert..." + PCOPY 3, 0 + IF INSTR(_OS$, "WIN") THEN + SHELL _HIDE "qb64pe -x internal/support/converter/QB45BIN.bas -o internal/utilities/QB45BIN" + ELSE + SHELL _HIDE "./qb64pe -x ./internal/support/converter/QB45BIN.bas -o ./internal/utilities/QB45BIN" + END IF + IF _FILEEXISTS(convertUtility$) THEN GOTO ConvertIt + clearStatusWindow 0 + dummy = DarkenFGBG(0) + PCOPY 3, 0 + result = idemessagebox("Binary format", "Error launching conversion utility.", "") + END IF + BinaryFormatCheck% = 1 + END IF + END SELECT +END FUNCTION + +FUNCTION OfferNoprefixConversion(file$) + what$ = ideyesnobox("$NOPREFIX", "This program uses the $NOPREFIX directive which is unsupported.\n\nQB64PE can automatically convert this file and any included files to\nremove $NOPREFIX. Backups of all files will be made.\n\nConvert this program?") + IF what$ <> "Y" THEN EXIT FUNCTION + + SCREEN , , 3, 0 + dummy = DarkenFGBG(1) + COLOR 15, 1 + _PRINTSTRING (2, idewy - 3), "Converting... " + PCOPY 3, 0 + + IF INSTR(_OS$, "WIN") THEN + convertUtility$ = "internal\utilities\addprefix.exe" + ELSE + convertUtility$ = "internal/utilities/addprefix" + END IF + IF NOT _FILEEXISTS(convertUtility$) THEN + IF _DIREXISTS("./internal/utilities") = 0 THEN MKDIR "./internal/utilities" + IF INSTR(_OS$, "WIN") THEN + SHELL _HIDE "qb64pe -x internal/support/addprefix/addprefix.bas -o " + convertUtility$ + ELSE + SHELL _HIDE "./qb64pe -x ./internal/support/addprefix/addprefix.bas -o " + convertUtility$ + END IF + END IF + + convertLine$ = convertUtility$ + " " + QuotedFilename$(file$) + IF _SHELLHIDE(convertLine$) = 0 _ANDALSO OpenFile$(file$) <> "C" THEN + OfferNoprefixConversion = -1 + ELSE + clearStatusWindow 0 + dummy = DarkenFGBG(0) + PCOPY 3, 0 + SCREEN , , 3, 0 + result = idemessagebox("$NOPREFIX", "Error running conversion utility.", "") + END IF +END FUNCTION diff --git a/source/ide/ide_global.bas b/source/ide/ide_global.bas index e2f24ce4e..70b0f5c7d 100644 --- a/source/ide/ide_global.bas +++ b/source/ide/ide_global.bas @@ -165,6 +165,7 @@ DIM SHARED idefindonlycomments AS INTEGER, idefindonlystrings AS INTEGER DIM SHARED idefindinvert AS INTEGER DIM SHARED idechangeto AS STRING DIM SHARED idechangemade AS INTEGER +DIM SHARED ideFirstCompileFromDisk AS INTEGER 'Set true when a file is loaded, false once a compilation is done. Supports one-off actions on loaded programs. DIM SHARED ideinsert AS INTEGER DIM SHARED idepathsep AS STRING * 1 DIM SHARED SubFuncLIST(0) AS STRING diff --git a/source/ide/ide_methods.bas b/source/ide/ide_methods.bas index b4429278d..9f6a0d017 100644 --- a/source/ide/ide_methods.bas +++ b/source/ide/ide_methods.bas @@ -1,3 +1,37 @@ +'The function ide() is the sole entry point to the IDE from the compiler. + +'Commands are sent from the compiler to IDE by setting idecommand$ with a command byte + any extra data, +'then calling ide(0). The 0 argument causes it to behave as an implicit array if the IDE is not compiled in. + +'The ide() function returns a status byte. Any additional information is stored in idereturn$. + +'Command/status bytes: +'0 From IDE: No ide present (auto defined array ide() return 0) +'1 To IDE: Open file name (only supported on first call) +' idecommand$ = [1][file name] +'2 From IDE: Begin new compilation +' idereturn$ = [first line of code] +'3 To IDE: Request next line to be compiled. Formatted version of previous line may be available in idecompiledline$. +'4 From IDE: Here is the next line of code as requested +' idereturn$ = [next line of code] +'5 From IDE: No more lines of code exist +'6 To IDE: Compilation has finished and code is OK, return to ready state +'7 To IDE: Rewind position to first line for repass +'8 To IDE: An error has occurred with 'this' message on 'this' line +' idecommand$ = [8][error message][line as LONG] +'9 From IDE: C++ compile (if necessary) and run with 'this' name (compiler<-ide) +' idereturn$ = [name(no path, no .bas)] +'10 To IDE: Like command 3, but return (via status 4) the given line of code instead of the actual next line +' idecommand$ = [10][line of code] +'11 To IDE: ".EXE file created" message +'12 To IDE: The name of the exe I'll create is '...' +' idecommand$ = [12][exe name without .exe] +'13 To IDE: $NOPREFIX was found +'14 From IDE: $NOPREFIX was not removed, please generate a compilation error +'100 To IDE: Simplified version of command 3; next line of code is immediately set in idereturn$. No status byte returned. +'254 To IDE: Compilation has finished, launch debug interface (implies command 6) +'255 To IDE: A qb error happened in the IDE. Command byte actually ignored, this command is detected by ideerror <> 0 + 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' @@ -602,6 +636,7 @@ FUNCTION ide2 (ignore) ideprogname = f$: _TITLE ideprogname + " - " + WindowTitle IdeImportBookmarks idepath$ + idepathsep$ + ideprogname$ AddToHistory "RECENT", idepath$ + idepathsep$ + ideprogname$ + ideFirstCompileFromDisk = -1 END IF 'message 1 END IF 'no restore @@ -713,6 +748,7 @@ FUNCTION ide2 (ignore) IF c$ = CHR$(6) THEN idecompiling = 0 + ideFirstCompileFromDisk = 0 ready = 1 IF ideautorun THEN ideautorun = 0: GOTO idemrunspecial END IF @@ -757,6 +793,7 @@ FUNCTION ide2 (ignore) GOSUB redrawItAll idecompiling = 0 + ideFirstCompileFromDisk = 0 ready = 1 _RESIZE OFF DebugMode @@ -781,6 +818,7 @@ FUNCTION ide2 (ignore) IF c$ = CHR$(11) THEN idecompiling = 0 + ideFirstCompileFromDisk = 0 ready = 1 ideautorun = 0 showexecreated = 1 @@ -792,8 +830,23 @@ FUNCTION ide2 (ignore) sendnextline = 1 END IF + IF c$ = CHR$(13) THEN + IF ideFirstCompileFromDisk _ANDALSO OfferNoprefixConversion(idepath$ + idepathsep$ + ideprogname$) THEN + IF ideerror > 1 THEN GOTO IDEerrorMessage + 'A new compilation will be triggered + ideunsaved = -1: idechangemade = 1: idelayoutallow = 2: ideundobase = 0: QuickNavTotal = 0: ModifyCOMMAND$ = "": idefocusline = 0: startPausedPending = 0 + GOSUB redrawItAll + GOTO ideloop + ELSE + GOSUB redrawItAll + ide2 = 14 + EXIT FUNCTION + END IF + END IF + IF LEFT$(c$, 1) = CHR$(8) THEN idecompiling = 0 + ideFirstCompileFromDisk = 0 failed = 1 ideautorun = 0 END IF @@ -1557,6 +1610,7 @@ FUNCTION ide2 (ignore) EXIT FUNCTION ELSE 'finished compilation + ideFirstCompileFromDisk = 0 ide2 = 5 'end of program reached, what next? 'could return: 'i) 6 code ready for export/run @@ -6392,7 +6446,7 @@ FUNCTION ide2 (ignore) r$ = idefiledialog$("", 1) 'for old dialog file open routine. END IF IF ideerror > 1 THEN PCOPY 3, 0: SCREEN , , 3, 0: GOTO IDEerrorMessage - IF r$ <> "C" THEN ideunsaved = -1: idechangemade = 1: idelayoutallow = 2: ideundobase = 0: QuickNavTotal = 0: ModifyCOMMAND$ = "": idefocusline = 0: startPausedPending = 0 + IF r$ <> "C" THEN ideFirstCompileFromDisk = -1: ideunsaved = -1: idechangemade = 1: idelayoutallow = 2: ideundobase = 0: QuickNavTotal = 0: ModifyCOMMAND$ = "": idefocusline = 0: startPausedPending = 0 PCOPY 3, 0: SCREEN , , 3, 0 GOSUB redrawItAll: GOTO ideloop END IF @@ -20004,111 +20058,6 @@ SUB LoadColorSchemes 'End of color schemes END SUB -FUNCTION BinaryFormatCheck% (pathToCheck$, pathSepToCheck$, fileToCheck$) - - file$ = pathToCheck$ + pathSepToCheck$ + fileToCheck$ - - fh = FREEFILE - OPEN file$ FOR BINARY AS #fh - a$ = SPACE$(LOF(fh)) - GET #fh, 1, a$ - IF INSTR(a$, CHR$(0)) = 0 THEN CLOSE #fh: EXIT FUNCTION 'not a binary file - a$ = "" - GET #fh, 1, Format% - GET #fh, , Version% - CLOSE #fh - - SELECT CASE Format% - CASE 2300 'VBDOS - result = idemessagebox("Invalid format", "VBDOS binary format not supported.", "") - BinaryFormatCheck% = 1 - CASE 764 'QBX 7.1 - result = idemessagebox("Invalid format", "QBX 7.1 binary format not supported.", "") - BinaryFormatCheck% = 1 - CASE 252 'QuickBASIC 4.5 - IF INSTR(_OS$, "WIN") THEN - convertUtility$ = "internal\utilities\QB45BIN.exe" - ELSE - convertUtility$ = "./internal/utilities/QB45BIN" - END IF - IF _FILEEXISTS(convertUtility$) THEN - what$ = ideyesnobox("Binary format", "QuickBASIC 4.5 binary format detected. Convert to plain text?") - IF what$ = "Y" THEN - ConvertIt: - IF FileHasExtension(file$) THEN - FOR i = LEN(file$) TO 1 STEP -1 - IF ASC(file$, i) = 46 THEN - 'keep previous extension - ofile$ = LEFT$(file$, i - 1) + " (converted)" + MID$(file$, i) - EXIT FOR - END IF - NEXT - ELSE - ofile$ = file$ + " (converted).bas" - END IF - - SCREEN , , 3, 0 - dummy = DarkenFGBG(1) - clearStatusWindow 0 - COLOR 15, 1 - _PRINTSTRING (2, idewy - 3), "Converting... " - PCOPY 3, 0 - - convertLine$ = convertUtility$ + " " + QuotedFilename$(file$) + " -o " + QuotedFilename$(ofile$) - SHELL _HIDE convertLine$ - - clearStatusWindow 0 - dummy = DarkenFGBG(0) - PCOPY 3, 0 - - IF _FILEEXISTS(ofile$) = 0 THEN - result = idemessagebox("Binary format", "Conversion failed.", "") - BinaryFormatCheck% = 2 'conversion failed - ELSE - pathToCheck$ = getfilepath$(ofile$) - IF LEN(pathToCheck$) THEN - fileToCheck$ = MID$(ofile$, LEN(pathToCheck$) + 1) - pathToCheck$ = LEFT$(pathToCheck$, LEN(pathToCheck$) - 1) 'remove path separator - ELSE - fileToCheck$ = ofile$ - END IF - END IF - ELSE - BinaryFormatCheck% = 1 - END IF - ELSE - IF _FILEEXISTS("internal/support/converter/QB45BIN.bas") = 0 THEN - result = idemessagebox("Binary format", "Conversion utility not found. Cannot open QuickBASIC 4.5 binary format.", "") - BinaryFormatCheck% = 1 - EXIT FUNCTION - END IF - what$ = ideyesnobox("Binary format", "QuickBASIC 4.5 binary format detected. Convert to plain text?") - IF what$ = "Y" THEN - 'Compile the utility first, then convert the file - IF _DIREXISTS("./internal/utilities") = 0 THEN MKDIR "./internal/utilities" - PCOPY 3, 0 - SCREEN , , 3, 0 - dummy = DarkenFGBG(1) - clearStatusWindow 0 - COLOR 15, 1 - _PRINTSTRING (2, idewy - 3), "Preparing to convert..." - PCOPY 3, 0 - IF INSTR(_OS$, "WIN") THEN - SHELL _HIDE "qb64pe -x internal/support/converter/QB45BIN.bas -o internal/utilities/QB45BIN" - ELSE - SHELL _HIDE "./qb64pe -x ./internal/support/converter/QB45BIN.bas -o ./internal/utilities/QB45BIN" - END IF - IF _FILEEXISTS(convertUtility$) THEN GOTO ConvertIt - clearStatusWindow 0 - dummy = DarkenFGBG(0) - PCOPY 3, 0 - result = idemessagebox("Binary format", "Error launching conversion utility.", "") - END IF - BinaryFormatCheck% = 1 - END IF - END SELECT -END FUNCTION - FUNCTION removesymbol2$ (varname$) i = INSTR(varname$, "~"): IF i THEN GOTO foundsymbol i = INSTR(varname$, "`"): IF i THEN GOTO foundsymbol @@ -20563,16 +20512,16 @@ FUNCTION OpenFile$ (IdeOpenFile AS STRING) 'load routine copied/pasted from the 'recheck to see if file exists with bas extension ideerror = 2 IF _FILEEXISTS(path$ + idepathsep$ + f$) = 0 THEN EXIT FUNCTION + END IF - IdeOpenFile = path$ + idepathsep$ + f$ + IdeOpenFile = path$ + idepathsep$ + f$ - IF BinaryFormatCheck%(path$, idepathsep$, f$) > 0 THEN - IF LEN(IdeOpenFile) THEN - OpenFile$ = "C" - EXIT FUNCTION - ELSE - info = 0: GOTO ideopenloop 'tried to open a zero length file. Retry? - END IF + IF BinaryFormatCheck%(path$, idepathsep$, f$) > 0 THEN + IF LEN(IdeOpenFile) THEN + OpenFile$ = "C" + EXIT FUNCTION + ELSE + info = 0: GOTO ideopenloop 'tried to open a zero length file. Retry? END IF END IF @@ -21249,3 +21198,4 @@ FUNCTION AnsiTextToUtf8Text$ (text$) AnsiTextToUtf8Text$ = utf$ END FUNCTION +'$INCLUDE: 'file_converters.bas' \ No newline at end of file diff --git a/source/qb64pe.bas b/source/qb64pe.bas index 26ea76925..b4e39e3cc 100644 --- a/source/qb64pe.bas +++ b/source/qb64pe.bas @@ -394,50 +394,6 @@ ELSE _ICON END IF -'the function ?=ide(?) should always be passed 0, it returns a message code number, any further information -'is passed back in idereturn - -'message code numbers: -'0 no ide present (auto defined array ide() return 0) - -'1 launch ide & with passed filename (compiler->ide) - -'2 begin new compilation with returned line of code (compiler<-ide) -' [2][line of code] - -'3 request next line (compiler->ide) -' [3] - -'4 next line of code returned (compiler<-ide) -' [4][line of code] - -'5 no more lines of code exist (compiler<-ide) -' [5] - -'6 code is OK/ready (compiler->ide) -' [6] - -'7 repass the code from the beginning (compiler->ide) -' [7] - -'8 an error has occurred with 'this' message on 'this' line(compiler->ide) -' [8][error message][line as LONG] - -'9 C++ compile (if necessary) and run with 'this' name (compiler<-ide) -' [9][name(no path, no .bas)] - -'10 The line requires more time to process -' Pass-back 'line of code' using method [4] when ready -' [10][line of code] - -'11 ".EXE file created" message - -'12 The name of the exe I'll create is '...' (compiler->ide) -' [12][exe name without .exe] - -'255 A qb error happened in the IDE (compiler->ide) -' note: detected by the fact that ideerror was not set to 0 -' [255] '$INCLUDE:'./utilities/hash.bi' TYPE Label_Type @@ -1010,6 +966,11 @@ IF C = 9 THEN 'run GOTO sendcommand END IF +IF C = 14 THEN + a$ = "$NOPREFIX is a deprecated feature, QB64(PE) specific keywords MUST have the underscore" + GOTO errmes +END IF + PRINT "Invalid IDE message": END ideerror: @@ -1644,8 +1605,14 @@ DO END IF IF temp$ = "$NOPREFIX" THEN - a$ = "$NOPREFIX is a deprecated feature, QB64(PE) specific keywords MUST have the underscore" - GOTO errmes + IF idemode THEN + 'Offer to convert the file + sendc$ = CHR$(13) + GOTO sendcommand + ELSE + a$ = "$NOPREFIX is a deprecated feature, QB64(PE) specific keywords MUST have the underscore. To convert this program, open it in the IDE." + GOTO errmes + END IF END IF IF LEFT$(temp$, 7) = "$ERROR " THEN diff --git a/tests/add_prefix_test.sh b/tests/add_prefix_test.sh new file mode 100644 index 000000000..a70e48680 --- /dev/null +++ b/tests/add_prefix_test.sh @@ -0,0 +1,52 @@ +#!/bin/bash + +PREFIX="Addprefix" +RESULTS_DIR="./tests/results/$PREFIX" +mkdir -p "$RESULTS_DIR" +QB64="$1" +OS=$CI_OS + +show_failure() +{ + cat "$RESULTS_DIR/addprefix-$1_result.txt" +} + +show_incorrect_result() +{ + diff -u <(echo -n "$1") <(echo -n "$2") +} + + +EXE="$RESULTS_DIR/addprefix" +if [[ "$OS" == "win" ]]; then + EXE="$EXE.exe" +fi + +# First attempt to compile converter +rm -fr internal/temp/* +rm -f "$EXE*" +compileResultOutput="$RESULTS_DIR/addprefix-compile_result.txt" +"$QB64" -x internal/support/addprefix/addprefix.bas -o "${EXE}" 1>"$compileResultOutput" +ERR=$? +cp_if_exists ./internal/temp/compilelog.txt "$RESULTS_DIR/addprefix-compilelog.txt" +(exit $ERR) +assert_success_named "Compile" "Compilation Error:" show_failure "compile" + +test -f "$EXE" +assert_success_named "exe exists" "addprefix-output executable does not exist!" show_failure "compile" + +# Copy test case into place so converted result ends up in the results directory +cp tests/converter_tests/addprefix.bas "$RESULTS_DIR/addprefix.bas" + +# Do conversion +conversionResultOutput="$RESULTS_DIR/addprefix-convert_result.txt" +"$EXE" "$RESULTS_DIR/addprefix.bas" 1> "$conversionResultOutput" +ERR=$? +(exit $ERR) +assert_success_named "Convert" "Conversion Error:" show_failure "convert" + +# Confirm result is as expected +expectedResult="$(cat "tests/converter_tests/addprefix.output")" +actualResult="$(cat "$RESULTS_DIR/addprefix.bas")" +[[ "$expectedResult" == "$actualResult" ]] +assert_success_named "result" "Result is wrong:" show_incorrect_result "$expectedResult" "$actualResult" diff --git a/tests/converter_tests/addprefix.bas b/tests/converter_tests/addprefix.bas new file mode 100644 index 000000000..384374f7c --- /dev/null +++ b/tests/converter_tests/addprefix.bas @@ -0,0 +1,99 @@ +option explicit +$noprefix +option explicitarray +dim explicitarray +explicitarray = 8 +declare function f(a as unsigned integer, fullscreen, newimage) +type t + fullscreen as unsigned long + a as integer64 + instr as unsigned byte +end type +dim q as t +print q.fullscreen +declare library + function f + function b() + function c(byval rgba as unsigned long) + function d%&(rgba as unsigned long, byval fullscreen&) +end declare +dim x, y, s$, clip, a(2), smoothshrunk, ontop, bin(4) +screen newimage(640, 480, 32) +put 1, , x +put step(x, (y + 1)), clip +put step(x, (y + 1)), a(2) +put step(x, (y + 1)), a(2),clip 'this is a comment +put step(x, (y + 1)), a(2), clip and, 3 +put step(x, _ + (y + 1)), _ + _ + a(2), clip and, 3 +clip = 2 +screenmove +screenmove 1, 4 : screenmove middle +fullscreen +fullscreen stretch +fullscreen off, smooth +fullscreen , smooth +allowfullscreen +allowfullscreen squarepixels +_allowfullscreen all, all +allowfullscreen , off +print smooth +resize +resize on +_resize , stretch +resize off, smooth +x = resize +glrender behind + +print ontop +displayorder +displayorder software rem do displayorder stuff +displayorder software ,_ + hardware,glrender +if x then displayorder hardware1 +while 0 +exit while +wend +print exit +print _exit +fps auto +fps 30 +clearcolor +clearcolor none, 2 +clearcolor , 1 +maptriangle anticlockwise seamless (1, 1)-(2, 2)-(3, 3), 4 to (1, 1, 1)-(2, 2, 2)-(3, 3, 3), 1 + (height * 2) / 3, smoothstretched +maptriangle clockwise (1, 1)-(2, width)-(3, 3) to (1, 1)-(2, 2)-(3, 3), , smoothshrunk +maptriangle (1, 1)-(2, 2)-(3, 3) to (1, 1)-(2, width)-(3, 3) +print smoothshrunk +depthbuffer lock +depthbuffer clear, 3 +clear x +width 40 +print width(x) +shell +shell "asdf" +shell dontwait +shell hide +shell dontwait "foo" +shell hide "bar" +shell dontwait hide "foo" +shell hide dontwait "bar" +capslock toggle +scrolllock toggle +numlock toggle +consolecursor +consolecursor show +consolecursor hide +consolecursor , 2 +x = bin(3) +s$ = bin$(3) +$color:32 +dim np_blink~&& +print red(100) +print np_red +print np_blue% +print NP_GREEN& +print Np_Blink~&& +data 1, hello, putimage, 3 diff --git a/tests/converter_tests/addprefix.output b/tests/converter_tests/addprefix.output new file mode 100644 index 000000000..3dd0ec288 --- /dev/null +++ b/tests/converter_tests/addprefix.output @@ -0,0 +1,99 @@ +option _explicit +'$noprefix removed here +option _explicitarray +dim explicitarray +explicitarray = 8 +declare function f(a as unsigned integer, fullscreen, newimage) +type t + fullscreen as _unsigned long + a as _integer64 + instr as _unsigned _byte +end type +dim q as t +print q.fullscreen +declare library + function f + function b() + function c(byval rgba as _unsigned long) + function d%&(rgba as _unsigned long, byval fullscreen&) +end declare +dim x, y, s$, clip, a(2), smoothshrunk, ontop, bin(4) +screen _newimage(640, 480, 32) +put 1, , x +put step(x, (y + 1)), clip +put step(x, (y + 1)), a(2) +put step(x, (y + 1)), a(2),_clip 'this is a comment +put step(x, (y + 1)), a(2), _clip and, 3 +put step(x, _ + (y + 1)), _ + _ + a(2), _clip and, 3 +clip = 2 +_screenmove +_screenmove 1, 4 : _screenmove _middle +_fullscreen +_fullscreen _stretch +_fullscreen _off, _smooth +_fullscreen , _smooth +_allowfullscreen +_allowfullscreen _squarepixels +_allowfullscreen _all, _all +_allowfullscreen , _off +print _smooth +_resize +_resize on +_resize , _stretch +_resize off, _smooth +x = _resize +_glrender _behind + +print ontop +_displayorder +_displayorder _software rem do displayorder stuff +_displayorder _software ,_ + _hardware,_glrender +if x then _displayorder _hardware1 +while 0 +exit while +wend +print _exit +print _exit +_fps _auto +_fps 30 +_clearcolor +_clearcolor _none, 2 +_clearcolor , 1 +_maptriangle _anticlockwise _seamless (1, 1)-(2, 2)-(3, 3), 4 to (1, 1, 1)-(2, 2, 2)-(3, 3, 3), 1 + (_height * 2) / 3, _smoothstretched +_maptriangle _clockwise (1, 1)-(2, _width)-(3, 3) to (1, 1)-(2, 2)-(3, 3), , _smoothshrunk +_maptriangle (1, 1)-(2, 2)-(3, 3) to (1, 1)-(2, _width)-(3, 3) +print smoothshrunk +_depthbuffer lock +_depthbuffer _clear, 3 +clear x +width 40 +print _width(x) +shell +shell "asdf" +shell _dontwait +shell _hide +shell _dontwait "foo" +shell _hide "bar" +shell _dontwait _hide "foo" +shell _hide _dontwait "bar" +_capslock _toggle +_scrolllock _toggle +_numlock _toggle +_consolecursor +_consolecursor _show +_consolecursor _hide +_consolecursor , 2 +x = bin(3) +s$ = _bin$(3) +$color:32 +dim np_blink~&& +print _red(100) +print red +print blue% +print GREEN& +print Np_Blink~&& +data 1, hello, putimage, 3 diff --git a/tests/run_tests.sh b/tests/run_tests.sh index 22fb90ea7..116867ea2 100755 --- a/tests/run_tests.sh +++ b/tests/run_tests.sh @@ -5,5 +5,6 @@ result=0 ./tests/assert.sh ./tests/compile_tests.sh ./qb64pe || result=1 ./tests/assert.sh ./tests/qbasic_tests.sh ./qb64pe || result=1 ./tests/assert.sh ./tests/format_tests.sh ./qb64pe || result=1 +./tests/assert.sh ./tests/add_prefix_test.sh ./qb64pe || result=1 exit $result