27 Cards Trick presented with QB64

[bplus]

I love this card trick, so I share.

It's a nice trick to pick a card from 27 with only 3 clues but to place that card anywhere you please among the 27 so that you can deal cards out to that number with that card is pretty cool.

Huh? OK might be clearer to see the demo, this is a computer sim of how a human could do it:

Here is source code to .exe

Code Select Expand


OPTION _EXPLICIT

_TITLE "27 Cards Trick" ' B+ started 2019-11-06
' Saw this on Internet after Steve's Flip It link   https://www.youtube.com/watch?v=l7lP9y7Bb5g
' Cool! I wonder if it works half as well as computer program? Let's see!
' So I barrowed Steve's Cards and some code for the presentation.
' 2019-11-08 some changes in wording per jack's suggestion and added do again option.

DEFINT A-Z
CONST cardW = 72, cardH = 96, marg = 50, mint = &HFF88DDAA

DIM SHARED Deck(51) AS INTEGER
DIM SHARED CardImage AS LONG: CardImage = _LOADIMAGE("Cards.bmp", 32)
DIM SHARED xSpace, ySpace
DIM SHARED table(0 TO 8, 0 TO 2) ' store card indexes as layed out each time
DIM SHARED stack0(0 TO 8), stack1(0 TO 8), stack2(0 TO 8)

DIM fav, cardsAbove, nines, threes, ones, remains, col, row, i, p$, pick$, f$, pass

SCREEN _NEWIMAGE(800, 600, 32)
_SCREENMOVE 200, 60
RANDOMIZE TIMER

WHILE _KEYDOWN(27) = 0
    favAgain:
    COLOR &HFFAAAAFF, &HFF000044: CLS
    yCP 160, "* * *  The 27 Cards Trick  * * *"
    yCP 200, "I present to you a 27 cards trick I learned from the Internet."
    yCP 220, "I will shuffle the deck, and lay out 27 cards in 3 rows."
    yCP 240, "You just need to pick a card and tell me which row the card is in."
    yCP 260, "I will deal cards 2 more times and ask for the row the card is in now."
    yCP 280, "I will then show you your card."
    COLOR mint
    inputG 132, 320, "But first, enter your favorite number between 1 and 27 (inclusive)", f$, 4
    fav = VAL(f$)
    cardsAbove = fav - 1
    IF fav > 0 AND fav < 28 THEN
        ones = INT(cardsAbove / 9)
        remains = cardsAbove - 9 * ones
        threes = INT(remains / 3)
        nines = remains - threes * 3
    ELSE
        yCP 340, "Number needs to be > 0 and < 28. Try again."
        _DELAY 2
        GOTO favAgain
    END IF

    CLS
    Shuffle
    xSpace = (_WIDTH - 2 * marg) / 9
    ySpace = (_HEIGHT - 2 * marg) / 3

    FOR i = 1 TO 3
        IF i = 1 THEN
            pass = nines: p$ = "Choose any card then enter the row: 1, 2 or 3 that card is on >"
        ELSEIF i = 2 THEN
            pass = threes: p$ = "Again, enter the row: 1, 2 or 3 that the card is on now >"
        ELSEIF i = 3 THEN
            pass = ones: p$ = "One last time, enter the row: 1, 2 or 3 that the card is now on >"
        END IF
        tryAgain:
        deal27
        inputG (_WIDTH - 8 * LEN(p$)) / 2, _HEIGHT - 40, p$, pick$, 5
        IF INSTR("123", pick$) THEN
            stacks2deck pass, pick$
        ELSE
            'go back and get a proper row
            GOTO tryAgain
        END IF
    NEXT

    CLS: i = 0
    FOR row = 0 TO 2
        FOR col = 0 TO 8
            DisplayCard col * xSpace + marg, row * ySpace + marg, Deck(i)
            i = i + 1
            LINE (_WIDTH - 100, _HEIGHT - 100)-STEP(100, 100), &HFF000044, BF
            Text _WIDTH - 98, _HEIGHT - 98, 80, mint, _TRIM$(STR$(i))
            IF i = fav THEN GOTO quiz
            _DELAY .5
        NEXT
    NEXT

    quiz:
    p$ = "Isn't that your card at your favorite number," + STR$(fav) + ", on the end?"
    inputG 50, _HEIGHT - 40, p$, f$, 5
    CLS
    p$ = "Want to see the trick again? enter y for yes, any other for no >"
    inputG (_WIDTH - 8 * LEN(p$)) / 2, _HEIGHT / 2 + 10, p$, f$, 15
    IF LCASE$(f$) <> "y" THEN CLS: END
WEND

SUB deal27
    DIM col, row, i
    CLS
    FOR col = 0 TO 8
        FOR row = 0 TO 2
            DisplayCard col * xSpace + marg, row * ySpace + marg, Deck(i)
            table(col, row) = Deck(i)
            i = i + 1
            _DELAY .1
        NEXT
    NEXT
    FOR col = 0 TO 8
        stack0(col) = table(col, 0)
        stack1(col) = table(col, 1)
        stack2(col) = table(col, 2)
    NEXT
END SUB

