'===========================================================================
' Subject: Yabalon - Acy-Deucy Card Game      Date: 10-18-03 (  :  )       
'  Author: Richard D. Clark                   Code: IBASIC                 
'  Origin: rickclark58@yhoo.com             Packet: GAMES.ABC
'===========================================================================
'    Copyright (C) 2003  Richard D. Clark
'	 rickclark58@yahoo.com

'    This program is free software; you can redistribute it and/or modify
'    it under the terms of the GNU General Public License as published by
'    the Free Software Foundation; either version 2 of the License, or
'    (at your option) any later version.

'    This program is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU General Public License for more details.

'    You should have received a copy of the GNU General Public License
'    along with this program; if not, write to the Free Software
'    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' Required in Form Load to use dll
DECLARE "qcard32.dll",InitializeDeck(hwnd:INT),INT
' Reset all card values to defaults
DECLARE "qcard32.dll",SetDefaultValues()
' Set the currently used card back design for cards 105 to 109
DECLARE "qcard32.dll",SetCurrentBack(nIndex:INT)
DECLARE "qcard32.dll",SetCardStatus(nCard:INT, bValue:INT)
' Card drawing "qcard32.dll",s
DECLARE "qcard32.dll",DrawSymbol(hwnd:INT, nValue:INT, x:INT, y:INT)
DECLARE "qcard32.dll",DealCard(hwnd:INT, nCard:INT, x:INT, y:INT)
DECLARE "qcard32.dll",DrawCard(hwnd:INT, nCard:INT, x:INT, y:INT)
' Get card information "qcard32.dll",s
DECLARE "qcard32.dll",GetCardValue(nCard:INT),INT
DECLARE "qcard32.dll",ReturnDrag(hwnd:INT, nCard:INT, nOldX:INT, nOldY:INT)

'Yablon subs
DECLARE "kernel32",Sleep(dwMilliseconds:INT)
DECLARE Shuffle()
DECLARE DrawWindow()
DECLARE DealCardToLocation (card:INT, x:INT, y:INT)
DECLARE Startup()
DECLARE PrintMoney()
DECLARE PrintStatus()
DECLARE PrintBet()
DECLARE DoBet()
DECLARE CalcSpread(c1:INT, c2:INT)
DECLARE DoRaise()
DECLARE DoTie()
DECLARE DoPair()
DECLARE ChangeCardBack(x:INT, y:INT)

'Useful consts
Const FACEDOWN = 0
Const FACEUP = 1
Const CARDWIDTH = 71
Const CARDHEIGHT = 96
Const OFFSET = 16
CONST TRUE = 1
CONST FALSE = 0
CONST IBBITMAP = 0
CONST PLACEX=1
CONST PLACEHOLDER = 3
CONST GBET = 0
CONST GRAISE = 1

DEF run:INT
DEF w:WINDOW 
DEF ret:INT
DEF ihback:INT
DEF ihpay:INT
DEF appath:STRING
DEF backcolor, ycolor, wcolor:INT
DEF deck[52]:INT
DEF deckptr:INT
DEF p1x,p2x,p3x,py,px,bx,by:INT
DEF mx, my, money:INT
DEF mbet, mraise:INT
DEF turn:INT
DEF ix, iy:INT
DEF statusmsg:STRING
DEF card1, card2, spread:INT
DEF cv1, cv2:INT
DEF ingame:INT
DEF inshuffle:INT
DEF cardback:INT

'The card back.
cardback = 1
'Dark green.
backcolor = RGB(0, 99, 0)
'Yellow
ycolor = RGB(255, 255, 0)
'White
wcolor = RGB(255, 255, 255)
'Get the application path.
appath = GETSTARTPATH
IF RIGHT$(appath,1)<>"\"
	appath = appath + "\"
ENDIF
'The play area
p1x = CARDWIDTH + 20
p2x = CARDWIDTH + CARDWIDTH + 40
p3x = CARDWIDTH + CARDWIDTH + CARDWIDTH + 60
'The draw area.
py = 110:px = 10
'The money print location.
mx = 10:my = py + CARDHEIGHT + 20
'The status statusmsgages.
ix = 10:iy = my + 30
'Load the bitmaps
ihback = LOADIMAGE(appath + "yab1.bmp", IBBITMAP)
ihpay = LOADIMAGE(appath + "yab2.bmp", IBBITMAP)

