1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
----------------------------------------------------------------------
-- |
-- Module : GF.System.ATKSpeechInput
-- Maintainer : BB
-- Stability : (stable)
-- Portability : (non-portable)
--
-- > CVS $Date: 2005/05/10 15:04:01 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.2 $
--
-- Use ATK and Speech.ATKRec for speech input.
-----------------------------------------------------------------------------
module GF.System.ATKSpeechInput (recognizeSpeech) where
import GF.Infra.Ident (Ident, prIdent)
import GF.Infra.Option
import GF.Conversion.Types (CGrammar)
import GF.Speech.PrSLF
import Speech.ATKRec
import Control.Monad
import Data.Maybe
import Data.IORef
import System.Environment
import System.IO
import System.IO.Unsafe
data ATKLang = ATKLang {
hmmlist :: FilePath,
mmf0 :: FilePath,
mmf1 :: FilePath,
dict :: FilePath,
opts :: [(String,String)]
}
atk_home_error = "The environment variable ATK_HOME is not set. "
++ "It should contain the path to your copy of ATK."
gf_atk_cfg_error = "The environment variable GF_ATK_CFG is not set. "
++ "It should contain the path to your GF ATK configuration"
++ " file. A default version of this file can be found"
++ " in GF/src/gf_atk.cfg"
getLanguage :: String -> IO ATKLang
getLanguage l =
case l of
"en_UK" -> do
atk_home <- getEnv_ "ATK_HOME" atk_home_error
let res = atk_home ++ "/Resources"
return $ ATKLang {
hmmlist = res ++ "/UK_SI_ZMFCC/hmmlistbg",
mmf0 = res ++ "/UK_SI_ZMFCC/WI4",
mmf1 = res ++ "/UK_SI_ZMFCC/BGHMM2",
dict = res ++ "/beep.dct",
opts = [("TARGETKIND", "MFCC_0_D_A_Z"),
("HPARM:CMNDEFAULT", res ++ "/UK_SI_ZMFCC/cepmean")]
}
"sv_SE" -> do
let res = "/home/bjorn/projects/atkswe/numerals-swe/final"
return $ ATKLang {
hmmlist = res ++ "/hmm_tri/hmmlist",
mmf0 = res ++ "/hmm_tri/macros",
mmf1 = res ++ "/hmm_tri/hmmdefs",
dict = res ++ "/NumeralsSwe.dct",
opts = [("TARGETKIND", "MFCC_0_D_A")]
}
_ -> fail $ "ATKSpeechInput: language " ++ l ++ " not supported"
-- | Current language for which we have loaded the HMM
-- and dictionary.
{-# NOINLINE currentLang #-}
currentLang :: IORef (Maybe String)
currentLang = unsafePerformIO $ newIORef Nothing
-- | Initializes the ATK, loading the given language.
-- ATK must not be initialized when calling this function.
loadLang :: String -> IO ()
loadLang lang =
do
l <- getLanguage lang
config <- getEnv_ "GF_ATK_CFG" gf_atk_cfg_error
hPutStrLn stderr $ "Initializing ATK..."
initialize (Just config) (opts l)
let hmmName = "hmm_" ++ lang
dictName = "dict_" ++ lang
hPutStrLn stderr $ "Initializing ATK (" ++ lang ++ ")..."
loadHMMSet hmmName (hmmlist l) (mmf0 l) (mmf1 l)
loadDict dictName (dict l)
writeIORef currentLang (Just lang)
initATK :: String -> IO ()
initATK lang =
do
ml <- readIORef currentLang
case ml of
Nothing -> loadLang lang
Just l | l == lang -> return ()
| otherwise -> do
deinitialize
loadLang lang
recognizeSpeech :: Ident -- ^ Grammar name
-> String -- ^ Language, e.g. en_UK
-> CGrammar -- ^ Context-free grammar for input
-> String -- ^ Start category name
-> Int -- ^ Number of utterances
-> IO [String]
recognizeSpeech name language cfg start number =
do
let slf = slfPrinter name start cfg
n = prIdent name
hmmName = "hmm_" ++ language
dictName = "dict_" ++ language
slfName = "gram_" ++ n
recName = "rec_" ++ language ++ "_" ++ n
writeFile "debug.net" slf
initATK language
hPutStrLn stderr $ "Loading grammar " ++ n ++ " ..."
loadGrammarString slfName slf
createRecognizer recName hmmName dictName slfName
hPutStrLn stderr $ "Listening in category " ++ start ++ "..."
s <- replicateM number (recognize recName)
return s
getEnv_ :: String -- ^ Name of environment variable
-> String -- ^ Message to fail with if the variable is not set.
-> IO String
getEnv_ e err =
do
env <- getEnvironment
case lookup e env of
Just v -> return v
Nothing -> fail err
|
