100 init 110 randomize 120 emax=10 130 mapsize=11 140 dim ex(emax),ez(emax),ed(emax),edx(emax),edz(emax),et(emax) 150 dim map(mapsize,mapsize) 160 campos 1,40*mapsize/2+20,-270,-85 170 camrot 1,pi/4,0,0 180 stage=1 190 call initmap(1) 200 call initplayer 210 rem ####################### main 220 label main 230 call moveen 240 call movepl 250 call checkcatch 260 call checktouch(ret) 270 !locate 0,0 280 !print pd,pd0,sd 290 if ret=1 then end 300 fsync 1 310 goto *main 320 rem ###################### touch 330 sub checktouch(ret) 340 r=collision(1,51,50+enum) 350 if r>0 and et(r-50)=0 then 360 ret=1 370 else 380 ret=0 390 end if 400 end sub 410 rem ###################### catch 420 sub checkcatch 430 cc=collision(1,3,4) 440 if cc>0 then 450 if cc=3 then 460 modoff 3 470 call getrndpos(x,z) 480 modpos 4,x,0,z 490 moddisp 4 500 elseif cc=4 then 510 modoff 4 520 stage=stage+1 530 call initmap(stage) 540 end if 550 end if 560 end sub 570 rem ################# move-pl 580 sub movepl 590 if sd>0 then 600 select case sd 610 case 1 620 sz=sz+sv 630 case 2 640 sz=sz-sv 650 case 3 660 sx=sx-sv 670 case 4 680 sx=sx+sv 690 end select 700 modpos 2,sx,0,sz 710 if sx<40 or sz<40 or sx>440 or sz>440 then 720 modoff 2 730 sd=0 740 else 750 ec=collision(2,51,50+enum) 760 if ec>0 then 770 if et(ec-50)=0 then 780 et(ec-50)=60 790 modoff 2 800 sd=0 810 end if 820 end if 830 end if 840 end if 850 if pd>0 then 860 px0=pdx-px 870 pz0=pdz-pz 880 select case pd 890 case 1 900 pz=pz+pv 910 case 2 920 pz=pz-pv 930 case 3 940 px=px-pv 950 case 4 960 px=px+pv 970 end select 980 px1=pdx-px 990 pz1=pdz-pz 1000 if px1*px0<=0 and pz1*pz0<=0 then 1010 px=pdx 1020 pz=pdz 1030 pd=0 1040 end if 1050 modpos 1,px,0,pz 1060 end if 1070 xx=pad(1,14)-127 1080 zz=pad(1,13)-127 1090 if pd=0 then 1100 !if pd=0 and abs(xx)>30 and abs(zz)>30 then 1110 pdx=px 1120 pdz=pz 1130 if abs(zz)>abs(xx) then xx=0 1140 if xx<-30 then 1150 pd=3 1160 pdx=px-40 1170 elseif xx>30 then 1180 pd=4 1190 pdx=px+40 1200 elseif zz<-30 then 1210 pd=1 1220 pdz=pz+40 1230 elseif zz>30 then 1240 pd=2 1250 pdz=pz-40 1260 end if 1270 if pd>0 then 1280 call getrot(pd,r) 1290 modrot 1,0,r,0 1300 pd0=pd 1310 call getmappat(pdx,pdz,m) 1320 if m>0 then 1330 pd=0 1340 pdx=px 1350 pdz=pz 1360 end if 1370 end if 1380 end if 1390 a=pad(1,6) 1400 if a>20 and a0<=20 and sd=0 then 1410 sd=pd0 1420 sx=px 1430 sz=pz 1440 modpos 2,sx,0,sz 1450 moddisp 2 1460 end if 1470 end sub 1480 rem ################# move-en 1490 sub moveen 1500 for n=1 to enum 1510 if et(n)>0 then 1520 et(n)=et(n)-0.4 1530 modpos 50+n,ex(n),et(n),ez(n) 1540 if et(n)<0 then et(n)=0 1550 elseif ed(n)>0 then 1560 ex0=edx(n)-ex(n) 1570 ez0=edz(n)-ez(n) 1580 select case ed(n) 1590 case 1 1600 ez(n)=ez(n)+ev 1610 case 2 1620 ez(n)=ez(n)-ev 1630 case 3 1640 ex(n)=ex(n)-ev 1650 case 4 1660 ex(n)=ex(n)+ev 1670 end select 1680 ex1=edx(n)-ex(n) 1690 ez1=edz(n)-ez(n) 1700 if ex1*ex0<=0 and ez1*ez0<=0 then 1710 ex(n)=edx(n) 1720 ez(n)=edz(n) 1730 ed(n)=0 1740 end if 1750 modpos 50+n,ex(n),0,ez(n) 1760 else 1770 call setnewend(n) 1780 end if 1790 next n 1800 end sub 1810 rem ################ setnewen-d 1820 sub setnewend(n) 1830 !x=40*int((ex(n)+39)/40) 1840 !ex(n)=x 1850 !z=40*int((ez(n)+39)/40) 1860 !ez(n)=z 1870 m=1 1880 do 1890 x=ex(n) 1900 z=ez(n) 1910 d=int(rnd*4)+1 1920 select case d 1930 case 1 1940 z=z+40 1950 case 2 1960 z=z-40 1970 case 3 1980 x=x-40 1990 case 4 2000 x=x+40 2010 end select 2020 call getmappat(x,z,m) 2030 loop until m=0 2040 call getrot(d,r) 2050 modrot 50+n,0,r,0 2060 edx(n)=x 2070 edz(n)=z 2080 ed(n)=d 2090 end sub 2100 rem ################# getrot 2110 sub getrot(d,r) 2120 select case d 2130 case 1 2140 r=pi 2150 case 2 2160 r=0 2170 case 3 2180 r=pi/2 2190 case 4 2200 r=pi*3/2 2210 end select 2220 end sub 2230 rem ################# getrndpos 2240 sub getrndpos(x,z) 2250 do 2260 m=1 2270 do 2280 x=(int(rnd*9)+2)*40 2290 z=(int(rnd*9)+2)*40 2300 call getmappat(x,z,m) 2310 loop until m=0 2320 xx=abs(px-x) 2330 zz=abs(pz-z) 2340 loop until xx>40 and zz>40 2350 end sub 2360 rem ################# getmappat 2370 sub getmappat(x,z,m) 2380 xx=x/40 2390 zz=z/40 2400 m=map(xx,zz) 2410 end sub 2420 rem ################# init-en 2430 sub initen 2440 ev=0.3 2450 for i=1 to emax 2460 en=50+i 2470 et(i)=0 2480 if i<=enum then 2490 do 2500 x=int(rnd*5)+6 2510 z=int(rnd*5)+6 2520 loop while map(x,z)=1 2530 ex(i)=x*40 2540 ez(i)=z*40 2550 ed(i)=int(rnd*4)+1 2560 call getrot(ed(i),r) 2570 modrot en,0,r,0 2580 modpos en,ex(i),0,ez(i) 2590 modset en,6,epat 2600 moddisp en 2610 call setnewend(i) 2620 else 2630 modoff en 2640 end if 2650 next i 2660 end sub 2670 rem ############### init-player 2680 sub initplayer 2690 px=2*40 2700 pz=2*40 2710 modset 1,6,2 2720 modpos 1,px,0,pz 2730 moddisp 1 2740 pdx=px 2750 pdz=pz 2760 pd0=2 2770 pv=2 2780 sd=0 2790 sv=5 2800 modset 2,5,2 2810 modset 3,4,8 2820 modset 4,4,1 2830 end sub 2840 rem ################# init-map 2850 sub initmap(s) 2860 px=2*40 2870 pz=2*40 2880 pd=0 2890 modpos 1,px,0,pz 2900 select case s 2910 case 1 2920 restore 3480 2930 case 2 2940 restore 3490 2950 case 3 2960 restore 3500 2970 case 4 2980 restore 3510 2990 case 5 3000 restore 3520 3010 case else 3020 restore 3530 3030 end select 3040 read epat,enum 3050 mp=mod(s,3) 3060 if mp=1 then 3070 m1=2 3080 m2=6 3090 bgcol 0,50,0 3100 elseif mp=2 then 3110 m1=3 3120 m2=8 3130 bgcol 50,50,0 3140 else 3150 m1=1 3160 m2=9 3170 bgcol 50,50,50 3180 end if 3190 k=0 3200 for i=1 to mapsize 3210 for j=1 to mapsize 3220 k=k+1 3230 if i=1 or i=mapsize or j=1 or j=mapsize then 3240 map(i,j)=1 3250 elseif mod(i,2)=1 and mod(j,2)=1 then 3260 map(i,j)=1 3270 else 3280 map(i,j)=0 3290 end if 3300 x=j*40 3310 z=i*40 3320 modset 100+k,3,m1 3330 modpos 100+k,x,40,z 3340 moddisp 100+k 3350 if map(i,j)=1 then 3360 modset 250+k,3,m2 3370 modpos 250+k,x,0,z 3380 moddisp 250+k 3390 end if 3400 next j 3410 next i 3420 call initen 3430 call getrndpos(x,z) 3440 modpos 3,x,0,z 3450 moddisp 3 3460 ch=3 3470 end sub 3480 data 7,2 3490 data 8,3 3500 data 6,3 3510 data 7,5 3520 data 9,3 3530 data 10,3