2000-05-17 18:50

     $TYPECHECK ON

     DIM DX AS QDXSCREEN

     DECLARE SUB AfficheCoup                 ' Affiche le coup de l'ordi ou du joueur
     DECLARE SUB CalculScores                ' Met à jour la grille après un coup joué
     DECLARE SUB CommencerPartie             ' Détermine les couleurs de chaque joueur
     DECLARE SUB InitTableau                 ' Initialisation du tableau de grille
     DECLARE SUB JeuJoueur                   ' Coup du joueur
     DECLARE SUB JeuOrdi                     ' Coup de l'ordinateur
     DECLARE SUB JoueurCommence              ' Le joueur choisit de commencer
     DECLARE SUB OrdiCommence                ' C'est l'ordi qui commence
     DECLARE SUB AfficheGrille               ' Affiche la grille
     DECLARE SUB Quitter
     DECLARE SUB Grille10                    ' Sélection des 3 dimensions de grille
     DECLARE SUB Grille15
     DECLARE SUB Grille20
     DECLARE SUB PrefereRouge                ' Le joueur préfère les rouges
     DECLARE SUB PrefereBleu                 ' ... ou les bleus
     DECLARE SUB JaiGagne
     DECLARE SUB TextesOrigine               ' Textes de base de la fenêtre d'infos

     CONST ORDI   = 0
     CONST JOUEUR = 1
     CONST VRAI   = 1
     CONST FAUX   = 0
     CONST ROUGE  = &HFF
     CONST BLEU   = &HFFOOOO

     DIM AfficheCoupX AS WORD            ' Coordonnées X, Y du coup à afficher
     DIM AfficheCoupY AS WORD
     DIM Numalign AS INTEGER
     NumAlign = 2 * (21 - 4) * ((2 * 21) - 4)
     DIM CoupJoueurOrdi(21, 21) AS INTEGER 'Tableau des cases jouées par le joueur (-1), l'ordi (1) ou no jouées (0)
     DIM al(21, 21, 0 TO 20) AS INTEGER
     DIM NbrPionsAlign(Numalign) AS INTEGER
     DIM OrdiJoue AS INTEGER
     DIM Ponderation(5)  AS WORD

     DIM Gauche AS INTEGER                  ' Position gauche de la grille
     DIM Haut   AS INTEGER                  '          Haute
     DIM Largeur AS INTEGER                 ' Largeur de la grille
     DIM Hauteur AS INTEGER                 ' Hauteur
     DIM NumeroRangee AS INTEGER            ' Pour numéroter les rangées de la grille
     DIM CouleurJoueur AS INTEGER           ' Couleur choisie par le joueur (ROUGE ou BLEU)
     DIM CouleurEnCours AS INTEGER          ' Couleur du coup en cours
     DIM CouleurOrdi    AS INTEGER
     DIM QuiCommence   AS INTEGER           ' ORDI ou JOUEUR
     DIM Gagne AS BYTE                      ' Quelqu'un a gagné

     DIM CaseH AS INTEGER
     DIM CaseV AS INTEGER
     DIM Alignement AS INTEGER
     DIM Coup_Joueur_Ordi AS INTEGER        ' coup du joueur = -1 , coup de l'ordi = 1
     DIM DimGrille AS INTEGER
     DIM Nalign AS INTEGER                  ' Nombre d'alignements d'une case
     DIM ponderRef AS INTEGER               ' Pondération de référence minimum pour calcul coup ordi
     DIM PonderCase AS INTEGER              ' Pondération de la case en cours d'évaluation (calcul coup ordi)
     DIM CaseHCoupJoue AS INTEGER           ' Case X du dernier coup joué
     DIM CaseVCoupJoue AS INTEGER           ' Case Y

     DIM DernierCoupOrdi$ AS STRING         ' Texte du dernier coup joué par l'ordi
     DIM DernierCoupJoueur$ AS STRING       ' Texte du dernier coup joué par le joueur
     DIM CoupsJoues AS WORD                 ' Nombre de coups joués

     DIM a$ AS STRING                       ' Chaîne générale

     Ponderation(1) = 1                     ' en modifiant ce tableau de pondération, vous pouvez
     Ponderation(2) = 3                     ' modifier la tactique de jeu de l'ordinateur
     Ponderation(3) = 9
     Ponderation(4) = 30
     Ponderation(5) = 10000

     DimGrille = 10
     OrdiJoue= 1                            ' Interdit un clic sur la grille
     QuiCommence = JOUEUR
     CouleurJoueur = ROUGE
     CouleurOrdi = BLEU

     CREATE Fenetre_Principale AS QFORM     ' on crée la fenêtre principale
      width = 640
      height = 475
      BorderStyle = 4
      CREATE FenetreJeu AS QCANVAS         ' On crée un grille de 10 x 10 par défaut
       Top = 70
       Left = 200
       Width = 202
       Height = 202
       onpaint = AfficheGrille
       OnClick = JeuJoueur
      END CREATE
      CREATE menu AS QMAINMENU             ' On fabrique le menu Fichier
       CREATE menu1 AS QMENUITEM
        CAPTION = "&Fichier"
        CREATE menu_CommencePartie AS QMENUITEM
         CAPTION = "&Commencer une partie"
         Onclick = CommencerPartie
        END CREATE
        CREATE menu_Inter AS QMENUITEM
         CAPTION = "-"
        END CREATE
        CREATE menu_Quitter AS QMENUITEM
         CAPTION = "&Quitter"
         onclick = quitter
        END CREATE
       END CREATE
       CREATE menu2 AS QMENUITEM          ' puis le menu des grilles
        CAPTION = "&Grille"
        CREATE menu_grille10 AS QMENUITEM
         CAPTION = "&10 x 10"
         onclick = Grille10
         checked = VRAI
        END CREATE
        CREATE menu_grille15 AS QMENUITEM
         CAPTION = "1&5 x 15"
         onclick = Grille15
        END CREATE
        CREATE menu_grille20 AS QMENUITEM
         CAPTION = "&21 x 21"
         onclick = Grille20
        END CREATE
       END CREATE
       CREATE menu3 AS QMENUITEM          ' puis le menu des options
        CAPTION = "&options"
        CREATE MenuRouge AS QMENUITEM
         CAPTION = "Vous jouez avec les &Rouges"
         Checked = VRAI
         onclick = PrefereRouge
        END CREATE
        CREATE MenuBleu AS QMENUITEM
         CAPTION = "Vous jouez avec les &Bleus"
         onclick = PrefereBleu
        END CREATE
        CREATE OptionsInter1 AS QMENUITEM
         CAPTION = "-"
        END CREATE
        CREATE MenuStartHomme AS QMENUITEM
         CAPTION = "Vous commencez"
         checked = 1
         onclick = JoueurCommence
        END CREATE
        CREATE MenuStartOrdi AS QMENUITEM
         CAPTION = "Je commence"
         onclick = OrdiCommence
        END CREATE
       END CREATE
      END CREATE
      CREATE BarreInfos AS QSTATUSBAR      ' et enfin la barre d'informations
       SizeGrip = FAUX
       AddPanels "", "", "",""
       Panel(0).Width = 260
       Panel(1).Width = 110
       Panel(2).Width = 135
       Panel(0).Alignment = 2             ' Centré
      END CREATE
      center
      SHOWMODAL
     END CREATE
