Shareware Overload/ShartewareOverload.cdr/games/tbridge.zip/INPUT.BR

Text File | 1986-06-01 | 14KB | 502 lines

 {  ╔══════════════════════════════════════════════════════╗
    ║          INPUT.BR  Module of BRIDGE.PAS              ║                                                      ║
    ║                                                      ║
    ║                Last modified 10/29/85                ║
    ║                                                      ║
    ║    Handles user I/O in bidding and playing.          ║
    ║                                                      ║
    ╚══════════════════════════════════════════════════════╝
 }
const
  ShortDelay = 250;
  LongDelay  = 1200;

procedure GetCh(var ch : char);
begin
  Read(KBD, ch);
  ch := UpCase(ch);
end; { GetKey }

procedure AbortCheck(ch : char);
begin
  case ch of
    ^C : StopGames;
    ^[ : FlushBuffer;
  end; { case }
end; { AbortCheck }

type
  CharSet = set of char;

procedure CheckKBD;
{ Scan keyboard, ignore input unless aborting }
var
  ch : char;
begin
 if KeyPressed then
 begin
   GetCh(ch);
   AbortCheck(ch);
 end;
end; { CheckKBD }

procedure GetOption(var ch : char; LegalChars : CharSet);
{ Reads keyboard until character is in Legal set }
begin
  repeat
    GetCh(ch);
    AbortCheck(ch);
  until ch in LegalChars;
end; { GetOption }

procedure DummyMessage;
{ Asks if the user wants to play the Dummy's Hand }
var
  ch : char;
begin
  DummyPartner := -1;
  if (not Computer[Dummy]) and
     (Computer[Partner(Dummy)]) then { Dummy = human, Partner = Computer }
  begin
    ClearMenu;
    GotoPos(MenuPos,0,2);
    Write('Do you wish to play the');
    GotoPos(MenuPos,0,3);
    Write('   cards for your side? ');
    GetOption(ch, ['Y', 'N', ^C]);
    case ch of
      ^C  : StopGames;
      'Y' : begin
              Write('Yes');
              DummyPartner := Partner(Dummy);
            end;
       else Write('No');
    end; { case }
    Delay(ShortDelay);
    ClearMenu;
  end; { if }
end; { DummyMessage }

const
  CommandLength = 4;
type
  CommandString = string[CommandLength];
var
  Command : CommandString;

procedure PrintRankSuit(Rank,Suit : char);
{ outputs the Card }
begin
  case Suit of
   'C' : begin
           SetColor(TrumpColor[Club]);
           Write(Rank + ' ' + TrumpStr[Club]);
         end;
   'D' : begin
           SetColor(TrumpColor[Diamond]);
           Write(Rank + ' ' + TrumpStr[Diamond]);
         end;
   'H' : begin
           SetColor(TrumpColor[Heart]);
           Write(Rank + ' ' + TrumpStr[Heart]);
         end;
   'S' : begin
           SetColor(TrumpColor[Spade]);
           Write(Rank + ' ' + TrumpStr[Spade]);
         end;
   'N' : begin
           SetColor(TrumpColor[NT]);
           Write(Rank + ' ' + TrumpStr[NT]);
         end;
  end;
  TextColor(MenuPos.Color);
  TextBackground(MenuPos.background);
end; { PrintRankSuit }

procedure BackSpace;
begin
  Delete(Command, Length(Command) , 1);
  GotoXY(WhereX-1, WhereY);
  Write(' ');
  GotoXY(WhereX-1, WhereY);
end; { BackSpace }

procedure NewDefaults;
{ Asks if user wants to change the defaults, if yes calls GetDefaults }
var
  ch : char;
begin
  ClearMenu;
  GotoPos(MenuPos,0,3);
  Write('Reset the defaults? ');
  GetOption(ch, ['Y', 'N', ^C ]);
  case ch of
    ^C    : StopGames;
    'Y'   : begin
               Write('Yes');
               GetDefaults;
               NewScreen;
             end;
     else Write('No');
  end; { case }
  Delay(400);
  ch := ' ';
end; { NewDefaults }

procedure PrintPrompt(Hand : HandType);
{ The user prompt is the hand to play }
begin
  GotoPos(CommandPos,0,0);
  ClearEol;
  Write(HandName[Hand],': ');
end; { PrintPrompt }

procedure ShowScore(Bidding : boolean; Hand : HandType);
{ Checks if the user wants to look at the score }
begin
  DisplayScore(0);
  if Bidding then
    BidMenu
  else
    PlayMenu;
  PrintPrompt(Hand);
end; { ShowScore }

procedure ReadPrepare(Hand : HandType;
                      var Command : CommandString);
{ Sets up for reading an option }
begin
  PrintPrompt(Hand);
  Write(' ');
  GotoXY(WhereX-1, WhereY);
  Command := '';
  FlushBuffer;
end; { ReadPrepare }

procedure GetBid(Hand : HandType;
                 var Command : CommandString;
                 var Restart : boolean);
{ Reads, parses and prints the the user Bid option }
var
  OptionRead : boolean; { True when we are Done reading the option }

procedure PrintOption(var Command : CommandString);
begin
  if Length(Command) = 1 then
  begin
    case Command[1] of
      'D'  : Command := 'DBL';
      'R'  : Command := 'RDBL';
      'P'  : Command := 'PASS';
      else;
    end;
    Write(Command);
  end
  else
  begin
    GotoXY(WhereX-1, WhereY);
    Write(' ');
    GotoXY(WhereX-1, WhereY);
    PrintRankSuit(Command[1],Command[2]);
  end;
  Delay(ShortDelay);
end; { PrintOption }

procedure ReadBid(var Command : CommandString);
{ Reads options of Length 1 and 2 passing in the approprate sets of
  Legal characters }
const
  Legal1stChars : CharSet = ['1'..'7','R','D','P','C','N','S','X'];
  Legal2ndChars : CharSet = ['C','D','H','S','N',#8];
var
  ch : char;
begin
  if Length(Command) = 0 then
  begin
    GetOption(ch, Legal1stChars);
    ClearError;
  end
  else
    if Length(Command) = 1 then
      GetOption(ch, Legal2ndChars);
  Command := Command + ch;
end; { ReadBid }

procedure ParseBid(var Command : CommandString;
                   Hand : HandType;
                   var OptionRead, Restart : boolean);
{ Command holds the user's bid this routine checks its legality }

procedure ParseFirst(var Command : CommandString; Hand : HandType;
                     var OptionRead, Restart : boolean);
begin
  Restart := false;
  case Command[1] of
    'X'      : begin
                 Write('EXIT');
                 StopGames;               { Exits program }
               end;
    '1'..'7' : begin
                 Write(Command);
                 OptionRead := false;      { Bid Number }
                 BidSuitHelp;
               end;
    'R',                                   { Redouble   }
    'D',                                   { Double     }
    'P'      : OptionRead := true;         { Pass       }
    'C'      : begin                       { Clear Bids }
                 Write(Command);
                 Command := '';
                 Delay(ShortDelay);
                 ClearBids;
                 Restart := true;
                 OptionRead := true;
               end;
    'N'      : begin                       { New Deal }
                 Write(Command);
                 Delay(ShortDelay);
                 Command := '';
                 NewDefaults;
                 NewDeal;
                 Restart := true;
                 OptionRead := true;

               end;
    'S'      : begin                      { Show Score }
                 ShowScore(true,Hand);    { First paramater indicates
                                             that we are Bidding }
                 Command := '';
                 OptionRead := false;
               end;
  end; { case }
end; { ParseFirst }

procedure ParseSecond(var Command : CommandString;
                      var OptionRead : boolean);
begin
  case Command[2] of
    #8          : begin
                    BackSpace;
                    BidMenu;    { Redraw the first menu }
                    Command := '';
                    OptionRead := false;
                  end;
    'C','S',
    'H','D','N' : OptionRead := true;
  end;
end; { ParseSecond }

begin { ParseBid }
 if Length(Command) = 1 then
   ParseFirst(Command, Hand, OptionRead, Restart)
 else
   if (Length(Command) = 2) then
     ParseSecond(Command, OptionRead);
end; { ParseBid }

procedure GetBidOption(Hand : HandType;
                       var Command : CommandString;
                       var OptionRead, Restart : boolean);
{ Reads the users Bid Command and parses it for meaning }
begin
  ReadBid(Command);
  ParseBid(Command, Hand, OptionRead, Restart);
end; { GetBidOption }

begin { GetBid }
  Restart := false;
  OptionRead := false;
  ReadPrepare(Hand, Command);
  repeat
    GetBidOption(Hand, Command, OptionRead, Restart);
  until OptionRead;
  if Length(Command) > 0 then
    PrintOption(Command);
end; { GetBid }

procedure GetPlay(Hand : HandType;
                  var Command : CommandString;
                  var Restart : boolean);
{ Gets the users Command to play a Card }

procedure PrintOption(var Command : CommandString);
begin
  if Length(Command) > 1 then
  begin
    GotoXY(WhereX-1, WhereY);
    Write(' ');
    GotoXY(WhereX-1, WhereY);
    PrintRankSuit(Command[1],Command[2]);
    Delay(ShortDelay);
  end;
end; { PrintOption }

procedure ReadPlay(var Command : CommandString);
const
  Legal1stChars : CharSet = ['2'..'9','T','J','Q','K',
                             'A','S','X','N','O','H',#13];
  Legal2ndChars : CharSet = ['C','D','H','S',#8,#13];
var
  ch : char;
begin
  if Length(Command) = 0 then
  begin
    GetOption(ch, Legal1stChars);
    ClearError;
  end
  else
    GetOption(ch, Legal2ndChars);
  Command := Command + ch;
end; { ReadPlay }

procedure ParsePlay(var Command : CommandString;
                     Hand : HandType; var OptionRead, Restart : boolean);

procedure ParseFirst(var Command : CommandString;
                     Hand : HandType; var OptionRead, Restart : boolean);
{ Parses the first character of a play command }
begin
  case Command[1] of
    #13             : begin
                        Delete(Command,Length(Command),1);
                        OptionRead := true;
                      end;
    '2'..'9','T',
    'J','Q','K','A' : begin
                        Write(Command);
                        OptionRead := false; { Read one more }
                        PlaySuitHelp;
                      end;
    'S'             : begin
                        Write(Command);
                        Delay(ShortDelay);
                        ShowScore(false,Hand);
                        { First paramater indicates that we are playing }
                        Command := '';
                        OptionRead := false; { Option handled internally }
                      end;
    'X'             : begin
                        Write('EXIT');
                        StopGames;             { Abort program }
                      end;
    'N'             : begin
                        Write(Command);
                        Delay(ShortDelay);
                        Command := '';
                        Restart := true;
                        OptionRead := true;
                        Writeln(OutputFile);
                        Writeln(OutputFile);
                        Writeln(OutputFile, ' ':10, 'Game cancelled...');
                        Writeln(OutputFile);
                      end;
    'O','H'         : begin
                        Write(Command);
                        Delay(ShortDelay);
                        OptionRead := true;
                      end;
  end;
end; { ParseFirst }

procedure ParseSecond(var Command : CommandString;
                      var OptionRead : boolean);
begin
  case Command[2] of
    #8   : begin
             BackSpace;
             PlayMenu;    { Redraw the first menu }
             Command := '';
             OptionRead := false;
           end;
    #13  : begin
             Delete(Command,Length(Command),1);
             OptionRead := true;
           end;
    else  OptionRead := true;
  end;
end; { ParseSecond }

begin { ParsePlay }
  if Length(Command) = 1 then
    ParseFirst(Command, Hand, OptionRead, Restart)
  else
    ParseSecond(Command, OptionRead);
end; { ParsePlay }

procedure GetPlayOption(Hand : HandType;
                        var Command : CommandString;
                        var OptionRead, Restart : boolean );
begin
  ReadPlay(Command);
  ParsePlay(Command, Hand, OptionRead, Restart);
end; { GetPlayOption }

var
  OptionRead : boolean;

begin { GetPlay }
  Restart := false;
  ReadPrepare(Hand, Command);
  repeat
    GetPlayOption(Hand, Command, OptionRead, Restart);
  until OptionRead;
  PrintOption(Command);
end; { GetPlay }

procedure Answer(Hand        : HandType;
                 var Command : CommandString;
                 Bidding     : boolean;
                 var Restart : boolean);
{ Reads a Command for the Hand }
begin
  if Bidding then
  begin
    BidMenu;
    GetBid(Hand, Command, Restart);
  end
  else
    GetPlay(Hand, Command, Restart);
  GotoPos(CommandPos,0,0);
  ClearEol;
END; { Answer }

procedure ChangeDefaults;
{ Ask about a new Game, change of defaults }
var
  Choice : char;

begin { ChangeDefaults }
  ClearMenu;
  FlushBuffer;
  GotoPos(MenuPos,2,2);
  Write('Reset the options? ');
  GetOption(Choice,['Y','N']);
  if Choice = 'Y' then
  begin
    Write('Yes');
    FlushBuffer;
    GetDefaults;
    NewScreen;
  end
  else
  begin
    Write('No');
  end;
  ClearMenu;
end; { ChangeDefaults }

procedure ShowHint(Hand : HandType;
                   HintCard : CardType; var HintPlayed : boolean);
var
  Choice : char;
begin
  ClearMenu;
  PrintPrompt(Hand);
  SetColor(TrumpColor[HintCard.Suit]);
  write(CardStr(HintCard));
  HintHelp;
  GetOption(Choice,[#13, #8]);
  HintPlayed := (Choice = #13);
end;

{ end INPUT.BR }