Les dames françaises - la table d'exercices

rem ' Dames françaises
   dim a , i , j : rem Variables provisoires numériques
   dim a$ : rem Variables provisoires alphanumériques
   dim ae : rem Ancien Emplacement du clic
   dim cc(10,10) , cp(10,10) : rem Contenu des Cases du damier et son double
   dim cf : rem Couleur du feu du bas (vert=0 - rouge=1)
   dim ir : rem Indicateur de point Rouge
   dim nq : rem Numéroc où s`est passé le clic
   dim tq : rem Tour du clic (celleule de départ ou d`arrivée)
   dim tt1 , tt2 : rem Totaux des blancs et des noirs
   label aide : rem Aide à l`utilisation du programme
   label ajoutb : rem Placer un pion Blanc
   label ajoutn : rem Placer un pion Noir
   label clic : rem Clic sur les cases blanches
   label dame : rem Transformer en dame
   label feux : rem Inversion des feux bicolores
   label invers : rem Inverser les noirs et les blancs
   label new : rem Nouvelle partie
   label oter : rem retirer un pion
   label regles : rem Rappel des règles du jeu des dames françaises
   label totaux : rem Calcul des totaux de pions présents sur le damier
   label vider : rem Vider le damier
   label zquit : rem Quitter le programme

rem form0
   width 0,1000
   height 0,730
   caption 0," Dames françaises - Table d'exercices"

rem Boutons de commande
   button 48
      left 48,820
      top 48,413
      width 48,100
      height 48,68
      font_bold 48
      font_size 48,12
      caption 48,"Règles"
      on_click 48,regles
   button 50
      left 50,820
      top 50,5
      width 50,100
      height 50,68
      font_bold 50
      font_size 50,12
      caption 50,"Ôter"
      on_click 50,oter
   button 52
      left 52,820
      top 52,73
      width 52,100
      height 52,68
      font_bold 52
      font_size 52,12
      caption 52,"Dame"
      on_click 52,dame
   button 54
      left 54,820
      top 54,141
      width 54,100
      height 54,68
      font_bold 54
      font_size 54,32
      font_name 54,"Wingdings 3"
      caption 54,chr$(69)
      on_click 54,invers
   button 56
      left 56,13
      top 56,348
      width 56,100
      height 56,68
      font_bold 56
      font_size 56,32
      font_name 56,"Wingdings"
      caption 56,chr$(244)
      on_click 56,feux
   button 58
      left 58,820
      top 58,481
      width 58,100
      height 58,68
      font_bold 58
      font_size 58,12
      caption 58,"Vider"
      on_click 58,vider
   button 60
      left 60,820
      top 60,549
      width 60,100
      height 60,68
      font_bold 60
      font_size 60,12
      caption 60,"Nouveau"
      on_click 60,new
   button 62
      left 62,820
      top 62,345
      width 62,100
      height 62,68
      font_bold 62
      font_size 62,12
      caption 62,"Aide"
      on_click 62,aide
   button 64
      left 64,820
      top 64,617
      width 64,100
      height 64,68
      font_bold 64
      font_size 64,12
      caption 64,"Quitter"
      on_click 64,zquit
   button 66
      left 66,820
      top 66,209
      width 66,100
      height 66,68
      font_bold 66
      font_size 66,12
      caption 66,"+ Blanc"
      on_click 66,ajoutb
   button 68
      left 68,820
      top 68,277
      width 68,100
      height 68,68
      font_bold 68
      font_size 68,12
      caption 68,"+ Noir"
      on_click 68,ajoutn

rem Affichettes blancs/noirs
   alpha 70
      left 70,50
      top 70,5
      width 70,75
      height 70,30
      color 70,0,0,0
   alpha 71
      left 71,70
      top 71,13
      font_bold 71
      color 71,0,0,0
      font_color 71,255,255,255
      caption 71,"Noirs"
   alpha 73
      left 73,50
      top 73,655
      width 73,75
      height 73,30
      color 73,255,255,255
   alpha 74
      left 74,70
      top 74,663
      font_bold 74
      color 74,255,255,255
      caption 74,"Blancs"

rem Affichage des totaux de chaque joueur
   alpha 75
      left 75,23
      top 75,180
      width 75,40
      height 75,30
      color 75,255,255,255
   alpha 76
      left 76,63
      top 76,180
      width 76,40
      height 76,30
      color 76,0,0,0
   alpha 78
      left 78,32
      top 78,185
      font_bold 78
      font_size 78,12
      color 78,255,255,255
   alpha 79
      left 79,72
      top 79,185
      font_bold 79
      font_size 79,12
      color 79,0,0,0
      font_color 79,255,255,255

rem Fond du damier
   alpha 80
      left 80,125
      width 80,690
      height 80,690
      color 80,120,90,0
      
rem Affichage des feux bicolores
   alpha 90
      left 90,30
      top 90,55
      width 90,68
      height 90,68
      color 90,255,0,0
   alpha 92
      left 92,30
      top 92,565
      width 92,68
      height 92,68
      color 92,0,255,0
   alpha 94
      left 94,38
      top 94,592
      font_bold 94
      font_size 94,10
      color 94,0,255,0
      caption 94,"A  vous"

rem Affichage du damier et des pions
   for i=1 to 10
      for j=1 to 10
         picture 99+(i-1)*10+j
            left 99+(i-1)*10+j,(j-1)*68+130
            top 99+(i-1)*10+j,(i-1)*68+5
            width 99+(i-1)*10+j,68
            height 99+(i-1)*10+j,68
            color 99+(i-1)*10+j,255,255,200
            if odd(i)=odd(j)
               color 99+(i-1)*10+j,0,150,255
               cc(i,j)=-1
            else
               on_click 99+(i-1)*10+j,clic
               if i>6
                  2d_target_is 99+(i-1)*10+j
                  2d_circle 34,34,30
                  cc(i,j)=1
               end_if
               if i<5
                  2d_target_is 99+(i-1)*10+j
                  2d_fill_color 0,0,0
                  2d_circle 34,34,30
                  cc(i,j)=2
               end_if
            end_if
      next j
   next i
   gosub totaux
  
end : rem ' Début des routines ===============================================

aide: : rem Aide à l`utilisation du programme
   application_title "Aide du programme Dames"
   a$="- Pour avancer un pion, cliquez dessus et ensuite"+chr$(13)
   a$=a$+"  sur la case où vous souhaitez le placer."+chr$(13)
   a$=a$+"- Pour ôter un pion ou le transformer en dame,"+chr$(13)
   a$=a$+"  cliquez d'abord dessus avant de presser le bouton."+chr$(13)
   a$=a$+"- Pour ajouter un pion blanc ou noir, cliquez d'abord"+chr$(13)
   a$=a$+"  sur la case où vous désirez le placer avant de"+chr$(13)
   a$=a$+"  presser le bouton correspondant."
   message a$
