====== PATIENCE ====== {{:otros:Patience_p1.jpg?690|}} ===== Info ===== ^ Author | Phil Lawson | ^ Compatibility | Amstrad PCW 8256 / 8512 / 9512 | ^ Year | 1988 | ^ Gender | Card | ^ Controls | Keyboard | ^ Language | English | ^ Status | [[preserved|Preserved]] | ===== Screenshots ===== {{:otros:Patience_(en)_screenshot01.png?220}} {{:otros:Patience_(en)_screenshot02.png?220}} {{:otros:Patience_(en)_screenshot03.png?220}} {{:otros:Patience_(en)_screenshot04.png?220}} ===== Description ===== Patience is a clone of the popular Windows Solitaire. The graphic quality is good, although as usual in PCW the lack of sound is noticeable to make it more professional. The screen is displayed with all the cards spread over 7 columns. Column 1 contains 7 cards, 6 in column 2 and so on until you reach row 7 with only one card. In each column the top card is shown face up. The remaining cards are shown in the upper right part of the screen called Pack, made up of two boxes, in which the one on the left shows the deck of cards face down. On the right side of the screen there are four rows where we must stack the cards. On the left side is an empty column whose function we will explain in more detail shortly. The objective is to move the cards to each of the rows (right side) in ascending order. For example. The row of hearts must begin with the "ACE" of hearts followed by 2, 3, 4, etc., until the pile is filled with the king. Each row has a color associated with it, and only cards matching that color can be placed in that pile (Spades with Spades, Club with Club Heart with Heart, and Diamond with Diamond). However, the cards in the columns have to be placed in descending order, and of a different color. For example. The five of diamonds can be removed from the pack and placed on the six of hearts in any row. On the left side of the screen we can place the cards (always in descending order and of a different color), and select them with the "Q" key. To move a card, or a group of cards, simply press two numbers, first the column of the card you want to move, followed by the destination column. To move cards from the pack is done in a similar way. So we press the destination column followed by the letter "P". If a mistake is made, the selection will be cancelled. When the pack runs out, it will disappear from the screen and the pack's control keys will no longer be effective. If in the pack, we have a color that matches in the ascending order to stack the card, we will press "D", "H", "S" or "C" depending on the color. The program will remove the card from the pack and place it in the corresponding pile. If a column has no cards, it can only be occupied by a King, even if the King is in a column stacked with other cards by pressing the "K" key. If we find ourselves in a situation where it is impossible to progress, we will press the "RETURN" key that will allow us to start a new game. This also works when each stack is completed and the game is over. * Clarifies that the letter "T" corresponds to 10 (Ten). ===== Listing ===== * **__Listing - 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 ===== Controls ===== 0-7 = Card Column Selection Q = Pick a card A = Abort column selection P = Card deck selection D = Pile to deposit diamond cards H = Pile to deposit heart cards S = Pile to deposit Spade cards C = Pile to deposit Club cards K = Occupy empty slot (only for a King) RETURN = Quit game / Return to game SPACE = Start new game ===== Loading the program ===== 1.- Insert the CP/M disc on side 2 2.- Write BASIC and wait for it to load 3.- Remove the CP/M disk and insert the disk containing the Patience game 4.- Type run "Patience" and press the "ENTER" key ===== 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}} ===== Download ===== * {{:otros:Patience (en) (Basic).zip|Patience }}(game in dsk format, compressed with zip)