Umiestnenie súboru www.TrSek.com/cover/smejkal/greed.pas{ GREED.PAS Copyright (c) David Smejkal }
{ Graficka hra pri ktorej mate za ulohu zbierat kamene. }
{ Postupne sa zvysuje obtiaznost. }
{ Vyzaduje EGAVGA.OBJ a TRIP.CHR }
{ }
{ Datum:09.04.2005 http://www.trsek.com }
procedure loading;
begin
gd:=9; gm:=2; initgraph(gd,gm,'');
SetTextStyle(2,0,5); setcolor(green);
SetTextJustify(CenterText,CenterText);
OutTextXY(330,180,'LOADING, PLEASE WAIT...');
SetFillPattern(gray50,yellow);bar(250,215,400,223);
delay(2000);
for i:=250 to 400 do
begin
GetFillPattern(fpt);SetFillPattern(fpt,green); bar(250,215,i,223); delay(20);
end;
closegraph;
end;
procedure koniec;
begin
gd:=9;gm:=2;initgraph(gd,gm,'');setbkcolor(6);cleardevice;
SetTextStyle(10,0,1);setcolor(14);SetTextJustify(CenterText,CenterText);
OutTextXY(320,240,'This game was created for you by David!');
for i:=600 downto 1 do
begin
setcolor(2);circle(320,240,i);circle(321,241,i);circle(319,241,i);
if i=600 then putpixel(320,240,6);
if i<550 then
begin
setcolor(6);
circle(320,240,i+50);circle(321,241,i+50);circle(319,241,i+50);
end;
if i=100 then
begin
setcolor(14);putpixel(320,240,14);
for a:=0 to 98 do
begin
circle(320,240,a);circle(321,241,a);circle(319,241,a);delay(10)
end;
end;
delay(10);
end;
setcolor(6);
for i:=101 downto 1 do
begin
circle(320,240,i);circle(321,241,i);circle(319,241,i);
delay(10);putpixel(320,240,2);
end;
cleardevice;
SetTextStyle(10,0,1);setcolor(14);SetTextJustify(CenterText,CenterText);
OutTextXY(320,240,'Hope you enjoy it...');
delay(2000);closegraph;
end;
procedure pytliky;
begin
if (r1>bo2x-4) and (r1<bo2x+4) and (r2>bo2y-4) and (r2<bo2y+21) and (bo1=false) then
begin peniaze:=true;pe:=pe+1;bo1:=true;exi:=false end;
if (rr1>bo2x-4) and (rr1<bo2x+4) and (rr2>bo2y-4) and (rr2<bo2y+21) and (bo2=false) then
begin peniaze:=true;pe:=pe+1;bo2:=true;exi:=false end;
if (rrr1>bo2x-4) and (rrr1<bo2x+4) and (rrr2>bo2y-4) and (rrr2<bo2y+21) and (bo3=false) then
begin peniaze:=true;pe:=pe+1;bo3:=true;exi:=false end;
if bo1=false then
pytlik(r1,r2);
if bo2=false then
pytlik(rr1,rr2);
if bo3=false then
pytlik(rrr1,rrr2);
end;
procedure zly (p1,p2:integer);
begin
if (p1>bo2x-4) and (p1<bo2x+4) and (p2>bo2y-4) and (p2<bo2y+21) then
begin bo4:=true;exi:=false end;
end;
procedure mina (p1,p2:integer);
begin
setcolor(lightgray);
circle(p1,p2,4);
GetFillPattern(fpt);
SetFillPattern(fpt,lightgray);
floodfill(p1,p2+1,lightgray);
putpixel(p1,p2,red+blink);
setcolor(red+blink);
rectangle(p1-1,p2-1,p1+1,p2+1);
end;
procedure hra;
begin
bo1:=false;bo2:=false;bo3:=false;bo4:=false;
peniaze:=false;findway:=false;ex:=false;
gd:=9;gm:=2; initgraph(gd,gm,'k:\BP\BGI');
randomize;
r1:=random(580)+20;r2:=random(440)+20;
rr1:=random(580)+20;rr2:=random(440)+20;
rrr1:=random(580)+20;rrr2:=random(440)+20;
xx:=0;yy:=0;rr:=0;m:=20;pe:=0;
repeat
setbkcolor(brown);
cleardevice;
if (m mod 10=0) then
case random(3) of
0 :cas:=10;
1 :cas:=20;
2 :cas:=30;
end;
{generovanie suradnic pre miny}
if m=20 then cas:=20;
if (m mod cas=0) then
for i:=1 to 30 do
begin
repeat
m1[i]:=random(580)+20;m2[i]:=random(440)+20;
until (m1[i]<295) or (m1[i]>345) and (m2[i]<210) or (m2[i]>270);
end;
{vykreslenie a podmienky pytlikov}
pytliky;
{prachy}
if (peniaze=true) and (bo4=false) then
begin
if (pe=1) then
begin
SetTextStyle(1,0,1);setcolor(yellow);
SetTextJustify(CenterText,CenterText);
outtextxy(30,5,'100$');
end;
if (pe=2) then
begin
SetTextStyle(1,0,1);setcolor(yellow);
SetTextJustify(CenterText,CenterText);
outtextxy(30,5,'200$');
end;
if (pe=3) then
begin
SetTextStyle(1,0,1);setcolor(yellow);
SetTextJustify(CenterText,CenterText);
outtextxy(30,5,'300$');
end;
{povel ist domov}
if (pe=3) and (findway=false) then
begin
setcolor(yellow);
SetTextJustify(CenterText,CenterText);
cleardevice;outtextxy(30,5,'300$');
outtextxy(320,240,'Find way back to house.');
delay(3000);cleardevice;
outtextxy(30,5,'300$');
findway:=true;
end;
end;
{vykreslenie a podmienky min}
for i:=1 to 30 do
begin
mina(m1[i],m2[i]);zly(m1[i],m2[i]);
end;
{podmienky pre ukoncenie hry}
if bo4 then begin ex:=true;break; end;
if (peniaze) and (pe=3) and (bo2x>299) and (bo2x<341) and (bo2y>214) and (bo2y<266) then
begin ex:=true;break; end;
{domcek}
setcolor(white);
rectangle(300,215,340,265);
setcolor(red);
line(300,215,340,215);
line(300,215,320,190);
line(340,215,320,190);
GetFillPattern(fpt);
SetFillPattern(fpt,red);
floodfill(320,200,red);
{Carl}
setcolor(1);
bo2x:=320+xx; bo2y:=240+yy;
circle(bo2x,bo2y,5+rr);
GetFillPattern(fpt);
SetFillPattern(fpt,9);
floodfill(bo2x,bo2y,1);
putpixel(319+xx,239+yy,1);putpixel(321+xx,239+yy,1);
line(320+xx,245+yy,320+xx,255+yy);
line(320+xx,255+yy,316+xx,261+yy);
line(320+xx,255+yy,324+xx,261+yy);
line(320+xx,250+yy,316+xx,246+yy);
line(320+xx,250+yy,324+xx,246+yy);
{pohyb}
x:=readkey;
if (x='o') or (x='O') then rr:=rr+1;
if (x='p') or (x='P') then rr:=rr-1;
if (x='a') or (x='A') then xx:=xx-5;
if (x='d') or (x='D') then xx:=xx+5;
if (x='w') or (x='W') then yy:=yy-5;
if (x='x') or (x='X') then yy:=yy+5;
if (x='q') or (x='Q') then begin xx:=xx-5;yy:=yy-5;end;
if (x='e') or (x='E') then begin xx:=xx+5;yy:=yy-5;end;
if (x='z') or (x='y') or (x='Z') or (x='Y') then begin xx:=xx-5;yy:=yy+5;end;
if (x='c') or (x='C') then begin xx:=xx+5;yy:=yy+5;end;
if xx<-315 then xx:=-315;if xx>313 then xx:=313;
if yy<-235 then yy:=-235;if yy>210 then yy:=210;
m:=m+1;
until ex or (ord(x)=27);
end;
procedure exit;begin exi:=true end;
procedure menu;
begin
gd:=9;gm:=2; initgraph(gd,gm,'k:\BP\BGI');
SetTextStyle(2,0,10);setcolor(2);SetTextJustify(CenterText,CenterText);
OutTextXY(320,10,'GAME MENU');SetTextJustify(0,0);
SetTextStyle(2,0,4);
setcolor(14);
outtextxy(30,90,'1');outtextxy(30,100,'2');outtextxy(30,110,'0');
setcolor(2);
outtextxy(42,90,'- PLAY GAME');
outtextxy(42,100,'- INSTRUCTIONS');
outtextxy(42,110,'- EXIT');
n:=readkey;
case n of
'1','+' : begin hra;h:=1;if ord(x)=27 then h:=0; end;
'2','–' : begin
gd:=9;gm:=2; initgraph(gd,gm,'k:\BP\BGI');
SetTextStyle(2,0,10);setcolor(2);
SetTextJustify(CenterText,CenterText);
OutTextXY(320,10,'INSTRUCTIONS');
SetTextJustify(0,0);SetTextStyle(2,0,4);
outtextxy(30,70,'Your task is to collect money. To do that, move Carl (little man) by pressing these keys:');
setcolor(14);
outtextxy(30,90,'w');outtextxy(30,100,'x');
outtextxy(30,110,'a');outtextxy(30,120,'d');
outtextxy(30,130,'q');outtextxy(30,140,'e');
outtextxy(30,150,'z');outtextxy(30,160,'c');
setcolor(6);
outtextxy(42,90,'- up');outtextxy(42,100,'- down');
outtextxy(42,110,'- left');outtextxy(42,120,'- right');
outtextxy(42,130,'- up,left');outtextxy(42,140,'- up,right');
outtextxy(42,150,'- down,left');outtextxy(42,160,'- down,right');
setcolor(2);
outtextxy(30,180,'After all bags are collected return home. Beware of traps.');
outtextxy(369,180,'Follow these simple guide-lines and have fun.');
outtextxy(30,190,'[To return to game menu press any key.]');
n:=readkey;menu;
end;
'0','‚' : exit;
else menu;
end;
end;
begin
loading;menu;
repeat
if exi or (ord(x)=27) then break;
if bo4 then begin gameover;menu end
else begin victory;menu end;
until exi or (ord(x)=27);
if (h=1) then koniec;
end.