WINDOW w,0,0,640,380,@SIZE|@MINBOX|@NOAUTODRAW|@SIZE,0,"Yablon",main 
MENU w,"T,&Game,0,0","I,&New,0,1","I,-,0,0","I,&Quit,0,2"
CENTERWINDOW w
CONTROL w,"E,,19,my + 80,70,20,0x50800000,1"
'SETCONTROLCOLOR w, 1, ycolor, backcolor
CONTROL w,"B,Bet,95,my + 80,49,20,0x50008000,2"
SETCONTROLCOLOR w, 2, ycolor, backcolor
CONTROL w,"B,Raise,150,my + 80,49,20,0x50008000,3"
SETCONTROLCOLOR w, 3, ycolor, backcolor
CONTROL w,"B,Stay,205,my + 80,49,20,0x50008000,4"
SETCONTROLCOLOR w, 4, ycolor, backcolor
'Set the bet statusmsgage location.
bx = 275:by = my + 80
'Set the back color
SETWINDOWCOLOR w, backcolor
'Set the font for the window
SETFONT w, "Tahoma", 0, 0
'Set the back pen color.
BACKPEN w, backcolor
'Init the deck.
ret = InitializeDeck(w)
IF ret = FALSE
	'If we can't load the dll then exit.
	MESSAGEBOX w,"Cannot initialize Qcards32.dll.","Yablon"
	run = 0
ELSE
	Startup
	run = 1 
ENDIF

run = 1 
WAITUNTIL run=0 
CLOSEWINDOW w
'Delete the images.
DELETEIMAGE ihback, IBBITMAP
DELETEIMAGE ihpay, IBBITMAP
END 


SUB main 
SELECT @CLASS
     CASE @IDCLOSEWINDOW 
		run = 0
	 CASE @IDPAINT
		DrawWindow
	 CASE @IDLBUTTONUP
		ChangeCardBack @MOUSEX, @MOUSEY
	 CASE @IDCONTROL
		SELECT @CONTROLID
			CASE 4
				'Stay
				IF (turn = GRAISE) & (ingame = TRUE) & (inshuffle = FALSE)
					mraise = 0
					DoRaise
				ENDIF
			CASE 3
				'Raise
				mraise = VAL(GETCONTROLTEXT(w, 1))
				IF (turn = GRAISE) & (ingame = TRUE) & (inshuffle = FALSE)
					IF mraise = 0
						MESSAGEBOX w,"Raise must be greater than zero.","Yablon"
					ELSE
						IF mraise > (money - mbet)
							MESSAGEBOX w,"You don't have enough money to place this bet.","Yablon"
						ELSE
							DoRaise
						ENDIF
					ENDIF
				ENDIF
			CASE 2
				'Bet
				mbet = VAL(GETCONTROLTEXT(w, 1))
				IF (turn = GBET) & (ingame = TRUE) & (inshuffle = FALSE)
					IF mbet = 0
						MESSAGEBOX w,"Bet must be greater than zero.","Yablon"
					ELSE
						IF mbet > money
							MESSAGEBOX w,"You don't have enough money to place this bet.","Yablon"
						ELSE
							DoBet
						ENDIF
					ENDIF
				ENDIF
		ENDSELECT
	 CASE @IDMENUPICK
		SELECT @MENUNUM
			CASE 1
				'New
				Startup
				DrawWindow
			CASE 2
				'Quit
				run = 0
		ENDSELECT
ENDSELECT 
RETURN

SUB Shuffle
	DEF i,j:INT
	DEF k:INT
	DEF temp:INT
	DEF msg:STRING
	
	'Play the shuffle sound.
	PLAYWAVE appath + "shuffle.wav", @SNDASYNC
	'Reset the deck.
	SetDefaultValues
	'Set the shuffle flag.
	inshuffle = TRUE
	'Load all the cards
	FOR i = 0 TO 51
		deck[i] = i + 1
	NEXT i	
	FOR j = 1 to 10
		'Shuffle the cards.	
		FOR i = 0 TO 51
			'Get a random slot.
			k = RND(52) - 1
			'Get the value for the slot.
			temp = deck[k]
			'Swap the values with the current slot.
			deck[k] = deck[i]
			deck[i] = temp
		NEXT i
	NEXT j
	'Set the deck card pointer
	deckptr = 51
	FOR i = 0 TO 51
		'Deal the draw pile.
		SetCardStatus deck[i], FACEDOWN
		Dealcard w, deck[i], px, py
	NEXT i
	inshuffle = FALSE