return

ajoutb: : rem Placer un pion Blanc
   if nq>99
      if (cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)=0) and (ir=1)
         cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)=1
         2d_target_is nq
         2d_fill_color 255,255,255
         2d_pen_color 0,0,0
         2d_circle 34,34,30
         gosub totaux
         active 54
         tq=1-tq
         ir=0
      end_if
   end_if
return

ajoutn: : rem Placer un pion Noir
   if nq>99
      if (cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)=0) and (ir=1)
         cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)=2
         2d_target_is nq
         2d_fill_color 0,0,0
         2d_pen_color 0,0,0
         2d_circle 34,34,30
         gosub totaux
         active 54
         tq=1-tq
         ir=0
      end_if
   end_if
return

clic: : rem Clic sur les cases blanches
   nq=number_click
   tq=1-tq
   if tq=1
      2d_target_is nq
      2d_fill_color 255,0,0
      2d_pen_color 255,0,0
      2d_circle 34,34,15
      inactive 54
      ae=nq
      ir=1
   else
      if ae<>nq
         2d_target_is ae
         2d_fill_color 255,255,200
         2d_pen_color 255,255,200
         2d_circle 34,34,30
         2d_target_is nq
         2d_pen_color 0,0,0
         cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)=cc((int((ae-100)/10)+1),(ae-(int(ae/10)*10))+1)
         cc((int((ae-100)/10)+1),(ae-(int(ae/10)*10))+1)=0
         select cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)
            case 0 : 2d_fill_color 255,255,200 : 2d_pen_color 255,255,200
            case 1 : 2d_fill_color 255,255,255
            case 2 : 2d_fill_color 0,0,0
            case 3 : 2d_fill_color 255,190,255
            case 4 : 2d_fill_color 140,0,255
         end_select
         2d_circle 34,34,30
         gosub totaux
         gosub feux
      else
         2d_target_is nq
         2d_pen_color 0,0,0
         select cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)
            case 0 : 2d_fill_color 255,255,200 : 2d_pen_color 255,255,200
            case 1 : 2d_fill_color 255,255,255
            case 2 : 2d_fill_color 0,0,0
            case 3 : 2d_fill_color 255,190,255
            case 4 : 2d_fill_color 140,0,255
         end_select
         2d_circle 34,34,30
      end_if
      ir=0
      active 54
   end_if
