TestDrive Super Store 2.3/TESTDRIVE_2.ISO/realizer/demos/games/bj.rlz

Text File | 1992-09-30 | 10.1 KB | 366 lines

'***********************************************************************
'    BJ.rlz
'
'    BlackJack Program
'
'    Copyright ⌐ 1991-1992 Computer Associates International, Inc.
'    All rights reserved.
'
'***********************************************************************

SetSys(_LoadDir, QSys(_LoadDir) + ";" + QSys(_ProgDir) + "cards")

'Shuffle the card deck
PROC ShuffleDeck
    LOCAL bmp, i
    NextCard = 1
    Deck = StatSort(rnd(NumCards), Deck)
    FOR I = 1 TO 8    'Show cards shuffling
        bmp = IF I MOD 2 THEN "shuff1.bmp" ELSE "shuff2.bmp"
    FormSetObject(10000, _Bitmap, bmp, 2 pct, 12 pct)
    NEXT I
    FormModifyObject(10000, _Close)
END PROC

'Return name of bitmap file containing a card.
FUNC CardName(card)
    RETURN "card" + sprint("P(0)", card) + ".bmp"
END FUNC

'Returns value of a card.  Note special processing for faces
'and aces
FUNC CardValue(card)
    LOCAL num
    num = ((card-1) Mod 13)+1
    SELECT CASE num
    CASE 11 TO 13
        num = 10
    CASE 1
        num = 11
    END SELECT
    RETURN num
END FUNC

'Determines the value of a hand.  Sums cards, and if greater than
'21, sees if it is a soft hand.
FUNC HandValue(cards)
    LOCAL I, value
    value = Sum(cards)
    IF value > 21 THEN
        WHILE Sum(cards = 11)    'while there exists an ace
            FOR I = 1 TO EndValid(cards)    'flip the first
                                   'ace
                IF cards[I] = 11 THEN
                    cards[I] = 1
                    EXIT FOR
                END IF
            NEXT I
            value = Sum(cards)    'still busted?
            IF value < 22 THEN
                EXIT WHILE
            END IF
        END WHILE
    END IF
    RETURN value
END FUNC

'Determine outcome of game, and adjust score appropriately
PROC DoScore(dlhand,playhand,playn)
    IF Bust[playn] THEN
        EXIT PROC
    END IF
    SELECT CASE dlhand
    CASE IS > 21
        IF NHands = 1 THEN
            INPUT "Dealer Broke";
        ELSE
            INPUT "Dealer Broke -- Hand" + Sprint("##", playn) + " wins";
        END IF
        Score = Score + Bet
    CASE IS > playhand
        IF NHands = 1 THEN
            INPUT "You Lose";
        ELSE
            INPUT "Hand" + Sprint("##", playn) + " loses";
        END IF
        Score = Score - Bet
    CASE playhand
        IF NHands = 1 THEN
            INPUT "Push";
        ELSE
            INPUT "Push -- Hand" + Sprint("##", playn);
        END IF
    CASE ELSE
        IF NHands = 1 THEN
            INPUT "You Win";
        ELSE
            INPUT "Hand" + Sprint("##", playn) + " wins";
        END IF
        Score = Score + Bet
    END SELECT
END PROC

'Deal one card.  tdeck contains the cards in that deck, which
'is 1 for the dealer and 2 or 3 for the player
PROC DealCard(tdeck,which)
    LOCAL ncards, crd
    ncards = CardsHand[which]
    crd = Deck[NextCard]
    IF which = 1 THEN
        FormSetObject(which*100 + ncards, _Bitmap, CardName(crd), 18*ncards pct, 12 pct)
    ELSE
        FormSetObject(which*100 + ncards, _Bitmap, CardName(crd), (which - 2)*20 + 2 pct, 7*ncards + 52 pct)
    END IF
    CardsHand[which] = ncards + 1
    tdeck[ncards+1] = CardValue(crd)
    NextCard = NextCard + 1
END PROC

