Program Poker;

{Ken Hoetmer}

{This Program will create an ordered deck of cards (52 - no jokers). Next it
will shuffle the deck (two-dimensional array) by swapping randomly selected
cards with each other 40000 times.  It will then deal the user the top five
cards from the shuffled deck.  It will allow the user to throw back any of
the five cards dealt, and then deal new ones off of the top of the deck.
Then it will analyze the hand to see what kind of hand the user has.  It will
then add money to the total if the hand was a winning hand.  The money value
will be able to be carried over for multiple rounds.  The game will also give
the user a straight flush or a royal flush based on a random number generator.}


Uses Crt;

{--------- Define Universal Constants, Arrays, and Types, and Labels -------}

Const
     heart   = chr(3);
     diamond = chr(4);
     club    = chr(5);
     spade   = chr(6);

Type
    deck     = array[1..4,1..13] of string[20];
    card     = string[20];

Var

   index,index2,index3,index4,index5,
   index6,index7,rank1,rank2,suit1,
   suit2,num,num1,num2                        : shortint;
   new,straight                               : array[1..5] of shortint;
   count,nodecimal,index8,
   checktens                                  : longint;
   menu,choose                                : char;
   throws                                     : array[1..200] of char;
   startdeck                                  : deck;
   tempsuit                                   : string[8];
   rank                                       : array[1..14] of string[6];
   suit                                       : array[1..4] of string[8];
   suitdraw                                   : array[1..4] of string[1];
   temp,temprank                              : card;
   handrank,handsuit,playhand                 : array[1..5] of card;
   handvalue                                  : array[1..9] of card;
   playdeck                                   : array[1..52] of card;
   hand                                       : array[1..9] of boolean;
   P                                          : pointer;
   winnings,numvalue                          : array[1..9] of real;
   Money, bet,cash,totalmoney                 : real;

Label Suck,Youloseforreal;

{------------- Procedure Set Arrays ----------------------------------}

Procedure Set_arrays;

{Will be called from the beginning to fill up the arrays with the required
strings, integers, etc.}

Begin              {Procedure Set Arrays}

    for index := 1 to 9 do hand[index] := false;
    for index := 1 to 9 do winnings[index] := 0;
    for index := 1 to 9 do numvalue[index] := 0;

    rank[1] := 'Ace';               rank[8] := 'Eight';
    rank[2] := 'Two';               rank[9] := 'Nine';
    rank[3] := 'Three';             rank[10] := 'Ten';
    rank[4] := 'Four';              rank[11] := 'Jack';
    rank[5] := 'Five';              rank[12] := 'Queen';
    rank[6] := 'Six';               rank[13] := 'King';
    rank[7] := 'Seven';             rank[14] := 'Ace';

    suit[1] := 'Hearts';            suit[3] := 'Clubs';
    suit[2] := 'Diamonds';          suit[4] := 'Spades';

    suitdraw[1] := Heart;           suitdraw[3] := Club;
    suitdraw[2] := Diamond;         suitdraw[4] := Spade;

    handvalue[1] := 'Royal Flush';       HandValue[2] := 'Straight Flush';
    handvalue[3] := 'Four of a Kind';    HandValue[4] := 'Full House';
    handvalue[5] := 'Flush';             HandValue[6] := 'Straight';
    handvalue[7] := 'Three of a Kind';   HandValue[8] := 'Two Pair';
    handvalue[9] := 'Pair-Face Cards';

End;             {Procedure Set Arrays}

{--------------- Procedure Fill Deck ------------------------------------}

Procedure Fill_Deck;

{Will fill the deck array with the set of cards}

Begin               {Procedure Fill Deck}

    count := 0;
    index := 0;
    while count < 4 do begin
          inc(count);
          while index < 13 do begin
              inc(index);
              startdeck[count,index] := rank[index] + ' of ' + suit[count];
          end;
          index := 0;
    end;

end;            {Procedure Fill Deck}

{----------------- Procedure Shuffle Deck ---------------------------------}

Procedure Shuffle_Deck(shuffles : longint);

{Will randomly swap the memory locations of 2 cards 40000 times in order to
shuffle the deck}

Begin            {Procedure Shuffle Deck}

   randomize;
   for count := 1 to (shuffles) do begin
       suit1 := trunc(random*4) + 1;
       rank1 := trunc(random*13) + 1;
       suit2 := trunc(random*4) + 1;
       rank2 := trunc(random*13) + 1;
       temp := startdeck[suit1,rank1];
       startdeck[suit1,rank1] := startdeck[suit2,rank2];
       startdeck[suit2,rank2] := temp;
   end;

End;            {Procedure Shuffle Deck}

{--------------- Procedure First Cards ------------------------------------}

Procedure Firstcards;

{will deal the user the top five cards off the deck}

Begin          {Procedure First Cards}

    num := 0;
    count := 0;
    Repeat
          inc(count);
          index := 0;
          repeat
                inc(num);
                inc(index);
                playdeck[num] := startdeck[count,index];
          until index = 13;
    until count = 4;
    count := 0;
    for count := 1 to 5 do playhand[count] := playdeck[count];

end;          {Procedure first cards}

{------------------- Procedure Draw Ace ---------------------------------}

Procedure Draw_Ace;

