{ 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 (r1bo2y-4) and (r2bo2x-4) and (rr1bo2y-4) and (rr2bo2x-4) and (rrr1bo2y-4) and (rrr2bo2x-4) and (p1bo2y-4) and (p2345) 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.