Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,162 +0,0 @@
|
|||
pragma Ada_2022;
|
||||
with Ada.Characters.Handling; use Ada.Characters.Handling;
|
||||
with Ada.Containers.Generic_Constrained_Array_Sort;
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
|
||||
procedure Poker is
|
||||
|
||||
type Face_T is (two, three, four, five, six, seven, eight, nine, t, j, q, k, a);
|
||||
for Face_T use (2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14);
|
||||
type Suit_T is (C, D, H, S);
|
||||
type Card_T is record
|
||||
Face : Face_T;
|
||||
Suit : Suit_T;
|
||||
end record;
|
||||
|
||||
subtype Hand_Index is Natural range 1 .. 5;
|
||||
type Hand_T is array (Hand_Index) of Card_T;
|
||||
type Test_Hand_Arr is array (Positive range <>) of Hand_T;
|
||||
type Pip_Counter_T is array (Face_T range Face_T'Range) of Natural;
|
||||
|
||||
Pip_Counts : Pip_Counter_T := [others => 0];
|
||||
|
||||
Test_Hands : Test_Hand_Arr := [
|
||||
1 => [(two, H), (two, D), (two, C), (k, S), (q, D)],
|
||||
2 => [(two, H), (five, H), (seven, D), (eight, C), (nine, S)],
|
||||
3 => [(a, H), (two, D), (three, C), (four, C), (five, D)],
|
||||
4 => [(two, H), (three, H), (two, D), (three, C), (three, D)],
|
||||
5 => [(two, H), (seven, H), (two, D), (three, C), (three, D)],
|
||||
6 => [(two, H), (seven, H), (seven, D), (seven, C), (seven, S)],
|
||||
7 => [(t, H), (j, H), (q, H), (k, H), (a, H)],
|
||||
8 => [(four, H), (four, S), (k, S), (five, D), (t, S)],
|
||||
9 => [(q, C), (t, C), (seven, C), (six, C), (q, C)]
|
||||
];
|
||||
|
||||
function "<" (L, R : Card_T) return Boolean is
|
||||
begin
|
||||
if L.Face = R.Face then
|
||||
return L.Suit < R.Suit;
|
||||
else
|
||||
return L.Face < R.Face;
|
||||
end if;
|
||||
end "<";
|
||||
|
||||
procedure Sort_Hand is new Ada.Containers.Generic_Constrained_Array_Sort (Hand_Index, Card_T, Hand_T);
|
||||
|
||||
procedure Print_Hand (Hand : Hand_T) is
|
||||
begin
|
||||
for Card of Hand loop
|
||||
if Card.Face < j then
|
||||
Put (Face_T'Enum_Rep (Card.Face)'Image);
|
||||
else
|
||||
Put (" " & To_Lower (Card.Face'Img));
|
||||
end if;
|
||||
Put (To_Lower (Card.Suit'Img));
|
||||
end loop;
|
||||
end Print_Hand;
|
||||
|
||||
function Is_Invalid (Hand : Hand_T) return Boolean is
|
||||
begin
|
||||
for Ix in 2 .. 5 loop
|
||||
if Face_T'Pos (Hand (Ix).Face) = Face_T'Pos (Hand (Ix - 1).Face) and then
|
||||
Hand (Ix).Suit = Hand (Ix - 1).Suit
|
||||
then
|
||||
return True;
|
||||
end if;
|
||||
end loop;
|
||||
return False;
|
||||
end Is_Invalid;
|
||||
|
||||
function Is_Flush (Hand : Hand_T) return Boolean is
|
||||
begin
|
||||
for Ix in 2 .. 5 loop
|
||||
if Hand (Ix).Suit /= Hand (1).Suit then
|
||||
return False;
|
||||
end if;
|
||||
end loop;
|
||||
return True;
|
||||
end Is_Flush;
|
||||
|
||||
function Is_Straight (Hand : Hand_T) return Boolean is
|
||||
begin
|
||||
-- special case: Ace low
|
||||
if Hand (5).Face = a and then Hand (1).Face = two and then Hand (2).Face = three and then Hand (3).Face = four then
|
||||
return True;
|
||||
end if;
|
||||
for Ix in 2 .. 5 loop
|
||||
if Face_T'Pos (Hand (Ix).Face) /= Face_T'Pos (Hand (Ix - 1).Face) + 1 then
|
||||
return False;
|
||||
end if;
|
||||
end loop;
|
||||
return True;
|
||||
end Is_Straight;
|
||||
|
||||
function Of_A_Kind (N : Positive) return Boolean is
|
||||
begin
|
||||
for Pip in two .. a loop
|
||||
if Pip_Counts (Pip) = N then
|
||||
return True;
|
||||
end if;
|
||||
end loop;
|
||||
return False;
|
||||
end Of_A_Kind;
|
||||
|
||||
function Count_Pairs return Natural is
|
||||
Pairs : Natural := 0;
|
||||
begin
|
||||
for Pip in two .. a loop
|
||||
if Pip_Counts (Pip) = 2 then
|
||||
Pairs := Pairs + 1;
|
||||
end if;
|
||||
end loop;
|
||||
return Pairs;
|
||||
end Count_Pairs;
|
||||
|
||||
Flush, Straight : Boolean;
|
||||
|
||||
begin
|
||||
|
||||
for Hand of Test_Hands loop
|
||||
Print_Hand (Hand);
|
||||
Put (":");
|
||||
Set_Col (20);
|
||||
Sort_Hand (Hand); -- Print_Hand (Hand);
|
||||
if Is_Invalid (Hand) then
|
||||
Put ("invalid");
|
||||
else
|
||||
Flush := Is_Flush (Hand);
|
||||
Straight := Is_Straight (Hand);
|
||||
if Flush and Straight then
|
||||
Put ("straight-flush");
|
||||
else
|
||||
for Pip in two .. a loop
|
||||
Pip_Counts (Pip) := 0;
|
||||
for Card of Hand loop
|
||||
if Card.Face = Pip then
|
||||
Pip_Counts (Pip) := Pip_Counts (Pip) + 1;
|
||||
end if;
|
||||
end loop;
|
||||
end loop;
|
||||
if Of_A_Kind (4) then
|
||||
Put ("four-of-a-kind");
|
||||
elsif Of_A_Kind (3) and then Of_A_Kind (2) then
|
||||
Put ("full-house");
|
||||
elsif Flush then
|
||||
Put ("flush");
|
||||
elsif Straight then
|
||||
Put ("straight");
|
||||
elsif Of_A_Kind (3) then
|
||||
Put ("three-of-a-kind");
|
||||
else
|
||||
case Count_Pairs is
|
||||
when 2 => Put ("two-pairs");
|
||||
when 1 => Put ("one-pair");
|
||||
when others => Put ("high-card");
|
||||
end case;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
Put_Line ("");
|
||||
end loop;
|
||||
|
||||
end Poker;
|
||||
|
|
@ -1,124 +0,0 @@
|
|||
option explicit
|
||||
class playingcard
|
||||
dim suit
|
||||
dim pips
|
||||
'public property get gsuit():gsuit=suit:end property
|
||||
'public property get gpips():gpips=pips:end property
|
||||
public sub print
|
||||
dim s,p
|
||||
select case suit
|
||||
case "S":s=chrW(&h2660)
|
||||
case "D":s=chrW(&h2666)
|
||||
case "C":s=chrW(&h2663)
|
||||
case "H":s=chrW(&h2665)
|
||||
end select
|
||||
|
||||
select case pips
|
||||
case 1:p="A"
|
||||
case 11:p="J"
|
||||
case 12:p="Q"
|
||||
case 13:p="K"
|
||||
case else: p=""& pips
|
||||
end select
|
||||
|
||||
wscript.stdout.write right(" "&p & s,3)&" "
|
||||
end sub
|
||||
end class
|
||||
|
||||
sub printhand(byref h,start)
|
||||
dim i
|
||||
for i =start to ubound(h)
|
||||
h(i).print
|
||||
next
|
||||
'wscript.stdout.writeblanklines(1)
|
||||
end sub
|
||||
|
||||
function checkhand(byval arr)
|
||||
dim ss,i,max,last,uses,toppip,j,straight, flush,used,ace
|
||||
redim nn(13)
|
||||
|
||||
ss=arr(0).suit '?????
|
||||
straight=true:flush=true
|
||||
max=0:last=0:used=0:toppip=0:ace=0
|
||||
for i=0 to ubound(arr)
|
||||
j=arr(i).pips
|
||||
if arr(i).suit<>ss then flush=false
|
||||
if j>toppip then toppip=j
|
||||
if j=1 then ace=1
|
||||
nn(j)=nn(j)+1
|
||||
if nn(j)>max then max= nn(j)
|
||||
if abs(j-toppip)>=4 then straight=0
|
||||
next
|
||||
for i=1 to ubound(nn)
|
||||
if nn(i) then used=used+1
|
||||
next
|
||||
if max=1 then
|
||||
if nn(1) and nn(10) and nn(11) and nn(12) and nn(13) then straight=1
|
||||
end if
|
||||
if flush and straight and max=1 then
|
||||
checkhand= "straight-flush"
|
||||
elseif flush then
|
||||
checkhand= "flush"
|
||||
elseif straight and max=1 then
|
||||
checkhand= "straight"
|
||||
elseif max=4 then
|
||||
checkhand= "four-of-a-kind"
|
||||
elseif max=3 then
|
||||
if used=2 then
|
||||
checkhand= "full-house"
|
||||
else
|
||||
checkhand= "three-of-a-kind"
|
||||
end if
|
||||
elseif max=2 then
|
||||
if used=3 then
|
||||
checkhand= "two-pair"
|
||||
else
|
||||
checkhand= "one-pair"
|
||||
end if
|
||||
else
|
||||
checkhand= "Top "& toppip
|
||||
End If
|
||||
end function
|
||||
|
||||
|
||||
function readhand(h)
|
||||
dim i,b,c,p
|
||||
redim a(4)
|
||||
for i=0 to ubound(a)
|
||||
b=h(i)
|
||||
set c=new playingcard
|
||||
p=left(b,1)
|
||||
select case p
|
||||
case "j": c.pips=11
|
||||
case "q": c.pips=12
|
||||
case "k": c.pips=13
|
||||
case "t": c.pips=10
|
||||
case "a": c.pips=1
|
||||
case else c.pips=cint(p)
|
||||
end select
|
||||
c.suit=ucase(right(b,1))
|
||||
set a(i)=c
|
||||
next
|
||||
readhand=a
|
||||
erase a
|
||||
end function
|
||||
|
||||
dim hands,hh,i
|
||||
hands = Array(_
|
||||
Array("2h", "5h", "7d", "8c", "9s"),_
|
||||
Array("2h", "2d", "2c", "kc", "qd"),_
|
||||
Array("ah", "2d", "3c", "4c", "5d"),_
|
||||
Array("2h", "3h", "2d", "3c", "3d"),_
|
||||
Array("2h", "7h", "2d", "3c", "3d"),_
|
||||
Array("th", "jh", "qh", "kh", "ah"),_
|
||||
Array("4h", "4s", "ks", "5d", "ts"),_
|
||||
Array("qc", "tc", "7c", "6c", "4c"),_
|
||||
Array("ah", "ah", "7c", "6c", "4c"))
|
||||
|
||||
for i=1 to ubound(hands)
|
||||
hh=readhand(hands(i))
|
||||
printhand hh,0
|
||||
wscript.stdout.write vbtab & checkhand(hh)
|
||||
wscript.stdout.writeblanklines(1)
|
||||
'exit for
|
||||
next
|
||||
Loading…
Add table
Add a link
Reference in a new issue