It can compress and decompress code. You can either run the program and use the command prompt style file selector or you can compile this and the drag and drop .dba files onto it.
As far as I know it's perfect, so if you have any problems please tell me about them. It compressed itself.
Edit: If you make one constant reference a string constant or string variable you can trick the constant into being declared as the wrong type. It would be annoying to fix this, but I will probably work on it.
Compressed (18 lines)
sync on :sync rate 0 :i as integer :a as integer :b as integer :maxlines as integer :dim code(0) as string :if check display mode(640,400,32)=1 :set display mode 640,400,32 :else :exit prompt "You do not have this display mode.","Display Mode Error" :end :endif :set window layout 3,0,0 :set window title "Auto Formatter" :set window size 640,400 :set text font "Courier New" :set text size 18 :path$=cl$() :if path$="" :path$="C:" :print "Type 'help' for instructions." :while lower$(right$(path$,4))<>"dba" :if path$<>"" :set dir path$
endif :sync :input path$,cmd$ :cmd$=lower$(cmd$) :if cmd$="dir" :if path$="" :perform checklist for drives :for i=1 to checklist quantity() :print checklist string$(i) :next i :else :perform checklist for files :for i=1 to checklist quantity() :if checklist value a(i)=1 :temp$="<DIR>" :else :temp$="" :endif :print checklist string$(i)+space$(35-len(checklist string$(i)))+temp$ :if i mod 18=17 :print "Press any key to continue..." :sync :sync :wait key :endif
next i :endif :else :if cmd$=".." :repeat :path$=left$(path$,len(path$)-1) :until path$="" or right$(path$,1)="" :else :if cmd$="help" :print "This looks like command prompt, but it is not exactly the same." :print "Type 'dir' to view directories and files under the current" :print "path." :print "Type '..' to go up a directory" :print "Do NOT type 'cd' to set the directory, just type in the relative" :print "file name." :print "Select the .dba file to format it." :print "Type 'help' to view these instructions." :else :if path exist(path$+cmd$)=1 :path$=path$+cmd$ :if right$(path$,1)<>"" :path$=path$+"" :endif :endif :endif
endif :endif :if escapekey()=1 :end :endif :endwhile :else :path$=right$(path$,len(path$)-1) :print "Using dropped file." :sync :sync :wait key :endif :print "1. Decompress" :print "2. Compress" :print "3. Quit" :repeat :input "- ",resp :if resp=3 or escapekey()=1 :end :endif :until resp=1 or resp=2 :path$=left$(path$,len(path$)-1) :print "Formatting "+chr$(34)+path$+chr$(34)+"." :sync
sync :open to read 1,path$ :i=0 :repeat :read string 1,code(i) :if code(i)<>"" :array insert at bottom code(0) :inc i :endif :until file end(1) :close file 1 :maxlines=i-1 :print "Lines read." :sync :sync :for i=0 to maxlines :code(i)=trim(code(i)) :for a=1 to len(code(i)) :letter$=mid$(code(i),a) :if letter$=" " and a>1 and a<len(code(i)) :if mid$(code(i),a+1)=" " or mid$(code(i),a+1)=":" or mid$(code(i),a-1)=":" :code(i)=left$(code(i),a-1)+right$(code(i),len(code(i))-a) :dec a :endif :endif
next a :next i :print "Unformatted." :sync :sync :for i=0 to maxlines :for a=1 to len(code(i))-4 :if lower$(mid(code(i),a,4))="then" :inquotes=-1 :for b=1 to a :if mid$(code(i),b)=chr$(34) :inquotes=inquotes*-1 :endif :next b :if inquotes=-1 :full$=code(i) :code(i)=mid(full$,1,a-2) :full$=right$(full$,len(full$)-a-4) :lines=1 :running$="" :for b=1 to len(full$) :letter$=mid$(full$,b) :if letter$=":" :array insert at element code(0),i+lines :code(i+lines)=running$
inc lines :full$=trim(right$(full$,len(full$)-len(running$)-1)) :running$="" :b=0 :else :running$=running$+letter$ :endif :next b :array insert at element code(0),i+lines :code(i+lines)=running$ :array insert at element code(0),i+lines+1 :code(i+lines+1)="endif" :a=1 :i=i+lines+1 :maxlines=maxlines+lines+1 :endif :endif :next a :next i :print "Reformed then statements." :sync :sync :for i=0 to maxlines :inquotes=-1 :for a=1 to len(code(i))-1
letter$=mid$(code(i),a) :if letter$=":" and inquotes=-1 and mid$(code(i),a+1)<>":" :full$=code(i) :code(i)=left$(full$,a-1) :array insert at element code(0),i+1 :code(i+1)=trim(right$(full$,len(full$)-a)) :inc maxlines :inc i :a=1 :else :if letter$=chr$(34) :inquotes=inquotes*-1 :endif :endif :next i :next i :print "Removed colons." :sync :sync :if resp=1 :tab=0 :for i=0 to maxlines :if lower$(left$(code(i),2))="if" or lower$(left$(code(i),5))="select" or lower$(left$(code(i),3))="for" or lower$(left$(code(i),2))="do" or lower$(left$(code(i),6))="repeat" or lower$(left$(code(i),4))="case" or lower$(left$(code(i),5))="while" or lower$(left$(code(i),4))="type" or lower$(left$(code(i),8))="function" :code(i)=space$(tab*3)+code(i) :inc tab
else :if lower$(left$(code(i),5))="endif" or lower$(left$(code(i),4))="next" or lower$(left$(code(i),4))="loop" or lower$(left$(code(i),7))="endcase" or lower$(left$(code(i),9))="endselect" or lower$(left$(code(i),5))="until" or lower$(left$(code(i),8))="endwhile" or lower$(left$(code(i),7))="endtype" or lower$(left$(code(i),11))="endfunction" :dec tab :endif :code(i)=space$(tab*3)+code(i) :endif :next i :print "Tabbed." :sync :sync :else :for i=0 to maxlines :if lower$(left$(code(i),8))="remstart" :a=0 :repeat :array delete element code(0),i :inc a :dec maxlines :until lower$(left$(code(i),7))="remend" :array delete element code(0),i :dec maxlines :i=i-a :else :if left$(code(i),1)="`" or lower$(left$(code(i),3))="rem" :array delete element code(0),i
dec i :dec maxlines :endif :endif :next i :for i=0 to maxlines :inquotes=-1 :for a=1 to len(code(i)) :if mid$(code(i),a)="`" and inquotes=-1 :code(i)=left$(code(i),a-1) :endif :if mid$(code(i),a)=chr$(34) :inquotes=inquotes*-1 :endif :next a :inquotes=-1 :for a=1 to len(code(i))-2 :if lower$(mid(code(i),a,3))="rem" and inquotes=-1 :code(i)=left$(code(i),a-1) :endif :if mid$(code(i),a)=chr$(34) :inquotes=inquotes*-1 :endif :next a :next i
print "Removed comments." :sync :sync :for i=0 to maxlines-1 :if lower$(left$(code(i),4))="data" and lower$(left$(code(i+1),4))="data" :code(i)=code(i)+","+right$(code(i+1),len(code(i+1))-5) :array delete element code(0),i+1 :dec maxlines :dec i :endif :next i :print "Combined data statements." :for i=0 to maxlines :if lower$(left$(code(i),9))="#constant" :temp$=code(i) :temp2$=trim(right$(temp$,len(temp$)-9)) :for a=0 to len(temp2$) :if mid$(temp2$,a)=" " or mid$(temp2$,a)="=" :temp$=left$(temp2$,a-1) :temp2$=right$(temp2$,len(temp2$)-a+1) :exit :endif :next a :temp$=trim(temp$) :temp2$=trim(temp2$)
if left$(temp2$,1)="=" :temp2$=right$(temp2$,len(temp2$)-1) :endif :code(i)=temp$+"="+temp2$ :array insert at element code(0),i :code(i)="global "+temp$ :if mid$(temp2$,1)=chr$(34) :code(i)=code(i)+" as string" :else :code(i)=code(i)+" as float" :endif :inc maxlines :endif :next i :sync :sync :print "Constants changed to globals." :dim code2(0) as string :coms=0 :cline=0 :for i=0 to maxlines :if coms>0 :if lower$(left$(code(i),8))="function" or lower$(left$(code(i),11))="endfunction" or lower$(left$(code(i),4))="type" or lower$(left$(code(i),7))="endtype" or coms=25 :coms=0 :array insert at bottom code2(0)
inc cline :endif :endif :code2(cline)=code2(cline)+code(i)+":" :inc coms :next i :undim code(0) :maxlines=cline :dim code(maxlines) as string :for i=0 to maxlines :code(i)=left$(code2(i),len(code2(i))-2) :next i :print "Compressed." :sync :sync :endif :delete file path$ :open to write 1,path$ :for i=0 to maxlines :write string 1,code(i) :next i :close file 1 :print "Formatted." :sync :sync
wait key :end
function trim(str as string) :while mid$(str,1)=" " :str=right$(str,len(str)-1) :endwhile :while mid$(str,len(str))=" " :str=left$(str,len(str)-1) :endwhile
endfunction str
function mid(str as string,start as integer,length as integer) :part$=right$(left$(str,start+length-1),length)
endfunction part$
Decompressed version
sync on
sync rate 0
i as integer
a as integer
b as integer
maxlines as integer
dim code(0) as string
if check display mode(640,400,32)=1
set display mode 640,400,32
else
exit prompt "You do not have this display mode.","Display Mode Error"
end
endif
set window layout 3,0,0
set window title "Auto Formatter"
set window size 640,400
set text font "Courier New"
set text size 18
path$=cl$()
if path$=""
path$="C:"
print "Type 'help' for instructions."
while lower$(right$(path$,4))<>"dba"
if path$<>""
set dir path$
endif
sync
input path$,cmd$
cmd$=lower$(cmd$)
if cmd$="dir"
if path$=""
perform checklist for drives
for i=1 to checklist quantity()
print checklist string$(i)
next i
else
perform checklist for files
for i=1 to checklist quantity()
if checklist value a(i)=1
temp$="<DIR>"
else
temp$=""
endif
print checklist string$(i)+space$(35-len(checklist string$(i)))+temp$
if i mod 18=17
print "Press any key to continue..."
sync
sync
wait key
endif
next i
endif
else
if cmd$=".."
repeat
path$=left$(path$,len(path$)-1)
until path$="" or right$(path$,1)=""
else
if cmd$="help"
print "This looks like command prompt, but it is not exactly the same."
print "Type 'dir' to view directories and files under the current"
print "path."
print "Type '..' to go up a directory"
print "Do NOT type 'cd' to set the directory, just type in the relative"
print "file name."
print "Select the .dba file to format it."
print "Type 'help' to view these instructions."
else
if path exist(path$+cmd$)=1
path$=path$+cmd$
if right$(path$,1)<>""
path$=path$+""
endif
endif
endif
endif
endif
if escapekey()=1
end
endif
endwhile
else
path$=right$(path$,len(path$)-1)
print "Using dropped file."
sync
sync
wait key
endif
print "1. Decompress"
print "2. Compress"
print "3. Quit"
repeat
input "- ",resp
if resp=3 or escapekey()=1
end
endif
until resp=1 or resp=2
path$=left$(path$,len(path$)-1)
print "Formatting "+chr$(34)+path$+chr$(34)+"."
sync
sync
open to read 1,path$
i=0
repeat
read string 1,code(i)
if code(i)<>""
array insert at bottom code(0)
inc i
endif
until file end(1)
close file 1
maxlines=i-1
print "Lines read."
sync
sync
for i=0 to maxlines
code(i)=trim(code(i))
for a=1 to len(code(i))
letter$=mid$(code(i),a)
if letter$=" " and a>1 and a<len(code(i))
if mid$(code(i),a+1)=" " or mid$(code(i),a+1)=":" or mid$(code(i),a-1)=":"
code(i)=left$(code(i),a-1)+right$(code(i),len(code(i))-a)
dec a
endif
endif
next a
next i
print "Unformatted."
sync
sync
for i=0 to maxlines
for a=1 to len(code(i))-4
if lower$(mid(code(i),a,4))="then"
inquotes=-1
for b=1 to a
if mid$(code(i),b)=chr$(34)
inquotes=inquotes*-1
endif
next b
if inquotes=-1
full$=code(i)
code(i)=mid(full$,1,a-2)
full$=right$(full$,len(full$)-a-4)
lines=1
running$=""
for b=1 to len(full$)
letter$=mid$(full$,b)
if letter$=":"
array insert at element code(0),i+lines
code(i+lines)=running$
inc lines
full$=trim(right$(full$,len(full$)-len(running$)-1))
running$=""
b=0
else
running$=running$+letter$
endif
next b
array insert at element code(0),i+lines
code(i+lines)=running$
array insert at element code(0),i+lines+1
code(i+lines+1)="endif"
a=1
i=i+lines+1
maxlines=maxlines+lines+1
endif
endif
next a
next i
print "Reformed then statements."
sync
sync
for i=0 to maxlines
inquotes=-1
for a=1 to len(code(i))-1
letter$=mid$(code(i),a)
if letter$=":" and inquotes=-1 and mid$(code(i),a+1)<>":"
full$=code(i)
code(i)=left$(full$,a-1)
array insert at element code(0),i+1
code(i+1)=trim(right$(full$,len(full$)-a))
inc maxlines
inc i
a=1
else
if letter$=chr$(34)
inquotes=inquotes*-1
endif
endif
next i
next i
print "Removed colons."
sync
sync
if resp=1
tab=0
for i=0 to maxlines
if lower$(left$(code(i),2))="if" or lower$(left$(code(i),5))="select" or lower$(left$(code(i),3))="for" or lower$(left$(code(i),2))="do" or lower$(left$(code(i),6))="repeat" or lower$(left$(code(i),4))="case" or lower$(left$(code(i),5))="while" or lower$(left$(code(i),4))="type" or lower$(left$(code(i),8))="function"
code(i)=space$(tab*3)+code(i)
inc tab
else
if lower$(left$(code(i),5))="endif" or lower$(left$(code(i),4))="next" or lower$(left$(code(i),4))="loop" or lower$(left$(code(i),7))="endcase" or lower$(left$(code(i),9))="endselect" or lower$(left$(code(i),5))="until" or lower$(left$(code(i),8))="endwhile" or lower$(left$(code(i),7))="endtype" or lower$(left$(code(i),11))="endfunction"
dec tab
endif
code(i)=space$(tab*3)+code(i)
endif
next i
print "Tabbed."
sync
sync
else
for i=0 to maxlines
if lower$(left$(code(i),8))="remstart"
a=0
repeat
array delete element code(0),i
inc a
dec maxlines
until lower$(left$(code(i),7))="remend"
array delete element code(0),i
dec maxlines
i=i-a
else
if left$(code(i),1)="`" or lower$(left$(code(i),3))="rem"
array delete element code(0),i
dec i
dec maxlines
endif
endif
next i
for i=0 to maxlines
inquotes=-1
for a=1 to len(code(i))
if mid$(code(i),a)="`" and inquotes=-1
code(i)=left$(code(i),a-1)
endif
if mid$(code(i),a)=chr$(34)
inquotes=inquotes*-1
endif
next a
inquotes=-1
for a=1 to len(code(i))-2
if lower$(mid(code(i),a,3))="rem" and inquotes=-1
code(i)=left$(code(i),a-1)
endif
if mid$(code(i),a)=chr$(34)
inquotes=inquotes*-1
endif
next a
next i
print "Removed comments."
sync
sync
for i=0 to maxlines-1
if lower$(left$(code(i),4))="data" and lower$(left$(code(i+1),4))="data"
code(i)=code(i)+","+right$(code(i+1),len(code(i+1))-5)
array delete element code(0),i+1
dec maxlines
dec i
endif
next i
print "Combined data statements."
for i=0 to maxlines
if lower$(left$(code(i),9))="#constant"
temp$=code(i)
temp2$=trim(right$(temp$,len(temp$)-9))
for a=0 to len(temp2$)
if mid$(temp2$,a)=" " or mid$(temp2$,a)="="
temp$=left$(temp2$,a-1)
temp2$=right$(temp2$,len(temp2$)-a+1)
exit
endif
next a
temp$=trim(temp$)
temp2$=trim(temp2$)
if left$(temp2$,1)="="
temp2$=right$(temp2$,len(temp2$)-1)
endif
code(i)=temp$+"="+temp2$
array insert at element code(0),i
code(i)="global "+temp$
if mid$(temp2$,1)=chr$(34)
code(i)=code(i)+" as string"
else
code(i)=code(i)+" as float"
endif
inc maxlines
endif
next i
sync
sync
print "Constants changed to globals."
dim code2(0) as string
coms=0
cline=0
for i=0 to maxlines
if coms>0
if lower$(left$(code(i),8))="function" or lower$(left$(code(i),11))="endfunction" or lower$(left$(code(i),4))="type" or lower$(left$(code(i),7))="endtype" or coms=25
coms=0
array insert at bottom code2(0)
inc cline
endif
endif
code2(cline)=code2(cline)+code(i)+" :"
inc coms
next i
undim code(0)
maxlines=cline
dim code(maxlines) as string
for i=0 to maxlines
code(i)=left$(code2(i),len(code2(i))-2)
next i
print "Compressed."
sync
sync
endif
delete file path$
open to write 1,path$
for i=0 to maxlines
write string 1,code(i)
next i
close file 1
print "Formatted."
sync
sync
wait key
end
function trim(str as string)
while mid$(str,1)=" "
str=right$(str,len(str)-1)
endwhile
while mid$(str,len(str))=" "
str=left$(str,len(str)-1)
endwhile
endfunction str
function mid(str as string,start as integer,length as integer)
part$=right$(left$(str,start+length-1),length)
endfunction part$
Edit: Aaah. Something in the forum killed all the slashes so now it doesn't work. I have attached the uncompressed code. It can compress and decompress itself so I saw no reason attaching both.
