Puissance 4 - Table d'Exercices

rem ' Puissanse-4
   dim a , b , i , j : rem Variables provisoires numériques
   dim a$ : rem Variables provisoires alphanumériques
   dim cj : rem Couleur du jeton (1=rouge -1=jaune)
   dim nq : rem Numéro de la flèche cliQuée
   dim pr , pv , pz : rem Pixel Rouge, Vert et bleu du fond d`écran
   dim tj(7,6) : rem Tableau correspondant à la grille de jeu
   label aide : rem Système d`aide du programme
   label arret : rem Arrêter le jeu
   label fleches : rem Dessin des flèches du haut
   label go : rem Faire marcher le jeu
   label jeton : rem Apparition du jeton à lancer
   label jouer : rem Débuter le jeu
   label verif : rem Voir si un des joueurs est gagnant
   label zquit : rem Fermeture du programme
   cj=-1
rem form0
   width 0,1000
   height 0,720
   caption 0,"   P U I S S A N C E  4  -  Table d'exercice"
   pr=color_pixel_red(0,1,1)
   pv=color_pixel_green(0,1,1)
   pz=color_pixel_blue(0,1,1)
alpha 10 : rem Fond bleu du jeu
   left 10,100
   top 10,100
   width 10,650
   height 10,550
   color 10,0,0,255
for i=1 to 7 : rem Place des pions y compris en haut (12 à 60)
   for j=1 to 7
      picture (i-1)*7+j+11
         left (i-1)*7+j+11,(j-1)*90+110
         top (i-1)*7+j+11,(i-1)*90+10
         width (i-1)*7+j+11,90
         height (i-1)*7+j+11,90
         2d_target_is (i-1)*7+j+11
         if i=1
            color (i-1)*7+j+11,pr,pv,pz
            2d_pen_color pr,pv,pz
            2d_fill_color pr,pv,pz
         else
            color (i-1)*7+j+11,0,0,255
            2d_pen_color 0,0,255
         end_if
         2d_circle 45,45,40
   next j
next i
rem Flèches
   for i=12 to 18
      gosub fleches
   next i
alpha 62 : rem Support du pion à lancer
   left 62,750
   top 62,100
   width 62,120
   height 62,20
   color 62,0,0,255
picture 64 : rem Jeton prêt au lancer
   left 64,770
   top 64,20
   width 64,80
   height 64,80
   color 64,pr,pv,pz
button 66 : rem Bouton Jouer
   left 66,753
   top 66,123
   width 66,117
   height 66,117
   font_bold 66
   font_size 66,14
   caption 66,"Jouer"
   on_click 66,jouer
alpha 67 : rem Zone où va être affichée l`annonce de gain d`un des joueurs
   left 67,800
   top 67,300
   font_bold 67
   font_size 67,14
   font_color 67,0,0,255
alpha 68 : rem Étiquette indiquant qu`il faut cliquer sur les flèches
   hide 68
   left 68,12
   top 68,15
   font_bold 68
   font_size 68,14
   font_color 68,0,0,255
   caption 68,"Cliquez"+chr$(13)+"sur les"+chr$(13)+"flèches"
button 70 : rem Bouton Aide
   left 70,753
   top 70,413
   width 70,117
   height 70,117
   font_bold 70
   font_size 70,14
   caption 70,"Aide"
   on_click 70,aide
button 72 : rem Bouton Quitter
   left 72,753
   top 72,533
   width 72,117
   height 72,117
   font_bold 72
   font_size 72,14
   caption 72,"Quitter"
   on_click 72,zquit
button 74 : rem Bouton Arrêter
   left 74,5
   top 74,510
   width 74,90
   height 74,80
   font_bold 74
   font_size 74,12
   caption 74,"Arrêter"
   on_click 74,arret
   inactive 74
end : rem ' Début des routines ==============================================
aide: : rem Système d`aide du programme
   application_title "Règles du jeu PUISSANCE 4"
   a$="   Le but du jeu est d'aligner 4 pions de sa couleur dans le sens"+chr$(13)
   a$=a$+"horizontal, vertical ou diagonal. Le premier qui réalise cela a"+chr$(13)
   a$=a$+"gagné et le jeu s'arrête. Si toutes les cases du jeu sont remplies"+chr$(13)
   a$=a$+"sans que cela ait pu être réalisé, alors la partie est nulle."
   message a$
return
arret: : rem Arrêter le jeu
   active 66
   hide 68
   for i=12 to 18
      off_click i
   next i
   2d_target_is 64
   2d_pen_color pr,pv,pz
   2d_fill_color pr,pv,pz
   2d_circle 40,40,40
   inactive 74
return
fleches: : rem Dessin des flèches du haut
   color i,pr,pv,pz
   2d_target_is i
   2d_pen_color 0,240,255
   2d_fill_color 0,240,255
   2d_rectangle 25,15,65,41
   2d_line 5,40,85,40
   2d_line 5,40,45,80
   2d_line 45,80,85,40
   2d_flood 25,45,0,240,255
return
go: : rem Faire marcher le jeu
   nq=number_click
   if tj(((nq-12)-(int((nq-12)/7)*7))+1,1)=0
      for i=12 to 18
         off_click i
      next i
      inactive 74
      2d_target_is 64
      2d_pen_color pr,pv,pz
      2d_fill_color pr,pv,pz
      2d_circle 40,40,40
      for i=18 to nq step -1
         2d_target_is i
         2d_pen_color 255,-127.5*(cj-1),0
         2d_fill_color 255,-127.5*(cj-1),0
         2d_circle 45,45,40
         wait 200
         if i=nq
            wait 300
         end_if
         2d_pen_color pr,pv,pz
         2d_fill_color pr,pv,pz
         2d_circle 45,45,40
         gosub fleches
      next i
      for i=nq+7 to nq+42 step 7
         if tj(((i-12)-(int((i-12)/7)*7))+1,int((i-12)/7))=0
            2d_target_is i
            2d_pen_color 255,-127.5*(cj-1),0
            2d_fill_color 255,-127.5*(cj-1),0
            2d_circle 45,45,40
            wait 200
            2d_pen_color 255,255,255
            2d_fill_color 255,255,255
            2d_circle 45,45,40
         end_if
      next i
      for i=6 to 1 step -1
         if tj(((nq-12)-(int((nq-12)/7)*7))+1,i)=0
            tj(((nq-12)-(int((nq-12)/7)*7))+1,i)=cj
            2d_target_is nq+i*7
            2d_pen_color 255,-127.5*(cj-1),0
            2d_fill_color 255,-127.5*(cj-1),0
            2d_circle 45,45,40
            exit_for
         end_if
      next i
      cj=cj*(-1)
      gosub jeton
      for i=12 to 18
         on_click i,go
      next i
      active 74
      gosub verif
   end_if
return
jeton: : rem Apparition du jeton à lancer
   2d_target_is 64
   2d_pen_color 255,-127.5*(cj-1),0
   2d_fill_color 255,-127.5*(cj-1),0
   2d_circle 40,40,40
return
jouer: : rem Débuter le jeu
   for i=2 to 7
      for j=1 to 7
         2d_target_is (i-1)*7+j+11
         2d_pen_color 0,0,255
         2d_fill_color 255,255,255
         2d_circle 45,45,40
         tj(j,i-1)=0
      next j
   next i
   for i=12 to 18
      on_click i,go
   next i
   cj=-1
   gosub jeton
   show 68
   inactive 66
   caption 67,""
   active 74
return
verif: : rem Voir si un des joueurs est gagnant
   b=0
   for i=1 to 4 : rem Oblique Nord-Est
      for j=1 to 3
         a=tj(i,j)+tj(i+1,j+1)+tj(i+2,j+2)+tj(i+3,j+3)
         if a=4 or a=-4 then b=a
      next j
   next i
   for i=4 to 7 : rem Oblique Sud-Est
      for j=1 to 3
         a=tj(i,j)+tj(i-1,j+1)+tj(i-2,j+2)+tj(i-3,j+3)
         if a=4 or a=-4 then b=a
      next j
   next i
   for i=1 to 7 : rem Verticale
      for j=1 to 3
         a=tj(i,j)+tj(i,j+1)+tj(i,j+2)+tj(i,j+3)
         if a=4 or a=-4 then b=a
      next j
   next i
   for i=1 to 4 : rem Horizontale
      for j=1 to 6
         a=tj(i,j)+tj(i+1,j)+tj(i+2,j)+tj(i+3,j)
         if a=4 or a=-4 then b=a
      next j
   next i
   if b<>0
      beep
      show 67
      a$="LES "
      if b=4
         a$=a$+"ROUGES"
      end_if
      if b=-4
         a$=a$+"JAUNES"
      end_if
      caption 67,a$+chr$(13)+"ONT GAGNÉ"
      gosub arret
   end_if
return
zquit: : rem Fermeture du programme
   a=message_confirmation_yes_no("Voulez-vous réellement quitter ce jeu ?")
   if a=1
      terminate
   end_if
return