WINDOW #1 OPEN:WINDOW #1 FULL:CLS #1
'
'  dimension all arrays and strings
'  and initialise variables and screen
'
   DIM arr$(8,10) :  'used in valid move logic
   DIM l(10)      :  'block lengths
   DIM h(10)      :  ' "    heights
   DIM c(10)      :  ' "    colors
   DIM x(10)      :  'x-cords
   DIM y(10)      :  'y-co-ords
   DIM bk$(10)    :  'data for blocks
   DIM k$(16)     :  '
'
'  setup screen
'
   GOSUB setup
'
'  ***** MAIN ******
'
   play$="yes"
'
   WHILE play$="yes
'
     GOSUB initdata
     finish$="no"
     ans$="no"
     ians=0
'
        WHILE finish$="no"
          IF ans$="no" THEN GOSUB getmove ELSE GOSUB getans
          IF move$="q" THEN finish$="quit"
          IF move$="a" THEN ans$="yes":GOSUB initdata:GOSUB getans
          GOSUB checkmove
          IF move$="valid" THEN GOSUB checkend
        WEND
'
     MOVE 200;100
     IF ans$="yes" THEN finish$="no": PRINT MODE(1);"EASY,wasn't it..try again ?"
     IF finish$="yes"  THEN PRINT MODE(1);"WELL DONE.....another go  ?"
     IF finish$="quit" THEN PRINT MODE(1);"HARD LUCK.......try again   ?"
'
        ans$=""
        WHILE ans$=""
          ans$=INKEY$
          IF ans$<>"y" AND ans$<>"n" THEN ans$=""
        WEND
'
        IF ans$="n" THEN play$="no"
'
   WEND
'
   WINDOW #1 CLOSE : CLS : STOP
'
'  *** ENDMAIN ****
'
'
'
   LABEL getans
   ians=ians+1
   block=VAL(MID$(ac$,ians,1))
   IF block=0 THEN block=10
   move$=MID$(ad$,ians,1)
   RETURN
'
'
'
   LABEL checkmove
   lp=l(block):hp=h(block):xp=x(block):yp=y(block):cp=c(block)
   e$=bk$(block):dk$=k$(block):oldmv$=mv$:mv$=dk$+"-"+move$
   dx=0 : dy=0
   IF move$="u" AND yp>1     THEN dy=-1
   IF move$="d" AND yp+hp<11 THEN dy=1
   IF move$="l" AND xp>2     THEN dx=-2
   IF move$="r" AND xp+lp<9  THEN dx=2
   IF dx=0 AND dy=0 THEN move$="invalid" : RETURN
   GOSUB dummy  :'check valid move
   IF move$="invalid" THEN RETURN
   MOVE 100;167:PRINT MODE(1);mv$
   cp=7:GOSUB drawblock
   cp=c(block):xp=x(block):yp=y(block):m=1:GOSUB drawblock:cp=1:GOSUB drawoutline
   IF lastblock=block THEN RETURN
   movecount=movecount+1
   lastblock=block
   MOVE 100;153:PRINT MODE(1);movecount
   RETURN
'
'
'
   LABEL checkend
   IF x(1)<>5 OR y(1)<>7 THEN RETURN
   IF x(2)<>7 OR y(2)<>7 THEN RETURN
   IF x(7)<>1 OR y(7)<>1 THEN RETURN
   IF x(10)<>1 OR y(10)<>3 THEN RETURN
   finish$="yes"
   RETURN
'
'
'
   LABEL getmove
   ik=0
     WHILE ik<11
        GOSUB getkeys
        IF ik<11 THEN block=ik:MOVE 100;167:PRINT MODE(1); k$(ik)+"  "
     WEND
   move$=ky$
   RETURN
'
'
'
   LABEL getkeys
   ik=0
   WHILE ik=0
   ky$=""
       WHILE ky$=""
         ky$=INKEY$
       WEND
           FOR k=1 TO 16
           IF ky$=k$(k) THEN ik=k
           NEXT k
   WEND
   RETURN
