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

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.

Article lu   fois.

Les deux auteurs

Profil Pro

Profil Pro

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

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.

Image non disponible

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.

Image non disponible

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
Sélectionnez
% 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'
Sélectionnez

:- 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 :

 
Sélectionnez

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

 
Sélectionnez

?- 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'
Sélectionnez

:- 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'
Sélectionnez
				
:- 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.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

2