Advertisement
mixster

mixster

May 15th, 2009
189
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 5.40 KB | None | 0 0
  1. program Poker;
  2. type
  3.   TPoker = record
  4.     suit: Integer;
  5.     value: Integer;
  6.   end;
  7. type
  8.   THand = record
  9.     cards: array of TPoker;
  10.     value: Integer;
  11.   end;
  12. var
  13.   hand, table: array of TPoker;
  14.  
  15. procedure Write(input: TVariantArray);
  16. var
  17.   s: string;
  18.   i: Integer;
  19. begin
  20.   s := '';
  21.   for i := 0 to High(input) do
  22.     s := s + input[i];
  23.   Writeln(s);
  24. end;
  25.  
  26. procedure WriteHand(input: THand);
  27. var
  28.   s: string;
  29.   i: Integer;
  30. begin
  31.   s := IntToStr(input.value) + ': ';
  32.   for i := 0 to High(input.cards) do
  33.   begin
  34.     case input.cards[i].suit of
  35.       0: s := s + '(H)';
  36.       1: s := s + '(D)';
  37.       2: s := s + '(C)';
  38.       3: s := s + '(S)';
  39.     end;
  40.     if (input.cards[i].value < 10) then
  41.       s := s + IntToStr(input.cards[i].value + 1)
  42.     else
  43.       case input.cards[i].value of
  44.         10: s := s + 'J';
  45.         11: s := s + 'Q';
  46.         12: s := s + 'K';
  47.       end;
  48.     s := s + '; ';
  49.   end;
  50.   Writeln(s);
  51. end;
  52.  
  53. function Card(suit, value: Integer): TPoker;
  54. begin
  55.   Result.suit := suit;
  56.   Result.value := value;
  57. end;
  58.  
  59. function GroupSuits(input: array of TPoker): array of array of TPoker;
  60. var
  61.   i: Integer;
  62.   l: TIntegerArray;
  63. begin
  64.   SetLength(Result, 4);
  65.   l := [0, 0, 0, 0];
  66.   for i := 0 to High(input) do
  67.     l[input[i].suit] := l[input[i].suit] + 1;
  68.   for i := 0 to 3 do
  69.     SetLength(Result[i], l[i]);
  70.   l := [0, 0, 0, 0];
  71.   for i := 0 to High(input) do
  72.   begin
  73.     Result[input[i].suit][l[input[i].suit]] := input[i];
  74.     l[input[i].suit] := l[input[i].suit] + 1;
  75.   end;
  76. end;
  77.  
  78. procedure SizeOrder(var input: array of TPoker);
  79. var
  80.   i, ii: Integer;
  81.   ordered: array of TPoker;
  82. begin
  83.   SetLength(ordered, Length(input));
  84.   for i := 0 to High(input) do
  85.   begin
  86.     ordered[0] := input[i];
  87.     for ii := 1 to High(ordered) do
  88.       if (ordered[ii - 1].value > ordered[ii].value) then
  89.         Swap(ordered[ii], ordered[ii - 1])
  90.       else
  91.         break;
  92.   end;
  93.   ii := High(ordered);
  94.   for i := 0 to ii do
  95.     input[i] := ordered[ii - i];
  96. end;
  97.  
  98. function FindFlush(input: array of TPoker): THand;
  99. var
  100.   i: Integer;
  101. begin
  102.   SetLength(Result.cards, 0);
  103.   if (Length(input) < 5) then
  104.     exit;
  105.   SetLength(Result.cards, 5);
  106.   for i := 0 to 4 do
  107.     Result.cards[i] := input[i];
  108.   Result.value := 4;
  109. end;
  110.  
  111. procedure FilterSameCards(var input: array of TPoker);
  112. var
  113.   i, l: Integer;
  114.   store: array of TPoker;
  115. begin
  116.   l := 0;
  117.   SetLength(store, l + 1);
  118.   store[l] := input[0];
  119.   for i := 1 to High(input) do
  120.     if (input[i].value <> store[l].value) then
  121.     begin
  122.       l := l + 1;
  123.       SetLength(store, l + 1);
  124.       store[l] := input[i];
  125.     end;
  126.   SetLength(input, l + 1);
  127.   for i := 0 to l do
  128.     input[i] := store[i];
  129. end;
  130.  
  131. function FindStraight(input: array of TPoker): THand;
  132. var
  133.   i, ii, l: Integer;
  134. begin
  135.   SetLength(Result.cards, 0);
  136.   FilterSameCards(input);
  137.   if (Length(input) < 5) then
  138.     exit;
  139.   l := 1;
  140.   for i := 1 to High(input) do
  141.   begin
  142.     if (input[i].value = input[i - 1].value - 1) then
  143.       l := l + 1
  144.     else
  145.       l := 1;
  146.     if (l >= 5) then
  147.     begin
  148.       Write(['Found a straight!']);
  149.       SetLength(Result.cards, 5);
  150.       for ii := 0 to 4 do
  151.         Result.cards[4 - ii] := input[i - ii];
  152.       Result.value := 5;
  153.     end;
  154.   end;
  155. end;
  156.  
  157. function FindPairs(input: array of TPoker): array of THand;
  158. var
  159.   i, ii, l, r: Integer;
  160. begin
  161.   l := 1;
  162.   r := 0;
  163.   SetLength(Result, 0);
  164.   for i := 1 to High(input) do
  165.     if (input[i].value = input[i - 1].value) then
  166.       l := l + 1
  167.     else
  168.     begin
  169.       if (l >= 2) then
  170.       begin
  171.         SetLength(Result, r + 1);
  172.         SetLength(Result[r].cards, l);
  173.         for ii := 0 to l - 1 do
  174.           Result[r].cards[ii] := input[i - ii - 1];
  175.         case l of
  176.           2: Result[r].value := 8;
  177.           3: Result[r].value := 6;
  178.           4: Result[r].value := 2;
  179.         end;
  180.         r := r + 1;
  181.       end;
  182.       l := 1;
  183.     end;
  184. end;
  185.  
  186. procedure AddHand(var curHands: array of THand; newHand: THand);
  187. var
  188.   i, l, h: Integer;
  189. begin
  190.   l := Length(curHands);
  191.   SetLength(curHands, l + 1);
  192.   h := High(newHand.cards);
  193.   SetLength(curHands[l].cards, h + 1);
  194.   for i := 0 to h do
  195.     curHands[l].cards[i] := newHand.cards[i];
  196.   curHands[l].value := newHand.value;
  197. end;
  198.  
  199. function CreateHands(input: array of array of TPoker): array of THand;
  200. var
  201.   i, ii, l, h: Integer;
  202.   allCards: array of TPoker;
  203.   suits: array of array of TPoker;
  204.   pairs: array of THand;
  205.   flush, straight: THand;
  206. begin
  207.   for i := 0 to High(input) do
  208.     l := l + Length(input[i]);
  209.   SetLength(allCards, l);
  210.   l := 0;
  211.   for i := 0 to High(input) do
  212.     for ii := 0 to High(input[i]) do
  213.     begin
  214.       allCards[l] := input[i][ii];
  215.       l := l + 1;
  216.     end;
  217.    
  218.   SizeOrder(allCards);
  219.   suits := GroupSuits(allCards);
  220.  
  221.   for i := 0 to 3 do
  222.   begin
  223.     flush := FindFlush(suits[i]);
  224.     if (Length(flush.cards) <> 0) then
  225.       AddHand(Result, flush);
  226.   end;
  227.  
  228.   straight := FindStraight(allCards);
  229.   if (Length(straight.cards) <> 0) then
  230.     AddHand(Result, straight);
  231.  
  232.   pairs := FindPairs(allCards);
  233.   h := High(pairs);
  234.   for i := 0 to h do
  235.     AddHand(Result, pairs[i]);
  236.  
  237.   for i := 0 to High(Result) do
  238.     WriteHand(Result[i]);
  239. end;
  240.  
  241. begin
  242.   Write(['Begin']);
  243.   hand := [Card(1, 5), Card(3, 7)];
  244.   table := [Card(1, 6), Card(1, 4), Card(0,7), Card(2,2), Card(3, 6)];
  245.   CreateHands([hand, table]);
  246.   Write(['End']);
  247. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement