Author Topic: 256 Cards Trick  (Read 3872 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
256 Cards Trick
« on: November 10, 2019, 07:06:05 pm »
Steve RE: 27 Cards Trick
Quote
I saw the same video for this trick, and tried to amp it up to 256 cards — 4 rows of 64, dealt and chosen 4 times, but I got myself lost working it out.  Theory says it should work (and I can find the card doing so), but I can’t position it where I want in the deck yet.

I was thinking ASCII is 256 characters, so 256 choices would be nice, but I just flubbed it up somewhere.  Maybe you’d want to take a shot to step it up a notch and give it a go.  (Heck, afterwards, you can even share the code/exe with the video guys.  Maybe they’ll give a little shout out to us and raise a little more QB64 interest out there in WWWland!)

OK Steve here it is!
Code: QB64: [Select]
  1.  
  2. _TITLE "256 Cards Trick" ' B+ started 2019-11-06 from 27 Cards Trick
  3. ' Saw this on Internet after Steve's Flip It link   [youtube]https://www.youtube.com/watch?v=l7lP9y7Bb5g[/youtube]
  4. ' Cool! I wonder if it works half as well as computer program? Let's see!
  5. ' So I barrowed Steve's Cards and some code for the presentation.
  6. ' 2019-11-08 some changes in wording per jack's suggestion and added do again option.
  7. ' 2019-11-10 27 Cards Trick mod 2 attempt a more elegant stacking sub, good success!
  8. ' eliminated several variables and arrays.
  9. ' 2019-11-10 OK try 256 Cards Trick! This ought to be good! ;-))
  10.  
  11. CONST xmax = 1284, ymax = 500, cardW = 18, cardH = 40, marg = 2, xSpace = 20, ySpace = 50, mint = &HFF88DDAA, deepblue = &HFF000044
  12.  
  13. DEFINT A-Z
  14. DIM SHARED Deck(255)
  15. DIM SHARED table(0 TO 63, 0 TO 3) ' store card indexes as layed out each time
  16. DIM SHARED pass(1 TO 4)
  17. DIM fav, cardsAbove, col, row, i, p$, pick$, f$, remains
  18.  
  19. SCREEN _NEWIMAGE(xmax, ymax, 32)
  20. _SCREENMOVE 70, 100
  21.  
  22. WHILE _KEYDOWN(27) = 0
  23.     favAgain:
  24.     COLOR &HFFAAAAFF, deepblue: CLS
  25.     yCP 160, "* * *  The 256 Cards Trick  * * *"
  26.     yCP 200, "I present to you a 256 cards trick a modified 27 Cards Trick I learned from the Internet."
  27.     yCP 220, "I will shuffle the deck, and lay out 256 cards in 4 rows."
  28.     yCP 240, "You just need to pick a card and tell me which row the card is in."
  29.     yCP 260, "I will deal cards 3 more times and ask for the row the card is in now."
  30.     yCP 280, "I will then show you your card."
  31.     COLOR mint
  32.     p$ = "But first, enter your favorite number between 1 and 256 (inclusive)"
  33.     inputG (_WIDTH - (LEN(p$) + 6) * 8) / 2, 320, p$, f$, 4
  34.     fav = VAL(f$)
  35.     cardsAbove = fav - 1
  36.     IF fav > 0 AND fav < 257 THEN
  37.         pass(4) = INT(cardsAbove / 64)
  38.         remains = cardsAbove - 64 * pass(4)
  39.         pass(3) = INT(remains / 16)
  40.         remains = remains - 16 * pass(3)
  41.         pass(2) = INT(remains / 4)
  42.         pass(1) = remains - 4 * pass(2)
  43.     ELSE
  44.         yCP 340, "Number needs to be > 0 and < 257. Try again."
  45.         _DELAY 2
  46.         GOTO favAgain
  47.     END IF
  48.  
  49.     CLS
  50.     Shuffle
  51.     FOR i = 1 TO 4
  52.         IF i = 1 THEN
  53.             p$ = "Choose any card then enter the row: 1, 2, 3 or 4 that card is on >"
  54.         ELSEIF i = 2 OR i = 3 THEN
  55.             p$ = "Again, enter the row: 1, 2, 3 or 4 that the card is on now >"
  56.         ELSEIF i = 4 THEN
  57.             p$ = "One last time, enter the row: 1, 2, 3 or 4 that the card is now on >"
  58.         END IF
  59.         tryAgain:
  60.         deal256
  61.         inputG (_WIDTH - 8 * LEN(p$)) / 2, _HEIGHT - 40, p$, pick$, 5
  62.         IF INSTR("1234", pick$) THEN
  63.             stacks2deck pass(i), pick$
  64.         ELSE
  65.             'go back and get a proper row
  66.             GOTO tryAgain
  67.         END IF
  68.     NEXT
  69.  
  70.     CLS: i = 0
  71.     FOR row = 0 TO 4
  72.         FOR col = 0 TO 63
  73.             drawCard col * xSpace + marg, row * ySpace + marg, Deck(i)
  74.             i = i + 1
  75.             LINE (_WIDTH - 100, _HEIGHT - 100)-STEP(100, 100), &HFF000044, BF
  76.             Text _WIDTH - 98, _HEIGHT - 98, 40, mint, _TRIM$(STR$(i))
  77.             IF i = fav THEN GOTO quiz
  78.             _DELAY .05
  79.         NEXT
  80.     NEXT
  81.  
  82.     quiz:
  83.     p$ = "Isn't that your card at your favorite number," + STR$(fav) + ", on the end?"
  84.     inputG 50, _HEIGHT - 40, p$, f$, 5
  85.     CLS
  86.     p$ = "Want to see the trick again? enter y for yes, any other for no >"
  87.     inputG (_WIDTH - 8 * LEN(p$)) / 2, _HEIGHT / 2 + 10, p$, f$, 15
  88.     IF LCASE$(f$) <> "y" THEN CLS: END
  89.  
  90. SUB deal256
  91.     DIM col, row, i
  92.     COLOR , deepblue: CLS
  93.     FOR col = 0 TO 63
  94.         FOR row = 0 TO 3
  95.             drawCard col * xSpace + marg, row * ySpace + marg, Deck(i)
  96.             table(col, row) = Deck(i)
  97.             i = i + 1
  98.             _DELAY .01
  99.         NEXT
  100.     NEXT
  101.  
  102. ' I am sure there is a less awkward way to do this but I am eager to share, mod 2 YES! there is!
  103. SUB stacks2deck (place, pick$)
  104.     DIM nPick, i
  105.     nPick = VAL(pick$) - 1
  106.     FOR i = 0 TO 63
  107.         Deck(i + place * 64) = table(i, nPick)
  108.         Deck(i + ((place + 1) MOD 4) * 64) = table(i, ((nPick + 1) MOD 4))
  109.         Deck(i + ((place + 2) MOD 4) * 64) = table(i, ((nPick + 2) MOD 4))
  110.         Deck(i + ((place + 3) MOD 4) * 64) = table(i, ((nPick + 3) MOD 4))
  111.     NEXT
  112.  
  113. SUB yCP (y, s$) 'for xmax pixel wide graphics screen Center Print at pixel y row
  114.     _PRINTSTRING ((_WIDTH - LEN(s$) * 8) / 2, y), s$
  115.  
  116. SUB Shuffle
  117.     DIM i
  118.     FOR i = 0 TO 255: Deck(i) = i: NEXT 'put the cards in the deck
  119.     FOR i = 0 TO 255: SWAP Deck(i), Deck(INT(RND * 256)): NEXT
  120.  
  121. 'INPUT for Graphics screen
  122. SUB inputG (x, y, prmpt$, var$, expectedLenVar%) 'input for a graphics screen x, y is where the prompt will start , returns through var$
  123.     DIM tmp$, k$, saveAD
  124.     saveAD = _AUTODISPLAY
  125.     _KEYCLEAR
  126.     _PRINTSTRING (x, y), prmpt$ + " {}"
  127.     DO
  128.         k$ = INKEY$
  129.         IF LEN(k$) = 1 THEN
  130.             SELECT CASE ASC(k$)
  131.                 CASE 13: var$ = tmp$: EXIT SUB
  132.                 CASE 27: var$ = "": EXIT SUB
  133.                 CASE 8 'backspace
  134.                     IF LEN(tmp$) THEN
  135.                         IF LEN(tmp$) = 1 THEN tmp$ = "" ELSE tmp$ = LEFT$(tmp$, LEN(tmp$) - 1)
  136.                     END IF
  137.                 CASE ELSE: IF ASC(k$) > 31 THEN tmp$ = tmp$ + k$
  138.             END SELECT
  139.             _PRINTSTRING (x, y), prmpt$ + " {" + tmp$ + "}" + SPACE$(expectedLenVar% - LEN(tmp$)) 'spaces needed at end to clear backspace chars
  140.             IF saveAD <> -1 THEN _DISPLAY
  141.         END IF
  142.         _LIMIT 120
  143.     LOOP
  144.  
  145. SUB Text (x, y, textHeight, K AS _UNSIGNED LONG, txt$)
  146.     DIM fg AS _UNSIGNED LONG, cur&, I&, mult, xlen
  147.     fg = _DEFAULTCOLOR
  148.     'screen snapshot
  149.     cur& = _DEST
  150.     I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
  151.     _DEST I&
  152.     COLOR K, _RGBA32(0, 0, 0, 0)
  153.     _PRINTSTRING (0, 0), txt$
  154.     mult = textHeight / 16
  155.     xlen = LEN(txt$) * 8 * mult
  156.     _PUTIMAGE (x, y)-STEP(xlen, textHeight), I&, cur&
  157.     COLOR fg
  158.     _FREEIMAGE I&
  159.  
  160.  
  161. SUB drawCard (x, y, i)
  162.     DIM s4$, clr, c~&, shape, n$, op
  163.     s4$ = DecBase4$(i)
  164.     clr = VAL(MID$(s4$, 1, 1))
  165.     SELECT CASE clr
  166.         CASE 0: c~& = &HFFDD4040
  167.         CASE 1: c~& = &HFF00AA00
  168.         CASE 2: c~& = &HFF0000FF
  169.         CASE 3: c~& = &HFF660055
  170.     END SELECT
  171.     shape = VAL(MID$(s4$, 2, 1))
  172.     n$ = _TRIM$(STR$(4 * VAL(MID$(s4$, 3, 1)) + VAL(MID$(s4$, 4, 1))))
  173.     IF LEN(n$) = 1 THEN op = 4 ELSE op = 0
  174.     LINE (x, y)-STEP(cardW, cardH), &HFFFFFFFF, BF
  175.     COLOR c~&, &HFFFFFFFF
  176.     _PRINTSTRING (x + 1 + op, y + 1), n$
  177.     COLOR &HFF000000
  178.     polygon x + 9, y + 30, 8, shape + 3, _PI(1.5)
  179.     PAINT (x + 9, y + 30), c~&, &HFF000000
  180.     COLOR &HFFFFFFFF, deepblue
  181.  
  182. FUNCTION DecBase4$ (nDec AS INTEGER)
  183.     DIM n AS INTEGER, pow AS INTEGER, d AS INTEGER, b$
  184.     n = nDec 'copy this because or nDec gets changed effecting main code
  185.     FOR pow = 3 TO 0 STEP -1
  186.         IF n >= 4 ^ pow THEN
  187.             d = INT(n / 4 ^ pow)
  188.             b$ = b$ + _TRIM$(STR$(d))
  189.             n = n - d * 4 ^ pow
  190.         ELSE
  191.             b$ = b$ + "0"
  192.         END IF
  193.     NEXT
  194.     DecBase4$ = b$
  195.  
  196. SUB polygon (xOrigin, yOrigin, radius, nVertex, RadianAngleOffset!)
  197.     DIM polyAngle!, x1!, y1!, i, x2!, y2!
  198.     polyAngle! = _PI(2) / nVertex
  199.     x1! = xOrigin + radius * COS(polyAngle! + RadianAngleOffset!)
  200.     y1! = yOrigin + radius * SIN(polyAngle! + RadianAngleOffset!)
  201.     FOR i = 2 TO nVertex + 1
  202.         x2! = xOrigin + radius * COS(i * polyAngle! + RadianAngleOffset!)
  203.         y2! = yOrigin + radius * SIN(i * polyAngle! + RadianAngleOffset!)
  204.         LINE (x1!, y1!)-(x2!, y2!)
  205.         x1! = x2!: y1! = y2!
  206.     NEXT
  207.  

I have to say, with each row 12 cards more than a deck of cards, it's a little more work finding your card.
« Last Edit: November 10, 2019, 07:26:42 pm by bplus »