home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols200 / vol243 / chips1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-07-13  |  8.9 KB  |  245 lines
  1. { PROGRAM AUTHOR: Mark Aldon Weiss   PROGRAM DONATED TO PUBLIC DOMAIN }
  2. { This file should not be compiled; instead, compile CHIPS2.Pas which }
  3. { uses this file (Chips1.pas) as an include file.                     }
  4.  
  5. CONST
  6.  
  7. allotment        = 300;
  8. LowerSuggestion  =   5;
  9. UpperSuggestion  = 150;
  10. list1size        =  15;
  11. list2size        =   4;
  12. list3size        =   3;
  13. PriceChip        =   3;
  14. MinBalance       =  10;
  15.  
  16. AlphaTravelCost  =  10;
  17.  
  18. ScoreForNewChip  =   5;
  19. ScoreForOldChip  =   1;
  20. ScoreForComplete = 100;
  21.  
  22. Arrival1Score    =  20;
  23. Arrival2Score    =  10;
  24. Arrival3Score    =   5;
  25. NthArrivalScore  =   2;
  26.  
  27. BetaArrivalScore =  15;
  28. GamaArrivalScore =  35;
  29.  
  30. WarnPenaltyMult  =   2;
  31. Bal2AwardMult    =   6;
  32. MoneyToPointCon  =   4;
  33.  
  34. IniRankIncFrac   = 2.1;
  35. SubRankIncFrac   = 2.6;
  36.  
  37.  
  38.  
  39.  
  40. TYPE
  41.  
  42. Flag1Array = Array[1..List1Size] of Boolean;  Count1Array = Array[1..List1Size] of Byte;
  43. Flag2Array = Array[1..List2Size] of Boolean;  Count2Array = Array[1..List2Size] of Byte;
  44. Flag3Array = Array[1..List3Size] of Boolean;  Count3Array = Array[1..List3Size] of Byte;
  45.  
  46.  
  47.  
  48.  
  49. VAR
  50.  
  51. i,score,TripMoney,MoneyLeft,balance1,balance2: Integer;
  52.  
  53. NumRequested,NewNumRequested,WarnCount,AlphaCount,WholeTripCount: Integer;
  54.  
  55. NumAlphaGot,OldNumAlphaGot,rank: Integer;
  56.  
  57. ReadRules,quit,again: Char;
  58.  
  59. OKamount,CompleteSet,GoingHome: Boolean;
  60.  
  61. f: Flag1Array;  g: Flag2Array;  h: Flag3Array;
  62.  
  63. fcount: Count1Array;  gcount: Count2Array;  hcount: Count3Array;
  64.  
  65. FileName: String[12];  ChipsLog: Text;
  66.  
  67.  
  68.  
  69.  
  70. PROCEDURE  RULES(rank: integer);
  71.  
  72. Begin  {RULES}
  73. Writeln;
  74. Writeln('The scoring and other rules are given below; you will be given your score');
  75. Writeln('only after the completion of a trip.  ');
  76. Writeln;
  77. Writeln('For each new chip you will get ',ScoreForNewChip,' points.');
  78. Write('For each old chip you will get ',ScoreForOldChip);
  79. IF ScoreForOldChip = 1 THEN Writeln(' point.') ELSE Writeln('points.');
  80. Writeln;
  81. Writeln('For arriving at Alpha you will get the following number of points:');
  82. Writeln;
  83. Write('1st time ---> ',Arrival1Score,'   2nd time ---> ',Arrival2Score,'   3rd time ---> ',Arrival3Score);
  84. Writeln('   subsequent times ---> ',NthArrivalScore);
  85. Writeln;
  86. Writeln('For arriving at Beta you will get  ',BetaArrivalScore,' points each time.');
  87. Writeln;
  88. Writeln('For arriving at Gamma you will get ',GamaArrivalScore,' points each time.');
  89. Writeln;
  90. Writeln('If you obtain a complete set of Alpha chips you will be told so and also be');
  91. Writeln('awarded a bonus of ',ScoreForComplete,' points.');
  92. Writeln;
  93. Write('There are more rules; when you''re ready to read them, hit return.  ',#7);
  94. Readln(ReadRules);
  95. Writeln;
  96. Writeln('You may end your trip and go home.  To do this, answer zero (type 0) when');
  97. Writeln('asked for how many chips you want.  You will then be asked if you want to');
  98. Writeln('go home.  Any money you have left will be converted to points at the rate');
  99. Writeln('of ',MoneyToPointCon,' dollars per point.');
  100. Writeln;
  101. Writeln('I M P O R T A N T :    If you request too many chips you will be warned about');
  102. Writeln('it.  "too many" does not neccessarily mean that you don''t have the money');
  103. Writeln('that it would cost to buy the chips.  "too many" just means that you would');
  104. Writeln('be left with less money than a certain minimum amount if permitted to pur-');
  105. Writeln('chase the number of chips you requested.  RECEIVING A WARNING SUBTRACTS');
  106. Writeln('POINTS FROM YOUR SCORE ACCORDING TO THE FORMULA:  (n-1) x ',WarnPenaltyMult);
  107. Writeln('where n is the number of warnings you''ve gotten during the current trip.');
  108. Writeln(#7);
  109. Write('Good Luck ');
  110. CASE rank OF
  111.             0: Writeln('Space Cadet!');
  112.             1: Writeln('Space Captain!');
  113.             2: Writeln('Space Avenger!')
  114. End;  {of CASE}
  115. Writeln;  Writeln
  116. End;   {RULES}
  117.  
  118.  
  119.  
  120. PROCEDURE  INITIALIZE;
  121.  
  122. Begin  {INITIALIZE}
  123.       OKamount := FALSE;
  124.      GoingHome := FALSE;
  125.    CompleteSet := FALSE;
  126.      WarnCount := 0;
  127.     AlphaCount := 0;
  128.          score := 0;
  129.    NumAlphaGot := 0;
  130. FOR i := 1 TO List1Size DO  Begin   f[i] := FALSE;  fcount[i] := 0   End;
  131. FOR i := 1 TO List2Size DO  Begin   g[i] := FALSE;  gcount[i] := 0   End;
  132. FOR i := 1 TO List3Size DO  Begin   h[i] := FALSE;  hcount[i] := 0   End
  133. End;   {INITIALIZE}
  134.  
  135.  
  136.  
  137.  
  138. PROCEDURE  LIST1(WhichOne: integer);
  139.  
  140. Begin  {LIST1}
  141. IF f[WhichOne] THEN score := score + ScoreForOldChip ELSE score := score + ScoreForNewChip;
  142. f[WhichOne] := TRUE;
  143. fcount[WhichOne] := fcount[WhichOne] + 1;
  144. CASE  fcount[WhichOne]  OF
  145.                           1: Writeln('You have obtained chip Alpha-',WhichOne,'.');
  146.                           2: Writeln('You now have a second  Alpha-',WhichOne,' chip.');
  147.                           3: Writeln('This gives you a third Alpha-',WhichOne,' chip.');
  148.                        ELSE  Writeln('You now have ',fcount[WhichOne],' Alpha-',WhichOne,' chips.');
  149.                        End;  {of CASE}
  150. CASE  fcount[WhichOne]  OF
  151.                           1: Writeln(ChipsLog,'You have obtained chip Alpha-',WhichOne,'.');
  152.                           2: Writeln(ChipsLog,'You now have a second  Alpha-',WhichOne,' chip.');
  153.                           3: Writeln(ChipsLog,'This gives you a third Alpha-',WhichOne,' chip.');
  154.                        ELSE  Writeln(ChipsLog,'You now have ',fcount[WhichOne],' Alpha-',WhichOne,' chips.');
  155.                        End;  {of CASE}
  156. End;   {LIST1}
  157.  
  158.  
  159.  
  160.  
  161. PROCEDURE  LIST2(WhichOne: integer);
  162.  
  163. Begin  {LIST2}
  164. IF g[WhichOne] THEN score := score + ScoreForOldChip ELSE score := score + ScoreForNewChip;
  165. g[WhichOne] := TRUE;
  166. gcount[WhichOne] := gcount[WhichOne] + 1;
  167. CASE  gcount[WhichOne]  OF
  168.                           1: Writeln('You have obtained chip Beta-',WhichOne,'.');
  169.                           2: Writeln('You now have a second  Beta-',WhichOne,' chip.');
  170.                           3: Writeln('This gives you a third Beta-',WhichOne,' chip.');
  171.                        ELSE  Writeln('You now have ',gcount[WhichOne],' Beta-',WhichOne,' chips.');
  172.                        End;  {of CASE}
  173. CASE  gcount[WhichOne]  OF
  174.                           1: Writeln(ChipsLog,'You have obtained chip Beta-',WhichOne,'.');
  175.                           2: Writeln(ChipsLog,'You now have a second  Beta-',WhichOne,' chip.');
  176.                           3: Writeln(ChipsLog,'This gives you a third Beta-',WhichOne,' chip.');
  177.                        ELSE  Writeln(ChipsLog,'You now have ',gcount[WhichOne],' Beta-',WhichOne,' chips.');
  178.                        End;  {of CASE}
  179. End;   {LIST2}
  180.  
  181.  
  182.  
  183.  
  184. PROCEDURE  LIST3(WhichOne: integer);
  185.  
  186. Begin  {LIST3}
  187. IF h[WhichOne] THEN score := score + ScoreForOldChip ELSE score := score + ScoreForNewChip;
  188. h[WhichOne] := TRUE;
  189. hcount[WhichOne] := hcount[WhichOne] + 1;
  190. CASE  hcount[WhichOne]  OF
  191.                           1: Writeln('You have obtained chip Gamma-',WhichOne,'.');
  192.                           2: Writeln('You now have a second  Gamma-',WhichOne,' chip.');
  193.                           3: Writeln('This gives you a third Gamma-',WhichOne,' chip.');
  194.                        ELSE  Writeln('You now have ',hcount[WhichOne],' Gamma-',WhichOne,' chips.');
  195.                        End;  {of CASE}
  196. CASE  hcount[WhichOne]  OF
  197.                           1: Writeln(ChipsLog,'You have obtained chip Gamma-',WhichOne,'.');
  198.                           2: Writeln(ChipsLog,'You now have a second  Gamma-',WhichOne,' chip.');
  199.                           3: Writeln(ChipsLog,'This gives you a third Gamma-',WhichOne,' chip.');
  200.                        ELSE  Writeln(ChipsLog,'You now have ',hcount[WhichOne],' Gamma-',WhichOne,' chips.');
  201.                        End;  {of CASE}
  202. End;   {LIST3}
  203.  
  204.  
  205.  
  206.  
  207. FUNCTION  ProbComplete(NumInCollection,NumTook: integer): REAL;
  208.  
  209. Var
  210.  
  211. k,SumIndex,sign,bigger,smaller: Integer;
  212.  
  213. ratio,CombCoeff,PowerFactor,PartProb: Real;
  214.  
  215. Begin  {ProbComplete}
  216. PartProb := 0;
  217. IF NumTook <  NumInCollection THEN ProbComplete := 0;
  218. IF NumTook >= NumInCollection THEN
  219.    Begin
  220.    FOR SumIndex := 1 TO (NumInCollection-1) DO
  221.        Begin
  222.        If (SumIndex MOD 2 = 0) Then sign := -1 Else sign := 1;
  223.        If ( SumIndex < (NumInCollection - SumIndex) ) THEN
  224.           begin
  225.           smaller := SumIndex;   bigger := NumInCollection - SumIndex
  226.           end
  227.        Else
  228.           begin
  229.           smaller := NumInCollection - SumIndex;   bigger := SumIndex
  230.           end;
  231.        IF  bigger = NumInCollection THEN CombCoeff := 1;
  232.        IF bigger <> NumInCollection THEN
  233.           Begin
  234.           CombCoeff := 1;
  235.           For k := 1 to smaller Do CombCoeff := CombCoeff * ( (NumInCollection - k + 1) / k )   {See Numerical Math Book}
  236.           End;
  237.        ratio := (NumInCollection - SumIndex) / NumInCollection;
  238.        PowerFactor := ratio;
  239.        For i := 1 To ( NumTook - 1 ) Do  PowerFactor := PowerFactor * ratio;
  240.        PartProb := PartProb + ( sign * CombCoeff * PowerFactor)
  241.        End;
  242.        ProbComplete := 1 - PartProb
  243.    End
  244. End;   {ProbComplete}
  245.