Older Version
Newer Version
harmonv
Mar 1, 2008
- "McCub -- Sharefest 2008 entry"
[[code format="vb.net"]] ' McCub -- A Just BASIC / Liberty BASIC Case Conversion utility ' It allows you to -- ' change the case of Reserved words, such as FOR, IF, SCAN ' change case of Functions, such as CHR$(, DATE$(, EOF(, SIN( ' case conversion for text inside strings. On Error Goto [ErrorTrapper] ' Just BASIC's RESERVED WORDS list Data AND, APPEND, AS, BEEP, BMPBUTTON, _ BMPSAVE, BOOLEAN, BUTTON, BYREF, CALL, _ CASE, CHECKBOX, CLOSE, CLS, COMBOBOX, _ CONFIRM, DATA, DIALOG, DIM, DO, _ DUMP, ELSE, END, ERROR, EXIT, _ FIELD, FILEDIALOG, FILES, FOR, FUNCTION, _ GET, GLOBAL, GOSUB, GOTO, GRAPHICBOX, _ GRAPHICS, GROUPBOX, IF, INPUT, KILL, _ LET, LINE, LISTBOX, LOADBMP, LONG, _ LOOP, LPRINT, MAINWIN, MAPHANDLE, MENU, _ NAME, NEXT, NOMAINWIN, NONE, NOTICE, _ ON, ONCOMERROR, OR, OPEN, OUTPUT, _ PLAYMIDI, PLAYWAVE, PRINT, PROMPT, PUT, _ RADIOBUTTON, RANDOM, RANDOMIZE, READ, READJOYSTICK, _ REDIM, "REM", RESTORE, RETURN, RUN, _ SCAN, SELECT, STATICTEXT, STOP, STOPMIDI ,_ SUB, TEXT, TEXTBOX, TEXTEDITOR, THEN, _ TIMER, UNLOADBMP, UNTIL, WAIT, WINDOW, _ WEND, WHILE, WORD, XOR ' Missing Just BASIC RESERVED WORDS: Data BINARY, BYVAL, CALLFN, COLORDIALOG, LOCATE, _ MOD, PRINTERDIALOG, SEEK, STEP, TO ' Liberty BASIC-only RESERVED WORDS Data CALLBACK, CALLDLL, CURSOR, DLL, DOUBLE, _ DWORD, FONTDIALOG, GETTRIM, MAPHANDLE, OUT, _ PASSWORD, POPUPMENU, PTR, RESUME, SHORT, _ SORT, STRUCT, STYLEBITS, TITLEBAR, TRACE, _ ULONG, USHORT, VOID ' End of Data marker Data "ZZZ" ' Just BASIC FUNCTIONS: ' Note that the opening parenthesis is part of the function name: Data "ABS(", "ACS(", "ASC(", "ASN(", "ATN(", _ "CHR$(", "COS(", "DATE$(", "EOF(", "EXP(", _ "INPUT$(", "INSTR(", "INT(", "LEFT$(", "LEN(", _ "LOF(", "LOG(", "LOWER$(", "MIDIPOS(", "MID$(", _ "MKDIR(", "NOT(", "RIGHT$(", "RMDIR(", "RND(", _ "SIN(", "SPACE$(", "SQR(", "STR$(", "TAB(", _ "TAN(", "TIME$(", "TRIM$(", "TXCOUNT(", "UPPER$(", _ "USING(", "VAL(", "WORD$(" ' Missing FUNCTIONS: Data "LOC(" ' Liberty BASIC-only FUNCTIONS Data "DECHEX$(", "EVAL(", "EVAL$(", "HBMP(", "HEXDEC(", "HWND(", _ "INP(", "INPUTTO$(", "MAX(", "MIN(", "WINSTRING(" ' End of Data marker Data "ZZZ" Global basfileOpen, mainOpen Dim allwords$(10), option(10) ' Read keywords$ Gosub [LoadWords] nkeywords = n Print "Keywords read = "; n allwords$(1) = keys$ ' Read functions$ Gosub [LoadWords] nfunctions = n Print "Functions read = "; n allwords$(2) = keys$ opt1str$ = "No change,First letter,lowercase,UPPERCASE" opt2str$ = "No change,First letter,lowercase,UPPERCASE" opt3str$ = "No change,First letter,lowercase,UPPERCASE" For a = 1 To 4 opt1ray$(a) = Word$(opt1str$,a,",") opt2ray$(a) = Word$(opt2str$,a,",") opt3ray$(a) = Word$(opt3str$,a,",") Next WindowWidth = 365 WindowHeight = 390 Statictext #main.st1, "Path: None Selected", 10, 20, 300, 25 Statictext #main.st2, "File: None Selected", 10, 50, 300, 25 Statictext #main.st3, "How would you like your BASIC text?", 50, 90, 300, 25 Statictext #main.opt1, "Keywords: ", 20, 130, 80, 25 Statictext #main.opt2, "Functions:", 20, 160, 80, 25 Statictext #main.opt3, "Quoted text:", 20, 250,120, 25 Combobox #main.keywords, opt1ray$(), setopt1, 140,130,170,25 Combobox #main.functions, opt2ray$(), setopt2, 140,160,170,25 Combobox #main.strings, opt3ray$(), setopt3, 140,250,170,25 Button #main.getfile, " Choose File ", ChooseFile, UL, 20, 300 Button #main.go, " GO ", McCubit, UL, 260, 300 Open "McCub: A Code Case Utility" For Window As #main #main "trapclose [mainquit]" mainOpen = 1 #main "font Arial 12" #main.st1 "!font Arial_Narrow 12" #main.st2 "!font Arial_Narrow 12" #main.keywords "selectindex 1" #main.functions "selectindex 1" #main.strings "selectindex 1" #main.getfile "!setfocus" Wait [mainquit] If basfileOpen=1 Then Close #basfile If mainOpen=1 Then Close #main End ' ----- End of Main Program ----- ' Gosub to read DATA statements into string [LoadWords] lastone$ = "ZZZ" n = 0 : Read k$ : keys$ = " " While k$<>lastone$ n = n + 1 keys$ = keys$ + k$ + " " Read k$ Wend Return Sub setopt1 handle$ #main.keywords, "selectionindex? x" option(1) = x End Sub Sub setopt2 handle$ #main.functions, "selectionindex? x" option(2) = x End Sub Sub setopt3 handle$ #main.strings, "selectionindex? x" option(3) = x End Sub ' Choose File sub Sub ChooseFile handle$ Filedialog "Open BASIC source code", "*.bas;*.BAS", myfile$ If myfile$<>"" Then allwords$(0) = myfile$ ' store in global array x = Len(myfile$) ' separate path and filename While x>0 And Mid$(myfile$,x,1)<>"\" x = x - 1 Wend mypath$ = Mid$(myfile$, 1, x) myfile$ = Mid$(myfile$, x+1, 256) #main.st1 "Path: "+mypath$ #main.st2 "File: "+myfile$ Print "BAS file chosen: "; mypath$, myfile$ End If End Sub ' ChooseFile ' Open & read source file. Apply user's selections to text. ' Print to mainwin (or .new file) Sub McCubit handle$ quote$ = Chr$(34) Print "Keywords option = "; opt1ray$(option(1)) Print "Functions option = "; opt2ray$(option(2)) Print "Quoted text option= "; opt3ray$(option(3)) stopper$ = " ,:;()=<>+-*/"+Chr$(34)+Chr$(39)+Chr$(13)+Chr$(10) If allwords$(0)<>"" Then Open allwords$(0) For Input As #basfile Print allwords$(0); " opened." Print "======================================================================" While Eof(#basfile)=0 Line Input #basfile, code$ While Right$(code$,1)=" " ' remove trailing whitespace code$ = Left$(code$,Len(code$)-1) Wend codePos = 0 ' print code$ newCode$ = "" While codePos<Len(code$) wrd$ = GetNextWord$(code$, codePos, stopper$) If Instr(allwords$(1), Upper$(" "+wrd$+" "), 1)>0 Then Select Case option(1) 'if so convert it to users' choice Case 2 : wrd$ = Capitalize$(wrd$) ' First letter cap Case 3 : wrd$ = Lower$(wrd$) ' lowercase Case 4 : wrd$ = Upper$(wrd$) ' UPPERCASE End Select End If If Instr(allwords$(2), Upper$(" "+wrd$+"( "), 1)>0 Then Select Case option(2) 'if so convert it to users' choice Case 2 : wrd$ = Capitalize$(wrd$) ' First letter cap Case 3 : wrd$ = Lower$(wrd$) ' lowercase Case 4 : wrd$ = Upper$(wrd$) ' UPPERCASE End Select End If If Right$(wrd$,1)=quote$ Then Select Case option(3) 'if so convert it to users' choice Case 2 : wrd$ = Capitalize$(wrd$) ' First letter cap Case 3 : wrd$ = Lower$(wrd$) ' lowercase Case 4 : wrd$ = Upper$(wrd$) ' UPPERCASE End Select End If ' print wrd$ newCode$ = newCode$ + wrd$ + Mid$(code$, codePos, 1) Wend Print newCode$ ' print #fout, newCode$ Wend Close #basfile ' close #fout End If End Sub ' McCubit ' code$ = line of source code to be examined. ' cpos = current position in code$ ' stopper$ = characters marking end of word Function GetNextWord$(code$, Byref cpos, stopper$) ' if at start of comment ('), then skip to end of line If Mid$(code$,cpos,1)=Chr$(39) Then stopper$ = "" ' if at start of quote ("), then only stopper is closing " If Mid$(code$,cpos,1)=Chr$(34) Then stopper$ = Chr$(34) oldpos = cpos+1 npos = Len(code$) ' temporary setting of next stopper For a = 1 To Len(stopper$) s$ = Mid$(stopper$,a,1) p = Instr(code$, s$, oldpos) If p>0 And p<npos Then npos = p Next a ' print "next stopper = "; npos If npos=Len(code$) Then npos = npos+1 Else If s$=Chr$(34) Then npos = npos+1 End If cpos = npos GetNextWord$ = Mid$(code$, oldpos, npos-oldpos) End Function ' GetNextWord$ Function Capitalize$(w$) c1$ = Upper$(Left$(w$,1)) c2$ = Lower$(Mid$(w$,2,Len(w$))) Capitalize$ = c1$ + c2$ End Function Function FileExists(path$,file$) Dim info$(10,10) Files path$,file$, info$() FileExists = Val(info$(0, 0)) ' non zero is true End Function [ErrorTrapper] Print "Err = "; Err Print "Err$ = "; Err$ Wait [[code]]