home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol9n04.zip / TPOKER.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-23  |  2KB  |  81 lines
  1. PROGRAM TPoker;
  2. USES Crt, Cards, poker;
  3. TYPE
  4.   TextPoker = OBJECT (PokerGame)
  5.     CONSTRUCTOR Init(iTC : Byte);
  6.     DESTRUCTOR Done; virtual;
  7.     PROCEDURE Display; virtual;
  8.     PROCEDURE ClearBottom; virtual;
  9.     PROCEDURE ShowStake; virtual;
  10.     PROCEDURE HoldButton(B : Byte); virtual;
  11.     PROCEDURE Tell(M1, M2 : Message); virtual;
  12.   END;
  13.  
  14.   CONSTRUCTOR TextPoker.Init(iTC : Byte);
  15.   BEGIN
  16.     PokerGame.Init(iTC);
  17.     Randomize;
  18.     D := New(DeckP, Init(0, 0, iTC));
  19.     D^.shuffle;
  20.     stake := 40;
  21.     margin := 20; tab := 10; topmargin := 10;
  22.   END;
  23.  
  24.   PROCEDURE TextPoker.Display;
  25.   BEGIN
  26.     TextAttr := TableColor;
  27.     ClrScr;
  28.     TextAttr := $70;
  29.     GotoXY(28, 2); Write('┌───────────────────────┐');
  30.     GotoXY(28, 3); Write('│ V*I*D*E*O   P*O*K*E*R │');
  31.     GotoXY(28, 4); Write('└───────────────────────┘');
  32.     TextAttr := TableColor;
  33.     Frame(30, 5, 50, 7, 1, true, ' ');
  34.     Frame(41, 19, 79, 25, 2, true, ' ');
  35.     GotoXY(42, 20); Write('One pair    1-1| Full house       9-1');
  36.     GotoXY(42, 21); Write('Two pair    2-1| 4 of a kind     25-1');
  37.     GotoXY(42, 22); Write('3 of a kind 3-1| Straight flush  50-1');
  38.     GotoXY(42, 23); Write('Straight    4-1| Royal flush    250-1');
  39.     GotoXY(42, 24); Write('Flush       6-1|');
  40.   END;
  41.  
  42.   DESTRUCTOR TextPoker.Done; BEGIN PokerGame.Done; END;
  43.  
  44.   PROCEDURE TextPoker.ClearBottom;
  45.   BEGIN frame(1, 20, 40, 25, 0, true, ' '); END;
  46.  
  47.   PROCEDURE TextPoker.ShowStake;
  48.   VAR S : String[20];
  49.   BEGIN
  50.     Str(0.25*stake:1:2, S); {19 blanks on next line}
  51.     GotoXY(31, 6); Write('                   ');
  52.     GotoXY(47-length(S), 6);
  53.     Write('$'+S);
  54.   END;
  55.  
  56.   PROCEDURE TextPoker.HoldButton(B : Byte);
  57.   BEGIN
  58.     GotoXY(20+B*10, 16);
  59.     IF hold[B] THEN
  60.       BEGIN
  61.         TextAttr := ((TableColor SHL 4)+(TableColor SHR 4)) AND $7F;
  62.         Write('HOLD');
  63.         TextAttr := TableColor;
  64.       END
  65.     ELSE Write('    ');
  66.   END;
  67.  
  68.   PROCEDURE TextPoker.Tell(M1, M2 : Message);
  69.   BEGIN GotoXY(2, 20); Write(M1); GotoXY(2,21); Write(M2); END;
  70.  
  71. VAR
  72.   V       : TextPoker;
  73.   doagain : boolean;
  74. BEGIN
  75.   V.Init($F);
  76.   V.Display;
  77.   REPEAT
  78.     V.Play(doagain);
  79.   UNTIL NOT doagain;
  80.   V.Done;
  81. END.