PROC MakeForm
    LOCAL fontTitle, fontCaption

    fontTitle = FontQUnique
    FontNew(fontTitle; "helv", 24, _Bold)
    fontCaption = FontQUnique
    FontNew(fontCaption; "tms rmn", 12, _Bold)
    formBJ = FormQUnique
    FormNew(formBJ; "BlackJack", _Title + _Close + _Minimize)
    FormControl(_Size; _Center, _Center, 96 pct, 96 pct)
    FormSetObject(6, _CaptionCenter, "Realizer Casino -- Blackjack", fontTitle, 0 pct, 1 pct, 100 pct, _Default)
    FormSetObject(Hit, _DefButton, "Deal", 2 pct, 42 pct, 13 pct, _Default)
    FormSetObject(Stand, _Button, "Quit", 22 pct, 42 pct, 13 pct, _Default)
    FormSetObject(210, _GroupBox, "", 47 pct, 53 pct, 51 pct, 46 pct)
    FormSetObject(208, _CaptionCenter, "Double down on first two cards only.", fontCaption, 50 pct, 56 pct, 47 pct, _Default; _Blue)
    FormSetObject(207, _CaptionCenter, "Dealer hits on 16, stands on 17.", fontCaption, 50 pct, 61 pct, 47 pct, _Default; _Blue)
    FormSetObject(211, _CaptionCenter, "$5 minimum bet. $300 maximum bet.", fontCaption, 50 pct, 66 pct, 47 pct, _Default; _Blue)
    FormSetObject(209, _CaptionCenter, "Blackjack pays 2-1.", fontCaption, 50 pct, 71 pct, 47 pct, _Default; _Blue)
    FormSetObject(4, _CaptionCenter, Sprint("You have $#####.##", Score), fontCaption, 50 pct, 78 pct, 47 pct, _Default; _Red)
    FormSetObject(5, _CaptionLeft, "Bet:", fontCaption, 65 pct, 87 pct; _Red)
    FormSetObject(3, _EditText, "5.00", 72 pct, 86.5 pct, 12 pct, _Default)
    FormSetProc(formprocBJ)
    FormControl(_Show)
    FontSelect(fontCaption)
    FontControl(_Close)
    FontSelect(fontTitle)
    FontControl(_Close)
END PROC

'Change Hit/Stand buttons to Deal/Quit
PROC SetBut1
    FormModifyObject(Hit, _Normal, "Deal")
    FormModifyObject(Stand, _Normal, "Quit")
END PROC

'Display Hit, Stand, Double, Split, and Surrender buttons
PROC SetBut2
    FormModifyObject(Hit, _Normal, "Hit")
    FormModifyObject(Stand, _Normal, "Stand")
    FormSetObject(Double, _Button, "Double", 42 pct, 42 pct, 13 pct, _Default)
    FormSetObject(Split, _Button, "Split", 62 pct, 42 pct, 13 pct, _Default)
    FormSetObject(Surrender, _Button, "Surrender", 82 pct,  42 pct, 13 pct, _Default)
END PROC

'Remove Double, Split, Surrender buttons.  Remove all cards.
'Update score.
PROC ClearForm
    LOCAL I,J
    FOR I = 12 TO 14
        FormModifyObject(I, _Close)
    NEXT I
    FOR J = 0 TO NHands
        FOR I = 1 TO CardsHand[J+1]
            FormModifyObject(J*100 + I + 99, _Close)
        NEXT I
    NEXT J
    FormModifyObject(4, _Normal, Sprint("You have $#####.##", Score))
END PROC

'This procedure processes clicks on buttons and cards.
'buttonp contains the number of the form item clicked upon.
'Returns 1 if the hand is over
FUNC ProcessButton(buttonp)
    LOCAL junk, button
    button = buttonp
    'Fake the proper hit
    IF button = Hit THEN
        button = (1 + CurHand)*100
    END IF
    SELECT CASE button
    CASE Surrender
        Score = Score - Bet/2
        RETURN 1
    CASE 200 TO 299    'Clicked in hand 1
        IF CurHand = 2 THEN
            RETURN 0
        END IF
        DealCard(Players, 2)
        IF HandValue(Players) > 21 THEN
            Score = Score - Bet
            Bust[1] = 1
            INPUT "You Broke";
            IF NHands = 1 THEN
                RETURN 1
            ELSE
                CurHand = 2
                RETURN 0
            END IF
        END IF
    CASE IS >= 300    'Clicked in hand 2
        CurHand = 2
        DealCard(Players2, 3)
        IF HandValue(Players2) > 21 THEN
            Score = Score - Bet
            INPUT "You Broke";
            Bust[2] = 1
            IF Bust[1] THEN
                RETURN 1
            ELSE
                RETURN ProcessButton(Stand)
            END IF
        END IF
    CASE Stand
        IF CurHand <> NHands THEN
            CurHand = CurHand + 1
            EXIT SELECT
        END IF
        FormSetObject(100, _Bitmap, CardName(DownCard), 2 pct, 12 pct)    'Dealers turn
        WHILE HandValue(Dealers) < 17
            DealCard(Dealers, 1)
        END WHILE
        junk = HandValue(Dealers)    'Update score
        DoScore(junk,HandValue(Players), 1)
        IF NHands = 2 THEN
            DoScore(junk, HandValue(Players2), 2)
        END IF
        RETURN 1
    CASE Double
        Bet = 2*Bet
        IF NOT ProcessButton(Hit) THEN      'Deal one card
            junk = ProcessButton(Stand)    'Dealers turn
        END IF
        RETURN 1
    CASE Split
        NHands = 2
        'Be tricky
        NextCard = NextCard - 1
        IF Players[1] = 1 THEN
            Players[1] = 11    'If splitting aces,
                        'change first ace back
                        'to an 11
        END IF
        DealCard(Players2, 3)
        CardsHand[2] = 1
        DealCard(Players, 2)
        DealCard(Players2, 3)
    END SELECT
    RETURN 0
