{************************************************
                 Hugo Eti‚vant
     http://www.multimania.com/cyberzoide/
      e-mail : cyberzoide@multimania.com
      (pour une aide en Turbo Pascal 7.0)
*************************************************}


Uses Graph,Crt; {unit‚s utilis‚es}

var vga,vgahi:Integer;  {d‚claration des variables}
    x,y,i,j,z,ordinat:integer;
    Joueur,nive:integer;
    Tab:Array[1..3,1..3] of integer;
    key,niv:char;
    Trans:Array[1..9,1..2] of integer;
    P,G: Pointer;
    Size,Size2: Word;

Procedure Croix(x,y:integer);
{pose le pion en forme de croix aux coordonn‚es voulues}
begin;
x:=x*128;y:=y*96;
PutImage(x+1, y+1, P^, NormalPut);
end;

Procedure Rond(x,y:integer);
{pose le pion en forme de rond aux coordonn‚es voulues}
begin;
x:=x*128;y:=y*96;
Putimage(x+1, y+1, G^, NormalPut);
end;

Procedure Jouer(Posit:integer);
{proc‚dure param‚tr‚e pour la lecture de la position … affecter aux pions}
var a,b:integer;
begin;
a:=Trans[Posit,1];
b:=Trans[Posit,2];
if Tab[a,b]=0 then
   begin
   case Joueur of
   1:begin
     Tab[a,b]:=1;
     Croix(a,b);
     end;
   2:begin
     Tab[a,b]:=2;
     Rond(a,b);
     end;
   end;
   case Joueur of
   2:Joueur:=1;
   1:Joueur:=2;
   end;
   end
              else

   begin;
   Sound(500);Delay(150);nosound;delay(10);
   Sound(100);Delay(300);Nosound;
   end;
end;

procedure joujou;
begin
setcolor(9);
settextstyle(triplexfont,horizdir,4);
settextjustify(centertext,centertext);
setfillstyle(1,0);bar(0,400,640,460);
case joueur of
1:
outtextxy(succ(getmaxx) div 2 ,430,'Au joueur 1 . . .');
2:
outtextxy(succ(getmaxx) div 2 ,430,'A l''ordinateur . . .');
end;
setcolor(15);
end;

procedure demo; {affiche le titre}
begin
settextstyle(gothicfont,horizdir,5);
settextjustify(centertext,centertext);
setcolor(4); outtextxy(320,20,'SuperMorback');
setcolor(14); outtextxy(323,17,'SuperMorback');
settextstyle(defaultfont,horizdir,1);
setcolor(15);
outtextxy(succ(getmaxx) div 2,60,'Programm‚ par Hugo ETIEVANT (version 2.0).');
end;

procedure initpions;
{cr‚ation des pions, mˆme m‚thode que pour le labyrinthe}
begin
Size := ImageSize(0, 96,128 , 0);
GetMem(P, Size);
setcolor(1);line(20,20,108,76);line(108,20,20,76);
settextstyle(gothicfont,horizdir,8);outtextxy(40,-7,'S');
setcolor(4);outtextxy(42,-5,'S');
GetImage(1, 1, 127, 95, P^);
size2:=imagesize(0,96,128,0);
getmem(G,Size);
setcolor(10);circle(164,148,35);setcolor(15);outtextxy(130,95,'M');
setcolor(9);outtextxy(132,97,'M');
getimage(101,101,227,195,G^);
cleardevice;
end;

