program dames;
(*----------------------------------------------------------------------*)
(* Auteurs:BERNARD Didier                    licence informatique       *)
(*         DUCAMP Denis                      ann‚e 1992-1993            *)
(*                                                                      *)
(*                      JEU DE DAMES                                    *)
(*----------------------------------------------------------------------*)
const vide=0,pion=1,dame=2,bloc=4,noir=-1,blanc=1,damenoire=-2,dameblanche=2;
    var quit:boolean,
	horiz,vert,debhoriz,debvert,horiz1,vert1,horiz2,
	coulblanc,coulnoir,coulrouge:integer,
	damier:arrayof integer,
	liste,h_g,h_d,b_g,b_d:arrayof arrayof integer,
	ap:aff_pions,
	arb:arbitre,
	cc:calc_coord,
	clc:calcul_liste_coup,
	clr:clear;

unit init_deplact:procedure;
(* Cette proc‚dure calcule pour chaque case le num‚ro de la case au *)
(* dessus … gauche, au dessus … droite, en bas … gauche et en bas … droite *)

var i,j,k:integer;
begin
    array h_g dim(noir:blanc);
    array h_g(noir) dim(1:50); array h_g(blanc) dim(1:50);
    array h_d dim(noir:blanc);
    array h_d(noir) dim(1:50); array h_d(blanc) dim(1:50);
    array b_g dim(noir:blanc);
    array b_g(noir) dim(1:50); array b_g(blanc) dim(1:50);
    array b_d dim(noir:blanc);
    array b_d(noir) dim(1:50); array b_d(blanc) dim(1:50);
    for i:=1 to 50 do
	j:=i mod 10; k:=(i-1)mod 10;
	if i<=5 or j=6 then h_g(blanc,i):=0;
	else if k<5 then h_g(blanc,i):=i-5;
	else h_g(blanc,i):=i-6; fi; fi;
	if i<=5 or j=5 then h_d(blanc,i):=0;
	else if k<5 then h_d(blanc,i):=i-4;
	else h_d(blanc,i):=i-5; fi; fi;
	if i>=46 or j=6 then b_g(blanc,i):=0;
	else if k<5 then b_g(blanc,i):=i+5;
	else b_g(blanc,i):=i+4; fi; fi;
	if i>=46 or j=5 then b_d(blanc,i):=0;
	else if k<5 then b_d(blanc,i):=i+6;
	else b_d(blanc,i):=i+5; fi; fi;
	h_d(noir,i):=b_g(blanc,i); h_g(noir,i):=b_d(blanc,i);
	b_d(noir,i):=h_g(blanc,i); b_g(noir,i):=h_d(blanc,i);
    od;
end init_deplact;

unit calcul_liste_coup:coroutine;
(* Cette coroutine calcule la liste des coups du joueur qui … la main *)

var i,nc,joueur,nbmax,nb_coup:integer,
    coup,damier:arrayof integer,
    liste_coup:arrayof arrayof integer,
    saut:boolean,
    ec:enreg_coup;

unit enreg_coup:coroutine;
(* Cette coroutine enregistre un coup dans la liste des coups *)

var i,nb:integer;
begin
return;
do;
    if nb=nbmax then   
	nb_coup:=nb_coup+1;
	array liste_coup(nb_coup) dim(1:nb);
	for i:=1 to nb do liste_coup(nb_coup,i):=coup(i); od;
    else if nb>nbmax then
    (* La longueur du nouveau coup est sup‚rieure … celle des autres *)        
    (* donc on peut supprimer les anciens qui ne peuvent plus etre jou‚s *)
	for i:=1 to nb_coup do kill(liste_coup(i)); od;
	array liste_coup(1) dim(1:nb);
	nb_coup:=1;
	nbmax:=nb;
	for i:=1 to nb do liste_coup(1,i):=coup(i); od;
    fi; fi;
    detach;
od;
end enreg_coup;

