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 '