| 10 REM ******************
20 REM * PATIENCE * 30 REM * By Robin Nixon * 40 REM ****************** 50 REM (c) Computing with the Amstrad 55 REM CPC only 60 MODE 1:CALL &BC02:CALL &BB4E 70 INK 0,11:INK 1,1:INK 2,26:BORDER 0 80 DIM a$(52),b$(13),c$(7,18),d(7,2),e$(24),f$(4),g$(13),h$(4),j$(6) 90 SYMBOL AFTER 250 100 SYMBOL 250,90,165,90,165,165,90,165,90 110 SYMBOL 251,255,171,213,171,213,171,213,255 120 GOSUB 3370 130 WHILE INKEY$<>"":WEND 140 WHILE INKEY$="":rand=RND:WEND 150 BORDER 13:INK 0,9:INK 1,0:INK 2,26 160 MODE 1:PLOT 0,0,1:DRAW 638,0 170 DRAW 638,398:DRAW 0,398:DRAW 0,0 180 DEFINT a-z 190 DATA " A"," 2"," 3"," 4" 200 DATA " 5"," 6"," 7"," 8" 210 DATA " 9","10"," J"," Q"," K" 220 z$="A234567890JQK" 230 DATA Ace,Two,Three,Four,Five,Six,Seven,Eight,Nine,Ten,Jack,Queen,King 240 DATA clubs,diamonds,hearts,spades 250 RESTORE 190 260 FOR j=1 TO 13:READ b$(j):NEXT 270 FOR j=1 TO 13:READ g$(j):NEXT 280 FOR j=1 TO 4:READ h$(j):NEXT 290 FOR j=1 TO 7:d(j,1)=j:d(j,2)=j:NEXT 300 FOR j=0 TO 39 STEP 13 310 FOR k=1 TO 13 320 a$(j+k)=b$(k)+CHR$(j/13+226) 330 NEXT:NEXT 340 FOR j=1 TO 156:r1=RND*51+1 350 r2=RND*51+1:c$=a$(r1) 360 a$(r1)=a$(r2):a$(r2)=c$ 370 NEXT 380 FOR j=29 TO 52:e$(j-28)=a$(j) 390 NEXT 400 IF np=0 THEN GOSUB 3220 410 h=0:c=1 420 FOR k=0 TO 6:FOR j=h TO 6 430 IF h=j THEN PEN 2:PAPER 2 ELSE PEN 1:PAPER 2 440 FOR m=1 TO 5:LOCATE j*4+2,k+m+1 450 PRINT STRING$(4,250);:NEXT 460 np=24:np1=4:np2=0 470 IF h<>j THEN GOTO 540 480 PAPER 2 490 n=ASC(RIGHT$(a$(c),1)) 500 IF n=226 OR n=229 THEN PEN 1 ELSE PEN 3 510 LOCATE j*4+2,k+2 520 PRINT MID$(a$(c),INSTR(a$(c)," ")+1) 530 LOCATE j*4+3,k+6:PRINT a$(c) 540 PLOT j*64+16,384-k*16,1 550 DRAW j*64+78,384-k*16 560 DRAW j*64+78,382-k*16-78 570 DRAW j*64+16,382-k*16-78 580 DRAW j*64+16,384-k*16 590 c$(j+1,k+1)=a$(c):c=c+1:NEXT 600 h=h+1:NEXT 610 PEN 1:PAPER 2:FOR j=1 TO 5 620 LOCATE 31,19+j 630 PRINT STRING$(4,250):NEXT 640 PLOT 480,96,1:DRAW 542,96 650 DRAW 542,16:DRAW 480,16 660 DRAW 480,96:PEN 2:PAPER 2 670 FOR j=1 TO 5:LOCATE 36,19+j 680 PRINT STRING$(4,250):NEXT:p=4 690 IF np=0 THEN pf=0:GOSUB 2790:GOTO 810 700 n=ASC(RIGHT$(e$(p),1)):pf=0 710 IF n=226 OR n=229 THEN PEN 1 ELSE PEN 3 720 LOCATE 36,20 730 PRINT MID$(e$(p),INSTR(e$(p)," ")+1);" " 740 LOCATE 37,24:PRINT e$(p) 750 PLOT 560,96,1:DRAW 622,96 760 DRAW 622,16:DRAW 560,16 770 DRAW 560,96 780 IF np=0 THEN GOSUB 3220 790 IF pf THEN GOTO 690 800 GOSUB 3170 810 GOSUB 2960 820 lc=14:GOSUB 1560 830 IF g$=CHR$(32) THEN GOTO 810 840 IF g$=CHR$(127) OR h$=CHR$(127) OR (j1a=0 AND j2=0 AND j3=0) OR j3 THEN GOSUB 2960:SOUND 2,600:GOTO 810 850 tj1a=j1a:tj1b=j1b:tj2=j2:f$=g$ 860 IF j3 THEN GOTO 930 870 IF LEFT$(f$,1)="A" THEN GOSUB 1960:ct=0:GOTO 780 880 IF LEFT$(f$,1)="K" THEN GOSUB 2510 890 IF LEFT$(f$,1)="K" AND ee=0 THEN SOUND 2,600:GOTO 780 900 IF LEFT$(f$,1)="K" THEN ct=0:GOTO 1090 910 PEN 2:PAPER 0:LOCATE 34,16 920 PRINT"to":lc=17 930 GOSUB 1560 940 IF g$=CHR$(32) THEN GOTO 810 950 IF g$=CHR$(127) OR h$=CHR$(127) OR (j1a=0 AND j2=0 AND j3=0) THEN GOSUB 2960:SOUND 2,600:GOTO 810 960 IF tj1a>0 AND j1a>0 AND tj1a=j1a THEN SOUND 2,600:GOTO 810 970 IF j1a>0 AND j1b<d(j1a,2) THEN SOUND 2,600:GOTO 810 980 t$=g$ 990 IF j3 THEN GOSUB 2420:GOTO 780 1000 IF j2 THEN SOUND 2,600:GOTO 780 1010 IF RIGHT$(f$,1)=CHR$(226) OR RIGHT$(f$,1)=CHR$(229) THEN GOTO 1050 1020 IF RIGHT$(t$,1)=CHR$(226) OR RIGHT$(t$,1)=CHR$(229) THEN GOTO 1080 1030 SOUND 2,600 1040 GOTO 780 1050 IF RIGHT$(t$,1)=CHR$(227) OR RIGHT$(t$,1)=CHR$(228) THEN GOTO 1080 1060 SOUND 2,600 1070 GOTO 780 1080 IF (INSTR(z$,LEFT$(t$,1))-INSTR(z$,LEFT$(f$,1)))<>1 THEN SOUND 2,600:GOTO 780 1090 ct=0 1100 IF tj2=0 THEN GOTO 1140 1110 tj1a=0:tj1b=0:c$(0,0)=e$(p) 1120 GOSUB 2920:GOSUB 2360 1130 pf=1:ct=0:GOTO 1350 1140 ORIGIN 0,0,(tj1a*4-3)*16,(tj1a*4)*16+10,398-tj1b*16+2,2 1150 ct=0:CLG 0 1160 ORIGIN 0,0,0,640,0,400 1170 jj=d(tj1a,2)-tj1b 1180 d(tj1a,2)=tj1b-1 1190 IF d(tj1a,2)<d(tj1a,1) THEN d(tj1a,1)=d(tj1a,2) 1200 IF d(tj1a,2)=0 THEN GOTO 1350 1210 PEN 2:PAPER 2:FOR j=1 TO 5 1220 LOCATE tj1a*4-2,tj1b+j-1 1230 PRINT STRING$(4,250):NEXT 1240 q=ASC(RIGHT$(c$(tj1a,tj1b-1),1)) 1250 IF q=226 OR q=229 THEN PEN 1 ELSE PEN 3 1260 LOCATE tj1a*4-2,tj1b 1270 PRINT MID$(c$(tj1a,tj1b-1),INSTR(c$(tj1a,tj1b-1)," ")+1) 1280 LOCATE tj1a*4-1,tj1b+4 1290 PRINT c$(tj1a,tj1b-1) 1300 PLOT (tj1a*4+4)*16-112,398-tj1b*16+18,1 1310 DRAW (tj1a*4+4)*16-50,398-tj1b*16+18 1320 DRAW (tj1a*4+4)*16-50,318-tj1b*16+18 1330 DRAW (tj1a*4+4)*16-112,318-tj1b*16+18 1340 DRAW (tj1a*4+4)*16-112,398-tj1b*16+18 1350 kk=d(tj1a,2)+1 1360 IF pf=1 THEN kk=0:jj=0 1370 FOR j=j1b+1 TO j1b+jj+1 1380 c$(j1a,j)=c$(tj1a,kk) 1390 kk=kk+1:IF pf=1 THEN kk=0 1400 d(j1a,2)=d(j1a,2)+1 1410 PEN 2:PAPER 2:FOR k=1 TO 5 1420 LOCATE j1a*4-2,j+k 1430 PRINT STRING$(4,250):NEXT 1440 q=ASC(RIGHT$(c$(j1a,j),1)) 1450 IF q=226 OR q=229 THEN PEN 1 ELSE PEN 3 1460 LOCATE j1a*4-2,j+1 1470 PRINT MID$(c$(j1a,j),INSTR(c$(j1a,j)," ")+1) 1480 LOCATE j1a*4-1,j+5 1490 PRINT c$(j1a,j) 1500 PLOT (j1a*4+4)*16-112,398-j*16+2,1 1510 DRAW (j1a*4+4)*16-50,398-j*16+2 1520 DRAW (j1a*4+4)*16-50,318-j*16+2 1530 DRAW (j1a*4+4)*16-112,318-j*16+2 1540 DRAW (j1a*4+4)*16-112,398-j*16+2 1550 NEXT:GOTO 780 1560 WHILE INKEY$<>"":WEND 1570 PEN 1:PAPER 0:LOCATE 31,lc 1580 j2=0:j3=0 1590 g$=UPPER$(INKEY$) 1600 IF g$="" THEN GOTO 1590 1610 SOUND 2,250,2 1620 IF g$="1" THEN g$="0" 1630 zz=INSTR(z$,g$) 1640 IF zz>0 THEN PRINT g$(zz);" of "; 1650 IF g$=CHR$(32) THEN GOSUB 2960:GOSUB 2560:RETURN 1660 IF g$=CHR$(127) THEN RETURN 1670 IF g$="E" THEN GOTO 3260 1680 IF INSTR(z$,g$)=0 THEN SOUND 2,600:GOTO 1590 1690 WHILE INKEY$<>"":WEND 1700 h$=UPPER$(INKEY$) 1710 IF h$="" THEN GOTO 1700 1720 SOUND 2,400,2 1730 IF h$=CHR$(32) THEN GOSUB 2960:GOSUB 2560:RETURN 1740 IF h$=CHR$(127) THEN RETURN 1750 IF h$="E" THEN GOTO 3260 1760 IF INSTR("CDHS",h$)=0 THEN SOUND 2,600:GOTO 1700 1770 n=INSTR("CDHS",h$) 1780 IF n=0 THEN GOTO 1700 1790 LOCATE 31,lc+1:PRINT h$(n) 1800 g$=g$+CHR$(n+225):j1a=1 1810 j1b=d(j1a,1) 1820 IF RIGHT$(c$(j1a,j1b),2)=g$ THEN GOTO 1950 1830 j1b=j1b+1 1840 IF j1b<=d(j1a,2) THEN GOTO 1820 1850 j1a=j1a+1 1860 IF j1a<8 THEN GOTO 1810 1870 j1a=0:j1b=0:j2=1 1880 IF RIGHT$(e$(p),2)=g$ THEN GOTO 1950 1890 j2=0:j3=1 1900 j3=1 1910 IF RIGHT$(f$(j3),2)=g$ THEN GOTO 1950 1920 j3=j3+1 1930 IF j3>4 THEN g$=CHR$(127):j3=0:RETURN 1940 GOTO 1910 1950 RETURN 1960 pf=0 1970 IF tj2 THEN GOSUB 2920:GOSUB 2360:pf=1:GOTO 2190 1980 ORIGIN 0,0,(j1a*4-3)*16,(j1a*4)*16+10,398-j1b*16+2,2 1990 CLG 0 2000 ORIGIN 0,0,0,640,0,400 2010 d(j1a,2)=d(j1a,2)-1 2020 IF d(j1a,2)<d(j1a,1) THEN d(j1a,1)=d(j1a,2) 2030 IF d(j1a,2)=0 THEN GOTO 2190 2040 PEN 2:PAPER 2 2050 FOR j=1 TO 5 2060 LOCATE j1a*4-2,j1b+j-1 2070 PRINT STRING$(4,250):NEXT 2080 q=ASC(RIGHT$(c$(j1a,j1b-1),1)) 2090 IF q=226 OR q=229 THEN PEN 1 ELSE PEN 3 2100 LOCATE j1a*4-2,j1b 2110 PRINT MID$(c$(j1a,j1b-1),INSTR(c$(j1a,j1b-1)," ")+1) 2120 LOCATE j1a*4-1,j1b+4 2130 PRINT c$(j1a,j1b-1) 2140 PLOT (j1a*4+4)*16-112,398-j1b*16+18,1 2150 DRAW (j1a*4+4)*16-50,398-j1b*16+18 2160 DRAW (j1a*4+4)*16-50,318-j1b*16+18 2170 DRAW (j1a*4+4)*16-112,318-j1b*16+18 2180 DRAW (j1a*4+4)*16-112,398-j1b*16+18 2190 PEN 2:PAPER 2 2200 FOR j=5 TO 1 STEP -1 2210 LOCATE ((n-1) MOD 2)*5+31,15-(2-6*(n>2)+j) 2220 PRINT STRING$(4,250):NEXT 2230 q=ASC(RIGHT$(f$,1)) 2240 IF q=226 OR q=229 THEN PEN 1 ELSE PEN 3 2250 LOCATE ((n-1) MOD 2)*5+31,10-(2-6*(n>2)) 2260 IF LEFT$(f$,1)="0" OR LEFT$(f$,1)="1" THEN f$="10"+RIGHT$(f$,1) ELSE f$=" "+f$ 2270 PRINT MID$(f$,INSTR(f$," ")+1) 2280 LOCATE ((n-1) MOD 2)*5+32,10-(2-6*(n>2))+4 2290 PRINT f$:f$=RIGHT$(f$,2) 2300 PLOT 480+((n-1) MOD 2)*80,288-96*(n>2),1 2310 DRAW 544+((n-1) MOD 2)*80,288-96*(n>2) 2320 DRAW 544+((n-1) MOD 2)*80,208-96*(n>2) 2330 DRAW 480+((n-1) MOD 2)*80,208-96*(n>2) 2340 DRAW 480+((n-1) MOD 2)*80,286-98*(n>2) 2350 f$(n)=f$:RETURN 2360 e$(p)="" 2370 np=np-1 2380 IF np<0 THEN np=0:RETURN 2390 p=p-1:IF p<1 THEN p=24 2400 IF e$(p)="" AND np>0 THEN GOTO 2390 2410 RETURN 2420 IF tj2 THEN GOTO 2460 2430 j1a=tj1a:j1b=tj1b 2440 IF tj1b<d(tj1a,2) THEN SOUND 2,600:RETURN 2450 IF tj2=0 THEN GOTO 2480 2460 IF RIGHT$(e$(p),1)<>RIGHT$(f$(n),1) THEN SOUND 2,600:RETURN 2470 IF(INSTR(z$,MID$(e$(p),2,1))-INSTR(z$,LEFT$(f$(n),1)))<>1 THEN SOUND 2,600:RETURN ELSE GOTO 2500 2480 IF RIGHT$(c$(j1a,j1b),1)<>RIGHT$(f$(n),1) THEN SOUND 2,600:RETURN 2490 IF (INSTR(z$,MID$(c$(j1a,j1b),2,1))-INSTR(z$,LEFT$(f$(n),1)))<>1 THEN SOUND 2,600:RETURN 2500 GOSUB 1960:RETURN 2510 ee=0:FOR j=1 TO 7 2520 IF d(j,2)=0 THEN ee=j:j=7 2530 NEXT 2540 IF ee=0 THEN RETURN 2550 ct=0:j1a=ee:j1b=0:RETURN 2560 IF np=0 THEN GOTO 3220 2570 PEN 1:PAPER 0:LOCATE 33,16 2580 PRINT"Twist":FOR xx=1 TO 3 2590 IF np1>np OR np<2 THEN GOSUB 2790 2600 IF np1>1 AND np2=1 THEN GOSUB 2850 2610 p=p+1 2620 IF ct>np THEN GOTO 3000 2630 IF p>24 THEN p=1 2640 IF e$(p)="" THEN GOTO 2610 2650 PEN 2:PAPER 2:FOR m=1 TO 5 2660 LOCATE 36,19+m 2670 PRINT STRING$(4,250):NEXT 2680 n=ASC(RIGHT$(e$(p),1)) 2690 IF n=226 OR n=229 THEN PEN 1 ELSE PEN 3 2700 LOCATE 36,20 2710 PRINT MID$(e$(p),INSTR(e$(p)," ")+1) 2720 LOCATE 37,24:PRINT e$(p) 2730 PLOT 560,96,1:DRAW 622,96 2740 DRAW 622,16:DRAW 560,16 2750 DRAW 560,96 2760 FOR xx1=1 TO 100:NEXT 2770 np1=np1+1:NEXT 2780 ct=ct+1:RETURN 2790 np1=1:PLOT 480,96,0 2800 DRAW 542,96:PEN 0:PAPER 0 2810 np2=1:FOR zz=1 TO 5 2820 LOCATE 31,19+zz 2830 PRINT STRING$(4,250):NEXT 2840 RETURN 2850 PEN 1:PAPER 2:np2=0 2860 FOR zz=1 TO 5 2870 LOCATE 31,19+zz 2880 PRINT STRING$(4,250):NEXT 2890 PLOT 480,96,1:DRAW 542,96 2900 DRAW 542,16:DRAW 480,16 2910 DRAW 480,96:RETURN 2920 PEN 2:PAPER 2:FOR m=1 TO 5 2930 LOCATE 36,19+m 2940 PRINT STRING$(4,250):NEXT 2950 RETURN 2960 ORIGIN 0,0,480,620,112,192 2970 CLG 0 2980 ORIGIN 0,0,0,640,0,400 2990 SOUND 2,100,3:RETURN 3000 GOSUB 2960 3010 PEN 1:PAPER 0:LOCATE 31,14 3020 PRINT"You lost" 3030 LOCATE 31,15:PRINT"this game" 3040 SOUND 2,2000,200 3050 LOCATE 33,17:PRINT "Press" 3060 LOCATE 33,18:PRINT "SPACE" 3070 WHILE INKEY$<>"":WEND 3080 WHILE INKEY(47)<0:WEND 3090 GOTO 150 3100 GOSUB 2960 3110 PEN 1:PAPER 0:LOCATE 31,14 3120 PRINT"Well done" 3130 LOCATE 32,15:PRINT"you win" 3140 FOR jj=100 TO 35 STEP -1 3150 SOUND 2,jj,5:NEXT 3160 GOTO 3050 3170 pp=0:FOR pp1=1 TO 7 3180 IF d(pp1,1)>1 THEN pp=1 3190 NEXT 3200 IF pp=0 AND np=0 THEN GOTO 3100 3210 RETURN 3220 PEN 0:PAPER 0:FOR pp=19 TO 24 3230 LOCATE 36,pp 3240 PRINT STRING$(4,250):NEXT 3250 RETURN 3260 GOSUB 2960 3270 PEN 1:PAPER 0 3280 LOCATE 31,14:PRINT"End game" 3290 LOCATE 31,16:PRINT"Are you" 3300 LOCATE 31,17:PRINT"sure?" 3310 WHILE INKEY$<>"":WEND 3320 i$=UPPER$(INKEY$) 3330 IF i$="" THEN GOTO 3320 3340 IF i$="N" THEN g$=CHR$(127):h$=CHR$(127):GOTO 2960 3350 IF i$<>"Y" THEN GOTO 3320 3360 GOTO 150 3370 CLS 3380 PLOT 1000,1000,3 3390 FOR jj=0 TO 638 STEP 6 3400 MOVE jj,0:DRAW jj,398:NEXT 3410 PLOT 1000,1000,2 3420 FOR jj=0 TO 398 STEP 6 3430 MOVE 0,jj:DRAW 638,jj:NEXT 3440 kk=0:FOR jj=0 TO 92 3450 PLOT jj*6+kk*3,jj*4,1 3460 DRAW 638-jj*6,jj*4+kk*2 3470 DRAW 638-jj*6-kk*3,398-jj*4 3480 DRAW jj*6,398-jj*4-kk*2 3490 DRAW jj*6+kk*3,jj*4 3500 kk=kk+1:NEXT:GOSUB 3990 3510 RESTORE 3890 3520 FOR n=1 TO 5:READ j$(n):NEXT 3530 FOR n=1 TO 5:READ z$ 3540 j$(n)=j$(n)+z$:NEXT 3550 j$(0)=STRING$(34,32) 3560 j$(6)=j$(0):PEN 0:PAPER 3 3570 FOR n=0 TO 6:LOCATE 4,n+2 3580 FOR p=1 TO LEN(j$(n)) 3590 IF MID$(j$(n),p,1)="*" THEN PRINT CHR$(251); ELSE PRINT " "; 3600 NEXT:NEXT 3610 PLOT 48,272,2:DRAW 590,272 3620 DRAW 590,382:DRAW 48,382 3630 DRAW 48,272:PEN 2:PAPER 0 3640 LOCATE 13,10 3650 PRINT" By Robin Nixon " 3660 PEN 1:PAPER 2:LOCATE 5,11 3670 PRINT" (c) Computing with the Amstrad " 3680 PEN 1:PAPER 0:FOR jj=13 TO 22 3690 LOCATE 2,jj 3700 PRINT STRING$(38,250);:NEXT 3710 PLOT 16,48,2:DRAW 622,48 3720 DRAW 622,208:DRAW 16,208 3730 DRAW 16,48:PEN 3:PAPER 2 3740 LOCATE 3,14 3750 PRINT" Press the following to pick a card " 3760 PEN 0:PAPER 3:LOCATE 8,16 3770 PRINT" A 2 3 4 5 6 7 8 9 1 J Q K " 3780 LOCATE 8,17 3790 PRINT" C D H S " 3800 PEN 3:PAPER 2:LOCATE 11,19 3810 PRINT" SPACE = Twist " 3820 LOCATE 11,20 3830 PRINT" DEL = Delete move " 3840 LOCATE 11,21 3850 PRINT" E = End game " 3860 PEN 2:PAPER 0:LOCATE 10,24 3870 PRINT" Press SPACE to start " 3880 RETURN 3890 DATA " *** *** *** ***" 3900 DATA " * * * * * * " 3910 DATA " *** *** * * " 3920 DATA " * * * * * " 3930 DATA " * * * * ***" 3940 DATA " *** * * *** *** " 3950 DATA " * ** * * * " 3960 DATA " ** **** * ** " 3970 DATA " * * ** * * " 3980 DATA " *** * * *** *** " 3990 FOR jj=1 TO 1000:NEXT 4000 FOR jj=0 TO 398 STEP 2 4010 PLOT 0,jj,2 4020 PLOT 638,jj,2 4030 IF jj=0 OR jj=398 THEN kk=2 ELSE kk=1 4040 PLOT 2,jj,kk:DRAW 636,jj 4050 NEXT 4060 RETURN |