Projet d'un programme de jeu d'échecs

[Roland Chastain]

Envoyé par droggo

La faute est ici :

Code :

Je suis bien content d'être débarrassé de cette erreur.

Merci d'avoir pris le temps de regarder et de commenter.

Je vais faire un effort sur la présentation.

[droggo]

Gie,

Envoyé par Roland Chastain

Je vais faire un effort sur la présentation.

Je l'espère pour toi, c'est plus important qu'on ne le pense a priori.

[Roland Chastain]

Bonjour !

J'ai refait toute la présentation de mon code après avoir enfin compris la différence entre tabulation et indentation (merci à droggo qui m'a mis sur la voie).



Attention ! Pour que le programme fonctionne il faut changer cette ligne :

CheminFichiers : String = 'c:\Atelier\PAS\TEMP\' ;

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
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
 
 
 
{
  ========================================
  *  Programme : .............. ESCHECS  *
  *  Compilation : ... Turbo Pascal 7.0  *
  *  ............... Virtual Pascal 2.1  *
  *  Description : ....... Jeu d'‚checs  *
  *  Auteur : ......... Roland Chastain  *
  *  Version : .............. Brouillon  *
  *  DerniŠre modification : 25/02/2012  *
  ========================================
}
 
PROGRAM ESCHECS ;
 
USES Crt, Dos ;
 
{
  Carreau vide .  0
  Pion blanc ...  1
  Cavalier blanc  2
  Fou blanc ....  3
  Tour blanche .  4
  Dame blanche .  5
  Roi blanc ....  6
	Pion noir .... -1
  Cavalier noir  -2
  Fou noir ..... -3
  Tour noire ... -4
  Dame noire ... -5
  Roi noir ..... -6
	Garde-fou ....  7	
}
 
{
      10
 
       9
 
       8   .   .   .   .   .   .   .   .
 
       7   .   .   .   .   .   .   .   .
 
       6   .   .   .   .   .   .   .   .
 
       5   .   .   .   .   .   .   .   .
			                                                        A B C D E F G H
       4   .   .   .   .   .   .   .   .                   8  . . . . . . . .  8
			                                                     7  . . . . . . . .  7
       3   .   .   .   .   .   .   .   .                   6  . . . . . . . .  6
			                                                     5  . . . . . . . .  5
       2   .   .   .   .   .   .   .   .                   4  . . . . . . . .  4
			                                                     3  . . . . . . . .  3
       1   .   .   .   .   .   .   .   .                   2  . . . . . . . .  2
			                                                     1  . . . . . . . .  1
  -1   0   1   2   3   4   5   6   7   8   9   10        	    A B C D E F G H
 
     - 1
}
 
{ ============================================================================ }
 
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 [0..6]              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
 
  CheminFichiers : String = 'c:\Atelier\PAS\TEMP\' ;
	{ ***************** A MODIFIER ***************** }
 
  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));
 
  Caracteres : TCaracteres = ( chr ( 176 ), 'P', 'C', 'F', 'T', 'D', 'R') ;
 
	roque_e8c8 = 0 ;
	roque_e8g8 = 1 ;
	roque_e1c1 = 2 ;
	roque_e1g1 = 3 ;
 
	{ ============================================================================ }
 
{
PROCEDURE VISIBILITE_CURSEUR ( v : Boolean ) ;
FUNCTION NomCaze (x,y : TCoord8) : TNomCaze ;
FUNCTION PositionFEN (
  oc :  TTableau8x8  ;
  tr :      Boolean  ;
  a1 :   TTableau4B  ;
  pa :     TNomCaze  ;
  c1 :      Integer  ;
  c2 :      Integer  ) : STRING ;
PROCEDURE Initialise ;
FUNCTION SGN ( n : TPiece ) : TCouleur ;
PROCEDURE AfficheCoordonnees ( couleur : Byte ) ;
PROCEDURE AfficheTablier ( occup : TTableau8x8 ;
couleur_pieces_blanches, couleur_pieces_noires,
couleur_carreaux : Byte ) ;
PROCEDURE CalculeECHEC   (
occ        : TTableau8x8 ;
trt        :     Boolean ;
var chc    :     Boolean ;
var cnd    :  TTableau4B ;
NomFichier :      String ) ;
PROCEDURE CoupsSpeciaux  (
occ        : TTableau8x8 ;
trt        :     Boolean ;
cnd1       :  TTableau4B ;
cnd2       :  TTableau4B ;
pass       :    TNomCaze ;
NomFichier :      String ) ;
PROCEDURE CoupsPermis ( occ : TTableau8x8 ; trt : Boolean ; nf1 : String ; nf2 : String ; nf3 : String ) ;
PROCEDURE Informations ;
PROCEDURE Commande ( trt : Boolean ; var cmnd : String ) ;
PROCEDURE FichierTXT ;
PROCEDURE Mouvement ( cp : TCoup ) ;
}
 
PROCEDURE VISIBILITE_CURSEUR ( v : Boolean ) ;
 
  var	regs : registers;
  procedure cursor_aus;
    begin
      regs.ax := $0100;
      regs.cx := $2607;
      intr($10, regs);
    end;
  procedure cursor_ein;
    begin
      regs.ax := $0100;
      regs.cx := $0607;
      intr($10, regs);
    end;
 
	begin
	  if v
		then cursor_ein
		else cursor_aus;
	end;
 
{ ============================================================================ }
 
FUNCTION NomCaze (x,y : TCoord8) : TNomCaze ;
  begin
    NomCaze:=chr(x+96)+chr(y+48);
  end; { NomCaze }
 
