' TFL - Text File Lister
' Version 1.02  September 20,1985
'
' (C) Copright 1985 by William D. Hileman
'
10 ' For misc. error traps
'
defint a-z
'
on error goto TRAPPER
'
' Main Program
'
gosub INITIALIZE
gosub DISPLAY.TITLE
gosub GET.SOURCE
width "lpt1:",pgwid
if not done then _
  while inkey$<>"":wend: _
  if batch then _
    gosub LIST.BATCH _
  else _
    gosub LIST.ONE
  rem endif
rem endif
'
end
'
' Subroutines
'
' ***********
  INITIALIZE:
' ***********
'
false=0:true=(not false)
batch=false
done=false
abort=false
pglen=66:pgwid=80
version$="1.02"
versdate$="09/20/85"
'
return
'
' **************
  DISPLAY.TITLE:
' **************
'
print "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
print "³ TFL - Text File Lister Version ";version$;" ";versdate$;" ³"
print "³    (C)opyright 1985 by William D. Hileman    ³"
print "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
'
return
'
' ***********
  GET.SOURCE:
' ***********
'
if command$="?" then _
  gosub DISPLAY.FORMAT: _
  done=true _
else _
  if command$="" then _
    gosub ASK.SOURCE _
  else _
    gosub PARSE.SOURCE
  rem endif
rem endif
if not done then _
  while right$(src.fil$,1)=" ": _
    src.fil$=left$(src.fil$,len(src.fil$)-1): _
  wend: _
  while left$(src.fil$,1)=" ": _
    src.fil$=mid$(src.fil$,2): _
  wend: _
  if len(src.fil$)>7 then _
    if right$(src.fil$,8)="TFL.DAT" then _
      batch=true
    rem endif
  rem endif
rem endif
'
return
'
' ************
  MAKE.UPCASE:
' ************
'
for cnt=1 to len(src.fil$)
  sub$=mid$(src.fil$,cnt,1)
  if sub$>="a" and sub$<="z" then _
    mid$(src.fil$,cnt,1)=chr$(asc(sub$) and 223)
  rem endif
next cnt
'
return
'
' ***********
  LIST.BATCH:
' ***********
'
gosub CHECK.FIL
'
if not exist then _
  print: _
  print "'";src.fil$;"' not found!";: _
  beep _
else _
  open "I",2,src.fil$: _
  while (not eof(2) and not abort): _
    line input #2, src.fil$: _
    gosub LIST.ONE: _
  wend: _
  close #2
rem endif
'
return
'
' *********
  LIST.ONE:
' *********
'
gosub CHECK.FIL
'
if not exist then _
  print: _
  print "'";src.fil$;"' not found!";: _
  beep _
else _
  gosub FILE.INTEGRITY: _
  if file.ok then _
    print: _
    print "Now listing '";src.fil$;"'";: _
    lincnt=pglen:page=1: _
    open "I",1,src.fil$: _
    while (not eof(1) and not abort): _
      line input #1, ps$: _
      gosub REPLACE.TABS: _
      firstcheck=true: _
      gosub MAKE.SUBSTRING: _
      firstcheck=false:
      while (ss$<>"" and not abort): _
        gosub HEADER.CHECK: _
        lprint ss$: _
        lincnt=lincnt+1: _
        gosub MAKE.SUBSTRING: _
        gosub KEYCHECK: _
      wend: _
    wend: _
    close #1: _
    gosub PAGE.EJECT: _
    if abort then _
      print " - print aborted";: _
      beep
    rem endif
  rem endif
rem endif
'
return
'
' *********
  KEYCHECK:
' *********
'
if inkey$=chr$(27) then _
  abort=true
rem endif
'
return
'
' **********
  CHECK.FIL:
' **********
'
100 '
'
exist=true
open "I",3,src.fil$
'
101 '
'
close #3
'
return
'
' ***************
  FILE.INTEGRITY:
' ***************
'
file.ok=false
open "R",4,src.fil$
field #4,1 as tst$
get #4,1
if lof(4)=0 or tst$=chr$(26) then _
  print: _
  print "'";src.fil$;"' is empty!";: _
  beep _
else if tst$=chr$(255) then _
  print: _
  print "'";src.fil$;"' is a binary file!";: _
  beep _
