home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 130 / 130.d81 / numcon (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1995-01-01  |  10.0 KB  |  295 lines
  1. 10 rem *** universal base converter ***
  2. 20 rem ***    version 2.0 090194    ***
  3. 30 rem ***   by michael j. gulyas   ***
  4. 40 :
  5. 50 clr:dv=peek(186):if dv<8 then dv=8
  6. 60 poke788,52:gosub 270:gosub 870
  7. 70 poke214,16:poke211,2:sys58732:printc0$s0$(0)
  8. 80 poke214,16:poke211,21:sys58732:printc0$s0$(0)
  9. 90 poke214,19:poke211,2:sys58732:printc0$s0$(1)
  10. 100 poke214,22:poke211,2:sys58732:printc0$s0$(1):x=0:y=0
  11. 110 poke214,16+y0*3:poke211,2-19*x0*(y0=0):sys58732
  12. 120 printc0$s0$(y0)nv$(3*y0-(y0=0)*(1+x0));
  13. 130 poke214,16+y*3:poke211,2-19*x*(y=0):sys58732
  14. 140 printc0$s0$(y)nv$(3*y-(y=0)*(1+x));
  15. 150 poke214,16+y*3:poke211,2-19*x*(y=0):sys58732:ct=0:y0=y:x0=x
  16. 160 gosub 460:for n=1 to 50
  17. 170 get a$:if a$="" then next:goto 160
  18. 180 n=50:next:gosub 490:if mo then mo=0:mg=0:gosub 2140
  19. 190 for n=1tolen(pc$):if a$=mid$(pc$,n,1) then co=n:n=len(pc$):next:goto 210
  20. 200 next:gosub 1180:goto 160
  21. 210 on co gosub 1140,1150,1140,1150,2330,1890
  22. 220 on co goto 110,110,110,110,160,160
  23. 230 goto 160
  24. 240 print"
  25. 250 [161] a$:[139] a$[178]"" [167] 250
  26. 260 [128]:[138]
  27. 270 [143] *** load files ***
  28. 280 [141] 500
  29. 290 [158]57812"numcon.font",dv,0:[151]780,0:[151]781,0:[151]782,224:[158]65493
  30. 300 [158]57812"numcon.obj",dv,0:[151]780,0:[151]781,0:[151]782,192:[158]65493
  31. 310 [158] ad[170]21,1
  32. 320 [153]"load":[151] 53280,11:[151] 53281,0:[151] 53265,([194](53265)[175]191)
  33. 330 [151] 56578,[194](56578)[176]3
  34. 340 [151] 56576,([194](56576)[175]252)[176]0
  35. 350 [151] 53272,([194](53272)[175]15)[176]32
  36. 360 [151] 648,200
  37. 370 [151] 53272,([194](53272)[175]240)[176]8
  38. 380 [142]
  39. 390 [143]
  40. 400 [129] i[178]0 [164] 15
  41. 410 [158]ad[170]30,8,32,22,24,32,i[170]8,1
  42. 420 [158]ad[170]30,9,31,23,23,32,i,1
  43. 430 [129] j[178]1 [164] 10:[161] a$:[139] a$[178]"" [167] [130]:[130]:[137] 400
  44. 440 j[178]10:i[178]15:[130]:[130]:[142]
  45. 450 wd$[178]"":dp[178]0:[142]
  46. 460 z[178]51200[170]40[172][194](214)[170][194](211)
  47. 470 ct[178]1[171]ct:[145] ct[170]1 [137] 490,480
  48. 480 [151] z,[194](z)[176]128:[142]
  49. 490 [151] z,[194](z)[175] 127:[142]
  50. 500 [143] *** loading screen ***
  51. 510 [141] 730
  52. 520 [151]53265,[194](53265)[176]64
  53. 530 [151] 53280,6:[151] 53281,14:[151] 53282,0:[151]53283,1:[151]53284,6
  54. 540 tb[178]7
  55. 550 [153]"loadreturn"[163]tb[170]1)"sys+++++++++++++++++++++++++
  56. 560 printtab(tb)"[158][160][146][170]                       [146][170]
  57. 570 [153][163]tb)"sysclosewait+     stopuniversal base    syswait+
  58. 580 printtab(tb)"[158][160][146][170]       [144]converter       [158][146][170]
  59. 590 [153][163]tb)"sysclosewait+                       syswait+
  60. 600 printtab(tb)"[158][160][146][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170]
  61. 610 [153][163]tb)"sysclosewait+                       syswait+
  62. 620 printtab(tb)"[158][160][146][170]  [144]version 2.0 090194   [158][146][170]
  63. 630 [153][163]tb)"sysclosewait+                       wait+
  64. 640 printtab(tb)"[158][160][146][170]  [144]by michael j. gulyas [146][158][170]
  65. 650 [153][163]tb)"sysclosewait+                       wait+
  66. 660 printtab(tb)"[158][160][146][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170]
  67. 670 [153][163]tb)"sysclosewait+                       wait+
  68. 680 printtab(tb)"[158][160][146][170]       [144]loading...      [146][158][170]
  69. 690 [153][163]tb)"sysclosewait+                       wait+
  70. 700 printtab(tb)"[158][160][146][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170][170]
  71. 710 [153][163]tb)"sysclosecloseclosecloseclosecloseclosecloseclosecloseclosecloseclosecloseclosecloseclosecloseclosecloseclosecloseclosecloseclose
  72. 720 return
  73. 730 rem *** variables ***
  74. 740 dim a,ad,a$,b,b0,b1,b%,b$,c,co,cp,ct,c0$,c1$,dp,fr,i,in
  75. 750 dim j,ln,lo,mg,mo,n,nu$,pc$,s,tb,tm,wd$,x,x0,xp,y,y0,yp,z
  76. 760 dim nv$(3),s0$(1),mg$(10)
  77. 770 rem reserved for dimming
  78. 780 s0$(0)="                 [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]"
  79. 790 s0$(1)="                                    "
  80. 800 s0$(1)=s0$(1)+"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]"
  81. 810 c0$="[158]":c1$="[129]"
  82. 820 nu$="0123456789abcdefghijklmnopqrstuvwxyz"
  83. 830 pc$="[145][157][133][136]"
  84. 840 for n=0 to 10:read mg$(n):next
  85. 850 ad=49152:s=54272
  86. 860 return
  87. 870 rem *** print screen ***
  88. 880 print"[147][151]                                        [184][188][188][188][188][188][188][188]";
  89. 890 print"[188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][185][190][146]   [153]*** [213][206][201][214][197][210][211][193][204]";
  90. 900 print" [194][193][211][197] [195][207][206][214][197][210][212][197][210] [153]***[151]   [191][181][182][182][182][182][182][182][182][182][182][182][182][182][182][182][182][182][182][182][182][182][182]";
  91. 910 print"[182][182][182][182][182][182][182][182][182][182][182][182][182][182][182][182][182][183][190][146]             [201]nstructions    [152]";
  92. 920 print"         [151][191][190][152][146]                            [152]     ";
  93. 930 print"     [151][191][190][152][146] [154]1. [197]nter [154][198][210][207][205] base in decimal.   [152]";
  94. 940 print"    [151][191][190][152][146] [154]2. [197]nter [154][212][207] base in decimal.     [152] ";
  95. 950 print"   [151][191][190][152][146] [154]3. [197]nter numeral to be converted.  [152]  ";
  96. 960 print"[151][191][190][146] [154]4.[152] [154][210]ead converted numeral at bottom[152]  [151]";
  97. 970 print"[191][190][152][146]    window.[152]                           [151][191][190][152][146]";
  98. 980 print"                                      [151][191][186][189][189][189][189][189][189][189][189]";
  99. 990 print"[189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][187]                   ";
  100. 1000 print"                      [198][210][207][205]:              [212][207]:      ";
  101. 1010 print"            [184][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][185][184][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][185]";
  102. 1020 print"  [190][152][146]                 [151][191][190][152][146]                 [151]";
  103. 1030 print"[191]  [186][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][187][186][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][187]  [184][188][188][188][188][188]";
  104. 1040 print"[188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][185]  [190][152][146]          ";
  105. 1050 print"                          [151][191]  [186][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189]";
  106. 1060 print"[189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][187]  [184][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188][188]";
  107. 1070 print"[188][188][188][188][188][188][188][188][188][185]  [190][152][146]                                 ";
  108. 1080 print"   [151][191]  [186][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][189][187]    ";
  109. 1090 print"                                    [146]";
  110. 1100 poke53280,11:poke53281,00:poke52199,160:poke56295,11
  111. 1110 poke53282,02:poke53283,03:poke53284,04
  112. 1120 sys ad+6:return
  113. 1130 rem *** cursors ***
  114. 1140 y=1-y:gosub 450:return
  115. 1150 ify=0thenx=1-x:gosub 450:return
  116. 1160 co=5:return
  117. 1170 rem
  118. 1180 rem *** handle digits ***
  119. 1190 on -1*(a$=chr$(13))-2*(a$=".")-3*(a$=chr$(20))goto 1330,1830,2010
  120. 1200 if len(wd$)=0 and a$="0" then return:rem no leading zeros
  121. 1210 if y=1 then 1260
  122. 1220 if a$<"0" or a$>"9" then 1320
  123. 1230 if len(wd$)=2 then return
  124. 1240 if wd$="" then printc0$s0$(y);
  125. 1250 wd$=wd$+a$:printa$;:return
  126. 1260 a=asc(a$)-48:if a>9 then a=a-7:if a=<9 then 1320
  127. 1270 if (a+1)>val(nv$(1)) or a<0 then 1320
  128. 1280 if len(wd$)>34 then return
  129. 1290 if val(nv$(1))=0 or val(nv$(2))=0 then 1320
  130. 1300 ifwd$=""then poke214,19:poke211,2:sys58732:printc0$s0$(1);
  131. 1310 goto 1250
  132. 1320 mg=4:gosub 2140:mo=1:return
  133. 1330 rem *** return ***
  134. 1340 if y=1 then 1430
  135. 1350 if wd$="" then return
  136. 1360 if val(wd$)>36 then 1480
  137. 1370 ifval(wd$)=0orval(wd$)=1then nv$(1+x)="":goto 1480
  138. 1380 rem ifval(wd$)=val(nv$(2-x))then 1480
  139. 1390 if wd$="" then return
  140. 1400 nv$(3*y-(y=0)*(1+x))=wd$:poke214,16:poke211,2+19*x:sys58732
  141. 1410 if x=0 then nv$(3)=""
  142. 1420 goto 450
  143. 1430 remifnv$(3)=""then poke214,19:poke211,2:sys58732:printc0$s0$(1);
  144. 1440 if wd$="0" then nv$(3)=""
  145. 1450 if nv$(3)<>"" and wd$="" then 1510
  146. 1460 if wd$="" then return
  147. 1470 nv$(3)=wd$:poke 214,19:poke211,2:sys58732:gosub 450:goto 1510
  148. 1480 poke 214,16+y*3:poke 211,2-19*x*(y=0):sys58732:printc0$s0$(y);
  149. 1490 printnv$(3*y-(y=0)*(1+x));:poke214,16+y*3:poke211,2-19*x*(y=0):sys 58732
  150. 1500 goto 450
  151. 1510 rem *** convert ***
  152. 1520 mg=1:gosub 2140:yp=peek(214):xp=peek(211):cp=peek(646)
  153. 1530 b0=val(nv$(1)):b1=val(nv$(2)):in=0:fr=0:ln=len(nv$(3))
  154. 1540 for n=1 to ln
  155. 1550 if mid$(nv$(3),n,1)="." then n=ln:next:goto 1590
  156. 1560 a=asc(mid$(nv$(3),n,1))-48:if a>9 then a=a-7
  157. 1570 if in>10000000 then 1820
  158. 1580 in=b0*in+a:next:goto 1630
  159. 1590 for n=ln to 1 step -1
  160. 1600 if mid$(nv$(3),n,1)="." then n=1:next:goto 1630
  161. 1610 a=asc(mid$(nv$(3),n,1))-48:if a>9 then a=a-7
  162. 1620 fr=(fr+a)/b0:next
  163. 1630 a$="":b$=".":n=0
  164. 1640 if fr>=1 then fr=fr-1:in=in+1:goto 1640
  165. 1650 if in=0 then a$="0":goto 1700
  166. 1660 if in=0 then 1700
  167. 1670 a=in/b1:b=int(a):a=in-b*b1:in=b
  168. 1680 a$=mid$(nu$,a+1,1)+a$
  169. 1690 goto 1660
  170. 1700 if fr=0 then 1760
  171. 1710 if fr=0 or n=9 then 1750
  172. 1720 a=fr*b1:b=int(a):fr=a-b
  173. 1730 b$=b$+mid$(nu$,b+1,1):n=n+1
  174. 1740 goto 1710
  175. 1750 a$=a$+b$
  176. 1760 poke 214,22:poke 211,2:sys58732:printc0$s0$(1)left$(a$,36):gosub 2240
  177. 1770 poke 214,yp:poke 211,xp:sys 58732
  178. 1780 mg=0:gosub 2140:return
  179. 1790 poke 214,22:poke 211,2:sys58732:printc0$s0$(1)in+fr
  180. 1800 poke 214,yp:poke 211,xp:sys 58732
  181. 1810 mg=0:goto 2140
  182. 1820 mg=2:gosub 2140:gosub 2260:mo=1:poke 214,yp:poke 211,xp:sys58732:return
  183. 1830 rem *** decimal point ***
  184. 1840 if y=0 then return
  185. 1850 if dp then return
  186. 1860 if len(wd$)>34 then return
  187. 1870 if len(wd$)=0 then poke214,19:poke211,2:sys58732:printc0$s0$(1);
  188. 1880 dp=1:wd$=wd$+a$:printa$;:return
  189. 1890 rem *** quit program ***
  190. 1900 mg=3:gosub 2140:poke 198,0:wait197,64,64:get a$
  191. 1910 if a$="y" or a$="[217]" then 1930
  192. 1920 mg=0:goto 2140
  193. 1930 mg=5:gosub 2140:poke198,0:wait197,64,64:get a$
  194. 1940 if a$="[204]" or a$="l" then gosub2810:goto 40000
  195. 1950 if a$="b" or a$="[194]" then print"[147]":gosub 2810:end:run
  196. 2010 rem *** delete ***
  197. 2020 if len(wd$)=0 then return
  198. 2030 if right$(wd$,1)="." then dp=0
  199. 2040 wd$=left$(wd$,len(wd$)-1)
  200. 2050 print"[157] [157]";:return
  201. 2060 rem *** string data ***
  202. 2070 data "[155]*** [213][206][201][214][197][210][211][193][204] [194][193][211][197] [195][207][206][214][197][210][212][197][210] [155]***32
  203. 2080 [131] "for(NULL)orking...10
  204. 2090 data "[129][207]verflow error.15
  205. 2100 [131] "for(NULL)uit!? atnre you sure? ((NULL)/(NULL))27
  206. 2110 data "[129] [198]1 [146]-[200]elp  [129] [198]7 [146]-[209]uit20
  207. 2120 [131] "def(NULL)waitfor(NULL)atnstr$(NULL)(NULL)atn(NULL) or defpeekwaitforatn(NULL)right$len17
  208. 2130 data end,end,end,end,end,end,end,end
  209. 2140 rem *** display message ***
  210. 2150 xp=peek(211):yp=peek(214):cp=peek(646)
  211. 2160 tb=20-val(right$(mg$(mg),2))/2
  212. 2170 poke214,2:poke 211,2:sys58732:prints0$(1);
  213. 2180 poke214,2:poke211,tb:sys58732:printleft$(mg$(mg),len(mg$(mg))-2);
  214. 2190 poke 214,yp:poke211,xp:sys58732:poke646,cp:return
  215. 2200 rem *** press delay ***
  216. 2210 rem *** sound f/x ***
  217. 2220 rem *** clear chip ***
  218. 2230 for n=0 to 24:poke s+n,0:next:return
  219. 2240 rem *** bell tone ***
  220. 2250 sysad+24:pokes+1,090:pokes+4,16:pokes+5,11:pokes+24,15:pokes+4,17:return
  221. 2260 rem *** buzzer ***
  222. 2270 sysad+24:pokes+1,19:pokes,200:pokes+4,32:pokes+6,240:pokes+24,15
  223. 2280 :pokes+4,33:tm=100:gosub 2290:pokes+4,32:return
  224. 2290 rem *** user-canceled delay ***
  225. 2300 poke 198,0:for i=1 to tm
  226. 2310 get a$:if a$="" then next:return
  227. 2320 i=tm:next:return
  228. 2330 rem *** help screens ***
  229. 2340 sys ad+9,0:sys ad+15,0:a=peek(53280):b=peek(53281)
  230. 2350 c=peek(646):sysad+18,1,1,0:yp=peek(214):xp=peek(211)
  231. 2360 print"[147][155]*** [213][206][201][214][197][210][211][193][204][160][194][193][211][197][160][195][207][206][214][197][210][212][197][210] [155]***"
  232. 2370 print"    [154][213][194][195] will convert any positive
  233. 2380 [153]"numerical base in the range cont2-36 to
  234. 2390 print"any other base in that range.  [213]nlike
  235. 2400 [153]"other converters you might have used,
  236. 2410 print"[154][213][194][195] will also convert the fractional
  237. 2420 [153]"part of the numeral!
  238. 2430 print"    [198]or example, what would pi:
  239. 2440 [153]"       cont3.14159265 (base ten)
  240. 2450 print"look like in hexidecimal?  [213]se the
  241. 2460 [153]"contlen(NULL)(NULL)(NULL)(NULL)(NULL)(NULL) to move to the window under
  242. 2470 print"the label [154][198][210][207][205]:.  [197]nter [154]'10' and press
  243. 2480 [153]"cont(NULL)val(NULL)(NULL)(NULL)(NULL).  (NULL)ove to the cont(NULL)(NULL): window and
  244. 2490 print"enter [154]'16'.  [206]ow move down to the long
  245. 2500 [153]"window and enter cont3.14159265.  atns soon
  246. 2510 print"as you press [154][210][197][212][213][210][206], the 64 converts
  247. 2520 [153]"and answers in the bottom window:
  248. 2530 print"      [154]3.243f6a794 (base sixteen)
  249. 2540 [141] 2760
  250. 2550 [158]ad[170]15,0
  251. 2560 [153]"loadlist*** (NULL)(NULL)right$(NULL)val(NULL)(NULL)atn(NULL)closepeekatn(NULL)valcloselen(NULL)(NULL)(NULL)val(NULL)(NULL)val(NULL) list***"
  252. 2570 [153]"cont(NULL)peeklen will convert any numeral less
  253. 2580 print"than [154]100000000 (decimal), and convert
  254. 2590 [153]"up to cont9 fractional places.  (NULL)alid key
  255. 2600 print"entries are the numbers [154]0-9 and also
  256. 2610 [153]"the letters conta-z for bases higher than
  257. 2620 print"base 10.  [211]ince a conversion from a
  258. 2630 [153]"base to the same base is trivial, cont(NULL)peeklen
  259. 2640 print"will not allow the [154][198][210][207][205] base to equal
  260. 2650 [153]"the cont(NULL)(NULL) base.
  261. 2660 print"     [211]ee the docs for more detailed
  262. 2670 [153]"instructions and an explanation of
  263. 2680 print"how to convert decimal bases.
  264. 2690 [153]"     cont(NULL)(NULL)(NULL)val: str$o not confuse the number
  265. 2700 print"one [154](1) with the 12th letter [154](l)."
  266. 2710 print"when converting bases higher than "
  267. 2720 print"[154]21.
  268. 2730 [153]"for asc1 wait-(NULL)hese screens  for asc7 wait-(NULL)uit":[141] 2760
  269. 2740 [158]ad[170]15,0:[151]53280,a:[151]53281,b:[151] 646,c:[158]ad[170]12,0
  270. 2750 [151]214,yp:[151]211,xp:[158] 58732:[158] ad[170]15,1:[142]
  271. 2760 [143] *** key press ***
  272. 2770 [153]"      *newnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewrnd"
  273. 2780 [153]"      sgnsys >>> (NULL)(NULL)val(NULL)(NULL)closeatn(NULL)(NULL)close(NULL)val(NULL) <<< waitget"
  274. 2790 [153]"      lognewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewnewwaitcos";
  275. 2800 [158]ad[170]15,1:[151] 198,0:[146]197,64,64:[161] a$:[142]
  276. 2810 [143] *** reset computer ***
  277. 2820 [151] 56578,[194](56578)[176]3
  278. 2830 [151] 56576,([194](56576)[175]252)[176]3
  279. 2840 [151] 53272,([194](53272)[175]15)[176]16
  280. 2850 [151] 648,4
  281. 2860 [151] 53272,([194](53272)[175]240)[176]4
  282. 2870 [158]ad[170]21,0:[151] 788,49
  283. 2880 [142]
  284. 10000 dv[178][194](186):[159]15,dv,15,"s0:numcon":[160]15:[148]"numcon",dv:[128]
  285. 40000 [129]i[178]0[164]21:[151]828[170]i,8[170]i:[130]
  286. 40010 [139]dv[179]8[176]dv[177]29[176]dv[178]8[167]40030
  287. 40020 a[178][194](828):b[178][194](828[170]dv[171]8):[151]828,b:[151]828[170]dv[171]8,a
  288. 40030 a$[178]"hello connect":[129]j[178]8[164]29:i[178][194](828[170]j[171]8):[139]i[178]14[167][130]
  289. 40040 [160]2:[159]2,i,2:[160]2:[139]st[167]40060
  290. 40050 [160]15:[159]15,i,15,"r0:"[170]a$[170]"="[170]a$:[132]15,er:[160]15:[139]er[178]63[167]40070
  291. 40060 [130]:[153]"load":[151]53272,23:[151]186,8:[128]
  292. 40070 q$[178][199](34):[151]646,[194](53281):[153]"load":[151]53272,23
  293. 40080 [153]"loadp(NULL)2048,0:p(NULL)44,8:p(NULL)43,1:p(NULL)56,160:p(NULL)55,0:clr:l(NULL)"q$a$q$","i
  294. 40090 [153]"run:":[151]631,13:[151]632,13:[151]198,2:[128]
  295.