{ ============================================================================ }
 
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 [ roque_e8c8 ] := True ; { q }
    Condition1 [ roque_e8g8 ] := True ; { k }
    Condition1 [ roque_e1c1 ] := True ; { Q }
    Condition1 [ roque_e1g1 ] := True ; { K }
 
    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 ( couleur : Byte ) ;
  const ABC : String = chr ( 254 ) + '  a  b  c  d  e  f  g  h  ' + chr ( 254 ) ;
  var x, y : Byte ;
  begin
 
    TextColor ( couleur ) ;
    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 ;
couleur_pieces_blanches, couleur_pieces_noires,
couleur_carreaux : Byte ) ;
 
  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 ( couleur_pieces_noires ) ;
           0 : TextColor ( couleur_carreaux       ) ;
           1 : TextColor ( couleur_pieces_blanches ) ;
 
        end;
 
        GotoXY ( 3 * x + 2, 2 * ( 9 - y ) + 2 ) ;
        Write ( Caracteres [  Abs ( occup [ x, y ] ) ] ) ;
 
      end;
    end;
    TextColor ( Black ) ;
  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 =  1 ) 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, CheminFichiers + 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 ;
            dySGN := y2-y1 ;
				  	dxABS := Abs(dxSGN);
			  		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 [ roque_e8c8 ] := True ;
    cnd [ roque_e8g8 ] := True ;
    cnd [ roque_e1c1 ] := True ;
    cnd [ roque_e1g1 ] := True ;
 
    Assign(lst,CheminFichiers+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[ roque_e1c1 ]:=False;
        if (y2=1) and (x2>5) then cnd[ roque_e1g1 ]:=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[ roque_e8c8 ]:=False;
        if (y2=8) and (x2>5) then cnd[ roque_e8g8 ]:=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[ roque_e1c1 ] and cnd2[ roque_e1c1 ]) then bon:=True; { Q }
          end;
          if (occ[6,1]=0) and (occ[7,1]=0) then
				  begin
            if (cnd1[ roque_e1g1 ] and cnd2[ roque_e1g1 ]) 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[ roque_e8c8 ] and cnd2[ roque_e8c8 ]) then bon:=True; { q }
          end;
          if (occ[6,8]=0) and (occ[7,8]=0) then
			    begin
            if (cnd1[ roque_e8g8 ] and cnd2[ roque_e8g8 ]) then bon:=True; { k }
          end;
        end;
 
      end
    end;
 
  begin
 
    Assign(lst,CheminFichiers+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 ;
    dySGN := y2-y1 ;
  	dxABS := Abs ( dxSGN ) ;
  	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; { CoupsSpeciaux }
 
{ ============================================================================ }
 
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,CheminFichiers+nf3); Rewrite(lstb);
 
      Assign(lst,CheminFichiers+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,CheminFichiers+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,CheminFichiers+'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; {Information }
 
{ ============================================================================ }
 
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, 24 ) ;
      Write ( nomProg, '>' ) ;
 
      if not trt
			then couleur := 'BLANC'
			else couleur := 'NOIR' ;
 
      Write ( couleur, '>' ) ;
			ClrEol ; ReadLn ( cmnd ) ;
 
      Assign ( lst, CheminFichiers + 'LISTE3' ) ;
 
        Reset ( lst );
 
        valab := False ;
 
        while not Eof ( lst ) do
        begin
          Read ( lst, cp ) ;
          if cmnd = cp then valab := True ;
        end ;
 
        OK := valab ;
 
      Close ( lst ) ;
 
      if cmnd = 'exit' then OK := True ;
 
    end ;
  end ; { Commande }
 
{ ============================================================================ }
 
PROCEDURE FichierTXT ;
  var
  F : Text ;
  i : Byte ;
  lst : TListe ;
  cp : TCoup ;
  begin
 
    Assign ( F, CheminFichiers + '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, CheminFichiers + 'LISTE3' ) ;
 
        Reset ( lst ) ;
 
        while not Eof ( lst ) do
        begin
          Read ( lst, cp ) ;
          WriteLn ( F, cp ) ;
        end;
 
      Close ( lst ) ;
 
    Close ( F ) ;
 
  end ; { FichierTXT }
 
{ ============================================================================ }
 
PROCEDURE Mouvement ( cp : TCoup ) ;
 
  var
	  x1, y1, x2, y2, x, y : TCoord8 ;
    piece, 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 ] ;
 
    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 ;
 
    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 [ roque_e8c8 ] := false ;
      Condition1 [ roque_e8g8 ] := false ;
 
    end;
 
    if piece= 6 then
    begin
 
      Condition1 [ roque_e1c1 ] := false ;
      Condition1 [ roque_e1g1 ] := false ;
 
    end;
 
    if NomCaze ( x1, y1 ) = 'a8' then Condition1 [ roque_e8c8 ] := false ;
    if NomCaze ( x1, y1 ) = 'h8' then Condition1 [ roque_e8g8 ] := false ;
    if NomCaze ( x1, y1 ) = 'a1' then Condition1 [ roque_e1c1 ] := false ;
    if NomCaze ( x1, y1 ) = 'h1' then Condition1 [ roque_e1g1 ] := 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
 
	Initialise ;
	VISIBILITE_CURSEUR ( False ) ;	
 
  TextBackground ( Brown ) ;
	ClrScr ;
 
	{ fenêtre échiquier }
	TextBackground ( LightGray ) ;
	Window ( 2, 2, 31, 22 ) ;
	ClrScr ;
 
  AfficheCoordonnees ( Brown ) ;
 
  repeat
 
		{ fenêtre échiquier }	
	  TextBackground ( LightGray ) ;
	  Window ( 2, 2, 31, 22 ) ;  
 
    AfficheTablier ( Occupant8, Blue, Red, DarkGray ) ;
 
		{ fenêtre standard }
		TextBackground ( Brown ) ;
		Window ( 1, 1, 80, 25 ) ;
 
    CalculeECHEC (
		Occupant8,
		Trait,
		Echec,
		Condition2,
		'LISTE1' ) ;
 
    CoupsSpeciaux (
		Occupant8,
		Trait,
		Condition1,
		Condition2,
		CazePassant,
		'LISTE2' ) ;
 
    CoupsPermis (
		Occupant8,
		Trait,
		'LISTE1',
		'LISTE2',
		'LISTE3' ) ;
 
    FichierTXT ;
		Informations ;
 
		VISIBILITE_CURSEUR ( True ) ;
    Commande ( Trait, Ordre ) ;
		VISIBILITE_CURSEUR ( False ) ;
 
    if not ( Ordre = 'exit' ) then Mouvement ( Ordre ) ;
 
  until Ordre='exit';