return

dame: : rem Transformer en dame
   if nq>99
      if cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)>0 and ir=1
         2d_target_is nq
         if cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)=1
            2d_fill_color 255,190,255
         end_if
         if cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)=2
            2d_fill_color 140,0,255
         end_if
         2d_pen_color 0,0,0
         2d_circle 34,34,30
         cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)=cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)+2
         active 54
         tq=1-tq
         ae=nq
         ir=0
      end_if
   end_if
return

feux: : rem Inversion des feux bicolores
   cf=1-cf
   if cf=1
      color 90,0,255,0
      color 92,255,0,0
      top 94,82
   else
      color 90,255,0,0
      color 92,0,255,0
      top 94,592
   end_if
return

invers: : rem Inverser les noirs et les blancs
   for i=1 to 10
      for j=1 to 10
         cp(i,j)=cc(11-i,11-j)
      next j
   next i
   for i=1 to 10
      for j=1 to 10
         cc(i,j)=cp(i,j)
         2d_target_is 99+(i-1)*10+j
         2d_pen_color 0,0,0
         select cc(i,j)
            case 0 : 2d_fill_color 255,255,200 : 2d_pen_color 255,255,200
            case 1 : 2d_fill_color 255,255,255
            case 2 : 2d_fill_color 0,0,0
            case 3 : 2d_fill_color 255,190,255
            case 4 : 2d_fill_color 140,0,255
         end_select
         if cc(i,j)>-1
            2d_circle 34,34,30
         end_if
      next j
   next i
   top 70,660-top(70)
   top 71,676-top(71)
   top 73,660-top(73)
   top 74,676-top(74)
   gosub feux
   ir=0
return

new: : rem Nouvelle partie
   a=message_confirmation_yes_no("Vous voulez vraiment réinitialiser le damier ?")
   if a=1
      for i=1 to 10
         for j=1 to 10
            if cc(i,j)>-1
               2d_target_is 99+(i-1)*10+j
               2d_fill_color 255,255,200
               2d_pen_color 255,255,200
               2d_circle 34,34,30
               cc(i,j)=0
            end_if
         next j
      next i
      for i=1 to 10
         for j=1 to 10
            if cc(i,j)>-1
               if i>6
                  2d_target_is 99+(i-1)*10+j
                  2d_pen_color 0,0,0
                  2d_fill_color 255,255,255
                  2d_circle 34,34,30
                  cc(i,j)=1
               end_if
               if i<5
                  2d_target_is 99+(i-1)*10+j
                  2d_pen_color 0,0,0
                  2d_fill_color 0,0,0
                  2d_circle 34,34,30
                  cc(i,j)=2
               end_if
            end_if
         next j
      next i
      gosub totaux
      ir=0
   end_if
