summaryrefslogtreecommitdiff
path: root/trivmix
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2018-05-15 16:04:27 +0200
committerGregor Kleen <gkleen@yggdrasil.li>2018-05-15 16:04:27 +0200
commit1010c8a31e2b441683f5d8c3905a87d4369e7586 (patch)
tree191b061e229591e0fa63c9b106538231a1f0cbdf /trivmix
parentcca9139ed34788e34da599abefd8b2c31cffdeec (diff)
downloadtrivmix-1010c8a31e2b441683f5d8c3905a87d4369e7586.tar
trivmix-1010c8a31e2b441683f5d8c3905a87d4369e7586.tar.gz
trivmix-1010c8a31e2b441683f5d8c3905a87d4369e7586.tar.bz2
trivmix-1010c8a31e2b441683f5d8c3905a87d4369e7586.tar.xz
trivmix-1010c8a31e2b441683f5d8c3905a87d4369e7586.zip
Smooth out discontinuity from start
Diffstat (limited to 'trivmix')
-rw-r--r--trivmix/Trivmix.hs28
1 files changed, 14 insertions, 14 deletions
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
150trivmix :: Options -> IO () 150trivmix :: Options -> IO ()
151trivmix Options{..} = do 151trivmix 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
182mix :: MVar Level -> CFloat -> IO CFloat 182mix :: MVar Level -> CFloat -> IO CFloat
183mix level input = do 183mix level input = do