Puissance4 avec intelligence artificielle

Partagez votre expérience de PureBasic avec les autres utilisateurs.
erix14
Messages : 480
Inscription : sam. 27/mars/2004 16:44
Contact :

Puissance4 avec intelligence artificielle

Message par erix14 »

Bonjour,
je me suis amusé à écrire un Puissance4. L'intelligence artificielle utilise l'algorithme Mini-Max élaboré en 1928 par John Von Neumann. Cette technique amène l'ordinateur à passer en revue toutes les possibilités pour un nombre limité de coups et à leur assigner une valeur qui prenne en compte les bénéfices pour le joueur et pour son adversaire. Le meilleur choix étant alors celui qui maximise ses bénéfices tout en minimisant ceux de son adversaire. Elle peut être utilisée pour les jeux des Echecs,d'Othello, etc.....
Ce programme est un bon exemple pour apprendre à utiliser des procédures récursives. J'espère que ce code apportera quelque chose aux débutants...
Pour lancer une partie il suffit de cliquer sur le niveau Novice,Moyen ou Maître. Ensuite, soit vous appuyée sur le numéro correspondant à la colonne de votre choix ou soit vous cliqué dessus. Si vous cliqués sur un niveau avant que la partie en cours soit terminée une autre partie recommencera avec le niveau sélectionné. Vous avez une chance sur deux de commencer la partie le premier, ensuite, c'est chacun à votre tour pour toute nouvelle partie.

Code : Tout sélectionner

;/
;/                   -  Puissance 4  - Programme Eric Ducoulombier ( Erix14 )
;/                  Windows XP SP2 - PureBasic 3.91 - jaPBe 2.4.7.17
;/                                                          26/09/2004
;/
#WindowWidth = 400
#WindowHeight = 600
#Humain = 1
#CPU = 10
#Pi = 3.14159265
Enumeration
          #Window
          #Jeu
          #Vide
          #Jeton1
          #Jeton2
          #Tampon
          #Texte1
          #Texte2
          #Texte3
          #Texte4
          #Novice
          #Moyen
          #Maitre
          #Colonnes
          #Quitter
          #Rien
EndEnumeration
Structure TailleBox
          Num.l
          x1.l
          y1.l
          x2.l
          y2.l
EndStructure
Structure Colonne
          Ligne.b[6]
EndStructure
Structure Plateau
          Colonne.Colonne[7]
EndStructure
Global m_hMidiOut,m_MIDIOpen.b,hWnd,SurvolID,Trait.rect,FinDeLaPartie,hBmp,AToi.b,Force,PlateauJeu.Plateau
Global ScoreHumain,ScoreCPU,ScoreNul,LeProchain.b,Time,TimeDir.b,ToiGagne.b,ToiPerdu.b,MatchNul.b
NewList MaBox.TailleBox()
;/ copie un plateau vers un autre plateau
Procedure.l CopiePlateau(*PlateauDestination.Plateau,*PlateauSource.Plateau)
          For y=0 To 6
                    For x=0 To 5
                              *PlateauDestination\Colonne[y]\Ligne[x] = *PlateauSource\Colonne[y]\Ligne[x]
                    Next
          Next
          ProcedureReturn *PlateauDestination
EndProcedure
;/ Renvoie le nombre de cases libres dans une colonne donnée
Procedure.l CasesLibresDansColonne(*Plateau.Plateau,Colonne)
          compteur = 0
          For x=0 To 5 : If *Plateau\Colonne[Colonne]\Ligne[x] = 0 : compteur + 1 : EndIf : Next
          ProcedureReturn compteur
EndProcedure
;/ Renvoie une note en fonction des pions existants ou non dans une direction donnée
Procedure.l InteretCaseDirection(*Plateau.Plateau,joueur,Colonne,Ligne,DirectionX,DirectionY)
          Xmax = Colonne+3*DirectionX
          Ymax = Ligne+3*DirectionY
          If (Xmax>6) Or (Xmax<0) Or (Ymax>5) Or (Ymax<0)
                    ProcedureReturn 0
          Else
                    If joueur=#Humain : adverse = #CPU
                    Else : adverse = #Humain
                    EndIf
                    i = 0 : j = 0
                    While ( i < 4 ) And ( *Plateau\Colonne[Colonne+i*DirectionX]\Ligne[Ligne+i*DirectionY] <> adverse )
                              If *Plateau\Colonne[Colonne+i*DirectionX]\Ligne[Ligne+i*DirectionY] = joueur : j + 1 : EndIf : i + 1
                    Wend
                    If i = 4 : ProcedureReturn j*2+1
                    Else : ProcedureReturn 0
                    EndIf
          EndIf
EndProcedure
;/ Evalue un plateau pour un joueur donné
Procedure.l InteretPlateau(*Plateau.Plateau,joueur)
          compteur = 0
          For Colonne=0 To 6
                    For Ligne=0 To 5
                              compteur + InteretCaseDirection(*Plateau,joueur,Colonne,Ligne,1,0)
                              compteur + InteretCaseDirection(*Plateau,joueur,Colonne,Ligne,1,1)
                              compteur + InteretCaseDirection(*Plateau,joueur,Colonne,Ligne,0,1)
                              compteur + InteretCaseDirection(*Plateau,joueur,Colonne,Ligne,1,-1)
                    Next
          Next
          ProcedureReturn compteur
