256 Cards Trick

[bplus]

Steve RE: 27 Cards Trick

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

I have to say, with each row 12 cards more than a deck of cards, it's a little more work finding your card.