Drawing Cards?

i'm making a simple card game and am having trouble "drawing" or picking cards from a deck.

here's my attempt:

For x=1 To drawnum 
temp(x)=Rand(1,drawnum)
Next 

For c.card=Each card
	If c\num=temp(x) And c\where$="" Then 
		c\where$="hand"
		c\x=500+nx     ;offset hand value
	EndIf 
Next 

this doesn't seem to work as it will draw multiple card of the same kind.
Please Help!

For x=1 To drawnum 
temp(x)=Rand(1,drawnum)
For xx=1 To drawnum
If temp(x)=temp(xx) And x<>xx Then drawnum=drawnum+1
Next 
Next 

For x=1 To drawnum
For c.card=Each card
	If c\num=temp(x) And c\where$="" Then 
		c\where$="hand"
		c\x=500+nx     ;offset hand value
	EndIf 
Next 
Next 

ok, this is selecting the first two of three cards i told it to draw but not the third one. Whats wrong?

hmm.. i kinda rooted the problem down to this:
i need a function that return a different number between a [to] and [from] variable that is much like the rand() function.

Seems simple but i cant get it.

hmm, i'll try to whip up a small example of drawing random numbers

heres a small example:

Type Card
	Field name_number%
	Field name$
	Field number%
End Type

Global maxnumber

Graphics 500,300
SeedRnd MilliSecs()

Print "Press R to redraw!"
maxnumber%=Input("Whats the max amount of cards to be drawn?")
Print ""

ReDraw()

i=0

While Not KeyHit(1)

If KeyHit(19)
	ReDraw()
End If

Wend
End
	
	
	
Function ReDraw()

Delete Each Card

For i=0 To maxnumber-1

	DrawnCard.Card = New Card
	DrawnCard\name_number = Rand(1,4)
	
	Select DrawnCard\name_number
	
		Case 1: DrawnCard\name = "Spades"
		Case 2: DrawnCard\name = "Hearts"
		Case 3: DrawnCard\name = "Dimonds"
		Case 4: DrawnCard\name = "Clubs"
	
	End Select
	DrawnCard\number = Rand(1,10)
	
Next

Print ""
i=1
	For Hand.Card = Each Card
		Print "Card "+i+": " + Hand\number + " Of " + Hand\name
		i=i+1
	Next

End Function

hope it helps

thats helpful but i'm getting duplicates:


I've got an idea for a card game that's like Fluxx (if you ever heard of it) and uses a special deck of cards which has no dups.

thanks for the help

yeah, it doesnt count dupes, you'd have to set up a system:

1) create a card
2) check that card agenst all of the cards
3) if it finds one card, its fine, because that 1 would be the card just drawn.
4) if it find more then 1, delete the card, and redraw it.

heres an example:

Type Card
	Field name_number%
	Field name$
	Field number%
End Type

Global maxnumber

Graphics 500,300
SeedRnd MilliSecs()

Print "Press R to redraw!"
maxnumber%=Input("Whats the max amount of cards to be drawn?")
Print ""

ReDraw()

i=0

While Not KeyHit(1)

If KeyHit(19)
	ReDraw()
End If

Wend
End
	
	
	
Function ReDraw()

Delete Each Card


For i=0 To maxnumber-1
.redo

;sets matchs up to count matchs
matchs=0

    
	DrawnCard.Card = New Card
	DrawnCard\name_number = Rand(1,4)
	
	Select DrawnCard\name_number
	
		Case 1: DrawnCard\name = "Spades"
		Case 2: DrawnCard\name = "Hearts"
		Case 3: DrawnCard\name = "Dimonds"
		Case 4: DrawnCard\name = "Clubs"
	
	End Select
	DrawnCard\number = Rand(1,10)
	
	
	For check.Card = Each Card
	
		If DrawnCard\name$ = check\name$ And DrawnCard\number = check\number matchs=matchs+1
			
	Next
	
	If matchs > 1 
		Delete DrawnCard
		Goto redo
	End If
Next

Print "" 
	i=1
	For Hand.Card = Each Card
		Print "Card "+i+": " + Hand\number + " Of " + Hand\name
		i=i+1
	Next

End Function

