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