Grafická hra pri ktorej máte za úlohu zbierať kamene

{ 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 }
 
program GREED_1;
uses crt,graph;
const
 Gray50 : FillPatternType = ($AA, $55, $AA, $55, $AA, $55, $AA, $55);
var
 gd,gm,r,rr,xx,yy,r1,rr1,rrr1,r2,rr2,rrr2,bo2x,bo2y,i,a,m,pe,cas,h: integer;
 bo1,bo2,bo3,bo4,peniaze,findway,ex,exi                           : boolean;
 x,n                                                              : char;
 fpt                                                              : FillPatternType;
 m1,m2                                                            : array [1..30] of integer;
 
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 pytlik(p1,p2:integer);
 begin
  setcolor(yellow);
  circle(p1,p2,10);
  GetFillPattern(fpt);
  SetFillPattern(fpt,yellow);
  floodfill(p1,p2,yellow);
  line(p1,p2-8,p1-8,p2-17);
  line(p1,p2-8,p1+8,p2-17);
  line(p1-8,p2-17,p1+8,p2-17);
  floodfill(p1,p2-16,yellow);
  SetTextStyle(1,0,1);setcolor(green);
  SetTextJustify(CenterText,CenterText);
  outtextxy(p1,p2-2,'$');
 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 victory;
 begin
  gd:=9;gm:=2; initgraph(gd,gm,'k:\BP\BGI');
  SetTextStyle(2,0,8);setcolor(yellow);setbkcolor(brown);
  SetTextJustify(CenterText,CenterText);
  outtextxy(320,240,'Mission accomplished!');
  delay(2000);cleardevice;
 end;
 
procedure gameover;
 begin
  gd:=9;gm:=2; initgraph(gd,gm,'k:\BP\BGI');
  SetTextStyle(2,0,8);setcolor(yellow);setbkcolor(brown);
  SetTextJustify(CenterText,CenterText);
  outtextxy(320,240,'BUM!');
  delay(2000);cleardevice;SetTextStyle(3,0,5);outtextxy(320,240,'GAME OVER');delay(2000);
 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.