Begin
     gotoxy(2,2);
     write ('A');
     gotoxy (12,8);
     write ('A');
     gotoxy (7,5);
     write (suitdraw[suit1]);
End;

{------------------ Procedure Draw Two --------------------------------}

Procedure Draw_Two;

Begin
     gotoxy(2,2);
     write ('2');
     gotoxy (12,8);
     write ('2');
     gotoxy (7,3);
     write (suitdraw[suit1]);
     gotoxy (7,7);
     write (suitdraw[suit1]);
end;

{-------------- Procedure Draw Three ------------------------------}

Procedure Draw_Three;

Begin
     gotoxy(2,2);
     write ('3');
     gotoxy (12,8);
     write ('3');
     gotoxy (7,3);
     write (suitdraw[suit1]);
     gotoxy (7,5);
     write (suitdraw[suit1]);
     gotoxy (7,7);
     write (suitdraw[suit1]);
end;

{---------------- Procedure Draw Four ---------------------------------}

Procedure Draw_Four;

Begin
     gotoxy(2,2);
     write ('4');
     gotoxy (12,8);
     write ('4');
     gotoxy (5,3);
     write (suitdraw[suit1]);
     gotoxy (5,7);
     write (suitdraw[suit1]);
     gotoxy (9,3);
     write (suitdraw[suit1]);
     gotoxy (9,7);
     write (suitdraw[suit1]);
end;

{---------------- Procedure Draw Five ---------------------------}

Procedure Draw_Five;

Begin
     gotoxy(2,2);
     write ('5');
     gotoxy (12,8);
     write ('5');
     gotoxy (4,3);
     write (suitdraw[suit1]);
     gotoxy (10,3);
     write (suitdraw[suit1]);
     gotoxy (7,5);
     write (suitdraw[suit1]);
     gotoxy (4,7);
     write (suitdraw[suit1]);
     gotoxy (10,7);
     write (suitdraw[suit1]);
end;

{--------------- Procedure Draw Six ---------------------------------}

Procedure Draw_Six;

Begin
        gotoxy(2,2);
        write ('6');
        gotoxy (12,8);
        write ('6');
        index2 := 1;
        repeat
              index2 := index2 + 2;
              gotoxy (5,index2);
              write (suitdraw[suit1]);
              gotoxy (9,index2);
              write (suitdraw[suit1]);
        until index2 = 7;
end;

{---------------- Procedure Draw Seven ---------------------------------}

Procedure Draw_Seven;

Begin                {Procedure Draw Seven}

     gotoxy(2,2);
     write ('7');
     gotoxy (12,8);
     write ('7');
     index2 := 1;

{--- Draw the symbols in the center using an array ---------}

        repeat
              index2 := index2 + 2;
              gotoxy (4,index2);
              write (suitdraw[suit1]);
              gotoxy (10,index2);
              write (suitdraw[suit1]);
        until index2 = 7;

     gotoxy (7,4);
     write (suitdraw[suit1]);

End;                         {Procedure Draw Seven}

{---------- Procedure Draw Eight ----------------------------------}

Procedure Draw_Eight;

Begin                {Procedure Draw Eight}

     gotoxy(2,2);
     write ('8');
     gotoxy (12,8);
     write ('8');
     index2 := 1;
        repeat
              index2 := index2 + 2;
              gotoxy (4,index2);
              write (suitdraw[suit1]);
              gotoxy (10,index2);
              write (suitdraw[suit1]);
        until index2 = 7;
     gotoxy (7,4);
     write (suitdraw[suit1]);
     gotoxy (7,6);
     write (suitdraw[suit1]);

End;                {Procedure Draw Eight}

{--------------- Procedure Draw Nine ------------------------------}

Procedure Draw_Nine;

Begin               {Procedure Draw Nine}

     gotoxy(2,2);
     write ('9');
     gotoxy (12,8);
     write ('9');
     index2 := 0;
        repeat
              index2 := index2 + 2;
              gotoxy (5,index2);
              write (suitdraw[suit1]);
              gotoxy (9,index2);
              write (suitdraw[suit1]);
        until index2 = 8;
     gotoxy (7,5);
     write (suitdraw[suit1]);

End;               {Procedure Draw Nine}

{-------------- Procedure Draw Ten ----------------------------------------}

Procedure Draw_Ten;

Begin              {Procedure Draw Ten}

     gotoxy(2,2);
     write ('1');
     gotoxy (2,3);
     write ('0');
     gotoxy (12,7);
     write ('1');
     gotoxy (12,8);
     write ('0');
     index2 := 0;
        repeat
              index2 := index2 + 2;
              gotoxy (5,index2);
              write (suitdraw[suit1]);
              gotoxy (9,index2);
              write (suitdraw[suit1]);
        until index2 = 8;
     gotoxy (7,3);
     write (suitdraw[suit1]);
     gotoxy (7,7);
     write (suitdraw[suit1]);

End;               {Procedure Draw Ten}

{---------- Procedure Draw Jack ----------------------------------------}

Procedure Draw_Jack;

Begin               {Procedure Draw Jack}

     gotoxy (3,2);
     writeln('JJJJJJJJJ');
     writeln('      JJ');
     writeln('      JJ');
     writeln('      JJ');
     writeln('  JJ  JJ');
     writeln('  JJ  JJ');
     writeln('   JJJJJ');

