home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol243 / chips2.pqs / CHIPS2.PAS
Pascal/Delphi Source File  |  1986-02-10  |  16KB  |  316 lines

  1. { PROGRAM AUTHOR: Mark Aldon Weiss  PROGRAM DONATED TO PUBLIC DOMAIN }
  2. { This file should be compiled; below is a compiler directive to use }
  3. { the include file, CHIPS1.Pas.                                      }
  4.  
  5. {$I CHIPS1.PAS}
  6.  
  7.  
  8.  
  9. BEGIN  { M A I N    P R O G R A M }
  10. Writeln;
  11. Writeln('This program is a game called "CHIPS."  The main idea is to do some detective');
  12. Writeln('work in order to discover the restrictions and algortihms of the game.  Most');
  13. Writeln('important of all is to EXPERIMENT--purposely trying all sorts of things.');
  14. Writeln;   Writeln;
  15. Writeln('* * * *  KEEP PAPER AND PENCIL HANDY  * * * * *');
  16. Writeln;
  17. Writeln('* * * *  EXPERIMENT AND NOTE RESULTS  * * * * *');
  18. Writeln;
  19. Writeln('* * * *  KEEP TRACK OF YOUR BALANCE   * * * * *');
  20. Writeln;   Writeln;
  21. Writeln('YOUR MISSION:  Collect all the computer chips you can--preferably different');
  22. Writeln('               ones.  Try to get a complete set of Alpha chips.  Your score');
  23. Writeln('               indicates the degree of success of your mission.');
  24. Writeln;
  25. Writeln('HINTS:  Try to EXPERIMENT to find out answers to such questions as:');
  26. Writeln('        1.)  How many alpha chips are there?');
  27. Writeln('        2.)  How much money can I take to start with?');
  28. Writeln('        3.)  What is the minimum balance I must have after purchasing chips?');
  29. Writeln('        & many others.');
  30. Writeln;
  31. again := 'y';     rank := 0;    OldNumAlphaGot := 0;    WholeTripCount :=0;
  32. WHILE again IN ['y','Y'] DO
  33.   Begin
  34.   INITIALIZE;
  35.   WholeTripCount := WholeTripCount + 1;
  36.   Write(#7,'Please give a name for a file to record this trip--->  ');
  37.   Readln(FileName);
  38.   ASSIGN(ChipsLog,FileName);
  39.   REWRITE(ChipsLog);
  40.   Writeln;
  41.   Writeln('You may print or display this file on the terminal after exiting this program.');
  42.   Writeln;
  43.   Writeln;
  44.   Write(#7,'Do you want to see the rules?   ');
  45.   Readln(ReadRules);
  46.   IF ReadRules IN ['y','Y'] THEN RULES(rank) ELSE
  47.      Begin
  48.      Writeln;
  49.      Write('OK, Good luck ');
  50.      CASE rank OF
  51.                  0: Writeln('Space Cadet!');
  52.                  1: Writeln('Space Captain!');
  53.               ELSE  Writeln('Space Avenger!');
  54.      End;  {of CASE}
  55.      Writeln;
  56.      End;
  57.   REPEAT
  58.      Writeln('How much money are you going to take with you (between ',LowerSuggestion);
  59.      Write('& ',UpperSuggestion,' is suggested)?     ');
  60.      Readln(TripMoney);
  61.      Writeln;
  62.      IF TripMoney < 0 THEN  Writeln('Negative money is nonsense!');
  63.      IF TripMoney = 0 THEN  Writeln('You must take at least 1 dollar.');
  64.      IF TripMoney > Allotment THEN  Writeln('I''m sorry, we can''t let you take that much money.');
  65.      IF (TripMoney > 0) AND (TripMoney <= Allotment) THEN
  66.         Begin
  67.         OKamount := TRUE;
  68.         MoneyLeft := TripMoney;
  69.         Writeln(ChipsLog,'BEGINNING BALANCE = ',MoneyLeft);
  70.         Writeln(ChipsLog);
  71.         End;
  72.      Writeln
  73.   UNTIL OKamount;
  74.   REPEAT  {until MoneyLeft = 0 or GoingHome}
  75.      IF MoneyLeft >= MinBalance THEN
  76.         Begin
  77.         Writeln;
  78.         AlphaCount := AlphaCount + 1;
  79.         CASE AlphaCount OF
  80.                               1:  score := score + Arrival1Score;
  81.                               2:  score := score + Arrival2Score;
  82.                               3:  score := score + Arrival3Score;
  83.                            ELSE   score := score + NthArrivalScore;
  84.         End;  {of CASE}
  85.         IF AlphaCount = 1 THEN Writeln('Welcome to Alpha!') ELSE
  86.                                    Writeln('You have visited Alpha ',AlphaCount,' times counting this one.');
  87.         IF AlphaCount = 1 THEN Writeln(ChipsLog,'Welcome to Alpha!')  ELSE  Begin  Writeln(ChipsLog);
  88.                                    Writeln(ChipsLog,'You have visited Alpha ',AlphaCount,' times counting this one.')  End;
  89.         MoneyLeft := MoneyLeft - AlphaTravelCost;
  90.         Writeln('It cost you ',AlphaTravelCost,' dollars to get here.');
  91.         Writeln(ChipsLog,'It cost you ',AlphaTravelCost,' dollars to get here.');
  92.         Writeln;  Writeln(ChipsLog);
  93.         REPEAT  {until NumRequested >= 0 and NumRequested <= List1Size}
  94.            Write('How many chips would you like (they are ',PriceChip,' dollars each)?  ');
  95.            Readln(NumRequested);
  96.            IF NumRequested >= 0 THEN IF NumRequested <> 1 THEN Writeln(ChipsLog,'[you asked for ',NumRequested,' chips.]');
  97.            IF NumRequested >= 0 THEN IF NumRequested = 1 THEN Writeln(ChipsLog,'[you asked for 1 chip.]');
  98.            IF NumRequested < 0 THEN Writeln('A negative number of chips is nonsense!');
  99.            IF NumRequested > List1Size THEN
  100.               Begin
  101.               Writeln('I''m sorry we don''t have that many chips.');
  102.               Writeln(ChipsLog,'I''m sorry we don''t have that many chips.')
  103.               End;
  104.            Writeln;  Writeln(ChipsLog)
  105.         UNTIL (NumRequested >= 0) AND (NumRequested <= List1Size);
  106.         Writeln;
  107.         IF NumRequested = 0 THEN
  108.            Begin
  109.            Write('Do you want to go home?   ');  Readln(quit);
  110.            Writeln;
  111.            IF quit IN ['y','Y'] THEN
  112.               Begin
  113.               GoingHome := TRUE;
  114.               Writeln(ChipsLog,'[you said you wanted to go home]')
  115.               End
  116.            End;
  117.         IF NumRequested > 0 THEN
  118.            Begin
  119.            balance1 := MoneyLeft - (NumRequested * PriceChip);
  120.            IF balance1 < MinBalance THEN
  121.               Begin
  122.               Writeln('I''m sorry, we feel that you cannot afford to spend that much money.  Please');
  123.               Writeln('reevaluate your situation and give us a new request.  If your new request is');
  124.               Writeln('again unsuitable, we will take the money that it would cost you but without');
  125.               Writeln('giving you the chips.');
  126.               Writeln(ChipsLog,'I''m sorry, we feel that you cannot afford to spend that much money.  Please');
  127.               Writeln(ChipsLog,'reevaluate your situation and give us a new request.  If your new request is');
  128.               Writeln(ChipsLog,'again unsuitable, we will take the money that it would cost you but without');
  129.               Writeln(ChipsLog,'giving you the chips.');
  130.               REPEAT  {until NewNumRequested >= 0 and <= list1size}
  131.                  Write('Now, how many chips do you want?  ');  Readln(NewNumRequested);
  132.                  Writeln;
  133.                  IF NewNumRequested >= 0 THEN
  134.                     Begin
  135.                     Writeln(ChipsLog);
  136.                     If NewNumRequested <> 1 Then Writeln(ChipsLog,'[you then asked for ',NewNumRequested,' chips.]');
  137.                     If NewNumRequested = 1 Then Writeln(ChipsLog,'[you then asked for 1 chip.]');
  138.                     End;
  139.                  IF NewNumRequested < 0 THEN  Writeln('A negative number of chips is nonsense!');
  140.                  IF NewNumRequested > List1Size THEN Writeln('I''m sorry, we don''t have that many chips.');
  141.                  Writeln;  Writeln(ChipsLog)
  142.               UNTIL (NewNumRequested >= 0) AND (NewNumRequested <= List1Size);
  143.               Writeln;  Writeln(ChipsLog);
  144.               WarnCount := WarnCount + 1;
  145.               score := score - (WarnCount-1) * WarnPenaltyMult;
  146.               IF NewNumRequested = 0 THEN
  147.                  Begin
  148.                  Write('Do you want to end this trip and go home?  ');
  149.                  Readln(quit);
  150.                  IF quit IN ['y','Y'] THEN
  151.                     Begin
  152.                     GoingHome := TRUE;
  153.                     Writeln(ChipsLog,'[you then said you wanted to go home.]');
  154.                     Writeln(ChipsLog)
  155.                     End
  156.                  End;
  157.               IF NewNumRequested > 0 THEN
  158.                  Begin
  159.                  balance2 := MoneyLeft - (NewNumRequested * PriceChip);
  160.                  IF balance2 < MinBalance THEN
  161.                     Begin
  162.                     Writeln('Welcome to Beta!');  Writeln(ChipsLog,'Welcome to Beta!');
  163.                     score := score + BetaArrivalScore;
  164.                     Writeln;  Writeln(ChipsLog);
  165.                     IF balance2 <= 0 THEN
  166.                        Begin
  167.                        MoneyLeft := 0;
  168.                        Writeln('It cost you nothing to get here.  Seeing that someone took all your');
  169.                        Writeln('money, we will give you one free chip.');
  170.                        Writeln;
  171.                        Writeln(ChipsLog,'It cost you nothing to get here.  Seeing that someone took all your');
  172.                        Writeln(ChipsLog,'money, we will give you one free chip.');
  173.                        Writeln(ChipsLog);
  174.                        LIST2( TRUNC(RANDOM*List2Size) + 1 )
  175.                        End
  176.                     ELSE
  177.                        Begin
  178.                        MoneyLeft := Bal2AwardMult * balance2 - PriceChip;
  179.                        Writeln('It cost you ',balance2,' dollars to get here.  We have taken that, but we are');
  180.                        Writeln('giving you ',MoneyLeft,' dollars so that you may continue your journey.');
  181.                        Writeln('Meanwhile here is a chip for you.');
  182.                        Writeln;
  183.                        Writeln(ChipsLog,'It cost you ',balance2,' dollars to get here.  We have taken that, but we are');
  184.                        Writeln(ChipsLog,'giving you ',MoneyLeft,' dollars so that you may continue your journey.');
  185.                        Writeln(ChipsLog,'Meanwhile here is a chip for you.');
  186.                        Writeln(ChipsLog);
  187.                        LIST2( TRUNC(RANDOM*List2Size) + 1 )
  188.                        End;
  189.                     Writeln;  Writeln(ChipsLog)
  190.                     End;
  191.                     IF balance2 >= MinBalance THEN
  192.                        Begin
  193.                        MoneyLeft := Balance2;
  194.                        FOR i := 1 TO NewNumRequested DO LIST1( TRUNC(RANDOM*List1Size) + 1)
  195.                        End
  196.                  End
  197.               End;
  198.            IF balance1 >= MinBalance THEN
  199.               Begin
  200.               MoneyLeft := balance1;
  201.               FOR i := 1 TO NumRequested DO LIST1( TRUNC(RANDOM*List1Size) + 1)
  202.               End
  203.            End
  204.         End;
  205.      IF (MoneyLeft < MinBalance) AND (MoneyLeft > 0) AND (NOT GoingHome) THEN
  206.         Begin
  207.         score := score + GamaArrivalScore;
  208.         Writeln;  Writeln(ChipsLog);
  209.         If MoneyLeft = 1 Then Writeln('Welcome to Gamma!  It cost you only 1 dollar to get here.')
  210.                          Else Writeln('Welcome to Gamma!  It cost you ',Moneyleft,' dollars to get here.');
  211.         Writeln;
  212.         If MoneyLeft = 1 Then Writeln(ChipsLog,'Welcome to Gamma!  It cost you only 1 dollar to get here.')
  213.                          Else Writeln(ChipsLog,'Welcome to Gamma!  It cost you ',Moneyleft,' dollars to get here.');
  214.         Writeln(ChipsLog);
  215.         MoneyLeft := 0;
  216.         Writeln('Here is a chip for you.');  Writeln(ChipsLog,'Here is a chip for you.');
  217.         Writeln;  Writeln(ChipsLog);
  218.         LIST3 ( TRUNC(RANDOM*List3Size) + 1 )
  219.         End
  220.   UNTIL (MoneyLeft = 0) OR (GoingHome);
  221.   Writeln;  Writeln;  Writeln(ChipsLog);  Writeln(ChipsLog);
  222.   FOR i := 1 TO List1Size DO NumAlphaGot := NumAlphaGot + fcount[i];
  223.   i := 0;  REPEAT  i := i + 1;  CompleteSet := f[i]  UNTIL (NOT CompleteSet) OR (i = List1Size);
  224.   IF CompleteSet THEN
  225.      Begin
  226.      score := score + ScoreForComplete;
  227.      Writeln(#7,'Congratulations, you have obtained a complete set of Alpha chips!!!');
  228.      Writeln('You are hereby awarded ',ScoreForComplete,' bonus points for your achievement.');
  229.      Writeln;
  230.      Writeln('For your information, the probability of obtaining the complete set was');
  231.      Writeln(ProbComplete(List1Size,NumAlphaGot),'.  This probability is based on the number');
  232.      Writeln('of Alpha chips you got (',NumAlphaGot,') and the number of different Alpha');
  233.      Writeln('chips in the collection.  Your score award, however, didn''t depend');
  234.      Writeln('on this probability.');
  235.      Writeln(ChipsLog,'Congratulations, you have obtained a complete set of Alpha chips!!!');
  236.      Writeln(ChipsLog,'You are hereby awarded ',ScoreForComplete,' bonus points for your achievement.');
  237.      Writeln(ChipsLog);
  238.      Writeln(ChipsLog,'For your information, the probability of obtaining the complete set was');
  239.      Writeln(ChipsLog,ProbComplete(List1Size,NumAlphaGot),'.  This probability is based on the number');
  240.      Writeln(ChipsLog,'of Alpha chips you got (',NumAlphaGot,') and the number of different Alpha');
  241.      Writeln(ChipsLog,'chips in the collection.  Your score award, however, didn''t depend');
  242.      Writeln(ChipsLog,'on this probability.')
  243.      End;
  244.   IF GoingHome THEN
  245.      Begin
  246.      score := score + (MoneyLeft DIV MoneyToPointCon);
  247.      Writeln;
  248.      Writeln('Since you ended your trip, you were entitled to convert any leftover');
  249.      Writeln('money to points at the rate of ',MoneyToPointCon,' dollars per point.');
  250.      Writeln('These points have been added to your socre.');
  251.      Writeln(ChipsLog);
  252.      Writeln(ChipsLog,'Since you ended your trip, you were entitled to convert any leftover');
  253.      Writeln(ChipsLog,'money to points at the rate of ',MoneyToPointCon,' dollars per point.');
  254.      Writeln(ChipsLog,'These points have been added to your socre.')
  255.      End;
  256.   Writeln;  Writeln(ChipsLog);
  257.   Writeln(#7,'* * * * *  YOUR SCORE FOR THE TRIP IS ',score,'  * * * * *');
  258.   Writeln(ChipsLog,'* * * * *  YOUR SCORE FOR THE TRIP IS ',score,'  * * * * *');
  259.   IF (WholeTripCount = 1) AND (NOT CompleteSet) AND ( NumAlphaGot >= TRUNC(IniRankIncFrac*List1Size) ) THEN
  260.      Begin
  261.      Writeln;
  262.      Writeln('You have collected enough chips to be promoted to Space Captain!');
  263.      Writeln(ChipsLog);
  264.      Writeln(ChipsLog,'You have collected enough chips to be promoted to Space Captain!');
  265.      rank := 1
  266.      End;
  267.   IF (rank < 2) AND (CompleteSet) THEN
  268.      Begin
  269.      Writeln;
  270.      Writeln('In addition to your score award, you have been promoted to Space Avenger');
  271.      Writeln('for having collected a complete set of Alpha chips.');
  272.      Writeln(ChipsLog);
  273.      Writeln(ChipsLog,'In addition to your score award, you have been promoted to Space Avenger');
  274.      Writeln(ChipsLog,'for having collected a complete set of Alpha chips.');
  275.      rank := 2
  276.      End;
  277.   IF (WholeTripCount > 1) AND (rank < 2) AND (NumAlphaGot > OldNumAlphaGot) AND (NOT CompleteSet)
  278.      AND ( NumAlphaGot > TRUNC(SubRankIncFrac*List1Size) ) THEN
  279.      Begin
  280.      rank := rank + 1;
  281.      Writeln;
  282.      Write('You have obtained a sufficient number of chips to be promoted to ');
  283.      CASE rank OF  1: Writeln('Space Captain!');  2: Writeln('Space Avenger!')  End;
  284.      Writeln(ChipsLog);
  285.      Write(ChipsLog,'You have obtained a sufficient number of chips to be promoted to ');
  286.      CASE rank OF  1: Writeln(ChipsLog,'Space Captain!');  2: Writeln(ChipsLog,'Space Avenger!')  End
  287.      End;
  288.   Writeln;  Writeln;  Writeln(ChipsLog);  Writeln(ChipsLog);
  289.   OldNumAlphaGot := NumAlphaGot;
  290.   IF NOT CompleteSet THEN
  291.      Begin
  292.      Writeln('For your information the probability of you obtaining the complete');
  293.      Write('set of Alpha chips was ');
  294.      IF NumAlphaGot < List1Size THEN  Writeln('zero.')  ELSE  Writeln(ProbComplete(List1Size,NumAlphaGot),'.');
  295.      Writeln('This probability is based on the number of Alpha chips you got (',NumAlphaGot,')');
  296.      Writeln('and the number of different Alpha chips in the collection.');
  297.      Writeln(ChipsLog,'For your information the probability of you obtaining the complete');
  298.      Write(ChipsLog,'set of Alpha chips was ');
  299.      IF NumAlphaGot < List1Size  THEN Writeln(ChipsLog,'zero.') ELSE Writeln(ChipsLog,ProbComplete(List1Size,NumAlphaGot));
  300.      Writeln(ChipsLog,'This probability is based on the number of Alpha chips you got (',NumAlphaGot,')');
  301.      Writeln(ChipsLog,'and the number of different Alpha chips in the collection.')
  302.      End;
  303.   Writeln;  Writeln;
  304.   CLOSE(ChipsLog);
  305.   Write('Would you like to take another trip?   ');  Readln(again);
  306.   Writeln
  307.   End;
  308. Writeln;
  309. Writeln('Goodbye!');
  310. Writeln
  311. END.   { M A I N    P R O G R A M }
  312.  
  313.  
  314.  
  315.  
  316.