1 rem NETRIS for NBASIC 2 (Rev. 20.01.19)
2 rem left arrow:move left, right arrow:move right, up arrow:rotate, down arrow:soft drop
10 sf=color(0):sb=color(-1):randomize
15 if peek(36)<20 then def fn pc(x,y)=point(x,y,1) else def fn pc(x,y)=point(y,x,1)
20 color 15,10:clr 0,0,80,21:color 15,0:clr 21,0,80,4
25 print @21,35;"WELCOME...";
30 bw=16:bh=20:tr=0:tc=int((80-bw)/2):xl=tc:xr=xl+bw-1:db=0
35 read sc,sw:dim c(sc-1),x(sc*sw-1,sw-1),y(sc*sw-1,sw-1),r(bh-1):s=0
40 read c:if c>=0 then c(s)=c:for j=0 to sw-1:h=s*sw+j:for i=0 to sw-1:read x(h,i),y(h,i):next i,j:s=s+1:goto 40
45 clr tr,tc,bw,bh
50 print @23,29;"PRESS ANY KEY TO BEGIN";:print @24,32;"PRESS Q TO QUIT";
55 k$=inkey$:if k$="" then 55 else if k$="q" or k$="Q" then 7000
60 clr 21,35,10,1
65 print @23,29;"      GET READY       ";:wait 1500:poke 1999,117
100 gs=0:gl=1:print @21,0;"SCORE ";gs;:print @21,40;"LEVEL ";gl;
105 print @23,29;"   PRESS P TO PAUSE   ";
110 gosub 650:gosub 300
115 gd=1:gt=now
120 if gt+gd<now then 4000
125 k$=inkey$:if k$="" then 120
130 if k$=chr$(0,38) or instr("rRaA",k$)>0 or k$=chr$(13) then 1000
135 if k$=chr$(0,37) or k$=chr$(8) or k$="," then 2000
140 if k$=chr$(0,39) or k$="." then 3000
145 if k$=chr$(0,40) or instr("zZ ",k$)>0 then 4000
150 if k$="p" or k$="P" then 5000 else if k$="q" or k$="Q" then 7000
155 poke 1999,117:goto 120
200 gosub 350:gosub 500:if not f then x=xx:y=yy:s=ss:gosub 300:if dn gosub 600
210 gosub 300:return
300 color 15,cc:for p=0 to 3:print @y+y(s,p),x+x(s,p);" ";:next p:xx=x:yy=y:ss=s:return
350 color 15,db:for p=0 to 3:print @yy+y(ss,p),xx+x(ss,p);" ";:next p:return
400 gs=gs+pp:color 15,0:print @21,6;gs;
410 on -(gs<gl*500) goto 440:gl=gl+1:print @21,46;gl;:n=7+len(str$(gl))
420 for j=1 to 3:invert 21,40,n,1:wait 250:invert 21,40,n,1:wait 250:next j
430 gd=gd-.1:if gd<.1 then gd=.1
440 return
500 f=-1:for p=0 to 3:if fn pc(x+x(s,p),y+y(s,p))>0 then f=0 else next p
510 return
600 pp=10:r=0:y=bh-1
605 x=xl
610 if fn pc(x,y)=db then 625
615 x=x+1:if x<=xr then 610
620 r(r)=y:r=r+1
625 y=y-1:if y>=0 then 605
630 if r>0 gosub 8000 else gosub 400
650 x=int((xr-xl)/2)+xl:y=0
660 s=int(rnd(1)*sc):cc=c(s):s=s*4
670 gosub 500:if not f then pop:pop:goto 6000
680 return
1000 s=s+1:if s mod 4=0 then s=s-4
1010 gosub 200:goto 155
2000 x=x-1:gosub 200:goto 155
3000 x=x+1:gosub 200:goto 155
4000 y=y+1:dn=-1:gosub 200:dn=0:gt=now:goto 155
5000 color 15,12:print @23,23;"GAME PAUSED - PRESS P TO CONTINUE";
5010 k$=inkey$:if k$="" then 5010 else if k$="q" or k$="Q" then 7000 else if k$<>"p" and k$<>"P" then 5010
5020 color 15,0:print @23,23;"         PRESS P TO PAUSE        ";:goto 155
6000 color 15,0:clr 23,0,80,1
6010 go$=center$("GAME OVER",80)
6020 for i=1 to 2:color 15,9:print @22,0;go$;:wait 250:color 15,0:print @22,0;go$;:wait 250:next i
6030 color 15,9:print @22,0;go$;:wait 500
6040 color 15,0:print @23,29;"PRESS ANY KEY TO BEGIN";:poke 1999,117
6050 k$=inkey$:if k$="" then 6050 else if k$="q" or k$="Q" then 7000
6060 clr 22,0,80,1:clr tr,tc,bw,bh:clr 21,0,80,1
6070 print @23,29;"      GET READY       ";:wait 1500:poke1999,117:goto 100
7000 color sf,sb:cls:end
8000 t=r:r=r-1
8010 for a=0 to 15:color 15,a:for i=0 to r:clr r(i),xl,bw,1:wait 25:next i:next a
8020 for i=0 to r:y=r(i)+i
8030 yp=y-1:for x=xl to xr:color 15,fn pc(x,yp):print @y,x;" ";:next x:y=y-1:if y>0 then 8030
8040 if t<4 then pp=pp+100 else pp=pp+250
8050 next i:gosub 400:return
9000 data 7,4
9010 data 11,0,0,1,0,0,1,1,1,0,0,1,0,0,1,1,1,0,0,1,0,0,1,1,1,0,0,1,0,0,1,1,1
9020 data 14,0,1,1,1,2,1,3,1,1,0,1,1,1,2,1,3,0,1,1,1,2,1,3,1,1,0,1,1,1,2,1,3
9030 data 5,1,1,0,1,1,0,2,1,1,1,0,1,1,0,1,2,1,1,0,1,2,1,1,2,1,1,1,0,2,1,1,2
9040 data 9,1,1,0,1,2,1,0,2,1,1,1,0,1,2,2,2,1,1,0,1,2,1,2,0,1,1,1,0,1,2,0,0
9050 data 4,1,1,0,1,2,1,2,2,1,1,1,0,1,2,2,0,1,1,0,1,2,1,0,0,1,1,1,0,1,2,0,2
9060 data 1,1,1,1,0,0,0,2,1,1,1,1,0,0,1,0,2,1,1,1,0,0,0,2,1,1,1,1,0,0,1,0,2
9070 data 2,1,1,0,1,1,0,2,0,1,1,0,1,0,0,1,2,1,1,0,1,1,0,2,0,1,1,0,1,0,0,1,2
9080 data -1