Metropoli BBS
VIEWER: playfish.pas MODE: TEXT (ASCII)
PROGRAM PlayFish;
USES Crt, Cards, ListObj, Gofish;

TYPE
  FBPlayerP = ^FBrightPlayer;
  FCPlayerP = ^FCheatPlayer;
  FSPlayerP = ^FShadowPlayer;

  FBrightPlayer = OBJECT (FPlayer)
    CardToChoose : ShortInt;
    CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
                     iDire : direction; iName : string);
    DESTRUCTOR done; virtual;
    PROCEDURE Chooseopponent(opps : list; VAR P : FPP); virtual;
    PROCEDURE ChooseCard(VAR Cval : word); virtual;
  END;

  FCheatPlayer = OBJECT (FBrightPlayer)
    Cheat : Boolean;
    CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
                     iDire : direction; iName : string);
    DESTRUCTOR done; virtual;
    FUNCTION  HaveAny(num : byte) : boolean; virtual;
    PROCEDURE TakeTurn(opps : list; VAR same : boolean; 
                       VAR numl : byte; dek : DeckP); virtual;
  END;

  FShadowPlayer = OBJECT (FBrightPlayer)
    CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
                     iDire : direction; iName : string);
    DESTRUCTOR done; virtual;
    PROCEDURE SetRev(cvalu : Byte; RevIt : boolean); virtual;
  END;

(*-methods for FBrightPlayer-*)

  CONSTRUCTOR FBrightPlayer.Init(iX, iY : Word; iShow : decision;
                                 iDire : direction; iName : string);
  BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); END;

  DESTRUCTOR FBrightPlayer.done; BEGIN FPlayer.done; END;

  PROCEDURE FBrightPlayer.ChooseOpponent(opps : list; VAR P : FPP);
  VAR B, N : byte;
    hehas  : revealed;
  BEGIN
    CardToChoose := -1;
    P := FPP(opps.NextCirc(@Self));
    WHILE (P <> @Self) AND (CardToChoose = -1) DO
      BEGIN
        P^.Tell(heHas);
        FOR B := 0 to 12 DO
          IF Hehas[B] AND (HaveAny(B)) THEN CardToChoose := B;
        IF (CardToChoose = -1) THEN P := FPP(opps.NextCirc(P));
      END;
    IF CardToChoose = -1 THEN {just guess}
      BEGIN
        P := FPP(FirsNotSelf(opps));
        FOR N := 1 to random(6) DO P := FPP(NextNotSelf(opps, P));
        IF P^.OutOfCards THEN
          BEGIN
            P := @Self;
            REPEAT P := FPP(opps.NextCirc(P))
            UNTIL (NOT P^.OutOfCards) OR (P = @Self);
            IF P = @Self THEN P := FPP(opps.NextCirc(P));
          END;
      END;
  END;

  PROCEDURE FBrightPlayer.ChooseCard(VAR Cval : word);
  VAR B, N : byte;
    C : CardP;
  BEGIN
    IF CardToChoose <> -1 THEN Cval := CardToChoose
    ELSE {just guess}
      BEGIN
        C := CardP(H^.OnBot);
        FOR N := 1 to random(H^.NumInPile) DO C := H^.NextCard(C);
        cval := C^.GetRank;
      END;
  END;

(*-methods for FCheatPlayer--*)

  CONSTRUCTOR FCheatPlayer.Init(iX, iY : Word; iShow : decision; 
                                iDire : direction; iName : string);
  BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); Cheat := true; END;

  DESTRUCTOR FCheatPlayer.done; BEGIN FPlayer.done; END;

  FUNCTION FCheatPlayer.HaveAny(num : Byte) : Boolean;
  VAR temp : boolean;
  BEGIN
    temp := FPlayer.HaveAny(num);
    IF Cheat THEN
      IF temp AND (random < 0.5) THEN
        BEGIN temp := false; Click; Delay(500); END;
    HaveAny := temp;
  END;

  PROCEDURE FCheatPlayer.TakeTurn(opps : list; VAR same : boolean;
                                  VAR numl : byte; dek : DeckP);
  BEGIN
    Cheat := false; {don't fool YOURSELF!}
    FPlayer.TakeTurn(opps, same, numl, dek);
    Cheat := true;
  END;

(*-methods for FShadowPlayer-*)

  CONSTRUCTOR FShadowPlayer.Init(iX, iY : Word; iShow : decision;
                                 iDire : direction; iName : string);
  BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); END;

  DESTRUCTOR FShadowPlayer.done; BEGIN FPlayer.Done; END;

  PROCEDURE FShadowPlayer.SetRev(cvalu : Byte; RevIt : boolean);
  BEGIN END; {never reveal anything}

VAR
  fishgame        : fish;
  numPlay, N, row : Byte;
  CH              : Char;
  name            : String[10];
  choices         : String[9];
BEGIN
  WriteLn('Time to play **GO FISH**');
  WriteLn;
  Fishgame.Init;
  ClrScr;
  Write('How many players? (2-4)');
  REPEAT CH := ReadKey UNTIL (CH >= '2') AND (CH <= '4');
  WriteLn(CH);
  numPlay := ord(CH)-ord('0');
  WriteLn('H = Human    -- controlled by YOU');
  WriteLn('D = Dumb     -- plays at random');
  WriteLn('B = Bright   -- remembers what others asked for');
  WriteLn('C = Cheater  -- lies about its hand half the time');
  WriteLn('S = Shadow   -- can "cloud men''s minds"');
  row := 1;
  Choices := 'H D B C S';
  FOR N := 1 to NumPlay DO
    BEGIN
      Write('Player type for player #', N, ' : (', choices, ')');
      REPEAT CH := UpCase(ReadKey) UNTIL odd(pos(CH, choices));
      WriteLn(CH);
      Write('Name for player (10 characters) : ');  ReadLn(name);
      CASE CH OF
        'H' : BEGIN
               inc(row); {human needs an extra row}
               FishGame.AddPlayer(
                 New(FHPlayerP, Init(2, row, yes, rt, name)));
               choices := 'D B C S';
             END;
        'D' : FishGame.AddPlayer(
               New(FMPlayerP, Init(2, row, no, rt, name)));
        'B' : FishGame.AddPlayer(
               New(FBPlayerP, Init(2, row, no, rt, name)));
        'C' : FishGame.AddPlayer(
               New(FCPlayerP, Init(2, row, no, rt, name)));
        'S' : FishGame.AddPlayer(
               New(FSPlayerP, Init(2, row, no, rt, name)));
      END;
      Inc(row, 6);
    END; 
  WriteLn;
  IF choices = 'D B C S' THEN
    BEGIN
      WriteLn('When it is your turn : ');
      WriteLn;
      WriteLn('Step 1 : Highlight another player using up/down');
      WriteLn('         arrows and press ENTER to choose.  You');
      WriteLn('         may press "?" first for a little help.');
      WriteLn('Step 2 : Point to a card using right/left arrows');
      WriteLn('         and press ENTER to choose.');
      WriteLn;
      WriteLn('Now press a key to begin the game.');
      IF ReadKey = #0 THEN;
    END;
  IF NumPlay = 2 THEN FishGame.DealCards(7)
  ELSE Fishgame.DealCards(5);
  Fishgame.Display;
  Fishgame.Play;
END.
[ RETURN TO DIRECTORY ]