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
' 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