EndProcedure
;/ Teste si il y a victoire lors de l'exploration combinatoire
Procedure.b Victoire(*Plateau.Plateau,joueur)
          For x=0 To 3
                    For y=0 To 5
                              r = *Plateau\Colonne[x]\Ligne[y]+*Plateau\Colonne[x+1]\Ligne[y]+*Plateau\Colonne[x+2]\Ligne[y]+*Plateau\Colonne[x+3]\Ligne[y]
                              If r = joueur * 4 : ProcedureReturn #True : EndIf
                    Next
          Next
          For x=0 To 6
                    For y=0 To 2
                              r = *Plateau\Colonne[x]\Ligne[y]+*Plateau\Colonne[x]\Ligne[y+1]+*Plateau\Colonne[x]\Ligne[y+2]+*Plateau\Colonne[x]\Ligne[y+3]
                              If r = joueur * 4 : ProcedureReturn #True : EndIf
                    Next
          Next
          For x=0 To 3
                    For y=0 To 2
                              r = *Plateau\Colonne[x]\Ligne[y]+*Plateau\Colonne[x+1]\Ligne[y+1]+*Plateau\Colonne[x+2]\Ligne[y+2]+*Plateau\Colonne[x+3]\Ligne[y+3]
                              If r = joueur * 4 : ProcedureReturn #True : EndIf
                    Next
          Next
          For x=0 To 3
                    For y=3 To 5
                              r = *Plateau\Colonne[x]\Ligne[y]+*Plateau\Colonne[x+1]\Ligne[y-1]+*Plateau\Colonne[x+2]\Ligne[y-2]+*Plateau\Colonne[x+3]\Ligne[y-3]
                              If r = joueur * 4 : ProcedureReturn #True : EndIf
                    Next
          Next
          ProcedureReturn #False
EndProcedure
;/ Applique un coup dans un plateau
Procedure.b AppliqueCoup(*Plateau.Plateau,joueur,Colonne)
          If CasesLibresDansColonne(*Plateau,Colonne) = 0 : ProcedureReturn #False : EndIf
          *Plateau\Colonne[Colonne]\Ligne[CasesLibresDansColonne(*Plateau,Colonne)-1] = joueur
          ProcedureReturn #True