end;                {Procedure Draw Jack}

{-------------- Procedure Draw Queen ----------------------------------}

Procedure Draw_Queen;

Begin                {Procedure Draw Queen}

     gotoxy(3,2);
     writeln('  QQQQ');
     writeln('  QQ    QQ');
     writeln('  QQ    QQ');
     writeln('  QQ    QQ');
     writeln('  QQ  Q QQ');
     writeln('    QQQQQ');
     writeln('        QQ');

end;                 {Procedure Draw Queen}

{------------ Procedure Draw King --------------------------------------}

Procedure Draw_King;

Begin               {Procedure Draw King}

     gotoxy(3,2);
     writeln(' KK   KK');
     writeln('   KK  KK');
     writeln('   KK KK');
     writeln('   KKKK');
     writeln('   KK KK');
     writeln('   KK  KK');
     writeln('   KK   KK');

end;             {Procedure Draw King}

{------------------ Procedure Find Rank ------------------------------}

Procedure Find_Rank(rankcount : shortint);

{This Procedure will check the first word of the card string (rank) against
strings containing the ranks to find the rank of the card.  It will then
call the specific procedure to draw that rank}

Begin             {Procedure Find Rank}

     temprank := 'fred';
     num := 0;
     Repeat
        inc(num);
        if playhand[rankcount][num] = ' ' then begin
           temprank := copy (playhand[rankcount],1,num-1);
        end;
     Until temprank <> 'fred';
     if temprank = 'Ace' then Draw_Ace;
     if temprank = 'Two' then Draw_Two;
     if temprank = 'Three' then Draw_Three;
     if temprank = 'Four' then Draw_Four;
     if temprank = 'Five' then Draw_Five;
     if temprank = 'Six' then Draw_Six;
     if temprank = 'Seven' then Draw_Seven;
     if temprank = 'Eight' then Draw_Eight;
     if temprank = 'Nine' then Draw_Nine;
     if temprank = 'Ten' then Draw_Ten;
     if temprank = 'Jack' then Draw_Jack;
     if temprank = 'Queen' then Draw_Queen;
     if temprank = 'King' then Draw_King;

End;              {Procedure Find Rank}

{------------ Procedure Draw Suit -------------------------------------}

Procedure drawsuit(suitcount : shortint);

{This procedure will test the last word of the string (suit) and test it
against the suits to find the suit of the card.  It will then draw the suit
markings in the corner of the cards}

Begin             {Procedure Draw Suit}

     suit1 := 0;
     for num := 1 to length(playhand[suitcount]) do begin
             if (playhand[suitcount][num] = ' ') and (playhand[suitcount][num+3] <> ' ') then begin
                suit2 := length(playhand[suitcount]);
                tempsuit := copy(playhand[suitcount],num+1,suit2 - (num-1));
             end;
     end;
     if tempsuit = 'Hearts'         then suit1 := 1;
     if tempsuit = 'Diamonds'       then suit1 := 2;
     if tempsuit = 'Clubs'          then suit1 := 3;
     if tempsuit = 'Spades'         then suit1 := 4;
     if (suit1 = 1) or (suit1 = 2) then textcolor(red);
     if (suit1 = 3) or (suit1 = 4) then textcolor(black);
     gotoxy (2,1);
     write (suitdraw[suit1]);
     gotoxy(12,1);
     write (suitdraw[suit1]);
     gotoxy (2,9);
     write (suitdraw[suit1]);
     gotoxy (12,9);
     write (suitdraw[suit1]);


end;              {Procedure Draw Suit}

{------------ Procedure Draw Cards -----------------------------------}

Procedure Drawcards;

{This Procedure will draw windows on the bottom of the screen to represent
cards.  It will then call the find rank and draw suit procedures to draw
the card markings in the window.  It also contains a section to give the
user a royal or straight flush based on a random number generator.  This
random hand will be distributed with a probability of about one in one
hundred}

Begin             {Procedure Draw Cards}

{---- Give an excellent hand option ---------------------}

     index := trunc(random * 200) + 1;
     if index = 49 then begin
          playhand[1] := 'Ten of Hearts';
          playhand[2] := 'Jack of Hearts';
          playhand[3] := 'King of Hearts';
          playhand[4] := 'Ace of Hearts';
          playhand[5] := 'Queen of Hearts';
     end;
     if index = 97 then begin
          playhand[1] := 'Three of Clubs';
          playhand[2] := 'Five of Clubs';
          playhand[3] := 'Four of Clubs';
          playhand[4] := 'Two of Clubs';
          playhand[5] := 'Six of Clubs';
     end;

{------ Draw the windows for the cards to appear in ---------------------}

     count := 4;
     index := 0;
     repeat
         inc(index);
         window (count,16,count + 12,24);
         count := count + 15;
         textbackground (white);
         clrscr;

{------- Call the Procedures to draw in the suit and rank markings -------}

         drawsuit(index);
         find_rank(index);
     until count > 70;
     count := 0;

end;      {Procedure Draw Cards}

{----------- Procedure Throw Back -------------------------------------}

Procedure Throw_Back(throw_num : char);

{This procedure will be called to draw the card back in place of the card
front if the user throws back a card}