return

oter: : rem retirer un pion
   if nq>99
      if cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)>0 and ir=1
         cc((int((nq-100)/10)+1),(nq-(int(nq/10)*10))+1)=0
         2d_target_is nq
         2d_fill_color 255,255,200
         2d_pen_color 255,255,200
         2d_circle 34,34,30
         tq=1-tq
         gosub totaux
         active 54
         ir=0
      end_if
   end_if
return

regles: : rem Rappel des règles du jeu des dames françaises
   application_title "Règles du jeu des dames françaises"
   a$="   Dans les dames françaises, les blancs commencent. Le pion se déplace"+chr$(13)
   a$=a$+"en diagonale d'une case en avant exclusivement sur les cases blanches."+chr$(13)
   a$=a$+"Il ne peut revenir en arrière, sauf pour prendre. Pour cela, il doit"+chr$(13)
   a$=a$+"sauter par dessus un pion adverse et occuper une nouvelle case libre."+chr$(13)
   a$=a$+"Il peut continuer à sauter ainsi par dessus d'autres pions, y compris"+chr$(13)
   a$=a$+"en arrière. Ces prises sont obligatoires. L'ancienne règle du soufflage"+chr$(13)
   a$=a$+"n'est plus légale depuis plus d'un demi siècle. A la place, le joueur"+chr$(13)
   a$=a$+"fautif peut recommencer ce qu'il a fait. Si plusieurs chemins possibles"+chr$(13)
   a$=a$+"s'offrent à lui, il doit choisir celui qui lui permettra de prendre le"+chr$(13)
   a$=a$+"plus grand nombre de pions, et ne peut pas préférer prendre une dame"+chr$(13)
   a$=a$+"à la place de plusieurs pions. Les pions capturés doivent être retirés"+chr$(13)
   a$=a$+"seulement à la fin de toute la série de prises."+chr$(13)+chr$(13)
   a$=a$+"   Quand un pion atteint la 10° rangée, il devient automatiquement dame."+chr$(13)
   a$=a$+"Il ne peut devenir dame simplement « en passant », pendant une"+chr$(13)
   a$=a$+"succession de prises. La dame doit attendre que l'adversaire ait joué"+chr$(13)
   a$=a$+"pour entrer en action. Elle se déplace en avant et en arrière et prend"+chr$(13)
   a$=a$+"comme le pion, mais elle peut enjamber autant de cases diagonales en"+chr$(13)
   a$=a$+"ligne droite qu'elle veut, avant de prendre un pion, ou après l'avoir"+chr$(13)
   a$=a$+"pris, pour en prendre d'autres. Le jeu consiste à s'emparer de toutes"+chr$(13)
   a$=a$+"les pièces de l'adversaire, ou à les bloquer, en protégeant les siennes."+chr$(13)
   a$=a$+"La nullité est possible quand le jeu n'est plus en possibilité d'évoluer."
   message a$
return

totaux: : rem Calcul des totaux de pions présents sur le damier
   tt1=0 : tt2=0
   for i=1 to 10
      for j=1 to 10
         if cc(i,j)=1 or cc(i,j)=3
            tt1=tt1+1
         end_if
         if cc(i,j)=2 or cc(i,j)=4
            tt2=tt2+1
         end_if
      next j
   next i
   caption 78,tt1
   caption 79,tt2
return

vider: : rem Vider le damier
   a=message_confirmation_yes_no("Vous voulez vraiment vider le damier ?")
   if a=1
      for i=1 to 10
         for j=1 to 10
            if cc(i,j)>-1
               2d_target_is 99+(i-1)*10+j
               2d_fill_color 255,255,200
               2d_pen_color 255,255,200
               2d_circle 34,34,30
               cc(i,j)=0
            end_if
         next j
      next i
      gosub totaux
      ir=0
   end_if
return

zquit: : rem Quitter le programme
   a=message_confirmation_yes_no("Déjà, vous voulez nous quitter ?")
   if a=1
      terminate
   end_if
return