'------------------------------------------------------------------------------------------------
     SUB Grille10                           ' grille 10 x 10
      Menu_grille10.checked = 1
      Menu_grille15.checked = 0
      Menu_grille20.checked = 0
      FenetreJeu.Top = 70
      FenetreJeu.Left = 200
      FenetreJeu.Width = 202
      FenetreJeu.Height = 202
      DimGrille = 10
      AfficheGrille
     END SUB
'------------------------------------------------------------------------------------------------
     SUB Grille15                           ' grille 15 x 15
      Menu_grille10.checked = 0
      Menu_grille15.checked = 1
      Menu_grille20.checked = 0
      FenetreJeu.Top = 25
      FenetreJeu.Left = 150
      FenetreJeu.Width = 292
      FenetreJeu.Height = 292
      DimGrille = 15
      AfficheGrille
     END SUB
'------------------------------------------------------------------------------------------------
     SUB Grille20                           ' grille 21 x 21
      Menu_grille10.checked = 0
      Menu_grille15.checked = 0
      Menu_grille20.checked = 1
      FenetreJeu.Top = 0
      FenetreJeu.Left = 100
      FenetreJeu.Width = 400
      FenetreJeu.Height = 400
      DimGrille = 21
      AfficheGrille
     END SUB
'------------------------------------------------------------------------------------------------
     SUB AfficheGrille                      ' Affichage de la grille
      DIM i AS WORD
      Gauche = FenetreJeu.Left
      Haut = FenetreJeu.Top
      Largeur = FenetreJeu.Width
      Hauteur = FenetreJeu.Height
      fenetrejeu.fillrect = 20,20,Largeur, hauteur, &HC2FEFB
      NumeroRangee = 0
      FOR i=20 TO Largeur STEP 18
       numeroRangee= numeroRangee + 1                   ' Pour numéroter les rangées
       a$=STR$(NumeroRangee)                            ' Numéros verticaux
       FenetreJeu.TextOut(0, i+5, a$, 0, &HC0C0C0)
       fenetrejeu.line(20,i,Largeur,i, &H808080)        ' Trait horizontal
       fenetrejeu.line(20,i+1,Largeur,i+1, &H808080)    ' ... doublé
       fenetrejeu.line(i,20,i,hauteur,&H808080)         ' Trait vertical
       fenetrejeu.line(i+1,20,i+1,hauteur,&H808080)     ' ... doublé
       FenetreJeu.Textout(i+5, 5, CHR$(NumeroRangee+64), 0, &HC0C0C0) ' Numéros Horizontaux
      NEXT i
      FenetreJeu.FillRect(20,19,Largeur,22, &HFFFFFF)    ' Bords blancs Haut et gauche
      FenetreJeu.FillRect(19,20,22,hauteur, &HFFFFFF)
      FenetreJeu.FillRect(23, hauteur - 2, Largeur,hauteur, 0)
      FenetreJeu.FillRect(Largeur-2,Hauteur,Largeur, 23, 0)
      CALL TextesOrigine
     END SUB
