DECLARE FUNCTION Seq%(a%,b%) DECLARE FUNCTION NaipComp%(a%,b%) DECLARE SUB Box(l1%,c1%,l2%,c2%,char$,f%) DECLARE SUB FazerCarta(l%,C%,num%) DECLARE FUNCTION SelPilha%(n%) RANDOMIZE TIMER:DEFINT A-Z DIM Carta(1 TO 32) DIM Pilha(1 TO 15,0 TO 32) COLOR 7,1 DO Naipe=1:Valor=1 FOR i=1 TO 32 Carta(i)=Valor*10+Naipe Valor=Valor+1 IF Valor=2 THEN Valor=7 ELSE IF Valor=14 THEN Valor=1:Naipe=Naipe+1 NEXT FOR i=1 TO 100:SWAP Carta(INT(RND*32)+1),Carta(INT(RND*32)+1):NEXT ERASE Pilha n=0 FOR i=1 TO 11 Pilha(i,0)=3+(i=11) FOR j=1 TO 3+(i=11) n=n+1 Pilha(i,j)=Carta(n) NEXT NEXT item=1 ct=1 1 DO CLS LOCATE 1,1:?"Paciencia 1.0á"; LOCATE 19,1:?"Chance n§";ct; LOCATE 21,1 ?"Mover : < e > ?"Escolher : Enter ?"Embaralhar : Espa‡o FOR i=1 TO 11 t=Pilha(i,0) LOCATE 2,i*6-4:?"( )"; FOR j=1 TO t FazerCarta 1+2*j,i*6-5,Pilha(i,j) NEXT NEXT king=-1 FOR i=1 TO 4 LOCATE i*6-2,71:?"( )"; n=Pilha(i+11,1) FazerCarta i*6-4,74,n king=king AND(n\10=13) NEXT IF king THEN EXIT DO LOCATE 20,1:?"Retirar de pilha"; 2 de=SelPilha(11) IF de=0 THEN EXIT DO IF de=99 THEN item=aitem n=0 FOR i=1 TO 11 FOR j=1 TO Pilha(i,0) n=n+1 Carta(n)=Pilha(i,j) NEXT NEXT FOR i=1 TO 50:SWAP Carta(INT(RND*n)+1),Carta(INT(RND*n)+1):NEXT FOR i=1 TO 11 Pilha(i,0)=0 FOR j=1 TO 3 Pilha(i,j)=0 IF n>0 THEN Pilha(i,j)=Carta(n):Pilha(i,0)=j:n=n-1 NEXT NEXT ct=ct+1 IF ct>3 THEN EXIT DO GOTO 1 END IF tde=Pilha(de,0) IF tde=0 THEN 2 cde=Pilha(de,tde) COLOR 15,1 FazerCarta 1+2*tde,de*6-5,cde COLOR 7,1 LOCATE 20,1:?"Colocar em pilha"; LOCATE 23,1:?" "; para=SelPilha(15) IF para=0 THEN EXIT DO IF para>11 THEN tpara=1 ELSE tpara=Pilha(para,0) cpara=Pilha(para,tpara) IF para>11 THEN IF(cpara MOD 10=cde MOD 10 OR cpara=0)AND Seq(cpara\10,cde\10)THEN DO tde=tde-1 Pilha(de,0)=tde Pilha(para,1)=cde IF tde=0 THEN EXIT DO cpara=cde cde=Pilha(de,tde) IF NOT(Seq(cpara\10,cde\10)AND cpara MOD 10=cde MOD 10)THEN EXIT DO LOOP END IF ELSE IF NaipComp(cpara MOD 10,cde MOD 10)AND Seq(cde\10,cpara\10)THEN Pilha(de,0)=tde-1 Pilha(para,0)=tpara+1 Pilha(para,tpara+1)=cde END IF END IF LOOP LOCATE 23,1 IF ct>3 THEN ?"Vocˆ perdeu... ";ELSE IF king THEN ?"Vocˆ ganhou ! "; ?"Deseja jogar novamente [sn] ? "; DO:a$=UCASE$(INPUT$(1)):LOOP UNTIL a$="S" OR a$="N ?a$ LOOP WHILE a$="S COLOR 7,0 CLS SYSTEM SUB Box(l1,c1,l2,c2,char$,f) ff=-(f<>0) IF char$="" THEN char$="ÚÄ¿³ÙÄÀ³"+SPACE$(ff) char$=LEFT$(char$+SPACE$(8+ff),8+ff) DIM chrl(1 TO 8+ff)AS STRING*1 FOR i=1 TO 8+ff:chrl(i)=MID$(char$,i,1):NEXT ln=c2-c1-1 LOCATE l1,c1:?chrl(1);STRING$(ln,chrl(2));chrl(3); LOCATE l2,c1:?chrl(7);STRING$(ln,chrl(6));chrl(5); IF f THEN FOR l=l1+1 TO l2-1 LOCATE l,c1:?chrl(8);STRING$(ln,chrl(9));chrl(4); NEXT ELSE FOR l=l1+1 TO l2-1 LOCATE l,c1:?chrl(8); LOCATE l,c2:?chrl(4); NEXT END IF END SUB SUB FazerCarta(l,C,num) Naipe=num MOD 10 Valor=num\10 SELECT CASE Valor CASE 1:v$="A CASE 7 TO 10:v$=MID$(STR$(Valor),2) CASE 11:v$="J CASE 12:v$="Q CASE 13:v$="K END SELECT n$=CHR$(2+Naipe) Box l,C,l+5,C+5,"",1 IF Naipe<3 THEN COLOR 5 ELSE COLOR 7 IF Naipe>0 THEN LOCATE l+1,C+1:?v$;n$; LOCATE l+4,C+3+(Valor=10):?n$;v$; END IF COLOR 7 END SUB FUNCTION NaipComp(a,b) NaipComp=((a=1 OR a=2)AND(b=a OR b>2))XOR((a=3 OR a=4)AND(b=a OR b<3)) END FUNCTION FUNCTION SelPilha(n) SHARED item,aitem IF aitem=item OR aitem=0 THEN aitem=(item MOD 15)+1 DO IF aitem<>item THEN LOCATE(aitem>11)*(70-aitem*6)+2,(aitem<12)*(75-aitem*6)+72:?" "; LOCATE(item>11)*(70-item*6)+2,(item<12)*(75-item*6)+72:?"*"; END IF aitem=item k$=INKEY$ SELECT CASE k$ CASE "<",",":item=item-1:IF item=0 THEN item=15 CASE ">",".":item=item+1:IF item=16 THEN item=1 CASE CHR$(13):IF item<=n THEN EXIT DO CASE " ":IF n=11 THEN item=99:EXIT DO CASE "":EXIT FUNCTION END SELECT LOOP SelPilha=item END FUNCTION FUNCTION Seq(a,b) Seq=(a=1 AND b=7)XOR(b=a+1) END FUNCTION