Data commit

Task/Playing-cards/ZX-Spectrum-Basic/playing-cards.basic

@@ -0,0 +1,122 @@
+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