100 'action sample.
110 cls 3:'"M0 L1-3 E4-19 B20-35
D36-43"
120 screen 0,0,1,1:priority "TSBG"
130 init"kb:3"
140 dim
cx(64),cy(64),cmx(64),cmy(64),cpt(64),cvt(64),cag(64),cdt(64)
150 dim
rd(10)
160 lc=0:ec=3:bc=19:dc=35
170
rd(0)=lc:rd(2)=ec:rd(4)=bc:rd(6)=dc:rd(8)=43
180
mx=128:my=128:mpt=8:mvt=8:md=-1:rv=0:ft=44
190
sz=min(size(0),size(1))\256:range sz,1,4
200 gload "dg1.png",1
210
bg_scale 4,4
220 bg_view (size(0)-256*sz)\2,0,256,256,sz
230 bg_load
"dm1.dat"
240 bg_border 2
250 'opengl on
260 bg_scene 0,0
270 for
i=0 to 7:sp_def i,(80+i*16,0),16,16:next
280 for i=0 to 12:sp_def
i+8,(i*16,16),16,16:next
290 sp_target 0,ec+1,dc
300 sp_target
1,ec+1,bc:sp_target 2,ec+1,bc:sp_target 3,ec+1,bc
310 sp_margin 0,2
320
sp_on 0,1
330 for i=4 to 35: sp_margin i,2:next
340 sp_put
0,(mx,my),mpt,rv:aa=0
350 if dir$("acbgm1.ogg")<>"" then play
,,"acbgm1.ogg"
360 '
370 main:
380 'put
390 sp_put 0
400 for i=1
to lc:sp_put i:next
410 for i=4 to ec:sp_put i:next
420 for i=20 to
bc:sp_put i:next
430 for i=36 to dc:sp_put i:next
440 rx=0:ry=0
450 if
mx<72 or mx>167 then rx=sgn(mx-128)
460 if my<72 or my>167 then
ry=sgn(my-128)
470 bg_roll rx,ry
480 vsync
490 '
500 'hit
510
sp_check:rc=2
520 if sp_hit(0,0)>0 then
530
kn=sp_hit(0,1):dc+=1:nn=dc:nx=cx(kn):ny=cy(kn):na=4:gosub cmake:
540
f=-(19<kn):fn=-ec*(not -f)+bc*f:rc=f*2+2:gosub ckill:
550 mvt-=1:if
mvt=0 then sp_on 0,0:ui_msg"end."
560 endif
570 for i=1 to
lc
580 if sp_hit(i,0)>0 then
590
kn=sp_hit(i,1):dc+=1:nn=dc:nx=cx(kn):ny=cy(kn):na=4:gosub
cmake:
600 if cag(kn)=3 then fn=ec:rc=2:gosub
ckill:
610 kn=i:fn=lc:rc=0:i-=1:gosub ckill:
620
endif
630 next
640 '
650 'move
660 if mvt>0 then gosub
ctrl:
670 mx+=mmx-rx
680 my+=mmy-ry
690 rc=0:max=lc+1
700
rd(1)=lc+1:rd(3)=ec+1:rd(5)=bc+1:rd(7)=dc+1
710 for i=1 to 43
720
if i>=max then rc=rc+2:i=rd(rc):max=rd(rc+1):continue
730 killf=0
740 on cag(i) gosub algo1,algo2,algo3,algo4
750 if killf or
sp_out(i) then kn=i:max-=1:fn=max:i-=1:gosub ckill: :continue
760
cx(i)+=cmx(i)-rx
770 cy(i)+=cmy(i)-ry
780 next
790 if
rnd(1)<0.01 and ec<19 then
ec+=1:nn=ec:nx=irnd(2)*256-8:ny=16:na=irnd(2)+2:gosub cmake:
800 goto
main:
810 '
820 cmake:
830 cx(nn)=nx:cy(nn)=ny
840
cmx(nn)=0:cmy(nn)=0
850 cvt(nn)=1:cag(nn)=na:cdt(nn)=0
860 select case
na
870 case 1: cpt(nn)=0:cmx(nn)=md*4
880 case 2:
cpt(nn)=1:cmx(nn)=sgn(128-nx)
890 case 3: cpt(nn)=16
900 case
4: cpt(nn)=3
910 case 5: cpt(nn)=2
920
d1=mx-nx:d2=my-ny:k=sqr(d1^2+d2^2+1)
930
cmx(nn)=d1/k:cmy(nn)=d2/k:cx(nn)+=4:cy(nn)+=4
940 end select
950 sp_put
nn,(cx(nn),cy(nn)),cpt(nn)
960 sp_on nn,1
970 return
980 '
990
ckill:
1000 cx(kn)=cx(fn):cy(kn)=cy(fn)
1010
cmx(kn)=cmx(fn):cmy(kn)=cmy(fn)
1020 cpt(kn)=cpt(fn):cvt(kn)=cvt(fn)
1030
cag(kn)=cag(fn):cdt(kn)=cdt(fn)
1040 sp_swap kn,fn
1050 sp_on fn,0
1060 select case rc
1070 case 0: lc-=1
1080 case 2: ec-=1
1090 case 4: bc-=1
1100 case 6: dc-=1
1110 end
select
1120 return
1130 '
1140 ctrl:
1150 bg_border
1-dropf*(mmx<>0):h1=sp_bghit(0,0,3):bg_border 2
1160
h2=bg_get(mx+8,my+8,0)
1170 if h2=1 then bg_put mx+8,my+8,0:ft=ft-1:if ft=0
then ui_msg"fine.":'item
1180 if strig(0)=2 and lc<3 then
lc+=1:nn=lc:nx=mx:ny=my:na=1:gosub cmake:'shot
1190 stx=stick(0)
1200 if
stx<>0 then md=stx:mpt=8-(mmy=0)*((mx+bg_map(0)) mod 8)\2:rv=(stx+1)\2
1210 if h1=0 and h2<2 then
1220
mmy=mmy+0.3:dropf=1:'drop
1230 if mmy<0 then if sp_bghit(0,0,-3)=2
then mmy=0
1240 else
1250 if dropf=1 and h2<>2 then
my=my-(my+bg_map(1)) mod 16
1260 dropf=0:mmx=stx:'on
ground
1270 mmy=stick(1):'up down
1280 if mmy<>0
then
1290 if sp_bghit(0,0,sgn(mmy)*3)<>2 and
((sp_bghit(0,0,2+(mmy+1)\2)=1) or h2=2) then
1300
mmx=0:c1=(mx+bg_map(0)) mod
16:mx=mx+(c1<8)*c1-(c1>7)*(16-c1):mpt=12+((my+bg_map(1)) mod 8)\2:rv=0
1310 else
1320 mmy=0
1330
endif
1340 endif
1350 if strig(1)=2 and h2<2 then
mmy=-4:'jump
1360 endif
1370 if sp_bghit(0,mmx,0)=2 then mmx=0
1380
return
1390 '
1400 algo1:
1410 d1=bg_get(cx(i)+7,cy(i)+7,0)
1420 if
d1=4 then bg_put cx(i)+7,cy(i)+7,0
1430 if d1>2 then killf=-1
1440
return
1450 '
1460 algo2:
1470 if sp_bghit(i,0,3)=2 then cmy(i)=0 else
cmy(i)=cmy(i)+0.3
1480 sp_margin i,7:if sp_bghit(i,cmx(i)*7,0)=2 then
cmx(i)*=-1
1490 sp_margin i,2
1500 return
1510 '
1520
algo3:
1530 if cdt(i)<0 then
1540 if rnd(1)>0.2
then
1550 d1=irnd(240)+8-cx(i)
1560
d2=irnd(200)+16-cy(i)
1570 k=sqr(d1^2+d2^2+1)
1580
cmx(i)=d1/k:cmy(i)=d2/k:cdt(i)=k
1590 else
1600
cmx(i)=0:cmy(i)=0:cdt(i)=irnd(100)+1
1610 endif
1620 endif
1630
cpt(i)=16+(cdt(i) mod 20)\4
1640 cdt(i)-=1
1650 if rnd(1)<0.002 and
bc<35 then bc+=1:nn=bc:nx=cx(i):ny=cy(i):na=5:gosub cmake:
1660
return
1670 '
1680 algo4:
1690 cdt(i)+=1
1700 if cdt(i) mod 4=0
then cpt(i)+=1
1710 if cdt(i)>19 then killf=-1
1720 return
1730
'