DUzun's Web
Programare, proiecte personale, divertisment

uses crt;

const o='O';x='X';

type cel=array[0..9] of char;

label 1,2,3,4,5,6,7,8,9;

var i,j,n,ex,ey,cl,mx,my,tm:longint;  s,l,key:char; c:cel;

​

   procedure sun(nr:word);

   var fr:longint;

begin

fr:=500;

   case nr of

1:begin sound(fr+82*2);delay(10000);nosound;

        sound(fr+82*6);delay(10000);

        sound(fr+82*2);delay(10000);nosound;

        sound(fr+82*6);delay(10000);

        sound(fr+82*2);delay(10000);nosound;

        sound(fr);delay(30000);nosound; end;

2:begin sound(fr*2);delay(500);nosound;end;

3:begin sound(fr*2-200);delay(500);nosound;end;

end;end;

   procedure pxy(s,x,y:longint);

  begin

gotoxy(x,y);

write(chr(s));

  end;

   procedure dff(x,y:longint);

 begin

for i:=40 downto 1 do begin cl:=(i+12) mod 15+1; textcolor(cl);

if y-i>0 then pxy(196,x,y-i);pxy(32,x,y-(1+i));

if (x-i>0) and (y-i>0) then begin

pxy(197,x-i,y-i);pxy(32,x-(1+i),y-(1+i));end;

if y+i<51 then pxy(196,x,y+i);pxy(32,x,y+(1+i));

if (x+i<81) and (y-i>0) then begin

pxy(197,x+i,y-i);pxy(32,x+(1+i),y-(1+i));end;

if x-i>0 then pxy(179,x-i,y);pxy(32,x-(i+1),y);

if (x+i<81) and (y+i<51) then begin

pxy(197,x+i,y+i);pxy(32,x+(1+i),y+(1+i));end;

if x+i<81 then pxy(179,x+i,y);pxy(32,x+(i+1),y);

if (x-i>0) and (y+i<51) then begin

pxy(197,x-i,y+i);pxy(32,x-(1+i),y+(1+i));end;gotoxy(1,1);

delay(800);end;

for i:=40 downto 1 do begin cl:=(i+13) mod 15+1; textcolor(cl);

if (x+i<81) and (y-2*i>0) then

begin pxy(179,x+i,y-2*i);pxy(32,x+i+1,y-2*(i+1));end;

if (x-i>0) and (y-2*i>0) then

begin pxy(179,x-i,y-2*i);pxy(32,x-i-1,y-2*(i+1));end;

if (x+i<81) and (y+2*i<51) then

begin pxy(179,x+i,y+2*i);pxy(32,x+i+1,y+2*(i+1));end;

if (x-i>0) and (y+2*i<51) then

begin pxy(179,x-i,y+2*i);pxy(32,x-i-1,y+2*(i+1));end;

if (x+2*i<81) and (y-i>0) then

begin pxy(196,x+2*i,y-i);pxy(32,x+2*(i+1),y-i-1);end;

if (x-2*i>0) and (y-i>0) then

begin pxy(196,x-2*i,y-i);pxy(32,x-2*(i+1),y-i-1);end;

if (x+2*i<81) and (y+i<51) then

begin pxy(196,x+2*i,y+i);pxy(32,x+2*(i+1),y+i+1);end;

if (x-2*i>0) and (y+i<51) then

begin pxy(196,x-2*i,y+i);pxy(32,x-2*(i+1),y+i+1);end;gotoxy(1,1);

delay(1000);end;

​

for i:=38 downto 1 do begin cl:=(i+12) mod 15+1; textcolor(cl);

if (x+3+i<mx+1) and (y-2*(i+1)>0) then begin

pxy(179,x+2+i,y-2*i);pxy(32,x+i+3,y-2*(i+1));end;

if (x-2-i>0) and (y-2*i>0) then begin

pxy(179,x-2-i,y-2*i);pxy(32,x-i-3,y-2*(i+1));end;

if (x+2+i<mx+1) and (y+2*i<my+1) then begin

pxy(179,x+2+i,y+2*i);pxy(32,x+i+3,y+2*(i+1));end;

if (x-2-i>0) and (y+2*i<my+1) then begin

pxy(179,x-2-i,y+2*i);pxy(32,x-i-3,y+2*(i+1));end;

if (x+2*i<mx+1) and (y-2-i>0) then begin

pxy(196,x+2*i,y-2-i);pxy(32,x+2*(i+1),y-i-3);end;

if (x-2*i>0) and (y-2-i>0) then begin

pxy(196,x-2*i,y-2-i);pxy(32,x-2*(i+1),y-i-3);end;

if (x+2*i<mx+1) and (y+2+i<my+1) then begin

pxy(196,x+2*i,y+2+i);pxy(32,x+2*(i+1),y+i+3);end;

if (x-2*i>0) and (y+2+i<my+1) then begin

pxy(196,x-2*i,y+2+i);pxy(32,x-2*(i+1),y+i+3);end;

​

if y-2-i>0 then pxy(196,x,y-2-i);pxy(32,x,y-i-3);

