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

Text File | 1986-06-01 | 15KB | 457 lines

 {  ╔══════════════════════════════════════════════════════╗
    ║        DEFAULTS.BR  Module of BRIDGE.PAS             ║                                                      ║
    ║                                                      ║
    ║            Last modified 10/29/85                    ║
    ║                                                      ║
    ║  Gets the users playing defaults : which hands to    ║
    ║  play, which hands to show, let the computer cheat.  ║
    ╚══════════════════════════════════════════════════════╝
 }
type
  DefaultRec = record
                 Computer : PlayerHand;
                 PrintAll, Cheat, OK : boolean;
               end;
var
  Defaults : DefaultRec;

procedure InitDefaults;
{ init default values }
begin
  Defaults.Computer[North] := false;
  Defaults.Computer[South] := true;
  Defaults.Computer[East] := false;
  Defaults.Computer[West] := false;
  Defaults.PrintAll := false;
  Defaults.Cheat := false;
end; { InitDefaults }

procedure GetDefaults;
const
  LeftX  = 7;
  LeftY  = 3;
  RightX = 72;
  RightY = 20;
  North  = 0;
  East   = 1;
  South  = 2;
  West   = 3;

type
  MaxString = string[255];
  PositionRec  = record
                   X, Y, Color, Background : byte;
                 end;

  ScreenPositions = (Box, Title, PlayHands,
                     ShowHands, Cheat1, Cheat2,
                     NorthHand, EastHand, SouthHand, WestHand,
                     Showing, Cheating, Play);
  CursorRec = record
    StartLine, EndLine : integer;
  end;

const
  Positions : array[Box..Play] of PositionRec = (
   { Box }       (X : LeftX;  Y : LeftY;
                  Color : Black; Background : LightGray),
   { Title }     (X : 24; Y : 4;
                  Color : LightGreen; Background : Black),
   { PlayHands } (X : 4; Y : 8;
                  Color : Yellow; Background : Black),
   { ShowHands } (X : 4; Y : 10;
                  Color : Yellow; Background : Black),
   { Cheat1 }    (X : 4; Y : 12;
                  Color : Yellow; Background : Black),
   { Cheat2 }    (X : 4; Y : 13;
                  Color : Yellow; Background : Black),
   { NorthHand } (X : 35;  Y : 8;                        { PlayHands.y }
                  Color : LightGray; Background : Black),
   { EastHand }  (X : 43;  Y : 8;                        { PlayHands.y }
                  Color : LightGray; Background : Black),
   { SouthHand } (X : 50;  Y : 8;                        { PlayHands.y }
                  Color : LightGray; Background : Black),
   { WestHand }  (X : 58;  Y : 8;                        { PlayHands.y }
                  Color : LightGray; Background : Black),
   { Showing }   (X : 35;  Y : 10;                        { ShowHands.y }
                  Color : LightGray; Background : Black),
   { Cheating }  (X : 35;  Y : 13;                        { Cheat2.y }
                  Color : LightGray; Background : Black),
   { Play }      (X : 57; Y : 16;
                  Color : LightGray; Background : Black));

var
  Item : ScreenPositions;

var
  LastCursor : CursorRec;

{ ================= begin cursor control module ================== }
procedure Cursor(On : boolean; var LastCursor : CursorRec);

procedure SetCursor(StartLine, EndLine : integer);
type
  Registers = record
              ax, bx, cx, dx, bp, si, di, ds, es, flags: integer;
            end;
var
  RegPack : Registers;
  CXRegArray : array[1..2] of byte;
  CXReg      : integer absolute CXRegArray;