'
'
'
   LABEL dummy
   xd=xp+dx : yd=yp+dy
   xd1=xd+lp-1 : yd1=yd+hp-1
   xa=xp : ya=yp : a$=" "
   GOSUB arrmove : ' delete block
   move$="valid" : i=0
   FOR id=yd TO yd1
   FOR jd=xd TO xd1
   i=i+1
   IF arr$(jd,id)<>" " AND MID$(e$,i,1)="X" THEN move$="invalid"
   NEXT jd
   NEXT id
   xa=xp : ya=yp : a$=k$(block)
   GOSUB arrmove : ' return block after check
   IF move$="invalid" THEN RETURN
   xa=xp : ya=yp : a$=" "
   GOSUB arrmove
   xa=xd : ya=yd : a$=dk$
   GOSUB arrmove
   x(block)=xd : y(block)=yd
   RETURN
'
'
'
   LABEL arrmove
   x1=xa : x2=x1+lp-1 : y1=ya : y2=y1+hp-1
   i=0
   FOR ym=y1 TO y2
     FOR xm=x1 TO x2
     i=i+1
     IF MID$(e$,i,1)="X" THEN arr$(xm,ym)=a$
                         ELSE arr$(xm,ym)=" "
     NEXT xm
   NEXT ym
   RETURN
'
'
'
   LABEL drawblock
   xo=160+(xp*30):yo=190-(yp*15)
   IF block=1 THEN SHAPE xo;yo, xo+58;yo, xo+58;yo-30, xo+118;yo-30,xo+118;yo-59, xo;yo-59, xo;yo WIDTH 4 COLOR cp MODE 1 FILL
   IF block=2 OR block=4 OR block=8 OR block=10  THEN SHAPE xo;yo, xo+58;yo, xo+58;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp MODE 1 FILL
   IF block=3 THEN SHAPE xo;yo, xo+118;yo, xo+118;yo-13, xo+58;yo-13, xo+58;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp MODE 1 FILL
   IF block=5 THEN SHAPE xo;yo, xo+58;yo, xo+58;yo-16, xo+118;yo-16, xo+118;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp MODE 1 FILL
   IF block=6 THEN SHAPE xo;yo, xo+118;yo, xo+118;yo-29, xo+60;yo-29, xo+60;yo-14, xo;yo-14, xo;yo WIDTH 4 COLOR cp MODE 1 FILL
   IF block=7 THEN SHAPE xo;yo, xo+118;yo, xo+118;yo-59, xo+61;yo-59, xo+61;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp MODE 1 FILL
   IF block=9 THEN SHAPE xo;yo-16, xo+60;yo-16, xo+60;yo, xo+118;yo, xo+118;yo-29, xo;yo-29, xo;yo-16 WIDTH 4 COLOR cp MODE 1 FILL
   IF cp=7 THEN RETURN
   IF block=9 THEN MOVE (xo+5);(yo-25) ELSE MOVE (xo+5);(yo-10)
   PRINT k$(block)
   RETURN
'
'
'
   LABEL drawoutline
   xo=160+(xp*30):yo=190-(yp*15)
   IF block=1 THEN SHAPE xo;yo, xo+58;yo, xo+58;yo-30, xo+118;yo-30,xo+118;yo-59, xo;yo-59, xo;yo WIDTH 4 COLOR 1
   IF block=2 OR block=4 OR block=8 OR block=10  THEN SHAPE xo;yo, xo+58;yo, xo+58;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp
   IF block=3 THEN SHAPE xo;yo, xo+118;yo, xo+118;yo-13, xo+58;yo-13, xo+58;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp
   IF block=5 THEN SHAPE xo;yo, xo+58;yo, xo+58;yo-16, xo+118;yo-16, xo+118;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp
   IF block=6 THEN SHAPE xo;yo, xo+118;yo, xo+118;yo-29, xo+60;yo-29, xo+60;yo-14, xo;yo-14, xo;yo WIDTH 4 COLOR cp
   IF block=7 THEN SHAPE xo;yo, xo+118;yo, xo+118;yo-59, xo+61;yo-59, xo+61;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp
   IF block=9 THEN SHAPE xo;yo-16, xo+60;yo-16, xo+60;yo, xo+118;yo, xo+118;yo-29, xo;yo-29, xo;yo-16 WIDTH 4 COLOR cp
   RETURN
