====== PATIENCE ====== {{:otros:Patience_p1.jpg?690|}} ===== Ficha ===== ^ Autor | Phil Lawson | ^ Compatibilidad | Amstrad PCW 8256 / 8512 / 9512 | ^ Año | 1988 | ^ Género | Cartas | ^ Controles | Teclado | ^ Idioma | Inglés | ^ Estado | [[preservado|Preservado]] | ===== Capturas ===== {{:otros:Patience_(en)_screenshot01.png?220}} {{:otros:Patience_(en)_screenshot02.png?220}} {{:otros:Patience_(en)_screenshot03.png?220}} {{:otros:Patience_(en)_screenshot04.png?220}} ===== Descripción ===== Patience es un clon del conocido Solitario de Windows. La calidad gráfica es buena aunque como de costumbre en el PCW se nota la carencia de sonido para hacerlo más profesional. La pantalla se muestra con todas las cartas repartidas en 7 columnas. La columna 1 contiene 7 cartas, 6 en la columna 2 y así sucesivamente hasta llegar a la fila 7 con una sola carta. En cada columna la carta superior se muestra boca arriba. Las cartas que sobran se muestran en la parte superior derecha de la pantalla llamada Pack formada por dos casillas, en la cual la de la izquierda muestra el mazo de cartas boca abajo. En la parte derecha de la pantalla se muestran cuatro filas donde deberemos apilar las cartas. En el lado izquierdo hay una columna vacía cuya función la explicaremos con más detalle en breve. El objetivo es mover las cartas a cada una de las filas (lado derecho) en orden ascendente. Por ejemplo. La fila de corazones debe comenzar por el "AS" de corazones seguida del 2, 3, 4, etc., hasta que el montón se complete con el rey. Cada fila tiene un color asociado con él, y solo se pueden colocar las cartas que coincidan con el color en ese montón (Picas con picas, trébol con trébol corazón con corazón y diamante con diamante). Sin embargo, las cartas en las columnas tienen que colocarse en orden descendente, y de diferente color. Por ejemplo. El cinco de diamantes puede ser retirado del pack y colocarse en el seis de corazones de cualquiera de las filas. En el lado izquierdo de la pantalla podremos ir colocando las cartas (siempre en orden descendente y de distinto color), y seleccionándolas con la tecla "Q". Para mover una carta, o un grupo de cartas, simplemente presione dos número, primero la columna de la carta que queremos mover, seguida de la columna destino. Para mover las cartas del pack se hace de una manera similar. Así que presionamos la columna de destino seguida dela letra "P". Si se comete un error se anulará la selección. Cuando el pack se agote este desaparecerá de la pantalla y las teclas de control del pack dejarán de ser efectivas. Si en el pack, tenemos un color que coincide en el orden ascendente para apilar la carta, pulsaremos "D", "H", "S" o "C" dependiendo del color. El programa eliminará la carta del pack y la colocará en la pila correspondiente. Si una columna no tiene cartas, sólo podrá ser ocupada con un Rey, aunque el Rey esté en una columna apilada por otras cartas pulsando la tecla "K". Si nos encontramos en una situación en la que es imposible progresar, pulsaremos la tecla "RETURN" que nos permitirá iniciar un nuevo juego. Esto también funciona cuando cada montón sea completado y el juego haya terminado. * Aclara que la carta "T" corresponde al 10 (Ten). ===== Listado ===== * **__Listado - PATIENCE.BAS__** 10 REM Patience 20 REM by Phil Lawson 30 REM (c) Amstrad PCW 40 REM ----------------------------------- 50 e$=CHR$(27):cls$=e$+"E"+e$+"H" 60 PRINT cls$;CHR$(27)+"f" 70 DEF FNat$(xx,yy)=e$+"Y"+CHR$(32+yy)+CHR$(32+xx) 80 GOSUB 2490:GOSUB 2290:GOSUB 2030 90 GOSUB 1460 100 WHILE (p(1)+p(2)+p(3)+p(4)<>52) AND key<>15 110 OPTION RUN 120 c1=0:c2=0:WHILE c1=0 OR c2=0 130 GOSUB 270:IF key<>15 THEN GOSUB 420 140 WHILE INKEY$<>"":WEND 150 WEND:WEND 160 x%=17:y%=28:p=255:POKE paper,85:d=0 170 a$="Press spacebar to play again" 180 OPTION STOP:GOSUB 1730:POKE paper,0 190 IF p(1)+p(2)+p(3)+p(4)=52 THEN 210 200 PRINT FNat$(32,29);"or Return to continue" 210 IF INKEY$=" " THEN RUN 220 IF p(1)+p(2)+p(3)+p(4)=52 THEN 210 230 IF INKEY$<>CHR$(13) THEN 210 240 PRINT FNat$(17,28);SPACE$(60) 250 PRINT FNat$(32,29);SPACE$(30) 260 key=0:GOTO 100 270 key=0:WHILE key=0:i$="" 280 WHILE i$="":i$=UPPER$(INKEY$):WEND 290 IF i$>"0"AND i$<"8" THEN key=VAL(i$) 300 IF i$="Q" THEN key=8 310 IF i$="A" THEN key=9 320 IF i$="P" THEN key=10 330 IF i$="K" THEN key=10 340 IF i$="D" THEN key=11 350 IF i$="H" THEN key=12 360 IF i$="S" THEN key=13 370 IF i$="C" THEN key=14 380 IF ASC(i$)=13 THEN key=15:c1=1:c2=1 390 WEND 400 IF key<8 THEN IF c1=0 THEN c1=key ELSE c2=key 410 RETURN 420 IF key>7 THEN ON key-7 GOSUB 670,770,780,1040,1040,1040,1040:RETURN 430 d=0:IF rt(c1)=0 THEN RETURN 440 IF c2=0 THEN p=255:GOSUB 1360:POKE pen,85:RETURN 450 p=85:GOSUB 1360:POKE pen,255 460 IF c1=c2 THEN RETURN 470 cu1=rt(c1):WHILE cu$(c1,cu1-1)="U":cu1=cu1-1:WEND 480 cu2=rt(c2) 490 t$=LEFT$(r$(c1,cu1),1):GOSUB 1400:t1=t 500 t$=LEFT$(r$(c2,cu2),1):GOSUB 1400:t2=t 510 IF rt(c2)=0 AND LEFT$(r$(c1,cu1),1)="K" THEN GOSUB 560:RETURN 520 IF t2<>t1+1 THEN RETURN 530 t$=RIGHT$(r$(c1,cul),1):GOSUB 1980:t1=t 540 t$=RIGHT$(r$(c2,cu2),1):GOSUB 1980:t2=t 550 IF SGN(t1-3)=SGN(t2-3) THEN RETURN 560 FOR a=rt(c1)+1 TO cu1-3 STEP-1 570 PRINT FNat$((c1+0.5)*9-4,a+4);SPACE$(8) 580 NEXT:FOR a=cu1 TO rt(c1) 590 cu$(c2,rt(c2)+1-(cu1-a))="U" 600 r$(c2,rt(c2)+1-(cu1-a))=r$(c1,a):cu$(c1,a)="":r$(c1,a)="":NEXT:rt(c1)=cu-1 610 FOR a=cu1 TO rt(c1) 620 x=c2+0.5:y=rt(c2)+1:GOSUB 1880 630 rt(c2)=rt(c2)+1:NEXT:rt(c1)=cu1-1 640 IF rt(c1)=0 THEN cu$(c1,1)="":RETURN 650 cu$(c1,rt(c1))="U":x=c1+0.5:y=rt(c1) 660 GOSUB 1880:RETURN 670 IF c1=0 THEN RETURN 680 FOR a=1 TO 20:t$=RIGHT$(r$(c1,a),1) 690 GOSUB 1980:a$=LEFT$(r$(c1,a),1) 700 x%=1:y%=2+a:d=0 710 IF cu$(c1,a)=" " OR cu$(c1,a)="" THEN a$=" " 720 a$=a$+CHR$(t)+CHR$(t+1) 730 IF cu$(c1,a)<>"U" THEN a$="???":p=255 740 IF cu$(c1,a)="" THEN a$=" " 750 GOSUB 1730:NEXT 760 GOSUB 770:POKE pen,255:RETURN 770 p=85:GOSUB 1360:c1=0:RETURN 780 REM Move cards from pack 790 d=0:IF pack=0 THEN RETURN 800 IF i$="K" THEN GOSUB 980:RETURN 810 IF c1=0 THEN GOSUB 940:RETURN 820 t1$=r$(cl,rt(c1)):t2$=pack$(pa) 830 t$=LEFT$(t1$,1):GOSUB 1400:t1=t 840 t$=LEFT$(t2$,1):GOSUB 1400:t2=t 850 IF t1<>t2+1 THEN GOSUB 770:RETURN 860 rt(c1)=rt(c1)+1:r$(c1,rt(c1))=pack$(pa):cu$(c1,rt(c1))="U" 870 FOR a=pa TO pack-1:pack$(a)=pack$(a+1):NEXT:pack$(pack)=" ":pack=pack-1 880 x=c1+0.5:y=rt(c1):GOSUB 1880:GOSUB 770 890 IF pack=0 THEN GOSUB 920:RETURN 900 pa=pa-1:IF pa=0 THEN pa=1 910 GOSUB 970:RETURN 920 FOR a=1 TO 7:PRINT FNat$(73,a);SPACE$(17):NEXT 930 RETURN 940 REM turn cards over 950 pa=pa+3 960 WHILE pa>pack:pa=ABS(pa-pack):WEND 970 x=9.5:y=2:t$=pack$(pa):GOSUB 1900:RETURN 980 REM king from pack to pile 990 IF LEFT$(pack$(pa),1)<>"K" THEN RETURN 1000 IF c1>0 THEN p=85:GOSUB 1360 1010 c1=0:FOR a=1 TO 7:IF rt(a)=0 THEN c1=a:a=7 1020 NEXT:IF c1=0 THEN RETURN 1030 GOSUB 860:RETURN 1040 REM Cards to piles 1050 key=key-10:card=0:FOR i=1 TO 7 1060 tt$=r$(i,rt(i)) 1070 IF RIGHT$(tt$,1)<>i$ THEN 1220 1080 t$=LEFT$(tt$,1):GOSUB 1400 1090 IF p(key)+1<>t THEN 1220 1100 card=1:c1=i:c2=0 1110 FOR a=rt(c1)+1 TO rt(c1)-3 STEP -1 1120 PRINT FNat$((c1+0.5)*9-4,a+4);SPACE$(8):NEXT 1130 r$(c1,rt(c1))="":cu$(c1,rt(c1))="":rt(c1)=rt(c1)-1 1140 IF rt(c1)<>0 THEN x=c1+0.5:y=rt(c1):GOSUB 1770 1150 t$=i$ 1160 GOSUB 1980:x%=81:y%=10+(t*2.5) 1170 IF (t+2)/2<>key THEN RETURN 1180 p(key)=p(key)+1 1190 a$=cv$(p(key)) 1200 d=1:GOSUB 1730:POKE double,0:i=7 1210 IF rt(c1)<>0 THEN cu$(c1,rt(c1))="U":x=c1+0.5:y=rt(c1):GOSUB 1880 1220 NEXT 1230 IF card=1 THEN c1=0:RETURN 1240 REM card from pack to pile 1250 t$=LEFT$(pack$(pa),1):GOSUB 1400 1260 IF p(key)+1<>t THEN RETURN 1270 t$=RIGHT$(pack$(pa),1):GOSUB 1980 1280 IF (t+2)/2<>key THEN RETURN 1290 p(key)=p(key)+1 1300 d=1:x%=81:y%=10+(t*2.5) 1310 a$=cv$(p(key)):GOSUB 1730 1320 FOR a=pa TO pack-1:pack$(a)=pack$(a+1):NEXT:pack$(pack)=" ":pack=pack-1 1330 pa=pa-1:IF pa=0 THEN pa=1 1340 IF pack=0 THEN pa=0:GOSUB 920 ELSE x=9.5:y=2:t$=pack$(pa):GOSUB 1900 1350 RETURN 1360 REM draw number 1370 a$=STR$(c1):d=1:x%=c1*9+2 1380 y%=26:GOSUB 1730:POKE double,0 1390 RETURN 1400 t=VAL(t$):IF t$="T" THEN t=10 1410 IF t$="J" THEN t=11 1420 IF t$="Q" THEN t=12 1430 IF t$="K" THEN t=13 1440 IF t$="A" THEN t=1 1450 RETURN 1460 p=255:d=1:a$="PATIENCE" 1470 x%=33:y%=0:GOSUB 1730 1480 FOR t1=1 TO 7:FOR t2=1 TO (8-t1) 1490 cu$(t1,t2)="D":NEXT 1500 cu$(t1,t2-1)="U":rt(t1)=8-t1:NEXT 1510 t=0:FOR t1=1 TO 7:FOR t2=1 TO (8-t1) 1520 t=t+1:r$(t2,t1)=c$(t):NEXT:NEXT 1530 FOR t1=1 TO 7:FOR t2=1 TO (8-t1) 1540 x=t2+0.5:y=t1:GOSUB 1770:NEXT 1550 x=8.5-t1:y=t1:GOSUB 1880:NEXT 1560 x=8.5:y=2:GOSUB 1770 1570 x=9.5:y=2:GOSUB 1820 1580 FOR t1=0 TO 6 STEP 2 1590 x=9.1:y=8+(5*INT(t1/2)):GOSUB 1820 1600 a$=CHR$(t1)+CHR$(t1+1) 1610 x%=80:y%=12+(5*INT(t1/2)) 1620 IF t1>2 THEN p=85 1630 GOSUB 1730:NEXT 1640 RESTORE 1720 1650 FOR a=1 TO 5:READ x%,y%,a$ 1660 p=255:d=1:GOSUB 1730:NEXT 1670 PRINT FNat$(0,2);tr$ 1680 FOR a=1 TO 26:PRINT mr$:NEXT 1690 PRINT br$:FOR a=1 TO 7:a$=STR$(a) 1700 d=1:p=85:x%=a*9+2:y7=26 1710 GOSUB 1730:NEXT:RETURN 1720 DATA 77,1,PACK,87,11,D,87,16,H,87,21,S,87,26,C 1730 REM Large Printing 1740 POKE pen,p:POKE double,d 1750 CALL print1(x%,y%,a$) 1760 d=0:POKE double,d:RETURN 1770 REM face down card 1780 p=255:d=0:GOSUB 1820 1790 a$=STRING$(3,CHR$(8)) 1800 x%=x*9-3:FOR a=2 TO 4:y%=y+a 1810 GOSUB 1730:NEXT:RETURN 1820 REM draw the edge of the card 1830 x%=x*9-4:y%=y+1 1840 PRINT FNat$(x%,y%);tr$ 1850 FOR loop=1 TO 4 1860 PRINT FNat$(x%,y%+loop);mr$:NEXT 1870 PRINT FNat$(x%,y+5);br$:RETURN 1880 REM draw the value of the card 1890 t$=r$(INT(x),y) 1900 GOSUB 1820 1910 PRINT FNat$(x*9-3,y+2);LEFT$(t$,1) 1920 PRINT FNat$(x*9+1,y+4);LEFT$(t$,1) 1930 t$=RIGHT$(t$,1):GOSUB 1980 1940 a$=CHR$(t)+CHR$(t+1) 1950 x%=x*9-1:y%=y+2:GOSUB 1730 1960 x%=x*9-3:y%=y+4:GOSUB 1730 1970 POKE pen,255:RETURN 1980 p=255:t=0:IF t$="H" THEN t=2 1990 IF t$="S" THEN t=4:p=85 2000 IF t$="C" THEN t=6:p=85 2010 RETURN 2020 REM set up the arrays 2030 DIM cv$(13),c$(52),r$(7,20),cu$(7,20),pack$(24) 2040 a=(PEEK(64504!)*PEEK(64503!))+PEEK(64504!) 2050 RANDOMIZE a 2060 RESTORE 2230:card$="":FOR a=1 TO 4 2070 READ t$:card$=card$+t$ 2080 s$(a)=RIGHT$(t$,1):NEXT 2090 FOR a=1 TO 13:READ cv$(a):NEXT 2100 FOR a=1 TO 48 2110 x=INT(RND*(49-a))+1:x=x*2-1 2120 c$(a)=MID$(card$,x,2) 2130 MID$(card$,x,2)=RIGHT$(card$,2) 2140 card$=LEFT$(card$,LEN(card$)-2) 2150 NEXT:FOR a=1 TO 4 2160 c$(48+a)=MID$(card$,(a*2)-1,2):NEXT 2170 pack$="":FOR a=29 TO 52:pa=0 2180 pack$(a-28)=c$(a):NEXT:pack=24:pack$(0)=" " 2190 tr$=CHR$(134)+STRING$(6,CHR$(138))+CHR$(140) 2200 br$=CHR$(131)+STRING$(6,CHR$(138))+CHR$(137) 2210 mr$=CHR$(133)+SPACE$(6)+CHR$(133) 2220 RETURN 2230 DATA AD2D3D4D5D6D7D8D9DTDJDQDKD 2240 DATA AH2H3H4H5H6H7H8H9HTHJHQHKH 2250 DATA AS2S3S4S5S6S7S8S9STSJSQSKS 2260 DATA AC2C3C4C5C6C7C8C9CTCJCQCKC 2270 DATA A,2,3,4,5,6,7,8,9,T,J,Q,K 2280 REM set up graphics 2290 RESTORE 2330 2300 FOR a=0 TO 9:FOR b=0 TO 7 2310 READ value:POKE (udgs+a*8+b),value 2320 NEXT:NEXT:RETURN 2330 REM diamond 2340 DATA 1,3,7,15,15,7,3,1 2350 DATA 128,192,224,240,240,224,192,128 2360 REM heart 2370 DATA 6,15,31,31,15,7,3,1 2380 DATA 96,240,248,248,240,224,192,128 2390 REM spade 2400 DATA 1,2,4,8,16,18,13,1 2410 DATA 128,64,32,16,8,72,176,128 2420 REM club 2430 DATA 3,4,4,59,37,34,31,1 2440 DATA 192,32,32,220,164,68,248,128 2450 REM back of card 2460 DATA 170,85,170,85,170,85,170,85 2470 DATA 170,85,170,85,170,85,170,85 2480 REM machine code large print routine 2490 MEMORY &HCFFF 2500 RESTORE 2600:address=&HE000 2510 FOR i=1 TO 31:sum=0:READ code$,check$:FOR j=1 TO 21 STEP 2 2520 byte=VAL("&H"+MID$(code$,j,2)) 2530 POKE address,byte:sum=sum+byte 2540 address=address+1:NEXT 2550 IF sum<>VAL("&H"+check$) THEN PRINT"'Error in data line";i*10+2590:STOP 2560 NEXT:screen=&HE000:print1=&HE003 2570 udgs=&HD100:pen=&HD001 2580 paper=&HD000:double=&HD006 2590 POKE pen,255:POKE paper,0:POKE doub1e,0:CALL screen:RETURN 2600 DATA C306E0C35BE0CD29E01198,626 2610 DATA 2C2100B60168013E20F5D5,395 2620 DATA 3E0873237223133D20F8D1,3AA 2630 DATA EB09EBF13D20ECC9C1CD5A,6CA 2640 DATA FCE900C9661A6F2202D00A,49B 2650 DATA 3210D0030A6F030A67ED4B,33A 2660 DATA 10D006001113D0EDB02A02,3A3 2670 DATA D0CDFCE02204D02113D022,595 2680 DATA 11D0C9CD30E0CD29E0F32A,67A 2690 DATA 11D07E232211D0CDEAE011,52D 2700 DATA 4FE1010800EDB0DD2A04D0,4B1 2710 DATA 0E08FD214FE12A00D07D06,3E1 2720 DATA 08FDCB0006380D07DDCB08,3D2 2730 DATA 16DDCB001607C3A4E0CB04,4F1 2740 DATA DDCB0816DDCB0016CB04DD,530 2750 DATA CB0816DDCB001610D7FD23,4AE 2760 DATA 3A06D0A7CAD1E0DD7E08DD,672 2770 DATA 7709DD7E00DD7701DD2379,4A9 2780 DATA FE05C2D1E001C802DD094F,576 2790 DATA DD230DC282E02A04D00110,440 2800 DATA 00092204D02110D035C262,359 2810 DATA E0FBC91100B8FE20300311,4CF 2820 DATA 00D16F260029292919C95C,31F 2830 DATA 260054CB25010FE1094E23,2D5 2840 DATA 46EB29292909C93059005C,363 2850 DATA D05EA06170644067106AE0,504 2860 DATA 6CB06F807250752078F07A,544 2870 DATA C07D9080608330860089D0,53F 2880 DATA 8BA08E709140941097E099,5AE 2890 DATA B09C809F50A220A5F0A7C0,679 2900 DATA AA90AD60B0000000000000,2F7 ===== Controles ===== 0-7 = Selección de columna de cartas Q = Selección de una carta A = Abortar selección de columna P = Selección de mazo de cartas D = Pila para depositar cartas de diamante H = Pila para depositar cartas de corazones S = Pila para depositar cartas de Pica C = Pila para depositar cartas de Trébol K = Ocupar hueco vacío (sólo por un Rey) RETURN = Abandonar juego / Regresar al juego SPACE = Comenzar nuevo juego ===== Carga del programa ===== 1.- Introducir el disco CP/M por la cara 2 2.- Escribir BASIC y esperar a que cargue 3.- Retirar el disco CP/M e introducir el disco que contiene el juego Patience 4.- Teclear run "Patience" y pulsar la tecla "ENTER" ===== Extras ===== {{:otros:Patience_en_programa_01.jpg?170}} {{:otros:Patience_en_programa_02.jpg?170}} {{:otros:Patience_en_programa_03.jpg?170}} {{:otros:Patience_en_programa_04.jpg?170}} ===== Descarga ===== * {{:otros:Patience (en) (Basic).zip|Patience }}(juego en formato dsk, comprimido con zip)