unit recurse_pion:procedure
(damier:arrayof integer,num,sautee,caz:integer,prof:boolean);
(* Cette proc‚dure recherche tous les coups possibles pour un pion donn‚ *)
(* Elle s'appelle r‚cursivement si le pion peut en sauter au moins une fois *)

var rec:boolean,
    nc,nc2:integer,
    damier2:arrayof integer;
begin
    rec:=false;
    if prof then
	coup(num):=sautee;
	num:=num+1;
    fi;
    coup(num):=caz;
    nc:=h_g(joueur,caz);
    if nc=/=0 then
	if damier(nc)*joueur<0 then
	    nc2:=h_g(joueur,nc);
	    if nc2=/=0 then
		if damier(nc2)=vide then
		    rec:=true;
		    damier2:=copy(damier);
		    damier2(nc2):=damier(caz);
		    damier2(nc),damier2(caz):=vide;
		    call recurse_pion(damier2,num+1,nc,nc2,true);
    fi; fi; fi; fi;
    nc:=h_d(joueur,caz);
    if nc=/=0 then
	if damier(nc)*joueur<0 then
	    nc2:=h_d(joueur,nc);
	    if nc2=/=0 then
		if damier(nc2)=vide then
		    rec:=true;
		    if damier2<>none then kill(damier2); fi;
		    damier2:=copy(damier);
		    damier2(nc2):=damier(caz);
		    damier2(nc),damier2(caz):=vide;
		    call recurse_pion(damier2,num+1,nc,nc2,true);
    fi; fi; fi; fi;
    nc:=b_g(joueur,caz);
    if nc=/=0 then
	if damier(nc)*joueur<0 then
	    nc2:=b_g(joueur,nc);
	    if nc2=/=0 then
		if damier(nc2)=vide then
		    rec:=true;
		    if damier2<>none then kill(damier2); fi;
		    damier2:=copy(damier);
		    damier2(nc2):=damier(caz);
		    damier2(nc),damier2(caz):=vide;
		    call recurse_pion(damier2,num+1,nc,nc2,true);
    fi; fi; fi; fi;
    nc:=b_d(joueur,caz);
    if nc=/=0 then
	if damier(nc)*joueur<0 then
	    nc2:=b_d(joueur,nc);
	    if nc2=/=0 then
		if damier(nc2)=vide then
		    rec:=true;
		    if damier2<>none then kill(damier2); fi;
		    damier2:=copy(damier);
		    damier2(nc2):=damier(caz);
		    damier2(nc),damier2(caz):=vide;
		    call recurse_pion(damier2,num+1,nc,nc2,true);
    fi; fi; fi; fi;
    if rec then kill(damier2)
    else if prof then
	saut:=true;
	ec.nb:=num;
	attach(ec);
    fi; fi;
end recurse_pion;

unit recurse_dame:procedure
(damier:arrayof integer,num,sautee,caz:integer,prof:boolean);
(* Cette proc‚dure recherche tous les coups possible pour une dame *)
(* Elle s'appelle r‚cursivement si la dame peut sauter au moins une fois *)

var rec:boolean,
    nc,nc2:integer,
    damier2:arrayof integer;
begin
    rec:=false;
    if prof then
	coup(num):=sautee;
	num:=num+1;
    fi;
    coup(num):=caz;
    nc:=caz;
    do
	nc:=h_g(joueur,nc);
	if nc=0 orif damier(nc)=/=vide then exit; fi;
    od;
    if nc=/=0 then
	if damier(nc)*joueur<0 then
	    nc2:=h_g(joueur,nc);
	    while nc2=/=0 do
		if damier(nc2)=/=vide then exit; fi;
		rec:=true;
		damier2:=copy(damier);
		damier2(nc2):=damier(caz);
		damier2(nc):=bloc*joueur;
		damier2(caz):=vide;
		call recurse_dame(damier2,num+1,nc,nc2,true);
		nc2:=h_g(joueur,nc2);
	    od;
    fi; fi;
    nc:=caz;
    do
	nc:=h_d(joueur,nc);
	if nc=0 orif damier(nc)=/=vide then exit; fi;
    od;
    if nc=/=0 then
	if damier(nc)*joueur<0 then
	    nc2:=h_d(joueur,nc);
	    while nc2=/=0 do
		if damier(nc2)=/=vide then exit; fi;
		rec:=true;
		if damier2=/=none then kill(damier2); fi;
		damier2:=copy(damier);
		damier2(nc2):=damier(caz);
		damier2(nc):=bloc*joueur;
		damier2(caz):=vide;
		call recurse_dame(damier2,num+1,nc,nc2,true);
		nc2:=h_d(joueur,nc2);
	    od;
    fi; fi;
    nc:=caz;
    do
	nc:=b_g(joueur,nc);
	if nc=0 orif damier(nc)=/=vide then exit; fi;
    od;
    if nc=/=0 then
	if damier(nc)*joueur<0 then
	    nc2:=b_g(joueur,nc);
	    while nc2=/=0 do
		if damier(nc2)=/=vide then exit; fi;
		rec:=true;
		if damier2=/=none then kill(damier2); fi;
		damier2:=copy(damier);
		damier2(nc2):=damier(caz);
		damier2(nc):=bloc*joueur;
		damier2(caz):=vide;
		call recurse_dame(damier2,num+1,nc,nc2,true);
		nc2:=b_g(joueur,nc2);
	    od;
    fi; fi;
    nc:=caz;
    do
	nc:=b_d(joueur,nc);
	if nc=0 orif damier(nc)=/=vide then exit; fi;
    od;
    if nc=/=0 then
	if damier(nc)*joueur<0 then
	    nc2:=b_d(joueur,nc);
	    while nc2=/=0 do
		if damier(nc2)=/=vide then exit; fi;
		rec:=true;
		if damier2=/=none then kill(damier2); fi;
		damier2:=copy(damier);
		damier2(nc2):=damier(caz);
		damier2(nc):=bloc*joueur;
		damier2(caz):=vide;
		call recurse_dame(damier2,num+1,nc,nc2,true);
		nc2:=b_d(joueur,nc2);
	    od;
    fi; fi;
    if rec then kill(damier2)    
    else if prof then
	saut:=true;
	ec.nb:=num;
	attach(ec);
    fi; fi;
end recurse_dame;

begin (* calcul_liste_coup  *)
    ec:=new enreg_coup;
    array coup dim(1:21);
return;
do;
    saut:=false;
    nbmax:=2;
    nb_coup:=0;
    if liste_coup<>none then
	for i:=1 to upper(liste_coup) do
	    if liste_coup(i)<>none then kill(liste_coup(i)); fi;
    od; fi;
    for i:=1 to 50 do
	if damier(i)*joueur>0 then
	    if abs(damier(i))=pion then
		call recurse_pion(damier,1,0,i,false);
		if not saut then
		    nc:=h_g(joueur,i);
		    if nc=/=0 then
			if damier(nc)=vide then
			    coup(1):=i;
			    coup(2):=nc;
			    ec.nb:=2;
			    attach(ec);
		    fi; fi;
		    nc:=h_d(joueur,i);
		    if nc=/=0 then
			if damier(nc)=vide then
			    coup(1):=i;
			    coup(2):=nc;
			    ec.nb:=2;
			    attach(ec);
		fi; fi; fi;
	    else call recurse_dame(damier,1,0,i,false);
		if not saut then
		    nc:=h_g(joueur,i);
		    while nc=/=0 do
			if damier(nc)=/=vide then exit; fi;
			coup(1):=i;
			coup(2):=nc;
			    ec.nb:=2;
			    attach(ec);
			nc:=h_g(joueur,nc);
		    od;
		    nc:=h_d(joueur,i);
		    while nc=/=0 do
			if damier(nc)=/=vide then exit; fi;
			coup(1):=i;
			coup(2):=nc;
			    ec.nb:=2;
			    attach(ec);
			nc:=h_d(joueur,nc);
		    od;
		    nc:=b_g(joueur,i);
		    while nc=/=0 do
			if damier(nc)=/=vide then exit; fi;
			coup(1):=i;
			coup(2):=nc;
			    ec.nb:=2;
			    attach(ec);
			nc:=b_g(joueur,nc);
		    od;
		    nc:=b_d(joueur,i);
		    while nc=/=0 do
			if damier(nc)=/=vide then exit; fi;
			coup(1):=i;
			coup(2):=nc;
			    ec.nb:=2;
			    attach(ec);
			nc:=b_d(joueur,nc);
		    od;
	fi; fi; fi;
    od;
    detach;
od;
    kill(coup);
end calcul_liste_coup;

unit valide:coroutine;
(* Renvoie TRUE si une ligne de Liste_Coup est ‚gal … Coup, FALSE sinon *)

var egaux:boolean,
    i,j,long1,long2,n_coup:integer,
    coup:arrayof integer,
    liste_coup:arrayof arrayof integer;
begin
return;
do
    long1:=upper(coup);
    long2:=upper(liste_coup(1));
    if (long1=long2) then
	for i:=1 to n_coup do
	    egaux:=true;
	    for j:=1 to long1 do
		if liste_coup(i,j)<>coup(j) then
		    egaux:=false;
		    exit;
		fi;
	    od;
	    if egaux then exit; fi;
	od;
    else egaux:=false;
    fi;
    detach;
od;
end valide;

unit init_damier:procedure(inout damier:arrayof integer);
(* Initialise le damier en m‚moire *)
(* en positionnant les pions comme en d‚but de partie *)

var i:integer;
begin
    if damier=none then array damier dim(1:50); fi;
    for i:=1 to 20 do damier(i):=noir; od;
    for i:=21 to 30 do damier(i):=vide; od;
    for i:=31 to 50 do damier(i):=blanc; od;
end init_damier;

unit aff_pions:coroutine;
(* Coroutine qui affiche … l'‚cran tous les pions du *)
(* damier en fonction du tableau damier en m‚moire *)

var i:integer;
begin
return;
do
    for i:=1 to 50 do
	if damier(i)=blanc then call aff_blanc(i)
	else if damier(i)=noir then call aff_noir(i)
	else if damier(i)=dameblanche then call aff_dameblanche(i)
	else if damier(i)=damenoire then call aff_damenoire(i)
	else call del_case(i);
	fi; fi; fi; fi;
    od;
    detach;
od;
end aff_pions;

unit calc_coord:coroutine;
(* Calcule les coordonn‚es du coin haut gauche de la case caz *)

var caz,h,v:integer;
begin
return;
do
    caz:=caz-1;
    if((caz div 5)mod 2=0)then h:=debhoriz+horiz+(caz mod 5)*horiz2;
    else h:=debhoriz+(caz mod 5)*horiz2; fi;
    v:=debvert+vert*(caz div 5);
    detach;
od;
end calc_coord;

unit aff_dameblanche:procedure(caz:integer);
(* Affiche une dame blanche sur la case caz *)

var h,v:integer;
begin
    cc.caz:=caz;   attach(cc);   h:=cc.h;   v:=cc.v;   clr.h:=h;   clr.v:=v;
    clr.long:=horiz1;   clr.haut:=vert1;   clr.col:=coulnoir;   attach(clr);
    clr.h:=h+9;   clr.v:=v+4;   clr.long:=15;   clr.haut:=12;
    clr.col:=coulblanc;   attach(clr);
    clr.h:=h+5;   clr.v:=v+8;   attach(clr);
end aff_dameblanche;

unit aff_damenoire:IIUWGraph procedure(caz:integer);
(* Affiche une dame noire sur la case caz *)

var h,v:integer;
begin
    cc.caz:=caz;   attach(cc);   h:=cc.h;   v:=cc.v;
    clr.h:=h;   clr.v:=v;   clr.long:=horiz1;   clr.haut:=vert1;
    clr.col:=coulnoir;   attach(clr);
    call color(coulblanc);   call move(h+9,v+8);
    call draw(h+9,v+4);   call draw(h+24,v+4);
    call draw(h+24,v+16);   call draw(h+20,v+16);
    call move(h+5,v+8);
    call draw(h+20,v+8);   call draw(h+20,v+20);
    call draw(h+5,v+20);   call draw(h+5,v+8);
end aff_damenoire;

unit aff_blanc:procedure(caz:integer);
(* affiche un pion blanc sur la case caz *)

var h,v:integer;
begin
    cc.caz:=caz;   attach(cc);   h:=cc.h;   v:=cc.v;
    clr.h:=h;   clr.v:=v;   clr.long:=horiz1;   clr.haut:=vert1;
    clr.col:=coulnoir;   attach(clr);
    clr.h:=h+7;   clr.v:=v+6;   clr.long:=14;   clr.haut:=12;
    clr.col:=coulblanc;   attach(clr);
end aff_blanc;

unit aff_noir:IIUWGraph procedure(caz:integer);
(* Affiche un pion noir sur la case caz *)

var h,v:integer;
begin
    cc.caz:=caz;   attach(cc);   h:=cc.h;   v:=cc.v;
    clr.h:=h;   clr.v:=v;   clr.long:=horiz1;   clr.haut:=vert1;
    clr.col:=coulnoir;   attach(clr);
    call color(coulblanc);   call move(h+7,v+6);   call draw(h+21,v+6);
    call draw(h+21,v+18);   call draw(h+7,v+18);   call draw(h+7,v+6);
end aff_noir;

unit aff_damier:IIUWGraph procedure;
(* Affiche un damier vide … l'‚cran *)

var i,j,bord,h,v:integer;
begin
    clr.h:=debhoriz-1;   clr.v:=debvert-1;
    clr.long:=10*horiz+1;   clr.haut:=10*vert+1;
    clr.col:=coulblanc;   attach(clr);
    bord:=horiz;   clr.v:=debvert;
    clr.long:=horiz1;   clr.haut:=vert1;   clr.col:=coulnoir;
    for i:=1 to 10 do
	clr.h:=debhoriz+bord;
	for j:=1 to 5 do
	    attach(clr);
	    clr.h:=clr.h+60;
	od;
	bord:=horiz-bord;
	clr.v:=clr.v+vert;
    od;
end aff_damier;

unit del_case:procedure(caz:integer);
(* Efface tout ce qui pourrait se trouver sur la case caz *) 

var h,v:integer;
begin
    cc.caz:=caz;   attach(cc);   h:=cc.h;   v:=cc.v;
    clr.h:=h;   clr.v:=v;   clr.long:=horiz1;   clr.haut:=vert1;
    clr.col:=coulnoir;   attach(clr);
end del_case;

unit clear:IIUWGraph coroutine;
(* Dessine un rectangle de coin haut gauche h,v et bas droit h+long,v+haut *)

var h,v,long,haut,col,i:integer;
begin
return;
do
    call color(col);
    for i:=0 to haut do
	call move(h,v+i);
	call draw(h+long,v+i);
    od;
    detach;
od;
end clear;

unit aff_tab_car:IIUWGraph procedure(h,v:integer,tab:arrayof char);
(* Affiche une chaŒne de caractŠres … l'‚cran *)

var i:integer;
begin
    clr.h:=h;   clr.v:=v;   clr.long:=(upper(tab)-lower(tab)+1)*8-1;
    clr.haut:=7;   clr.col:=coulnoir;   attach(clr);
    call color(coulblanc);   call move(h,v);
    for i:=lower(tab) to upper(tab) do
	call hascii(ord(tab(i)));
    od;
end aff_tab_car;

unit aff_nb:procedure(h,v,n,l:integer);
(* Transforme un nombre en tableau de chiffres puis appelle la *)
(* proc‚dure Aff_Tab_Car pour l'afficher sur un ‚cran graphique *)

var tab,bat:arrayof char,
    i,j,k:integer;
begin
    if n=0 then
	array tab dim(1:l);
	tab(1):='0';
	for i:=2 to l do tab(i):=' '; od;
	call aff_tab_car(h,v,tab);
    else
	array tab dim(1:6);
	if n<0 then
	    tab(1):='-';
	    i:=1;
	    n:=-n;
	fi;
	while n>0 do
	    i:=i+1;
	    tab(i):=chr((n mod 10)+48);
	    n:=n div 10;
	od;
	array bat dim(1:l);
	if tab(1)='-' then
	    bat(1):='-';
	    k:=1;
	fi;
	for j:=k+1 to i do
	    bat(j):=tab(i);
	    i:=i-1;
	od;
	for i:=j to l do bat(i):=' '; od;
	call aff_tab_car(h,v,bat);
	kill(bat);
    fi;
    kill(tab);
end aff_nb;

unit attend_bouton:mouse procedure(output h,v:integer);
(* Cette proc‚dure renvoie les coordonn‚es du pixel point‚ par la *)
(* souris lorsque le bouton gauche a ‚t‚ cliqu‚ pour la derniŠre fois *)

var l,r,c:boolean,
    h1,v1,p:integer;
begin
    do
	call getpress(0,h1,v1,p,l,r,c);
	if not l and not r and not c then exit fi;
    od;
    do
	call getpress(0,h,v,p,l,r,c);
	if l or r then exit fi;
    od;
	if r then 
	    pref IIUWGraph block begin
		call groff;
		writeln("Abandon d'un joueur");
		call endrun;
	    end;
	fi; 
end attend_bouton;

unit sur_damier:function(h,v:integer):boolean;
(* Retourne TRUE si le pixel de coordonn‚es *)
(* (h,v) est sur une case num‚rot‚e du damier *) 

begin
    if h>=debhoriz and v>=debvert and h<debhoriz+10*horiz and v<debvert+10*vert
    then result:=true
    else result:=false;
    fi;
end sur_damier;

unit num_caz:function(h,v:integer):integer;
(* Calcule le num‚ro de la case … laquelle *)
(* appartient le pixel de coordonn‚e (h,v) *)

var ligne,colon:integer;
begin
    ligne:=(v-debvert)div vert;
    colon:=(h-debhoriz)div horiz;
    if(ligne mod 2)+(colon mod 2)=1
    then result:=1+(5*ligne)+(colon div 2)
    else result:=0;
    fi;
end num_caz;


unit quelle_caz:IIUWGraph function:integer;       
(* Renvoie le num‚ro de la case o— on vient de cliquer *)

var h,v,n_c:integer;
begin
    do
	call attend_bouton(h,v);
	if sur_damier(h,v) then n_c:=num_caz(h,v); fi;
	if(h=0 or v=0)then quit:=true; fi;
	if n_c<>0 or quit then exit fi;
    od;
    result:=n_c;
end quelle_caz;

unit maj_aff:procedure(damier,coup:arrayof integer);
(* Met … jour l'affichage du damier en actualisant *)
(* … l'‚cran les cases point‚es par le tableau Coup *)

var i,n:integer;
begin
    for i:=1 to upper(coup) do
	n:=coup(i);
	case damier(n)
	when blanc:       call aff_blanc(n);
	when noir:        call aff_noir(n);
	when dameblanche: call aff_dameblanche(n);
	when damenoire:   call aff_damenoire(n);
	otherwise         call del_case(n);
	esac;
    od;
end maj_aff;

unit maj_damier:procedure(damier,coup:arrayof integer,joueur:integer);
(* Met … jour le damier en m‚moire en jouant le coup *)

var deb,fin,i,n:integer;
begin
    n:=upper(coup);
    deb:=coup(1);
    fin:=coup(n);
    for i:=2 step 2 to n-1 do damier(coup(i)):=0; od;
    if joueur=blanc then
	if fin<6
	then damier(fin):=dameblanche
	else damier(fin):=damier(deb); fi;
    else if fin>45
	then damier(fin):=damenoire
	else damier(fin):=damier(deb); fi;
    fi;
    if fin<>deb then damier(deb):=vide; fi;
end maj_damier;

unit aff_croix:IIUWGraph procedure(caz:integer);
(* Affiche une croix sur la case caz du damier *)

var h,v:integer;
begin
    cc.caz:=caz;   attach(cc);   h:=cc.h;   v:=cc.v;
    call color(coulrouge);   call move(h,v);
    call draw(h+horiz1,v+vert1);
    call move(h,v+vert1);
    call draw(h+horiz1,v);
    call color(coulblanc);
end aff_croix;

unit arbitre:IIUWGraph coroutine;
(* Cette coroutine initialise la partie (damier et coroutines), *)
(* gŠre la partie en donnant alternativement la main aux deux joueurs, *)
(* v‚rifie la validit‚ des coups jou‚s et gŠre leur affichage *)

var joueur,nmax,ncoup,coul,rep,rep1,i:integer,
    coup:arrayof integer,
    liste:arrayof arrayof integer,
    joueur1,joueur2:participant,
    val:valide;
begin
    call init_damier(damier);
    array liste dim(1:50);
    call init_deplact;
    clc:=new calcul_liste_coup;
    cc:=new calc_coord;
    ap:=new aff_pions;
    clr:=new clear;
    val:=new valide;
    for i:=1 to 25 do writeln; od;
    writeln("             JEU DE DAMES");
    writeln;
    writeln("Voici les options de ce jeu:");
    writeln;writeln;
    writeln("1 - Jouer contre l'ordinateur");
    writeln("2 - Deux joueurs");
    writeln("3 - Deux ordinateurs");
    writeln;
    do
	write("Quel est votre choix ? ");read(rep);writeln;
	if(rep>=1 and rep<=3) then exit; fi;
    od;
    case rep
    when 1:
	do 
	    write("Sous quelle couleur voulez-vous jouer (noir=-1/blanc=1)? ");
	    read(coul);writeln;
	    if (abs(coul)=1) then exit; fi;
	od;
	do
	    write("A quel niveau l'ordinateur doit-il jouer (1,2,etc)? ");
	    read(rep);writeln;
	    if rep>0 then exit; fi;
	od;
	if coul=blanc then
	    joueur1:=new player(damier,coul);
	    joueur2:=new computer(damier,-coul,rep);
	    rep1:=rep;
	else
	    joueur1:=new computer(damier,-coul,rep);
	    joueur2:=new player(damier,coul);
	fi;
    when 2:
	joueur1:=new player(damier,blanc);
	joueur2:=new player(damier,noir);
    when 3:
	do
	    write("A quel niveau l'ordinateur BLANC doit-il jouer (1,2,etc)? ");
	    read(rep);writeln;
	    if rep>0 then exit; fi;
	od;
	joueur1:=new computer(damier,blanc,rep);
	do
	    write("A quel niveau l'ordinateur NOIR doit-il jouer (1,2,etc)? ");
	    read(rep1);writeln;
	    if rep1>0 then exit; fi;
	od;
	joueur2:=new computer(damier,noir,rep);
    esac;
    call gron(5);
    call cls;
    call aff_damier;
    attach(ap);
    call aff_tab_car((debhoriz-40)div 2,debvert,unpack("Blanc"));
    call aff_tab_car(debhoriz+10*horiz+(debhoriz-32)div 2,debvert,
	unpack("Noir"));
    call aff_tab_car(240,(debvert-8)div 2,unpack("Joueur actif:"));
    if joueur1 is computer then
	call aff_tab_car((debhoriz-144)div 2,debvert+vert,
	    unpack("Machine niveau:"));
	call aff_nb((debhoriz-144)div 2+128,debvert+vert,rep,1);
    else
	call aff_tab_car((debhoriz-48)div 2,debvert+vert,unpack("Humain"));
    fi;
    if joueur2 is computer then
	call aff_tab_car(debhoriz+10*horiz+(debhoriz-144)div 2,debvert+vert,
	    unpack("Machine niveau:"));
	call aff_nb(debhoriz+10*horiz+(debhoriz-144)div 2+128,debvert+vert,rep1,1);
    else
	call aff_tab_car(debhoriz+10*horiz+(debhoriz-48)div 2,debvert+vert,
	    unpack("Humain"));
    fi;
    joueur:=blanc;
    call aff_tab_car((debhoriz-144)div 2,debvert+2*vert,
	unpack("Dernier coup jou‚:"));
    call aff_tab_car(debhoriz+10*horiz+(debhoriz-144)div 2,debvert+2*vert,
	unpack("Dernier coup jou‚:"));
    return;
    pref mouse block begin
	call showcursor;
    end;
    do
	clc.joueur:=joueur;   clc.damier:=damier;   clc.liste_coup:=liste;
	attach(clc);   nmax:=clc.nbmax;   ncoup:=clc.nb_coup;
	if ncoup=0 then
	    call groff;
	    if joueur=blanc
	    then writeln("Les BLANCS ont PERDU...")
	    else writeln("Les NOIRS ont PERDU...");
	    fi;
	    call endrun;
	fi;
	for i:=1 to ncoup do
	    kill(liste(i));
	od;
	pref mouse block begin    
	    call hidecursor;
	    if(joueur=blanc) then
		call aff_tab_car(360,(debvert-8)div 2,unpack("blanc"));
		call showcursor;
		attach(joueur1);
		coup:=joueur1.coupjou;
	    else
		call aff_tab_car(360,(debvert-8)div 2,unpack("noir "));
		call showcursor;
		attach(joueur2);
		coup:=joueur2.coupjou;
	    fi;
	end;
	do
	    clc.joueur:=joueur;   clc.damier:=damier;   clc.liste_coup:=liste;
	    attach(clc);   nmax:=clc.nbmax;   ncoup:=clc.nb_coup;
	    val.liste_coup:=liste;   val.coup:=coup;   val.n_coup:=ncoup;
	    attach(val);   if val.egaux then exit; fi;
	    if (joueur=blanc) then
		attach(joueur1);
		coup:=joueur1.coupjou;
	    else
		attach(joueur2);
		coup:=joueur2.coupjou;
	    fi;
	od;
	pref mouse block begin
	    call hidecursor;
	    call maj_damier(damier,coup,joueur);
	    call maj_aff(damier,coup);
	    if (joueur=blanc) then
		call aff_nb((debhoriz-40)div 2,debvert+3*vert,coup(1),2);
		call aff_nb((debhoriz-40)div 2+24,debvert+3*vert,
		    coup(upper(coup)),2);
	    else
		call aff_nb(debhoriz+10*horiz+(debhoriz-40)div 2,
		    debvert+3*vert,coup(1),2);
		call aff_nb(debhoriz+10*horiz+(debhoriz-40)div 2+24,
		    debvert+3*vert,coup(upper(coup)),2);
	    fi;
	    call showcursor;
	    joueur:=-joueur;
	end;
    od;
end arbitre;

unit participant:mouse coroutine(damier:arrayof integer,moi:integer);
(* Cette coroutine pr‚fixe les coroutines computer et player *)

var coupjou:arrayof integer;
begin
end participant;

unit computer:participant coroutine(prof:integer);
(* Calcule le coup que l'ordianteur va jouer *)

var alf,i,k,maxi,ncoup,nmax,num,valeur:integer,
    damierec:arrayof integer,
    listejou:arrayof arrayof integer,
    rec:recurrence;
 
unit recurrence:coroutine(jeu:arrayof integer);
(* Cette coroutine pr‚fixe les coroutines note, alpha et beta *)

var alf,bet,resultat:integer;
begin
end recurrence;

unit note:recurrence coroutine(moi:integer);
(* Attribut une note … la position du damier: *)
(* positive si elle est favorable … l'ordinateur, n‚gative sinon *)

var c,i,k:integer,
    val,val2,val3,val4:arrayof integer;
begin
    array val dim(1:50);   array val2 dim(1:50);
    array val3 dim(1:50);   array val4 dim(1:50);
    val(3):=18;
    val(2),val(8),val(13),val(9),val(4):=17;
    val(1),val(7),val(12),val(18),val(23),val(19),val(14),val(10),val(5):=16;
    val(6),val(11),val(17),val(22),val(28):=15;
	val(33),val(29),val(24),val(20),val(15):=15;
    val(16),val(21),val(27),val(32),val(38):=14;
	val(43),val(39),val(34),val(30),val(25):=14;
    val(26),val(31),val(37),val(42),val(48):=13;
	val(49),val(44),val(40),val(35):=13;
    val(36),val(41),val(47),val(50),val(45):=12;
    val(46):=11;
    if moi=noir then
	i:=50;
	for c:=1 to 50 do
	    k:=val(c); val(c):=val(i); val(i):=k; i:=i-1;
    od; fi;
    i:=50;
    for c:=1 to 50 do
	    val2(c):=val(i); i:=i-1;
	    val3(c):=30+val(c);
	    val4(c):=30+val2(c);
    od;
return;
do
    resultat:=0;
    for i:=1 to 50 do
	k:=jeu(i)*moi;
	case k
	when blanc:       resultat:=resultat+val(i);
	when noir:        resultat:=resultat-val2(i);
	when dameblanche: resultat:=resultat+val3(i);
	when damenoire:   resultat:=resultat-val4(i);
	esac;
    od;
    detach;
od;
end note;

unit alpha:recurrence coroutine(qui,prof:integer);
(* Maximise les coups de l'ordinateur *)

var i,k,maxi,ncoup,nmax,valeur:integer,
    damier:arrayof integer,
    liste:arrayof arrayof integer,
    rec:recurrence;
begin
    array damier dim(1:50);
    array liste dim(1:50);
    if prof>1
    then rec:=new beta(damier,-qui,prof-1)
    else rec:=new note(damier,moi);
    fi;
return;
do
    clc.joueur:=qui;   clc.damier:=jeu;   clc.liste_coup:=liste;
    attach(clc);   nmax:=clc.nbmax;   ncoup:=clc.nb_coup;
    if ncoup<=0
    then resultat:=-999
    else
	maxi:=-1000;
	for i:=1 to ncoup do
	    for k:=1 to 50 do damier(k):=jeu(k); od;
	    call maj_damier(damier,liste(i),qui);
		rec.alf:=alf;
		rec.bet:=bet;
		attach(rec);
		valeur:=rec.resultat;
		if maxi<valeur then
		    maxi:=valeur;
		    if alf<maxi then alf:=maxi; fi;
		    if maxi>=bet then
			exit;
		fi; fi;
	    kill(liste(i));
	od;
	for k:=i to ncoup do kill(liste(k));od;
	resultat:=maxi;
    fi;
    detach;
od;
end alpha;

unit beta:recurrence coroutine(qui,prof:integer);
(* Minimise les coups du joueur *)

var i,k,maxi,ncoup,nmax,valeur:integer,
    damier:arrayof integer,
    liste:arrayof arrayof integer,
    rec:recurrence;
begin
    array damier dim(1:50);
    array liste dim(1:50);
    if prof>1
    then rec:=new alpha(damier,-qui,prof-1)
    else rec:=new note(damier,moi);
    fi;
return;
do
    clc.joueur:=qui;   clc.damier:=jeu;   clc.liste_coup:=liste;
    attach(clc);   nmax:=clc.nbmax;   ncoup:=clc.nb_coup;
    if ncoup<=0
    then resultat:=999
    else
	maxi:=1000;
	for i:=1 to ncoup do
	    for k:=1 to 50 do damier(k):=jeu(k); od;
	    call maj_damier(damier,liste(i),qui);
		rec.alf:=alf;
		rec.bet:=bet;
		attach(rec);
		valeur:=rec.resultat;
	    if maxi>valeur then
		maxi:=valeur;
		if bet>maxi then bet:=maxi; fi;
		if maxi<=alf then
		    exit;
	    fi; fi;
	    kill(liste(i));
	od;
	for k:=i to ncoup do kill(liste(k));od;
	resultat:=maxi;
    fi;
    detach;
od;
end beta;

begin (*computer*)
    array listejou dim(1:50);
    array damierec dim(1:50);
    rec:=new beta(damierec,-moi,prof);
return;
    call hidecursor;
    if moi=blanc then
	call aff_tab_car((debhoriz-80)div 2,debvert+6*vert,unpack("Note: "));
	call aff_tab_car((debhoriz-112)div 2,debvert+4*vert,
	    unpack("Meilleur coup:"));
	call aff_tab_car((debhoriz-120)div 2,debvert+7*vert,
	    unpack("Coup en calcul:"));
    else
	call aff_tab_car((debhoriz+10*horiz+(debhoriz-80)div 2),
	    debvert+6*vert,unpack("Note: "));
	call aff_tab_car((debhoriz+10*horiz+(debhoriz-112)div 2),
	    debvert+4*vert,unpack("Meilleur coup:"));
	call aff_tab_car((debhoriz+10*horiz+(debhoriz-120)div 2),
	    debvert+7*vert,unpack("Coup en calcul:"));
    fi;
    do
	if moi=blanc then
	    call aff_tab_car((debhoriz-40)div 2,debvert+5*vert,unpack("-- --"));
	    call aff_tab_car(((debhoriz-80)div 2)+48,debvert+6*vert,
		unpack("    "));
	else
	    call aff_tab_car((debhoriz+10*horiz+(debhoriz-40)div 2),
		debvert+5*vert,unpack("-- --"));
	    call aff_tab_car((debhoriz+10*horiz+(debhoriz-80)div 2+48),
		debvert+6*vert,unpack("    "));
	fi;
	call showcursor;
	clc.joueur:=moi;   clc.damier:=damier;   clc.liste_coup:=listejou;
	attach(clc);   nmax:=clc.nbmax;   ncoup:=clc.nb_coup;
	if ncoup=1 then
	    coupjou:=listejou(1);
	    listejou(1):=none;
	else
	    maxi:=-1000;
	    alf:=-999;
	    for i:=1 to ncoup do
		call hidecursor;
		if moi=blanc then
		    call aff_nb(((debhoriz-40)div 2),debvert+8*vert,
			listejou(i,1),4);
		    call aff_nb(((debhoriz-40)div 2)+24,debvert+8*vert,
			listejou(i,upper(listejou(i))),4);
		else
		    call aff_nb((debhoriz+10*horiz+(debhoriz-40)div 2),
			debvert+8*vert,listejou(i,1),4);
		    call aff_nb((debhoriz+10*horiz+(debhoriz-40)div 2)+24,
			debvert+8*vert,listejou(i,upper(listejou(i))),4);
		fi;
		call showcursor;
		for k:=1 to 50 do damierec(k):=damier(k); od;
		call maj_damier(damierec,listejou(i),moi);
		rec.alf:=alf;
		rec.bet:=999;
		attach(rec);
		valeur:=rec.resultat;
		if valeur=maxi then
		    if moi=blanc then
			if random<0.75 then
			    kill(coupjou);
			    coupjou:=copy(listejou(i));
			    kill(listejou(i));
			fi;
		    else if random>0.75 then
			kill(coupjou);
			coupjou:=copy(listejou(i));
			kill(listejou(i));
		fi; fi; fi;
		if maxi<valeur then
		    maxi:=valeur;
		    if alf<maxi then alf:=maxi; fi;
		    kill(coupjou);
		    coupjou:=copy(listejou(i));
		    kill(listejou(i));
		fi;
		call hidecursor;
		if moi=blanc then
		    call aff_nb(((debhoriz-80)div 2)+48,debvert+6*vert,maxi,4);
		    call aff_nb(((debhoriz-40)div 2),debvert+5*vert,
coupjou(1) (*listejou(num,1)*) ,4);
		    call aff_nb(((debhoriz-40)div 2)+24,debvert+5*vert,
coupjou(nmax) (*listejou(num,upper(listejou(num)))*) ,4);
		else
		    call aff_nb((debhoriz+10*horiz+(debhoriz-80)div 2)+48,
			debvert+6*vert,maxi,4);
		    call aff_nb((debhoriz+10*horiz+(debhoriz-40)div 2),
debvert+5*vert,coupjou(1) (*listejou(num,1)*) ,4);
		    call aff_nb((debhoriz+10*horiz+(debhoriz-40)div 2)+24,
debvert+5*vert,coupjou(nmax) (*listejou(num,upper(listejou(num)))*) ,4);
		fi;
		call showcursor;
	    od;
	    call hidecursor;
	    if moi=blanc then
		call aff_tab_car((debhoriz-40)div 2,debvert+8*vert,unpack("-- --"));
	    else
		call aff_tab_car((debhoriz+10*horiz+(debhoriz-40)div 2),
		    debvert+8*vert,unpack("-- --"));
	    fi;
	    call showcursor;
(*coupjou:=listejou(num);*)
	fi;
	detach;
	call showcursor;
    od;
end computer;

unit player:participant coroutine;
(* Enregistre le coup jou‚ par l'utilisateur *)

var ok,q,ret,saute:boolean,
    cas,deb,fin,i,j,k,ncoup,nmax,prof:integer,
    coupe,damierjou:arrayof integer,
    listejou:arrayof arrayof integer;
begin
    array listejou dim(1:50);
return;
do
    clc.joueur:=moi;   clc.damier:=damier;   clc.liste_coup:=listejou;
    attach(clc);   nmax:=clc.nbmax;   ncoup:=clc.nb_coup;
    damierjou:=damier;   array coupe dim(1:21);  
    do
	do      
	    ok:=false;
	    deb:=1;
	    prof:=1;
	    cas:=quelle_caz;
	    if(cas<>0) then
		if(damier(cas)=moi or damier(cas)=(moi+moi))then
		    i:=1;
		    coupe(i):=cas;
		    exit;
	    fi; fi;
	od;
	j:=deb;
	while(j<=ncoup) do
	    if coupe(1)=listejou(j,1) then 
		ok:=true;
		deb:=j;
		exit;
	    fi;
	    j:=j+1;      
	od;
	while((j<=ncoup) and ok) do
	    if coupe(1)=listejou(j,1)
	    then j:=j+1;
	    else exit;
	    fi;
	od;
	fin:=j-1;
	if ok then exit; fi;
    od;   
(*    pref mouse block begin*)
	call hidecursor;
	call aff_croix(cas);
	call showcursor;
	cas:=quelle_caz;
	if (upper(listejou(1))>2)
	then saute:=true;
	else saute:=false;
	fi;
	do
	    deb:=1;
	    fin:=ncoup;
	    ret:=false;
	    if saute
	    then i:=i+2;
	    else i:=i+1;
	    fi;
	    coupe(i):=cas;
	    q:=false;
	    ok:=false;
	    if i>1 andif not(saute) andif coupe(i)=coupe(i-1) then 
		i:=i-1;
		ret:=true;
	    fi;
	    if i>2 andif saute andif coupe(i)=coupe(i-2) then   
		i:=i-2;
		ret:=true;
	    fi;
	    if ret then   
		call hidecursor;
		case damier(coupe(i))
		when blanc:       call aff_blanc(coupe(i));
		when noir:        call aff_noir(coupe(i));
		when dameblanche: call aff_dameblanche(coupe(i));
		when damenoire:   call aff_damenoire(coupe(i));
		otherwise         call del_case(coupe(i));
		esac;
		if saute
		then i:=i-2;
		else i:=i-1;
		fi;
		call showcursor;
	    else          
		if i=2 then
		    if (damier(coupe(1))=moi and(coupe(2)=h_d(moi,coupe(1)) 
		    or coupe(2)=h_g(moi,coupe(1))))
		    then saute:=false;
		    else
			if (damier(coupe(1))=moi) then
			    i:=i+1;
			    coupe(3):=coupe(2);
			    saute:=true;
		fi; fi; fi;
		j:=deb;
		if (i<=nmax) then
		    while(j<=fin) do
			ok:=true;
			k:=1;
			while k<=i do
			    if coupe(k)<>listejou(j,k) then 
				ok:=false;
				exit;
			    fi;
			    if saute
			    then k:=k+2;
			    else k:=k+1;
			    fi;
			od;
			if ok then
			    deb:=j;
			    exit;
			else j:=j+1;      
			fi;
		    od;
		    j:=deb;
		    while((j<=fin) and ok) do
			k:=1;
			while k<=i do
			    if coupe(k)<>listejou(j,k) then
				q:=true;
				exit; 
			    fi;
			    if saute
			    then k:=k+2;
			    else k:=k+1;
			    fi;
			od;
			if q then exit; fi;
			j:=j+1;
		    od;
		    fin:=j-1;
		else
		    saute:=false;
		    i:=i-1;
		fi;
		if ok then
		    call hidecursor;
		    call aff_croix(cas);
		    call showcursor;
		else
		    if saute
		    then i:=i-2;
		    else i:=i-1;
		fi; fi;
		if (i=nmax) then exit; fi;
	    fi;         
	    cas:=quelle_caz;
	od;
	array coupjou dim (1:i);
	for i:=1 to upper(coupjou) do
	    coupjou(i):=listejou(deb,i);
	od;
(*    end;*)
    detach;
od;
end player;

begin (*main*)
    pref mouse block;
    var driver:boolean,
	bouton:integer;
    begin
	(* v‚rifie qu'un gestionnaire de souris est install‚ *)

	driver:=init(bouton);
	if driver
	then writeln("Une souris avec ",bouton:1, " boutons a ‚t‚ d‚tect‚e");
	else writeln("Erreur: aucune souris n'a ‚t‚ d‚tect‚e
	    , celle-ci est obligatoire"); exit;
	fi;
	pref IIUWGraph block
	begin
	(*v‚rifie que la carte vid‚o pr‚sente est support‚e par le programme*)

	    case nocard
		when 5:
		(* Cas d'une carte EGA/VGA/SVGA *)
		    writeln("Une carte EGA ou compatible VGA a ‚t‚ d‚tect‚e");
		    coulblanc:=15;coulnoir:=0;coulrouge:=12;
		    horiz:=30;vert:=25;debhoriz:=160;debvert:=50;
		    horiz1:=29;vert1:=24;horiz2:=60;
		otherwise
		    writeln("La carte vid‚o pr‚sente n'est pas supportee
			par le programme: ",nocard);
		    writeln("Une carte EGA ou compatible VGA est obligatoire");
		    exit;
	    esac;
	    arb:=new arbitre;
	    attach(arb);
	end (*IIUWGraph*);
    end (* mouse *)
end (* program *)