home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP-UTIL.ARK / ROLLEM.PAS < prev    next >
Pascal/Delphi Source File  |  1986-01-06  |  5KB  |  159 lines
  1. {-------------------------------}
  2. {            ROLLEM             }
  3. {                               }
  4. {  A dice game in Turbo Pascal  }
  5. {                               }
  6. {     by Jeff Duntemann         }
  7. {                               }
  8. {  Last modified: 12/4/84       }
  9. {-------------------------------}
  10.  
  11. PROGRAM ROLLEM;
  12.  
  13. CONST DICE_FACES : ARRAY[0..5,0..2] OF STRING[5] =
  14.                    (('     ','  o  ','     '),  { 1 }
  15.                     ('o    ','     ','    o'),  { 2 }
  16.                     ('    o','  o  ','o    '),  { 3 }
  17.                     ('o   o','     ','o   o'),  { 4 }
  18.                     ('o   o','  o  ','o   o'),  { 5 }
  19.                     ('o o o','     ','o o o')); { 6 }
  20.  
  21. TYPE GRAFREC = RECORD
  22.                  UL_CORNER,
  23.                  UR_CORNER,
  24.                  LL_CORNER,
  25.                  LR_CORNER,
  26.                  H_BAR,
  27.                  V_BAR,
  28.                  LINE_CROSS,
  29.                  T_DOWN,
  30.                  T_UP,
  31.                  T_RIGHT,
  32.                  T_LEFT     : STRING[4]
  33.                END;
  34.  
  35.      STRING80  = STRING[80];
  36.  
  37.  
  38. VAR GRAFCHARS : GRAFREC;
  39.     TOSS      : INTEGER;
  40.     BANNER    : STRING80;
  41.     DICE      : INTEGER;
  42.     DICE_X    : INTEGER;
  43.     I         : INTEGER;
  44.     CH        : CHAR;
  45.     QUIT      : BOOLEAN;
  46.  
  47.  
  48. PROCEDURE DEFINE_CHARS(VAR GRAFCHARS : GRAFREC);
  49.  
  50. BEGIN
  51.   WITH GRAFCHARS DO
  52.     BEGIN
  53.       UL_CORNER := CHR(201);
  54.       UR_CORNER := CHR(187);
  55.       LL_CORNER := CHR(200);
  56.       LR_CORNER := CHR(188);
  57.       H_BAR     := CHR(205);
  58.       V_BAR     := CHR(186);
  59.       LINE_CROSS := CHR(206);
  60.       T_DOWN     := CHR(203);
  61.       T_UP       := CHR(202);
  62.       T_RIGHT    := CHR(185);
  63.       T_LEFT     := CHR(204)
  64.     END
  65. END;
  66.  
  67.  
  68. PROCEDURE MAKE_BOX(X,Y,WIDTH,HEIGHT : INTEGER;
  69.                    GRAFCHARS        : GRAFREC);
  70.  
  71. VAR I,J : INTEGER;
  72.  
  73. BEGIN
  74.   IF X < 0 THEN X := (80-WIDTH) DIV 2;    { Negative X centers box }
  75.   WITH GRAFCHARS DO
  76.     BEGIN                                 { Draw top line }
  77.       GOTOXY(X,Y); WRITE(UL_CORNER);
  78.       FOR I := 3 TO WIDTH DO WRITE(H_BAR);
  79.       WRITE(UR_CORNER);
  80.                                           { Draw bottom line }
  81.       GOTOXY(X,(Y+HEIGHT)-1); WRITE(LL_CORNER);
  82.       FOR I := 3 TO WIDTH DO WRITE(H_BAR);
  83.       WRITE(LR_CORNER);
  84.                                           { Draw sides }
  85.       FOR I := 1 TO HEIGHT-2 DO
  86.         BEGIN
  87.           GOTOXY(X,Y+I); WRITE(V_BAR);
  88.           GOTOXY((X+WIDTH)-1,Y+I); WRITE(V_BAR)
  89.         END
  90.     END
  91. END;
  92.  
  93.  
  94. PROCEDURE ROLL(X,Y            : INTEGER;
  95.                NUMBER_OF_DICE : INTEGER;
  96.                VAR TOSS       : INTEGER);
  97.  
  98. VAR I,J,THROW,X_OFFSET : INTEGER;
  99.  
  100. BEGIN
  101.   IF (NUMBER_OF_DICE * 9)+X >= 80 THEN      { Too many dice horizontally     }
  102.     NUMBER_OF_DICE := (80-X) DIV 9;         { will scramble the CRT display! }
  103.   FOR I := 1 TO NUMBER_OF_DICE DO
  104.     BEGIN
  105.       X_OFFSET := (I-1)*9;                  { Nine space offset for each die }
  106.       MAKE_BOX(X+X_OFFSET,Y,7,5,GRAFCHARS); { Draw a die }
  107.       THROW := RANDOM(6);                   { "Toss" it  }
  108.       FOR J := 0 TO 2 DO                    { and fill it with dots }
  109.         BEGIN
  110.           GOTOXY(X+1+X_OFFSET,Y+1+J);
  111.           WRITE(DICE_FACES[THROW,J])
  112.         END
  113.     END
  114.  END;
  115.  
  116.  
  117.  
  118. BEGIN
  119.   RANDOMIZE;                   { Seed the pseudorandom number generator }
  120.   CLRSCR;                      { Clear the entire screen }
  121.   QUIT := FALSE;               { Initialize the quit flag }
  122.   DEFINE_CHARS(GRAFCHARS);     { Go get box-draw characters for this machine }
  123.   BANNER := 'GONNA ROLL THE BONES!';
  124.   MAKE_BOX(-1,1,LENGTH(BANNER)+4,3,GRAFCHARS);         { Draw banner box }
  125.   GOTOXY((80-LENGTH(BANNER)) DIV 2,2); WRITE(BANNER);  { Put banner in it }
  126.   REPEAT
  127.     REPEAT
  128.       FOR I := 6 TO 18 DO                 { Clear the game portion of screen }
  129.         BEGIN
  130.           GOTOXY(1,I);
  131.           CLREOL
  132.         END;
  133.       GOTOXY(1,6);
  134.       WRITE('>>How many dice will we roll this game? (1-5, or 0 to exit): ');
  135.       READLN(DICE);
  136.       IF DICE = 0 THEN QUIT := TRUE ELSE  { Zero dice sets quit flag }
  137.         IF (DICE < 1) OR (DICE > 5) THEN  { Show error for dice out of range }
  138.           BEGIN
  139.             GOTOXY(0,23);
  140.             WRITE('>>The legal range is 1-5 dice!')
  141.           END
  142.     UNTIL (DICE >= 0) AND (DICE <= 5);
  143.     GOTOXY(0,23); CLREOL;           { Get rid of any leftover error messages }
  144.     IF NOT QUIT THEN                { Play the game! }
  145.       BEGIN
  146.         DICE_X := (80-(9*DICE)) DIV 2;   { Calculate centered X for dice }
  147.         REPEAT
  148.           GOTOXY(1,16); CLREOL;
  149.           ROLL(DICE_X,9,DICE,TOSS);                      { Roll & draw dice }
  150.           GOTOXY(1,16); WRITE('>>Roll again? (Y/N): ');
  151.           READLN(CH);
  152.         UNTIL NOT (CH IN ['Y','y']);
  153.         GOTOXY(1,18); WRITE('>>Play another game? (Y/N): ');
  154.         READLN(CH);
  155.         IF NOT (CH IN ['Y','y']) THEN QUIT := TRUE
  156.       END
  157.   UNTIL QUIT      { Quit flag set ends the game }
  158. END.
  159.