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 | |
| parent | a132c54a0cdbc0fd00ad818780ac4e129a33b358 (diff) | |
| download | trivmix-e8bd291609192725ea0b40190fd3bd84f0d96920.tar trivmix-e8bd291609192725ea0b40190fd3bd84f0d96920.tar.gz trivmix-e8bd291609192725ea0b40190fd3bd84f0d96920.tar.bz2 trivmix-e8bd291609192725ea0b40190fd3bd84f0d96920.tar.xz trivmix-e8bd291609192725ea0b40190fd3bd84f0d96920.zip | |
…
| -rw-r--r-- | trivmix.cabal | 2 | ||||
| -rw-r--r-- | trivmix.nix | 2 | ||||
| -rw-r--r-- | trivmix/Trivmix.hs | 11 |
3 files changed, 8 insertions, 7 deletions
diff --git a/trivmix.cabal b/trivmix.cabal index f5cf777..0cbccdb 100644 --- a/trivmix.cabal +++ b/trivmix.cabal | |||
| @@ -2,7 +2,7 @@ | |||
| 2 | -- documentation, see http://haskell.org/cabal/users-guide/ | 2 | -- documentation, see http://haskell.org/cabal/users-guide/ |
| 3 | 3 | ||
| 4 | name: trivmix | 4 | name: trivmix |
| 5 | version: 3.3.1 | 5 | version: 3.3.2 |
| 6 | -- synopsis: | 6 | -- synopsis: |
| 7 | -- description: | 7 | -- description: |
| 8 | license: PublicDomain | 8 | license: PublicDomain |
diff --git a/trivmix.nix b/trivmix.nix index f5bb6c0..be84746 100644 --- a/trivmix.nix +++ b/trivmix.nix | |||
| @@ -5,7 +5,7 @@ | |||
| 5 | }: | 5 | }: |
| 6 | mkDerivation { | 6 | mkDerivation { |
| 7 | pname = "trivmix"; | 7 | pname = "trivmix"; |
| 8 | version = "3.3.1"; | 8 | version = "3.3.2"; |
| 9 | src = ./.; | 9 | src = ./.; |
| 10 | isLibrary = true; | 10 | isLibrary = true; |
| 11 | isExecutable = true; | 11 | isExecutable = true; |
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 |