if y+2+i<51 then pxy(196,x,y+2+i);pxy(32,x,y+i+3);

if x-2-i>0 then pxy(179,x-2-i,y);pxy(32,x-i-3,y);

if x+2+i<81 then pxy(179,x+2+i,y);pxy(32,x+i+3,y);gotoxy(1,1);

delay(1000);end;{readkey;}delay(10000);

end;

​

   procedure pc(n:longint;s:char);

begin

case n of

1:begin gotoxy(ex-2,ey+2);c[1]:=s;write(c[1]);end;

2:begin gotoxy(ex,ey+2);  c[2]:=s;write(c[2]);end;

3:begin gotoxy(ex+2,ey+2);c[3]:=s;write(c[3]);end;

4:begin gotoxy(ex-2,ey);  c[4]:=s;write(c[4]);end;

5:begin gotoxy(ex,ey);    c[5]:=s;write(c[5]);end;

6:begin gotoxy(ex+2,ey);  c[6]:=s;write(c[6]);end;

7:begin gotoxy(ex-2,ey-2);c[7]:=s;write(c[7]);end;

8:begin gotoxy(ex,ey-2);  c[8]:=s;write(c[8]);end;

9:begin gotoxy(ex+2,ey-2);c[9]:=s;write(c[9]);end;end;gotoxy(1,1);

if s=x then sun(2);if s=o then sun(3);

end;

   procedure ver;

begin textcolor(cl+16);

for i:=1 to 3 do begin

if (c[3*(i-1)+1]=c[3*(i-1)+2]) and (c[3*(i-1)+1]=c[3*(i-1)+3]) then

    begin for j:=3*(i-1)+1 to i*3 do pc(j,c[j]);sun(1);n:=10;end;

if (c[i]=c[i+3]) and (c[i]=c[i+6]) then

    begin for j:=0 to 2 do pc(3*j+i,c[3*j+i]);sun(1);n:=10;end;end;

if (c[1]=c[5]) and (c[5]=c[9]) then

    begin for j:=0 to 2 do pc(1+4*j,c[1+4*j]);sun(1);n:=10;end;

if (c[3]=c[5]) and (c[5]=c[7]) then

    begin for j:=0 to 2 do pc(3+2*j,c[3+2*j]);sun(1);n:=10;end;

end;

   procedure xo;

label 1;

  begin

n:=1;  repeat     case s of

x: begin s:=o;cl:=9;end;

o: begin s:=x;cl:=12;end;end;

textcolor(cl);

1:l:=readkey;     case l of

'1': if (c[1]<>x) and (c[1]<>o) then pc(1,s) else goto 1;

'2': if (c[2]<>x) and (c[2]<>o) then pc(2,s) else goto 1;

'3': if (c[3]<>x) and (c[3]<>o) then pc(3,s) else goto 1;

'4': if (c[4]<>x) and (c[4]<>o) then pc(4,s) else goto 1;

'5': if (c[5]<>x) and (c[5]<>o) then pc(5,s) else goto 1;

'6': if (c[6]<>x) and (c[6]<>o) then pc(6,s) else goto 1;

'7': if (c[7]<>x) and (c[7]<>o) then pc(7,s) else goto 1;

'8': if (c[8]<>x) and (c[8]<>o) then pc(8,s) else goto 1;

'9': if (c[9]<>x) and (c[9]<>o) then pc(9,s) else goto 1;

#27: halt else goto 1; end;n:=n+1; ver;

until n=10;

  end;

      procedure ps(s:longint);

  begin

write(chr(s));

  end;

      procedure df(ex,ey:longint);

var i:longint;

      procedure pr(x,y,a,b,c,d,e,f,g:longint);

   begin

gotoxy(x,y);

ps(a);ps(b);ps(c);ps(d);ps(e);ps(f);ps(g);

   end;

     begin

textcolor(7);

pr(ex-3,ey-3,218,196,194,196,194,196,191);

gotoxy(ex-3,ey-2);ps(179);gotoxy(ex+3,ey-2);ps(179);

gotoxy(ex-3,ey-1);ps(195);gotoxy(ex+3,ey-1);ps(180);

gotoxy(ex-3,ey);ps(179);gotoxy(ex+3,ey);ps(179);

gotoxy(ex-3,ey+1);ps(195);gotoxy(ex+3,ey+1);ps(180);

gotoxy(ex-3,ey+2);ps(179);gotoxy(ex+3,ey+2);ps(179);

pr(ex-3,ey+3,192,196,193,196,193,196,217);

   end;

​

begin

textmode(259);textbackground(8);

1:clrscr;

mx:=lo(windmax);my:=hi(windmax);

ex:=mx div 2+1;ey:=my div 2;

dff(40,24);df(ex,ey);for i:=1 to 9 do pc(i,chr(48+i));

s:=o;xo;

gotoxy(mx div 2-6,my);write('Mai joci (D/N)');

2:key:=readkey;

   case key of

'd': goto 1;

'n': halt(1);

 else goto 2;end;

end.

​

​