GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3

1 files changed, 137 insertions, 0 deletions

diff --git a/src-3.0/GF/System/ATKSpeechInput.hs b/src-3.0/GF/System/ATKSpeechInput.hs
new file mode 100644
index 000000000..4b50293af
--- /dev/null
+++ b/src-3.0/GF/System/ATKSpeechInput.hs
@@ -0,0 +1,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