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                           //
//                                                          //
/////////////////////////////////////////////////////////////////////////////////
//                                                                             //
// Licensed under the Apache License, Version 2.0 (the "License"); you may not //
//     use this file except in compliance with the License, as described at    //
//     http://www.apache.org/licenses/ and http://www.pp4s.co.uk/licenses/     //
//                                                                             //
/////////////////////////////////////////////////////////////////////////////////

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;
  readln;
  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)');
   keyPress:=readkey;
    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);
  readln;
end.
 

Remarks

Can you think of a program like this that you could write?

Programming - a skill for life!

A-star, Calculator, MarbleRun and SpaceShooter by Christopher Winward