A graphic shooting game
Delphi & Pascal (česká wiki)
Category: KMP (Club of young programmers)
Author: Ivan Dimov
Program: T-stynet.pas
File exe: T-stynet.exe
need: Egavga.bgi
Author: Ivan Dimov
Program: T-stynet.pas
File exe: T-stynet.exe
need: Egavga.bgi
A graphic shooting game.
{ T-STYNET.PAS } { } { Author: Ivan Dimov } { Date : 15.02.1997 http://www.trsek.com } program skynet_terminator; uses crt,dos,graph; var gr,gd,m,n,xm,ym,but,xp,yp,xb,yb,q,xa,ya:integer; ch:char; size:word; p,r:pointer; label 1; procedure sorry; begin settextstyle(3,0,3); setcolor(5); outtextxy(300,400,'SORRY JE TO IBA DEMO'); delay(1000); setfillstyle(1,0); bar(295,395,640,480); end; procedure menu; begin cleardevice; setcolor(blue); line(1,1,640,1); line(1,1,1,50); line(1,50,640,50); line(640,50,640,1); line(640,1,640,50); line(3,3,637,3); line(3,3,3,47); line(3,47,637,47); line(637,47,637,3); line(637,3,3,3); line(639,1,639,50); line(1,1,3,3); line(639,1,637,3); line(1,50,3,47); line(639,50,637,47); line(150,3,150,47); line(300,3,300,47); line(450,3,450,47); line(600,3,600,47); setfillstyle(1,6); {floodfill(4,5,blue);} setfillstyle(1,5); lowvideo; {floodfill(2,4,blue); floodfill(5,2,blue); floodfill(5,49,blue); floodfill(638,3,blue);} setfillstyle(1,6); floodfill(200,10,blue); floodfill(350,10,blue); floodfill(500,10,blue); floodfill(630,10,blue); setcolor(2); settextstyle(1,0,2); outtextxy(10,9,'START GAME'); outtextxy(160,9,'LOAD GAME'); outtextxy(310,9,'SAVE GAME'); outtextxy(480,9,'QUIT GAME'); randomize; { setcolor(random(15)); settextstyle(random(6),0,random(7)); outtextxy(random(344),random(200),'SkyNET');} end; function gminit:boolean; {zisti ovladac mysi} var reg:registers; begin reg.ax:=$0000; intr($33,reg); if reg.ax=$0000 then gminit:=false else gminit:=true; but:=reg.bx; end; procedure zobraz_mys; {Zobrazi mys} var reg:registers; begin reg.ax:=$0001; intr($33,reg); end; procedure skryj_mys; {Zobrazi mys} var reg:registers; begin reg.ax:=$0002; intr($33,reg); end; procedure test_mys(var x,y,but:integer); {Otestuje mys} var reg:registers; begin reg.ax:=$0003; intr($33,reg); x:=reg.cx; y:=reg.dx; but:=reg.bx; end; procedure demo1; begin cleardevice; settextstyle(3,0,7); m:=1; n:=1; repeat setcolor(red); outtextxy(m,n,'Dimov soft.'); delay(50); cleardevice; m:=m+20; n:=n+15; until (m>450); end; procedure vybuch; var a,b:integer; begin setcolor(red); for a:=1 to 15 do circle(xa,ya,a); end; procedure demo2; var m,n:integer; begin cleardevice; setcolor(7); outtextxy(220,200,'Programing Ivan Dimov'); delay(1200); cleardevice; end; procedure demo3; var p,r:pointer; size:word; a,b:integer; begin cleardevice; nosound; setcolor(13); settextstyle(3,0,8); outtextxy(100,100,'BETHESDA'); size:=imagesize(90,100,470,200); getmem(p,size); getimage(90,100,470,200,p^); {bar(90,100,470,200);} cleardevice; settextstyle(3,0,8); setcolor(13); outtextxy(100,300,'SOFTWORKS '); size:=imagesize(90,290,470,440); getmem(r,size); getimage(90,290,560,430,r^); cleardevice; {bar(90,290,560,430);} setcolor(5); for a:=1 to 150 do begin putimage(a,100,p^,normalput); end; for b:=700 downto 120 do begin putimage(b,250,r^,normalput); end; delay(1000); cleardevice; settextstyle(6,0,9);outtextxy(55,100,'The');sound(45);delay(476);nosound; delay(1000);outtextxy(200,100,'Terminator'); sound(56);delay(465);nosound; delay(1000);setcolor(red); outtextxy(200,300,'SkyNET');sound(76); delay(754);nosound; delay(1500); cleardevice; end; procedure time; var a:integer; begin cleardevice; for a:=1 to 320 do begin setcolor(red); circle(320,240,a); end; end; procedure game; begin skryj_mys; line(100,100,100,160); line(100,160,120,160); line(120,160,120,100); arc(110,100,0,180,10); arc(110,105,0,180,5); line(105,105,105,130); line(115,105,115,130); arc(108,130,180,270,4); line(108,134,125,134); line(115,128,125,128); line(125,128,125,134); circle(110,75,15); line(100,160,102,225); line(102,225,118,225); line(118,225,120,160); {zbran} line(125,128,127,125); line(127,125,145,125); line(145,125,145,128); line(145,128,132,129); line(132,129,129,135); line(129,135,125,134); {topanky} line(102,225,102,230); line(102,230,130,230); line(130,230,130,228); line(130,228,118,225); {tvar} {x=110,y=75,r=15} circle(118,72,2); line(123,79,115,77); line(115,77,122,82); setfillstyle(1,6); floodfill(110,75,2); setfillstyle(1,4); floodfill(118,72,2); setfillstyle(1,8); floodfill(105,100,2); floodfill(107,108,2); floodfill(124,129,2); setfillstyle(1,9); floodfill(126,129,2); setfillstyle(1,3); floodfill(108,220,2); {bar(95,60,145,240);} size:=imagesize(90,55,150,240); getmem(p,size); getimage(90,55,150,240,p^); setcolor(2); circle(500,100,30); circle(490,90,2); circle(510,90,2); setfillstyle(1,yellow); floodfill(500,100,2); setfillstyle(1,red); floodfill(490,90,2); floodfill(510,90,2); arc(500,120,0,180,8); size:=imagesize(460,60,540,140); {bar(465,65,535,135);} getmem(r,size); getimage(460,60,540,140,r^); cleardevice; xp:=1; yp:=1; xb:=500; yb:=100; repeat setcolor(0); bar(xb+460,yb+60,xb+540,yb+140); bar(500,1,640,480); q:=random(6); if (q=6) then yb:=yb+5; {pohyb lode a podmienky} if (yb>=420) then yb:=420; if (q=2) then yb:=yb-5; if (yb<=1) then yb:=1; if (q=3) then yb:=yb; if (q=4) then yb:=yb+5; if (yb>=420) then yb:=420; if (q=5) then yb:=yb; if (q=0) then yb:=yb-5; if (yb<=1) then yb:=1; putimage(xb+10,yb+50,r^,normalput); if (q=1) then begin setcolor(14); line(xb,yb+90,xb-500,yb+90); line(xb,yb+91,xb-500,yb+91); line(xb,yb+92,xb-500,yb+92); sound(500); delay(50); nosound; setcolor(0); {zmaz strelu} line(xb,yb+90,xb-500,yb+90); line(xb,yb+91,xb-500,yb+91); line(xb,yb+92,xb-500,yb+92); end; if (ch=#13) then begin {strela} sound(150); delay(500); nosound; setcolor(white); {vykresli strelu} line(xp+80,yp+123,xp+180,yp+123); delay(100); xa:=xp+180;ya:=yp+123; if (getpixel(xp+80,yp+122)<>0)then vybuch; if (getpixel(xp+180,yp+122)<>0)then vybuch; if (getpixel(xp+130,yp+122)<>0)then vybuch; setcolor(black); {zmaz strelu} line(xp+80,yp+123,xp+180,yp+123); delay(100); setcolor(white); line(xp+180,yp+123,xp+280,yp+123); delay(100); xa:=xp+280;ya:=yp+123; if (getpixel(xp+180,yp+122)<>0)then vybuch; if (getpixel(xp+280,yp+122)<>0)then vybuch; if (getpixel(xp+230,yp+122)<>0)then vybuch; setcolor(black); line(xp+180,yp+123,xp+280,yp+123); delay(100); setcolor(white); line(xp+280,yp+123,xp+380,yp+123); delay(100); xa:=xp+380;ya:=yp+123; if (getpixel(xp+280,yp+122)<>0)then vybuch; if (getpixel(xp+380,yp+122)<>0)then vybuch; if (getpixel(xp+330,yp+122)<>0)then vybuch; setcolor(black); line(xp+280,yp+123,xp+380,yp+123); delay(100); setcolor(white); line(xp+380,yp+123,xp+480,yp+123); delay(100); xa:=xp+480;ya:=yp+123; if (getpixel(xp+380,yp+122)<>0)then vybuch; if (getpixel(xp+480,yp+122)<>0)then vybuch; if (getpixel(xp+430,yp+122)<>0)then vybuch; setcolor(black); line(xp+380,yp+123,xp+480,yp+123); delay(100); setcolor(white); line(xp+480,yp+123,xp+580,yp+123); delay(100); xa:=xp+580;ya:=yp+123; if (getpixel(xp+480,yp+122)<>0)then vybuch; if (getpixel(xp+580,yp+122)<>0)then vybuch; if (getpixel(xp+530,yp+122)<>0)then vybuch; setcolor(black); line(xp+480,yp+123,xp+580,yp+123); delay(100); setcolor(white); line(xp+580,yp+123,xp+680,yp+123); delay(100); xa:=xp+680;ya:=yp+123; if (getpixel(xp+580,yp+122)<>0)then vybuch; if (getpixel(xp+680,yp+122)<>0)then vybuch; if (getpixel(xp+630,yp+122)<>0)then vybuch; setcolor(black); line(xp+580,yp+123,xp+680,yp+123); delay(100); end; setfillstyle(1,0); setcolor(0); putimage(xp+10,yp+50,p^,normalput); {bar(x+95,y+60,x+145,y+240);} ch:=readkey; if (ch=#0) then begin bar(xp+90,yp+55,xp+150,yp+240); ch:=readkey; if (ch='K') then xp:=xp-5; if (ch='M') then xp:=xp+5; if (ch='H') then yp:=yp-5; if (ch='P') then yp:=yp+5; end; until (ch=#27); menu; zobraz_mys; end; procedure pause; begin settextstyle(1,0,2); setcolor(15); outtextxy(300,440,'Press any key...'); repeat until keypressed; ch:=readkey; end; BEGIN gr:=detect; initgraph(gr,gd,''); randomize; demo1; time; pause; { demo2; time; pause;} cleardevice;{ demo3; time; } menu; if not(gminit) then outtextxy(100,400,'Nemas nainstalovany ovladac na mys.'); zobraz_mys; repeat test_mys(xm,ym,but); {testuje mys} if ((xm>1) and (xm<150) and (ym>1) and (ym<50) and (but=1)) then game; { if ((xm>1) and (xm<15) and (ym>1) and (ym<30) and (but=2)) then FileMenu(0);} if ((xm>151) and (xm<300) and (ym>1) and (ym<50) and (but=1)) then sorry; { if ((xm>90) and (xm<180) and (ym>1) and (ym<30) and (but=2)) then GameMenu(0);} if ((xm>301) and (xm<450) and (ym>1) and (ym<50) and (but=1)) then sorry; if ((xm>451) and (xm<600) and (ym>1) and (ym<50) and (but=1)) then goto 1; until ((ch=#27) and (but=2)); 1: closegraph; END.