home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
MADTRB21.ZIP
/
ROLLEM.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-02-19
|
5KB
|
159 lines
{-------------------------------}
{ ROLLEM }
{ }
{ A dice game in Turbo Pascal }
{ }
{ by Jeff Duntemann }
{ }
{ Last modified: 12/4/84 }
{-------------------------------}
PROGRAM ROLLEM;
CONST DICE_FACES : ARRAY[0..5,0..2] OF STRING[5] =
((' ',' o ',' '), { 1 }
('o ',' ',' o'), { 2 }
(' o',' o ','o '), { 3 }
('o o',' ','o o'), { 4 }
('o o',' o ','o o'), { 5 }
('o o o',' ','o o o')); { 6 }
TYPE GRAFREC = RECORD
UL_CORNER,
UR_CORNER,
LL_CORNER,
LR_CORNER,
H_BAR,
V_BAR,
LINE_CROSS,
T_DOWN,
T_UP,
T_RIGHT,
T_LEFT : STRING[4]
END;
STRING80 = STRING[80];
VAR GRAFCHARS : GRAFREC;
TOSS : INTEGER;
BANNER : STRING80;
DICE : INTEGER;
DICE_X : INTEGER;
I : INTEGER;
CH : CHAR;
QUIT : BOOLEAN;
PROCEDURE DEFINE_CHARS(VAR GRAFCHARS : GRAFREC);
BEGIN
WITH GRAFCHARS DO
BEGIN
UL_CORNER := CHR(201);
UR_CORNER := CHR(187);
LL_CORNER := CHR(200);
LR_CORNER := CHR(188);
H_BAR := CHR(205);
V_BAR := CHR(186);
LINE_CROSS := CHR(206);
T_DOWN := CHR(203);
T_UP := CHR(202);
T_RIGHT := CHR(185);
T_LEFT := CHR(204)
END
END;
PROCEDURE MAKE_BOX(X,Y,WIDTH,HEIGHT : INTEGER;
GRAFCHARS : GRAFREC);
VAR I,J : INTEGER;
BEGIN
IF X < 0 THEN X := (80-WIDTH) DIV 2; { Negative X centers box }
WITH GRAFCHARS DO
BEGIN { Draw top line }
GOTOXY(X,Y); WRITE(UL_CORNER);
FOR I := 3 TO WIDTH DO WRITE(H_BAR);
WRITE(UR_CORNER);
{ Draw bottom line }
GOTOXY(X,(Y+HEIGHT)-1); WRITE(LL_CORNER);
FOR I := 3 TO WIDTH DO WRITE(H_BAR);
WRITE(LR_CORNER);
{ Draw sides }
FOR I := 1 TO HEIGHT-2 DO
BEGIN
GOTOXY(X,Y+I); WRITE(V_BAR);
GOTOXY((X+WIDTH)-1,Y+I); WRITE(V_BAR)
END
END
END;
PROCEDURE ROLL(X,Y : INTEGER;
NUMBER_OF_DICE : INTEGER;
VAR TOSS : INTEGER);
VAR I,J,THROW,X_OFFSET : INTEGER;
BEGIN
IF (NUMBER_OF_DICE * 9)+X >= 80 THEN { Too many dice horizontally }
NUMBER_OF_DICE := (80-X) DIV 9; { will scramble the CRT display! }
FOR I := 1 TO NUMBER_OF_DICE DO
BEGIN
X_OFFSET := (I-1)*9; { Nine space offset for each die }
MAKE_BOX(X+X_OFFSET,Y,7,5,GRAFCHARS); { Draw a die }
THROW := RANDOM(6); { "Toss" it }
FOR J := 0 TO 2 DO { and fill it with dots }
BEGIN
GOTOXY(X+1+X_OFFSET,Y+1+J);
WRITE(DICE_FACES[THROW,J])
END
END
END;
BEGIN
RANDOMIZE; { Seed the pseudorandom number generator }
CLRSCR; { Clear the entire screen }
QUIT := FALSE; { Initialize the quit flag }
DEFINE_CHARS(GRAFCHARS); { Go get box-draw characters for this machine }
BANNER := 'GONNA ROLL THE BONES!';
MAKE_BOX(-1,1,LENGTH(BANNER)+4,3,GRAFCHARS); { Draw banner box }
GOTOXY((80-LENGTH(BANNER)) DIV 2,2); WRITE(BANNER); { Put banner in it }
REPEAT
REPEAT
FOR I := 6 TO 18 DO { Clear the game portion of screen }
BEGIN
GOTOXY(1,I);
CLREOL
END;
GOTOXY(1,6);
WRITE('>>How many dice will we roll this game? (1-5, or 0 to exit): ');
READLN(DICE);
IF DICE = 0 THEN QUIT := TRUE ELSE { Zero dice sets quit flag }
IF (DICE < 1) OR (DICE > 5) THEN { Show error for dice out of range }
BEGIN
GOTOXY(0,23);
WRITE('>>The legal range is 1-5 dice!')
END
UNTIL (DICE >= 0) AND (DICE <= 5);
GOTOXY(0,23); CLREOL; { Get rid of any leftover error messages }
IF NOT QUIT THEN { Play the game! }
BEGIN
DICE_X := (80-(9*DICE)) DIV 2; { Calculate centered X for dice }
REPEAT
GOTOXY(1,16); CLREOL;
ROLL(DICE_X,9,DICE,TOSS); { Roll & draw dice }
GOTOXY(1,16); WRITE('>>Roll again? (Y/N): ');
READLN(CH);
UNTIL NOT (CH IN ['Y','y']);
GOTOXY(1,18); WRITE('>>Play another game? (Y/N): ');
READLN(CH);
IF NOT (CH IN ['Y','y']) THEN QUIT := TRUE
END
UNTIL QUIT { Quit flag set ends the game }
END.