Résolution du puzzle de l' Ane rouge en Prolog

Trap D

Ce programme montre les facilités offertes par Prolog pour résoudre le puzzle de l' Ane Rouge et comment utiliser XPCE pour afficher la suite des coups.

- Titre : Résolution du puzzle de l' Ane rouge en Prolog

- Auteur : Trap D

- Parution : 5 mai 2011

- Mise à jour : 5 mai 2011

- Licence : 2

Sommaire

- I. Le puzzle de l' Ane Rouge

- I-A. Qu'est-ce-que l' Ane Rouge ?

- I-B. Pourquoi ce programme ?

- I-C. Organisation du programme

- II. La gestion de la recherche en largeur

- II-A. Les différences avec le programme de partage

- II-B. Utilité du repeat/0

- III. Le code

- III-A. Le module principal

- III-B. Le module de gestion des mouvements de l'âne

- III-C. L'animation XPCE

I - Le puzzle de l' Ane Rouge

I-A - Qu'est-ce-que l' Ane Rouge ?

L'Ane rouge est un casse-tête d'origine thaÏlandaise dont la première solution optimale a été donnée par Martin Gardner dans la revue Scientific American. La position initiale est en général celle-ci.

Il s'agit de faire passer le carré rouge à la place des deux carrés simples jaunes et des deux cases vides marrons comme montré ici.

La position des autres pièces n'a aucune importance.
L'affichage de la solution sous forme d'animation, écrite à l'aide de XPCE, est visible ici.

I-B - Pourquoi ce programme ?

L'idée m'est venue d'écrire un programme Prolog pour résoudre ce puzzle suite à la parution du défi C/C++ et à une remarque sur le forum Prolog ou un contributeur avait écrit :

"Euh non d'apres mon prof aucun programme Prolog sur l'Ane Rouge n'est dispo sur la toile Dommage xD
A faire tout seul ^^ "

Je l'ai donc fait tout seul. Je publie ma solution, ce grave manque est maintenant réparé.

I-C - Organisation du programme

La résolution du puzzle se prête bien à une recherche en largeur dans l'arbre des possibilités. A chaque étape de la recherche, on cherche tous les mouvements possibles qui amènent à des configuration non encore vues, on crée ainsi de nouveaux chemins, et on recommence.
L'organisation du programme est semblable à celle du problème des bidons : trois modules

- 'probleme.pl', le module principal qui construit la recherche en largeur.

- 'ane-rouge.pl' le module qui gère les déplacements des pièces et définit les états de départ et final.

- 'anime-ane-rouge.pl' le module qui gère l'affichage de la solution.

Cette organisation se traduit en Prolog par l'ajout dans le module principal, en tête de fichier, de prédicats use_module/1, un pour chaque module nécessaire.

Prolog

% Entete du fichier probleme.pl
% predicats de chargement des modules necessaires au programme
:- use_module('ane-rouge.pl').
:- use_module('anime-ane-rouge.pl').

Nous allons maintenant étudier chaque module.

II - La gestion de la recherche en largeur

II-A - Les différences avec le programme de partage

Elle diffère sensiblement de celle du programme de partage. Dans le programme de partage, la largeur et la profondeur de la recherche étaient faibles, dans celui de l'Ane rouge la largeur est assez faible (deux/trois mouvements à peu près à chaque tour) mais la profondeur est importante 86 ou 116 selon les mouvements acceptés).
On va donc

- utiliser un repeat (et non plus la récursivité) pour gérer l'enchaînement des recherches

- mémoriser dans la base de données Prolog les chemins déjà parcourus

- laisser au module 'Ane rouge.pl' le soin de mémoriser les états déjà visités, donc le module de recherche ne s'occupera que d'ajouter les états accessibles à partir du dernier état atteint aux différents chemins déjà parcourus

Pourquoi la dernière modification par rapport au programme de partage ? Etant donné la taille de l'espace de recherche il est nécessaire pour cause d'encombrement mémoire de coder les états parcourus, ce codage dépend évidemment du problème étudié et est dévolu au module 'ane-rouge.pl', autant donc vérifier, au moment de ce codage que l'état n'a pas déjà été rencontré.

II-B - Utilité du repeat/0