END FUNC

'This procedure processes all events in the blackjack playing
'form.  The global variable State can have three values:  0 means
'that the Deal/Quit buttons are visible.  1 means that
'the hands were just dealt, and thus the Hit and Stand buttons
'are visible, as well as Double and Split if
'applicable.  2 means that the player has already played one
'card, and thus cannot Double or Split.
PROC formprocBJ(params)
    'Only process buttons
    FormSelect(params[_FormNum])
    IF params[_Invoke] <> _Click THEN
        EXIT PROC
    END IF
    event = params[_ItemNum]    'See what button was hit
    IF NOT State THEN    'State indicates the state -- if it
                      'is zero, expect a Deal or a Quit
        IF event = Stand THEN    'Really a Quit button
            'Close the form
            FormControl(_Close)
            EXIT PROC
        ELSEIF event = Hit THEN    'Really a Deal button
            Bet = StrToNum(FormQStr(3))
            IF Bet >= 5 and Bet <= 300 THEN
                'Switch states
                State = 1
                'Do initialization
                Bust[1] = 0
                Bust[2] = 0
                CardsHand[1] = 1
                CardsHand[2] = 0
                CardsHand[3] = 0
                NHands = 1
                CurHand = 1
                SetBut2
                'Clear all cards from the deck arrays
                CLEAR Players, Players2, Dealers
                'Check for reshuffle
                IF NumCards - NextCard < 20 THEN
                    ShuffleDeck
                END IF
                'Deal dealer
                FormSetObject(100, _Bitmap, "back.bmp", 2 pct,  12 pct)
                DownCard = Deck[NextCard]
                Dealers[1] = CardValue(Deck[NextCard])
                NextCard = NextCard + 1
                DealCard(Players, 2)
                DealCard(Dealers, 1)
                DealCard(Players, 2)
                'Check for BlackJack
                IF HandValue(Players) = 21 THEN
                    INPUT "BlackJack";
                    Score = Score + 2*Bet
                    'Reset the form
                    ClearForm()
                    SetBut1()
                    'Now back to state 0
                    State = 0
                ELSEIF Players[1] <> Players[2] AND  Players[1] <> 1 THEN
                    FormModifyObject(Split, _Gray)
                END IF
            ELSE    'Bad bet
                IF Bet < 5 THEN
                    INPUT "Table minimum is $5";
                ELSE
                    INPUT "There's a $300 Maximum at this table, Tex";
                END IF
            END IF
        END IF
    ELSE        'Expecting Hit, Stand, etc.
        IF State = 1 THEN
            'Need to clear out buttons that can no longer use
            FormModifyObject(Split, _Gray)
            FormModifyObject(Surrender, _Gray)
            FormModifyObject(Double, _Gray)
            'And switch states
            State = 2
        END IF
        'Process the event.  If the return value is 0, then it
        'is time to reset and return to state 0
        IF ProcessButton(event) THEN
            ClearForm
            SetBut1
            State = 0
        END IF
    END IF
END PROC


'Here is where the program begins

NumCards = 52
Deck = ((Index(NumCards) - 1) Mod 52) + 1    'Initialize deck
NextCard = NumCards
ShowCount = 0
Finished = 0
Score = 0
Bet = 5
State = 0
hit = 1
stand = 11
double = 12
split = 13
surrender = 14

RANDOMIZE StrToNum(Sprint("D(s1)", QDate)) / 7

MakeForm()