summaryrefslogtreecommitdiff
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
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
-rw-r--r--trivmix.cabal2
-rw-r--r--trivmix.nix2
-rw-r--r--trivmix/Trivmix.hs28
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
4name: trivmix 4name: trivmix
5version: 3.1.2 5version: 3.1.3
6-- synopsis: 6-- synopsis:
7-- description: 7-- description:
8license: PublicDomain 8license: 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}:
6mkDerivation { 6mkDerivation {
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
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