Poker hand analyser: Difference between revisions

</pre>

=={{header|XPL0}}==

<syntaxhighlight lang "XPL0">string 0; \Use null-terminated strings (vs MSB terminated)

int Count(1+18); \Counts of ranks and suits in a hand

proc ShowCat; \Show category of poker hand

int I, J;

[for I:= 1 to 14 do

[if Count(I) = 1 then

[for J:= I+1 to I+4 do \are next 4 cards present?

if Count(J) # 1 then J:= 100;

if J <= 100 then

[Text(0, "straight");

for J:= 15 to 18 do \scan suits

if Count(J) >= 4 then Text(0, "-flush");

return;

];

];

];

for I:= 15 to 18 do

if Count(I) = 4 then [Text(0, "flush"); return];

for I:= 1 to 14 do \scan ranks

if Count(I) = 4 then

[Text(0, "four-of-a-kind"); return];

for I:= 1 to 14 do

[if Count(I) = 3 then

[for J:= 1 to 14 do

if Count(J) = 2 then

[Text(0, "full-house"); return];

Text(0, "three-of-a-kind"); return;

];

];

for I:= 1 to 14 do

[if Count(I) = 2 then

[for J:= 1 to 14 do

if J # I and Count(J) = 2 then

[Text(0, "two-pairs"); return];

Text(0, "one-pair"); return;

];

];

Text(0, "high-card");

];

int Hands, H, Card, I, Char, N, Invalid, Valid(4), Suit, Rank;

char Str;

[Hands:= [

"2h 2d 2c kc qd ",

"2h 5h 7d 8c 9s ",

"ah 2d 3c 4c 5d ",

"2h 3h 2d 3c 3d ",

"2h 7h 2d 3c 3d ",

"2h 7h 7d 7c 7s ",

"10h jh qh kh ah ",

"4h 4s ks 5d 10s ",

"qc 10c 7c 6c qc "];

for H:= 0 to 9-1 do

[for I:= 0 to 18 do Count(I):= 0;

for I:= 0 to 3 do Valid(I):= 0;

Invalid:= false;

Str:= Hands(H);

Card:= 0; I:= 0;

loop [Char:= Str(I); I:= I+1;

case Char of

^h: N:= 18;

^d: N:= 17;

^c: N:= 16;

^s: N:= 15;

^a: N:= 14;

^k: N:= 13;

^q: N:= 12;

^j: N:= 11;

^1: N:= 10;

^ : [N:= 0; Card:= Card+1; if Card >= 5 then quit]

other N:= Char-^0;

Count(N):= Count(N)+1;

if N = 14 then Count(1):= Count(1)+1; \two-place ace

if N <= 14 then Rank:= N

else [Suit:= N - 15;

if Valid(Suit) and 1<<Rank then Invalid:= true

else Valid(Suit):= Valid(Suit) or 1<<Rank;

];

];

Text(0, Str);

if Invalid then Text(0, "invalid")

else ShowCat;

CrLf(0);

];

]</syntaxhighlight>

{{out}}

<pre>

2h 2d 2c kc qd three-of-a-kind

2h 5h 7d 8c 9s high-card

ah 2d 3c 4c 5d straight

2h 3h 2d 3c 3d full-house

2h 7h 2d 3c 3d two-pairs

2h 7h 7d 7c 7s four-of-a-kind

10h jh qh kh ah straight-flush

4h 4s ks 5d 10s one-pair

qc 10c 7c 6c qc invalid