Kółko i krzyżyk

Sunday tym razem napisał bardziej rozbudowaną gierkę. Oto kółko i krzyżyk zrobione w Pascalu. Całość działa w konsoli, więc jest to świetny programik, który może działać na wielu systemach. Nie pozostało mi nic innego jak znów przekazać głos Sunday'owi

Procek

Tym razem gierka zrobiona w Pascalu:

program kik;
uses crt;
 
var
Plansza:array[1..3,1..3] of char; {Plansza do rozgrywki}
kursor_x,kursor_y:integer; {Gdzie aktualnie znajduje sie kursor}
koniec:boolean; {czy konczymy juz}
 
procedure
CzyscPlansze; 
var i1,i2:integer;
begin
koniec:=false;
for
i1 := 1 to 3 do
for i2 := 1 to 3 do
Plansza[i1,i2]:='';
end;
 
procedure RysujPlansze;
var
i1,i2:integer;
begin
{Ustalenie koloru tla}
TextBackGround(white);
for i1 := 1 to 3 do
for i2 := 1
to 3 do
begin
if(i1=kursor_x)and(i2=kursor_y)then
TextBackGround(green);
{Jeżeli i1,i2 = kursor_x,kursorY wtedy zmien tlo}
gotoxy(i1,i2);
textcolor(red);
write(Plansza[i1,i2]);
TextBackGround(white);
end;
end;
 
procedure
kursor;
var znak:char;
begin
repeat
znak:=readkey;
{Tutaj obsluga klawisz zmiennianie zmiennych kursor_x i y}
case znak
of
'4':kursor_x:=kursor_x-1;
'6':kursor_x:=kursor_x+1;
'8':kursor_y:=kursor_y-1;
'2':kursor_y:=kursor_y+1;
'k':koniec:=true;
end;
if(kursor_x>3)then
kursor_x:=1;
if(kursor_x<1)then kursor_x:=3;
if(kursor_y>3)then
kursor_y:=1;
if(kursor_y<1)then
kursor_y:=3;
RysujPlansze;
until
((znak=#13)and(Plansza[kursor_x,kursor_y]=''))or(koniec);
Plansza[kursor_x,kursor_y]:='X';
RysujPlansze;
end;
 
function
Sedzia:Char; {X-wygral x, O-wygralo o, R- remis, D-gramy Dalej}
var
i1,i2,licznik:integer;
wynik:char;
begin
licznik:=0;
wynik:='D';
 
 
{Sprawdzanie czy nie wygral krzyzyk}
if(Plansza[1,1]='X')and(Plansza[2,1]='X')and(Plansza[3,1]='X')then
wynik:='X';
if(Plansza[1,2]='X')and(Plansza[2,2]='X')and(Plansza[3,2]='X')then
wynik:='X';
if(Plansza[1,3]='X')and(Plansza[2,3]='X')and(Plansza[3,3]='X')then
wynik:='X';
 
if(Plansza[1,1]='X')and(Plansza[1,2]='X')and(Plansza[1,3]='X')then
wynik:='X';
if(Plansza[2,1]='X')and(Plansza[2,2]='X')and(Plansza[2,3]='X')then
wynik:='X';
if(Plansza[3,1]='X')and(Plansza[3,2]='X')and(Plansza[3,3]='X')then
wynik:='X';
 
if(Plansza[1,1]='X')and(Plansza[2,2]='X')and(Plansza[3,3]='X')then
wynik:='X';
if(Plansza[1,3]='X')and(Plansza[2,2]='X')and(Plansza[3,1]='X')then
wynik:='X';
 
{Sprawdzanie czy nie wygralo kolko}
if(Plansza[1,1]='O')and(Plansza[2,1]='O')and(Plansza[3,1]='O')then
wynik:='O';
if(Plansza[1,2]='O')and(Plansza[2,2]='O')and(Plansza[3,2]='O')then
wynik:='O';
if(Plansza[1,3]='O')and(Plansza[2,3]='O')and(Plansza[3,3]='O')then
wynik:='O';
 
if(Plansza[1,1]='O')and(Plansza[1,2]='O')and(Plansza[1,3]='O')then
wynik:='O';
if(Plansza[2,1]='O')and(Plansza[2,2]='O')and(Plansza[2,3]='O')then
wynik:='O';
if(Plansza[3,1]='O')and(Plansza[3,2]='O')and(Plansza[3,3]='O')then
wynik:='O';
 
if(Plansza[1,1]='O')and(Plansza[2,2]='O')and(Plansza[3,3]='O')then
wynik:='O';
if(Plansza[1,3]='O')and(Plansza[2,2]='O')and(Plansza[3,1]='O')then
wynik:='O';
 
 
{Sprawdzanie czy nie ma remisu}
if(wynik='D')then
begin
for i1 := 1 to 3 do
for
i2 := 1 to 3 do
if(Plansza[i1,i2]=' ')then
licznik:=licznik+1;
if(licznik=0)then
wynik:='R';
end;
 
Sedzia:=wynik;
end;
 
procedure
przeciwnik;
var
x,y,i:integer;
begin
i:=0;
repeat
x:=random(3)+1;
y:=random(3)+1;
i:=i+1;
until
(plansza[x,y]='')or(i>500);
plansza[x,y]:='O';
RysujPlansze;
end;
 
 
begin
randomize;
repeat
textcolor(white);
TextBackGround(black);
clrscr;
CzyscPlansze;
kursor_x:=1;
kursor_y:=1;
RysujPlansze;
textcolor(white);
TextBackGround(black);
writeln;
 
writeln;
writeln('4 - w lewo');
writeln('6 - w prawo');
writeln('8 - w gore');
writeln('2 - w dol');
writeln('Enter - zatwierdz');
writeln('k - koniec/jeszcze raz');
if random(2)=1
then Przeciwnik; {czasami zaczyna przeciwnik, czasami my}
repeat
kursor;
if(Sedzia='D')then Przeciwnik;
until
(koniec)or(Sedzia<>'D');
textcolor(white);
TextBackGround(black);
clrscr;
RysujPlansze;
textcolor(white);
TextBackGround(black);
writeln;
writeln;
if
Sedzia='X'then Writeln('Wygrales!');
if Sedzia='O'then
Writeln('Przegrales!');
if Sedzia='R'then
Writeln('Remis');
writeln;
writeln('Jeszcze raz(t/n)?');
until
readkey<>'t';
end. 
 

Sunday