Morpion vocal

Soyez le premier à donner votre avis sur cette source.

Vue 5 176 fois - Téléchargée 517 fois

Description

Jeux de morpion 100% au micro.

Inspiré de la source "http://www.vbfrance.com/codes/RECONNAISSANCE-VOCALE-SIMPLIFIEE-AVEC-MICROSOFT-SPEECH_16631.aspx"
les sources trouvées sur VBfrance montrent des exemples de reconnaissance vocale mais je n'en ai pas encore vu qui implémentent un éxemple concret.
Ce jeu, vieux comme le monde, démontre le pouvoir de Speech SDK 5.1

pour utiliser cette source, il faut installer le SDK (microsoft)
http://www.microsoft.com/downloads/details.aspx?FamilyID=5e86ec97-40a7-453f-b0ee-6583171b4530&displaylang=en

Lancez le programme et après il ne vous reste plus qu'a parler (en anglais je suis désolé)

Les commandes vocales :
pour la fenetre :
"hide application" --> minimizer la fenetre
"show application" --> remontrer la fenetre
"quit application" ou "quit game" --> quitter le programme

pour le jeu :
"start new game" --> démarer une nouvelle partie
"select case colone ligne" --> sélectionner une case (colonne et ligne sont des nombres de 1 à 3)
"validate" jouer dans la case sélectionnée
"is case colonne ligne free" --> savoir si la case est libre et si oui la selectionner
"so play on it" --> valider la case selectionnée
"whose turn it is" --> à quel joueur est-ce de jouer

il en reste d'autres, pour les connaitre, il suffit de regarder le code source.

je n'ai pas commenté, ca ne me semblait pas utile dans la mesure ou tous les noms sont explicits et que il ne faut pas l'oublier c'est un jeux de morpions ^_^

Source / Exemple :


Option Explicit

Private selected_case As Integer
Private current_player As Integer
Private current_turn As Integer

 'Constante de la grammaire
Const m_GrammarId = 14
 'Variables de la reconnaisance
 Dim WithEvents RecoContext As SpSharedRecoContext
 Dim Grammar As ISpeechRecoGrammar ' La grammaire est
 'une banque de mots. Le SDK chosira toujours un mot
 'faisant partit de la grammaire
 Dim TopRule As ISpeechGrammarRule
 Dim ListItemsRule As ISpeechGrammarRule
 'Constante du mot a dire avant la commande vocale
Const m_def_PreCommandString = ""   '"say"
 Dim m_PreCommandString As String
 'Collection source de la grammaire
 Public GrammarSource As Collection

 Sub InitReco()

 'Initie les variables
 Dim AfterCmdState As ISpeechGrammarRuleState
 Set RecoContext = New SpSharedRecoContext
 Set Grammar = RecoContext.CreateGrammar(m_GrammarId)

 'TopRule=Le mot avant
 'ListItemsRule=La règle qui détermine le 2e mot
 Set TopRule = Grammar.Rules.Add("TopLevelRule", SRATopLevel Or SRADynamic, 1)
 Set ListItemsRule = Grammar.Rules.Add("ListItemsRule", SRADynamic, 2)
 Set AfterCmdState = TopRule.AddState

 m_PreCommandString = m_def_PreCommandString
 TopRule.InitialState.AddWordTransition AfterCmdState, _
 m_PreCommandString, " ", , "", 0, 0
 AfterCmdState.AddRuleTransition Nothing, ListItemsRule, "", 1, 1
 RebuildGrammar GrammarSource
 Grammar.CmdSetRuleState "TopLevelRule", SGDSActive
 End Sub

 Sub RebuildGrammar(Source As Collection)

 Dim i As Integer
 For i = 1 To Source.Count
 Dim text As String
 text = Source(i)
 'Ajoute tous les mots dans la grammaire
 ListItemsRule.InitialState.AddWordTransition Nothing, text, " ", , text, i, i
 Next
 'Recompile la grammaire
 Grammar.Rules.Commit
 'Avant de recompiler la prochaine fois, il faudra
 'réajouter tous les mots, alors chaque fois que l'on
 'veut modifier la grammaire, il faut réappeler
 'RebuildGrammar

 End Sub

