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