StPendl
Jul 11, 2011
- "separated code from resulting output"
[[code format="lb"]]
' 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, ""
print #dbf," DECODE OF Symbology"
print #dbf," ---------------------------------"
print #dbf," [G] - Variable defined as GLOBAL"
print #dbf," [D] - Variable Dimensioned ($)"
print #dbf," [d] - Variable or Constant used in Dimension Declaration"
print #dbf," [S] - Sub Routine name"
print #dbf," [s] - Variable or Constant used in Sub Routine Declaration"
print #dbf," [F] & [f] as above, but for Functions"
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
[[code]]
[[code]]
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
---------------------------------------- This is the output of itself ----------------------------
xref42.bas X-REF created Jul 10, 2011 20:46:01
DECODE OF Symbology
[G] - Variable defined as GLOBAL
[D] - Variable Dimensioned ($)
[d] - Variable or Constant used in Dimension Declaration
[S] - Sub Routine name
[s] - Variable or Constant used in Sub Routine Declaration
[F] & [f] as above, but for Functions
#dbf 196 199 200 212 214 215 216 226 228 230 231 232 235
#df 221 222 223 233 247 249 250 345
#main 102 103 104 149 153
#main.dotbox 92 253 484
#main.filebox 99 139 140
#main.fileisbox 91 179
#main.Listing 95
#main.NoListing 94 106
#main.Numbers 96 105 110 120
#main.timebox 93 189
[alldone] 391 403
[endlist] 219 234
[ListReset] 95 125
[ListSet] 95 119
[LNReset] 96 133
[LNSet] 96 129
[main.inputLoop] 107
[makeword] 372 376 393
[NoListReset] 94 115
[NoListSet] 94 109
[nextchr] 274 279 290 295 300
[nextline] 260 343
[nextword] 330 333 339
[quit.main] 152
[selectfile] 99 137
[setup.main.Window] 75
[startsort] 426 446
0 111 112 122 174 205 207 210 212 219 220 222 241 242 243 244 245 249 255 257 264 287 310 333 351 352 353 359 361 370 374 384 399 429 431 434 437 440 446 456 457 458 461 463 470 471 474
0.25 357
1 121 130 160 162 189 203 212 224 225 251 254 259 264 267 269 273 277 283 288 294 314 318 322 326 340 354 355 374 375 382 383 388 389 399 400 419 427 428 429 431 432 433 434 435 436 438 442 470 475 491
[d] 10 32 173
100 94
1000 165 182 187
12 99
15 91
150 81 96
[d] 2 25 30 82 83 163 172 202 204 205 209 260 264 289 354 366 409 412 414 428 433 436 439 458
20 92 99
2000 190
25 91 92 93 94 95 96
250 99
275 92 99
325 91 93 94
34 73 271
37 94 95 96
380 91 93
4 355
[d] 40 24 26
460 95
5 226 386 397
[d] 5000 30 172
580 96
60 92 93 95
740 80
[F] ADDSPACE$() 272 278 298 490 491
a$ 223 228 250 258 260 264 267 268 269 272 278 283 289 294 298 306
[S] allfiles 142 158
[G] BAScount 44 160 456 457
[G] BASFile$ 44 144 161 176 177 179 189 199
[G] BASIdx$ 44 177 196
[D] BASname$() 27 99 161 461 463 471 472 478
[G] BASTxt$ 44 176 221 247
cpointer 354 358 362 364
cstep 355 357 362 364 366
[G] Etimerval 43 181 182 186 187
[D] filedata$() 25 459
[G] filedate$ 46 163
[G] fileIs$ 41 141 144
[G] filesize 45 162
filetime 182 187 189
[S] findfiles 88 453
[S] findword 337 350
[G] funcdefline 54 245 257 312 406
hexline$ 385 386 388 396 397 399 400
hide 105 110
[D] info$() 26 162 163 455 456 459 461 469 470 471
[G] LBkey$ 48 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 310
[G] legalchr$ 49 73 287
length 268 293 294
[G] longestword 51 174 202 212 390
[d] maxinput 23 24 25 27
[G] maxperline 37 38 243
[G] maxwordcount 36 242 389
[G] metaid$ 53 256 315 319 323 327 406 409 411 412 414
[G] metatagword 52 255 314 318 322 326 408
[s] mil 482 485
newname$ 472 473 475 476 478
oldpointer 353 358 359 361 369 370 371 374 375
[S] pause 165 190 482
[G] Qlisting 55 111 121 219
[G] Qnumbers 56 112 122 130 225
[S] readascii 184 240
[S] removespaces 87 467
rotateflag 259 264 273 277
[f] Sa$ 490 491
[G] Stimerval 42 178 182 187
[f] Sy 490 491
set 106
show 120
sorted 427 440 442 446
[S] sortme 419 425
space 473 474 475 476
[S] start 147 164 171
[D] stats() 32 173 189 203 354 355 382 383 419 428
sx 428 429 431 432 433 434 435 436 437 438 439 445
t 483 485
[G] t$ 47 308 310 311 313 317 321 325
[G] targetline 40 220 224 226 244 251 253 312 385 396 406
[G] targetword$ 39 304 305 306 307 308 333 359 361 370 374 384 390
temp0$ 431 437
temp1$ 432 438
temp2$ 433 439
[G] totalwords 37 241
[D] wordarray$() 30 172 204 205 207 209 210 212 359 361 370 374 384 388 399 400 409 412 414 429 431 432 433 434 435 436 437 438 439
[G] wordcount 35 254 306 314 318 322 326 340 408
[G] wordfound 34 351 371 375 383 384 388 399 400 409 412 414 419
[G] wordplace 50 352 369
[S] writeidx 188 194
x 203 204 205 207 209 210 212 213 457 459 461 462 470 471 472 478 479
xx 160 161 162 163 166
y 267 269 272 278 283 288 293 298 301 458 459 460
z$ 269 271 282 287
[[code]]