Older Version
Newer Version
JanetTerra
Aug 18, 2011
This is a work in progress... [[code format="lb"]] ' Card DLL Contest ' Anandis ' http://www.pagat.com/invented/anandis.html ' August, 2011 ' Uses Qcard32.dll, a freeware library of playing card images. ' DLL by Stephen Murphy. Qcard32.DLL website: ' http://www.telusplanet.net/public/stevem/ ' Rules ' 2 Players ' 17 card deck (4 Aces, 12 face cards, one Joker) ' 8 cards alternately dealt to each player ' Last card is placed face down in middle of table ' Object of the game is to guess the card in the middle ' Player opposite the dealer starts first ' Play options are ' Guess the card in the middle ' Correct guess = WIN game ' Incorrect guess = LOSE game ' Either way, game ends ' Play a card ' Opponent lays down all cards of the ' same suit and same rank ' Play then passes to the opposing player ' Pass the Joker ' If held, the player may pass the Joker ' to the opposing player, forcing that ' player to play ' A player with less than 2 cards MUST ' guess the middle card ' Winner is the best of 7 hands WindowWidth = 800 WindowHeight = 500 UpperLeftX = Int((DisplayWidth - WindowWidth) / 2) UpperLeftY = Int((DisplayHeight - WindowHeight) / 2) graphicbox #main.g, 0, 0, 800, 500 open "Simple Anandis" for window as #main #main "trapclose [quit]" hGbox = hWnd(#main.g) #main.g "down; color 0 192 0; backcolor 0 192 0" #main.g "font verdana 12 bold" #main.g "place 0 0; boxfilled 800 500; flush bg" #main.g "place 355 305; boxfilled 425 385" #main.g "flush clearGuess" #main.g "color black" #main.g "place 365 325" #main.g "\ ???" #main.g "\Guess" #main.g "\ Card" #main.g "\ ???" #main.g "flush playerGuess" #main.g "color 0 192 0" ' Initialize the deck call InitializeDeck hGbox call SetCurrentBack 3 ' Select (by number) only the cards to be used ' 11 = Jack Clubs, 24 = Jack Diamonds ' 37 = Jack Hearts, 50 = Jack Spades dim dCards(17) dCards(1) = 11 dCards(2) = 24 dCards(3) = 37 dCards(4) = 50 ' 12 = Queen Clubs, 25 = Queen Diamonds ' 38 = Queen Hearts, 51 = Queen Spades dCards(5) = 12 dCards(6) = 25 dCards(7) = 38 dCards(8) = 51 ' 13 = King Clubs, 26 = King Diamonds ' 39 = King Hearts, 52 = King Spades dCards(9) = 13 dCards(10) = 26 dCards(11) = 39 dCards(12) = 52 ' 1 = Ace Clubs, 14 = Ace Diamonds ' 27 = Ace Hearts, 40 = Ace Spades dCards(13) = 1 dCards(14) = 14 dCards(15) = 27 dCards(16) = 40 ' 110 = Joker dCards(17) = 110 ' Set up array to hold nCards to shuffle dim nCards(17) ' Set up an array to hold visibility of cards dim iCards(17) ' Set up array to hold xCards to determine best guess dim xCards(17) ' Fill arrays call InitCards ' Set up array to hold cards dim hand1(2, 8) dim hand2(2, 8) ' (1, = computer's hand ' (2, = player's hand ' , 1-8) = nCard ' , 9: 1-8 = nCard ' Set GameInProgressFlag GameInProgressFlag = 0 ' Select dealer dealer = int(rnd(1) * 2) + 1 if dealer = 1 then human = 2 computer = 1 else human = 1 computer = 2 end if ' Define coordinates x1 = 50 ' x of dealt cards x2 = 50 ' x of revealed cards y1 = 300 ' y of human cards y2 = 30 ' y of computer cards [AnnounceDealer] call AnnounceDealer dealer [ShuffleCards] ' Remove cards from hand redim hand1(2, 8) redim hand2(2, 8) ' Shuffle the cards call ShuffleCards dealer ' Deal the cards call NewDeal dealer, hGbox [AnnouncePlayer] if dealer = human then playerTurn = computer else playerTurn = human end if call AnnouncePlayer playerTurn if playerTurn = human then ' Human's Turn #main.g "when leftButtonDown [PlayerClick]" wait end if ' Computer's Turn wait [quit] close #qc close #main end [PlayerClick] xPos = MouseX yPos = MouseY clickCard = -1 select case case yPos < 300 clickCard = 0 case yPos > 395 clickCard = 0 case xPos > 400 clickCard = 0 case xPos > 352 clickCard = 9 case xPos > 260 if xPos < 330 then clickCard = 8 else clickCard = 0 end if if clickCard = 8 then if hand1(1, 8) = 0 then clickCard = 0 if hand1(1, 7) > 0 then if xPos < 300 then clickCard = 7 end if end if end if end if case xPos > 230 if xPos < 300 then clickCard = 7 else clickCard = 0 end if if clickCard = 7 then if hand1(1, 7) = 0 then clickCard = 0 if hand1(1, 6) > 0 then if xPos < 270 then clickCard = 6 end if end if end if end if case xPos > 200 if xPos < 270 then clickCard = 6 else clickCard = 0 end if if clickCard = 6 then if hand1(1, 6) = 0 then clickCard = 0 if hand1(1, 5) > 0 then if xPos < 240 then clickCard = 5 end if end if end if end if case xPos > 170 if xPos < 240 then clickCard = 5 else clickCard = 0 end if if clickCard = 5 then if hand1(1, 5) = 0 then clickCard = 0 if hand1(1, 4) > 0 then if xPos < 210 then clickCard = 4 end if end if end if end if case xPos > 140 if xPos < 210 then clickCard = 4 else clickCard = 0 end if if clickCard = 4 then if hand1(1, 4) = 0 then clickCard = 0 if hand1(1, 3) > 0 then if xPos < 180 then clickCard = 3 end if end if end if end if case xPos > 110 if xPos < 180 then clickCard = 3 else clickCard = 0 end if if clickCard = 3 then if hand1(1, 3) = 0 then clickCard = 0 if hand1(1, 2) > 0 then if xPos < 150 then clickCard = 2 end if end if end if end if case xPos > 80 if xPos < 150 then clickCard = 2 else clickCard = 0 end if if clickCard = 2 then if hand1(1, 2) = 0 then clickCard = 0 if hand1(1, 1) > 0 then if xPos < 120 then clickCard = 1 end if end if end if end if case xPos > 50 if xPos < 120 then clickCard = 1 else clickCard = 0 end if end select if clickCard < 1 then call RefreshCards hGbox, 1 call RefreshCards hGbox, 2 wait end if nCard = hand1(1, clickCard) hand2(1, clickCard) = hand1(1, clickCard) hand1(1, clickCard) = 0 call RefreshCards hGbox, 1 [computerDiscardsLikes] ' Find all invisible cards for i = 1 to 17 iC = iCards(i) for j = 1 to 8 if hand2(1, j) = iC then iCards(i) = 0 end if if hand1(2, j) = iC then iCards(i) = 0 end if if hand2(2, j) = iC then iCards(i) = 0 end if next j next i sort iCards(), 17, 1 nChoices = 0 for i = 1 to 17 if iCards(i) > 0 then nChoices = nChoices + 1 end if next i cValue = GetCardValue(hand2(1, clickCard)) if cValue = 99 then cValue = -1 end if cSuit = GetCardSuit(hand2(1, clickCard)) for i = 1 to 8 if GetCardValue(hand1(2, i)) = cValue then call SetCardStatus hand1(2, i), 1 hand2(2, i) = hand1(2, i) hand1(2, i) = 0 end if if GetCardSuit(hand1(2, i)) = cSuit then call SetCardStatus hand1(2, i), 1 hand2(2, i) = hand1(2, i) hand1(2, i) = 0 end if next i call RefreshCards hGbox, 2 wait sub Pause ms calldll #kernel32,"Sleep", _ ms as long, _ result as void end sub sub InitializeDeck hGbox open "qcard32.dll" for dll as #qc calldll #qc, "InitializeDeck", _ hGbox as ulong, _ result as long end sub sub SetCardStatus nCard, 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", _ nCard as long,_ face as long,_ result as void end sub sub DealCard hGbox, nCard, xPos, yPos 'places card on window whose handle is hGbox at xPos, yPos 'nC is number of card - 1-52 in first deck and '53-104 in second deck, if used calldll #qc, "DealCard", _ hGbox as ulong, _ nCard as long,_ xPos as long, _ yPos as long, _ result as void end sub sub RemoveCard hGbox,nCard 'removes a card from screen that was 'drawn with DealCard, replacing screen background calldll #qc, "RemoveCard", _ hGbox as ulong, _ nCard as long, _ result as void end sub sub SetCurrentBack nDesign 'nDesign can be 1,2,3,4,5,6 for 6 possible designs calldll #qc, "SetCurrentBack", _ nDesign as long, _ result as void end sub sub RefreshCards hGbox, player for i = 1 to 8 call RemoveCard hGbox, hand1(player, i) call RemoveCard hGbox, hand2(player, i) next i if player = 1 then #main.g "place 40 295; boxfilled 340 400" yPos = 300 else #main.g "place 40 45; boxfilled 340 150" yPos = 50 end if x1Pos = 50 x2Pos = 450 for i = 1 to 8 n1Card = hand1(player, i) if n1Card > 0 then call DealCard hGbox, n1Card, x1Pos, yPos end if n2Card = hand2(player, i) if n2Card > 0 then call DealCard hGbox, n2Card, x2Pos, yPos end if x1Pos = x1Pos + 30 x2Pos = x2Pos + 30 next i end sub sub InitCards for i = 1 to 17 nCards(i) = dCards(i) iCards(i) = dCards(i) xCards(i) = dCards(i) next i end sub sub ShuffleCards dealer for i = 17 to 2 step -1 n = int(rnd(1) * i) + 1 temp = nCards(i) nCards(i) = nCards(n) nCards(n) = temp next i if dealer = 1 then hand1 = 2 hand2 = 1 else hand1 = 1 hand2 = 2 end if ct = 0 for i = 1 to 15 step 2 ct = ct + 1 hand1(hand1, ct) = nCards(i) hand1(hand2, ct) = nCards(i + 1) hand2(hand1, ct) = 0 hand2(hand2, ct) = 0 next i questCard = nCards(17) end sub sub NewDeal dealer, hGbox xPos = 50 if dealer=1 then hand1 = 2 hand2 = 1 vis1 = 0 vis1 = 1 ' Preserve computer CardStatus 0 for actual play vis2 = 1 y1Pos = 50 y2Pos = 300 else hand1 = 1 hand2 = 2 vis1 = 1 vis2 = 0 vis2 = 1 ' Preserve computer CardStatus to 0 for actual play y1Pos = 300 y2Pos = 50 end if for i = 1 to 8 call Pause 250 nCard = hand1(hand1, i) call SetCardStatus nCard, vis1 call DealCard hGbox, nCard, xPos, y1Pos call Pause 250 nCard = hand1(hand2, i) call SetCardStatus nCard, vis2 call DealCard hGbox, nCard, xPos, y2Pos xPos = xPos + 30 next i call Pause 500 nCard = nCards(17) ' Reset Middle (Guess) CardStatus to 1 for actual play ' call SetCardStatus nCard, 0 Call DealCard hGbox, nCard, 162, 175 end sub sub AnnounceDealer dealer if dealer = 1 then msg$ = "Your Deal" else msg$ = "Computer Deals" end if confirm msg$;yn$ ' Validates proper deal of cards end sub sub AnnouncePlayer playerTurn if playerTurn = 1 then msg$ = "Your Turn" y = 420 else msg$ = "Computer's Turn" y = 40 end if #main.g "stringwidth? msg$ width" #main.g "place ";int(200 - width/2);" ";y #main.g "\";msg$ end sub function GetCardSuit(nCard) calldll #qc, "GetCardSuit", _ nCard as long, _ GetCardSuit as long 'returns 1=Clubs, 2=Diamonds, 3=Hearts, 4=Spades end function function GetCardValue(nCard) calldll #qc, "GetCardValue", _ nCard as long, _ GetCardValue as long 'ace=1,deuce=2....jack=11,queen=12,king=13,joker=99 end function [[code]] At this point, the only action is for the human to click a card, and the computer then reveals cards of the same value and same suit. Turn is never passed to the computer, so human can keep clicking away. All cards are face up. Eventually the computer's hand will be face down (with discards face up) and the middle (guess) card will be face down as well. ----