oh, yeah! I forgot you could locally put a goto in a function! That was what i was trying to work around! Thanks!

I actually prefer to make an array of cards and scramble it. Then just draw off the top like you would any deck.

Graphics 800,600,32,2

Type TCard
	Field Value
	Field Suit$
End Type

Dim Deck.TCard(52) ;The deck
Global TopCard ;the top card (next to be drawn) of the deck
Dim Player.TCard(4,5) ;4 players recieve 5 cards each

LoadDeck() ;fills the deck with the cards
ShuffleDeck() ;Now we shuffle the deck

For c = 1 To 5
	For p = 1 To 4
		Player(p,c) = DrawCard() ;deal the cards to each player
	Next
Next

ClsColor 0,198,0
While Not KeyHit(1)
	Cls
	For p = 1 To 4
		Select p
			Case 1: x = 200: y = 10
			Case 2: x = 10: y = 250
			Case 3: x = 500:y = 250
			Case 4:x = 200: y = 400
		End Select
		
		For c = 1 To 5
			If Player(p,c)\Suit = "Hearts" Or Player(p,c)\Suit = "Diamonds"
				Color 255,0,0
			Else
				Color 0,0,0
			End If
			Select Player(p,c)\Value
				Case 1: Text x,y,"Ace of "+Player(p,c)\suit
				Case 11: Text x,y,"Jack of "+Player(p,c)\suit
				Case 12: Text x,y,"Queen of "+Player(p,c)\Suit
				Case 13: Text x,y,"King of "+Player(p,c)\suit
				Default: Text x,y,Player(p,c)\Value+" of "+Player(p,c)\Suit
			End Select
			y = y + 20
		Next
	Next
	Flip
Wend

End

Function LoadDeck()
	TopCard = 0
	For t = 0 To 51
		Deck(t) = New TCard
		SuitNum = Floor(t/13.0)
		Deck(t)\Value = (t - SuitNum*13)+1
		Select SuitNum
			Case 0: Deck(t)\Suit = "Hearts"
			Case 1: Deck(t)\Suit = "Spades"
			Case 2: Deck(t)\Suit = "Diamonds"
			Case 3: Deck(t)\Suit = "Clubs"
		End Select
	Next
End Function

Function ShuffleDeck()
	For t = 0 To 51
		Card = Rand(0,51)
		temp.TCard = Deck(t)
		Deck(t) = Deck(Card)
		Deck(Card) = temp
	Next
End Function

Function DrawCard.TCard()
	If TopCard > 51 Then Return Null ;no cards left to draw
	TopCard = TopCard + 1
	Return Deck(TopCard - 1)
End Function

Edit: And no Goto in sight :)

Why not just create your pack of cards and have a flag if it's been drawn or not...

So

Type TCard
Field Value
Field Suit$
Field HeldBy$
End Type

Then when picking a new card just check if it's been drawn already, if it has just move onto the next one until you get a card that isn't drawn. This way you have your deck of cards and you know which player is holding it, or if it's on the table, in the dealers hands, up someone's sleeve etc.

Or go down the array route, I'm pretty sure I wrote a card game a while back and used arrays.

thats kinda what i've been doing but i need to draw new cards every turn out of the deck and be able to draw cards out of the discard pile randomly for this card game.

anyways this is kinda working:

Function DrawHand(drawnum)

Local x=1

.Draw
drawrand=Rand(1,total)
Print drawrand
For c.card=Each card
If c\num=drawrand And c\where$="" Then 
	c\where$="hand"
	c\x=x*100
	c\y=GraphicsHeight()-100
	DebugLog  "Card "+x+" Found"
	If x<drawnum Then x=x+1:Else If x=drawnum Then Return  
Else 
Goto Draw
EndIf
Next 


End Function 

...but it results in finding one card and then gets stuck in an endless loop

Would it be ok if you posted all of your code? or at least more, its hard for me to make out the problem with the code listed in your latest post.

OK... A bit of work and I get something like this:

This creates a deck of cards, each card can be given to a 'pile'. A pile could be the main deck, a player, the table, whatever you want, you can have any number of piles, it doesn't matter.

