Jeu de dames

Bon si Lode nous envoie de bon petits jeux sympas, il faut que j'avance un peu sur le mien ... pas facile chez mes beaux-parents, mais bon, j'ai squatté un peu l'ordi pour coder ce matin et je me connecte sur l'ordi de beau-papa pour poster le coe résultant .... ça avance ...
(Avant que vous le mettiez, il est prévu d'afficher le nom des lignes et des colonnes un peu plus tard)
Les modifs: Messages reprenant les actions dans une liste à droite.
Bon, il faut que j'ajoute un truc pour faire défiler la liste toute seule. Je n'ais pas encore cherché, mais si quelqu'un a le truc comme ça, sans chercher, je prends (Je sais que Klaus et JL35 l'ont déjà fait mais je ne me souviens plus et comme je n'ais pas le net quand je programme, de toute façon, vu le temps je vais profiter un peu du soleil ...)
On ne peut plus ne pas prendre quand on doit le faire (je n'ais pas eu le temps de tester à fond, mais à priori ça marche ...) mais dites moi si il y a des bugs (applicatifs ou comportement)

Code:: REM Jeu de dames par Jean-Charles
REM V0.4 du 23/05/2011
REM Programmation en cours - Selection des pièces - mouvements de base terminés
REM Gestion du couronnement - Gestion du comptage des pièces et des tours

LABEL Init: GOTO Init

Aide:
SHOW 900
RETURN

Faide:
HIDE 900
RETURN

Regle:
SHOW 910
RETURN

Fregle:
HIDE 910
RETURN

Quitter:
TERMINATE
RETURN

Dessine_Damier:
2D_TARGET_IS 2
2D_PEN_COLOR 40,40,40: 2D_RECTANGLE 0,0,WIDTH(2),HEIGHT(2)
case% = 0
FOR j% = 0 TO 9
FOR k% = 0 TO 9
IF case% = 0
2D_FILL_COLOR CDR,CDV,CDB
case% = 1
ELSE
2D_FILL_COLOR CCR,CCV,CCB
case% = 0
END_IF
2D_RECTANGLE k%*pas_case,j%*pas_case,(k%+1)*pas_case,(j%+1)*pas_case
IF damier%(j%,k%) > 0 THEN GOSUB Dessine_piece
2D_PEN_COLOR 40,40,40
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
RETURN

Dessine_piece:
SELECT damier%(j%,k%)
CASE 0: ' NORMALEMENT ON NE LE FAIT JAMAIS
CASE 1: ' PION BLANC
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
CASE 2: ' PION NOIR
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
CASE 9: ' DAME BLANCHE
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case-3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%-6,r% - 7 : 2D_PEN_WIDTH 3
CASE 8: ' DAME NOIRE
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case-3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%-6,r% - 7 : 2D_PEN_WIDTH 3
END_SELECT
RETURN

Clic_Damier:
OFF_CLICK 2
GOSUB Test_PeutJouer
IF Tour=0 AND PeutJouer=0 THEN Message$="Fin de partie, les blancs ne peuvent plus jouer" : ITEM_ADD 916, Message$
IF Tour=0 AND PeutJouer=0 THEN Message$="Les noirs gagnent" : ITEM_ADD 916, Message$
IF Tour=1 AND PeutJouer=0 THEN Message$="Fin de partie, les noirs ne peuvent plus jouer" : ITEM_ADD 916, Message$
IF Tour=1 AND PeutJouer=0 THEN Message$="Les blancs gagnent" : ITEM_ADD 916, Message$

Sposx = INT(MOUSE_X_POSITION(2)/pas_case)
Sposy = INT(MOUSE_Y_POSITION(2)/pas_case)
Clic_Damier3:
IF tour=0 AND PeutJouer <> 0
' Tour des blancs
IF damier%(Sposy,Sposx) = 1 OR damier%(Sposy,Sposx) = 9
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
IF damier%(Sposy,Sposx) = 1 THEN Message$=" le pion en "
IF damier%(Sposy,Sposx) = 9 THEN Message$=" la dame en "
Message$=Message$+CHR$(65+Sposx)+":"+CHR$(48+Sposy)
ON_CLICK 2, Clic2_Damier_blancs
ELSE
ON_CLICK 2, Clic_Damier
END_IF
ELSE
' Tour des noirs
IF PeutJouer<>0
IF damier%(Sposy,Sposx) = 2 OR damier%(Sposy,Sposx) = 8
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
IF damier%(Sposy,Sposx) = 2 THEN Message$=" le pion en "
IF damier%(Sposy,Sposx) = 8 THEN Message$=" la dame en "
Message$=Message$+CHR$(65+Sposx)+":"+CHR$(48+Sposy)
ON_CLICK 2, Clic2_Damier_noirs
ELSE
ON_CLICK 2, Clic_Damier
END_IF
END_IF
END_IF
IF PeutJouer=0 THEN GOSUB Fin
RETURN

Clic2_Damier_noirs:
TempX=NposX: TempY=NposY : GOSUB Test_PeutJouer : NposX=TempX : NposY=TempY
Nposx = INT(MOUSE_X_POSITION(2)/pas_case) : Nposy = INT(MOUSE_Y_POSITION(2)/pas_case)
IF NposX <> SposX OR NposY <> SposY
OFF_CLICK 2
Delta=abs(Sposx - Nposx):PeutPrendre=0:i%=0:Cpt=0:j%=(NposX - SposX)/Delta : k%=(NposY - SposY)/Delta
IF damier%(Nposy,Nposx) = 0 THEN i%=1
IF i%=1
IF NposY > SposY
IF (NposY - Delta) = SposY THEN i%=2
ELSE
IF (NposY + Delta) = SposY THEN i%=2
END_IF
END_IF
IF Delta = 1 AND SposY < NposY AND i%=2
PeutPrendre=1
ELSE
IF Delta = 2 AND i%=2
IF Damier%(SposY+k%,SposX+j%)=1 OR Damier%(SposY+k%,SposX+j%)=9 THEN PeutPrendre=1:Cpt=1:PionX=SposX+j%: PionY=SposY+k%
ELSE
IF Damier%(SposY,SposX)=8 AND i%=2
PeutPrendre=1
FOR i% = 1 TO Delta
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=1 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=9
IF Cpt=0
Cpt=1:PionX=SposX+(j%*i%): PionY=SposY+(k%*i%)
ELSE
PeutPrendre=0 : i%=Delta
END_IF
ELSE
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=2 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=8 THEN PeutPrendre=0 : i%=Delta
END_IF
NEXT i%
END_IF
END_IF
END_IF
IF PeutPrendre=1
IF Cpt=0
IF DoitPrendre=0
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
tour= 0 : 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30, 100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_TARGET_IS 2 : ON_CLICK 2, Clic_Damier
Message$="Les noirs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy):ITEM_ADD 916,Message$
ELSE
Message$="Irrégularité des noirs: vous devez prendre":ITEM_ADD 916,Message$
ON_CLICK 2, Clic2_Damier_noirs
END_IF
ELSE
IF Cpt=1
damier%(PionY,PionX)=0 : Nb_blancs = Nb_blancs - 1 : CAPTION 40,Nb_blancs
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE (PionX)*pas_case,(PionY)*pas_case,(PionX+1)*pas_case,(PionY+1)*pas_case
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
Message$="Les noirs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy):ITEM_ADD 916,Message$
GOSUB Test_PeutPrendre
IF PeutPrendre = 0
tour=0 : 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30, 100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_TARGET_IS 2 : ON_CLICK 2, Clic_Damier
ELSE
Sposx=Nposx : Sposy=Nposy
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic2_Damier_noirs
END_IF
END_IF
END_IF
ELSE
IF damier%(Nposy,Nposx) = 2 or damier%(Nposy,Nposx) = 8
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=SposY:k%=SposX: GOSUB Dessine_piece
Sposx=Nposx : Sposy=Nposy : Goto Clic_Damier3
ELSE
ON_CLICK 2,Clic2_Damier_noirs
END_IF
END_IF
IF tour=0 AND Nposy=9 THEN IF damier%(Nposy,Nposx)=2 THEN j%=Nposy : k%= Nposx : damier%(j%,k%)=8 : GOSUB Dessine_piece
END_IF
RETURN

Clic2_Damier_blancs:
TempX=NposX: TempY=NposY : GOSUB Test_PeutJouer : NposX=TempX : NposY=TempY
Nposx = INT(MOUSE_X_POSITION(2)/pas_case) : Nposy = INT(MOUSE_Y_POSITION(2)/pas_case)
IF NposX <> SposX OR NposY <> SposY
OFF_CLICK 2
Delta=abs(Sposx - Nposx):PeutPrendre=0:i%=0:Cpt=0:j%=(NposX - SposX)/Delta : k%=(NposY - SposY)/Delta
IF damier%(Nposy,Nposx) = 0 THEN i%=1
IF i%=1
IF NposY > SposY
IF (NposY - Delta) = SposY THEN i%=2
ELSE
IF (NposY + Delta) = SposY THEN i%=2
END_IF
END_IF
IF Delta = 1 AND SposY > NposY AND i%=2
PeutPrendre=1
ELSE
IF Delta = 2 AND i%=2
IF Damier%(SposY+k%,SposX+j%)=2 OR Damier%(SposY+k%,SposX+j%)=8 THEN PeutPrendre=1:Cpt=1:PionX=SposX+j%: PionY=SposY+k%
ELSE
IF Damier%(SposY,SposX)=9 AND i%=2
PeutPrendre=1
FOR i% = 1 TO Delta
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=2 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=8
IF Cpt=0
Cpt=1:PionX=SposX+(j%*i%): PionY=SposY+(k%*i%)
ELSE
PeutPrendre=0 : i%=Delta
END_IF
ELSE
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=1 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=9 THEN PeutPrendre=0 : i%=Delta
END_IF
NEXT i%
END_IF
END_IF
END_IF
IF PeutPrendre=1
IF Cpt=0
IF DoitPrendre=0
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
tour = 1 : 2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7 : 2D_TARGET_IS 2
ITEM_ADD 916,"Les blancs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
ON_CLICK 2, Clic_Damier
ELSE
Message$="Irrégularité des blancs: vous devez prendre":ITEM_ADD 916,Message$
ON_CLICK 2, Clic2_Damier_blancs
END_IF
ELSE
IF Cpt=1
damier%(PionY,PionX)=0 : Nb_Noirs = Nb_Noirs - 1 : CAPTION 41,Nb_noirs
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE (PionX)*pas_case,(PionY)*pas_case,(PionX+1)*pas_case,(PionY+1)*pas_case
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
ITEM_ADD 916,"Les blancs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
IF Nb_Noirs <=0
Message$="Il ne reste plus de pion noir. Les blancs gagnent":ITEM_ADD 916,Message$
ELSE
GOSUB Test_PeutPrendre
IF PeutPrendre = 0
tour = 1: 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7 : 2D_TARGET_IS 2
ON_CLICK 2, Clic_Damier
ELSE
Sposx=Nposx : Sposy=Nposy
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic2_Damier_blancs
END_IF
END_IF
END_IF
END_IF
ELSE
IF damier%(Nposy,Nposx) = 1 or damier%(Nposy,Nposx) = 9
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=SposY:k%=SposX: GOSUB Dessine_piece
Sposx=Nposx : Sposy=Nposy : Goto Clic_Damier3
ELSE
ON_CLICK 2,Clic2_Damier_blancs
END_IF
END_IF
IF Nb_noirs=0 THEN GOTO Fin
IF tour=1 AND Nposy=0
IF damier%(Nposy,Nposx)=1
Message$="Nouvelle Dame blanche en "+CHR$(65+Nposx)+":"+CHR$(48+Nposy):ITEM_ADD 916,Message$
j%=Nposy : k%= Nposx : damier%(j%,k%)=9 : GOSUB Dessine_piece
END_IF
END_IF
END_IF
RETURN

Test_deplacement:
case%=0
IF damier%(Nposy,Nposx)=1 AND tour=0 THEN case%= 1
IF damier%(Nposy,Nposx)=2 AND tour=1 THEN case%= 2
IF damier%(Nposy,Nposx)=8 OR damier%(Nposy,Nposx)=9 THEN case%= 3

IF Nposx < 9 AND Nposy < 9
IF case%=2 OR case%=3
IF damier%(Nposy+1,Nposx+1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx < 9 AND Nposy > 0
IF case%=1 OR case%=3
IF damier%(Nposy-1,Nposx+1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx > 0 AND Nposy < 9
IF case%=2 OR case%=3
IF damier%(Nposy+1,Nposx-1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx > 1 AND Nposy > 1
IF case%=1 OR case%=3
IF damier%(Nposy-1,Nposx-1)=0 THEN PeutJouer = 1
END_IF
END_IF
RETURN

Test_PeutJouer:
case% = 0: PeutPrendre=0 : DoitPrendre = 0 : PeutJouer=0
FOR Nposy = 0 TO 9 : ' Correspond à la ligne (y)
FOR Nposx = 0 TO 9 : ' Correspond à la rangée (x)
IF case% = 0
case% = 1 : ' Case vide, on passe
ELSE
GOSUB Test_deplacement
IF tour=0 and damier%(Nposy,Nposx)=1 THEN GOSUB Test_PeutPrendre
IF tour=0 and damier%(Nposy,Nposx)=9 THEN GOSUB Test_PeutPrendre_Dame
IF tour=1 and damier%(Nposy,Nposx)=2 THEN GOSUB Test_PeutPrendre
IF tour=1 and damier%(Nposy,Nposx)=8 THEN GOSUB Test_PeutPrendre_Dame
IF PeutPrendre = 1 THEN DoitPrendre = 1:PeutJouer = 1
case% = 0
END_IF
NEXT NposX
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT NposY
RETURN

Test_PeutPrendre_dame:
PeutPrendre = 0: Delta = 0
IF tour=0 THEN j%=2 : k%=8
IF tour=1 THEN j%=1 : k%=9

IF Nposx < 8 AND Nposy < 8
IF Nposx > Nposy THEN Delta = 8-Nposx :ELSE : Delta = 8-Nposy
FOR i% = 1 TO Delta
IF (damier%(Nposy+i%,Nposx+i%)=j% OR damier%(Nposy+i%,Nposx+i%)=k%) AND damier%(Nposy+i%+1,Nposx+i%+1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF

IF Nposx < 8 AND Nposy > 1
IF Nposy >= (8-Nposx) THEN Delta= 8-Nposx : ELSE : Delta = Nposy-1
FOR i% = 1 TO Delta
IF (damier%(Nposy-i%,Nposx+i%)=j% OR damier%(Nposy-i%,Nposx+i%)=k%) AND damier%(Nposy-i%-1,Nposx+i%+1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF

IF Nposx > 1 AND Nposy < 8
IF ((8-Nposy) > (Nposx-1)) THEN Delta= Nposx -1: ELSE : Delta = 8-Nposy
FOR i% = 1 TO Delta
IF damier%(Nposy+i%,Nposx-i%)=j% OR damier%(Nposy+i%,Nposx-i%)=k%
IF damier%(Nposy+i%+1,Nposx-i%-1)= 0 THEN PeutPrendre = 1
END_IF
NEXT i%
END_IF

IF Nposx > 1 AND Nposy > 1
IF Nposx > Nposy THEN Delta= Nposy-1: ELSE : Delta = Nposx-1
FOR i% = 1 TO Delta
IF (damier%(Nposy-i%,Nposx-i%)=j% OR damier%(Nposy-i%,Nposx-i%)=k%) AND damier%(Nposy-i%-1,Nposx-i%-1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF
RETURN

Test_PeutPrendre:
PeutPrendre = 0
IF tour=0 THEN j%=2 : k%=8
IF tour=1 THEN j%=1 : k%=9
IF Nposx < 8 AND Nposy < 8
IF (damier%(Nposy+1,Nposx+1)=j% OR damier%(Nposy+1,Nposx+1)=k%) AND damier%(Nposy+2,Nposx+2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx < 8 AND Nposy > 1
IF (damier%(Nposy-1,Nposx+1)=j% OR damier%(Nposy-1,Nposx+1)=k%) AND damier%(Nposy-2,Nposx+2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx > 1 AND Nposy < 8
IF (damier%(Nposy+1,Nposx-1)=j% OR damier%(Nposy+1,Nposx-1)=k%) AND damier%(Nposy+2,Nposx-2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx > 1 AND Nposy > 1
IF (damier%(Nposy-1,Nposx-1)=j% OR damier%(Nposy-1,Nposx-1)=k%) AND damier%(Nposy-2,Nposx-2)= 0 THEN PeutPrendre = 1
END_IF
RETURN

Fin:
case%=MESSAGE_CONFIRMATION_YES_NO("Voulez vous faire une nouvelle partie ?")
IF case%=1 THEN GOTO Relance
IF case%=0 THEN GOTO Fin
Terminate

Init:
COLOR 0,180,100,60
LABEL Aide,Regle,Faide, Fregle, Quitter, Clic_Damier, Clic2_Damier_blancs, Clic_Damier3, Clic2_Damier_noirs, Dessine_Damier, Dessine_piece
LABEL Test_PeutPrendre, Test_PeutPrendre_dame, Relance, Test_PeutJouer, Test_deplacement, Fin
DIM x_Max, y_Max : x_Max=1000 : y_max=700
DIM Marge_x, Marge_y : Marge_x = 40 : Marge_y = 30
DIM hlp$,regle$,h%,i%,j%,k%,case%,tour,PeutPrendre,PeutJouer,DoitPrendre, Message$
DIM Delta, Cpt, PionX, PionY, TempX, TempY
DIM damier%(10,10) : ' 0: Case vide, 1: Pion du joueur, 9: Dame du joueur, 2: Pion de l'Ai, 8: Dame de l'Ai
DIM Sposx, Sposy : ' Position du pion sélectionné
DIM Nposx, Nposy : ' Position de la destination sélectionné
DIM pas_case : if (y_Max - 2* Marge_y) > (x_Max - 2 * Marge_x) Then pas_case= (x_Max - 2 * Marge_x) / 11 : else: pas_case= (y_Max - 2 * Marge_y) / 11
DIM rc$ : rc$=CHR$(10)
DIM Nb_Noirs,Nb_blancs : ' Nombre de pions noirs et blancs
DIM r%: r% = pas_case/2 -1
DIM CBR,CBV,CBB, CNR, CNV, CNB
CBR = 205 : CBV = 205: CBB = 205 : ' Couleurs des pions blancs
CNR = 55 : CNV = 55 : CNB = 55 : ' Couleurs des pions noirs
DIM CDR,CDV,CDB,CCR,CCV,CCB
CDR = 255 : CDV = 255: CDB = 255 : ' Couleurs des cases 'blanches'
CCR = 30 : CCV = 30 : CCB = 180 : ' Couleurs des cases 'noires'
CAPTION 0, "Jeu de dames en Basic Panoramic par Jean-Charles"
WIDTH 0,x_Max : HEIGHT 0, y_max

' Création de l'image support pour le damier
PICTURE 2 : WIDTH 2, 10 * pas_case : HEIGHT 2, 10 * pas_case : TOP 2,Marge_y: LEFT 2, Marge_x

' Menu Principal
MAIN_MENU 1 : REM On reserve les objets 1 à 30 pour le menu
SUB_MENU 11: PARENT 11, 1: CAPTION 11, "Fichier"
SUB_MENU 16: PARENT 16, 1: CAPTION 16, "Aide"
SUB_MENU 17: PARENT 17, 1: CAPTION 17, "Règle"
ON_CLICK 16, Aide : ON_CLICK 17, Regle

' Sous menu Fichier
SUB_MENU 25: CAPTION 25,"Relancer partie" : PARENT 25, 11
SUB_MENU 26: CAPTION 26,"Quitter" : PARENT 26, 11
ON_CLICK 25, Relance :ON_CLICK 26, Quitter

' Préparation de l'aide
hlp$=CHR$(9)+CHR$(9)+CHR$(9)+" - AIDE DU JEU DE DAMES -"+rc$
hlp$=hlp$+CHR$(9)+CHR$(9)+CHR$(9)+" ==============================="+rc$+rc$
hlp$=hlp$+"A remplir"+rc$
FORM 900: TOP 900,2*Marge_y: LEFT 900,3*Marge_X: WIDTH 900,x_Max-6*Marge_X: HEIGHT 900,y_Max-4*Marge_y: HIDE 900
FONT_SIZE 900,10
LIST 901: PARENT 901,900: WIDTH 901,WIDTH(900)-16: HEIGHT 901,HEIGHT(900)-80
k% = INSTR(hlp$, rc$)
WHILE k% > 0
ITEM_ADD 901, LEFT$(hlp$, k%-1): hlp$ = MID$(hlp$, k%+1, 9000)
k% = INSTR(hlp$, rc$)
END_WHILE
BUTTON 902: PARENT 902,900: TOP 902,HEIGHT(900)-70: LEFT 902,280: CAPTION 902,"OK"
ON_CLICK 902, Faide

regle$=CHR$(9)+CHR$(9)+CHR$(9)+" - REGLES DU JEU DE DAMES -"+rc$
regle$=regle$+CHR$(9)+CHR$(9)+CHR$(9)+" ==============================="+rc$+rc$
rem regle$=regle$+""+rc$ : ' Modèle d'une ligne vide
regle$=regle$+"Le jeu de dames international se joue sur un damier carré divisé en 100 cases égales, alternativement claires et foncées."+rc$
regle$=regle$+"Le jeu se joue sur les cases foncées du damier. Il y a donc 50 cases actives."+rc$
regle$=regle$+"La plus longue diagonale, joignant deux coins du damier et comprenant 10 cases foncées, se dénomme la grande diagonale."+rc$
regle$=regle$+"Le damier doit être placé de sorte que la première case de gauche, pour chaque joueur, soit une case foncée."+rc$
regle$=regle$+"Le jeu de dames international se joue avec 20 pions blancs (clairs) et 20 pions noirs (foncés)"+rc$
regle$=regle$+"Avant de débuter une partie, les 20 pions noirs et les 20 pions blancs sont disposés sur les 4 premières rangées de chaque joueur."+rc$
regle$=regle$+"Il faut manger tous les pions de l'autre en passant par dessus avec l'un de vos pions."+rc$
regle$=regle$+"Les déplacements autoriser : seulement d'une case en avant, en diagonale si celle ci est libre."+rc$
regle$=regle$+"Le premier coup est toujours joué par les blancs. Les adversaires jouent un coup chacun à tour de rôle avec leurs pièces."+rc$
regle$=regle$+"Pour cela, on couronne le pion en plaçant dessus un deuxième pion de la même couleur."+rc$
regle$=regle$+"Il est interdit de reculer en dehors des prises"+rc$
regle$=regle$+"Si un pion avance jusqu'à la dernière rangée, il devient une Dame."+rc$
regle$=regle$+"La dame peut se déplacer de plusieurs cases en avant ou en arrière si ces cases sont vides."+rc$
regle$=regle$+"La prise des pièces adverse est obligatoire et s’effectue aussi bien en avant qu’en arrière."+rc$
regle$=regle$+"Lorsqu’un pion se trouve en présence, diagonalement, d’une pièce adverse derrière laquelle se trouve une case libre, il doit"+rc$
regle$=regle$+"obligatoirement sauter par-dessus cette pièce et occuper la case libre. Cette pièce adverse est alors enlevée du damier."+rc$
regle$=regle$+"Cette opération complète est la prise par un pion."+rc$
regle$=regle$+"Lorsqu’au cours d’une prise par un pion, celui-ci se trouve à nouveau en présence, diagonalement, d’une pièce adverse derrière "+rc$
regle$=regle$+"laquelle se trouve une case libre, il doit obligatoirement sauter par-dessus cette seconde pièce, voire d’une troisième et"+rc$
regle$=regle$+"ainsi de suite, et occuper la case libre se trouvant derrière la dernière pièce capturée. Les pièces adverses ainsi capturées"+rc$
regle$=regle$+"sont ensuite enlevées du damier dans l’ordre de la prise."+rc$
regle$=regle$+"Cette opération complète est une rafle par un pion."+rc$
regle$=regle$+"Lorsqu’au cours d’une prise par une dame, celle-ci se trouve à nouveau en présence, sur une même diagonale, d’une pièce adverse"+rc$
regle$=regle$+"derrière laquelle se trouve une ou plusieurs cases libres, elle doit obligatoirement sauter par-dessus cette seconde pièce, voire"+rc$
regle$=regle$+"d’une troisième et ainsi de suite, et occuper au choix une case libre se trouvant derrière et sur la même diagonale que la dernière"+rc$
regle$=regle$+"pièce capturée. Les pièces adverses ainsi capturées sont ensuite enlevées du damier dans l’ordre de la prise."+rc$
regle$=regle$+"Cette opération complète est une rafle par une dame."+rc$
regle$=regle$+"Au cours d’une rafle, il est interdit de passer au-dessus de ses propres pièces."+rc$
regle$=regle$+"Au cours d’une rafle, il est permis de passer plusieurs fois sur une même case libre mais il est interdit de passer plus d’une fois "+rc$
regle$=regle$+"au-dessus d’une même pièce adverse."+rc$
regle$=regle$+"Une rafle doit être clairement indiquée, pièce par pièce, en posant la pièce preneuse sur la case de saut, le temps d’y passer, et"+rc$
regle$=regle$+"en déposant cette pièce sur la case terminale."+rc$
regle$=regle$+"Les pièces prises ne peuvent être enlevées du damier qu’à l’issue de l’exécution complète de la rafle."+rc$
regle$=regle$+"La prise du plus grand nombre de pièces est prioritaire, donc obligatoire. Dans ce cas, une dame compte pour une pièce, tout comme un pion."+rc$
regle$=regle$+"Elle ne confère nulle priorité et n’impose aucune obligation."+rc$
regle$=regle$+"Si les pièces à prendre sont en nombre égal dans deux ou plusieurs possibilités de prise ou de rafle, le joueur est libre de choisir "+rc$
regle$=regle$+"une de ces possibilités, soit avec un pion, soit avec une dame."+rc$
regle$=regle$+"Un pion qui au cours d’une rafle, ne fait que passer sur une des 5 cases de la rangée de base adverse reste un pion lorsque la rafle est terminée."+rc$

FORM 910: TOP 910,2*Marge_y: LEFT 910,3*Marge_X: WIDTH 910,x_Max-6*Marge_X: HEIGHT 910,y_Max-4*Marge_y: HIDE 910
FONT_SIZE 910,10
LIST 911: PARENT 911,910: WIDTH 911,WIDTH(910)-16: HEIGHT 911,HEIGHT(910)-80
k% = INSTR(regle$, rc$)
WHILE k% > 0
ITEM_ADD 911, LEFT$(regle$, k%-1): regle$ = MID$(regle$, k%+1, 9000)
k% = INSTR(regle$, rc$)
END_WHILE
BUTTON 912: PARENT 912,910: TOP 912,HEIGHT(910)-70: LEFT 912,280: CAPTION 912,"OK"
ON_CLICK 912, Fregle

' Creation des compteurs de pions
ALPHA 40 : LEFT 40,Marge_X + 12* pas_case : TOP 40,pas_case - 15: WIDTH 40, 40 : FONT_SIZE 40,20
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE 11.5*pas_case+r%,0.5*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE 11.5*pas_case+r%,0.5*pas_case+r%,r% - 7
ALPHA 41 : LEFT 41,5*Marge_X + 12* pas_case : TOP 41,pas_case - 15: WIDTH 41, 40 : FONT_SIZE 41,20
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE 11.5*pas_case+r%+4*Marge_X,0.5*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE 11.5*pas_case+r%+4*Marge_X,0.5*pas_case+r%,r% - 7
LIST 916 : TOP 916,pas_case+r%+Marge_Y : HEIGHT 916,HEIGHT(0) - (pas_case+r%+4*Marge_Y): FONT_SIZE 916,10
LEFT 916,10*pas_case+Marge_X+20 : WIDTH 916,WIDTH(0) - (10.5*pas_case+r%+Marge_X)

Relance:
' INITIALISATION DES PIONS SUR LE DAMIER
' PIONS DE L'AI
case% = 0
FOR j% = 0 TO 3
FOR k% = 0 TO 9
IF case% = 0 THEN case% = 1 : ELSE : damier%(j%,k%)= 2 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
' CASES VIDES
FOR j% = 4 TO 5
FOR k% = 0 TO 9
damier%(j%,k%)= 0
NEXT k%
NEXT j%
' PIONS DU JOUEUR
case% = 0
FOR j% = 6 TO 9
FOR k% = 0 TO 9
IF case% = 0 THEN case% = 1 : ELSE : damier%(j%,k%)= 1 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%

Nb_Noirs = 20 : Nb_blancs = 20 :CAPTION 40,Nb_blancs : CAPTION 41,Nb_noirs

tour=0 : ' Les blancs commencent
2D_TARGET_IS 0 : 2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
Message$="Les pions blancs commencent": ITEM_ADD 916, Message$

' Représentation du Damier
GOSUB Dessine_Damier
ON_CLICK 2, Clic_Damier

END

Ce que j'ai fait pour les listes, tu le trouves sur mon site, dans la rubrique Panoramic, sous le titre GLIST, dans mes pseudo-objets. Voici le lien.

Le problème, c'est qu'on ne peut pas gérer en Panoramic, le défilement d'une liste. C'est pourquoi j'ai simulé une liste par un picture. Et on peut avoir plusieurs listes synchronisées, qui défilent donc ensemble, quelque soit la liste ciblée. Les insertion, modifications et suppressions sont également synchronisées.

Salut,

Je suis tomber sur une erreur: Les noirs devaient prendre, j'ai insisté pour jouer ailleurs, et le programme s'est boqué (après un message d'erreur "Not floating point value")

A+

Merci à vous deux. Klaus, je regarde. Jean-Claude, je vais tester plus, j'ai vraiment testé rapidement ce matin, j'espère pouvoir reproduire ton erreur, mais je ne sais pas si je la résoudrai ce week-end, mais merci pour ton test, ça me prouve que je dois tester plus ... J'ai dû faire une erreur de logique à force de bidouiller

Bon, j'ai le bug aussi de temps en temps Jean-Claude, mais je n'ai pas le temps de chercher là.
Par contre pour la liste, GLIST est trop puissant pour mon usage, j'ai fait un simple ITEM_DELETE quand ma liste atteind un nombre de lignes définit, ça répond à mon besoin. (GLIST est génial, mais là, ça serait utiliser un bazooka pour tuer une foumi Wink

)
Si quelqu'un à le temps de regarder pour le problème d'erreur quand on clic sur un pion qui se produit de temps en temps, ça doit être tout con, sans doute un problème de mise à jour, mais bon, ça peut aussi être un problème de logique comme là, je ne prend pas de recul par rapport au code.
En tout cas, j'ai corrigé un problème de condition de victoire qui n'avait pas était rajouté pour les noirs et le nommage des lignes, colonnes. Il est temps que je libère l'ordi ...

Code:: REM Jeu de dames par Jean-Charles
REM V0.5 du 26/05/2011
REM Programmation en cours

LABEL Init: GOTO Init

Aide:
SHOW 900
RETURN

Faide:
HIDE 900
RETURN

Regle:
SHOW 910
RETURN

Fregle:
HIDE 910
RETURN

Quitter:
TERMINATE
RETURN

Ajout_Liste916:
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916, Message$
RETURN

Dessine_Damier:
2D_TARGET_IS 2
2D_PEN_COLOR 40,40,40: 2D_RECTANGLE 0,0,WIDTH(2),HEIGHT(2)
case% = 0
FOR j% = 0 TO 9
FOR k% = 0 TO 9
IF case% = 0
2D_FILL_COLOR CDR,CDV,CDB
case% = 1
ELSE
2D_FILL_COLOR CCR,CCV,CCB
case% = 0
END_IF
2D_RECTANGLE k%*pas_case,j%*pas_case,(k%+1)*pas_case,(j%+1)*pas_case
IF damier%(j%,k%) > 0 THEN GOSUB Dessine_piece
2D_PEN_COLOR 40,40,40
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
RETURN

Dessine_piece:
SELECT damier%(j%,k%)
CASE 0: ' NORMALEMENT ON NE LE FAIT JAMAIS
CASE 1: ' PION BLANC
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
CASE 2: ' PION NOIR
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
CASE 9: ' DAME BLANCHE
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case-3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%-6,r% - 7 : 2D_PEN_WIDTH 3
CASE 8: ' DAME NOIRE
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case-3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%-6,r% - 7 : 2D_PEN_WIDTH 3
END_SELECT
RETURN

Clic_Damier:
OFF_CLICK 2
GOSUB Test_PeutJouer
IF Tour=0 AND PeutJouer=0 THEN Message$="Fin de partie, les blancs ne peuvent plus jouer" : GOSUB Ajout_Liste916
IF Tour=0 AND PeutJouer=0 THEN Message$="Les noirs gagnent" : GOSUB Ajout_Liste916
IF Tour=1 AND PeutJouer=0 THEN Message$="Fin de partie, les noirs ne peuvent plus jouer" : GOSUB Ajout_Liste916
IF Tour=1 AND PeutJouer=0 THEN Message$="Les blancs gagnent" : GOSUB Ajout_Liste916

Sposx = INT(MOUSE_X_POSITION(2)/pas_case)
Sposy = INT(MOUSE_Y_POSITION(2)/pas_case)
Clic_Damier3:
IF tour=0 AND PeutJouer <> 0
' Tour des blancs
IF damier%(Sposy,Sposx) = 1 OR damier%(Sposy,Sposx) = 9
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
IF damier%(Sposy,Sposx) = 1 THEN Message$=" le pion en "
IF damier%(Sposy,Sposx) = 9 THEN Message$=" la dame en "
Message$=Message$+CHR$(65+Sposx)+":"+CHR$(48+Sposy)
ON_CLICK 2, Clic2_Damier_blancs
ELSE
ON_CLICK 2, Clic_Damier
END_IF
ELSE
' Tour des noirs
IF PeutJouer<>0
IF damier%(Sposy,Sposx) = 2 OR damier%(Sposy,Sposx) = 8
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
IF damier%(Sposy,Sposx) = 2 THEN Message$=" le pion en "
IF damier%(Sposy,Sposx) = 8 THEN Message$=" la dame en "
Message$=Message$+CHR$(65+Sposx)+":"+CHR$(48+Sposy)
ON_CLICK 2, Clic2_Damier_noirs
ELSE
ON_CLICK 2, Clic_Damier
END_IF
END_IF
END_IF
IF PeutJouer=0 THEN GOSUB Fin
RETURN

Clic2_Damier_noirs:
OFF_CLICK 2
TempX=NposX: TempY=NposY : GOSUB Test_PeutJouer : NposX=TempX : NposY=TempY
Nposx = INT(MOUSE_X_POSITION(2)/pas_case) : Nposy = INT(MOUSE_Y_POSITION(2)/pas_case)
IF NposX <> SposX OR NposY <> SposY
Delta=abs(Sposx - Nposx):PeutPrendre=0:i%=0:Cpt=0:j%=(NposX - SposX)/Delta : k%=(NposY - SposY)/Delta
IF damier%(Nposy,Nposx) = 0 THEN i%=1
IF i%=1
IF NposY > SposY
IF (NposY - Delta) = SposY THEN i%=2
ELSE
IF (NposY + Delta) = SposY THEN i%=2
END_IF
END_IF
IF Delta = 1 AND SposY < NposY AND i%=2
PeutPrendre=1
ELSE
IF Delta = 2 AND i%=2
IF Damier%(SposY+k%,SposX+j%)=1 OR Damier%(SposY+k%,SposX+j%)=9 THEN PeutPrendre=1:Cpt=1:PionX=SposX+j%: PionY=SposY+k%
ELSE
IF Damier%(SposY,SposX)=8 AND i%=2
PeutPrendre=1
FOR i% = 1 TO Delta
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=1 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=9
IF Cpt=0
Cpt=1:PionX=SposX+(j%*i%): PionY=SposY+(k%*i%)
ELSE
PeutPrendre=0 : i%=Delta
END_IF
ELSE
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=2 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=8 THEN PeutPrendre=0 : i%=Delta
END_IF
NEXT i%
END_IF
END_IF
END_IF
IF PeutPrendre=1
IF Cpt=0
IF DoitPrendre=0
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
tour= 0 : 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30, 100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_TARGET_IS 2 : ON_CLICK 2, Clic_Damier
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les noirs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
ELSE
Message$="Irrégularité des noirs: vous devez prendre":GOSUB Ajout_Liste916
ON_CLICK 2, Clic2_Damier_noirs
END_IF
ELSE
IF Cpt=1
damier%(PionY,PionX)=0 : Nb_blancs = Nb_blancs - 1 : CAPTION 40,Nb_blancs
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE (PionX)*pas_case,(PionY)*pas_case,(PionX+1)*pas_case,(PionY+1)*pas_case
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les noirs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
IF Nb_blancs <=0
Message$="Il ne reste plus de pion blanc. Les noirs gagnent": GOSUB Ajout_Liste916
ELSE
GOSUB Test_PeutPrendre
IF PeutPrendre = 0
tour=0 : 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30, 100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_TARGET_IS 2 : ON_CLICK 2, Clic_Damier
ELSE
Sposx=Nposx : Sposy=Nposy
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic2_Damier_noirs
END_IF
END_IF
END_IF
END_IF
ELSE
IF damier%(Nposy,Nposx) = 2 or damier%(Nposy,Nposx) = 8
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=SposY:k%=SposX: GOSUB Dessine_piece
Sposx=Nposx : Sposy=Nposy : Goto Clic_Damier3
ELSE
ON_CLICK 2,Clic2_Damier_noirs
END_IF
END_IF
IF tour=0 AND Nposy=9 THEN IF damier%(Nposy,Nposx)=2 THEN j%=Nposy : k%= Nposx : damier%(j%,k%)=8 : GOSUB Dessine_piece
ELSE
ON_CLICK 2,Clic2_Damier_noirs
END_IF
IF Nb_blancs= 0 THEN GOTO Fin
RETURN

Clic2_Damier_blancs:
OFF_CLICK 2
TempX=NposX: TempY=NposY : GOSUB Test_PeutJouer : NposX=TempX : NposY=TempY
Nposx = INT(MOUSE_X_POSITION(2)/pas_case) : Nposy = INT(MOUSE_Y_POSITION(2)/pas_case)
IF NposX <> SposX OR NposY <> SposY
Delta=abs(Sposx - Nposx):PeutPrendre=0:i%=0:Cpt=0:j%=(NposX - SposX)/Delta : k%=(NposY - SposY)/Delta
IF damier%(Nposy,Nposx) = 0 THEN i%=1
IF i%=1
IF NposY > SposY
IF (NposY - Delta) = SposY THEN i%=2
ELSE
IF (NposY + Delta) = SposY THEN i%=2
END_IF
END_IF
IF Delta = 1 AND SposY > NposY AND i%=2
PeutPrendre=1
ELSE
IF Delta = 2 AND i%=2
IF Damier%(SposY+k%,SposX+j%)=2 OR Damier%(SposY+k%,SposX+j%)=8 THEN PeutPrendre=1:Cpt=1:PionX=SposX+j%: PionY=SposY+k%
ELSE
IF Damier%(SposY,SposX)=9 AND i%=2
PeutPrendre=1
FOR i% = 1 TO Delta
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=2 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=8
IF Cpt=0
Cpt=1:PionX=SposX+(j%*i%): PionY=SposY+(k%*i%)
ELSE
PeutPrendre=0 : i%=Delta
END_IF
ELSE
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=1 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=9 THEN PeutPrendre=0 : i%=Delta
END_IF
NEXT i%
END_IF
END_IF
END_IF
IF PeutPrendre=1
IF Cpt=0
IF DoitPrendre=0
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
tour = 1 : 2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7 : 2D_TARGET_IS 2
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les blancs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
ON_CLICK 2, Clic_Damier
ELSE
Message$="Irrégularité des blancs: vous devez prendre":GOSUB Ajout_Liste916
ON_CLICK 2, Clic2_Damier_blancs
END_IF
ELSE
IF Cpt=1
damier%(PionY,PionX)=0 : Nb_Noirs = Nb_Noirs - 1 : CAPTION 41,Nb_noirs
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE (PionX)*pas_case,(PionY)*pas_case,(PionX+1)*pas_case,(PionY+1)*pas_case
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les blancs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
IF Nb_Noirs <=0
Message$="Il ne reste plus de pion noir. Les blancs gagnent":GOSUB Ajout_Liste916
ELSE
GOSUB Test_PeutPrendre
IF PeutPrendre = 0
tour = 1: 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7 : 2D_TARGET_IS 2
ON_CLICK 2, Clic_Damier
ELSE
Sposx=Nposx : Sposy=Nposy
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic2_Damier_blancs
END_IF
END_IF
END_IF
END_IF
ELSE
IF damier%(Nposy,Nposx) = 1 or damier%(Nposy,Nposx) = 9
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=SposY:k%=SposX: GOSUB Dessine_piece
Sposx=Nposx : Sposy=Nposy : Goto Clic_Damier3
ELSE
ON_CLICK 2,Clic2_Damier_blancs
END_IF
END_IF
IF tour=1 AND Nposy=0
IF damier%(Nposy,Nposx)=1
Message$="Nouvelle Dame blanche en "+CHR$(65+Nposx)+":"+CHR$(48+Nposy):GOSUB Ajout_Liste916
j%=Nposy : k%= Nposx : damier%(j%,k%)=9 : GOSUB Dessine_piece
END_IF
END_IF
ELSE
ON_CLICK 2,Clic2_Damier_noirs
END_IF
IF Nb_noirs=0 THEN GOTO Fin
RETURN

Test_deplacement:
case%=0
IF damier%(Nposy,Nposx)=1 AND tour=0 THEN case%= 1
IF damier%(Nposy,Nposx)=2 AND tour=1 THEN case%= 2
IF damier%(Nposy,Nposx)=8 OR damier%(Nposy,Nposx)=9 THEN case%= 3

IF Nposx < 9 AND Nposy < 9
IF case%=2 OR case%=3
IF damier%(Nposy+1,Nposx+1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx < 9 AND Nposy > 0
IF case%=1 OR case%=3
IF damier%(Nposy-1,Nposx+1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx > 0 AND Nposy < 9
IF case%=2 OR case%=3
IF damier%(Nposy+1,Nposx-1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx > 1 AND Nposy > 1
IF case%=1 OR case%=3
IF damier%(Nposy-1,Nposx-1)=0 THEN PeutJouer = 1
END_IF
END_IF
RETURN

Test_PeutJouer:
case% = 0: PeutPrendre=0 : DoitPrendre = 0 : PeutJouer=0
FOR Nposy = 0 TO 9 : ' Correspond à la ligne (y)
FOR Nposx = 0 TO 9 : ' Correspond à la rangée (x)
IF case% = 0
case% = 1 : ' Case vide, on passe
ELSE
GOSUB Test_deplacement
IF tour=0 and damier%(Nposy,Nposx)=1 THEN GOSUB Test_PeutPrendre
IF tour=0 and damier%(Nposy,Nposx)=9 THEN GOSUB Test_PeutPrendre_Dame
IF tour=1 and damier%(Nposy,Nposx)=2 THEN GOSUB Test_PeutPrendre
IF tour=1 and damier%(Nposy,Nposx)=8 THEN GOSUB Test_PeutPrendre_Dame
IF PeutPrendre = 1 THEN DoitPrendre = 1:PeutJouer = 1
case% = 0
END_IF
NEXT NposX
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT NposY
RETURN

Test_PeutPrendre_dame:
PeutPrendre = 0: Delta = 0
IF tour=0 THEN j%=2 : k%=8
IF tour=1 THEN j%=1 : k%=9

IF Nposx < 8 AND Nposy < 8
IF Nposx > Nposy THEN Delta = 8-Nposx :ELSE : Delta = 8-Nposy
FOR i% = 1 TO Delta
IF (damier%(Nposy+i%,Nposx+i%)=j% OR damier%(Nposy+i%,Nposx+i%)=k%) AND damier%(Nposy+i%+1,Nposx+i%+1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF

IF Nposx < 8 AND Nposy > 1
IF Nposy >= (8-Nposx) THEN Delta= 8-Nposx : ELSE : Delta = Nposy-1
FOR i% = 1 TO Delta
IF (damier%(Nposy-i%,Nposx+i%)=j% OR damier%(Nposy-i%,Nposx+i%)=k%) AND damier%(Nposy-i%-1,Nposx+i%+1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF

IF Nposx > 1 AND Nposy < 8
IF ((8-Nposy) > (Nposx-1)) THEN Delta= Nposx -1: ELSE : Delta = 8-Nposy
FOR i% = 1 TO Delta
IF damier%(Nposy+i%,Nposx-i%)=j% OR damier%(Nposy+i%,Nposx-i%)=k%
IF damier%(Nposy+i%+1,Nposx-i%-1)= 0 THEN PeutPrendre = 1
END_IF
NEXT i%
END_IF

IF Nposx > 1 AND Nposy > 1
IF Nposx > Nposy THEN Delta= Nposy-1: ELSE : Delta = Nposx-1
FOR i% = 1 TO Delta
IF (damier%(Nposy-i%,Nposx-i%)=j% OR damier%(Nposy-i%,Nposx-i%)=k%) AND damier%(Nposy-i%-1,Nposx-i%-1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF
RETURN

Test_PeutPrendre:
PeutPrendre = 0
IF tour=0 THEN j%=2 : k%=8
IF tour=1 THEN j%=1 : k%=9
IF Nposx < 8 AND Nposy < 8
IF (damier%(Nposy+1,Nposx+1)=j% OR damier%(Nposy+1,Nposx+1)=k%) AND damier%(Nposy+2,Nposx+2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx < 8 AND Nposy > 1
IF (damier%(Nposy-1,Nposx+1)=j% OR damier%(Nposy-1,Nposx+1)=k%) AND damier%(Nposy-2,Nposx+2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx > 1 AND Nposy < 8
IF (damier%(Nposy+1,Nposx-1)=j% OR damier%(Nposy+1,Nposx-1)=k%) AND damier%(Nposy+2,Nposx-2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx > 1 AND Nposy > 1
IF (damier%(Nposy-1,Nposx-1)=j% OR damier%(Nposy-1,Nposx-1)=k%) AND damier%(Nposy-2,Nposx-2)= 0 THEN PeutPrendre = 1
END_IF
RETURN

Fin:
case%=MESSAGE_CONFIRMATION_YES_NO("Voulez vous faire une nouvelle partie ?")
IF case%=1 THEN GOTO Relance
IF case%=0 THEN GOTO Fin
Terminate

Init:
COLOR 0,180,100,60
LABEL Aide,Regle,Faide, Fregle, Quitter, Clic_Damier, Clic2_Damier_blancs, Clic_Damier3, Clic2_Damier_noirs, Dessine_Damier, Dessine_piece
LABEL Test_PeutPrendre, Test_PeutPrendre_dame, Relance, Test_PeutJouer, Test_deplacement, Fin, Ajout_Liste916
DIM x_Max, y_Max : x_Max=1000 : y_max=700
DIM Marge_x, Marge_y : Marge_x = 40 : Marge_y = 30
DIM hlp$,regle$,h%,i%,j%,k%,case%,tour,PeutPrendre,PeutJouer,DoitPrendre, Message$
DIM Delta, Cpt, PionX, PionY, TempX, TempY, taille_max_liste: taille_max_liste = 20
DIM damier%(10,10) : ' 0: Case vide, 1: Pion du joueur, 9: Dame du joueur, 2: Pion de l'Ai, 8: Dame de l'Ai
DIM Sposx, Sposy : ' Position du pion sélectionné
DIM Nposx, Nposy : ' Position de la destination sélectionné
DIM pas_case : if (y_Max - 2* Marge_y) > (x_Max - 2 * Marge_x) Then pas_case= (x_Max - 2 * Marge_x) / 11 : else: pas_case= (y_Max - 2 * Marge_y) / 11
DIM rc$ : rc$=CHR$(10)
DIM Nb_Noirs,Nb_blancs : ' Nombre de pions noirs et blancs
DIM r%: r% = pas_case/2 -1
DIM CBR,CBV,CBB, CNR, CNV, CNB
CBR = 205 : CBV = 205: CBB = 205 : ' Couleurs des pions blancs
CNR = 55 : CNV = 55 : CNB = 55 : ' Couleurs des pions noirs
DIM CDR,CDV,CDB,CCR,CCV,CCB
CDR = 255 : CDV = 255: CDB = 255 : ' Couleurs des cases 'blanches'
CCR = 30 : CCV = 30 : CCB = 180 : ' Couleurs des cases 'noires'
CAPTION 0, "Jeu de dames en Basic Panoramic par Jean-Charles"
WIDTH 0,x_Max : HEIGHT 0, y_max

' Création de l'image support pour le damier
PICTURE 2 : WIDTH 2, 10 * pas_case : HEIGHT 2, 10 * pas_case : TOP 2,Marge_y: LEFT 2, Marge_x

' Menu Principal
MAIN_MENU 1 : REM On reserve les objets 1 à 30 pour le menu
SUB_MENU 11: PARENT 11, 1: CAPTION 11, "Fichier"
SUB_MENU 16: PARENT 16, 1: CAPTION 16, "Aide"
SUB_MENU 17: PARENT 17, 1: CAPTION 17, "Règle"
ON_CLICK 16, Aide : ON_CLICK 17, Regle

' Sous menu Fichier
SUB_MENU 25: CAPTION 25,"Relancer partie" : PARENT 25, 11
SUB_MENU 26: CAPTION 26,"Quitter" : PARENT 26, 11
ON_CLICK 25, Relance :ON_CLICK 26, Quitter

' Préparation de l'aide
hlp$=CHR$(9)+CHR$(9)+CHR$(9)+" - AIDE DU JEU DE DAMES -"+rc$
hlp$=hlp$+CHR$(9)+CHR$(9)+CHR$(9)+" ==============================="+rc$+rc$
hlp$=hlp$+"A remplir"+rc$
FORM 900: TOP 900,2*Marge_y: LEFT 900,3*Marge_X: WIDTH 900,x_Max-6*Marge_X: HEIGHT 900,y_Max-4*Marge_y: HIDE 900
FONT_SIZE 900,10
LIST 901: PARENT 901,900: WIDTH 901,WIDTH(900)-16: HEIGHT 901,HEIGHT(900)-80
k% = INSTR(hlp$, rc$)
WHILE k% > 0
ITEM_ADD 901, LEFT$(hlp$, k%-1): hlp$ = MID$(hlp$, k%+1, 9000)
k% = INSTR(hlp$, rc$)
END_WHILE
BUTTON 902: PARENT 902,900: TOP 902,HEIGHT(900)-70: LEFT 902,280: CAPTION 902,"OK"
ON_CLICK 902, Faide

regle$=CHR$(9)+CHR$(9)+CHR$(9)+" - REGLES DU JEU DE DAMES -"+rc$
regle$=regle$+CHR$(9)+CHR$(9)+CHR$(9)+" ==============================="+rc$+rc$
rem regle$=regle$+""+rc$ : ' Modèle d'une ligne vide
regle$=regle$+"Le jeu de dames international se joue sur un damier carré divisé en 100 cases égales, alternativement claires et foncées."+rc$
regle$=regle$+"Le jeu se joue sur les cases foncées du damier. Il y a donc 50 cases actives."+rc$
regle$=regle$+"La plus longue diagonale, joignant deux coins du damier et comprenant 10 cases foncées, se dénomme la grande diagonale."+rc$
regle$=regle$+"Le damier doit être placé de sorte que la première case de gauche, pour chaque joueur, soit une case foncée."+rc$
regle$=regle$+"Le jeu de dames international se joue avec 20 pions blancs (clairs) et 20 pions noirs (foncés)"+rc$
regle$=regle$+"Avant de débuter une partie, les 20 pions noirs et les 20 pions blancs sont disposés sur les 4 premières rangées de chaque joueur."+rc$
regle$=regle$+"Il faut manger tous les pions de l'autre en passant par dessus avec l'un de vos pions."+rc$
regle$=regle$+"Les déplacements autoriser : seulement d'une case en avant, en diagonale si celle ci est libre."+rc$
regle$=regle$+"Le premier coup est toujours joué par les blancs. Les adversaires jouent un coup chacun à tour de rôle avec leurs pièces."+rc$
regle$=regle$+"Pour cela, on couronne le pion en plaçant dessus un deuxième pion de la même couleur."+rc$
regle$=regle$+"Il est interdit de reculer en dehors des prises"+rc$
regle$=regle$+"Si un pion avance jusqu'à la dernière rangée, il devient une Dame."+rc$
regle$=regle$+"La dame peut se déplacer de plusieurs cases en avant ou en arrière si ces cases sont vides."+rc$
regle$=regle$+"La prise des pièces adverse est obligatoire et s’effectue aussi bien en avant qu’en arrière."+rc$
regle$=regle$+"Lorsqu’un pion se trouve en présence, diagonalement, d’une pièce adverse derrière laquelle se trouve une case libre, il doit"+rc$
regle$=regle$+"obligatoirement sauter par-dessus cette pièce et occuper la case libre. Cette pièce adverse est alors enlevée du damier."+rc$
regle$=regle$+"Cette opération complète est la prise par un pion."+rc$
regle$=regle$+"Lorsqu’au cours d’une prise par un pion, celui-ci se trouve à nouveau en présence, diagonalement, d’une pièce adverse derrière "+rc$
regle$=regle$+"laquelle se trouve une case libre, il doit obligatoirement sauter par-dessus cette seconde pièce, voire d’une troisième et"+rc$
regle$=regle$+"ainsi de suite, et occuper la case libre se trouvant derrière la dernière pièce capturée. Les pièces adverses ainsi capturées"+rc$
regle$=regle$+"sont ensuite enlevées du damier dans l’ordre de la prise."+rc$
regle$=regle$+"Cette opération complète est une rafle par un pion."+rc$
regle$=regle$+"Lorsqu’au cours d’une prise par une dame, celle-ci se trouve à nouveau en présence, sur une même diagonale, d’une pièce adverse"+rc$
regle$=regle$+"derrière laquelle se trouve une ou plusieurs cases libres, elle doit obligatoirement sauter par-dessus cette seconde pièce, voire"+rc$
regle$=regle$+"d’une troisième et ainsi de suite, et occuper au choix une case libre se trouvant derrière et sur la même diagonale que la dernière"+rc$
regle$=regle$+"pièce capturée. Les pièces adverses ainsi capturées sont ensuite enlevées du damier dans l’ordre de la prise."+rc$
regle$=regle$+"Cette opération complète est une rafle par une dame."+rc$
regle$=regle$+"Au cours d’une rafle, il est interdit de passer au-dessus de ses propres pièces."+rc$
regle$=regle$+"Au cours d’une rafle, il est permis de passer plusieurs fois sur une même case libre mais il est interdit de passer plus d’une fois "+rc$
regle$=regle$+"au-dessus d’une même pièce adverse."+rc$
regle$=regle$+"Une rafle doit être clairement indiquée, pièce par pièce, en posant la pièce preneuse sur la case de saut, le temps d’y passer, et"+rc$
regle$=regle$+"en déposant cette pièce sur la case terminale."+rc$
regle$=regle$+"Les pièces prises ne peuvent être enlevées du damier qu’à l’issue de l’exécution complète de la rafle."+rc$
regle$=regle$+"La prise du plus grand nombre de pièces est prioritaire, donc obligatoire. Dans ce cas, une dame compte pour une pièce, tout comme un pion."+rc$
regle$=regle$+"Elle ne confère nulle priorité et n’impose aucune obligation."+rc$
regle$=regle$+"Si les pièces à prendre sont en nombre égal dans deux ou plusieurs possibilités de prise ou de rafle, le joueur est libre de choisir "+rc$
regle$=regle$+"une de ces possibilités, soit avec un pion, soit avec une dame."+rc$
regle$=regle$+"Un pion qui au cours d’une rafle, ne fait que passer sur une des 5 cases de la rangée de base adverse reste un pion lorsque la rafle est terminée."+rc$

FORM 910: TOP 910,2*Marge_y: LEFT 910,3*Marge_X: WIDTH 910,x_Max-6*Marge_X: HEIGHT 910,y_Max-4*Marge_y: HIDE 910
FONT_SIZE 910,10
LIST 911: PARENT 911,910: WIDTH 911,WIDTH(910)-16: HEIGHT 911,HEIGHT(910)-80
k% = INSTR(regle$, rc$)
WHILE k% > 0
ITEM_ADD 911, LEFT$(regle$, k%-1): regle$ = MID$(regle$, k%+1, 9000)
k% = INSTR(regle$, rc$)
END_WHILE
BUTTON 912: PARENT 912,910: TOP 912,HEIGHT(910)-70: LEFT 912,280: CAPTION 912,"OK"
ON_CLICK 912, Fregle

' Creation des compteurs de pions
ALPHA 40 : LEFT 40,Marge_X + 12* pas_case : TOP 40,pas_case - 15: WIDTH 40, 40 : FONT_SIZE 40,20
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE 11.5*pas_case+r%,0.5*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE 11.5*pas_case+r%,0.5*pas_case+r%,r% - 7
ALPHA 41 : LEFT 41,5*Marge_X + 12* pas_case : TOP 41,pas_case - 15: WIDTH 41, 40 : FONT_SIZE 41,20
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE 11.5*pas_case+r%+4*Marge_X,0.5*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE 11.5*pas_case+r%+4*Marge_X,0.5*pas_case+r%,r% - 7
LIST 916 : TOP 916,pas_case+r%+Marge_Y : HEIGHT 916,HEIGHT(0) - (pas_case+r%+4*Marge_Y): FONT_SIZE 916,10
LEFT 916,10*pas_case+Marge_X+20 : WIDTH 916,WIDTH(0) - (10.5*pas_case+r%+Marge_X)
FOR k% = 0 TO 9
i% = 50+k% : ALPHA i%: TOP i%,Marge_Y-32 : WIDTH i%,20 : LEFT i%, (k%+0.5)*pas_case + 30 : FONT_SIZE i%,20 : CAPTION i%,CHR$(65+k%)
i% = 60+k% : ALPHA i%: TOP i%,Marge_Y-20 + (k%+0.5)*pas_case : WIDTH i%,20 : LEFT i%, 10 : FONT_SIZE i%,20 : CAPTION i%,CHR$(48+k%)
NEXT k%

Relance:
' INITIALISATION DES PIONS SUR LE DAMIER
' PIONS DE L'AI
case% = 0
FOR j% = 0 TO 3
FOR k% = 0 TO 9
IF case% = 0 THEN case% = 1 : ELSE : damier%(j%,k%)= 2 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
' CASES VIDES
FOR j% = 4 TO 5
FOR k% = 0 TO 9
damier%(j%,k%)= 0
NEXT k%
NEXT j%
' PIONS DU JOUEUR
case% = 0
FOR j% = 6 TO 9
FOR k% = 0 TO 9
IF case% = 0 THEN case% = 1 : ELSE : damier%(j%,k%)= 1 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%

Nb_Noirs = 20 : Nb_blancs = 20 :CAPTION 40,Nb_blancs : CAPTION 41,Nb_noirs

tour=0 : ' Les blancs commencent
2D_TARGET_IS 0 : 2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
CLEAR 916: Message$="Les pions blancs commencent": ITEM_ADD 916, Message$

' Représentation du Damier
GOSUB Dessine_Damier
ON_CLICK 2, Clic_Damier

END

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Je n'ai pas tout suivi, mais pour le moment donc on joue contre un autre adversaire humain (et non contre l'ordinateur). C'est prometteur (et compliqué, je l'admets).

Juste une petite remarque esthétique: je trouve que les pions noirs ne ressortent pas très bien sur les cases foncées.
Juste pour voir j'ai ajouté, juste après la ligne 59 (CASE 2: ' pion noir) la ligne suivante:

Code:: 2D_PEN_COLOR 164,164,164 : 2D_CIRCLE k%*pas_case+r%-2,j%*pas_case+3+r%-2,r%-7

ce n'est pas idéal mais bon...

Une petite remarque bénigne: en début de partie ('les pions blancs commencent'), les noirs ont également le feu vert.

Bravo Jicehel. très prometteur !

Seul bémol, j'ai eu un plantage en essayant de changer le pion que je souhaite déplacer (selection) et après avoir cliqué plusieurs fois sur plusieurs pions qui étaient 'selectionnable' tous s'est figé sans méssage d'erreur et je n'ai pas réussi a sélectionner un autre pion !!

sinon super. j'attend de voir la partie IA avec impatience.
Bon courage pour la suite...

Bon voilà, j'ai trouvé l'erreur bête que j'avais faite qui créé le plantage je pense
J'ai rajouté la possibilité de choisir la couleur de son damier pour JL35 et j'ai rajouté l'effacement de la led verte quand on relance une partie si c'était les noirs qui jouaient
Merci à tous pour vos tests et vous pouvez continuer sur cette nouvelle version pour vérifier qu'il n'y a pas d’anomalie (il en reste probablement, mais mes premiers tests semblent corrects)
Je pense que ça devrait fonctionner là mais je vous laisse vérifier par vous même.
Je fais un petit break s'il n'y a pas de bug et la semaine prochaine, je m'attaque à l'IA si on veut pour calculer le coup de l'ordi

Code:: REM Jeu de dames par Jean-Charles
REM V0.5 du 26/05/2011
REM Programmation en cours

LABEL Init: GOTO Init

Aide:
SHOW 900
RETURN

Faide:
HIDE 900
RETURN

Regle:
SHOW 910
RETURN

Fregle:
HIDE 910
RETURN

Quitter:
TERMINATE
RETURN

Ajout_Liste916:
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916, Message$
RETURN

Dessine_Damier:
2D_TARGET_IS 2
2D_PEN_COLOR 40,40,40: 2D_RECTANGLE 0,0,WIDTH(2),HEIGHT(2)
case% = 0
FOR j% = 0 TO 9
FOR k% = 0 TO 9
IF case% = 0
2D_FILL_COLOR CDR,CDV,CDB
case% = 1
ELSE
2D_FILL_COLOR CCR,CCV,CCB
case% = 0
END_IF
2D_RECTANGLE k%*pas_case,j%*pas_case,(k%+1)*pas_case,(j%+1)*pas_case
IF damier%(j%,k%) > 0 THEN GOSUB Dessine_piece
2D_PEN_COLOR 40,40,40
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
RETURN

Dessine_piece:
SELECT damier%(j%,k%)
CASE 0: ' NORMALEMENT ON NE LE FAIT JAMAIS
CASE 1: ' PION BLANC
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
CASE 2: ' PION NOIR
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
CASE 9: ' DAME BLANCHE
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case-3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%-6,r% - 7 : 2D_PEN_WIDTH 3
CASE 8: ' DAME NOIRE
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case-3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%-6,r% - 7 : 2D_PEN_WIDTH 3
END_SELECT
RETURN

Clic_Damier:
Sposx = INT(MOUSE_X_POSITION(2)/pas_case) : Sposy = INT(MOUSE_Y_POSITION(2)/pas_case)
Clic_Damier3:
OFF_CLICK 2
GOSUB Test_PeutJouer
IF Tour=0 AND PeutJouer=0 THEN Message$="Fin de partie, les blancs ne peuvent plus jouer" : GOSUB Ajout_Liste916
IF Tour=0 AND PeutJouer=0 THEN Message$="Les noirs gagnent" : GOSUB Ajout_Liste916
IF Tour=1 AND PeutJouer=0 THEN Message$="Fin de partie, les noirs ne peuvent plus jouer" : GOSUB Ajout_Liste916
IF Tour=1 AND PeutJouer=0 THEN Message$="Les blancs gagnent" : GOSUB Ajout_Liste916

IF tour=0 AND PeutJouer <> 0
' Tour des blancs
IF damier%(Sposy,Sposx) = 1 OR damier%(Sposy,Sposx) = 9
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
IF damier%(Sposy,Sposx) = 1 THEN Message$=" le pion en "
IF damier%(Sposy,Sposx) = 9 THEN Message$=" la dame en "
Message$=Message$+CHR$(65+Sposx)+":"+CHR$(48+Sposy)
ON_CLICK 2, Clic2_Damier_blancs
ELSE
ON_CLICK 2, Clic_Damier
END_IF
ELSE
' Tour des noirs
IF PeutJouer<>0
IF damier%(Sposy,Sposx) = 2 OR damier%(Sposy,Sposx) = 8
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
IF damier%(Sposy,Sposx) = 2 THEN Message$=" le pion en "
IF damier%(Sposy,Sposx) = 8 THEN Message$=" la dame en "
Message$=Message$+CHR$(65+Sposx)+":"+CHR$(48+Sposy)
ON_CLICK 2, Clic2_Damier_noirs
ELSE
ON_CLICK 2, Clic_Damier
END_IF
END_IF
END_IF
IF PeutJouer=0 THEN GOSUB Fin
RETURN

Clic2_Damier_noirs:
OFF_CLICK 2
Nposx = INT(MOUSE_X_POSITION(2)/pas_case) : Nposy = INT(MOUSE_Y_POSITION(2)/pas_case)
IF NposX <> SposX OR NposY <> SposY
TempX=NposX: TempY=NposY : GOSUB Test_PeutJouer : NposX=TempX : NposY=TempY
Delta=abs(Sposx - Nposx):PeutPrendre=0:i%=0:Cpt=0:j%=(NposX - SposX)/Delta : k%=(NposY - SposY)/Delta
IF damier%(Nposy,Nposx) = 0 THEN i%=1
IF i%=1
IF NposY > SposY
IF (NposY - Delta) = SposY THEN i%=2
ELSE
IF (NposY + Delta) = SposY THEN i%=2
END_IF
END_IF
IF Delta = 1 AND SposY < NposY AND i%=2
PeutPrendre=1
ELSE
IF Delta = 2 AND i%=2
IF Damier%(SposY+k%,SposX+j%)=1 OR Damier%(SposY+k%,SposX+j%)=9 THEN PeutPrendre=1:Cpt=1:PionX=SposX+j%: PionY=SposY+k%
ELSE
IF Damier%(SposY,SposX)=8 AND i%=2
PeutPrendre=1
FOR i% = 1 TO Delta
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=1 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=9
IF Cpt=0
Cpt=1:PionX=SposX+(j%*i%): PionY=SposY+(k%*i%)
ELSE
PeutPrendre=0 : i%=Delta
END_IF
ELSE
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=2 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=8 THEN PeutPrendre=0 : i%=Delta
END_IF
NEXT i%
END_IF
END_IF
END_IF
IF PeutPrendre=1
IF Cpt=0
IF DoitPrendre=0
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
tour= 0 : 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30, 100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_TARGET_IS 2 : ON_CLICK 2, Clic_Damier
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les noirs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
ELSE
Message$="Irrégularité des noirs: vous devez prendre":GOSUB Ajout_Liste916
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic_Damier
END_IF
ELSE
IF Cpt=1
damier%(PionY,PionX)=0 : Nb_blancs = Nb_blancs - 1 : CAPTION 40,Nb_blancs
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE (PionX)*pas_case,(PionY)*pas_case,(PionX+1)*pas_case,(PionY+1)*pas_case
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les noirs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
IF Nb_blancs <=0
Message$="Il ne reste plus de pion blanc. Les noirs gagnent": GOSUB Ajout_Liste916
ELSE
GOSUB Test_PeutPrendre
IF PeutPrendre = 0
tour=0 : 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30, 100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_TARGET_IS 2 : ON_CLICK 2, Clic_Damier
ELSE
Sposx=Nposx : Sposy=Nposy
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic2_Damier_noirs
END_IF
END_IF
END_IF
END_IF
ELSE
IF damier%(Nposy,Nposx) = 2 or damier%(Nposy,Nposx) = 8
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=SposY:k%=SposX: GOSUB Dessine_piece
Sposx=Nposx : Sposy=Nposy : GOSUB Clic_Damier3
ELSE
ON_CLICK 2,Clic2_Damier_noirs
END_IF
END_IF
IF tour=0 AND Nposy=9 THEN IF damier%(Nposy,Nposx)=2 THEN j%=Nposy : k%= Nposx : damier%(j%,k%)=8 : GOSUB Dessine_piece
ELSE
ON_CLICK 2,Clic2_Damier_noirs
END_IF
IF Nb_blancs= 0 THEN GOSUB Fin
RETURN

Clic2_Damier_blancs:
OFF_CLICK 2
Nposx = INT(MOUSE_X_POSITION(2)/pas_case) : Nposy = INT(MOUSE_Y_POSITION(2)/pas_case)
IF NposX <> SposX OR NposY <> SposY
TempX=NposX: TempY=NposY : GOSUB Test_PeutJouer : NposX=TempX : NposY=TempY
Delta=abs(Sposx - Nposx):PeutPrendre=0:i%=0:Cpt=0:j%=(NposX - SposX)/Delta : k%=(NposY - SposY)/Delta
IF damier%(Nposy,Nposx) = 0 THEN i%=1
IF i%=1
IF NposY > SposY
IF (NposY - Delta) = SposY THEN i%=2
ELSE
IF (NposY + Delta) = SposY THEN i%=2
END_IF
END_IF
IF Delta = 1 AND SposY > NposY AND i%=2
PeutPrendre=1
ELSE
IF Delta = 2 AND i%=2
IF Damier%(SposY+k%,SposX+j%)=2 OR Damier%(SposY+k%,SposX+j%)=8 THEN PeutPrendre=1:Cpt=1:PionX=SposX+j%: PionY=SposY+k%
ELSE
IF Damier%(SposY,SposX)=9 AND i%=2
PeutPrendre=1
FOR i% = 1 TO Delta
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=2 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=8
IF Cpt=0
Cpt=1:PionX=SposX+(j%*i%): PionY=SposY+(k%*i%)
ELSE
PeutPrendre=0 : i%=Delta
END_IF
ELSE
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=1 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=9 THEN PeutPrendre=0 : i%=Delta
END_IF
NEXT i%
END_IF
END_IF
END_IF
IF PeutPrendre=1
IF Cpt=0
IF DoitPrendre=0
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
tour = 1 : 2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7 : 2D_TARGET_IS 2
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les blancs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
ON_CLICK 2, Clic_Damier
ELSE
Message$="Irrégularité des blancs: vous devez prendre":GOSUB Ajout_Liste916
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic_Damier
END_IF
ELSE
IF Cpt=1
damier%(PionY,PionX)=0 : Nb_Noirs = Nb_Noirs - 1 : CAPTION 41,Nb_noirs
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE (PionX)*pas_case,(PionY)*pas_case,(PionX+1)*pas_case,(PionY+1)*pas_case
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les blancs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
IF Nb_Noirs <=0
Message$="Il ne reste plus de pion noir. Les blancs gagnent":GOSUB Ajout_Liste916
ELSE
GOSUB Test_PeutPrendre
IF PeutPrendre = 0
tour = 1: 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7 : 2D_TARGET_IS 2
ON_CLICK 2, Clic_Damier
ELSE
Sposx=Nposx : Sposy=Nposy
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic2_Damier_blancs
END_IF
END_IF
END_IF
END_IF
ELSE
IF damier%(Nposy,Nposx) = 1 or damier%(Nposy,Nposx) = 9
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=SposY:k%=SposX: GOSUB Dessine_piece
Sposx=Nposx : Sposy=Nposy : GOSUB Clic_Damier3
ELSE
ON_CLICK 2,Clic2_Damier_blancs
END_IF
END_IF
IF tour=1 AND Nposy=0
IF damier%(Nposy,Nposx)=1
Message$="Nouvelle Dame blanche en "+CHR$(65+Nposx)+":"+CHR$(48+Nposy):GOSUB Ajout_Liste916
j%=Nposy : k%= Nposx : damier%(j%,k%)=9 : GOSUB Dessine_piece
END_IF
END_IF
ELSE
ON_CLICK 2,Clic2_Damier_blancs
END_IF
IF Nb_noirs=0 THEN GOSUB Fin
RETURN

Test_deplacement:
case%=0
IF damier%(Nposy,Nposx)=1 AND tour=0 THEN case%= 1
IF damier%(Nposy,Nposx)=2 AND tour=1 THEN case%= 2
IF damier%(Nposy,Nposx)=8 OR damier%(Nposy,Nposx)=9 THEN case%= 3

IF Nposx < 9 AND Nposy < 9
IF case%=2 OR case%=3
IF damier%(Nposy+1,Nposx+1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx < 9 AND Nposy > 0
IF case%=1 OR case%=3
IF damier%(Nposy-1,Nposx+1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx > 0 AND Nposy < 9
IF case%=2 OR case%=3
IF damier%(Nposy+1,Nposx-1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx > 1 AND Nposy > 1
IF case%=1 OR case%=3
IF damier%(Nposy-1,Nposx-1)=0 THEN PeutJouer = 1
END_IF
END_IF
RETURN

Test_PeutJouer:
case% = 0: PeutPrendre=0 : DoitPrendre = 0 : PeutJouer=0
FOR Nposy = 0 TO 9 : ' Correspond à la ligne (y)
FOR Nposx = 0 TO 9 : ' Correspond à la rangée (x)
IF case% = 0
case% = 1 : ' Case vide, on passe
ELSE
GOSUB Test_deplacement
IF tour=0 and damier%(Nposy,Nposx)=1 THEN GOSUB Test_PeutPrendre
IF tour=0 and damier%(Nposy,Nposx)=9 THEN GOSUB Test_PeutPrendre_Dame
IF tour=1 and damier%(Nposy,Nposx)=2 THEN GOSUB Test_PeutPrendre
IF tour=1 and damier%(Nposy,Nposx)=8 THEN GOSUB Test_PeutPrendre_Dame
IF PeutPrendre = 1 THEN DoitPrendre = 1:PeutJouer = 1
case% = 0
END_IF
NEXT NposX
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT NposY
RETURN

Test_PeutPrendre_dame:
PeutPrendre = 0: Delta = 0
IF tour=0 THEN j%=2 : k%=8
IF tour=1 THEN j%=1 : k%=9

IF Nposx < 8 AND Nposy < 8
IF Nposx > Nposy THEN Delta = 8-Nposx :ELSE : Delta = 8-Nposy
FOR i% = 1 TO Delta
IF (damier%(Nposy+i%,Nposx+i%)=j% OR damier%(Nposy+i%,Nposx+i%)=k%) AND damier%(Nposy+i%+1,Nposx+i%+1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF

IF Nposx < 8 AND Nposy > 1
IF Nposy >= (8-Nposx) THEN Delta= 8-Nposx : ELSE : Delta = Nposy-1
FOR i% = 1 TO Delta
IF (damier%(Nposy-i%,Nposx+i%)=j% OR damier%(Nposy-i%,Nposx+i%)=k%) AND damier%(Nposy-i%-1,Nposx+i%+1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF

IF Nposx > 1 AND Nposy < 8
IF ((8-Nposy) > (Nposx-1)) THEN Delta= Nposx -1: ELSE : Delta = 8-Nposy
FOR i% = 1 TO Delta
IF damier%(Nposy+i%,Nposx-i%)=j% OR damier%(Nposy+i%,Nposx-i%)=k%
IF damier%(Nposy+i%+1,Nposx-i%-1)= 0 THEN PeutPrendre = 1
END_IF
NEXT i%
END_IF

IF Nposx > 1 AND Nposy > 1
IF Nposx > Nposy THEN Delta= Nposy-1: ELSE : Delta = Nposx-1
FOR i% = 1 TO Delta
IF (damier%(Nposy-i%,Nposx-i%)=j% OR damier%(Nposy-i%,Nposx-i%)=k%) AND damier%(Nposy-i%-1,Nposx-i%-1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF
RETURN

Test_PeutPrendre:
PeutPrendre = 0
IF tour=0 THEN j%=2 : k%=8
IF tour=1 THEN j%=1 : k%=9
IF Nposx < 8 AND Nposy < 8
IF (damier%(Nposy+1,Nposx+1)=j% OR damier%(Nposy+1,Nposx+1)=k%) AND damier%(Nposy+2,Nposx+2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx < 8 AND Nposy > 1
IF (damier%(Nposy-1,Nposx+1)=j% OR damier%(Nposy-1,Nposx+1)=k%) AND damier%(Nposy-2,Nposx+2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx > 1 AND Nposy < 8
IF (damier%(Nposy+1,Nposx-1)=j% OR damier%(Nposy+1,Nposx-1)=k%) AND damier%(Nposy+2,Nposx-2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx > 1 AND Nposy > 1
IF (damier%(Nposy-1,Nposx-1)=j% OR damier%(Nposy-1,Nposx-1)=k%) AND damier%(Nposy-2,Nposx-2)= 0 THEN PeutPrendre = 1
END_IF
RETURN

Fin:
case%=MESSAGE_CONFIRMATION_YES_NO("Voulez vous faire une nouvelle partie ?")
IF case%=1 THEN GOSUB Relance
IF case%=0 THEN GOSUB Fin
Terminate

Damier_Bleu_Blanc:
CAPTION 30,"X Damier Bleu foncé/Blanc": CAPTION 31," Damier Gris/Blanc"
CAPTION 32," Damier Vert foncé/Blanc": CAPTION 33," Damier Violet/Blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 30 : CCV = 30 : CCB = 180
GOSUB Dessine_damier
RETURN

Damier_Gris_Blanc:
CAPTION 30," Damier Bleu foncé/Blanc": CAPTION 31,"X Damier Gris/blanc"
CAPTION 32," Damier Vert foncé/Blanc": CAPTION 33," Damier Violet/blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 160 : CCV = 160 : CCB = 160
GOSUB Dessine_damier
RETURN

Damier_Vert_Blanc:
CAPTION 30," Damier Bleu foncé/Blanc": CAPTION 31," Damier Gris/blanc"
CAPTION 32,"X Damier Vert foncé/Blanc": CAPTION 33," Damier Violet/Blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 130 : CCV = 190 : CCB = 130
GOSUB Dessine_damier
RETURN

Damier_Violet_Blanc:
CAPTION 30," Damier Bleu foncé/blanc": CAPTION 31," Damier Gris/blanc"
CAPTION 32," Damier Vert foncé/blanc": CAPTION 33,"X Damier Violet/blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 200 : CCV = 60 : CCB = 200
GOSUB Dessine_damier
RETURN

Init:
COLOR 0,180,100,60
LABEL Aide,Regle,Faide, Fregle, Quitter, Clic_Damier, Clic2_Damier_blancs, Clic_Damier3, Clic2_Damier_noirs, Dessine_Damier, Dessine_piece
LABEL Test_PeutPrendre, Test_PeutPrendre_dame, Relance, Test_PeutJouer, Test_deplacement, Fin, Ajout_Liste916
LABEL Damier_Bleu_Blanc, Damier_Gris_Blanc, Damier_Vert_Blanc, Damier_Violet_Blanc
DIM x_Max, y_Max : x_Max=1000 : y_max=700
DIM Marge_x, Marge_y : Marge_x = 40 : Marge_y = 30
DIM hlp$,regle$,h%,i%,j%,k%,case%,tour,PeutPrendre,PeutJouer,DoitPrendre, Message$
DIM Delta, Cpt, PionX, PionY, TempX, TempY, taille_max_liste: taille_max_liste = 20
DIM damier%(10,10) : ' 0: Case vide, 1: Pion du joueur, 9: Dame du joueur, 2: Pion de l'Ai, 8: Dame de l'Ai
DIM Sposx, Sposy : ' Position du pion sélectionné
DIM Nposx, Nposy : ' Position de la destination sélectionné
DIM pas_case : if (y_Max - 2* Marge_y) > (x_Max - 2 * Marge_x) Then pas_case= (x_Max - 2 * Marge_x) / 11 : else: pas_case= (y_Max - 2 * Marge_y) / 11
DIM rc$ : rc$=CHR$(10)
DIM Nb_Noirs,Nb_blancs : ' Nombre de pions noirs et blancs
DIM r%: r% = pas_case/2 -1
DIM CBR,CBV,CBB, CNR, CNV, CNB
CBR = 205 : CBV = 205: CBB = 205 : ' Couleurs des pions blancs
CNR = 55 : CNV = 55 : CNB = 55 : ' Couleurs des pions noirs
DIM CDR,CDV,CDB,CCR,CCV,CCB
CDR = 255 : CDV = 255: CDB = 255 : ' Couleurs des cases 'blanches'
CCR = 30 : CCV = 30 : CCB = 180 : ' Couleurs des cases 'noires'
CAPTION 0, "Jeu de dames en Basic Panoramic par Jean-Charles"
WIDTH 0,x_Max : HEIGHT 0, y_max

' Création de l'image support pour le damier
PICTURE 2 : WIDTH 2, 10 * pas_case : HEIGHT 2, 10 * pas_case : TOP 2,Marge_y: LEFT 2, Marge_x

' Menu Principal
MAIN_MENU 1 : REM On reserve les objets 1 à 30 pour le menu
SUB_MENU 11: PARENT 11, 1: CAPTION 11, "Fichier"
SUB_MENU 12: PARENT 12, 1: CAPTION 12, "Options"
SUB_MENU 16: PARENT 16, 1: CAPTION 16, "Aide"
SUB_MENU 17: PARENT 17, 1: CAPTION 17, "Règle"
ON_CLICK 16, Aide : ON_CLICK 17, Regle

' Sous menu Fichier
SUB_MENU 25: CAPTION 25,"Relancer partie" : PARENT 25, 11
SUB_MENU 26: CAPTION 26,"Quitter" : PARENT 26, 11
ON_CLICK 25, Relance :ON_CLICK 26, Quitter

' Sous menu Options
SUB_MENU 30: CAPTION 30,"X Damier Bleu foncé/blanc" : PARENT 30, 12
SUB_MENU 31: CAPTION 31," Damier Gris/blanc" : PARENT 31, 12
SUB_MENU 32: CAPTION 32," Damier Vert foncé/blanc" : PARENT 32, 12
SUB_MENU 33: CAPTION 33," Damier Violet/blanc" : PARENT 33, 12
ON_CLICK 30, Damier_Bleu_Blanc :ON_CLICK 31, Damier_Gris_Blanc
ON_CLICK 32, Damier_Vert_Blanc :ON_CLICK 33, Damier_Violet_Blanc

' Préparation de l'aide
hlp$=CHR$(9)+CHR$(9)+CHR$(9)+" - AIDE DU JEU DE DAMES -"+rc$
hlp$=hlp$+CHR$(9)+CHR$(9)+CHR$(9)+" ==============================="+rc$+rc$
hlp$=hlp$+"A remplir"+rc$
FORM 900: TOP 900,2*Marge_y: LEFT 900,3*Marge_X: WIDTH 900,x_Max-6*Marge_X: HEIGHT 900,y_Max-4*Marge_y: HIDE 900
FONT_SIZE 900,10
LIST 901: PARENT 901,900: WIDTH 901,WIDTH(900)-16: HEIGHT 901,HEIGHT(900)-80
k% = INSTR(hlp$, rc$)
WHILE k% > 0
ITEM_ADD 901, LEFT$(hlp$, k%-1): hlp$ = MID$(hlp$, k%+1, 9000)
k% = INSTR(hlp$, rc$)
END_WHILE
BUTTON 902: PARENT 902,900: TOP 902,HEIGHT(900)-70: LEFT 902,280: CAPTION 902,"OK"
ON_CLICK 902, Faide

regle$=CHR$(9)+CHR$(9)+CHR$(9)+" - REGLES DU JEU DE DAMES -"+rc$
regle$=regle$+CHR$(9)+CHR$(9)+CHR$(9)+" ==============================="+rc$+rc$
rem regle$=regle$+""+rc$ : ' Modèle d'une ligne vide
regle$=regle$+"Le jeu de dames international se joue sur un damier carré divisé en 100 cases égales, alternativement claires et foncées."+rc$
regle$=regle$+"Le jeu se joue sur les cases foncées du damier. Il y a donc 50 cases actives."+rc$
regle$=regle$+"La plus longue diagonale, joignant deux coins du damier et comprenant 10 cases foncées, se dénomme la grande diagonale."+rc$
regle$=regle$+"Le damier doit être placé de sorte que la première case de gauche, pour chaque joueur, soit une case foncée."+rc$
regle$=regle$+"Le jeu de dames international se joue avec 20 pions blancs (clairs) et 20 pions noirs (foncés)"+rc$
regle$=regle$+"Avant de débuter une partie, les 20 pions noirs et les 20 pions blancs sont disposés sur les 4 premières rangées de chaque joueur."+rc$
regle$=regle$+"Il faut manger tous les pions de l'autre en passant par dessus avec l'un de vos pions."+rc$
regle$=regle$+"Les déplacements autoriser : seulement d'une case en avant, en diagonale si celle ci est libre."+rc$
regle$=regle$+"Le premier coup est toujours joué par les blancs. Les adversaires jouent un coup chacun à tour de rôle avec leurs pièces."+rc$
regle$=regle$+"Pour cela, on couronne le pion en plaçant dessus un deuxième pion de la même couleur."+rc$
regle$=regle$+"Il est interdit de reculer en dehors des prises"+rc$
regle$=regle$+"Si un pion avance jusqu'à la dernière rangée, il devient une Dame."+rc$
regle$=regle$+"La dame peut se déplacer de plusieurs cases en avant ou en arrière si ces cases sont vides."+rc$
regle$=regle$+"La prise des pièces adverse est obligatoire et s’effectue aussi bien en avant qu’en arrière."+rc$
regle$=regle$+"Lorsqu’un pion se trouve en présence, diagonalement, d’une pièce adverse derrière laquelle se trouve une case libre, il doit"+rc$
regle$=regle$+"obligatoirement sauter par-dessus cette pièce et occuper la case libre. Cette pièce adverse est alors enlevée du damier."+rc$
regle$=regle$+"Cette opération complète est la prise par un pion."+rc$
regle$=regle$+"Lorsqu’au cours d’une prise par un pion, celui-ci se trouve à nouveau en présence, diagonalement, d’une pièce adverse derrière "+rc$
regle$=regle$+"laquelle se trouve une case libre, il doit obligatoirement sauter par-dessus cette seconde pièce, voire d’une troisième et"+rc$
regle$=regle$+"ainsi de suite, et occuper la case libre se trouvant derrière la dernière pièce capturée. Les pièces adverses ainsi capturées"+rc$
regle$=regle$+"sont ensuite enlevées du damier dans l’ordre de la prise."+rc$
regle$=regle$+"Cette opération complète est une rafle par un pion."+rc$
regle$=regle$+"Lorsqu’au cours d’une prise par une dame, celle-ci se trouve à nouveau en présence, sur une même diagonale, d’une pièce adverse"+rc$
regle$=regle$+"derrière laquelle se trouve une ou plusieurs cases libres, elle doit obligatoirement sauter par-dessus cette seconde pièce, voire"+rc$
regle$=regle$+"d’une troisième et ainsi de suite, et occuper au choix une case libre se trouvant derrière et sur la même diagonale que la dernière"+rc$
regle$=regle$+"pièce capturée. Les pièces adverses ainsi capturées sont ensuite enlevées du damier dans l’ordre de la prise."+rc$
regle$=regle$+"Cette opération complète est une rafle par une dame."+rc$
regle$=regle$+"Au cours d’une rafle, il est interdit de passer au-dessus de ses propres pièces."+rc$
regle$=regle$+"Au cours d’une rafle, il est permis de passer plusieurs fois sur une même case libre mais il est interdit de passer plus d’une fois "+rc$
regle$=regle$+"au-dessus d’une même pièce adverse."+rc$
regle$=regle$+"Une rafle doit être clairement indiquée, pièce par pièce, en posant la pièce preneuse sur la case de saut, le temps d’y passer, et"+rc$
regle$=regle$+"en déposant cette pièce sur la case terminale."+rc$
regle$=regle$+"Les pièces prises ne peuvent être enlevées du damier qu’à l’issue de l’exécution complète de la rafle."+rc$
regle$=regle$+"La prise du plus grand nombre de pièces est prioritaire, donc obligatoire. Dans ce cas, une dame compte pour une pièce, tout comme un pion."+rc$
regle$=regle$+"Elle ne confère nulle priorité et n’impose aucune obligation."+rc$
regle$=regle$+"Si les pièces à prendre sont en nombre égal dans deux ou plusieurs possibilités de prise ou de rafle, le joueur est libre de choisir "+rc$
regle$=regle$+"une de ces possibilités, soit avec un pion, soit avec une dame."+rc$
regle$=regle$+"Un pion qui au cours d’une rafle, ne fait que passer sur une des 5 cases de la rangée de base adverse reste un pion lorsque la rafle est terminée."+rc$

FORM 910: TOP 910,2*Marge_y: LEFT 910,3*Marge_X: WIDTH 910,x_Max-6*Marge_X: HEIGHT 910,y_Max-4*Marge_y: HIDE 910
FONT_SIZE 910,10
LIST 911: PARENT 911,910: WIDTH 911,WIDTH(910)-16: HEIGHT 911,HEIGHT(910)-80
k% = INSTR(regle$, rc$)
WHILE k% > 0
ITEM_ADD 911, LEFT$(regle$, k%-1): regle$ = MID$(regle$, k%+1, 9000)
k% = INSTR(regle$, rc$)
END_WHILE
BUTTON 912: PARENT 912,910: TOP 912,HEIGHT(910)-70: LEFT 912,280: CAPTION 912,"OK"
ON_CLICK 912, Fregle

' Creation des compteurs de pions
ALPHA 40 : LEFT 40,Marge_X + 12* pas_case : TOP 40,pas_case - 15: WIDTH 40, 40 : FONT_SIZE 40,20
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE 11.5*pas_case+r%,0.5*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE 11.5*pas_case+r%,0.5*pas_case+r%,r% - 7
ALPHA 41 : LEFT 41,5*Marge_X + 12* pas_case : TOP 41,pas_case - 15: WIDTH 41, 40 : FONT_SIZE 41,20
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE 11.5*pas_case+r%+4*Marge_X,0.5*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE 11.5*pas_case+r%+4*Marge_X,0.5*pas_case+r%,r% - 7
LIST 916 : TOP 916,pas_case+r%+Marge_Y : HEIGHT 916,HEIGHT(0) - (pas_case+r%+4*Marge_Y): FONT_SIZE 916,10
LEFT 916,10*pas_case+Marge_X+20 : WIDTH 916,WIDTH(0) - (10.5*pas_case+r%+Marge_X)
FOR k% = 0 TO 9
i% = 50+k% : ALPHA i%: TOP i%,Marge_Y-32 : WIDTH i%,20 : LEFT i%, (k%+0.5)*pas_case + 30 : FONT_SIZE i%,20 : CAPTION i%,CHR$(65+k%)
i% = 60+k% : ALPHA i%: TOP i%,Marge_Y-20 + (k%+0.5)*pas_case : WIDTH i%,20 : LEFT i%, 10 : FONT_SIZE i%,20 : CAPTION i%,CHR$(48+k%)
NEXT k%

Relance:
' INITIALISATION DES PIONS SUR LE DAMIER
' PIONS DE L'AI
case% = 0
FOR j% = 0 TO 3
FOR k% = 0 TO 9
IF case% = 0 THEN case% = 1 : ELSE : damier%(j%,k%)= 2 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
' CASES VIDES
FOR j% = 4 TO 5
FOR k% = 0 TO 9
damier%(j%,k%)= 0
NEXT k%
NEXT j%
' PIONS DU JOUEUR
case% = 0
FOR j% = 6 TO 9
FOR k% = 0 TO 9
IF case% = 0 THEN case% = 1 : ELSE : damier%(j%,k%)= 1 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%

Nb_Noirs = 20 : Nb_blancs = 20 :CAPTION 40,Nb_blancs : CAPTION 41,Nb_noirs

tour=0 : ' Les blancs commencent
2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
CLEAR 916: Message$="Les pions blancs commencent": ITEM_ADD 916, Message$

' Représentation du Damier
GOSUB Dessine_Damier
ON_CLICK 2, Clic_Damier

END

Salut Jicehel.

Le jeu des dames avance et c’est bien.
J’ai testé.
J’ai aussi modifié la ligne 477 comme ceci :

Code:: CCR = 150 : CCV = 150 : CCB = 50 : ' Couleurs des cases 'noires'

Avant de remarquer que le menu ‘Options’ propose de choisir entre plusieurs damiers.

J’ai trouvé un bug tout de même au niveau du sous-programme Fin:
Après avoir terminé une partie, le message ‘ Voulez-vous faire une nouvelle partie’ : si on clique sur ‘yes’, tout semble correct (un nouveau damier est dessiné) mais dès qu’on clique sur un pion pour commencer, le message s’affiche de nouveau et on ne peut sortir qu’en cliquant sur ‘no’

Il arrive également que la dame « se contente » parfois d’une seule prise de pion alors qu’une rafle est possible !

Ce cas se présente lorsque la dame saute sur un pion et vient se placer non pas sur la case libre immédiatement qui suit le pion mais quelques cases plus loin et cette position lui permet de prendre un ou plusieurs autres pions !
Je ne sais pas si ma dernière phrase était compréhensible !

Bonne continuation.

lol!

Bonjour Jicehel, Smile

On a toujours un message d'erreur "Nan is not a floating point value!". J'ai remarqué qu cela était quand tu cliques sur une mauvaise case mais dans la colonne devant ou derrière le pion sélectionné. Donc il faut que tu voyes si c'est bien ça qui cause le bug!
Mais j'adore, ça commence à être jouable!
A+ et bon courage. Wink

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Jicehel, j'ai hâte de confronter ma bêtise naturelle à ton intelligence artificielle !

Merci pour vos commentaires, tests et encouragements.
Dès que le moteur 'de base' fonctionnera bien je m'attaquerais à l'IA, mais bon d'abord il faut que les dames prennent quand il faut et que la fin termine le jeu et autres trucs du genre Wink

Merci beaucoup pour vos descriptions précises, ça va m'aider dans le debuggage
Tu as raison sinon Bignono, je n'avais pas pensé à tester le clic sur les cases blanches .... Bien vu

Bon, avant que les invités n'arrivent, j'ai corrigé le problème de la fin de partie (enfin, je pense) et le problème des cases blanches est réglé (là, j'en suis sûr) - dès que j'ai un peu de temps, je regarde le problème de la prise multiple des dames (rafle_dame)

Code:: REM Jeu de dames par Jean-Charles
REM V0.6 du 27/05/2011
REM Programmation en cours - le jeu à 2 joueurs devrait être OK
REM Reste à faire l'AI s'il n'y a plus de bug
REM Reste à corriger le bug de la prise de la dame en cas de rafle

LABEL Init: application_title "Jeu de dames":GOTO Init

Aide:
SHOW 900
RETURN

Faide:
HIDE 900
RETURN

Regle:
SHOW 910
RETURN

Fregle:
HIDE 910
RETURN

Quitter:
TERMINATE
RETURN

Ajout_Liste916:
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916, Message$
RETURN

Dessine_Damier:
2D_TARGET_IS 2
2D_PEN_COLOR 40,40,40: 2D_RECTANGLE 0,0,WIDTH(2),HEIGHT(2)
case% = 0
FOR j% = 0 TO 9
FOR k% = 0 TO 9
IF case% = 0
2D_FILL_COLOR CDR,CDV,CDB
case% = 1
ELSE
2D_FILL_COLOR CCR,CCV,CCB
case% = 0
END_IF
2D_RECTANGLE k%*pas_case,j%*pas_case,(k%+1)*pas_case,(j%+1)*pas_case
IF damier%(j%,k%) > 0 THEN GOSUB Dessine_piece
2D_PEN_COLOR 40,40,40
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
RETURN

Dessine_piece:
SELECT damier%(j%,k%)
CASE 0: ' NORMALEMENT ON NE LE FAIT JAMAIS
CASE 1: ' PION BLANC
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
CASE 2: ' PION NOIR
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
CASE 9: ' DAME BLANCHE
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case-3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%-6,r% - 7 : 2D_PEN_WIDTH 3
CASE 8: ' DAME NOIRE
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case-3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%-6,r% - 7 : 2D_PEN_WIDTH 3
END_SELECT
RETURN

Clic_Damier:
Sposx = INT(MOUSE_X_POSITION(2)/pas_case) : Sposy = INT(MOUSE_Y_POSITION(2)/pas_case)

Clic_Damier3:
OFF_CLICK 2
GOSUB Test_PeutJouer
IF Tour=0 AND PeutJouer=0 THEN Message$="Fin de partie, les blancs ne peuvent plus jouer" : GOSUB Ajout_Liste916
IF Tour=0 AND PeutJouer=0 THEN Message$="Les noirs gagnent" : GOSUB Ajout_Liste916
IF Tour=1 AND PeutJouer=0 THEN Message$="Fin de partie, les noirs ne peuvent plus jouer" : GOSUB Ajout_Liste916
IF Tour=1 AND PeutJouer=0 THEN Message$="Les blancs gagnent" : GOSUB Ajout_Liste916
IF tour=0 AND PeutJouer <> 0
' Tour des blancs
IF damier%(Sposy,Sposx) = 1 OR damier%(Sposy,Sposx) = 9
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
IF damier%(Sposy,Sposx) = 1 THEN Message$=" le pion en "
IF damier%(Sposy,Sposx) = 9 THEN Message$=" la dame en "
Message$=Message$+CHR$(65+Sposx)+":"+CHR$(48+Sposy)
ON_CLICK 2, Clic2_Damier_blancs
ELSE
ON_CLICK 2, Clic_Damier
END_IF
ELSE
' Tour des noirs
IF PeutJouer<>0
IF damier%(Sposy,Sposx) = 2 OR damier%(Sposy,Sposx) = 8
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
IF damier%(Sposy,Sposx) = 2 THEN Message$=" le pion en "
IF damier%(Sposy,Sposx) = 8 THEN Message$=" la dame en "
Message$=Message$+CHR$(65+Sposx)+":"+CHR$(48+Sposy)
ON_CLICK 2, Clic2_Damier_noirs
ELSE
ON_CLICK 2, Clic_Damier
END_IF
ELSE
GOTO Fin
END_IF
END_IF
RETURN

Clic2_Damier_noirs:
Nposx = INT(MOUSE_X_POSITION(2)/pas_case) : Nposy = INT(MOUSE_Y_POSITION(2)/pas_case)
OFF_CLICK 2
IF (NposX <> SposX OR NposY <> SposY) AND Damier%(NposY,NposX) >= 0
TempX=NposX: TempY=NposY : GOSUB Test_PeutJouer : NposX=TempX : NposY=TempY
Delta=abs(Sposx - Nposx):PeutPrendre=0:i%=0:Cpt=0:j%=(NposX - SposX)/Delta : k%=(NposY - SposY)/Delta
IF damier%(Nposy,Nposx) = 0 THEN i%=1
IF i%=1
IF NposY > SposY
IF (NposY - Delta) = SposY THEN i%=2
ELSE
IF (NposY + Delta) = SposY THEN i%=2
END_IF
END_IF
IF Delta = 1 AND SposY < NposY AND i%=2
PeutPrendre=1
ELSE
IF Delta = 2 AND i%=2
IF Damier%(SposY+k%,SposX+j%)=1 OR Damier%(SposY+k%,SposX+j%)=9 THEN PeutPrendre=1:Cpt=1:PionX=SposX+j%: PionY=SposY+k%
ELSE
IF Damier%(SposY,SposX)=8 AND i%=2
PeutPrendre=1
FOR i% = 1 TO Delta
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=1 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=9
IF Cpt=0
Cpt=1:PionX=SposX+(j%*i%): PionY=SposY+(k%*i%)
ELSE
PeutPrendre=0 : i%=Delta
END_IF
ELSE
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=2 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=8 THEN PeutPrendre=0 : i%=Delta
END_IF
NEXT i%
END_IF
END_IF
END_IF
IF PeutPrendre=1
IF Cpt=0
IF DoitPrendre=0
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
tour= 0 : 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30, 100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_TARGET_IS 2 : ON_CLICK 2, Clic_Damier
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les noirs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
ELSE
Message$="Irrégularité des noirs: vous devez prendre":GOSUB Ajout_Liste916
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic_Damier
END_IF
ELSE
IF Cpt=1
damier%(PionY,PionX)=0 : Nb_blancs = Nb_blancs - 1 : CAPTION 40,Nb_blancs
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE (PionX)*pas_case,(PionY)*pas_case,(PionX+1)*pas_case,(PionY+1)*pas_case
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les noirs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
IF Nb_blancs <=0
Message$="Il ne reste plus de pion blanc. Les noirs gagnent": GOSUB Ajout_Liste916
ELSE
GOSUB Test_PeutPrendre
IF PeutPrendre = 0
tour=0 : 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30, 100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_TARGET_IS 2 : ON_CLICK 2, Clic_Damier
ELSE
Sposx=Nposx : Sposy=Nposy
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic2_Damier_noirs
END_IF
END_IF
END_IF
END_IF
ELSE
IF damier%(Nposy,Nposx) = 2 or damier%(Nposy,Nposx) = 8
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=SposY:k%=SposX: GOSUB Dessine_piece
Sposx=Nposx : Sposy=Nposy : GOSUB Clic_Damier3
ELSE
ON_CLICK 2,Clic2_Damier_noirs
END_IF
END_IF
IF tour=0 AND Nposy=9 THEN IF damier%(Nposy,Nposx)=2 THEN j%=Nposy : k%= Nposx : damier%(j%,k%)=8 : GOSUB Dessine_piece
ELSE
ON_CLICK 2,Clic2_Damier_noirs
END_IF
IF Nb_blancs= 0 THEN GOTO Fin
RETURN

Clic2_Damier_blancs:
Nposx = INT(MOUSE_X_POSITION(2)/pas_case) : Nposy = INT(MOUSE_Y_POSITION(2)/pas_case)
OFF_CLICK 2
IF (NposX <> SposX OR NposY <> SposY) AND Damier%(NposY,NposX) >= 0
TempX=NposX: TempY=NposY : GOSUB Test_PeutJouer : NposX=TempX : NposY=TempY
Delta=abs(Sposx - Nposx):PeutPrendre=0:i%=0:Cpt=0:j%=(NposX - SposX)/Delta : k%=(NposY - SposY)/Delta
IF damier%(Nposy,Nposx) = 0 THEN i%=1
IF i%=1
IF NposY > SposY
IF (NposY - Delta) = SposY THEN i%=2
ELSE
IF (NposY + Delta) = SposY THEN i%=2
END_IF
END_IF
IF Delta = 1 AND SposY > NposY AND i%=2
PeutPrendre=1
ELSE
IF Delta = 2 AND i%=2
IF Damier%(SposY+k%,SposX+j%)=2 OR Damier%(SposY+k%,SposX+j%)=8 THEN PeutPrendre=1:Cpt=1:PionX=SposX+j%: PionY=SposY+k%
ELSE
IF Damier%(SposY,SposX)=9 AND i%=2
PeutPrendre=1
FOR i% = 1 TO Delta
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=2 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=8
IF Cpt=0
Cpt=1:PionX=SposX+(j%*i%): PionY=SposY+(k%*i%)
ELSE
PeutPrendre=0 : i%=Delta
END_IF
ELSE
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=1 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=9 THEN PeutPrendre=0 : i%=Delta
END_IF
NEXT i%
END_IF
END_IF
END_IF
IF PeutPrendre=1
IF Cpt=0
IF DoitPrendre=0
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
tour = 1 : 2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7 : 2D_TARGET_IS 2
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les blancs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
ON_CLICK 2, Clic_Damier
ELSE
Message$="Irrégularité des blancs: vous devez prendre":GOSUB Ajout_Liste916
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic_Damier
END_IF
ELSE
IF Cpt=1
damier%(PionY,PionX)=0 : Nb_Noirs = Nb_Noirs - 1 : CAPTION 41,Nb_noirs
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE (PionX)*pas_case,(PionY)*pas_case,(PionX+1)*pas_case,(PionY+1)*pas_case
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les blancs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
IF Nb_Noirs <=0
Message$="Il ne reste plus de pion noir. Les blancs gagnent":GOSUB Ajout_Liste916
ELSE
GOSUB Test_PeutPrendre
IF PeutPrendre = 0
tour = 1: 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7 : 2D_TARGET_IS 2
ON_CLICK 2, Clic_Damier
ELSE
Sposx=Nposx : Sposy=Nposy
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic2_Damier_blancs
END_IF
END_IF
END_IF
END_IF
ELSE
IF damier%(Nposy,Nposx) = 1 or damier%(Nposy,Nposx) = 9
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=SposY:k%=SposX: GOSUB Dessine_piece
Sposx=Nposx : Sposy=Nposy : GOSUB Clic_Damier3
ELSE
ON_CLICK 2,Clic2_Damier_blancs
END_IF
END_IF
IF tour=1 AND Nposy=0
IF damier%(Nposy,Nposx)=1
Message$="Nouvelle Dame blanche en "+CHR$(65+Nposx)+":"+CHR$(48+Nposy):GOSUB Ajout_Liste916
j%=Nposy : k%= Nposx : damier%(j%,k%)=9 : GOSUB Dessine_piece
END_IF
END_IF
ELSE
ON_CLICK 2,Clic2_Damier_blancs
END_IF
IF Nb_noirs=0 THEN GOTO Fin
RETURN

Test_deplacement:
cas%=0
IF damier%(Nposy,Nposx)=1 AND tour=0 THEN cas%= 1
IF damier%(Nposy,Nposx)=2 AND tour=1 THEN cas%= 2
IF damier%(Nposy,Nposx)=8 OR damier%(Nposy,Nposx)=9 THEN cas%= 3
IF cas% > 0
IF Nposx < 9 AND Nposy < 9
IF cas%=2 OR cas%=3
IF damier%(Nposy+1,Nposx+1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx < 9 AND Nposy > 0
IF cas%=1 OR cas%=3
IF damier%(Nposy-1,Nposx+1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx > 0 AND Nposy < 9
IF cas%=2 OR cas%=3
IF damier%(Nposy+1,Nposx-1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx > 1 AND Nposy > 1
IF cas%=1 OR cas%=3
IF damier%(Nposy-1,Nposx-1)=0 THEN PeutJouer = 1
END_IF
END_IF
END_IF
RETURN

Test_PeutJouer:
case% = 0: PeutPrendre=0 : DoitPrendre = 0 : PeutJouer=0
FOR Nposy = 0 TO 9 : ' Correspond à la ligne (y)
FOR Nposx = 0 TO 9 : ' Correspond à la rangée (x)
IF case% = 0
case% = 1 : ' Case vide, on passe
ELSE
GOSUB Test_deplacement
IF tour=0 and damier%(Nposy,Nposx)=1 THEN GOSUB Test_PeutPrendre
IF tour=0 and damier%(Nposy,Nposx)=9 THEN GOSUB Test_PeutPrendre_Dame
IF tour=1 and damier%(Nposy,Nposx)=2 THEN GOSUB Test_PeutPrendre
IF tour=1 and damier%(Nposy,Nposx)=8 THEN GOSUB Test_PeutPrendre_Dame
IF PeutPrendre = 1 THEN DoitPrendre = 1:PeutJouer = 1
IF PeutJouer = 1 THEN h%=1
case% = 0
END_IF
NEXT NposX
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT NposY
IF h%=1 THEN PeutJouer=1
RETURN

Test_PeutPrendre_dame:
PeutPrendre = 0: Delta = 0
IF tour=0 THEN j%=2 : k%=8
IF tour=1 THEN j%=1 : k%=9

IF Nposx < 8 AND Nposy < 8
IF Nposx > Nposy THEN Delta = 8-Nposx :ELSE : Delta = 8-Nposy
FOR i% = 1 TO Delta
IF (damier%(Nposy+i%,Nposx+i%)=j% OR damier%(Nposy+i%,Nposx+i%)=k%) AND damier%(Nposy+i%+1,Nposx+i%+1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF

IF Nposx < 8 AND Nposy > 1
IF Nposy >= (8-Nposx) THEN Delta= 8-Nposx : ELSE : Delta = Nposy-1
FOR i% = 1 TO Delta
IF (damier%(Nposy-i%,Nposx+i%)=j% OR damier%(Nposy-i%,Nposx+i%)=k%) AND damier%(Nposy-i%-1,Nposx+i%+1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF

IF Nposx > 1 AND Nposy < 8
IF ((8-Nposy) > (Nposx-1)) THEN Delta= Nposx -1: ELSE : Delta = 8-Nposy
FOR i% = 1 TO Delta
IF damier%(Nposy+i%,Nposx-i%)=j% OR damier%(Nposy+i%,Nposx-i%)=k%
IF damier%(Nposy+i%+1,Nposx-i%-1)= 0 THEN PeutPrendre = 1
END_IF
NEXT i%
END_IF

IF Nposx > 1 AND Nposy > 1
IF Nposx > Nposy THEN Delta= Nposy-1: ELSE : Delta = Nposx-1
FOR i% = 1 TO Delta
IF (damier%(Nposy-i%,Nposx-i%)=j% OR damier%(Nposy-i%,Nposx-i%)=k%) AND damier%(Nposy-i%-1,Nposx-i%-1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF
RETURN

Test_PeutPrendre:
PeutPrendre = 0
IF tour=0 THEN j%=2 : k%=8
IF tour=1 THEN j%=1 : k%=9
IF Nposx < 8 AND Nposy < 8
IF (damier%(Nposy+1,Nposx+1)=j% OR damier%(Nposy+1,Nposx+1)=k%) AND damier%(Nposy+2,Nposx+2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx < 8 AND Nposy > 1
IF (damier%(Nposy-1,Nposx+1)=j% OR damier%(Nposy-1,Nposx+1)=k%) AND damier%(Nposy-2,Nposx+2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx > 1 AND Nposy < 8
IF (damier%(Nposy+1,Nposx-1)=j% OR damier%(Nposy+1,Nposx-1)=k%) AND damier%(Nposy+2,Nposx-2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx > 1 AND Nposy > 1
IF (damier%(Nposy-1,Nposx-1)=j% OR damier%(Nposy-1,Nposx-1)=k%) AND damier%(Nposy-2,Nposx-2)= 0 THEN PeutPrendre = 1
END_IF
RETURN

Fin:
case%=MESSAGE_CONFIRMATION_YES_NO("Voulez vous faire une nouvelle partie ?")
IF case%=1 THEN GOSUB Relance
IF case%=0 THEN GOTO Fin
Terminate

Damier_Bleu_Blanc:
CAPTION 30,"X Damier Bleu foncé/Blanc": CAPTION 31," Damier Gris/Blanc"
CAPTION 32," Damier Vert foncé/Blanc": CAPTION 33," Damier Violet/Blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 30 : CCV = 30 : CCB = 180
GOSUB Dessine_damier
RETURN

Damier_Gris_Blanc:
CAPTION 30," Damier Bleu foncé/Blanc": CAPTION 31,"X Damier Gris/blanc"
CAPTION 32," Damier Vert foncé/Blanc": CAPTION 33," Damier Violet/blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 160 : CCV = 160 : CCB = 160
GOSUB Dessine_damier
RETURN

Damier_Vert_Blanc:
CAPTION 30," Damier Bleu foncé/Blanc": CAPTION 31," Damier Gris/blanc"
CAPTION 32,"X Damier Vert foncé/Blanc": CAPTION 33," Damier Violet/Blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 130 : CCV = 190 : CCB = 130
GOSUB Dessine_damier
RETURN

Damier_Violet_Blanc:
CAPTION 30," Damier Bleu foncé/blanc": CAPTION 31," Damier Gris/blanc"
CAPTION 32," Damier Vert foncé/blanc": CAPTION 33,"X Damier Violet/blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 200 : CCV = 60 : CCB = 200
GOSUB Dessine_damier
RETURN

Init:
COLOR 0,180,100,60
LABEL Aide,Regle,Faide, Fregle, Quitter, Clic_Damier, Clic2_Damier_blancs, Clic_Damier3, Clic2_Damier_noirs, Dessine_Damier, Dessine_piece
LABEL Test_PeutPrendre, Test_PeutPrendre_dame, Relance, Test_PeutJouer, Test_deplacement, Fin, Ajout_Liste916
LABEL Damier_Bleu_Blanc, Damier_Gris_Blanc, Damier_Vert_Blanc, Damier_Violet_Blanc
DIM x_Max, y_Max : x_Max=1000 : y_max=700
DIM Marge_x, Marge_y : Marge_x = 40 : Marge_y = 30
DIM hlp$,regle$,h%,i%,j%,k%,case%,tour,PeutPrendre,PeutJouer,DoitPrendre, Message$, cas%
DIM Delta, Cpt, PionX, PionY, TempX, TempY, taille_max_liste: taille_max_liste = 20
DIM damier%(10,10) : ' 0: Case vide, 1: Pion du joueur, 9: Dame du joueur, 2: Pion de l'Ai, 8: Dame de l'Ai
DIM Sposx, Sposy : ' Position du pion sélectionné
DIM Nposx, Nposy : ' Position de la destination sélectionné
DIM pas_case : if (y_Max - 2* Marge_y) > (x_Max - 2 * Marge_x) Then pas_case= (x_Max - 2 * Marge_x) / 11 : else: pas_case= (y_Max - 2 * Marge_y) / 11
DIM rc$ : rc$=CHR$(10)
DIM Nb_Noirs,Nb_blancs : ' Nombre de pions noirs et blancs
DIM r%: r% = pas_case/2 -1
DIM CBR,CBV,CBB, CNR, CNV, CNB
CBR = 205 : CBV = 205: CBB = 205 : ' Couleurs des pions blancs
CNR = 55 : CNV = 55 : CNB = 55 : ' Couleurs des pions noirs
DIM CDR,CDV,CDB,CCR,CCV,CCB
CDR = 255 : CDV = 255: CDB = 255 : ' Couleurs des cases 'blanches'
CCR = 150 : CCV = 150 : CCB = 50 : ' Couleurs des cases 'noires'
CAPTION 0, "Jeu de dames en Basic Panoramic par Jean-Charles"
WIDTH 0,x_Max : HEIGHT 0, y_max

' Création de l'image support pour le damier
PICTURE 2 : WIDTH 2, 10 * pas_case : HEIGHT 2, 10 * pas_case : TOP 2,Marge_y: LEFT 2, Marge_x

' Menu Principal
MAIN_MENU 1 : REM On reserve les objets 1 à 30 pour le menu
SUB_MENU 11: PARENT 11, 1: CAPTION 11, "Fichier"
SUB_MENU 12: PARENT 12, 1: CAPTION 12, "Options"
SUB_MENU 16: PARENT 16, 1: CAPTION 16, "Aide"
SUB_MENU 17: PARENT 17, 1: CAPTION 17, "Règle"
ON_CLICK 16, Aide : ON_CLICK 17, Regle

' Sous menu Fichier
SUB_MENU 25: CAPTION 25,"Relancer partie" : PARENT 25, 11
SUB_MENU 26: CAPTION 26,"Quitter" : PARENT 26, 11
ON_CLICK 25, Relance :ON_CLICK 26, Quitter

' Sous menu Options
SUB_MENU 30: CAPTION 30,"X Damier Bleu foncé/blanc" : PARENT 30, 12
SUB_MENU 31: CAPTION 31," Damier Gris/blanc" : PARENT 31, 12
SUB_MENU 32: CAPTION 32," Damier Vert foncé/blanc" : PARENT 32, 12
SUB_MENU 33: CAPTION 33," Damier Violet/blanc" : PARENT 33, 12
ON_CLICK 30, Damier_Bleu_Blanc :ON_CLICK 31, Damier_Gris_Blanc
ON_CLICK 32, Damier_Vert_Blanc :ON_CLICK 33, Damier_Violet_Blanc

' Préparation de l'aide
hlp$=CHR$(9)+CHR$(9)+CHR$(9)+" - AIDE DU JEU DE DAMES -"+rc$
hlp$=hlp$+CHR$(9)+CHR$(9)+CHR$(9)+" ==============================="+rc$+rc$
hlp$=hlp$+"A remplir"+rc$
FORM 900: TOP 900,2*Marge_y: LEFT 900,3*Marge_X: WIDTH 900,x_Max-6*Marge_X: HEIGHT 900,y_Max-4*Marge_y: HIDE 900
FONT_SIZE 900,10
LIST 901: PARENT 901,900: WIDTH 901,WIDTH(900)-16: HEIGHT 901,HEIGHT(900)-80
k% = INSTR(hlp$, rc$)
WHILE k% > 0
ITEM_ADD 901, LEFT$(hlp$, k%-1): hlp$ = MID$(hlp$, k%+1, 9000)
k% = INSTR(hlp$, rc$)
END_WHILE
BUTTON 902: PARENT 902,900: TOP 902,HEIGHT(900)-70: LEFT 902,280: CAPTION 902,"OK"
ON_CLICK 902, Faide

regle$=CHR$(9)+CHR$(9)+CHR$(9)+" - REGLES DU JEU DE DAMES -"+rc$
regle$=regle$+CHR$(9)+CHR$(9)+CHR$(9)+" ==============================="+rc$+rc$
rem regle$=regle$+""+rc$ : ' Modèle d'une ligne vide
regle$=regle$+"Le jeu de dames international se joue sur un damier carré divisé en 100 cases égales, alternativement claires et foncées."+rc$
regle$=regle$+"Le jeu se joue sur les cases foncées du damier. Il y a donc 50 cases actives."+rc$
regle$=regle$+"La plus longue diagonale, joignant deux coins du damier et comprenant 10 cases foncées, se dénomme la grande diagonale."+rc$
regle$=regle$+"Le damier doit être placé de sorte que la première case de gauche, pour chaque joueur, soit une case foncée."+rc$
regle$=regle$+"Le jeu de dames international se joue avec 20 pions blancs (clairs) et 20 pions noirs (foncés)"+rc$
regle$=regle$+"Avant de débuter une partie, les 20 pions noirs et les 20 pions blancs sont disposés sur les 4 premières rangées de chaque joueur."+rc$
regle$=regle$+"Il faut manger tous les pions de l'autre en passant par dessus avec l'un de vos pions."+rc$
regle$=regle$+"Les déplacements autoriser : seulement d'une case en avant, en diagonale si celle ci est libre."+rc$
regle$=regle$+"Le premier coup est toujours joué par les blancs. Les adversaires jouent un coup chacun à tour de rôle avec leurs pièces."+rc$
regle$=regle$+"Pour cela, on couronne le pion en plaçant dessus un deuxième pion de la même couleur."+rc$
regle$=regle$+"Il est interdit de reculer en dehors des prises"+rc$
regle$=regle$+"Si un pion avance jusqu'à la dernière rangée, il devient une Dame."+rc$
regle$=regle$+"La dame peut se déplacer de plusieurs cases en avant ou en arrière si ces cases sont vides."+rc$
regle$=regle$+"La prise des pièces adverse est obligatoire et s’effectue aussi bien en avant qu’en arrière."+rc$
regle$=regle$+"Lorsqu’un pion se trouve en présence, diagonalement, d’une pièce adverse derrière laquelle se trouve une case libre, il doit"+rc$
regle$=regle$+"obligatoirement sauter par-dessus cette pièce et occuper la case libre. Cette pièce adverse est alors enlevée du damier."+rc$
regle$=regle$+"Cette opération complète est la prise par un pion."+rc$
regle$=regle$+"Lorsqu’au cours d’une prise par un pion, celui-ci se trouve à nouveau en présence, diagonalement, d’une pièce adverse derrière "+rc$
regle$=regle$+"laquelle se trouve une case libre, il doit obligatoirement sauter par-dessus cette seconde pièce, voire d’une troisième et"+rc$
regle$=regle$+"ainsi de suite, et occuper la case libre se trouvant derrière la dernière pièce capturée. Les pièces adverses ainsi capturées"+rc$
regle$=regle$+"sont ensuite enlevées du damier dans l’ordre de la prise."+rc$
regle$=regle$+"Cette opération complète est une rafle par un pion."+rc$
regle$=regle$+"Lorsqu’au cours d’une prise par une dame, celle-ci se trouve à nouveau en présence, sur une même diagonale, d’une pièce adverse"+rc$
regle$=regle$+"derrière laquelle se trouve une ou plusieurs cases libres, elle doit obligatoirement sauter par-dessus cette seconde pièce, voire"+rc$
regle$=regle$+"d’une troisième et ainsi de suite, et occuper au choix une case libre se trouvant derrière et sur la même diagonale que la dernière"+rc$
regle$=regle$+"pièce capturée. Les pièces adverses ainsi capturées sont ensuite enlevées du damier dans l’ordre de la prise."+rc$
regle$=regle$+"Cette opération complète est une rafle par une dame."+rc$
regle$=regle$+"Au cours d’une rafle, il est interdit de passer au-dessus de ses propres pièces."+rc$
regle$=regle$+"Au cours d’une rafle, il est permis de passer plusieurs fois sur une même case libre mais il est interdit de passer plus d’une fois "+rc$
regle$=regle$+"au-dessus d’une même pièce adverse."+rc$
regle$=regle$+"Une rafle doit être clairement indiquée, pièce par pièce, en posant la pièce preneuse sur la case de saut, le temps d’y passer, et"+rc$
regle$=regle$+"en déposant cette pièce sur la case terminale."+rc$
regle$=regle$+"Les pièces prises ne peuvent être enlevées du damier qu’à l’issue de l’exécution complète de la rafle."+rc$
regle$=regle$+"La prise du plus grand nombre de pièces est prioritaire, donc obligatoire. Dans ce cas, une dame compte pour une pièce, tout comme un pion."+rc$
regle$=regle$+"Elle ne confère nulle priorité et n’impose aucune obligation."+rc$
regle$=regle$+"Si les pièces à prendre sont en nombre égal dans deux ou plusieurs possibilités de prise ou de rafle, le joueur est libre de choisir "+rc$
regle$=regle$+"une de ces possibilités, soit avec un pion, soit avec une dame."+rc$
regle$=regle$+"Un pion qui au cours d’une rafle, ne fait que passer sur une des 5 cases de la rangée de base adverse reste un pion lorsque la rafle est terminée."+rc$

FORM 910: TOP 910,2*Marge_y: LEFT 910,3*Marge_X: WIDTH 910,x_Max-6*Marge_X: HEIGHT 910,y_Max-4*Marge_y: HIDE 910
FONT_SIZE 910,10
LIST 911: PARENT 911,910: WIDTH 911,WIDTH(910)-16: HEIGHT 911,HEIGHT(910)-80
k% = INSTR(regle$, rc$)
WHILE k% > 0
ITEM_ADD 911, LEFT$(regle$, k%-1): regle$ = MID$(regle$, k%+1, 9000)
k% = INSTR(regle$, rc$)
END_WHILE
BUTTON 912: PARENT 912,910: TOP 912,HEIGHT(910)-70: LEFT 912,280: CAPTION 912,"OK"
ON_CLICK 912, Fregle

' Creation des compteurs de pions
ALPHA 40 : LEFT 40,Marge_X + 12* pas_case : TOP 40,pas_case - 15: WIDTH 40, 40 : FONT_SIZE 40,20
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE 11.5*pas_case+r%,0.5*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE 11.5*pas_case+r%,0.5*pas_case+r%,r% - 7
ALPHA 41 : LEFT 41,5*Marge_X + 12* pas_case : TOP 41,pas_case - 15: WIDTH 41, 40 : FONT_SIZE 41,20
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE 11.5*pas_case+r%+4*Marge_X,0.5*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE 11.5*pas_case+r%+4*Marge_X,0.5*pas_case+r%,r% - 7
LIST 916 : TOP 916,pas_case+r%+Marge_Y : HEIGHT 916,HEIGHT(0) - (pas_case+r%+4*Marge_Y): FONT_SIZE 916,10
LEFT 916,10*pas_case+Marge_X+20 : WIDTH 916,WIDTH(0) - (10.5*pas_case+r%+Marge_X)
FOR k% = 0 TO 9
i% = 50+k% : ALPHA i%: TOP i%,Marge_Y-32 : WIDTH i%,20 : LEFT i%, (k%+0.5)*pas_case + 30 : FONT_SIZE i%,20 : CAPTION i%,CHR$(65+k%)
i% = 60+k% : ALPHA i%: TOP i%,Marge_Y-20 + (k%+0.5)*pas_case : WIDTH i%,20 : LEFT i%, 10 : FONT_SIZE i%,20 : CAPTION i%,CHR$(48+k%)
NEXT k%

Relance:
' INITIALISATION DES PIONS SUR LE DAMIER
' PIONS DE L'AI
case% = 0
FOR j% = 0 TO 3
FOR k% = 0 TO 9
IF case% = 0 THEN damier%(j%,k%)= -1:case% = 1 : ELSE : damier%(j%,k%)= 2 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
' CASES VIDES
case%=0
FOR j% = 4 TO 5
FOR k% = 0 TO 9
IF case% = 0 THEN damier%(j%,k%)= -1:case% = 1 : ELSE : damier%(j%,k%)= 0 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
' PIONS DU JOUEUR
case% = 0
FOR j% = 6 TO 9
FOR k% = 0 TO 9
IF case% = 0 THEN damier%(j%,k%)= -1:case% = 1 : ELSE : damier%(j%,k%)= 1 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%

Nb_Noirs = 20 : Nb_blancs = 20 :CAPTION 40,Nb_blancs : CAPTION 41,Nb_noirs

tour=0 : ' Les blancs commencent
2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
CLEAR 916: Message$="Les pions blancs commencent": ITEM_ADD 916, Message$

' Représentation du Damier
GOSUB Dessine_Damier
ON_CLICK 2, Clic_Damier

END

Bonjour Jicehel,

Je vois que ca avance....
Par contre, malgrès cette nouvelle version, il y a toujours l'erreur "Nan is not a floating point value".

elle apparait lorsque tu clique un peu partout au hasard sur les cases.
en esperant que cela puisse t'aider.

bon courage et bon appétit.

Salut Jicehel.

Après avoir joué et gagné une partie, il n’est pas possible de rejouer une autre : Le message « Voulez-vous faire une nouvelle partie ? yes no » est une boucle infinie ; on n’en sort qu’en choisissant ‘no’. Lorsqu’on choisit ‘yes’, le damier se redessine à nouveau et tout semble correct, mais dès qu’on clique sur un pion pour jouer, le même message s’affiche et… la boucle infernale ! (Il y a peut-être une variable à réinitialiser ?).

Je confirme aussi l’erreur soulevée par Bignono et Minibug "Nan is not a floating point value!"

lol!

Bon, j'espère que cette version résout aussi ce problème. Je la livre à vos tests rigoureux. Dites moi quand même s'il reste des bugs. Avant de le compliquer un peu, mieux vaut déjà que ça tourne bien (c'est pour ça que je n'implémente pas la partie sauvegarde restauration de partie et autres fioritures tant que ça ne tourne pas nickel.
Bon, voilà le code:

Code:: REM Jeu de dames par Jean-Charles
REM V0.7 du 28/05/2011
REM Programmation en cours - le jeu à 2 joueurs devrait être OK
REM Reste à faire l'AI s'il n'y a plus de bug
REM Reste à corriger le bug de la prise de la dame en cas de rafle

LABEL Init: application_title "Jeu de dames":GOTO Init

Aide:
SHOW 900
RETURN

Faide:
HIDE 900
RETURN

Regle:
SHOW 910
RETURN

Fregle:
HIDE 910
RETURN

Quitter:
TERMINATE
RETURN

Ajout_Liste916:
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916, Message$
RETURN

Dessine_Damier:
2D_TARGET_IS 2
2D_PEN_COLOR 40,40,40: 2D_RECTANGLE 0,0,WIDTH(2),HEIGHT(2)
case% = 0
FOR j% = 0 TO 9
FOR k% = 0 TO 9
IF case% = 0
2D_FILL_COLOR CDR,CDV,CDB
case% = 1
ELSE
2D_FILL_COLOR CCR,CCV,CCB
case% = 0
END_IF
2D_RECTANGLE k%*pas_case,j%*pas_case,(k%+1)*pas_case,(j%+1)*pas_case
IF damier%(j%,k%) > 0 THEN GOSUB Dessine_piece
2D_PEN_COLOR 40,40,40
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
RETURN

Dessine_piece:
SELECT damier%(j%,k%)
CASE 0: ' NORMALEMENT ON NE LE FAIT JAMAIS
CASE 1: ' PION BLANC
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
CASE 2: ' PION NOIR
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
CASE 9: ' DAME BLANCHE
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case-3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%-6,r% - 7 : 2D_PEN_WIDTH 3
CASE 8: ' DAME NOIRE
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case-3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%-6,r% - 7 : 2D_PEN_WIDTH 3
END_SELECT
RETURN

Clic_Damier:
Sposx = INT(MOUSE_X_POSITION(2)/pas_case) : Sposy = INT(MOUSE_Y_POSITION(2)/pas_case)

Clic_Damier3:
OFF_CLICK 2
GOSUB Test_PeutJouer
IF Tour=0 AND PeutJouer=0 THEN Message$="Fin de partie, les blancs ne peuvent plus jouer" : GOSUB Ajout_Liste916
IF Tour=0 AND PeutJouer=0 THEN Message$="Les noirs gagnent" : GOSUB Ajout_Liste916
IF Tour=1 AND PeutJouer=0 THEN Message$="Fin de partie, les noirs ne peuvent plus jouer" : GOSUB Ajout_Liste916
IF Tour=1 AND PeutJouer=0 THEN Message$="Les blancs gagnent" : GOSUB Ajout_Liste916
IF tour=0 AND PeutJouer <> 0
' Tour des blancs
IF damier%(Sposy,Sposx) = 1 OR damier%(Sposy,Sposx) = 9
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
IF damier%(Sposy,Sposx) = 1 THEN Message$=" le pion en "
IF damier%(Sposy,Sposx) = 9 THEN Message$=" la dame en "
Message$=Message$+CHR$(65+Sposx)+":"+CHR$(48+Sposy)
ON_CLICK 2, Clic2_Damier_blancs
ELSE
ON_CLICK 2, Clic_Damier
END_IF
ELSE
' Tour des noirs
IF PeutJouer<>0
IF damier%(Sposy,Sposx) = 2 OR damier%(Sposy,Sposx) = 8
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
IF damier%(Sposy,Sposx) = 2 THEN Message$=" le pion en "
IF damier%(Sposy,Sposx) = 8 THEN Message$=" la dame en "
Message$=Message$+CHR$(65+Sposx)+":"+CHR$(48+Sposy)
ON_CLICK 2, Clic2_Damier_noirs
ELSE
ON_CLICK 2, Clic_Damier
END_IF
ELSE
GOTO Fin
END_IF
END_IF
RETURN

Clic2_Damier_noirs:
Nposx = INT(MOUSE_X_POSITION(2)/pas_case) : Nposy = INT(MOUSE_Y_POSITION(2)/pas_case)
OFF_CLICK 2
IF (NposX <> SposX OR NposY <> SposY) AND (Damier%(NposY,NposX) = 0 OR Damier%(NposY,NposX) = 2 OR Damier%(NposY,NposX) = 8)
TempX=NposX: TempY=NposY : GOSUB Test_PeutJouer : NposX=TempX : NposY=TempY
Delta=ABS(Sposx - Nposx):PeutPrendre=0:i%=0:Cpt=0
IF Delta > 0 THEN j%=(NposX - SposX)/Delta : k%=(NposY - SposY)/Delta
IF damier%(Nposy,Nposx) = 0 AND Delta > 0
IF (((NposY - Delta) = SposY) OR ((NposY + Delta) = SposY)) THEN i%=2
END_IF
IF Delta = 1 AND SposY < NposY AND i%=2
PeutPrendre=1
ELSE
IF Delta = 2 AND i%=2
IF Damier%(SposY+k%,SposX+j%)=1 OR Damier%(SposY+k%,SposX+j%)=9 THEN PeutPrendre=1:Cpt=1:PionX=SposX+j%: PionY=SposY+k%
ELSE
IF Damier%(SposY,SposX)=8 AND i%=2
PeutPrendre=1
FOR i% = 1 TO Delta
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=1 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=9
IF Cpt=0
Cpt=1:PionX=SposX+(j%*i%): PionY=SposY+(k%*i%)
ELSE
PeutPrendre=0 : i%=Delta
END_IF
ELSE
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=2 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=8 THEN PeutPrendre=0 : i%=Delta
END_IF
NEXT i%
END_IF
END_IF
END_IF
IF PeutPrendre=1
IF Cpt=0
IF DoitPrendre=0
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
tour= 0 : 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30, 100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_TARGET_IS 2 : ON_CLICK 2, Clic_Damier
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les noirs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
ELSE
Message$="Irrégularité des noirs: vous devez prendre":GOSUB Ajout_Liste916
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic_Damier
END_IF
ELSE
IF Cpt=1
damier%(PionY,PionX)=0 : Nb_blancs = Nb_blancs - 1 : CAPTION 40,Nb_blancs
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE (PionX)*pas_case,(PionY)*pas_case,(PionX+1)*pas_case,(PionY+1)*pas_case
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les noirs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
IF Nb_blancs <=0
Message$="Il ne reste plus de pion blanc. Les noirs gagnent": GOSUB Ajout_Liste916
ELSE
IF damier%(NposY,NposX)=2 THEN GOSUB Test_PeutPrendre
IF damier%(NposY,NposX)=8 THEN GOSUB Test_PeutPrendre_Dame
IF PeutPrendre = 0
tour=0 : 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30, 100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_TARGET_IS 2 : ON_CLICK 2, Clic_Damier
ELSE
Sposx=Nposx : Sposy=Nposy
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic2_Damier_noirs
END_IF
END_IF
END_IF
END_IF
ELSE
IF damier%(Nposy,Nposx) = 2 or damier%(Nposy,Nposx) = 8
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=SposY:k%=SposX: GOSUB Dessine_piece
Sposx=Nposx : Sposy=Nposy : GOSUB Clic_Damier3
ELSE
ON_CLICK 2,Clic2_Damier_noirs
END_IF
END_IF
IF tour=0 AND Nposy=9 THEN IF damier%(Nposy,Nposx)=2 THEN j%=Nposy : k%= Nposx : damier%(j%,k%)=8 : GOSUB Dessine_piece
ELSE
ON_CLICK 2,Clic2_Damier_noirs
END_IF
IF Nb_blancs= 0 THEN GOTO Fin
RETURN

Clic2_Damier_blancs:
Nposx = INT(MOUSE_X_POSITION(2)/pas_case) : Nposy = INT(MOUSE_Y_POSITION(2)/pas_case)
OFF_CLICK 2
IF (NposX <> SposX OR NposY <> SposY) AND (Damier%(NposY,NposX) = 0 OR Damier%(NposY,NposX) = 1 OR Damier%(NposY,NposX) = 9)
TempX=NposX: TempY=NposY : GOSUB Test_PeutJouer : NposX=TempX : NposY=TempY
Delta=abs(Sposx - Nposx): PeutPrendre=0:i%=0:Cpt=0
IF Delta > 0 THEN j%=(NposX - SposX)/Delta : k%=(NposY - SposY)/Delta
IF damier%(Nposy,Nposx) = 0 THEN i%=1
IF i%=1 AND Delta > 0
IF NposY > SposY
IF (NposY - Delta) = SposY THEN i%=2
ELSE
IF (NposY + Delta) = SposY THEN i%=2
END_IF
END_IF
IF Delta = 1 AND SposY > NposY AND i%=2
PeutPrendre=1
ELSE
IF Delta = 2 AND i%=2
IF Damier%(SposY+k%,SposX+j%)=2 OR Damier%(SposY+k%,SposX+j%)=8 THEN PeutPrendre=1:Cpt=1:PionX=SposX+j%: PionY=SposY+k%
ELSE
IF Damier%(SposY,SposX)=9 AND i%=2
PeutPrendre=1
FOR i% = 1 TO Delta
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=2 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=8
IF Cpt=0
Cpt=1:PionX=SposX+(j%*i%): PionY=SposY+(k%*i%)
ELSE
PeutPrendre=0 : i%=Delta
END_IF
ELSE
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=1 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=9 THEN PeutPrendre=0 : i%=Delta
END_IF
NEXT i%
END_IF
END_IF
END_IF
IF PeutPrendre=1
IF Cpt=0
IF DoitPrendre=0
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
tour = 1 : 2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7 : 2D_TARGET_IS 2
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les blancs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
ON_CLICK 2, Clic_Damier
ELSE
Caption 0,"Doitprendre=1"
Message$="Irrégularité des blancs: vous devez prendre":GOSUB Ajout_Liste916
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic_Damier
END_IF
ELSE
IF Cpt=1
damier%(PionY,PionX)=0 : Nb_Noirs = Nb_Noirs - 1 : CAPTION 41,Nb_noirs
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE (PionX)*pas_case,(PionY)*pas_case,(PionX+1)*pas_case,(PionY+1)*pas_case
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les blancs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
IF Nb_Noirs <=0
Message$="Il ne reste plus de pion noir. Les blancs gagnent":GOSUB Ajout_Liste916
ELSE
IF damier%(NposY,NposX)=1 THEN GOSUB Test_PeutPrendre
IF damier%(NposY,NposX)=9 THEN GOSUB Test_PeutPrendre_Dame
IF PeutPrendre = 0
tour = 1: 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7 : 2D_TARGET_IS 2
ON_CLICK 2, Clic_Damier
ELSE
Sposx=Nposx : Sposy=Nposy
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic2_Damier_blancs
END_IF
END_IF
END_IF
END_IF
ELSE
IF damier%(Nposy,Nposx) = 1 or damier%(Nposy,Nposx) = 9
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=SposY:k%=SposX: GOSUB Dessine_piece
Sposx=Nposx : Sposy=Nposy : GOSUB Clic_Damier3
ELSE
ON_CLICK 2,Clic2_Damier_blancs
END_IF
END_IF
IF tour=1 AND Nposy=0
IF damier%(Nposy,Nposx)=1
Message$="Nouvelle Dame blanche en "+CHR$(65+Nposx)+":"+CHR$(48+Nposy):GOSUB Ajout_Liste916
j%=Nposy : k%= Nposx : damier%(j%,k%)=9 : GOSUB Dessine_piece
END_IF
END_IF
ELSE
ON_CLICK 2,Clic2_Damier_blancs
END_IF
IF Nb_noirs=0 THEN GOTO Fin
RETURN

Test_deplacement:
cas%=0
IF damier%(Nposy,Nposx)=1 AND tour=0 THEN cas%= 1
IF damier%(Nposy,Nposx)=2 AND tour=1 THEN cas%= 2
IF damier%(Nposy,Nposx)=8 OR damier%(Nposy,Nposx)=9 THEN cas%= 3
IF cas% > 0
IF Nposx < 9 AND Nposy < 9
IF cas%=2 OR cas%=3
IF damier%(Nposy+1,Nposx+1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx < 9 AND Nposy > 0
IF cas%=1 OR cas%=3
IF damier%(Nposy-1,Nposx+1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx > 0 AND Nposy < 9
IF cas%=2 OR cas%=3
IF damier%(Nposy+1,Nposx-1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx > 1 AND Nposy > 1
IF cas%=1 OR cas%=3
IF damier%(Nposy-1,Nposx-1)=0 THEN PeutJouer = 1
END_IF
END_IF
END_IF
RETURN

Test_PeutJouer:
case% = 0: PeutPrendre=0 : DoitPrendre = 0 : PeutJouer=0
FOR Nposy = 0 TO 9 : ' Correspond à la ligne (y)
FOR Nposx = 0 TO 9 : ' Correspond à la rangée (x)
IF case% = 0
case% = 1 : ' Case vide, on passe
ELSE
GOSUB Test_deplacement
IF tour=0 and damier%(Nposy,Nposx)=1 THEN GOSUB Test_PeutPrendre
IF tour=0 and damier%(Nposy,Nposx)=9 THEN GOSUB Test_PeutPrendre_Dame
IF tour=1 and damier%(Nposy,Nposx)=2 THEN GOSUB Test_PeutPrendre
IF tour=1 and damier%(Nposy,Nposx)=8 THEN GOSUB Test_PeutPrendre_Dame
IF PeutPrendre = 1 THEN DoitPrendre = 1:PeutJouer = 1
IF PeutJouer = 1 THEN h%=1
case% = 0
END_IF
NEXT NposX
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT NposY
IF h%=1 THEN PeutJouer=1
RETURN

Test_PeutPrendre_dame:
PeutPrendre = 0: Delta = 0
IF tour=0 THEN j%=2 : k%=8
IF tour=1 THEN j%=1 : k%=9

IF Nposx < 8 AND Nposy < 8
IF Nposx > Nposy THEN Delta = 8-Nposx :ELSE : Delta = 8-Nposy
FOR i% = 1 TO Delta
IF (damier%(Nposy+i%,Nposx+i%)=j% OR damier%(Nposy+i%,Nposx+i%)=k%) AND damier%(Nposy+i%+1,Nposx+i%+1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF

IF Nposx < 8 AND Nposy > 1
IF Nposy >= (8-Nposx) THEN Delta= 8-Nposx : ELSE : Delta = Nposy-1
FOR i% = 1 TO Delta
IF (damier%(Nposy-i%,Nposx+i%)=j% OR damier%(Nposy-i%,Nposx+i%)=k%) AND damier%(Nposy-i%-1,Nposx+i%+1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF

IF Nposx > 1 AND Nposy < 8
IF ((8-Nposy) > (Nposx-1)) THEN Delta= Nposx -1: ELSE : Delta = 8-Nposy
FOR i% = 1 TO Delta
IF damier%(Nposy+i%,Nposx-i%)=j% OR damier%(Nposy+i%,Nposx-i%)=k%
IF damier%(Nposy+i%+1,Nposx-i%-1)= 0 THEN PeutPrendre = 1
END_IF
NEXT i%
END_IF

IF Nposx > 1 AND Nposy > 1
IF Nposx > Nposy THEN Delta= Nposy-1: ELSE : Delta = Nposx-1
FOR i% = 1 TO Delta
IF (damier%(Nposy-i%,Nposx-i%)=j% OR damier%(Nposy-i%,Nposx-i%)=k%) AND damier%(Nposy-i%-1,Nposx-i%-1)= 0 THEN PeutPrendre = 1
NEXT i%
END_IF
RETURN

Test_PeutPrendre:
PeutPrendre = 0
IF tour=0 THEN j%=2 : k%=8
IF tour=1 THEN j%=1 : k%=9
IF Nposx < 8 AND Nposy < 8
IF (damier%(Nposy+1,Nposx+1)=j% OR damier%(Nposy+1,Nposx+1)=k%) AND damier%(Nposy+2,Nposx+2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx < 8 AND Nposy > 1
IF (damier%(Nposy-1,Nposx+1)=j% OR damier%(Nposy-1,Nposx+1)=k%) AND damier%(Nposy-2,Nposx+2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx > 1 AND Nposy < 8
IF (damier%(Nposy+1,Nposx-1)=j% OR damier%(Nposy+1,Nposx-1)=k%) AND damier%(Nposy+2,Nposx-2)= 0 THEN PeutPrendre = 1
END_IF
IF Nposx > 1 AND Nposy > 1
IF (damier%(Nposy-1,Nposx-1)=j% OR damier%(Nposy-1,Nposx-1)=k%) AND damier%(Nposy-2,Nposx-2)= 0 THEN PeutPrendre = 1
END_IF
RETURN

Fin:
case%=MESSAGE_CONFIRMATION_YES_NO("Voulez vous faire une nouvelle partie ?")
IF case%=1 THEN GOTO Relance
IF case%=0 THEN GOTO Fin
Terminate

Damier_Bleu_Blanc:
CAPTION 30,"X Damier Bleu foncé/Blanc": CAPTION 31," Damier Gris/Blanc"
CAPTION 32," Damier Vert foncé/Blanc": CAPTION 33," Damier Violet/Blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 30 : CCV = 30 : CCB = 180
GOSUB Dessine_damier
RETURN

Damier_Gris_Blanc:
CAPTION 30," Damier Bleu foncé/Blanc": CAPTION 31,"X Damier Gris/blanc"
CAPTION 32," Damier Vert foncé/Blanc": CAPTION 33," Damier Violet/blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 160 : CCV = 160 : CCB = 160
GOSUB Dessine_damier
RETURN

Damier_Vert_Blanc:
CAPTION 30," Damier Bleu foncé/Blanc": CAPTION 31," Damier Gris/blanc"
CAPTION 32,"X Damier Vert foncé/Blanc": CAPTION 33," Damier Violet/Blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 130 : CCV = 190 : CCB = 130
GOSUB Dessine_damier
RETURN

Damier_Violet_Blanc:
CAPTION 30," Damier Bleu foncé/blanc": CAPTION 31," Damier Gris/blanc"
CAPTION 32," Damier Vert foncé/blanc": CAPTION 33,"X Damier Violet/blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 200 : CCV = 60 : CCB = 200
GOSUB Dessine_damier
RETURN

Init:
COLOR 0,180,100,60
LABEL Aide,Regle,Faide, Fregle, Quitter, Clic_Damier, Clic2_Damier_blancs, Clic_Damier3, Clic2_Damier_noirs, Dessine_Damier, Dessine_piece
LABEL Test_PeutPrendre, Test_PeutPrendre_dame, Relance, Test_PeutJouer, Test_deplacement, Fin, Ajout_Liste916
LABEL Damier_Bleu_Blanc, Damier_Gris_Blanc, Damier_Vert_Blanc, Damier_Violet_Blanc
DIM x_Max, y_Max : x_Max=1000 : y_max=700
DIM Marge_x, Marge_y : Marge_x = 40 : Marge_y = 30
DIM hlp$,regle$,h%,i%,j%,k%,case%,tour,PeutPrendre,PeutJouer,DoitPrendre, Message$, cas%
DIM Delta, Cpt, PionX, PionY, TempX, TempY, taille_max_liste: taille_max_liste = 20
DIM damier%(10,10) : ' 0: Case vide, 1: Pion du joueur, 9: Dame du joueur, 2: Pion de l'Ai, 8: Dame de l'Ai
DIM Sposx, Sposy : ' Position du pion sélectionné
DIM Nposx, Nposy : ' Position de la destination sélectionné
DIM pas_case : if (y_Max - 2* Marge_y) > (x_Max - 2 * Marge_x) Then pas_case= (x_Max - 2 * Marge_x) / 11 : else: pas_case= (y_Max - 2 * Marge_y) / 11
DIM rc$ : rc$=CHR$(10)
DIM Nb_Noirs,Nb_blancs : ' Nombre de pions noirs et blancs
DIM r%: r% = pas_case/2 -1
DIM CBR,CBV,CBB, CNR, CNV, CNB
CBR = 205 : CBV = 205: CBB = 205 : ' Couleurs des pions blancs
CNR = 55 : CNV = 55 : CNB = 55 : ' Couleurs des pions noirs
DIM CDR,CDV,CDB,CCR,CCV,CCB
CDR = 255 : CDV = 255: CDB = 255 : ' Couleurs des cases 'blanches'
CCR = 150 : CCV = 150 : CCB = 50 : ' Couleurs des cases 'noires'
CAPTION 0, "Jeu de dames en Basic Panoramic par Jean-Charles"
WIDTH 0,x_Max : HEIGHT 0, y_max

' Création de l'image support pour le damier
PICTURE 2 : WIDTH 2, 10 * pas_case : HEIGHT 2, 10 * pas_case : TOP 2,Marge_y: LEFT 2, Marge_x

' Menu Principal
MAIN_MENU 1 : REM On reserve les objets 1 à 30 pour le menu
SUB_MENU 11: PARENT 11, 1: CAPTION 11, "Fichier"
SUB_MENU 12: PARENT 12, 1: CAPTION 12, "Options"
SUB_MENU 16: PARENT 16, 1: CAPTION 16, "Aide"
SUB_MENU 17: PARENT 17, 1: CAPTION 17, "Règle"
ON_CLICK 16, Aide : ON_CLICK 17, Regle

' Sous menu Fichier
SUB_MENU 25: CAPTION 25,"Relancer partie" : PARENT 25, 11
SUB_MENU 26: CAPTION 26,"Quitter" : PARENT 26, 11
ON_CLICK 25, Relance :ON_CLICK 26, Quitter

' Sous menu Options
SUB_MENU 30: CAPTION 30,"X Damier Bleu foncé/blanc" : PARENT 30, 12
SUB_MENU 31: CAPTION 31," Damier Gris/blanc" : PARENT 31, 12
SUB_MENU 32: CAPTION 32," Damier Vert foncé/blanc" : PARENT 32, 12
SUB_MENU 33: CAPTION 33," Damier Violet/blanc" : PARENT 33, 12
ON_CLICK 30, Damier_Bleu_Blanc :ON_CLICK 31, Damier_Gris_Blanc
ON_CLICK 32, Damier_Vert_Blanc :ON_CLICK 33, Damier_Violet_Blanc

' Préparation de l'aide
hlp$=CHR$(9)+CHR$(9)+CHR$(9)+" - AIDE DU JEU DE DAMES -"+rc$
hlp$=hlp$+CHR$(9)+CHR$(9)+CHR$(9)+" ==============================="+rc$+rc$
hlp$=hlp$+"A remplir"+rc$
FORM 900: TOP 900,2*Marge_y: LEFT 900,3*Marge_X: WIDTH 900,x_Max-6*Marge_X: HEIGHT 900,y_Max-4*Marge_y: HIDE 900
FONT_SIZE 900,10
LIST 901: PARENT 901,900: WIDTH 901,WIDTH(900)-16: HEIGHT 901,HEIGHT(900)-80
k% = INSTR(hlp$, rc$)
WHILE k% > 0
ITEM_ADD 901, LEFT$(hlp$, k%-1): hlp$ = MID$(hlp$, k%+1, 9000)
k% = INSTR(hlp$, rc$)
END_WHILE
BUTTON 902: PARENT 902,900: TOP 902,HEIGHT(900)-70: LEFT 902,280: CAPTION 902,"OK"
ON_CLICK 902, Faide

regle$=CHR$(9)+CHR$(9)+CHR$(9)+" - REGLES DU JEU DE DAMES -"+rc$
regle$=regle$+CHR$(9)+CHR$(9)+CHR$(9)+" ==============================="+rc$+rc$
rem regle$=regle$+""+rc$ : ' Modèle d'une ligne vide
regle$=regle$+"Le jeu de dames international se joue sur un damier carré divisé en 100 cases égales, alternativement claires et foncées."+rc$
regle$=regle$+"Le jeu se joue sur les cases foncées du damier. Il y a donc 50 cases actives."+rc$
regle$=regle$+"La plus longue diagonale, joignant deux coins du damier et comprenant 10 cases foncées, se dénomme la grande diagonale."+rc$
regle$=regle$+"Le damier doit être placé de sorte que la première case de gauche, pour chaque joueur, soit une case foncée."+rc$
regle$=regle$+"Le jeu de dames international se joue avec 20 pions blancs (clairs) et 20 pions noirs (foncés)"+rc$
regle$=regle$+"Avant de débuter une partie, les 20 pions noirs et les 20 pions blancs sont disposés sur les 4 premières rangées de chaque joueur."+rc$
regle$=regle$+"Il faut manger tous les pions de l'autre en passant par dessus avec l'un de vos pions."+rc$
regle$=regle$+"Les déplacements autorisés : seulement d'une case en avant, en diagonale si celle ci est libre."+rc$
regle$=regle$+"Le premier coup est toujours joué par les blancs. Les adversaires jouent un coup chacun à tour de rôle avec leurs pièces."+rc$
regle$=regle$+"Pour cela, on couronne le pion en plaçant dessus un deuxième pion de la même couleur."+rc$
regle$=regle$+"Il est interdit de reculer en dehors des prises"+rc$
regle$=regle$+"Si un pion avance jusqu'à la dernière rangée, il devient une Dame."+rc$
regle$=regle$+"La dame peut se déplacer de plusieurs cases en avant ou en arrière si ces cases sont vides."+rc$
regle$=regle$+"La prise des pièces adverses est obligatoire et s’effectue aussi bien en avant qu’en arrière."+rc$
regle$=regle$+"Lorsqu’un pion se trouve en présence, diagonalement, d’une pièce adverse derrière laquelle se trouve une case libre, il doit"+rc$
regle$=regle$+"obligatoirement sauter par-dessus cette pièce et occuper la case libre. Cette pièce adverse est alors enlevée du damier."+rc$
regle$=regle$+"Cette opération complète est la prise par un pion."+rc$
regle$=regle$+"Lorsqu’au cours d’une prise par un pion, celui-ci se trouve à nouveau en présence, diagonalement, d’une pièce adverse derrière "+rc$
regle$=regle$+"laquelle se trouve une case libre, il doit obligatoirement sauter par-dessus cette seconde pièce, voire d’une troisième et"+rc$
regle$=regle$+"ainsi de suite, et occuper la case libre se trouvant derrière la dernière pièce capturée. Les pièces adverses ainsi capturées"+rc$
regle$=regle$+"sont ensuite enlevées du damier dans l’ordre de la prise."+rc$
regle$=regle$+"Cette opération complète est une rafle par un pion."+rc$
regle$=regle$+"Lorsqu’au cours d’une prise par une dame, celle-ci se trouve à nouveau en présence, sur une même diagonale, d’une pièce adverse"+rc$
regle$=regle$+"derrière laquelle se trouve une ou plusieurs cases libres, elle doit obligatoirement sauter par-dessus cette seconde pièce, voire"+rc$
regle$=regle$+"d’une troisième et ainsi de suite, et occuper au choix une case libre se trouvant derrière et sur la même diagonale que la dernière"+rc$
regle$=regle$+"pièce capturée. Les pièces adverses ainsi capturées sont ensuite enlevées du damier dans l’ordre de la prise."+rc$
regle$=regle$+"Cette opération complète est une rafle par une dame."+rc$
regle$=regle$+"Au cours d’une rafle, il est interdit de passer au-dessus de ses propres pièces."+rc$
regle$=regle$+"Au cours d’une rafle, il est permis de passer plusieurs fois sur une même case libre mais il est interdit de passer plus d’une fois "+rc$
regle$=regle$+"au-dessus d’une même pièce adverse."+rc$
regle$=regle$+"Une rafle doit être clairement indiquée, pièce par pièce, en posant la pièce preneuse sur la case de saut, le temps d’y passer, et"+rc$
regle$=regle$+"en déposant cette pièce sur la case terminale."+rc$
regle$=regle$+"Les pièces prises ne peuvent être enlevées du damier qu’à l’issue de l’exécution complète de la rafle."+rc$
regle$=regle$+"La prise du plus grand nombre de pièces est prioritaire, donc obligatoire. Dans ce cas, une dame compte pour une pièce, tout comme un pion."+rc$
regle$=regle$+"Elle ne confère nulle priorité et n’impose aucune obligation."+rc$
regle$=regle$+"Si les pièces à prendre sont en nombre égal dans deux ou plusieurs possibilités de prise ou de rafle, le joueur est libre de choisir "+rc$
regle$=regle$+"une de ces possibilités, soit avec un pion, soit avec une dame."+rc$
regle$=regle$+"Un pion qui au cours d’une rafle, ne fait que passer sur une des 5 cases de la rangée de base adverse reste un pion lorsque la rafle est terminée."+rc$

FORM 910: TOP 910,2*Marge_y: LEFT 910,3*Marge_X: WIDTH 910,x_Max-6*Marge_X: HEIGHT 910,y_Max-4*Marge_y: HIDE 910
FONT_SIZE 910,10
LIST 911: PARENT 911,910: WIDTH 911,WIDTH(910)-16: HEIGHT 911,HEIGHT(910)-80
k% = INSTR(regle$, rc$)
WHILE k% > 0
ITEM_ADD 911, LEFT$(regle$, k%-1): regle$ = MID$(regle$, k%+1, 9000)
k% = INSTR(regle$, rc$)
END_WHILE
BUTTON 912: PARENT 912,910: TOP 912,HEIGHT(910)-70: LEFT 912,280: CAPTION 912,"OK"
ON_CLICK 912, Fregle

' Creation des compteurs de pions
ALPHA 40 : LEFT 40,Marge_X + 12* pas_case : TOP 40,pas_case - 15: WIDTH 40, 40 : FONT_SIZE 40,20
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE 11.5*pas_case+r%,0.5*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE 11.5*pas_case+r%,0.5*pas_case+r%,r% - 7
ALPHA 41 : LEFT 41,5*Marge_X + 12* pas_case : TOP 41,pas_case - 15: WIDTH 41, 40 : FONT_SIZE 41,20
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE 11.5*pas_case+r%+4*Marge_X,0.5*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE 11.5*pas_case+r%+4*Marge_X,0.5*pas_case+r%,r% - 7
LIST 916 : TOP 916,pas_case+r%+Marge_Y : HEIGHT 916,HEIGHT(0) - (pas_case+r%+4*Marge_Y): FONT_SIZE 916,10
LEFT 916,10*pas_case+Marge_X+20 : WIDTH 916,WIDTH(0) - (10.5*pas_case+r%+Marge_X)
FOR k% = 0 TO 9
i% = 50+k% : ALPHA i%: TOP i%,Marge_Y-32 : WIDTH i%,20 : LEFT i%, (k%+0.5)*pas_case + 30 : FONT_SIZE i%,20 : CAPTION i%,CHR$(65+k%)
i% = 60+k% : ALPHA i%: TOP i%,Marge_Y-20 + (k%+0.5)*pas_case : WIDTH i%,20 : LEFT i%, 10 : FONT_SIZE i%,20 : CAPTION i%,CHR$(48+k%)
NEXT k%

Relance:
' INITIALISATION DES PIONS SUR LE DAMIER
' PIONS DE L'AI
case% = 0
FOR j% = 0 TO 3
FOR k% = 0 TO 9
IF case% = 0 THEN damier%(j%,k%)= -1:case% = 1 : ELSE : damier%(j%,k%)= 2 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
' CASES VIDES
case%=0
FOR j% = 4 TO 5
FOR k% = 0 TO 9
IF case% = 0 THEN damier%(j%,k%)= -1:case% = 1 : ELSE : damier%(j%,k%)= 0 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
' PIONS DU JOUEUR
case% = 0
FOR j% = 6 TO 9
FOR k% = 0 TO 9
IF case% = 0 THEN damier%(j%,k%)= -1:case% = 1 : ELSE : damier%(j%,k%)= 1 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%

Nb_Noirs = 20 : Nb_blancs = 20 :CAPTION 40,Nb_blancs : CAPTION 41,Nb_noirs

tour=0 : ' Les blancs commencent
2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
CLEAR 916: Message$="Les pions blancs commencent": ITEM_ADD 916, Message$

' Représentation du Damier
GOSUB Dessine_Damier
ON_CLICK 2, Clic_Damier

END

Salut Jicehel.

D’après mon test, les bugs mentionnés ont été corrigés, mai j’ai découvert un autre bug.
• Lorsque l’un des joueurs (disons le blanc) ne peut plus déplacer ses pions (j’ai provoqué cette situation volontairement) et se trouve dans l’impossibilité de jouer alors qu’il a le trait, normalement la partie est considérée comme perdue pour lui. Or le programme reste bloqué dans cette situation !

J’ai rectifié 2 fautes d’inattentions :
Ligne 534 : Les déplacements autoriser ---> autorisés
Ligne 540 : La prise des pièces adverse ---> adverses

J’ai une petite suggestion : en cas d’irrégularité de l’un des joueurs, si, en plus d’afficher le message, tu peux avertir le joueur par un signal sonore (un BEEP par exemple). Moi, je n’y arrive pas. D’ailleurs, j’ai posté un message dans la rubrique ‘A l’aide’ sous le titre ‘La commande BEEP n'émet aucun son’.

A part ces quelques remarques, le programme est devenu intéressant.
Bonne continuation.

A+

Bonjour Jicehel,

j'ai testé ce matin la nouvelle version qui fonctionne parfaitement sans plantage cette fois.

Par contre, j'ai rencontré des soucis dans le déplacement des dames qui parfois semblent bloquées et ne permet pas le déplacement sur certaines cases normalement autorisées.

Bonne journée et bon courage.

Salut à tous,

Bravo Jicehel, il y a encore des soucis. En premier j'ai eu le même problème que Minibug et en second un blocage ou on me dit que les noirs doivent prendre alors que c'est impossible.
Voici l'image:

BON COURAGE !
A+

Merci pour vos tests, on finira par les avoir ces maudits bugs ... J'ai dû encore me planter quelque part, je regarde ça à tête froide ce soir je pense (plus de belle famille, je pourrais me concentrer un peu plus ... Wink

)
Et la capture, c'est bien pratique pour que je comprenne la situation à tester . Merci à vous

Hum, comme je fais une pause dans la programmation, je vous mets juste le programme que j'avais modifié pour supprimer quelques bugs et surtout par ce que le test pour la prise de la dame était vraiment mal fait ...
Si vous voyez des bugs ou des améliorations à faire ne vous en privez pas. Pour le moment, je mets en stand by, mais je reprendrais sans doute un jour pour faire l'IA. Pour le moment, je reporte à plus tard ...

Code:: REM Jeu de dames par Jean-Charles
REM V0.7 du 28/05/2011
REM Programmation en cours - le jeu à 2 joueurs devrait être OK
REM Reste à faire l'AI s'il n'y a plus de bug
REM Reste à corriger le bug de la prise de la dame en cas de rafle

LABEL Init: application_title "Jeu de dames":GOTO Init

Aide:
SHOW 900
RETURN

Faide:
HIDE 900
RETURN

Regle:
SHOW 910
RETURN

Fregle:
HIDE 910
RETURN

Quitter:
TERMINATE
RETURN

Ajout_Liste916:
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916, Message$
RETURN

Dessine_Damier:
2D_TARGET_IS 2
2D_PEN_COLOR 40,40,40: 2D_RECTANGLE 0,0,WIDTH(2),HEIGHT(2)
case% = 0
FOR j% = 0 TO 9
FOR k% = 0 TO 9
IF case% = 0
2D_FILL_COLOR CDR,CDV,CDB
case% = 1
ELSE
2D_FILL_COLOR CCR,CCV,CCB
case% = 0
END_IF
2D_RECTANGLE k%*pas_case,j%*pas_case,(k%+1)*pas_case,(j%+1)*pas_case
IF damier%(j%,k%) > 0 THEN GOSUB Dessine_piece
2D_PEN_COLOR 40,40,40
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
RETURN

Dessine_piece:
SELECT damier%(j%,k%)
CASE 0: ' NORMALEMENT ON NE LE FAIT JAMAIS
CASE 1: ' PION BLANC
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
CASE 2: ' PION NOIR
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
CASE 9: ' DAME BLANCHE
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case-3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%-6,r% - 7 : 2D_PEN_WIDTH 3
CASE 8: ' DAME NOIRE
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%,r% - 7 : 2D_PEN_WIDTH 3
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE k%*pas_case+r%,j%*pas_case-3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE k%*pas_case+r%,j%*pas_case+r%-6,r% - 7 : 2D_PEN_WIDTH 3
END_SELECT
RETURN

Clic_Damier:
Sposx = INT(MOUSE_X_POSITION(2)/pas_case) : Sposy = INT(MOUSE_Y_POSITION(2)/pas_case)

Clic_Damier3:
OFF_CLICK 2
GOSUB Test_PeutJouer
IF tour=0
' Tour des blancs
IF damier%(Sposy,Sposx) = 1 OR damier%(Sposy,Sposx) = 9
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
IF damier%(Sposy,Sposx) = 1 THEN Message$=" le pion en "
IF damier%(Sposy,Sposx) = 9 THEN Message$=" la dame en "
Message$=Message$+CHR$(65+Sposx)+":"+CHR$(48+Sposy)
ON_CLICK 2, Clic2_Damier_blancs
ELSE
ON_CLICK 2, Clic_Damier
END_IF
ELSE
' Tour des noirs
IF damier%(Sposy,Sposx) = 2 OR damier%(Sposy,Sposx) = 8
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
IF damier%(Sposy,Sposx) = 2 THEN Message$=" le pion en "
IF damier%(Sposy,Sposx) = 8 THEN Message$=" la dame en "
Message$=Message$+CHR$(65+Sposx)+":"+CHR$(48+Sposy)
ON_CLICK 2, Clic2_Damier_noirs
ELSE
ON_CLICK 2, Clic_Damier
END_IF
END_IF
RETURN

Clic2_Damier_noirs:
Nposx = INT(MOUSE_X_POSITION(2)/pas_case) : Nposy = INT(MOUSE_Y_POSITION(2)/pas_case)
OFF_CLICK 2
IF (NposX <> SposX OR NposY <> SposY) AND (Damier%(NposY,NposX) = 0 OR Damier%(NposY,NposX) = 2 OR Damier%(NposY,NposX) = 8)
Delta=ABS(Sposx - Nposx):PeutPrendre=0:i%=0:Cpt=0
IF Delta > 0 THEN j%=(NposX - SposX)/Delta : k%=(NposY - SposY)/Delta
IF damier%(Nposy,Nposx) = 0 AND Delta > 0
IF (((NposY - Delta) = SposY) OR ((NposY + Delta) = SposY)) THEN i%=2
END_IF
IF Delta = 1 AND SposY < NposY AND i%=2
PeutPrendre=1
ELSE
IF Delta = 2 AND i%=2
IF Damier%(SposY+k%,SposX+j%)=1 OR Damier%(SposY+k%,SposX+j%)=9 THEN PeutPrendre=1:Cpt=1:PionX=SposX+j%: PionY=SposY+k%
ELSE
IF Damier%(SposY,SposX)=8 AND i%=2
PeutPrendre=1
FOR i% = 1 TO Delta
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=1 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=9
IF Cpt=0
Cpt=1:PionX=SposX+(j%*i%): PionY=SposY+(k%*i%)
ELSE
PeutPrendre=0 : i%=Delta
END_IF
ELSE
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))=2 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=8 THEN PeutPrendre=0 : i%=Delta
END_IF
NEXT i%
END_IF
END_IF
END_IF
IF PeutPrendre=1
IF Cpt=0
IF DoitPrendre=0
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
tour= 0 : 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30, 100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_TARGET_IS 2 : ON_CLICK 2, Clic_Damier
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les noirs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
ELSE
Message$="Irrégularité des noirs: vous devez prendre ("+CHR$(65+PrendreX)+":"+STR$(PrendreY)+")":GOSUB Ajout_Liste916
Message$="Pion à prendre: ("+CHR$(65+PrendreX2)+":"+STR$(PrendreY2)+")":GOSUB Ajout_Liste916
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic_Damier
END_IF
ELSE
IF Cpt=1
damier%(PionY,PionX)=0 : Nb_blancs = Nb_blancs - 1 : CAPTION 40,Nb_blancs
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE (PionX)*pas_case,(PionY)*pas_case,(PionX+1)*pas_case,(PionY+1)*pas_case
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les noirs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
IF Nb_blancs <=0
Message$="Il ne reste plus de pion blanc. Les noirs gagnent": GOSUB Ajout_Liste916
ELSE
IF damier%(NposY,NposX)=2 THEN GOSUB Test_PeutPrendre
IF damier%(NposY,NposX)=8 THEN GOSUB Test_PeutPrendre_Dame
IF PeutPrendre = 0
tour=0 : 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30, 100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_TARGET_IS 2 : ON_CLICK 2, Clic_Damier
ELSE
Sposx=Nposx : Sposy=Nposy
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic2_Damier_noirs
END_IF
END_IF
END_IF
END_IF
ELSE
IF damier%(Nposy,Nposx) = 2 or damier%(Nposy,Nposx) = 8
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=SposY:k%=SposX: GOSUB Dessine_piece
Sposx=Nposx : Sposy=Nposy : GOSUB Clic_Damier3
ELSE
ON_CLICK 2,Clic2_Damier_noirs
END_IF
END_IF
IF tour=0 AND Nposy=9 THEN IF damier%(Nposy,Nposx)=2 THEN j%=Nposy : k%= Nposx : damier%(j%,k%)=8 : GOSUB Dessine_piece
ELSE
ON_CLICK 2,Clic2_Damier_noirs
END_IF
IF Nb_blancs= 0 THEN GOTO Fin
RETURN

Clic2_Damier_blancs:
Nposx = INT(MOUSE_X_POSITION(2)/pas_case) : Nposy = INT(MOUSE_Y_POSITION(2)/pas_case)
OFF_CLICK 2
IF (NposX <> SposX OR NposY <> SposY) AND (Damier%(NposY,NposX) = 0 OR Damier%(NposY,NposX) = 1 OR Damier%(NposY,NposX) = 9)
Delta=abs(Sposx - Nposx): PeutPrendre=0:i%=0:Cpt=0
IF Delta > 0 THEN j%=(NposX - SposX)/Delta : k%=(NposY - SposY)/Delta
IF damier%(Nposy,Nposx) = 0 AND Delta > 0
IF ((NposY > SposY) AND NposY = (SposY + Delta)) THEN i%=2
IF ((NposY < SposY) AND NposY = (SposY - Delta)) THEN i%=2
END_IF
IF Delta = 1 AND SposY > NposY AND i%=2
PeutPrendre=1
ELSE
IF Delta = 2 AND i%=2
IF Damier%(SposY+k%,SposX+j%)=2 OR Damier%(SposY+k%,SposX+j%)=8 THEN PeutPrendre=1:Cpt=1:PionX=SposX+j%: PionY=SposY+k%
ELSE
IF Damier%(SposY,SposX)=9 AND i%=2
PeutPrendre=1
FOR i% = 1 TO (Delta-1)
IF (Damier%(SposY+(k%*i%),SposX+(j%*i%))=2 OR Damier%(SposY+(k%*i%),SposX+(j%*i%))=8) AND Cpt=0
Cpt=1:PionX=SposX+(j%*i%): PionY=SposY+(k%*i%)
ELSE
IF Damier%(SposY+(k%*i%),SposX+(j%*i%))<>0 THEN PeutPrendre=0 : i%=Delta
END_IF
NEXT i%
END_IF
END_IF
END_IF

IF PeutPrendre=1
IF Cpt=0
IF DoitPrendre=0
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
tour = 1 : 2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7 : 2D_TARGET_IS 2
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les blancs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
ON_CLICK 2, Clic_Damier
ELSE
Message$="Irrégularité des blancs: vous devez prendre ("+CHR$(65+PrendreX)+":"+STR$(PrendreY)+")" :GOSUB Ajout_Liste916
Message$="Pion à prendre: ("+CHR$(65+PrendreX2)+":"+STR$(PrendreY2)+")":GOSUB Ajout_Liste916
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic_Damier
END_IF
ELSE
IF Cpt=1
damier%(PionY,PionX)=0 : Nb_Noirs = Nb_Noirs - 1 : CAPTION 41,Nb_noirs
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE (PionX)*pas_case,(PionY)*pas_case,(PionX+1)*pas_case,(PionY+1)*pas_case
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Nposy : k%= Nposx : damier%(j%,k%) = damier%(Sposy,Sposx) : damier%(Sposy,Sposx)=0 : GOSUB Dessine_piece
IF COUNT(916) > taille_max_liste THEN ITEM_DELETE 916,1
ITEM_ADD 916,"Les blancs jouent"+Message$+"-"+CHR$(65+Nposx)+":"+CHR$(48+Nposy)
IF Nb_Noirs <=0
Message$="Il ne reste plus de pion noir. Les blancs gagnent":GOSUB Ajout_Liste916
ELSE
IF damier%(NposY,NposX)=1 THEN GOSUB Test_PeutPrendre
IF damier%(NposY,NposX)=9 THEN GOSUB Test_PeutPrendre_Dame
IF PeutPrendre = 0
tour = 1: 2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7 : 2D_TARGET_IS 2
ON_CLICK 2, Clic_Damier
ELSE
Sposx=Nposx : Sposy=Nposy
2D_PEN_COLOR 255,0,0 : 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=Sposy : k%= Sposx : GOSUB Dessine_piece
ON_CLICK 2, Clic2_Damier_blancs
END_IF
END_IF
END_IF
END_IF
ELSE
IF damier%(Nposy,Nposx) = 1 or damier%(Nposy,Nposx) = 9
2D_PEN_COLOR 40,40,40: 2D_FILL_COLOR CCR,CCV,CCB
2D_RECTANGLE Sposx*pas_case,Sposy*pas_case,(Sposx+1)*pas_case,(Sposy+1)*pas_case
j%=SposY:k%=SposX: GOSUB Dessine_piece
Sposx=Nposx : Sposy=Nposy : GOSUB Clic_Damier3
ELSE
ON_CLICK 2,Clic2_Damier_blancs
END_IF
END_IF
IF tour=1 AND Nposy=0
IF damier%(Nposy,Nposx)=1
Message$="Nouvelle Dame blanche en "+CHR$(65+Nposx)+":"+CHR$(48+Nposy):GOSUB Ajout_Liste916
j%=Nposy : k%= Nposx : damier%(j%,k%)=9 : GOSUB Dessine_piece
END_IF
END_IF
ELSE
ON_CLICK 2,Clic2_Damier_blancs
END_IF
IF Nb_noirs=0 THEN GOTO Fin
RETURN

Test_deplacement:
cas%=0
IF damier%(Nposy,Nposx)=1 AND tour=0 THEN cas%= 1
IF damier%(Nposy,Nposx)=2 AND tour=1 THEN cas%= 2
IF damier%(Nposy,Nposx)=8 OR damier%(Nposy,Nposx)=9 THEN cas%= 3
IF cas% > 0
IF Nposx < 9 AND Nposy < 9
IF cas%=2 OR cas%=3
IF damier%(Nposy+1,Nposx+1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx < 9 AND Nposy > 0
IF cas%=1 OR cas%=3
IF damier%(Nposy-1,Nposx+1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx > 0 AND Nposy < 9
IF cas%=2 OR cas%=3
IF damier%(Nposy+1,Nposx-1)=0 THEN PeutJouer = 1
END_IF
END_IF
IF Nposx > 0 AND Nposy > 0
IF cas%=1 OR cas%=3
IF damier%(Nposy-1,Nposx-1)=0 THEN PeutJouer = 1
END_IF
END_IF
END_IF
RETURN

Test_PeutJouer:
case% = 0: PeutPrendre=0 : DoitPrendre = 0 : PeutJouer=0 : PrendreX = -1: PrendreY= -1
FOR Nposy = 0 TO 9 : ' Correspond à la ligne (y)
FOR Nposx = 0 TO 9 : ' Correspond à la rangée (x)
IF case% = 0
case% = 1 : ' Case vide, on passe
ELSE
GOSUB Test_deplacement : IF PeutJouer = 1 THEN h%=1
IF (damier%(Nposy,Nposx)=1 AND tour=0) OR (damier%(Nposy,Nposx)=2 AND tour=1) THEN GOSUB Test_PeutPrendre
IF (damier%(Nposy,Nposx)=9 AND tour=0) OR (damier%(Nposy,Nposx)=8 AND tour=1) THEN GOSUB Test_PeutPrendre_Dame
IF PeutPrendre = 1 THEN DoitPrendre = 1: h% = 1 : PrendreX=TempX : PrendreY=TempY : PrendreX2=TempX2 : PrendreY2=TempY2
case% = 0
END_IF
NEXT NposX
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT NposY
IF h%=1 THEN PeutJouer=1
IF Tour=0 AND PeutJouer=0 THEN Message$="Fin de partie, les blancs ne peuvent plus jouer" : GOSUB Ajout_Liste916
IF Tour=0 AND PeutJouer=0 THEN Message$="Les noirs gagnent" : GOSUB Ajout_Liste916
IF Tour=1 AND PeutJouer=0 THEN Message$="Fin de partie, les noirs ne peuvent plus jouer" : GOSUB Ajout_Liste916
IF Tour=1 AND PeutJouer=0 THEN Message$="Les blancs gagnent" : GOSUB Ajout_Liste916
IF PeutJouer=0 THEN GOTO FIN
RETURN

Test_PeutPrendre_dame:
PeutPrendre = 0: Delta = 0
IF tour=0 THEN j%=2 : k%=8 : l%=1 : m%=9
IF tour=1 THEN j%=1 : k%=9 : l%=2 : m%=8

IF Nposx < 8 AND Nposy < 8
IF Nposx > Nposy THEN Delta = 8-Nposx :ELSE : Delta = 8-Nposy
TempPrendre = 0
FOR i% = 1 TO Delta
IF (damier%(Nposy+i%,Nposx+i%)=l% OR damier%(Nposy+i%,Nposx+i%)=m%) THEN TempPrendre = -1
IF (damier%(Nposy+i%,Nposx+i%)=j% OR damier%(Nposy+i%,Nposx+i%)=k%) AND damier%(Nposy+i%+1,Nposx+i%+1)<> 0 THEN TempPrendre = -1
IF (damier%(Nposy+i%,Nposx+i%)=j% OR damier%(Nposy+i%,Nposx+i%)=k%) AND damier%(Nposy+i%+1,Nposx+i%+1) = 0 THEN TempPrendre = 1: TempX=Nposx : TempY=NposY:: TempX2=Nposx+i% : TempY2=NposY+i%
IF TempPrendre <> 0 THEN EXIT_FOR
NEXT i%
IF TempPrendre=1 THEN PeutPrendre = 1
END_IF

IF Nposx < 8 AND Nposy > 1
IF Nposy >= (8-Nposx) THEN Delta= 8-Nposx : ELSE : Delta = Nposy-1
TempPrendre = 0
FOR i% = 1 TO Delta
IF (damier%(Nposy-i%,Nposx+i%)=l% OR damier%(Nposy-i%,Nposx+i%)=m%) THEN TempPrendre = -1
IF (damier%(Nposy-i%,Nposx+i%)=j% OR damier%(Nposy-i%,Nposx+i%)=k%) AND damier%(Nposy-i%-1,Nposx+i%+1)<> 0 THEN TempPrendre = -1
IF (damier%(Nposy-i%,Nposx+i%)=j% OR damier%(Nposy-i%,Nposx+i%)=k%) AND damier%(Nposy-i%-1,Nposx+i%+1) = 0 THEN TempPrendre = 1 : TempX=Nposx : TempY=NposY: TempX2=Nposx+i% : TempY2=NposY-i%
IF TempPrendre <> 0 THEN EXIT_FOR
NEXT i%
IF TempPrendre=1 THEN PeutPrendre = 1
END_IF

IF Nposx > 1 AND Nposy < 8
IF ((8-Nposy) > (Nposx-1)) THEN Delta= Nposx -1: ELSE : Delta = 8-Nposy
TempPrendre = 0
FOR i% = 1 TO Delta
IF (damier%(Nposy+i%,Nposx-i%)=l% OR damier%(Nposy+i%,Nposx-i%)=m%) THEN TempPrendre = -1
IF (damier%(Nposy+i%,Nposx-i%)=j% OR damier%(Nposy+i%,Nposx-i%)=k%) AND damier%(Nposy+i%+1,Nposx-i%-1)<> 0 THEN TempPrendre = -1
IF (damier%(Nposy+i%,Nposx-i%)=j% OR damier%(Nposy+i%,Nposx-i%)=k%) AND damier%(Nposy+i%+1,Nposx-i%-1) = 0 THEN TempPrendre = 1 : TempX=Nposx : TempY=NposY: TempX2=Nposx-i% : TempY2=NposY+i%
IF TempPrendre <> 0 THEN EXIT_FOR
NEXT i%
IF TempPrendre=1 THEN PeutPrendre = 1
END_IF

IF Nposx > 1 AND Nposy > 1
IF Nposx > Nposy THEN Delta= Nposy-1: ELSE : Delta = Nposx-1
TempPrendre = 0
FOR i% = 1 TO Delta
IF (damier%(Nposy-i%,Nposx-i%)=l% OR damier%(Nposy-i%,Nposx-i%)=m%) THEN TempPrendre = -1
IF (damier%(Nposy-i%,Nposx-i%)=j% OR damier%(Nposy-i%,Nposx-i%)=k%) AND damier%(Nposy-i%-1,Nposx-i%-1)<> 0 THEN TempPrendre = -1
IF (damier%(Nposy-i%,Nposx-i%)=j% OR damier%(Nposy-i%,Nposx-i%)=k%) AND damier%(Nposy-i%-1,Nposx-i%-1) = 0 THEN TempPrendre = 1 : TempX=Nposx : TempY=NposY: TempX2=Nposx-i% : TempY2=NposY-i%
IF TempPrendre <> 0 THEN EXIT_FOR
NEXT i%
IF TempPrendre=1 THEN PeutPrendre = 1
END_IF
RETURN

Test_PeutPrendre:
TempX=-1 : TempY=-1 :PeutPrendre = 0
IF tour=0 THEN j%=2 : k%=8
IF tour=1 THEN j%=1 : k%=9
IF Nposx < 8 AND Nposy < 8
IF (damier%(Nposy+1,Nposx+1)=j% OR damier%(Nposy+1,Nposx+1)=k%) AND damier%(Nposy+2,Nposx+2)= 0 THEN PeutPrendre = 1 : TempX=Nposx : TempY=NposY: TempX2=NposX+1: TempY2=NposY+1
END_IF
IF Nposx < 8 AND Nposy > 1
IF (damier%(Nposy-1,Nposx+1)=j% OR damier%(Nposy-1,Nposx+1)=k%) AND damier%(Nposy-2,Nposx+2)= 0 THEN PeutPrendre = 1 : TempX=Nposx : TempY=NposY: TempX2=NposX+1: TempY2=NposY-1
END_IF
IF Nposx > 1 AND Nposy < 8
IF (damier%(Nposy+1,Nposx-1)=j% OR damier%(Nposy+1,Nposx-1)=k%) AND damier%(Nposy+2,Nposx-2)= 0 THEN PeutPrendre = 1 :TempX=Nposx : TempY=NposY: TempX2=NposX-1: TempY2=NposY+1
END_IF
IF Nposx > 1 AND Nposy > 1
IF (damier%(Nposy-1,Nposx-1)=j% OR damier%(Nposy-1,Nposx-1)=k%) AND damier%(Nposy-2,Nposx-2)= 0 THEN PeutPrendre = 1 :TempX=Nposx : TempY=NposY: TempX2=NposX-1: TempY2=NposY-1
END_IF
RETURN

Fin:
case%=MESSAGE_CONFIRMATION_YES_NO("Voulez vous faire une nouvelle partie ?")
IF case%=1 THEN GOTO Relance
IF case%=0 THEN GOTO Fin
Terminate

Damier_Bleu_Blanc:
CAPTION 30,"X Damier Bleu foncé/Blanc": CAPTION 31," Damier Gris/Blanc"
CAPTION 32," Damier Vert foncé/Blanc": CAPTION 33," Damier Violet/Blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 30 : CCV = 30 : CCB = 180
GOSUB Dessine_damier
RETURN

Damier_Gris_Blanc:
CAPTION 30," Damier Bleu foncé/Blanc": CAPTION 31,"X Damier Gris/blanc"
CAPTION 32," Damier Vert foncé/Blanc": CAPTION 33," Damier Violet/blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 160 : CCV = 160 : CCB = 160
GOSUB Dessine_damier
RETURN

Damier_Vert_Blanc:
CAPTION 30," Damier Bleu foncé/Blanc": CAPTION 31," Damier Gris/blanc"
CAPTION 32,"X Damier Vert foncé/Blanc": CAPTION 33," Damier Violet/Blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 130 : CCV = 190 : CCB = 130
GOSUB Dessine_damier
RETURN

Damier_Violet_Blanc:
CAPTION 30," Damier Bleu foncé/blanc": CAPTION 31," Damier Gris/blanc"
CAPTION 32," Damier Vert foncé/blanc": CAPTION 33,"X Damier Violet/blanc"
CDR = 255 : CDV = 255: CDB = 255 : CCR = 200 : CCV = 60 : CCB = 200
GOSUB Dessine_damier
RETURN

Init:
COLOR 0,180,100,60
LABEL Aide,Regle,Faide, Fregle, Quitter, Clic_Damier, Clic2_Damier_blancs, Clic_Damier3, Clic2_Damier_noirs, Dessine_Damier, Dessine_piece
LABEL Test_PeutPrendre, Test_PeutPrendre_dame, Relance, Test_PeutJouer, Test_deplacement, Fin, Ajout_Liste916
LABEL Damier_Bleu_Blanc, Damier_Gris_Blanc, Damier_Vert_Blanc, Damier_Violet_Blanc
DIM x_Max, y_Max : x_Max=1000 : y_max=700
DIM Marge_x, Marge_y : Marge_x = 40 : Marge_y = 30
DIM hlp$,regle$,h%,i%,j%,k%,l%,m%,case%,tour,PeutPrendre,PeutJouer,DoitPrendre, Message$, cas%
DIM Delta,Cpt,PionX,PionY,taille_max_liste: taille_max_liste = 20
DIM PrendreX, PrendreY,PrendreX2,PrendreY2,TempX, TempY,TempX2, TempY2,TempPrendre
DIM damier%(10,10) : ' 0: Case vide, 1: Pion du joueur, 9: Dame du joueur, 2: Pion de l'Ai, 8: Dame de l'Ai
DIM Sposx, Sposy : ' Position du pion sélectionné
DIM Nposx, Nposy : ' Position de la destination sélectionné
DIM pas_case : if (y_Max - 2* Marge_y) > (x_Max - 2 * Marge_x) Then pas_case= (x_Max - 2 * Marge_x) / 11 : else: pas_case= (y_Max - 2 * Marge_y) / 11
DIM rc$ : rc$=CHR$(10)
DIM Nb_Noirs,Nb_blancs : ' Nombre de pions noirs et blancs
DIM r%: r% = pas_case/2 -1
DIM CBR,CBV,CBB, CNR, CNV, CNB
CBR = 205 : CBV = 205: CBB = 205 : ' Couleurs des pions blancs
CNR = 55 : CNV = 55 : CNB = 55 : ' Couleurs des pions noirs
DIM CDR,CDV,CDB,CCR,CCV,CCB
CDR = 255 : CDV = 255: CDB = 255 : ' Couleurs des cases 'blanches'
CCR = 150 : CCV = 150 : CCB = 50 : ' Couleurs des cases 'noires'
CAPTION 0, "Jeu de dames en Basic Panoramic par Jean-Charles"
WIDTH 0,x_Max : HEIGHT 0, y_max

' Création de l'image support pour le damier
PICTURE 2 : WIDTH 2, 10 * pas_case : HEIGHT 2, 10 * pas_case : TOP 2,Marge_y: LEFT 2, Marge_x

' Menu Principal
MAIN_MENU 1 : REM On reserve les objets 1 à 30 pour le menu
SUB_MENU 11: PARENT 11, 1: CAPTION 11, "Fichier"
SUB_MENU 12: PARENT 12, 1: CAPTION 12, "Options"
SUB_MENU 16: PARENT 16, 1: CAPTION 16, "Aide"
SUB_MENU 17: PARENT 17, 1: CAPTION 17, "Règle"
ON_CLICK 16, Aide : ON_CLICK 17, Regle

' Sous menu Fichier
SUB_MENU 25: CAPTION 25,"Relancer partie" : PARENT 25, 11
SUB_MENU 26: CAPTION 26,"Quitter" : PARENT 26, 11
ON_CLICK 25, Relance :ON_CLICK 26, Quitter

' Sous menu Options
SUB_MENU 30: CAPTION 30,"X Damier Bleu foncé/blanc" : PARENT 30, 12
SUB_MENU 31: CAPTION 31," Damier Gris/blanc" : PARENT 31, 12
SUB_MENU 32: CAPTION 32," Damier Vert foncé/blanc" : PARENT 32, 12
SUB_MENU 33: CAPTION 33," Damier Violet/blanc" : PARENT 33, 12
ON_CLICK 30, Damier_Bleu_Blanc :ON_CLICK 31, Damier_Gris_Blanc
ON_CLICK 32, Damier_Vert_Blanc :ON_CLICK 33, Damier_Violet_Blanc

' Préparation de l'aide
hlp$=CHR$(9)+CHR$(9)+CHR$(9)+" - AIDE DU JEU DE DAMES -"+rc$
hlp$=hlp$+CHR$(9)+CHR$(9)+CHR$(9)+" ==============================="+rc$+rc$
hlp$=hlp$+"A remplir"+rc$
FORM 900: TOP 900,2*Marge_y: LEFT 900,3*Marge_X: WIDTH 900,x_Max-6*Marge_X: HEIGHT 900,y_Max-4*Marge_y: HIDE 900
FONT_SIZE 900,10
LIST 901: PARENT 901,900: WIDTH 901,WIDTH(900)-16: HEIGHT 901,HEIGHT(900)-80
k% = INSTR(hlp$, rc$)
WHILE k% > 0
ITEM_ADD 901, LEFT$(hlp$, k%-1): hlp$ = MID$(hlp$, k%+1, 9000)
k% = INSTR(hlp$, rc$)
END_WHILE
BUTTON 902: PARENT 902,900: TOP 902,HEIGHT(900)-70: LEFT 902,280: CAPTION 902,"OK"
ON_CLICK 902, Faide

regle$=CHR$(9)+CHR$(9)+CHR$(9)+" - REGLES DU JEU DE DAMES -"+rc$
regle$=regle$+CHR$(9)+CHR$(9)+CHR$(9)+" ==============================="+rc$+rc$
rem regle$=regle$+""+rc$ : ' Modèle d'une ligne vide
regle$=regle$+"Le jeu de dames international se joue sur un damier carré divisé en 100 cases égales, alternativement claires et foncées."+rc$
regle$=regle$+"Le jeu se joue sur les cases foncées du damier. Il y a donc 50 cases actives."+rc$
regle$=regle$+"La plus longue diagonale, joignant deux coins du damier et comprenant 10 cases foncées, se dénomme la grande diagonale."+rc$
regle$=regle$+"Le damier doit être placé de sorte que la première case de gauche, pour chaque joueur, soit une case foncée."+rc$
regle$=regle$+"Le jeu de dames international se joue avec 20 pions blancs (clairs) et 20 pions noirs (foncés)"+rc$
regle$=regle$+"Avant de débuter une partie, les 20 pions noirs et les 20 pions blancs sont disposés sur les 4 premières rangées de chaque joueur."+rc$
regle$=regle$+"Il faut manger tous les pions de l'autre en passant par dessus avec l'un de vos pions."+rc$
regle$=regle$+"Les déplacements autorisés : seulement d'une case en avant, en diagonale si celle ci est libre."+rc$
regle$=regle$+"Le premier coup est toujours joué par les blancs. Les adversaires jouent un coup chacun à tour de rôle avec leurs pièces."+rc$
regle$=regle$+"Pour cela, on couronne le pion en plaçant dessus un deuxième pion de la même couleur."+rc$
regle$=regle$+"Il est interdit de reculer en dehors des prises"+rc$
regle$=regle$+"Si un pion avance jusqu'à la dernière rangée, il devient une Dame."+rc$
regle$=regle$+"La dame peut se déplacer de plusieurs cases en avant ou en arrière si ces cases sont vides."+rc$
regle$=regle$+"La prise des pièces adverses est obligatoire et s’effectue aussi bien en avant qu’en arrière."+rc$
regle$=regle$+"Lorsqu’un pion se trouve en présence, diagonalement, d’une pièce adverse derrière laquelle se trouve une case libre, il doit"+rc$
regle$=regle$+"obligatoirement sauter par-dessus cette pièce et occuper la case libre. Cette pièce adverse est alors enlevée du damier."+rc$
regle$=regle$+"Cette opération complète est la prise par un pion."+rc$
regle$=regle$+"Lorsqu’au cours d’une prise par un pion, celui-ci se trouve à nouveau en présence, diagonalement, d’une pièce adverse derrière "+rc$
regle$=regle$+"laquelle se trouve une case libre, il doit obligatoirement sauter par-dessus cette seconde pièce, voire d’une troisième et"+rc$
regle$=regle$+"ainsi de suite, et occuper la case libre se trouvant derrière la dernière pièce capturée. Les pièces adverses ainsi capturées"+rc$
regle$=regle$+"sont ensuite enlevées du damier dans l’ordre de la prise."+rc$
regle$=regle$+"Cette opération complète est une rafle par un pion."+rc$
regle$=regle$+"Lorsqu’au cours d’une prise par une dame, celle-ci se trouve à nouveau en présence, sur une même diagonale, d’une pièce adverse"+rc$
regle$=regle$+"derrière laquelle se trouve une ou plusieurs cases libres, elle doit obligatoirement sauter par-dessus cette seconde pièce, voire"+rc$
regle$=regle$+"d’une troisième et ainsi de suite, et occuper au choix une case libre se trouvant derrière et sur la même diagonale que la dernière"+rc$
regle$=regle$+"pièce capturée. Les pièces adverses ainsi capturées sont ensuite enlevées du damier dans l’ordre de la prise."+rc$
regle$=regle$+"Cette opération complète est une rafle par une dame."+rc$
regle$=regle$+"Au cours d’une rafle, il est interdit de passer au-dessus de ses propres pièces."+rc$
regle$=regle$+"Au cours d’une rafle, il est permis de passer plusieurs fois sur une même case libre mais il est interdit de passer plus d’une fois "+rc$
regle$=regle$+"au-dessus d’une même pièce adverse."+rc$
regle$=regle$+"Une rafle doit être clairement indiquée, pièce par pièce, en posant la pièce preneuse sur la case de saut, le temps d’y passer, et"+rc$
regle$=regle$+"en déposant cette pièce sur la case terminale."+rc$
regle$=regle$+"Les pièces prises ne peuvent être enlevées du damier qu’à l’issue de l’exécution complète de la rafle."+rc$
regle$=regle$+"La prise du plus grand nombre de pièces est prioritaire, donc obligatoire. Dans ce cas, une dame compte pour une pièce, tout comme un pion."+rc$
regle$=regle$+"Elle ne confère nulle priorité et n’impose aucune obligation."+rc$
regle$=regle$+"Si les pièces à prendre sont en nombre égal dans deux ou plusieurs possibilités de prise ou de rafle, le joueur est libre de choisir "+rc$
regle$=regle$+"une de ces possibilités, soit avec un pion, soit avec une dame."+rc$
regle$=regle$+"Un pion qui au cours d’une rafle, ne fait que passer sur une des 5 cases de la rangée de base adverse reste un pion lorsque la rafle est terminée."+rc$

FORM 910: TOP 910,2*Marge_y: LEFT 910,3*Marge_X: WIDTH 910,x_Max-6*Marge_X: HEIGHT 910,y_Max-4*Marge_y: HIDE 910
FONT_SIZE 910,10
LIST 911: PARENT 911,910: WIDTH 911,WIDTH(910)-16: HEIGHT 911,HEIGHT(910)-80
k% = INSTR(regle$, rc$)
WHILE k% > 0
ITEM_ADD 911, LEFT$(regle$, k%-1): regle$ = MID$(regle$, k%+1, 9000)
k% = INSTR(regle$, rc$)
END_WHILE
BUTTON 912: PARENT 912,910: TOP 912,HEIGHT(910)-70: LEFT 912,280: CAPTION 912,"OK"
ON_CLICK 912, Fregle

' Creation des compteurs de pions
ALPHA 40 : LEFT 40,Marge_X + 12* pas_case : TOP 40,pas_case - 15: WIDTH 40, 40 : FONT_SIZE 40,20
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_PEN_WIDTH 3 : 2D_CIRCLE 11.5*pas_case+r%,0.5*pas_case+3+r%,r% - 7
2D_PEN_COLOR CBR - 60,CBV - 60,CBB - 60 : 2D_FILL_COLOR CBR,CBV,CBB : 2D_CIRCLE 11.5*pas_case+r%,0.5*pas_case+r%,r% - 7
ALPHA 41 : LEFT 41,5*Marge_X + 12* pas_case : TOP 41,pas_case - 15: WIDTH 41, 40 : FONT_SIZE 41,20
2D_PEN_COLOR 20, 20, 20 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_PEN_WIDTH 3 : 2D_CIRCLE 11.5*pas_case+r%+4*Marge_X,0.5*pas_case+3+r%,r% - 7
2D_PEN_COLOR CNR - 30,CNV - 30,CNB - 30 : 2D_FILL_COLOR CNR,CNV,CNB : 2D_CIRCLE 11.5*pas_case+r%+4*Marge_X,0.5*pas_case+r%,r% - 7
LIST 916 : TOP 916,pas_case+r%+Marge_Y : HEIGHT 916,HEIGHT(0) - (pas_case+r%+4*Marge_Y): FONT_SIZE 916,10
LEFT 916,10*pas_case+Marge_X+20 : WIDTH 916,WIDTH(0) - (10.5*pas_case+r%+Marge_X)
FOR k% = 0 TO 9
i% = 50+k% : ALPHA i%: TOP i%,Marge_Y-32 : WIDTH i%,20 : LEFT i%, (k%+0.5)*pas_case + 30 : FONT_SIZE i%,20 : CAPTION i%,CHR$(65+k%)
i% = 60+k% : ALPHA i%: TOP i%,Marge_Y-20 + (k%+0.5)*pas_case : WIDTH i%,20 : LEFT i%, 10 : FONT_SIZE i%,20 : CAPTION i%,CHR$(48+k%)
NEXT k%

Relance:
' INITIALISATION DES PIONS SUR LE DAMIER
' PIONS DE L'AI
case% = 0
FOR j% = 0 TO 3
FOR k% = 0 TO 9
IF case% = 0 THEN damier%(j%,k%)= -1:case% = 1 : ELSE : damier%(j%,k%)= 2 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
' CASES VIDES
case%=0
FOR j% = 4 TO 5
FOR k% = 0 TO 9
IF case% = 0 THEN damier%(j%,k%)= -1:case% = 1 : ELSE : damier%(j%,k%)= 0 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%
' PIONS DU JOUEUR
case% = 0
FOR j% = 6 TO 9
FOR k% = 0 TO 9
IF case% = 0 THEN damier%(j%,k%)= -1:case% = 1 : ELSE : damier%(j%,k%)= 1 : case% = 0
NEXT k%
IF case%=0 THEN case%=1 : ELSE : case%=0
NEXT j%

Nb_Noirs = 20 : Nb_blancs = 20 :CAPTION 40,Nb_blancs : CAPTION 41,Nb_noirs

tour=0 : ' Les blancs commencent
2D_TARGET_IS 0 : 2D_PEN_COLOR 180,100,60 : 2D_FILL_COLOR 180,100,60 : 2D_CIRCLE 11*pas_case+r%+4*Marge_X-10,0.5*pas_case+r%,7
2D_PEN_COLOR 30,100,30 : 2D_FILL_COLOR 60,150,60 : 2D_CIRCLE 11*pas_case+r%-10,0.5*pas_case+r%,7
CLEAR 916: Message$="Les pions blancs commencent": ITEM_ADD 916, Message$

' Représentation du Damier
GOSUB Dessine_Damier
ON_CLICK 2, Clic_Damier

END

Je viens de faire 2 parties, çà semble aller bien.

A+

Bonsoir Jicehel, Smile

Ça semble bien fonctionner maintenant, pas de problèmes particuliers. Mais je regrette que tu n'essaye pas de continuer sur l'IA. Mais c'est toi qui voit!
A+ Wink

Merci, je n'abandonne pas, mais bon là je n'ai pas trop le temps et j'ai la tête ailleurs, je m'y mettrais juste plus tard. A priori, ce n'est pas très sorcier par contre la méthode peut être éventuellement assez gourmande en calculs alors j'essayerai bientôt avec la V1 compilée Wink

C'est juste une pause sur l'IA et en aucun cas un abandon

» Le problème des 8 dames
» Le source d'un jeu de dames internationnales si ça interesse
» Le problème des huit dames
» Les dames françaises - la table d'exercices