END.

[Roland Chastain]

Bonjour !

Je voudrais vous présenter le dernier état de mon programme. Comme il commence à être un peu lourd pour l'insérer ici, je vous le propose à télécharger.

ESCHECS.PAS

Désormais vous jouez contre l'ordinateur. Pour le moment, son "intelligence articielle" se limite à cette idée que prendre une pièce vaut mieux que de ne pas la prendre, et que plus la prise est importante mieux c'est !

Code :

Plus ( note[index], P2 ) ; { dans la fonction MeilleurCoup }

Quand cette règle n'est pas applicable, il joue au hasard (le dernier coup évalué).

J'ai noté que la compilation avec Virtual Pascal semble bien se passer, mais qu'ensuite le programme donne des résultats faux.

Attention, pour que le programme fonctionne il y a toujours cette ligne à modifier :

Code :

1
2
3
 
CheminFichiers : String = 'c:\Atelier\PAS\TEMP\' ;
{****************** A MODIFIER ******************}

Enfin, j'aimerais avoir votre conseil sur la question suivante : serait-il possible (et pas trop difficile !) de faire un échiquier graphique sous la forme d'un exécutable séparé que le programme principal appellerait ?

Edition 06/03

Suite de ma question d'hier. Je voulais ajouter que si quelqu'un était tenté par l'exercice de réaliser une interface graphique pour un jeu d'échecs, j'accepterais volontiers une association ! Cela me permettrait de me concentrer sur le moteur.

Voici ce que j'ai en tête : j'aimerais bien continuer mon moteur avec TP7 et le joindre (je ne sais trop comment) à un échiquier fait avec Lazarus ou Virtual Pascal par exemple. A votre avis est-ce possible et est-ce une bonne idée ?

[Roland Chastain]

Bonjour !

Voici à quoi ressemble mon début de jeu d'échecs :



Le jeu de l'ordinateur commence à prendre forme. Je me suis servi, entre autres choses, de tableaux de constantes pour indiquer à chaque pièce les "bonnes" cases :

Code :

1
2
3
4
5
6
7
8
9
10
 
 { Cavalier noir } 
((1,1,1,1,1,0,1,1),
 (1,1,1,1,1,1,1,1),
 (1,1,1,1,1,1,1,1),
 (1,1,1,1,1,1,0,1),
 (1,1,1,1,1,1,0,1),
 (1,1,1,1,1,1,1,1),
 (1,1,1,1,1,1,1,1),
 (1,1,1,1,1,0,1,1)),

C'est rudimentaire mais assez pratique, au moins pour l'ouverture.

Du coup les parties d'essai deviennent un peu plus longues, et quand la position se complique, l'affichage par lettres devient vraiment un obstacle. Aussi, je crois que je vais laisser ce petit programme tel qu'il est et changer d'environnement.

[droggo]

Qua,

Petite suggestion pour la présentation :

Au lieu d'utiliser des minuscules/majuscules pour différencier les 2 joueurs, 2 couleurs seraient plus aisément distinguables au coup d'œil.

De même pour l'échiquier, tu pourrais jouer du BackGround pour dessiner les cases avec 2 couleurs (sans oublier de gérer correctement l'affichage avec les lettres des pièces selon le joueur).

C'est en tout cas le genre de truc que j'aurais fait (avec un principe : profiter des possibilités quand elles permettent d'améliorer l'ergonomie).

[Roland Chastain]

Envoyé par droggo

Petite suggestion pour la présentation :

Au lieu d'utiliser des minuscules/majuscules pour différencier les 2 joueurs, 2 couleurs seraient plus aisément distinguables au coup d'œil.

De même pour l'échiquier, tu pourrais jouer du BackGround pour dessiner les cases avec 2 couleurs (sans oublier de gérer correctement l'affichage avec les lettres des pièces selon le joueur).

Merci pour ta réponse. J'ai remis mon ouvrage sur le métier. Voici ce que ça donne :



Il y a du mieux !

[Roland Chastain]

Bonjour !

Un autre essai d'échiquier en mode texte :



