Playing cards: Difference between revisions

Added solution for Action!
(Added Quackery.)
(Added solution for Action!)
Line 86:
4 of DIAMONDS
(NIL <state>)</pre>
 
=={{header|Action!}}==
<lang Action!>DEFINE PTR="CARD"
DEFINE MAXDECKSIZE="52"
 
TYPE Deck=[
PTR cards ;BYTE ARRAY
BYTE first,count]
 
BYTE FUNC IsEmpty(Deck POINTER d)
IF d.count=0 THEN
RETURN (1)
FI
RETURN (0)
 
BYTE FUNC IsFull(Deck POINTER d)
IF d.count=MAXDECKSIZE THEN
RETURN (1)
FI
RETURN (0)
 
BYTE FUNC Index(Deck POINTER d BYTE i)
RETURN ((d.first+i) MOD MAXDECKSIZE)
 
PROC InitEmpty(Deck POINTER d BYTE ARRAY crds)
d.cards=crds
d.first=0
d.count=0
RETURN
 
PROC InitFull(Deck POINTER d BYTE ARRAY crds)
BYTE i
 
d.cards=crds
d.first=0
d.count=MAXDECKSIZE
FOR i=0 TO MAXDECKSIZE-1
DO
crds(i)=i
OD
RETURN
 
PROC Shuffle(Deck POINTER d)
BYTE i,j,i2,j2,tmp
BYTE ARRAY crds
 
crds=d.cards
i=d.count-1
WHILE i>0
DO
j=Rand(i)
i2=Index(d,i)
j2=Index(d,j)
tmp=crds(i2)
crds(i2)=crds(j2)
crds(j2)=tmp
i==-1
OD
RETURN
 
BYTE FUNC Deal(Deck POINTER d)
BYTE ARRAY crds
BYTE c
 
IF IsEmpty(d) THEN
PrintE("Error: deck is empty!")
Break()
FI
 
crds=d.cards
c=crds(d.first)
d.count==-1
d.first==+1
IF d.first=MAXDECKSIZE THEN
d.first=0
FI
RETURN (c)
 
PROC Add(Deck POINTER d BYTE c)
BYTE ARRAY crds
BYTE i
 
IF IsFull(d) THEN
PrintE("Error: deck is full!")
Break()
FI
 
crds=d.cards
i=Index(d,d.count)
crds(i)=c
d.count==+1
RETURN
 
PROC PrintCard(BYTE c)
BYTE s,v
BYTE ARRAY fig=['J 'Q 'K 'A]
BYTE ARRAY suit=[16 96 0 123]
 
s=c/13 v=c MOD 13
IF v<=8 THEN
PrintB(v+2)
ELSE
Put(fig(v-9))
FI
Put(suit(s))
RETURN
 
PROC PrintDeck(Deck POINTER d)
BYTE i,i2
BYTE ARRAY crds
 
crds=d.cards
IF IsEmpty(d) THEN
Print("Empty")
ELSE
FOR i=0 TO d.count-1
DO
i2=Index(d,i)
PrintCard(crds(i2))
IF i<d.count-1 THEN
Put(' )
FI
OD
FI
RETURN
 
PROC Main()
BYTE LMARGIN=$52,oldLMARGIN,i,c
BYTE ARRAY crds(MAXDECKSIZE),crds1(MAXDECKSIZE),crds2(MAXDECKSIZE)
Deck d,d1,d2
 
oldLMARGIN=LMARGIN
LMARGIN=0 ;remove left margin on the screen
Put(125) PutE() ;clear the screen
 
PrintE("New deck:")
InitFull(d,crds)
PrintDeck(d) PutE() PutE()
 
PrintE("Shuffle:")
Shuffle(d)
PrintDeck(d) PutE() PutE()
 
PrintE("Deal cards:")
InitEmpty(d1,crds1) InitEmpty(d2,crds2)
FOR i=1 TO 5
DO
c=Deal(d) Add(d1,c)
c=Deal(d) Add(d2,c)
OD
Print(" Player 1: ") PrintDeck(d1) PutE()
Print(" Player 2: ") PrintDeck(d2) PutE() PutE()
 
PrintE("Deck after dealing:")
PrintDeck(d)
 
LMARGIN=oldLMARGIN ;restore left margin on the screen
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Playing_cards.png Screenshot from Atari 8-bit computer]
<pre>
New deck:
2♣ 3♣ 4♣ 5♣ 6♣ 7♣ 8♣ 9♣ 10♣ J♣ Q♣ K♣ A♣
2♦ 3♦ 4♦ 5♦ 6♦ 7♦ 8♦ 9♦ 10♦ J♦ Q♦ K♦ A♦
2♥ 3♥ 4♥ 5♥ 6♥ 7♥ 8♥ 9♥ 10♥ J♥ Q♥ K♥ A♥
2♠ 3♠ 4♠ 5♠ 6♠ 7♠ 8♠ 9♠ 10♠ J♠ Q♠ K♠ A♠
 
Shuffle:
5♥ K♦ 2♣ 3♠ 4♣ 5♣ 9♦ J♣ 10♠ K♣ K♠ 8♦ 5♦
3♦ 4♠ 4♥ 10♦ 8♥ 3♣ A♦ 7♣ 10♥ Q♣ 6♦ 2♦ 3♥
4♦ 7♥ 7♦ J♥ 9♣ A♥ 2♠ 10♣ J♠ Q♥ 2♥ A♣ Q♦
8♣ 9♥ 9♠ 6♥ K♥ Q♠ 6♣ 5♠ A♠ 8♠ J♦ 6♠ 7♠
 
Deal cards:
Player 1: 5♥ 2♣ 4♣ 9♦ 10♠
Player 2: K♦ 3♠ 5♣ J♣ K♣
 
Deck after dealing:
K♠ 8♦ 5♦ 3♦ 4♠ 4♥ 10♦ 8♥ 3♣ A♦ 7♣ 10♥ Q♣
6♦ 2♦ 3♥ 4♦ 7♥ 7♦ J♥ 9♣ A♥ 2♠ 10♣ J♠ Q♥
2♥ A♣ Q♦ 8♣ 9♥ 9♠ 6♥ K♥ Q♠ 6♣ 5♠ A♠ 8♠
J♦ 6♠ 7♠
</pre>
 
=={{header|Ada}}==
Anonymous user