'
'
   LABEL setup
   USER SPACE 200
   USER ORIGIN 0;0
   BOX 0;0,640,200 COLOR 4 FILL
   SET #1 MODE 2
   BOX 470;100,110,85 COLOR 7 FILL
   BOX 470;100,110,85 WIDTH 2 COLOR 1
   BOX 526;104,49,26 COLOR 3 FILL
   BOX 476;143,49,26 COLOR 5 FILL
   LINE 470;171,580;171
   MOVE 490;175 :PRINT "OBJECTIVE"
   MOVE 476;80  :PRINT "KEYS :"
   MOVE 476;70  :PRINT "0 - 9 .. select"
   MOVE 476;60  :PRINT "u ...... up"
   MOVE 476;50  :PRINT "d ...... down"
   MOVE 476;40  :PRINT "l ...... left"
   MOVE 476;30  :PRINT "r ...... right"
   MOVE 476;20  :PRINT "q ...... quit"
   BOX 30;140,110,45 COLOR 0 FILL
   BOX 30;140,110,45 WIDTH 4
   MOVE 52;167 : PRINT "MOVE"
   MOVE 52;153 : PRINT"TOTAL"
   BOX 30;15,110,100 FILL COLOR 13
   BOX 30;15,110,100 WIDTH 4:MOVE 60;100:PRINT "RATINGS":MOVE 60;90:PRINT"-------":MOVE 40;80:PRINT "<50...WORDS":MOVE 40;70:PRINT"      FAIL":MOVE 40;60:PRINT "51-60 GREAT":MOVE 40;50:PRINT"61-70 GOOD":MOVE 40;40:PRINT"71-80 FAIR"
   MOVE 40;30:PRINT">80   Hmmm"
   RETURN
'
'
'
   LABEL initdata
   RESTORE
   ac$="666611156444522335522666444770981722224445533665554442220009718881117024444422333665577700000888884444222299992211"
   ad$="uurrdddlldddrddlluurruulluuuurrddlddddrddddrruulluuuuuuuuuuruuurrdddllldddddrddddrrrruuululuuuulullluuddlluuuurrrr"
   FOR i=1 TO 10
   READ  l(i),h(i),x(i),y(i),c(i),bk$(i),k$(i)
       FOR j=1 TO 8
       arr$(j,i)=" "
       NEXT j
   NEXT i
   FOR i=11 TO 16
   READ k$(i)
   NEXT i
   DATA 4,4,1,1,3,"XXOOXXOOXXXXXXXX","1"
   DATA 2,2,3,1,3,"XXXX"            ,"2"
   DATA 4,2,5,1,6,"XXXXXXOO"        ,"3"
   DATA 2,2,7,2,6,"XXXX"            ,"4"
   DATA 4,2,5,3,6,"XXOOXXXX"        ,"5"
   DATA 4,2,1,7,6,"XXXXOOXX"        ,"6"
   DATA 4,4,5,7,5,"XXXXXXXXOOXXOOXX","7"
   DATA 2,2,1,8,6,"XXXX"            ,"8"
   DATA 4,2,1,9,6,"OOXXXXXX"        ,"9"
   DATA 2,2,5,9,5,"XXXX"            ,"0"
   DATA "u","d","r","l","q","a"
   lastblock=10:ik=0
   mv$="   ":movecount=0
   MOVE 100;167:PRINT MODE(1);mv$
   MOVE 100;153:PRINT MODE(1);movecount
   BOX 170;15,280,170 COLOR 7 FILL
   BOX 170;15,280,170 WIDTH 4 COLOR 1
   FOR block=1 TO 10
   lp=l(block):hp=h(block):xp=x(block)
   yp=y(block):cp=c(block):dx=0:dy=0
   e$=bk$(block)
   xa=xp : ya=yp : a$=k$(block)
   GOSUB arrmove :m=1: GOSUB drawblock : cp=1 : GOSUB drawoutline
   NEXT block
   block=6
   RETURN