decibel levels && multiple level files

1 files changed, 96 insertions, 37 deletions

diff --git a/src/Trivmix.hs b/src/Trivmix.hs
index c1fbe8a..abb7c32 100644
--- a/src/Trivmix.hs
+++ b/src/Trivmix.hs
@@ -17,6 +17,7 @@ import System.Process
 
 import Control.Concurrent
 import Control.Concurrent.MVar
+import Control.Concurrent.Chan
 
 import qualified Control.Monad.Trans.Class as Trans
 import qualified Control.Monad.Exception.Synchronous as Sync
@@ -27,16 +28,40 @@ import System.IO.Error
 import System.INotify
 
 import Data.Char
+import Data.Function
+
+import Control.Monad
+  
+import           Data.CaseInsensitive  ( CI )
+import qualified Data.CaseInsensitive as CI
 
 data Options = Options
                { input :: String
                , output :: String
                , client :: String
                , run :: Maybe String
-               , initialLevel :: Float
-               , stateDir :: FilePath
+               , levelFiles :: [FilePath]
                }
 
+data Level = Lin Float | DB Float
+
+instance Show Level where
+  show (Lin x) = show x
+  show (DB x) = (show x) ++ "dB"
+
+instance Read Level where
+  readsPrec i = map toL . readsPrec i
+    where
+      toL :: (Float, String) -> (Level, String)
+      toL (f, str)
+        | ((==) `on` CI.mk) prec unit = (DB f, rest)
+        | otherwise = (Lin f, str)
+        where
+          prec = take lU str
+          rest = drop lU str
+          unit = "dB"
+          lU = length unit
+
 optionParser :: Parser Options
 optionParser = Options <$>
                (fromMaybe "in" <$> optional (strOption ( long "input"
@@ -56,14 +81,24 @@ optionParser = Options <$>
                                           <> metavar "FILE"
                                         )
                             )
-               <*> (fromMaybe 0 <$> optional (option auto ( long "level"
-                                                            <> metavar "FLOAT"
-                                                          )
-                                             )
-                   )
-               <*> strOption ( long "dir"
-                               <> metavar "DIRECTORY"
-                             )
+               <*> some (strOption ( long "level"
+                                     <> metavar "FILE"
+                                   )
+                        )
+
+initialLevel :: Level
+initialLevel = Lin 0
+
+watchedAttrs :: [EventVariety]
+watchedAttrs = [ Modify
+               , Move
+               , MoveIn
+               , MoveOut
+               , MoveSelf
+               , Create
+               , Delete
+               , DeleteSelf
+               ]
 
 main :: IO ()
 main = execParser opts >>= trivmix
@@ -75,11 +110,10 @@ main = execParser opts >>= trivmix
            )
 
 trivmix :: Options -> IO ()
-trivmix Options{..} = onDirectory stateDir $ do
+trivmix Options{..} = do
   level <- newMVar initialLevel
-  let levelFile = stateDir </> "level"
-  onLevelFile levelFile initialLevel $ withINotify $ \n -> do
-    addWatch n [Modify] levelFile (const $ handleLevel level levelFile)
+  withINotify $ \inotify -> do
+    handleFiles inotify level levelFiles
     Jack.handleExceptions $
       Jack.withClientDefault client $ \client' ->
       Jack.withPort client' input $ \input' ->
@@ -93,42 +127,67 @@ trivmix Options{..} = onDirectory stateDir $ do
         Audio.withProcessMono client' input' (mix level) output' $
           Jack.withActivation client' $ Trans.lift Jack.waitForBreak
 
-onDirectory :: FilePath -> IO () -> IO ()
-onDirectory stateDir io = do
-  exists <- doesDirectoryExist stateDir
-  createDirectoryIfMissing True stateDir
-  finally io $ if exists then removeDirectory stateDir else return ()
-  
-mix :: MVar Float -> CFloat -> IO CFloat
+mix :: MVar Level -> CFloat -> IO CFloat
 mix level input = do
   level' <- readMVar level
-  return $ (CFloat level') * input
-
-onLevelFile :: FilePath -> Float -> IO a -> IO a
-onLevelFile file initial action = do
+  return $ (CFloat $ toFloat level') * input
+  where
+    toFloat (Lin x) = x
+    toFloat (DB x) = 10 ** (0.05 * x)
+
+handleFiles :: INotify -> MVar Level -> [FilePath] -> IO ()
+handleFiles inotify level files = do
+  initLevel <- readMVar level
+  levelChanges <- (newChan :: IO (Chan Level))
+  let 
+    handleFiles' = mapM handleFile files
+    handleFile file = do
+      levelChanges' <- dupChan levelChanges
+      forkIO $ forever $ do -- Broadcast level changes and update all files
+        readChan levelChanges' >>= writeLevel file
+      addWatch inotify watchedAttrs file (const $ readLevel levelChanges level file)
+  foldl (.) id [onStateFile f (show initLevel ++ "\n") | f <- files] $ handleFiles'
+  forkIO $ forever $ do
+    readChan levelChanges >>= swapMVar level
+    return ()
+  return ()
+
+onStateFile :: FilePath -> String -> IO a -> IO a
+onStateFile file initial action = do
+  let directory = takeDirectory file
+  dirExists <- doesDirectoryExist directory
   exists <- doesFileExist file
-  let acquire = case exists of
+  createDirectoryIfMissing True directory
+  let acquireFile = case exists of
         True -> return ()
-        False -> createFile file mode >>= closeFd >> writeFile file (show initial ++ "\n")
-      mode = foldl unionFileModes nullFileMode [ ownerReadMode
-                                               , ownerWriteMode
-                                               , groupReadMode
-                                               , groupWriteMode
-                                               ]
-      release = case exists of
+        False -> createFile file fileMode >>= closeFd >> writeFile file initial
+      fileMode = foldl unionFileModes nullFileMode [ ownerReadMode
+                                                   , ownerWriteMode
+                                                   , groupReadMode
+                                                   , groupWriteMode
+                                                   ]
+      releaseFile = case exists of
         True -> return ()
         False -> removeFile file
+      releaseDir = case dirExists of
+        True -> return ()
+        False -> removeFile directory
+      acquire = acquireFile
+      release = releaseFile >> releaseDir
   bracket_ acquire release action
 
-handleLevel :: MVar Float -> FilePath -> IO ()
-handleLevel level file = catch action handler
+readLevel :: Chan Level -> MVar Level -> FilePath -> IO ()
+readLevel levelChan current file = catch action handler
   where
-    action = readFile file >>= readIO . stripSpace >>= swapMVar level >>= const (return ())
+    action = readFile file >>= readIO . stripSpace >>= writeChan levelChan
     handler e = if isUserError e
-                then readMVar level >>= \l -> writeFile file (show l ++ "\n")
+                then readMVar current >>= writeLevel file
                 else throw e
     stripSpace = reverse . stripSpace' . reverse . stripSpace'
     stripSpace' [] = []
     stripSpace' l@(x:xs) = if isSpace x
                           then stripSpace' xs
                           else l
+
+writeLevel :: FilePath -> Level -> IO ()
+writeLevel file level = writeFile file (show level ++ "\n")