123 lines
3.0 KiB
Plaintext
123 lines
3.0 KiB
Plaintext
10 GOSUB 5000
|
|
20 CLS
|
|
30 PRINT "Options:"
|
|
40 PRINT "1: Shuffle deck"
|
|
50 PRINT "2: Deal cards"
|
|
60 PRINT "3: Display deck"
|
|
70 INPUT o
|
|
80 IF o<1 OR o>3 OR o<>INT o THEN GOTO 70
|
|
90 GO SUB (o+1)*1000
|
|
100 GO TO 20
|
|
|
|
999 REM convert index to card
|
|
1000 LET s=INT ((x-1)/13)+1
|
|
1010 LET p=x-13*(s-1)
|
|
1020 LET n=s-2*INT (s/2)+1
|
|
1030 LET c$=p$(p)+CHR$ 16+CHR$ (n AND n>1)+s$(s): REM colour codes to force red or black
|
|
1040 RETURN
|
|
|
|
1999 REM shuffle - only a naive shuffle algorithm but it'll do; the modularity of the program means this is easy enough to modify
|
|
2000 CLS : PRINT FLASH 1;"Shuffling..."
|
|
2010 LET s=1: REM changing s allows shuffling the remainder of an undealt deck, say
|
|
2020 FOR x=1 TO 100
|
|
2030 LET a=INT (RND*53-s)+s
|
|
2040 LET b=INT (RND*53-s)+s
|
|
2050 LET n=d(a)
|
|
2060 LET d(a)=d(b)
|
|
2070 LET d(b)=n
|
|
2080 NEXT x
|
|
2090 RETURN
|
|
|
|
2999 REM deal
|
|
3000 INPUT "How many players? ";p
|
|
3010 INPUT "How many cards? ";c
|
|
3020 IF c<1 OR p<1 OR c<>INT c OR p<>INT p THEN PRINT "Don't be silly!": GO TO 3000
|
|
3030 IF c*p>52 THEN PRINT "Not enough cards for that!": GO TO 3000
|
|
3040 CLS : DIM h(p,c)
|
|
3050 LET k=1
|
|
3060 FOR f=1 TO c
|
|
3070 FOR e=1 TO p
|
|
3080 LET h(e,f)=d(k)
|
|
3090 LET k=k+1
|
|
3100 NEXT e
|
|
3110 NEXT f
|
|
3120 FOR e=1 TO p
|
|
3130 PRINT "Player ";e;"'s hand:"
|
|
3140 FOR f=1 TO c
|
|
3150 LET x=h(e,f)
|
|
3160 GO SUB 1000
|
|
3170 PRINT c$;" ";
|
|
3180 NEXT e
|
|
3190 PRINT
|
|
3200 NEXT f
|
|
3210 PRINT
|
|
3220 PRINT "Remaining deck:"
|
|
3230 IF c*p=52 THEN PRINT "none"
|
|
3240 GO SUB 4010
|
|
3250 RETURN
|
|
|
|
3999 REM display deck
|
|
4000 CLS : LET k=1
|
|
4010 FOR y=k TO 52: REM enter here with k>1 to show the rest of an undealt deck
|
|
4020 LET x=d(y)
|
|
4030 GO SUB 1000
|
|
4040 PRINT c$
|
|
4050 NEXT y
|
|
4060 FOR y=0 TO 1000
|
|
4070 NEXT y
|
|
4080 RETURN
|
|
|
|
4999 REM initialise
|
|
5000 DIM d(52)
|
|
5010 GO SUB 6000
|
|
5020 LET s$=CHR$ 144+CHR$ 145+CHR$ 146+CHR$ 147: REM or LET s$="HSDC" if you don't want symbols
|
|
5030 LET p$="A23456789TJQK"
|
|
5040 FOR x=1 TO 52
|
|
5050 LET d(x)=x
|
|
5060 NEXT x
|
|
5070 RETURN
|
|
|
|
5999 REM characters - the ZX Spectrum character set doesn't contain suit symbols
|
|
6000 RESTORE 7000
|
|
6010 FOR x=65368 TO 65399
|
|
6020 READ a
|
|
6030 POKE x,a
|
|
6040 NEXT x
|
|
6050 RETURN
|
|
|
|
7000 DATA BIN 01101100: REM 108
|
|
7010 DATA BIN 11111110: REM 254
|
|
7020 DATA BIN 11111110: REM 254
|
|
7030 DATA BIN 11111110: REM 254
|
|
7040 DATA BIN 01111100: REM 124
|
|
7050 DATA BIN 00111000: REM 56
|
|
7060 DATA BIN 00010000: REM 16
|
|
7070 DATA BIN 00000000: REM 0
|
|
|
|
7080 DATA BIN 00010000: REM 16
|
|
7090 DATA BIN 00111000: REM 56
|
|
7100 DATA BIN 01111100: REM 124
|
|
7110 DATA BIN 11111110: REM 254
|
|
7120 DATA BIN 01010100: REM 84
|
|
7130 DATA BIN 00010000: REM 16
|
|
7140 DATA BIN 01111100: REM 124
|
|
7150 DATA BIN 00000000: REM 0
|
|
|
|
7160 DATA BIN 00010000: REM 16
|
|
7170 DATA BIN 00111000: REM 56
|
|
7180 DATA BIN 01111100: REM 124
|
|
7190 DATA BIN 11111110: REM 254
|
|
7200 DATA BIN 01111100: REM 124
|
|
7210 DATA BIN 00111000: REM 56
|
|
7220 DATA BIN 00010000: REM 16
|
|
7230 DATA BIN 00000000: REM 0
|
|
|
|
7240 DATA BIN 00010000: REM 16
|
|
7250 DATA BIN 00111000: REM 56
|
|
7260 DATA BIN 01010100: REM 84
|
|
7270 DATA BIN 11111110: REM 254
|
|
7280 DATA BIN 01010100: REM 84
|
|
7290 DATA BIN 00010000: REM 16
|
|
7300 DATA BIN 01111100: REM 124
|
|
7310 DATA BIN 00000000: REM 0
|