diff options
Diffstat (limited to 'trivmix/Trivmix.hs')
-rw-r--r-- | trivmix/Trivmix.hs | 54 |
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 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | 1 | {-# LANGUAGE RecordWildCards #-} |
2 | {-# LANGUAGE ViewPatterns #-} | ||
3 | {-# LANGUAGE TemplateHaskell, QuasiQuotes #-} | ||
2 | 4 | ||
3 | import Foreign.C.Types (CFloat(..)) | 5 | import Foreign.C.Types (CFloat(..)) |
4 | import qualified Sound.JACK as Jack | 6 | import qualified Sound.JACK as Jack |
5 | import qualified Sound.JACK.Audio as Audio | 7 | import qualified Sound.JACK.Audio as Audio |
6 | 8 | ||
7 | import Options.Applicative | 9 | import Options.Applicative hiding (str) |
8 | 10 | ||
9 | import Data.Maybe | 11 | import Data.Maybe |
10 | 12 | ||
@@ -16,7 +18,7 @@ import System.Posix.Types | |||
16 | import System.Environment | 18 | import System.Environment |
17 | import System.Process | 19 | import System.Process |
18 | 20 | ||
19 | import System.Systemd.Daemon (notifyReady) | 21 | import System.Systemd.Daemon (notifyReady, notifyWatchdog) |
20 | 22 | ||
21 | import Control.Concurrent | 23 | import Control.Concurrent |
22 | import Control.Concurrent.MVar | 24 | import Control.Concurrent.MVar |
@@ -38,15 +40,22 @@ import Data.Char | |||
38 | import Data.Function | 40 | import Data.Function |
39 | 41 | ||
40 | import Control.Monad | 42 | import Control.Monad |
43 | |||
44 | import Text.Heredoc (str) | ||
45 | import Refined | ||
41 | 46 | ||
42 | import Trivmix.Types | 47 | import Trivmix.Types |
43 | 48 | ||
49 | type Balance = Refined ZeroToOne Float | ||
50 | |||
44 | data Options = Options | 51 | data Options = Options |
45 | { input :: String | 52 | { input :: String |
46 | , output :: String | 53 | , output :: String |
47 | , client :: String | 54 | , client :: String |
48 | , initialLevel :: Level | 55 | , initialLevel :: Level |
56 | , initialBalance :: Balance | ||
49 | , run :: [FilePath] | 57 | , run :: [FilePath] |
58 | , balanceFiles :: [FilePath] | ||
50 | , levelFiles :: [FilePath] | 59 | , levelFiles :: [FilePath] |
51 | } | 60 | } |
52 | 61 | ||
@@ -74,13 +83,33 @@ optionParser = Options | |||
74 | <> value def | 83 | <> value def |
75 | <> showDefault | 84 | <> showDefault |
76 | ) | 85 | ) |
86 | <*> option auto ( long "balance" | ||
87 | <> metavar "BALANCE" | ||
88 | <> help "Initial value for balance" | ||
89 | <> value ($$(refineTH 1.0) :: Balance) | ||
90 | <> showDefault | ||
91 | ) | ||
77 | <*> many ( strOption ( long "run" | 92 | <*> many ( strOption ( long "run" |
78 | <> metavar "FILE" | 93 | <> metavar "FILE" |
79 | <> 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." | 94 | <> help [str|Execute a file once setup of jacks is done (use this to autoconnect) |
95 | |The executable gets passed the input port (including client name) as its first argument and the output as its second. | ||
96 | |] | ||
80 | ) | 97 | ) |
81 | ) | 98 | ) |
99 | <*> many ( strOption ( long "balance" | ||
100 | <> metavar "FILE" | ||
101 | <> help [str|Files that contain factors in the interval [0,1] to multiply with each other and the current level. | ||
102 | |For deterministic behaviour use flock(2). | ||
103 | |The format used in these files is a float using ‘.’ as a decimal point. | ||
104 | |] | ||
105 | ) | ||
106 | ) | ||
82 | <*> many (strArgument ( metavar "FILE..." | 107 | <*> many (strArgument ( metavar "FILE..." |
83 | <> 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’)" | 108 | <> help [str|Files that contain levels to assume and synchronize |
109 | |For deterministic behaviour use flock(2). | ||
110 | |The format used in these files is either a signed float, using ‘.’ as a decimal point or a signed float postfixed with ‘dB’. | ||
111 | |Caveat: ‘-InfinitydB’ exists and works as expected (i.e.: it is equal to ‘0.0’) | ||
112 | |] | ||
84 | ) | 113 | ) |
85 | ) | 114 | ) |
86 | 115 | ||
@@ -122,6 +151,7 @@ main = execParser opts >>= trivmix | |||
122 | trivmix :: Options -> IO () | 151 | trivmix :: Options -> IO () |
123 | trivmix Options{..} = do | 152 | trivmix Options{..} = do |
124 | level <- newMVar initialLevel | 153 | level <- newMVar initialLevel |
154 | balance <- newMVar initialBalance | ||
125 | level' <- newMVar initialLevel | 155 | level' <- newMVar initialLevel |
126 | forkIO $ forever $ do -- Smooth out discontinuity | 156 | forkIO $ forever $ do -- Smooth out discontinuity |
127 | let | 157 | let |
@@ -130,12 +160,15 @@ trivmix Options{..} = do | |||
130 | frames = interval * fps | 160 | frames = interval * fps |
131 | delay = round $ recip fps * 1e6 | 161 | delay = round $ recip fps * 1e6 |
132 | linInt x a b = a * (1 - x) + b * x | 162 | linInt x a b = a * (1 - x) + b * x |
133 | newLevel <- readMVar level | 163 | linInt' x a b = either error id $ asFloat (linInt x) a b |
164 | mulBalance (unrefine -> b) x = either error id $ asFloat (*) (Lin . either error id $ refine b) x | ||
165 | newLevel <- mulBalance <$> readMVar balance <*> readMVar level | ||
134 | currentLevel <- readMVar level' | 166 | currentLevel <- readMVar level' |
135 | mapM_ (\x -> swapMVar level' (asFloat (linInt x) currentLevel newLevel) >> threadDelay delay) ([0,recip frames..1] :: [Float]) | 167 | mapM_ (\x -> swapMVar level' (linInt' x currentLevel newLevel) >> threadDelay delay) ([0,recip frames..1] :: [Float]) |
136 | let withFiles = foldl (.) id $ map (\f -> onStateFile f (show initialLevel ++ "\n")) levelFiles | 168 | let withFiles = foldl (.) id $ map (\f -> onStateFile f (show initialLevel ++ "\n")) levelFiles |
137 | withFiles $ withINotify $ \inotify -> do | 169 | withFiles $ withINotify $ \inotify -> do |
138 | handleFiles inotify level levelFiles | 170 | handleFiles inotify level levelFiles |
171 | handleFiles inotify balance levelFiles | ||
139 | Jack.handleExceptions $ | 172 | Jack.handleExceptions $ |
140 | Jack.withClientDefault client $ \client' -> | 173 | Jack.withClientDefault client $ \client' -> |
141 | Jack.withPort client' input $ \input' -> | 174 | Jack.withPort client' input $ \input' -> |
@@ -149,13 +182,14 @@ trivmix Options{..} = do | |||
149 | 182 | ||
150 | mix :: MVar Level -> CFloat -> IO CFloat | 183 | mix :: MVar Level -> CFloat -> IO CFloat |
151 | mix level input = do | 184 | mix level input = do |
185 | notifyWatchdog | ||
152 | level' <- readMVar level | 186 | level' <- readMVar level |
153 | return $ (CFloat $ toFloat level') * input | 187 | return $ (CFloat $ toFloat level') * input |
154 | 188 | ||
155 | handleFiles :: INotify -> MVar Level -> [FilePath] -> IO () | 189 | handleFiles :: (Read l, Show l, Eq l) => INotify -> MVar l -> [FilePath] -> IO () |
156 | handleFiles inotify level files = do | 190 | handleFiles inotify level files = do |
157 | initLevel <- readMVar level | 191 | initLevel <- readMVar level |
158 | levelChanges <- (newChan :: IO (Chan Level)) | 192 | levelChanges <- newChan |
159 | stderrLock <- newEmptyMVar | 193 | stderrLock <- newEmptyMVar |
160 | let | 194 | let |
161 | handleFile file = addWatch inotify watchedAttrs file (const $ readLevel levelChanges level file stderrLock) | 195 | handleFile file = addWatch inotify watchedAttrs file (const $ readLevel levelChanges level file stderrLock) |
@@ -206,7 +240,7 @@ takeWhileM pred (x:xs) = do | |||
206 | False -> do | 240 | False -> do |
207 | return [] | 241 | return [] |
208 | 242 | ||
209 | readLevel :: Chan Level -> MVar Level -> FilePath -> MVar () -> IO () | 243 | readLevel :: (Read l, Show l, Eq l) => Chan l -> MVar l -> FilePath -> MVar () -> IO () |
210 | readLevel levelChan current file stderrLock = catch action handler | 244 | readLevel levelChan current file stderrLock = catch action handler |
211 | where | 245 | where |
212 | action = do | 246 | action = do |
@@ -228,7 +262,7 @@ readLevel levelChan current file stderrLock = catch action handler | |||
228 | then stripSpace' xs | 262 | then stripSpace' xs |
229 | else l | 263 | else l |
230 | 264 | ||
231 | writeLevel :: FilePath -> MVar () -> Level -> IO () | 265 | writeLevel :: Show l => FilePath -> MVar () -> l -> IO () |
232 | writeLevel file stderrLock level = withFileLock file Exclusive $ const $ do | 266 | writeLevel file stderrLock level = withFileLock file Exclusive $ const $ do |
233 | withMVarLock stderrLock $ | 267 | withMVarLock stderrLock $ |
234 | hPutStrLn stderr $ "Writing out level ‘" ++ (show level) ++ "’ to ‘" ++ file ++ "’" | 268 | hPutStrLn stderr $ "Writing out level ‘" ++ (show level) ++ "’ to ‘" ++ file ++ "’" |