Hi there!
Acey Ducey is played in the following manner.
You are dealt two cards face up. You have an option to bet or not to bet depending on whether or not you feel the next card dealt will have a value between the first two. In Acey Ducey, the cards are valued 2-Ace(14).
If your option is not to bet, input a 0. Your initial bank is set to the amount you nominate. The game continues until you lose all your money or interrupt the programme.
remstart
=======================================================
ACEY DUCEY CARD GAME
***********************
Author: gearce - June 2007
***********************
=======================================================
remend
` ----------------------------------------------------------------
` PART ONE - Initialisation
` ----------------------------------------------------------------
` Start of programme
start:
` This command will hide the mouse pointer
hide mouse
` Assure random is always different
randomize timer()
` Declare array/s
dim card(52):dim card$(52):dim value(52)
` Initialise go bet counter
gobet=0
` ----------------------------------------------------------------
` PART TWO - Introduction
` ----------------------------------------------------------------
` Set text style and size, and ink colour
set text font "arial"
set text size 36
set text to bold
th=text height("arial")
ink rgb(255,217,128),1
` Write title text
center text 320,10,"ACEY DUCEY CARD GAME"
` Set text style and size, and ink colour
set text font "arial"
set text size 21
set text to bold
th=text height("arial")
` If choice is play again
if a=21
` A short wait before proceeding
wait 1000
gosub instructions
endif
` Define the message string.
` Since the message is over 255 characters long it is necessary to split it
` into two parts - part one ...
partone$="**|Acey Ducey is played in the following manner.**||You are dealt two "
partone$=partone$+"cards face up.**You have an|option to bet or not to bet "
partone$=partone$+"depending on whether|or not you feel the next card dealt "
partone$=partone$+"will have a|value between the first two. "
message$=partone$
` Determine text width of longest message line
tw=text width("option to bet or not to bet depending on whether")/2
` Set across and down coordinates
across=320-tw:down=79
` Go to subroutine to write message
gosub writemessage
` ... and part two
parttwo$="**In Acey Ducey, the|cards are valued 2-Ace(14).**If your option is not|to "
parttwo$=parttwo$+"bet, input a 0.**||Your initial bank is set to the amount you|"
parttwo$=parttwo$+"nominate.**The game continues until you lose|all your money or "
parttwo$=parttwo$+"interrupt the programme.**||Press any key to begin."
message$=parttwo$
` Go to subroutine to write message
gosub writemessage
` Suspend for keypress
wait key
` Load and paste box image
load image "blockout.bmp",2
paste image 2,1,46
instructions:
` ----------------------------------------------------------------
` PART THREE - Instructions
` ----------------------------------------------------------------
nominatebank:
` Write text
text 107,79,"Nominate your initial bank (minimum 100)"
` Load and paste box image
load image "box.bmp",2
paste image 2,481,79
` Set cursor
set cursor 468,82
` Input bank
input " ";initial
` If bank less than minimum
if initial<100 then gosub nominatebank
` Progressive bank
progressive=initial
` Go to subroutine to determine progressive bank
gosub bank
` A short pause before proceeding
wait 1000
` To continue the game 'til bank is exhausted
` or programme is interrupted
reshuffle:
` Go to subroutine to arrange 52 cards in random order
gosub randomcards
` Set cards dealt counter
cardsdealt=0
` Set newacross and newdown coordinates
newacross=168:newdown=153
` Until 51 cards are dealt
` Maximum bets equals 17 by 3 cards
repeat
` Write text
center text 320,121,"Here are your next two cards"
` Increment cards dealt counter
inc cardsdealt
` Increment newacross counter
inc newacross,78
` Determine card dealt
card=card(cardsdealt)
card$=card$(card)
` Go to subroutine to get card image
gosub getimage
` Where to paste card image
paste image 2,newacross,newdown
` A short wait before proceeding
wait 10
` First hand dealt
if cardsdealt=2 then gosub whatsyourbet
` Second hand plus dealt
for gobet=5 to 50 step 3
if cardsdealt=gobet
gosub whatsyourbet
endif
next gobet
until cardsdealt=51
` To continue the game 'til bank is exhausted
` or programme is interrupted
mybets=0
gosub reshuffle
theend:
end
` ----------------------------------------------------------------
` PART FOUR - Functions and Subroutines
` ----------------------------------------------------------------
` --------------------------------------------------
` Subroutine to write message, one letter at a time
` --------------------------------------------------
writemessage:
` Go through all the characters in the message
for character=1 to len(message$)
` Check if the character is a | or an *
` If the character is a |, this indicates the start of a new line
if mid$(message$,character)="|"
across=320-tw-text width(mid$(message$,character))
inc down,(th*1)
endif
` If the character is an *, this indicates a short wait before
` proceeding
if mid$(message$,character)="*"
across=across+text width(mid$(message$,character-1))
wait 500
endif
` If the character is a | or an *, create a write character switch and
` turn it off to avoid writing ...
if mid$(message$,character)="|" or mid$(message$,character)="*"
writetext$="off"
else
` ... or turn it on to write all other characters
writetext$="on"
across=across+text width(mid$(message$,character-1))
text across,down,mid$(message$,character)
` A short wait before proceeding. The shorter the wait, the
` faster the character is written to screen
wait 30
endif
next character
return
` ----------------------------------------------
` Subroutine to arrange 52 cards in random order
` ----------------------------------------------
randomcards:
Hearts$= "AH2H3H4H5H6H7H8H9HTHJHQHKH"
Clubs$= "AC2C3C4C5C6C7C8C9CTCJCQCKC"
Diamonds$="AD2D3D4D5D6D7D8D9DTDJDQDKD"
Spades$= "AS2S3S4S5S6S7S8S9STSJSQSKS"
Pack$=Hearts$+Clubs$+Diamonds$+Spades$
for n=1 to 52
nextcard=rnd(len(pack$)/2-1)
card$(n)=mid$(pack$,nextcard*2+1)+mid$(pack$,nextcard*2+2)
pack$=left$(pack$,nextcard*2)+right$(pack$,len(pack$)-nextcard*2+2)
card(n)=n
card$=card$(n)
next n
return
` ----------------------------------------------
` Subroutine to get card image
` ----------------------------------------------
getimage:
` Increment this card value
inc thiscard
if card$="2H" then card$="Two of Hearts":value=2:load image "TwoH.bmp",2
if card$="3H" then card$="Three of Hearts":value=3:load image "ThreeH.bmp",2
if card$="4H" then card$="Four of Hearts":value=4:load image "FourH.bmp",2
if card$="5H" then card$="Five of Hearts":value=5:load image "FiveH.bmp",2
if card$="6H" then card$="Six of Hearts":value=6:load image "SixH.bmp",2
if card$="7H" then card$="Seven of Hearts":value=7:load image "SevenH.bmp",2
if card$="8H" then card$="Eight of Hearts":value=8:load image "EightH.bmp",2
if card$="9H" then card$="Nine of Hearts":value=9:load image "NineH.bmp",2
if card$="TH" then card$="Ten of Hearts":value=10:load image "TenH.bmp",2
if card$="JH" then card$="Jack of Hearts":value=11:load image "JackH.bmp",2
if card$="QH" then card$="Queen of Hearts":value=12:load image "QueenH.bmp",2
if card$="KH" then card$="King of Hearts":value=13:load image "KingH.bmp",2
if card$="AH" then card$="Ace of Hearts":value=14:load image "AceH.bmp",2
if card$="2C" then card$="Two of Clubs":value=2:load image "TwoC.bmp",2
if card$="3C" then card$="Three of Clubs":value=3:load image "ThreeC.bmp",2
if card$="4C" then card$="Four of Clubs":value=4:load image "FourC.bmp",2
if card$="5C" then card$="Five of Clubs":value=5:load image "FiveC.bmp",2
if card$="6C" then card$="Six of Clubs":value=6:load image "SixC.bmp",2
if card$="7C" then card$="Seven of Clubs":value=7:load image "SevenC.bmp",2
if card$="8C" then card$="Eight of Clubs":value=8:load image "EightC.bmp",2
if card$="9C" then card$="Nine of Clubs":value=9:load image "NineC.bmp",2
if card$="TC" then card$="Ten of Clubs":value=10:load image "TenC.bmp",2
if card$="JC" then card$="Jack of Clubs":value=11:load image "JackC.bmp",2
if card$="QC" then card$="Queen of Clubs":value=12:load image "QueenC.bmp",2
if card$="KC" then card$="King of Clubs":value=13:load image "KingC.bmp",2
if card$="AC" then card$="Ace of Clubs":value=14:load image "AceC.bmp",2
if card$="2D" then card$="Two of Diamonds":value=2:load image "TwoD.bmp",2
if card$="3D" then card$="Three of Diamonds":value=3:load image "ThreeD.bmp",2
if card$="4D" then card$="Four of Diamonds":value=4:load image "FourD.bmp",2
if card$="5D" then card$="Five of Diamonds":value=5:load image "FiveD.bmp",2
if card$="6D" then card$="Six of Diamonds":value=6:load image "SixD.bmp",2
if card$="7D" then card$="Seven of Diamonds":value=7:load image "SevenD.bmp",2
if card$="8D" then card$="Eight of Diamonds":value=8:load image "EightD.bmp",2
if card$="9D" then card$="Nine of Diamonds":value=9:load image "NineD.bmp",2
if card$="TD" then card$="Ten of Diamonds":value=10:load image "TenD.bmp",2
if card$="JD" then card$="Jack of Diamonds":value=11:load image "JackD.bmp",2
if card$="QD" then card$="Queen of Diamonds":value=12:load image "QueenD.bmp",2
if card$="KD" then card$="King of Diamonds":value=13:load image "KingD.bmp",2
if card$="AD" then card$="Ace of Diamonds":value=14:load image "AceD.bmp",2
if card$="2S" then card$="Two of Spades":value=2:load image "TwoS.bmp",2
if card$="3S" then card$="Three of Spades":value=3:load image "ThreeS.bmp",2
if card$="4S" then card$="Four of Spades":value=4:load image "FourS.bmp",2
if card$="5S" then card$="Five of Spades":value=5:load image "FiveS.bmp",2
if card$="6S" then card$="Six of Spades":value=6:load image "SixS.bmp",2
if card$="7S" then card$="Seven of Spades":value=7:load image "SevenS.bmp",2
if card$="8S" then card$="Eight of Spades":value=8:load image "EightS.bmp",2
if card$="9S" then card$="Nine of Spades":value=9:load image "NineS.bmp",2
if card$="TS" then card$="Ten of Spades":value=10:load image "TenS.bmp",2
if card$="JS" then card$="Jack of Spades":value=11:load image "JackS.bmp",2
if card$="QS" then card$="Queen of Spades":value=12:load image "QueenS.bmp",2
if card$="KS" then card$="King of Spades":value=13:load image "KingS.bmp",2
if card$="AS" then card$="Ace of Spades":value=14:load image "AceS.bmp",2
` Determine value of each card dealt
value(cardsdealt)=value
return
` ----------------------------------------------
` Subroutine to get bet
` ----------------------------------------------
whatsyourbet:
` Increment my bets counter
inc mybets
` Increment cards dealt counter
inc cardsdealt
inputbet:
` Write text
center text 290,259,"What's your bet? "
` Load and paste box image
load image "box.bmp",2
paste image 2,371,259
` Set cursor
set cursor 358,262
` Input bet
input " ";bet$
` If bet$ equals null string
if bet$="" then gosub inputbet
` Convert string to non-string
bet=val(bet$)
` If bet equals zero
if bet=0
` A short pause before proceeding
wait 1000
` Load and paste double blank card image
load image "cardblank2.bmp",2
paste image 2,246,newdown
` Set newacross and newdown coordinates
newacross=168:newdown=153
return
endif
if bet>progressive
` Write text
text$="Sorry, you bet too much. Your bank is only "+str$(progressive)+" dollars"
center text 320,407,text$
` A short pause before proceeding
wait 1000
` Load and paste box image
load image "box3.bmp",2
paste image 2,1,407
` Go to subroutine to place another bet
goto inputbet
endif
` Determine card dealt
card=card(cardsdealt)
card$=card$(card)
` A short wait before proceeding
wait 100
` Go to subroutine to get card image
gosub getimage
` Where to paste card image
paste image 2,285,290
` Check if third card has a value between
` previous two cards
gosub checkbetween
` A short wait before proceeding
wait 1000
blankout:
` Load and paste blank card image
load image "cardblank.bmp",2
paste image 2,285,290
` Load and paste double blank card image
load image "cardblank2.bmp",2
paste image 2,246,newdown
` Load and paste box image
load image "box3.bmp",2
paste image 2,1,407
` Set newacross and newdown coordinates
newacross=168:newdown=153
` A short wait before proceeding
wait 1000
return
` ----------------------------------------------
` Subroutine to determine if third card value is
` between first and second card values
` ----------------------------------------------
checkbetween:
for x=cardsdealt-2 to cardsdealt
c=value(cardsdealt):a=value(cardsdealt-2):b=value(cardsdealt-1)
if (c>a and c<b) or (c<a and c>b)
center text 320,407,"Congratulations, you win"
` Add to progressive bank
progressive=progressive+bet
` A short wait before proceeding
wait 1000
gosub bank
exit
else
center text 320,407,"Sorry, you lose"
` Subtract from progressive bank
progressive=progressive-bet
` A short wait before proceeding
wait 1000
gosub bank
exit
endif
next x
` A short wait before proceeding
wait 1000
return
` ----------------------------------------------
` Subroutine to determine progressive bank
` ----------------------------------------------
bank:
` Load and paste box image
load image "box3.bmp",2
paste image 2,1,449
` Write text
center text 320,449,"OK you now have "+str$(progressive)+" dollars"
` If progressive bank equals zero
if progressive=0
` A short wait before proceeding
wait 1000
` Load and paste box image
load image "box3.bmp",2
paste image 2,1,407
` Write text
text$="Sorry, You have no dollars left. Play again?"
center text 320,407,text$
` Load and paste box image
load image "box3.bmp",2
paste image 2,1,449
` Write text
text$="Left click mouse for YES - right click mouse for NO"
center text 320,449,text$
` Until mouse is clicked
do
` If mouse is left clicked,
` a=21 where 21 equals scancode for the letter Y
if mouseclick()=1
a=21
` A short wait before proceeding
wait 1000
` Clear screen
cls
gosub start
endif
` If mouse is right clicked,
` a=49 where 49 equals scancode for the letter N
if mouseclick()=2
` A short wait before proceeding
wait 1000
` Clear screen
cls
gosub theend
endif
` End loop
loop
endif
return
First, create a folder on your computer where you wish to keep the programme (e.g. Acey Ducey).
Highlight the code, right click, copy and paste into Dark Basic then save as
Acey Ducey.dba in the folder you have just created.
Download the attached Acey.zip file, which contains the media required, and unzip into the same folder.
Enjoy
gearce
LANG MEY YER LUM REEK
