Games Digger in pascal

Delphi & Pascal (èeská wiki)
Pøejít na: navigace, hledání
Category: KMP (Club of young programmers)
digger.pngAuthor: Pavol Rusiòák
Program: Digger.pas
File exe: Digger.exe

Games Digger in pascal. A really super game in the text mode.
{ DIGGER.PAS                                                        }
{                                                                   }
{ Author: Pavol Rusinak                                             }
{ Date  : 15.02.1997                           http://www.trsek.com }
 
program digger;
uses crt;
var ch:char;
    dig,dig2:string;
    s:longint;
    x,y,ax,ay,px,py,o,p,r,xp,yp,xprisera,yprisera:integer;
 
procedure hlina;
var a:integer;
begin
clrscr;
textcolor(6);for a:=1 to 1920 do write('Û');
end;
 
procedure kresli (x,y:integer;dig,dig2:string;ch:char);
begin
if ch='P' then begin gotoxy(x,y-1);write('    ');end;
if ch='H' then begin gotoxy(x,y+2);write('    ');end;
if ch='M' then begin gotoxy(x-1,y);write(' ');gotoxy(x-1,y+1);write(' ');end;
if ch='K' then begin gotoxy(x+4,y);write(' ');gotoxy(x+4,y+1);write(' ');end;
textcolor(10);gotoxy(x,y);write(dig);gotoxy(x,y+1);write(dig2);
end;
 
procedure demo;
begin
clrscr;textcolor(14);gotoxy(25,12);
write('ÛßßßÜ Û ÜßßßÜ ÜßßßÜ Ûßßßß ÛßßßÜ');gotoxy(25,13);
write('Û   Û Û Û  ÜÜ Û  ÜÜ Ûßßß  ÛÜÜÜß');gotoxy(25,14);
write('ÛÜÜÜß Û ßÜÜÜß ßÜÜÜß ÛÜÜÜÜ Û  ßÜ');gotoxy(36,20);
textcolor(4);write('Super hra!');
gotoxy(57,25);textcolor(10);write('Software by Pavol Rusn k');
repeat until keypressed;
end;
 
procedure diggerk(ax,ay:integer);
begin
gotoxy(ax,ay);textcolor(6);write('ÛÛÛÛÛ');textcolor(9);write('\');
gotoxy(ax,ay+1);textcolor(6);write('ÛÛÛÛÛÛ');textcolor(8);write('>');
gotoxy(ax,ay+2);write('o   o/');
end;
procedure panak(px,py:integer);
begin
gotoxy(px+1,py);textcolor(6);write(chr(2));
gotoxy(px,py+1);textcolor(6);write('Ä');textcolor(4);write('O');textcolor(6);write('Ä');
gotoxy(px,py+2);textcolor(9);write('/ \');
end;
 
procedure uvod;
begin
for o:=1 to 20 do
 begin
 panak(o,12);diggerk(20,12);delay(100);clrscr;
 end;
for p:=21 to 74 do
 begin
 diggerk(p,12);delay(100);sound(20);clrscr;
 end;
NOSOUND;
for r:=-2 to 25 do
 begin
 textcolor(14);
 if (r>0) and (r<26) then Begin gotoxy(25,r);write('Û     ÜÜÜ  ÜÛÜ Û  ÜÜÜ    ÜÜÜÜ  ÜÜÜ  Û');enD;
 if (r+1>0) and (r+1<26) then
                        Begin gotoxy(25,r+1);write('Û    ÛÜÜÜÛ  Û    ÛÜÜÜ   Û   Û Û   Û Û');enD;
 if (r+2>0) and (r+2<26) then
                        Begin gotoxy(25,r+2);write('ÛÜÜÜ ßÜÜÜ   Û    ÜÜÜß   ßÜÜÜÛ ßÜÜÜß Ü');enD;
 if (r+3>0) and (r+3<26) then
                        Begin gotoxy(50,r+3);write('ÜÜÜß');enD;
 if r=12 then delay(5000)
         else delay(100);
 clrscr;
 end;
end;
 
Procedure Beep;
begin
sound(200);
delay(150);
nosound;
end;
 
procedure napoklad;
 begin
 xp:=round(random(77)+3);
 yp:=round(random(23)+2);
 gotoxy(xp,yp);textcolor(15);write('Û');beep;s:=s+1000;
 end;
 
procedure score;
 begin
 gotoxy(1,25);textcolor(9);write('Sk¢re:',s);
 end;
 
begin {hlavny}
randomize;demo;uvod;
clrscr;hlina;x:=1;y:=1;xp:=4;yp:=2;dig:='ÛÛ\ ';dig2:='o o/';s:=900;ch:=' ';
 repeat
  if (x+3=xp) and (y+1=yp) then napoklad;
  textcolor(10);kresli(x,y,dig,dig2,ch);score;
  ch:=ReadKey;
  if (ch='H') and (y>1)  then begin y:=y-1;dig:='/\  ';dig2:='8ÛÛ ';end;
  if (ch='P') and (y<23) then begin y:=y+1;dig:=' ÛÛ8';dig2:='  \/';end;
  if (ch='M') and (x<77) then begin x:=x+1;dig:='ÛÛ\ ';dig2:='o o>';end;
  if (ch='K') and (x>1)  then begin x:=x-1;dig:=' /ÛÛ';dig2:='<o o';end;
  textcolor(0);kresli(x,y,dig,dig2,ch);s:=s-10;{prisera;}
 until ch=#27;
clrscr;
end.