home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol9n04.zip / GPOKER.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-23  |  4KB  |  140 lines
  1. PROGRAM GPoker;
  2. USES Crt, Cards, Graph, Drivers, Fonts, GCards, poker;
  3. TYPE
  4.   GraphicPoker = 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 GraphicPoker.Init(iTC : Byte);
  15.   VAR
  16.     grDriver : Integer;
  17.     grMode   : Integer;
  18.     ErrCode  : Integer;
  19.  
  20.     PROCEDURE ErrorOut(what : String);
  21.     BEGIN WriteLn('Error in ', what, ' loading.'); Halt(1); END;
  22.  
  23.   BEGIN
  24.     PokerGame.Init(iTC);
  25.     TableColor := iTC;
  26.     grDriver := EGA; grMode := EGAhi;
  27.     IF RegisterBGIDriver(@EGAVGAdriverProc) < 0 THEN
  28.       ErrorOut('EGAVGA driver');
  29.     IF RegisterBGIFont(@TriplexFontProc) < 0 THEN
  30.       ErrorOut('Triplex font');
  31.     IF RegisterBGIFont(@SmallFontProc) < 0 THEN
  32.       ErrorOut('Small font');
  33.     IF RegisterBGIFont(@SansSerifFontProc) < 0 THEN
  34.       ErrorOut('SansSerif font');
  35.     InitGraph(grDriver, grMode, '');
  36.     ErrCode := GraphResult;
  37.     IF ErrCode <> grOk THEN
  38.       BEGIN
  39.         WriteLn('Graphics error : ', GraphErrorMsg(ErrCode));
  40.         Halt(1);
  41.       END;
  42.     D := New(GDeckP, Init(0, 0, tableColor));
  43.     D^.shuffle;
  44.     margin := 30; tab := 120; topmargin := 120;
  45.   END;
  46.  
  47.   PROCEDURE GraphicPoker.Display;
  48.   BEGIN
  49.     SetBkColor(tableColor);
  50.     SetPalette(brown, black);
  51.     SetColor(white);
  52.     Rectangle(0, 0, 639, 349);
  53.     SetTextStyle(TriplexFont, HorizDir, 7);
  54.     SetTextJustify(CenterText, BottomText);
  55.     OutTextXY(320, 50, 'VIDEO POKER');
  56.     SetTextJustify(LeftText, BottomText);
  57.     SetColor(brown);
  58.     rectangle(320, 265, 633, 346);
  59.     SetFillStyle(solidfill, white);
  60.     SetTextStyle(SmallFont, HorizDir, 4);
  61.     SetColor(brown);
  62.     bar(321, 266, 632, 345);
  63.     OutTextXY(325, 288, 'Jacks or better');
  64.     OutTextXY(325, 299, 'Two pair');
  65.     OutTextXY(325, 310, 'Three of a kind');
  66.     OutTextXY(325, 321, 'Straight');
  67.     OutTextXY(480, 288, 'Flush');
  68.     OutTextXY(480, 299, 'Full house');
  69.     OutTextXY(480, 310, 'Four of a kind');
  70.     OutTextXY(480, 321, 'Straight flush');
  71.     OutTextXY(480, 332, 'Royal flush');
  72.     SetTextJustify(RightText, BottomText);
  73.     SetColor(LightRed);
  74.     OutTextXY(470, 288, '1-1');
  75.     OutTextXY(470, 299, '2-1');
  76.     OutTextXY(470, 310, '3-1');
  77.     OutTextXY(470, 321, '4-1');
  78.     OutTextXY(622, 288, '6-1');
  79.     OutTextXY(622, 299, '9-1');
  80.     OutTextXY(622, 310, '25-1');
  81.     OutTextXY(622, 321, '50-1');
  82.     OutTextXY(622, 332, '250-1');
  83.   END;
  84.  
  85.   DESTRUCTOR GraphicPoker.Done;
  86.   BEGIN PokerGame.Done; CloseGraph; END;
  87.  
  88.   PROCEDURE GraphicPoker.ClearBottom;
  89.   BEGIN
  90.     SetFillStyle(solidFill, GetBkColor);
  91.     BAR(1, 265, 319, 348);
  92.   END;
  93.  
  94.   PROCEDURE GraphicPoker.ShowStake;
  95.   VAR S : String[40];
  96.   BEGIN
  97.     Str(0.25*stake:1:2, S);
  98.     SetFillStyle(SolidFill, Brown);
  99.     Bar(180, 60, 460, 100);
  100.     SetColor(white);
  101.     SetTextStyle(TriplexFont, HorizDir, 4);
  102.     Rectangle(180, 60, 460, 100);
  103.     SetTextJustify(RightText, BottomText);
  104.     OutTextXY(450, 90, '$'+S);
  105.     SetTextStyle(TriplexFont, HorizDir, 2);
  106.     SetTextJustify(LeftText, TopText);
  107.   END;
  108.  
  109.   PROCEDURE GraphicPoker.HoldButton(B : Byte);
  110.   BEGIN
  111.     IF Hold[B] THEN
  112.       BEGIN
  113.         SetFillStyle(SolidFill, white);
  114.         SetColor(Red);
  115.         Bar(30+B*120, 230, 130+B*120, 255);
  116.         Rectangle(30+B*120, 230, 130+B*120, 255);
  117.         OutTextXY(40+B*120, 232, 'H O L D');
  118.         SetColor(white);
  119.       END
  120.     ELSE
  121.       BEGIN
  122.         SetFillStyle(solidFill, GetBkColor);
  123.         Bar(30+B*120, 230, 130+B*120, 255);
  124.       END;
  125.   END;
  126.  
  127.   PROCEDURE GraphicPoker.Tell(M1, M2 : message);
  128.   BEGIN OutTextXY(10, 280, M1); OutTextXY(10, 310, M2); END;
  129.  
  130. VAR
  131.   V     : GraphicPoker;
  132.   again : boolean;
  133. BEGIN
  134.   V.Init(blue);
  135.   V.Display;
  136.   REPEAT
  137.     V.Play(again);
  138.   UNTIL NOT again;
  139.   V.Done;
  140. END.