begin
  CXREgArray[2] := Lo(StartLine);
  CXREgArray[1] := Lo(EndLine);
  with RegPack do
  begin
    ax := $0100;  { cursor interrupt }
    bx := $0;     { page #           }
    cx := CXReg;
    intr($10, RegPack);
  end;
end; { SetCursor }

procedure GetCursor(var StartLine, EndLine : integer);
type
  Registers = record
              ax, bx, cx, dx, bp, si, di, ds, es, flags: integer;
            end;
var
  RegPack : Registers;
begin
  with RegPack do
  begin
    ax := $0300;  { cursor interrupt }
    bx := $0;     { page #           }
    intr($10, RegPack);
  end;
  StartLine := Hi(RegPack.cx);
  EndLine := Lo(RegPack.cx);
end; { GetCursor }

begin { Cursor }
  if On then
  begin
    with LastCursor do
      SetCursor(StartLine, EndLine)
  end
  else
  begin
    with LastCursor do                    { save original cursor type }
      GetCursor(StartLine, Endline);
    SetCursor(32, 0);
  end;
end; { Cursor }
{ ================= Cursor control module ================== }

procedure RestoreScreen;
begin
  LowVideo;
  Window(1, 1, 80, 25);
  GoToXY(1, 24);
  Cursor(true, LastCursor);
end; { RestoreScreen }

procedure Abort;
begin
  RestoreScreen;
  Halt;
end; { Abort }

procedure DrawBox;
var
  i : integer;

procedure DrawHelpLine;

procedure WriteHelp(s : MaxString; No : byte);
begin
  TextBackground(Positions[Box].Color);
  TextColor(Positions[Box].Background);
  Write(Copy(s, 1, No));
  Delete(s, 1, No);
  TextBackground(Positions[Box].Background);
  TextColor(Positions[Box].Color);
  Write(s);
end; { WriteHelp }

begin
  GoToXY(LeftX, RightY + 1);                       { help line }
  Write(' ':RightX - LeftX + 1);
  GoToXY(LeftX + 3, RightY + 1);
  WriteHelp(^[ + '-', 1);
  WriteHelp(^Z + '-Move blinking arrows  ', 1);
  WriteHelp('SPACE-Selects  ', 5);
  WriteHelp('Play-Begins game', 4);
end; { DrawHelpLine }

begin
  NormVideo;
  ClrScr;
  TextColor(Positions[Box].Color);
  TextBackground(Positions[Box].Background);
  GoToXY(LeftX, LeftY);
  Write('╓');                                  { top line }
  for i := LeftX + 1 to RightX - 1 do
    Write('─');
  Write('╖');
  for i := LeftY + 1 to RightY - 1 do          { sides }
  begin
    GoToXY(LeftX, i);
    Write('║');
    GoToXY(RightX, i);
    Write('║');
  end;
  GoToXY(LeftX, RightY);                       { bottom line }
  Write('╙');
  for i := LeftX + 1 to RightX - 1 do
    Write('─');
  Write('╜');
  DrawHelpLine;
end; { DrawBox }

procedure DisPlayText;

procedure Paint(Item : PositionRec; s : MaxString);
begin
  with Item do
  begin
    GoToXY(x, y);
    TextColor(Color);
    TextBackground(Background);
    Write(s);
  end;
end; { Paint }

begin { DisPlayText }
  Window(LeftX, LeftY, RightX, RightY + 2);
  Paint(Positions[Title], 'T U R B O - B R I D G E');
  Paint(Positions[PlayHands], 'Select hands you wish to Play:');
  Paint(Positions[ShowHands], 'Display all 4 hands?');
  Paint(Positions[Cheat1], 'Should the program cheat');
  Paint(Positions[Cheat2], 'and look at your cards?');
  TextColor(Positions[Box].Background);                   { inverse of border }
  TextBackground(Positions[Box].Color);
  GoToXY(Positions[Play].X - 1, Positions[Play].Y - 1);
  Write('┌──────┐');
  GoToXY(Positions[Play].X - 1, Positions[Play].Y);
  Write('│      │');
  GoToXY(Positions[Play].X - 1, Positions[Play].Y + 1);
  Write('└──────┘');
end; { DisplayText }

procedure ShowSetting(Item : PositionRec;
                         s : MaxString;
                       On,
                  Selected : boolean);
var
  c, b : byte;
begin
  with Item do
  begin
    GoToXY(x, y);
    if On then            { inverse video }
    begin
      b := Color;
      c := Background;
    end
    else                  { normal video }
    begin
      b := Background;
      c := Color;
    end;
  end;
  TextColor(c);
  TextBackground(b);
  if Selected then
  begin
    TextColor(c + blink);
    Write(^P);
    TextColor(c);
  end
  else
    Write(' ');
  Write(s);
  if s = 'NO' then
  begin
    Write('  ');
    GoToXY(whereX - 2, whereY);
  end;
  if Selected then
  begin
    TextColor(c + blink);
    Write(^Q);
  end
  else
    Write(' ');
end; { ShowSetting }

procedure ShowDefaults(Position : ScreenPositions;
                       Defaults : DefaultRec;
                       Selected : boolean);

function ToggleString(On : boolean) : MaxString;
begin
  if On then ToggleString := 'YES'
  else ToggleString := 'NO';
end; { ToggleString }

begin
  with Defaults do
  begin
    case Position of
      NorthHand : ShowSetting(Positions[NorthHand], 'NORTH',
                                  Computer[North], Selected);
      EastHand  : ShowSetting(Positions[EastHand], 'EAST',
                                  Computer[East], Selected);
      SouthHand : ShowSetting(Positions[SouthHand], 'SOUTH',
                                  Computer[South], Selected);
      WestHand  : ShowSetting(Positions[WestHand], 'WEST',
                                  Computer[West], Selected);
      Showing   : ShowSetting(Positions[Showing], ToggleString(PrintAll),
                                  false, Selected);
      Cheating  : ShowSetting(Positions[Cheating], ToggleString(Cheat),
                                  false, Selected);
      Play      : ShowSetting(Positions[Succ(Cheating)], 'Play',
                                  OK, Selected);
    end; { case }
  end; { with }
end; { ShowDefaults }

procedure SelectDefaults;
var
  Curr, Last : ScreenPositions;

procedure GetCommand(var Curr : ScreenPositions);
var
  ch : char;

procedure Toggle(Curr : ScreenPositions; var Defaults : DefaultRec);
begin
  with Defaults do
    case Curr of
      NorthHand..WestHand : begin
                              Computer[Ord(Curr) - Ord(NorthHand)] :=
                                 not Computer[Ord(Curr)- Ord(NorthHand)];
                            end;
      Showing : PrintAll := not PrintAll;
      Cheating : Cheat := not Cheat;
      Play : OK := true;
    end; { case }
  ShowDefaults(Curr, Defaults, true);
end; { Toggle }

begin { GetCommand }
  Read(KBD, ch);
  case UpCase(ch) of
    #13, #32 : Toggle(Curr, Defaults);                 { toggle current }
    'N'      : case Curr of                            { north, no }
                 NorthHand..WestHand : begin
                                         Curr := NorthHand;
                                         Toggle(Curr, Defaults);
                                       end;
                 Showing             : if Defaults.PrintAll then
                                        begin
                                          Curr := Showing;
                                          Toggle(Curr, Defaults);
                                         end;
                 Cheating            : if Defaults.Cheat then
                                       begin
                                         Curr := Cheating;
                                         Toggle(Curr, Defaults);
                                       end;
               end; { case }
    'Y'      : case Curr of
                 Showing             : if not Defaults.PrintAll then
                                        begin
                                          Curr := Showing;
                                          Toggle(Curr, Defaults);
                                         end;
                 Cheating            : if not Defaults.Cheat then
                                       begin
                                         Curr := Cheating;
                                         Toggle(Curr, Defaults);
                                       end;
               end; { case }
    'E'      : if Curr in [NorthHand..WestHand] then     { east }
               begin
                 Curr := EastHand;
                 Toggle(Curr, Defaults);
               end;
    'S'      : if Curr in [NorthHand..WestHand] then     { south }
               begin
                 Curr := SouthHand;
                 Toggle(Curr, Defaults);
               end;
    'W'      : if Curr in [NorthHand..WestHand] then     { west }
               begin
                 Curr := WestHand;
                 Toggle(Curr, Defaults);
               end;
    'P'      : begin                                   { Play }
                 Curr := Play;
                 Toggle(Curr, Defaults);
               end;
    ^C, 'Q'  : Abort;                                  { abort }
    ^[       : begin                     { ESC or function/arrow key }
                 if not KeyPressed then Abort
                 else
                 begin
                   Read(KBD, ch);
                   case ch of
                     'K' : Curr := Pred(Curr);  { left arrow }
                     'M' : Curr := Succ(Curr);  { right arrow}
                     'H' : case Curr of         { up arrow }
                             NorthHand..WestHand : Curr := Play;
                             Showing             : Curr := NorthHand;
                             Cheating            : Curr := Showing;
                             Play                : Curr := Cheating;
                           end;
                     'P' : case Curr of           { down arrow}
                             NorthHand..WestHand : Curr := Showing;
                             Showing             : Curr := Cheating;
                             Cheating            : Curr := Play;
                             Play                : Curr := NorthHand;
                           end;
                   end; { case }
                 end;
               end;
  end; { case }
  if Curr > Play then Curr := NorthHand
  else
    if Curr < NorthHand then Curr := Play;
end; { GetCommand }

begin { SelectDefaults }
  Last := NorthHand;
  Curr := Play;
  repeat
    if Curr <> Last then
    begin
      ShowDefaults(Last, Defaults, false);
      ShowDefaults(Curr, Defaults, true);
      Last := Curr;
    end;
    GetCommand(Curr);
  until Defaults.Ok = true;
end; { SelectDefaults }

begin { OpeningScreen }
  FlushBuffer;
  Cursor(false, LastCursor);
  Defaults.Ok := false;
  ShowTricks := true;
  DrawBox;                                { paint screen }
  DisplayText;
  for Item := NorthHand to Cheating do
    ShowDefaults(Item, Defaults, false);  { Display toggle switches }
  SelectDefaults;
  Computer[North] := not Defaults.Computer[North];
  Computer[South] := not Defaults.Computer[South];
  Computer[East]  := not Defaults.Computer[East];
  Computer[West]  := not Defaults.Computer[West];
  PrintAll := Defaults.PrintAll;
  Cheat := Defaults.Cheat;
  RestoreScreen;                          { restore screen, do not abort }
end; { GetDefaults }

{ end DEFAULTS.BR }