home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / a / cribbage.lbr / CRIBBAGE.PZ2 / CRIBBAGE.PS2
Encoding:
Text File  |  1993-10-26  |  4.0 KB  |  156 lines
  1. { Included File: CRIBBAGE.PS2 }
  2.  
  3. procedure makedeck; { creates deck }
  4. var
  5.   cardnum: 0..decksize;
  6.   rank: ranktype;
  7.   suit: suitype;
  8. begin
  9.   cardnum:=0;
  10.   for suit:=hearts to spades do
  11.     for rank:=1 to ranksize do
  12.       begin
  13.         cardnum:=cardnum+1;
  14.         deck[cardnum].rank:=rank;
  15.         deck[cardnum].suit:=suit
  16.       end
  17. end;  {makedeck}
  18.  
  19. procedure shuffle;
  20. var
  21.   curcard,              { current card number }
  22.   newcard: 1..decksize; { where to shuffle the current card to }
  23.   tmp: card;
  24. begin
  25.   for curcard:=1 to decksize do
  26.     begin
  27.       newcard:=random(decksize)+1;
  28.       tmp:=deck[newcard];
  29.       deck[newcard]:=deck[curcard];
  30.       deck[curcard]:=tmp
  31.     end
  32. end;  {shuffle}
  33.  
  34. procedure deal;    { deal the first six cards to the human }
  35. var                { the next six to the computer }
  36.   i: 1..dealsize;
  37. begin
  38.   common.rank:=0;
  39.   for i:=1 to dealsize do
  40.     begin
  41.       human[i]:=deck[i];
  42.       comp[i]:=deck[i+dealsize];
  43.     end
  44. end;  {deal}
  45.  
  46. procedure showcard(toshow: card); { prints card in semi-readable format }
  47. begin
  48.   case toshow.rank of
  49.     1: write('A');
  50.     2,3,4,5,6,7,8,9: write(toshow.rank:1);
  51.     10: write('T');
  52.     11: write('J');
  53.     12: write('Q');
  54.     13: write('K')
  55.     end;  {case}
  56.   case toshow.suit of
  57.     hearts: write('H');
  58.     clubs: write('C');
  59.     diamonds: write('D');
  60.     spades: write('S')
  61.     end;  {suit}
  62.   write(' ')
  63. end;  {showcard}
  64.  
  65.  
  66. function getelement:integer;
  67. label retry;
  68. var irank,          { rank input by user }
  69.     isuit: char;    { suit input by user }
  70.     rank: ranktype; { rank from user }
  71.     suit: suitype;  { suit from user }
  72.     which: integer; { which number to return }
  73.     index: 1..dealsize;
  74.     many: -5..4;    { how many cards correspond }
  75.  
  76.     procedure getcard(VAR rankchar:char; VAR suitchar:char);
  77.     var ch: char;
  78.         s: str80;
  79.         i: integer;
  80.     begin
  81.       repeat
  82.         write('__',chr(8),chr(8));
  83.         getln(s);
  84.         rankchar:=' '; suitchar:=' ';
  85.         for i:=1 to length(s) do
  86.           begin
  87.             ch:=s[i];
  88.             if (ch in ['A','2'..'9','T','J','Q','K']) then rankchar:=ch;
  89.             if (ch in ['S','H','D','C']) then suitchar:=ch
  90.           end;
  91.         if (rankchar=' ') or (suitchar=' ') then
  92.           begin
  93.             gotoxy(1,18);
  94.             writeln(s,'?');
  95.             writeln('Suits = S,H,D,C (Spades,Hearts,Diamonds,Clubs)');
  96.             writeln('Ranks = A,2,3,4,5,6,7,8,9,T,J,Q,K  (Ace is A, 10 is T!)');
  97.             writeln('Example: 8D (eight of Diamonds) or TH (ten of Hearts)');
  98.             writeln;
  99.             write('Try again from the start.  Which card? ');
  100.             cluttered:=true
  101.           end
  102.       until (rankchar<>' ') and (suitchar<>' ');
  103.       gotoxy(1,6);
  104.     end;  {getcard}
  105.  
  106. begin
  107.   retry:
  108.   getcard(irank,isuit);
  109.   case upcase(irank) of
  110.     'A': rank:=1;
  111.     '2','3','4','5','6','7','8','9': rank:=ord(irank)-ord('0');
  112.     'T': rank:=10;
  113.     'J': rank:=11;
  114.     'Q': rank:=12;
  115.     'K': rank:=13
  116.     end; {case}
  117.   case upcase(isuit) of
  118.     'S': suit := spades;
  119.     'H': suit := hearts;
  120.     'D': suit := diamonds;
  121.     'C': suit := clubs
  122.     end; {case}
  123.   many:=0;
  124.   which:=0;
  125.   for index:=1 to dealsize do
  126.     begin
  127.       if human[index].rank = rank then
  128.         begin
  129.           many:=many+1;
  130.           if many>0 then which:=index;
  131.           if isuit<>' ' then
  132.           if human[index].suit = suit then
  133.           many:=-5
  134.         end
  135.     end;
  136.   if many=0 then
  137.     begin
  138.       gotoxy(1,18);
  139.       writeln('What?!  No such card exists.');
  140.       write('Which card? ');
  141.       cluttered:=true;
  142.       goto retry
  143.     end;
  144.   if many>1 then
  145.     begin
  146.       gotoxy(1,18);
  147.       writeln('There is more than one ',irank);
  148.       write('Please be more specific:  ');
  149.       cluttered:=true;
  150.       goto retry
  151.     end;
  152.   if (many=1) or (many<0) then getelement:=which;
  153. end;  {getelement}
  154.  
  155. { End of included file }
  156.