packages feed

tttool 1.0 → 1.1

raw patch · 6 files changed

+174/−27 lines, 6 filesdep +unordered-containers

Dependencies added: unordered-containers

Files

README.md view
@@ -15,9 +15,7 @@ The tool can also be used to generate completely new files from scratch; see below for details. -If you want to learn more, here are some relevant links:- * Discussion about Tip-Toi: http://www.quadrierer.de/geekythinking/blog/?itemid=368 (German)- * Discussion about Tip-Toi and the related TING pen, including discussion on how to print your own books: http://www.mikrocontroller.net/topic/214479 (German)+If you want to learn more please have a look into our wiki (https://github.com/entropia/tip-toi-reveng/wiki).  The tttool tool ---------------@@ -102,7 +100,7 @@     `cabal`, and you should run the two commands          cabal update-        cabal install --dependencies-only+        cabal install --only-dependencies   3. Now you can build the program using @@ -153,7 +151,7 @@ Text to speech -------------- -If you have libttspico-utils and vorbis-tools installed, you can have tttool+If you have `libttspico-utils` and `vorbis-tools installed`, you can have tttool generate audio files from text for you, which makes developing your yaml file much easier. See [text2speech.yaml](text2speech.yaml) for more information. @@ -172,6 +170,7 @@  * [tiptoi hacking](https://blogs.fsfe.org/guido/2014/05/tiptoi-hacking-und-systemanforderungen/) by Guido Arnold  * [TipToi Hacking](http://www.nerd.junetz.de/blogbox/index.php?/archives/1377-TipToi-Hacking.html) and [TipToi Hacking II](http://www.nerd.junetz.de/blogbox/index.php?/archives/1378-TipToi-Hacking-II.html) by Mr. Blog  * [Various posts](https://www.joachim-breitner.de/blog/tag/Tiptoi) by Joachim “nomeata” Breitner (the main author of `tttool`)+ * [Self-made animal figures](https://www.youtube.com/watch?v=Yic57Y9VORA&app=desktop) demonstration video  TODO ----@@ -193,5 +192,5 @@  * `matlab/` contains scripts to analyse gme files in Matlab  * `wip/` (work in progess) contains notes about the parts of the gme files that are not    fully understood yet.-+ * `perl-tools` contains a perl based script, to generate a PDF with all OID codes from a yaml-file as well some functions to generate PNG-files, inject pHYs-chunks with resolution hints into GD generated PNG files as result from some testing
+ src/Language.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}+module Language where++import Data.Aeson.Types+import Control.Monad+import Data.Text+++data Language = En | De | Fr++defaultLanguage :: Language+defaultLanguage = En++ppLang :: Language -> String+ppLang En = "en"+ppLang De = "de"+ppLang Fr = "fr"++instance ToJSON Language where+    toJSON = toJSON . ppLang++instance FromJSON Language where+    parseJSON (String "en") = return En+    parseJSON (String "de") = return De+    parseJSON (String "fr") = return Fr+    parseJSON (String s) = fail $ "Unknown language \"" ++ unpack s ++ "\"."+    parseJSON _ = mzero+
src/TextToSpeech.hs view
@@ -10,16 +10,90 @@ import Control.Monad import Data.Hashable import Text.Printf+import Control.Exception+import System.IO.Error+import System.Environment+import System.Info (os) -ttsFileName txt = "tts-cache" </> "tts-" ++ map go (shorten txt) <.> "ogg"+import Language++ttsFileName lang txt =+    "tts-cache" </> "tts-" ++ map go (shorten txt) ++ "-" ++ ppLang lang <.>  "ogg"   where go '/'         = '_'         go c | c < ' ' = '_'         go c           = c         shorten x | length x > 20 = printf "%s-%016X" (take 20 x) (hash x)         shorten x                 = x -textToSpeech :: FilePath -> String -> IO ()-textToSpeech fn txt = do++pico :: Language -> FilePath -> String -> (String, [String])+pico lang tmp txt =+   ("pico2wave", ["--wave", tmp, "--lang", l, txt])+  where+    l = case lang of +            En -> "en-GB"+            De -> "de-DE"+            Fr -> "fr-FR"++espeak :: Language -> FilePath -> String -> (String, [String])+espeak lang tmp txt =+ ("espeak", ["-v", l, "-w", tmp, "-s", "120", txt])+  where+    l = case lang of +            En -> "en"+            De -> "de"+            Fr -> "fr"++espeak_contrib :: Language -> FilePath -> String -> (String, [String])+espeak_contrib lang tmp txt =+ ("./contrib/espeak", ["-v", l, "-w", tmp, "-s", "120", txt])+  where+    l = case lang of +            En -> "en"+            De -> "de"+            Fr -> "fr"+++engines :: Language -> FilePath -> String -> [(String, [String])]+engines l ft txt =+    [ pico l ft txt+    , espeak l ft txt+    , espeak_contrib l ft txt+    ]++oggenc :: FilePath -> FilePath -> (String, [String])+oggenc from to = ("oggenc", ["-Q", "-o", to, from])++oggenc_contrib :: FilePath -> FilePath -> (String, [String])+oggenc_contrib from to = ("contrib/oggenc", ["-Q", "-o", to, from])++encoders :: FilePath -> FilePath -> [(String, [String])]+encoders from to =+    [ oggenc from to+    , oggenc_contrib from to+    ] ++tryPrograms [] e = e+tryPrograms ((c,args):es) e = do+    -- Missing programs cause exceptions on Windows, but error 127 on Linux.+    -- Try to handle both here.+    r <- tryJust (guard . isDoesNotExistError) $ do+        env <- getEnvironment+        let env' | os == "mingw32" = ("ESPEAK_DATA_PATH", "contrib") : env+                 | otherwise       = env+        ph <- runProcess  c args Nothing (Just env') Nothing Nothing Nothing+        ret <- waitForProcess ph+        if ret == ExitSuccess then return True+        else if ret == ExitFailure 127 then return False+        else do+            putStrLn $ "Failed to execute \"" ++ c ++ "\" (" ++ show ret ++ ")"+            exitFailure+    case r of+       Right True -> return ()+       _ -> tryPrograms es e++textToSpeech :: Language -> String -> IO ()+textToSpeech lang txt = do     ex <- doesFileExist fn     if ex then return () else do @@ -29,17 +103,15 @@     (tmp,h) <- openTempFile (takeDirectory fn) (takeBaseName fn <.> "wav")     hClose h -    (ret, _, err) <- readProcessWithExitCode "pico2wave" ["--wave", tmp, "--lang", "en-GB", txt] ""-    unless (ret == ExitSuccess) $ do-        putStrLn "Failed to execute \"pico2wave\":"-        putStrLn err-        putStrLn "Do you have libttspico-utils installed?"+    tryPrograms (engines lang tmp txt) $ do+        putStrLn "No suitable text-to-speech-engine found."+        putStrLn "Do you have libttspico-utils or espeak installed?" -    (ret, _, err) <- readProcessWithExitCode "oggenc" ["-o", fn, tmp] ""-    unless (ret == ExitSuccess) $ do-        putStrLn "Failed to execute \"oggenc\":"-        putStrLn err+    tryPrograms (encoders tmp fn) $ do+        putStrLn "Could not find \"oggenc\"."         putStrLn "Do you have vorbis-tools installed?"      removeFile tmp     return ()+  where+    fn = ttsFileName lang txt
src/TipToiYaml.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards, DeriveGeneric, CPP #-}+{-# LANGUAGE RecordWildCards, DeriveGeneric, CPP, TupleSections #-}  module TipToiYaml     ( tt2ttYaml, ttYaml2tt@@ -22,6 +22,7 @@ import System.Directory import qualified Data.Map as M import qualified Data.Set as S+import qualified Data.Vector as V import Control.Monad.Writer.Strict #if MIN_VERSION_time(1,5,0) import Data.Time.Format (defaultTimeLocale)@@ -38,10 +39,12 @@ import Text.Parsec.Language (emptyDef) import GHC.Generics import qualified Data.Foldable as F+import qualified Data.Traversable as T import Control.Arrow import Control.Applicative ((<*>), (<*))  import TextToSpeech+import Language import Types import Constants import KnownCodes@@ -59,7 +62,8 @@     , ttyWelcome :: Maybe String     , ttyProduct_Id :: Word32     , ttyScriptCodes :: Maybe CodeMap-    , ttySpeak :: Maybe (M.Map String String)+    , ttySpeak :: Maybe SpeakSpecs+    , ttyLanguage :: Maybe Language     }     deriving Generic @@ -68,6 +72,41 @@     }     deriving Generic +data SpeakSpec = SpeakSpec+    { ssLanguage :: Maybe Language+    , ssSpeak    :: M.Map String String+    }++instance FromJSON SpeakSpec where+    parseJSON v = do+        m <- parseJSON v+        l <- T.traverse parseJSON  $ M.lookup "language" m+        m' <- T.traverse parseJSON $ M.delete "language" m +        return $ SpeakSpec l m'++instance ToJSON SpeakSpec where+    toJSON (SpeakSpec (Just l) m) = toJSON $ M.insert "language" (ppLang l) m +    toJSON (SpeakSpec Nothing m)  = toJSON $ m++toSpeakMap :: Language -> Maybe SpeakSpecs -> M.Map String (Language, String)+toSpeakMap l Nothing = M.empty+toSpeakMap l (Just (SpeakSpecs specs)) = M.unionsWith e $ map go specs+  where+    go (SpeakSpec ml m) = M.map ((l',)) m+      where l' = fromMaybe l ml+    e = error "Conflicting definitions in section \"speak\""+          ++newtype SpeakSpecs = SpeakSpecs [SpeakSpec] ++instance FromJSON SpeakSpecs where+    parseJSON (Array a) = SpeakSpecs <$> mapM parseJSON  (V.toList a)+    parseJSON v = SpeakSpecs . (:[]) <$> parseJSON v++instance ToJSON SpeakSpecs where+    toJSON (SpeakSpecs [x]) = toJSON x+    toJSON (SpeakSpecs l)   = Array $ V.fromList $ map toJSON $ l+     options = defaultOptions { fieldLabelModifier = map fix . map toLower . drop 3 }        where fix '_' = '-'              fix c   = c@@ -94,6 +133,7 @@     , ttyMedia_Path = Just path     , ttyScriptCodes = Nothing     , ttySpeak = Nothing+    , ttyLanguage = Nothing     }  @@ -211,13 +251,15 @@             , Line _ cs as _ <- ls             , r <- concatMap F.toList cs ++ concatMap F.toList as ] +    let ttySpeakMap = toSpeakMap (fromMaybe defaultLanguage ttyLanguage) ttySpeak+         -- Generate text-to-spech files-    forM (maybe [] M.elems ttySpeak) $ \txt -> do-        textToSpeech (ttsFileName txt) txt+    forM (M.elems ttySpeakMap) $ \(lang, txt) ->+        textToSpeech lang txt -    files <- forM filenames' $ \fn -> case ttySpeak >>= M.lookup fn of-        Just txt -> do-            B.readFile (ttsFileName txt)+    files <- forM filenames' $ \fn -> case M.lookup fn ttySpeakMap of+        Just (lang, txt) -> do+            B.readFile (ttsFileName lang txt)         Nothing -> do             let paths = [ combine dir relpath                     | ext <- map snd fileMagics@@ -469,6 +511,7 @@             , let chars = [oid `div` 10^p `mod` 10| p <-[4,3,2,1,0]]             , let line = ppLine t $ Line 0 [] [Play n | n <- [0..5]] ([10] ++ chars)             ]+        , ttyLanguage = Nothing         }   where     t= M.fromList $
src/tttool.hs view
@@ -254,7 +254,10 @@ export inf out = do     (tt,_) <- parseTipToiFile <$> B.readFile inf     let tty = tt2ttYaml (printf "media/%s_%%s" (takeBaseName inf)) tt-    writeTipToiYaml out tty+    ex <- doesFileExist out+    if ex+        then printf "File \"%s\" does already exist. Please remove it first\nif you want to export \"%s\" again.\n" out inf >> exitFailure+        else writeTipToiYaml out tty   assemble :: FilePath -> FilePath -> IO ()
tttool.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                tttool-version:             1.0+version:             1.1 synopsis:            Working with files for the Tiptoi® pen description:         The Ravensburger Tiptoi® pen is programmed via special                      files. Their file format has been reverse engineered; this@@ -36,6 +36,7 @@     GMERun,     GMEWriter,     Lint,+    Language,     OidCode,     OneLineParser,     PrettyPrint,@@ -64,6 +65,7 @@     text        == 0.11.*  ||  == 1.2.*,     parsec      == 3.1.*,     process     == 1.1.*   ||  == 1.2.*,+    unordered-containers  == 0.2.*,     vector      == 0.10.*,     yaml        == 0.8.*