Le jeu Othello : seconde partie

Dernière mise à jour le par vb95 .

Programmer un jeu - OTHELLO - Seconde partie

Découvrir Visual Basic Express Edition dans une première application.

Introduction

Ce tutoriel est la suite de Programmer un jeu - OTHELLO - Première partie.

L'auteur en est AffreuxJojp, je n'ai contribué qu'à sa mise en page dans cette nouvelle interface.

Rendre notre programme plus exploitable

Donc, nous venons de découvrir qu'il faut changer de couleur de pion après chaque coup ! Ce n'est pas une découverte puisque c'est la règle du jeu, mais que l'on applique implicitement, sans vraiment y penser et de plus cette règle introduit des exceptions. Pour la résoudre, il faut introduire une nouvelle fonction capable de tester si le jeu est possible (dans au moins une case) pour une couleur donnée :

'
' Teste si le jeu est possible pour cette couleur de pion

Function CanPlay(ByVal pion As Piece) As Boolean

For idx As Index = Index.a1 To Index.h8 'teste toutes les cases du jeu
    If CaseCheck(idx, pion) Then Return True
Next
CanPlay = False
End Function

Une procédure supplémentaire est créée pour assurer le changement de la couleur du pion joueur et l'événement est modifié en conséquence.
Remarque : La nouvelle procédure ne ré-affiche pas le jeu si la case choisie n'était pas bonne.

'
Sub PionPlaying(ByVal idx As Index)
Dim count As Integer = Playing(idx, Player)

If count > 0 Then 'OK c'est bon
    If CanPlay(NotColor(Player)) Then Player = NotColor(Player)
    Display()
End If
End Sub

Private Sub Form1_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseClick
Dim idx As Index = ToIndex(e.Location)

If idx <> Index.ovf Then PionPlaying(idx) 'si on clique dans l'Othellier
End Sub

Rendre notre programme plus convivial

Cette fois-ci ça marche, on peut jouer, mais si notre programme assure le minimum, il ne communique toujours pas beaucoup, il pourrait faire beaucoup mieux ! Et puis, il ne gère pas la fin de partie, lorsqu'aucun des joueurs ne peut jouer !

Nous allons réécrire la dernière fonction « PionPlaying » et ajouter toutes fonctions nécessaires pour sortir les différents messages sur le jeu, en utilisant les « TextBox » prévues. La fonction « Display » est aussi complétée. A la suite de toutes ces modifications, voici un état complet du jeu dans cette nouvelle version :

'
Public Class Form1

Dim g As Graphics
' position Othellier dans l'image (et dans Form1)
Const ofsX = 17, OfsY = 17, oWidth = 208, oHeight = 208

'====================================================================
' Etat du jeu

Enum Index As Byte ' positions caractéristiques sur l'Othellier
  a1 = 0 ' première case du jeu
  h8 = 63 ' dernière case du jeu
  d4 = 8 * 3 + 3 ' cases centrales de départ
  d5 = 8 * 3 + 4
  e4 = 8 * 4 + 3
  e5 = 8 * 4 + 4
  ovf = 64 'valeur utilisée pour signifier le bord du jeu, hors Othellier
End Enum

Enum Piece As Byte ' différentes valeurs possibles d'une case du jeu
  Empty
  Black
  White
  Border ' valeur de la case Index.ovf
End Enum

' État courant du jeu : état des 64 cases du jeu, plus une, réservée pour signaler
Dim table(Index.ovf) As Piece 'le bord de l'Othellier lors des déplacements
Dim Player As Piece 'la couleur du pion qui doit jouer (Piece.Empty = partie terminée)

'====================================================================

' Mouvements sur l'Othellier dans les 8 directions
Enum Direction As Byte ' Les 8 directions de mouvements sur l'Othellier (0..7)
  North
  NorthEast
  East
  SouthEast
  South
  SouthWest
  West
  NorthWest
  last = 7
End Enum

'====================================================================

'Tables utilisées pour convertir un index en texte désignant la case ("a1".."h8")
Const tchar As String = "abcdefgh"
Const tnum As String = "12345678"

'====================================================================

' Conversion d'un index (dans la table de jeu) en position dans l'affichage
Function ToPosition(ByVal idx As Index) As Point

If idx = Index.ovf Then
    ToPosition.X = -1 : ToPosition.Y = -1
Else
    ToPosition.X = ((idx And 7) * oWidth) \ 8 + ofsX
    ToPosition.Y = ((idx >> 3) * oHeight) \ 8 + OfsY
End If
End Function

' Conversion d'une position dans l'affichage en index dans la table (de jeu)
Function ToIndex(ByVal pos As Point) As Index

pos.X -= ofsX : pos.Y -= OfsY
If pos.X >= 0 And pos.X < oWidth And pos.Y >= 0 And pos.Y < oHeight Then
    ToIndex = ((pos.X * 8) \ oWidth) + 8 * ((pos.Y * 8) \ oHeight)
Else
    ToIndex = Index.ovf
End If
End Function

' Conversion d'un index (dans la table de jeu) en texte de position
Function IndexStr(ByVal idx As Index) As String

'codage : a1=0, h1=7, a2=8, a8=56, h8=63, ...
IndexStr = If(idx >= 0 AndAlso idx < 64, _
tchar.Chars(idx Mod 8) & tnum.Chars(idx \ 8), "??")
End Function

' Conversion d'un texte de position en index dans la table de jeu
Function AlphaNumToIndex(ByVal str As String) As Index

'codage : a1=0, h1=7, a2=8, a8=56, h8=63, ...
str = str.Trim(" "",;'").ToLower() + " " 'nettoyage du texte
Dim u As Integer = tchar.IndexOf(str.Chars(0)) 'premier car. (a..h) nom colonnes
Dim v As Integer = tnum.IndexOf(str.Chars(1)) '2eme car (1..8) nom lignes
AlphaNumToIndex = If(u >= 0 And v >= 0, u + 8 * v, Index.ovf)
End Function

' Conversion d'un no de case exprime en décimal (11..88) en Index
Function NumToIndex(ByVal val As Byte) As Index

' codage : 11=a1(0), 18=h1(7), 21=a2(8), 81=a8(56), 88=h8(63), utilise par WTB
Dim u As Integer = val \ 10 - 1 ' dizaines
Dim v As Integer = val Mod 10 - 1 ' unites
NumToIndex = If(u >= 0 And v >= 0 And u < 8 And v < 8, v + 8 * u, Index.ovf)
End Function

' Calcul de la position suivante pour un déplacement sur l'Othellier
Function NextPos(ByVal idx As Index, ByVal dir As Direction) As Index

'suivant la position de départ et la direction, on peut sortir de l'Othellier
Select Case dir
    Case Direction.North
        NextPos = If(idx \ 8 = 0, Index.ovf, idx - 8)

    Case Direction.NorthEast
        NextPos = If(idx Mod 8 = 7 Or idx \ 8 = 0, Index.ovf, idx - 7)

    Case Direction.East
        NextPos = If(idx Mod 8 = 7, Index.ovf, idx + 1)

    Case Direction.SouthEast
        NextPos = If(idx Mod 8 = 7 Or idx \ 8 = 7, Index.ovf, idx + 9)

    Case Direction.South
        NextPos = If(idx \ 8 = 7, Index.ovf, idx + 8)

    Case Direction.SouthWest
        NextPos = If(idx Mod 8 = 0 Or idx \ 8 = 7, Index.ovf, idx + 7)
 
    Case Direction.West
        NextPos = If(idx Mod 8 = 0, Index.ovf, idx - 1)

    Case Direction.NorthWest
        NextPos = If(idx Mod 8 = 0 Or idx \ 8 = 0, Index.ovf, idx - 9)

End Select
End Function

' Retournement d'un pion
Function NotColor(ByVal pion As Piece) As Piece

Select Case pion
    Case Piece.Black
        NotColor = Piece.White

    Case Piece.White
        NotColor = Piece.Black

    Case Else ' pour les autres états pas de changement
        NotColor = pion

End Select
End Function

' Conversion en text du nom du pion joueur
Function PieceStr(ByVal pion As Piece) As String

Select Case pion
    Case Piece.Black
        PieceStr = "Noir"

    Case Piece.White
        PieceStr = "Blanc"

    Case Else
        PieceStr = ""

End Select
End Function

' Invite une couleur a jouer
Function PromptPlayer(ByVal m As Byte) As String

If m = 0 Then
    PromptPlayer = "C'est maintenant à " & PieceStr(Player) & " de jouer."
ElseIf m = 1 Then
    PromptPlayer = "Et " & PieceStr(Player) & " continue de jouer."
Else
    PromptPlayer = "Et " & PieceStr(Player) & " abandonne !"
End If
End Function

' Change la couleur du joueur si c'est nécessaire et sortie du message d'invite
' à jouer ou de fin

Sub ComputNext(ByVal text As String, Optional ByVal db As Boolean = False)
Dim flg As Byte = If(db, 2, 0)

Messages.Text = text & vbCrLf
If CanPlay(Player) Then
    Messages.Text &= PromptPlayer(flg)
ElseIf CanPlay(NotColor(Player)) Then 'la couleur adverse ne peut jouer,
    ' continue la meme couleur
    Player = NotColor(Player)
    Messages.Text &= PromptPlayer(flg + 1)
Else 'fin du jeu, aucun des pions ne pouvant jouer
    Player = Piece.Empty ' indique la fin de la partie
    Messages.Text &= ScoreEndOfPlay()
End If
End Sub

' Édite le score de fin de jeu
Function ScoreEndOfPlay() As String
Dim noir As Byte = CountPions(Piece.Black)
Dim blanc As Byte = CountPions(Piece.White)

If noir > blanc Then Return " Et Noir gagne " & Str(64 - blanc) _
& " à " & Str(blanc) & "."

If blanc > noir Then Return " Et Blanc gagne " & Str(64 - noir) _
& " à " & Str(noir) & "."

Return " Et le jeu se termine match null " & Str(noir) & " à " & Str(blanc) & "."
End Function

' Message ajoutant le compte des cases vides
Function VidesMsg(ByVal total As Byte) As String

VidesMsg = If(total = 64, "", " + " + Str(64 - total))
End Function