RETURN

SUB DrawWindow
	DEF i:INT
	
	'Paint the background image.
	SHOWIMAGE w, ihback, IBBITMAP, 0, 0, 400, 100
	'Paint the payoff image.
	SHOWIMAGE w, ihpay, IBBITMAP, 400, 0, 220, 300
	'Draw the card placeholders.
	'DrawSymbol w, PLACEX, px, py
	DrawSymbol w, PLACEHOLDER, p1x, py
	DrawSymbol w, PLACEHOLDER, p2x, py
	DrawSymbol w, PLACEHOLDER, p3x, py
	'Place the draw cards
	FOR i = 0 TO 51
		IF deck[i]<>0
			SetCardStatus deck[i], FACEDOWN
			DealCard w, deck[i], px, py
		ENDIF
	NEXT i
	'Draw the face up cards.
	IF card1<>0
		SetCardStatus card1, FACEUP
		DealCard w, card1, p1x, py
	ENDIF
	IF card2<>0
		SetCardStatus card2, FACEUP
		DealCard w, card2, p2x, py
	ENDIF
	'Print the statusmsgages.
	PrintMoney
	PrintStatus
	PrintBet
RETURN

SUB DealCardToLocation (card:INT, x:INT, y:INT)
	DEF i:INT

	'Play the deal sound.
	PLAYWAVE appath + "deal.wav", @SNDASYNC
	SetCardStatus card, FACEUP
	FOR i = px TO x STEP 2
		ReturnDrag w, card, i, y
	NEXT i
	ReturnDrag w, card, x, y
RETURN

SUB Startup
	'Reset cards.
	SetDefaultValues
	'Shuffle the cards.
	Shuffle
	'Set the money amount.
	money = 1000
	'Start with the bet routine.
	turn = GBET
	'Set the first statusmsgage.
	statusmsg = "Place your bet for the deal.        "
	card1 = 0:card2 = 0
	mbet = 0:mraise = 0
	ingame = TRUE
RETURN

SUB PrintMoney
	'Print the current money amount
	MOVE w, mx, my
	FRONTPEN w, ycolor
	PRINT w, "Your current cash amount is $" + LTRIM$(STR$(money)) + ".     "
RETURN

SUB PrintStatus
	'Print the current status statusmsgage.
	MOVE w, ix, iy
	FRONTPEN w, wcolor
	IF ingame = TRUE
		PRINT w, statusmsg + "            "
	ELSE
		PRINT w, "Game over.                    "
	ENDIF
RETURN

SUB PrintBet
	'Print the current status statusmsgage.
	MOVE w, bx, by
	FRONTPEN w, wcolor
	IF ingame = TRUE 
		PRINT w, "Bet:" + STR$(mbet) + " Raise:" + STR$(mraise) + "           "
	ELSE
		PRINT w, "                                 "
	ENDIF
RETURN

SUB DoBet
	'Toggle turn to raise.
	turn = GRAISE
	'Print the messages
	PrintBet
	'Deal the first two cards.
	card1 = deck[deckptr]
	'Move the card to the location
	DealCardToLocation card1, p1x, py
	'Clear this card from the deck.
	deck[deckptr] = 0
	'Move the deck pointer
	deckptr = deckptr -1
	'Get the second card
	card2 = deck[deckptr]
	DealCardToLocation card2, p2x, py
	deck[deckptr] = 0
	deckptr = deckptr -1
	'Get the spread.
	spread = CalcSpread(card1, card2)
	'Do we have consecutive cards.
	IF spread = 0
		DoTie
	ELSE
		'Do we have a pair.
		IF spread = -1
			DoPair
		ELSE
			statusmsg = "Raise or Stay. Spread is" + STR$(spread) + ".       "
		ENDIF
	ENDIF
	PrintStatus
RETURN

SUB CalcSpread(c1:INT, c2:INT)
	DEF ret:INT

	'Get the card values.
	cv1 = GetCardValue(c1)
	'If an ace bump to 14
	IF cv1 = 1
		cv1 = 14
	ENDIF
	cv2 = GetCardValue(c2)
	IF cv2 = 1
		cv2 = 14
	ENDIF
	'Calc the spread
	ret = ABS(cv1 - cv2) - 1
RETURN ret