Begin    {Procedure Throw Back}

           case throw_num of
                '1' : window (4,16,16,24);
                '2' : window (19,16,31,24);
                '3' : window (34,16,46,24);
                '4' : window (49,16,61,24);
                '5' : window (64,16,76,24);
           end;
           textbackground (lightblue);
           clrscr;
           textcolor (Black);
           for index3 := 1 to 29 do write ('MOO ');

end;         {Procedure Throw Back}

{--------------- Procedure Choose Cards --------------------------------}

Procedure Choose_Cards;

{This procedure will be called to prompt the user to enter the cards to
throw back.  It will call the throw back procedure to draw the card back
in place of each card chosen to throw away.}

Label Throw;

Begin           {Procedure Choose Cards}

{-------- Prompt to enter card choices ---------------------------}

   window (26,3,80,15);
   textbackground (black);
   textcolor (5);
   clrscr;
   writeln;
   writeln ('         These are your First Five Cards');
   writeln;
   writeln ('      Enter the card numbers to throw back  ');
   writeln;
   write ('      Press <');
   textcolor (lightgray); write ('Space Bar');
   textcolor (5); writeln('> to finish selecting ');
   index4 := 0;

{--------- Draw number headings above the cards --------------------}

   window (1,15,80,15);
   repeat
         inc(index4);
         if index4 = 1 then write (index4:10)
         else write(index4:15);
   until index4 = 5;

{---------- Draw card backs for the cards thrown back -------------------}

   index := 0;
   index2 := 0;
   index7 := 0;
   repeat
         index3 := 0;
         window (26,3,80,14);
         textbackground (black);
         textcolor (5);
         gotoxy (15,8);
         inc(index7);

{---------- Get the card numbers to throw back -----------------------}

         repeat
               throws[index7] := readkey;
         until ((ord(throws[index7]) > 48) and (ord(throws[index7]) < 54))
         or (throws[index7] = ' ');
         index4 := 0;
         if throws[index7] = ' ' then goto throw;

{------- If the card has already been selected, draw the card again -------}
{------- Otherwise draw the card back -------------------------------------}

         for index3 := 1 to index7 do begin
             if throws[index3] = throws[index7] then index4 := index4 + 1;
         end;
         index6 := 0;
         index5 := 2;

{----------- Draw the card back ------------------------------}

         repeat
              if (index4*2) = index5 then begin
                 throw_back(throws[index7]);
                 goto throw;
              end;
              index5 := index5 + 4;
         until (index5 - 4 = index4*2) or (index5 > index4*2);

{------ Draw the correct window for the card & draw the face ---------------}

         index5 := 0;
         repeat
               if index4*2 = index5 then begin
                  case throws[index7] of
                       '1' : begin
                             index6 := 1;
                             window (4,16,16,24);
                             end;
                       '2' : begin
                             index6 := 2;
                             window (19,16,31,24);
                             end;
                       '3' : begin
                             index6 := 3;
                             window (34,16,46,24);
                             end;
                       '4' : begin
                             index6 := 4;
                             window (49,16,61,24);
                             end;
                       '5' : begin
                             index6 := 5;
                             window (64,16,76,24);
                             end;
                  end;           {Case}
                  textbackground (white);
                  clrscr;
                  drawsuit(index6);
                  find_rank(index6);
               end;          {If Statement}
               index5 := index5 + 4;
         until (index5-4 = index4*2) or (index5-4 > index4*2);
         throw:
   until (throws[index7] = ' ') or (throws[index7] = ' ');

end;               {Procedure Choose Cards}

{---------------- Procedure Give New Cards -----------------------------}

Procedure Give_new_cards;

{This procedure will exchange the chosen card for new ones and draw the
new ones in}

Begin             {Procedure Give New Cards}

{----- Determine how many cards were thrown back and which ones ------------}

     index5 := 0;
     for index5 := 1 to 5 do new[index5] := 0;
     index5 := 0;
     for index3 := 1 to index7 do begin
         index5 := ord(throws[index3]) - 48;
         if (index5 = 1) or (index5 = 2) or (index5 = 3) or
         (index5 = 4) or (index5 = 5) then inc(new[index5])
     end;

{-------- Give new cards and draw the new set ----------------------}

     for index3 := 1 to 5 do begin
         index5 := 2;
         repeat

{-------- If the card was chosen then insert a new one -------------}

              if (new[index3]*2) = index5 then begin
                 inc(index8);
                 playhand[index3] := playdeck[index8];
                 if index3 = 1 then window (4,16,16,24);
                 if index3 = 2 then window (19,16,31,24);
                 if index3 = 3 then window (34,16,46,24);
                 if index3 = 4 then window (49,16,61,24);
                 if index3 = 5 then window (64,16,76,24);

{--------- Draw the new card -------------------------------------}

                 textbackground (white);
                 clrscr;
                 drawsuit(index3);
                 find_rank(index3);
              end;
              index5 := index5 + 4;
         until (index5 - 4 = new[index3]*2) or (index5 > new[index3]*2);
     end;

end;            {Procedure Give new cards}

{--------------- Procedure Find Hand -----------------------------------}

Procedure Find_Hand;

{This procedure will be called after the user has selected and recieved
his new cards.  It will analyze the hand to determine what kind of hand, if
any the user has.  It will use an array of boolean to tell if each kind of
hand is either true or false. }