Je ne m'étendrai pas sur les détails du module de recherche en largeur, tout est expliqué ici.
Il faut simplement savoir que repeat/0 dans le code du prédicat etape_suivante/0, offre un nombre illimité de points de choix et donc, lorsque le test final ((Y = [] ; recherche_terminee(Y, R)) échoue, on revient au prédicat suivant repeat/0, et on recommence une nouvelle recherche.
Le repeat/0 évite ainsi l'empilement des procédure récursives et l'explosion de la pile d'exécution.

III - Le code

III-A - Le module principal

Le code complet du module est donné ici :

Module 'probleme.pl'

:- use_module('ane-rouge.pl').
:- use_module('anime-ane-rouge').

% Ce squelette de programme permet la recherche
% du plus court chemin pour atteindre un état donné
% à partir d'un état initial dans un graphe.
%
% Il construit la liste de tous les chemins parcourus à partir
% de l'état initial en ajoutant à chaque etape les noeuds accessibles
% à partir du dernier noeud atteint.
% Les chemins sont construits à l'envers.

% chemins/1 memorise les chemins parcourus
% déclare en "dynamic" puisque son contenu va varier pendant le
% déroulement du programme
:- dynamic chemins/1.

ane_rouge :-
% on nettoie la base de donnees Prolog
retractall(chemins(_)),

% on charge la position initiale de l'ane rouge
etat_initial(Init),

% on memorise la premiere étape du parcours
assert(chemins([[Init]])),

% on appelle le predicat de recherche en largeur
% time/1 permet d'avoir des statistiques
% sur le déroulement du prédicat (duree, nombre d'inférences...
time(etape_suivante),

% ici on récupere le resultat de la recherche
chemins(S),

% on l'affiche
affiche_resultat(S).

% le prédicat de parcours en largeur
etape_suivante :-
% on simule un tant que
repeat,
% on récupère les chemins deja construits
% en les supprimant de la base de donnes Prolog
retract(chemins(X)),

% on calcule l'étape suivante
calcule_etape_suivante(X, Y),

% on memorise les nouveaux chemins
assert(chemins(Y)),

% on s'arrete s'il n'y a plus de chemin
% ou si on a trouve la position finale
((Y = [] ; recherche_terminee(Y, R)),

% dans ca cas, on inverse le chemin gagnant
% et on le memorise
retract(chemins(_)),reverse(R, S), assert(chemins(S))).

% On travaille sur la liste de tous les
% chemins déjà créés.
calcule_etape_suivante([], []).

calcule_etape_suivante([H|T],Y) :-
calcule_etape_suivante(T, X1),
etape_suivante_un_chemin(H, X2),
append(X2,X1,Y).

% On travaille sur un chemin particulier
% On construit la liste de tous les états accessibles
% depuis le dernier état atteint,
% puis on les ajoute au chemin
% sans aucun test puisqu'on est sur qu'il n'a pas
% déja ete visite
etape_suivante_un_chemin([N | L] , X) :-
etats_suivants(N, LN),
ajoute(LN,[N| L], X).

% on ajoute les nouveaux noeuds au chemin
% dont ils sont issus
ajoute([], _, []).

ajoute([H|T], L, [[H | L] | X]) :-
ajoute(T, L, X).

% le dernier etat atteint est-il l'etat final ?
noeud_terminal_atteint([Final|_A]):-
etat_final(Final).

% test d'arrivée à l'état final
% on ne garde que le premier chemin de la liste
% si le prédicat reussit.
recherche_terminee(Y,R) :-
include(noeud_terminal_atteint, Y, [R |_]).

% Enlever le % pour lancer le problème
% automatiquement à la fin de la compilation
% :-ane_rouge.

III-B - Le module de gestion des mouvements de l'âne

Le puzzle est "symétrique" verticalement, on peut donc associer à chaque état rencontré l'état "symétrique", cela allège la recherche de la solution. Pour limiter la taille de la liste des états rencontrés, chaque état est codé avec un calcul utilisant la base 4. Exemple de calcul pour la position de départ :

calcul_key(cq(LCQ, CCQ), bh(LBH,CBH),
bv(LBV1,CBV1), bv(LBV2,CBV2), bv(LBV3,CBV3), bv(LBV4,CBV4),
cs(LCS1,CCS1), cs(LCS2,CCS2), cs(LCS3,CCS3), cs(LCS4,CCS4),
H3) :-
H1 is ((LCQ*4+CCQ)*4+LBH)*4+CBH,
H2 is (((((((H1*4+LBV1)*4+CBV1)*4+LBV2)*4+CBV2)*4+LBV3)*4+CBV3)*4+LBV4)*4+CBV4,
H3 is (((((((H2*4+LCS1)*4+CCS1)*4+LCS2)*4+CCS2)*4+LCS3)*4+CCS3)*4+LCS4)*4+CCS4.

calcul_key_sym(cq(LCQ, CCQ), bh(LBH,CBH),
bv(LBV1,CBV1), bv(LBV2,CBV2), bv(LBV3,CBV3), bv(LBV4,CBV4),
cs(LCS1,CCS1), cs(LCS2,CCS2), cs(LCS3,CCS3), cs(LCS4,CCS4),
H3) :-

% le carré et le bloc horizontal ont 2 carreaux de largeur
CCQ1 is 2 - CCQ, CBH1 is 2 - CBH,
CBV11 is 3 - CBV1, CBV21 is 3 - CBV2, CBV31 is 3 - CBV3, CBV41 is 3 - CBV4,
sort([bv(LBV1,CBV11), bv(LBV2,CBV21), bv(LBV3,CBV31), bv(LBV4,CBV41)],
[bv(LBV10,CBV10), bv(LBV20,CBV20), bv(LBV30,CBV30), bv(LBV40,CBV40)]),

% les autres pièces ont 1 seul carreau de largeur
CCS11 is 3 - CCS1, CCS21 is 3 - CCS2, CCS31 is 3 - CCS3, CCS41 is 3 - CCS4,
sort([cs(LCS1,CCS11), cs(LCS2,CCS21), cs(LCS3,CCS31), cs(LCS4,CCS41)],
[cs(LCS10,CCS10), cs(LCS20,CCS20), cs(LCS30,CCS30), cs(LCS40,CCS40)]),

H1 is ((LCQ*4+CCQ1)*4+LBH)*4+CBH1,
H2 is (((((((H1*4+LBV10)*4+CBV10)*4+LBV20)*4+CBV20)*4+LBV30)*4+CBV30)*4+LBV40)*4+CBV40,
H3 is (((((((H2*4+LCS10)*4+CCS10)*4+LCS20)*4+CCS20)*4+LCS30)*4+CCS30)*4+LCS40)*4+CCS40.

test :-
% position initiale
calcul_key(cq(0, 1), bh(2,1),
bv(0,0), bv(0,3), bv(2,0), bv(2,3),
cs(3,1), cs(3,2), cs(4,0), cs(4,3),
H1),
writeln(H1),
calcul_key_sym(cq(0, 1), bh(2,1),
bv(0,0), bv(0,3), bv(2,0), bv(2,3),
cs(3,1), cs(3,2), cs(4,0), cs(4,3),
H2),
writeln(H2).

Le résultat obtenu est

?- test.
107433680659
107433680659
true.

La position initiale est symétrique, on obtient bien le même résultat. Le code complet du module est donné ici :

Module 'ane-rouge.pl'

:- module('ane-rouge.pl',[etat_initial/1
,etat_final/1,
etats_suivants/2]).

:- discontiguous move2/3.
:- dynamic tous_les_etats/1.

/*
La liste des différentes pièces
vi(L, C) -> les cases vides (2)
cs(L, C) -> les carrés simples (4)
bh(L, C) -> le bloc horizontal
bv(L, C) -> les blocs verticaux (4)
cq(L, C) -> l'ane (carre quatre)
*/

% bon ane rouge
etat_initial(Init):-
retractall(tous_les_etats(_)),
% il faut mémoriser cette position
Init = [[vi(4,1), vi(4,2)],
[cq(0,1), bh(2,1),
[bv(0,0), bv(0,3), bv(2,0), bv(2,3)],
[cs(3,1), cs(3,2), cs(4,0), cs(4,3)]]],

calcul_key(cq(0,1), bh(2,1),
bv(0,0), bv(0,3), bv(2,0), bv(2,3),
cs(3,1), cs(3,2), cs(4,0), cs(4,3),
H),

assert(tous_les_etats(H)).

etat_final([_,[cq(3,1)| _]]).

etats_suivants([VI, PI], ListeEtats) :-
findall(L, move1(VI, PI, L), LE),
findall(L1, move2(VI, PI, L1), LE1),
reconstitue(LE1, LE, ListeEtats).

reconstitue([], L, L1):-
% on enleve les etats déjà rencontrés
include(etat_jamais_vu, L, L1).

reconstitue([[] | T], L, LF) :-
!,
reconstitue(T, L, LF).

reconstitue([H|T], L, LF) :-
append(L, H, L1),
reconstitue(T, L1, LF).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% recherche des mouvements des différentes pièces

% ane rouge se deplace vers le haut
move1([vi(L1,C), vi(L1,C1)], [cq(L,C) | H], [ [vi(L, C), vi(L,C1)], [cq(L1, C) | H]]) :-
% les conditions d'application
C1 is C+1,
L1 is L - 1.

% ane rouge se deplace vers la droite
move1([vi(L,C1), vi(L1,C1)], [cq(L,C) | H], [[vi(L, C), vi(L1,C)], [cq(L, NC) | H]]) :-
% les conditions d'application
L1 is L+1,
C1 is C + 2,
NC is C+1.

% ane rouge se deplace vers le bas
move1([vi(L1,C1), vi(L1,C2)], [cq(L,C) | H], [ [vi(L, C1), vi(L,C2)], [cq(NL, C) | H]]) :-
% les conditions d'application
C = C1, C2 is C1+1,
L1 is L + 2,
NL is L+1.

% ane rouge se deplace vers la gauche
move1([vi(L,C1), vi(L1,C1)], [cq(L,C) | H], [[vi(L, NC), vi(L1,NC)], [cq(L, C1) | H]]) :-
% les conditions d'application
L1 is L+1,
C1 is C -1,
NC is C + 1.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Les déplacements du bloc horizontal
% vers le haut
move1([vi(L1,C), vi(L1,C1)], [AR, bh(L,C) | H], [[vi(L, C), vi(L,C1)], [AR, bh(L1, C) | H]]) :-
% les conditions d'application
C1 is C+1,
L is L1+1.

%vers le bas
move1([vi(L1,C), vi(L1,C1)], [AR, bh(L,C)| H], [[vi(L, C), vi(L,C1)], [AR, bh(L1, C) | H]]) :-
% les conditions d'application
C1 is C+1,
L is L1 - 1.

%  vers la gauche
move1([vi(L,C1), vi(L2,C2)], [AR, bh(L,C)| H], [NVI, [AR , bh(L, C1) | H]]) :-
% les conditions d'application
C1 is C - 1,
NC is C+1,
sort([vi(L, NC), vi(L2,C2)], NVI).

% vers la gauche
move1([vi(L2,C2), vi(L,C1)],  [AR, bh(L,C)| H], [NVI, [AR, bh(L, C1) | H]]) :-
% les conditions d'application
C1 is C - 1,
NC is C+1,
sort([vi(L2, C2), vi(L,NC)], NVI).

% vers la gauche de deux cases
move1([vi(L,C1), vi(L,C2)],  [AR, bh(L,C3)| H], [[vi(L, C3), vi(L, NC)], [AR, bh(L, C1) | H]]) :-
% les conditions d'application
C2 is C1 + 1,
C3 is C2 + 1,
NC is C3 + 1.

% vers la droite
move1([vi(L,C1), vi(L2,C2)],  [AR, bh(L,C)| H], [NVI, [AR, bh(L, NC) | H]]) :-
% les conditions d'application
C1 is C + 2,
NC is C+1,
sort([vi(L, C), vi(L2,C2)], NVI).

%  vers la droite
move1([vi(L2,C2), vi(L,C1)],  [AR, bh(L,C)| H], [NVI, [AR, bh(L, NC) | H]]) :-
% les conditions d'application
C1 is C + 2,
NC is C+1,
sort([vi(L2, C2), vi(L,C)], NVI).

%  vers la droite de deux cases
move1([vi(L,C1), vi(L,C2)],  [AR, bh(L,C3)| H], [[vi(L, C3), vi(L,NC)], [AR, bh(L, C1) | H]]) :-
% les conditions d'application
C1 is C3 + 2,
C2 is C1 + 1,
NC is C3 + 1.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Les déplacements du bloc vertical
% le haut
reconstitue_bv1([BV2, BV3, BV4], [AR, BH, CS], [NVI, NBV1], [NVI, [AR, BH, BVN, CS]]) :-
BVN = [NBV1, BV2, BV3, BV4].
reconstitue_bv2([BV1, BV3, BV4], [AR, BH, CS], [NVI, NBV2], [NVI, [AR, BH, BVN, CS]]) :-
BVN = [BV1, NBV2, BV3, BV4].
reconstitue_bv3([BV1, BV2, BV4], [AR, BH, CS], [NVI, NBV3], [NVI, [AR, BH, BVN, CS]]) :-
BVN = [BV1, BV2, NBV3, BV4].
reconstitue_bv4([BV1, BV2, BV3], [AR, BH, CS], [NVI, NBV4], [NVI, [AR, BH, BVN, CS]]) :-
BVN = [BV1, BV2, BV3, NBV4].

move2(VI, [AR, BH, [BV1, BV2, BV3, BV4], CS], L) :-
findall(R, move_bv(VI, BV1, R), LR), % R = [NVI, CS1N],
maplist(reconstitue_bv1([BV2, BV3, BV4], [AR, BH, CS]), LR, L).

move2(VI, [AR, BH, [BV1, BV2, BV3, BV4], CS], L) :-
findall(R, move_bv(VI, BV2, R), LR), % R = [NVI, CS1N],
maplist(reconstitue_bv2([BV1, BV3, BV4], [AR, BH, CS]), LR, L).

move2(VI, [AR, BH, [BV1, BV2, BV3, BV4], CS], L) :-
findall(R, move_bv(VI, BV3, R), LR), % R = [NVI, CS1N],
maplist(reconstitue_bv3([BV1, BV2, BV4], [AR, BH, CS]), LR, L).

move2(VI, [AR, BH, [BV1, BV2, BV3, BV4], CS], L) :-
findall(R, move_bv(VI, BV4, R), LR), % R = [NVI, CS1N],
maplist(reconstitue_bv4([BV1, BV2, BV3], [AR, BH, CS]), LR, L).

% le haut
move_bv([vi(L1,C), vi(L2,C2)], bv(L,C), [NVI, bv(L1, C)]) :-
L1 is L - 1,
NL is L+1,
sort([vi(NL, C), vi(L2,C2)], NVI).

% vers le haut
move_bv([vi(L2,C2), vi(L1,C)], bv(L,C), [NVI, bv(L1, C)]) :-
L1 is L - 1,
NL is L+1,
sort([vi(L2,C2), vi(NL, C)], NVI).

% vers le haut de 2 cases
move_bv([vi(L1,C), vi(L2,C)], bv(L3,C), [[vi(L3,C), vi(NL, C)], bv(L1, C)]) :-
L2 is L1 + 1,
L3 is L2 + 1,
NL is L3 + 1.

%  vers le bas
move_bv([vi(L1,C), vi(L2,C2)], bv(L,C), [NVI, bv(NL, C)]) :-
L1 is L + 2,
NL is L+1,
sort([vi(L, C), vi(L2,C2)], NVI).

%  vers le bas
move_bv([vi(L2,C2), vi(L1,C)], bv(L,C), [NVI, bv(NL, C)]) :-
L1 is L + 2,
NL is L+1,
sort([vi(L2,C2), vi(L, C)], NVI).

%  vers le bas de 2 cases
move_bv([vi(L1,C), vi(L2,C)], bv(L3,C), [[vi(L3,C), vi(NL, C)], bv(L1, C)]) :-
L1 is L3 + 2,
L2 is L1 + 1,
NL is L3 + 1.

%  la droite
move_bv([vi(L,C1), vi(L1,C1)], bv(L,C), [[vi(L,C), vi(L1, C)], bv(L, C1)]) :-
% conditions de déplacement
L1 is L + 1,
C is C1 - 1.

%  la gauche
move_bv([vi(L,C1), vi(L1,C1)], bv(L,C), [[vi(L,C), vi(L1, C)], bv(L, C1)]) :-
% conditions de déplacement
L1 is L +1,
C is C1 + 1.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Les déplacements du carre simple
%
% vers le haut
reconstitue_cs1([CS2, CS3, CS4], [AR, BH, BV], [NVI, CS1N], [NVI, [AR, BH, BV, CSN]]) :-
CSN = [CS1N, CS2, CS3, CS4].
reconstitue_cs2([CS1, CS3, CS4], [AR, BH, BV], [NVI, CS2N], [NVI, [AR, BH, BV, CSN]]) :-
CSN = [CS1, CS2N, CS3, CS4].
reconstitue_cs3([CS1, CS2, CS4], [AR, BH, BV], [NVI, CS3N], [NVI, [AR, BH, BV, CSN]]) :-
CSN = [CS1, CS2, CS3N, CS4].
reconstitue_cs4([CS1, CS2, CS3], [AR, BH, BV], [NVI, CS4N], [NVI, [AR, BH, BV, CSN]]) :-
CSN = [CS1, CS2, CS3, CS4N].

move2(VI, [AR, BH, BV, [CS1, CS2, CS3, CS4]], L) :-
findall(R, move_cs(VI, CS1, R), LR), % R = [NVI, CS1N],
maplist(reconstitue_cs1([CS2, CS3, CS4], [AR, BH, BV]), LR, L).

move2(VI, [AR, BH, BV, [CS1, CS2, CS3, CS4]], L) :-
findall(R, move_cs(VI, CS2, R), LR), % R = [NVI, CS1N],
maplist(reconstitue_cs2([CS1, CS3, CS4], [AR, BH, BV]), LR, L).

move2(VI, [AR, BH, BV, [CS1, CS2, CS3, CS4]], L) :-
findall(R, move_cs(VI, CS3, R), LR), % R = [NVI, CS1N],
maplist(reconstitue_cs3([CS1, CS2, CS4], [AR, BH, BV]), LR, L).

move2(VI, [AR, BH, BV, [CS1, CS2, CS3, CS4]], L) :-
findall(R, move_cs(VI, CS4, R), LR), % R = [NVI, CS1N],
maplist(reconstitue_cs4([CS1, CS2, CS3], [AR, BH, BV]), LR, L).

% vers le haut
move_cs([vi(L1,C), vi(L2,C2)], cs(L,C), [NVI, cs(L1, C)]):-
L is L1 + 1,
sort([vi(L, C), vi(L2,C2)], NVI).

% vers le haut
move_cs([vi(L2,C2), vi(L1,C)], cs(L,C), [NVI, cs(L1, C)]):-
L is L1 + 1,
sort([vi(L2,C2), vi(L, C)], NVI).

% vers le haut de 2 cases
move_cs([vi(L1,C), vi(L2,C)], cs(L3,C), [[vi(L2,C), vi(L3, C)], cs(L1, C)]):-
L2 is L1 + 1,
L3 is L2 + 1.

% vers le bas
move_cs([vi(L1,C), vi(L2,C2)], cs(L,C), [NVI, cs(L1, C)]):-
L is L1 - 1,
sort([vi(L, C), vi(L2,C2)], NVI).

% vers le bas
move_cs([vi(L2,C2), vi(L1,C)], cs(L,C), [NVI, cs(L1, C)]):-
L is L1 - 1,
sort([vi(L2,C2), vi(L, C)], NVI).

% vers le bas de deux cases
move_cs([vi(L1,C), vi(L2,C)], cs(L3,C), [[vi(L3,C), vi(L1, C)], cs(L2, C)]):-
L1 is L3 + 1,
L2 is L1 + 1.

% vers la droite
move_cs([vi(L,C1), vi(L2,C2)], cs(L,C), [NVI, cs(L, C1)]):-
C is C1 - 1,
sort([vi(L, C), vi(L2,C2)], NVI)  .

move_cs([vi(L2,C2), vi(L,C1)], cs(L,C), [NVI, cs(L, C1)]):-
C is C1 - 1,
sort([vi(L2,C2), vi(L, C)], NVI).

% vers la droite de 2 cases
move_cs([vi(L,C1), vi(L,C2)], cs(L,C3), [[vi(L,C3), vi(L, C1)], cs(L, C2)]):-
C1 is C3 + 1,
C2 is C1 + 1.

% vers la gauche
move_cs([vi(L,C1), vi(L2,C2)], cs(L,C), [NVI, cs(L, C1)]):-
C is C1 + 1,
sort([vi(L, C), vi(L2,C2)], NVI).

move_cs([vi(L2,C2), vi(L,C1)], cs(L,C), [NVI, cs(L, C1)]):-
C is C1 + 1,
sort([vi(L2,C2), vi(L, C)], NVI).

% vers la gauche de 2 cases
move_cs([vi(L,C1), vi(L,C2)], cs(L,C3), [[vi(L,C2), vi(L, C3)], cs(L, C1)]):-
C1 is C3 - 2,
C2 is C1 + 1.

% les mouvements en angles
% droite -> Haut DDH
move_cs([vi(NL,NC), vi(L, NC)], cs(L,C), [[vi(L,C), vi(L, NC)], cs(NL, NC)]):-
NL is L - 1,
NC is C + 1.
%    NVI = [vi(L,C), vi(L, NC)].

% droite -> haut DHD
move_cs([vi(NL,C), vi(NL, NC)], cs(L,C), [[vi(NL,C), vi(L, C)], cs(NL, NC)]):-
NL is L - 1,
NC is C + 1.
%    NVI = [vi(NL,C), vi(L, C)].

% gauche -> Haut DGH
move_cs([vi(NL,NC), vi(L, NC)], cs(L,C), [[vi(L,NC), vi(L, C)], cs(NL, NC)]):-
NL is L - 1,
NC is C - 1.

% gauche -> Haut DHG
move_cs([vi(NL,NC), vi(NL, C)], cs(L,C), [[vi(NL,C), vi(L, C)], cs(NL, NC)]):-
NL is L - 1,
NC is C - 1.

% droite -> bas DDB
move_cs([vi(L,NC), vi(NL, NC)], cs(L,C), [[vi(L,C), vi(L, NC)], cs(NL, NC)]):-
NL is L + 1,
NC is C + 1.

% droite -> bas DBD
move_cs([vi(NL,C), vi(NL, NC)], cs(L,C), [[vi(L,C), vi(NL, C)], cs(NL, NC)]):-
NL is L + 1,
NC is C + 1.

% gauche -> bas DGB
move_cs([vi(L,NC), vi(NL, NC)], cs(L,C), [[vi(L,NC), vi(L, C)], cs(NL, NC)]):-
NL is L + 1,
NC is C - 1.

% gauche -> bas DBG
move_cs([vi(NL,NC), vi(L, NC)], cs(L,C), [[vi(L,C), vi(L, NC)], cs(NL, NC)]):-
NL is L + 1,
NC is C - 1.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Test des etats deja rencontres
%
etat_jamais_vu(H) :-
H = [_VI, [cq(LCQ, CCQ), bh(LBH,CBH), BV, CS]],
sort(BV, [bv(LBV1,CBV1), bv(LBV2,CBV2), bv(LBV3,CBV3), bv(LBV4,CBV4)]),
sort(CS, [cs(LCS1,CCS1), cs(LCS2,CCS2), cs(LCS3,CCS3), cs(LCS4,CCS4)]),

calcul_key(cq(LCQ, CCQ), bh(LBH,CBH),
bv(LBV1,CBV1), bv(LBV2,CBV2), bv(LBV3,CBV3), bv(LBV4,CBV4),
cs(LCS1,CCS1), cs(LCS2,CCS2), cs(LCS3,CCS3), cs(LCS4,CCS4),
H1),

calcul_key_sym(cq(LCQ, CCQ), bh(LBH,CBH),
bv(LBV1,CBV1), bv(LBV2,CBV2), bv(LBV3,CBV3), bv(LBV4,CBV4),
cs(LCS1,CCS1), cs(LCS2,CCS2), cs(LCS3,CCS3), cs(LCS4,CCS4),
H2),
(   \+tous_les_etats(H1), \+tous_les_etats(H2)),
!,
assert(tous_les_etats(H1)),
assert(tous_les_etats(H2)).

calcul_key(cq(LCQ, CCQ), bh(LBH,CBH),
bv(LBV1,CBV1), bv(LBV2,CBV2), bv(LBV3,CBV3), bv(LBV4,CBV4),
cs(LCS1,CCS1), cs(LCS2,CCS2), cs(LCS3,CCS3), cs(LCS4,CCS4),
H3) :-
H1 is ((LCQ*4+CCQ)*4+LBH)*4+CBH,
H2 is (((((((H1*4+LBV1)*4+CBV1)*4+LBV2)*4+CBV2)*4+LBV3)*4+CBV3)*4+LBV4)*4+CBV4,
H3 is (((((((H2*4+LCS1)*4+CCS1)*4+LCS2)*4+CCS2)*4+LCS3)*4+CCS3)*4+LCS4)*4+CCS4.

calcul_key_sym(cq(LCQ, CCQ), bh(LBH,CBH),
bv(LBV1,CBV1), bv(LBV2,CBV2), bv(LBV3,CBV3), bv(LBV4,CBV4),
cs(LCS1,CCS1), cs(LCS2,CCS2), cs(LCS3,CCS3), cs(LCS4,CCS4),
H3) :-
CCQ1 is 2 - CCQ, CBH1 is 2 - CBH,
CBV11 is 3 - CBV1, CBV21 is 3 - CBV2, CBV31 is 3 - CBV3, CBV41 is 3 - CBV4,
sort([bv(LBV1,CBV11), bv(LBV2,CBV21), bv(LBV3,CBV31), bv(LBV4,CBV41)],
[bv(LBV10,CBV10), bv(LBV20,CBV20), bv(LBV30,CBV30), bv(LBV40,CBV40)]),

CCS11 is 3 - CCS1, CCS21 is 3 - CCS2, CCS31 is 3 - CCS3, CCS41 is 3 - CCS4,
sort([cs(LCS1,CCS11), cs(LCS2,CCS21), cs(LCS3,CCS31), cs(LCS4,CCS41)],
[cs(LCS10,CCS10), cs(LCS20,CCS20), cs(LCS30,CCS30), cs(LCS40,CCS40)]),

H1 is ((LCQ*4+CCQ1)*4+LBH)*4+CBH1,
H2 is (((((((H1*4+LBV10)*4+CBV10)*4+LBV20)*4+CBV20)*4+LBV30)*4+CBV30)*4+LBV40)*4+CBV40,
H3 is (((((((H2*4+LCS10)*4+CCS10)*4+LCS20)*4+CCS20)*4+LCS30)*4+CCS30)*4+LCS40)*4+CCS40.

III-C - L'animation XPCE

Deux objets importants dans cette animation :

- Le gestionnaire qui gère la liste des déplacements et le cadencement de ceux-ci.

- Le scheduler qui gère chaque déplacement de pièces

Le code complet du module est donné ici :

Module 'anime-ane-rouge.pl'

:- module('anime-ane-rouge.pl',[affiche_resultat/1]).
:- use_module(library(pce)).

affiche_resultat([H | T]) :-
new(D, window('L'' Ane rouge')),
send(D, size, size(271,350)),
get(@display, size, size(SCRX,SCRY)),
PX is (SCRX - 271)/2,
PY is (SCRY - 350) / 2,

new(B1, box(251, 310)),
R is  165 * 257,
G1 is  42 * 257,
B is 42 * 257,
send(B1, fill_pattern,  colour(@default,R, G1, B)),
send(D, display, B1,point(10,10)),

new(B2, box(207, 258)),
send(B2, fill_pattern, colour(@default, 65535, 65535, 65535)),
send(D, display, B2,point(32,36)),

% on cree d'abord le gestionnaire
new(G, gestionnaire(D)),
% on cree ensuite le scheduler
new(S, scheduler(G)),

% Destruction des objets Gestionnaire et Scheduler puis de la fenetre
send(D, done_message, and(message(@prolog, 'delete_object', S, G),
message(@receiver,destroy))),

send(D, open),
get(D, frame, Frame),
send(Frame, move, point(PX, PY)),

% on cree les pieces
H = [_, [cq(XCQ,YCQ),bh(XBH,YBH),
[bv(XBV1,YBV1),bv(XBV2,YBV2),bv(XBV3,YBV3),bv(XBV4,YBV4)],
[cs(XCS1,YCS1),cs(XCS2,YCS2),cs(XCS3,YCS3),cs(XCS4,YCS4)]]],
% on cree l'ane
new(CQ, t_pion(point(XCQ,YCQ), 101, 101, red, D)),
send(CQ, set_scheduler, S),
send(G, set_cq, CQ) ,

% on cree le bloc horizontal
new(BH, t_pion(point(XBH,YBH), 101, 50, green, D)),
send(BH, set_scheduler, S),
send(G, set_bh, BH) ,

% on cree les blocs verticaux
new(BV1, t_pion(point(XBV1,YBV1), 50, 101, blue, D)),
send(BV1, set_scheduler, S),
send(G, set_bv1, BV1) ,

new(BV2, t_pion(point(XBV2,YBV2), 50, 101, blue, D)),
send(BV2, set_scheduler, S),
send(G, set_bv2, BV2) ,

new(BV3, t_pion(point(XBV3,YBV3), 50, 101, blue, D)),
send(BV3, set_scheduler, S),
send(G, set_bv3, BV3) ,

new(BV4, t_pion(point(XBV4,YBV4), 50, 101, blue, D)),
send(BV4, set_scheduler, S),
send(G, set_bv4, BV4) ,

% on cree les carrés simples
new(My_grey,  colour(@default, 48830, 48830, 48830)),
new(CS1, t_pion(point(XCS1,YCS1), 50, 50, My_grey, D)),
send(CS1, set_scheduler, S),
send(G, set_cs1, CS1) ,

new(CS2, t_pion(point(XCS2,YCS2), 50, 50, My_grey, D)),
send(CS2, set_scheduler, S),
send(G, set_cs2, CS2) ,

new(CS3, t_pion(point(XCS3,YCS3), 50, 50, My_grey, D)),
send(CS3, set_scheduler, S),
send(G, set_cs3, CS3) ,

new(CS4, t_pion(point(XCS4,YCS4), 50, 50, My_grey, D)),
send(CS4, set_scheduler, S),
send(G, set_cs4, CS4) ,

chain_list(XL, T),
send(G, liste, XL),
send(G?mytimer, start(once)).

% il faut arréter les timers avant de détruire la fenetre
delete_object(S,G) :-
send(S?mytimer, stop),
send(G?mytimer, stop).

% classe permettant le dessin des pions
:- pce_begin_class(pion(boite, fenetre), object).

variable(boite, box, both, "objet lui-même").
% Fenetre d'affichage
variable(fenetre, object, both, "fenêtre d'affichage du pion").

% méthode pour l'initialisation du dessin
initialise(P, Largeur:int, Hauteur : int, Couleur : colour, Fenetre : object) :->
"Création à partir de la taille et de la couleur"::
new(Bo, box(Largeur, Hauteur)),
send(Bo, fill_pattern, Couleur),
send(P, boite, Bo),
send(P, fenetre, Fenetre).

% dessin d'un pion au moment de l'initialisation
dessine(P, Pos) :->
get(P, fenetre, Fenetre),
get(Pos, x, Y),
get(Pos, y, X),
get(P, boite, Bo),
PosX is X * 50 + X + 1 + 33,
PosY is Y * 50 + Y + 1 + 37,
send(Fenetre, display, Bo,point(PosX,PosY)).

deplace(P, Pos) :->
get(P, fenetre, Fenetre),
get(P, boite, Bo),
send(Fenetre, display, Bo,Pos).

:- pce_end_class.

% classe gérant les pions
:- pce_begin_class(t_pion(boite, position, schedule), object).
variable(boite, pion, both, "son dessin").
variable(position, point, both, "coordonnées du pion").
variable(schedule, scheduler, both, "Cadence l'affichage").

% méthode pour l'initialisation de l'objet
initialise(P, Pos : point,
Largeur : int,
Hauteur : int,
Couleur : colour,
Fenetre : object) :->
new(B, pion(Largeur, Hauteur, Couleur, Fenetre)),
send(P, boite, B),
send(P, position, Pos),
send(B, dessine, Pos).

set_scheduler(P, S : scheduler) :->
send(P, schedule, S).

move_to(P, NP : point) :->
% trace,
get(P, position, Pos),
get(Pos, x, X),
get(Pos, y, Y),
get(NP, x, NX),
get(NP, y, NY),
(   ((X \= NX; Y \= NY),
get(P, schedule, S),
get(P, boite, Pion),
send(S, set, Pion, Pos, NP),
send(P, position, NP))
;
true
).

% a cause des déplacements en diagonale des carrés simples
move_to_cs(P, NP : point, V1 : point, V2 : point) :->
% trace,
get(P, position, Pos),
get(Pos, x, X),
get(Pos, y, Y),
get(NP, x, NX),
get(NP, y, NY),
get(P, schedule, S),
get(P, boite, Pion),
% trace,
(   ((X \= NX; Y \= NY),
(     send(P, position, NP),
% il faut maintenant calculer si c'est un déplacement en diagonale
(X = NX ; Y = NY),
send(S, set, Pion, point(X,Y), NP)
;

% ici c'est un déplacement en diagonale
(   get(V1, x, XV1), get(V1, y , YV1),
get(V2, x, XV2), get(V2, y , YV2),
calcule_delta_diagonale(X,Y, NX, NY, XV1, YV1, XV2, YV2, Delta),
send(S, set_cs, Pion, point(X,Y), NP, Delta)
)
))
;
true
).

:- pce_end_class.

% deplacement droite haut -> ^ (code DDH) correct
calcule_delta_diagonale(L, C, NL, NC, L, C, L, NC, 2) :-
NL is L - 1,
NC is C + 1.

% deplacement  haut droite  ^ -> (code DHD correct)
calcule_delta_diagonale(L, C, NL, NC, NL, C, L, C, 3) :-
NL is L - 1,
NC is C + 1.

% deplacement gauche haut <- ^  (correct)
calcule_delta_diagonale(L, C, NL, NC, L, NC, L, C, 4) :-
NL is L - 1,
NC is C - 1.

% deplacement  haut gauche  ^ <-
calcule_delta_diagonale(L, C, NL, NC, NL, C, L, C, 5) :-
NL is L - 1,
NC is C - 1.

% deplacement droite bas -> v
calcule_delta_diagonale(L, C, NL, NC, L, C, L, NC, -2) :-
NL is L + 1,
NC is C + 1.

% deplacement  bas droite  v ->
calcule_delta_diagonale(L, C, NL, NC, L, C, NL, C, -3) :-
NL is L + 1,
NC is C + 1.

% deplacement gauche bas <- v
calcule_delta_diagonale(L, C, NL, NC, L, NC, L, C, -4) :-
NL is L + 1,
NC is C - 1.

% deplacement  bas gauche  v <-
calcule_delta_diagonale(L, C, NL, NC, L, C, NL, C, -5) :-
NL is L + 1,
NC is C - 1.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% module définissant l'objet gérant chaque deplacement de piece
:- pce_begin_class(scheduler, object).

variable(boite,     pion, both, "pion se déplacant").
variable(curpos,    point, both, "position courante du pion").
variable(endpos,    point, both, "position d'arrivée du pion").
variable(gestion,   object, both, "Gestionnaire de l'animation").
variable(mytimer,   timer,  both, "timer lançant l'animation fréquence 20 fois par seconde").
variable(delta,     int,    both, "1 on va à droite ou vers le bas, -1, autres direction").
variable(deltadiag, int,    both, "2 -> NE, 3 -> NO, -2 -> SE, -3 -> SO").

% méthode appelée lors de la destruction de l'objet
% On arrête d'abord le timer pour poursuivre ensuite
% sans problème (appel par le timer de ressources libérées)
unlink(F) :->
send(F?mytimer, stop),
send(F, send_super, unlink).

% initialisation de l'objet
initialise(P, G : gestionnaire) :->
send(P, gestion, G),
% Les déplacements ont lieu à la vitesse de 200 par seconde
send(P, mytimer, new(_, timer(0.005,message(P, my_message)))).

set(P, Boite : pion, Curpos : point, Endpos : point) :->
% writeln('scheduler got'),
send(P, boite, Boite),
get(Curpos, x, Y),
get(Curpos, y, X),
PosX is X * 50 + X + 1 + 33,
PosY is Y * 50 + Y + 1 + 37,
send(P, curpos, point(PosX, PosY)),

get(Endpos, x, EY),
get(Endpos, y, EX),
PosEX is EX * 50 + EX + 1 + 33,
PosEY is EY * 50 + EY + 1 + 37,
send(P, endpos, point(PosEX, PosEY)),
% calcul du delta
calcul_delta(X, EX, Y, EY, Delta),
send(P, delta, Delta),
send(P, deltadiag, 0),
% on lance l'animation
send(P?mytimer, start).

set_cs(P, Boite : pion, Curpos : point, Endpos : point, Deltadiag : int) :->
% writeln('scheduler got'),
send(P, boite, Boite),
get(Curpos, x, Y),
get(Curpos, y, X),
PosX is X * 50 + X + 1 + 33,
PosY is Y * 50 + Y + 1 + 37,
send(P, curpos, point(PosX, PosY)),

get(Endpos, x, EY),
get(Endpos, y, EX),
PosEX is EX * 50 + EX + 1 + 33,
PosEY is EY * 50 + EY + 1 + 37,
send(P, endpos, point(PosEX, PosEY)),
% calcul du delta en fonction de deltadiag
% trace,
send_delta(P, Deltadiag),
send(P, deltadiag, Deltadiag),
% on lance l'animation
send(P?mytimer, start).

my_message(P) :->
get(P, curpos, CP),
get(P, endpos,EM),
get(CP, y, CY),
get(EM, y, NY),
get(CP, x, CX),
get(EM, x, NX),
(   ((CY = NY, CX = NX),
send(P?mytimer, stop),
get(P, gestion, G),
send(G?mytimer, start(once))
)
;
(    % on regarde d'abord le deltadiag
get(P, delta, D),
get(P, deltadiag, DG),
deplace_diag(P, DG, D, CX, CY, NX, NY)
)
).

deplace_X(P) :->
get(P, boite, Bo),
get(P, curpos, CP),
get(CP, x, CX),
get(CP, y, CY),
get(P, delta, Delta),
CX1 is CX + Delta,
send(P, curpos, point(CX1, CY)),
send(Bo, deplace, point(CX1, CY)).

deplace_Y(P) :->
get(P, boite, Bo),
get(P, curpos, CP),
get(CP, x, CX),
get(CP, y, CY),
get(P, delta, Delta),
CY1 is CY + Delta,
send(P, curpos, point(CX, CY1)),
send(Bo, deplace, point(CX, CY1)).

:- pce_end_class.

calcul_delta(X, EX, Y, Y, 1) :-
X < EX, !.

calcul_delta(X, EX, Y, Y, -1) :-
X > EX, !.

calcul_delta(X, X, Y, EY, 1) :-
Y < EY, !.

calcul_delta(X, X, Y, EY, -1) :-
Y > EY, !.

send_delta(P, 2) :-
send(P, delta, 1).

send_delta(P, 3) :-
send(P, delta, -1).

send_delta(P, 4) :-
send(P, delta, -1).

send_delta(P, 5) :-
send(P, delta, -1).

send_delta(P, -2) :-
send(P, delta, 1).

send_delta(P, -3) :-
send(P, delta, 1).

send_delta(P, -4) :-
send(P, delta, -1).

send_delta(P, -5) :-
send(P, delta, 1).

% delta_diag(P, DG, D, CX, CY, NX, NY)
deplace_diag(P, 0, _, CX, _CY, CX, _NY) :-
send(P, deplace_Y).

deplace_diag(P, 0, _, _CX, CY, _NX, CY) :-
send(P, deplace_X).

% Deplacement DDH
deplace_diag(P, 2, 1, CX, _CY, CX, _NY) :-
!,
send(P, delta, -1),
send(P, deplace_Y).

deplace_diag(P, 2, 1, _CX, _CY, _NX, _NY) :-
send(P, deplace_X).

deplace_diag(P, 2, -1, _CX, _CY, _NX, _NY) :-
send(P, deplace_Y).

% Deplacement DHD
deplace_diag(P, 3, -1, _CX, CY, _NX, CY) :-
!,
send(P, delta, 1),
send(P, deplace_X).

deplace_diag(P, 3, -1, _CX, _CY, _NX, _NY) :-
send(P, deplace_Y).

deplace_diag(P, 3, 1, _CX, _CY, _NX, _NY) :-
send(P, deplace_X).

% Deplacement DGH
deplace_diag(P, 4, -1, CX, _CY, CX, _NY) :-
!,
send(P, deplace_Y).

deplace_diag(P, 4, -1, _CX, _CY, _NX, _NY) :-
send(P, deplace_X).

% Deplacement DHG
deplace_diag(P, 5, -1, _CX, CY, _NX, CY) :-
!,
send(P, deplace_X).

deplace_diag(P, 5, -1, _CX, _CY, _NX, _NY) :-
send(P, deplace_Y).

% Deplacement DDB
deplace_diag(P, -2, 1, CX, _CY, CX, _NY) :-
!,
send(P, deplace_Y).

deplace_diag(P, -2, 1, _CX, _CY, _NX, _NY) :-
send(P, deplace_X).

% Deplacement DBD
deplace_diag(P, -3, 1, _CX, CY, _NX, CY) :-
send(P, deplace_X).

deplace_diag(P, -3, 1, _CX, _CY, _NX, _NY) :-
send(P, deplace_Y).

% Deplacement DGB
deplace_diag(P, -4, -1, CX, _CY, CX, _NY) :-
!,
send(P, delta, 1),
send(P, deplace_Y).

deplace_diag(P, -4, -1, _CX, _CY, _NX, _NY) :-
send(P, deplace_X).

deplace_diag(P, -4, 1, _CX, _CY, _NX, _NY) :-
send(P, deplace_Y).

% Deplacement DBG
deplace_diag(P, -5, 1, _CX, CY, _NCX, CY) :-
!,
send(P, delta, -1),
send(P, deplace_X).

deplace_diag(P, -5, -1, _CX, _CY, _NX, _NY) :-
send(P, deplace_X).

deplace_diag(P, -5, 1, _CX, _CY, _NX, _NY) :-
send(P, deplace_Y).

% classe définissant l'objet gérant la liste des coups
% et le cadencement des déplacements de pièces
:- pce_begin_class(gestionnaire(liste, p1, mytimer), object).
variable(liste, object,  both, "liste d'affichage").
variable(cq, t_pion, both, "pion a afficher").
variable(bh, t_pion, both, "pion a afficher").
variable(bv1, t_pion, both, "pion a afficher").
variable(bv2, t_pion, both, "pion a afficher").
variable(bv3, t_pion, both, "pion a afficher").
variable(bv4, t_pion, both, "pion a afficher").
variable(cs1, t_pion, both, "pion a afficher").
variable(cs2, t_pion, both, "pion a afficher").
variable(cs3, t_pion, both, "pion a afficher").
variable(cs4, t_pion, both, "pion a afficher").
variable(coups, int,  both, "nombre de déplacements effectués").
variable(fenetre, object, both, "pour afficher le nombre de déplacements").
variable(mytimer, timer, both, "attente avant lancement d'action de transvasement").

% méthode appelée lors de la destruction de l'objet
% On arrête d'abord le timer pour poursuivre ensuite
% sans problème (appel par le timer de ressources libérées)
unlink(F) :->
send(F?mytimer, stop),
send(F, send_super, unlink).

initialise(P, Fenetre) :->
send(P, coups, 0),
send(P, fenetre, Fenetre),
send(P, mytimer, new(_, timer(1,message(P, my_message)))).

set_cq(P, Pion : t_pion) :->
send(P, cq, Pion).
set_bh(P, Pion : t_pion) :->
send(P, bh, Pion).
set_bv1(P, Pion : t_pion) :->
send(P, bv1, Pion).
set_bv2(P, Pion : t_pion) :->
send(P, bv2, Pion).
set_bv3(P, Pion : t_pion) :->
send(P, bv3, Pion).
set_bv4(P, Pion : t_pion) :->
send(P, bv4, Pion).
set_cs1(P, Pion : t_pion) :->
send(P, cs1, Pion).
set_cs2(P, Pion : t_pion) :->
send(P, cs2, Pion).
set_cs3(P, Pion : t_pion) :->
send(P, cs3, Pion).
set_cs4(P, Pion : t_pion) :->
send(P, cs4, Pion).

% message d'initialisation du champs liste
set_liste(P, L) :->
send(P, liste, L).

% message interne envoyé par le timer
% Action principale du gestionnaire
my_message(P) :->
% trace,
get(P, liste, XL),
chain_list(XL, L),
(   L \= [] ,
L = [V1,V2,CQ,BH,BV1,BV2,BV3,BV4,CS1,CS2,CS3,CS4 | T],
get(P, coups, Coups),
Coups1 is Coups + 1,
send(P, coups, Coups1),
% pour gérer les mouvements en diagonales des carrés simples
% savoir par quelle case vide passer
get(V1, x, XV1),    get(V1, y, YV1),
get(V2, x, XV2),    get(V2, y, YV2),
get(CQ, x, XCQ),    get(CQ, y, YCQ),
get(BH, x, XBH),    get(BH, y, YBH),
get(BV1, x, XBV1),    get(BV1, y, YBV1),
get(BV2, x, XBV2),    get(BV2, y, YBV2),
get(BV3, x, XBV3),    get(BV3, y, YBV3),
get(BV4, x, XBV4),    get(BV4, y, YBV4),
get(CS1, x, XCS1),    get(CS1, y, YCS1),
get(CS2, x, XCS2),    get(CS2, y, YCS2),
get(CS3, x, XCS3),    get(CS3, y, YCS3),
get(CS4, x, XCS4),    get(CS4, y, YCS4),
chain_list(XT, T),
send(P, liste, XT),
get(P, cq, Cq),        send(Cq, move_to, point(XCQ, YCQ)),
get(P, bh, Bh),           send(Bh, move_to, point(XBH, YBH)),
get(P, bv1, Bv1),    send(Bv1, move_to, point(XBV1, YBV1)),
get(P, bv2, Bv2),    send(Bv2, move_to, point(XBV2, YBV2)),
get(P, bv3, Bv3),    send(Bv3, move_to, point(XBV3, YBV3)),
get(P, bv4, Bv4),    send(Bv4, move_to, point(XBV4, YBV4)),
get(P, cs1, Cs1),    send(Cs1, move_to_cs, point(XCS1, YCS1),
point(XV1, YV1), point(XV2, YV2)),
get(P, cs2, Cs2),    send(Cs2, move_to_cs, point(XCS2, YCS2),
point(XV1, YV1), point(XV2, YV2)),
get(P, cs3, Cs3),    send(Cs3, move_to_cs, point(XCS3, YCS3),
point(XV1, YV1), point(XV2, YV2)),
get(P, cs4, Cs4),    send(Cs4, move_to_cs, point(XCS4, YCS4),
point(XV1, YV1), point(XV2, YV2))
;
get(P, coups, Coups),
sformat(Str, 'Solution trouvée en ~w déplacements', [Coups]),
new(Str1, string(Str)),
new(Tx1, text(Str1?value)),
send(Tx1, colour(black)),
send(Tx1, font, font(times, bold, 12)),
get(P, fenetre, Fenetre),
% calcul de la largeur du texte pour centrage
get(font(times, bold, 12), width(Str1), M),
XT1 is 10 + (251 - M)/2,
send(Fenetre, display,Tx1, point(XT1, 330))).

:- pce_end_class.

% definition des classes permettant la création
% des pions  de l'ane rouge
:- pce_begin_class(cq, object, "L'ane rouge").
variable(x, int,  both, "abscisse").
variable(y, int, both, "ordonnee").

initialise(P, X : int, Y : int) :->
send(P, x, X),
send(P, y, Y).

:- pce_end_class.

:- pce_begin_class(vi, object, "les cases vides").
variable(x, int,  both, "abscisse").
variable(y, int, both, "ordonnee").

initialise(P, X : int, Y : int) :->
send(P, x, X),
send(P, y, Y).

:- pce_end_class.

:- pce_begin_class(cs, object, "les carrés simples").
variable(x, int,  both, "abscisse").
variable(y, int, both, "ordonnee").

initialise(P, X : int, Y : int) :->
send(P, x, X),
send(P, y, Y).

:- pce_end_class.

:- pce_begin_class(bv, object, "les blocs verticaux").
variable(x, int,  both, "abscisse").
variable(y, int, both, "ordonnee").

initialise(P, X : int, Y : int) :->
send(P, x, X),
send(P, y, Y).

:- pce_end_class.

:- pce_begin_class(bh, object, "Le bloc horizontal").
variable(x, int,  both, "abscisse").
variable(y, int, both, "ordonnee").

initialise(P, X : int, Y : int) :->
send(P, x, X),
send(P, y, Y).

:- pce_end_class.