home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Transactor
/
Transactor_18_1987_Transactor_Publishing.d64
/
shuffle
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2023-02-26
|
1KB
|
50 lines
8000 rem **shuffle subroutine**
8010 rem 8/27/86
8020 rem **dimension arrays**
8030 dim c%(52),c1(26),c2(26):rem (0) not used
8040 print"hit f1 to start"
8050 if peek(197)<>4 then 8050: rem time is part of random factor
8060 rem set up the deck
8070 forx=1to52:c%(x)=x:next:formm=1to10:gosub8130:next
8080 x=rnd(-ti):rem enter here for all subsequent shuffles
8090 sh=int(10*rnd(x)+1)+2: rem change the '10' to suit yourself
8100 formm=1tosh:gosub8130:d=0: rem shuffle random times
8110 next
8120 end: replace this with 'return'
8130 rem **a real shuffle**
8140 c=0:ca=0:cb=0:cc=0:cd=0
8150 print"...shuffle....shuffle..."
8160 fori=1to26:c1(i)=c%(i):c2(i)=c%(i+26):next:rem split deck into two
8170 gosub8400:gosub8250:ifcb>=26then8360
8171 rem deal 1st card from right packet so 1st card changes (just like real!)
8180 gosub8400:gosub8200:ifca>=26then8300
8190 goto8170
8200 rem **riffle cards from left half**
8210 forc=1tor:ca=ca+1:ifca>26thenc=7:return
8220 cd=cd+1
8230 c%(cd)=c1(ca)
8240 next:return
8250 rem**riffle cards from right half**
8260 forc=1tor:cb=cb+1:ifcb>26thenc=5:return
8270 cd=cd+1
8280 c%(cd)=c2(cb):next
8290 return
8300 rem **shuffle balance of left**
8310 forc=cbto26:cb=cb+1:ifcb>26thenreturn
8320 cd=cd+1
8330 c%(cd)=c2(cb):next
8340 return
8350 rem **shuffle balance of right**
8360 forc=cato26:ca=ca+1:ifca>26thenreturn
8370 cd=cd+1
8380 c%(cd)=c1(ca):next
8390 return
8400 x=rnd(-ti)
8410 r=4*rnd(x)+1
8420 return
9000 rem ***this is for you to verify there is one and only one of each
9010 rem number in the array c%(x). use 'goto 9000' and note that
9020 rem each left hand number occurs once only.
9030 forx=1to56:forjj=1to52:ifc%(jj)=xthenprintx;jj
9040 next:next:end