'------------------------------------------------------------------------------------------------
     SUB TextesOrigine
      BarreInfos.Panel(0).CAPTION = " French Morpion (version provisoire)"
      BarreInfos.Panel(1).CAPTION = " Coups joués : 0 "
      BarreInfos.Panel(2).CAPTION = " Votre dernier coup : "
      BarreInfos.Panel(3).CAPTION = " Mon dernier coup : "
     END SUB
'------------------------------------------------------------------------------------------------
     SUB PrefereRouge                                 ' Le joueur préfère les rouges
      MenuRouge.Checked = VRAI
      MenuBleu.Checked  = FAUX
      CouleurJoueur = ROUGE
      CouleurOrdi   = BLEU
     END SUB
'------------------------------------------------------------------------------------------------
     SUB PrefereBleu                                  ' Le joueur préfère les bleus
      MenuRouge.Checked = FAUX
      MenuBleu.Checked  = VRAI
      CouleurJoueur = BLEU
      CouleurOrdi   = ROUGE
     END SUB
'------------------------------------------------------------------------------------------------
     SUB JoueurCommence                               ' Le joueur choisit de commencer
      MenuStartHomme.Checked = VRAI
      MenuStartOrdi.Checked  = FAUX
      QuiCommence = JOUEUR                     ' 1 : Le joueur commence, 0 : L'ordi commence
     END SUB
