diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2018-05-15 16:04:27 +0200 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2018-05-15 16:04:27 +0200 |
commit | 1010c8a31e2b441683f5d8c3905a87d4369e7586 (patch) | |
tree | 191b061e229591e0fa63c9b106538231a1f0cbdf | |
parent | cca9139ed34788e34da599abefd8b2c31cffdeec (diff) | |
download | trivmix-1010c8a31e2b441683f5d8c3905a87d4369e7586.tar trivmix-1010c8a31e2b441683f5d8c3905a87d4369e7586.tar.gz trivmix-1010c8a31e2b441683f5d8c3905a87d4369e7586.tar.bz2 trivmix-1010c8a31e2b441683f5d8c3905a87d4369e7586.tar.xz trivmix-1010c8a31e2b441683f5d8c3905a87d4369e7586.zip |
Smooth out discontinuity from start
-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 |