home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol9n04.zip / GOFISH.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-23  |  11KB  |  383 lines
  1. UNIT GoFish;
  2. (**********************)
  3. (**)   INTERFACE    (**)
  4. (**********************)
  5.  
  6. USES crt, cards, ListObj;
  7. TYPE
  8.   FPP = ^FPlayer;
  9.   FHPlayerP = ^FHumanPlayer;
  10.   FMPlayerP = ^FMachPlayer;
  11.   revealed = ARRAY[0..12] of boolean;
  12.  
  13.   FPlayer = OBJECT (player)
  14.     Score : byte;
  15.     Rev   : revealed;
  16.     CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
  17.                 iDire : direction; iName : string);
  18.     DESTRUCTOR done; virtual;
  19.     PROCEDURE ShowHand; virtual;
  20.     PROCEDURE HideHand; virtual;
  21.   {-- Above are overridden, below new for FISH player --}
  22.     PROCEDURE LineMsg(S:String);
  23.     PROCEDURE PointToMe; virtual; 
  24.     PROCEDURE UnPointMe; virtual; 
  25.     FUNCTION  GetScore : Word; 
  26.     PROCEDURE Tell(VAR RevWhat : revealed);
  27.     PROCEDURE SetRev(cvalu : byte; RevIt : boolean); virtual; 
  28.     PROCEDURE ChooseOpponent(opps : list; VAR P : FPP); virtual;
  29.     PROCEDURE ChooseCard(VAR Cval : word); virtual; 
  30.     PROCEDURE AskFor(P : FPP; num : byte); 
  31.     FUNCTION  HaveAny(num : byte) : boolean; virtual; 
  32.     PROCEDURE GiveTo(num : byte; P : FPP); 
  33.     PROCEDURE TakeTurn(opps : List; VAR same : boolean; 
  34.                        VAR numl : byte; dek : DeckP); virtual;
  35.  END;
  36.  
  37.   FHumanPlayer = OBJECT (FPlayer)
  38.     CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
  39.                     iDire : direction; iName : string);
  40.     DESTRUCTOR done; virtual;
  41.     PROCEDURE ShowHand; virtual;
  42.     PROCEDURE ChooseOpponent(opps : List; VAR P : FPP); virtual;
  43.     PROCEDURE ChooseCard(VAR Cval : word); virtual;
  44.   END;
  45.  
  46.   FMachPlayer = OBJECT (FPlayer)
  47.     CONSTRUCTOR Init(iX, iY : Word; iShow : decision;
  48.                      iDire : direction; iName : string);
  49.     DESTRUCTOR done; virtual;
  50.     PROCEDURE ChooseOpponent(opps : List; VAR P : FPP); virtual;
  51.     PROCEDURE ChooseCard(VAR Cval : word); virtual;
  52.   END;
  53.  
  54.   Fish = OBJECT (game)
  55.     NumLeft : Byte;
  56.     CONSTRUCTOR Init;
  57.     DESTRUCTOR done; virtual;
  58.     PROCEDURE Play; virtual;
  59.     PROCEDURE Display; virtual;
  60.   END;
  61.  
  62. (**********************)
  63. (**) IMPLEMENTATION (**)
  64. (**********************)
  65.  
  66. (*-methods for FPlayer-------*)
  67.  
  68.   CONSTRUCTOR FPlayer.Init(iX, iY : Word; iShow : decision;
  69.                               iDire : direction; iName : string); 
  70.   BEGIN
  71.     Player.Init(iX, iY, iShow, IDire, iName);
  72.     Score := 0; FillChar(Rev, SizeOf(Rev), false);
  73.   END;
  74.  
  75.   DESTRUCTOR FPlayer.done; BEGIN player.Done; END;
  76.  
  77.   PROCEDURE FPlayer.ShowHand;
  78.   BEGIN
  79.     WITH H^ DO BEGIN display; GotoXY(GetX, GetY+5); END;
  80.     Write(name, ' : ', score);
  81.   END;
  82.  
  83.   PROCEDURE FPlayer.HideHand; BEGIN H^.Hide; END;
  84.  
  85.   PROCEDURE FPlayer.LineMsg(S : String);
  86.   BEGIN
  87.     GotoXY(30, 25); ClrEOL;
  88.     Write(S);  Delay(3000);
  89.     GotoXY(30, 25); ClrEOL;
  90.   END;
  91.  
  92.   PROCEDURE FPlayer.PointToMe;
  93.   VAR ro : Byte;
  94.   BEGIN
  95.     FOR ro := (H^.GetY) TO (H^.GetY+4) DO
  96.       BEGIN GotoXY(pred(H^.GetX), ro); Write(#219); END;
  97.   END;
  98.  
  99.   PROCEDURE FPlayer.UnPointMe;
  100.   VAR ro : Byte;
  101.   BEGIN
  102.     FOR ro := (H^.GetY) TO (H^.GetY+4) DO
  103.       BEGIN GotoXY(pred(H^.GetX), ro); Write(' '); END;
  104.   END;
  105.  
  106.   FUNCTION FPlayer.GetScore : Word; BEGIN GetScore := Score; END;
  107.  
  108.   PROCEDURE FPlayer.Tell(VAR RevWhat : revealed); 
  109.   BEGIN RevWhat := Rev; END; 
  110.  
  111.   PROCEDURE FPlayer.SetRev(cvalu : byte; RevIt : boolean);
  112.   BEGIN Rev[cvalu] := RevIt; END;
  113.  
  114.   PROCEDURE FPlayer.ChooseOpponent(opps : List; VAR P : FPP);
  115.   BEGIN END;
  116.  
  117.   PROCEDURE FPlayer.ChooseCard(VAR Cval : word); BEGIN END;
  118.  
  119.   PROCEDURE FPlayer.AskFor(P : FPP; num : byte);
  120.   VAR S : String;
  121.   BEGIN
  122.     CASE random(4) OF
  123.       0 : S := 'gimme all your ';
  124.       1 : S := 'please give me your ';
  125.       2 : S := 'do you have some ';
  126.       3 : S := 'I want your ';
  127.     END;
  128.     LineMsg(name+' : "'+P^.GetName+', ' + S + pips[num]+'''s"');
  129.   END;
  130.  
  131.   FUNCTION FPlayer.HaveAny(num : byte) : boolean;
  132.   VAR C : CardP;
  133.   BEGIN
  134.     HaveAny := FALSE; C := H^.OnBot;
  135.     WHILE C <> NIL DO
  136.       BEGIN
  137.         IF C^.GetRank = num THEN HaveAny := true;
  138.         C := H^.NextCard(C);
  139.       END;
  140.   END;
  141.  
  142.   PROCEDURE FPlayer.GiveTo(num : byte; P : FPP);
  143.   VAR C, C1 : CardP;
  144.     N       : Byte;
  145.   BEGIN
  146.     N := 0; C := H^.OnBot;
  147.     HideHand;
  148.     WHILE C <> NIL DO
  149.       BEGIN
  150.         C1 := H^.NextCard(C);
  151.         IF C^.GetRank = num THEN
  152.           BEGIN H^.remove(C); P^.TakeCard(C); Inc(N); END;
  153.         C := C1;
  154.       END;
  155.     ShowHand;
  156.     LineMsg(Name+' gives '+P^.GetName+' '+char(N+ord('0'))+
  157.                 ' '+pips[num]+'''s');
  158.   END;
  159.  
  160.   PROCEDURE FPlayer.TakeTurn(opps : List; VAR same : boolean;
  161.                              VAR numl : byte; dek : DeckP);
  162.   VAR P : FPP;
  163.     cvalue : word;
  164.  
  165.     PROCEDURE CheckFour(num : byte);
  166.     VAR N : byte;
  167.       C, C1 : CardP;
  168.     BEGIN
  169.       C := H^.OnBot; N := 0;
  170.       WHILE C <> NIL DO
  171.         BEGIN
  172.           IF C^.GetRank = num THEN Inc(N);
  173.           C := H^.NextCard(C);
  174.         END;
  175.       IF N = 4 THEN
  176.         BEGIN
  177.           Fanfare;
  178.           LineMsg(name+' just matched off four '+pips[num]+'''s');
  179.           Inc(Score); dec(numl);
  180.           SetRev(num, false);
  181.           HideHand;
  182.           C := H^.OnBot;    {-- remove the matched set of 4 --}
  183.           WHILE C <> NIL DO
  184.             BEGIN
  185.               C1 := H^.NextCard(C);
  186.               IF C^.GetRank = num THEN
  187.                 BEGIN H^.remove(C); dispose(C, done); END;
  188.               C := C1;
  189.             END;
  190.           ShowHand;
  191.         END;
  192.     END;
  193.  
  194.   BEGIN
  195.     TextAttr := TextAttr OR $80;
  196.     ShowHand;
  197.     TextAttr := TextAttr AND $7F;
  198.     IF H^.Empty THEN
  199.       BEGIN
  200.         IF NOT Dek^.empty THEN
  201.           BEGIN
  202.             LineMsg(Name+' just draws a card.');
  203.             TakeCard(dek^.FromTop);
  204.             CValue := H^.OnTop^.GetRank;
  205.           END
  206.         ELSE LineMsg('Sorry, '+name+', no more cards.');
  207.       END
  208.     ELSE
  209.       BEGIN
  210.         ChooseOpponent(opps, P);
  211.         ChooseCard(CValue);
  212.         SetRev(cValue, true);
  213.         P^.SetRev(cValue, false);
  214.         AskFor(P, CValue);
  215.         IF P^.HaveAny(CValue) THEN
  216.           BEGIN
  217.             Happy;      same := true;
  218.             P^.GiveTo(CValue, @self);
  219.           END
  220.         ELSE
  221.           BEGIN
  222.             Sad;       same := false;
  223.             LineMsg(P^.GetName+' says "**** GO FISH ****"');
  224.             IF NOT Dek^.empty THEN
  225.               BEGIN
  226.                 TakeCard(Dek^.FromTop);
  227.                 CValue := H^.OnTop^.GetRank;
  228.               END;
  229.           END;
  230.       END;
  231.     ShowHand;
  232.     CheckFour(CValue);
  233.     IF H^.Empty THEN same := false;
  234.   END;
  235.  
  236. (*-methods for FHumanPlayer--*)
  237.  
  238.   CONSTRUCTOR FHumanPlayer.Init(iX, iY : Word; iShow : decision;
  239.                                 iDire : direction; iName : string);
  240.   BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); END;
  241.  
  242.   DESTRUCTOR FHumanPlayer.done; BEGIN FPlayer.done; END;
  243.  
  244.   PROCEDURE FHumanPlayer.ShowHand;
  245.   BEGIN H^.Sort(false); FPlayer.ShowHand; END;
  246.  
  247.   PROCEDURE FHumanPlayer.ChooseOpponent(opps : List; VAR P : FPP);
  248.   VAR ro : Byte;
  249.     CH   : char;
  250.  
  251.     PROCEDURE Remember;
  252.     VAR N   : Byte;
  253.       heRev : revealed;
  254.       S     : String;
  255.     BEGIN
  256.       P^.Tell(heRev); S := '';
  257.       FOR N := 0 to 12 DO IF heRev[N] THEN S := S + pips[N] + ' ';
  258.       IF S = '' THEN
  259.         LineMsg('You don''t know what '+P^.GetName+' has.')
  260.       ELSE LineMsg('You remember that '+P^.GetName+' has '+S);
  261.     END;
  262.  
  263.   BEGIN
  264.     P := FPP(FirsNotSelf(opps));
  265.     REPEAT
  266.       P^.PointToMe;
  267.       CH := ReadKey;
  268.       P^.UnPointMe;
  269.       CASE CH OF
  270.         #0 : CASE ReadKey OF
  271.                #$48 : {up} P := FPP(PrevNotSelf(opps, P));
  272.                #$50 : {down} P := FPP(NextNotSelf(opps, P));
  273.              END;
  274.         '?': Remember;
  275.       END;
  276.     UNTIL CH = #13;
  277.   END;
  278.  
  279.   PROCEDURE FHumanPlayer.ChooseCard(VAR Cval : word);
  280.   VAR CH : Char;
  281.     C    : CardP;
  282.   BEGIN
  283.     C := CardP(H^.OnBot);
  284.     REPEAT
  285.       H^.PointToCard(C, up);
  286.       CH := ReadKey;
  287.       H^.UnPointCard(C, up);
  288.       IF CH = #0 THEN
  289.         CASE ReadKey OF {left or right arrow}
  290.           #$4B : IF H^.PrevCard(C) <> NIL THEN C := H^.PrevCard(C);
  291.           #$4D : IF H^.NextCard(C) <> NIL THEN C := H^.NextCard(C);
  292.         END;
  293.     UNTIL CH = #13;
  294.     Cval := C^.GetRank;
  295.   END;
  296.  
  297. (*-methods for FMachPlayer---*)
  298.  
  299.   CONSTRUCTOR FMachPlayer.Init(iX, iY : Word; iShow : decision;
  300.                                iDire : direction; iName : string);
  301.   BEGIN FPlayer.Init(iX, iY, iShow, IDire, iName); END;
  302.  
  303.   DESTRUCTOR FMachPlayer.done; BEGIN FPlayer.done; END;
  304.  
  305.   PROCEDURE FMachPlayer.ChooseOpponent(opps : List; VAR P : FPP);
  306.   VAR N : byte;
  307.   BEGIN
  308.     P := FPP(FirsNotSelf(opps));
  309.     FOR N := 1 to random(6) DO P := FPP(NextNotSelf(opps, P));
  310.   END;
  311.  
  312.   PROCEDURE FMachPlayer.ChooseCard(VAR Cval : word);
  313.   VAR N : byte;
  314.     C   : CardP;
  315.   BEGIN
  316.     C := CardP(H^.OnBot);
  317.     FOR N := 1 to random(H^.NumInPile) DO C := H^.NextCard(C);
  318.     cval := C^.GetRank;
  319.   END;
  320.  
  321. (*-methods for Fish----------*)
  322.  
  323.   CONSTRUCTOR Fish.Init;
  324.   BEGIN
  325.     Game.Init($1F); NumLeft := 13;
  326.     New(D, Init(0, 0, $1F)); D^.Shuffle;
  327.   END;
  328.  
  329.   DESTRUCTOR Fish.done; BEGIN game.done; END;
  330.  
  331.   PROCEDURE Fish.Display;
  332.   VAR P : PlayerP;
  333.   BEGIN
  334.     TextAttr := TableColor;  ClrScr;
  335.     P := PlayerP(Players.Firs);
  336.     WHILE P <> NIL DO
  337.       BEGIN
  338.         P^.ShowHand;
  339.         P := PlayerP(players.next(P));
  340.       END;
  341.   END;
  342.  
  343.   PROCEDURE Fish.Play;
  344.   VAR same   : boolean;
  345.  
  346.     PROCEDURE SeeWhoWon;
  347.     VAR FP    : FPP;
  348.       Max, N  : Word;
  349.       S       : String;
  350.     BEGIN
  351.       Max := 0; S := ''; N := 0;
  352.       FP := FPP(players.Firs);
  353.       WHILE FP <> NIL DO
  354.         BEGIN
  355.           IF FP^.GetScore > Max THEN
  356.             BEGIN
  357.               Max := FP^.GetScore; S := FP^.GetName; N := 1;
  358.             END
  359.           ELSE IF FP^.GetScore = Max THEN
  360.             BEGIN
  361.               S := S+' & '+FP^.GetName; Inc(N);
  362.             END;
  363.           FP := FPP(Players.next(FP));
  364.         END;
  365.       GotoXY(1, 25);  ClrEOL;
  366.       Write(S,' got ',Max,' points:  ');
  367.       CASE N OF
  368.         1: Write('A WINNER!');
  369.         2: Write('a tie');
  370.         3: Write('a 3-way tie');
  371.       END;
  372.     END;
  373.  
  374.   BEGIN
  375.     IF WhoseTurn = NIL THEN Exit;
  376.     REPEAT
  377.       FPP(WhoseTurn)^.TakeTurn(players, same, NumLeft, D);
  378.       IF NOT same THEN WhoseTurn := FPP(players.NextCirc(WhoseTurn));
  379.     UNTIL NumLeft = 0;
  380.     SeeWhoWon;
  381.    END;
  382.  
  383. END.