20 CLEAR 5000    'Required only for OBASIC not MBASIC or BASICA
90 CLOSE:PRINT CHR$(26)    'Clear Screen Code for KAYPRO, May be machine dependent
100 ' For ZORBA use Print CHR$(27)+"E"; For IBM, use CLS
110 PRINT TAB(15);"---------------------------------------------"
111 PRINT TAB(15);"|           BASLIST.BAS                     |"
114 PRINT TAB(15);"|  BASIC PROGRAM LISTER  Version 2.01       |"
116 PRINT TAB(15);"|  (ASCII FORMAT)        September 21, 1985 |"
118 PRINT TAB(15);"|                                           |"
120 PRINT TAB(15);"|  PROGRAM BY:     Thomas S. Cox            |"
122 PRINT TAB(15);"|                  102 Evergreen Street     |"
124 PRINT TAB(15);"|  (C) 1985        Easley, SC  29640        |"
126 PRINT TAB(15);"|                                           |"
128 PRINT TAB(15);"|  PUBLIC DOMAIN SOFTWARE.  May be freely   |"
130 PRINT TAB(15);"|  copied.  Please leave this sign-on       |"
132 PRINT TAB(15);"|  message on all copies.  Thanks.          |"
136 PRINT TAB(15);"---------------------------------------------"
138 PRINT" " 
160 OP=0:LINE INPUT"Output listing to printer (Y)es or (N)o   {DEFAULT=Y} ";OP$:IF OP$="" THEN OP$="Y"
170 IF LEFT$(OP$,1)="Y" OR LEFT$(OP$,1)="y" THEN OP=1 ELSE IF LEFT$(OP$,1)="N" OR LEFT$(OP$,1)="n" THEN OP=0 ELSE PRINT"Your input of ";OP$;" was invalid.  Please re-enter":GOTO 160
180 LINE INPUT "Please enter Date and Time (MM/DD/YY  HH:MM) ";TD$
190 LINE INPUT"Maximum number of characters per line (Default is 80) ";MC$:MC=VAL(MC$)
191 IF MC=0 THEN MC=80
192 WIDTH LPRINT MC      'USED ONLY FOR CP/M VERSIONS OF OBASIC AND MBASIC
194 ' FOR IBM BASICA THE PROPER FORMAT IS  'WIDTH "LPT1:",MC'
196 LINE INPUT "Please enter number of lines per page (Default is 60) ";LL$:LL=VAL(LL$)
198 IF LL=0 THEN LL=60
200 LINE INPUT "Multistatement lines one statement per line (Y)es or (N)o  {DEFAULT=Y} ";MS$:IF MS$="" THEN MS$="Y"
210 IF LEFT$(MS$,1)="Y" OR LEFT$(MS$,1)="y" THEN ML=1 ELSE IF LEFT$(MS$,1)="N" OR LEFT$(MS$,1)="n" THEN ML=0 ELSE PRINT"Your input of ";ML$;" was invalid.  Please re-enter.":GOTO 200 
220 LINE INPUT "Please enter the filename of program to be printed  ";F$
230 OL=0
240 LINE INPUT "Output listing to Disk File (Y)es or (N)o   {DEFAULT=N} ";OL$:IF OL$="" THEN OL$="N"
250 IF LEFT$(OL$,1)="Y" OR LEFT$(OL$,1)="y" THEN GOTO 260 ELSE IF LEFT$(OL$,1)="N" OR LEFT$(OL$,1)="n"THEN GOTO 290 ELSE PRINT"Your entry of ";OL$;"was invalid.  Please re-enter.":GOTO 230
260 OL=1:LINE INPUT"Please enter filename for disk storage of listing  ";FS$
270 OPEN "O",2,FS$
290 LP=0:N=1
300 OPEN "I",1,F$
301 LINE INPUT #1,B$
302 IF ASC(B$)=255 THEN PRINT CHR$(26):PRINT CHR$(7):PRINT"SORRY, THE FILE YOU SPECIFIED IS NOT IN ASCII FORMAT (IT IS TOKENIZED)":PRINT " ":CLOSE 1:GOTO 110
304 CLOSE 1
305 OPEN "I",1,F$:IF EOF(1) THEN GOTO 90
307 B1$=" );=":A2$=" "
310 PRINT CHR$(26):GOSUB 1000     'print title at start of first page
320 IF EOF(1) THEN GOTO 380  'if no more data then quit
330 LINE INPUT #1,B$ 'read file up through next CR/LF
360 GOSUB 2000   'Start extraction of MC Column lines
370 GOTO 320
380 PRINT CHR$(26);"END of File"    'When all has been done, eject page and STOP
390 IF OP=1 THEN LPRINT CHR$(12)    'CHR$(12)=Form Feed
400 IF OL=1 THEN PRINT #2,CHR$(12)
410 CLOSE     'Any open file will be closed                        
415 PRINT CHR$(7):GOTO 90
420 END
1000 ' This subroutine prints Titles, Page Numbers, etc.
1003 PRINT TD$;TAB(42);F$;"  Page # ";N:PRINT " "
1005 IF OL=1 THEN PRINT #2,TD$,TAB(42);F$;"  Page # ";N:PRINT #2,"     "
1010 IF OP=1 THEN LPRINT TD$;TAB(42);F$;"   Page ";N
1020 IF OP=1 THEN LPRINT" "
1030 LP=2:RETURN  
2000 ' This subroutine extracts up to MC characters for a line
2010 K1=1:F=0:Q1=1:CC=0
2020 FOR I=1 TO LEN(B$)
2023 IF MQ=1 THEN GOSUB 3000
2030 CC=CC+1:A1$=MID$(B$,I,1):IF CC=MC THEN GOSUB 3000
2046 IF CC>=(MC-8) AND INSTR(1,B1$,A1$) THEN MQ=1
2050 IF ML=0 THEN 2100
2060 IF A1$=CHR$(34) THEN Q1=Q1*-1
2070 IF Q1<0 THEN 2100
2090 IF A1$=":" THEN GOSUB 3000
2095 IF A1$>CHR$(127) THEN GOSUB 4000    'Strip any high bits
2100 NEXT I
2110 GOSUB 3000
2120 RETURN
3000 ' This subroutine PRINTS a string up to MC characters in length
3005 F1$=MID$(B$,K1,I-K1)
3010 IF F1$="" THEN RETURN
3020 IF F=1 THEN K=(INSTR(1,B$,A2$)+1):IF OP=1 THEN LPRINT TAB(K);
3030 IF F=1 AND OL=1 THEN PRINT #2,TAB(K);
3040 IF OP=1 THEN LPRINT F1$
3050 IF OL=1 THEN PRINT #2,F1$
3055 IF F=1 THEN PRINT TAB(K);
3056 PRINT F1$
3060 K1=I:F=1:LP=LP+1:CC=K:MQ=0
3070 IF LP>=LL THEN LP=0:N=N+1:IF OP=1 THEN LPRINT CHR$(12)
3080 IF OL=1 AND LP=0 THEN PRINT #2,CHR$(12)
3090 IF LP=0 THEN GOSUB 1000
3100 RETURN
4000 N1=ASC(A1$):N1=N1-128:MID$(B$,I,1)=CHR$(N1):RETURN
=0 THEN PRINT #2,CHR$(12)
3090 IF LP=0 THEN GOSUB 1000
3100 RETURN
4000 N1=ASC(A1$):N1=N1-128:MID$(B