Implement balance & refine types

1 files changed, 44 insertions, 10 deletions

diff --git a/trivmix/Trivmix.hs b/trivmix/Trivmix.hs
index 084da7f..4d7c6f7 100644
--- a/trivmix/Trivmix.hs
+++ b/trivmix/Trivmix.hs
@@ -1,10 +1,12 @@
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
 
 import Foreign.C.Types (CFloat(..))
 import qualified Sound.JACK as Jack
 import qualified Sound.JACK.Audio as Audio
 
-import Options.Applicative
+import Options.Applicative hiding (str)
 
 import Data.Maybe
 
@@ -16,7 +18,7 @@ import System.Posix.Types
 import System.Environment
 import System.Process
 
-import System.Systemd.Daemon (notifyReady)
+import System.Systemd.Daemon (notifyReady, notifyWatchdog)
 
 import Control.Concurrent
 import Control.Concurrent.MVar
@@ -38,15 +40,22 @@ import Data.Char
 import Data.Function
 
 import Control.Monad
+
+import Text.Heredoc (str)
+import Refined
   
 import Trivmix.Types
 
+type Balance = Refined ZeroToOne Float
+  
 data Options = Options
                { input :: String
                , output :: String
                , client :: String
                , initialLevel :: Level
+               , initialBalance :: Balance
                , run :: [FilePath]
+               , balanceFiles :: [FilePath]
                , levelFiles :: [FilePath]
                }
 
@@ -74,13 +83,33 @@ optionParser = Options
                                <> value def
                                <> showDefault
                                )
+               <*> option auto ( long "balance"
+                              <> metavar "BALANCE"
+                              <> help "Initial value for balance"
+                              <> value ($$(refineTH 1.0) :: Balance)
+                              <> showDefault
+                               )
                <*> many ( strOption ( long "run"
                                    <> metavar "FILE"
-                                   <> help "Execute a file once setup of jacks is done (use this to autoconnect)\nThe executable gets passed the input port (including client name) as its first argument and the output as its second."
+                                   <> help [str|Execute a file once setup of jacks is done (use this to autoconnect)
+                                               |The executable gets passed the input port (including client name) as its first argument and the output as its second.
+                                               |]
                                     )
                         )
+               <*> many ( strOption  ( long "balance"
+                                    <> metavar "FILE"
+                                    <> help [str|Files that contain factors in the interval [0,1] to multiply with each other and the current level.
+                                                |For deterministic behaviour use flock(2).
+                                                |The format used in these files is a float using ‘.’ as a decimal point.
+                                                |]
+                                     )
+                        )
                <*> many (strArgument ( metavar "FILE..."
-                                       <> help "Files that contain levels to assume and synchronize\nFor deterministic behaviour use flock(2).\nThe format used in these files is either a signed float, using ‘.’ as a decimal point or a signed float postfixed with ‘dB’.\nCaveat: ‘-InfinitydB’ exists and works as expected (i.e.: it is equal to ‘0.0’)"
+                                       <> help [str|Files that contain levels to assume and synchronize
+                                                   |For deterministic behaviour use flock(2).
+                                                   |The format used in these files is either a signed float, using ‘.’ as a decimal point or a signed float postfixed with ‘dB’.
+                                                   |Caveat: ‘-InfinitydB’ exists and works as expected (i.e.: it is equal to ‘0.0’)
+                                                   |]
                                      )
                         )
 
@@ -122,6 +151,7 @@ main = execParser opts >>= trivmix
 trivmix :: Options -> IO ()
 trivmix Options{..} = do
   level <- newMVar initialLevel
+  balance <- newMVar initialBalance
   level' <- newMVar initialLevel
   forkIO $ forever $ do -- Smooth out discontinuity
     let
@@ -130,12 +160,15 @@ trivmix Options{..} = do
       frames = interval * fps
       delay = round $ recip fps * 1e6
       linInt x a b = a * (1 - x) + b * x
-    newLevel <- readMVar level
+      linInt' x a b = either error id $ asFloat (linInt x) a b
+      mulBalance (unrefine -> b) x = either error id $ asFloat (*) (Lin . either error id $ refine b) x
+    newLevel <- mulBalance <$> readMVar balance <*> readMVar level
     currentLevel <- readMVar level'
-    mapM_ (\x -> swapMVar level' (asFloat (linInt x) currentLevel newLevel) >> threadDelay delay) ([0,recip frames..1] :: [Float])
+    mapM_ (\x -> swapMVar level' (linInt' x currentLevel newLevel) >> threadDelay delay) ([0,recip frames..1] :: [Float])
   let withFiles = foldl (.) id $ map (\f -> onStateFile f (show initialLevel ++ "\n")) levelFiles
   withFiles $ withINotify $ \inotify -> do
     handleFiles inotify level levelFiles
+    handleFiles inotify balance levelFiles
     Jack.handleExceptions $
       Jack.withClientDefault client $ \client' ->
       Jack.withPort client' input $ \input' ->
@@ -149,13 +182,14 @@ trivmix Options{..} = do
 
 mix :: MVar Level -> CFloat -> IO CFloat
 mix level input = do
+  notifyWatchdog
   level' <- readMVar level
   return $ (CFloat $ toFloat level') * input
 
-handleFiles :: INotify -> MVar Level -> [FilePath] -> IO ()
+handleFiles :: (Read l, Show l, Eq l) => INotify -> MVar l -> [FilePath] -> IO ()
 handleFiles inotify level files = do
   initLevel <- readMVar level
-  levelChanges <- (newChan :: IO (Chan Level))
+  levelChanges <- newChan
   stderrLock <- newEmptyMVar
   let 
     handleFile file = addWatch inotify watchedAttrs file (const $ readLevel levelChanges level file stderrLock)
@@ -206,7 +240,7 @@ takeWhileM pred (x:xs) = do
     False -> do
       return []
 
-readLevel :: Chan Level -> MVar Level -> FilePath -> MVar () -> IO ()
+readLevel :: (Read l, Show l, Eq l) => Chan l -> MVar l -> FilePath -> MVar () -> IO ()
 readLevel levelChan current file stderrLock = catch action handler
   where
     action = do
@@ -228,7 +262,7 @@ readLevel levelChan current file stderrLock = catch action handler
                           then stripSpace' xs
                           else l
 
-writeLevel :: FilePath -> MVar () -> Level -> IO ()
+writeLevel :: Show l => FilePath -> MVar () -> l -> IO ()
 writeLevel file stderrLock level = withFileLock file Exclusive $ const $ do
   withMVarLock stderrLock $ 
     hPutStrLn stderr $ "Writing out level ‘" ++ (show level) ++ "’ to ‘" ++ file ++ "’"