MarbleRun

by Christopher Winward: L6 Age ~16

Introduction

This is our first example of a program inspired by an existing contribution to the site. Unlike MarbleDrop, it uses the CRT unit. This means that it will run in Lazarus without any changes. In order to run it in Delphi, you will need to download and include CRT files as described in the last section of our Graphics tutorial. The program offers you a choice of sizes of grid as well as a guess about the destination of the marble, then makes a considered comment about the accuracy of your guess. Christopher made effective use of this site in learning how to program in Pascal so impressively in just a few weeks.

The Program

```program MarbleRun;

//////////////////////////////////////////////////////////////
//                                                          //
//    {*****  COMMAND PROMPT MARBLE RUN PROGRAM  *****}     //
//          Written by Christopher Winward, Age 16          //
//                           2010                           //
//                                                          //
/////////////////////////////////////////////////////////////////////////////////
//                                                                             //
//     use this file except in compliance with the License, as described at    //
//                                                                             //
/////////////////////////////////////////////////////////////////////////////////

uses
Crt, Math;
const
DELAYTIME = 180;
var
MarbleRunning : Boolean = false; //Is the marble currently in motion or not?
MainLoop : Boolean = true; //Is the main loop running? Usually true.
BallXNum,BallRow,MAXRows,Rand, FinalX, ChoiceNum, Err, MissedBy : integer;
RowsInput, ChoiceInput : shortstring; //These will be short inputs, and won't
keyPress : char;                      //need much memory.

Procedure DrawTower(delay1:integer);
var
i,k,j,MaxStars:integer; //i and k are standard "looping" variables.
begin                 //MaxStars determines the maximum number of stars in a row.
CursorOff;
MaxStars := 1;
for i := 1 to MAXRows do //Stop drawing after we've reached the maximum number of rows
begin
GoToXY((MAXRows*2-(i))+10,i+4);//Go to the starting point of the line according
//to how many stars will be drawn.

for k := 1 to MaxStars+1 do//Draw however many stars are needed - in this case, the line number + 1
begin                      //excluding rows 0 and 1 (1 and 2)
write('. ');
delay(delay1);
end;
inc(MaxStars);             //Increase the number of MaxStars according to row.
end;

for k:=1 to MaxStars+1 do //If we're at the bottom row
begin
GoToXY((MaxRows*2-MaxRows+(k*2)-3)+10,MaxRows+5); //Find the correct position
write('. ');
delay(delay1);
end;

for j:=1 to 2 do
begin
for k:=1 to MaxStars do
begin
GoToXY((MaxRows*2-MaxRows+(k*2)-3)+10,MaxRows+5+j);
write('|');
if(j=2) then
write(k);
delay(delay1);
end;
GoToXY((MaxRows*2-MaxRows+(MaxStars*2)-1)+10,MaxRows+5+j);
write('|'); //Draw the last | no matter what.
delay(delay1);
end;
writeln;
end;

Procedure UpdateBall();
begin
CursorOff;
if ((BallRow>1)and(BallRow<MaxRows)) then //For rows 1 and 2, make the ball drop vertically down.
begin
rand := random(11);
case rand of
0..5: begin
BallXNum:=BallXNum+1;//Randomly drop either to the right
end;
6..10: begin
BallXNum:=BallXNum-1;                      //or the left
end;
end;
end;
if(BallRow>MaxRows+1) then
begin
MarbleRunning := false; //If at the bottom, stop updating the position
if(BallXNum>0) then FinalX:=(BallXNum div 2)+(MaxRows div 2)+(MaxRows mod 2)+1;
if(BallXNum<1) then FinalX:=(BallXNum div 2)+(MaxRows div 2)+1;
end; //Figure out the slot number it dropped into.
end;

Procedure DrawBall();
begin
CursorOff;
GoToXY(MAXRows*2+BallXNum+10,BallRow+4);
write('o'); //THIS IS THE BALL
end;

Procedure MarbleLoop();
begin
MarbleRunning:=true; //Show that the marble is in motion.
BallXNum:=0; //Set the X and Y of the ball to 0.
BallRow:=0;
repeat
clrscr; //Clear the screen so the ball doesn't appear to stay in the same place.
cursoroff;
DrawTower(0);  //Guess what this does.
UpdateBall();
DrawBall();   //I dare you.
cursoron;
inc(BallRow); //Increase the Ball's Y value.
delay(DELAYTIME);   //Give a 100 millisecond delay before it moves again.
until(MarbleRunning=false);
end;

Procedure PickNum();
begin
CursorOn;
repeat //Ask the player for a number slot
GoToXY(1,1);//Go to the top left
write('Pick a number from 1 to ',MaxRows+1,': ');
ClrEol; //Clears the rest of the line
readln(ChoiceInput);//Validating that a number was input, otherwise reloop
val(ChoiceInput,ChoiceNum,Err);
until (ChoiceNum < MaxRows+2) and (ChoiceNum > 0) and (Err=0);
//Don't accept the value until there is no error.
end;

Procedure CreateMarbleSign();
var
MarbleASCII : array[1..11] of string;
PressEnter : string;
count, count1 : integer;
begin
writeln;
CursorOff;
PressEnter := 'Press Enter to continue';
MarbleASCII[1]:= '     ## ##       #    ###   ###  #     #####  ';
MarbleASCII[2]:= '    #  #  #     # #   #  #  #  # #     #      ';
MarbleASCII[3]:= '   #   #   #   #####  ###   ###  #     ###    ';
MarbleASCII[4]:= '   #       #  #     # #  #  #  # #     #      ';
MarbleASCII[5]:= '   #       #  #     # #   # ###  ##### #####  ';
MarbleASCII[6]:= '                                              ';
MarbleASCII[7]:= '              ###   #   # #   #               ';
MarbleASCII[8]:= '              #  #  #   # ##  #               ';
MarbleASCII[9]:= '              ###   #   # # # #               ';
MarbleASCII[10]:='              #  #  #   # #  ##               ';
MarbleASCII[11]:='              #   #  ###  #   #               ';
for count := 1 to 11 do
begin
for count1 := 1 to length(MarbleASCII[count]) do
begin
write((MarbleASCII[count])[count1]);
delay(4);
end;
writeln;
end;
writeln;
delay(1000);
for count := 1 to length(PressEnter) do
begin
write(PressEnter[count]);
delay(6);
end;
CursorOn;
clrscr;
end;

procedure PickRows;
begin
repeat
GoToXY(1,1);  //Go to the top left of the screen
write('How many slots do you want your marble run to have? (3 to 9): ');
ClrEol; //Clears the rest of the current line
readln(RowsInput);//Validating that a number was input, otherwise reloop
val(RowsInput,MaxRows,Err);//Input the string RowsInput, outputting MaxRows
until (MaxRows>2) and (MaxRows < 10) and (Err=0);//Don't accept a value until
dec(MaxRows);                                    //there's no error
end;

begin {*****MAIN PROGRAM IS STARTING HERE*****}
CreateMarbleSign();
randomize; //Set the random seed to the current time
MaxRows := 6;
DrawTower(10);
writeln;
writeln;
writeln('This is what a 7 row marble run looks like.');
PickRows;
clrscr;
DrawTower(40); //Run the DrawTower function, so players can see what they're picking from
PickNum; //Run the PickNum function, asking what slot they want
(***Running the Marble Loop***)
MarbleLoop;
repeat
GoToXY(1,MaxRows+8); //Go to the 8th line down.
if(ChoiceNum = FinalX) then
begin
writeln('You chose the right slot, number #',ChoiceNum,'! You win!');
writeln;
end
else
begin
MissedBy:=ABS(FinalX-ChoiceNum);
case MissedBy of
1:     writeln('Ohh, so close! You were just a single slot off!');
2:     writeln('Great guess! Your choice of ',ChoiceNum,' was only 2 off!');
3..5:  writeln('I suppose it''s not a TERRIBLE guess of ',ChoiceNum,' - you were ',MissedBy,' off, though.');
6,7:   begin
writeln('Oh come on, you can surely do better than that!');
writeln('I mean, your guess of ',ChoiceNum,' was a whole ',MissedBy,' off!');
end;
8:     writeln('Your guess of ',ChoiceNum,' was just astoundingly poor. I mean, really. What would your mother think?');
end;
writeln;
end;
writeln('Play again? y/n/p');
writeln('(Press p to choose a new marble run size)');
case keyPress of
'y': begin
clrscr;
DrawTower(10);
BallXNum:=0;
BallRow:=0;
CursorOn;
PickNum;
MarbleLoop; //Reset the variables and restart.
end;
'n': begin halt; end; //Quit.
'p': begin
PickRows;
clrscr;
DrawTower(40);
CursorOn;
PickNum;
MarbleLoop;
end;
end;
//Keep asking for a y or n until one is given.
until (MainLoop=false);