'------------------------------------------------------------------------------------------------
     SUB OrdiCommence                                 ' C'est l'ordinateur qui commence
      MenuStartHomme.Checked = 0
      MenuStartOrdi.Checked  = 1
      QuiCommence = ORDI
     END SUB
'------------------------------------------------------------------------------------------------
     SUB CommencerPartie
      OrdiJoue = 1                         ' cette variable interdit un clic de souris
      CALL AfficheGrille                   ' pendant le jeu de l'ordinateur
      CALL InitTableau                     ' Initialisation du tableau de la grille
      IF QuiCommence = ORDI THEN           ' c'est l'ordi qui commence
       IF CouleurJoueur = ROUGE THEN
        CouleurEnCours = BLEU
       ELSE
        CouleurEnCours = ROUGE
       END IF
       JeuOrdi                            ' c'est l'ordi qui commence
      ELSE
       OrdiJoue = 0
       CouleurEnCours = CouleurJoueur     ' C'est le joueur qui commence
      END IF
     END SUB
'------------------------------------------------------------------------------------------------
' Initialisation des tableaux d'alignements
     SUB InitTableau                        ' Alignements par case
      DIM nt AS INTEGER   'Variable temporaire de NumAlign, puis variable de boucle NumAlign
      BarreInfos.panel(0).CAPTION = "Patience... Je me concentre..."
      FOR CaseH = 1 TO 21
       FOR CaseV = 1 TO 21
        al(caseV, CaseH, 0) = 0
       NEXT CaseV
      NEXT CaseH

      FOR CaseH = 1 TO DimGrille           ' Alignements horizontaux
       FOR CaseV = 1 TO DimGrille - 4
        NumAlign = (CaseH - 1) * (DimGrille - 4) + CaseV
        FOR Alignement = 0 TO 4
        ' Incrémente le nombre d'alignements de la case
         al(CaseH, CaseV + Alignement, 0) = al(CaseH, CaseV + Alignement, 0) + 1
         al(CaseH, CaseV + Alignement, al(CaseH, CaseV + Alignement, 0)) = NumAlign
        NEXT Alignement
       NEXT CaseV
      NEXT CaseH
      nt = NumAlign

      FOR CaseV = 1 TO DimGrille           ' alignements verticaux
       FOR CaseH = 1 TO DimGrille - 4
        NumAlign = nt + ((CaseV - 1) * (DimGrille - 4) + CaseH)
        FOR Alignement = 0 TO 4
         al(CaseH + Alignement, CaseV, 0) = al(CaseH + Alignement, CaseV, 0) + 1
         al(CaseH + Alignement, CaseV, al(CaseH + Alignement, CaseV, 0)) = NumAlign
        NEXT Alignement
       NEXT CaseH
      NEXT CaseV
      nt = NumAlign

      FOR CaseH = 1 TO DimGrille - 4       ' alignements diagonaux 1
       FOR CaseV = 1 TO DimGrille - 4
        NumAlign = nt + ((CaseH - 1) * (DimGrille - 4) + CaseV)
        FOR Alignement = 0 TO 4
         al(CaseH + Alignement, CaseV + Alignement, 0) = al(CaseH + Alignement, CaseV + Alignement, 0) + 1
         al(CaseH + Alignement, CaseV + Alignement, al(CaseH + Alignement, CaseV + Alignement, 0)) = NumAlign
        NEXT Alignement
       NEXT CaseV
      NEXT CaseH
      nt = NumAlign

      FOR CaseH = 1 TO DimGrille - 4       ' alignements diagonaux 2
       FOR CaseV = 5 TO DimGrille
        NumAlign = nt + (CaseH - 1) * (DimGrille - 4) + (CaseV - 4)
        FOR Alignement = 0 TO 4
         al(CaseH + Alignement, CaseV - Alignement, 0) = al(CaseH + Alignement, CaseV - Alignement, 0) + 1
         al(CaseH + Alignement, CaseV - Alignement, al(CaseH + Alignement, CaseV - Alignement, 0)) = NumAlign
        NEXT Alignement
       NEXT CaseV
      NEXT CaseH

      FOR CaseH = 1 TO DimGrille           ' tableau des coups de l'ordi et du joueur
       FOR CaseV = 1 TO DimGrille
        CoupJoueurOrdi(CaseH, CaseV) = 0
       NEXT CaseV
      NEXT CaseH

      NumAlign = 2 * (21 - 4) * ((2 * 21) - 4)
      FOR nt = 1 TO Numalign               ' note de pondération de chaque alignement à 0
       NbrPionsAlign(nt) = 0
      NEXT nt

      CoupsJoues = 0                       ' Nombre de coups joués
      IF QuiCommence = JOUEUR THEN
       BarreInfos.panel(0).CAPTION = "A vous..."
      END IF
     END SUB