' I am sure there is a less awkward way to do this but I am eager to share
SUB stacks2deck (place, pick$)
    DIM i, j
    SELECT CASE place
        CASE 0 'make deck 0-8 = picked stack
            FOR i = 0 TO 8
                SELECT CASE pick$
                    CASE "1": Deck(i) = stack0(i)
                        FOR j = 9 TO 17
                            Deck(j) = stack1(j - 9)
                        NEXT
                        FOR j = 18 TO 26
                            Deck(j) = stack2(j - 18)
                        NEXT
                    CASE "2": Deck(i) = stack1(i)
                        FOR j = 9 TO 17
                            Deck(j) = stack2(j - 9)
                        NEXT
                        FOR j = 18 TO 26
                            Deck(j) = stack0(j - 18)
                        NEXT
                    CASE "3": Deck(i) = stack2(i)
                        FOR j = 9 TO 17
                            Deck(j) = stack0(j - 9)
                        NEXT
                        FOR j = 18 TO 26
                            Deck(j) = stack1(j - 18)
                        NEXT
                END SELECT
            NEXT
        CASE 1 'make deck 9-17= picked stack
            FOR i = 9 TO 17
                SELECT CASE pick$
                    CASE "1": Deck(i) = stack0(i - 9)
                        FOR j = 0 TO 8
                            Deck(j) = stack1(j)
                        NEXT
                        FOR j = 18 TO 26
                            Deck(j) = stack2(j - 18)
                        NEXT
                    CASE "2": Deck(i) = stack1(i - 9)
                        FOR j = 0 TO 8
                            Deck(j) = stack2(j)
                        NEXT
                        FOR j = 18 TO 26
                            Deck(j) = stack0(j - 18)
                        NEXT
                    CASE "3": Deck(i) = stack2(i - 9)
                        FOR j = 0 TO 8
                            Deck(j) = stack0(j)
                        NEXT
                        FOR j = 18 TO 26
                            Deck(j) = stack1(j - 18)
                        NEXT
                END SELECT
            NEXT
        CASE 2 'make deck 18-26 = picked stack
            FOR i = 18 TO 26
                SELECT CASE pick$
                    CASE "1": Deck(i) = stack0(i - 18)
                        FOR j = 0 TO 8
                            Deck(j) = stack1(j)
                        NEXT
                        FOR j = 9 TO 17
                            Deck(j) = stack2(j - 9)
                        NEXT
                    CASE "2": Deck(i) = stack1(i - 18)
                        FOR j = 0 TO 8
                            Deck(j) = stack2(j)
                        NEXT
                        FOR j = 9 TO 17
                            Deck(j) = stack0(j - 9)
                        NEXT
                    CASE "3": Deck(i) = stack2(i - 18)
                        FOR j = 0 TO 8
                            Deck(j) = stack0(j)
                        NEXT
                        FOR j = 9 TO 17
                            Deck(j) = stack1(j - 9)
                        NEXT
                END SELECT
            NEXT
    END SELECT
END SUB

SUB DisplayCard (x, y, index)
    DIM suit, value
    suit = index \ 13: value = index MOD 13
    _PUTIMAGE (x, y)-STEP(cardW, cardH), CardImage, 0, (value * cardW, suit * cardH)-STEP(cardW, cardH)
END SUB

SUB yCP (y, s$) 'for xmax pixel wide graphics screen Center Print at pixel y row
    _PRINTSTRING ((_WIDTH - LEN(s$) * 8) / 2, y), s$
END SUB

SUB Shuffle
    DIM i
    FOR i = 0 TO 51: Deck(i) = i: NEXT 'put the cards in the deck
    FOR i = 0 TO 51: SWAP Deck(i), Deck(INT(RND * 52)): NEXT
END SUB

'INPUT for Graphics screen
SUB inputG (x, y, prmpt$, var$, expectedLenVar%) 'input for a graphics screen x, y is where the prompt will start , returns through var$
    DIM tmp$, k$, saveAD
    saveAD = _AUTODISPLAY
    _KEYCLEAR
    _PRINTSTRING (x, y), prmpt$ + " {}"
    DO
        k$ = INKEY$
        IF LEN(k$) = 1 THEN
            SELECT CASE ASC(k$)
                CASE 13: var$ = tmp$: EXIT SUB
                CASE 27: var$ = "": EXIT SUB
                CASE 8 'backspace
                    IF LEN(tmp$) THEN
                        IF LEN(tmp$) = 1 THEN tmp$ = "" ELSE tmp$ = LEFT$(tmp$, LEN(tmp$) - 1)
                    END IF
                CASE ELSE: IF ASC(k$) > 31 THEN tmp$ = tmp$ + k$
            END SELECT
            _PRINTSTRING (x, y), prmpt$ + " {" + tmp$ + "}" + SPACE$(expectedLenVar% - LEN(tmp$)) 'spaces needed at end to clear backspace chars
            IF saveAD <> -1 THEN _DISPLAY
        END IF
        _LIMIT 120
    LOOP
END SUB

SUB Text (x, y, textHeight, K AS _UNSIGNED LONG, txt$)
    DIM fg AS _UNSIGNED LONG, cur&, I&, mult, xlen
    fg = _DEFAULTCOLOR
    'screen snapshot
    cur& = _DEST
    I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
    _DEST I&
    COLOR K, _RGBA32(0, 0, 0, 0)
    _PRINTSTRING (0, 0), txt$
    mult = textHeight / 16
    xlen = LEN(txt$) * 8 * mult
    _PUTIMAGE (x, y)-STEP(xlen, textHeight), I&, cur&
    COLOR fg
    _FREEIMAGE I&
END SUB



Attached in zip is source, exe and cards.bmp file:

If still not clear, I left youTube ref link in source code.

[Pfaber11]

Yes very cool trick. Thanks for sharing.