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 >
Wrap
Commodore BASIC
|
2022-10-26
|
10KB
|
410 lines
0 remnn this is the magic byte
1 rem start
10 ifpeek(2054)=78then50
20 ef=1:nm$="":poke53002,0:gosub12000
30 gosub11000:ifkp<>56then30
40 ef=0:gosub6090:goto4023
50 ifru=0thengosub1000
60 sys49152:sys49155:sys49173:poke53000,0
70 goto4000
1000 rem dim & fill
1005 ru=1
1010 sn=12:dimos(sn):fori=1tosn:reados(i):next
1020 data 48,55,58,81,47,54,51,52,84,46,53,49
1030 mk=54:dimok(mk):fori=1tomk:readok(i):next
1040 data 37,42,50,71,76,85,26,27,28,29,30,31
1050 data 33,35,64,68,34,65,36,73,44,78,39
1060 data 79,66,69,74,70,67,32,41,61,62,60
1070 data 38,43,72,77,59,82,256,256,75,63
1080 data 40,45,56,57,22,25,21,24,23,83
1090 dimch(16):dimco(16,5):dimcn(16,5):dimms(7)
1100 dimdi$(15):fori=0to15:readdi$(i):next
1110 data "0","1","2","3","4","5","6","7","8","9","a","b","c","d","e","f"
1120 dimoc(4,61):fori=13to61:oc(0,i)=ok(i-12):next
1121 fori=1to12:oc(0,i)=os(i):next
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
1135 data 74,77,81,83
1140 fori=1to61
1150 ifi>27thenoc(1,i)=256:goto1170
1160 readoc(1,i)
1170 oc(2,i)=oc(1,i):oc(3,i)=oc(1,i):next
1175 oc(0,41)=256:oc(1,19)=256:oc(2,21)=256:oc(3,24)=256:oc(0,61)=83
1180 fori=1to61
1190 ifi>26thenoc(4,i)=256:goto1210
1200 readoc(4,i)
1210 next
1220 data 21,22,23,24,25,32,34,38,40,43,45,56,57,60,61,62,63,65,66,67,69
1230 data 72,74,75,77,79
1240 dimpo(10):fori=1to10:readpo(i):next
1250 data 1,1,1,1,2,2,2,3,3,0
1260 dimmx(4):mx(0)=61:mx(1)=27:mx(2)=27:mx(3)=27:mx(4)=26
1300 rem sprite
1310 poke53250,100:poke53251,81:poke53288,0:return
4000 rem organ
4010 bf=0:ef=0:sf=0:ff=255:ns=0:poke52998,0:ds=0:poke52997,0:po=0:cf=0
4015 b(0)=10:b(1)=16:b(2)=8:b(3)=2:b(4)=10
4020 x=0:bc=0:poke53002,0:poke52996,0:m=0:poke53277,3
4023 poke53269,1:poke2054,79:gosub15000
4025 bf=0
4030 gosub12000
4040 gosub10000
4045 bf=1:sk=1:gosub12000:ifns=4then4080
4050 fori=1tosn
4060 ifkp=os(i)then4380
4070 next
4080 ifnm$=""then4110
4090 cm$=nm$:ce$=ne$:gosub4310
4100 x=cm*10^ce
4110 ao=0
4115 fori=1tomk
4120 ifkp=ok(i)thenao=i:goto4145
4130 next
4140 goto4025
4145 rf=0
4150 onaogosub5000,5040,5080,5120,5160,5200,5240,5260,5280,5300
4160 ifrf<>0then4025
4170 ao=ao-10
4180 onaogosub5320,5340,5360,5380,5400,5420,5440,5460,5480,5500
4190 ifrf<>0then4025
4200 ao=ao-10
4210 onaogosub5530,5550,5570,5590,5650,5660,5670,5680,5690,5700
4220 ifrf<>0then4025
4230 ao=ao-10
4240 onaogosub5720,5750,5780,5810,5820,5830,5840,5850,5860,5910,5950
4250 ifrf<>0then4025
4260 ao=ao-11
4270 onaogosub5990,6010,6020,6050,6070,6090,6100,6110,6120,6130,6140,6150,6200
4300 goto4025
4310 if(ns=0)or(ns=4)thencm=val(cm$):ce=val(ce$):return
4320 am=1:s=0:as=0:ifleft$(cm$,1)="-"thenas=1
4323 fori=0to(len(cm$)-as-1)
4326 cd$=mid$(cm$,len(cm$)-i,1)
4330 ifcd$<="9"thencd=val(cd$):goto4350
4340 cd=asc(cd$)-55
4350 s=s+cd*am:am=am*b(ns):next
4360 cm=s:ifas=1thencm=-cm
4370 ce=0:return
4380 op=i
4390 ifop=10then4490
4400 ifop=11thengosub4530:goto4025
4410 ifop=12then4600
4415 po=op:cf=0
4420 ifch(bc)=0then4460
4430 ifnm$=""thenco(bc,ch(bc))=op:cn(bc,ch(bc))=x:gosub13000:goto4025
4440 ch(bc)=ch(bc)+1:cm$=nm$:ce$=ne$:gosub4310:x=cm*10^ce
4450 nm$="":goto4430
4460 ch(bc)=ch(bc)+1
4470 ifnm$=""then4430
4480 ch(bc)=ch(bc)-1:goto4440
4490 ifch(bc)=0thener=0/0
4510 bc=bc+1:poke53002,sgn(bc):ifbc>16thener=0/0
4520 ch(bc)=0:x=0:goto4025
4530 ifbc=0thener=0/0
4540 ifch(bc)>0then4570
4550 ifnm$<>""thencm$=nm$:ce$=ne$:gosub4310:x=cm*10^ce
4560 bc=bc-1:poke53002,sgn(bc):return
4570 ch(bc)=ch(bc)+1
4580 ifnm$<>""thencm$=nm$:ce$=ne$:gosub4310:x=cm*10^ce
4590 co(bc,ch(bc))=10:cn(bc,ch(bc))=x:gosub13000:goto4560
4600 ifbc=0then4630
4610 gosub4530
4620 nm$="":goto4600
4630 ifcf=1then4680
4635 ifpo<>0thencf=1
4640 ifnm$<>""thencm$=nm$:ce$=ne$:gosub4310:x=cm*10^ce
4650 pn=x
4660 ch(0)=ch(0)+1:co(0,ch(0))=10:cn(0,ch(0))=x:gosub13000
4670 ch(0)=0:goto4025
4680 ifpo=0then4025
4690 ifnm$<>""thencm$=nm$:ce$=ne$:gosub4310:x=cm*10^ce
4700 cn(0,1)=x:co(0,1)=po:cn(0,2)=pn:co(0,2)=10:ch(0)=2:gosub13000
4710 goto4670
5000 ifds=0thenx=x/57.2957795
5010 ifds=2thenx=x/63.6619772
5020 x=sin(x)
5030 rf=1:return
5040 ifds=0thenx=x/57.2957795
5050 ifds=2thenx=x/63.6619772
5060 x=cos(x)
5070 goto5030
5080 ifds=0thenx=x/57.2957795
5090 ifds=2thenx=x/63.6619772
5100 x=tan(x)
5110 goto5030
5120 x=atn(x/sqr(1-x*x))
5130 ifds=0thenx=x*57.2957795
5140 ifds=2thenx=x*63.6619772
5150 goto5030
5160 x=(NULL)/2-atn(x/sqr(1-x*x))
5170 ifds=0thenx=x*57.2957795
5180 ifds=2thenx=x*63.6619772
5190 goto5030
5200 x=atn(x)
5210 ifds=0thenx=x*57.2957795
5220 ifds=2thenx=x*63.6619772
5230 goto5030
5240 x=(exp(x)-exp(-x))/2
5250 goto5030
5260 x=(exp(x)+exp(-x))/2
5270 goto5030
5280 x=(exp(x)-exp(-x))/(exp(x)+exp(-x))
5290 goto5030
5300 x=log(x+sqr(x*x+1))
5310 goto5030
5320 x=log(x-sqr(x*x-1))
5330 goto5030
5340 x=.5*log((1+x)/(1-x))
5350 goto5030
5360 x=10^x
5370 goto5030
5380 x=exp(x)
5390 goto5030
5400 x=log(x)/2.30258509
5410 goto5030
5420 x=log(x)
5430 goto5030
5440 x=int(x)
5450 goto5030
5460 x=x-int(x)
5470 goto5030
5480 x=int(1000*rnd(0))/1000
5490 goto5030
5500 if(x<0)or(x<>int(x))thener=0/0
5510 if(x=0)or(x=1)thenx=1:goto5030
5520 p=1:fori=2tox:p=p*i:next:x=p:goto5030
5530 x=x*x
5540 goto5030
5550 x=sqr(x)
5560 goto5030
5570 x=1/x
5580 goto5030
5590 ifch(bc)=0then5030
5600 ifco(bc,ch(bc))=5thenx=x/100:goto5030
5610 ifco(bc,ch(bc))=6thenx=x/100:goto5030
5620 ifco(bc,ch(bc))=1thenx=cn(bc,ch(bc))*x/100:goto5030
5630 ifco(bc,ch(bc))=2thenx=cn(bc,ch(bc))*x/100:goto5030
5640 goto5030
5650 ns=1:poke52998,1:poke52999,1:goto5030
5660 ns=2:poke52998,2:poke52999,0:goto5030
5670 ns=3:poke52998,3:poke52999,0:goto5030
5680 ns=4:poke52998,4:poke52999,0:cc=4:goto5030
5690 ns=0:poke52998,0:poke52999,0:goto5030
5700 ifsf=1thensf=0:goto5030
5710 sf=1:goto5030
5720 ifds=0thends=1:poke52997,1:x=x/57.2957795:goto5030
5730 ifds=1thends=2:poke52997,2:x=x*63.6619772:goto5030
5740 ds=0:poke52997,0:x=x*.9:goto5030
5750 poke52996,1
5760 ifx=0thenpoke52996,0
5770 m=x:goto5030
5780 poke52996,1
5790 m=m+x:ifm=0thenpoke52996,0
5800 goto5030
5810 x=m:goto5030
5820 a=x:goto5030
5830 b=x:goto5030
5840 x=a:goto5030
5850 x=b:goto5030
5860 a1=sqr(a*a+b*b):b1=atn(b/a)
5870 a=a1:b=b1
5880 ifds=0thenb=b*57.2957795
5890 ifds=2thenb=b*63.6619772
5900 x=a:goto5030
5910 ifds=0thenb=b/57.2957795
5920 ifds=2thenb=b/63.6619772
5930 a1=a*cos(b):b1=a*sin(b)
5940 a=a1:b=b1:x=a:goto5030
5950 tm=int(x):x=x-tm
5960 mc=int(x*60):x=x-mc/60
5970 sc=x*3600
5980 x=tm+mc/100+sc/10000:goto5030
5990 h1=int(x):m1=int((x-h1)*100):s1=int((x-h1-m1/100)*10000)
6000 x=h1+m1/60+s1/3600:goto5030
6010 x=(NULL):goto5030
6020 sk=4:gosub14000:gosub11500:ifgs=255then5030
6030 ifgs=16thenff=255:goto5030
6040 ff=gs:goto5030
6050 sk=2:gosub14000:gosub11500:if(gs=255)or(gs=16)then5030
6060 ms(gs)=x:goto5030
6070 sk=3:gosub14000:gosub11500:if(gs=255)or(gs=16)then5030
6080 x=ms(gs):goto5030
6090 poke53002,0:bc=0:ch(0)=0:po=0:x=0:cf=0:goto5030
6100 poke2054,78:poke830,255:goto1
6110 cr=a:ci=b:cc=0:goto5030
6120 cr=a:ci=b:cc=1:goto5030
6130 cr=a:ci=b:cc=2:goto5030
6140 cr=a:ci=b:cc=3:goto5030
6150 onccgoto6170,6180,6190,5030
6160 a=a+cr:b=b+ci:x=a:goto5030
6170 a=a-cr:b=b-ci:x=a:goto5030
6180 c1=a*cr-b*ci:c2=a*ci+b*cr:a=c1:b=c2:x=a:goto5030
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
6200 x=not(x):goto5030
10000 rem getnum;ns in
10005 np=0:nd=0:nm$="":ne$=""
10020 gosub11000
10030 ifkp>b(ns)-1then10060
10040 iflen(nm$)=9+np+ndthen10020
10045 ifnm$="0"thennm$=di$(kp):goto10020
10050 nm$=nm$+di$(kp):goto10020
10060 if(kp<>16)or(ns=1)or(ns=2)or(ns=3)then10100
10070 ifnm$=""thennm$="0.":nd=1:goto10020
10080 if(nd=0)and(len(nm$)-np<9)thennm$=nm$+".":nd=1:goto10020
10090 goto10020
10100 ifkp<>17then10140
10110 if(nm$="")or(nm$="0")or(nm$="0.")then10020
10120 ifnp=1thennm$=right$(nm$,len(nm$)-1):np=0:goto10020
10130 np=1:nm$="-"+nm$:goto10020
10140 ifkp<>18then10190
10150 if(len(nm$)<2+np)thennm$="0":np=0:goto10020
10160 if(right$(nm$,1)=".")and(len(nm$)=2+np)thennm$="0":np=0:nd=0:goto10020
10170 ifright$(nm$,1)="."thennm$=left$(nm$,len(nm$)-2):nd=0:goto10020
10180 nm$=left$(nm$,len(nm$)-1):goto10020
10190 ifkp<>19then10210
10200 goto10370
10210 if(kp<>20)or(ns=1)or(ns=2)or(ns=3)then10380
10215 ifval(nm$)=0thennm$="1":nd=0
10217 ifright$(nm$,1)="."thennm$=left$(nm$,len(nm$)-1):nd=0
10220 ne$="00":np=0
10230 gosub11000
10240 ifkp>9then10280
10250 ne$=right$(ne$,1)+di$(kp):ifne$="00"thennp=0
10260 ifnp<>0thenne$="-"+ne$
10270 goto10230
10280 ifkp<>17then10320
10290 ifne$="00"then10230
10300 ifnp=0thenne$="-"+ne$:np=1:goto10230
10310 np=0:ne$=right$(ne$,2):goto10230
10320 ifkp<>18then10360
10330 ifleft$(right$(ne$,2),1)="0"thenne$="00":np=0:goto10230
10340 ifnp=1thenne$="-0"+mid$(ne$,2,1):goto10230
10350 ne$="0"+left$(ne$,1):goto10230
10360 ifkp<>19then10380
10370 nm$="0":ne$="":np=0:nd=0:goto10020
10380 fori=1tomx(ns)
10390 ifkp=oc(ns,i)then10430
10400 next
10410 sys49155:poke830,0:ifne$=""then10020
10420 goto10230
10430 return
11000 rem getkey;nm$,ne$,kp
11010 ifnm$=""then11130
11015 fori=1tolen(nm$)
11020 poke53023+i,asc(mid$(nm$,i,1)):next
11025 poke53024+len(nm$),0
11030 ifne$=""thenpoke53040,0:goto11130
11035 fori=1tolen(ne$)
11040 poke53039+i,asc(mid$(ne$,i,1)):next
11045 poke53040+len(ne$),0
11130 poke830,0:sys49167:kp=peek(829)
11140 ifkp=255thensys49155:goto11130
11150 return
11500 rem get numberkey
11510 sys49167:kp=peek(829)
11520 ifkp>16or(kp>7andkp<16)thengs=255:return
11530 ifkp=16thengs=16:return
11540 gs=kp:return
12000 rem outnum ; ns,ef,bf,sf,ff in
12005 xm$="":xe$=""
12010 ew=0:np=0:nd=0:poke53269,1:sys49155
12020 ifef<>0thenpoke53024,64:poke830,0:return
12025 ifbf<>0thengosub12530:return
12030 if(ns<>0)and(ns<>4)then12470
12040 gosub12370
12050 ifxe<>0then12170
12060 ifsf=0then12170
12070 sm=abs(xm)
12080 ifsm<1then12130
12090 ifsm<10thenew=1:goto12170
12100 sm=sm/10:xe=xe+1
12110 ifsm<10thenxm=sm*sgn(xm):goto12170
12120 goto12100
12130 ifsm=0thenew=1:goto12170
12140 sm=sm*10:xe=xe-1
12150 ifsm>=1thenxm=sm*sgn(xm):goto12170
12160 goto12140
12170 ifff<=7then12180
12173 xm$=str$(xm):ifxm>=0thenxm$=right$(xm$,len(xm$)-1)
12176 goto12320
12180 xm=int(xm*10^ff+.5)/10^ff
12190 xm$=str$(xm):ifxm>=0thenxm$=right$(xm$,len(xm$)-1)
12195 df=0:dc=0
12200 fori=1tolen(xm$)
12210 an$=mid$(xm$,i,1)
12220 ifdf<>0thendc=dc+1
12230 ifan$="."thendf=1
12240 next
12250 ifdc>ffthenxm$=left$(xm$,len(xm$)-(dc-ff)):goto12320
12260 ifdc=ffthen12320
12270 n$=""
12280 fori=1to(ff-dc)
12290 n$=n$+"0":next
12300 ifdf=0thenn$="."+n$
12310 xm$=xm$+n$
12320 if(xe=0)and(ew=0)thenxe$="":goto12350
12330 xe$=right$("0"+right$(str$(xe),len(str$(xe))-1),2)
12340 ifxe<0thenxe$="-"+xe$
12350 ifleft$(xm$,1)="."thenxm$="0"+xm$
12351 ifleft$(xm$,2)="-."thenxm$="-0"+right$(xm$,len(xm$)-1)
12352 np=0:nd=0
12353 ifxm<0thennp=1
12354 fori=1tolen(xm$):ifmid$(xm$,i,1)="."thennd=1
12355 next
12356 iflen(xm$)>9+np+ndthenxm$=left$(xm$,9+np+nd)
12357 ifright$(xm$,1)="."thenxm$=left$(xm$,len(xm$)-1)
12359 gosub12530
12360 return
12370 x$=right$(str$(x),len(str$(x))-1):ifx<0thenx$="-"+x$
12380 im$="":ie$=""
12390 fori=1tolen(x$)
12400 an$=mid$(x$,i,1)
12410 ifan$="e"then12440
12420 im$=im$+an$:next
12430 xm=val(im$):xe=0:return
12440 xm=val(im$)
12450 ie$=right$(x$,len(x$)-i):xe=val(ie$)
12460 return
12470 s=int(abs(x)+.5):d=b(ns):xm$=""
12480 dv=s/d:ma=s-int(dv)*d:xm$=di$(ma)+xm$:s=int(dv)
12490 ifs<>0then12480
12500 iflen(xm$)>9thener=0/0
12510 ifx<0thenxm$="-"+xm$
12520 goto12350
12530 ifxm$=""thenpoke53024,0:gosub14000:goto12570
12540 fori=1tolen(xm$)
12550 poke53023+i,asc(mid$(xm$,i,1)):next
12560 poke53024+len(xm$),0
12570 ifxe$=""thenpoke53040,0:goto12610
12580 fori=1tolen(xe$)
12590 poke53039+i,asc(mid$(xe$,i,1)):next
12600 poke53040+len(xe$),0
12610 poke830,0:return
13000 rem eval ; x,bc,ch(bc) in
13010 ee=0
13015 ifch(bc)=1then13130
13020 fori=1to10
13030 ifco(bc,ch(bc))=ithenap=po(i)
13040 ifco(bc,ch(bc)-1)=ithenpp=po(i)
13050 next
13060 ifap>ppthenreturn
13070 o1=cn(bc,ch(bc)-1):o2=cn(bc,ch(bc))
13080 op=co(bc,ch(bc)-1)
13090 onopgosub13150,13160,13170,13180,13190,13200,13210,13220,13230,13240
13100 cn(bc,ch(bc)-1)=rs:co(bc,ch(bc)-1)=co(bc,ch(bc))
13110 x=rs:ch(bc)=ch(bc)-1
13120 goto13015
13130 ifco(bc,1)=10thenee=1
13140 return
13150 rs=o1+o2:return
13160 rs=o1-o2:return
13170 rs=o1oro2:return
13180 rs=(o1and(noto2))or((noto1)ando2):return
13190 rs=o1*o2:return
13200 rs=o1/o2:return
13210 rs=o1ando2:return
13220 rs=o1^o2:return
13230 rs=o1^(1/o2):return
13240 return
14000 poke58361,144+sk:poke53269,3:return
15000 sys53120:print"goto1":poke631,19:poke632,13:poke198,2:return