'------------------------------------------------------------------------------------------------
     SUB JeuOrdi                            ' Jeu de l'ordinateur
      BarreInfos.Panel(3).CAPTION = " Mon dernier coup : " + DernierCoupOrdi$
      BarreInfos.Panel(0).CAPTION = "Je réfléchis ..."
      OrdiJoue = 1                         ' Pour interdire un clic de souris
      PonderRef = -10000
      FOR CaseH = 1 TO DimGrille
       FOR CaseV = 1 TO DimGrille
        PonderCase = 0
        IF CoupJoueurOrdi(CaseH, CaseV) = 0 THEN         ' Si cette case n'a jamais été jouée
         Nalign = al(CaseH, CaseV, 0)
         FOR Alignement = 1 TO Nalign
          NumAlign = al(CaseH, CaseV, Alignement)
          IF NbrPionsAlign(NumAlign) <> 9999 THEN      ' Si pas de pions des 2 joueurs dans l'alignement
           IF NbrPionsAlign(NumAlign) >= 0 THEN       ' S'il y a des pions de l'ordi
            PonderCase = PonderCase + Ponderation(NbrPionsAlign(NumAlign) + 1) ' Met à jour la pondération de cette case pour chaque alignement
           ELSE                                       ' Sinon, ce sont des pions du joueur
            PonderCase = PonderCase + Ponderation(1 - NbrPionsAlign(NumAlign)) ' Met à jour la pondération
           END IF
          END IF
         NEXT Alignement
         IF PonderCase > PonderRef THEN
          CaseHCoupJoue = CaseH
          CaseVCoupJoue = CaseV
          PonderRef = PonderCase
         END IF
        END IF
       NEXT CaseV
      NEXT CaseH
      Coup_Joueur_Ordi = 1
      CalculScores
      CouleurEnCours = CouleurOrdi
      AfficheCoup
      IF gagne THEN                      ' Si l'ordinateur a gagné
       OrdiJoue = 2
       CALL JaiGagne
      ELSE
       OrdiJoue = 0                         ' Autorise le clic sur la grille
       DernierCoupOrdi$ = CHR$(CaseHCoupJoue + 64) + " - " + STR$(CaseVCoupJoue)
       BarreInfos.Panel(0).CAPTION = "  Je joue en  " + DernierCoupOrdi$ + "   A vous..."
      END IF
     END SUB
'------------------------------------------------------------------------------------------------
     SUB JeuJoueur
      IF OrdiJoue > 0 THEN                 ' Ne pas tenir compte de ce clic non autorisé
       EXIT SUB
      END IF
      CaseHCoupJoue = (MOUSEX - 12) / 18
      CaseVCoupJoue = (MOUSEY - 12) / 18
      IF CaseHCoupJoue = 0 OR CaseVCoupJoue = 0 THEN   ' Clic en dehors de la grille
       EXIT SUB
      END IF
      DernierCoupJoueur$ = CHR$(CaseHCoupJoue + 64) + " - " + STR$(CaseVCoupJoue)
      BarreInfos.Panel(2).CAPTION = " Votre dernier coup : " + DernierCoupJoueur$
      CouleurEnCours = CouleurJoueur
      Coup_Joueur_Ordi = -1
      CALL CalculScores
      CALL AfficheCoup
      IF gagne THEN                        'le joueur a gagné
       CALL JaiGagne
      ELSE
       CALL JeuOrdi
      END IF
     END SUB
