home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol9n04.zip / PLAYFISH.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-20  |  6KB  |  184 lines
  1. PROGRAM PlayFish;
  2. USES Crt, Cards, ListObj, Gofish;
  3.  
  4. TYPE
  5.   FBPlayerP = ^FBrightPlayer;
  6.   FCPlayerP = ^FCheatPlayer;
  7.   FSPlayerP = ^FShadowPlayer;
  8.  
  9.   FBrightPlayer = OBJECT (FPlayer)
  10.     CardToChoose : ShortInt;
  11.     CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
  12.                      iDire : direction; iName : string);
  13.     DESTRUCTOR done; virtual;
  14.     PROCEDURE Chooseopponent(opps : list; VAR P : FPP); virtual;
  15.     PROCEDURE ChooseCard(VAR Cval : word); virtual;
  16.   END;
  17.  
  18.   FCheatPlayer = OBJECT (FBrightPlayer)
  19.     Cheat : Boolean;
  20.     CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
  21.                      iDire : direction; iName : string);
  22.     DESTRUCTOR done; virtual;
  23.     FUNCTION  HaveAny(num : byte) : boolean; virtual;
  24.     PROCEDURE TakeTurn(opps : list; VAR same : boolean; 
  25.                        VAR numl : byte; dek : DeckP); virtual;
  26.   END;
  27.  
  28.   FShadowPlayer = OBJECT (FBrightPlayer)
  29.     CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
  30.                      iDire : direction; iName : string);
  31.     DESTRUCTOR done; virtual;
  32.     PROCEDURE SetRev(cvalu : Byte; RevIt : boolean); virtual;
  33.   END;
  34.  
  35. (*-methods for FBrightPlayer-*)
  36.  
  37.   CONSTRUCTOR FBrightPlayer.Init(iX, iY : Word; iShow : decision;
  38.                                  iDire : direction; iName : string);
  39.   BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); END;
  40.  
  41.   DESTRUCTOR FBrightPlayer.done; BEGIN FPlayer.done; END;
  42.  
  43.   PROCEDURE FBrightPlayer.ChooseOpponent(opps : list; VAR P : FPP);
  44.   VAR B, N : byte;
  45.     hehas  : revealed;
  46.   BEGIN
  47.     CardToChoose := -1;
  48.     P := FPP(opps.NextCirc(@Self));
  49.     WHILE (P <> @Self) AND (CardToChoose = -1) DO
  50.       BEGIN
  51.         P^.Tell(heHas);
  52.         FOR B := 0 to 12 DO
  53.           IF Hehas[B] AND (HaveAny(B)) THEN CardToChoose := B;
  54.         IF (CardToChoose = -1) THEN P := FPP(opps.NextCirc(P));
  55.       END;
  56.     IF CardToChoose = -1 THEN {just guess}
  57.       BEGIN
  58.         P := FPP(FirsNotSelf(opps));
  59.         FOR N := 1 to random(6) DO P := FPP(NextNotSelf(opps, P));
  60.         IF P^.OutOfCards THEN
  61.           BEGIN
  62.             P := @Self;
  63.             REPEAT P := FPP(opps.NextCirc(P))
  64.             UNTIL (NOT P^.OutOfCards) OR (P = @Self);
  65.             IF P = @Self THEN P := FPP(opps.NextCirc(P));
  66.           END;
  67.       END;
  68.   END;
  69.  
  70.   PROCEDURE FBrightPlayer.ChooseCard(VAR Cval : word);
  71.   VAR B, N : byte;
  72.     C : CardP;
  73.   BEGIN
  74.     IF CardToChoose <> -1 THEN Cval := CardToChoose
  75.     ELSE {just guess}
  76.       BEGIN
  77.         C := CardP(H^.OnBot);
  78.         FOR N := 1 to random(H^.NumInPile) DO C := H^.NextCard(C);
  79.         cval := C^.GetRank;
  80.       END;
  81.   END;
  82.  
  83. (*-methods for FCheatPlayer--*)
  84.  
  85.   CONSTRUCTOR FCheatPlayer.Init(iX, iY : Word; iShow : decision; 
  86.                                 iDire : direction; iName : string);
  87.   BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); Cheat := true; END;
  88.  
  89.   DESTRUCTOR FCheatPlayer.done; BEGIN FPlayer.done; END;
  90.  
  91.   FUNCTION FCheatPlayer.HaveAny(num : Byte) : Boolean;
  92.   VAR temp : boolean;
  93.   BEGIN
  94.     temp := FPlayer.HaveAny(num);
  95.     IF Cheat THEN
  96.       IF temp AND (random < 0.5) THEN
  97.         BEGIN temp := false; Click; Delay(500); END;
  98.     HaveAny := temp;
  99.   END;
  100.  
  101.   PROCEDURE FCheatPlayer.TakeTurn(opps : list; VAR same : boolean;
  102.                                   VAR numl : byte; dek : DeckP);
  103.   BEGIN
  104.     Cheat := false; {don't fool YOURSELF!}
  105.     FPlayer.TakeTurn(opps, same, numl, dek);
  106.     Cheat := true;
  107.   END;
  108.  
  109. (*-methods for FShadowPlayer-*)
  110.  
  111.   CONSTRUCTOR FShadowPlayer.Init(iX, iY : Word; iShow : decision;
  112.                                  iDire : direction; iName : string);
  113.   BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); END;
  114.  
  115.   DESTRUCTOR FShadowPlayer.done; BEGIN FPlayer.Done; END;
  116.  
  117.   PROCEDURE FShadowPlayer.SetRev(cvalu : Byte; RevIt : boolean);
  118.   BEGIN END; {never reveal anything}
  119.  
  120. VAR
  121.   fishgame        : fish;
  122.   numPlay, N, row : Byte;
  123.   CH              : Char;
  124.   name            : String[10];
  125.   choices         : String[9];
  126. BEGIN
  127.   WriteLn('Time to play **GO FISH**');
  128.   WriteLn;
  129.   Fishgame.Init;
  130.   ClrScr;
  131.   Write('How many players? (2-4)');
  132.   REPEAT CH := ReadKey UNTIL (CH >= '2') AND (CH <= '4');
  133.   WriteLn(CH);
  134.   numPlay := ord(CH)-ord('0');
  135.   WriteLn('H = Human    -- controlled by YOU');
  136.   WriteLn('D = Dumb     -- plays at random');
  137.   WriteLn('B = Bright   -- remembers what others asked for');
  138.   WriteLn('C = Cheater  -- lies about its hand half the time');
  139.   WriteLn('S = Shadow   -- can "cloud men''s minds"');
  140.   row := 1;
  141.   Choices := 'H D B C S';
  142.   FOR N := 1 to NumPlay DO
  143.     BEGIN
  144.       Write('Player type for player #', N, ' : (', choices, ')');
  145.       REPEAT CH := UpCase(ReadKey) UNTIL odd(pos(CH, choices));
  146.       WriteLn(CH);
  147.       Write('Name for player (10 characters) : ');  ReadLn(name);
  148.       CASE CH OF
  149.         'H' : BEGIN
  150.                inc(row); {human needs an extra row}
  151.                FishGame.AddPlayer(
  152.                  New(FHPlayerP, Init(2, row, yes, rt, name)));
  153.                choices := 'D B C S';
  154.              END;
  155.         'D' : FishGame.AddPlayer(
  156.                New(FMPlayerP, Init(2, row, no, rt, name)));
  157.         'B' : FishGame.AddPlayer(
  158.                New(FBPlayerP, Init(2, row, no, rt, name)));
  159.         'C' : FishGame.AddPlayer(
  160.                New(FCPlayerP, Init(2, row, no, rt, name)));
  161.         'S' : FishGame.AddPlayer(
  162.                New(FSPlayerP, Init(2, row, no, rt, name)));
  163.       END;
  164.       Inc(row, 6);
  165.     END; 
  166.   WriteLn;
  167.   IF choices = 'D B C S' THEN
  168.     BEGIN
  169.       WriteLn('When it is your turn : ');
  170.       WriteLn;
  171.       WriteLn('Step 1 : Highlight another player using up/down');
  172.       WriteLn('         arrows and press ENTER to choose.  You');
  173.       WriteLn('         may press "?" first for a little help.');
  174.       WriteLn('Step 2 : Point to a card using right/left arrows');
  175.       WriteLn('         and press ENTER to choose.');
  176.       WriteLn;
  177.       WriteLn('Now press a key to begin the game.');
  178.       IF ReadKey = #0 THEN;
  179.     END;
  180.   IF NumPlay = 2 THEN FishGame.DealCards(7)
  181.   ELSE Fishgame.DealCards(5);
  182.   Fishgame.Display;
  183.   Fishgame.Play;
  184. END.