home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / snug / CONVERT.TXT < prev    next >
Text File  |  2006-10-19  |  8KB  |  198 lines
  1. 100 REM Base Conversion Program
  2. 101 REM By Walid Maalouli
  3. 102 REM August 2004
  4. 103 PRINT "CTL +: B=BIN D=DEC H=HEX T=2's Comp F=FLT R=RDX C=CLR":PAUSE
  5. 110 N=0:N$="":BASE$="DEC":DIM BN$(16)
  6. 111 FOR C=1 TO 6:READ HX$(C):NEXT C
  7. 112 FOR C=0 TO 15:READ BN$(C):NEXT C
  8. 120 DISPLAY ERASE ALL,BASE$;": ";N
  9. 130 CALL KEY(K,S)
  10. 140 IF S=0 THEN 130
  11. 150 IF K=2 AND BASE$="DEC"THEN GOSUB 1500:GOTO 130
  12. 151 IF K=2 AND BASE$="HEX"THEN GOSUB 2500:GOTO 130
  13. 152 IF K=4 AND BASE$="HEX"THEN GOSUB 1000:GOTO 130
  14. 153 IF K=4 AND BASE$="BIN"THEN GOSUB 2000:GOTO 130
  15. 154 IF K=4 AND BASE$="FLT"THEN GOSUB 4500:GOTO 130
  16. 155 IF K=8 AND BASE$="DEC"THEN GOSUB 500:GOTO 130
  17. 160 IF K=8 AND BASE$="BIN"THEN GOSUB 3000:GOTO 130
  18. 161 IF K=6 AND BASE$="RDX"THEN DPFLAG=0:GOSUB 3500:GOTO 130
  19. 162 IF K=6 AND BASE$="DEC"THEN DPFLAG=0:GOSUB 5000:GOTO 130
  20. 163 IF K=18 AND BASE$="FLT"THEN GOSUB 4000:GOTO 130
  21. 164 IF K=3 AND BASE$="FLT"THEN DISPLAY AT(1),BASE$;":  ";"0.0" ELSE 166
  22. 165 N=0:N$="":GOTO 130
  23. 166 IF K=3 THEN N$="":N=0:DISPLAY ERASE ALL,BASE$;": ";N:GOTO 130
  24. 167 IF K=20 AND (BASE$="HEX"OR BASE$="BIN")THEN GOSUB 5500:GOTO 130
  25. 170 IF BASE$="HEX"AND ((K<97 OR K>102)AND (K<48 OR K>57))THEN 130
  26. 175 IF BASE$="HEX"AND LEN(N$)=6 THEN 130
  27. 176 IF K=45 AND N$=""AND (BASE$="DEC"OR BASE$="FLT")THEN 210
  28. 180 IF BASE$="DEC"AND (K<48 OR K>57)THEN 130
  29. 190 IF BASE$="BIN"AND ((K<48 OR K>49)OR LEN(N$)=24)THEN 130
  30. 200 IF BASE$="FLT"AND (K<48 OR K>57)AND K<>46 THEN 130
  31. 201 IF BASE$="RDX"AND ((K<97 OR K>102)AND (K<48 OR K>57))THEN 130
  32. 202 IF BASE$="RDX"AND LEN(N$)>16 THEN 130
  33. 205 IF K=46 THEN IF DPFLAG=1 THEN 130 ELSE DPFLAG=1
  34. 210 N$=N$&CHR$(K)
  35. 211 IF N$="-"OR N$="."THEN 220
  36. 215 IF BASE$="DEC"THEN N=VAL(N$)
  37. 220 DISPLAY ERASE ALL,BASE$;":  ";N$
  38. 230 GOTO 130
  39. 490 DATA "A","B","C","D","E","F"
  40. 495 DATA "0000","0001","0010","0011","0100","0101","0110"
  41. 496 DATA "0111","1000","1001","1010","1011","1100","1101","1110","1111"
  42. 500 REM Dec to Hex Routine
  43. 501 FLAG=0
  44. 505 IF N$=""THEN BASE$="HEX":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
  45. 510 IF BASE$="HEX"THEN RETURN
  46. 520 IF BASE$="BIN"THEN GOSUB 2000
  47. 521 N1=N
  48. 525 IF ABS(N)>=16777216 THEN DISPLAY AT(1),"Overflow!":PAUSE ELSE 527
  49. 526 DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
  50. 527 IF N<0 THEN NFLAG=1:N$=SEG$(N$,2,LEN(N$)-1)
  51. 530 RESTORE 900
  52. 540 IF N$=""THEN N=0 ELSE N=VAL(N$)
  53. 545 READ HB
  54. 546 N$=""
  55. 560 IF N>=HB THEN RETURN
  56. 570 FOR C=1 TO 6:READ HB
  57. 580 IF N<HB AND FLAG=0 THEN 620
  58. 581 IF N<HB THEN N$=N$&"0":GOTO 620
  59. 585 FLAG=1
  60. 590 I=INT(N/HB)
  61. 600 IF I<10 THEN N$=N$&STR$(I) ELSE N$=N$&HX$(I-9)
  62. 610 N=N-(I*HB)
  63. 620 NEXT C
  64. 625 N=N1
  65. 645 IF K=2 THEN GOSUB 2500:RETURN
  66. 646 IF K=8 AND NFLAG=1 THEN 647 ELSE 650
  67. 647 CFLAG=1:GOSUB 2500:GOSUB 3000
  68. 650 IF CFLAG=1 THEN 660 ELSE BASE$="HEX":DISPLAY ERASE ALL,BASE$;":  ";N$
  69. 660 RETURN
  70. 900 DATA 16777216,1048576,65536,4096,256,16,1
  71. 1000 REM Hex to Dec Routine
  72. 1010 IF N$=""THEN BASE$="DEC":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
  73. 1020 IF (SEG$(N$,1,1)="f"OR SEG$(N$,1,1)="F")AND LEN(N$)=6 THEN 1030 ELSE 1040
  74. 1030 NFLAG=1:DNEG=1:CFLAG=1:GOSUB 2500:GOSUB 3000:CFLAG=0
  75. 1040 T=0
  76. 1050 IF DNEG=1 THEN N1$="-" ELSE N1$=""
  77. 1060 FOR C=1 TO LEN(N$)
  78. 1070 H$=SEG$(N$,C,1):IF ASC(H$)<58 THEN D=VAL(H$):GOTO 1100
  79. 1075 IF ASC(H$)>70 THEN H$=CHR$(ASC(H$)-32)
  80. 1080 FOR I=1 TO 6
  81. 1090 IF HX$(I)=H$THEN D=I+9:GOTO 1100 ELSE NEXT I
  82. 1100 T=T+D*16^(LEN(N$)-C):NEXT C
  83. 1110 IF DNEG=1 THEN N=-T ELSE N=T
  84. 1120 N$=N1$&STR$(T):DNEG=0
  85. 1130 IF CFLAG=1 THEN 1140 ELSE BASE$="DEC":DISPLAY ERASE ALL,BASE$;":  ";N$
  86. 1140 RETURN
  87. 1500 REM Dec to Bin Routine
  88. 1505 IF N$=""THEN BASE$="BIN":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
  89. 1510 GOSUB 500:RETURN
  90. 2000 REM Bin to Dec Routine
  91. 2010 IF N$=""THEN BASE$="DEC":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
  92. 2020 CFLAG=1:GOSUB 3000:CFLAG=0:GOSUB 1000:RETURN
  93. 2500 REM Hex to Bin Routine
  94. 2501 IF N$=""THEN BASE$="BIN":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
  95. 2505 N1$=""
  96. 2510 FOR C=1 TO LEN(N$)
  97. 2520 HN$=SEG$(N$,C,1)
  98. 2530 IF ASC(HN$)<58 THEN HN=VAL(HN$):GOTO 2550
  99. 2540 IF ASC(HN$)<97 THEN HN=ASC(HN$)-55 ELSE HN=ASC(HN$)-87
  100. 2550 N1$=N1$&BN$(HN)
  101. 2560 NEXT C
  102. 2570 IF NFLAG=1 THEN NFLAG=0:GOTO 2585
  103. 2575 IF CFLAG=1 THEN N$=N1$:RETURN
  104. 2580 N$=N1$:BASE$="BIN":DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
  105. 2585 N$=""
  106. 2590 FOR C=1 TO 24-LEN(N1$)
  107. 2600 N$=N$&"0":NEXT C
  108. 2610 N1$=N$&N1$:N$=""
  109. 2620 FOR C=1 TO LEN(N1$)
  110. 2720 B$=SEG$(N1$,C,1)
  111. 2730 IF B$="1"THEN B$="0" ELSE B$="1"
  112. 2740 N$=N$&B$
  113. 2750 NEXT C
  114. 2760 IF B$="0"THEN N$=SEG$(N$,1,23)&"1":N1$=N$:GOTO 2820
  115. 2765 N1$="":CARRY=1
  116. 2770 FOR C=24 TO 1 STEP -1
  117. 2780 B$=SEG$(N$,C,1)
  118. 2790 IF B$="1"AND CARRY=1 THEN B$="0":GOTO 2810
  119. 2800 IF B$="0"AND CARRY=1 THEN B$="1":CARRY=0
  120. 2810 N1$=B$&N1$:NEXT C
  121. 2820 IF CFLAG=1 THEN N$=N1$:RETURN ELSE 2580
  122. 3000 REM BIN to HEX Routine
  123. 3001 IF N$=""THEN BASE$="HEX":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
  124. 3005 N1$="":IF LEN(N$)<24 THEN N$=RPT$("0",24-LEN(N$))&N$
  125. 3010 FOR C=1 TO 24 STEP 4
  126. 3020 B$=SEG$(N$,C,4)
  127. 3030 FOR I=0 TO 15
  128. 3040 IF BN$(I)=B$THEN 3050 ELSE NEXT I
  129. 3050 IF I<10 THEN N1$=N1$&STR$(I) ELSE N1$=N1$&HX$(I-9)
  130. 3055 T$=N1$
  131. 3060 NEXT C
  132. 3061 FOR C=1 TO 6:B$=SEG$(T$,C,1)
  133. 3062 IF B$="0"THEN N1$=SEG$(T$,C+1,6-C) ELSE 3065
  134. 3063 NEXT C
  135. 3065 N$=N1$:IF CFLAG=1 THEN RETURN
  136. 3070 BASE$="HEX":DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
  137. 3500 REM RDX to FLT Routine
  138. 3505 N1$="":NEGRDX=0:FRACT$=""
  139. 3510 IF SEG$(N$,1,1)=">"THEN 3520 ELSE 3530
  140. 3520 FOR C=1 TO 22 STEP 3:N1$=N1$&SEG$(N$,C+1,2):NEXT C:N$=N1$
  141. 3530 IF ASC(SEG$(N$,1,1))>57 THEN NFLAG=1:NEGRDX=1
  142. 3540 PREFIX$=SEG$(N$,1,4):N2$=N$:CFLAG=1
  143. 3550 IF NFLAG=1 THEN K=8:N$=PREFIX$:GOSUB 646:PREFIX$=SEG$(N$,3,4)
  144. 3560 N$=SEG$(PREFIX$,1,2):GOSUB 1000:MULT=VAL(N$)
  145. 3570 N$=SEG$(PREFIX$,3,2):GOSUB 1000:INTEG$=N$
  146. 3580 FOR X=5 TO 15 STEP 2:N$=SEG$(N2$,X,2):GOSUB 1000:FRACT$=FRACT$&N$:NEXT X
  147. 3590 N=VAL(INTEG$&"."&FRACT$)*(100^(MULT-64)):CFLAG=0
  148. 3595 N$=STR$(N):IF SEG$(N$,1,1)="."THEN N$="0"&N$
  149. 3600 IF NEGRDX=1 THEN N=-1*N:N$="-"&N$
  150. 3610 BASE$="FLT":DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
  151. 4000 REM FLT to RDX Routine
  152. 4005 NEGFLT=0
  153. 4010 IF N$=""THEN BASE$="RDX":DISPLAY AT(1),BASE$;":  ";RPT$(">00",8):RETURN
  154. 4020 IF SEG$(N$,1,1)="."THEN N$="0"&SEG$(N$,1,LEN(N$)-1)
  155. 4025 N1=VAL(N$)
  156. 4030 IF SEG$(N$,1,1)="-"THEN NEGFLT=1:N$=SEG$(N$,2,LEN(N$)-1)
  157. 4040 IF LEN(N$)>15 THEN 4050 ELSE 4070
  158. 4050 DISPLAY AT(1),"Overflow!":PAUSE:DISPLAY ERASE ALL,BASE$;":  ";N$
  159. 4055 RETURN
  160. 4070 P=0:N1$="":ZFLAG=0:P1=POS(N$,".",1):IF P1=0 THEN 4075 ELSE 4079
  161. 4075 DISPLAY AT(1),"Not a float number!":PAUSE
  162. 4076 DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
  163. 4079 IF LEN(N$)<15 THEN N$=N$&RPT$("0",15-LEN(N$))
  164. 4080 IF SEG$(N$,1,1)="0"THEN C=3:ZFLAG=1:P=P-1:GOTO 4090 ELSE 4100
  165. 4090 IF SEG$(N$,C,1)="0"THEN P=P-1:C=C+1:GOTO 4090 ELSE 4110
  166. 4100 IF SEG$(N$,2,1)<>"."AND P1<>3 THEN P=P1-2 ELSE P=0
  167. 4110 IF INT(P/2)<>P/2 THEN P=P-1
  168. 4120 D=P/2:R$=STR$(64+D)
  169. 4130 N2$=N$:N$=R$:CFLAG=1:GOSUB 500:N1$=N$:N$=N2$
  170. 4135 IF ZFLAG=1 THEN P2=P1-P ELSE P2=P1-P-1
  171. 4140 N$=SEG$(N$,1,P1-1)&SEG$(N$,P1+1,LEN(N$)-P1):N2$=N$
  172. 4145 IF P1<P2 THEN P2=P2-1
  173. 4160 IF P2=1 THEN R$=SEG$(N$,1,1) ELSE R$=SEG$(N$,P2-1,2)
  174. 4170 N$=R$:GOSUB 500:IF LEN(N$)=1 THEN N$="0"&N$
  175. 4175 N1$=N1$&N$
  176. 4180 IF NEGFLT=1 THEN NFLAG=1:N$=N1$:GOSUB 2500:GOSUB 3000:N1$=SEG$(N$,3,4)
  177. 4195 N1$=">"&N1$:N1$=SEG$(N1$,1,3)&">"&SEG$(N1$,4,2)
  178. 4200 FOR L=P2+1 TO 14 STEP 2
  179. 4205 IF L>=14 THEN 4225
  180. 4210 R$=SEG$(N2$,L,2):N$=R$:IF R$="00"THEN 4220 ELSE GOSUB 500
  181. 4220 N1$=N1$&">"&N$:N$=N2$
  182. 4225 NEXT L
  183. 4226 N=N1
  184. 4227 N$=N1$:IF LEN(N$)<24 THEN N$=N$&">00"
  185. 4230 CFLAG=0:BASE$="RDX":DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
  186. 4500 REM FLT to DEC Routine
  187. 4510 IF N$=""THEN BASE$="DEC":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
  188. 4520 N=VAL(N$):N$=STR$(INT(N))
  189. 4530 BASE$="DEC":DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
  190. 5000 REM DEC to FLT Routine
  191. 5010 IF N$=""THEN BASE$="FLT":DISPLAY ERASE ALL,BASE$;":  ";"0.0":RETURN
  192. 5020 IF LEN(N$)>12 THEN 4050
  193. 5030 N$=N$&".0":N=VAL(N$):BASE$="FLT"
  194. 5040 DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
  195. 5500 REM Two's Complement Routine
  196. 5510 IF BASE$="BIN"THEN NFLAG=1:N1$=N$:GOSUB 2570:RETURN
  197. 5520 NFLAG=1:CFLAG=1:GOSUB 2500:CFLAG=0:GOSUB 3000:RETURN
  198.