' Compte les points d'une couleur donnée
Function CountPions(ByVal pion As Piece) As Byte

CountPions = 0
For i As Index = Index.a1 To Index.h8
    If table(i) = pion Then CountPions += 1
Next
End Function

'====================================================================
' JEU

' initialise et démarre le jeu
Sub Initialize()

InitTable()
Messages.Text = "Début du jeu :" & vbCrLf & PromptPlayer(0)
End Sub

' Initialisation de la table du jeu
Sub InitTable()

For i As Index = Index.a1 To Index.h8
    table(i) = Piece.Empty
Next
table(Index.d4) = Piece.White
table(Index.d5) = Piece.Black
table(Index.e4) = Piece.Black
table(Index.e5) = Piece.White
table(Index.ovf) = Piece.Border
Player = Piece.Black ' Noir commence toujours la partie
End Sub

' Recherche si, dans une direction donnée, le retournement de pions adverses est possible
Function Search(ByVal idx As Index, ByVal dir As Direction, ByVal pion As Piece) As Boolean
Dim notPion As Piece = NotColor(pion) ' couleur pion adverse

'il faut, au moins, qu'à la premiere case parcourue, le pion rencontré soit adverse
idx = NextPos(idx, dir)
If table(idx) <> notPion Then Return False
Do 'cherche la fin des pions adverses dans la direction
    idx = NextPos(idx, dir)
Loop While table(idx) = notPion
'la case suivante, dans la direction, doit être occupée par un pion de la couleur
Return CBool(table(idx) = pion)
End Function

' Teste si le jeu de cette case avec cette couleur de pion est possible
Function CaseCheck(ByVal idx As Index, ByVal pion As Piece) As Boolean

If table(idx) <> Piece.Empty Then Return False 'la case n'est pas vide
For dir As Direction = 0 To Direction.last 'dans les 8 directions
    If Search(idx, dir, pion) Then Return True 'cherche une ou le jeu est possible
Next
Return False
End Function

' Teste si le jeu est possible pour cette couleur de pion
Function CanPlay(ByVal pion As Piece) As Boolean

For idx As Index = Index.a1 To Index.h8 'teste toutes les cases
    If CaseCheck(idx, pion) Then Return True
Next
CanPlay = False
End Function

' Place un nouveau pion dans le jeu (si possible), indique le nombre de pions gagnés
Function Playing(ByVal idx As Index, ByVal pion As Piece) As Integer

Playing = 1 ' on compte le pion joué
If table(idx) = Piece.Empty Then ' La case est vide
    For dir As Direction = 0 To Direction.last ' pour les 8 directions
        If Search(idx, dir, pion) Then ' Cette direction est valide
            Dim i As Index = NextPos(idx, dir) ' première case dans la direction
            'le premier est toujours à retourner, puisque la direction est valide
            Do
                table(i) = pion 'retourne les pions dans cette direction
                Playing += 1 'compte les pions retournés
                i = NextPos(i, dir) 'extrait la position suivante
            Loop While table(i) <> pion 'termine sur un pion de sa couleur
        End If
    Next
End If
'Si la case de depart (idx) est mal choisie, aucun pion n'est retourné
If Playing > 1 Then table(idx) = pion Else Playing = 0
End Function

' Affiche le jeu
Sub Display()
Dim noir As Byte = CountPions(Piece.Black)
Dim blanc As Byte = CountPions(Piece.White)

' Affiche l'état des cases du jeu
For i As Index = Index.a1 To Index.h8
    ImageList1.Draw(g, ToPosition(i), table(i))
Next
' Affiche le score actuel du jeu
If Player <> Piece.Empty OrElse noir = blanc Then 'partie en cours ou match null
    ScoreBlack.Text = "Score Noir : " + Str(noir) + " pions"
    ScoreWhite.Text = "Score Blanc : " + Str(blanc) + " pions"
ElseIf noir > blanc Then 'partie terminée, Noir gagne
    ScoreBlack.Text = "Noir gagne : " + Str(noir) + " pions" _
    & VidesMsg(noir + blanc)
    ScoreWhite.Text = "Score Blanc : " + Str(blanc) + " pions"
Else 'partie terminée, Blanc gagne
    ScoreBlack.Text = "Score Noir : " + Str(noir) + " pions"
    ScoreWhite.Text = "Blanc gagne : " + Str(blanc) _
    & " pions" + VidesMsg(noir + blanc)
End If
End Sub

' Affiche les messages d'après avoir joué un pion
Sub PlayingMsg(ByVal idx As Index, ByVal count As Integer)

If count > 0 Then 'OK c'est bon, on memorise et affiche le nouveau jeu
    Dim msg As String = PieceStr(Player) & " a joué et gagne" & Str(count) _
    & " points."
    Player = NotColor(Player)
    ComputNext(msg)
    Display()
ElseIf Player <> Piece.Empty Then
    Messages.Text = "Erreur, " & PieceStr(Player) _
    & " doit jouer une case valide !"
