rafael
Administrator
Dołączył: 07 Lut 2006
Posty: 72
Przeczytał: 0 tematów
Ostrzeżeń: 0/3 Skąd: Pszczyna
|
Temat postu: Spider 2.0 |
|
|
GRA PRZYPOMINAJĄCA SNAKE'A, STERUJESZ PAJĄKIEM ZBIERAJĄC POROZRZUCANE PUNKTY. SWOJE SUGESTIE NA TEMAT PROGRAMU PISZCIE NA ADRES: rafael92@vp.pl
Kod: | program spider;
{$APPTYPE CONSOLE}
uses
crt;
type
Tpunkty = record
x: integer;
y: integer;
end;
Tsave = record
imie: string[20];
wynik: integer;
end;
var
znak: char;
x,y: integer;
imie: string;
punkty_razem: integer;
level: byte;
punkty: array[1..20] of Tpunkty;
szybkosc: integer;
razem: integer;
plik: file of Tsave;
stare_punkty: Tsave;
zycie: byte;
procedure sprawdzacz; forward;
procedure przegrana; forward;
procedure losuj_punkty;forward;
procedure rysuj;forward;
procedure newgame; forward;
procedure intro;
var
x,y: shortint;
begin
x := 25;
y := 10;
textcolor(white);
gotoxy(21,y); write(' #### ### ##### ### ##### #');
gotoxy(21,y+1);write(' # # # # # # # # #');
gotoxy(21,y+2);write(' #### ##### ### ##### ### #');
gotoxy(21,y+3);write(' # # # # # # # # #');
gotoxy(21,y+4);write(' # # # # # # # ##### #####');
delay(2000);
clrscr;
gotoxy(4,y); write(' #### #### ##### ##### #### #### ##### ### # # # ###');
gotoxy(4,y+1);write(' # # # # # # # # # # # # # # # # #');
gotoxy(4,y+2);write(' #### #### # ### # # ### # ##### # # # # #####');
gotoxy(4,y+3);write(' # # # # # # # # # # # # # # # # #');
gotoxy(4,y+4);write(' # # # ##### ##### #### #### # # # ### # # #');
delay(1000);
clrscr;
gotoxy(x,y); write(' #### #### # #### ##### ####');
gotoxy(x,y+1);write('# # # # # # # # #');
gotoxy(x,y+2);write(' ### #### # # # ### ####');
gotoxy(x,y+3);write(' # # # # # # # #');
gotoxy(x,y+4);write('#### # # #### ##### # #');
delay(2000);
clrscr;
end;
procedure sprawdz_wynik(imie: string; nowe_punkty: integer);
var
dane, bufor: Tsave;
begin
bufor.imie := imie;
bufor.wynik := nowe_punkty;
assign(plik,'dane.save');
reset(plik);
if filesize(plik) = 0 then
begin
seek(plik,1);
write(plik,bufor);
end;
seek(plik,1);
read(plik,dane);
if bufor.wynik > dane.wynik then
begin
seek(plik,1);
write(plik,bufor);
end;
seek(plik,1);
read(plik, stare_punkty);
close(plik);
end;
procedure rysuj;
var
i: integer;
begin
textcolor(white);
clrscr;
for i := 1 to 15 do
begin
gotoxy(i,1);
write ('-');
end;
for i := 1 to 20 do
begin
gotoxy(1,i);
write('|');
end;
for i := 1 to 15 do
begin
gotoxy(i,20);
write('-');
end;
for i := 1 to 20 do
begin
gotoxy(15,i);
write('|');
end;
gotoxy(1,22);
write ('ESC -> PAUZA || Q -> WYJSCIE');
gotoxy(40,16);
write('NAJLEPSZY WYNIK: ');
gotoxy(37,17);
write ('Imie: ',stare_punkty.imie,' Punkty: ',stare_punkty.wynik);
gotoxy(2,2);
write ('@');
losuj_punkty;
end;
procedure next_level;
begin
level := level + 1;
if level = 1 then
begin
szybkosc := 425;
zycie := 2;
end;
if level > 1 then
begin
szybkosc := szybkosc - 50;
razem := 0;
end;
rysuj;
end;
procedure odliczanie;
begin
gotoxy(40,9);
write (' ##### #### #');
gotoxy(40,10);
write ('# # # #');
gotoxy(40,11);
write ('# ### # # #');
gotoxy(40,12);
write ('# # # # #');
gotoxy(40,13);
write ('# # # #');
gotoxy(40,14);
write (' ##### #### #');
end;
procedure pauza;
begin
if znak = #27 then
begin
gotoxy(1,24);
writeln ('TRYB PAUZY; ABY WYLACZYC TEN TRYB WCISNIJ ESC');
repeat
znak := readkey;
until znak = #27;
end;
gotoxy(1,24);
clreol;
end;
procedure ruch_;
var
zasysacz: char;
begin
y := 2;
x := 2;
gotoxy(20,1);
write ('P U N K T Y: ',punkty_razem);
gotoxy(40,1);
write ('L E V E L: ',level);
gotoxy(60,1);
write ('Z Y C I A: ',zycie);
zasysacz := readkey;
repeat
znak := readkey;
pauza;
odliczanie;
if znak=#80 then
begin
repeat
y := y + 1;
gotoxy(x,y-1);
write (' ');
gotoxy(x,y);
write('@');
sound(100);
delay(szybkosc);
nosound;
sprawdzacz;
until keypressed;
end;
if znak=#72 then
begin
repeat
y := y - 1;
gotoxy(x,y+1);
write (' ');
gotoxy(x,y);
write('@');
sound(100);
delay(szybkosc);
nosound;
sprawdzacz;
until keypressed;
end;
if znak=#77 then
begin
repeat
x := x + 1;
gotoxy(x-1,y);
write (' ');
gotoxy(x,y);
write('@');
sound(100);
delay(szybkosc);
nosound;
sprawdzacz;
until keypressed;
end;
if znak=#75 then
begin
repeat
x := x - 1;
gotoxy(x+1,y);
write (' ');
gotoxy(x,y);
write('@');
sound(100);
delay(szybkosc);
nosound;
sprawdzacz;
until keypressed;
end;
until znak in ['Q','q'];
halt;
end;
procedure sprawdzacz;
var
e: integer;
begin
if znak in ['Q','q'] then halt;
if (y = 1) or (y = 20) or (x = 1) or (x = 15) then
begin
clrscr;
razem := 0;
zycie := zycie - 1;
if zycie = 0 then przegrana;
rysuj;
end;
for e := 1 to 10 do
begin
if (punkty[e].x = x) and (punkty[e].y = y) then
begin
punkty_razem := punkty_razem + 100;
punkty[e].x := 0;
punkty[e].y := 0;
razem := razem + 1;
gotoxy(20,1);
write ('P U N K T Y: ',punkty_razem);
end;
end;
if (punkty[11].x = x) and (punkty[11].y = y) then
begin
zycie := zycie + 1;
punkty[11].x := 0;
punkty[11].y := 0;
gotoxy(60,1);
write ('Z Y C I A: ',zycie);
end;
if razem = 10 then next_level;
end;
procedure przegrana;
var
m: integer;
begin
delay(1500);
m := 1;
repeat
clrscr;
m := m +1;
gotoxy(m,10);
textcolor(lightred);
writeln ('G A M E O V E R');
delay(100);
until m >= 60;
clrscr;
textcolor(white);
gotoxy(28,12);
writeln ('T W O J W Y N I K: ',punkty_razem);
if punkty_razem > stare_punkty.wynik then
begin
gotoxy(28,13);
write('PODAJ IMIE: ');
readln(imie);
end
else
readln;
sprawdz_wynik(imie, punkty_razem);
newgame;
end;
procedure losuj_punkty;
var
pos1, pos2, n, o: byte;
begin
randomize;
for n := 1 to 10 do
begin
pos1 := random (13)+2;
pos2 := random (18)+2;
punkty[n].x := pos1;
punkty[n].y := pos2;
gotoxy (pos1,pos2);
write ('*');
end;
o := random (5) + 1;
if o in [1,2] then
begin
pos1 := random (13) + 2;
pos2 := random (18) + 2;
punkty[11].x := pos1;
punkty[11].y := pos2;
gotoxy(pos1,pos2);
write ('$');
end;
ruch_;
end;
procedure newgame;
var
gra: char;
begin
clrscr;
gotoxy(28,12);
write ('N O W A G R A ??');
gotoxy(29,13);
write ('(T)ak / (N)ie: ');
gra := readkey;
if gra in ['N','n'] then halt
else
punkty_razem := 0;
razem := 0;
level := 0;
next_level;
end;
begin
intro;
sprawdz_wynik(imie, stare_punkty.wynik);
next_level;
rysuj;
losuj_punkty;
ruch_;
end. |
:arrow: Plik *.exe wraz z potrzebnymi plikami [link widoczny dla zalogowanych]
Post został pochwalony 0 razy
Ostatnio zmieniony przez rafael dnia Śro 18:28, 05 Kwi 2006, w całości zmieniany 6 razy
|
|