{---------------- Procedure Royal Flush -------------------------------}

Procedure Royal_Flush;

{This procedure will be called from the main find hand procedure to determine
if the user has a royal flush.  It will return a boolean value to the main
procedure to tell if the hand is a royal flush.}

Label End_Royal_Flush;

Begin                    {Procedure Royal Flush}

{-------- Sort the card ranks alphabetically -----------------------}

     hand[1] := false;
     while hand[1] <> true do begin
          hand[1] := true;
          for index := 1 to 4 do begin
              if handrank[index] < handrank[index + 1] then begin
                 temprank := handrank[index];
                 handrank[index] := handrank[index + 1];
                 handrank[index + 1] := temprank;
                 hand[1] := False;
              end;   {if statement}
          end;       {for loop}
     end;            {While - do begin loop}

{---------- Find if the sorted ranks equal the royal flush string ----------}

    textcolor (white);
    temprank := '';
    for index := 1 to 5 do temprank := handrank[index] + temprank;
    if temprank <> 'AceJackKingQueenTen' then begin
       hand[1] := false;
       goto End_Royal_Flush;
    end;
    hand[1] := true;
    index := 0;
    repeat
           inc(index);
           if handsuit[index] <> handsuit[1] then hand[1] := false;
    until (index = 5) or (not(hand[1]));
    End_Royal_Flush:

end;                {Procedure Royal Flush}

{----------------- Procedure Num of a Kind -------------------------}

Procedure num_of_a_kind(trythis : shortint);

{This procedure will be called for determining if the user has a four of a
kind, full house, three of a kind, two pair, or a pair.  It will determine
the hand to search for depending on the value passed by the parameter.}

Begin             {Procedure Num_of_a_kind}

{----- Determine the frequency of each rank of card in the hand --------}

    for index := 1 to 5 do begin
        new[index] := 0;
        for index2 := 1 to 5 do begin
            if handrank[index] = handrank[index2] then
            new[index] := new[index] + 1;
        end;
    end;

{---- Sort the frequencies so higher numbers come first in the array ----}

    hand[index8] := false;
    while hand[index8] <> true do begin
          hand[index8] := true;
          for index := 1 to 4 do begin
              if new[index] < new[index + 1] then begin
                 index3 := new[index];
                 new[index] := new[index + 1];
                 new[index + 1] := index3;
                 hand[index8] := False;
              end;   {if statement}
          end;       {for loop}
     end;            {While loop}

{----- Check for a Full house ----------------------------------------}

     hand[index8] := false;
     if index8 = 4 then begin
        if (new[1] = 3) and (new[5] = 2) then hand[index8] := true;
     end

{-------- Check for Two Pair ----------------------------------------}

     else begin
          if index8 = 8 then begin
             index4 := 0;
             hand[index8] := true;
             while (hand[index8]) do begin
                   inc(index4);
                   hand[index8] := false;
                   if new[index4] = 2 then hand[index8] := true;
             end;
             if index4 = 5 then hand[index8] := true;
          end
          else begin
               if new[1] = trythis then begin
                  if trythis = 2 then begin
                     hand[index8] := false;
                     index := 0;
                     while (index < 5) and (not(hand[index8])) do begin
                         inc(index);