else if tst$=chr$(254) then _
  print: _
  print "'";src.fil$;"' is a protected file!";: _
  beep _
else _
  file.ok=true
rem endif
close #4
'
return
'
' *************
  REPLACE.TABS:
' *************
'
x=instr(ps$,chr$(9))
while (x<>0)
  ps$=left$(ps$,x-1)+space$(9-(x mod 8))+mid$(ps$,x+1)
  x=instr(ps$,chr$(9))
wend
'
return
'
' ***************
  MAKE.SUBSTRING:
' ***************
'
if len(ps$)>pgwid then _
  ss$=left$(ps$,pgwid): _
  ps$=right$(ps$,len(ps$)-pgwid) _
else _
  ss$=ps$: _
  ps$="": _
  if firstcheck and ss$="" then _
    gosub HEADER.CHECK: _
    lprint: _
    lincnt=lincnt+1: _
    gosub KEYCHECK
  rem endif
rem endif
'
return
'
' *************
  HEADER.CHECK:
' *************
'
if lincnt>pglen-3 then _
  for cnt=lincnt to pglen: _
    lprint: _
  next cnt: _
  lprint src.fil$;: _
  txt$=date$+"  "+time$: _
  lprint tab((pgwid-len(txt$))/2+1);txt$;: _
  lprint tab(pgwid-9);"Page ";using "###";page: _
  lprint: _
  page=page+1: _
  lincnt=3
rem endif
'
return
'
' ***********
  PAGE.EJECT:
' ***********
'
for cnt=lincnt to pglen-1
  lprint
next cnt
'
return
'
' ***************
  DISPLAY.FORMAT:
' ***************
'
print
print "Formats are: TFL                          - Prompts for filename"
print "             TFL drive:\path\filename.ext - Lists specific file"
print "             TFL drive:\path\TFL.DAT      - Lists files in TFL.DAT"
print "             TFL ?                        - Displays this message"
print
print "Optional command line switches:"
print
print "             /PWnnn - Width of page in characters - default is 80"
print "             /PLnnn - Length of page in lines - default is 66"
print
print "For example, TFL C:\SOURCE\MYPROG.BAS /PW132 /PL88 would list file"
print "'MYPROG.BAS' in subdirectory 'SOURCE' on drive 'C' with a page width"
print "of 132 characters per line, and a page length of 88 lines per page."
print
print "Notes:  Your printer must already be set-up for the correct vertical"
print "        and horozontal spacing before using the 'PW' and 'PL' switches."
print "        Pressing [ESC] during execution will cause printing to abort.";
'
return
'
' ***********
  ASK.SOURCE:
' ***********
'
print
print "List file name: ";
line input src.fil$
if src.fil$="" then _
  done=true _
else _
  gosub MAKE.UPCASE
rem endif
'
return
'
' *************
  PARSE.SOURCE:
' *************
'
pwv=0:plv=0
src.fil$=command$
gosub MAKE.UPCASE
pw=instr(src.fil$,"/PW")
if pw<>0 then _
  stp=instr(pw+1,src.fil$,"/"): _
  if stp=0 then _
    pwv=val(mid$(src.fil$,pw+3)): _
    src.fil$=left$(src.fil$,pw-1) _
  else _
    pwv=val(mid$(src.fil$,pw+3,stp-pw-3)): _
    src.fil$=left$(src.fil$,pw-1)+mid$(src.fil$,stp)
  rem endif
rem endif
if pwv>0 then _
  pgwid=pwv
rem endif
pl=instr(src.fil$,"/PL")
if pl<>0 then _
  stp=instr(pl+1,src.fil$,"/"): _
  if stp=0 then _
    plv=val(mid$(src.fil$,pl+3)): _
    src.fil$=left$(src.fil$,pl-1) _
  else _
    plv=val(mid$(src.fil$,pl+3,stp-pl-3)): _
    src.fil$=left$(src.fil$,pl-1)+mid$(src.fil$,stp)
  rem endif
rem endif
if plv>0 then _
  pglen=plv
rem endif
'
return
'
' ********
  TRAPPER:
' ********
'
if erl=100 then _
  exist=false: _
  resume 101 _
else _
  on error goto 0
rem endif
'
' End of Code
'