You can actually create any number of decks of cards, however, there's no id for which deck you're working with so that might be something worth adding if you need to distinguish between multiple decks.

Each pile can be drawn from, by default it draws from pile 0, simply pass which pile you want to draw from. ie DrawNextCard(5) will take the next card off 5.

You can pass a card to any pile by using the function GiveCardTo(card, pile)

Example code of how to use it after all the functions.

Not sure if this is 100% as not really tested it. So it probably needs tweaking.

It needs a couple more functions
MovePileTo(PileID) - Moves all cards from one pile to another
ResetPile(PileID) - Resets the next card (used after a shuffle etc)

Graphics 640,480,32,2


Dim Suit$(3)
Suit(0) = "Hearts"
Suit(1) = "Diamonds"
Suit(2) = "Clubs"
Suit(3) = "Spades"

Type Card
	Field Value
	Field Suit
	Field Pile
	Field Order
End Type

Type Piles
	Field ID
	Field NextCard
End Type

Function CreatePile(ID)
	p.piles = New piles
	p\id = id
	p\nextcard = 1
End Function

Function CreateDeck(PileID=0)
	If Not PileExist(PileID) Then CreatePile(PileID)
	Order = 0
	For s = 0 To 3
	For v = 1 To 13
		c.Card = New Card
		c\value = v
		c\suit = s
		c\Pile = PileID
		c\Order = Order
		Order = Order + 1
	Next
	Next
End Function

Function PileCount(Pile=0)
	; Checks if a pile is empty
	count = 0
	For c.card = Each card
		If c\Pile = Pile Then Count = Count + 1
	Next
	Return Count
End Function

Function PileExist(PileID)
	For p.piles = Each piles
		If p\ID = PileID Then Return 1
	Next
	Return 0
End Function

Function DrawRandomCard.Card(Pile=0)
	Print "Get Random Card from " + Pile

	If PileCount(Pile) = 0 Then Return Null
	
	SeedRnd MilliSecs()
	i = Rand(1,pilecount(pile))
	
	For c.card = Each card
		If c\Pile = Pile And c\order = i Return c.card
	Next	
		
End Function

Function DrawNextCard.Card(cc.card,PileID=0)
	Print "Get Next Card from " + pileid

	pc = PileCount(PileID) 
	If pc = 0 Then Return Null
	

	NextCard = 0
	For p.piles = Each piles
		If p\ID = PileID Then
			NextCard = p\nextcard
			p\nextcard = p\nextcard + 1
			If p\nextcard > pc Then p\nextcard = 1
		EndIf
	Next
	
	For c.card = Each card
		If c\pile = pileid And c\order = nextcard Then Return c.card
	Next
	
	Return Null
	
End Function

Function ConvertValue$(Value)
	If Value = 1 Then Return "Ace"
	If Value > 1 And Value < 11 Then Return Value
	If Value = 11 Then Return "Jack"
	If Value = 12 Then Return "Queen"
	If value = 13 Then Return "King"
End Function

Function DisplayCard(c.card)
	Print ConvertValue(c\value) + " " + Suit(c\suit) + ", In pile " + c\Pile + " order " + c\order
	Print	
End Function

Function GiveCardTo(c.card,PileID)
	Print "Give card to " + pileid
	If Not PileExist(PileID) Then CreatePile(PileID)

	c\Pile = PileID
	c\Order = PileCount(PileID)
End Function

Function ShufflePile(PileID)
	pc = PileCount(PileID)
	For c.card = Each card
		If c\pile = pileid Then
			r = Rand(1,pc)
			For cc.card = Each card
				If cc\pile = pileid And cc\order = r Then
					cc\order = c\order
					c\order = r
					Exit
				EndIf
			Next
		EndIf
	Next
End Function



; The actual stuff
createdeck(0)
shufflePile(0)

current.card = New card
current = drawrandomcard.card()
DisplayCard(current)

GiveCardTo(current,1)
DisplayCard(current)

current = drawrandomcard.card()
DisplayCard(current)

current = drawrandomcard.card()
DisplayCard(current)

GiveCardTo(Current,2)
DisplayCard(current)

current = DrawNextcard(Current.card)
DisplayCard(current)

