home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / basic / egbas.lbr / DCODE.BZS / DCODE.BAS
Encoding:
BASIC Source File  |  1988-01-24  |  3.1 KB  |  85 lines
  1. 0 REM 02-02-85 <-- last backup
  2. 10 PRINT"Eric Gans"
  3. 20 PRINT"French Department, UCLA"
  4. 30 PRINT"Los Angeles, CA 90024"
  5. 40 PRINT"02/02/85"
  6. 50 ON ERROR GOTO 770
  7. 60 REM seems finished 11/1/84
  8. 70 PRINT TAB(35)"DCODE"
  9. 80 PRINT:PRINT"     This program will decode MBasic's compressed file format to ASCII."
  10. 90 PRINT"It's not as fast as Basic itself but it gives you a better idea of what's"
  11. 100 PRINT"going on.  Double-precision numbers are not supported."
  12. 110 PRINT:PRINT"     The (data) file BCODE.DAT must be on disk to support this program."
  13. 120 PRINT"It has a few peculiarities (extra spaces before/after numbers, etc.),"
  14. 130 PRINT"but that shouldn't matter."
  15. 140 DEFINT A-Z
  16. 150 DIM NM$(256),C1(140),C2(140)
  17. 160 OPEN "I",1,"BCODE.DAT"
  18. 170 FOR I=1 TO 140
  19. 180 IF ZAP THEN N=K:INPUT#1,NM$,C1(I),K:ZAP=0:GOTO 200
  20. 190 INPUT#1,N,NM$,C1(I),K
  21. 200 IF K<>I+1 THEN C2(I)=K ELSE C2(I)=0:ZAP=-1
  22. 210 IF C1(I)<>255 THEN NM$(C1(I))=NM$ ELSE NM$(C2(I)-128)=NM$
  23. 220 PRINT".";
  24. 230 NEXT
  25. 240 CLOSE
  26. 250 PRINT
  27. 260 INPUT "File to read";F$
  28. 270 FOR I=1 TO LEN(F$)
  29. 280 IF ASC(MID$(F$,I,1))>96 AND ASC(MID$(F$,I,1))<123 THEN MID$(F$,I,1)=CHR$(ASC(MID$(F$,I,1)) AND NOT 32)
  30. 290 NEXT
  31. 300 INPUT "Record # (<cr> for 1)";RN
  32. 310 IF RN=0 THEN RN=1
  33. 320 OPEN "R",1,F$
  34. 330 FIELD#1,128 AS B$
  35. 340 GET#1,RN
  36. 350 IF EOF(1) THEN PRINT"File not found":CLOSE:KILL F$:GOTO 260
  37. 360 E$=INPUT$(1,#1)
  38. 370 E$=INPUT$(1,#1)
  39. 380 E1=ASC(E$)
  40. 390 E$=INPUT$(1,#1)
  41. 400 IF E$=CHR$(0) AND E1=0 THEN CLOSE:GOTO 260
  42. 410 E$=INPUT$(1,#1)
  43. 420 E1=ASC(E$)
  44. 430 E$=INPUT$(1,#1)
  45. 440 E2=ASC(E$)
  46. 450 PRINT E1+256*E2;
  47. 460 E$=INPUT$(1,#1)
  48. 470 IF HEXCODE=2 THEN N=ASC(E$):HEXCODE=1:GOTO 630 ELSE IF HEXCODE=1 THEN PRINT HEX$(256*ASC(E$)+N);:HEXCODE=0:GOTO 630
  49. 480 IF N2CODE=2 THEN N=ASC(E$):N2CODE=1:GOTO 630 ELSE IF N2CODE=1 THEN PRINT 256*ASC(E$)+N;:N2CODE=0:GOTO 630
  50. 490 IF NUMCODE THEN PRINT ASC(E$);:NUMCODE=0:GOTO 630
  51. 500 IF COLON THEN IF ASC(E$)=162 THEN PRINT NM$(58);:COLON=0:GOTO 630 ELSE PRINT":";:COLON=0
  52. 510 IF E$=CHR$(0) THEN 640
  53. 520 IF ASC(E$)=12 THEN PRINT"&H";:HEXCODE=2:GOTO 630
  54. 530 IF ASC(E$)=14 OR ASC(E$)=28 THEN N2CODE=2:GOTO 630
  55. 540 IF ASC(E$)=15 THEN NUMCODE=-1:GOTO 630
  56. 550 IF ASC(E$)>16 AND ASC(E$)<27 THEN PRINT ASC(E$)-17;:GOTO 630
  57. 560 IF ASC(E$)=29 THEN GOSUB 660:GOTO 630
  58. 570 IF E$=":" THEN COLON=-1:GOTO 630
  59. 580 IF ASC(E$)>31 AND ASC(E$)<127 THEN PRINT E$;:GOTO 630
  60. 590 IF FFCODE THEN PRINT NM$(ASC(E$)-128);:FFCODE=0:GOTO 630
  61. 600 IF E$=CHR$(180) THEN PRINT"WHILE";:E$=INPUT$(1,#1):GOTO 630
  62. 610 IF E$<>CHR$(255) THEN PRINT NM$(ASC(E$));:GOTO 630
  63. 620 FFCODE=-1
  64. 630 GOTO 460
  65. 640 PRINT
  66. 650 GOTO 370
  67. 660 REM single precision
  68. 670 DEFSNG N
  69. 680 FOR I=1 TO 4
  70. 690 E$=INPUT$(1,#1)
  71. 700 N(I)=ASC(E$)
  72. 710 NEXT
  73. 720 EX=N(4)-129
  74. 730 NB=2^EX*(1+2^(-7)*(N(3) AND 127)+2^(-15)*N(2)+2^(-31)*N(1))
  75. 740 IF (N(3) AND 128) THEN NB=-NB
  76. 750 PRINT NB;
  77. 760 RETURN
  78. 770 REM ERRORS
  79. 780 'PRINT CHR$(7)"["ERR"/"ERL"]";
  80. 790 IF ERR=62 AND E$=CHR$(15) THEN PRINT"26";:NUMCODE=0:RESUME
  81. 800 IF ERR=50 THEN RN=RN+1:GET#1,RN:RESUME
  82. 810 IF ERR=62 THEN E$=CHR$(26):RESUME NEXT
  83. 820 IF ERR=53 AND ERL=160 THEN PRINT"BCODE.DAT not on disk: program aborted":END
  84. 830 PRINT:PRINT"ERROR"ERR"IN LINE"ERL:STOP
  85.