Older Version
Newer Version
terciops
Jul 10, 2011
' xref.bas - a cross reference utility for Liberty Basic and similar ' Author: Ken B Smith - Wattle Downs, Auckland Jun 2011 ' ' ' This program is free software: you can redistribute it and/or modify ' it under the terms of the GNU General Public License as published by ' the Free Software Foundation, either version 3 of the License, or ' (at your option) any later version. ' ' This program is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY; without even the implied warranty of ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' You should have received a copy of the GNU General Public License ' along with this program. If not, see <http://www.gnu.org/licenses/>. ' Date: 26/13/11 ' 27/6/11 Based on IQPDF text conversion module ' 28/6/11 Removed snag with showing words in quotes in readascii ' 28/6/11 Tidied up the aligment on listing ' 04/7/11 Added Functions to show as 'F' and Function defined variables as 'f' - for Will ! global maxinput ' Number of files accepted on filelist maxinput = 40 dim filedata$(maxinput,2) ' (x,0) - filename ! (x,1) - size ! (x,2) = date dim info$(40,40) dim BASname$(maxinput) ' These are decode variables ' dim results(2,maxinput) ' hold the top 20 results from upto 20 file dim wordarray$(5000,2) ' the structure will be strange : 0 = word : 1 = line/line/line/line/line - line numbers as 5 byte dec : 2 is variable type G etc ' linenumber + 11111 + (len(word) * 11) - ready for main program directly. dim stats(10) ' stats(0) = total line count / stats(1) = totalwords / stats(2) = total word count / stats(3) = Highest line count on a word ' 6 bytes hex = totalwords / 4 bytes hex largest word count / 4 bytes hex highest line count on a word global wordfound ' flag 0 = false global wordcount ' word count on a line global maxwordcount ' words in a document global totalwords, maxperline global maxperline global targetword$ ' word to be inserted global targetline ' line number to go in the string if not already there global fileIs$ ' What file are we working on ? global Stimerval ' Start timer global Etimerval ' End timer global BASTxt$, BASIdx$, BASFile$, BAScount global filesize global filedate$ global t$ global LBkey$ ' all the Liberty reserved words and variables global legalchr$ ' string holding chr$ allowed global wordplace global longestword global metatagword global metaid$ ' meta word ID global funcdefline ' holder for line number where a function defined global Qlisting ' True or False for listing on top of Xref global Qnumbers ' do you want line numbers with that ? LBkey$ = " abs acs append as asc and asn atn backgroundcolor$ beep binary bmpbutton bmpsave boolean button call " LBkey$ = LBkey$ + " callback calldll case checkbox chr$ close cls colordialog combobox comboboxcolor$ commandline$ " LBkey$ = LBkey$ + " confirm cos cursor data date$ dechex$ defaultdir$ dialog dialog_fs dialog_modal dialog_nf dialog_nf_modal " LBkey$ = LBkey$ + " dialog_nf_fs dim displayheight displaywidth dll do drives$ dword dump else end eof err error err$ eval " LBkey$ = LBkey$ + " eval$ exit exp field filedialog files fontdialog end for foregroundcolor$ function get gettrim global " LBkey$ = LBkey$ + " gosub goto graphics graphics_fs graphics_fs_nsb graphics_nsb graphics_nf_nsb graphicbox groupbox hbmp " LBkey$ = LBkey$ + " hexdec hwnd if inkey$ inp input input$ inputto$ instr int joy1x joy1y joy1z joy1button1 joy1button2 joy2x " LBkey$ = LBkey$ + " joy2y joy2z joy2button1 joy2button2 kill left$ len let line listbox listboxcolor$ loadbmp locate loc " LBkey$ = LBkey$ + " lof log long loop lower$ lprint lr maphandle max menu midipos mid$ min mkdir mod name next nomainwin " LBkey$ = LBkey$ + " notice on open or out output platform$ playmidi playwave popupmenu print printerdialog printerfont$ prompt " LBkey$ = LBkey$ + " ptr put radiobutton randomize read readjoystick redim rem restore resume return right$ rmdir rnd run " LBkey$ = LBkey$ + " scan seek select short sin sort space$ spreadsheet sqr statictext step str$ stopmidi struct stylebits sub " LBkey$ = LBkey$ + " tab tan text textbox textboxcolor$ texteditor texteditorcolor$ text_fs text_nsb text_nsb_ins then time$ " LBkey$ = LBkey$ + " timer titlebar to trace trim$ txcount ul ulong unloadbmp until upper$ upperleftx upperlefty ur ushort using " LBkey$ = LBkey$ + " val version$ void wait wend while window windowheight windowwidth window_nf winstring word word$ " legalchr$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890_'[].$#" + chr$(34) [setup.main.Window] '-----Begin code for #main nomainwin WindowWidth = 740 WindowHeight = 150 UpperLeftX=int((DisplayWidth-WindowWidth)/2) UpperLeftY=int((DisplayHeight-WindowHeight)/2) '-----Begin GUI objects code call removespaces call findfiles ' find all BASs in the directory TextboxColor$ = "white" textbox #main.fileisbox, 325, 15, 380, 25 textbox #main.dotbox, 20, 60, 275, 25 textbox #main.timebox, 325, 60, 380, 25 radiobutton #main.NoListing, "No Listing?", [NoListSet], [NoListReset], 325, 37, 100, 25 radiobutton #main.Listing, "Listing?", [ListSet], [ListReset], 460, 37, 60, 25 radiobutton #main.Numbers, "With Line Numbers?", [LNSet], [LNReset], 580, 37, 150, 25 combobox #main.filebox, BASname$(), [selectfile], 20, 12, 275, 250 '-----End GUI objects code open "XRef2 - Liberty BASIC Cross-Index Creation Tool - V2.1 [c] Ken B Smith - June 2011" for window as #main print #main, "font ms_sans_serif 10" print #main, "trapclose [quit.main]" #main.Numbers,"hide" #main.NoListing, "set" [main.inputLoop] 'wait here for input event wait [NoListSet] #main.Numbers,"hide" Qlisting = 0 Qnumbers = 0 wait [NoListReset] wait [ListSet] #main.Numbers,"show" Qlisting = 1 Qnumbers = 0 wait [ListReset] wait [LNSet] Qnumbers = 1 wait [LNReset] wait [selectfile] 'Perform action for the combobox named 'filebox' print #main.filebox, "contents? fileIs$" print #main.filebox, "selectionindex? fileselect" if fileIs$ = "All Files" then call allfiles else BASFile$ = fileIs$ ' filesize = val(info$(fileselect,1)) ' filedate$ = info$(fileselect,2) call start end if close #main end [quit.main] 'End the program close #main end '---------------------------allfiles-------- sub allfiles ' do all files in list in one go for xx = 1 to BAScount ' This is the total filecount of "BAS" files BASFile$ = BASname$(xx) filesize = val(info$(xx,1)) filedate$ = info$(xx,2) call start call pause 1000 next xx end sub ' --------------------------- start ----------------- sub start redim wordarray$(5000,2) ' Flush the word buffer redim stats(10) longestword = 0 BASTxt$ = left$(BASFile$,instr(BASFile$,".")) + "bas" BASIdx$ = left$(BASFile$,instr(BASFile$,".")) + "idx" Stimerval = time$("ms") print #main.fileisbox, "Working on - " + BASFile$ Etimerval = time$("ms") filetime = (Etimerval - Stimerval) / 1000 call readascii ' read the txt file to make the idx Etimerval = time$("ms") filetime = (Etimerval - Stimerval) / 1000 call writeidx print #main.timebox, BASFile$ + " took " + str$(filetime) + " secs or " + str$(int(stats(1)/filetime)) + " lines/sec" call pause 2000 end sub ' ----------------------- writeidx -------------- sub writeidx open BASIdx$ for output as #dbf ' add the originating filename and todays date / time print #dbf,BASFile$; " X-REF created "; date$(); " "; time$() print #dbf, "" ' now the word list and line data longestword = longestword + 2 ' establish minimum spacing for x = 1 to stats(1) if wordarray$(x,2) <> "" then wordarray$(x,0) = "[" + wordarray$(x,2) + "] " + wordarray$(x,0) else wordarray$(x,0) = " " + wordarray$(x,0) end if if wordarray$(x,2) = "D" or wordarray$(x,2) = "F" then wordarray$(x,0) = wordarray$(x,0) + "()" end if print #dbf, wordarray$(x,0);space$(longestword - len(wordarray$(x,0)));wordarray$(x,1) next x print #dbf, "" print #dbf, " -------------------------------- " print #dbf, "" ' Now list out the program for those without line numbers if Qlisting = 0 goto [endlist] targetline = 0 open BASTxt$ for input as #df ' this is the target ascii file while eof(#df) = 0 line input #df, a$ ' take the whole line and find out what it is targetline = targetline + 1 if Qnumbers = 1 then print #dbf, str$(targetline);space$(5 - len(str$(targetline)));" "; end if print #dbf,a$ wend print #dbf, "" print #dbf, " -------------------------------- " print #dbf, "" close #df [endlist] close #dbf end sub ' -------------------------- readascii ------------------- sub readascii totalwords = 0 maxwordcount = 0 maxperline = 0 targetline = 0 funcdefline = 0 open BASTxt$ for input as #df ' this is the target ascii file while eof(#df) = 0 line input #df, a$ ' take the whole line and find out what it is targetline = targetline + 1 ' print #main.dotbox, "Working on line - ";str$(targetline); print #main.dotbox,"Working on line - ";using("#####",targetline) wordcount = 1 metatagword = 0 metaid$ = "" funcdefline = 0 a$ = trim$(a$) ' get the spaces out rotateflag = 1 ' used to kill quoted text if len(a$) < 2 goto [nextline] ' nothing there ' Now a special case. I have a label in a handler ie #main.gr, "When mouseMove [pixelFollow]" ' I need to subvert the rotateflag and allow the quotes and all within to be allowed if instr(left$(a$,1),"#") > 0 then rotateflag = 2 ' quotes cancelled for this line ' First remove all the punctuation in a line. This is easier than splitting targetword$ for y = 1 to len(a$) length = len(a$) z$ = mid$(a$,y,1) ' I need to dump everything between quotes. rotateflag shows beginning and end of quotes as -1 and + 1 respectively if asc(z$) = 34 then a$ = ADDSPACE$(a$,y) rotateflag = rotateflag * -1 ' show quote flag active goto [nextchr] end if if rotateflag = -1 then ' quote flag is active ? a$ = ADDSPACE$(a$,y) goto [nextchr] end if if z$ = "'" then a$ = left$(a$,y-1) exit for ' lose the rest of the line end if if instr(legalchr$,z$) = 0 then ' this is not a legal character so ... if y = 1 then ' on the start of a line add a space instead a$ = " " + mid$(a$,2) goto [nextchr] end if if y = length then ' at the end of a line add a space a$ = left$(a$,length - 1) + " " goto [nextchr] end if a$ = ADDSPACE$(a$,y) ' add a space everwhere else end if [nextchr] next y ' Now we can process a line that only contains words, numbers and keywords targetword$ = "dummy" ' give targetword$ a value while targetword$ <> "" targetword$ = word$(a$,wordcount) targetword$ = trim$(targetword$) t$ = " " + lower$(targetword$) + " " ' set up a temp string in lowercase to look for keywords ' the space either side ensures we don't pick up bits of words if instr(LBkey$,t$) > 0 then ' this is a keyword t$ = trim$(t$) funcdefline = targetline ' keyword ID on this line if t$ = "global" then metatagword = wordcount + 1 ' the next word to be actioned metaid$ = "G" ' metaid$ = G is a global end if if t$ = "dim" then metatagword = wordcount + 1 metaid$ = "D" end if if t$ = "sub" then metatagword = wordcount + 1 metaid$ = "S" end if if t$ = "function" then metatagword = wordcount + 1 metaid$ = "F" end if goto [nextword] ' this was a keyword - ignore it end if if len(targetword$) = 0 goto [nextword] ' somehow the word was zero length - so ignore that too. ' we have a valid word - file it call findword [nextword] wordcount = wordcount + 1 wend [nextline] wend close #df end sub ' -------------------------- find word ------------------------ ' Find a targetword$ in array wordarray$(x,y) where 0 = word / 1 = lines and make a place for it at wordpos if not there sub findword wordfound = 0 wordplace = 0 oldpointer = 0 cpointer = stats(1) / 2 ' stats(1) is the total word count to date cstep = stats(1) / 4 ' half way and increment n/4 while cstep > 0.25 oldpointer = int(cpointer) if targetword$ = wordarray$(oldpointer,0) then exit while ' A hit if targetword$ > wordarray$(oldpointer,0) then cpointer = cpointer + cstep else cpointer = cpointer - cstep end if cstep = cstep / 2 wend wordplace = oldpointer ' hold that number for a moment if targetword$ = wordarray$(oldpointer,0) then ' We have a hit at oldpointer wordfound = oldpointer ' hold where we found it goto [makeword] else if targetword$ = wordarray$(oldpointer + 1,0) then ' it could be one below wordfound = oldpointer + 1 goto [makeword] end if end if ' If we get here then the word wasn't found in the existing list stats(1) = stats(1) + 1 ' stats(1) is total words wordfound = stats(1) ' that is where we are wordarray$(wordfound,0) = targetword$ hexline$ = str$(targetline) hexline$ = space$(5 - len(hexline$)) + hexline$ ' pad to 5 chrs wordarray$(wordfound,1) = hexline$ maxwordcount = maxwordcount + 1 if len(targetword$) > longestword then longestword = len(targetword$) ' print formatting goto [alldone] [makeword] ' now add the line number if not already added for this line hexline$ = str$(targetline) hexline$ = space$(5 - len(hexline$)) + hexline$ ' pad to 5 chrs if instr(wordarray$(wordfound,1),hexline$) = 0 then ' not there ? wordarray$(wordfound,1) = wordarray$(wordfound,1) + hexline$ ' add the hex end if [alldone] ' now pick up the status of the metaid$ in wordarray$(wordfound,2) ' if the word is on the same line as the definition itself then something must be done if funcdefline = targetline and metaid$ <> "" then ' we are on a keyword line if metatagword = wordcount then ' this is the word directly after a keyword = name wordarray$(wordfound,2) = metaid$ ' give this the capital value if allocated else if metaid$ = "G" then wordarray$(wordfound,2) = metaid$ ' special case else wordarray$(wordfound,2) = lower$(metaid$) ' otherwise the lowercase end if end if end if if wordfound = stats(1) then call sortme ' new entry - sort it end sub ' -------------------- Home Brew sort to get around problems in ordering with LB sort cmd --------- 'sort wordarray$(),wordplace,stats(1),0 is what we are replacing ' very nasty - but will do for now sub sortme [startsort] sorted = 1 for sx = stats(1) to 2 step -1 if wordarray$(sx,0) < wordarray$(sx - 1,0) then ' and wordarray$(sx - 1,0) <> "" then ' swap elements 0 & 1 & 2 temp0$ = wordarray$(sx - 1,0) temp1$ = wordarray$(sx - 1,1) temp2$ = wordarray$(sx - 1,2) wordarray$(sx - 1,0) = wordarray$(sx,0) wordarray$(sx - 1,1) = wordarray$(sx,1) wordarray$(sx - 1,2) = wordarray$(sx,2) wordarray$(sx,0) = temp0$ wordarray$(sx,1) = temp1$ wordarray$(sx,2) = temp2$ sorted = 0 else sorted = 1 exit for end if next sx if sorted = 0 goto [startsort] end sub ' ------------------------ findfiles --------------------- sub findfiles files DefaultDir$, "*.BAS",info$() BAScount = val(info$(0,0)) for x = 0 to BAScount for y = 0 to 2 filedata$(x,y) = info$(x,y) next y BASname$(x) = info$(x,0) next x BASname$(0) = "All Files" end sub ' -----------------------------removespaces ------------------------ sub removespaces ' remove spaces from filenames in BASname$() and replace with _ files DefaultDir$, "*.BAS",info$() for x = 1 to val(info$(0,0)) BASname$(x) = info$(x,0) newname$ = BASname$(x) space = instr(newname$," ") while space > 0 newname$ = left$(newname$,space-1) + "_" + mid$(newname$,space+1) space = instr(newname$," ") wend name BASname$(x) as newname$ next x end sub ' ------------------------------ pause ----------------------------------- sub pause mil t=time$("milliseconds") print #main.dotbox, " *** PAUSE *** " while time$("milliseconds")<t+mil wend end sub ' ================ Functions ========================= function ADDSPACE$(Sa$,Sy) 'replace a character from Sa$ at position Sy ADDSPACE$ = left$(Sa$,Sy-1) + " " + mid$(Sa$,Sy + 1) ' dump the chr at Sy end function ' The end