24
May
12

Num Drop Pascal source code

This is a pascal version of one of the very first gwbasic games I ever made. I’ve made improvements over the original but it is still pretty true to what it was. It should be pretty simple to compile as it only requires the dos and crt units to function. Source code follows…


{Numdrop A.Danson 1997}
{ modified in 2012: A J Danson
  corrected indenting
  added comments
  changed to better timer (to be similar to gwbasic version)
  changed scoring and levels.
}

program Numd;

uses crt,dos;

var
   map			: array[1..11,1..20] of integer; {the game map.}
   currentx,currenty	: integer; { the current pieces location }
   currentp,i,c		: integer; { the current piece and some general purpose variables}
   key			: char;    { the last keypress }
   score,oldscore,level	: integer; { current score, what the score was last cycle, and the level }
   quit,en		: boolean; { quit : has the user quit the game en: is the current game over }
   gap			: single; { the gap in seconds between the movements. }
   nextm		: single; { The time the next movement should happen at }

{ Gets the time in the same way that gwbasic timer function works }
function timer:single;
var result			: single;
   Hour, Minute, Second, Sec100	: word;
begin	   
   result:=0;
   GetTime(Hour, Minute, Second, Sec100);
   minute:=minute + (hour*60);
   second:=second + (minute*60);
   result:=second + (sec100 / 100);
   timer:=result;
end;

{ Initialise everything }
procedure init;
begin
   oldscore:=0;
   quit:=false;
   en:=false;
   i:=0;
   c:=0;
   randomize;
   while i0 then
   begin
      if mpcurrentp then
   begin
      if currenty=2 then en:=true;
      map[currentx,currenty]:=currentp;
      textcolor(currentp);
      gotoxy(currentx,currenty);
      write(chr(178));
      currenty:=1;
      currentx:=5;
      currentp:=random(15)+1;
   end;
   textcolor(currentp);
   gotoxy(currentx,currenty);
   write(chr(178));
end;

{ Move to bottom }
procedure moveToBottom;
begin
   while (currenty>1) do moveDown;
end;

{ displays the basics on screen for gameplay }
procedure initdisplay;
begin
   window(34,3,54,10);
   textcolor(blue);
   textbackground(brown);
   clrscr;
   writeln('Score ',score);
   writeln('Level ',level);
   writeln('Keys');
   writeln('j = left');
   writeln('l = right');
   writeln('space = drop');
   writeln('q = quit');
   window(1,1,6,16);
   textbackground(black);
   clrscr;
   i:=0;
   while i1 then
   begin
      if map[currentx-1,currenty]=0 then currentx:=currentx-1;
   end;
   textcolor(currentp);
   gotoxy(currentx,currenty);
   write(chr(178));
end;

{ moves the piece right, called when the user presses the right key }
procedure right;
begin
   textcolor(black);
   gotoxy(currentx,currenty);
   write(chr(178));
   if currentx<10 then
   begin
      if map[currentx+1,currenty]=0 then currentx:=currentx+1;
   end;
   textcolor(currentp);
   gotoxy(currentx,currenty);
   write(chr(178));
end;

{ Asks the user if they want to play again }
procedure newgameq;
begin
   window(30,10,44,13);
   textbackground(green);
   textcolor(red);
   clrscr;
   write('Do you wish to play again?');
   while not keypressed do
   begin
   end;
   key:=readkey;
   if key='y' then
   begin
      init;
      initdisplay;
   end;
   if key='n' then quit:=true;
end;

{ redsiplays the score panel. }
procedure rescore;
begin
   window(34,3,54,10);
   textcolor(blue);
   textbackground(brown);
   clrscr;
   writeln('Score ',score);
   writeln('Level ',level);
   writeln('Keys');
   writeln('j = left');
   writeln('l = right');
   writeln('space = drop');
   writeln('q = quit');
   window(20,3,30,22);
   textbackground(black);
end;

{main program}
begin
   init;
   intro;
   initdisplay;
   while not quit do
   begin
      while not en do
      begin
	 while timer(level*level*100) then
	 begin
	    i:=0 ;
	    c:=0;
	    while i<20000 do
	    begin
	       i:=i+1;
	       sound(i);
	    end;
	    nosound;
	    score:=score+1;
	    level:=level+1;
	    gap:= gap * 0.8;
	 end;
	 if oldscore<score then
	 begin
	    oldscore:=score;
	    rescore;
	 end;
      end;
      newgameq;
   end;
   init;
   window(1,1,80,25);
   textbackground(black);
   textcolor(lightgray);
   clrscr
end.


Advertisements

0 Responses to “Num Drop Pascal source code”



  1. Leave a Comment

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s


Blogs I Follow

Enter your email address to follow this blog and receive notifications of new posts by email.


Mister G Kids

A daily comic about real stuff little kids say in school. By Matt Gajdoš

Random Battles: my life long level grind

completing every RPG, ever.

Gough's Tech Zone

Reversing the mindless enslavement of humans by technology.

Retrocosm's Vintage Computing, Tech & Scale RC Blog

Random mutterings on retro computing, old technology, some new, plus radio controlled scale modelling.

ancientelectronics

retro computing and gaming plus a little more

Retrocomputing with 90's SPARC

21st-Century computing, the hard way

lazygamereviews

MS-DOS game reviews, retro ramblings and more...

%d bloggers like this: