Une premiere version de puissance 4

' Puissance 4 version 1 (Simple)
' Mode contre l'ordinateur
' Dessins simples sans animation
' Les jaunes commencent toujours et sont jou par l'ordinateur

' Définir le type pour une case de la grille
' Case = 0 => ROUGE; 1 => JAUNE; 2 => VIDE
DIM ROUGE% : ROUGE% = -1
DIM JAUNE% : JAUNE% = 1
DIM GAGNE% : GAGNE% = 2
DIM VIDE%  : VIDE%  = 0
DIM C_ORDI% :' Couleur des pions de l'odinateur

' Définir la grille de jeu
DIM NB_COLONNES% : NB_COLONNES% = 7
DIM NB_LIGNES%  : NB_LIGNES%  = 6
DIM NB_VIDES% : NB_VIDES% = NB_COLONNES% * NB_LIGNES%

' La grille de jeu avec une bordure supplémentaire
DIM Grille%(NB_COLONNES%, NB_LIGNES%)
DIM Sauve_Grille%(NB_COLONNES%, NB_LIGNES%)
DIM Colonnes%(NB_COLONNES%),Sauve_Colonnes%(NB_COLONNES%)

' Programmation du mode de debuggage
DIM Debug% : Debug% = 0 : ' Mettre à 1 pour activer le mode debug
DIM F_Debug% : F_Debug% = 1
DIM M_Debug%, Tps_Msg_Debug%  : Tps_Msg_Debug% = 1500

' Tailles des éléments du jeu
DIM Marge% : Marge% = 20
DIM Bordure% : Bordure% = 10
DIM Largeur_pion% : Largeur_pion% = 60

' Définition des numéro d'objet
DIM N_Grille% : N_Grille% = 10

DIM Num%, Message$, resultat%
DIM Tour%, Aff_tour%, sortie%

DIM NB_jouables%, col_jouables%(NB_COLONNES%)
DIM P_Gagne%(3,1)

LABEL Clic

Retourne_Dimension_Bandeau_Et_Bord() :' retourne bandeau%,bord% pour portabilité

INIT()
AIDE()
IF Debug% = 1 THEN CREER_FENETRE_DEBUG()

CREER_GRILLE()
VIDER()
SHOW 0
C_ORDI% = JAUNE%
IF Tour% = C_ORDI% THEN Ajoute_Pion(4) : Dessine_Pion2(4) : Change_Tour()
IF Debug% = 1 THEN DEBUG_GRILLE()
ON_CLICK N_Grille%,clic
END

SUB CREER_GRILLE()
DIM_LOCAL Decal_x,Decal_y, i%, j%, r
  PICTURE N_Grille% : LEFT N_Grille%, Marge% : TOP N_Grille%, Marge%
  WIDTH N_Grille%,  Bordure% + NB_COLONNES% * (Largeur_pion% + Bordure%)
  HEIGHT N_Grille%, Bordure% + NB_LIGNES% * (Largeur_pion% + Bordure%)
  COLOR N_Grille%,0,0,255 : 2D_FILL_COLOR 50,50,50
  2D_TARGET_IS N_Grille%
  r =  Largeur_pion% / 2
  Decal_y = Bordure%

  FOR i% = 1 TO NB_LIGNES%
    Decal_x = Bordure%
    FOR j% = 1 TO NB_COLONNES%
        2D_CIRCLE Decal_x + r, Decal_y +  r,  r
        Decal_x = Decal_x +  Largeur_pion% + Bordure%
    NEXT j%
    Decal_y = Decal_y +  Largeur_pion% + Bordure%
  NEXT i%
END_SUB

SUB INIT()
DIM_LOCAL Largeur%, Hauteur%, ind%
  HIDE 0
  Largeur% =  Bordure% + NB_COLONNES% * (Largeur_pion% + Bordure%) + 2 * Marge% + 2 * bord%
  WIDTH 0, Largeur%
  Hauteur% =  2*Bordure% + (NB_LIGNES% + 1 ) * (Largeur_pion% + Bordure%) + 2 * Marge% + 2 * bord%
  HEIGHT 0, Hauteur% + bandeau%
  CAPTION 0,"  P U I S S A N C E  4"
  Tour% = JAUNE%
  ind% = 3 : ALPHA ind% : LEFT ind%, Marge% + 10 : TOP ind%, (NB_LIGNES%)* (Largeur_pion% + Bordure%) + Bordure% + Largeur_pion% / 2
  FONT_SIZE ind%,22 :  FONT_NAME ind%,"Times New Roman" :  CAPTION ind%,"C'est au tour de jouer de : "
  2D_TARGET_IS 0 :Dessine_Pion(6, NB_LIGNES% +0.5,Tour%)
  Aff_tour% = 1
END_SUB

SUB VIDER()
DIM_LOCAL i%, j%  : ' parcourir les cases de la grille pour la vider
FOR i% = 1 TO NB_LIGNES%
  FOR j% = 1 TO NB_COLONNES%
    Grille%(j%,i%) = VIDE%
  NEXT j%
NEXT i%
FOR j% = 1 TO NB_COLONNES%
  Colonnes%(j%) = 0
NEXT j%
END_SUB

SUB CREER_FENETRE_DEBUG()
DIM_LOCAL i%,j%, ind%
ind% = 200
  FORM F_Debug%
  LEFT  F_Debug%, WIDTH(0) +50 : WIDTH F_Debug%,600
  CAPTION F_Debug%,"Debug"
  M_Debug% = ind%
  ALPHA ind% :  PARENT ind%, F_Debug%
  LEFT ind%, 10 : WIDTH ind%, WIDTH(F_Debug%) - 20
  TOP ind%, 10
  FOR i% = 1 TO NB_LIGNES% + 2
    ALPHA ind%+i% :  PARENT ind%+i%, F_Debug%
    LEFT ind%+i%, 10 : WIDTH ind%+i%, WIDTH(F_Debug%) - 20
    TOP ind%+i%, 10 + 13*(NB_LIGNES% - i% +4)
  NEXT i%
END_SUB

SUB DEBUG_GRILLE()
DIM_LOCAL i%,j%, ind%, T$
ind% = 200
  FOR i% = 1 TO NB_LIGNES%
    T$ = ""
    FOR j% = 1 TO NB_COLONNES%
      T$=T$ + RIGHT$("  "+ STR$(Grille%(j%, i%)),3)
    NEXT j%
    CAPTION ind%+i%, T$
  NEXT i%
  T$ = ""
  FOR j% = 1 TO NB_COLONNES%
      T$=T$ + RIGHT$("  "+ STR$(Colonnes%(j%)),3)
  NEXT j%
  CAPTION ind%+NB_LIGNES% + 2, T$
END_SUB

rem ====================================' détection des dimensions de la fenêtre
SUB Retourne_Dimension_Bandeau_Et_Bord()
    ' controle de la position de la procédure dans le programme
    IF NUMBER_OBJECTS>0
      MESSAGE "La SUB 'Retourne_Dimension_Bandeau_Et_Bord' doit être placée avant la création du premier objet !"
      TERMINATE
    END_IF
    ' création des VARIABLES GLOBALES
    IF VARIABLE("bandeau%")=0 THEN DIM bandeau%
    IF VARIABLE("bord%")=0 THEN DIM bord%
    ' Calcul de bandeau% et bord%
    DIM_LOCAL w0%,h0%,w1%,h1%,w2%,h2%
    w0%=WIDTH(0) : h0%=HEIGHT(0)
    PICTURE 1 : FULL_SPACE 1 : w1%=WIDTH(1) : h1%=HEIGHT(1)
    w2%=w0%-w1% : h2%=h0%-h1% : bandeau%=h2%-(w2%/2) : bord%=w2%/2
    ' Suppression du Picture devenu inutile
    DELETE 1
END_SUB

SUB AIDE()
DIM_LOCAL a$
' 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."+chr$(13)+chr$(13)
  a$=a$+"Cliquez dans une colonne avec au moins un emplacement de libre"+chr$(13)
  a$=a$+"pour lacher le pion dans cette colonne"
  MESSAGE a$
END_SUB

SUB Dessine_Pion(Col%,Ligne,Couleur%)
    IF Couleur% = JAUNE%
      2D_FILL_COLOR 230,230,50
    ELSE
      IF Couleur% = ROUGE%
        2D_FILL_COLOR 240,50,50
      ELSE
        2D_FILL_COLOR 230,50,230
      END_IF
    END_IF
    2D_CIRCLE Col% * (Largeur_pion% + Bordure%) + Bordure% + Largeur_pion% / 2, Ligne * (Largeur_pion% + Bordure%) + Bordure% + Largeur_pion% / 2,  Largeur_pion% / 2
END_SUB

SUB Fin()
    wait 2000
    Terminate
END_SUB

SUB Verifie_victoire(COLONNE%,LIGNE%)
dim_local i%,j%,k%, pions%
resultat%=0
for i%=1 to NB_COLONNES% - 3
      for j%=1 to 3
        pions% = GRILLE%(i%,j%)
        for k% = 1 to 3
            pions%=  pions% + GRILLE%(i%+k%,j%+k%)
        next k%
        if pions%=4*ROUGE% or pions%=4*JAUNE%
          resultat%=pions%
          P_Gagne%(0,0) = i% : P_Gagne%(0,1) = j%
          for k% = 1 to 3
              P_Gagne%(k%,0) = i%+k% : P_Gagne%(k%,1) = j%+k%
          next k%
        end_if
      next j%
next i%

if resultat% =0
  for i%=4 to NB_COLONNES%
      for j%=1 to 3
        pions% = GRILLE%(i%,j%)
        for k% = 1 to 3
            pions%=  pions% + GRILLE%(i%-k%,j%+k%)
        next k%
        if pions%=4*ROUGE% or pions%=4*JAUNE%
          resultat%=pions%
          P_Gagne%(0,0) = i% : P_Gagne%(0,1) = j%
          for k% = 1 to 3
              P_Gagne%(k%,0) = i%-k% : P_Gagne%(k%,1) = j%+k%
          next k%
        end_if
      next j%
  next i%
end_if

if resultat% =0
  i%=COLONNE%
  for j%=1 to (NB_LIGNES% - 3)
      pions% = GRILLE%(i%,j%)
      for k% = 1 to 3
        pions%=  pions% + GRILLE%(i%,j%+k%)
      next k%
      if pions%=4*ROUGE% or pions%=4*JAUNE%
        resultat%=pions%
        P_Gagne%(0,0) = i% : P_Gagne%(0,1) = j%
        for k% = 1 to 3
          P_Gagne%(k%,0) = i% : P_Gagne%(k%,1) = j%+k%
        next k%
      end_if
  next j%
end_if

if resultat% =0
  j% = LIGNE%
  for i%=1 to (NB_COLONNES% - 3) : rem Horizontale
      pions% = GRILLE%(i%,j%)
      for k% = 1 to 3
        pions%=  pions% + GRILLE%(i%+k%,j%)
      next k%
      if pions%=4*ROUGE% or pions%=4*JAUNE%
        resultat%=pions%
        P_Gagne%(0,0) = i% : P_Gagne%(0,1) = j%
        for k% = 1 to 3
          P_Gagne%(k%,0) = i%+k% : P_Gagne%(k%,1) = j%
        next k%
      end_if
  next i%
end_if
END_SUB

SUB Change_Tour()
      IF Tour% = JAUNE%
          Tour% = ROUGE%
      ELSE
          Tour% = JAUNE%
      END_IF
      IF Aff_tour% = 1 THEN 2D_TARGET_IS 0 : Dessine_Pion(5, NB_LIGNES% + 0.6,Tour%)
END_SUB

SUB Sauve_grille()
dim_local i%,j%
FOR i% = 1 TO NB_LIGNES%
  FOR j% = 1 TO NB_COLONNES%
    Sauve_Grille%(j%,i%) = Grille%(j%,i%)
  NEXT j%
NEXT i%
FOR j% = 1 TO NB_COLONNES%
  Sauve_Colonnes%(j%) = Colonnes%(j%)
NEXT j%
END_SUB

SUB Restore_grille()
dim_local i%,j%
NB_VIDES% =  NB_VIDES% + 1
FOR i% = 1 TO NB_LIGNES%
  FOR j% = 1 TO NB_COLONNES%
    Grille%(j%,i%) = Sauve_Grille%(j%,i%)
  NEXT j%
NEXT i%
FOR j% = 1 TO NB_COLONNES%
  Colonnes%(j%) = Sauve_Colonnes%(j%)
NEXT j%
END_SUB

SUB Ordi_essai_gagne()
dim_local j%
  FOR j% = 1 TO NB_COLONNES%
    IF Colonnes%(j%) < NB_LIGNES%
      Ajoute_Pion(j%)
      Verifie_victoire(j%, Colonnes%(j%))
      IF resultat% = 4 * C_Ordi%
        Dessine_Pion2(j%)
        Victoire()
        j% = NB_COLONNES% : sortie% = 1
      ELSE
        Restore_grille()
      END_IF
    END_IF
  NEXT j%
END_SUB

SUB Ordi_empeche_victoire()
dim_local j%
 Aff_tour% = 0 : Change_tour()
 FOR j% = 1 TO NB_COLONNES%
  IF Debug% = 1 THEN CAPTION F_Debug%, "Colonnes%(" + STR$(j%) + "): "+STR$(Colonnes%(j%))+ " - Ordi_empeche_victoire"
  IF Colonnes%(j%) < NB_LIGNES%
    Ajoute_Pion(j%)
    Verifie_victoire(j%, Colonnes%(j%))
    IF ABS(resultat%) = 4
      Message$ =  "Jeu auto en" + STR$(j%)
      IF Debug% = 1 THEN CAPTION M_Debug%, Message$  : WAIT Tps_Msg_Debug%
      Restore_grille()
      Change_tour()
      Ajoute_Pion(j%)
      Dessine_Pion2(j%)
      j% = NB_COLONNES% : sortie%= 1 : Change_tour()
    ELSE
      Restore_grille()
    END_IF
  END_IF
 NEXT j%
 Aff_tour% = 1 : Change_tour()
END_SUB

SUB Ordi_empeche_victoire_suiv()
dim_local i%,j%
 Aff_tour% = 0 : NB_jouables% = 0
 FOR j% = 1 TO NB_COLONNES%
  IF Debug% = 1 THEN CAPTION F_Debug%, "Colonnes%(" + STR$(j%) + "): "+STR$(Colonnes%(j%))+ " - Ordi_empeche_victoire_suiv"
  IF Colonnes%(j%) < (NB_LIGNES% - 1)
    Ajoute_Pion(j%) : Change_tour() : Ajoute_Pion(j%)
    Verifie_victoire(j%, Colonnes%(j%))
    IF ABS(resultat%) <> 4
        NB_jouables% = NB_jouables%+1
        col_jouables%(NB_jouables%) = j%
    END_IF
    Restore_grille(): NB_VIDES% =  NB_VIDES% + 1 : Change_tour()
  ELSE
    IF Colonnes%(j%) = (NB_LIGNES% - 1)
        NB_jouables% = NB_jouables%+1
        col_jouables%(NB_jouables%) = j%
        Restore_grille()
    END_IF
  END_IF
 NEXT j%
 IF NB_jouables% = 0
  FOR j% = 1 TO NB_COLONNES%
    IF Colonnes%(j%) < NB_LIGNES%
        NB_jouables% = NB_jouables%+1
        col_jouables%(NB_jouables%) = j%
    END_IF
  NEXT j%
  IF NB_jouables% > 0
      i%=INT(RND(NB_jouables%))+1
      Message$ =  "L'ordinateur joue dans la colonne n°" + STR$(col_jouables%(i%))
      IF Debug% = 1 THEN CAPTION M_Debug%, Message$ : WAIT Tps_Msg_Debug%
      Ajoute_Pion(col_jouables%(i%))
      Dessine_Pion2(col_jouables%(i%))
      sortie% = 1
  ELSE
      NB_VIDES% = 0
      Verifie_complet()
  END_IF
 ELSE
  i%=INT(RND(NB_jouables%))+1
  Message$ =  "L'ordinateur joue dans la colonne n°" + STR$(col_jouables%(i%))
  IF Debug% = 1 THEN CAPTION M_Debug%, Message$ : WAIT Tps_Msg_Debug%
  Ajoute_Pion(col_jouables%(i%))
  Dessine_Pion2(col_jouables%(i%))
  sortie% = 1
 END_IF
 Aff_tour% = 1
END_SUB

SUB Ordi_joue()
dim_local i%,j%

sortie% = 0
  Sauve_grille()
  Ordi_essai_gagne()
  IF sortie% = 0 THEN Ordi_empeche_victoire()
  IF sortie% = 0 AND NB_VIDES% > 1 THEN Ordi_empeche_victoire_suiv()
END_SUB

SUB Ajoute_Pion(Col%)
      Colonnes%(Col%) = Colonnes%(Col%) + 1
      Grille%(Col%, Colonnes%(Col%)) = Tour%
      NB_VIDES% =  NB_VIDES% - 1
END_SUB

SUB Dessine_Pion2(Colonne%)
  2D_TARGET_IS N_Grille%
  Dessine_Pion(Colonne% -1, NB_LIGNES% - Colonnes%(Colonne%),Tour%)
END_SUB

SUB Victoire()
dim_local i%,j%,k%
        BEEP
        j% = Tour% : message$ =""
        FOR i% = 0 TO 7
          IF j% = Tour% THEN j% = GAGNE% : ELSE: j% = Tour%
          FOR k% = 0 TO 3
            Dessine_Pion(P_Gagne%(k%,0) -1, NB_LIGNES% - P_Gagne%(k%,1),j%)
            IF i% = 0
              IF message$ <> "" THEN message$ = message$ + " : "
              message$ = message$ + "P_Gagne%(" + STR$(k%) + ") = (" + STR$(P_Gagne%(k%,0)) + " , " + STR$(P_Gagne%(k%,1)) + ")"
              IF Debug% = 1 THEN CAPTION F_Debug%, message$
            END_IF
          NEXT k%
          WAIT 200
        NEXT i%
        message$="Bravo, la partie est finie"+ CHR$(13) + "LES "
        IF resultat%= 4*JAUNE% THEN message$=message$+"JAUNES"
        IF resultat%= 4*ROUGE% THEN message$=message$+"ROUGES"
        message$=message$ + " ONT GAGNE !"
        IF MESSAGE_CONFIRMATION_OK(message$) > -1 THEN Fin()
        IF Debug% = 1
            CAPTION M_Debug%, Message$
        END_IF
        Fin()
END_SUB

SUB Verifie_complet()
  IF NB_VIDES% <= 0
    message$="Partie nulle, la grille est pleine" +CHR$(13)
    message$=message$+"Personne n'a réussi à gagner"
    IF MESSAGE_CONFIRMATION_OK(message$) > -1 THEN Fin()
    IF Debug% = 1
        CAPTION M_Debug%, Message$
    END_IF
    Fin()
  END_IF
END_SUB

Clic:
OFF_CLICK N_Grille%
    Num% = INT((MOUSE_X_POSITION(N_Grille%) - 0.5 * Bordure%) / (Largeur_pion% + Bordure%)) + 1
    Message$ =  "Clic sur la colonne n°" + STR$(Num%)
    IF Debug% = 1 THEN CAPTION M_Debug%, Message$
    IF Debug% = 1 THEN CAPTION F_Debug%, "Colonnes%(Num%): "+STR$(Colonnes%(Num%))+ " - Clic"
    IF Colonnes%(Num%) < NB_LIGNES%
      Ajoute_Pion(Num%)
      Dessine_Pion2(Num%) : WAIT 50
      Verifie_victoire(Num%, Colonnes%(Num%))
      IF resultat%<>0 THEN Victoire()
      Verifie_complet()
      IF Debug% = 1 THEN DEBUG_GRILLE()
      Change_Tour()
      Ordi_joue()
      Verifie_complet()
      IF Debug% = 1 THEN DEBUG_GRILLE()
      Change_Tour()
    END_IF
ON_CLICK N_Grille%,clic
RETURN