J'ai complété la fonction d'évaluation :

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
{ DEBUT DE L'EVALUATION }
 
{ prise }
Plus ( note [ index ], P2 ) ;
if P2 > P1 then Plus ( note [ index ], 100 ) ;
{ couverture à l'arrivée }
if couleurP1 * ( nbPCB[x2,y2] - nbPCN[x2,y2] ) > 0
then Plus ( note [ index ], 1 ) ;
{ jeu au centre }
Plus ( note [ index ], - 0.1 * Abs ( x2-9/2 ) ) ;
{ ordre }
case P1 of
  Pion     : Plus ( note [ index ], 0.3 ) ;
  Cavalier : Plus ( note [ index ], 0.2 ) ;
  Fou      : Plus ( note [ index ], 0.2 ) ;
  Tour     : Plus ( note [ index ], 0.1 ) ;
  Dame     : Plus ( note [ index ], 0.1 ) ;
  Roi      : Plus ( note [ index ], 0.0 ) ;
end ;
{ guide-pièce }
Plus ( note [ index ], Guide [ piece, x2, y2 ] / 5 ) ;
{ premier coup du pion }
if ( P1 = Pion ) and ( dy = 2 ) then
begin
  if ( nbCoups = 1 )
  then
    begin
      Plus ( note [ index ], 1 ) ;
    end
  else
    begin
      Plus ( note [ index ], - 1 ) ;
    end ;
end ;
{ pièces menacées }
CalculeECHECmod ( Fictif, not Trait, Menace, 'L' ) ;
Plus ( note [ index ], - Menace ) ;
 
{ FIN DE L'EVALUATION }

Pour les premiers coups de la partie, cela donne un jeu acceptable. Il faudrait que j'ajoute une détection défensive et offensive du mat, au moins au coup suivant.



ESCHECS.PAS

[droggo]

Luo,

Je préfère la version montrée dans le message #27, sauf pour la bordure avec les indices ligne/colonne, plus clair dans la nouvelle version.

Pour les pièces, j'aurais utilisé p au lieu de P pour les pions, ça se distingue plus aisément des majuscules pour les autres pièces.

[Roland Chastain]

Envoyé par droggo

Je préfère la version montrée dans le message #27, sauf pour la bordure avec les indices ligne/colonne, plus clair dans la nouvelle version.

Pour les pièces, j'aurais utilisé p au lieu de P pour les pions, ça se distingue plus aisément des majuscules pour les autres pièces.

Oui et oui !

J'avais déjà fait la première modification. Merci de m'avoir fait penser à la seconde. Il me semble que c'est nettement mieux comme ça. Je garde !

[mick605]

Salut

Pour répondre à :

Voici ce que j'ai en tête : j'aimerais bien continuer mon moteur avec TP7 et le joindre (je ne sais trop comment) à un échiquier fait avec Lazarus ou Virtual Pascal par exemple. A votre avis est-ce possible et est-ce une bonne idée ?

Je pense que c'est se prendre la tête pour rien. Normalement, c'est du Pascal, donc un simple portage de ton code sous Lazarus devrait fonctionner (moyennant quelques modifs minimes)

Peut tu m'expliquer ton astuce du tableau de constantes ?

Je me suis servi, entre autres choses, de tableaux de constantes pour indiquer à chaque pièce les "bonnes" cases :

J'avous être intrigué par ta technique ^^.

Bonne chance

[Roland Chastain]

Envoyé par mick605

Je pense que c'est se prendre la tête pour rien. Normalement, c'est du Pascal, donc un simple portage de ton code sous Lazarus devrait fonctionner (moyennant quelques modifs minimes)

Merci pour ta réponse. Je vais essayer d'écrire avec Free Pascal et de repérer les différences en question.

Envoyé par mick605

Peut tu m'expliquer ton astuce du tableau de constantes ?

C'est bête comme tout, et je crains que tu ne sois déçu par mon explication !

A chaque pièce est associé un tableau qui donne tant de points pour telle case. Les points sont ajoutés automatiquement (avec un faible coefficient toutefois) à la note des coups : coup de telle pièce à destination de telle case, tant de points. Par exemple le cavalier a trois façons de sortir de sa position initiale. Une "bonne" et deux mauvaises. J'ajoute un point sur la bonne case ; il joue le coup que je veux. Comme tu vois, cela ne peut servir que pour les coups d'ouverture, parce qu'ensuite on ne peut plus savoir à l'avance quelles sont les "bonnes" cases.

J'ai trouvé cette idée dans les excellentes pages d'Ed Schröder, l'auteur de Rebel et de Pro Deo, deux très forts programmes d'échecs. Je n'ai fait que simplifier le procédé qui était décrit.

En répondant à ta question, je m'aperçois qu'il me faut une fonction qui distingue les moments du jeux. Il me semble à présent que le coefficient n'est pas la bonne solution.

Merci pour tes encouragements !

J'ai essayé sérieusement Free Pascal. Il me plaît. Mais je ne sais pas me servir des librairies et pour le moment je ne veux pas apprendre, parce que cela me détournerait de mon projet actuel, qui est d'apprendre à programmer un jeu d'échecs et d'apprendre à bien programmer en Pascal. Pour cela, l'IDE Free Pascal me suffit. Mais si quelqu'un qui a déjà bien en main Lazarus veut s'associer à ce projet, il ne me faudra pas longtemps pour réécrire mon code.

[Roland Chastain]

Bonjour !

Un mot pour vous présenter la dernière modification de mon programme.
Il s'agit d'une procédure qui détecte les coups faisant échec et mat :

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
 
PROCEDURE ChercheCoupGagnant ( nomfich : String ; var coup : TCoup ) ;
 
var
liste : TListe ;
cp : TCoup ;
x1, y1, x2, y2 : TCoord ;
Fictif : TEchiquier ;
Inutile : T4Bool ;
E : Boolean ;
NP : Byte ;
 
const
ToutFaux : T4Bool = ( False, False, False, False ) ;
 
begin
coup := '----' ;
 
Assign ( liste, CheminFichiers+nomfich ) ;
Reset ( liste ) ;
 
while not Eof ( liste ) do
begin
Read ( liste, cp ) ;
 
x1 := Ord ( cp [ 1 ] ) - 96 ;
y1 := Ord ( cp [ 2 ] ) - 48 ;
x2 := Ord ( cp [ 3 ] ) - 96 ;
y2 := Ord ( cp [ 4 ] ) - 48 ;
 
Fictif := Occupant ;
 
{ CALCUL POSITION FICTIVE }
 
{ Déplacement de la tour en cas de roque }
if ( Abs ( Fictif [x1,y1] ) = Roi ) and ( Abs ( x2-x1 ) = 2 ) then
begin
 if y2=1 then
 begin
  if x2=3 then
   begin
    Fictif [1,1] := Vide ;
    Fictif [4,1] := Tour ;
   end
  else
   begin
    Fictif [8,1] := Vide ;
    Fictif [6,1] := Tour ;
   end ;
  end
 else
  begin
   if x2=3 then
   begin
    Fictif [1,8] := Vide ;
    Fictif [4,8] := - Tour ;
   end
  else
   begin
    Fictif [8,8] := Vide ;
    Fictif [6,8] := - Tour ;
   end ;					
  end ;		
end ;
 
{ Effacement du pion en cas de prise "en passant" }
if ( Abs ( Fictif [x1,y1] ) = Pion ) and ( Abs(x2-x1) = 1 )
and ( Fictif [x2,y2] = Vide ) then
begin
Fictif [x2,y1] := Vide ;
end ;
 
{ Déplacement de la pièce principale }
Fictif [x2,y2] := Fictif [x1,y1] ;
Fictif [x1,y1] := Vide ;
 
{ CALCUL COUPS ADVERSAIRE }
 
CalculeECHEC  ( Fictif, ( not Trait ), E, Inutile, 'L1' ) ;
CoupsSpeciaux ( Fictif, ( not Trait ), ToutFaux, ToutFaux, '-', 'L2' ) ;
CoupsPermis   ( Fictif, ( not Trait ), 'L1', 'L2', 'L3', NP	) ;
 
if E and ( NP = 0 ) then coup := cp ;
 
end ;
 
Close ( liste ) ;
 
end ; { ChercheCoupGagnant }

Pour tester la procédure, j'ai remplacé ceci :

Code :

1
2
3
4
5
6
7
8
9
10
11
 
Initiale : TEchiquier = (
 
( Tour , Pion , Vide , Vide , Vide , Vide , -Pion , -Tour ),
( Cava , Pion , Vide , Vide , Vide , Vide , -Pion , -Cava ),
( Fou  , Pion , Vide , Vide , Vide , Vide , -Pion , -Fou  ),
( Dame , Pion , Vide , Vide , Vide , Vide , -Pion , -Dame ),
( Roi  , Pion , Vide , Vide , Vide , Vide , -Pion , -Roi  ),
( Fou  , Pion , Vide , Vide , Vide , Vide , -Pion , -Fou  ),
( Cava , Pion , Vide , Vide , Vide , Vide , -Pion , -Cava ),
( Tour , Pion , Vide , Vide , Vide , Vide , -Pion , -Tour ));

par cela :

Code :

1
2
3
4
5
6
7
8
9
10
11
 
Initiale : TEchiquier = (
 
( Tour , Pion , Vide , Vide , Vide , Vide , -Pion , -Tour ),
( Cava , Pion , Vide , Vide , Vide , Vide , -Pion , -Cava ),
( Fou  , Pion , Vide , Vide , Vide , Vide , -Pion , -Fou  ),
( Dame , Pion , Vide , Vide , Fou  , Vide , -Pion , -Dame ), <--- Ajouté un fou
( Roi  , Pion , Vide , Vide , Vide , Vide , -Pion , -Roi  ),
( Fou  , Pion , Vide , Vide , Dame , Vide , -Pion , -Fou  ), <--- Ajouté une dame
( Cava , Pion , Vide , Vide , Vide , Vide , -Pion , -Cava ),
( Tour , Pion , Vide , Vide , Vide , Vide , -Pion , -Tour ));

Le programme répond : "Coup gagnant : f7f5".

Cependant la procédure en question prend une bonne vingtaine de secondes pour répondre !



Pour corriger ce défaut, il faudra que je remplace les lourdes procédures "à tout faire" dont je me suis servi. Dans le cas testé, elles sont appelées 43 fois !


Autrement j'ai voulu voir ce qu'il y avait comme programme d'échecs pour Free Pascal. Hormis un moteur de jeu déjà ancien et sans code source, je n'ai trouvé que le projet FPChess, qui ne m'a pas paru très avancé, et pour tout dire qui m'a même paru un peu abandonné !



ESCHECS.zip (9 k)

Edition 21/03

Testé à l'aide d'une variable le nombre d'appels à la procédure CalculECHEC :
pour un coup de l'utilisateur, 906 fois
pour un coup de l'ordinateur, 2021 fois !
et cela dans la position initiale, alors que les "grosses" pièces ne sont pas encore dans le jeu !

[Roland Chastain]

Bonjour !

Je viens de faire des essais de compilation dont le résultat est curieux.
J'ai retiré de mon programme une procédure qui ne passait qu'avec TP7 (une procédure en assembleur pour éteindre le curseur que j'avais trouvée quelque part).
Le code se compile sans message d'erreur et fonctionne, aussi bien avec Free Pascal qu'avec Virtual Pascal. Mais il produit un résultat faux : il joue un coup impossible. Compilé avec TP7, il joue un coup correct.
Ce qui m'étonne encore, c'est que la même erreur exactement se produit avec Free Pascal et Virtual Pascal : la dame noire prend la dame blanche au premier coup des noirs !



Auriez-vous une idée de ce qui pourrait expliquer cette compatibilité trompeuse ?

Une dernière observation : l'ajout (pour Free Pascal) de la directive

Code :

1
2
 
{$mode TP}

ne change pas le comportement du programme.

[Roland Chastain]

Bonjour !

Maintenant que je sais un peu mieux programmer en Pascal, j'ai commencé à réécrire mon jeu d'échecs, en essayant de garder ce qu'il y avait de bon dans mes précédents essais.

Je posterai au fur et à mesure les parties du programme. Je ferai en sorte que le code soit toujours exécutable même sans les parties manquantes. De cette façon, en attendant un programme d'échecs complet, ce travail pourra éventuellement être utile comme suite d'exemples de code autour de la programmation d'un jeu d'échecs.

Voici la première partie refaite, qui contient :

- La déclaration des constantes, types et variables
- La procédure qui affiche un échiquier en mode texte
- Une fonction qui convertit les valeurs courantes dans une chaîne au format standard FEN
- Plus diverses petites fonctions utiles

Avis et conseils toujours bienvenus !

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
 
Program Eschecs;
 
Uses Crt, Dos;
 
Type
 
  TCoord  = 1..8;
  TPiece  =-6..6;
  TCouleur=-1..1;
 
  TEchiquier=Array [TCoord, TCoord] Of TPiece;
  TTableauBooleen=Array[0..3] Of Boolean;
 
  TCoup=Record
	        x1,y1,x2,y2: TCoord;
		notation: String[4];
	    End;
 
  TNomCoup=String[4];
  TNomCarreau=String[2];
 
  TLettres=Array[TPiece] Of Char;
 
Var
 
  Occupant       : TEchiquier;
  Trait          : TCouleur;
  RoquePrimo     : TTableauBooleen;
  CarreauPassant : String[2];
  Echec          : Boolean;
  RoqueSecundo   : TTableauBooleen;
  NombreDemiCoups: Integer;
  NombreCoups    : Integer;
  NombrePossibles: Byte;
 
Const
 
  Blanc=1;
  Noir=-1;
  Vide=0;
  Pion=1;
  Cavalier=2;
  Fou=3;
  Tour=4;
  Dame=5;
  Roi=6;
  e8c8=0;
  e8g8=1;
  e1c1=2;
  e1g1=3;
  Vrai=True;
  Faux=False;
  Cava=Cavalier;
  Initiale: TEchiquier=(
  (Tour, Pion, Vide, Vide, Vide, Vide, -Pion, -Tour),
  (Cava, Pion, Vide, Vide, Vide, Vide, -Pion, -Cava),
  (Fou , Pion, Vide, Vide, Vide, Vide, -Pion, -Fou ),
  (Dame, Pion, Vide, Vide, Vide, Vide, -Pion, -Dame),
  (Roi , Pion, Vide, Vide, Vide, Vide, -Pion, -Roi ),
  (Fou , Pion, Vide, Vide, Vide, Vide, -Pion, -Fou ),
  (Cava, Pion, Vide, Vide, Vide, Vide, -Pion, -Cava),
  (Tour, Pion, Vide, Vide, Vide, Vide, -Pion, -Tour));
 
  LettresAFF: TLettres=('R','D','T','F','C','p',#32,'p','C','F','T','D','R');
  LettresFEN: TLettres=('k','q','r','b','n','p',#32,'P','N','B','R','Q','K');
 
Procedure Initialise;
  Var x,y: TCoord;
  Begin
    For x:=1 To 8 Do
     Begin
      For y:=1 To 8 Do
       Begin
        Occupant[x,y]:=Initiale[x,y];
      End;
    End;
    Trait:=Blanc;
    RoquePrimo[e8c8]:=Vrai;
    RoquePrimo[e8g8]:=Vrai;
    RoquePrimo[e1c1]:=Vrai;
    RoquePrimo[e1g1]:=Vrai;
    CarreauPassant:='-';
    NombreDemiCoups:=0;
    NombreCoups:=1;
  End; {Initialise}
 
Function Carreau (x,y: TCoord): Boolean;
  Begin
    Carreau:=(x In [1..8]) And (y In [1..8]);
  End; {Carreau}
 
Function CarreauBlanc (x,y: TCoord): Boolean;
  Begin
    CarreauBlanc:=Not ( (x+y) Mod 2 = 0 );
  End; {CarreauBlanc}
 
Function IntToStr (i: Longint): String;
	Var
	  s: String[11];
	Begin
	  Str(i,s);
	  IntToStr:=s;
	End; {IntToStr}
 
Function NomCarreau (x,y: TCoord): TNomCarreau;
  Begin
    NomCarreau:=chr(x+96)+chr(y+48);
  End; {NomCarreau}
 
Function Signe (p: TPiece): TCouleur;
  Begin
    case p Of
      -6..-1 : Signe:=-1;
           0 : Signe:= 0;
       1.. 7 : Signe:= 1;
    End;
  End; {Signe}
 
Function FEN(
  PP: TEchiquier;
  AC: TCouleur;
  CA: TTableauBooleen;
  TS: TNomCarreau;
  HC: Integer;
  FN: Integer): String;
  Var
    x,y,n: Byte;
    a: Boolean;
    s: String;
  Procedure ESPACE ; Begin s:=Concat(s, chr(32)); End;
  Begin
    s:='';
    For y:=8 DownTo 1 Do Begin
      x:=1; n:=1;
      repeat
	If (Abs(PP[x,y]) > 0)
	Then
	Begin s:=Concat(s,LettresFEN[PP[x,y]]); Inc(x); End
	else
	Begin
	  If (x=8)
	  Then
	  Begin s:=Concat(s,IntToStr(n)); Inc(x); End
	 else
	  Begin
	    If (Abs(PP[x+1,y])>0)
	    Then
	    Begin s:=Concat(s,IntToStr(n)); Inc(x); End
	  else
	    Begin Inc(n); Inc(x); End;
          End;
        End;
      until (x=9);
 
      If Not (y=1) Then s:=Concat(s,'/')
      else ESPACE;
    End;
 
    If (AC=Blanc) Then s:=Concat(s,'w') else s:=Concat(s,'b');
    ESPACE;
    a:=False;
    If CA[e1g1] Then Begin s:=Concat(s,'K'); a:=True; End;
    If CA[e1c1] Then Begin s:=Concat(s,'Q'); a:=True; End;
    If CA[e8g8] Then Begin s:=Concat(s,'k'); a:=True; End;
    If CA[e1g1] Then Begin s:=Concat(s,'q'); a:=True; End;
    If Not a Then s:=Concat(s,'-');
    ESPACE;
    s:=Concat(s,TS);
    ESPACE;
    s:=Concat(s,IntToStr(HC));
    ESPACE;
    s:=Concat(s,IntToStr(FN));
    FEN := s ;
  End ; { FEN }
 
Procedure AfficheTablier (occup: TEchiquier; c1,c2,c3,c4,c5,c6: Byte);
  Var x,y: TCoord;
  Begin
    For y:=8 DownTo 1 Do
    Begin
	TextBackground(c5); TextColor(c6);
	GotoXY(1,-3*y+25); Write(' ');
	GotoXY(1,-3*y+26); Write(IntToStr(y));
	GotoXY(1,-3*y+27); Write(' ');
      For x := 1 To 8 Do
      Begin
	If CarreauBlanc(x,y)
	Then TextBackground(c3)
	else TextBackground(c4) ;
	If (occup[x,y] > 0)
	Then TextColor(c1)
	else TextColor(c2);
	GotoXY(5*x-3,-3*y+25); Write('     ');
	GotoXY(5*x-3,-3*y+26); Write('  '+LettresAFF[occup[x,y]]+'  ');
	GotoXY(5*x-3,-3*y+27); Write('     ');
      End;
    End;
 
    TextBackground(c5); TextColor(c6);
    GotoXY(1,25);
    Write('   a    b    c    d    e    f    g    h  ');
  End; {AfficheTablier}
 
Begin
  Initialise;
  AfficheTablier(Occupant,White,Yellow,Green,Brown,LightGray,Black);
  ReadKey;
 
  ClrScr;
  Write(FEN(Occupant,Trait,RoquePrimo,CarreauPassant,NombreDemiCoups,NombreCoups));
  ReadKey;
End.

[Roland Chastain]

Bonjour !

Je cherche à améliorer la partie de mon programme qui calcule les coups possibles. J'ai voulu écrire une fonction qui pour une position donnée renvoie la liste des coups. Cette fonction fait appel à deux autres : une qui vérifie que le mouvement est conforme à la nature de la pièce, l'autre qui vérifie que le mouvement en question ne met pas le roi en échec.

J'ai testé les deux premières fonctions séparément. Mais quand j'appelle la troisième, j'obtiens un "error 202 stack overflow".
Qu'est-ce qui ne va pas au juste dans ma façon de procéder ?
Quelle serait à votre avis la bonne façon de faire ?



Voici le 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
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
 
Function MouvementNaturel (x1,y1,x2,y2:TCoord; E:TEchiquier): Boolean;
 
  Var dx,dy: ShortInt;
 
  Function Passage: Boolean;
    Var
      vx,vy,x,y: ShortInt;
      Obstacle: Boolean;
    Begin
      Passage:=Faux;
      Obstacle:=Faux;
      vx:=Signe(dx);
      vy:=Signe(dy);
      x:=x1;
      y:=y1;
      Repeat
        Inc(x,vx);
        Inc(y,vy);
        If (x=x2) And (y=y2) Then Passage:=Vrai;
        If (Passage=Faux) And (E[x,y]<>Vide) Then Obstacle:=Vrai;
      Until (Passage or Obstacle);
    End;
 
  Begin
 
    If Signe(E[x2,y2])=Signe(E[x1,y1]) Then
    Begin
      MouvementNaturel:=Faux;
      Exit;
    End;
 
    dx:=x2-x1;
    dy:=y2-y1;
 
    If (dx=0) and (dy=0) Then
    Begin
      MouvementNaturel:=Faux;
      Exit;
    End;
 
    Case Abs(E[x1,y1]) Of
 
      Pion:
        Begin
          If Signe(dy)=E[x1,y1] Then
          Begin
            If (Abs(dx*dy)=1) And (E[x2,y2]<>Vide) Then
            Begin
              MouvementNaturel:=Vrai;
              Exit;
            End;
            If (dx=0) And (E[x1,y1+E[x1,y1]]=Vide) Then
            Begin
              If Abs(dy)=1 Then
              Begin
                MouvementNaturel:=Vrai;
                Exit;
              End;
              If (Abs(dy)=2) And (E[x1,y1+dy]=Vide) Then
              Begin
                If ((E[x1,y1]=Blanc) And (y1=2))
                Or ((E[x1,y1]=Noir) And (y1=7)) Then
                Begin
                  MouvementNaturel:=Vrai;
                  Exit;
                End;
              End;
            End;
          End;
        End;
 
      Cavalier:
        Begin
          If dx*dx+dy*dy=5 Then
          Begin
            MouvementNaturel:=Vrai;
            Exit;
          End;
        End;
 
      Fou:
        Begin
          If Abs(dx)=Abs(dy) Then
          Begin
             If Passage Then
             Begin
               MouvementNaturel:=Vrai;
               Exit;
             End;
          End;
        End;
 
      Tour:
        Begin
          If dx*dy=0 Then
          Begin
            If Passage Then
            Begin
              MouvementNaturel:=Vrai;
              Exit;
            End;
          End;
        End;
 
      Dame:
        Begin
          If Abs(dx)=Abs(dy) Then
          Begin
            If Passage Then
            Begin
              MouvementNaturel:=Vrai;
              Exit;
            End;
          End;
          If dx*dy=0 Then
          Begin
            If Passage Then
            Begin
              MouvementNaturel:=Vrai;
              Exit;
            End;
          End;
        End;
 
      Roi:
        Begin
          If dx*dx+dy*dy<=2 Then
          Begin
            MouvementNaturel:=Vrai;
            Exit;
          End;
        End;
 
    End;
 
    MouvementNaturel:=Faux;
 
  End;
 
Function EchecAuRoi(
  tablier:TEchiquier;
  couleur:TCouleur): Boolean;
 
  Var x1,y1,x2,y2: TCoord;
 
  Begin
    For x2:=1 To 8 Do Begin
      For y2:=1 To 8 Do Begin
        If tablier[x2,y2]=Roi*couleur Then
        Begin
          For x1:=1 To 8 Do Begin
            For y1:=1 To 8 Do Begin
              If Signe(tablier[x1,y1])=-1*couleur Then
              Begin
                If MouvementNaturel(x1,y1,x2,y2,tablier) Then
                Begin
                  If not ((abs(tablier[x1,y1])=Pion) And (x2=x1)) Then
                  Begin
                    EchecAuRoi:=Vrai;
                    Exit;
                  End;
                End;
              End;
            End;
          End;
        End;
      End;
    End;
    EchecAuRoi:=Faux;
  End;
 
Function CoupsPossibles(
  tablier: TEchiquier;
  couleur: TCouleur;
  roque: TTableauBooleen;
  passant: TNomCarreau): String;
 
  Var
    x1,y1,x2,y2: TCoord;
    s:String;
    fictif: TEchiquier;
 
  Begin
 
    s:='';
 
    For x1:=1 To 8 Do Begin
      For y1:=1 To 8 Do Begin
 
        If Signe(tablier[x1,y1])=couleur Then Begin
 
          For x2:=1 To 8 Do Begin
            For y2:=1 To 8 Do Begin
 
              If MouvementNaturel(x1,y1,x2,y2,tablier) Then
              Begin
                fictif:=tablier;
                fictif[x2,y2]:=fictif[x1,y1];
                fictif[x1,y1]:=Vide;
 
                If Not EchecAuRoi(fictif,couleur) Then Begin
                  s:=Concat(s,NomCarreau(x1,y1));
                  s:=Concat(s,NomCarreau(x2,y2));
                End;
 
              End;
 
            End;
          End;
 
        End;
 
      End;
    End;
 
    CoupsPossibles:=s;
 
  End;

[Alcatîz]

Je n'ai malheureusement pas le temps de regarder attentivement ton code mais une remarque me vient immédiatement à l'esprit : il vaut mieux transmettre un paramètre qui ne doit pas être modifié comme constante plutôt que par valeur, pour éviter une copie inutile sur la pile et, par corollaire, pour économiser de l'espace sur la pile :

http://pascal.developpez.com/faq/?pa...sConstOuValeur

[Roland Chastain]

Merci pour ta réponse et pour le lien. Je vais creuser de ce côté-là.

[Roland Chastain]

J'ai appris beaucoup de choses en parcourant la FAQ Pascal. Excellente qualité de documentation !

Pour revenir au débordement de pile ou "stack overflow", je me souviens que dans mes premiers essais de programmation d'un jeu d'échecs, je n'avais que des variables globales et des procédures sans paramètres. On m'a dit et j'ai constaté par moi-même que ce n'était la meilleure façon de faire.
Mais à présent je m'aperçois que le passage explicite des paramètres a aussi ses inconvénients :

Il est à noter que, dans le cas de la transmission par valeur, lorsque c'est l'adresse du paramètre qui est déposée sur la pile, une copie locale de la variable est réalisée au début de la procédure ou fonction.

Si je comprends bien : beaucoup de passages explicites, beaucoup de copies. Beaucoup de copies, débordement de la pile !

Sur le passage d'un paramètre comme constante, j'ai cru comprendre que Turbo Pascal ne le permettait pas :

Remarque : Turbo Pascal ne supporte que la transmission par valeur et par adresse.

Comme je n'étais pas sûr d'avoir bien compris, j'ai quand même essayé cette écriture :

Code :

Function Exemple (const a: byte): byte;

Le compilateur l'accepte, mais je ne sais pas si cela change quelque chose.

[Paul TOTH]

l'ajout de "const" a deux conséquences

1) la variable n'est plus modifiable

2) si c'est une structure ou une chaîne, elle est passée par adresse et non par valeur (aucune incidence sur un BYTE donc).

si elle est déclarée "var" c'est la même chose mais modifiable (et dans le cas d'un BYTE c'est un pointeur vers un BYTE et non plus un BYTE qui est passé en paramètre).

voici un exemple avec une variable globale

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
 
var
  E:TEchiquier;
 
procedure proc1(E:TEchiquier);
begin
end;
 
procedure proc2(const E:TEchiquier);
begin
end;
 
procedure proc3(var E:TEchiquier);
begin
end;
 
procedure proc4;
begin
end;
 
begin
  proc1(E);
  proc2(E);
  proc3(E);
  proc4();
end;

lors d'un appel à proc1, une copie de E est placée sur la pile, si E est gros tu arrives vite à saturation de la pile avec un appel récursif.

dans les trois autres cas, c'est la variable globale E qui est utilisée, alors quelle différence entre proc2, proc3 et proc4 ?

proc2 interdit de modifier E, c'est ce qui la distingue de proc3

quand à proc3 il n'y a aucune différence avec proc4, MAIS il devient possible de l'utiliser dans un contexte différent qui donne tout son sens à la présence du paramètre.

Code :

1
2
3
4
5
6
7
 
var
  E1, E2: TEchiquier;
begin
  proc3(E1);
  proc3(E2);
end;

Et pour la récursivité sur de grosses structures, il est intéressant de ne conserver que les modifications et non la structure entière, exemple:

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 JouerUnCoup(var E: TEchiquier; Profondeur: Integer);
var
  x1, y1: Byte;
  x2, y2: Byte;
  avant : Byte;
  piece : Byte;
begin
 // déterminer le coup à jouer : piece de x1, y1 vers x2, y2
  ...
 
// déplacer la pièce
  E[x1, y1] := vide;
  avant := E[x2,y2];
  E[x2, y2] := piece;
 
// coup suivant
  if Profondeur > 0 then
   JouerUnCoup(E, Profondeur - 1);
 
// fin de procédure on annule le coup pour en tester un autre
  E[x1,y1] := piece;
  E[x2,y2] := avant;
 
end;

cet appel récursif ne conserve à chaque itération que 6 octets au lieu de la totalité de l'échiquier...bon en fait il faudrait aussi conserver la pièce mangée s'il y en a une, mais c'est le principe qui est montré ici