home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CMPLTPAS.ZIP / ROLLEM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-07-15  |  3.8 KB  |  107 lines
  1. {--------------------------------------------------------------}
  2. {                           Rollem                             }
  3. {                                                              }
  4. {   A dice game to demonstrate random numbers and box draws    }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V5.0                }
  8. {                             Last update 7/14/88              }
  9. {                                                              }
  10. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  11. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  12. {--------------------------------------------------------------}
  13.  
  14. PROGRAM Rollem;
  15.  
  16. USES Crt,BoxStuff;
  17.  
  18. CONST
  19.   DiceFaces : ARRAY[0..5,0..2] OF STRING[5] =
  20.                    (('     ','  o  ','     '),  { 1 }
  21.                     ('o    ','     ','    o'),  { 2 }
  22.                     ('    o','  o  ','o    '),  { 3 }
  23.                     ('o   o','     ','o   o'),  { 4 }
  24.                     ('o   o','  o  ','o   o'),  { 5 }
  25.                     ('o o o','     ','o o o')); { 6 }
  26.  
  27.  
  28. TYPE
  29.   String80  = String[80];
  30.  
  31.  
  32. VAR
  33.   I,X,Y        : Integer;
  34.   Width,Height : Integer;
  35.   Quit         : Boolean;
  36.   Dice,Toss    : Integer;
  37.   DiceX        : Integer;
  38.   Ch           : Char;
  39.   Banner       : String80;
  40.  
  41.  
  42.  
  43. PROCEDURE Roll(X,Y          : Integer;
  44.                NumberOfDice : Integer;
  45.                VAR Toss     : Integer);
  46.  
  47. VAR I,J,Throw,XOffset : Integer;
  48.  
  49. BEGIN
  50.   IF (NumberOfDice * 9)+X >= 80 THEN      { Too many dice horizontally     }
  51.     NumberOfDice := (80-X) DIV 9;         { will scramble the CRT display! }
  52.   FOR I := 1 TO NumberOfDice DO
  53.     BEGIN
  54.       XOffset := (I-1)*9;                 { Nine space offset for each die }
  55.       MakeBox(X+XOffset,Y,7,5,GrafChars); { Draw a die }
  56.       Throw := Random(6);                 { "Toss" it  }
  57.       FOR J := 0 TO 2 DO                  { and fill it with dots }
  58.         BEGIN
  59.           GotoXY(X+1+XOffset,Y+1+J);
  60.           Write(DiceFaces[Throw,J])
  61.         END
  62.     END
  63.  END;
  64.  
  65.  
  66.  
  67. BEGIN
  68.   Randomize;                   { Seed the pseudorandom number generator }
  69.   ClrScr;                      { Clear the entire screen }
  70.   Quit := False;               { Initialize the quit flag }
  71.   Banner := 'GONNA Roll THE BONES!';
  72.   MakeBox(-1,1,Length(Banner)+4,3,GrafChars);          { Draw Banner box }
  73.   GotoXY((80-Length(Banner)) DIV 2,2); Write(Banner);  { Put Banner in it }
  74.   REPEAT
  75.     REPEAT
  76.       FOR I := 6 TO 18 DO      { Clear the game portion of screen }
  77.         BEGIN
  78.           GotoXY(1,I);
  79.           ClrEol
  80.         END;
  81.       GotoXY(1,6);
  82.       Write('>>How many dice will we Roll this game? (1-5, or 0 to exit): ');
  83.       Readln(Dice);
  84.       IF Dice = 0 THEN Quit := True ELSE  { Zero dice sets Quit flag }
  85.         IF (Dice < 1) OR (Dice > 5) THEN  { Show error for dice out of range }
  86.           BEGIN
  87.             GotoXY(0,23);
  88.             Write('>>The legal range is 1-5 Dice!')
  89.           END
  90.     UNTIL (Dice >= 0) AND (Dice <= 5);
  91.     GotoXY(0,23); ClrEol;       { Get rid of any leftover error messages }
  92.     IF NOT Quit THEN            { Play the game! }
  93.       BEGIN
  94.         DiceX := (80-(9*Dice)) DIV 2;   { Calculate centered X for dice }
  95.         REPEAT
  96.           GotoXY(1,16); ClrEol;
  97.           Roll(DiceX,9,Dice,Toss);                      { Roll & draw dice }
  98.           GotoXY(1,16); Write('>>Roll again? (Y/N): ');
  99.           Readln(Ch);
  100.         UNTIL NOT (Ch IN ['Y','y']);
  101.         GotoXY(1,18); Write('>>Play another game? (Y/N): ');
  102.         Readln(Ch);
  103.         IF NOT (Ch IN ['Y','y']) THEN Quit := True
  104.       END
  105.   UNTIL Quit      { Quit flag set ends the game }
  106. END.
  107.