1 ''            READBAS 1.4 -  READS BASIC PROGRAMS SAVED IN BINARY
2 ''        NELSON FORD (713) 960-1300   (713) 721-6104    MAY 10, 1984
3 ''
4 '' PUBLIC DOMAIN.  The idea is to compile this program and use it while in
5 '' DOS to look at BASIC programs that have been saved in compacted binary.
6 '' This code may also be added to other programs that need to read BASIC
7 '' programs that may not be saved in ASCII.
8 ''
10 DEFINT A-Z: PRINT CHR$(26);: INPUT "FILE NAME"; FI$
30 INPUT "OUTPUT FILENAME"; F2$
40 DIM X#(8): PRINT: PRINT "PRESS ANY KEY TO ABORT": PRINT
50 DIM T$(115), T3$(6), T4$(30), T5$(37)
60 FOR T=129 TO 243: READ T$(T-128):  NEXT   'tokens 129-243
70 FOR T=129 TO 134: READ T3$(T-128): NEXT   'token 253 followed by 129-134
80 FOR T=129 TO 158: READ T4$(T-128): NEXT   'token 254 followed by 129-158
90 FOR T=129 TO 165: READ T5$(T-128): NEXT   'token 255 followed by 129-165
95 '
100 OPEN "R",1,FI$,1:FIELD 1,1 AS X$
110 OPEN "O",2,F2$:GET 1
120 IF ASC(X$) <>255 THEN PRINT "NOT A BASIC PROGRAM SAVED IN BINARY": END
125 '----get, print line number:
130 GET 1: X=ASC(X$): GET 1: IF X=0 AND ASC(X$)=0 THEN CLOSE:PRINT"DONE":END
140 GET 1: N$=STR$(ASC(X$)):  GET 1: X=ASC(X$)
150 IF X>0 THEN N$=STR$(X*256+VAL(N$))
160 PRINT #2, RIGHT$(N$,LEN(N$)-1) " ";
190 '----get a hex character and translate:
200 GET 1: X= ASC(X$)
210 U$=INKEY$: IF U$<>"" THEN END
220 IF X=58 THEN GET 1: X=ASC(X$):  IF X=143  THEN  GOSUB 910:  GOTO 130  ELSE      IF X<>161 THEN PRINT #2,":";
230 IF X=0  THEN PRINT #2,"": GOTO 130    'ascii 0 marks end of BASIC line
240 IF X>31 THEN 300  ELSE IF X <11 THEN STOP
250   ON X-10 GOSUB 400,440,480,500,540,580,600,600,600,600,600,600,600,600,600,      600,640,660,720,815,820
260   GOTO 200
270   RETURN
290 '------
300 IF X <128 THEN PRINT #2, X$;:  IF X=34 THEN 1200 ELSE 200
310 IF X >128 AND X <244 THEN PRINT #2, T$(X-128);:  GOTO 200
320 IF X >252 AND X <256 THEN GET 1: Y=ASC(X$) ELSE 200
330 IF Y <129 THEN PRINT "ERROR IN FILE": STOP
340 ON X-252 GOTO 350,360,370:  GOTO 200
350   PRINT #2, T3$(Y-128);:  GOTO 200
360   PRINT #2, T4$(Y-128);:  GOTO 200
370   PRINT #2, T5$(Y-128);:  GOTO 200
390 '
400 GET 1: N=ASC(X$): GET 1: N=ASC(X$)*256 +N    '11  =  OCTAL
410 PRINT #2, "&O" OCT$(N);
420 RETURN
430 '
440 GET 1: N=ASC(X$): GET 1: N=ASC(X$)*256 +N    '12  =  HEX
450 PRINT #2, "&H" HEX$(N);
460 RETURN
470 '
480 STOP                             '13  NOT USED
490 '
500 GET 1: N$=STR$(ASC(X$))          '14  INTEGERS
505 GET 1: X=ASC(X$)
510 IF X>0 THEN N$=STR$(X*256+VAL(N$))
520 PRINT #2, RIGHT$(N$,LEN(N$)-1);
530 RETURN
535 '
540 GET 1: N$=STR$(ASC(X$))          '15  =  NUMBERS 10 TO 255
550 PRINT #2, RIGHT$(N$,LEN(N$)-1);
560 RETURN
570 '
580 STOP                             '16  NOT USED
590 '
600 N$=STR$(X-17)                    '17 - 26 = NUMBERS 0 TO 9
610 PRINT #2, RIGHT$(N$,LEN(N$)-1);
620 RETURN
630 '
640 STOP                             '27  NOT USED
650 '
660 GET 1: N=ASC(X$): GET 1          '28  =  NUMBERS > 255 AND <32267
670 N$= STR$(256*ASC(X$) +N)
680 PRINT #2, RIGHT$(N$,LEN(N$)-1);
690 RETURN
700 '
710                                  '29  =  NUMBERS >32267 AND < ?
720 N$="": FOR I=1 TO 4: GET 1: N$=N$+X$: NEXT
730 N$=STR$(CVS(N$))
740 PRINT #2, RIGHT$(N$,LEN(N$)-1); "!";
750 RETURN
815 '                                 30  NOT USED
816 '
819 '                                 31  =  DOUBLE PRECISION
820 N$="": FOR I=1 TO 8: GET 1: N$=N$+X$: NEXT
830 N$=STR$(CVD(N$))
840 PRINT #2, RIGHT$(N$,LEN(N$)-1); "#";
850 RETURN
905 '                        read from ' to end of line:
910 PRINT #2, "'";:  GET 1:
920 GET 1: IF ASC(X$) >0 THEN PRINT #2, X$;: GOTO 920
950 PRINT #2, "": RETURN
955 '
960 'tokens 129-244:
970 DATA END,FOR,NEXT,DATA,INPUT,DIM,READ,LET,GOTO,RUN,IF,RESTORE,GOSUB,RETURN
980 DATA REM,STOP,PRINT,CLEAR,LIST,NEW,ON,WAIT,DEF,POKE,CONT,NU,NU,OUT,LPRINT
990 DATA LLIST,NU,WIDTH,ELSE,TRON,TROFF,SWAP,ERASE,EDIT,ERROR,RESUME,DELETE
1000 DATA AUTO,RENUM,DEFSTR,DEFINT,DEFSNG,DEFDBL,LINE,WHILE,WEND,CALL,NU,NU,NU
1010 DATA WRITE,OPTION,RANDOMIZE,OPEN,CLOSE,LOAD,MERGE,SAVE,COLOR,CLS,MOTOR
1020 DATA BSAVE,BLOAD,SOUND,BEEP,PSET,PRESET,SCREEN,KEY,LOCATE,NU,TO,THEN,TAB(
1030 DATA STEP,USR,FN,SPC,NOT,ERL,ERR,STRING$,USING,INSTR,"'",VARPTR,CSRLIN
1040 DATA POINT,OFF,INKEY$,NU,NU,NU,NU,NU,NU,NU,>,=,<,+,-,*,/,^,AND,OR,XOR,EQV
1050 DATA IMP,MOD
1060 'pre-token 253, tokens 129-134:
1070 DATA CVI,CVS,CVD,MKI$,MKS$,MKD$
1080 'pre-token 254, tokens 129-158:
1090 DATA FILES,FIELD,SYSTEM,NAME,LSET,RSET,KILL,PUT,GET,RESET,COMMON,CHAIN
1100 DATA DATE$,TIME$,PAINT,COM,CIRCLE,DRAW,PLAY,TIMER,ERDEV,IOCTL,CHDIR,MKDIR
1110 DATA RMDIR,SHELL,ENVIRON,VIEW,WINDOW,PMAP
1120 'pre-token 255, tokens 129-165:
1130 DATA LEFT$,RIGHT$,MID$,SGN,INT,ABS,SQR,RND,SIN,LOG,EXP,COS,TAN,ATN,FRE
1140 DATA INP,POS,LEN,STR$,VAL,ASC,CHR$,PEEK,SPACE$,OCT$,HEX$,LPOS,CINT,CSNG
1150 DATA CDBL,FIX,PEN,STICK,STRIG,EOF,LOC,LOF
1200 'print stuff in quotes:
1210 GET 1: X=ASC(X$):  IF X=0 THEN PRINT #2,"": GOTO 130
1220 IF X=34 THEN PRINT #2, CHR$(34);:  GOTO 200
1230 PRINT #2,X$;:  GOTO 1210
