diff options
| -rw-r--r-- | trivmix.cabal | 2 | ||||
| -rw-r--r-- | trivmix.nix | 2 | ||||
| -rw-r--r-- | trivmix/Trivmix.hs | 28 |
3 files changed, 16 insertions, 16 deletions
diff --git a/trivmix.cabal b/trivmix.cabal index e12ea00..aa3ea99 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.1.2 | 5 | version: 3.1.3 |
| 6 | -- synopsis: | 6 | -- synopsis: |
| 7 | -- description: | 7 | -- description: |
| 8 | license: PublicDomain | 8 | license: PublicDomain |
diff --git a/trivmix.nix b/trivmix.nix index 416c55d..22961b0 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.1.2"; | 8 | version = "3.1.3"; |
| 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 2e05b13..825e3fa 100644 --- a/trivmix/Trivmix.hs +++ b/trivmix/Trivmix.hs | |||
| @@ -149,22 +149,11 @@ main = execParser opts >>= trivmix | |||
| 149 | 149 | ||
| 150 | trivmix :: Options -> IO () | 150 | trivmix :: Options -> IO () |
| 151 | trivmix Options{..} = do | 151 | trivmix Options{..} = do |
| 152 | level <- newMVar initialLevel | 152 | level <- newMVar 0 |
| 153 | balance <- newMVar initialBalance | 153 | balance <- newMVar initialBalance |
| 154 | level' <- newMVar initialLevel | 154 | level' <- newMVar initialLevel |
| 155 | forkIO $ forever $ do -- Smooth out discontinuity | ||
| 156 | let | ||
| 157 | fps = 200 | ||
| 158 | interval = 0.2 | ||
| 159 | frames = interval * fps | ||
| 160 | delay = round $ recip fps * 1e6 | ||
| 161 | linInt x a b = a * (1 - x) + b * x | ||
| 162 | linInt' x a b = either error id $ asFloat (linInt x) a b | ||
| 163 | mulBalance (bToFloat -> b) x = either error id $ asFloat (*) (Lin . either error id $ refine b) x | ||
| 164 | newLevel <- mulBalance <$> readMVar balance <*> readMVar level | ||
| 165 | currentLevel <- readMVar level' | ||
| 166 | mapM_ (\x -> swapMVar level' (linInt' x currentLevel newLevel) >> threadDelay delay) ([0,recip frames..1] :: [Float]) | ||
| 167 | let withFiles = foldl (.) id $ map (\f -> onStateFile f (show initialLevel ++ "\n")) levelFiles | 155 | let withFiles = foldl (.) id $ map (\f -> onStateFile f (show initialLevel ++ "\n")) levelFiles |
| 156 | ++ map (\f -> onStateFile b (show initialBalance ++ "\n")) balanceFiles | ||
| 168 | withFiles $ withINotify $ \inotify -> do | 157 | withFiles $ withINotify $ \inotify -> do |
| 169 | handleFiles inotify level levelFiles | 158 | handleFiles inotify level levelFiles |
| 170 | handleFiles inotify balance levelFiles | 159 | handleFiles inotify balance levelFiles |
| @@ -177,7 +166,18 @@ trivmix Options{..} = do | |||
| 177 | forM_ run $ \script -> | 166 | forM_ run $ \script -> |
| 178 | (callProcess script [client ++ ":" ++ input, client ++ ":" ++ output]) `catch` (\code -> hPutStrLn stderr $ script ++ " failed: " ++ show (code :: ExitCode)) | 167 | (callProcess script [client ++ ":" ++ input, client ++ ":" ++ output]) `catch` (\code -> hPutStrLn stderr $ script ++ " failed: " ++ show (code :: ExitCode)) |
| 179 | notifyReady | 168 | notifyReady |
| 180 | forever $ threadDelay 1000000 | 169 | forever $ do -- Smooth out discontinuity |
| 170 | let | ||
| 171 | fps = 200 | ||
| 172 | interval = 0.2 | ||
| 173 | frames = interval * fps | ||
| 174 | delay = round $ recip fps * 1e6 | ||
| 175 | linInt x a b = a * (1 - x) + b * x | ||
| 176 | linInt' x a b = either error id $ asFloat (linInt x) a b | ||
| 177 | mulBalance (bToFloat -> b) x = either error id $ asFloat (*) (Lin . either error id $ refine b) x | ||
| 178 | newLevel <- mulBalance <$> readMVar balance <*> readMVar level | ||
| 179 | currentLevel <- readMVar level' | ||
| 180 | mapM_ (\x -> swapMVar level' (linInt' x currentLevel newLevel) >> threadDelay delay) ([0,recip frames..1] :: [Float]) | ||
| 181 | 181 | ||
| 182 | mix :: MVar Level -> CFloat -> IO CFloat | 182 | mix :: MVar Level -> CFloat -> IO CFloat |
| 183 | mix level input = do | 183 | mix level input = do |