SUB DoRaise
	DEF card3:INT
	DEF temp:INT
	DEF winnings:INT
	DEF cv3:INT

	PrintBet
	'Deal the third card.
	card3 = deck[deckptr]
	DealCardToLocation card3, p3x, py
	deck[deckptr] = 0
	deckptr = deckptr -1
	'Get the card value of the third card.
	cv3 = GetCardValue(card3)
'stop
	'If an ace, then the value is 14
	IF cv3 = 1
		cv3 = 14
	ENDIF
	'Arrange the cards in order of value.
	IF cv1 > cv2
		temp = cv1
		cv1 = cv2
		cv2 = temp
	ENDIF
	'Does the card fall in between the first two?
	IF (cv3 > cv1) & (cv3 < cv2)
		PLAYWAVE appath + "money.wav", @SNDASYNC
		'Player gets original bet amount.
		winnings = mbet
		'Calc the bonus amount.
		IF spread = 1
			winnings = winnings + (5 * mraise)
		ENDIF
		IF spread = 2
			winnings = winnings + (4 * mraise)
		ENDIF
		IF spread = 3
			winnings = winnings + (2 * mraise)
		ENDIF
		IF spread > 3
			winnings = winnings + mraise
		ENDIF
		'Update the all the vars.
		statusmsg = "You win $" + LTRIM$(STR$(winnings)) + ".             "
		PrintStatus
		'Pause for a second.
		Sleep 2000
		money = money + winnings
	ELSE
		'Player loses money.
		statusmsg = "You lose.                "
		PrintStatus
		Sleep 1000
		'Update the vars.
		money = money - (mraise + mbet)
		'Does the player have any money left?
		IF money <= 0
			ingame = FALSE
		ENDIF
	ENDIF
	'Check to see if we need to shuffle.
	IF deckptr < 3
		statusmsg = "Shuffling cards...         " 
		PrintStatus
		Shuffle
	ENDIF
	'Reset the game vars.
	statusmsg = "Place your bet for the deal.          "
	turn = GBET
	mbet = 0:mraise = 0
	card1 = 0:card2 = 0
	DrawWindow
RETURN

SUB DoTie
	statusmsg = "Tie. You get your bet back.       "
	PrintStatus
	Sleep 2000
	'Check to see if we need to shuffle.
	IF deckptr < 3
		statusmsg = "Shuffling cards...         " 
		PrintStatus
		Shuffle
	ENDIF
	turn = GBET
	mbet = 0:mraise = 0
	card1 = 0:card2 = 0
	statusmsg = "Place your bet for the deal.          "
	DrawWindow
RETURN

SUB DoPair
	DEF card3:INT
	DEF cv3:INT
	DEF winnings:INT

	statusmsg = "Pair. Dealing third card.           "
	PrintStatus
	Sleep 1000
	'Deal the third card.
	card3 = deck[deckptr]
	DealCardToLocation card3, p3x, py
	deck[deckptr] = 0
	deckptr = deckptr -1
	'Get the card value of the third card.
	cv3 = GetCardValue(card3)
	'If an ace, then the value is 14
	IF cv3 = 1
		cv3 = 14
	ENDIF
	'If three of a kind, then pay out 11:1.
	IF cv3 = cv2
		PLAYWAVE appath + "clap.wav", @SNDASYNC
		'win big
		winnings = 11 * mbet
		'Add to the money pool
		money = money + winnings
		statusmsg = "Three of a kind. You win $" + LTRIM$(STR$(winnings)) + "."
		PrintStatus
		Sleep 2000
	ELSE
		statusmsg = "You lose.                             "
		PrintStatus
		Sleep 1000
		money = money - mbet
		'Does the player have any money left?
		IF money <= 0
			ingame = FALSE
		ENDIF
	ENDIF
	'Reset the vars.
	turn = GBET
	mbet = 0:mraise = 0
	card1 = 0:card2 = 0
	'Check to see if we need to shuffle.
	IF deckptr < 3
		statusmsg = "Shuffling cards...         " 
		PrintStatus
		Shuffle
	ENDIF
	statusmsg = "Place your bet for the deal.                 "
	DrawWindow
RETURN

SUB ChangeCardBack(x:INT, y:INT)
	
	'See if the mouse coordinates are in the draw pile.
	
	IF (x >= px) & (x <= px + CARDWIDTH)
		IF (y >= py) & (y <= py + CARDHEIGHT)
			cardback = cardback + 1
			IF cardback > 6
				cardback = 1
			ENDIF
			SetCurrentBack cardback
			DrawWindow
		ENDIF
	ENDIF

RETURN