Basic Univers
#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()
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
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
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
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
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
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
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
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)
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
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)
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
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))
OpenWindowedScreen(hWnd, 0, 0, #WindowWidth, #WindowHeight, 0, 0, 0)
SetTimer_(hWnd, 0, 50, 0) : Time = 0 : TimeDir = 10
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()
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)
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)
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()
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()
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()
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()
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)
*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()
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)
FinDeLaPartie = #True
SurvolID = #Rien
Repeat
Select WaitWindowEvent()
Case #WM_MOUSEMOVE
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
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
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
Timer()
Case #PB_Event_CloseWindow: End
EndSelect
ForEver