home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 87 / 64er_Magazin_Sonderheft_87_19xx_Markt__Technik_de_Side_B.d64 / bas (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  10KB  |  410 lines
  1. 0 remnn this is the magic byte
  2. 1 rem start
  3. 10 ifpeek(2054)=78then50
  4. 20 ef=1:nm$="":poke53002,0:gosub12000
  5. 30 gosub11000:ifkp<>56then30
  6. 40 ef=0:gosub6090:goto4023
  7. 50 ifru=0thengosub1000
  8. 60 sys49152:sys49155:sys49173:poke53000,0
  9. 70 goto4000
  10. 1000 rem dim & fill
  11. 1005 ru=1
  12. 1010 sn=12:dimos(sn):fori=1tosn:reados(i):next
  13. 1020 data 48,55,58,81,47,54,51,52,84,46,53,49
  14. 1030 mk=54:dimok(mk):fori=1tomk:readok(i):next
  15. 1040 data 37,42,50,71,76,85,26,27,28,29,30,31
  16. 1050 data 33,35,64,68,34,65,36,73,44,78,39
  17. 1060 data 79,66,69,74,70,67,32,41,61,62,60
  18. 1070 data 38,43,72,77,59,82,256,256,75,63
  19. 1080 data 40,45,56,57,22,25,21,24,23,83
  20. 1090 dimch(16):dimco(16,5):dimcn(16,5):dimms(7)
  21. 1100 dimdi$(15):fori=0to15:readdi$(i):next
  22. 1110 data "0","1","2","3","4","5","6","7","8","9","a","b","c","d","e","f"
  23. 1120 dimoc(4,61):fori=13to61:oc(0,i)=ok(i-12):next
  24. 1121 fori=1to12:oc(0,i)=os(i):next
  25. 1130 data 38,40,43,45,46,47,48,49,51,53,54,55,56,57,58,60,61,62,66,67,69,70,72
  26. 1135 data 74,77,81,83
  27. 1140 fori=1to61
  28. 1150 ifi>27thenoc(1,i)=256:goto1170
  29. 1160 readoc(1,i)
  30. 1170 oc(2,i)=oc(1,i):oc(3,i)=oc(1,i):next
  31. 1175 oc(0,41)=256:oc(1,19)=256:oc(2,21)=256:oc(3,24)=256:oc(0,61)=83
  32. 1180 fori=1to61
  33. 1190 ifi>26thenoc(4,i)=256:goto1210
  34. 1200 readoc(4,i)
  35. 1210 next
  36. 1220 data 21,22,23,24,25,32,34,38,40,43,45,56,57,60,61,62,63,65,66,67,69
  37. 1230 data 72,74,75,77,79
  38. 1240 dimpo(10):fori=1to10:readpo(i):next
  39. 1250 data 1,1,1,1,2,2,2,3,3,0
  40. 1260 dimmx(4):mx(0)=61:mx(1)=27:mx(2)=27:mx(3)=27:mx(4)=26
  41. 1300 rem sprite
  42. 1310 poke53250,100:poke53251,81:poke53288,0:return
  43. 4000 rem organ
  44. 4010 bf=0:ef=0:sf=0:ff=255:ns=0:poke52998,0:ds=0:poke52997,0:po=0:cf=0
  45. 4015 b(0)=10:b(1)=16:b(2)=8:b(3)=2:b(4)=10
  46. 4020 x=0:bc=0:poke53002,0:poke52996,0:m=0:poke53277,3
  47. 4023 poke53269,1:poke2054,79:gosub15000
  48. 4025 bf=0
  49. 4030 gosub12000
  50. 4040 gosub10000
  51. 4045 bf=1:sk=1:gosub12000:ifns=4then4080
  52. 4050 fori=1tosn
  53. 4060 ifkp=os(i)then4380
  54. 4070 next
  55. 4080 ifnm$=""then4110
  56. 4090 cm$=nm$:ce$=ne$:gosub4310
  57. 4100 x=cm*10^ce
  58. 4110 ao=0
  59. 4115 fori=1tomk
  60. 4120 ifkp=ok(i)thenao=i:goto4145
  61. 4130 next
  62. 4140 goto4025
  63. 4145 rf=0
  64. 4150 onaogosub5000,5040,5080,5120,5160,5200,5240,5260,5280,5300
  65. 4160 ifrf<>0then4025
  66. 4170 ao=ao-10
  67. 4180 onaogosub5320,5340,5360,5380,5400,5420,5440,5460,5480,5500
  68. 4190 ifrf<>0then4025
  69. 4200 ao=ao-10
  70. 4210 onaogosub5530,5550,5570,5590,5650,5660,5670,5680,5690,5700
  71. 4220 ifrf<>0then4025
  72. 4230 ao=ao-10
  73. 4240 onaogosub5720,5750,5780,5810,5820,5830,5840,5850,5860,5910,5950
  74. 4250 ifrf<>0then4025
  75. 4260 ao=ao-11
  76. 4270 onaogosub5990,6010,6020,6050,6070,6090,6100,6110,6120,6130,6140,6150,6200
  77. 4300 goto4025
  78. 4310 if(ns=0)or(ns=4)thencm=val(cm$):ce=val(ce$):return
  79. 4320 am=1:s=0:as=0:ifleft$(cm$,1)="-"thenas=1
  80. 4323 fori=0to(len(cm$)-as-1)
  81. 4326 cd$=mid$(cm$,len(cm$)-i,1)
  82. 4330 ifcd$<="9"thencd=val(cd$):goto4350
  83. 4340 cd=asc(cd$)-55
  84. 4350 s=s+cd*am:am=am*b(ns):next
  85. 4360 cm=s:ifas=1thencm=-cm
  86. 4370 ce=0:return
  87. 4380 op=i
  88. 4390 ifop=10then4490
  89. 4400 ifop=11thengosub4530:goto4025
  90. 4410 ifop=12then4600
  91. 4415 po=op:cf=0
  92. 4420 ifch(bc)=0then4460
  93. 4430 ifnm$=""thenco(bc,ch(bc))=op:cn(bc,ch(bc))=x:gosub13000:goto4025
  94. 4440 ch(bc)=ch(bc)+1:cm$=nm$:ce$=ne$:gosub4310:x=cm*10^ce
  95. 4450 nm$="":goto4430
  96. 4460 ch(bc)=ch(bc)+1
  97. 4470 ifnm$=""then4430
  98. 4480 ch(bc)=ch(bc)-1:goto4440
  99. 4490 ifch(bc)=0thener=0/0
  100. 4510 bc=bc+1:poke53002,sgn(bc):ifbc>16thener=0/0
  101. 4520 ch(bc)=0:x=0:goto4025
  102. 4530 ifbc=0thener=0/0
  103. 4540 ifch(bc)>0then4570
  104. 4550 ifnm$<>""thencm$=nm$:ce$=ne$:gosub4310:x=cm*10^ce
  105. 4560 bc=bc-1:poke53002,sgn(bc):return
  106. 4570 ch(bc)=ch(bc)+1
  107. 4580 ifnm$<>""thencm$=nm$:ce$=ne$:gosub4310:x=cm*10^ce
  108. 4590 co(bc,ch(bc))=10:cn(bc,ch(bc))=x:gosub13000:goto4560
  109. 4600 ifbc=0then4630
  110. 4610 gosub4530
  111. 4620 nm$="":goto4600
  112. 4630 ifcf=1then4680
  113. 4635 ifpo<>0thencf=1
  114. 4640 ifnm$<>""thencm$=nm$:ce$=ne$:gosub4310:x=cm*10^ce
  115. 4650 pn=x
  116. 4660 ch(0)=ch(0)+1:co(0,ch(0))=10:cn(0,ch(0))=x:gosub13000
  117. 4670 ch(0)=0:goto4025
  118. 4680 ifpo=0then4025
  119. 4690 ifnm$<>""thencm$=nm$:ce$=ne$:gosub4310:x=cm*10^ce
  120. 4700 cn(0,1)=x:co(0,1)=po:cn(0,2)=pn:co(0,2)=10:ch(0)=2:gosub13000
  121. 4710 goto4670
  122. 5000 ifds=0thenx=x/57.2957795
  123. 5010 ifds=2thenx=x/63.6619772
  124. 5020 x=sin(x)
  125. 5030 rf=1:return
  126. 5040 ifds=0thenx=x/57.2957795
  127. 5050 ifds=2thenx=x/63.6619772
  128. 5060 x=cos(x)
  129. 5070 goto5030
  130. 5080 ifds=0thenx=x/57.2957795
  131. 5090 ifds=2thenx=x/63.6619772
  132. 5100 x=tan(x)
  133. 5110 goto5030
  134. 5120 x=atn(x/sqr(1-x*x))
  135. 5130 ifds=0thenx=x*57.2957795
  136. 5140 ifds=2thenx=x*63.6619772
  137. 5150 goto5030
  138. 5160 x=(NULL)/2-atn(x/sqr(1-x*x))
  139. 5170 ifds=0thenx=x*57.2957795
  140. 5180 ifds=2thenx=x*63.6619772
  141. 5190 goto5030
  142. 5200 x=atn(x)
  143. 5210 ifds=0thenx=x*57.2957795
  144. 5220 ifds=2thenx=x*63.6619772
  145. 5230 goto5030
  146. 5240 x=(exp(x)-exp(-x))/2
  147. 5250 goto5030
  148. 5260 x=(exp(x)+exp(-x))/2
  149. 5270 goto5030
  150. 5280 x=(exp(x)-exp(-x))/(exp(x)+exp(-x))
  151. 5290 goto5030
  152. 5300 x=log(x+sqr(x*x+1))
  153. 5310 goto5030
  154. 5320 x=log(x-sqr(x*x-1))
  155. 5330 goto5030
  156. 5340 x=.5*log((1+x)/(1-x))
  157. 5350 goto5030
  158. 5360 x=10^x
  159. 5370 goto5030
  160. 5380 x=exp(x)
  161. 5390 goto5030
  162. 5400 x=log(x)/2.30258509
  163. 5410 goto5030
  164. 5420 x=log(x)
  165. 5430 goto5030
  166. 5440 x=int(x)
  167. 5450 goto5030
  168. 5460 x=x-int(x)
  169. 5470 goto5030
  170. 5480 x=int(1000*rnd(0))/1000
  171. 5490 goto5030
  172. 5500 if(x<0)or(x<>int(x))thener=0/0
  173. 5510 if(x=0)or(x=1)thenx=1:goto5030
  174. 5520 p=1:fori=2tox:p=p*i:next:x=p:goto5030
  175. 5530 x=x*x
  176. 5540 goto5030
  177. 5550 x=sqr(x)
  178. 5560 goto5030
  179. 5570 x=1/x
  180. 5580 goto5030
  181. 5590 ifch(bc)=0then5030
  182. 5600 ifco(bc,ch(bc))=5thenx=x/100:goto5030
  183. 5610 ifco(bc,ch(bc))=6thenx=x/100:goto5030
  184. 5620 ifco(bc,ch(bc))=1thenx=cn(bc,ch(bc))*x/100:goto5030
  185. 5630 ifco(bc,ch(bc))=2thenx=cn(bc,ch(bc))*x/100:goto5030
  186. 5640 goto5030
  187. 5650 ns=1:poke52998,1:poke52999,1:goto5030
  188. 5660 ns=2:poke52998,2:poke52999,0:goto5030
  189. 5670 ns=3:poke52998,3:poke52999,0:goto5030
  190. 5680 ns=4:poke52998,4:poke52999,0:cc=4:goto5030
  191. 5690 ns=0:poke52998,0:poke52999,0:goto5030
  192. 5700 ifsf=1thensf=0:goto5030
  193. 5710 sf=1:goto5030
  194. 5720 ifds=0thends=1:poke52997,1:x=x/57.2957795:goto5030
  195. 5730 ifds=1thends=2:poke52997,2:x=x*63.6619772:goto5030
  196. 5740 ds=0:poke52997,0:x=x*.9:goto5030
  197. 5750 poke52996,1
  198. 5760 ifx=0thenpoke52996,0
  199. 5770 m=x:goto5030
  200. 5780 poke52996,1
  201. 5790 m=m+x:ifm=0thenpoke52996,0
  202. 5800 goto5030
  203. 5810 x=m:goto5030
  204. 5820 a=x:goto5030
  205. 5830 b=x:goto5030
  206. 5840 x=a:goto5030
  207. 5850 x=b:goto5030
  208. 5860 a1=sqr(a*a+b*b):b1=atn(b/a)
  209. 5870 a=a1:b=b1
  210. 5880 ifds=0thenb=b*57.2957795
  211. 5890 ifds=2thenb=b*63.6619772
  212. 5900 x=a:goto5030
  213. 5910 ifds=0thenb=b/57.2957795
  214. 5920 ifds=2thenb=b/63.6619772
  215. 5930 a1=a*cos(b):b1=a*sin(b)
  216. 5940 a=a1:b=b1:x=a:goto5030
  217. 5950 tm=int(x):x=x-tm
  218. 5960 mc=int(x*60):x=x-mc/60
  219. 5970 sc=x*3600
  220. 5980 x=tm+mc/100+sc/10000:goto5030
  221. 5990 h1=int(x):m1=int((x-h1)*100):s1=int((x-h1-m1/100)*10000)
  222. 6000 x=h1+m1/60+s1/3600:goto5030
  223. 6010 x=(NULL):goto5030
  224. 6020 sk=4:gosub14000:gosub11500:ifgs=255then5030
  225. 6030 ifgs=16thenff=255:goto5030
  226. 6040 ff=gs:goto5030
  227. 6050 sk=2:gosub14000:gosub11500:if(gs=255)or(gs=16)then5030
  228. 6060 ms(gs)=x:goto5030
  229. 6070 sk=3:gosub14000:gosub11500:if(gs=255)or(gs=16)then5030
  230. 6080 x=ms(gs):goto5030
  231. 6090 poke53002,0:bc=0:ch(0)=0:po=0:x=0:cf=0:goto5030
  232. 6100 poke2054,78:poke830,255:goto1
  233. 6110 cr=a:ci=b:cc=0:goto5030
  234. 6120 cr=a:ci=b:cc=1:goto5030
  235. 6130 cr=a:ci=b:cc=2:goto5030
  236. 6140 cr=a:ci=b:cc=3:goto5030
  237. 6150 onccgoto6170,6180,6190,5030
  238. 6160 a=a+cr:b=b+ci:x=a:goto5030
  239. 6170 a=a-cr:b=b-ci:x=a:goto5030
  240. 6180 c1=a*cr-b*ci:c2=a*ci+b*cr:a=c1:b=c2:x=a:goto5030
  241. 6190 c1=(cr*a+ci*b)/(a*a+b*b):c2=(a*ci-cr*b)/(a*a+b*b):a=c1:b=c2:x=a:goto5030
  242. 6200 x=not(x):goto5030
  243. 10000 rem getnum;ns in
  244. 10005 np=0:nd=0:nm$="":ne$=""
  245. 10020 gosub11000
  246. 10030 ifkp>b(ns)-1then10060
  247. 10040 iflen(nm$)=9+np+ndthen10020
  248. 10045 ifnm$="0"thennm$=di$(kp):goto10020
  249. 10050 nm$=nm$+di$(kp):goto10020
  250. 10060 if(kp<>16)or(ns=1)or(ns=2)or(ns=3)then10100
  251. 10070 ifnm$=""thennm$="0.":nd=1:goto10020
  252. 10080 if(nd=0)and(len(nm$)-np<9)thennm$=nm$+".":nd=1:goto10020
  253. 10090 goto10020
  254. 10100 ifkp<>17then10140
  255. 10110 if(nm$="")or(nm$="0")or(nm$="0.")then10020
  256. 10120 ifnp=1thennm$=right$(nm$,len(nm$)-1):np=0:goto10020
  257. 10130 np=1:nm$="-"+nm$:goto10020
  258. 10140 ifkp<>18then10190
  259. 10150 if(len(nm$)<2+np)thennm$="0":np=0:goto10020
  260. 10160 if(right$(nm$,1)=".")and(len(nm$)=2+np)thennm$="0":np=0:nd=0:goto10020
  261. 10170 ifright$(nm$,1)="."thennm$=left$(nm$,len(nm$)-2):nd=0:goto10020
  262. 10180 nm$=left$(nm$,len(nm$)-1):goto10020
  263. 10190 ifkp<>19then10210
  264. 10200 goto10370
  265. 10210 if(kp<>20)or(ns=1)or(ns=2)or(ns=3)then10380
  266. 10215 ifval(nm$)=0thennm$="1":nd=0
  267. 10217 ifright$(nm$,1)="."thennm$=left$(nm$,len(nm$)-1):nd=0
  268. 10220 ne$="00":np=0
  269. 10230 gosub11000
  270. 10240 ifkp>9then10280
  271. 10250 ne$=right$(ne$,1)+di$(kp):ifne$="00"thennp=0
  272. 10260 ifnp<>0thenne$="-"+ne$
  273. 10270 goto10230
  274. 10280 ifkp<>17then10320
  275. 10290 ifne$="00"then10230
  276. 10300 ifnp=0thenne$="-"+ne$:np=1:goto10230
  277. 10310 np=0:ne$=right$(ne$,2):goto10230
  278. 10320 ifkp<>18then10360
  279. 10330 ifleft$(right$(ne$,2),1)="0"thenne$="00":np=0:goto10230
  280. 10340 ifnp=1thenne$="-0"+mid$(ne$,2,1):goto10230
  281. 10350 ne$="0"+left$(ne$,1):goto10230
  282. 10360 ifkp<>19then10380
  283. 10370 nm$="0":ne$="":np=0:nd=0:goto10020
  284. 10380 fori=1tomx(ns)
  285. 10390 ifkp=oc(ns,i)then10430
  286. 10400 next
  287. 10410 sys49155:poke830,0:ifne$=""then10020
  288. 10420 goto10230
  289. 10430 return
  290. 11000 rem getkey;nm$,ne$,kp
  291. 11010 ifnm$=""then11130
  292. 11015 fori=1tolen(nm$)
  293. 11020 poke53023+i,asc(mid$(nm$,i,1)):next
  294. 11025 poke53024+len(nm$),0
  295. 11030 ifne$=""thenpoke53040,0:goto11130
  296. 11035 fori=1tolen(ne$)
  297. 11040 poke53039+i,asc(mid$(ne$,i,1)):next
  298. 11045 poke53040+len(ne$),0
  299. 11130 poke830,0:sys49167:kp=peek(829)
  300. 11140 ifkp=255thensys49155:goto11130
  301. 11150 return
  302. 11500 rem get numberkey
  303. 11510 sys49167:kp=peek(829)
  304. 11520 ifkp>16or(kp>7andkp<16)thengs=255:return
  305. 11530 ifkp=16thengs=16:return
  306. 11540 gs=kp:return
  307. 12000 rem outnum ; ns,ef,bf,sf,ff in
  308. 12005 xm$="":xe$=""
  309. 12010 ew=0:np=0:nd=0:poke53269,1:sys49155
  310. 12020 ifef<>0thenpoke53024,64:poke830,0:return
  311. 12025 ifbf<>0thengosub12530:return
  312. 12030 if(ns<>0)and(ns<>4)then12470
  313. 12040 gosub12370
  314. 12050 ifxe<>0then12170
  315. 12060 ifsf=0then12170
  316. 12070 sm=abs(xm)
  317. 12080 ifsm<1then12130
  318. 12090 ifsm<10thenew=1:goto12170
  319. 12100 sm=sm/10:xe=xe+1
  320. 12110 ifsm<10thenxm=sm*sgn(xm):goto12170
  321. 12120 goto12100
  322. 12130 ifsm=0thenew=1:goto12170
  323. 12140 sm=sm*10:xe=xe-1
  324. 12150 ifsm>=1thenxm=sm*sgn(xm):goto12170
  325. 12160 goto12140
  326. 12170 ifff<=7then12180
  327. 12173 xm$=str$(xm):ifxm>=0thenxm$=right$(xm$,len(xm$)-1)
  328. 12176 goto12320
  329. 12180 xm=int(xm*10^ff+.5)/10^ff
  330. 12190 xm$=str$(xm):ifxm>=0thenxm$=right$(xm$,len(xm$)-1)
  331. 12195 df=0:dc=0
  332. 12200 fori=1tolen(xm$)
  333. 12210 an$=mid$(xm$,i,1)
  334. 12220 ifdf<>0thendc=dc+1
  335. 12230 ifan$="."thendf=1
  336. 12240 next
  337. 12250 ifdc>ffthenxm$=left$(xm$,len(xm$)-(dc-ff)):goto12320
  338. 12260 ifdc=ffthen12320
  339. 12270 n$=""
  340. 12280 fori=1to(ff-dc)
  341. 12290 n$=n$+"0":next
  342. 12300 ifdf=0thenn$="."+n$
  343. 12310 xm$=xm$+n$
  344. 12320 if(xe=0)and(ew=0)thenxe$="":goto12350
  345. 12330 xe$=right$("0"+right$(str$(xe),len(str$(xe))-1),2)
  346. 12340 ifxe<0thenxe$="-"+xe$
  347. 12350 ifleft$(xm$,1)="."thenxm$="0"+xm$
  348. 12351 ifleft$(xm$,2)="-."thenxm$="-0"+right$(xm$,len(xm$)-1)
  349. 12352 np=0:nd=0
  350. 12353 ifxm<0thennp=1
  351. 12354 fori=1tolen(xm$):ifmid$(xm$,i,1)="."thennd=1
  352. 12355 next
  353. 12356 iflen(xm$)>9+np+ndthenxm$=left$(xm$,9+np+nd)
  354. 12357 ifright$(xm$,1)="."thenxm$=left$(xm$,len(xm$)-1)
  355. 12359 gosub12530
  356. 12360 return
  357. 12370 x$=right$(str$(x),len(str$(x))-1):ifx<0thenx$="-"+x$
  358. 12380 im$="":ie$=""
  359. 12390 fori=1tolen(x$)
  360. 12400 an$=mid$(x$,i,1)
  361. 12410 ifan$="e"then12440
  362. 12420 im$=im$+an$:next
  363. 12430 xm=val(im$):xe=0:return
  364. 12440 xm=val(im$)
  365. 12450 ie$=right$(x$,len(x$)-i):xe=val(ie$)
  366. 12460 return
  367. 12470 s=int(abs(x)+.5):d=b(ns):xm$=""
  368. 12480 dv=s/d:ma=s-int(dv)*d:xm$=di$(ma)+xm$:s=int(dv)
  369. 12490 ifs<>0then12480
  370. 12500 iflen(xm$)>9thener=0/0
  371. 12510 ifx<0thenxm$="-"+xm$
  372. 12520 goto12350
  373. 12530 ifxm$=""thenpoke53024,0:gosub14000:goto12570
  374. 12540 fori=1tolen(xm$)
  375. 12550 poke53023+i,asc(mid$(xm$,i,1)):next
  376. 12560 poke53024+len(xm$),0
  377. 12570 ifxe$=""thenpoke53040,0:goto12610
  378. 12580 fori=1tolen(xe$)
  379. 12590 poke53039+i,asc(mid$(xe$,i,1)):next
  380. 12600 poke53040+len(xe$),0
  381. 12610 poke830,0:return
  382. 13000 rem eval ; x,bc,ch(bc) in
  383. 13010 ee=0
  384. 13015 ifch(bc)=1then13130
  385. 13020 fori=1to10
  386. 13030 ifco(bc,ch(bc))=ithenap=po(i)
  387. 13040 ifco(bc,ch(bc)-1)=ithenpp=po(i)
  388. 13050 next
  389. 13060 ifap>ppthenreturn
  390. 13070 o1=cn(bc,ch(bc)-1):o2=cn(bc,ch(bc))
  391. 13080 op=co(bc,ch(bc)-1)
  392. 13090 onopgosub13150,13160,13170,13180,13190,13200,13210,13220,13230,13240
  393. 13100 cn(bc,ch(bc)-1)=rs:co(bc,ch(bc)-1)=co(bc,ch(bc))
  394. 13110 x=rs:ch(bc)=ch(bc)-1
  395. 13120 goto13015
  396. 13130 ifco(bc,1)=10thenee=1
  397. 13140 return
  398. 13150 rs=o1+o2:return
  399. 13160 rs=o1-o2:return
  400. 13170 rs=o1oro2:return
  401. 13180 rs=(o1and(noto2))or((noto1)ando2):return
  402. 13190 rs=o1*o2:return
  403. 13200 rs=o1/o2:return
  404. 13210 rs=o1ando2:return
  405. 13220 rs=o1^o2:return
  406. 13230 rs=o1^(1/o2):return
  407. 13240 return
  408. 14000 poke58361,144+sk:poke53269,3:return
  409. 15000 sys53120:print"goto1":poke631,19:poke632,13:poke198,2:return
  410.