EndProcedure
;/ Applique et fait remonter les valeurs mini-max
Procedure.l ValeurMinMax(*Plateau.Plateau,profondeur,joueur)
          If profondeur = 0 : ProcedureReturn InteretPlateau(*Plateau,#CPU) - InteretPlateau(*Plateau,#Humain)
          Else
                    If joueur = #Humain
                              bscore = 101
                              For Colonne=0 To 6
                                        If AppliqueCoup(CopiePlateau(@Plateau.Plateau,*Plateau),#Humain,Colonne)
                                                  If Victoire(@Plateau,#Humain) : ProcedureReturn -100 : EndIf
                                                  score = ValeurMinMax(@Plateau,profondeur-1,#CPU)
                                                  If score < bscore : bscore = score : EndIf
                                        EndIf
                              Next
                    Else
                              bscore = -101
                              For Colonne=0 To 6
                                        If AppliqueCoup(CopiePlateau(@Plateau.Plateau,*Plateau),#CPU,Colonne)
                                                  If Victoire(@Plateau,#CPU) : ProcedureReturn 100 : EndIf
                                                  score = ValeurMinMax(@Plateau,profondeur-1,#Humain)
                                                  If score > bscore : bscore = score : EndIf
                                        EndIf
                              Next
                    EndIf
                    ProcedureReturn bscore
          EndIf
EndProcedure
;/ Applique l'algorithme mini-max à chaque colonne et décide de la meilleure
Procedure.b IA()
          If FinDeLaPartie = #False
                    t = 0 : For Colonne=0 To 6 : If PlateauJeu\Colonne[Colonne]\Ligne[0] = 0 : t + 1 : EndIf : Next
                    If t = 1 : For Colonne=0 To 6 : If PlateauJeu\Colonne[Colonne]\Ligne[0] = 0 : ProcedureReturn Colonne : EndIf : Next : EndIf
                    candidat = -1 : bscore = -101
                    For Colonne=0 To 6
                              If AppliqueCoup(CopiePlateau(@Plateau.Plateau,@PlateauJeu),#CPU,Colonne)
                                        If Victoire(@Plateau,#CPU) : ProcedureReturn Colonne : EndIf
                                        score = ValeurMinMax(@Plateau,Force,#Humain)
                                        If score > bscore
                                                  bscore = score
                                                  candidat = Colonne
                                        EndIf
                              EndIf
                    Next
                    ProcedureReturn candidat
          EndIf
EndProcedure
;/
Procedure SendMIDIMessage(nStatus.l,nCanal.l,nData1.l,nData2.l)
          dwFlags.l = nStatus | nCanal | (nData1 << 8) | (nData2 << 16)
          temp.l = midiOutShortMsg_(m_hMidiOut,dwFlags);
          If temp<>0 
                    MessageRequester("Problème", "Erreur dans l'envoi du message MIDI",0)
          EndIf
EndProcedure
Procedure MIDIOpen()
          If m_MIDIOpen = 0
                    If midiOutOpen_(@m_hMidiOut,MIDIMAPPER,0,0,0) <> 0 
                              MessageRequester("Problème", "Impossible d'ouvrir le périphérique MIDI",0)
                    Else
                              SendMIDIMessage($C0,0,0,0)
                              m_MIDIOpen = 1
                    EndIf
          EndIf
EndProcedure
Procedure PlayNoteMIDI(Canal.b,Note.b,VelociteDown.b,VelociteUp.b)
          If m_MIDIOpen
                    SendMIDIMessage($80 | Canal,0,Note,VelociteDown)
                    SendMIDIMessage($90 | Canal,0,Note,VelociteUp)
          EndIf          
EndProcedure
Procedure ChargeInstrument(Canal.b,Instrument.b)
          If m_MIDIOpen
                    SendMIDIMessage($C0 | Canal,0,Instrument,0)
          EndIf          
EndProcedure
Procedure RectangleArrondi3D(RectX,RectY,longueur,largeur,rayon,hauteur,couleur); C'est de la fausse 3D, fait à la hâte...
          Cr = Red(couleur) : Cg = Green(couleur) : Cb = Blue(couleur)
          RMin = Cr/2 : GMin = Cg/2 : BMin = Cb/2
          RMax = Cr*1.3 : If RMax > 255 : RMax = 255 :EndIf
          GMax = Cg*1.3 : If GMax > 255 : GMax = 255 :EndIf
          BMax = Cb*1.3 : If BMax > 255 : BMax = 255 :EndIf
          WPr.f = (RMax-Cr)/hauteur : WPg.f = (GMax-Cg)/hauteur : WPb.f = (BMax-Cb)/hauteur 
          BPr.f = (Cr-RMin)/hauteur : BPg.f = (Cg-GMin)/hauteur : BPb.f = (Cb-BMin)/hauteur 
          AZp = #Pi*rayon
          For t=0 To hauteur
                    FrontColor(RMax-t*WPr,GMax-t*WPg,BMax-t*WPb)
                    For x=rayon To longueur-rayon : Plot(RectX+x,RectY+t) : Next
                    For y=rayon To largeur-rayon : Plot(RectX+t,RectY+y) : Next
                    FrontColor(RMin+t*BPr,GMin+t*BPg,BMin+t*BPb)
                    For y=rayon To largeur-rayon : Plot(RectX+longueur-t,RectY+y) : Next
                    For x=rayon To longueur-rayon : Plot(RectX+x,RectY+largeur-t) : Next
                    Box(RectX+hauteur,RectY+rayon,longueur-2*hauteur,largeur-2*rayon,couleur)
          Next
          For AZ=0 To AZp
                    angle1.f = -AZ*#Pi/(2*AZp)
                    angle2.f = AZ*#Pi/(2*AZp)
                    angle3.f = (AZp+AZ)*#Pi/(2*AZp)
                    angle4.f = (AZp-AZ)*#Pi/(2*AZp)
                    For t=0 To hauteur
                              x = rayon-hauteur+t : y = 0
                              x1 = Cos(angle1)*x-Sin(angle1)*y
                              y1 = Sin(angle1)*x+Cos(angle1)*y
                              x1 + longueur-rayon : y1 + rayon
                              r.f = RMin+(hauteur-t)*BPr+AZ*((RMax-(hauteur-t)*WPr)-(RMin+(hauteur-t)*BPr))/AZp
                              g.f = GMin+(hauteur-t)*BPg+AZ*((GMax-(hauteur-t)*WPg)-(GMin+(hauteur-t)*BPg))/AZp
                              b.f = BMin+(hauteur-t)*BPb+AZ*((BMax-(hauteur-t)*WPb)-(BMin+(hauteur-t)*BPb))/AZp
                              If t<hauteur : Plot(RectX+x1,RectY+y1,RGB(r,g,b))
                              Else : c = Point(RectX+x1,RectY+y1)
                                        Plot(RectX+x1,RectY+y1,RGB((Red(c)+r)/2,(Green(c)+g)/2,(Blue(c)+b)/2))
                              EndIf
                              x = t-rayon : y = 0
                              x2 = Cos(angle2)*x-Sin(angle2)*y
                              y2 = Sin(angle2)*x+Cos(angle2)*y
                              x2 + rayon : y2 + rayon
                              r = RMax-t*WPr
                              g = GMax-t*WPg
                              b = BMax-t*WPb
                              If t>0 : Plot(RectX+x2,RectY+y2,RGB(r,g,b))
                              Else : c = Point(RectX+x2,RectY+y2)
                                        Plot(RectX+x2,RectY+y2,RGB((Red(c)+r)/2,(Green(c)+g)/2,(Blue(c)+b)/2))
                              EndIf
                              x = t+rayon-hauteur : y = 0
                              x3 = Cos(angle3)*x-Sin(angle3)*y
                              y3 = Sin(angle3)*x+Cos(angle3)*y
                              x3 + rayon : y3 + largeur-rayon
                              r = RMin+(hauteur-t)*BPr+AZ*((RMax-(hauteur-t)*WPr)-(RMin+(hauteur-t)*BPr))/AZp
                              g = GMin+(hauteur-t)*BPg+AZ*((GMax-(hauteur-t)*WPg)-(GMin+(hauteur-t)*BPg))/AZp
                              b = BMin+(hauteur-t)*BPb+AZ*((BMax-(hauteur-t)*WPb)-(BMin+(hauteur-t)*BPb))/AZp
                              If t<hauteur : Plot(RectX+x3,RectY+y3,RGB(r,g,b))
                              Else : c = Point(RectX+x3,RectY+y3)
                                        Plot(RectX+x3,RectY+y3,RGB((Red(c)+r)/2,(Green(c)+g)/2,(Blue(c)+b)/2))
                              EndIf
                              x = t+rayon-hauteur : y = 0
                              x4 = Cos(angle4)*x-Sin(angle4)*y
                              y4 = Sin(angle4)*x+Cos(angle4)*y
                              x4 + longueur-rayon : y4 + largeur-rayon
                              r = RMin+(hauteur-t)*BPr
                              g = GMin+(hauteur-t)*BPg
                              b = BMin+(hauteur-t)*BPb
                              If t<hauteur : Plot(RectX+x4,RectY+y4,RGB(r,g,b))
                              Else : c = Point(RectX+x4,RectY+y4)
                                        Plot(RectX+x4,RectY+y4,RGB((Red(c)+r)/2,(Green(c)+g)/2,(Blue(c)+b)/2))
                              EndIf
                              If t=0 And y2>hauteur: LineXY(RectX+x2+1,RectY+y2,RectX+x1,RectY+y2,couleur) : EndIf
                              If t=0 And y3<largeur-hauteur : LineXY(RectX+x3,RectY+y3,RectX+x4,RectY+y3,couleur) : EndIf
                    Next
          Next
EndProcedure
Procedure Box3D(x,y,longueur,hauteur)
          Line(x,y,longueur,0,$FFFFFF)
          Line(x,y,0,hauteur)
          Line(x,y+hauteur,longueur,0,$000000)
          Line(x+longueur,y,0,hauteur+1)
EndProcedure
Procedure Box3DI(x,y,longueur,hauteur)
          Line(x,y,longueur,0,$000000)
          Line(x,y,0,hauteur)
          Line(x,y+hauteur,longueur,0,$FFFFFF)
          Line(x+longueur,y,0,hauteur+1)
EndProcedure
Procedure PlaqueMetal(x,y,longueur,hauteur)
          Box3D(x,y,longueur,hauteur)
          Box3D(x+4,y+4,3,3)
          Box3D(x+4,y+hauteur-7,3,3)
          Box3D(x+longueur-7,y+4,3,3)
          Box3D(x+longueur-7,y+hauteur-7,3,3)
EndProcedure
Procedure AddClickBox(NumBox,x1,y1,x2,y2)
          AddElement(MaBox())
          MaBox()\Num = NumBox
          MaBox()\x1 = x1
          MaBox()\y1 = y1
          MaBox()\x2 = x2
          MaBox()\y2 = y2
EndProcedure
Procedure.b IsBox(x,y)
          If x >= MaBox()\x1 And x <= MaBox()\x2 And y >= MaBox()\y1 And y <= MaBox()\y2
                    ProcedureReturn #True
          EndIf
          ProcedureReturn #False
EndProcedure
Procedure Quitter(Survol)
          hDC = StartDrawing(ScreenOutput())
          pen = CreatePen_(0,4,$F0F0F0)
          SelectObject_(hDC,pen)
          Line(362,18,20,20)
          Line(361,38,20,-20) 
          If Survol : pen = CreatePen_(0,4,$2020C0)
          Else : pen = CreatePen_(0,4,$202020)
          EndIf
          SelectObject_(hDC,pen)
          Line(360,17,20,20)
          Line(360,37,20,-20) 
          DeleteObject_(pen)
          StopDrawing()
EndProcedure
Procedure AfficheJeu()
          DisplaySprite(#Jeu,0,0)
          For x=0 To 6
                    For y=0 To 5
                              If PlateauJeu\Colonne[x]\Ligne[y] = #Humain : DisplayTransparentSprite(#Jeton1,30+x*50,255+y*50) : EndIf
                              If PlateauJeu\Colonne[x]\Ligne[y] = #CPU : DisplayTransparentSprite(#Jeton2,30+x*50,255+y*50) : EndIf
                    Next
          Next
          If FinDeLaPartie And (ToiGagne Or ToiPerdu)
                    hDC = StartDrawing(ScreenOutput())
                    pen = CreatePen_(0,10,$00FF00)
                    SelectObject_(hDC,pen)
                    LineXY(Trait\Left,Trait\top,Trait\Right,Trait\bottom)
                    DeleteObject_(pen)
                    StopDrawing()
          EndIf
          If AToi = #Humain : DisplayTransparentSprite(#Jeton1,30,205) : EndIf
          If AToi = #CPU : DisplayTransparentSprite(#Jeton2,30,205) : EndIf
          StartDrawing(ScreenOutput())
          DrawingMode(1)
          DrawingFont(LoadFont(0,"Times New Roman",14,#PB_Font_Bold))
          FrontColor(250,250,250)
          Locate(260,120):DrawText(Str(ScoreHumain))
          Locate(260,140):DrawText(Str(ScoreCPU))
          Locate(260,160):DrawText(Str(ScoreNul))
          ScoreTotal = ScoreHumain + ScoreCPU + ScoreNul
          If ScoreTotal = 0 : ScoreTotal = 1 : EndIf; Empêche la division par zéro
          Locate(320,120):DrawText(Str(100*ScoreHumain/ScoreTotal)+" %")
          Locate(320,140):DrawText(Str(100*ScoreCPU/ScoreTotal)+" %")
          Locate(320,160):DrawText(Str(100*ScoreNul/ScoreTotal)+" %")
          StopDrawing()
EndProcedure
Procedure DeplaceJeton(JetonID,Colonne,Ligne)
          For x=30 To Colonne*50 Step 50
                    AfficheJeu()
                    DisplayTransparentSprite(JetonID,x,205)
                    FlipBuffers()
                    Delay(50)
          Next
          For y=205 To 505-Ligne*50 Step 50
                    AfficheJeu()
                    DisplayTransparentSprite(JetonID,x,y)
                    FlipBuffers()
                    Delay(50)
          Next
EndProcedure
Procedure MettreColonne(Colonne,joueur)
          AToi = 0
          If joueur = #Humain : DeplaceJeton(#Jeton1,Colonne,5-y) : AToi = #CPU
          Else : DeplaceJeton(#Jeton2,Colonne,5-y) : AToi = #Humain
          EndIf
          AppliqueCoup(@PlateauJeu,joueur,Colonne)
          PlayNoteMIDI(0,74,127,127)
          AfficheJeu()
          If AToi = #Humain : DisplayTransparentSprite(#Jeton1,30,205)
          Else : DisplayTransparentSprite(#Jeton2,30,205)
          EndIf
          FlipBuffers()
EndProcedure
Procedure ChargeRect(x1,y1,x2,y2)
          Trait\Left = x1
          Trait\top = y1
          Trait\Right = x2
          Trait\bottom = y2
EndProcedure
Procedure.b Gagne(joueur)
          For x=0 To 3
                    For y=0 To 5
                              r = PlateauJeu\Colonne[x]\Ligne[y]+PlateauJeu\Colonne[x+1]\Ligne[y]+PlateauJeu\Colonne[x+2]\Ligne[y]+PlateauJeu\Colonne[x+3]\Ligne[y]
                              If r = 4*joueur : ChargeRect(50+x*50,275+y*50,50+(x+3)*50,275+y*50) : ProcedureReturn #True : EndIf
                    Next
          Next
          For x=0 To 6
                    For y=0 To 2
                              r = PlateauJeu\Colonne[x]\Ligne[y]+PlateauJeu\Colonne[x]\Ligne[y+1]+PlateauJeu\Colonne[x]\Ligne[y+2]+PlateauJeu\Colonne[x]\Ligne[y+3]
                              If r = 4*joueur : ChargeRect(50+x*50,275+y*50,50+x*50,275+(y+3)*50) : ProcedureReturn #True : EndIf
                    Next
          Next
          For x=0 To 3
                    For y=0 To 2
                              r = PlateauJeu\Colonne[x]\Ligne[y]+PlateauJeu\Colonne[x+1]\Ligne[y+1]+PlateauJeu\Colonne[x+2]\Ligne[y+2]+PlateauJeu\Colonne[x+3]\Ligne[y+3]
                              If r = 4*joueur : ChargeRect(50+x*50,275+y*50,50+(x+3)*50,275+(y+3)*50) : ProcedureReturn #True : EndIf
                    Next
          Next
          For x=0 To 3
                    For y=5 To 3 Step -1
                              r = PlateauJeu\Colonne[x]\Ligne[y]+PlateauJeu\Colonne[x+1]\Ligne[y-1]+PlateauJeu\Colonne[x+2]\Ligne[y-2]+PlateauJeu\Colonne[x+3]\Ligne[y-3]
                              If r = 4*joueur : ChargeRect(50+x*50,275+y*50,50+(x+3)*50,275+(y-3)*50) : ProcedureReturn #True : EndIf
                    Next
          Next
          ProcedureReturn #False
EndProcedure
Procedure.b Plein()
          i = 0
          For x=0 To 6 : If PlateauJeu\Colonne[x]\Ligne[0] > 0 : i + 1 : EndIf : Next
          If i = 7 : ProcedureReturn #True : EndIf
          ProcedureReturn #False
EndProcedure
Procedure TestPartieFini()
          FinDeLaPartie = Gagne(#Humain)
          If FinDeLaPartie
                    ToiGagne = #True : AToi = 0 : ScoreHumain + 1 : AfficheJeu() : FlipBuffers()
                    For t=0 To 2 : PlayNoteMIDI(2,74,127,127) : Delay(200) : Next
                    ProcedureReturn
          EndIf
          If Plein()
                    FinDeLaPartie = #True : AToi = 0 : MatchNul = #True : ScoreNul + 1 : AfficheJeu() : FlipBuffers()
                    For t=0 To 5 : PlayNoteMIDI(2,64+t,127,127) : Delay(200) : Next
                    ProcedureReturn
          EndIf
          AfficheJeu() : FlipBuffers()
          MettreColonne(IA(),#CPU);/ C'est ici que l'on fait appel à l'intelligence artificielle
          FinDeLaPartie = Gagne(#CPU)
          If FinDeLaPartie
                    ToiPerdu = #True : AToi = 0 : ScoreCPU + 1 : AfficheJeu() : FlipBuffers()
                    For t=0 To 10 : PlayNoteMIDI(1,80+Random(20),127,127) : Delay(200-t*10) : Next
                    ProcedureReturn
          EndIf
          If Plein()
                    FinDeLaPartie = #True : AToi = 0 : MatchNul = #True : ScoreNul + 1 : AfficheJeu() : FlipBuffers()
                    For t=0 To 5 : PlayNoteMIDI(2,64+t,127,127) : Delay(200) : Next
                    ProcedureReturn
          EndIf
          AfficheJeu() : FlipBuffers()
EndProcedure
Procedure Timer()
          If AToi = #Humain
                    DisplaySprite(#Tampon,100,200)
                    DisplayTranslucideSprite(#Texte1,100,200,Time)
                    FlipBuffers()
          EndIf
          If ToiGagne = #True
                    DisplaySprite(#Tampon,100,200)
                    DisplayTranslucideSprite(#Texte2,100,200,Time)
                    FlipBuffers()
          EndIf
          If ToiPerdu = #True
                    DisplaySprite(#Tampon,100,200)
                    DisplayTranslucideSprite(#Texte3,100,200,Time)
                    FlipBuffers()
          EndIf
          If MatchNul = #True
                    DisplaySprite(#Tampon,100,200)
                    DisplayTranslucideSprite(#Texte4,100,200,Time)
                    FlipBuffers()
          EndIf
          Time + TimeDir
          If Time = 250 : TimeDir = -10 : EndIf
          If Time = 100 : TimeDir = 10 : EndIf
EndProcedure
Procedure NouvellePartie()
          For x=0 To 6 : For y=0 To 5 : PlateauJeu\Colonne[x]\Ligne[y] = 0 : Next : Next
          FinDeLaPartie = #False
          ToiGagne = #False
          ToiPerdu = #False
          MatchNul = #False
          If LeProchain = 0
                    If Random(100)<50 : LeProchain = #CPU
                    Else : LeProchain = #Humain
                    EndIf
          EndIf
          If LeProchain = #CPU
                    MettreColonne(3,#CPU)
                    LeProchain = #Humain
          Else
                    LeProchain = #CPU
                    AToi = #Humain
          EndIf
          AfficheJeu()
          FlipBuffers()
EndProcedure
Procedure mycallback(WindowID, Message, lParam, wParam)
          result = #PB_ProcessPureBasicEvents
          Select Message
                    Case #WM_PAINT
                              hRgn = CreateRoundRectRgn_(0,0,#WindowWidth,#WindowHeight,50,50)
                              hBrush = CreatePatternBrush_(hBmp)
                              SetClassLong_(hWnd, #GCL_HBRBACKGROUND, hBrush)
                              InvalidateRect_(hWnd, #Null, #True)
                              SetWindowRgn_(hWnd, hRgn, #True)
                              DeleteObject_(hRgn)
                              DeleteObject_(hBrush) 
                              AfficheJeu()
                              FlipBuffers()
          EndSelect
          ProcedureReturn result
EndProcedure
;- Debut du Programme
If InitSprite() = 0 : End : EndIf
SystemPath.s=Space(255)
GetSystemDirectory_(SystemPath,255)
hWnd = OpenWindow(#Window, 0, 0, #WindowWidth, #WindowHeight, #PB_Window_BorderLess | #PB_Window_Invisible | #PB_Window_ScreenCentered, "Puissance4")
SendMessage_(hWnd,#wm_seticon,#False,ExtractIcon_(0,SystemPath+"\shell32.dll",130));      affecte un icon au programme
OpenWindowedScreen(hWnd, 0,0,#WindowWidth,#WindowHeight,0,0,0)
SetTimer_(hWnd, 0, 50, 0) : Time = 0 : TimeDir = 10
;{/ Image Emplacement Vide
CreateSprite(#Vide,41,41) 
StartDrawing(SpriteOutput(#Vide)) 
DrawingBuffer = DrawingBuffer()
DrawingBufferPitch = DrawingBufferPitch()
Box(0,0,41,41,RGB(0,130,178))
RectangleArrondi3D(0,0,40,40,20,4,RGB(0,117,161))
*ptrD.LONG = DrawingBuffer : *ptrF.LONG = DrawingBuffer + 41*DrawingBufferPitch-32
While *ptrF > *ptrD
          a = *ptrD\l : *ptrD\l = *ptrF\l : *ptrF\l = a
          *ptrD + 4 : *ptrF -4
Wend
StopDrawing();}
;{/ Image Jeton1
CreateSprite(#Jeton1,41,41) 
StartDrawing(SpriteOutput(#Jeton1)) 
Box(0,0,41,41,RGB(0,130,178))
RectangleArrondi3D(0,0,40,40,20,4,RGB(198,145,0))
StopDrawing()
TransparentSpriteColor(#Jeton1,0,130,178);}
;{/ Image Jeton2
CreateSprite(#Jeton2,41,41) 
StartDrawing(SpriteOutput(#Jeton2)) 
Box(0,0,41,41,RGB(0,130,178))
RectangleArrondi3D(0,0,40,40,20,4,RGB(128,0,0))
StopDrawing()
TransparentSpriteColor(#Jeton2,0,130,178);}
;{/ Image Texte1
CreateSprite(#Texte1,250,50)
StartDrawing(SpriteOutput(#Texte1))
DrawingMode(1)
DrawingFont(LoadFont(0,"Times New Roman",30,#PB_Font_Bold))
FrontColor(10,10,10)
Locate(0,0) : DrawText("A toi de jouer !")
StopDrawing();}
;{/ Image Texte2
CreateSprite(#Texte2,250,50)
StartDrawing(SpriteOutput(#Texte2))
DrawingMode(1)
DrawingFont(LoadFont(0,"Times New Roman",30,#PB_Font_Bold))
FrontColor(10,10,10)
Locate(0,0) : DrawText("Tu as gagné !")
StopDrawing();}
;{/ Image Texte3
CreateSprite(#Texte3,250,50)
StartDrawing(SpriteOutput(#Texte3))
DrawingMode(1)
DrawingFont(LoadFont(0,"Times New Roman",30,#PB_Font_Bold))
FrontColor(10,10,10)
Locate(0,0) : DrawText("Tu as perdu !")
StopDrawing();}
;{/ Image Texte4
CreateSprite(#Texte4,250,50)
StartDrawing(SpriteOutput(#Texte4))
DrawingMode(1)
DrawingFont(LoadFont(0,"Times New Roman",30,#PB_Font_Bold))
FrontColor(10,10,10)
Locate(0,0) : DrawText("Match nul !")
StopDrawing();}
;{/ Image de fond
hBmp = CreateSprite(#Jeu,#WindowWidth,#WindowHeight) 
hDC = StartDrawing(SpriteOutput(#Jeu)) 
DrawingBuffer = DrawingBuffer()
Box(0,0,#WindowWidth,#WindowHeight,$FFFFFF)
RectangleArrondi3D(0,0,#WindowWidth,#WindowHeight,30,14,RGB(0,130,178))
DrawingMode(1)
DrawingFont(LoadFont(0,"Impact",14))
FrontColor(0,0,0)
For x=0 To 6
          Box3DI(25+x*50,250,49,300)
          Locate(47+x*50,555) : DrawText(Str(x+1))
Next
Box(20,70,120,120,RGB(0,104,142)) : PlaqueMetal(20,70,120,120)
Box(150,70,230,120,RGB(0,104,142)) : PlaqueMetal(150,70,230,120)
Box(180,80,170,25,RGB(0,78,107)) : Box3DI(180,80,170,25)
pen = CreatePen_(0,4,$F0F0F0) : SelectObject_(hDC,pen)
Line(362,18,20,20) : Line(361,38,20,-20)
pen = CreatePen_(0,4,$202020) : SelectObject_(hDC,pen)
Line(360,17,20,20) : Line(360,37,20,-20)
DeleteObject_(pen)
StopDrawing()
UseBuffer(#Jeu)
For x=0 To 6 : For y=0 To 5 : DisplaySprite(#Vide,30+x*50,255+y*50) : Next : Next
UseBuffer(-1)
;Lumière
*PtrRGB.rgbquad = DrawingBuffer
PDis.f = 0.5/(#WindowWidth*#WindowHeight)
For y=0 To #WindowHeight-1
          For x=0 To #WindowWidth-1
                    E.f = 1.4-(x*y*PDis)
                    Cr = *PtrRGB\rgbred & $FF : Cg = *PtrRGB\rgbgreen & $FF : Cb = *PtrRGB\rgbblue & $FF
                    r.f = Cr * E : If r > 255 : r = 255 : EndIf
                    g.f = Cg * E : If g > 255 : g = 255 : EndIf
                    b.f = Cb * E : If b > 255 : b = 255 : EndIf
                    *PtrRGB\rgbred = r : *PtrRGB\rgbgreen = g : *PtrRGB\rgbblue = b
                    *PtrRGB + 4
          Next
Next
StartDrawing(SpriteOutput(#Jeu)) 
DrawingMode(1)
DrawingFont(LoadFont(0,"Times New Roman",30))
FrontColor(50,50,50)
Locate(100,10) : DrawText("Puissance")
DrawingFont(LoadFont(0,"Times New Roman",34,#PB_Font_Italic))
FrontColor(50,50,50)
Locate(269,4) : DrawText("4") : Locate(269,6) : DrawText("4")
Locate(271,4) : DrawText("4") : Locate(271,6) : DrawText("4")
FrontColor(0,250,0)
Locate(270,5) : DrawText("4")
RectangleArrondi3D(30,80,100,30,15,6,RGB(0,90,174)) : AddClickBox(#Novice,30,80,130,110)
RectangleArrondi3D(30,115,100,30,15,6,RGB(0,90,174)) : AddClickBox(#Moyen,30,115,130,145)
RectangleArrondi3D(30,150,100,30,15,6,RGB(0,90,174)) : AddClickBox(#Maitre,30,150,130,180)
DrawingFont(LoadFont(0,"Times New Roman",14,#PB_Font_Bold))
FrontColor(200,200,200)
Locate(52,84):DrawText("Novice")
Locate(52,119):DrawText("Moyen")
Locate(52,154):DrawText("Maître")
DrawingFont(LoadFont(0,"Times New Roman",18,#PB_Font_Bold))
FrontColor(200,250,200)
Locate(235,79):DrawText("Scores")
DrawingFont(LoadFont(0,"Times New Roman",14,#PB_Font_Bold))
FrontColor(250,250,250)
Locate(170,120):DrawText("Humain")
Locate(170,140):DrawText("CPU")
Locate(170,160):DrawText("Nul")
StopDrawing();}
;{/ Image Tampon
UseBuffer(#Jeu)
GrabSprite(#Tampon,100,200,250,50)
UseBuffer(-1);}
;/
AddClickBox(#Quitter,360,17,380,37)
AddClickBox(#Colonnes,30,255,370,555)
SetWindowCallback(@mycallback())
HideWindow(#Window,0)
MIDIOpen() : ChargeInstrument(0,12) : ChargeInstrument(1,11) : ChargeInstrument(2,55)
;- Boucle Principale
FinDeLaPartie = #True
SurvolID = #Rien
Repeat
          Select WaitWindowEvent()
                    Case #WM_MOUSEMOVE;{ Gère les événements dus au déplacement de la souris
                              mx = WindowMouseX()
                              my = WindowMouseY()
                              ForEach MaBox()
                                        If IsBox(mx,my)
                                                  If SurvolID = #Rien
                                                            SetClassLong_(hWnd,#GCL_HCURSOR,LoadCursor_(0,#IDC_HAND))
                                                            Select MaBox()\Num
                                                                      Case #Colonnes
                                                                                SurvolID = #Colonnes
                                                                      Case #Novice
                                                                                SurvolID = #Novice
                                                                                StartDrawing(ScreenOutput())
                                                                                RectangleArrondi3D(30,80,100,30,15,6,RGB(0,108,209))
                                                                                DrawingMode(1)
                                                                                DrawingFont(LoadFont(0,"Times New Roman",14,#PB_Font_Bold))
                                                                                FrontColor(255,255,255)
                                                                                Locate(52,84):DrawText("Novice")
                                                                                StopDrawing() : FlipBuffers()
                                                                      Case #Moyen
                                                                                SurvolID = #Moyen
                                                                                StartDrawing(ScreenOutput())
                                                                                RectangleArrondi3D(30,115,100,30,15,6,RGB(0,108,209))
                                                                                DrawingMode(1)
                                                                                DrawingFont(LoadFont(0,"Times New Roman",14,#PB_Font_Bold))
                                                                                FrontColor(255,255,255)
                                                                                Locate(52,119):DrawText("Moyen")
                                                                                StopDrawing() : FlipBuffers()
                                                                      Case #Maitre
                                                                                SurvolID = #Maitre
                                                                                StartDrawing(ScreenOutput())
                                                                                RectangleArrondi3D(30,150,100,30,15,6,RGB(0,108,209))
                                                                                DrawingMode(1)
                                                                                DrawingFont(LoadFont(0,"Times New Roman",14,#PB_Font_Bold))
                                                                                FrontColor(255,255,255)
                                                                                Locate(52,154):DrawText("Maître")
                                                                                StopDrawing() : FlipBuffers()
                                                                      Case #Quitter
                                                                                SurvolID = #Quitter
                                                                                Quitter(1) : FlipBuffers()
                                                            EndSelect
                                                  EndIf
                                        Else
                                                  Select MaBox()\Num
                                                            Case #Colonnes
                                                                      If SurvolID = #Colonnes
                                                                                SurvolID = #Rien
                                                                                SetClassLong_(hWnd,#GCL_HCURSOR,LoadCursor_(0,#IDC_ARROW))
                                                                      EndIf
                                                            Case #Novice
                                                                      If SurvolID = #Novice
                                                                                SurvolID = #Rien
                                                                                SetClassLong_(hWnd,#GCL_HCURSOR,LoadCursor_(0,#IDC_ARROW))
                                                                                StartDrawing(ScreenOutput())
                                                                                RectangleArrondi3D(30,80,100,30,15,6,RGB(0,90,174))
                                                                                DrawingMode(1)
                                                                                DrawingFont(LoadFont(0,"Times New Roman",14,#PB_Font_Bold))
                                                                                FrontColor(200,200,200)
                                                                                Locate(52,84):DrawText("Novice")
                                                                                StopDrawing() : FlipBuffers()
                                                                      EndIf
                                                            Case #Moyen
                                                                      If SurvolID = #Moyen
                                                                                SurvolID = #Rien
                                                                                SetClassLong_(hWnd,#GCL_HCURSOR,LoadCursor_(0,#IDC_ARROW))
                                                                                StartDrawing(ScreenOutput())
                                                                                RectangleArrondi3D(30,115,100,30,15,6,RGB(0,90,174))
                                                                                DrawingMode(1)
                                                                                DrawingFont(LoadFont(0,"Times New Roman",14,#PB_Font_Bold))
                                                                                FrontColor(200,200,200)
                                                                                Locate(52,119):DrawText("Moyen")
                                                                                StopDrawing() : FlipBuffers()
                                                                      EndIf
                                                            Case #Maitre
                                                                      If SurvolID = #Maitre
                                                                                SurvolID = #Rien
                                                                                SetClassLong_(hWnd,#GCL_HCURSOR,LoadCursor_(0,#IDC_ARROW))
                                                                                StartDrawing(ScreenOutput())
                                                                                RectangleArrondi3D(30,150,100,30,15,6,RGB(0,90,174))
                                                                                DrawingMode(1)
                                                                                DrawingFont(LoadFont(0,"Times New Roman",14,#PB_Font_Bold))
                                                                                FrontColor(200,200,200)
                                                                                Locate(52,154):DrawText("Maître")
                                                                                StopDrawing() : FlipBuffers()
                                                                      EndIf
                                                            Case #Quitter
                                                                      If SurvolID = #Quitter
                                                                                SurvolID = #Rien
                                                                                SetClassLong_(hWnd,#GCL_HCURSOR,LoadCursor_(0,#IDC_ARROW))
                                                                                Quitter(0) : FlipBuffers()
                                                                      EndIf
                                                  EndSelect
                                        EndIf
                              Next;}
                    Case #WM_KEYDOWN;{  Commande clavier
                              Key = EventwParam()
                              If Key = 27 : End : EndIf
                              If FinDeLaPartie = #False
                                        If Key >= 49 And Key <= 55
                                                  MettreColonne(Key-49,#Humain) : TestPartieFini()
                                        EndIf
                                        If Key >= 97 And Key <= 103
                                                  MettreColonne(Key-97,#Humain) : TestPartieFini()
                                        EndIf
                              EndIf;}
                    Case #WM_LBUTTONDOWN;{ Gestion des boutons et déplacement de la fenêtre
                              mx = WindowMouseX()
                              Select SurvolID
                                        Case #Quitter : End
                                        Case #Colonnes : If FinDeLaPartie = #False : MettreColonne((mx-30)/50,#Humain) : TestPartieFini() : EndIf
                                        Case #Novice : Force = 2 : NouvellePartie()
                                        Case #Moyen : Force = 3 : NouvellePartie()
                                        Case #Maitre : Force = 4 : NouvellePartie()
                                        Case #Rien : SendMessage_(hWnd, #WM_NCLBUTTONDOWN, #HTCAPTION, NULL)
                              EndSelect;}
                    Case #WM_TIMER;{    Affiche les messages
                              Timer();}
                    Case #PB_Event_CloseWindow: End
          EndSelect
ForEver
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

:? toi t'es trop fort !!
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

Dobro a écrit ::? toi t'es trop fort !!
C'est sûr :cry:

:wink:
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

Y a pas à dire , c'est excellent, même le graphisme :D :D :D :D

Bravo
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Message par Le Soldat Inconnu »

ça m'énerve, l'IA est trop bonne :mrgreen:
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Oliv
Messages : 2117
Inscription : mer. 21/janv./2004 18:39

Message par Oliv »

8O Aussi bien que le tetris 8O
fweil
Messages : 505
Inscription : dim. 16/mai/2004 17:50
Localisation : Bayonne (64)
Contact :

Message par fweil »

erix14,

C'est excellent, bien écrit, agréable à voir et à utiliser !

Bravo
Mon avatar reproduit l'image de 4x1.8m présentée au 'Salon international du meuble de Paris' en janvier 2004, dans l'exposition 'Shades' réunisant 22 créateurs autour de Matt Sindall. L'original est un stratifié en 150 dpi.
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

Quelques traits parasites qui apparaissent uniquement lorsque je passe ma souris sur les boutons Novice ,Moyen , Maitre .

Image

A part ça rien à redire , sinon bravo et merci pour le code .
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Message par Le Soldat Inconnu »

Je peux le mettre sur Codes-FR ?
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
DominiqueB
Messages : 47
Inscription : sam. 01/mai/2004 14:41

merci !

Message par DominiqueB »

Trop fort, merci pour ce bon jeux !

Dominique.
Dominique
erix14
Messages : 480
Inscription : sam. 27/mars/2004 16:44
Contact :

Message par erix14 »

Le Soldat Inconnu,
oui, tu peux le mettre sur Codes-FR.
Comtois,
lorsque l'on passe la souris sur les boutons, ceux-ci s'éclaircissent, pour cela je les redessine avec des plot(x,y) et une sortie ScreenOutput(). Le truc normal... Ça marche très bien chez moi et chez tous ceux à qui j'ai fait tester, j'ai réfléchi longtemps sur ton problème, mais la, je ne vois vraiment pas ce qui se passe.
Si quelqu'un trouve une explication à ce phénomène, je suis preneur...
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

ok Erix4 , merci de confirmer ce que je pensais , ce problème n'existe que chez moi .
A l'occasion j'essaierai d'étudier ton code et d'extraire le code fautif pour mieux mettre en évidence le problème.
Je sais qu'avec ma carte ATI j'avais déjà des différences d'affichages par rapport à d'autres , mais est-ce la bonne explication ? mystère et boule de gomme .
Heis Spiter
Messages : 1092
Inscription : mer. 28/janv./2004 16:22
Localisation : 76
Contact :

Message par Heis Spiter »

Demandez à Ploux, il a déjà travaillé la dessus...
Heis Spiter, webmaster du site http://www.heisspiter.net
Développeur principal et administrateur du projet Bird Chat
Parti courir au bonheur du dév. public et GPL :D
garzul
Messages : 683
Inscription : mer. 26/mai/2004 0:33

Message par garzul »

Alors la bravo rien a dire je suis siderer PS : Ces dernier temps vous me voyez plus car je m'occupe de coder une démos pour le concour de bregeon donc c'est pour sa par contre je me ferais un plaisir de vous la montrer quand j'aurais les résultat :d .
cookie
Messages : 71
Inscription : mar. 27/janv./2004 21:08
Contact :

Message par cookie »

Impressionnant, encore bravo :D
Cookie
Répondre