Private Sub Form_Load()
 'La source de la gramaire
 Set GrammarSource = New Collection
'    GrammarSource.Add "yes"
'    GrammarSource.Add "no"
 
    GrammarSource.Add "exit application"
    GrammarSource.Add "close application"
    GrammarSource.Add "quit application"
    GrammarSource.Add "exit game"
    GrammarSource.Add "close game"
    GrammarSource.Add "quit game"
    
    GrammarSource.Add "minimize application"
    GrammarSource.Add "maximize application"
    GrammarSource.Add "show application"
    GrammarSource.Add "hide application"
 
 
    GrammarSource.Add "start new game"
    GrammarSource.Add "validate"
    GrammarSource.Add "so play in it"
    GrammarSource.Add "deselect case"
    
    'la colone en premier, la ligne en second
    GrammarSource.Add "select case one one"
    GrammarSource.Add "select case one twoo"
    GrammarSource.Add "select case one three"
    GrammarSource.Add "select case twoo one"
    GrammarSource.Add "select case twoo twoo"
    GrammarSource.Add "select case twoo three"
    GrammarSource.Add "select case three one"
    GrammarSource.Add "select case three twoo"
    GrammarSource.Add "select case three three"
    
    GrammarSource.Add "play case one one"
    GrammarSource.Add "play case one twoo"
    GrammarSource.Add "play case one three"
    GrammarSource.Add "play case twoo one"
    GrammarSource.Add "play case twoo twoo"
    GrammarSource.Add "play case twoo three"
    GrammarSource.Add "play case three one"
    GrammarSource.Add "play case three twoo"
    GrammarSource.Add "play case three three"
    
    GrammarSource.Add "Is case one one free"
    GrammarSource.Add "Is case one twoo free"
    GrammarSource.Add "Is case one three free"
    GrammarSource.Add "Is case twoo one free"
    GrammarSource.Add "Is case twoo twoo free"
    GrammarSource.Add "Is case twoo three free"
    GrammarSource.Add "Is case three one free"
    GrammarSource.Add "Is case three twoo free"
    GrammarSource.Add "Is case three three free"

    GrammarSource.Add "Say me whoose turn it is"
'    GrammarSource.Add "move left"
'    GrammarSource.Add "move right"
'    GrammarSource.Add "move top"
'    GrammarSource.Add "move bottom"
    
 'Après avoir changer la source n'oublier jamais d'appeler
 'RebuildGrammar (GrammarSource) pour mettre la grammaire a
 'jour. Ici ce n'est pas nécessaire puisque InitReco
 'appelle RebuildGrammar

 'Assurez-vous de ne jamais avoir de double dans la grammaire
 'sinon il y aura des erreurs
 InitReco
 
    Say "Hello on that : speacking : tictactoe game."
 End Sub

 Private Sub RecoContext_Recognition(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal RecognitionType As SpeechLib.SpeechRecognitionType, ByVal Result As SpeechLib.ISpeechRecoResult)

    Select Case Result.PhraseInfo.GetText
        Case Is = "exit application", "exit game", _
                    "close application", "close game", _
                    "quit application", "quit game"
            Say "Goodby !"
            Unload Me
                
        Case Is = "minimize application", "hide application"
            Me.WindowState = vbMinimized
            Say "TicTacToe is now hided."
            
        Case Is = "maximize application", "show application"
            Me.WindowState = vbNormal
            Say "TicTacToe is now showed."
        
        Case Is = "start new game"
            Call New_Game
            
        Case Is = "deselect case"
            Call deselect_case
        
        Case Is = "select case one one":            select_case 1, 1
        Case Is = "select case one twoo":           select_case 1, 2
        Case Is = "select case one three":          select_case 1, 3
        Case Is = "select case twoo one":           select_case 2, 1
        Case Is = "select case twoo twoo":          select_case 2, 2
        Case Is = "select case twoo three":         select_case 2, 3
        Case Is = "select case three one":          select_case 3, 1
        Case Is = "select case three twoo":         select_case 3, 2
        Case Is = "select case three three":        select_case 3, 3

        Case Is = "play case one one":            select_case 1, 1: If (selected_case <> 0) Then validate
        Case Is = "play case one twoo":           select_case 1, 2: If (selected_case <> 0) Then validate
        Case Is = "play case one three":          select_case 1, 3: If (selected_case <> 0) Then validate
        Case Is = "play case twoo one":           select_case 2, 1: If (selected_case <> 0) Then validate
        Case Is = "play case twoo twoo":          select_case 2, 2: If (selected_case <> 0) Then validate
        Case Is = "play case twoo three":         select_case 2, 3: If (selected_case <> 0) Then validate
        Case Is = "play case three one":          select_case 3, 1: If (selected_case <> 0) Then validate
        Case Is = "play case three twoo":         select_case 3, 2: If (selected_case <> 0) Then validate
        Case Is = "play case three three":        select_case 3, 3: If (selected_case <> 0) Then validate

        Case Is = "Is case one one free":         Case_free 1, 1
        Case Is = "Is case one twoo free":         Case_free 1, 2
        Case Is = "Is case one three free":         Case_free 1, 3
        Case Is = "Is case twoo one free":         Case_free 2, 1
        Case Is = "Is case twoo twoo free":         Case_free 2, 2
        Case Is = "Is case twoo three free":         Case_free 2, 3
        Case Is = "Is case three one free":         Case_free 3, 1
        Case Is = "Is case three twoo free":         Case_free 3, 2
        Case Is = "Is case three three free":         Case_free 3, 3
        
        Case Is = "Say me whoose turn it is"
            If (current_player = 0) Then
                Say "There is no game started, yet."
            Else
                Say "It is the turn of player : " & current_player
            End If
            
        Case Is = "validate":           Call validate
        Case Is = "so play in it":      Call validate