procedure niveau;
{ineffectif puisque l'ordinateur est incapable de r‚fl‚chir, ici}
begin
setcolor(11);outtextxy(succ(getmaxx) div 2,440,'Quel niveau de difficult‚ (1..5) ?');
niv:=readkey;
nive:=(ord(niv))-48;
end;

procedure ordi;
{jeu de l'ordinateur dont l'intelligence consiste … jouer au hasard !}
var a,b:integer;
begin
repeat
ordinat:=random(8)+1;
a:=Trans[ordinat,1];
b:=Trans[ordinat,2];
until Tab[a,b]=0;
end;

procedure verif;
 procedure gagne; {sous-proc‚dure}
 begin
 z:=1;
 setfillstyle(1,0);bar(0,400,640,480);
 setcolor(13);settextstyle(triplexfont,horizdir,4);
 outtextxy(succ(getmaxx) div 2,430,'Le joueur 1 a remport‚ la victoire !');
 repeat until keypressed;
 end;
 procedure gagne2; {autre sous-proc‚dure}
 begin
 z:=1;
 setfillstyle(1,0);bar(0,400,640,480);
 setcolor(13);settextstyle(triplexfont,horizdir,4);
 outtextxy(succ(getmaxx) div 2,430,'L''ordinateur a remport‚ la victoire !');
 repeat until keypressed;
 end;
begin
{v‚rification bˆbˆte de la r‚ussite ou non de la partie}
if (tab[1,1]=1) and (tab[1,2]=1) and (tab[1,3]=1) then gagne;
if (tab[2,1]=1) and (tab[2,2]=1) and (tab[2,3]=1) then gagne;
if (tab[3,1]=1) and (tab[3,2]=1) and (tab[3,3]=1) then gagne;
if (tab[1,1]=1) and (tab[2,2]=1) and (tab[3,3]=1) then gagne;
if (tab[1,3]=1) and (tab[2,2]=1) and (tab[3,1]=1) then gagne;
if (tab[1,1]=1) and (tab[2,1]=1) and (tab[3,1]=1) then gagne;
if (tab[1,2]=1) and (tab[2,2]=1) and (tab[3,2]=1) then gagne;
if (tab[1,3]=1) and (tab[2,3]=1) and (tab[3,3]=1) then gagne;
if (tab[1,1]=2) and (tab[1,2]=2) and (tab[1,3]=2) then gagne2;
if (tab[2,1]=2) and (tab[2,2]=2) and (tab[2,3]=2) then gagne2;
if (tab[3,1]=2) and (tab[3,2]=2) and (tab[3,3]=2) then gagne2;
if (tab[1,1]=2) and (tab[2,2]=2) and (tab[3,3]=2) then gagne2;
if (tab[1,3]=2) and (tab[2,2]=2) and (tab[3,1]=2) then gagne2;
if (tab[1,1]=2) and (tab[2,1]=2) and (tab[3,1]=2) then gagne2;
if (tab[1,2]=2) and (tab[2,2]=2) and (tab[3,2]=2) then gagne2;
if (tab[1,3]=2) and (tab[2,3]=2) and (tab[3,3]=2) then gagne2;
end;

BEGIN  {programme principal}
Initgraph(vga,vgahi,'c:\bp\bgi');
initpions;
demo;
setcolor(14);
for i:=1 to 4 do
begin
  Line(i*128,96,i*128,384);
end;
for j:=1 to 4 do
begin
  Line(128,j*96,512,j*96);
end;
Trans[1,1]:=1;Trans[1,2]:=3;Trans[2,1]:=2;Trans[2,2]:=3;Trans[3,1]:=3;
Trans[3,2]:=3;Trans[4,1]:=1;Trans[4,2]:=2;Trans[5,1]:=2;Trans[5,2]:=2;
Trans[6,1]:=3;Trans[6,2]:=2;Trans[7,1]:=1;Trans[7,2]:=1;Trans[8,1]:=2;
Trans[8,2]:=1;Trans[9,1]:=3;Trans[9,2]:=1;

niveau;
Joueur:=1;

repeat
joujou;
  repeat
  key:=Readkey;
  until ((ord(key)>48) and (ord(key)<59)) or (key=chr(27));
Jouer(Ord(key)-48);
verif;
joujou;
delay(1000);
ordi;
Jouer(ordinat);
verif;
if z=1 then key:=chr(27);
until key=chr(27);
END.