Basic Univers
;/
;/                   -  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 tPlot(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 tPlot(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 tPlot(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 y3LineXY(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