'------------------------------------------------------------------------------------------------
     SUB CalculScores                       ' Calcul et mise à jour des scores
      Nalign = al(CaseHCoupJoue, CaseVCoupJoue, 0)
      FOR Alignement = 1 TO Nalign
       NumAlign = al(CaseHCoupJoue, CaseVCoupJoue, Alignement)
       IF NbrPionsAlign(NumAlign) <> 9999 THEN
        IF NbrPionsAlign(NumAlign) * Coup_Joueur_Ordi < 0 THEN
         NbrPionsAlign(NumAlign) = 9999
        ELSE
         NbrPionsAlign(NumAlign) = NbrPionsAlign(NumAlign) + Coup_Joueur_Ordi
         Gagne = (ABS(NbrPionsAlign(NumAlign)) = 5)
        END IF
       END IF
       IF gagne THEN
        EXIT FOR
       END IF
      NEXT Alignement
      CoupJoueurOrdi(CaseHCoupJoue, CaseVCoupJoue) = Coup_Joueur_Ordi
      INC CoupsJoues
      BarreInfos.Panel(1).CAPTION = " Coups joués : " + STR$(CoupsJoues)
     END SUB
'------------------------------------------------------------------------------------------------
     SUB AfficheCoup                        ' Affiche le coup joué
      AfficheCoupX = 5+(18*CaseHCoupJoue)
      AfficheCoupY = 6+(18*CaseVCoupJoue)
      fenetrejeu.line(AfficheCoupX, AfficheCoupY,AfficheCoupX + 13, AfficheCoupY + 13, CouleurEnCours)
      fenetrejeu.line(AfficheCoupX, AfficheCoupY + 1,AfficheCoupX + 12, AfficheCoupY + 13, CouleurEnCours)
      fenetrejeu.line(AfficheCoupX + 1, AfficheCoupY,AfficheCoupX + 13, AfficheCoupY + 12, CouleurEnCours)
      fenetrejeu.line(AfficheCoupX + 13, AfficheCoupY,AfficheCoupX, AfficheCoupY + 13, CouleurEnCours)
      fenetrejeu.line(AfficheCoupX + 12, AfficheCoupY,AfficheCoupX, AfficheCoupY + 12, CouleurEnCours)
      fenetrejeu.line(AfficheCoupX + 13, AfficheCoupY + 1,AfficheCoupX + 1, AfficheCoupY + 13, CouleurEnCours)
     END SUB
'------------------------------------------------------------------------------------------------
     SUB JaiGagne                           ' L'un des 2 joueurs a gagné
      DIM Couleur AS INTEGER
      OrdiJoue = 1                         ' Plus de clic autorisé dans la grille
      IF Coup_Joueur_Ordi = -1 THEN
       BarreInfos.Panel(0).CAPTION = "Vous avez gagné en " + STR$(CoupsJoues) + "  coups."
      ELSE
       BarreInfos.Panel(0).CAPTION = "J'ai gagné en " + STR$(CoupsJoues) + "  coups."
      END IF
      couleur = CouleurEnCours
      FOR gagne = 1 TO 10
       CouleurEnCours = Couleur
       CALL AfficheCoup
       SLEEP 0.5
       CouleurEnCours = &HC2FEFB
       CALL AfficheCoup
       SLEEP 0.5
      NEXT gagne
     END SUB

     SUB Quitter                            ' Option Quitter du menu
      Fenetre_Principale.CLOSE
     END SUB

2000-05-17 18:50