End If
If Player = Piece.Empty Then ' le jeu est fini
    If MsgBox("Voulez-vous recommencer une autre partie ?", _
    MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
        Initialize()
        Display()
    End If
End If
End Sub

'====================================================================
' EVENEMENTS...

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Initialize()
End Sub

Private Sub Form1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint

g = Me.CreateGraphics()
Display()
End Sub

' Place le pion sur l'Othellier à la suite d'un clic souris
Private Sub Form1_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseClick
Dim idx As Index = ToIndex(e.Location)

If idx <> Index.ovf Then PlayingMsg(idx, Playing(idx, Player))
End Sub

'Avancer au pas suivant de la partie
Private Sub BtnFor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnFor.Click

End Sub

'Reculer d'un pas dans la partie

Private Sub BtnBack_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnBack.Click

End Sub

'Remise de la partie au début

Private Sub BtnZero_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnZero.Click

End Sub

'Se place à la fin de la partie telle qu'elle est enregistrée

Private Sub BtnMax_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnMax.Click

End Sub

'Rejouer une partie sauvegardée dans un fichier
Private Sub BtnRead_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnRead.Click

End Sub

'Ecriture dans un fichier de la partie en cours
Private Sub BtnWrite_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnWrite.Click

End Sub

'Rejouer la partie designée de la base de données
Private Sub RecNb_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RecNb.ValueChanged

End Sub
End Class

Fonctions complémentaires (rejouer, sauvegarder)

La version décrite plus haut, permet à deux joueurs de faire une partie, elle vérifie si les coups proposés sont légaux et elle compte les points et détermine le gagnant. Mais on peut lui ajouter des fonctionnalités de confort comme annuler un coup, sauvegarder une partie puis la rejouer, ou encore afficher les parties contenues dans une Base de Données de type WTB. Ces fonctionnalités font intervenir les boutons qui ne sont pas utilisés.

Pour cela, il faut ajouter les variables globales suivantes :

'
Dim current As Integer 'le numero du coup joué (1, 2,...)

Dim history(60) As Byte 'mémoire des coups joués, termine par une case à zéro

Dim db As Byte() 'Base de données de jeu, chargée par ReadWTB()

Et les traitements correspondants:

'
' Affichage de l'entête de la base de données (si elle est chargée)
Function DbHeader(ByVal nb As Integer) As String

DbHeader = ""
Try
    Dim year As Integer = db(10) + db(11) * 256
    Dim nbMax As Integer = (db.Length - 16) \ 68
    DbHeader = "Année" & Str(year)
    DbHeader &= If(nb > 0, ", partie" & Str(nb) & " /" & Str(nbMax), _
    ", comportant" & Str(nbMax) & " parties")
Catch
End Try
End Function

'====================================================================
' HISTORY

' Sauvegarde du coup dans l'history
Sub SaveStep(ByVal idx As Index, ByVal pion As Piece)

history(current) = (idx << 2) Or (pion And 3)
current += 1
history(current) = 0 ' indicateur de fin de l'history
End Sub

' Lecture de l'état du jeu, à un pas quelconque, à partir de l'history
Sub Restore(ByVal curStep As Integer, Optional ByVal back As Boolean = True)
Dim idx, count As Byte

InitTable()
Do While current < curStep AndAlso history(current) <> 0
    idx = history(current) : Player = idx And 3 : idx >>= 2
    count = Playing(idx, Player) ' replace les pions comme ils ont déjà été joués
    current += 1
Loop
If current = 0 Then
    Messages.Text = "Retour au début du jeu :" & vbCrLf & PromptPlayer(0)
Else
    Dim msg As String = SuppressMsg(back) & BackMsg(count, back)
    Player = NotColor(Player) ' Normalement on change de couleur à chaque coup
    ComputNext(msg)
End If
Display() 'Affiche le nouveau jeu
End Sub

'====================================================================
' LECTURE / ECRITURE FICHIER

Sub Read(ByRef filename As String)

If Strings.Right(filename, 4).ToLower() = ".wtb" Then ReadWTB(filename) Else ReadAscii(filename)
End Sub

' Lecture d'une partie a partir d'un fichier ascii
Sub ReadAscii(ByRef fileName As String)
Dim comments As String = "", line As String = "", nb As Integer = 0

InitTable()
history(0) = 0 ' vide la memoire de l'history
Try
    FileOpen(1, fileName, OpenMode.Input)
    While Not EOF(1)
        line = LineInput(1) : nb += 1
        Dim idx As Index = AlphaNumToIndex(line)
 If idx <> Index.ovf Then 'Le numero de la case est valide, détermine la couleur
     If Not CaseCheck(idx, Player) Then Player = NotColor(Player)
     If Playing(idx, Player) = 0 Then Err.Raise(6) 'le coup est illégal !
     SaveStep(idx, Player)
     Player = NotColor(Player)
 ElseIf line.Length() > 1 And line(0) = "'" Then
     comments = line.Substring(1) & " : "
 End If
    End While
    ComputNext(comments) 'Affiche le message de présentation de la partie
Catch
    Messages.Text = If(current > 0, Str(current) & " coups lus", "")
    InitTable()
    MsgBox(fileName & vbCrLf & If(nb > 0, comments & vbCrLf & line & _
    " >> Erreur à la ligne" & Str(nb), "Erreur de lecture !"))
Finally
    FileClose(1)
End Try
Display() 'Affiche le nouveau jeu
End Sub

'Chargement de la base de données
Sub ReadWTB(ByRef fileName As String)
Dim nb As Integer = 0

Try
    db = My.Computer.FileSystem.ReadAllBytes(fileName)
    If db.Length > 16 Then nb = (db.Length - 16) \ 68
Catch
    MsgBox(fileName & vbCrLf & "Erreur de lecture !")
    db = Nothing
End Try
If nb > 0 Then
    Dim year As Integer = db(10) + db(11) * 256
    RecNb.Maximum = nb
    RecNb.Value = 1 : LoadWTB(1) ' par défaut on charge le no 1
    Messages.Text = "Le fichier " & fileName & vbCrLf & DbHeader(0) & " est chargé."
    RecNb.Enabled = True
Else
    RecNb.Enabled = False
End If
End Sub

'Chargement du record nb à partir de la base de données
Sub LoadWTB(ByVal nb As Integer)
Dim n As Integer = nb * 68 + 16 - 60 ' position indice dans la base de données

If n >= 16 And n + 59 < db.Length Then
    InitTable()
    history(0) = 0 ' vide la memoire de l'history
    For i As Integer = 0 To 59
 Dim idx As Index = NumToIndex(db(n + i))
 If Not CanPlay(Player) Then Player = NotColor(Player)
 If Playing(idx, Player) = 0 Then Exit For ' fin de la partie
 SaveStep(idx, Player)
 Player = NotColor(Player)
    Next
    'Affiche le message de présentation, avec mention d'abandon si jeu non fini
    ComputNext(DbHeader(nb) & " est chargée.", True)
    Display() ' Affiche le nouveau jeu
End If
End Sub

' Sauvegarde le jeu courant dans un fichier
Sub Write(ByRef FileName As String)
Dim comments As String = InputBox("Voulez-vous ajouter un commentaire" & _
vbCrLf & " dans le fichier ?", "", DbHeader(RecNb.Value))

Try
    FileOpen(2, FileName, OpenMode.Output)
    If comments <> "" Then PrintLine(2, "'" & comments)
    ' Sortie de la liste des cases jouées
    For i As Integer = 0 To 60
        Dim idx As Integer = history(i)
        If idx = 0 Then Exit For ' fin du jeu
 PrintLine(2, IndexStr(idx >> 2))
    Next
Catch
    MsgBox(FileName & vbCrLf & " Erreur d'écriture !")
Finally
    FileClose(2)
End Try
End Sub

Puis ajouter les lignes de code (en rouge) dans les fonctions existantes :


' initialise et démarre le jeu
Sub Initialize()

InitTable()
history(0) = 0 'vide la memoire des coups joués
Messages.Text = "Début du jeu :" & vbCrLf & PromptPlayer(0)
End Sub

' Initialisation de la table du jeu
Sub InitTable()

For i As Index = Index.a1 To Index.h8
table(i) = Piece.Empty
Next
table(Index.d4) = Piece.White
table(Index.d5) = Piece.Black
table(Index.e4) = Piece.Black
table(Index.e5) = Piece.White
table(Index.ovf) = Piece.Border
current = 0 'annule le compte de coups joues, mais pas la memoire history des coups !
Player = Piece.Black ' Noir commence toujours la partie
End Sub

' Affiche le jeu
Sub Display()
Dim noir As Byte = CountPions(Piece.Black)
Dim blanc As Byte = CountPions(Piece.White)

' Affiche l'etat des cases du jeu
For i As Index = Index.a1 To Index.h8
ImageList1.Draw(g, ToPosition(i), table(i))
Next
' Affiche le score actuel du jeu}
If Player <> Piece.Empty OrElse noir = blanc Then 'partie en cours ou match null
ScoreBlack.Text = "Score Noir : " + Str(noir) + " pions"
ScoreWhite.Text = "Score Blanc : " + Str(blanc) + " pions"
ElseIf noir > blanc Then 'partie terminee, Noir gagne
ScoreBlack.Text = "Noir gagne : " + Str(noir) + " pions" + VidesMsg(noir + blanc)
ScoreWhite.Text = "Score Blanc : " + Str(blanc) + " pions"
Else 'partie terminee, Blanc gagne
ScoreBlack.Text = "Score Noir : " + Str(noir) + " pions"
ScoreWhite.Text = "Blanc gagne : " + Str(blanc) + " pions" + VidesMsg(noir + blanc)
End If

' Etat des boutons qui dependent du jeu
BtnBack.Enabled = (current <> 0) 'touche Back
BtnFor.Enabled = (history(current) <> 0) 'touche For
BtnZero.Enabled = (current <> 0) 'touche Mise a zero
BtnMax.Enabled = (history(current) <> 0) 'touche Mise au max
BtnWrite.Enabled = history(0) <> 0 'touche Write
End Sub

Et Enfin compléter les gestions d'événements correspondantes :

'
'Avancer au pas suivant de la partie
Private Sub BtnFor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnFor.Click
  
Restore(current + 1, False)
End Sub

'Reculer d'un pas dans la partie
Private Sub BtnBack_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnBack.Click
  
Restore(current - 1)
End Sub

'Remise de la partie au début
Private Sub BtnZero_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnZero.Click
  
Restore(0, False)
End Sub

'Se place à la fin de la partie telle qu'elle est enregistrée
Private Sub BtnMax_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnMax.Click

Restore(60)
End Sub

'Rejouer une partie sauvegardée dans un fichier
Private Sub BtnRead_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnRead.Click

If OpenFileDialog1.ShowDialog() = DialogResult.OK Then Read(OpenFileDialog1.FileName)
End Sub

'Ecriture dans un fichier de la partie en cours
Private Sub BtnWrite_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnWrite.Click

If SaveFileDialog1.ShowDialog() = DialogResult.OK Then Write(SaveFileDialog1.FileName)
End Sub

'Rejouer la partie désignée de la base de données
Private Sub RecNb_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RecNb.ValueChanged

If RecNb.Created() Then LoadWTB(RecNb.Value)
End Sub

Après toutes ces opérations les différents boutons sont actifs en fonction du contexte du jeu.

Gadgets complémentaires

Le premier permet, lorsqu'un joueur se trompe de case, de lui indiquer les cases possibles à jouer avec le gain en points pour chaque.

Le deuxième constate, après analyse de parties déjà jouées, que si Noir commence toujours, avec le choix entre quatre cases, ce choix n'a aucune importance sur la stratégie du jeu. Ca ne fait qu'orienter le jeu de manière différente. Nous ajoutons donc une fonction capable de changer cette case initiale pour des jeux existants.

Pour le premier gadget la réalisation est assez simple, il s'agit de créer une nouvelle Sub de Help :

'
'====================================================================
' AIDE AU JEU

' Indique les cases à jouer avec le nombre de pions à gagner
Sub Help(ByVal pion As Piece)
Dim drawFormat As New StringFormat

drawFormat.Alignment = StringAlignment.Center
drawFormat.LineAlignment = StringAlignment.Center
For idx As Index = Index.a1 To Index.h8 ' analyse toutes les cases
    If table(idx) = Piece.Empty Then ' La case est vide
        Dim count As Integer = 1 ' Ajoute le pion joué
 For dir As Direction = 0 To Direction.last ' pour les 8 directions
     If Search(idx, dir, pion) Then ' Cette direction est valide
  Dim i As Index = NextPos(idx, dir) ' première case dans la direction
  'le premier est toujours a retourner, puisque la direction est valide
  Do
      count += 1 'compte les pions a gagner
      i = NextPos(i, dir) 'extrait la position suivante
  Loop While table(i) <> pion
     End If
 Next
        If count > 1 Then ' Si un gain, affiche le score de la case
     Dim r As New Rectangle(IndexToPos(idx), ImageList1.ImageSize)
     g.DrawString(count.ToString, MyClass.Font(), Brushes.Blue, r, drawFormat)
     'ces valeurs ne sont pas memorisées, elles disparaissent facilement
 End If
    End If
Next
End Sub

Il suffit d'en faire l'appel dans la branche de traitement des jeux dans une mauvaise case de PlayingMsg.

Pour le deuxième, il faut modifier le contenu de l'history de toute la partie en transcodant les numéros de cases jouées pour faire les rotations demandées.

'
'====================================================================
' ROTATION DU JEU

Sub MakeRotation(ByVal rot As Byte)

Debug.Print("makeRotation" & Str(oldSel) & " new" & Str(rot))
If history(0) = 0 Then 'joue la case comme rien n'a encore été joué
    PlayingMsg(AlphaNumToIndex(ListBox1.Items(rot)))
ElseIf rot <> oldSel Then ' oriente le jeu
    Rotation(oldSel Xor rot)
End If
End Sub

' Modifie l'orientation du jeu
Sub Rotation(ByVal rot As Byte)

' modifie l'history avec la nouvelle orientation
For i As Integer = 0 To 59
    If history(i) = 0 Then Exit For ' fin history
    Dim idx As Index = history(i) >> 2 ' index de la case jouée
    Dim u As Byte = idx \ 8, v As Byte = idx Mod 8, t As Byte
    ' 90 degres, permutation ligne - colonne
    If (rot And 1) = 1 Then t = u : u = v : v = t
    ' 180 degres, complementation lignes et colonnes
    If (rot And 2) = 2 Then u = 7 - u : v = 7 - v
    history(i) = ((v + 8 * u) << 2) Or (history(i) And 3)
Next
Restore(current, False) ' affiche le jeu modifie
End Sub

' Indique le premier trait
Sub SelectFirstLine()
Dim h As Byte = history(0), idx As Index = h >> 2

If h <> 0 Then ' il y a un premier trait de memorise dans l'history
    Dim nb As Integer = ListBox1.FindString(IndexStr(idx))
    ListBox1.SetSelected(nb, True)
    oldSel = nb
Else
    oldSel = 0
    ListBox1.ClearSelected()
End If
End Sub

Cette fonctionnalité nécessite d'implémenter un nouvel objet ListBox par le processus habituel, nous la plaçons dans une zone libre de la forme et nous modifions les propriétés comme suit :

Propriétés Listbox1
CausesValidation False
Items (Collection)
Location 238; 161
Size 20; 56

Et en cliquant sur (collection) on fait apparaître la fenêtre « Editeur de Collections string » dans lequel on place le nom des cases concernées, une par ligne : d3, c4, e6, f5. De plus on crée l'événement MouseClick correspondant à cette listBox.

'
'Changer l'orientation du jeu
Private Sub ListBox1_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBox1.MouseClick

MakeRotation(sender.IndexFromPoint(e.Location))
End Sub

Enfin la variable globale suivante doit être ajoutée :

'
Dim oldSel As Byte = 0 ' sélection du premier trait du jeu

Et ajouter l'appel de « SelectFirstLine() » dans la Sub Display().

Puis pourquoi ne pas faire jouer l'ordinateur

Pour le jeu de l'ordinateur, il a été dit au début du texte que c'est une autre paire de manche pour programmer un partenaire de jeu consistant, capable d'appliquer une stratégie, lui permettant de gagner les parties. Mais il est toujours possible de faire un clin d'oeil, puisque nous avons déjà dans le dernier chapitre réalisé un programme capable de déterminer les coups à jouer, il ne reste que faire un semblant de jeu ordinateur en choisissant au hasard l'un de ces coups. Puisqu'il paraît que le hasard fait bien les choses !

Pour cette opération, il faut ajouter un bouton supplémentaire, un timer et une nouvelle variable globale :

'
Dim computer As Piece = Piece.Empty ' couleur du jeu ordinateur

Et les programmes suivants :

'
'====================================================================
' JEU ORDINATEUR

' Pseudo jeu ordinateur
Function ComputIndex(ByVal pion As Piece)
Dim data(20) As Index, n As Integer = 0

data(0) = Index.ovf
For idx As Index = Index.a1 To Index.h8 ' analyse toutes les cases
    If CaseCheck(idx, pion) Then data(n) = idx : n += 1
Next
ComputIndex = If(n <= 1, data(0), data(Rnd(n)))
End Function

Sub ComputerPlay()

If Player <> Piece.Empty And Player = computer Then Timer1.Start()
End Sub

Les propriétés des deux objets :

Propriétés Button1 Timer1
Name BtnComput
Location 249; 236
Size 69; 22
Text Computer
Interval 1000

Il faut ajouter les événements correspondants :

'
'Jeu ordinateur
Private Sub BtnComput_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnComput.Click

Randomize()
Dim idx As Index = ComputIndex(Player)
If computer = Piece.Empty Then computer = Player
If idx <> Index.ovf Then PlayingMsg(idx)
End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

Timer1.Stop()
Dim idx As Index = ComputIndex(Player)
If idx <> Index.ovf Then PlayingMsg(idx)
End Sub

Il faut insérer l'appel de ComputerPlay dans la Sub PlayingMsg() :

'
' Joue et affiche le jeu et les messages indiquant la suite
Sub PlayingMsg(ByVal idx As Index)
Dim count As Integer = Playing(idx, Player)

If count > 0 Then 'OK c'est bon, on mémorise et affiche le nouveau jeu
    SaveStep(idx, Player)
    Player = NotColor(Player) ' par défaut on change de couleur
    ComputNext(BackMsg(count, False))
    Display()
    ComputerPlay() ' lance le jeu éventuel de l'ordinateur
ElseIf Player <> Piece.Empty Then
    Messages.Text = "Erreur, " & PieceStr(Player) _
    & " doit jouer une case valide !"
    Help(Player)
End If
If Player = Piece.Empty Then ' le jeu est fini
    If MsgBox("Voulez-vous recommencer une autre partie ?", _
    MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
        Initialize()
 Display()
    End If
End If
End Sub

Pouvoir livrer l'application sur un CD

Le système de développement proposé est assez complet puisqu'il permet de réaliser, entres autres, les informations nécessaires pour réaliser un CD ou une clé USB auto extractible permettant de livrer le jeu à d'autres possesseurs d'ordinateurs.

Pour cette opération, initialisez les options suivantes : Menu Projet, Propriétés d'Othello. Dans la nouvelle fenêtre qui s'affiche choisir l'onglet Publier. Valider « L'application est également disponible hors connexion..., puis cliquez sur Options. Dans la nouvelle fenêtre qui s'affiche, cocher l'option :

« Pour les installations depuis un CD-ROM, démarrer automatiquement... »

Vous pouvez définir un nom éditeur, car il installera le programme sous ce nom, par exemple dans notre cas : Jeux

Puis fermer la fenêtre en cliquant sur OK et lancer :

Générer, Générer Othello
Générer, Publier Othello

Puis cliquez sur les Suivants du Wizard, puis sur Terminer, pour qu'au final, une fenêtre vous montre les fichiers à charger sur le fameux CD.

Test du programme et Débogue

Ca peut paraître bien tard dans cet exposé d'aborder seulement maintenant cet aspect, fondamental au gout de certains ! Certaines écoles préconisent le test systématique de chaque programme avec la rédaction de fiches de tests dès la phase de l'analyse. Si ces dispositions pouvaient remplir les pages de manuels qualité, elles étaient souvent très peu suivies en pratique et en contradiction avec l'évolution actuelle des outils de développement, notamment sur le plan intuitif et réactif !

Le principal inconvénient de ces méthodes était de passer du temps à tester des erreurs que l'on n'avait pas commises ! Puisque cela concernait des points auxquels on avait déjà réfléchi. Il est vrai que le seul fait de rédiger la fiche de test permettait de corriger les conséquences de certaines faiblesses de l'analyse initiale. Les bugs le plus insidieux correspondent aux situations aux quelles on n'avait pas pensé et dont on n'avait pas envisagé les conséquences.

De plus, Visual Studio nous offre des moyens interactifs assez fins pour corriger les principales fautes de saisie du programme en signalant au moment de l'écriture si la dernière phrase entrée est compréhensible par la machine. Au moment de l'exécution, il vérifie les principales erreurs aux plus graves conséquences, comme l'indice qui sort des limites d'un tableau avec ses risques d'enfoncement mémoire. Ces erreurs sont pernicieuses car elles échappent à toute logique, l'effet n'a pas de rapport immédiat avec la causes. L'exécution d'un programme modifie des données aux quelles il ne devrait pas avoir accès ou pire encore il modifie des instructions d'un autre programme !

Pour le test et la vérification des programmes nous pouvons définir une stratégie avec différents degrés de « lourdeur » suivant la manière où l'anomalie résiste :

  • Tester indépendamment chacune des fonctions au fur et à mesure de l'écriture. C'est la manière la plus simple et la plus légère, consistant à vérifier que le programme écrit réagit bien comme on peut s'y attendre aux différentes stimulations. C'est pour cela qu'il est intéressant de développer en suivant une certaine progression, brique par brique en s'appuyant sur des éléments déjà testés lors des phases précédentes.
  • Lancer l'exécution en plaçant des points d'arrêt. C'est une méthode plus lourde à réserver aux cas récalcitrants, consistant à placer un point d'arrêt aux points stratégiques de programme pour bien vérifier qu'on y passe et lire la valeur de certaines variables internes. Mais à l'usage, cette méthode est vite fastidieuse lorsque le programme comporte des boucles parcourues de nombreuses fois, ou lorsqu'il s'agit de briques beaucoup sollicitées !
  • Placer des traces dans le programme. Lorsque la méthode du point d'arrêt s'avère inefficace, il reste la solution d'ajouter les lignes de codes supplémentaires affichant des informations de trace et valeur de certaines variables clés :
'
Debug.Print(« text » & Str(x))

Par exemple : où text indique le nom de la fonction, complété de la valeur de la variable x. C'est très pratique dans une architecture événementielle où l'on peut apprécier ainsi l'occurrence et la chronologie des événements. Visual Basic possède une fenêtre spéciale : Fenêtre Exécution qui affiche ces messages. Ces traces peuvent être retirées lorsque les tests sont terminés.

Une autre manière assez astucieuse est d'utiliser l'instruction « Debug.Assert(condition) » qui permet de placer aux endroits stratégiques du programme un test pour vérifier qu'une variable ne sort pas des clous ! C'est particulièrement efficace dans le cas de situations erratiques car cette instruction provoque un break qui permet de tester le contexte au moment de l'erreur.

  • Passer du temps à faire des recherches dans la documentation fournie. Une des causes fréquentes de problèmes est l'incompréhension du fonctionnement de certains objets proposés, les conditions de génération de certains événements ou la validité de certaines informations. Souvent la documentation, quoique perfectible, fournit des informations utiles ! La documentation comporte aussi des exemples qui permettent de mieux comprendre le texte. La difficulté pour le novice est de trouver les mots clés compréhensibles du système permettant une recherche efficace. C'est pour cela qu'il ne faut pas rêver au miracle car pour se familiariser avec cette complexité, il faut y passer tu temps !

Réaliser soi-même les images nécessaires au jeu

Cette opération fait appel à une palette graphique standard de Windows : Paint. Ce programme est accessible dans Démarrer, Tous les programmes, Accessoires, Paint.

Réaliser l'image de l'Othellier

La première opération consiste à réaliser une Bitmap de l'image par la commande : Fichier, Nouveau, puis par la commande : Image, Attributs, qui ouvre la fenêtre Attributs et définir une Largeur et une Hauteur 230 Pixels. Ceci nous produit un carré blanc de 230 pixels de côté. Il faut s'habituer à parler pixel car on devra positionner sur cette image des pions et il est nécessaire d'être précis au pixel près !

Maintenant il faut tracer la grille, pour cette opération, on sélectionne l'outil ligne et la couleur Noir avec l'épaisseur la plus fine (1 pixel). On se positionne en haut du carré blanc à 15,1. Le 15 est obligatoire, mais le 1 est approximatif. La position s'affiche et se vérifie dans la barre de status au bas-droite de la fenêtre. On enfonce le bouton gauche de la souris et on descend au bas de l'image pour faire une ligne bien verticale (elle ne doit pas avoir de cassure). Au bas on lâche le bouton de la souris et on a dessiné ainsi une ligne bien verticale. Si c'est raté, il est possible d'annuler l'opération par la commande Edition, Annuler.

On continue maintenant avec un x = 41, puis 67, 93, 119, 145, 171, 197, 223. On arrive à un résultat qui ressemble à ceci :

On recommence l'opération avec des lignes horizontales, avec cette fois-ci pour des y biens définis :

y = 15, 41, 67, 93, 119, 145, 171, 197, 223.

On démarre sur le bord gauche à environ x = 1 et on fini sur le bord droite, ce qui nous dessine une grille.

Puis maintenant on sélectionne l'outil gomme de taille moyenne et on entreprend d'effacer traits qui dépassent. Pour plus de précision on peut se mettre en loupe par la commande Affichage, Zoom, Grande taille.

La prochaine étape consiste à doubler le cadre autour de la grille en traçant un trait à l'extérieur contre la grille.

Maintenant il faut marquer les cases, pour cette opération il faut augmenter la taille de l'image en hauteur par exemple en programmant la hauteur à 340. Puis dans la zone blanche en bas de l'image il faut rentrer le texte nécessaire sous forme de deux lignes composées de 'a', espace, 'b',... 'h' pour la première et '1', espace, '2' espace,... '8' pour la seconde en choisissant la police « Fixedsys 8 Occidental ». Il reste d'utiliser l'outil sélection rectangle pour transporter chacune de ces indications à la bonne place. C'est plus facile et précis en se plaçant en Zoom ! L'opération terminée, on revient à la taille initiale de l'image.

Pour le fun, il reste à ajouter les petits carrés noirs en bas des cases b2, f2, b6, et f6. Il reste à sauvegarder l'image sous son nom définitif et on peut choisir de réduire la définition de couleur à bitmap 16 couleurs.

Réaliser les images des pions et des cases vides

Cela devient un jeu d'enfant, par rapport à l'image du jeu. Il faut utiliser pour chaque des bitmap de 23 x 23 pixels et dessiner sur chacune comme suit. La couleur rouge indique les zones de transparence :

Version complète du programme

'
'===============================================================
' <auto-generated>
' Ce code a été généré par un outil.
' Version du runtime :2.0.50727.3623
'
' Les modifications apportées à ce fichier peuvent provoquer un comportement incorrect et seront perdues si
' le code est régénéré.
' </auto-generated>
'===============================================================

Option Strict On

Option Explicit On

Imports System
Namespace My.Resources

'Cette classe a été générée automatiquement par la classe StronglyTypedResourceBuilder
'à l'aide d'un outil, tel que ResGen ou Visual Studio.
'Pour ajouter ou supprimer un membre, modifiez votre fichier .ResX, puis réexécutez ResGen
'avec l'option /str ou régénérez votre projet VS.

'''<summary>
''' Une classe de ressource fortement typée destinée, entre autres, à la consultation des chaînes localisées.
'''</summary>

<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "2.0.0.0"), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.Microsoft.VisualBasic.HideModuleNameAttribute()> _
Friend Module Resources
Private resourceMan As Global.System.Resources.ResourceManager
Private resourceCulture As Global.System.Globalization.CultureInfo

'''<summary>
''' Retourne l'instance ResourceManager mise en cache utilisée par cette classe.
'''</summary>

<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
    If Object.ReferenceEquals(resourceMan, Nothing) Then
        Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("Othello.Resources", GetType(Resources).Assembly)
        resourceMan = temp
    End If
    Return resourceMan
End Get
End Property

'''<summary>
''' Remplace la propriété CurrentUICulture du thread actuel pour toutes
''' les recherches de ressources à l'aide de cette classe de ressource fortement typée.
'''</summary>

<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
    Return resourceCulture
End Get

Set
    resourceCulture = value
End Set
End Property

Friend ReadOnly Property BmOthellier() As System.Drawing.Bitmap
Get
    Dim obj As Object = ResourceManager.GetObject("BmOthellier", resourceCulture)
    Return CType(obj,System.Drawing.Bitmap)
End Get
End Property

Friend ReadOnly Property BmOthelloBlack() As System.Drawing.Bitmap
Get
    Dim obj As Object = ResourceManager.GetObject("BmOthelloBlack", resourceCulture)
    Return CType(obj,System.Drawing.Bitmap)
End Get
End Property

Friend ReadOnly Property BmOthelloEmpty() As System.Drawing.Bitmap
Get
    Dim obj As Object = ResourceManager.GetObject("BmOthelloEmpty", resourceCulture)
    Return CType(obj,System.Drawing.Bitmap)
End Get
End Property

Friend ReadOnly Property BmOthelloWhite() As System.Drawing.Bitmap
Get
    Dim obj As Object = ResourceManager.GetObject("BmOthelloWhite", resourceCulture)
    Return CType(obj,System.Drawing.Bitmap)
End Get
End Property

End Module

End Namespace

<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class Form1

Inherits System.Windows.Forms.Form

'Form remplace la méthode Dispose pour nettoyer la liste des composants.
<System.Diagnostics.DebuggerNonUserCode()> _
Protected Overrides Sub Dispose(ByVal disposing As Boolean)

Try
    If disposing AndAlso components IsNot Nothing Then
 components.Dispose()
    End If
Finally
    MyBase.Dispose(disposing)
End Try
End Sub

'Requise par le Concepteur Windows Form
Private components As System.ComponentModel.IContainer
'REMARQUE : la procédure suivante est requise par le Concepteur Windows Form
'Elle peut être modifiée à l'aide du Concepteur Windows Form.
'Ne la modifiez pas à l'aide de l'éditeur de code.

<System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent()

Me.components = New System.ComponentModel.Container
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(Form1))
Me.Messages = New System.Windows.Forms.TextBox
Me.ScoreBlack = New System.Windows.Forms.TextBox
Me.ScoreWhite = New System.Windows.Forms.TextBox
Me.BtnZero = New System.Windows.Forms.Button
Me.BtnFor = New System.Windows.Forms.Button
Me.BtnBack = New System.Windows.Forms.Button
Me.BtnWrite = New System.Windows.Forms.Button
Me.BtnRead = New System.Windows.Forms.Button
Me.ImageList1 = New System.Windows.Forms.ImageList(Me.components)
Me.OpenFileDialog1 = New System.Windows.Forms.OpenFileDialog
Me.SaveFileDialog1 = New System.Windows.Forms.SaveFileDialog
Me.BtnMax = New System.Windows.Forms.Button
Me.RecNb = New System.Windows.Forms.NumericUpDown
Me.Timer1 = New System.Windows.Forms.Timer(Me.components)
Me.BtnComput = New System.Windows.Forms.Button
Me.ListBox1 = New System.Windows.Forms.ListBox
CType(Me.RecNb, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'Messages
'
Me.Messages.Location = New System.Drawing.Point(238, 12)
Me.Messages.Multiline = True
Me.Messages.Name = "Messages"
Me.Messages.ReadOnly = True
Me.Messages.Size = New System.Drawing.Size(156, 84)
Me.Messages.TabIndex = 0
Me.Messages.TabStop = False
'
'ScoreBlack
'
Me.ScoreBlack.Location = New System.Drawing.Point(238, 102)
Me.ScoreBlack.Name = "ScoreBlack"
Me.ScoreBlack.ReadOnly = True
Me.ScoreBlack.Size = New System.Drawing.Size(156, 20)
Me.ScoreBlack.TabIndex = 1
Me.ScoreBlack.TabStop = False
'
'ScoreWhite
'
Me.ScoreWhite.Location = New System.Drawing.Point(238, 128)
Me.ScoreWhite.Name = "ScoreWhite"
Me.ScoreWhite.ReadOnly = True
Me.ScoreWhite.Size = New System.Drawing.Size(156, 20)
Me.ScoreWhite.TabIndex = 2
Me.ScoreWhite.TabStop = False
'
'BtnZero
'
Me.BtnZero.Location = New System.Drawing.Point(29, 236)
Me.BtnZero.Name = "BtnZero"
Me.BtnZero.Size = New System.Drawing.Size(40, 22)
Me.BtnZero.TabIndex = 3
Me.BtnZero.Text = "0 <<"
Me.BtnZero.UseVisualStyleBackColor = True
'
'BtnFor
'
Me.BtnFor.Location = New System.Drawing.Point(75, 236)
Me.BtnFor.Name = "BtnFor"
Me.BtnFor.Size = New System.Drawing.Size(40, 22)
Me.BtnFor.TabIndex = 4
Me.BtnFor.Text = ">>"
Me.BtnFor.UseVisualStyleBackColor = True
'
'BtnBack
'
Me.BtnBack.Location = New System.Drawing.Point(121, 236)
Me.BtnBack.Name = "BtnBack"
Me.BtnBack.Size = New System.Drawing.Size(40, 22)
Me.BtnBack.TabIndex = 5
Me.BtnBack.Text = "<<"
Me.BtnBack.UseVisualStyleBackColor = True
'
'BtnWrite
'
Me.BtnWrite.Location = New System.Drawing.Point(285, 195)
Me.BtnWrite.Name = "BtnWrite"
Me.BtnWrite.Size = New System.Drawing.Size(52, 22)
Me.BtnWrite.TabIndex = 6
Me.BtnWrite.Text = "Write"
Me.BtnWrite.UseVisualStyleBackColor = True
'
'BtnRead
'
Me.BtnRead.Location = New System.Drawing.Point(342, 195)
Me.BtnRead.Name = "BtnRead"
Me.BtnRead.Size = New System.Drawing.Size(52, 22)
Me.BtnRead.TabIndex = 7
Me.BtnRead.Text = "Read"
Me.BtnRead.UseVisualStyleBackColor = True
'
'ImageList1
'
Me.ImageList1.ImageStream = CType(resources.GetObject("ImageList1.ImageStream"), System.Windows.Forms.ImageListStreamer)
Me.ImageList1.TransparentColor = System.Drawing.Color.Red
Me.ImageList1.Images.SetKeyName(0, "BmOthelloEmpty.bmp")
Me.ImageList1.Images.SetKeyName(1, "BmOthelloBlack.bmp")
Me.ImageList1.Images.SetKeyName(2, "BmOthelloWhite.bmp")
'
'OpenFileDialog1
'
Me.OpenFileDialog1.FileName = "Othello.oth"
Me.OpenFileDialog1.Filter = "Othello (*.oth)|*.oth|Base de données (*.wtb)|*.wtb|Texte (*.txt)|*.txt|All (*.*)" & _
"|*.*"
'
'SaveFileDialog1
'
Me.SaveFileDialog1.FileName = "Othello.oth"
Me.SaveFileDialog1.Filter = "Othello (*.oth)|*.oth|Texte (*.txt)|*.txt|All (*.*)|*.*"
'
'BtnMax
'
Me.BtnMax.Location = New System.Drawing.Point(167, 236)
Me.BtnMax.Name = "BtnMax"
Me.BtnMax.Size = New System.Drawing.Size(40, 22)
Me.BtnMax.TabIndex = 8
Me.BtnMax.Text = ">> |"
Me.BtnMax.UseVisualStyleBackColor = True
'
'RecNb
'
Me.RecNb.Enabled = False
Me.RecNb.Location = New System.Drawing.Point(342, 223)
Me.RecNb.Minimum = New Decimal(New Integer() {1, 0, 0, 0})
Me.RecNb.Name = "RecNb"
Me.RecNb.Size = New System.Drawing.Size(52, 20)
Me.RecNb.TabIndex = 11
Me.RecNb.Value = New Decimal(New Integer() {1, 0, 0, 0})
'
'Timer1
'
Me.Timer1.Interval = 1000
'
'BtnComput
'
Me.BtnComput.Location = New System.Drawing.Point(249, 236)
Me.BtnComput.Name = "BtnComput"
Me.BtnComput.Size = New System.Drawing.Size(69, 22)
Me.BtnComput.TabIndex = 12
Me.BtnComput.Text = "Computer"
Me.BtnComput.UseVisualStyleBackColor = True
'
'ListBox1
'
Me.ListBox1.CausesValidation = False
Me.ListBox1.Items.AddRange(New Object() {"d3", "c4", "e6", "f5"})
Me.ListBox1.Location = New System.Drawing.Point(238, 161)
Me.ListBox1.Name = "ListBox1"
Me.ListBox1.Size = New System.Drawing.Size(20, 56)
Me.ListBox1.TabIndex = 15
'
'Form1
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.BackgroundImage = CType(resources.GetObject("$this.BackgroundImage"), System.Drawing.Image)
Me.BackgroundImageLayout = System.Windows.Forms.ImageLayout.None
Me.ClientSize = New System.Drawing.Size(408, 270)
Me.Controls.Add(Me.ListBox1)
Me.Controls.Add(Me.BtnComput)
Me.Controls.Add(Me.RecNb)
Me.Controls.Add(Me.BtnMax)
Me.Controls.Add(Me.BtnRead)
Me.Controls.Add(Me.BtnWrite)
Me.Controls.Add(Me.BtnBack)
Me.Controls.Add(Me.BtnFor)
Me.Controls.Add(Me.BtnZero)
Me.Controls.Add(Me.ScoreWhite)
Me.Controls.Add(Me.ScoreBlack)
Me.Controls.Add(Me.Messages)
Me.Name = "Form1"
Me.Text = "Othello"
CType(Me.RecNb, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
Me.PerformLayout()

End Sub

Friend WithEvents Messages As System.Windows.Forms.TextBox
Friend WithEvents ScoreBlack As System.Windows.Forms.TextBox
Friend WithEvents ScoreWhite As System.Windows.Forms.TextBox
Friend WithEvents BtnZero As System.Windows.Forms.Button
Friend WithEvents BtnFor As System.Windows.Forms.Button
Friend WithEvents BtnBack As System.Windows.Forms.Button
Friend WithEvents BtnWrite As System.Windows.Forms.Button
Friend WithEvents BtnRead As System.Windows.Forms.Button
Friend WithEvents ImageList1 As System.Windows.Forms.ImageList
Friend WithEvents OpenFileDialog1 As System.Windows.Forms.OpenFileDialog
Friend WithEvents SaveFileDialog1 As System.Windows.Forms.SaveFileDialog
Friend WithEvents BtnMax As System.Windows.Forms.Button
Friend WithEvents RecNb As System.Windows.Forms.NumericUpDown
Friend WithEvents Timer1 As System.Windows.Forms.Timer
Friend WithEvents BtnComput As System.Windows.Forms.Button
Friend WithEvents ListBox1 As System.Windows.Forms.ListBox

End Class

Public Class Form1
Dim g As Graphics
' position de l'Othellier dans l'image (et dans Form1)
Const ofsX = 17, OfsY = 17, oWidth = 208, oHeight = 208
'===============================================================
' Etat du jeu

Enum Index As Byte ' positions caracteristiques sur l'Othellier
  a1 = 0 ' premiere case du jeu
  h8 = 63 ' derniere case du jeu
  d4 = 8 * 3 + 3 ' cases centrales de depart
  d5 = 8 * 3 + 4
  e4 = 8 * 4 + 3
  e5 = 8 * 4 + 4
  ovf = 64 'valeur utilisee pour signifier le bord du jeu, hors Othellier
End Enum

Enum Piece As Byte ' differentes valeurs possibles d'une case du jeu
  Empty
  Black
  White
  Border ' valeur de la case Index.ovf
End Enum

' Etat courant du jeu : etat des 64 cases du jeu, plus une, reservee pour signaler
Dim table(Index.ovf) As Piece 'le bord de l'Othellier lors des deplacements
Dim current As Integer 'le numero du coup joue (1, 2,...)
Dim Player As Piece 'la couleur du pion qui doit jouer (Piece.Empty = partie terminee)
Dim history(60) As Byte 'memoire des coups joues, termine par une case a zero

'===============================================================
' Mouvements sur l'Othellier dans les 8 directions
Enum Direction As Byte ' Les 8 directions de mouvements sur l'Othellier (0..7)
  North
  NorthEast
  East
  SouthEast
  South
  SouthWest
  West
  NorthWest
  last = 7
End Enum

'===============================================================

Dim db As Byte() 'Base de donnees de jeu, chargee par ReadWTB()
Dim oldSel As Byte = 0 ' selection du premier trait du jeu
Dim computer As Piece = Piece.Empty ' couleur du jeu ordinateur

'===============================================================

'Tables utilisees pour convertir un index en texte designant la case ("a1".."h8")
Const tchar As String = "abcdefgh"
Const tnum As String = "12345678"

'===============================================================
' SOUS PROGRAMMES ET FONCTIONS

' Conversion d'un index (dans la table de jeu) en position dans l'affichage
Function IndexToPos(ByVal idx As Index) As Point

If idx = Index.ovf Then
    IndexToPos.X = -1 : IndexToPos.Y = -1
Else
    IndexToPos.X = ((idx And 7) * oWidth) \ 8 + ofsX
    IndexToPos.Y = ((idx >> 3) * oHeight) \ 8 + OfsY
End If
End Function

' Conversion d'une position dans l'affichage en index dans la table (de jeu)
Function PosToIndex(ByVal pos As Point) As Index

pos.X -= ofsX : pos.Y -= OfsY
If pos.X >= 0 And pos.X < oWidth And pos.Y >= 0 And pos.Y < oHeight Then
    PosToIndex = ((pos.X * 8) \ oWidth) + 8 * ((pos.Y * 8) \ oHeight)
Else
    PosToIndex = Index.ovf
End If
End Function

' Conversion d'un index (dans la table de jeu) en texte de position alphaNum
Function IndexStr(ByVal idx As Index) As String
'codage : a1=0, h1=7, a2=8, a8=56, h8=63, ...
IndexStr = If(idx >= 0 AndAlso idx < 64, _
tchar.Chars(idx Mod 8) & tnum.Chars(idx \ 8), "??")
End Function

' Conversion d'un texte de position alphaNum en index dans la table de jeu
Function AlphaNumToIndex(ByVal str As String) As Index
'codage : a1=0, h1=7, a2=8, a8=56, h8=63, ...
str = str.Trim(" "",;'").ToLower() + " " 'nettoyage du texte
Dim u As Integer = tchar.IndexOf(str.Chars(0)) 'premier car. (a..h) nom colonnes
Dim v As Integer = tnum.IndexOf(str.Chars(1)) '2eme car (1..8) nom lignes
AlphaNumToIndex = If(u >= 0 And v >= 0, u + 8 * v, Index.ovf)
End Function

' Conversion d'un no de case exprime en decimal (11..88) en Index
Function NumToIndex(ByVal val As Byte) As Index
' codage : 11=a1(0), 18=h1(7), 21=a2(8), 81=a8(56), 88=h8(63), utilise par WTB
Dim u As Integer = val \ 10 - 1 ' dizaines
Dim v As Integer = val Mod 10 - 1 ' unites
NumToIndex = If(u >= 0 And v >= 0 And u < 8 And v < 8, v + 8 * u, Index.ovf)
End Function

' Calcul de la position suivante pour un deplacement sur l'Othellier
Function NextPos(ByVal idx As Index, ByVal dir As Direction) As Index
'suivant la position de depart et la direction, on peut sortir de l'Othellier

Select Case dir
    Case Direction.North
 NextPos = If(idx \ 8 = 0, Index.ovf, idx - 8)

    Case Direction.NorthEast
 NextPos = If(idx Mod 8 = 7 Or idx \ 8 = 0, Index.ovf, idx - 7)

    Case Direction.East
 NextPos = If(idx Mod 8 = 7, Index.ovf, idx + 1)

    Case Direction.SouthEast
 NextPos = If(idx Mod 8 = 7 Or idx \ 8 = 7, Index.ovf, idx + 9)

    Case Direction.South
 NextPos = If(idx \ 8 = 7, Index.ovf, idx + 8)

    Case Direction.SouthWest
 NextPos = If(idx Mod 8 = 0 Or idx \ 8 = 7, Index.ovf, idx + 7)

    Case Direction.West
 NextPos = If(idx Mod 8 = 0, Index.ovf, idx - 1)

    Case Direction.NorthWest
 NextPos = If(idx Mod 8 = 0 Or idx \ 8 = 0, Index.ovf, idx - 9)

End Select
End Function

' Retournement d'un pion
Function NotColor(ByVal pion As Piece) As Piece

Select Case pion
    Case Piece.Black
 NotColor = Piece.White

    Case Piece.White
 NotColor = Piece.Black

    Case Else ' pour les autres etats pas de changement
 NotColor = pion

End Select
End Function

' Conversion en text du nom du pion joueur
Function PieceStr(ByVal pion As Piece) As String

If pion = Piece.Black Then Return "Noir"
If pion = Piece.White Then Return "Blanc" Else Return ""
End Function

' Affichage de l'entete de la base de donnees (si elle est chargee)
Function DbHeader(ByVal nb As Integer) As String

DbHeader = ""
Try
    Dim year As Integer = db(10) + db(11) * 256
    Dim nbMax As Integer = (db.Length - 16) \ 68
    DbHeader = "Année" & Str(year)
    DbHeader &= If(nb > 0, ", partie" & Str(nb) & " /" & Str(nbMax), _
    ", comportant" & Str(nbMax) & " parties")
Catch
End Try
End Function

' Invite une couleur a jouer
Function PromptPlayer(ByVal m As Byte) As String

If m = 0 Then
    PromptPlayer = "C'est maintenant à " & PieceStr(Player) & " de jouer."
ElseIf m = 1 Then
    PromptPlayer = "Et " & PieceStr(Player) & " continue de jouer."
Else
    PromptPlayer = "Et " & PieceStr(Player) & " abandonne !"
End If
End Function

' Change la couleur du joueur si c'est necessaire et sortie du message d'invite a jouer ou de fin
Sub ComputNext(ByVal text As String, Optional ByVal db As Boolean = False)
Dim flg As Byte = If(db, 2, 0)

Messages.Text = text & vbCrLf
If CanPlay(Player) Then
    Messages.Text &= PromptPlayer(flg)
ElseIf CanPlay(NotColor(Player)) Then 'la couleur adverse ne peut jouer, continue la meme couleur
    Player = NotColor(Player)
    Messages.Text &= PromptPlayer(flg + 1)
Else 'fin du jeu, aucun des pions ne pouvant jouer
    Player = Piece.Empty ' indique la fin de la partie
    Messages.Text &= ScoreEndOfPlay()
End If
End Sub

' Edite le score de fin de jeu
Function ScoreEndOfPlay() As String
Dim noir As Byte = CountPions(Piece.Black)
Dim blanc As Byte = CountPions(Piece.White)

If noir > blanc Then Return " Et Noir gagne " & Str(64 - blanc) & " à " & Str(blanc) & "."
If blanc > noir Then Return " Et Blanc gagne " & Str(64 - noir) & " à " & Str(noir) & "."
Return " Et le jeu se termine match null " & Str(noir) & " à " & Str(blanc) & "."
End Function

' Sortie du message de fin d'un coup
Function BackMsg(ByVal count As Integer, ByVal back As Boolean) As String
Dim h As Byte = history(current - 1), idx As Index = h >> 2, pion As Piece = h And 3

If back Then BackMsg = " Au coup précédent, " Else BackMsg = ""
BackMsg &= PieceStr(pion) & " a joué " & IndexStr(idx) _
& " et gagne " & count.ToString & " points."
End Function

' Sorie du message de coup supprime
Function SuppressMsg(ByVal en As Boolean) As String
Dim h As Byte = history(current), idx As Index = h >> 2, pion As Piece = h And 3

SuppressMsg = If(en And pion <> Piece.Empty, "Le jeu " & PieceStr(pion) _
& " en " & IndexStr(idx) & " est annulé.", "")
End Function

' Message ajoutant le compte des cases vides
Function VidesMsg(ByVal total As Byte) As String

VidesMsg = If(total = 64, "", " + " + Str(64 - total))
End Function

' Compte les points d'une couleur donnee
Function CountPions(ByVal pion As Piece) As Byte

CountPions = 0
For i As Index = Index.a1 To Index.h8
    If table(i) = pion Then CountPions += 1
Next
End Function

'===============================================================
' JEU

' initialise et demarre le jeu
Sub Initialize()

InitTable()
computer = Piece.Empty 'Ordinateur ne joue pas
history(0) = 0 'vide la memoire des coups joues
Messages.Text = "Début du jeu :" & vbCrLf & PromptPlayer(0)
End Sub

' Initialisation de la table du jeu
Sub InitTable()

For i As Index = Index.a1 To Index.h8
    table(i) = Piece.Empty
Next
table(Index.d4) = Piece.White
table(Index.d5) = Piece.Black
table(Index.e4) = Piece.Black
table(Index.e5) = Piece.White
table(Index.ovf) = Piece.Border
current = 0 'annule le compte de coups joues, mais pas la memoire history des coups !
Player = Piece.Black ' Noir commence toujours la partie
End Sub

' Recherche si, dans une direction donnee, le retournement de pions adverses est possible
Function Search(ByVal idx As Index, ByVal dir As Direction, ByVal pion As Piece) As Boolean
Dim notPion As Piece = NotColor(pion) ' couleur pion adverse

'il faut, au moins, qu'a la premiere case parcourue, le pion rencontre soit adverse
idx = NextPos(idx, dir)
If table(idx) <> notPion Then Return False
Do 'cherche la fin des pions adverses dans la direction
    idx = NextPos(idx, dir)
Loop While table(idx) = notPion
'la case suivante, dans la direction, doit etre occupee par un pion de la couleur
Return CBool(table(idx) = pion)
End Function

' Teste si le jeu de cette case avec cette couleur de pion est possible
Function CaseCheck(ByVal idx As Index, ByVal pion As Piece) As Boolean

If table(idx) <> Piece.Empty Then Return False 'la case n'est pas vide
For dir As Direction = 0 To Direction.last 'dans les 8 directions
    If Search(idx, dir, pion) Then Return True 'cherche une ou le jeu est possible
Next
Return False
End Function

' Teste si le jeux est possible pour cette couleur de pion
Function CanPlay(ByVal pion As Piece) As Boolean

For idx As Index = Index.a1 To Index.h8 'teste toutes les cases
    If CaseCheck(idx, pion) Then Return True
Next
CanPlay = False
End Function

' Place un nouveau pion dans le jeu (si possible), indique le nombre de pions gagnes
Function Playing(ByVal idx As Index, ByVal pion As Piece) As Integer

Playing = 1 ' on compte le pion joue
If table(idx) = Piece.Empty Then ' La case est vide
    For dir As Direction = 0 To Direction.last ' pour les 8 directions
 If Search(idx, dir, pion) Then ' Cette direction est valide
     Dim i As Index = NextPos(idx, dir) ' premiere case dans la direction
     'le premier est toujours a retourner, puisque la direction est valide
     Do
         table(i) = pion 'retourne les pions dans cette direction
         Playing += 1 'compte les pions retournes
  i = NextPos(i, dir) 'extrait la position suivante
     Loop While table(i) <> pion 'termine sur un pion de sa couleur
 End If
    Next
End If
'Si la case de depart (idx) est mal choisie, aucun pion n'est retourne
If Playing > 1 Then table(idx) = pion Else Playing = 0
End Function

' Affiche le jeu
Sub Display()
Dim noir As Byte = CountPions(Piece.Black)
Dim blanc As Byte = CountPions(Piece.White)

' Affiche l'etat des cases du jeu
For i As Index = Index.a1 To Index.h8
    ImageList1.Draw(g, IndexToPos(i), table(i))
Next
' Affiche le score actuel du jeu
If Player <> Piece.Empty OrElse noir = blanc Then 'partie en cours ou match null
    ScoreBlack.Text = "Score Noir : " + Str(noir) + " pions"
    ScoreWhite.Text = "Score Blanc : " + Str(blanc) + " pions"
ElseIf noir > blanc Then 'partie terminee, Noir gagne
    ScoreBlack.Text = "Noir gagne : " + Str(noir) + " pions" + VidesMsg(noir + blanc)
    ScoreWhite.Text = "Score Blanc : " + Str(blanc) + " pions"
Else 'partie terminee, Blanc gagne
    ScoreBlack.Text = "Score Noir : " + Str(noir) + " pions"
    ScoreWhite.Text = "Blanc gagne : " + Str(blanc) + " pions" + VidesMsg(noir + blanc)
End If

' Etat des boutons qui dependent du jeu
BtnBack.Enabled = (current <> 0) 'touche Back
BtnFor.Enabled = (history(current) <> 0) 'touche For
BtnZero.Enabled = (current <> 0) 'touche Mise a zero
BtnMax.Enabled = (history(current) <> 0) 'touche Mise au max
BtnWrite.Enabled = history(0) <> 0 'touche Write
SelectFirstLine() ' affiche le premier trait
End Sub

' Joue et affiche le jeu et les messages indiquant la suite
Sub PlayingMsg(ByVal idx As Index)
Dim count As Integer = Playing(idx, Player)

If count > 0 Then 'OK c'est bon, on memorise et affiche le nouveau jeu
    SaveStep(idx, Player)
    Player = NotColor(Player) ' par defaut on change de couleur
    ComputNext(BackMsg(count, False))
    Display()
    ComputerPlay() ' lance le jeu eventuel de l'ordinateur
ElseIf Player <> Piece.Empty Then
    Messages.Text = "Erreur, " & PieceStr(Player) _
    & " doit jouer une case valide !"
    Help(Player)
End If
If Player = Piece.Empty Then ' le jeu est fini
    If MsgBox("Voulez-vous recommencer une autre partie ?", _
    MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
        Initialize()
 Display()
    End If
End If
End Sub

'===============================================================
' HISTORY

' Sauvegarde du coup dans l'history
Sub SaveStep(ByVal idx As Index, ByVal pion As Piece)

history(current) = (idx << 2) Or (pion And 3)
current += 1
history(current) = 0 ' indicateur de fin de l'history
End Sub

' Lecture de l'etat du jeu, a un pas quelconque, a partir de l'history
Sub Restore(ByVal curStep As Integer, Optional ByVal back As Boolean = True)
Dim idx, count As Byte

InitTable()
Do While current < curStep AndAlso history(current) <> 0
    idx = history(current) : Player = idx And 3 : idx >>= 2
    count = Playing(idx, Player) ' replace les pions comme ils ont deja ete joues
    current += 1
Loop
If current = 0 Then
    Messages.Text = "Retour au début du jeu :" & vbCrLf & PromptPlayer(0)
Else
    Dim msg As String = SuppressMsg(back) & BackMsg(count, back)
    Player = NotColor(Player) ' Normalement on change de couleur a chaque coup
    ComputNext(msg)
End If
Display() 'Affiche le jeu
End Sub

'===============================================================
' LECTURE / ECRITURE FICHIER

Sub Read(ByRef filename As String)

If Strings.Right(filename, 4).ToLower() = ".wtb" Then ReadWTB(filename) Else ReadAscii(filename)
End Sub

' Lecture d'une partie a partir d'un fichier ascii
Sub ReadAscii(ByRef fileName As String)
Dim comments As String = "", line As String = "", nb As Integer = 0

InitTable()
history(0) = 0 ' vide la memoire de l'history
Try
    FileOpen(1, fileName, OpenMode.Input)
    While Not EOF(1)
 line = LineInput(1) : nb += 1
 Dim idx As Index = AlphaNumToIndex(line)
 If idx <> Index.ovf Then 'Le numero de la case est valide, determine la couleur
     If Not CaseCheck(idx, Player) Then Player = NotColor(Player)
     If Playing(idx, Player) = 0 Then Err.Raise(6) 'le coup est illegal !
     SaveStep(idx, Player)
     Player = NotColor(Player)
 ElseIf line.Length() > 1 And line(0) = "'" Then
     comments = line.Substring(1) & " : "
 End If
    End While
    ComputNext(comments) 'Affiche le message de presentation de la partie
Catch
    Messages.Text = If(current > 0, Str(current) & " coups lus", "")
    InitTable()
    MsgBox(fileName & vbCrLf & If(nb > 0, comments & vbCrLf & line & _
    " >> Erreur à la ligne" & Str(nb), "Erreur de lecture !"))
Finally
    FileClose(1)
End Try
Display() 'Affiche le nouveau jeu
End Sub

'Chargement de la base de donnees
Sub ReadWTB(ByRef fileName As String)
Dim nb As Integer = 0

Try
    db = My.Computer.FileSystem.ReadAllBytes(fileName)
    If db.Length > 16 Then nb = (db.Length - 16) \ 68
Catch
    MsgBox(fileName & vbCrLf & "Erreur de lecture !")
    db = Nothing
End Try
If nb > 0 Then
    Dim year As Integer = db(10) + db(11) * 256
    RecNb.Maximum = nb
    RecNb.Value = 1 : LoadWTB(1) ' par defaut on charge le no 1
    Messages.Text = "Le fichier " & fileName & vbCrLf & DbHeader(0) & " est chargé."
    RecNb.Enabled = True
Else
    RecNb.Enabled = False
End If
End Sub

'Chargement du record nb a partir de la base de donnees
Sub LoadWTB(ByVal nb As Integer)
Dim n As Integer = nb * 68 + 16 - 60 ' position indice dans la base de donnees

If n >= 16 And n + 59 < db.Length Then
    InitTable()
    history(0) = 0 ' vide la memoire de l'history
    For i As Integer = 0 To 59
 Dim idx As Index = NumToIndex(db(n + i))
 If Not CanPlay(Player) Then Player = NotColor(Player)
 If Playing(idx, Player) = 0 Then Exit For ' fin de la partie
 SaveStep(idx, Player)
 Player = NotColor(Player)
    Next
    'Affiche le message de presentation, avec mention d'abandon si jeu non fini
    ComputNext(DbHeader(nb) & " est chargée.", True)
    Display() ' Affiche le nouveau jeu
End If
End Sub

' Sauvegarde le jeu courant dans un fichier
Sub Write(ByRef FileName As String)
Dim comments As String = InputBox("Voullez-vous ajouter un commentaire" & _
vbCrLf & " dans le fichier ?", "", DbHeader(RecNb.Value))

Try
    FileOpen(2, FileName, OpenMode.Output)
    If comments <> "" Then PrintLine(2, "'" & comments)
    ' Sortie de la liste des cases jouees
    For i As Integer = 0 To 60
 Dim idx As Index = history(i)
 If idx = 0 Then Exit For ' fin du jeu
 PrintLine(2, IndexStr(idx >> 2))
    Next
Catch
    MsgBox(FileName & vbCrLf & " Erreur d'écriture !")
Finally
    FileClose(2)
End Try
End Sub

'===============================================================
' AIDE AU JEU

' Indique les cases a jouer avec le nombre de pions a gagner
Sub Help(ByVal pion As Piece)
Dim drawFormat As New StringFormat

drawFormat.Alignment = StringAlignment.Center
drawFormat.LineAlignment = StringAlignment.Center
For idx As Index = Index.a1 To Index.h8 ' analyse toutes les cases
    If table(idx) = Piece.Empty Then ' La case est vide
 Dim count As Integer = 1 ' Ajoute le pion joue
 For dir As Direction = 0 To Direction.last ' pour les 8 directions
     If Search(idx, dir, pion) Then ' Cette direction est valide
  Dim i As Index = NextPos(idx, dir) ' premiere case dans la direction
  'le premier est toujours a retourner, puisque la direction est valide
  Do
      count += 1 'compte les pions a gagner
      i = NextPos(i, dir) 'extrait la position suivante
  Loop While table(i) <> pion
     End If
 Next
 If count > 1 Then ' Si un gain, affiche le score de la case
     Dim r As New Rectangle(IndexToPos(idx), ImageList1.ImageSize)
     g.DrawString(count.ToString, MyClass.Font(), Brushes.Blue, r, drawFormat)
     'ces valeurs ne sont pas memorisees elles disparaissent facilement
 End If
    End If
Next
End Sub

'===============================================================
' ROTATION DU JEU

Sub MakeRotation(ByVal rot As Byte)

If history(0) = 0 Then 'joue la case comme rien n'a encore ete joue
    PlayingMsg(AlphaNumToIndex(ListBox1.Items(rot)))
ElseIf rot <> oldSel Then ' oriente le jeu
    Rotation(oldSel Xor rot)
End If
End Sub

' Modifie l'orientation du jeu
Sub Rotation(ByVal rot As Byte)
' modifie l'history avec la nouvelle orientation
For i As Integer = 0 To 59
    If history(i) = 0 Then Exit For ' fin history
    Dim idx As Index = history(i) >> 2 ' index de la case jouee
    Dim u As Byte = idx \ 8, v As Byte = idx Mod 8, t As Byte
    ' 90 degres, permutation ligne - colonne
    If (rot And 1) = 1 Then t = u : u = v : v = t
    ' 180 degres, complementation lignes et colonnes
    If (rot And 2) = 2 Then u = 7 - u : v = 7 - v
    history(i) = ((v + 8 * u) << 2) Or (history(i) And 3)
Next
Restore(current, False) ' affiche le jeu modifie
End Sub

' Indique le premier trait
Sub SelectFirstLine()
Dim h As Byte = history(0), idx As Index = h >> 2

If h <> 0 Then ' il y a un premier trait de memorise dans l'history
    Dim nb As Integer = ListBox1.FindString(IndexStr(idx))
    ListBox1.SetSelected(nb, True)
    oldSel = nb
Else
    oldSel = 0
    ListBox1.ClearSelected()
End If
End Sub

'===============================================================
' JEU ORDINATEUR

' Pseudo jeu ordinateur
Function ComputIndex(ByVal pion As Piece)
Dim data(20) As Index, n As Integer = 0

data(0) = Index.ovf
For idx As Index = Index.a1 To Index.h8 ' analyse toutes les cases
    If CaseCheck(idx, pion) Then data(n) = idx : n += 1
Next
ComputIndex = If(n <= 1, data(0), data(Rnd(n)))
End Function

Sub ComputerPlay()

If Player <> Piece.Empty And Player = computer Then Timer1.Start()
End Sub

'===============================================================
' EVENEMENTS...

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Initialize()
End Sub

Private Sub Form1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint

g = Me.CreateGraphics()
Display()
End Sub

' Place le pion sur l'Othellier a la suite d'un clic souris
Private Sub Form1_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseClick
Dim idx As Index = PosToIndex(e.Location)

Timer1.Stop()
If idx <> Index.ovf Then PlayingMsg(idx)
End Sub

'Avancer au pas suivant de la partie
Private Sub BtnFor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnFor.Click

Restore(current + 1, False)
End Sub

'Reculer d'un pas dans la partie
Private Sub BtnBack_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnBack.Click

Restore(current - 1)
End Sub

'Remise de la partie au début
Private Sub BtnZero_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnZero.Click

Restore(0, False)
End Sub

'Se place a la fin de la partie telle qu'elle est enregistree
Private Sub BtnMax_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnMax.Click

Restore(60)
End Sub

'Rejouer une partie sauvegardée dans un fichier
Private Sub BtnRead_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnRead.Click

If OpenFileDialog1.ShowDialog() = DialogResult.OK Then Read(OpenFileDialog1.FileName)
End Sub

'Sauvegarde dans un fichier de la partie en cours
Private Sub BtnWrite_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnWrite.Click

If SaveFileDialog1.ShowDialog() = DialogResult.OK Then Write(SaveFileDialog1.FileName)
End Sub

'Rejouer la partie designee de la base de donnees
Private Sub RecNb_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RecNb.ValueChanged, RecNb.Click

If RecNb.Created() Then LoadWTB(RecNb.Value)
End Sub

'Changer l'orientation du jeu
Private Sub ListBox1_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBox1.MouseClick

MakeRotation(sender.IndexFromPoint(e.Location))
End Sub

'Jeu ordinateur
Private Sub BtnComput_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnComput.Click

Randomize()
Dim idx As Index = ComputIndex(Player)
If computer = Piece.Empty Then computer = Player
If idx <> Index.ovf Then PlayingMsg(idx)
End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

Timer1.Stop()
Dim idx As Index = ComputIndex(Player)
If idx <> Index.ovf Then PlayingMsg(idx)
End Sub

End Class

Ce document intitulé « Le jeu Othello : seconde partie » issu de CodeS SourceS (codes-sources.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.
Comment utiliser 1 bouton pour 2 utilité différente
Comm WinSock VB6 <-> VB.Net (Encoding, UTF-8, Unicode)
Rejoignez-nous