GiveCardTo(Current,2)
DisplayCard(current)

current =DrawNextcard(Current)
DisplayCard(current)

GiveCardTo(Current,2)
DisplayCard(current)

WaitKey

Don't you just hate demonstrating you have too much free time on your hands?

Graphics 1024,768,32,2

Global fntSymbol = LoadFont ("symbol.ttf",20)
Global fntSymbolBig = LoadFont ("symbol.ttf",40)
Global fntArialBig = LoadFont ("Arial.ttf",70)
Global fntArial = LoadFont ("Arial.ttf",15)

Function DrawCard(x,y,Value,Suit)

SuitSymbol$ = Mid("§¨©ª",Suit+1,1)

Color 255,255,255
Rect x+1,y+1,98,148,True
Color 0,0,0
Rect x+2,y,96,1,False
Rect x,y+2,1,146,False
Rect x+99,y+2,1,146,False
Rect x+2,y+149,96,1,False
Plot x+1,y+1
Plot x+98,y+1
Plot x+1,y+148
Plot x+98,y+148

If suit=1 Or suit = 2 Then Color 200,0,0

SetFont fntArial

Text x+8,y+10,Convert(Value),True,True
Text x+92,y+140,Convert(Value),True,True

SetFont fntSymbol
Text x+8,y+25,SuitSymbol,True,True
Text x+92,y+125,SuitSymbol,True,True

If Value > 10 Then
	SetFont fntArialBig
	Text x+50,y+75,Convert(Value),True,True
Else
	SetFont fntSymbolBig
	If Value = 1 Or Value = 3 Or Value = 5 Or Value = 9 Then
		Text x+50,y+75,SuitSymbol,1,1
	EndIf
	
	If Value = 2 Or Value = 3 Then
		Text x+50,y+25,SuitSymbol,1,1
		Text x+50,y+125,SuitSymbol,1,1
	EndIf
		
	If Value > 3 Then
		Text x+30,y+25,SuitSymbol,1,1
		Text x+70,y+25,SuitSymbol,1,1
		Text x+30,y+125,SuitSymbol,1,1
		Text x+70,y+125,SuitSymbol,1,1
	EndIf
	
	If Value > 5 And Value < 9 Then
		Text x+30,y+75,SuitSymbol,1,1
		Text x+70,y+75,SuitSymbol,1,1
	EndIf
	
	If Value = 7 Or Value = 8 Then
		Text x+50,y+50,SuitSymbol,1,1
	EndIf

	If Value = 8 Then
		Text x+50,y+100,SuitSymbol,1,1
	EndIf
	
	If Value = 9 Or Value = 10 Then
		Text x+30,y+57,SuitSymbol,1,1
		Text x+70,y+57,SuitSymbol,1,1
		Text x+30,y+93,SuitSymbol,1,1
		Text x+70,y+93,SuitSymbol,1,1
	EndIf
	
	If Value = 10 Then
		Text x+50,y+40,SuitSymbol,1,1
		Text x+50,y+110,SuitSymbol,1,1
	EndIf
EndIf


End Function

Function Convert$(Value)
	If Value = 1 Then Return "A"
	If Value = 11 Then Return "J"
	If Value = 12 Then Return "Q"
	If Value = 13 Then Return "K"
	Return Value
End Function

; demo!


ClsColor 100,150,100
Cls

For n=1 To 100
	drawcard(Rand(0,924),Rand(0,618),Rand(1,13),Rand(0,3))
Next

WaitKey

thats neat, i'm a bit on the bored side aswell, i'll try to make some nifty images in photoshop :D

here's my code:

;fluxx card game framework
Graphics 800,600,32,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()

Type card
Field num
Field x,y
Field name$,info$,kind$
Field playfunction$
Field where$
End Type 

Global hand$=""
Global keepers$=""
Global rules$=""
Global notinplay$=""
Global total

Dim temp(100)

MakeCards()
DrawHand(3)

While Not KeyDown(1)


Draw()

Wend 
End 

Function MakeCards()

Restore cards

Read total 

For num=1 To total 

Read name$,kind$

c.card=New card
c\num=num
c\name$=name$
c\kind$=kind$
c\info$=CardInfo(c\kind$)
c\playfunction$="keeper"
c\where$=""

