REM FREECELL BY CCLX333 V1.4 DIM GLOBAL CARDUSE(52),TMP(4),DONE(4),BOARD(8,26) RANDOMIZE TIMER TOUCHSCREEN lvl=1 RESTART: CLS AUTO=1 FINISH=0 GOSUB SHUFFLE GOSUB DRAWBOARD GOSUB DRAWTMPDONE attr(0,) TEXT 9,0,"RE" TEXT 1,3,"A" text 0,15,"level="+str$(lvl) CELL 0,3,31 FREETMP=4 PICK=0 DO IF TOUCH THEN rem arrow SPRITE.A 1,(PICK+2,) SPRITE 1,TOUCH.X,TOUCH.Y,29 GOSUB GETXY IF X=0 AND Y=3 THEN AUTO=1-AUTO CELL 0,3,30+AUTO END IF if x=0 and y=15 then attr(0,) locate 0,15 input"level=";lvl if lvl<1 then lvl=1 keyboard off goto restart end if IF PICK=0 THEN PICK=1 PX=X1 PY=Y1 GOSUB GETV PV=V IF V<0 THEN PICK=0 ELSE TX=X1 TY=Y1 GOSUB GETV TV=V GOSUB MOVE END IF WAIT 20 END IF IF FINISH=2 THEN GOTO RESTART IF AUTO=1 THEN GOSUB AUTODONE IF FINISH=1 THEN TEXT 6,8," GOOD " WAIT 60 lvl=lvl+1 GOTO RESTART END IF WAIT VBL LOOP MOVE: REM BOARD TO TMP IF PY>1 AND TY=0 AND TV=0 AND PV>0 AND TX<5 AND TX>0 THEN TMP(TX)=PV CALL DRAWTMP(TX) BOARD(PX,PY)=0 CALL ERASECARD(PX,PY) FREETMP=FREETMP-1 END IF REM TMP TO BOARD IF PY=0 AND TY>1 AND PV>0 AND TX>0 AND TX<9 THEN GOSUB CHECK2 IF OK>0 THEN CALL ADDCARD(TX,PV) TMP(PX)=0 CALL DRAWTMP(PX) FREETMP=FREETMP+1 END IF END IF REM DONE TO BOARD IF PY=1 AND TY>1 AND PV>0 AND TX>0 AND TX<9 THEN GOSUB CHECK2 IF OK>0 THEN CALL ADDCARD(TX,PV) DONE(PX)=PV-1 CALL DRAWDONE(PX) END IF END IF REM TMP TO DONE IF PY=0 AND TY=1 AND PV>0 AND TX<5 THEN GOSUB CHECK1 IF OK>0 THEN DONE(TX)=PV CALL DRAWDONE(TX) TMP(PX)=0 CALL DRAWTMP(PX) FREETMP=FREETMP+1 END IF END IF REM BOARD TO BOARD IF PY>1 AND TY>1 AND PX<>TX AND PV>0 AND TX>0 AND TX<9 THEN GOSUB CHECK2 IF OK=1 THEN CALL ADDCARD(TX,PV) BOARD(PX,PY)=0 CALL ERASECARD(PX,PY) ELSE CALL CHECKN(PX,N) gosub getmaxn if board(tx,0)=0 then IF N>maxn1 THEN N=maxn1 else if n>maxn2 then n=maxn2 end if GOSUB CHECK2S IF OK=1 THEN CLEN=BOARD(PX,0) ' MOVE N CARDS FOR PY=CLEN-N+1 TO CLEN PV=BOARD(PX,PY) GOSUB GETN2 CALL ADDCARD(TX,PV) BOARD(PX,PY)=0 CALL DRAWCARD(PX*2,PY+2,0,0,1) WAIT 5 NEXT PY CLEN=CLEN-N BOARD(PX,0)=CLEN REM REDRAW LAST CARD IN THIS COLUMN IF CLEN>0 THEN V=BOARD(PX,CLEN) GOSUB GETN CALL DRAWCARD(PX*2,CLEN+2,N,PAT,1) END IF END IF END IF END IF PICK=0 RETURN CHECK1: GOSUB GETN2 OK=0 ' WRONG COLUMN IF PPAT<>TX THEN RETURN ' NUMBER NOT MORE 1 IF PN-1<>TN THEN RETURN OK=1 RETURN CHECK2: IF TV=0 THEN OK=2 RETURN END IF GOSUB GETN2 'COLUMN TO COLUMN OK=0 ' PATTERN SAME COLOR IF PPAT+TPAT=5 OR PPAT=TPAT THEN RETURN ' NUMBER NO LESS 1 IF PN+1<>TN THEN RETURN OK=1 RETURN CHECK2S: OK=1 IF TV=0 THEN RETURN IF TPAT=1 OR TPAT=4 THEN TCOLOR=1 ELSE TCOLOR=0 IF PPAT=1 OR PPAT=4 THEN PCOLOR=1 ELSE PCOLOR=0 DN=TN-PN OK=0 IF DN>N OR DN<1 THEN RETURN IF (DN MOD 2)=ABS(TCOLOR-PCOLOR) THEN OK=1 N=DN END IF RETURN AUTODONE: CHNG=0 FOR X0=1 TO 4 V0=DONE(X0) IF V0=0 THEN V0=V0+(X0-1)*13 FOR X2=1 TO 8 Y2=BOARD(X2,0) V2=BOARD(X2,Y2) IF V2=V0+1 THEN GOSUB AUTOMOVE NEXT X2 for x2=1 to 4 if tmp(x2)=v0+1 then gosub automovetmp next x2 NEXT X0 IF CHNG=1 THEN GOTO AUTODONE SUM=0 FOR I=1 TO 4 SUM=SUM+DONE(I) NEXT I IF SUM=130 THEN FINISH=1 RETURN AUTOMOVE: DONE(X0)=V2 CALL DRAWDONE(X0) BOARD(X2,Y2)=0 CALL ERASECARD(X2,Y2+2) V0=V0+1 DONE(X0)=V0 CHNG=1 WAIT 5 RETURN AUTOMOVETMP: DONE(X0)=tmp(x2) CALL DRAWDONE(X0) tmp(x2)=0 CALL DRAWTMP(X2) V0=V0+1 DONE(X0)=V0 FREETMP=FREETMP+1 CHNG=1 WAIT 5 RETURN GETXY: X=TOUCH.X\8 Y=TOUCH.Y\8 IF Y<3 THEN Y1=0 ELSE Y1=Y ' TMP OR BOARD IF Y1=0 THEN X1=(X+1)\2 ELSE X1=X\2 ' DONE IF Y1=0 AND X1>5 THEN Y1=1 X1=X1-5 END IF IF Y1>1 AND X1<9 THEN CLEN=BOARD(X1,0) Y1=CLEN+2 END IF RETURN GETV: V=0 IF Y1=0 THEN IF X1=5 THEN FINISH=2 ELSE V=TMP(X1) ELSE IF Y1=1 THEN IF X1<5 THEN V=DONE(X1) ELSE IF X1>0 AND X1<9 THEN V=BOARD(X1,Y1-2) END IF RETURN SHUFFLE: randomize lvl FOR I=1 TO 52 CARDUSE(I)=0 NEXT I FOR Y=1 TO 7 FOR X=1 TO 8 REPEAT R=INT(RND*52)+1 UNTIL CARDUSE(R)=0 BOARD(X,Y)=R CARDUSE(R)=1 IF Y=7 AND X=4 THEN X=8 NEXT X NEXT Y FOR I=1 TO 4 TMP(I)=0 DONE(I)=0 BOARD(I,0)=7 BOARD(I+4,0)=6 NEXT I RETURN DRAWBOARD: FOR X=1 TO 8 L=BOARD(X,0) FOR Y=1 TO L V=BOARD(X,Y) GOSUB GETN IF YN1+1 THEN N=CLEN-Y+1 Y=2 END IF NEXT Y END SUB SUB ERASECARD(X,Y) BOARD(X,Y)=0 CALL DRAWCARD(X*2,Y,0,0,1) CLEN=BOARD(X,0) IF CLEN>0 THEN BOARD(X,0)=CLEN-1 REM REDRAW LAST CARD IN THIS COLUMN IF CLEN>1 THEN V=BOARD(X,CLEN-1) GOSUB GETN CALL DRAWCARD(X*2,CLEN+1,N,PAT,1) END IF END SUB SUB ADDCARD(X,V) IF X>8 OR X<1 THEN EXIT SUB CLEN=BOARD(X,0)+1 IF CLEN<=0 THEN CLEN=1 BOARD(X,0)=CLEN BOARD(X,CLEN)=V GOSUB GETN CALL DRAWCARD(X*2,CLEN+2,N,PAT,1) END SUB SUB DRAWTMP(X) V=TMP(X) GOSUB GETN CALL DRAWCARD(X*2-1,0,N,PAT,1) END SUB SUB DRAWDONE(X) V=DONE(X) GOSUB GETN CALL DRAWCARD(X*2+9,0,N,PAT,1) END SUB SUB DRAWCARD(X,Y,N,PAT,FULL) IF N=0 THEN IF Y=0 THEN REM CARD SEAT CELL X,Y,23 CELL X+1,Y,24 CELL X,Y+1,25 CELL X+1,Y+1,26 CELL X,Y+2,27 CELL X+1,Y+2,28 EXIT SUB ELSE REM ERASE CARD CELL X,Y,0 CELL X+1,Y,0 CELL X,Y+1,0 CELL X+1,Y+1,0 CELL X,Y+2,0 CELL X+1,Y+2,0 EXIT SUB END IF END IF ' COLOR IF PAT=1 OR PAT=4 THEN ATTR(1,) ELSE ATTR(0,) END IF ' UPPER CELL X,Y,N+8 CELL X+1,Y,PAT IF FULL=0 THEN EXIT SUB ' MIDDLE IF N<11 THEN CELL X,Y+1,PAT+4 ATTR(,1) CELL X+1,Y+1,PAT+4 ELSE CELL X,Y+1,22 ATTR(,1) CELL X+1,Y+1,22 ATTR(,1,1) END IF ' LOWER ATTR(,1,1) CELL X,Y+2,PAT CELL X+1,Y+2,N+8 ATTR(,0,0) END SUB #1:MAIN PALETTES 053F3000003F1500003C0C00003F3C00 003F2A15003F2A15003F2A15003F2A15 #2:MAIN CHARACTERS 00000000000000000000000000000000 FFFFF7E3E3F7FFFFFF01091D1D090101 FFFFEBE3F7FFFFFFFF01151D09010101 FFFFF7E3F7FFFFFFFF01091D09010101 FFFFF7E3E3FFFFFFFF01091D1D010101 FEFCF8F0F0F0F8FE8183878F8F8F8781 FFF9F0F0F0F8FCFE80868F8F8F878381 FFFEFCF8F0F8FCFE808183878F878381 FEFCFCF2E0E0FEFC8183838D9F9F8183 FFFFEFD7C7D7D7FFFF8090A8B8A8A880 FFFFC7F7C7DFC7FFFF80B888B8A0B880 FFFFC7F7E7F7C7FFFF80B8889888B880 FFFFD7D7C7F7F7FFFF80A8A8B8888880 FFFFC7DFC7F7C7FFFF80B8A0B888B880 FFFFC7DFC7D7C7FFFF80B8A0B8A8B880 FFFFC7F7EFDFDFFFFF80B88890A0A080 FFFFC7D7C7D7C7FFFF80B8A8B8A8B880 FFFFC7D7C7F7C7FFFF80B8A8B888B880 FFFFD1D5D5D5D1FFFF80AEAAAAAAAE80 FFFFE3F7F7D7C7FFFF809C8888A8B880 FFFFE3DDDDDBE5FFFF809CA2A2A49A80 FFFFDBD7CFD7DBFFFF80A4A8B0A8A480 FFF5F0F9FBE0E8FFBFAAAFA6A4A1A0BF FF80808080808080FF80808080808080 FF01010101010101FF00000000000000 80808080808080808080808080808080 01010101010101010000000000000000 80808080808080FF8080808080808080 01010101010101FF0000000000000000 0000000000000000FEFCF0F8DCCE8703 FF818181818181FF0000000000000000 FFC5A991A9C581FF0000000000000000