GoFish!_jaba

GoFish! v.10.1.1
Additional code for interactive play.
Semi-AI computer play.
Computer's card selected automatically and randomly.
Human player must click card to complete action.
by jaba 11/09/11

[play]
    auto=1                              '<--- add this line
    hBox=hWnd(#1.g)                     'graphicbox window handle
.
.
.
[loop]
.
        if player=1 AND auto=1 then goto [checkIndex]  '<--- add this line
 
    'set up mouse click event handlers
    #1.g "setfocus; when leftButtonUp [checkIndex]"
.
.
.
[checkP1Index]  'computer selects card to click on
    if auto=1 then                       '<--- add these 7 lines
        i=int(rnd(1)*nP1cards)+1
        cardSelected=P1(i)
        cardValue=GetCardValue(P1(i))
        cPos=i
        goto [dealAuto]
    end if
.
    [dealAuto]                            '<--- add this branch label
    'redeal the hand with the selected card repositioned
.
//'end of code mods//

GoFish! card game for Card Contest
v.10.1
No artificial intelligence this version.
Player plays both hands.
by jaba 11/07/11

    'GoFish.bas
    'Author: Jack Burman
    'Date: 11/07/11
 
'   DESCRIPTION OF VERSION 10.1
'   For submission without AI.
 
dim card(52)
dim P1(52), P2(38), P3(52)  'array of cards in rows 1,2,3
dim xP1(52), yP1(52)        'x,y each card, computer hand
dim xP3(52), yP3(52)        'x,y each card, player's hand
dim cardVal(52,13)          'rank (value) each card index
dim rankCnt(13,4)           'count of total cards in hands by rank (value)
dim B1(4), B3(4)            'the 4 cards in a book to be discarded
 
 
    nomainwin
    WindowWidth=800:WindowHeight=550
    UpperLeftX=1:UpperLeftY=1
 
    menu #1, "&File", "E&xit", [quit], "P&lay again", [playAgain]
    menu #1, "&About", "About", [about]
    graphicbox #1.g, 0, 0, 800, 510
    open "Card Game" for window_nf as #1
    #1 "trapclose [quit]"
 
[play]
    hBox=hWnd(#1.g)                     'graphicbox window handle
 
    open "qcard32.dll " for dll as #qc
    call InitializeDeck hBox
    call SetCurrentBack 2
    #1.g "down; fill 0 113 0"           'background color of graphicbox
 
    call DrawSymbol hBox,3,30,50        'placeholder symbols
    call DrawSymbol hBox,2,12,170
    call DrawSymbol hBox,3,30,290
 
 
 
'The RankCnt is the number of any of the 13 card values that
' are in play in the computer hand or the player's hand...
'set the count to zero before dealing any cards
[setRankCntToZero]
    for i = 1 to 13
        rankCnt(i,1)=i
        rankCnt(i,2)=0
    next i
 
 
 
[fillCardArray]
    'put all 52 cards into an array
    for i = 1 to 52
        card(i)=i
    next
 
[shuffleCards]
    'shuffle the 52 card array so card order is mixed up
    for i = 1 to 52
        newIndex=int(rnd(0)*52)+1
        tempCard=card(i)
        card(i)=card(newIndex)
        card(newIndex)=tempCard
    next
 
[fillHandArrays]
    'fill row arrays with the right number of cards before dealing
    '[P1] Computer hand gets first 7 cards in shuffled array
    nP1cards=7
    for i = 1 to nP1cards
        P1(i)=card(i)
        r = GetCardValue(P1(i))         'r=rank of card(i)
        gosub [incrementRankCnt]
        r=0
    next i
 
    '[P2] Draw pile gets 38 cards
    nP2cards=38
    for i = 1 to nP2cards
        P2(i)=card(i+7)
    next i
 
    '[P3] Player hand gets 7 cards
    nP3cards=7
    for i = 1 to nP3cards
        P3(i)=card(i+45)
        r = GetCardValue(P3(i))         'r=rank of card(i)
        gosub [incrementRankCnt]
        r=0
    next i
 
    'sort player's cards
    call sortP3 1, 7, nP3cards
 
[newDeal]
    'deal the first (or new) hand
    yP1=50                              'y coords for rows
    yP2=170
    yP3=290
    margin=0                            'left hand margin (not used)
    reveal=30                           'card overlap (replaces xOffP... offset)
 
    '[P1] Deal Computer hand
    xOffP1=30                           'same as reveal (not used everywhere)
    for i = 1 to nP1cards
        call SetCardStatus P1(i), 0     '<---0 shows back; 1 shows face
        call DealCard hBox, P1(i), margin+i*reveal, yP1
    next
 
    '[P2] Deal draw pile
    xOffP2=12                           'space between cards (reveal)
    for i = 1 to nP2cards
        call SetCardStatus P2(i), 0     '<---0 shows back; 1 shows face
        call DealCard hBox, P2(i), margin+i*xOffP2, yP2
    next
 
    '[P3] Deal player hand
    xOffP3=30
    for i = 1 to nP3cards
        call SetCardStatus P3(i), 1     '<---0 shows back; 1 shows face
        call DealCard hBox, P3(i), margin+i*reveal, yP3
    next
 
    'initialize score display
    scoreP1=0
    scoreP3=0
    #1.g "font arial 11 bold; color green; backcolor 0 113 0"
    #1.g "place 30 40"
    #1.g "\Score:  ";scoreP1
    #1.g "place 30 410"
    #1.g "\Score:  ";scoreP3
 
 
    '******************************************************************************
    '******************************************************************************
 
[loop]
    player=3                            'first to play is human player
    [newTurn]
    'display whos turn
        #1.g "place 30 480" 'was 470
        #1.g "\                   "
        #1.g "place 30 480"
        #1.g "font arial 12 bold; color green; backcolor 0 113 0"
 
        'if a book is discarded, current player keeps play
        if bookRemoved=1 then bookRemoved=0:player=player
        if player=3 then #1.g "\Your play..." else #1.g "\Computer plays..."
 
 
    'set up mouse click event handlers
    #1.g "setfocus; when leftButtonUp [checkIndex]"
 
    [take]
    if player=3 then
        #1.g "setfocus; when leftButtonDouble [takeP1Cards]"
    else
        #1.g "setfocus; when leftButtonDouble [takeP3Cards]"
    end if
    wait
 
 
    '******************************************************************************
    '******************************************************************************
 
[checkIndex]
    'stop trapping mouse clicks
    #1.g "setfocus; when leftButtonUp"
 
    if player=3 then
        gosub [checkP3Index]
        gosub [checkComputerHand]   'see if computer hand holds any selected card
 
'--->When computer hand has no matches:
        if cnt=0 then
            gosub [goFishMsg]           'no match, so draw a card
            gosub [clickPoolHand]       'wait for player to click a pool card
            gosub [drawPoolCard]
            gosub [addToPlayerHand]
 
            'If a book is discarded by drawing a pool card,
            ' start current player's turn over again...
            if bookRemoved=1 then bookRemoved=0:goto [newTurn]
            '...or else, play changes to other player
            if player=3 then player=1:goto [newTurn]
        end if
 
'--->When computer hand has matches:
        if cnt>0 then
            gosub [showComputerHandMatchingCards]
            goto [take]
        end if
 
    'IF PLAYER = 1
    else
        gosub [checkP1Index]            'if player=1 go here
        gosub [checkPlayerHand]         'see if player hand holds any selected card
 
'--->When player hand has no matches:
        if cnt=0 then
            gosub [goFishMsg]           'no match, so draw a card
            gosub [clickPoolHand]       'wait for player to click a pool card
            gosub [drawPoolCard]
            gosub [addToComputerHand]
 
            if bookRemoved=1 then bookRemoved=0:goto [newTurn]
            'play changes to other player
            if player=1 then player=3:goto [newTurn]
        end if
 
'--->When player hand has matches:
        if cnt>0 then
            gosub [showPlayerHandMatchingCards]
            goto [take]
        end if
    end if
    wait
 
[checkP1Index]  'computer selects card to click on
    x=0:y=0
    mx=MouseX   :my=MouseY
 
    'check if mouse is within row of computer's cards
    if NOT (my > 50 AND my < 150) then notice "Try again.":goto [newTurn]
 
    cardSelected=0                      'holds index of clicked card
    cardValue=0                         'holds rank of selected card
 
    for i = 1 to nP1cards
        'if mouse is within visible part of card, get card index
        if mx >i*reveal AND mx <(i+1)*reveal then
            cardSelected=P1(i)
            cardValue=GetCardValue(P1(i))
            cPos=i                      'save card's position in hand
            exit for
        end if
    next i
 
    'redeal the hand with the selected card repositioned
    if cardSelected >0 then
        for i = nP1cards to 1 step -1
            call RemoveCard hBox, P1(i) 'remove all cards
        next i
 
        'deal cards up to selected card
        for i = 1 to cPos-1
            call DealCard hBox, P1(i), margin+i*reveal, yP1
        next i
 
        'deal the selected card
        call SetCardStatus, P1(cPos), 1
        call DealCard hBox, P1(cPos), margin+cPos*reveal, yP1+20
 
        'deal remainder of cards
        for i = (cPos+1) to nP1cards
            call DealCard hBox, P1(i), margin+i*reveal, yP1
        next i
    end if
    return
 
 
[checkP3Index]  'player selects card to click on
    x=0:y=0
    mx=MouseX   :my=MouseY
 
    'check if mouse is within row of player's cards
    if NOT (my > 290 AND my < 390) then notice "Try again.":goto [newTurn]
 
    cardSelected=0                      'holds index of card player clicks on
    cardValue=0                         'holds rank (value) of selected card
 
    for i = 1 to nP3cards
        'if mouse is within visible part of card, get card index
        if mx >i*reveal AND mx <(i+1)*reveal then
            cardSelected=P3(i)
            cardValue=GetCardValue(P3(i))
            cPos=i                      'save card's position in hand
            exit for                    'exit loop when a card is selected
        end if
    next i
 
    ' redeal the hand with the selected card repositioned
    if cardSelected >0 then
        for i = nP3cards to 1 step -1
            call RemoveCard hBox, P3(i)
        next i
 
        ' deal cards up to selected card
        for i = 1 to cPos-1
            call DealCard hBox, P3(i), margin+i*reveal, yP3
        next i
 
        ' deal the selected card
        call DealCard hBox, P3(cPos), margin+cPos*reveal, yP3-20
 
        ' deal remainder of cards
        for i = (cPos+1) to nP3cards
            call DealCard hBox, P3(i), margin+i*reveal, yP3
        next i
    end if
    return
 
[checkComputerHand]
    'See if computer hand holds any matches to selected card
    cnt=0
    redim match(28)
    for i = 1 to nP1cards
        cardChecked=GetCardValue(P1(i))
        if cardChecked=cardValue then
            cnt=cnt+1
            match(i)=P1(i)
        end if
    next i
    return
 
[checkPlayerHand]
    'See if player hand holds any matches to selected card
    cnt=0
    redim match(28)
    for i = 1 to nP3cards
        cardChecked=GetCardValue(P3(i))
        if cardChecked=cardValue then
            cnt=cnt+1
            match(i)=P3(i)
        end if
    next i
    return
 
 
[showComputerHandMatchingCards]
    if cnt=0 then return
    'remove all cards
    for i = nP1cards to 1 step -1
        call RemoveCard hBox, P1(i)
    next i
 
    'save number of P1 cards now
    oldnP1cards=nP1cards
 
    'display hand with matching cards turned over and repositioned
    for i = 1 to nP1cards
        if match(i)>0 then
            call SetCardStatus P1(i), 1
            call DealCard hBox, P1(i), margin+i*xOffP1, yP1+20
        else
            call DealCard hBox, P1(i), margin+i*xOffP1, yP1
        end if
    next i
    return
 
[showPlayerHandMatchingCards]
    if cnt=0 then return
    'remove all cards
    for i = nP3cards to 1 step -1
        call RemoveCard hBox, P3(i)
    next i
 
    'save number of P3 cards now
    oldnP3cards=nP3cards
 
    'display hand with matching cards repositioned
    for i = 1 to nP3cards
        if match(i)>0 then
            call SetCardStatus P3(i), 1
            call DealCard hBox, P3(i), margin+i*reveal, yP3-20
        else
            call DealCard hBox, P3(i), margin+i*reveal, yP3
        end if
    next i
    return
 
[takeP1Cards]
    #1.g "when leftButtonDouble"        'cancel double click handler
    mc=0
    'save player's present card count
    oldnP3cards=nP3cards
 
    'move matching cards to player's hand and increase total card count
    redim newP1(nP1cards)
    j=1
    for i = 1 to nP1cards
        if match(i)>0 then
            P3(nP3cards+1)=P1(i)
            nP3cards=nP3cards+1
            mc=mc+1
        else
            newP1(j)=P1(i)              'track unmatched cards to keep
            j=j+1
        end if
    next i
 
    for i = nP1cards to 1 step -1
        call RemoveCard hBox, P1(i)
    next i
 
    'subtract matched cards from computer hand total card count
    nP1cards=nP1cards-mc
 
    'set flag so cards are not removed a second time in [updateP1Hand]
    P1removed=1
 
    redim P1(28)
    for i = 1 to nP1cards
        P1(i)=newP1(i)                  'update P1 array without matches
    next i
 
    gosub [updateP1Hand]
    gosub [updateP3Hand]
    goto [newTurn]
    wait
 
[takeP3Cards]
    #1.g "when leftButtonDouble"        'cancel double click handler
    mc=0
 
    'save computer hand present card count
    oldnP1cards=nP1cards
 
    'save player hand present card count (just in case?)
    oldnP3cards=nP3cards
 
    'move matching cards to computer hand and increase total card count
    redim newP3(nP3cards)
    j=1
    for i = 1 to nP3cards
        if match(i)>0 then
            P1(nP1cards+1)=P3(i)
            nP1cards=nP1cards+1
            mc=mc+1
        else
            newP3(j)=P3(i)
            j=j+1
        end if
    next i
 
    for i = oldnP3cards to 1 step -1
        call RemoveCard hBox, P3(i)
    next i
 
    'subtract matched cards from player's hand total card count
    nP3cards=nP3cards-mc
 
    'set flag so cards are not removed a second time in [updateP3Hand]
    P3removed=1
 
    redim P3(28)
    for i = 1 to nP3cards
        P3(i)=newP3(i)                  'update P3 array without matches
    next i
 
    gosub [updateP3Hand]
    gosub [updateP1Hand]
    goto [newTurn]
    wait
 
[updateP1Hand]
    'fishing flag indicates a card has been drawn from the pool and added to hand
    if fishing=1 then
        allCards=nP1cards
    else
        allCards=oldnP1cards
    end if
 
    fishing=0                           'cancel flag
 
    'if a book has not been discarded, skip removing all cards
    'otherwise, remove all cards left after discarding the book
    'this should clear all background images and leave blank table for new deal
    if P1removed=0 then
        for i = allCards to 1 step -1
            call RemoveCard hBox, P1(i)
        next i
    end if
    P1removed=0                         'cancel flag
 
    for i = 1 to nP1cards
        call SetCardStatus P1(i), 0     '<--- 0= face down
        call DealCard hBox, P1(i), margin+i*reveal, yP1
    next
 
    'If player 3 has taken cards from computer hand, no need to check
    ' computer's hand for all 4 cards, so skip next routine
    if player=3 then [skipCnt]
 
    'check card count - see if there are 4 of the cardSelected are in play
    gosub [chkCardCnt]
 
    'if all 4 cards of a book are in play, check if all are in one hand
    if maxCnt=1 then gosub [rankInHandP1]
 
    'if all 4 in computer hand, go remove them
    if rankInHand=4 then
        gosub [removeRankSetP1]
        rankInHand=0
        cardSelected=0
    end if
 
    [skipCnt]
    'game is over if no cards left in a hand
    if nP1cards=0 then
        if scoreP1>scoreP3 then
            notice "Game over";chr$(13);"Computer wins!"
            wait
        else
            notice "Game over";chr$(13);"You win!"
        end if
        wait
    end if
    return
 
[updateP3Hand]
    if fishing=1 then
        allCards=nP3cards
    else
        allCards=oldnP3cards
    end if
 
    fishing=0
 
    if P3removed=0 then
        for i = allCards to 1 step -1
            call RemoveCard hBox, P3(i)
        next i
    end if
    P3removed=0
 
    'sort hand (player's hand is only one sorted)
    call sortP3 1, nP3cards, nP3cards
 
    for i = 1 to nP3cards
        call DealCard hBox, P3(i), margin+i*reveal, yP3
    next i
 
    if player=1 then [skipP3Cnt]
 
    'check card count
    gosub [chkCardCnt]
    if maxCnt=1 then gosub [rankInHandP3]
    if rankInHand=4 then
        gosub [removeRankSetP3]
        rankInHand=0
        cardSelected=0
    end if
 
    [skipP3Cnt]
    if nP3cards=0 then
        if scoreP1>scoreP3 then
            notice "Game over";chr$(13);"Computer wins!"
            wait
        else
            notice "Game over";chr$(13);"You win!"
        end if
        wait
    end if
    return
 
[rankInHandP1]
    'checks if all 4 cards are in computer's hand
    rankInHand=0
    for i = 1 to nP1cards
        rank=GetCardValue(P1(i))
        if rank=cardValue then rankInHand=rankInHand+1
    next i
    return
 
[removeRankSetP1]
    'remove the 4 cards of a book from the computer's hand
    for i = nP1cards to 1 step -1
        call RemoveCard hBox, P1(i)     'remove all cards
    next i
 
    redim B1(4)                 'clear any previous counts
    redim newP1(28)             'clear temporary array
    j=1
    k=0
    for i = 1 to nP1cards
        getRank=GetCardValue(P1(i))
        if NOT(getRank=cardValue) then
            newP1(j)=P1(i)
            j=j+1
        else
            k=k+1
            B1(k)=P1(i)
            call SetCardStatus, B1(k), 1    'cards face up
            'place the cards at bottom of window to show
            ' which book is being discarded
            call DealCard hBox, B1(k), 200+k*10, 400
        end if
    next i
 
    nP1cards=nP1cards-rankInHand
    for i = 1 to nP1cards
        P1(i)=newP1(i)
    next i
    for i = 1 to nP1cards
        call SetCardStatus P1(i), 0
        call DealCard hBox, P1(i), margin+i*xOffP1, yP1
    next i
 
    scoreP1=scoreP1+1
    #1.g "font arial 11 bold; color green; backcolor 0 113 0"
    #1.g "place 30 40"
    #1.g "\Score:  ";scoreP1
 
    'display the book for a bit...then remove it
    call Pause 1000                 'adjust to suit
    for i=4 to 1 step -1
        call RemoveCard, hBox, B1(i)
    next i
    bookRemoved=1
    return
 
[rankInHandP3]
    'checks if all 4 cards are in player's hand
    rankInHand=0
    for i = 1 to nP3cards
        rank=GetCardValue(P3(i))
        if rank=cardValue then rankInHand=rankInHand+1
    next i
    return
 
[removeRankSetP3]
    'remove the 4 cards of a book from the player's hand
    for i = nP3cards to 1 step -1
        call RemoveCard hBox, P3(i)
    next i
 
    redim B3(4)
    redim newP3(28)
    j=1
    k=0
    for i = 1 to nP3cards
        getRank=GetCardValue(P3(i))
        if NOT(getRank=cardValue) then
            newP3(j)=P3(i)
            j=j+1
        else
            k=k+1
            B3(k)=P3(i)
            call SetCardStatus, B3(k), 1
            call DealCard hBox, B3(k), 200+k*10, 400
        end if
    next i
 
    nP3cards=nP3cards-rankInHand
    for i = 1 to nP3cards
        P3(i)=newP3(i)
    next i
 
    for i = 1 to nP3cards
        call SetCardStatus P3(i), 1
        call DealCard hBox, P3(i), margin+i*reveal, yP3
    next i
 
    scoreP3=scoreP3+1
    #1.g "font arial 11 bold; color green; backcolor 0 113 0"
    #1.g "place 30 410"
    #1.g "\Score:  ";scoreP3
 
    call Pause 1000
    for i=4 to 1 step -1
        call RemoveCard, hBox, B3(i)
    next i
    bookRemoved=1
    return
 
[goFishMsg]
    if player=3 then
        d=40
    else
        d=430
    end if
    #1.g "place 500 ";d
    #1.g "font Georgia 20 bold;color white; backcolor 0 113 0"
    #1.g "\Go Fish!"
 
    'set flag to indicate will draw a pool card
    fishing=1
    return
 
[clickPoolHand]
    'set doubleclick event
    #1.g "setfocus; when leftButtonDouble [clickPool]"
    wait
 
    'no coords needed because player can click anywhere on table
    ' and will automatically select the topmost card from the pool hand.
 
    'a more complex scheme would allow selecting any card in the pool,
    ' but I don't see any need since it's all random anyway.
 
    '...but don't tell the user; he thinks he has to double click
    ' the selected card to draw from the pool...
    x=0:y=0
    mx=MouseX   :my=MouseY
    [clickPool]
    if player=3 then
        d=30
    else
        d=430
    end if
        'cancel gofish msg
        #1.g "color 0 113 0; backcolor 0 113 0; place ";490; " ";d-30
        #1.g "boxfilled ";650;" ";d+20
        #1.g "when leftButtonDouble"
    return
 
[drawPoolCard]
    'here the topmost card is actually removed from the pool hand
    ' and put in limbo for the current player to take
    limboCard=P2(nP2cards)              'get top card off draw pile
    r = GetCardValue(limboCard)         'r=rank of card(i)
    gosub [incrementRankCnt]            'add card to array of number of cards in play
 
    call SetCardStatus limboCard, 1     '<--- 1 shows face
 
    for i = nP2cards to 1 step -1
        call RemoveCard hBox, P2(i)     'remove all cards
    next i
 
    nP2cards=nP2cards-1                 'remove top card from hand
 
    'if all pool cards gone, game is over
    if nP2cards=0 then
        if scoreP1>scoreP3 then
            notice "Game over";chr$(13);"Computer wins!"
            wait
        else
            notice "Game over";chr$(13);"You win!"
        end if
        wait
    end if
 
    for i = 1 to nP2cards
        call DealCard hBox, P2(i), margin+i*xOffP2, yP2
    next
    return
 
[addToComputerHand]
    'adds pool card to computer hand
    oldnP1cards=nP1cards
    nP1cards=nP1cards+1
    P1(nP1cards)=limboCard
    cardSelected=limboCard
    call SetCardStatus P1(nP3cards), 1
 
    'redraw hand
'    fishing=1          'may be redundant - will check
    gosub [updateP1Hand]
    return
 
[addToPlayerHand]
    'adds pool card to player's hand
    nP3cards=nP3cards+1
    P3(nP3cards)=limboCard
    cardSelected=limboCard
    call SetCardStatus P3(nP3cards), 1
 
    'redraw hand
'    fishing=1
    gosub [updateP3Hand]
    return
 
[incrementRankCnt]
    'counts cards in play of any value
    rankCnt(r,2)=rankCnt(r,2)+1
    return
 
[chkCardCnt]
    'checks if all 4 cards of selected value are in play
    if r>0 then cardValue=r
    if rankCnt(cardValue,2) = 4 then
        maxCnt=1
    else
        maxCnt=0
    end if
    r=0
    return
 
[playAgain]
    'menu selection
    close #qc
    goto [play]
 
[about]
    notice "Help & About"; chr$(13);_
        "GoFish! Card Game";chr$(13);_
        "LB Card Contest submission";chr$(13);_
        "by jaba 11/30/2011";chr$(13);_
        chr$(13);_
        "How to play:";chr$(13);_
        "-Human plays both hands. (No AI yet.)";chr$(13);_
        "-Click card to select it.";chr$(13);_
        "-Double click selected card to take card from";chr$(13);_
        " other hand or fish from pool.";chr$(13);_
        "-You keep your turn if there is a match.";chr$(13);_
        "-All 4 cards of one kind in a hand scores 1 point.";chr$(13);_
        "-Play ends when any row runs out of cards.";chr$(13);_
        "-Highest score wins.";chr$(13);_
        "-Select 'Play Again' from menu to play again..."
    wait
 
[quit]
    close #qc
    close #1
    end
 
'==================================================================
'SUBS AND FUNCTIONS
'==================================================================
 
function GetCardValue(nC)
    calldll #qc, "GetCardValue", _
                nC as long, _
                GetCardValue as long
    end function
 
sub Pause ms
    'pause ms number of milliseconds
    calldll #kernel32, "Sleep",_
    ms as long,_
    re as void
    end sub
 
sub InitializeDeck hndle
    calldll #qc, "InitializeDeck",_
    hndle as ulong,_
    r as long
    end sub
 
sub DealCard hndle,nC,x,y
    'nC is number of card - 1-52
    calldll #qc, "DealCard",_
    hndle as ulong,_
    nC as long,_
    x as long,_
    y as long,_
    r as void
    end sub
 
sub SetCardStatus nC, face
    calldll #qc, "SetCardStatus",_
    nC as long,_
    face as long,_
    r as void
    end sub
 
sub SetCurrentBack nV
    calldll #qc, "SetCurrentBack",_
        nV as long,_
        r as void
        end sub
 
Sub RemoveCard hndle,nC
    'removes a card from screen that was
    'drawn with DealCard, replacing screen background
    calldll #qc, "RemoveCard",hndle as ulong,_
    nC as long,r as void
    End Sub
 
sub sortP3 b, e, nP3
    for i = b to e
        cardVal(i,1)= P3(i)
        cardVal(i,2)= GetCardValue(P3(i))
    next i
 
    sort cardVal(, b, e, 2
    for i = 1 to nP3
        P3(i)=cardVal(b+(i-1),1)
    next i
    end sub
 
Sub DrawSymbol hndle,nV,nx,ny
    calldll #qc, "DrawSymbol",_
        hndle as ulong,_    'handle of graphicbox
        nV as long,_        '1=X 2=O 3=place holder
        nx as long,_        'x location
        ny as long,_        'y location
        re as void          'no return
end sub
 

Go Fish! card game for Card Contest
A work in progress - not complete

'Questions of forum.
'1) In the gofishMsg sub, why don't the cards in the pool hand remove properly;
' and why don't they redisplay properly?
'2) Why is the pool hand so slow to redeal?
'3) The y1, y2, y3 variables are global but do not work right in the
' gofishMsg sub for placing the player's hand. Why not?
'4) Why doesn't the flush command work after redealing the pool hand
' and the player's hand?
 
'52CARDS_sortTest11B
global y1, y2, y3, ccfv, noOfCards1, noOfCards2, noOfCards3, x2Offset, x3Offset
 
dim ind(52,13)        'cardIndex 1-52
dim P1(25,2)          'computer's hand by cardIndex up to 25 cards
dim P2(25,2)          'player's hand by cardIndex up to 25 cards
dim P(38,2)           'pool hand by cardIndex begins with 38 cards
 
[varSetup]
 
'    nomainwin
    WindowWidth=700:WindowHeight=500
    UpperLeftX=1:UpperLeftY=1
 
    menu #1, "&File", "E&xit", [quit]
    graphicbox #1.g, 0, 0, 700, 440
    open "Card Game" for window_nf as #1
    #1 "trapclose [quit]"
 
    hBox=hWnd(#1.g)
 
    open "qcard32.dll " for dll as #qc
 
    call InitializeDeck hBox
    call SetCurrentBack 2
    #1.g "down; fill 10 225 127"
    #1.g "setfocus; when leftButtonDown [checkIndex]"
 
[fillCardArray]
    'using the cardIndex from the dll
    '       clubs A - K:    1-13
    '       diamonds A - K: 14-26
    '       hearts A - K:   27-39
    '       spades A - K:   40-52
    call indexDeck
 
[shuffleCards]
    call shuffleDeck
 
[newDeal]
    x1Offset=48
    y1=10
    '[P1]
    noOfCards1=7
    'Computer hand does not need sorted and is dealt face down
    for i = 1 to noOfCards1
        scan
        'place first 7 cards into computer's hand array
        P1(i,1)=ind(i,1)
        P1(i,2)=ind(i,2)
        call SetCardStatus P1(i,1), 0   '<---change to 0 to hide; 1 to view
        call DealCard hBox, P1(i,1),i*x1Offset,y1
        call Pause 20
    next
 
    '[P]
    x2Offset=12
    y2=150
    noOfCards2=38
    'Pool hand is dealt face down, unsorted
    for i = 1 to noOfCards2
        scan
        'place 38 cards into hand array for card pool
        P(i,1)=ind(i+7,1)
        P(i,2)=ind(i+7,2)
        'set face up=1; face down=0
        call SetCardStatus P(i,1), 0    '<--- set to 0 to hide; 1 to view
        call DealCard hBox, P(i,1),i*x2Offset,y2
        call Pause 20
    next
 
    '[P2]
    x3Offset=48
    y3=300
    noOfCards3=7
    'player's hand needs sorted by rank
    sort ind(, 46, 52, 2
    'create player's hand array
    for i = 1 to noOfCards3
        P2(i,1)=ind(i+45,1)
        P2(i,2)=ind(i+45,2)
    next i
    'deal player's hand
    for i = 1 to noOfCards3
        scan
        'set face up=1
        call SetCardStatus P2(i,1), 1   '<--- set to 0 to hide; 1 to view
        call DealCard hBox, P2(i,1),i*x3Offset,y3
        call Pause 20
    next
    #1.g "flush"
wait
 
[checkIndex]    'activated by leftButtonDown event
    x=0:y=0 'reset values
    cardClicked=0
    mx=MouseX   : my=MouseY 'mouse x and y location
    nCard=InitDrag(hBox, mx, my) 'discover index of card under mouse
    if nCard=0 then wait
 
    'find the leading edge of the card nCard
    for i = 1 to noOfCards3
        cardEdge=i*x3Offset
        if nCard=P2(i,1) then exit for
    next i
    'check if the mouse is within the overlapping area
    ' of the two cards. If so, the clicked card is nCard.
    ' If not, the clicked card is the next one in the array.
    if mx>cardEdge AND mx<(cardEdge+x3Offset) then
        cardClicked=P2(i,1)
        ccfv=P2(i,2)',2)
      else
        cardClicked=P2(i+1,1)
        ccfv=P2(i+1,2)',2)
    end if
 
    'temporary printout for checking index and rank of selection
    'will not be in final program
    #1.g "place 10 420;\Card Index is ";cardClicked
    #1.g "place 200 420;\Face value is ";ccfv
 
    x=GetCardX(cardClicked)
    y=GetCardY(cardClicked)
 
    call AbortDrag     'release DLL mouse capture
    'remove cards in player's hand
    for i = noOfCards3 to 1 step -1
        call RemoveCard hBox, P2(i,1)
    next
    'redeal player's hand with selected card up +50 pixels
    for i = 1 to noOfCards3
        if P2(i,1)=cardClicked then y=y3-50 else y=y3
            call DealCard hBox, P2(i,1),i*x3Offset,y
    next
    '--->   print "Card clicked = ";cardClicked:print
    'check to see if computer has any of the selected cards
    gosub [checkComputerHand]
 
    #1.g "setfocus; when leftButtonDown"    'stop mouse event checking
    #1.g "flush"
wait
 
[checkComputerHand]
    cnt=0
    for i=1 to noOfCards1
        if P1(i,2)=ccfv then
            call SetCardStatus P1(i,1), 1'0 '<--- change to 0 for game
            cnt=cnt+1
        end if
    next i
 
    'if no card in the computer's hand matches the rank
    ' of the selected card, the count is 0 and we Go Fish!
    if cnt=0 then
        call gofishMsg y1
        goto [nomatch]
    end if
 
    for i = noOfCards1 to 1 step -1
        call RemoveCard hBox, P1(i,1)
    next
 
    for i = 1 to noOfCards1
        if GetCardStatus( P1(i,1)) = 1 then y=y1+20 else y=y1
        call DealCard hBox, P1(i,1),i*x1Offset,y'1
    next i
[nomatch]
    return
 
'======================================================================
'THE FOLLOWING SUBS ARE PLACED HERE FOR CONVENIENCE TO FOLLOW CODE
'=======================================================================
 
'If we Go Fish!, we have to get a card from the pool (make it the
' last card in line for simplicity) and add that card to the
' player's hand (haven't worked out the routine for adding the card
' to the computer's hand yet).
'Then we'll remove the player's hand and redeal it with the
' added card and all cards back in line. Somewhere, we have to
' resort because we added a card.
sub gofishMsg y
    d=y+80
    #1.g "place 500 ";d
    #1.g "font Arial 20 bold;color red"
    #1.g "\Go Fish!"
 
    poolCard=P(noOfCards2,1)
    call moveCard poolCard
    call redealPool noOfCards2
 
    for i = noOfCards3 to 1 step -1
        call RemoveCard hBox, P2(i,1)
    next i
    #1.g "down; color 10 225 127; backcolor 10 225 127"
    #1.g "place 12 290; boxfilled 600 400"
    for i = 1 to noOfCards3
        nC=P2(i,1)
        call DealCard hBox, nC,i*x3Offset, 350 'why doesn't y2 work?
    next i
    call Pause 20
    end sub
 
sub moveCard poolCard
'next line for checking in mainwin
print "poolCard is: ";poolCard
    'add this card to player's hand
    noOfCards3=noOfCards3+1
    P2(noOfCards3,1)=P(noOfCards2,1)
    P2(noOfCards3,2)=P(noOfCards2,2)
    call SetCardStatus P2(noOfCards3,1), 1
 
    noOfCards2=(noOfCards2-1)
'next line for checking in mainwin
print noOfCards2
 
    call removePool noOfCards2
'next lines for checking in mainwin
for i = 1 to noOfCards3
    print i;"  - ";P2(i,1), P2(i,2)
next i
    end sub
 
sub removePool noOfCards2
    for i = noOfCards2 to 1 step -1
        call RemoveCard hBox, P(i,1)
    next
    #1.g "down; color 10 225 127; backcolor 10 225 127"
    #1.g "place 12 150; boxfilled 550 248"
'    #1.g "flush"   '<--- why doesn't flush work here?
    end sub
 
sub redealPool noOfCards2
    for i = 1 to noOfCards2
        scan
        nC=P(i,1)
        call DealCard hBox, nC,i*x2Offset, 195'y2 'why doesn't y2 work?
    next
    #1.g "flush"    '<--- why doesn't flush work?
    end sub
 
[quit]
    close #qc
    close #1
    end
 
'========================================================
'------------------- subs and functions -----------------
'========================================================
 
sub indexDeck
    j=0
    for i = 1 to 52
            ind(i,1)=i
            j=j+1
            ind(i,2)=j
            if j=13 then j=0
    next i
    end sub
 
sub shuffleDeck
    for i = 1 to 52
        newIndex=int(rnd(0)*52)+1
        tempCard=ind(i,1)
        tempVal=ind(i,2)
 
        ind(i,1)=ind(newIndex,1)
        ind(i,2)=ind(newIndex,2)
 
        ind(newIndex,1)=tempCard
        ind(newIndex,2)=tempVal
    next
    end sub
 
sub Pause ms
    'pause ms number of milliseconds
    calldll #kernel32, "Sleep",_
    ms as long,_
    re as void
    end sub
 
Sub SetOffSet offset
    calldll #qc, "SetOffSet",offset as long,_
        re as void
    end sub
 
Sub AdjustCardBlocked nC, bValue
    calldll #qc, "AdjustCardBlocked",_
        nC as long, bValue as long, re as void
    end sub
 
Function GetCardBlocked(nC)
    calldll #qc, "GetCardBlocked",nC as long,_
        GetCardBlocked as long
    end function
 
 
sub InitializeDeck hndle
    calldll #qc, "InitializeDeck",_
    hndle as ulong,_
    r as long
    end sub
 
sub DealCard hndle,nC,x,y
    'places cards on window whose handle is hndle at x,y
    'nC is number of card - 1-52 in first deck and
    '53-104 in second deck, if used
    calldll #qc, "DealCard",_
    hndle as ulong,_
    nC as long,_
    x as long,_
    y as long,_
    r as void
    end sub
 
sub SetCardStatus nC, face
    'nC is  number of card - 1-52 in first deck and
    '53-104 in second deck if used
    'face: 0=facedown, 1=faceup
    calldll #qc, "SetCardStatus",_
    nC as long,_
    face as long,_
    r as void
    end sub
 
sub SetCurrentBack nV
    calldll #qc, "SetCurrentBack",_
        nV as long,_
        r as void
        end sub
 
Sub RemoveCard hndle,nC
    'removes a card from screen that was
    'drawn with DealCard, replacing screen background
    calldll #qc, "RemoveCard",hndle as ulong,_
    nC as long,r as void
    End Sub
 
 
Function InitDrag(hndle, x, y)
    calldll #qc, "InitDrag",_
        hndle as ulong, x as long, y as long,_
        InitDrag as long
    end function
 
Sub AbortDrag
    calldll #qc, "AbortDrag",re as void
    end sub
 
Function GetCardX(nC)
    calldll #qc, "GetCardX",_
        nC as long,_    'index of card
        GetCardX as long 'x location of upper corner
    end function
 
Function GetCardY(nC)
    calldll #qc, "GetCardY",_
        nC as long,_    'index of card
        GetCardY as long 'y location of upper corner
    end function
 
Function GetCardStatus(nC)
    calldll #qc, "GetCardStatus", _
        nC as long, _
        GetCardStatus as long
    end function
 
 
 
 

THE FOLLOWING PROGRAM IS SUPERCEDED BY THE ONE ABOVE.
Go Fish! card game for Card Contest
A work in progress - not complete

global y1, y3
 
dim ind(52)        'cardIndex 1-52
dim P1(25)          'computer's hand by cardIndex up to 25 cards
dim P2(25)          'player's hand by cardIndex up to 25 cards
dim P(38)           'pool hand by cardIndex begins with 38 cards
dim card(52,2)      'dbl dim index + face value
[varSetup]
 
nomainwin
    WindowWidth=700:WindowHeight=500
    UpperLeftX=1:UpperLeftY=1
 
    menu #1, "&File", "E&xit", [quit]
    graphicbox #1.g, 0, 0, 700, 440
    open "Card Game" for window_nf as #1
    #1 "trapclose [quit]"
 
    'get graphicbox handle
    hBox=hWnd(#1.g)
 
    'open the dll
    open "qcard32.dll " for dll as #qc
    'initialize the deck
    call InitializeDeck hBox
    'back designs: bubbles=1;blue=2;red=3;mountain=4;purple=5;music=6
    call SetCurrentBack 2
    'paint background
    #1.g "down; fill 10 225 127"
 
    'This action selects the card in the player's hand that he wishes
    ' to ask opponent for.
    'If opponent has this card in his hand, all matches are added to
    ' player's hand.
    'If opponent does not have a matching card, a "Go Fish! message
    ' is issued.
    #1.g "setfocus; when leftButtonDown [checkIndex]"
 
 
[fillCardArray]
    'using the cardIndex from the dll
    '       clubs A - K:    1-13
    '       diamonds A - K: 14-26
    '       hearts A - K:   27-39
    '       spades A - K:   40-52
    call indexDeck
 
[shuffleCards]
    call shuffleDeck
    call dblIndexCards
 
'-------------------------------------------------
'NOTE: Since cards have been shuffled, the card() array holds a randomly
' organized card index, instead of 1 to 52. So, first 7 cards dealt could
' be any card index.
'--------------------------------------------------
[newDeal]
x1Offset=48
y1=10
    '[P1]
    noOfCards1=7
    'Computer hand does not need sorted and is dealt face down
    for i = 1 to noOfCards1
        scan
        'place first 7 cards into computer's hand array
        P1(i)=card(i,1)
        'set face down=0
        call SetCardStatus P1(i), 0   '<---change to 0 when ready
        'window handle, card index number, x, y
        call DealCard hBox, P1(i),i*x1Offset,y1
        call Pause 100
        '--->    print "P1(";i;") = ";card(i,1)
    next
 
    '[P]
x2Offset=12
y2=150
    noOfCards2=38
    'Pool hand is dealt face down, unsorted
    for i = 1 to noOfCards2
        scan
        'place 38 cards into hand array for card pool
        P(i)=card(i+7,1)
        'set face up=1; face down=0
        call SetCardStatus P(i), 0
        'window handle, card index number, x, y
        call DealCard hBox, P(i),i*x2Offset,y2
        call Pause 20
    next
 
    '[P2]
x3Offset=48
y3=300
    noOfCards3=7
    'player's hand needs sorted by rank
    sort card(, 46, 52, 2
    'create player's hand array
    for i = 1 to noOfCards3
        P2(i)=card(i+45,1)
    next i
 
    'deal player's hand
    for i = 1 to noOfCards3
        scan
        'set face up=1
        call SetCardStatus P2(i), 1   '<---change to 0 for down
        'window handle, card index number, x, y
        call DealCard hBox, P2(i),i*x3Offset,y3
        call Pause 100
        '--->   print "P2(";i;") = ";card(i+45,1)
    next
    #1.g "flush"
 
wait
 
[checkIndex]    'activated by leftButtonDown event
    x=0:y=0 'reset values
    cardClicked=0
    mx=MouseX   : my=MouseY 'mouse x and y location
    nCard=InitDrag(hBox, mx, my) 'discover index of card under mouse
    if nCard=0 then wait
 
    for i = 1 to noOfCards3
        cardEdge=i*x3Offset
        if nCard=P2(i) then exit for
    next i
 
    if mx>cardEdge AND mx<(cardEdge+x3Offset) then
        cardClicked=P2(i)
        ccfv=card(P2(i),2)
      else
        cardClicked=P2(i+1)
        ccfv=card(P2(i+1),2)
    end if
 
    for i = 1 to 52
        if card(i,1)=cardClicked then
            ccfv=card(i,2)
            exit for
        end if
    next i
 
    'for checking
    #1.g "place 10 420;\Card Index is ";cardClicked';space$(100)
    #1.g "place 200 420;\Face value is ";ccfv'cardClicked;space$(100)
 
    x=GetCardX(cardClicked)
    y=GetCardY(cardClicked)
 
    call AbortDrag     'release DLL mouse capture
 
    for i = noOfCards3 to 1 step -1
        call RemoveCard hBox, P2(i)
    next
 
    for i = 1 to noOfCards3
        if P2(i)=cardClicked then y=y3-50 else y=y3
            call DealCard hBox, P2(i),i*x3Offset,y
    next
    '--->   print "Card clicked = ";cardClicked:print
 
    gosub [checkComputerHand]
    #1.g "setfocus; when leftButtonDown"    'stop mouse event checking
 
wait
 
[checkComputerHand]
    cnt=0
    for j=1 to noOfCards1
        for i=1 to 52
            if P1(j)=card(i,1) then
                if card(i,2)=ccfv then
                    call SetCardStatus card(i,1), 1'0 '<--- change to 1 for game
                    cnt=cnt+1
                end if
            end if
        next i
    next j
 
    if cnt=0 then 'not sure cnt is ever 0?
        call gofishMsg y1
        goto [nomatch]
    end if
 
    for i = noOfCards1 to 1 step -1
        call RemoveCard hBox, P1(i)
    next
 
    for i = 1 to noOfCards1
        if GetCardStatus( card(i,1)) = 1 then y=y1+20 else y=y1
        call DealCard hBox, card(i,1),i*x1Offset,y'1
    next i
[nomatch]
    return
 
 
sub gofishMsg y
    y=y+80
    #1.g "place 500 ";y
    #1.g "font Arial 20 bold;color red"
    #1.g "\Go Fish!"
    #1.g "font 10 bold;color black"
    end sub
 
 
 
 
[quit]
    close #qc
    close #1
    end
 
'========================================================
'------------------- subs and functions -----------------
'========================================================
 
sub indexDeck
    for i = 1 to 52
        ind(i)=i
    next
    end sub
 
sub shuffleDeck
    for i = 1 to 52
        newIndex=int(rnd(0)*52)+1
        tempCard=ind(i)
        ind(i)=ind(newIndex)
        ind(newIndex)=tempCard
    next
    end sub
 
 
sub dblIndexCards
    for i = 1 to 52
    value = ind(i)
    select case
    case value <= 13
        card(i,1)=value
        card(i,2)=value
    case (value > 13) AND (value <= 26)
        card(i,1)=value
        card(i,2)=value-13
    case (value > 26) AND (value <= 39)
        card(i,1)=value
        card(i,2)=value-26
    case (value > 39)
        card(i,1)=value
        card(i,2)=value-39
    end select
    next i
'for i=1 to 52
'        print card(i,1),card(i,2)
'next i
'print:print
    end sub
 
sub Pause ms
    'pause ms number of milliseconds
    calldll #kernel32, "Sleep",_
    ms as long,_
    re as void
    end sub
 
Sub SetOffSet offset
    calldll #qc, "SetOffSet",offset as long,_
        re as void
    end sub
 
Sub AdjustCardBlocked nC, bValue
    calldll #qc, "AdjustCardBlocked",_
        nC as long, bValue as long, re as void
    end sub
 
Function GetCardBlocked(nC)
    calldll #qc, "GetCardBlocked",nC as long,_
        GetCardBlocked as long
    end function
 
 
sub InitializeDeck hndle
    calldll #qc, "InitializeDeck",_
    hndle as ulong,_
    r as long
    end sub
 
sub DealCard hndle,nC,x,y
    'places cards on window whose handle is hndle at x,y
    'nC is number of card - 1-52 in first deck and
    '53-104 in second deck, if used
    calldll #qc, "DealCard",_
    hndle as ulong,_
    nC as long,_
    x as long,_
    y as long,_
    r as void
    end sub
 
sub SetCardStatus nC, face
    'nC is  number of card - 1-52 in first deck and
    '53-104 in second deck if used
    'face: 0=facedown, 1=faceup
    calldll #qc, "SetCardStatus",_
    nC as long,_
    face as long,_
    r as void
    end sub
 
sub SetCurrentBack nV
    calldll #qc, "SetCurrentBack",_
        nV as long,_
        r as void
        end sub
 
Sub RemoveCard hndle,nC
    'removes a card from screen that was
    'drawn with DealCard, replacing screen background
    calldll #qc, "RemoveCard",hndle as ulong,_
    nC as long,r as void
    End Sub
 
 
Function InitDrag(hndle, x, y)
    calldll #qc, "InitDrag",_
        hndle as ulong, x as long, y as long,_
        InitDrag as long
    end function
 
Sub AbortDrag
    calldll #qc, "AbortDrag",re as void
    end sub
 
Function GetCardX(nC)
    calldll #qc, "GetCardX",_
        nC as long,_    'index of card
        GetCardX as long 'x location of upper corner
    end function
 
Function GetCardY(nC)
    calldll #qc, "GetCardY",_
        nC as long,_    'index of card
        GetCardY as long 'y location of upper corner
    end function
 
Function GetCardStatus(nC)
    calldll #qc, "GetCardStatus", _
        nC as long, _
        GetCardStatus as long
    end function