'''        Case Is = "move right"
'''        Case Is = "move left"
'''        Case Is = "move top"
'''        Case Is = "move bottom"
        
        Case Else
            Debug.Print Result.PhraseInfo.GetText
    End Select
 End Sub

Private Sub Case_free(c As Integer, l As Integer)
    If (current_player = 0) Then
        Say "You must start a new game."
        Exit Sub
    End If
    If (fond(10 * l + c).FillColor = vbRed) Or (fond(10 * l + c).FillColor = vbGreen) Then
        Say "No the case is not free."
    Else
        Say "Yes the case is free."
        select_case c, l
    End If
End Sub

Private Sub New_Game()
    current_player = 1
    current_turn = 1
    Me.Caption = "player " & current_player & " turn"
    Say "Let's Go !!!"
    selected_case = 0
    
    Dim c As Integer, l As Integer
    For c = 1 To 3
        For l = 1 To 3
            fond(10 * l + c).FillColor = vbWhite
        Next l
    Next c
End Sub

Private Sub deselect_case()
    If (selected_case = 0) Then Exit Sub
    fond(selected_case).FillColor = vbWhite
    selected_case = 0
End Sub
Private Sub select_case(c As Integer, l As Integer)
    If (current_player = 0) Then
        Say "You must start a new game."
        Exit Sub
    End If
    If (fond(10 * l + c).FillColor = vbRed) Or (fond(10 * l + c).FillColor = vbGreen) Then
        Say "This case is already occupied"
        selected_case = 0
        Exit Sub
    End If
    
    deselect_case
    selected_case = 10 * l + c
    fond(selected_case).FillColor = vbYellow
End Sub

Private Sub validate()
    If (selected_case = 0) Then
        Say "You must select a case."
        Exit Sub
    End If
    
    If (current_player = 1) Then
        fond(selected_case).FillColor = vbGreen
    Else
        fond(selected_case).FillColor = vbRed
    End If
    
    DoEvents
    If IsWinner Then
        Me.Caption = "Player :" & current_player & " winn the game !"
        Say "Player " & current_player & " winn the game !"
        current_player = 0
    Else
        If (current_turn = 9) Then
            current_player = 0
            Say "There is no winner."
        Else
            current_turn = current_turn + 1
            current_player = 3 - current_player
            Me.Caption = "player " & current_player & " turn"
            Say "player " & current_player
            selected_case = 0
        End If
    End If
End Sub

