{ PISKVOR.PAS Copyright (c) Sargo } { } { Klasicke piskvorky proti pocitacu. Logika pocitaca nie je uplne } { stopercenta (bolo by nutne prepisat program s inymi alogritmami } { overovania). Jedna sa o 4 verziu tohto programu a verte ze sa } { potrapite, a budete sa cudovat ako je mozne ze sa v pascali nieco } { take da naprogramovat... :) Najdenie toho spravneho postupu medzi } { obrannou a utokom zabral cas, pri zistovani parametrov som nechal } { pocitac hrat proti sebe a tak som vybral pre vas favorita. } { (je mozne vyhrat !!!) } { } { ovladanie sipkami (klasika hore dole doprava dolava) } { space bar - potvrdenie tahu } { escape - ihned ukonci program ... stav oznaci ako remiza } { } { Author: Sargo } { Date : 29.07.2006 http://www.trsek.com } program piskvorky; uses crt; var a,b,c,s,d,e,g, x,y, f:longint; p:array[-10..10,-10..10] of 0..2; vx,vy :array[0..4] of -10..10; pod: boolean; mp,jp:array[-10..10,-10..10] of real; n:real; px,py:longint; procedure nastav; begin pod:=true; for c:=0 to 4 do if p[vx[c],vy[c]]<>1 then pod:=false; if pod then s:=1; pod:=true; for c:=0 to 4 do if p[vx[c],vy[c]]<>2 then pod:=false; if pod then s:=2 end; procedure stav; begin for a:=-10 to 6 do for b:=-10 to 6 do begin for f:=0 to 1 do begin for c:=0 to 4 do begin case f of 0:begin vx[c]:=a+c;vy[c]:=b+c end; 1:begin vx[c]:=a+c;vy[c]:=b-c+4 end; end; end; nastav; end; end; for a:=-10 to 6 do for b:=-10 to 10 do begin for c:=0 to 4 do begin vx[c]:=a+c; vy[c]:=b end; nastav; end; for a:=-10 to 10 do for b:=-10 to 6 do begin for c:=0 to 4 do begin vx[c]:=a; vy[c]:=b+c end; nastav; end; end; procedure overenie; begin pod:=true; for c:=0 to 4 do if p[vx[c],vy[c]]=2 then pod:=false; if pod then begin d:=1; for c:=0 to 4 do if p[vx[c],vy[c]]=1 then inc(d); for c:=0 to 4 do if p[vx[c],vy[c]]=0 then jp[vx[c],vy[c]]:=jp[vx[c],vy[c]]+3*d*d*d+3*d*d+3*d; end; pod:=true; for c:=0 to 4 do if p[vx[c],vy[c]]=1 then pod:=false; if pod then begin d:=1; for c:=0 to 4 do if p[vx[c],vy[c]]=2 then inc(d); for c:=0 to 4 do if p[vx[c],vy[c]]=0 then mp[vx[c],vy[c]]:=mp[vx[c],vy[c]]+3*d*d*d+3*d*d+3*d; end; end; function je_volne: boolean; begin je_volne:=false; for a:=-10 to 10 do for b:=-10 to 10 do if p[a,b]=0 then je_volne:=true end; procedure povodne; begin gotoxy(x+39,y+20); case p[x,y] of 0:write(' '); 1:begin textcolor(2);write('X')end; 2:begin textcolor(4);write('O')end; end; gotoxy(28,9);textcolor(15); end; procedure bod; begin gotoxy(x+39,y+20); write(''); gotoxy(28,9) end; label cyk,dalej,hra,konec; begin textmode(CO80 + Font8x8); clrscr; gotoxy(52,49);write('Navrhol a naprogramoval:Sargo'); textcolor(15); gotoxy(36,15); write('Piskvorky'); gotoxy(29,20); write('Stlac lubovolnu klavesu'); readkey; clrscr; for a:=-11 to 11 do for b:=-11 to 11 do if 11 in [abs(a),abs(b)] then begin gotoxy(a+39,b+20); write('') end; x:=0;y:=0; hra:; stav; if (not(je_volne)) or (s>0) then goto konec; cyk: case f of 0:bod; 1:povodne; end; for a:=1 to (f*10+50) do begin if keypressed then case ord(readkey) of 72:if y>-10 then begin povodne;dec(y) end; 77:if x<10 then begin povodne;inc(x) end; 80:if y<10 then begin povodne;inc(y) end; 75:if x>-10 then begin povodne;dec(x) end; 32:if p[x,y]=0 then begin p[x,y]:=1;povodne;goto dalej end; 27:goto konec; end; delay(2); end; f:=abs(f-1); goto cyk;dalej:; sound(100);delay(10);nosound;delay(200); stav; if (not(je_volne)) or (s>0) then goto konec; for a:=-10 to 6 do for b:=-10 to 6 do begin for f:=0 to 1 do begin for c:=0 to 4 do begin case f of 0:begin vx[c]:=a+c;vy[c]:=b+c end; 1:begin vx[c]:=a+c;vy[c]:=b-c+4 end; end; end; overenie; end; end; for a:=-10 to 6 do for b:=-10 to 10 do begin for c:=0 to 4 do begin vx[c]:=a+c; vy[c]:=b end; overenie; end; for a:=-10 to 10 do for b:=-10 to 6 do begin for c:=0 to 4 do begin vx[c]:=a; vy[c]:=b+c end; overenie; end; n:=-1; for a:=-10 to 10 do for b:=-10 to 10 do if (jp[a,b]>n) and (p[a,b]=0) then begin n:=jp[a,b]; px:=a; py:=b; end; for a:=-10 to 10 do for b:=-10 to 10 do if (mp[a,b]>n) and (p[a,b]=0) then begin n:=mp[a,b]; px:=a; py:=b; end; p[px,py]:=2; gotoxy(px+39,py+20); textcolor(4);write('O'); textcolor(15); for a:=-10 to 10 do for b:=-10 to 10 do begin jp[a,b]:=0; mp[a,b]:=0; end; goto hra; konec: textcolor(9); gotoxy(29,33); case s of 0:write(' ***Remiza***'); 2:write(' ***Prehrali ste !!!***'); 1:write(' ***Vyhrali ste !!!***'); end; readkey; end.