|
more than 450 programs for free
|
![]() English |
![]() Slovensky |
![]() Česky |
![]() Šarišsky |
Category: Source in Pascal (KMP)![]() Author: Dávid Smejkal, Martin Sus Program: Pascal_s.pas File exe: Pascal_s.exe need: Egavga.bgi, Litt.chr, Sans.chr Pascal-strike is a perfect game made in Pascal, that was designed for two players. Find a weapon and shoot your opponent. Shelter behind the boxes. Think quickly and be fast, then you will certainly win. Do not forget that before playing the game you can set the color of your soldier. Enjoy playing this game.
Views: 555x
{ PASCAL_S.PAS Copyright (c) David Smejkal and Martin Sus} { Pascal-strike is a perfect game made in Pascal, that was designed } { for two players. } { Find a weapon and shoot your opponent. Shelter behind the boxes. } { Think quickly and be fast, then you will certainly win. } { Do not forget that before playing the game you can set the color } { of your soldier. Enjoy playing this game. } { Needed EGAVGA.BGI } { } { Datum:25.10.2005 http://www.trsek.com } program PASCAL_STRIKE; uses crt,graph; var gd,gm,h,i,xx,x,y,x1,y1,x2,y2,f1,f2,g1,g2,m1,m2 :integer; r,e,k,kk,f,ff : array [1..100] of integer; fa,n1,n2,v1,v2,v3,v4,c1,c2,b1,b2 :integer; OldPattern,fpt :FillPatternType; t,n,P1,P2,T1,T2 :char; Kz1,Mz1,Pz1,Kz2,Mz2,Pz2,exi :boolean; w :string; procedure krabica(kr1,kr2:integer); begin setcolor(8);setlinestyle(0,0,1); rectangle(kr1,kr2,kr1+25,kr2+25); line(kr1+5,kr2,kr1+5,kr2+25); line(kr1+10,kr2,kr1+10,kr2+25); line(kr1+15,kr2,kr1+15,kr2+25); line(kr1+20,kr2,kr1+20,kr2+25); GetFillPattern(fpt); SetFillPattern(fpt,7);floodfill(kr1+1,kr2+1,8);floodfill(kr1+1,kr2+24,8); SetFillPattern(fpt,14);floodfill(kr1+6,kr2+1,8);floodfill(kr1+6,kr2+24,8); SetFillPattern(fpt,7);floodfill(kr1+11,kr2+1,8);floodfill(kr1+11,kr2+24,8); SetFillPattern(fpt,14);floodfill(kr1+16,kr2+1,8);floodfill(kr1+16,kr2+24,8); SetFillPattern(fpt,7);floodfill(kr1+21,kr2+1,8);floodfill(kr1+21,kr2+24,8); end; procedure podmienkykrabice (kr1,kr2,v1,v2,v3,v4:integer); begin if (x1<kr1+35) and (x1>kr1-10) and (y1<kr2+35) and (y1>kr2-10) then begin x1:=v1;y1:=v2; end; if (x2<kr1+35) and (x2>kr1-10) and (y2<kr2+35) and (y2>kr2-10) then begin x2:=v3;y2:=v4; end; end; procedure kamen(ka1,ka2,ka3,ka4:integer); begin setcolor(8);setlinestyle(0,0,1); ellipse(ka1,ka2,0,360,ka3,ka4); GetFillPattern(fpt); SetFillPattern(fpt,7); floodfill(ka1,ka2,8); end; procedure trava(t1,t2:integer); begin setcolor(10);setlinestyle(0,0,1); ellipse(t1,t2,0,90,6,10); ellipse(t1+12,t2,450,540,6,10); line(t1+6,t2,t1+6,t2-13); end; {Z_KALACH -- Z} procedure Zkalach(x1,y1:integer); begin SetLineStyle(0, 0, 1); SetColor(8); line(x1+7,y1-7,x1+11,y1-3); line(x1+7,y1-7,x1+12,y1-12); SetLineStyle(0, 0, 3); line(x1+2,y1-2,x1+6,y1+2); SetColor(14); line(x1,y1,x1+7,y1-7); end; {Z_KALACH -- K} {Z_M4 -- Z} procedure ZM4(x1,y1:integer); begin SetLineStyle(0, 0, 3); SetColor(8); line(x1+2,y1-2,x1+6,y1+2); line(x1,y1,x1+7,y1-7); SetLineStyle(0, 0, 1); line(x1+7,y1-7,x1+11,y1-3); line(x1+7,y1-7,x1+12,y1-12); end; {Z_M4 -- K} {Z_PISTOL -- Z} procedure Zpistol(x1,y1:integer); begin SetLineStyle(0, 0, 3); SetColor(8); line(x1,y1,x1+7,y1-7); line(x1,y1,x1+4,y1+4); SetLineStyle(0, 0, 1); line(x1+3,y1-3,x1+3,y1+3); putpixel(x1-1,y1+1,8); end; {Z_PISTOL -- K} {SURADNICE ZBRANI -- Z} procedure random_f; var z1, z2:integer; begin for i:=1 to 6 do if (i mod 2=1) then begin f[i]:=random(580)+30;ff[i]:=f[i]; end else begin f[i]:=random(420)+30;ff[i]:=f[i]; end; end; {SURADNICE ZBRANI -- K} {KALACH -- Z} procedure kalach(x1,y1,x2,y2,x3,y3:integer); begin SetLineStyle(0, 0, 1); SetColor(8); line(x2,y2,x3,y3); SetLineStyle(0, 0, 3); SetColor(14); line(x1,y1,x2,y2); end; {KALACH -- K} {M4 -- Z} procedure M4(x1,y1,x2,y2,x3,y3:integer); begin SetLineStyle(0, 0, 3); SetColor(8); line(x1,y1,x2,y2); SetLineStyle(0, 0, 1); SetColor(8); line(x2,y2,x3,y3); end; {M4 -- K} {PISTOL -- Z} procedure pistol(x1,y1,x2,y2,x3,y3:integer); begin SetLineStyle(0, 0, 3); SetColor(8); line(x1,y1,x2,y2); end; {PISTOL -- K} {SEVER -- Z} procedure s(x,y,f,g:integer;pz,mz,kz:boolean); var fpt: FillPatternType; begin GetFillPattern(fpt); if Pz then case g of 1:pistol(x+7,y,x+7,y-10,x+7,y-17); end; if Mz then case g of 2:M4(x+7,y,x+7,y-10,x+7,y-17); end; if Kz then case g of 3:kalach(x+7,y,x+7,y-10,x+7,y-17); end; SetLineStyle(0, 0, 0); SetColor(f); ellipse(x,y,0,360,10,5); SetFillPattern(fpt,f); FloodFill(x,y,f); Setcolor(14); circle(x,y-3,4); SetFillPattern(fpt,14); FloodFill(x,y-5,14); end; {SEVER -- K} {JUH -- Z} procedure j(x,y,f,g:integer;pz,mz,kz:boolean); var fpt : FillPatternType; begin GetFillPattern(fpt); SetLineStyle(0, 0, 3); if Pz then case g of 1:pistol(x-7,y,x-7,y+10,x-7,y+17); end; if Mz then case g of 2:M4(x-7,y,x-7,y+10,x-7,y+17); end; if Kz then case g of 3:kalach(x-7,y,x-7,y+10,x-7,y+17); end; SetLineStyle(0, 0, 0); SetColor(f); ellipse(x,y,0,360,10,5); SetFillPattern(fpt,f); FloodFill(x,y,f); Setcolor(14); circle(x,y+3,4); SetFillPattern(fpt,14); FloodFill(x,y+3,14); end; {JUH -- K} {VYCHOD -- Z} procedure v(x,y,f,g:integer;pz,mz,kz:boolean); var gd, gm:integer; fpt: FillPatternType; begin GetFillPattern(fpt); SetLineStyle(0, 0, 3); if Pz then case g of 1:pistol(x,y+7,x+10,y+7,x+17,y+7); end; if Mz then case g of 2:M4(x,y+7,x+10,y+7,x+17,y+7); end; if Kz then case g of 3:kalach(x,y+7,x+10,y+7,x+17,y+7); end; SetLineStyle(0, 0, 0); SetColor(f); ellipse(x,y,0,360,5,10); SetFillPattern(fpt,f); FloodFill(x,y,f); Setcolor(14); circle(x+3,y,4); SetFillPattern(fpt,14); FloodFill(x+3,y,14); end; {VYCHOD -- K} {ZAPAD -- Z} procedure z(x,y,f,g:integer;pz,mz,kz:boolean); var gd, gm:integer; fpt: FillPatternType; begin GetFillPattern(fpt); SetLineStyle(0, 0, 3); if Pz then case g of 1:pistol(x,y-7,x-10,y-7,x-17,y-7); end; if Mz then case g of 2:M4(x,y-7,x-10,y-7,x-17,y-7); end; if Kz then case g of 3:kalach(x,y-7,x-10,y-7,x-17,y-7); end; SetLineStyle(0, 0, 0); SetColor(f); ellipse(x,y,0,360,5,10); SetFillPattern(fpt,f); FloodFill(x,y,f); Setcolor(14); circle(x-3,y,4); SetFillPattern(fpt,14); FloodFill(x-3,y,14); end; {ZAPAD -- K} {SEVERO-VYCHOD -- Z} procedure sv(x,y,f,g:integer;pz,mz,kz:boolean); var gd, gm:integer; fpt: FillPatternType; begin GetFillPattern(fpt); SetLineStyle(0, 0, 3); if Pz then case g of 1:pistol(x+7,y+2,x+14,y-5,x+19,y-10); end; if Mz then case g of 2:M4(x+7,y+2,x+14,y-5,x+19,y-10); end; if Kz then case g of 3:kalach(x+7,y+2,x+14,y-5,x+19,y-10); end; SetLineStyle(0, 0, 0); SetColor(f); ellipse(x-3,y-3,45,225,5,5); ellipse(x+3,y+3,225,45,5,5); line(x,y-7,x+7,y); line(x,y+7,x-7,y); SetFillPattern(fpt,f); FloodFill(x,y,f); Setcolor(14); circle(x+2,y-2,4); SetFillPattern(fpt,14); FloodFill(x+2,y-2,14); end; {SEVERO-VYCHOD -- K} {JUHO-VYCHOD -- Z} procedure jv(x,y,f,g:integer;pz,mz,kz:boolean); var gd, gm:integer; fpt: FillPatternType; begin GetFillPattern(fpt); SetLineStyle(0, 0, 3); if Pz then case g of 1:pistol(x-2,y+7,x+5,y+14,x+10,y+19); end; if Mz then case g of 2:M4(x-2,y+7,x+5,y+14,x+10,y+19); end; if Kz then case g of 3:kalach(x-2,y+7,x+5,y+14,x+10,y+19); end; SetLineStyle(0, 0, 0); SetColor(f); ellipse(x+3,y-3,315,135,5,5); ellipse(x-3,y+3,135,315,5,5); line(x-7,y,x,y-7); line(x+7,y,x,y+7); SetFillPattern(fpt,f); FloodFill(x,y,f); Setcolor(14); circle(x+2,y+2,4); SetFillPattern(fpt,14); FloodFill(x+2,y+2,14); end; {JUHO-VYCHOD -- K} {JUHO-ZAPAD -- Z} procedure jz(x,y,f,g:integer;pz,mz,kz:boolean); var gd, gm : integer; fpt : FillPatternType; begin GetFillPattern(fpt); SetLineStyle(0, 0, 3); if Pz then case g of 1:pistol(x-7,y-2,x-14,y+5,x-19,y+10); end; if Mz then case g of 2:M4(x-7,y-2,x-14,y+5,x-19,y+10); end; if Kz then case g of 3:kalach(x-7,y-2,x-14,y+5,x-19,y+10); end; SetLineStyle(0, 0, 0); SetColor(f); ellipse(x-3,y-3,45,225,5,5); ellipse(x+3,y+3,225,45,5,5); line(x,y-7,x+7,y); line(x,y+7,x-7,y); SetFillPattern(fpt,f); FloodFill(x,y,f); Setcolor(14); circle(x-2,y+2,4); SetFillPattern(fpt,14); FloodFill(x-2,y+2,14); end; {JUHO-ZAPAD -- K} {SEVERO-ZAPAD -- Z} procedure sz(x,y,f,g:integer;pz,mz,kz:boolean); var gd, gm : integer; fpt : FillPatternType; begin GetFillPattern(fpt); SetLineStyle(0, 0, 3); if Pz then case g of 1:pistol(x+2,y-7,x-5,y-14,x-10,y-19); end; if Mz then case g of 2:M4(x+2,y-7,x-5,y-14,x-10,y-19); end; if Kz then case g of 3:kalach(x+2,y-7,x-5,y-14,x-10,y-19); end; SetLineStyle(0, 0, 0); SetColor(f); ellipse(x+3,y-3,315,135,5,5); ellipse(x-3,y+3,135,315,5,5); line(x-7,y,x,y-7); line(x+7,y,x,y+7); SetFillPattern(fpt,f); FloodFill(x,y,f); Setcolor(14); circle(x-2,y-2,4); SetFillPattern(fpt,14); FloodFill(x-2,y-2,14); end; {SEVERO-ZAPAD -- K} {PODM_PRE_OSOBY -- Z} procedure PPO(x,y,xo,yo,sm:integer); begin case sm of 1,3:begin if (x>xo-10) and (x<xo+10) and (y>yo-2) and (y<yo+2) then begin Fa:=6; if t='`' then n2:=n2-1; if t='7' then n1:=n1-1; end; if (x>xo-3) and (x<xo+3) and (y>yo-6) and (y<yo+6) then begin Fa:=6; if t='`' then n2:=n2-1; if t='7' then n1:=n1-1; end; end; 2,4:begin if (x>xo-2) and (x<xo+2) and (y>yo-10) and (y<yo+10) then begin Fa:=6; if t='`' then n2:=n2-1; if t='7' then n1:=n1-1; end; if (x>xo-6) and (x<xo+6) and (y>yo-3) and (y<yo+3) then begin Fa:=6; if t='`' then n2:=n2-1; if t='7' then n1:=n1-1; end; end; 5,7:begin if (x>xo-6) and (x<xo+1) and (y>yo-6) and (y<yo+1) then begin Fa:=6; if t='`' then n2:=n2-1; if t='7' then n1:=n1-1; end; if (x>xo-1) and (x<xo+6) and (y>yo-1) and (y<yo+6) then begin Fa:=6; if t='`' then n2:=n2-1; if t='7' then n1:=n1-1; end; end; 6,8:begin if (x>xo-6) and (x<xo+1) and (y>yo-1) and (y<yo+6) then begin Fa:=6; if t='`' then n2:=n2-1; if t='7' then n1:=n1-1; end; if (x>xo-1) and (x<xo+6) and (y>yo-6) and (y<yo+1) then begin Fa:=6; if t='`' then n2:=n2-1; if t='7' then n1:=n1-1; end; end; end; end; {PODM_PRE_OSOBY -- K} {PODM_STRIEL -- Z} procedure podm_st(x,y,xo,yo,kr1,kr2,kr3,kr4,kr5,kr6,sm1,sm2:integer); var i:integer; begin Fa:=7; case sm1 of 1:begin x:=x+7; for i:=1 to 640 do begin y:=y-1; if (x<kr1+25) and (x>kr1) and (y<kr2+25) and (y>kr2) then break; if (x<kr3+25) and (x>kr3) and (y<kr4+25) and (y>kr4) then break; if (x<kr5+25) and (x>kr5) and (y<kr6+25) and (y>kr6) then break; PPO(x,y,xo,yo,sm2); if i mod 10 = 0 then putpixel(x,y,Fa); end; end; 2:begin y:=y+7; for i:=1 to 640 do begin x:=x+1; if (x<kr1+25) and (x>kr1) and (y<kr2+25) and (y>kr2) then break; if (x<kr3+25) and (x>kr3) and (y<kr4+25) and (y>kr4) then break; if (x<kr5+25) and (x>kr5) and (y<kr6+25) and (y>kr6) then break; PPO(x,y,xo,yo,sm2); if i mod 10 = 0 then putpixel(x,y,Fa); end; end; 3:begin x:=x-7; for i:=1 to 640 do begin y:=y+1; if (x<kr1+25) and (x>kr1) and (y<kr2+25) and (y>kr2) then break; if (x<kr3+25) and (x>kr3) and (y<kr4+25) and (y>kr4) then break; if (x<kr5+25) and (x>kr5) and (y<kr6+25) and (y>kr6) then break; PPO(x,y,xo,yo,sm2); if i mod 10 = 0 then putpixel(x,y,Fa); end; end; 4:begin y:=y-7; for i:=1 to 640 do begin x:=x-1; if (x<kr1+25) and (x>kr1) and (y<kr2+25) and (y>kr2) then break; if (x<kr3+25) and (x>kr3) and (y<kr4+25) and (y>kr4) then break; if (x<kr5+25) and (x>kr5) and (y<kr6+25) and (y>kr6) then break; PPO(x,y,xo,yo,sm2); if i mod 10 = 0 then putpixel(x,y,Fa); end; end; 5:begin x:=x+7;y:=y+2; for i:=1 to 640 do begin x:=x+1; y:=y-1; if (x<kr1+25) and (x>kr1) and (y<kr2+25) and (y>kr2) then break; if (x<kr3+25) and (x>kr3) and (y<kr4+25) and (y>kr4) then break; if (x<kr5+25) and (x>kr5) and (y<kr6+25) and (y>kr6) then break; PPO(x,y,xo,yo,sm2); if i mod 10 = 0 then putpixel(x,y,Fa); end; end; 6:begin x:=x-2;y:=y+7; for i:=1 to 640 do begin x:=x+1; y:=y+1; if (x<kr1+25) and (x>kr1) and (y<kr2+25) and (y>kr2) then break; if (x<kr3+25) and (x>kr3) and (y<kr4+25) and (y>kr4) then break; if (x<kr5+25) and (x>kr5) and (y<kr6+25) and (y>kr6) then break; PPO(x,y,xo,yo,sm2); if i mod 10 = 0 then putpixel(x,y,Fa); end; end; 7:begin x:=x-7;y:=y-2; for i:=1 to 640 do begin x:=x-1; y:=y+1; if (x<kr1+25) and (x>kr1) and (y<kr2+25) and (y>kr2) then break; if (x<kr3+25) and (x>kr3) and (y<kr4+25) and (y>kr4) then break; if (x<kr5+25) and (x>kr5) and (y<kr6+25) and (y>kr6) then break; PPO(x,y,xo,yo,sm2); if i mod 10 = 0 then putpixel(x,y,Fa); end; end; 8:begin x:=x+2;y:=y-7; for i:=1 to 640 do begin x:=x-1; y:=y-1; if (x<kr1+25) and (x>kr1) and (y<kr2+25) and (y>kr2) then break; if (x<kr3+25) and (x>kr3) and (y<kr4+25) and (y>kr4) then break; if (x<kr5+25) and (x>kr5) and (y<kr6+25) and (y>kr6) then break; PPO(x,y,xo,yo,sm2); if i mod 10 = 0 then putpixel(x,y,Fa); end; end; end; end; {PODM_STRIEL -- K} {STRELA -- Z} procedure strela(x,y,xo,yo,kr1,kr2,kr3,kr4,kr5,kr6,m1,m2,g:integer;pz,mz,kz:boolean); begin if Pz then case g of 1:podm_st(x,y,xo,yo,kr1,kr2,kr3,kr4,kr5,kr6,m1,m2);end; if Mz then case g of 2:podm_st(x,y,xo,yo,kr1,kr2,kr3,kr4,kr5,kr6,m1,m2);end; if Kz then case g of 3:podm_st(x,y,xo,yo,kr1,kr2,kr3,kr4,kr5,kr6,m1,m2);end; end; {STRELA -- K} {HRA -- Z} procedure hra; begin randomize; for i:=1 to 10 do begin if (i mod 2)=1 then begin r[i]:=random(580)+20; e[i]:=random(580)+20; k[i]:=random(580)+20; kk[i]:=random(4)+4; end else begin r[i]:=random(440)+20; e[i]:=random(440)+20; k[i]:=random(440)+20; kk[i]:=random(4)+4; end; end; x1:=100; y1:=100; x2:=540; y2:=380; n1:=30;n2:=30; P1:='w';P2:='o'; random_f; gd:=9;gm:=2; InitGraph(gd,gm,'L:\BP\BGI'); setbkcolor(6); Kz1:=false;Mz1:=false;Pz1:=false;Kz2:=false;Mz2:=false;Pz2:=false; b1:=0;b2:=0; repeat {pohyb} t:='ď'; if (b2=0) and (b1=1) then begin t:='k';b2:=1; end; if b1=0 then begin t:='d';b1:=1; end; v1:=x1;v2:=y1; v3:=x2;v4:=y2; if keypressed then t:=readkey; cleardevice; Zpistol(ff[1],ff[2]); ZM4(ff[3],ff[4]); Zkalach(ff[5],ff[6]); if (t='q') or (t='w') or (t='e') or (t='a') or (t='d') or (t='z') or (t='x') or (t='c') then P1:=t; if (t='i') or (t='o') or (t='p') or (t='k') or (t=';') or (t=',') or (t='.') or (t='/') then P2:=t; if (t='1') or (t='2') or (t='3') then T1:=t; if (t='8') or (t='9') or (t='0') then T2:=t; case t of 'w': begin y1:=y1-5; m1:=1; end; 'x': begin y1:=y1+5; m1:=3; end; 'a': begin x1:=x1-5; m1:=4; end; 'd': begin x1:=x1+5; m1:=2; end; 'q': begin y1:=y1-4; x1:=x1-4; m1:=8; end; 'e': begin y1:=y1-4; x1:=x1+4; m1:=5; end; 'c': begin y1:=y1+4; x1:=x1+4; m1:=6; end; 'z': begin y1:=y1+4; x1:=x1-4; m1:=7; end; 'o': begin y2:=y2-5; m2:=1; end; '.': begin y2:=y2+5; m2:=3; end; 'k': begin x2:=x2-5; m2:=4; end; ';': begin x2:=x2+5; m2:=2; end; 'i': begin y2:=y2-4; x2:=x2-4; m2:=8; end; 'p': begin y2:=y2-4; x2:=x2+4; m2:=5; end; '/': begin y2:=y2+4; x2:=x2+4; m2:=6; end; ',': begin y2:=y2+4; x2:=x2-4; m2:=7; end; '`': strela (x1,y1,x2,y2,r[1],r[2],r[3],r[4],r[5],r[6],m1,m2,g1,pz1,mz1,kz1); '7': strela (x2,y2,x1,y1,r[1],r[2],r[3],r[4],r[5],r[6],m2,m1,g2,pz2,mz2,kz2); end; {krabice a kamene a trava} podmienkykrabice (r[1],r[2],v1,v2,v3,v4); podmienkykrabice (r[3],r[4],v1,v2,v3,v4); podmienkykrabice (r[5],r[6],v1,v2,v3,v4); krabica(r[1],r[2]); krabica(r[3],r[4]); krabica(r[5],r[6]); kamen(k[1],k[2],kk[1],kk[2]); kamen(k[3],k[4],kk[3],kk[4]); kamen(k[5],k[6],kk[5],kk[6]); kamen(k[7],k[8],kk[7],kk[8]); kamen(k[9],k[10],kk[9],kk[10]); trava(e[1],e[2]); trava(e[3],e[4]); trava(e[5],e[6]); trava(e[7],e[8]); trava(e[9],e[10]); if x1<20 then x1:=16; if x1>620 then x1:=624; if x2<20 then x2:=16; if x2>620 then x2:=624; if y1<20 then y1:=16; if y1>460 then y1:=464; if y2<20 then y2:=16; if y2>460 then y2:=464; if (abs(x1-ff[1]-6)<10) and (abs(y1-ff[2]+6)<10) then Pz1:=true; if (abs(x1-ff[3]-6)<10) and (abs(y1-ff[4]+6)<10 |