FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» Mah-Jong américain
par Jean Claude Hier à 19:37

» StratégoV8 et V9
par Jean Claude Hier à 13:18

» Problème avec Deepl
par Klaus Hier à 0:34

» Déformation d'image en trapèze
par Klaus Dim 14 Jan 2018 - 16:22

» Quelques nouvelles ...
par Jean Claude Ven 12 Jan 2018 - 22:40

» Renommer les instructions ITEM_... ?
par Jicehel Ven 12 Jan 2018 - 18:56

» Ludothèque Panoramic
par jjn4 Ven 12 Jan 2018 - 18:11

» sous-programmes et fonctions
par Jack Ven 12 Jan 2018 - 17:51

» KGF_dll - nouvelles versions
par Minibug Ven 12 Jan 2018 - 0:21

» Mah-Jong français
par Jean Claude Jeu 11 Jan 2018 - 22:15

» HVIEWER
par Klaus Mer 10 Jan 2018 - 2:06

» panoramic 0.9.28
par gigi75 Ven 5 Jan 2018 - 14:06

» Un jeu qui va vous énerver!
par Jean Claude Jeu 4 Jan 2018 - 22:05

» Bonne fêtes de fin d'année ! Meilleurs Vœux 2018 !
par Jicehel Jeu 4 Jan 2018 - 17:28

» Mah-Jong international
par jjn4 Jeu 4 Jan 2018 - 16:55

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Janvier 2018
LunMarMerJeuVenSamDim
1234567
891011121314
15161718192021
22232425262728
293031    
CalendrierCalendrier

Partagez | 
 

 Jeu de dames

Voir le sujet précédent Voir le sujet suivant Aller en bas 
Aller à la page : Précédent  1, 2
AuteurMessage
Jicehel

avatar

Nombre de messages : 5871
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Jeu de dames   Sam 26 Mai 2012 - 11:51

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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10411
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Jeu de dames   Sam 26 Mai 2012 - 14:24

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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Jean Claude

avatar

Nombre de messages : 5120
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Jeu de dames   Sam 26 Mai 2012 - 14:57

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+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5871
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Jeu de dames   Sam 26 Mai 2012 - 16:16

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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5871
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Jeu de dames   Sam 26 Mai 2012 - 17:21

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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
JL35



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

MessageSujet: Re: Jeu de dames   Sam 26 Mai 2012 - 17:52

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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Minibug

avatar

Nombre de messages : 2478
Age : 51
Localisation : Vienne (86)
Date d'inscription : 10/02/2012

MessageSujet: Re: Jeu de dames   Sam 26 Mai 2012 - 20:52

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...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://gpp.panoramic.free.fr
Jicehel

avatar

Nombre de messages : 5871
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Jeu de dames   Dim 27 Mai 2012 - 0:51

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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
papydall

avatar

Nombre de messages : 5623
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: Jeu de dames   Dim 27 Mai 2012 - 4:03

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!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
bignono

avatar

Nombre de messages : 1108
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: Jeu de dames   Dim 27 Mai 2012 - 8:33

Bonjour Jicehel, Smile Cool
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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
JL35



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

MessageSujet: Re: Jeu de dames   Dim 27 Mai 2012 - 9:07

Jicehel, j'ai hâte de confronter ma bêtise naturelle à ton intelligence artificielle !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5871
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Jeu de dames   Dim 27 Mai 2012 - 9:12

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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5871
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Jeu de dames   Dim 27 Mai 2012 - 13:01

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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Minibug

avatar

Nombre de messages : 2478
Age : 51
Localisation : Vienne (86)
Date d'inscription : 10/02/2012

MessageSujet: Re: Jeu de dames   Dim 27 Mai 2012 - 13:14

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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://gpp.panoramic.free.fr
papydall

avatar

Nombre de messages : 5623
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: Jeu de dames   Dim 27 Mai 2012 - 17:25

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! study lol!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Jicehel

avatar

Nombre de messages : 5871
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Jeu de dames   Lun 28 Mai 2012 - 23:54

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


Dernière édition par Jicehel le Mar 29 Mai 2012 - 7:59, édité 1 fois
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
papydall

avatar

Nombre de messages : 5623
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: Jeu de dames   Mar 29 Mai 2012 - 5:30

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+

Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Minibug

avatar

Nombre de messages : 2478
Age : 51
Localisation : Vienne (86)
Date d'inscription : 10/02/2012

MessageSujet: Re: Jeu de dames   Mar 29 Mai 2012 - 8:59

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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://gpp.panoramic.free.fr
Jean Claude

avatar

Nombre de messages : 5120
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Jeu de dames   Mar 29 Mai 2012 - 9:28

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+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5871
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Jeu de dames   Mar 29 Mai 2012 - 9:47

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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5871
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Jeu de dames   Dim 3 Juin 2012 - 17:25

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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5120
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Jeu de dames   Dim 3 Juin 2012 - 20:14

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

A+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1108
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: Jeu de dames   Lun 4 Juin 2012 - 0:00

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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5871
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Jeu de dames   Lun 4 Juin 2012 - 0:07

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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Contenu sponsorisé




MessageSujet: Re: Jeu de dames   

Revenir en haut Aller en bas
 
Jeu de dames
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 2 sur 2Aller à la page : Précédent  1, 2
 Sujets similaires
-
» Jeu de dames
» Le problème des 8 dames
» Dame Tortue

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Les jeux faits avec Panoramic-
Sauter vers: