The QBasic Forum      Other Subforums, Links and Downloads
 Return to Index  

A much longer program to shuffle deck of cards

November 7 2009 at 6:57 AM
Solitaire  (Login Solitaire1)
S


Response to Here's a small amount of code I wrote a few years ago. It gives value + suit in ASCII.

I wrote this several years ago. It displays card name in black and red over a white background, includes option to display short or long names, may add or remove jokers, and can reshuffle numerous times.

=============================================================================

DIM N AS INTEGER, suit AS INTEGER, rank AS INTEGER, x AS INTEGER
DIM J AS INTEGER, D AS INTEGER, mixup AS INTEGER
DIM A AS STRING, B AS STRING, temp AS STRING, E AS STRING
RANDOMIZE TIMER
N = 52: J = 0: D = 0
COLOR 8, 7
DO
    CLS : PRINT , " Display ordered deck of"; N; "cards"
    PRINT
    REDIM deck(N) AS STRING
    FOR suit = 1 TO 4
        SELECT CASE suit
            CASE 1
                IF D = 0 THEN B$ = " of Hearts" ELSE B$ = CHR$(3)
            CASE 2
                IF D = 0 THEN B$ = " of Spades" ELSE B$ = CHR$(6)
            CASE 3
                IF D = 0 THEN B$ = " of Diamonds" ELSE B$ = CHR$(4)
            CASE 4
                IF D = 0 THEN B$ = " of Clubs" ELSE B$ = CHR$(5)
        END SELECT
        FOR rank = 1 TO 13
            x = rank + ((suit - 1) * 13)
            SELECT CASE rank
                CASE 1
                    IF D = 0 THEN A$ = " Ace" ELSE A$ = " A"
                CASE 11
                    IF D = 0 THEN A$ = " Jack" ELSE A$ = " J"
                CASE 12
                    IF D = 0 THEN A$ = " Queen" ELSE A$ = " Q"
                CASE 13
                    IF D = 0 THEN A$ = " King" ELSE A$ = " K"
                CASE ELSE
                    A$ = STR$(rank)
            END SELECT
            IF D = 0 THEN deck$(x) = A$ + B$ ELSE deck(x) = " " + B$ + A$
        NEXT rank
    NEXT suit
    IF N = 54 THEN
        IF D = 0 THEN deck$(53) = " Joker" ELSE deck$(53) = " ? ?"
        IF D = 0 THEN deck$(54) = " Joker" ELSE deck$(54) = " ? ?"
    END IF
    FOR rank = 1 TO 13
        x = rank
        FOR suit = 1 TO 4
            IF INSTR(deck$(x), "Hearts") OR INSTR(deck$(x), "Diamonds") OR INSTR(deck$(x), CHR$(3)) OR INSTR deck$(x), CHR$(4)) THEN
                COLOR 4
            ELSE
                COLOR 0
            END IF
            PRINT TAB(suit * 20 - 20); deck$(x);
            x = x + 13
        NEXT suit
        PRINT
    NEXT rank
    IF N = 54 THEN
        COLOR 1
        PRINT deck$(53); TAB(20); deck$(54)
    END IF
    COLOR 8
    PRINT : PRINT : PRINT TAB(8); "Press any key to shuffle the deck."
    E$ = INPUT$(1)
    DO
        CLS : PRINT , " Display shuffled deck of"; N; "cards"
        PRINT
        FOR x = 1 TO N       'swap array positions randomly
            mixup = INT(RND * N - x + 1) + x
            temp$ = deck$(mixup)
            deck$(mixup) = deck$(x)
            deck$(x) = temp$
        NEXT x

        FOR rank = 1 TO 13
            x = rank
            FOR suit = 1 TO 4
                IF INSTR(deck$(x), "Hearts") OR INSTR(deck$(x), "Diamonds") OR INSTR(deck$(x), CHR$(3)) OR INSTR(deck$(x), CHR$(4)) THEN
                    COLOR 4
                ELSEIF deck$(x) = " Joker" OR deck$(x) = " ? ?" THEN
                    COLOR 1
                ELSE
                    COLOR 0
                END IF

                PRINT TAB(suit * 20 - 20); deck$(x);
                x = x + 13
            NEXT suit
            PRINT
        NEXT rank
        IF N = 54 THEN
            FOR x = 53 TO 54
                IF INSTR(deck$(x), "Hearts") OR INSTR(deck$(x), "Diamonds") OR INSTR(deck$(x), CHR$(3)) OR INSTR(deck$(x), CHR$(4)) THEN
                    COLOR 4
                ELSEIF deck$(x) = " Joker" OR deck$(x) = " ? ?" THEN
                    COLOR 1
                ELSE
                    COLOR 0
                END IF
                PRINT deck$(x); TAB(20);
            NEXT x
        END IF
        COLOR 8
        PRINT : PRINT
        PRINT TAB(4); "Press any key to shuffle the deck again, Enter to reorder, J to include"
        PRINT TAB(4); "or remove jokers, D to change long or short display, Q or Esc to quit."
        E$ = UCASE$(INPUT$(1))
        IF E$ = "J" THEN J = NOT J
        IF E$ = "D" THEN D = NOT D
        IF J = 0 THEN N = 52 ELSE N = 54
    LOOP UNTIL E$ = "Q" OR E$ = CHR$(27) OR E$ = CHR$(13) OR E$ = "J" OR E$ = "D"
LOOP UNTIL E$ = "Q" OR E$ = CHR$(27)
COLOR 7, 0
END


 
 Respond to this message   

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums