home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / calculat / baseconv.lbr / BASECONV.BZS / BASECONV.BAS
BASIC Source File  |  1988-01-24  |  4KB  |  98 lines
  1. 10 REM **  BASECON.BAS  ORIGINAL AUTHOR UNKNOWN     **
  2. 20 REM **  MODIFIED FOR CP/M 2.2  MONTEZUMA MICRO   **
  3. 30 REM **              MBASIC 5.XX                  **
  4. 40 REM **      G. R. WOODROW  ELK CITY, OKLA        **
  5. 50 REM    ******  video control codes ' system dependant '*********
  6. 60 PRINT CHR$(26) REM **  clear screen code **
  7. 70 HI$=""        REM **  turn on hi-lighting **
  8. 80 LO$=""         REM **  turn off hi-lighting **
  9. 90 BL$=""         REM **  Bell code            **
  10. 100 REM =======================================================================
  11. 110 REM  ***** Lines 120 -250 sits up screen display  *******
  12. 120 REM  *****   X = ROW      Y = COLUMN              *******
  13. 130 X=2:Y=15:GOSUB 960
  14. 140 PRINT HI$;"Binary * * Decimal * * Hexadecimal * * Octal ";LO$
  15. 150 X=3:Y=15:GOSUB 960
  16. 160 PRINT HI$;"             * * Conversion * *              ";LO$
  17. 170 X=6:Y=8:GOSUB 960
  18. 180 PRINT "(Add the suffix B, O, D or H to the number you input)"
  19. 190 X=9:Y=10:GOSUB 960
  20. 200 PRINT "Enter number to be converted or <CR> to exit"
  21. 210 REM ** setup to print answers **
  22. 220 X=12:Y=0:GOSUB 960
  23. 230 PRINT "Hex";TAB(20)"Decimal";TAB(40)"Octal";TAB(60)"Binary"
  24. 240 X=13:Y=0:GOSUB 960:PRINT STRING$(79,95)
  25. 250 X=17:Y=0:GOSUB 960:PRINT STRING$(79,95)
  26. 260 REM ====================================================================
  27. 270 REM **** Line 280 Positions cursor and gets number to convert *****
  28. 280 X=9:Y=54:GOSUB 960:PRINT CHR$(21);BL$;:INPUT NI$
  29. 290 REM ====================================================================
  30. 300 REM *** Lines 310 - 400 checks input, exits if null, converts any lowercase letters to uppercase  ****
  31. 310 BI%=0:IF NI$="" THEN PRINT CHR$(26):END
  32. 320 IF LEN(NI$)<2 THEN 770
  33. 330 T%=LEN(NI$):X$=""
  34. 340 FOR L% = 1 TO T%
  35. 350 B$=MID$(NI$,L%,1)
  36. 360 IF ASC(B$) < 90 THEN 390
  37. 370 T = ASC(B$) - 32
  38. 380 B$= CHR$(T)
  39. 390 X$ = X$ + B$:NEXT L%
  40. 400 NI$ = X$
  41. 410 REM ====================================================================
  42. 420 REM ***** lines 430-470 checks input string for proper suffix and num value *****
  43. 430 IF ((RIGHT$(NI$,1)="B") AND (LEN(NI$) <= 9)) THEN BI%=2 : GOTO 570
  44. 440 IF ((RIGHT$(NI$,1)="O") AND (VAL(NI$) < 177778!)) THEN BI%=8 :GOTO 570
  45. 450 IF ((RIGHT$(NI$,1)="D") AND (VAL(NI$) < 65536! ))  THEN BI%=10 :GOTO 570 
  46. 460 IF ((RIGHT$(NI$,1)="H") AND (LEN(NI$) < 6 ))  THEN BI%=16:GOTO 570
  47. 470 IF RIGHT$(NI$,1) <> "B" AND RIGHT$(NI$,1) <> "D" AND RIGHT$(NI$,1) <> "O" AND RIGHT$(NI$,1) <> "H" THEN 520
  48. 480 REM ====================================================================
  49. 490 REM  **** lines 500 - 540  Error Messages    ******
  50. 500 IF BI%=0 THEN X=16:Y=0:GOSUB 960
  51. 510 PRINT CHR$(21);"Number to large !!!":GOTO 280
  52. 520 X=16:Y=0:GOSUB 960
  53. 530 PRINT CHR$(21);"Please use the indicated suffix so I know what you want -!!"
  54. 540 GOTO 280
  55. 550 REM =====================================================================
  56. 560 REM  **** lines 570 - 650 prints answers to screen  ******
  57. 570 L%=LEN(NI$)
  58. 580 NI$=LEFT$(NI$,L%-1)
  59. 590 BO%=16:GOSUB 670:X=16:Y=0:GOSUB 960:PRINT CHR$(21);NO$,
  60. 600 BO%=10:GOSUB 670:PRINT TAB(20)NO$,
  61. 610 BO%=8:GOSUB 670:PRINT TAB(40)NO$,
  62. 620 BO%=2:GOSUB 670
  63. 630 IF LEN(NO$) < 8 THEN NO$="0"+NO$:GOTO 630
  64. 640 PRINT TAB(60)NO$
  65. 650 GOTO 280
  66. 660 REM =====================================================================
  67. 670 REM  **BASE CONVERSION SUBROUTINE**
  68. 680 REM         **CONVERT TO DECIMAL**
  69. 690 L%=LEN(NI$)
  70. 700 DEC=0
  71. 710 PWR%=0
  72. 720 FOR J=L% TO 1 STEP -1
  73. 730 K%=ASC(MID$(NI$,J,1))
  74. 740 IF K%>64 THEN K%=K%-7
  75. 750 K%=K%-48
  76. 760 IF K%<BI% AND K%>-1 THEN 780
  77. 770 X=16:Y=0:GOSUB 960:PRINT CHR$(21);"INVALID INPUT ":GOTO 280
  78. 780 DEC=DEC+INT(K% * BI% ^ PWR% +.5)
  79. 790 PWR%=PWR%+1
  80. 800 NEXT J
  81. 810 REM  **CONVERT DECIMAL TO BASE**
  82. 820 H$="0123456789ABCDEF"
  83. 830 NO$=""
  84. 840 PWR%=INT(LOG(DEC)/LOG(BO%))
  85. 850 FOR J=PWR% TO 0 STEP -1
  86. 860 XX=INT(BO% ^ J + .5)
  87. 870 CH%=INT(DEC/XX)
  88. 880 NO$=NO$+MID$(H$,CH%+1,1)
  89. 890 DEC=INT(DEC - (CH% * XX) + .5)
  90. 900 NEXT J
  91. 910 RETURN
  92. 920 REM ===================================================================
  93. 930 REM ***   CURSOR POSITION ROUTINE  ***
  94. 940 REM ***   SET FOR MONTEZUMA MICRO 2.2 TRS80 MOD IV  ***
  95. 950 REM ***    CHANGE TO SUIT YOUR SYSTEM    ***
  96. 960 PRINT CHR$(27);"=";CHR$(X+32);CHR$(Y+32);
  97. 970 RETURN
  98.