diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2018-05-15 19:14:48 +0200 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2018-05-15 19:14:48 +0200 |
commit | e8bd291609192725ea0b40190fd3bd84f0d96920 (patch) | |
tree | fd085b8706c60ea1bf94c7b65a56abe0bab801fd /trivmix | |
parent | a132c54a0cdbc0fd00ad818780ac4e129a33b358 (diff) | |
download | trivmix-e8bd291609192725ea0b40190fd3bd84f0d96920.tar trivmix-e8bd291609192725ea0b40190fd3bd84f0d96920.tar.gz trivmix-e8bd291609192725ea0b40190fd3bd84f0d96920.tar.bz2 trivmix-e8bd291609192725ea0b40190fd3bd84f0d96920.tar.xz trivmix-e8bd291609192725ea0b40190fd3bd84f0d96920.zip |
…
Diffstat (limited to 'trivmix')
-rw-r--r-- | trivmix/Trivmix.hs | 11 |
1 files changed, 6 insertions, 5 deletions
diff --git a/trivmix/Trivmix.hs b/trivmix/Trivmix.hs index 41a1046..b2d87ec 100644 --- a/trivmix/Trivmix.hs +++ b/trivmix/Trivmix.hs | |||
@@ -162,9 +162,9 @@ main = execParser opts >>= trivmix | |||
162 | 162 | ||
163 | trivmix :: Options -> IO () | 163 | trivmix :: Options -> IO () |
164 | trivmix Options{..} = do | 164 | trivmix Options{..} = do |
165 | level <- newMVar 0 | 165 | level <- newMVar initialLevel |
166 | balance <- newMVar initialBalance | 166 | balance <- newMVar initialBalance |
167 | level' <- newMVar initialLevel | 167 | level' <- newMVar 0 |
168 | 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 |
169 | ++ map (\f -> onStateFile f (show initialBalance ++ "\n")) balanceFiles | 169 | ++ map (\f -> onStateFile f (show initialBalance ++ "\n")) balanceFiles |
170 | withFiles $ withINotify $ \inotify -> do | 170 | withFiles $ withINotify $ \inotify -> do |
@@ -178,17 +178,18 @@ trivmix Options{..} = do | |||
178 | Jack.withActivation client' . Trans.lift $ do | 178 | Jack.withActivation client' . Trans.lift $ do |
179 | forM_ run $ \script -> | 179 | forM_ run $ \script -> |
180 | (callProcess script [client ++ ":" ++ input, client ++ ":" ++ output]) `catch` (\code -> hPutStrLn stderr $ script ++ " failed: " ++ show (code :: ExitCode)) | 180 | (callProcess script [client ++ ":" ++ input, client ++ ":" ++ output]) `catch` (\code -> hPutStrLn stderr $ script ++ " failed: " ++ show (code :: ExitCode)) |
181 | notifyReady | 181 | forkIO . forever $ do -- Smooth out discontinuity |
182 | forever $ do -- Smooth out discontinuity | ||
183 | let | 182 | let |
184 | frames = interval * fps | 183 | frames = interval * fps |
185 | delay = round $ recip fps * 1e6 | 184 | delay = round $ recip fps * 1e6 |
186 | linInt x a b = a * (1 - x) + b * x | 185 | linInt x a b = a * (1 - x) + b * x |
187 | linInt' x a b = either (const 0) id $ asFloat (linInt x) a b | 186 | linInt' x a b = either error id $ asFloat (linInt x) a b |
188 | mulBalance (bToFloat -> b) x = either error id $ asFloat (*) (Lin . either error id $ refine b) x | 187 | mulBalance (bToFloat -> b) x = either error id $ asFloat (*) (Lin . either error id $ refine b) x |
189 | newLevel <- mulBalance <$> readMVar balance <*> readMVar level | 188 | newLevel <- mulBalance <$> readMVar balance <*> readMVar level |
190 | currentLevel <- readMVar level' | 189 | currentLevel <- readMVar level' |
191 | mapM_ (\x -> swapMVar level' (linInt' x currentLevel newLevel) >> threadDelay delay) [0,recip frames..1] | 190 | mapM_ (\x -> swapMVar level' (linInt' x currentLevel newLevel) >> threadDelay delay) [0,recip frames..1] |
191 | notifyReady | ||
192 | forever $ threadDelay 1000000 >> notifyWatchdog | ||
192 | 193 | ||
193 | mix :: MVar Level -> CFloat -> IO CFloat | 194 | mix :: MVar Level -> CFloat -> IO CFloat |
194 | mix level input = do | 195 | mix level input = do |