{---------- Check for a pair Jack or higher -----------------------------}

                         for index2 := 11 to 14 do begin
                             if handrank[index] = rank[index2] then begin
                                temp := handrank[index];
                                handrank[index] := handrank[1];
                                handrank[1] := temp;
                                for index3 := 2 to 5 do begin
                                    if handrank[index3] = handrank[1] then begin
                                    hand[index8] := true;
                                    end;      {if handrank[index3] = ...}
                                end;          {for index3 := 2 to 5}
                             end;             {if handrank[index] = rank[..]}
                         end;                 {for index2 := 11 to 14}
                     end;                     {While (index < 5) and(not(..}
                  end                         {If trythis = 2}

{----------- Check for a Three or Four of a kind --------------------------}

                  else
                  hand[index8] := true
                  end;                        {if trythis = 2}
               end;                           {if new[1] = trythis}
          end;                                {if index8 = 8}

end;                                          {Procedure Num of a kind}

{----------- Procedure Flush ---------------------------------------------}

Procedure Flush;

{This procedure will check the suit of each card to see if it matches the
first suit.  This will tell whether or not the user has a flush}

Begin             {Procedure Flush}

     hand[5] := true;
     index := 1;
     repeat
           inc(index);
           if handsuit[index] <> handsuit[1] then hand[5] := false;
     until (index = 5) or (not(hand[5]));

end;              {Procedure Flush}

{------------ Procedure Straight Hand ---------------------------------}

Procedure Straight_Hand;

{This procedure will give an integer value to each card.  Then it will rank
the values in ascending order.  It will check to see if each card has a value
of one greater than the one before it.}

Begin             {Procedure Straight Hand}

{--------- Give an integer value to each card ----------------------------}

     hand[6] := false;
     for index4 := 1 to 5 do straight[index4] := 0;
     index := 0;
     while index < 5 do begin
           inc(index);
           index2 := 1;
           repeat
                 inc(index2);
                 if handrank[index] = rank[index2] then straight[index] := index2;
           until (straight[index] = index2) or (index2 = 14);
     end;    {While}

{------- Rank the values -------------------------------------------------}

     while hand[6] <> true do begin
          hand[6] := true;
          for index := 1 to 4 do begin
              if straight[index] < straight[index + 1] then begin
                 index3 := straight[index];
                 straight[index] := straight[index + 1];
                 straight[index + 1] := index3;
                 hand[6] := False;
              end;   {if statement}
          end;       {for loop}
     end;            {While - do begin loop}

{-------- Check to see if they order ------------------------------------}

     index := 0;
     hand[6] := false;
     repeat
           inc (index);
           if straight[index + 1] = (straight[index] - 1) then hand[6] := true
           else Hand[6] := false;
     until (index = 4) or not(hand[6]);

end;              {Procedure Straight Hand}

{------------------- Begin Main Procedure Find Hand ---------------------}

Begin                  {Procedure Find Hand}

{For testing purposes only - If undocumented will give the hand specified}

{    playhand[1] := 'Jack of Clubs';
     playhand[2] := 'Ace of Clubs';
     playhand[3] := 'King of Clubs';
     playhand[4] := 'Queen of Clubs';
     playhand[5] := 'Ten of Clubs';}

{-------- Find the rank of each card in the hand -------------------------}

     for index := 1 to 5 do begin
         index2 := 0;
         repeat
               inc(index2);
               if playhand[index][index2] = ' ' then
                  handrank[index] := copy(playhand[index],1,index2-1);
         until playhand[index][index2] = ' ';

{--------- Find the suit of each card in the hand -------------------------}

         repeat
               inc(index2);
               if playhand[index][index2] = ' ' then handsuit[index]
               := copy(playhand[index],(index2+1),length(playhand[index])-(index2-1));
         until playhand[index][index2] = ' ';
     end;

{------ Call all the Procedures to determine the hand value ----------------}

     Royal_Flush;
     index8 := 3; num_of_a_kind(4);
     index8 := 4; num_of_a_kind(4);
     Flush;
     Straight_Hand;
     index8 := 7; num_of_a_kind(3);
     index8 := 8; num_of_a_kind(3);
     index8 := 9; num_of_a_kind(2);
     hand[2] := false;
     if (hand[5]) and (hand[6]) then hand[2] := true;

end;             {Procedure Find Hand}

{------------ Procedure Show Bet Screen -------------------------------}

Procedure Show_Bet_Screen;

{This procedure will draw a window in the left corner of the screen showing
the different types of hands and the money value of each hand.  It will also
show the money remaining.  It will be updated after the bet is entered. It
will also be called after the hand is analyzed to show which hand, if any
has been won.}

Begin          {Procedure Show Bet Screen}

     window (1,2,25,12);
     textcolor (red);
     clrscr;
     writeln ('         Hand Value');

{-------- Check to see if a hand has been won ---------------------}

     for num2 := 1 to 9 do begin
         winnings[num2] := bet * numvalue[num2];
         if (hand[num2]) then begin
            lowvideo;
            textcolor (green+blink);
            index6 := num2;
            for index7 := (num2+1) to 9 do hand[index7] := false;
         end

{--------- Otherwise write the string in normal color -----------------}

         else textcolor(cyan);
         writeln (handvalue[num2]:15,winnings[num2]:9:2);
     end;           {For num2 := 1 to 9}

End;             {Procedure Show Bet Screen}

{--------------- Procedure Get Bet --------------------------------------}

Procedure Get_Bet;

{This procedure will be called to get the user to enter their bet from the
keyboard.  It will make sure that the bet does not exceed $100, that the bet
is not greater than their money, and that the bet is a positive number.}

label Youlose;

Begin           {Procedure Get Bet}

     repeat

{----------- Get the bet ---------------------------------------}

           window (1,13,25,14);
           writeln ('Money = ':15,money:9:2);
           window (26,3,80,14);
           clrscr;
           writeln ('                     Enter Your Bet');
           writeln;writeln ('                  Must be $100.00 or less');
           write   ('                          ');
           readln (bet);

{--------- Make sure it's not more than $100 ------------------------}

           if bet > 100 then begin
              writeln;writeln ('                   Less than $100.00!!');
              write ('               Do you take me for a retard!!');
              money := money - 2;
              delay (2000);
              bet := -13;
           end;

{---------- Make sure they have as much as they bet -----------------------}

           if bet > money then begin
              writeln;
              writeln ('                  What do you take Me for ???');
              write ('                    You don''t have ',bet:0:2);
              money := money - 5;
              delay(2000);
              bet := -13;
           end;

{---------- Make sure they bet positive money ----------------------------}

           if bet <> -13 then begin
           if bet < 0 then begin
              writeln;
              writeln ('                     You Dickhead!!');
              write ('            You can''t bet Negative Numbers!!');
              money := money - 5;
              delay(2000);
           end;
           end;
           if money < 0 then goto youlose;
     until (bet > 0) and (bet <= money);

{---------- Update the money total ------------------------------------}

     money := money - bet;
     clrscr;
     youlose:
     window (1,13,25,14);
     writeln ('Money = ':15,money:9:2);

end;              {Procedure Get Bet}

{------------- Procedure Set Value -----------------------------------}

Procedure Set_Value;

{This procedure will set the value that the bet will be multiplied by to
find the value of each possible value.}

Begin                {Procedure Set Value}

    numvalue[1]  :=  200;       Numvalue[2] := 100;
    numvalue[3]  :=  75;        numvalue[4] := 40;
    numvalue[5]  :=  12.5;      numvalue[6] := 10;
    numvalue[7]  :=  7;         numvalue[8] := 3;
    numvalue[9]  :=  2;

end;                  {Procedure Set Value}

{----------- Procedure Double Down ------------------------------------}

Procedure Double_Down;

{This procedure acts as a sub program.  It will be called if the user has
a hand that wins money.  It will allow the user to double the value of their
winnings by choosing one of four cards.  If the card chosen beats the card
showing face up, then the user wins double their bet.  Otherwise the user
loses all their bet.}

Label Tryagain;

Begin           {Procedure Double Down}

index5 := 0;
repeat

{-------- Ask the User if he's going to Double Down ---------------------}

     inc(index5);
     window (26,3,80,14);
     textbackground(black);
     textcolor (red);
     clrscr;
     writeln ('                You have ',cash:0:2);
     write ('           Double Down to Win ',(cash*2):0:2,'? ');
     repeat
           choose := readkey;
     until (upcase(choose) = 'Y') or (upcase(choose) = 'N');
     if upcase(choose) = 'Y' then begin

tryagain:

{----------- Set up the Deck and card windows -------------------------}

           window (1,15,80,15);
           textbackground (black);
           textcolor (5);
           clrscr;
           index4 := 0;
           repeat
                 inc(index4);
                 if index4 = 1 then write (' ':10)
                 else write(index4-1:15);
           until index4 = 5;
           for index7 := 49 to 53 do throw_Back(chr(index7));
           fill_deck;
           Shuffle_Deck(20000);
           FirstCards;
           for index4 := 49 to 53 do begin
               case chr(index4) of
                '2' : window (19,16,31,24);
                '3' : window (34,16,46,24);
                '4' : window (49,16,61,24);
                '5' : window (64,16,76,24);
                end;
               throw_back (chr(index4));
           end;

{------------- Draw the first card ------------------------------------}

     window (4,16,16,24);
     textbackground (white);
     clrscr;
     drawsuit(1);
     find_rank(1);

{------------- Get the user to choose one of the 4 face down cards --------}

     textcolor (5);
     window (26,3,80,14);
     textbackground (black);
     clrscr;
     gotoxy (1,4);
     write ('       Enter your card choice - 1 to 4 -');
     repeat
           choose := readkey
     until (ord(choose) > 48) and (ord(choose) < 53);

{----------- Reveal the cards not chosen -----------------------------}

     for index4 := 1 to 4 do begin
         if index4 <> (ord(choose) - 48) then begin
            case  chr(index4+48) of
                '1' : window (19,16,31,24);
                '2' : window (34,16,46,24);
                '3' : window (49,16,61,24);
                '4' : window (64,16,76,24);
            end;
            textbackground (white);
            clrscr;
            drawsuit (index4+1);
            find_rank (index4+1);
            window (26,3,80,14);
            delay(500);
            sound (1000);
            delay (20);
            nosound;
         end;
     end;

{-------- Draw in the chosen card --------------------------------}

     case choose of
                '1' : window (19,16,31,24);
                '2' : window (34,16,46,24);
                '3' : window (49,16,61,24);
                '4' : window (64,16,76,24);
     end;
     textbackground (white);
     clrscr;
     drawsuit (ord(choose)-47);
     find_rank (ord(choose)-47);

{----------- Check to see if the chosen card beats the first one -----------}

     for index4 := 1 to 5 do begin
         index7 := 0;
         repeat
               inc(index7);
               if playhand[index4][index7] = ' ' then
               handrank[index4] := copy(playhand[index4],1,index7-1);
         until playhand[index4][index7] = ' ';
     end;
     for index7 := 2 to 14 do begin
         if handrank[1] = rank[index7] then new[1] := index7;
     end;
     hand[1] := false;
     index4 := ord(choose)-47;
     for index7 := 2 to 14 do begin
         if handrank[index4] = rank[index7] then new[index4] := index7;
     end;

{-------------- If the cards tie then Redo --------------------------------}

     if new[index4] = new[1] then begin
        window (26,3,80,14);
        textbackground(black);
        textcolor (brown);
        clrscr;
        writeln ('         Tie!!!!');
        writeln;writeln ('      Try it again!!');
        writeln;write ('     Press any key...');
        repeat until keypressed;
        goto tryagain;
     end;

{---------- If the card wins, then return to the top with twice the cash ---}

     if new[index4] > new[1] then hand[1] := true;
        window (26,3,80,14);
        textbackground(black);
        textcolor (brown);
        clrscr;
        if (hand[1]) then begin
                  writeln ('         You Win ',(cash*2):0:2,'!!!');
                  cash := cash * 2;
         end

{-------- Otherwise your winnings are nothing ---------------------------}

         else begin
               writeln ('           You Lose!!!!');
               cash := 0;
         end;
         writeln;write ('         Press any Key...');
         repeat until keypressed;
     end; {if}

until (upcase(choose) = 'N') or (cash = 0);

{---------- Print screen if the user leaves with money ----------------}

     if (cash > 0) and (index5 > 1) then begin
        textcolor (brown);
        writeln;
        writeln ('            Thank You for playing!!');
        writeln ('              Your money = ',(money + cash):0:2);
     end;

{---------- Print screen if the user loses or quits without playing -------}

     if (cash = 0) or (index5 = 1) then begin
          textcolor (brown);
          writeln;writeln;
          writeln ('           Thank You for coming out!!!');
     end;
     writeln;write ('               Press any key...');
     repeat until keypressed;
     clrscr;

end;            {Procedure Double Down}

{-------------- Main Program -------------------------------------------}

Begin            {Main}

{----------- Draw opening screen --------------------------------------}

   window (1,1,80,25);
   textbackground (black);
   clrscr;
   window (1,1,80,2);
   textcolor (lightblue);
   writeln ('                 MOO COW POKER - Created by Sir Kenneth Hoetmer');
   window (1,3,80,25);
   clrscr;
   writeln;
   textcolor (red);
   money := 50;
   write ('                             Press any key to Begin ');
   repeat until keypressed;
   menu := readkey;

repeat


{- Set the arrays, Draw the bet screen, and get the bet before starting ----}

   clrscr;
   window (1,15,80,15);
   set_Arrays;
   Show_Bet_Screen;
   Set_Value;
   Get_Bet;
   if money < 0 then goto youloseforreal;
   Show_Bet_Screen;

{------- Prepare the deck for playing ---------------------------------}

   window (26,3,80,14);
   textcolor (red);
   writeln;writeln;
   write ('          Shuffling the Cards');
   Fill_Deck;
   Shuffle_deck(40000);
   FirstCards;

{------- Draw the first five cards -----------------------------------}

   drawcards;
   index8 := 5;

{------- Get the user to choose his cards and give new ones -----------}

   Choose_Cards;
   Give_New_Cards;

{----------- Release the heap - Avoid memory overload -----------------}

   release(P);

{---------- Find the hand & show it in the bet screen ---------------------}

   window (26,3,80,14);
   textbackground(black);
   clrscr;
   find_hand;
   index6 := 0;
   Show_Bet_Screen;

{------- If the hand has no value then write you lose in the bet screen ----}

   if winnings[index6] = 0 then begin
      window (1,12,25,13);
      textcolor (green + blink);
      write ('       You Lose');
   end;

{----- If he has won money then double down ------------------------}


   cash := winnings[index6];
   if cash > 0 then double_down;

{------- Update the money ----------------------------------------}

   winnings[index6] := cash;
   totalmoney := money + winnings[index6];
   index8 := 0;
   checktens := 10;
   while money < totalmoney do begin
         index8 := index8 + 1;
         money := money + 0.05;
         if index8 = checktens then begin
                index8 := 0;
                window (1,13,25,14);
                textcolor (cyan);
                write ('Money = ':15,money:9:2);
                delay (3);
         end;
   end;
   money := totalmoney;

youloseforreal:

   window (26,3,80,14);
   textbackground(black);
   clrscr;
   window (1,13,25,14);
   textcolor (cyan);
   write ('Money = ':15,money:9:2);
   window (26,3,80,14);
   textcolor (red);
   writeln;

{------ Print screen when the user runs out of money ------------------}

   if money < 0.01 then begin
      textcolor (lightgreen);
      write ('            Money = 0');
      delay (4000);
      clrscr;
      textcolor (5);
      writeln ('     You Suck!!');
      writeln ('     I made this game easy and you still lost!!');
      writeln ('     Maybe next time you''ll make something of yourself');
      goto suck;
   end;

{------- Prompt to play another round ------------------------------}

   write ('            Play Another Round?  ');
   repeat
         choose := readkey;
   until (upcase(choose) = 'Y') or (upcase(choose) = 'N');

{--------- If playing another round then redraw the card backs -------}

   if upcase(choose) = 'Y' then begin

        window (1,15,80,15);
        textcolor (5);
        clrscr;
        index4 := 0;
        repeat
              inc(index4);
              if index4 = 1 then write (index4:10)
              else write(index4:15);
        until index4 = 5;
        for index7 := 49 to 53 do begin
            throw_Back(chr(index7));
        end;
        window (26,3,80,14);
        textbackground(black);
        clrscr;

   end;   {If upcase choose = Y}

until upcase(choose) = 'N';

{-------------- Write ending screen ---------------------------------}

   textcolor (5);
   writeln;
   writeln ('     Thank You for Playing!!');
   suck:
   textcolor (red);
   writeln ('     Leave $20 on the keyboard to pay for Ken''s');
   write ('     Grocery bill');
   delay (5000);
   writeln;
   writeln ('     I don''t see any money, Prepare to be electrocuted');
   index := 6;
   write ('               ');
   textcolor (brown);
   repeat
         index := index - 1;
         write (index,' ');
         delay (700);
   until index = 1;
   sound (100);
   delay (1000);
   nosound;
   writeln;writeln;
   writeln ('               Scary Huh!!');
   write ('     Check your pants before you leave');
   delay (1500);
   writeln;write ('               Press any Key');
   repeat until keypressed;
   window (1,1,80,25);
   textcolor (white);
   clrscr;

End.             {Main Program}