home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / mskermit / msbdm2.bas < prev    next >
BASIC Source File  |  2020-01-01  |  4KB  |  79 lines
  1. 1       'DECmate de-booing program MSBDM2.BAS
  2.  
  3. 2 DEFINT A-Z:ZRUBOUT$=CHR$(8)+" "+CHR$(8):ZESCAPE$=CHR$(27):'Sreen utility definitions B.E.
  4. 3 ZLEADIN$=ZESCAPE$+"[":ZCLEAR$=ZLEADIN$+"J":ZHOME$=ZLEADIN$+"0;0H"
  5. 4 ZDOUBLE1$=ZESCAPE$+"#3":ZDOUBLE2$=ZESCAPE$+"#4":WIDTH 255
  6. 5 ZBOLD$=ZLEADIN$+"1m":ZBLINK$=ZLEADIN$+"5m":ZSAVE$=ZESCAPE$+"7"
  7. 6 ZREVERSE$=ZLEADIN$+"7m":ZOFF$=ZLEADIN$+"0m":ZREST$=ZESCAPE$+"8"
  8. 7 ZGRAPHON$=ZESCAPE$+"(0":ZGRAPHOFF$=ZESCAPE$+"(B":ZBACKER$=ZLEADIN$+"0K"
  9. 8 ZKEYPAD$=ZESCAPE$+"=":ZBELL$=CHR$(7):ZCLRLIN$=ZLEADIN$+"2K"
  10. 9 DEF FNXY$(ZX,ZY)=ZLEADIN$+MID$(STR$(INT(ZX)),2)+";"+MID$(STR$(INT(ZY)),2)+"H":'Cursor Adressing function (ZX=Line[1..24],ZY=Column[1..80])
  11. 10 GOTO 30:'This to be modified to GOTO Start of program <===================
  12. 11 ZSTRING$="":ZORGL=ZLENGTH:PRINT ZSAVE$+ZREVERSE$+STRING$(ZORGL,95)+ZOFF$+STRING$(ZORGL,8);:'General Input-GOSUB (Input:ZLENGTH, OUTPUT:ZLENGTH,ZSTRING,ZNUMBER,ZRANDOM)
  13. 12 ZTEMP$=INKEY$:ZRANDOM=(ZRANDOM MOD 2000)+1:IF LEN(ZTEMP$)=0 THEN 12'Wait for Char
  14. 13 IF ASC(ZTEMP$)=127 OR ASC(ZTEMP$)=8 THEN 18 ELSE IF ASC(ZTEMP$)=21 THEN PRINT ZREST$+ZBACKER$;:ZLENGTH=ZORGL:GOTO 11 ELSE PRINT ZTEMP$;'RUBOUT
  15. 14 IF ASC(ZTEMP$)=3 THEN GOTO 9999 ELSE IF ZTEMP$ >= "a" THEN ZTEMP$=CHR$(ASC(ZTEMP$)-32)'Uppercase Modify GOTO xx to Control-C intercept <=====================
  16. 15 IF ASC(ZTEMP$)=13 THEN PRINT:GOTO 17'RETURN finishes
  17. 16 ZSTRING$=ZSTRING$+ZTEMP$:ZLENGTH=ZLENGTH-1:IF ZLENGTH >0 THEN 12
  18. 17 ZLENGTH=LEN(ZSTRING$):ZNUMBER=VAL(ZSTRING$): RETURN
  19. 18 IF LEN(ZSTRING$)>0 THEN ZLENGTH=ZLENGTH+1:ZSTRING$=LEFT$(ZSTRING$,(LEN(ZSTRING$)-1)):PRINT ZRUBOUT$;:GOTO 12 ELSE PRINT ZBELL$;: GOTO 12'Cleanup after RUBOUT
  20. 19 'End of VT100 definitions *****
  21.  
  22. 20      'Use this BASIC program on the CP/M side of the DECmate (with MicroSoft
  23. 21    'MBasic) to translate the MSVDM2.BOO file on your CP/M-80 disk to
  24. 22    'binary .EXE format, then from the MS-DOS side use CONVERT to transfer
  25. 23    'the result to the MS-DOS file system.  This program takes about 30
  26. 24      'minutes to run on a DECmate II with floppy disks.
  27. 25    'Bill Catchings, CU; modified for Rainbow by Bernie Eiben, DEC;
  28. 26    'modified for DECmate CP/M-80 by Charles Lasner CLA.
  29.  
  30. 30      PRINT ZHOME$+ZCLEAR$;"DECmate CP/M 4-for-3 Code Expander (de-booing) Utility Version 1.0"
  31. 40    PRINT:PRINT: N$ = CHR$(0)
  32. 50    Z = ASC("0")
  33. 60    T = ASC("~")-Z
  34. 70    DEF FNUCHR%(A$)=ASC(A$)-Z
  35. 80    PRINT "FILE-NAME to Expand : ";:ZLENGTH=13:GOSUB 11:'Get Input
  36. 90    OPEN "I",1,ZSTRING$
  37. 100    INPUT#1,F$            ' Is this the right file?
  38. 110    IF LEN(F$) > 20 THEN GOTO 900
  39. 120    OPEN "O",2,F$            ' Ouput-name from file
  40. 130    PRINT "Outputting to "+F$
  41. 200    IF EOF(1) THEN GOTO 800        ' Exit nicely on end of file.
  42. 210    INPUT#1,X$            ' Get a line.
  43. 220    Y$ = ""                ' Clear the output buffer.
  44. 230    GOTO 400
  45. 300    PRINT#2,Y$;            ' Print output buffer to file.
  46. 310    GOTO 200            ' Get another line.
  47. 400    IF LEN(X$) < 2 GOTO 300        ' Input buffer empty? (* 6 Feb 85 *)
  48. 410    A = FNUCHR%(X$)
  49. 420    IF A = T THEN GOTO 700        ' Null repeat character?
  50. 425    IF LEN(X$) < 3 GOTO 300         ' (* 6 Feb 85 *)
  51. 430    Q$=MID$(X$,2,3)            ' Get the quadruplet to decode.
  52. 440    X$=MID$(X$,5)
  53. 450    B = FNUCHR%(Q$)
  54. 460    Q$ = MID$(Q$,2)
  55. 470    C = FNUCHR%(Q$)
  56. 480    Q$ = MID$(Q$,2)
  57. 490    D = FNUCHR%(Q$)
  58. 500    Y$ = Y$ + CHR$(((A * 4) + (B \ 16)) AND 255) ' Decode the quad.
  59. 510    Y$ = Y$ + CHR$(((B * 16) + (C \ 4)) AND 255)
  60. 520    Y$ = Y$ + CHR$(((C * 64) + D) AND 255)
  61. 530    GOTO 400            ' Get another quad.
  62. 700    X$ = MID$(X$,2)            ' Expand the nulls.
  63. 710    R = FNUCHR%(X$)            ' Get the number of nulls.
  64. 715    PRINT FNXY$(6,5)+ZCLRLIN$;" Null: ",R
  65. 720    X$ = MID$(X$,2)
  66. 730    FOR I=1 TO R            ' Loop, adding nulls to string.
  67. 740    Y$ = Y$ + N$
  68. 750    NEXT
  69. 760    PRINT#2,Y$;            ' Output the nulls to the file.
  70. 770    Y$ = ""                ' Clear the output buffer.
  71. 780    GOTO 400
  72. 800    PRINT "Processing complete"
  73. 810    PRINT "Output in "+F$
  74. 820    CLOSE #1,#2
  75. 830    GOTO 9999
  76. 900    PRINT "?The FORMAT of the ",ZSTRING$," file is incorrect"
  77. 910    GOTO 820
  78. 9999    SYSTEM:END
  79.