[Turbo Pascal] Projet d'un programme de jeu d'échecs

[Roland Chastain]

Bonjour à tous !

Je commence un programme de jeu d'échecs en Pascal.

Je voudrais présenter mon travail, au fur et à mesure, dans le forum, afin de pouvoir recueillir les conseils et les sentiments des uns et des autres. J'espère aussi que les exemples (et les éventuelles discussions) pourront être utiles à d'autres que moi.

Je commence par ce petit bout de code qui est un essai de représentation de l'échiquier dans un tableau. Je cherchais un équivalent de la commande DATA du Basic, pour présenter agréablement les valeurs de la position initiale. La solution m'a été apportée hier par un membre du forum : j'ai appris avec grande joie qu'un tableau pouvait être déclaré comme une constante !

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 
{Représentation d'un échiquier avec ses pièces dans un tableau.}
{Compilateur : Turbo Pascal 7.0}
 
PROGRAM tablier;
USES crt;
TYPE
	tablier12x12 = array [1..12] of array [1..12] of shortint;
	tablier144   = array [1..144] of shortint;
VAR position : tablier12x12;
	x,y : shortint;
CONST initiale : tablier144=(
	+7, +7, +7, +7, +7, +7, +7, +7, +7, +7, +7, +7,
	+7, +7, +7, +7, +7, +7, +7, +7, +7, +7, +7, +7,
	+7, +7, -4, -2, -3, -5, -6, -3, -2, -4, +7, +7,
	+7, +7, -1, -1, -1, -1, -1, -1, -1, -1, +7, +7,
	+7, +7, +0, +0, +0, +0, +0, +0, +0, +0, +7, +7,
	+7, +7, +0, +0, +0, +0, +0, +0, +0, +0, +7, +7,
	+7, +7, +0, +0, +0, +0, +0, +0, +0, +0, +7, +7,
	+7, +7, +0, +0, +0, +0, +0, +0, +0, +0, +7, +7,
	+7, +7, +1, +1, +1, +1, +1, +1, +1, +1, +7, +7,
	+7, +7, +4, +2, +3, +5, +6, +3, +2, +4, +7, +7,
	+7, +7, +7, +7, +7, +7, +7, +7, +7, +7, +7, +7,
	+7, +7, +7, +7, +7, +7, +7, +7, +7, +7, +7, +7);
BEGIN
	textbackground(blue);
	textcolor(white);
	clrscr;
	for x:=1 to 12 do
		begin
		for y:=1 to 12 do
			begin
			{copie du tableau de constantes dans le tableau de variables}
			position[x,y]:=initiale[12*y +x -12];
			{affichage sommaire pour vérification du résultat}
                        gotoXY(2*x,2*y);
			writeln (abs(position[x,y]));
			end;
		end;
	readln;
END.

[Paul TOTH]

Bonjour,

c'est une bonne idée, mais reste dans la même discussion...

je suis moi même passé du BASIC au Pascal il y a un certain nombre d'années, c'est un vrai bonheur de passer à un langage qui, tout en restant simple, offre un vrai confort de programmation.

première remarque, ton tableau initial peut être initialisé en 12x12 également.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
type
  TTablier12x12 = array[0..11,0..11] of ShortInt;
const
  Initiale : TTablier12x12 = (
   (+7,+7........,+7,+7),
   (+7,+7,....  ),
   ...
   (+7....+7);
var
  position: TTablier12x12;
begin
  position := Initiale; // (en fonction du compilateur passera ou pas)
  Move(Initiale, position, SizeOf(TTablier12x12)); // copie brutale équivalente
end;

sous Delphi on a l'habitude de préfixer les types d'un T majuscule, et les tableaux sont souvent zéro basés, c'est plus naturel en programmation car le premier élément est à la position d'origine 0.

ceci dit, vu les valeurs de ton tableau, il pourrait tout aussi bien être déclaré array[-1..+10] ou [-2..+9] car manifestement les positions +7 sont des garde-fous.

tu peux également remplacer les shortInt par un énuméré

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
type
  TPiece = (
    HorsJeu, 
    CaseVide,
    PionBlanc, 
    TourBlanche,
    FouBlanc,
    ...
    ReineBlanche,
    PionNoir,
    ...
    ReineNoire
   );
 
type
  TEchiquier = array[-2..+9, -2..+9] of TPiece;
var
  Piece: TPiece;
begin
  if Piece in [TourBlanche, ReineBlanche] then
  begin
   // si un des deux pions
  end;
  if Piece in [PionBlanc..ReineBlanche] then
  begin
    // un des pions blanc
  end;
end;

c'est cependant moins pratique si tu utilises les valeurs de cases dans un calcul arithmétique...les tour sont alors identifiées par Piece in [TourBlanche, TourNoire] au lieu de Abs(Piece) = 4...mais sans doute plus lisible

tu peux aussi utiliser des constantes

Code :

1
2
3
4
5
6
7
8
9
10
11
 
const
  HORSJEU = 7;
  TOUR = 4;
  FOU   = 2;
 
  intiale  : TTableau12x12 = (
   (HORSJEU, HORSJEU...
   (HORSJEU, HORSJEU, + TOUR, + FOU...
   ...
  );

[Roland Chastain]

Envoyé par Paul TOTH

première remarque, ton tableau initial peut être initialisé en 12x12 également.

J'y ai pensé, mais je ne savais pas comment l'écrire.

Envoyé par Paul TOTH

sous Delphi on a l'habitude de préfixer les types d'un T majuscule, et les tableaux sont souvent zéro basés, c'est plus naturel en programmation car le premier élément est à la position d'origine 0.

C'est noté.

Envoyé par Paul TOTH

ceci dit, vu les valeurs de ton tableau, il pourrait tout aussi bien être déclaré array[-1..+10] ou [-2..+9] car manifestement les positions +7 sont des garde-fous.

Effectivement les rangées supplémentaires sont faites pour éviter des erreurs de dépassement de bornes. (Il y a deux rangées à cause du cavalier.)

Je retourne au travail. Merci pour les exemples et les indications.

[Roland Chastain]

Voici mon travail de l'après-midi. Rien de formidable, mais une première pierre pour le programme que je voudrais écrire. Quel beau langage que le Pascal !

A propos du compilateur : pour le moment je travaille avec TP7, parce que je n'ai pas eu le temps de me familiariser avec les autres. D'ailleurs, il me suffit, au moins pour commencer.

Bienvenue aux conseils, avis et remontrances à propos du code !

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
 
{Premiers éléments d'un programme de jeu d'échecs}
{Compilateur : Turbo Pascal 7.0}
PROGRAM principes;
USES crt;
TYPE
	TCoord = -1..10;
	TPiece = -6..7;
	TTableau12x12 = array [TCoord] of array [TCoord] of TPiece;
	TTableau8x8   = array [0..7] of array [0..7] of TPiece;
	TTableau4B    = array [0..3] of Boolean;
	TNomCaze      = string [2];
	TCoup         = string [4];
VAR 
	Position : TTableau12x12;
	x,y : TCoord;
	trait : Boolean; {qui doit jouer}
	passe : TCoord; {si un pion passe et, le cas échéant, sur quelle colonne}
	autorisation1 : TTableau4B; {si le roque est permis (1/2)}
	eschec : Boolean;
	autorisation2 : TTableau4B; {si le roque est permis (2/2)}
	compte : Byte; {nombre de coups échangés}
	coup : TCoup; {"a8b8"}
CONST
	Initiale : TTableau12x12=(
	(007,007,007,007,007,007,007,007,007,007,007,007),
	(007,007,007,007,007,007,007,007,007,007,007,007),
	(007,007, 4 , 1 , 0 , 0 , 0 , 0 ,-1 ,-4 ,007,007),
	(007,007, 2 , 1 , 0 , 0 , 0 , 0 ,-1 ,-2 ,007,007),
	(007,007, 3 , 1 , 0 , 0 , 0 , 0 ,-1 ,-3 ,007,007),
	(007,007, 5 , 1 , 0 , 0 , 0 , 0 ,-1 ,-5 ,007,007),
	(007,007, 6 , 1 , 0 , 0 , 0 , 0 ,-1 ,-6 ,007,007),
	(007,007, 3 , 1 , 0 , 0 , 0 , 0 ,-1 ,-3 ,007,007),
	(007,007, 2 , 1 , 0 , 0 , 0 , 0 ,-1 ,-2 ,007,007),
	(007,007, 4 , 1 , 0 , 0 , 0 , 0 ,-1 ,-4 ,007,007),
	(007,007,007,007,007,007,007,007,007,007,007,007),
	(007,007,007,007,007,007,007,007,007,007,007,007));
FUNCTION NomCaze (x,y : TCoord) : TNomCaze;
	begin
	NomCaze:=chr(x+96)+chr(y+48);
	end;
BEGIN
	textbackground(blue);
	textcolor(white);
	clrscr;
	for x:=-1 to 10 do
		begin
		for y:=-1 to 10 do
			begin
			Position[x,y]:=Initiale[x,y];
 
			{affichage pour vérification}
			case Position[x,y] of
				-6..-1 : textcolor(red);
				0..6 : textcolor(white);
				7 : textcolor(green);
			end ;
			gotoXY (x+3,12-y);
			writeln (abs(Position[x,y]));
                        gotoXY (2*(x+3)+20,12-y);
                        writeln (NomCaze(x,y));
			end;
		end;
	readln;
END.

[mick605]

Salut

Très interressant, j'ai bien envie de voir ce que ca va donner !
A moi d'apporter ma pierre a l'édifice :

Comme Paul t'as suggéré, utilise un type énuméré :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
  TPiece = (
    HorsJeu, 
    CaseVide,
    PionBlanc, 
    TourBlanche,
    FouBlanc,
    ...
    ReineBlanche,
    PionNoir,
    ...
    ReineNoire
   );

C'est plus lisible, et ca permet de comprendre d'un coup le code.

Ensuite, n'utilise pas de "marge" pour ton tableau : c'est inutile. Voici ce que je fait habituellement :

Code :

1
2
3
4
function IsCellInTab (ACol, ARow : integer): boolean;
begin
  Result:=(ACol in [0..7]) and (ARow in [0..7]);
end;

Et pour savoir si une case est libre, au lieu de faire

Code :

if Position[Col,Row]=007 then

tu fait

Code :

if IsCellInTab(Col,Row) then

L'indentation est très importante aussi. Dans ton cas, elle est trop forte je trouve. Pour ma part, j'utilise 2 espaces seulement, et j'indente un peu différement, voila ce que ca donne :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
  for x:=-1 to 10 do
  begin
    for y:=-1 to 10 do
    begin
      Position[x,y]:=Initiale[x,y];
 
      {affichage pour vérification}
      case Position[x,y] of
        -6..-1 : textcolor(red);
        0..6 : textcolor(white);
        7 : textcolor(green);
      end ;
 
      gotoXY (x+3,12-y);
      writeln (abs(Position[x,y]));
      gotoXY (2*(x+3)+20,12-y);
      writeln (NomCaze(x,y));
    end;
  end;

Voila pour l'instant. J'espere t'avoir été utile ...

Bonne chance pour la suite !

[Roland Chastain]

Envoyé par mick605

Très interressant, j'ai bien envie de voir ce que ca va donner !

Merci pour tes encouragements.

Envoyé par mick605

Comme Paul t'as suggéré, utilise un type énuméré. C'est plus lisible, et ca permet de comprendre d'un coup le code.

Je l'utiliserai, sans aucun doute, mais pas à cet endroit-là, parce qu'il me semble que ce serait, plus lisible certes, mais moins commode que des nombres (comme Paul lui-même l'avait d'ailleurs noté).

Envoyé par mick605

Ensuite, n'utilise pas de "marge" pour ton tableau : c'est inutile. Voici ce que je fait habituellement :

Code :

Exemple très utile : c'est noté ! (Autrement, c'est vrai qu'on peut se passer de la bordure, mais du coup il faut ajouter des vérifications, et c'est justement ce que les cases supplémentaires permettent d'éviter. Au bout du compte, je pense que les deux solutions se valent.)

Envoyé par mick605

L'indentation est très importante aussi. Dans ton cas, elle est trop forte je trouve. Pour ma part, j'utilise 2 espaces seulement, et j'indente un peu différement, voila ce que ca donne :

Merci pour le conseil et l'exemple.

Envoyé par mick605

Bonne chance pour la suite !

Merci !

P.-S. S'il y a un moyen simple d'utiliser une police de caractère avec TP7 en mode console, je voudrais bien le connaître ! J'ai un fichier TrueType qui contient de jolies pièces, mais je ne sais pas l'utiliser.

[Roland Chastain]

Bonjour !

J'ai fait un pas de plus en écrivant une fonction qui permet d'enregistrer une position quelconque au format FEN. Le format FEN ("Forsyth-Edwards Notation") est décrit dans cette page (en anglais) : http://kirill-kryukov.com/chess/doc/fen.html
La chose qui m'a donné du fil à retordre était de compter les cases vides et d'ajouter dans la chaîne un seul caractère correspondant au nombre des cases vides consécutives. Le moins qu'on puisse dire est que je n'y suis pas arrivé du premier coup ! Mais tout s'arrange, avec "patience et longueur de temps".
J'ai aussi travaillé à bien distinguer les deux types de tablier dont je me servirai, l'un avec un garde-fou, l'autre sans. Merci à Paul TOTH qui m'a fait penser à employer ce mot de "garde-fou", beaucoup plus parlant et plus intéressant que celui de "bordure" dont je me servais jusqu'ici.
Je pense travailler sur un affichage provisoire en mode texte. Je vais essayer de faire quelque chose qui ne soit pas trop désagréable, mais sans y passer trop de temps. Conseils bienvenus !
(Je cherche toujours à connaître la méthode pour utiliser une police TrueType avec TP7, si toutefois ce n'est pas trop compliqué à mettre en œuvre.)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
 
{*===================================================================*}
{*  Description : Premiers éléments d'un programme de jeu d'échecs   *}
{*  1) Types, constantes et variables pour la représentation du jeu  *}
{*  2) Fonction permettant d'enregistrer une position au format FEN  *}
{*  Compilateur : Turbo Pascal 7.0                                   *}
{*  Auteur : Roland Chastain, Bamako (MALI)                          *}
{*  Date : 02/02/2012                                                *}
{*===================================================================*}
 
PROGRAM Principes;
USES Crt;
 
TYPE
	TCoord12 = -1..10;
	TCoord8 = 1..8;
	TPiece = -6..7;
	TTableau12x12 = Array [TCoord12] of Array [TCoord12] of TPiece;
	TTableau8x8 = Array [TCoord8] of Array [TCoord8] of TPiece;
	TTableau4B = Array [0..3] of Boolean;
	TNomCaze = String [2];
	TCoup = String [4];
 
VAR
	Occupation12 : TTableau12x12;
	Occupation8 : TTableau8x8;
	x,y : TCoord12;
	Trait : Boolean;                         {à qui le tour}
	Autorisation1 : TTableau4B; {si le roque est permis 1/2}
	Passe : TCoord12;               {si un pion passe et où}
	PasseCaze : TNomCaze;
	Eschec : Boolean;
	Autorisation2 : TTableau4B; {si le roque est permis 2/2}
	NombreDemiCoups : Integer;
	NombreCoups : Integer;
	Coup : TCoup;                                   {"a8b8"}
 
CONST
	Initiale : TTableau12x12=(
	(7,7,007,007,007,007,007,007,007,007,7,7),
	(7,7,007,007,007,007,007,007,007,007,7,7),
	(7,7, 4 , 1 , 0 , 0 , 0 , 0 ,-1 ,-4 ,7,7),
	(7,7, 2 , 1 , 0 , 0 , 0 , 0 ,-1 ,-2 ,7,7),
	(7,7, 3 , 1 , 0 , 0 , 0 , 0 ,-1 ,-3 ,7,7),
	(7,7, 5 , 1 , 0 , 0 , 0 , 0 ,-1 ,-5 ,7,7),
	(7,7, 6 , 1 , 0 , 0 , 0 , 0 ,-1 ,-6 ,7,7),
	(7,7, 3 , 1 , 0 , 0 , 0 , 0 ,-1 ,-3 ,7,7),
	(7,7, 2 , 1 , 0 , 0 , 0 , 0 ,-1 ,-2 ,7,7),
	(7,7, 4 , 1 , 0 , 0 , 0 , 0 ,-1 ,-4 ,7,7),
	(7,7,007,007,007,007,007,007,007,007,7,7),
	(7,7,007,007,007,007,007,007,007,007,7,7));
 
FUNCTION NomCaze(x,y : TCoord8) : TNomCaze;
	Begin
		NomCaze:=chr(x+96)+chr(y+48);
	End;
 
FUNCTION PositionFEN (
	oc :   TTableau8x8 ;
	tr :       Boolean ;
	a1 :    TTableau4B ;
	pa :      TCoord12 ;
	c1 :       Integer ;
	c2 :       Integer )
	   :        STRING ;
	Var
		s,cs :  String;
		n,i  :    Byte;
		Stop : Boolean;
	Procedure CazeVide;
		Begin
			n:=0;
			While x+n<9 Do
			Begin
				n:=n+1;
			End;
			If Stop=False Then s:=s+chr(48+n);
			Stop:=True;
		End;
	Begin
		oc:=Occupation8;
		s:='';
		Stop:=False;
		For y:=8 Downto 1 Do
		Begin
			For x:=1 To 8 Do
			Begin
				Case oc[x,y] Of
					-6 : s:=s+'k';
					-5 : s:=s+'q';
					-4 : s:=s+'r';
					-3 : s:=s+'b';
					-2 : s:=s+'n';
					-1 : s:=s+'p';
					00 : CazeVide;
					01 : s:=s+'P';
					02 : s:=s+'N';
					03 : s:=s+'B';
					04 : s:=s+'R';
					05 : s:=s+'Q';
					06 : s:=s+'K';
				End;
				If oc[x,y]<>0 Then Stop:=False;
			End;
			If y>1 Then s:=s+'/';
			If y=1 Then s:=s+' ';
			Stop:=False;
		End;
		If trait=False then s:=s+'w' else s:=s+'b';
		s:=s+' ';
		If a1[3]=True then s:=s+'K';
		If a1[2]=True then s:=s+'Q';
		If a1[1]=True then s:=s+'k';
		If a1[0]=True then s:=s+'q';
		If ((a1[3] and a1[2]) and (a1[1] and a1[0]))=False then s:=s+'-';
		s:=s+' ';
		s:=s+PasseCaze;
		s:=s+' ';
		Str(c1,cs);
		s:=s+cs;
		s:=s+' ';
		Str(c2,cs);
		s:=s+cs;	
		PositionFEN:=s;
	End;
 
BEGIN
	textbackground(blue);
	textcolor(white);
	clrscr;
 
	for x:=-1 to 10 do {tablier avec garde-fou}
	begin
		for y:=-1 to 10 do
		begin
			Occupation12[x,y]:=Initiale[x,y];
		end;
	end;
 
	for x:=1 to 8 do           {tablier simple}
	begin
		for y:=1 to 8 do
		begin
			Occupation8[x,y]:=Initiale[x,y];
		end;
	end;
 
	Trait:=False;                       {trait}
	Autorisation1[0]:=True;             {roque}
	Autorisation1[1]:=True;
	Autorisation1[2]:=True;
	Autorisation1[3]:=True;
	Passe:=0;                    {pion passant}
	PasseCaze:='-';
	NombreDemiCoups:=0;             {compteurs}
	NombreCoups:=1;
 
	for x:=-1 to 10 do
	begin
		for y:=-1 to 10 do
		begin
			case Occupation12[x,y] of
				-6..-1 : textcolor(red);
				0..6 : textcolor(white);
				7 : textcolor(green);
			end ;
			gotoXY (x+3,12-y);
			writeln (abs(Occupation12[x,y]));
		end;
	end;
 
	for x:=1 to 8 do
	begin
		for y:=1 to 8 do
		begin
			gotoXY (2*(x+3)+20,12-y);
			writeln (NomCaze(x,y));
		end;
	end;
 
	gotoXY (2,15);
	write (PositionFEN (Occupation8, Trait, Autorisation1, Passe, NombreDemiCoups, NombreCoups));
 
	readln;
END.

P.-S. @ mick605 : j'ai bien tenu compte de ton conseil concernant l'indentation : je ne sais pas pourquoi, quand je copie/colle depuis mon éditeur, l'indentation est changée.

[Alcatîz]

Bonjour,

Envoyé par Roland Chastain

Je cherche toujours à connaître la méthode pour utiliser une police TrueType avec TP7, si toutefois ce n'est pas trop compliqué à mettre en œuvre.

Ton bonheur se trouve peut-être parmi nos téléchargements :
http://pascal.developpez.com/telecha...s-for-DOS-1-60

[Roland Chastain]

Envoyé par Alcatîz

Ton bonheur se trouve peut-être parmi nos téléchargements :
http://pascal.developpez.com/telecha...s-for-DOS-1-60

Merci pour ta réponse. Le contenu, que j'ai commencé à regarder, m'a paru être d'excellente qualité. Je vais prendre le temps de l'étudier. Mais déjà je crois comprendre quelque chose, à savoir : qui dit unité Graph sous Windows 7, dit DosBOX. Si tel est le cas, ce ne serait vraiment pas raisonnable de ma part de m'engager sur cette voie. Déjà que je dois jongler entre Notepad++ et TP7...
Je crois que je vais me contenter, pour l'instant, de représenter mes pièces avec des lettres.

P.-S. J'ai appris beaucoup de choses sur ce sujet (et sur d'autres) en relisant d'anciennes discussions du forum. Vous me direz que j'aurais peut-être dû commencer par là !

[mick605]

Peut etre devrais tu profiter du fait que tu n'es pas trop avancé dans ton programme pour envisager de passer sous Lazarus ... Il est plus récent, et te permettra de faire des applications fenetrées facilement (même si c'est pas ton but premier, on sait jamais)

Simplement une suggestion ^^

[Roland Chastain]

Envoyé par mick605

Peut etre devrais tu profiter du fait que tu n'es pas trop avancé dans ton programme pour envisager de passer sous Lazarus ... Il est plus récent, et te permettra de faire des applications fenetrées facilement (même si c'est pas ton but premier, on sait jamais)

Ça me ferait plaisir de finir quelque chose pour TP7 d'abord. Mais je vois bien que, quand le moment sera venu de faire du dessin (par exemple), il faudra que je change d'outil.
Cependant c'est vrai que je ne suis pas encore décidé. J'ai voulu télécharger Lazarus : le mastodonte ! Avec la connexion que j'ai ici, aucune chance d'y arriver. Pourquoi est-il si gros ?
Je plaisante naturellement. Il faudra que j'y jette un œil. Et, au besoin, je réécrirai mon programme depuis le début.

[Alcatîz]

Envoyé par Roland Chastain

qui dit unité Graph sous Windows 7, dit DosBOX. Si tel est le cas, ce ne serait vraiment pas raisonnable de ma part de m'engager sur cette voie. Déjà que je dois jongler entre Notepad++ et TP7...

DosBox ne servant qu'à exécuter le programme compilé, tu peux simplement monter comme disque le répertoire de destination de la compilation par TP7.

Par exemple, si TP7 compile vers le répertoire C:\TP7\EXE_TPU, tu peux monter ce répertoire comme disque C dans DosBox, avec la commande

z:\>mount c c:\tp7\exe_tpu
z:\>cd c:

Après chaque compilation, tu peux directement tester l'exécutable dans DosBox :

c:\>echecs

[Roland Chastain]

Envoyé par Alcatîz

DosBox ne servant qu'à exécuter le programme compilé, tu peux simplement monter comme disque le répertoire de destination de la compilation par TP7.

Quelle bonne idée ! Je vais le faire tout de suite. Merci pour l'explication détaillée de la manœuvre.

[Roland Chastain]

Je crois que j'ai fini la première partie de mon programme.
J'ai eu l'agréable surprise (que les utilisateurs plus expérimentés me pardonnent) de constater que ce morceau de code s'exécute parfaitement avec d'autres compilateurs que TP7. Je ne m'y attendais pas.
Il y a quand même une différence sensible, à savoir la taille des exécutables :

• Dev-Pascal (avec l'ancien FP) : 17 Ko
• Virtual Pascal : 15 Ko
• Free Pascal 2.6.0 : 57,3 Ko !
• TP7 : ... 5 Ko.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
 
{========================================}
{*  Projet : Programme de jeu d'échecs  *}
{*  Auteur : ......... Roland Chastain  *}
{*  Compilateur : ... Turbo Pascal 7.0  *}
{*  Date : ................ 08/02/2012  *}
{========================================}
 
PROGRAM ECHECS;
 
USES Crt;
 
TYPE
	TCoord12=-1..10;
	TCoord8=  1.. 8;
	TPiece=  -6.. 7;
	TNature=  0.. 6;
	TCouleur=-1.. 1;
	TTableau12x12=array[TCoord12] of array[TCoord12] of TPiece;
	TTableau8x8=  array[TCoord8]  of array[TCoord8]  of TPiece;
	TTableau4B=   array[0..3]     of Boolean                  ;
	TCaracteres=  array[TPiece]   of Char                     ;
	TNomCaze=     string[2]                                   ;
 
VAR
	Occupant12: TTableau12x12;
	Occupant8:  TTableau8x8  ;
	Trait:      Boolean      ;
	Condition1: TTableau4B   ;
	CazePassant:TNomCaze     ;
	Echec:      Boolean      ;
	Condition2: TTableau4B   ;
	nbDemiCoups:Integer      ;
	nbCoups:    Integer      ;
 
CONST
	Initiale:TTableau12x12=(
	(7,7, 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 ,7,7),
	(7,7, 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 ,7,7),
	(7,7, 4 , 1 , 0 , 0 , 0 , 0 ,-1 ,-4 ,7,7),
	(7,7, 2 , 1 , 0 , 0 , 0 , 0 ,-1 ,-2 ,7,7),
	(7,7, 3 , 1 , 0 , 0 , 0 , 0 ,-1 ,-3 ,7,7),
	(7,7, 5 , 1 , 0 , 0 , 0 , 0 ,-1 ,-5 ,7,7),
	(7,7, 6 , 1 , 0 , 0 , 0 , 0 ,-1 ,-6 ,7,7),
	(7,7, 3 , 1 , 0 , 0 , 0 , 0 ,-1 ,-3 ,7,7),
	(7,7, 2 , 1 , 0 , 0 , 0 , 0 ,-1 ,-2 ,7,7),
	(7,7, 4 , 1 , 0 , 0 , 0 , 0 ,-1 ,-4 ,7,7),
	(7,7, 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 ,7,7),
	(7,7, 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 ,7,7));
	Caracteres:TCaracteres=(
	'k','q','r','b','n','p',chr(176),
	'P','N','B','R','Q','K',chr(177));
	CazeVide :TPiece=0;
	GardeFou :TPiece=7;
	PB:TPiece=1; PN:TPiece=-1;
	CB:TPiece=2; CN:TPiece=-2;
	FB:TPiece=3; FN:TPiece=-3;
	TB:TPiece=4; TN:TPiece=-4;
	DB:TPiece=5; DN:TPiece=-5;
	RB:TPiece=6; RN:TPiece=-6;
	Pion    :TNature=1;
	Cavalier:TNature=2;
	Fou     :TNature=3;
	Tour    :TNature=4;
	Dame    :TNature=5;
	Roi     :TNature=6;
	Blanc :TCouleur= 1;
	Noir  :TCouleur=-1;
 
FUNCTION NomCaze(x,y:TCoord8):TNomCaze;
	begin
		NomCaze:=chr(x+96)+chr(y+48);
	end;
 
FUNCTION PositionFEN(
	oc:TTableau8x8    ;
	tr:Boolean        ;
	a1:TTableau4B     ;
	pa:TNomCaze       ;
	c1:Integer        ;
	c2:Integer        ):STRING;
	var
		x,y:TCoord8;
		s,cs:string;
		n,i:Byte;
		CC:Boolean;
	procedure CazeNono;
		begin
		n:=0;
		while x+n<9 do n:=n+1;
		if CC=False then s:=s+chr(48+n);
		CC:=True;
		end;
	begin
	oc:=Occupant8;
	s:='';
	CC:=False;
	for y:=8 downto 1 do begin
	for x:=1 to 8 do begin
	if oc[x,y]=0 then
		begin
			CazeNono;
		end
	else
		begin
			s:=s+Caracteres[oc[x,y]];
			CC:=False;
		end;
	end;
	if y>1 then s:=s+'/';
	if y=1 then s:=s+' ';
	CC:=False;
	end;
	if tr=False
	then s:=s+'w'
	else s:=s+'b'; s:=s+' ';
	if a1[3]=True then s:=s+'K';
	if a1[2]=True then s:=s+'Q';
	if a1[1]=True then s:=s+'k';
	if a1[0]=True then s:=s+'q';
	If (((a1[0]
	and   a1[1])
	and   a1[2])
	and   a1[3])
	=False
	then s:=s+'-';
	s:=s+' ';s:=s+pa;
	s:=s+' ';str(c1,cs);s:=s+cs;
	s:=s+' ';str(c2,cs);s:=s+cs;
	PositionFEN:=s;
	end;
 
PROCEDURE Initialisation;
	var x,y:TCoord12;
	begin
	for x:=-1 to 10 do begin
		for y:=-1 to 10 do begin
			Occupant12[x,y]:=Initiale[x,y];
		end;
	end;
	for x:=1 to 8 do begin
		for y:=1 to 8 do begin
			Occupant8[x,y]:=Initiale[x,y];
		end;
	end;
	Trait:=False;
	Condition1[0]:=True;
	Condition1[1]:=True;
	Condition1[2]:=True;
	Condition1[3]:=True;
	CazePassant:='-';
	nbDemiCoups:=0;
	nbCoups:=1;
	end;
 
PROCEDURE AffichePosition(occup:TTableau8x8);
	var x,y:TCoord8;
	begin
		WriteLn;
		TextColor(4);
		WriteLn('    A  B  C  D  E  F  G  H');
		WriteLn;
		for y:=8 downto 1 do
		begin
			TextColor(4);
			Write(' ',y,'  ');
			for x:=1 to 8 do
			begin
				case occup[x,y] of
				-6..-1 :TextColor(9);
				 0     :TextColor(2);
				 1.. 6 :TextColor(7);
				end;
				Write(Caracteres[occup[x,y]],'  ');
			end;
			WriteLn;WriteLn;
		end;
		WriteLn;
	end;
 
BEGIN
  ClrScr;
	Initialisation;
	AffichePosition(Occupant8);
	ReadLn;
END.

[Roland Chastain]

Bonjour !

Quelques mots pour présenter mes dernières avancées.

J'ai écrit les grandes lignes d'une procédure faite calculer la valeur de la variable "echec".
Pour cela il faut commencer à calculer des coups. Dans son état actuel, la procédure calcule les coups des pions et ceux des cavaliers, et les enregistre dans un fichier.

Jusqu'ici, le programme se compile sans problème avec TP7, Virtual Pascal, Free Pascal. Je vais faire en sorte de conserver cette compatibilité.

Veuillez noter que pour essayer le code, il faut changer le chemin du dossier où seront créés les fichiers temporaires. J'ai déclaré le chemin en tête du programme comme une constante, en attendant de faire mieux.

P.-S. Toujours pas résolu le problème de l'indentation. Je ne sais pas pourquoi mes "dents" s'élargissent quand je colle mon code ici.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
 
{========================================}
{*  Projet : Programme de jeu d'échecs  *}
{*  Auteur : ......... Roland Chastain  *}
{*  Compilateur : ... Turbo Pascal 7.0  *}
{*  Date : ................ 13/02/2012  *}
{========================================}
 
PROGRAM ECHECS;
USES Crt;
 
CONST NomDossier:String='c:/Atelier/PAS/TEMP/'; { à modifier }
 
TYPE
 
	TCoord12=-1..10;
	TCoord8 = 1.. 8;
	TPiece  =-6.. 7;
	TCouleur=-1.. 1;
 
	TTableau12x12=Array[TCoord12,TCoord12]of TPiece;
	TTableau8x8  =Array[TCoord8,TCoord8]of TPiece  ;
	TTableau4B   =Array[0..3]of Boolean            ;
	TCaracteres  =Array[TPiece]of Char             ;
	TNomCaze     =String[2]                        ;
	TCoup        =String[4]                        ;
	TListe       =File of TCoup                    ;
 
VAR
 
	Occupant12 :TTableau12x12;
	Occupant8  :TTableau8x8  ;
	Trait      :Boolean      ;
	Condition1 :TTableau4B   ;
	CazePassant:TNomCaze     ;
	Echec      :Boolean      ;
	Condition2 :TTableau4B   ;
	nbDemiCoups:Integer      ;
	nbCoups    :Integer      ;
 
CONST
 
	Initiale:TTableau12x12=(
	(7,7, 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 ,7,7),
	(7,7, 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 ,7,7),
	(7,7, 4 , 1 , 0 , 0 , 0 , 0 ,-1 ,-4 ,7,7),
	(7,7, 2 , 1 , 0 , 0 , 0 , 0 ,-1 ,-2 ,7,7),
	(7,7, 3 , 1 , 0 , 0 , 0 , 0 ,-1 ,-3 ,7,7),
	(7,7, 5 , 1 , 0 , 0 , 0 , 0 ,-1 ,-5 ,7,7),
	(7,7, 6 , 1 , 0 , 0 , 0 , 0 ,-1 ,-6 ,7,7),
	(7,7, 3 , 1 , 0 , 0 , 0 , 0 ,-1 ,-3 ,7,7),
	(7,7, 2 , 1 , 0 , 0 , 0 , 0 ,-1 ,-2 ,7,7),
	(7,7, 4 , 1 , 0 , 0 , 0 , 0 ,-1 ,-4 ,7,7),
	(7,7, 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 ,7,7),
	(7,7, 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 ,7,7));
 
	Caracteres: TCaracteres=('k','q','r','b','n','p',chr(176),'P','N','B','R','Q','K',chr(177));
 
FUNCTION NomCaze(x,y:TCoord8):TNomCaze;
	begin
		NomCaze:=chr(x+96)+chr(y+48);
	end;
 
FUNCTION PositionFEN(
			oc:TTableau8x8;
			tr:    Boolean;
			a1: TTableau4B;
			pa:   TNomCaze;
			c1:    Integer;
			c2:    Integer):STRING;
	var
		x,y :TCoord8;
		s,cs: String;
		n,i :   Byte;
		CC  :Boolean;
	procedure CazeNono;
		begin
		n:=0;
		while x+n<9 do n:=n+1;
		if CC=False then s:=s+chr(48+n);
		CC:=True;
		end;
	begin
	oc:=Occupant8;
	s:='';
	CC:=False;
	for y:=8 downto 1 do begin
	for x:=1 to 8 do begin
	if oc[x,y]=0 then
		begin
			CazeNono;
		end
	else
		begin
			s:=s+Caracteres[oc[x,y]];
			CC:=False;
		end;
	end;
	if y>1 then s:=s+'/';
	if y=1 then s:=s+' ';
	CC:=False;
	end;
	if tr=False
	then s:=s+'w'
	else s:=s+'b';
	s:=s+' ';
	if a1[3]=True then s:=s+'K';
	if a1[2]=True then s:=s+'Q';
	if a1[1]=True then s:=s+'k';
	if a1[0]=True then s:=s+'q';
	if not ((a1[3]=True)or(a1[2]=True)or(a1[1]=True)or(a1[0]=True)) then s:=s+'-';
	s:=s+' ';s:=s+pa;s:=s+' ';str(c1,cs);s:=s+cs;s:=s+' ';str(c2,cs);s:=s+cs;
	PositionFEN:=s;
	end; { positionFEN }
 
PROCEDURE Initialise;
	var x,y:TCoord12;
	begin
	for x:=-1 to 10 do begin
		for y:=-1 to 10 do begin
			Occupant12[x,y]:=Initiale[x,y];
		end;
	end;
	for x:=1 to 8 do begin
		for y:=1 to 8 do begin
			Occupant8[x,y]:=Initiale[x,y];
		end;
	end;
	Trait:=False; { w }
	Condition1[0]:=True; { q } { e8c8 }
	Condition1[1]:=True; { k } { e8g8 }
	Condition1[2]:=True; { Q } { e1c1 }
	Condition1[3]:=True; { K } { e1g1 }
	CazePassant:='-';
	nbDemiCoups:=0;
	nbCoups:=1;
	end; { Initialise }
 
FUNCTION SGN(n:TPiece):TCouleur;
	begin
		case n of
			-6..-1 :SGN:=-1;
			     0 :SGN:= 0;
			 1.. 7 :SGN:= 1;
		end;
	end; { SGN }
 
PROCEDURE AffichePosition(occup:TTableau8x8);
	const ABC:String[26]='    A  B  C  D  E  F  G  H';
	var x,y:TCoord8;
	begin
		ClrScr;WriteLn;TextColor(4);WriteLn(ABC);WriteLn;
		for y:=8 downto 1 do
		begin
			TextColor(4);
			Write(' ',y,'  ');
			for x:=1 to 8 do
			begin
				case SGN(occup[x,y]) of
					-1:TextColor(9);
					 0:TextColor(2);
					 1:TextColor(7);
				end;
				Write(Caracteres[occup[x,y]],'  ');
			end;
			TextColor(4);Write(y);WriteLn;WriteLn;
		end;
		TextColor(4);WriteLn(ABC);WriteLn;WriteLn;
	end; { AffichePosition }
 
PROCEDURE CalculeECHEC(
	occ:     TTableau8x8;
	trt:         Boolean;
	var chc:     Boolean;
	var cnd:  TTableau4B;
	NomFichier:   String);
 
	var
		x1,y1,x2,y2:      TCoord8;
		dxSGN,dySGN:     ShortInt;
		dxABS,dyABS:         Byte;
		colorP1,colorP2: TCouleur;
		cp:                 TCoup;
		bon:              Boolean;
		lst:               TListe;
 
	procedure mvtPION;
	begin
		if SGN(dySGN)=colorP1 then
		begin
 
			if (colorP2=-1*colorP1) and (dxABS=1) and (dyABS=1) then bon:=True;
			if (colorP2=0) and (dxABS=0) then
			begin
 
				if dyABS=1 then bon:=True;
				if dyABS=2 then
 
				begin
					if (colorP1=-1) and (y1=7) and (occ[x1,y1-1]=0) then bon:=True;
					if (colorP1=01) and (y1=2) and (occ[x1,y1+1]=0) then bon:=True;
				end;
 
			end;
		end;
	end; { mvtPION }
 
	procedure mvtCAVALIER;
		begin
			if (colorP2=-1*colorP1) or (colorP2=0) then
			begin
				if dxABS*dxABS+dyABS*dyABS=5 then bon:=True;
			end;
		end; { mvtCAVALIER }
 
	procedure mvtFOU;
		var
			ax,ay:TCouleur;
			nx,ny:ShortInt;
			obstat:Boolean;
		begin
			if (colorP2=-1*colorP1) or (colorP2=0) then
			begin
 
				if (dxABS>0) and (dxABS=dyABS) then
				begin
					ax:=SGN(dxSGN);
					ay:=SGN(dySGN);
					nx:=0;
					ny:=0;
					obstat:=False;
					repeat
						nx:=nx+ax;
						ny:=ny+ay;
						if nx=dxSGN then bon:=True;
						if Abs(occ[x1+nx,y1+ny])>0 then obstat:=True;
					until (bon=True) or (obstat=True);
				end;
 
			end;
		end; { mvtFOU }
 
	procedure mvtTOUR;
		var
			ax,ay:TCouleur;
			nx,ny:ShortInt;
			obstat:Boolean;
		begin
			if (colorP2=-1*colorP1) or (colorP2=0) then
			begin
 
				if (dxABS*dyABS=0) and (dxABS+dyABS>0) then
				begin
					ax:=SGN(dxSGN);
					ay:=SGN(dySGN);
					nx:=0;
					ny:=0;
					obstat:=False;
					repeat
						nx:=nx+ax;
						ny:=ny+ay;
						if (nx=dxSGN) and (ny=dySGN) then bon:=True;
						if Abs(occ[x1+nx,y1+ny])>0 then obstat:=True;
					until (bon=True) or (obstat=True);
				end;
 
			end;
		end; { mvtTOUR }
 
	procedure mvtDAME;
		var
			ax,ay:TCouleur;
			nx,ny:ShortInt;
			obstat:Boolean;
		begin
			if (colorP2=-1*colorP1) or (colorP2=0) then
			begin
 
				if (dxABS>0) and (dxABS=dyABS) then 
				begin
					ax:=SGN(dxSGN);
					ay:=SGN(dySGN);
					nx:=0;
					ny:=0;
					obstat:=False;
					repeat
						nx:=nx+ax;
						ny:=ny+ay;
						if nx=dxSGN then bon:=True;
						if Abs(occ[x1+nx,y1+ny])>0 then obstat:=True;
					until (bon=True) or (obstat=True);
				end;
 
				if (dxABS*dyABS=0) and (dxABS+dyABS>0) then
				begin
					ax:=SGN(dxSGN);
					ay:=SGN(dySGN);
					nx:=0;
					ny:=0;
					obstat:=False;
					repeat
						nx:=nx+ax;
						ny:=ny+ay;
						if (nx=dxSGN) and (ny=dySGN) then bon:=True;
						if Abs(occ[x1+nx,y1+ny])>0 then obstat:=True;
					until (bon=True) or (obstat=True);
				end;				
 
			end;
		end; { mvtDAME }
 
	procedure mvtROI;
		begin
			if (colorP2=-1*colorP1) or (colorP2=0) then
 
			begin
				if (dxABS<2) and (dyABS<2) then bon:=True;
			end;
 
		end; { mvtROI }
 
	begin
 
		Assign(lst,NomDossier+NomFichier);
		Rewrite(lst);
 
		for x1:=1 to 8 do
		begin
			for y1:=8 downto 1 do
			begin
				for x2:=1 to 8 do
				begin
					for y2:=8 downto 1 do
					begin
 
						dxSGN:=x2-x1; dxABS:=Abs(dxSGN);
						dySGN:=y2-y1; dyABS:=Abs(dySGN);
						colorP1:=SGN(occ[x1,y1]);
						colorP2:=SGN(occ[x2,y2]);
						bon:=False;
 
						case Abs(occ[x1,y1]) of
							1:mvtPION;
							2:mvtCAVALIER;
							3:mvtFOU;
							4:mvtTOUR;
							5:mvtDAME;
							6:mvtROI;
						end;
 
						if bon=True then
						begin
							cp:=NomCaze(x1,y1)+NomCaze(x2,y2);
							Write(lst,cp);
						end;
 
					end;
				end;
			end;
		end;
 
		Close(lst);
 
		chc:=False;
		cnd[0]:=True;
		cnd[1]:=True;		
		cnd[2]:=True;
		cnd[3]:=True;
 
		Assign(lst,NomDossier+NomFichier);
		Reset(lst);
 
		while not Eof(lst) do
		begin
 
			Read(lst,cp);
 
			x2:=Ord(cp[3])-96;
			y2:=Ord(cp[4])-48;
 
			if trt=False then
			begin
				if occ[x2,y2]=6 then chc:=True;
				if (y2=1) and (x2<6) then cnd[2]:=False;
				if (y2=1) and (x2>5) then cnd[3]:=False;
			end;
 
			if trt=True then
			begin
				if occ[x2,y2]=-6 then chc:=True;
				if (y2=8) and (x2<6) then cnd[0]:=False;
				if (y2=8) and (x2>5) then cnd[1]:=False;
			end;
 
		end;
 
		Close(lst);
 
	end; { CalculeECHEC }
 
PROCEDURE FichierTXT;
	var
		F:Text;
		i:Byte;
	begin
		Assign(F,NomDossier+'RESULTAT.txt');
		Rewrite(F);
		WriteLn(F,'FEN:',PositionFEN(Occupant8,Trait,Condition1,CazePassant,nbDemiCoups,nbCoups));
		WriteLn(F,'Echec:',Echec);
		for i:=0 to 3 do begin WriteLn(F,'C2[',i,']:',Condition2[i]); end;
		Close(F);
	end; { FichierTXT }
 
PROCEDURE CoupsSpeciaux(
		occ:    TTableau8x8;
		trt:        Boolean;
		cnd1:    TTableau4B;
		cnd2:    TTableau4B;
		pass:      TNomCaze;
		NomFichier: String);
	var
		x1,y1,x2,y2:      TCoord8;
		dxSGN,dySGN:     ShortInt;
		dxABS,dyABS:         Byte;
		colorP1,colorP2: TCouleur;
		cp:                 TCoup;
		bon:              Boolean;
		lst:               TListe;
	procedure mvtPION2;
	begin
		if (dySGN=colorP1) and (dxABS=1) then
		begin
			if NomCaze(x2,y2)=CazePassant then bon:=True;
		end;
	end;
	procedure mvtROI2;
	begin
		if (dyABS=0) and (dxABS=2) then
		begin
			if trt=False then begin
				if (occ[2,1]=0) and (occ[3,1]=0) and (occ[4,1]=0) then begin
					if (cnd1[2]=True) and (cnd2[2]=True) then bon:=True; { Q }
				end;
				if (occ[6,1]=0) and (occ[7,1]=0) then begin
					if (cnd1[3]=True) and (cnd2[3]=True) then bon:=True; { K }
				end;
			end;
			if trt=True then begin
				if (occ[2,8]=0) and (occ[3,8]=0) and (occ[4,8]=0) then begin
					if (cnd1[0]=True) and (cnd2[0]=True) then bon:=True; { q }
				end;
				if (occ[6,8]=0) and (occ[7,8]=0) then begin
					if (cnd1[1]=True) and (cnd2[1]=True) then bon:=True; { k }
				end;			
			end;
		end
	end;
	begin
 
		Assign(lst,NomDossier+NomFichier);Rewrite(lst);
 
		for x1:=1 to 8 do
		begin
			for y1:=8 downto 1 do
			begin
				for x2:=1 to 8 do
				begin
					for y2:=8 downto 1 do
					begin
						dxSGN:=x2-x1; dxABS:=Abs(dxSGN);
						dySGN:=y2-y1; dyABS:=Abs(dySGN);
						colorP1:=SGN(occ[x1,y1]);
						colorP2:=SGN(occ[x2,y2]);
						bon:=False;
 
						case Abs(occ[x1,y1]) of
							1:mvtPION2;
							6:mvtROI2;
						end;
 
						if bon=True then
						begin
							cp:=NomCaze(x1,y1)+NomCaze(x2,y2);
							Write(lst,cp);
						end;
					end;
				end;
			end;
		end;
 
		Close(lst);
 
	end;
 
BEGIN
	Initialise;
	AffichePosition(Occupant8);
	CalculeECHEC(Occupant8,Trait,Echec,Condition2,'LISTE1');
	CoupsSpeciaux(Occupant8,Trait,Condition1,Condition2,CazePassant,'LISTE2');
	FichierTXT;
	ReadLn;
END.

[Roland Chastain]

Bonjour !
Je voudrais vous présenter l'état actuel de mon programme :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
 
{
========================================
*  Programme : .............. ESCHECS  *
*  Compilation : ... Turbo Pascal 7.0  *
*  ................Virtual Pascal 2.1  *
*  Description : ....... Jeu d'‚checs  *
*  Auteur : ......... Roland Chastain  *
*  Adresse : .......... Bamako (MALI)  *
*  Version : .............. Brouillon  *
*  DerniŠre modification : 20/02/2012  *
========================================
}
 
PROGRAM ESCHECS;
 
USES Crt;
 
CONST NomDossier:String='c:\Atelier\PAS\TEMP\';
 
(* N.B. Le chemin ci-dessus est … remplacer. Il *)
(* doit conduire … un dossier d‚j… existant qui *)
(* contiendra les fichiers temporaires utilis‚s *)
(* par le programme.                            *)
 
TYPE
	{::::::::::::::::::::::::::::::::::::::::::::::::::::}
	TCoord12      = -1..10                               ;
	TCoord8       =  1.. 8                               ;
	TPiece        = -6.. 7                               ;
	TCouleur      = -1.. 1                               ;
	TNomCaze      = String[2]                            ;
	TCoup         = String[4]                            ;
	TTableau12x12 = Array [TCoord12,TCoord12] of  TPiece ;
	TTableau8x8   = Array [TCoord8,TCoord8]   of  TPiece ;
	TTableau4B    = Array [0..3]              of Boolean ;
	TCaracteres   = Array [TPiece]            of    Char ;
	TListe        = File                      of   TCoup ;
	{::::::::::::::::::::::::::::::::::::::::::::::::::::}
VAR
	{:::::::::::::::::::::::::::}
	Occupant12  : TTableau12x12 ;
	Occupant8   :   TTableau8x8 ;
	Trait       :       Boolean ;
	Condition1  :    TTableau4B ;
	CazePassant :      TNomCaze ;
	Echec       :       Boolean ;
	Condition2  :    TTableau4B ;
	nbDemiCoups :       Integer ;
	nbCoups     :       Integer ;
	Ordre       :        String ;
	{:::::::::::::::::::::::::::}
CONST
 
	Initiale:TTableau12x12=(
 
	( 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 ),
	( 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 ),
	( 7 , 7 , 4 , 1 , 0 , 0 , 0 , 0 ,-1 ,-4 , 7 , 7 ),
	( 7 , 7 , 2 , 1 , 0 , 0 , 0 , 0 ,-1 ,-2 , 7 , 7 ),
	( 7 , 7 , 3 , 1 , 0 , 0 , 0 , 0 ,-1 ,-3 , 7 , 7 ),
	( 7 , 7 , 5 , 1 , 0 , 0 , 0 , 0 ,-1 ,-5 , 7 , 7 ),
	( 7 , 7 , 6 , 1 , 0 , 0 , 0 , 0 ,-1 ,-6 , 7 , 7 ),
	( 7 , 7 , 3 , 1 , 0 , 0 , 0 , 0 ,-1 ,-3 , 7 , 7 ),
	( 7 , 7 , 2 , 1 , 0 , 0 , 0 , 0 ,-1 ,-2 , 7 , 7 ),
	( 7 , 7 , 4 , 1 , 0 , 0 , 0 , 0 ,-1 ,-4 , 7 , 7 ),
	( 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 ),
	( 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 ));
 
	Caracteres: TCaracteres=(
 
	'k','q','r','b','n','p',chr(176),
	'P','N','B','R','Q','K',chr(177));
 
	CaracterFR: TCaracteres=(
 
	'r','d','t','f','c','p',chr(176),
	'P','C','F','T','D','R',chr(177));
 
FUNCTION NomCaze(x,y:TCoord8):TNomCaze;
	begin NomCaze:=chr(x+96)+chr(y+48);
	end;
 
FUNCTION PositionFEN(
	oc :  TTableau8x8 ;
	tr :      Boolean ;
	a1 :   TTableau4B ;
	pa :     TNomCaze ;
	c1 :      Integer ;
	c2 :      Integer )
						: STRING;
 
	begin
	PositionFEN:='...';
	end; { positionFEN }
 
PROCEDURE Initialise;
	var x,y:TCoord12;
	begin
	for x:=-1 to 10 do begin
		for y:=-1 to 10 do begin
			Occupant12[x,y]:=Initiale[x,y];
		end;
	end;
	for x:=1 to 8 do begin
		for y:=1 to 8 do begin
			Occupant8[x,y]:=Initiale[x,y];
		end;
	end;
	Trait:=False; { w }
	Condition1[0]:=True; { q } { e8c8 }
	Condition1[1]:=True; { k } { e8g8 }
	Condition1[2]:=True; { Q } { e1c1 }
	Condition1[3]:=True; { K } { e1g1 }
	CazePassant:='-';
	nbDemiCoups:=0;
	nbCoups:=1;
	end; { Initialise }
 
FUNCTION SGN(n:TPiece):TCouleur;
	begin
		case n of
			-6..-1 :SGN:=-1 ;
					 0 :SGN:= 0 ;
			 1.. 7 :SGN:= 1 ;
		end;
	end; { SGN }
 
PROCEDURE AfficheCoordonnees(c:Byte);
	const ABC:String=chr(254)+'  A  B  C  D  E  F  G  H  '+chr(254);
	var x,y:Byte;
	begin
					TextColor(c);
					GotoXY(2,2);
					Write(ABC);
					for y:=8 downto 1 do
					begin
									GotoXY( 2,2*(9-y)+2); Write(y);
									GotoXY(29,2*(9-y)+2); Write(y);
					end;
					GotoXY(2,20); Write(ABC);
					TextColor(Black);
	end; { AfficheCoordonnees }
 
PROCEDURE AfficheTablier(occup:TTableau8x8;c1,c2,c3:Byte);
{
c1 couleur piŠces blanches
c2 couleur piŠces noires
c3 couleur carreaux
}
	var x,y:TCoord8;
 
	begin
	for y:=8 downto 1 do
	begin
	for x:=1 to 8 do
	begin
	case SGN(occup[x,y]) of
	-1:TextColor(c2);
	 0:TextColor(c3);
	 1:TextColor(c1);
	end;
	GotoXY(3*x+2,2*(9-y)+2);
	Write(CaracterFR[occup[x,y]]);
	end;
	end;
 
	end; { AfficheTablier }
 
PROCEDURE CalculeECHEC(
	occ:     TTableau8x8;
	trt:         Boolean;
	var chc:     Boolean;
	var cnd:  TTableau4B;
	NomFichier:  String);
	var
		x1,y1,x2,y2:      TCoord8;
		dxSGN,dySGN:     ShortInt;
		dxABS,dyABS:         Byte;
		colorP1,colorP2: TCouleur;
		cp:                 TCoup;
		bon:              Boolean;
		lst:               TListe;
	procedure mvtPION;
	begin
		if SGN(dySGN)=colorP1 then
		begin
			if (colorP2=-1*colorP1) and (dxABS=1) and (dyABS=1) then bon:=True;
			if (colorP2=0) and (dxABS=0) then
			begin
				if dyABS=1 then bon:=True;
				if dyABS=2 then
				begin
					if (colorP1=-1) and (y1=7) and (occ[x1,y1-1]=0) then bon:=True;
					if (colorP1=01) and (y1=2) and (occ[x1,y1+1]=0) then bon:=True;
				end;
			end;
		end;
	end; { mvtPION }
	procedure mvtCAVALIER;
		begin
			if (colorP2=-1*colorP1) or (colorP2=0) then
			begin
				if dxABS*dxABS+dyABS*dyABS=5 then bon:=True;
			end;
		end; { mvtCAVALIER }
	procedure mvtFOU;
		var
			ax,ay:TCouleur;
			nx,ny:ShortInt;
			obstat:Boolean;
		begin
			if (colorP2=-1*colorP1) or (colorP2=0) then
			begin
				if (dxABS>0) and (dxABS=dyABS) then
				begin
					ax:=SGN(dxSGN);
					ay:=SGN(dySGN);
					nx:=0;
					ny:=0;
					obstat:=False;
					repeat
						nx:=nx+ax;
						ny:=ny+ay;
						if nx=dxSGN then bon:=True;
						if Abs(occ[x1+nx,y1+ny])>0 then obstat:=True;
					until (bon=True) or (obstat=True);
				end;
			end;
		end; { mvtFOU }
	procedure mvtTOUR;
		var
			ax,ay:TCouleur;
			nx,ny:ShortInt;
			obstat:Boolean;
		begin
			if (colorP2=-1*colorP1) or (colorP2=0) then
			begin
				if (dxABS*dyABS=0) and (dxABS+dyABS>0) then
				begin
					ax:=SGN(dxSGN);
					ay:=SGN(dySGN);
					nx:=0;
					ny:=0;
					obstat:=False;
					repeat
						nx:=nx+ax;
						ny:=ny+ay;
						if (nx=dxSGN) and (ny=dySGN) then bon:=True;
						if Abs(occ[x1+nx,y1+ny])>0 then obstat:=True;
					until (bon=True) or (obstat=True);
				end;
			end;
		end; { mvtTOUR }
	procedure mvtDAME;
		var
			ax,ay:TCouleur;
			nx,ny:ShortInt;
			obstat:Boolean;
		begin
			if (colorP2=-1*colorP1) or (colorP2=0) then
			begin
				if (dxABS>0) and (dxABS=dyABS) then
				begin
					ax:=SGN(dxSGN);
					ay:=SGN(dySGN);
					nx:=0;
					ny:=0;
					obstat:=False;
					repeat
						nx:=nx+ax;
						ny:=ny+ay;
						if nx=dxSGN then bon:=True;
						if Abs(occ[x1+nx,y1+ny])>0 then obstat:=True;
					until (bon=True) or (obstat=True);
				end;
				if (dxABS*dyABS=0) and (dxABS+dyABS>0) then
				begin
					ax:=SGN(dxSGN);
					ay:=SGN(dySGN);
					nx:=0;
					ny:=0;
					obstat:=False;
					repeat
						nx:=nx+ax;
						ny:=ny+ay;
						if (nx=dxSGN) and (ny=dySGN) then bon:=True;
						if Abs(occ[x1+nx,y1+ny])>0 then obstat:=True;
					until (bon=True) or (obstat=True);
				end;
			end;
		end; { mvtDAME }
	procedure mvtROI;
	begin
		if (colorP2=-1*colorP1) or (colorP2=0) then
		begin
			if (dxABS<2) and (dyABS<2) then bon:=True;
		end;
	end; { mvtROI }
	begin
		Assign(lst,NomDossier+NomFichier);
		Rewrite(lst);
		for x1:=1 to 8 do
		begin
			for y1:=8 downto 1 do
			begin
				for x2:=1 to 8 do
				begin
					for y2:=8 downto 1 do
					begin
						dxSGN:=x2-x1; dxABS:=Abs(dxSGN);
						dySGN:=y2-y1; dyABS:=Abs(dySGN);
						colorP1:=SGN(occ[x1,y1]);
						colorP2:=SGN(occ[x2,y2]);
						bon:=False;
						case Abs(occ[x1,y1]) of
							1:mvtPION;
							2:mvtCAVALIER;
							3:mvtFOU;
							4:mvtTOUR;
							5:mvtDAME;
							6:mvtROI;
						end;
						if bon=True then
						begin
							cp:=NomCaze(x1,y1)+NomCaze(x2,y2);
							Write(lst,cp);
						end;
					end;
				end;
			end;
		end;
		Close(lst);
		chc:=False;
		cnd[0]:=True;
		cnd[1]:=True;
		cnd[2]:=True;
		cnd[3]:=True;
		Assign(lst,NomDossier+NomFichier);
		Reset(lst);
		while not Eof(lst) do
		begin
			Read(lst,cp);
 
			x1:=Ord(cp[1])-96;
			y1:=Ord(cp[2])-48;
			x2:=Ord(cp[3])-96;
			y2:=Ord(cp[4])-48;
 
			colorP1:=SGN(occ[x1,y1]);
 
			if (trt=False) and (colorP1=-1) then
			begin
				if occ[x2,y2]=6 then chc:=True;
				if (y2=1) and (x2<6) then cnd[2]:=False;
				if (y2=1) and (x2>5) then cnd[3]:=False;
			end;
 
			if (trt=True) and (colorP1=1) then
			begin
				if occ[x2,y2]=-6 then chc:=True;
				if (y2=8) and (x2<6) then cnd[0]:=False;
				if (y2=8) and (x2>5) then cnd[1]:=False;
			end;
 
		end;
		Close(lst);
	end; { CalculeECHEC }
 
PROCEDURE CoupsSpeciaux(
		occ:    TTableau8x8;
		trt:        Boolean;
		cnd1:    TTableau4B;
		cnd2:    TTableau4B;
		pass:      TNomCaze;
		NomFichier: String);
	var
		x1,y1,x2,y2:      TCoord8;
		dxSGN,dySGN:     ShortInt;
		dxABS,dyABS:         Byte;
		colorP1,colorP2: TCouleur;
		cp:                 TCoup;
		bon:              Boolean;
		lst:               TListe;
	procedure mvtPION2;
	begin
		if (dySGN=colorP1) and (dxABS=1) then
		begin
			if NomCaze(x2,y2)=pass then bon:=True;
		end;
	end;
	procedure mvtROI2;
	begin
		if (dyABS=0) and (dxABS=2) then
		begin
 
			if not trt then begin
				if (occ[2,1]=0) and (occ[3,1]=0) and (occ[4,1]=0) then begin
					if (cnd1[2] and cnd2[2]) then bon:=True; { Q }
				end;
				if (occ[6,1]=0) and (occ[7,1]=0) then begin
					if (cnd1[3] and cnd2[3]) then bon:=True; { K }
				end;
			end;
 
			if trt then begin
				if (occ[2,8]=0) and (occ[3,8]=0) and (occ[4,8]=0) then begin
					if (cnd1[0] and cnd2[0]) then bon:=True; { q }
				end;
				if (occ[6,8]=0) and (occ[7,8]=0) then begin
					if (cnd1[1] and cnd2[1]) then bon:=True; { k }
				end;
			end;
		end
	end;
	begin
		Assign(lst,NomDossier+NomFichier);
		Rewrite(lst);
		for x1:=1 to 8 do
		begin
			for y1:=8 downto 1 do
			begin
				for x2:=1 to 8 do
				begin
					for y2:=8 downto 1 do
					begin
						dxSGN:=x2-x1; dxABS:=Abs(dxSGN);
						dySGN:=y2-y1; dyABS:=Abs(dySGN);
						colorP1:=SGN(occ[x1,y1]);
						colorP2:=SGN(occ[x2,y2]);
						bon:=False;
						case Abs(occ[x1,y1]) of
							1:mvtPION2;
							6:mvtROI2;
						end;
						if bon=True then
						begin
							cp:=NomCaze(x1,y1)+NomCaze(x2,y2);
							Write(lst,cp);
						end;
					end;
				end;
			end;
		end;
		Close(lst);
	end;
 
PROCEDURE CoupsPermis(occ:TTableau8x8;trt:Boolean;nf1:String;nf2:String;nf3:String);
	var
	EchecA      :     Boolean ;
	Cond2A      :  TTableau4B ;
	Fictif      : TTableau8x8 ;
	x1,y1,x2,y2 :     TCoord8 ;
	cp          :       TCoup ;
	lst,lstb    :      TListe ;
	BCouleur    :     Boolean ;
 
	procedure Tri;
	begin
 
		x1:=Ord(cp[1])-96;
		y1:=Ord(cp[2])-48;
		x2:=Ord(cp[3])-96;
		y2:=Ord(cp[4])-48;
 
		EchecA:=False;
		Fictif:=occ;
		Fictif[x2,y2]:=Fictif[x1,y1];
		Fictif[x1,y1]:=0;
		CalculeEchec(Fictif,trt,EchecA,Cond2A,'L');
 
		BCouleur:=False;
		case trt of
		False:if SGN(occ[x1,y1])= 1 then BCouleur:=True;
		True:if SGN(occ[x1,y1])=-1 then BCouleur:=True;
		end;
 
	end; { Tri }
 
	begin
		Assign(lstb,NomDossier+nf3); Rewrite(lstb);
			Assign(lst,NomDossier+nf1); Reset(lst);
				while not Eof(lst) do
				begin
					Read(lst,cp);
					Tri;
					if (not EchecA) and BCouleur then write(lstb,cp);
				end;
			Close(lst);
			Assign(lst,NomDossier+nf2); Reset(lst);
				while not Eof(lst) do
				begin
					Read(lst,cp);
					Tri;
					if (not EchecA) and BCouleur then write(lstb,cp);
				end;
			Close(lst);
		Close(lstb);
	end; { Coups permis }
 
PROCEDURE Informations;
var lst:TListe; AucunCoupPossible:Boolean; cp:TCoup;
	begin
		AucunCoupPossible:=False; cp:='';
		Assign(lst,NomDossier+'LISTE3');
		Reset(lst);
		while not Eof(lst) do
		begin
			Read(lst,cp);
		end;
		Close(lst);
		if cp='' then AucunCoupPossible:=True;
		GotoXY(60,2); Write('Eschec au roi=',Echec); ClrEol;
		GotoXY(60,4); Write('Eschec et mat=',Echec and AucunCoupPossible); ClrEol;
		GotoXY(60,6); Write('Partie remise=',(not Echec) and AucunCoupPossible); ClrEol;
	end;
 
PROCEDURE Commande(trt:Boolean;var cmnd:String);
	const nomProg:String='ESCHECS';
	var couleur:String;OK:Boolean;lst:TListe;cp:TCoup;valab:Boolean;
	begin
		OK:=False;
		while OK=False do
		begin
			GotoXY(2,23);
			Write(nomProg,'>');
			if trt=False then couleur:='BLANC' else couleur:='NOIR';
			Write(couleur,'>'); ClrEol; ReadLn(cmnd);
			Assign(lst,NomDossier+'LISTE3'); Reset(lst); valab:=False;
			while not Eof(lst) do
			begin
				Read(lst,cp);
				if cmnd=cp then valab:=True;
			end;
			OK:=valab;
			if cmnd='exit'then OK:=True;
		end;
	end;
 
PROCEDURE FichierTXT;
	var
		F:Text;
		i:Byte;
		lst:TListe;
		cp:TCoup;
	begin
		Assign(F,NomDossier+'RESULTAT.txt');
			Rewrite(F);
			WriteLn(F,'FEN=',PositionFEN(Occupant8,Trait,Condition1,CazePassant,nbDemiCoups,nbCoups));
			WriteLn(F,'Echec=',Echec);
			for i:=0 to 3 do begin WriteLn(F,'C2[',i,']=',Condition2[i]); end;
			WriteLn(F,'Possibles=');
			Assign(lst,NomDossier+'LISTE3');
				Reset(lst);
				while not Eof(lst) do
				begin
					Read(lst,cp);
					WriteLn(F,cp);
				end;
			Close(lst);
		Close(F);
	end; { FichierTXT }
 
PROCEDURE AffichePalette;
	var i:Byte;
	begin
		for i:=15 downto 0 do
		begin
			GotoXY(3*i+2,25); TextColor(i); Write(chr(254));
		end;
	end;
 
PROCEDURE Mouvement(cp:TCoup);
	var x1,y1,x2,y2,x,y:TCoord8;
	piece:TPiece;
	prise:TPiece;
	dx,dy:ShortInt;
	begin
	x1:=Ord(cp[1])-96;
	y1:=Ord(cp[2])-48;
	x2:=Ord(cp[3])-96;
	y2:=Ord(cp[4])-48;
	piece:=Occupant8[x1,y1];
	prise:=Occupant8[x2,y2];
	dx:=Abs(x1-x2);
	dy:=Abs(y1-y2);
	if (Abs(piece)=1) and ( (y2=8) or (y2=1) ) then Occupant8[x1,y1]:=5*Occupant8[x1,y1] ;
{ promotion automatique du pion en dame }
	Occupant8[x2,y2]:=Occupant8[x1,y1]; Occupant8[x1,y1]:=0;
	if (Abs(piece)=1) and ( (dx=1) and (prise=0) ) then Occupant8[x2,y1]:=0; { prise du pion passant }
	if (Abs(piece)=6) and (dx=2) then
	begin
		if NomCaze(x2,y2)='c8' then begin
			Occupant8[1,8]:= 0;
			Occupant8[4,8]:=-4;
		end;
		if NomCaze(x2,y2)='g8' then begin
			Occupant8[8,8]:= 0;
			Occupant8[6,8]:=-4;
		end;
		if NomCaze(x2,y2)='c1' then begin
			Occupant8[1,1]:= 0;
			Occupant8[4,1]:=+4;
		end;
		if NomCaze(x2,y2)='g1' then begin
			Occupant8[8,1]:= 0;
			Occupant8[6,1]:=+4;
		end;
	end;
	for x:=1 to 8 do
	begin
		for y:=1 to 8 do
		begin
			Occupant12[x,y]:=Occupant8[x,y];
		end;
	end;
	Trait:=not Trait;
	if piece= -6 then
	begin
	Condition1[0]:=false;
	Condition1[1]:=false;
	end;
	if piece= +6 then
	begin
	Condition1[2]:=false;
	Condition1[3]:=false;
	end;
	if NomCaze(x1,y1)='a8' then Condition1[0]:=false;
	if NomCaze(x1,y1)='h8' then Condition1[1]:=false;
	if NomCaze(x1,y1)='a1' then Condition1[2]:=false;
	if NomCaze(x1,y1)='h1' then Condition1[3]:=false;
	if (Abs(piece)=1) and (dy=2) then CazePassant:=NomCaze(x2,y2-SGN(piece)) else CazePassant:='-';
	if (Abs(piece)=1) or (prise<>0) then nbDemiCoups:=0 else Inc(nbDemiCoups);
	if not Trait then Inc(nbCoups);
	end; { Mouvement }
 
BEGIN
 
	TextBackground(LightGray);ClrScr;
	AfficheCoordonnees(4);
	(*AffichePalette;*)
	Initialise;
 
	repeat
 
		AfficheTablier(Occupant8,15,0,8);
		TextColor(LightGray);
 
		CalculeECHEC(Occupant8,Trait,Echec,Condition2,'LISTE1');
		CoupsSpeciaux(Occupant8,Trait,Condition1,Condition2,CazePassant,'LISTE2');
		CoupsPermis(Occupant8,Trait,'LISTE1','LISTE2','LISTE3');
 
		TextColor(Black);
		Informations;
		FichierTXT;
		Commande(Trait,Ordre);
 
		if not (Ordre='exit') then Mouvement(Ordre);
 
	until Ordre='exit';
 
END.

Pour le moment c'est un simple échiquier : on ne peut jouer que contre soi-même. Le programme calcule pour chaque position : les coups possibles, l'échec, le mat, la partie nulle.



J'ai rencontré un problème sérieux : le programme s'exécute correctement pendant quelques tours, mais au bout d'un moment il s'arrête avec ce message : "ERROR 4 Too many files open". Pourtant, après vérification, il me semble que tous les fichiers ouverts sont correctement refermés.
Il y a une procédure dans laquelle j'ouvre deux fichiers en même temps, pour lire dans l'un et écrire dans l'autre. Mais si c'est de là que vient l'erreur, pourquoi cela marche-t-il au début ?

C'est ennuyeux parce que je comptais me servir de fichiers pour conserver des listes de coups, puisque j'ai cru comprendre qu'il ne fallait pas trop solliciter la mémoire vive. Pour ne pas avoir à m'inquiéter de cela, j'étais décidé à utiliser des fichiers pour conserver les données, et j'étais plutôt satisfait de la vitesse d'exécution. Auriez-vous une idée et pourriez-vous me dire ce qui ne va pas ?
Je viens de faire une partie entière avec Virtual Pascal : l'erreur ne s'est pas produite.
Je vais songer à changer de cheval. Auquel cas j'essaierai quand même de polir ce petit programme, même si ce n'est qu'un exercice de programmation.

[Alcatîz]

Désolé de sauter un peu du coq à l'âne mais il y a peut-être moyen d'afficher des caractères unicode dans la console à l'aide des fonctions de l'API WriteConsole, SetConsoleCursorPosition, etc. Mais pour cela, il faudrait abandonner Turbo Pascal au profit de Virtual Pascal ou Free Pascal.

Il y a des caractères très intéressants ici : http://www.utf8-chartable.de/unicode....pl?start=9728

Je n'ai jamais essayé mais dès que j'aurai un peu de temps...

[droggo]

Hie,

Je m'inquiète pour ton code quand je vois tant de "valeurs magiques", c'est à dire des valeurs numériques dispersées.

Pour la maintenance, lecture plus aisée, ..., on déclare des constantes.

Sinon, je vais prendre un moment pour lire, et voir d'où peut venir ton problème avec les fichiers.

[droggo]

Jai,

De retour.

La faute est ici :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
PROCEDURE Commande(trt:Boolean;var cmnd:String);
	const nomProg:String='ESCHECS';
	var couleur:String;OK:Boolean;lst:TListe;cp:TCoup;valab:Boolean;
	begin
		OK:=False;
		while OK=False do
		begin
			GotoXY(2,23);
			Write(nomProg,'>');
			if trt=False then couleur:='BLANC' else couleur:='NOIR';
			Write(couleur,'>'); ClrEol; ReadLn(cmnd);
			Assign(lst,NomDossier+'LISTE3');
 
			Reset(lst); { ICI, ouvert, et pas fermé }
 
			valab:=False;
			while not Eof(lst) do
			begin
				Read(lst,cp);
				if cmnd=cp then valab:=True;
			end;
			OK:=valab;
			if cmnd='exit'then OK:=True;
		end;
	end;

Pour trouver, je n'ai pas lu le code, mais utilisé la fonction de comptage d'occurrences de mon éditeur :
- 10 Assign
- 4 ReWrite
- 6 Reset
MAIS
- 9 Close !!!

Ne restait qu'à aller voir en se calant sur le ReWrite et Reset, et contrôler les quelques lignes suivantes.

Au passage :

- Évite d'utiliser des tabulations pour l'indentation, la mise en page change selon les options de l'éditeur utilisé.
L'indentation doit être régulière et cohérente dans tout le code, ce qui n'est pas le cas.

- Aère le code, en sautant des lignes pour délimiter les blocs logiques, entre autres, pour mettre en évidence les procédures/fonctions (y compris celles qui sont internes à une autre ).
Tu l'as parfois fait, mais comme pour l'indentation, il faut être cohérent.

- Évite d'écrire plusieurs instructions sur la même ligne, à quelques exceptions près, genre

Code :

1
2
 
		GotoXY(60,6); Write('Partie remise=',(not Echec) and AucunCoupPossible); ClrEol;

qui se comprend bien au premier coup d'œil.

- Idem pour la déclaration des variables quand elles ne sont pas même type.

À part ces remarques, c'est plutôt bien.

[Roland Chastain]

Envoyé par Alcatîz

Désolé de sauter un peu du coq à l'âne mais il y a peut-être moyen d'afficher des caractères unicode dans la console à l'aide des fonctions de l'API WriteConsole, SetConsoleCursorPosition, etc. Mais pour cela, il faudrait abandonner Turbo Pascal au profit de Virtual Pascal ou Free Pascal.

Il y a des caractères très intéressants ici : http://www.utf8-chartable.de/unicode....pl?start=9728

Je n'ai jamais essayé mais dès que j'aurai un peu de temps...

J'ai vu les caractères en question. Ce serait certes plus joli que mes lettres !

Autrement j'ai commencé à feuilleter ton tutoriel sur Virtual Pascal et OWL : ça m'a bien intéressé.