Private Sub Say(text As String)
    DoEvents
    RecoContext.State = SRCS_Disabled
    Dim V As New SpVoice
        Set V.Voice = V.GetVoices("name=Microsoft Mary").Item(0)
        
        V.AllowAudioOutputFormatChangesOnNextSet = False
        V.AudioOutputStream.Format.Type = SAFT48kHz16BitStereo
        Set V.AudioOutputStream = V.AudioOutputStream
        
        V.Volume = 100
        V.Rate = 0
        Call V.Speak(text)
    Set V = Nothing
    RecoContext.State = SRCS_Enabled
End Sub

Private Function IsWinner() As Boolean
    Dim c As Integer, l As Integer
    Dim ok As Boolean
    IsWinner = True
    
    Dim player_color As ColorConstants
    If (current_player = 1) Then
        player_color = vbGreen
    Else
        player_color = vbRed
    End If
        
    'vérification des colonnes
    For c = 1 To 3
        ok = True
        For l = 1 To 3
            ok = ok And CBool(fond(10 * l + c).FillColor = player_color)
        Next l
        
        If ok Then Exit Function
    Next c
    
    'vérification par ligne
    For l = 1 To 3
        ok = True
        For c = 1 To 3
            ok = ok And CBool(fond(10 * l + c).FillColor = player_color)
        Next c
        
        If ok Then Exit Function
    Next l
    
    'vérification de la premiere diagonale
    ok = True
    For c = 1 To 3
        ok = ok And CBool(fond(10 * c + c).FillColor = player_color)
    Next c
    If ok Then Exit Function

    'vérification de la seconde diagonale
    ok = True
    For c = 1 To 3
        ok = ok And CBool(fond(10 * c + (4 - c)).FillColor = player_color)
    Next c
    If ok Then Exit Function
    
    IsWinner = False
End Function

Conclusion :


maintenant, si vous avez encore des doutes sur les capacités de Speeck SDK 5.1 (SAPI) je peux plus rien pour vous.

je vais maintenant essayé de faire un add-in vocale pour VBE 0.6
genre :
- Run
- Compile
- Next Page
- Previous Page
- Start new Search
... (vais finir par ne plus me servir de la souris ^^)

pour rappel :
il faut parler distinctement un anglais compréhensible.
il ne faut pas parler trop fort
il ne faut pas qu'il y est des bruits parasites (musique ou autres)

bonne utilisation.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

FABMC2
Messages postés
8
Date d'inscription
mercredi 4 août 2004
Statut
Membre
Dernière intervention
28 août 2009
-
J'savais pas qu'ça causait ces bestioles, ah, ah ah ;)

Sinon très bonne idée ce petit soft.
Flocreate
Messages postés
307
Date d'inscription
lundi 17 juillet 2006
Statut
Membre
Dernière intervention
27 mai 2012
3 -
^^ a bon ? moi je dis twhou ^^
dès que j'aurais bien approfondis mes connaissances sur l'utilisation des grammaires et des règles je vais peut être écrire un tutoriel.
La seule chose c'est que pour le moment la reconnaissance vocale ca fait un peut gadget.
Mais je suis certain que dans un avenir assez proche c'est une chose qui prendra vraiment le pas sur des capteurs qui s'épuisent vites.
Renfield
Messages postés
17280
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
21 juillet 2019
58 -
Sympa...

note qu'on dit "Two" .... pas Twoo
Flocreate
Messages postés
307
Date d'inscription
lundi 17 juillet 2006
Statut
Membre
Dernière intervention
27 mai 2012
3 -
bon b g fini par trouvé.
Flocreate
Messages postés
307
Date d'inscription
lundi 17 juillet 2006
Statut
Membre
Dernière intervention
27 mai 2012
3 -
si une personne pouvait m'expliquer comment ajouter des règles et les utiliser dans la grammaire, ca serrait plus propre de faire ainsi :

rule colone
one
twoo
three

rule ligne
one
twoo
three

grammar.add "select case ?colone ?ligne"

ou même une règle qui permette de dire "n'importe quel nombre positif"

n'ésitez pas a metre des notes histoire que je sache ce que cette source vaut à vos yeux ^^

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.