{***************************************************}
{ T5APCrt -- Tahoe 5 Card Poker                     }
{            Atari Portfolio and DOS display unit   }
{            Displays 8x40 on Port, 16x40 otherwise }
{            Copyright (c) 1992 M. Zack Urlocker    }
{***************************************************}

Unit T5APCrt;
{$X+}
{$IFDEF Final}         { Remove debug code for final version }
{$D-,I-,L-,R-,S-}
{$ELSE}
{$D+,I+,L+,R+,S+}
{$ENDIF}

interface

uses  Cards, Poker, Sounds,
      Portfolio;       { B.J. Gleason's Atari Portfolio unit }

const
      Brk = #03;       { Keyboard constants }
      Bel = #07;
      Tab = #09;
      CR =  #13;
      Esc = #27;
      F1 =  #59;
      Up =  #72;
      Dn =  #80;
      Lf =  #75;
      Rt =  #77;

var StandardExit : Pointer;

function getKeyH : char;
procedure Title;

{ TDisplay object controls user interface, commands etc }
type
 TDisplay = Object
 Hand : TPokerHand;
 status1 : string;
 status2 : string;
 dealt : boolean;
 done : boolean;
 procedure init;
 procedure newGame;
 procedure getCommand;
 procedure deal;
 procedure bet(amount:integer);
 procedure hold(key:char);
 procedure showStatus1;
 procedure showStatus2;
 procedure showHoldCard(card:integer);
 procedure showHold;
 procedure showBalance;
 procedure showHand(delay:boolean);
 procedure showDraw;
 procedure showPayoffs;
 procedure drawCard(card:TCard; x:integer);
 procedure showEval;
 procedure debugMode;
end;

implementation

procedure Help; forward;
procedure Cleanup; far; forward;

procedure beep;
begin
  write(bel);
end;

{ Pauses used when dealing cards }
procedure pause;
var i : longint;
begin
 { use 64000 on 386sx }
  for i := 1 to 7500 do;
end;

{ Get a key, allow Escape, no help }
function getKey:char;
var key : char;
begin
  key := upCase(readKey);
  if key = #0 then key := readKey;
  case key of
   'S': ToggleSound;
   'X',
   'Q',
   Brk,
   Esc :  begin
           cleanUp;
           Halt(0);
          end;
   else
        getKey := key;
  end;
end;

{ Get a key, check for help }
function getKeyH:Char;
var key : char;
begin
 key := getKey;
 if (key = F1) or (key = Tab) then Help;
 getKeyH := key;
end;

Procedure Title;
begin
 Clrscr;
 if IsPort then
 begin
   writeLn('Tahoe 5 Video PokerÚÄÄÚÄÚÄÚÄÚÄÄÄÄÄ¿  ');
   writeLn('V.1.0     04/01/92 ³10³J³Q³K³A    ³  ');
   writeLn('Shareware          ³ ³³³³    ³  ');
   writeLn('                   ³  ³ ³ ³ ³   A³  ');
   writeLn('[F1]=Help          ÀÄÄÀÄÀÄÀÄÀÄÄÄÄÄÙ  ');
   writeLn('Copyright (c) 1992 M. Zack Urlocker  ');
 end
 else
 begin
   writeLn('Tahoe 5 Video Poker  ');
   writeLn('V.1.0     04/01/92   ');
   writeLn('Shareware            ');
   writeLn;
   writeLn('                ÚÄÄÚÄÚÄÚÄÚÄÄÄÄÄ¿     ');
   writeLn('                ³10³J³Q³K³A    ³     ');
   writeLn('                ³ ³³³³    ³     ');
   writeLn('                ³  ³ ³ ³ ³   A³     ');
   writeLn('                ÀÄÄÀÄÀÄÀÄÀÄÄÄÄÄÙ     ');
   writeLn;
   writeLn('[F1]=Help');
   writeLn('Copyright (c) 1992 M. Zack Urlocker  ');
 end;
 gotoXY(11,3);
 if IsPort then
   write('Portfolio')
 else
   write('DOS');
{$IFNDEF Final}
 gotoXY(1,4); write('*Debug*');
{$ENDIF}
 gotoXY(1,1);
end;

Procedure Help;
var key: char;
begin
 Clrscr;
 writeLn('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
 writeLn('³Tahoe 5 plays 5 card draw poker.     ³');
 writeLn('³You can bet multiples of $10 on each ³');
 writeLn('³hand by using the arrows.  Hit Enter ³');
 writeLn('³to deal or draw.  Press 1-5 to hold. ³');
 writeLn('³Press S to toggle sound on Portfolio.³');
 writeLn('³Press Esc to exit at any time.       ³');
 if not IsPort then
 begin
   writeLn('³                                     ³');
   writeLn('³Tahoe 5 is shareware.Send $10(US) for³');
   writeLn('³more games for DOS,palmtops & Windows³');
   writeLn('³including Blackjack. Add $10 for full³');
   writeLn('³source code.Outside US/Canada add $5.³');
   writeLn('³   M. Zack Urlocker P.O.Box 67301    ³');
   writeLn('³   Scotts Valley CA 95067 USA        ³');
   write  ('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ Thanks.');
 end;
 if isPort then
   write  ('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ More..');

 key := readKey;
 clrScr;
 if key = #0 then key := readkey;

 if isPort then
 begin
 if key <> Esc then
 begin
  writeLn('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
  writeLn('³Payoffs:                             ³');
  writeLn('³                   Flush           50³');
  writeLn('³Royal Flush   2500 Straight        40³');
  writeLn('³Straight Flush 500 Three of a kind 30³');
  writeLn('³Four of a kind 250 Two pair        20³');
  writeLn('³Full house      80 Jacks or better 10³');
  write  ('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ More..');
 key := readKey;
 clrScr;
 end;
 if key = #0 then key := readkey;
 if key <> Esc then
 begin
  writeLn('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
  writeLn('³Tahoe 5 is shareware.Send $10(US) for³');
  writeLn('³more games for DOS,palmtops & Windows³');
  writeLn('³including Blackjack. Add $10 for full³');
  writeLn('³source code.Outside US/Canada add $5.³');
  writeLn('³   M. Zack Urlocker P.O.Box 67301    ³');
  writeLn('³   Scotts Valley CA 95067 USA        ³');
  write  ('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ Thanks.');
  key := readkey;
  if key = #00 then readKey;
  clrscr;
 end;
 end;
end;

{ Initialize the display }
procedure TDisplay.Init;
begin
  Hand.balance := 100;
  newGame;
  getCommand;
end;

{ Start a new game }
procedure TDisplay.newGame;
const msgs : array[0..9] of string =
    ('Payable at 19.75% int. daily!',
     'Deposit car keys now...',
     'Aren''t you glad you''re not addicted?',
     'Shouldn''t you be working?',
     'Have you always been this lucky?',
     'You must live a charmed life.',
     'You must be very lucky in love.',
     'Got any good stock tips?',
     'Is this your first time playing?',
     'Good thing you know when to quit...'
     );
var key : char;
    i : integer;
    s : string;
begin
  done := false;
  if Hand.balance <= 0 then
  begin
    gotoXY(1,1);
    write('You are broke!  $100 loan (y/n)?        ');
    gotoXY(1,2);
    write('                                        ');
    gotoXY(1,2);
    key := getKey;
    if key = 'N' then
      begin
       cleanup;
       halt(0);
    end
    else
    begin
      i := random(10);
      write(msgs[i]);
      i := random(100);
      if i < 33 then soundLose2
      else if i < 66 then SoundLose1
      else SoundLose3;
      Hand.balance := 100;
      getkeyH;
    end;
  end;
  Hand.init;
  Hand.balance := Hand.balance - Hand.bet;
  status1:='  $         [Enter]= Deal [Esc]= Quit';
  status2:='Balance: $                   [F1]= Help';
  clrscr;
  showHold;
  showHand(false);
  if not isPort then showPayoffs;
  showStatus1;
  showStatus2;
  showBalance;
  dealt := False;
end;

{ Process all commands }
procedure TDisplay.getCommand;
var key : char;
begin
repeat
 repeat
  key := getKey;
  case key of
   Tab,
   F1 : begin
          help;
          showHold;
          showHand(false);
          if not isPort then showPayoffs;
          showStatus1;
          showStatus2;
          showBalance;
        end;
   Up : bet(10);
   Dn : bet(-10);
   Rt : bet(Hand.balance);
   Lf : bet(10-Hand.bet);
   'D', ' ',
   CR : deal;
   '1','2',
   '3','4',
   '5' : if dealt then hold(key);
{$IFNDEF Final}
   'Z' : debugMode;
{$ENDIF}
   else
     beep;
  end;
  until done;
 key := getKeyH;
 newGame;
 until key = Esc;
end;

{ Deal or draw new cards }
procedure TDisplay.deal;
begin
 if not dealt then
  begin
   Hand.deal;
   showHand(true);
   status1 := '[1-5] Hold    [Enter]= Deal [Esc]= Quit';
   showStatus1;
   dealt := true;
  end
  else
  begin
   showDraw;
   Hand.deal;    { new cards drawn }
   showHand(true);
   Hand.eval;
   showEval;
   done := true;
  end;
end;

{ Hold or discard a particular card }
Procedure TDisplay.Hold(key : char);
var s: string;
    card, err : integer;
begin
 val(key, card, err);
 Hand.hold(card);
 showHoldCard(card);
end;

{ Update the bet and remaining balance }
Procedure TDisplay.bet(amount:integer);
begin
 if dealt then
  beep
 else
 begin
 if amount > 0 then
 begin
   if (Hand.balance <= 0) or (hand.bet > 990) then
     amount := 0;
 end
 else
   if Hand.bet <= 10 then
     amount := 0;

 if amount <> 0 then
 begin
  inc(Hand.bet, amount);
  dec(Hand.balance, amount);
  showBalance;
 end
 else
  beep;
 end;
 end;

{ Show the balance }
procedure TDisplay.showBalance;
begin
 gotoXY(1,1);
 writeLn('  $',Hand.bet,' bet  ');
 write('Balance: $',Hand.balance,'   ');
 gotoXY(1,1);
end;

{ Display results of hand, update balance. }
procedure TDisplay.showEval;
var verb : string;
    amount, i : integer;
begin
 amount := Hand.bet * payoff[Hand.val];
 if amount > 0 then
   inc(Hand.balance, amount);
 gotoXY(1,1);
 if Hand.val = 0 then
   verb := 'lose'
 else
   verb := 'win';
 write(eval[Hand.val],' You ',verb,' $', abs(amount),'        ');
 gotoXY(29, 1);
 write('  [Esc][F1]');
 gotoXY(1, 2);
 write('Balance: $',Hand.balance,' ');
 gotoXY(29, 2);
 write  (' or [Enter]');
 gotoXY(1,1);
 i := random(100);
 if (Hand.val = nothing) then
   if (i < 25) then SoundLose1
   else if i < 50 then soundLose2
   else if i < 75 then soundLose3;
 if (Hand.val > twopair) then
   if (i < 50) then SoundWin1
   else SoundWin2;
end;

{ Show the cards that haven't changed.  Pause if delay = true }
procedure TDisplay.showHand(delay:boolean);
var i : integer;
begin
  for i := 1 to 5 do
  begin
    if (not Hand.held[i]) or (not delay) then
    begin
      if delay then
      begin
        pause;
        soundDeal;
      end;
      drawCard(Hand.cards[i], i);
    end;
  end;
end;

{ Display draw cards face down }
procedure TDisplay.showDraw;
var i : integer;
    down : TCard;
begin
  down.Init;
  for i := 1 to 5 do
  begin
    if (not Hand.held[i]) then
    begin
      pause;
      drawCard(down, i);
    end;
  end;
end;

{ Draw a card at a particular location }
Procedure TDisplay.DrawCard(card : TCard; x : integer);
var nstr: string;
    suitCh : char;
    i : integer;
    rows, nPos, sPos : integer;  { used for positioning chars }
begin
 x := 1+(x-1)*7;
 gotoXY(x,4);  write('ÚÄÄÄÄÄ¿');
 gotoXY(x,5);  write('³     ³');
 gotoXY(x,6);  write('³     ³');
 gotoXY(x,7);  write('³     ³');
if isPort then
begin
 gotoXY(x,8);  write('ÀÄÄÄÄÄÙ');
 rows := 3;
 nPos := 7;
 sPos := 6;
end
else
begin
 gotoXY(x,8);  write('³     ³');
 gotoXY(x,9);  write('³     ³');
 gotoXY(x,10);  write('ÀÄÄÄÄÄÙ');
 rows := 5;
 nPos := 9;
 sPos := 7;
end;

 if (card.face = faceDown) or
    (card.suit = faceDown)
 then
   for i:= 1 to rows do
   begin
    gotoXY(x+1, 4+i);
    write('°°°°°');
   end
 else
 begin
   case card.face of
    1    : nstr := 'A';
    11   : nstr := 'J';
    12   : nstr := 'Q';
    13   : nstr := 'K';
    else   str(card.face, nstr);
   end;
   suitCh := char(card.suit+2);
   gotoXY(x+1,5);
   write(nstr);
   gotoXY(x+4, nPos);
   write(nstr:2);
   gotoXY(x+3, sPos);
   write(suitCh);
 end;
end;

{ Write the contents of status lines }
procedure TDisplay.showStatus1;
begin
 gotoXY(1,1);
 write(status1);
 gotoXY(1,1);
end;

{ Write the contents of status lines }
procedure TDisplay.showStatus2;
begin
 gotoXY(1,2);
 write(status2);
 gotoXY(1,1);
end;

{ Display whether card is held }
procedure TDisplay.showHoldCard(card:integer);
var s: string;
begin
 if hand.held[card] then
   s := 'Hold'
 else
   str(card:3, s);
 gotoXY((card-1)*7+2,3);
 write(s,' ');
 gotoXY(1,1);
end;

{ Write the hold status line }
procedure TDisplay.showHold;
var i : integer;
begin
  for i := 1 to 5 do
    showHoldCard(i);
end;

{ Show the payoffs if not on a Portfolio }
procedure TDisplay.showPayoffs;
begin
  gotoXY(1,11);
  writeLn('Payoffs:             Flush           50');
  writeLn(' Royal Flush   2500  Straight        40');
  writeLn(' Straight Flush 500  Three of a kind 30');
  writeLn(' Four of a kind 250  Two pair        20');
  write  (' Full house      80  Jacks or better 10');
end;

{ Allow testing of eval function during debugging on PC }
procedure TDisplay.debugMode;
var i, card, err : integer;
    s : string;
begin
{$IFNDEF Final}
  status1 := 'Enter card (1-52)                       ';
  status2 := '                                        ';
  showStatus1;
  showStatus2;
  for i := 1 to 5 do
  begin
   repeat
    gotoXY(20,1);
    write(i,':   ');
    gotoXY(23,1);
    readLn(s);
    val(s, card, err);
    if (card < 1) or (card > 52) then err := 1;
    if err <> 0 then beep;
   until err = 0;
   Hand.Cards[i].setVal(card);
   showHand(false);
  end;
  Hand.eval;
  showEval;
  done := true;
{$ENDIF}
end;

{ Make sure display is properly initialized on Portfolio }
procedure Startup;
begin
 StandardExit := ExitProc;
 ExitProc := @Cleanup;
 if isPort then
 begin
  PortInitialization;
  PortSetCursorMode(0);
 end;
end;

{ Restore display on Portfolio }
Procedure Cleanup;
begin
  ExitProc := StandardExit;
  if isPort then PortSetCursorMode(2);
  Title;
  if IsPort then
    gotoXY(2,7)
  else
    gotoXY(2,13);
end;

{ Initialization of unit }
begin
 Startup;
end.