Next 

End Function

Function DrawHand(drawnum)

Local x=1

.Draw
drawrand=Rand(1,total)
Print drawrand
For c.card=Each card
If c\num=drawrand And c\where$="" Then 
	c\where$="hand"
	c\x=x*100
	c\y=GraphicsHeight()-100
	DebugLog  "Card "+x+" Found"
	If x<drawnum Then x=x+1:Else If x=drawnum Then Return  
Else 
Goto Draw
EndIf
Next 


End Function 

Function CardInfo(typeofcard$)

Select typeofcard$

Case "Keeper"

Return "To Play Place Face Up in Front of You"

End Select 


End Function 

Function Draw()

Cls 

For c.card=Each card 
Rect c\x,c\y,50,70,1
Color 255,0,0
Text c\x+1,c\y+10,c\name$
Text c\x+1,c\y+1,c\kind$
Color 255,255,255
Next 

Flip 

End Function 

.cards
Data 4   ;total cards
Data "chocolate","Keeper"
Data "sun","Keeper"
Data "rocket","Keeper" 
Data "war","Keeper"

those examples look useful, i'll go and see if i can get this baby running.

With my code if you wanted to deal 5 cards to 3 players for example:

Current.Card = New Card
CreateDeck(0)
shufflePile(0)

For Deal = 1 To 5
For Player = 1 To 3
	current = DrawNextcard(Current.Card,0)
	GiveCardTo(Current,Player)
Next
Next

heres a 1 of hearts i made in photoshop, took 10 minutes :D

Edit, i think the texture is a bit to visible.. :\

Nice card...

...but when was the last time you saw a standard deck of cards with a "1" in it?

As far as card images go i think this is a good find
(5 minutes of google/photoshop):


load as an animated image strip and use like so:

AutoMidHandle True

image = LoadAnimImage("Media/Cards/classic-playing-cards.png",73,98,0,52)
MaskImage image,255,0,255
cur_image=0
ClsColor 0,100,0
Repeat

Cls

DrawImage image,GraphicsHeight()/2,GraphicsWidth()/2,cur_image
cur_image=cur_image+1

Delay 1000
Until cur_image >51


WaitKey

I thought I'd have a go at making them look a little better...

holy crap, that looks nice.

Edit:

:D

Graphics 800,600,16,2
ClsColor 0,100,0
Cls

Type Card
	Field position$
	Field Card_number
End Type

SeedRnd MilliSecs()


	Global image = LoadAnimImage("Media/Cards/classic-playing-cards.png",73,98,0,52)
		MaskImage image,255,0,255

	


While Not KeyHit(1)
Cls

Text 0,0,"R to redraw"

If KeyHit(19) 
Redeal()
Hand=True
End If

If Hand=True
	i=0
	For all.Card = Each Card
		DrawImage image,150+i*80,500,all\Card_number
		i=i+1	
	Next
End If

Delay 5
Flip
Wend
End


;-------------------------------
;       Redeal()
;-------------------------------

Function Redeal()

cur_image=0
Repeat
	DrawImage image,350,250,cur_image : cur_image=cur_image+1
	Delay 50
Until cur_image>51

Delete Each Card
For i=1 To 5
	.ReDraw
	Draw.Card = New Card
		Draw\position$ = "Hand"
		Draw\Card_number = Rand(0,52)
	
	Matchs = 0
	For Check.Card = Each Card
		If Draw\Card_number = Check\Card_number
			Matchs=Matchs+1
		End If
	Next

	If Matchs > 1
		Delete Draw
		Goto ReDraw
	End If
	

Next




End Function

actually yahfree, i like the first one with the texture that shows. It reminds me of the plastic-coated playing card decks.

if you like the texture fill i used maybe you'll like this:

hmm... the texture actually is a little too much isn't it?

Doesn't really matter to me as i can't use them :)

not so sure fuller, I quite like Yahfree's textures. Go s back to the old addage 'beauty is in the eye of the beholder chap'. I don't have B3d on this computer, but I'm firing up my main beast (B3D capable) to check out these posts. It's great to have a reason to play with protean again.....

regards, BP.