diff options
Diffstat (limited to 'trivmix/Trivmix.hs')
-rw-r--r-- | trivmix/Trivmix.hs | 12 |
1 files changed, 8 insertions, 4 deletions
diff --git a/trivmix/Trivmix.hs b/trivmix/Trivmix.hs index ea8bad3..5075693 100644 --- a/trivmix/Trivmix.hs +++ b/trivmix/Trivmix.hs | |||
@@ -45,6 +45,7 @@ import Control.Monad | |||
45 | import Text.Heredoc (str) | 45 | import Text.Heredoc (str) |
46 | 46 | ||
47 | import Refined | 47 | import Refined |
48 | import Data.AEq | ||
48 | 49 | ||
49 | import Data.Scientific | 50 | import Data.Scientific |
50 | import Trivmix.Types | 51 | import Trivmix.Types |
@@ -195,10 +196,10 @@ trivmix Options{..} = do | |||
195 | mulBalance (bToScientific -> b) x = either error id $ asScientific (*) (Lin . either error id $ refine b) x | 196 | mulBalance (bToScientific -> b) x = either error id $ asScientific (*) (Lin . either error id $ refine b) x |
196 | newLevel <- mulBalance <$> readMVar balance <*> readMVar level | 197 | newLevel <- mulBalance <$> readMVar balance <*> readMVar level |
197 | currentLevel <- (\(CFloat f) -> Lin . either error id . refine $ realToFrac f) <$> readMVar level' | 198 | currentLevel <- (\(CFloat f) -> Lin . either error id . refine $ realToFrac f) <$> readMVar level' |
198 | case compare currentLevel newLevel of | 199 | case toCFloat currentLevel ~== toCFloat newLevel of |
199 | EQ -> threadDelay . round $ interval * 1e6 | 200 | True -> threadDelay . round $ interval * 1e6 |
200 | _ -> do | 201 | False -> do |
201 | mapM_ (\x -> (swapMVar level' $! toRealFloat . unrefine . toLin $ linInt' x currentLevel newLevel) >> threadDelay delay) (takeWhile (<= 1) $ iterate (+ recip frames) 0) | 202 | mapM_ (\x -> (swapMVar level' $! toCFloat $ linInt' x currentLevel newLevel) >> threadDelay delay) (takeWhile (<= 1) $ iterate (+ recip frames) 0) |
202 | errorConcurrent $ "Finished smooth transition from ‘" ++ show currentLevel ++ "’ to ‘" ++ show newLevel ++ "’.\n" | 203 | errorConcurrent $ "Finished smooth transition from ‘" ++ show currentLevel ++ "’ to ‘" ++ show newLevel ++ "’.\n" |
203 | notifyReady | 204 | notifyReady |
204 | forever $ threadDelay (round $ watchdogInterval * 1e6) >> notifyWatchdog | 205 | forever $ threadDelay (round $ watchdogInterval * 1e6) >> notifyWatchdog |
@@ -283,3 +284,6 @@ writeLevel :: Show l => FilePath -> l -> IO () | |||
283 | writeLevel file level = withFileLock file Exclusive $ const $ do | 284 | writeLevel file level = withFileLock file Exclusive $ const $ do |
284 | errorConcurrent $ "Writing out level ‘" ++ (show level) ++ "’ to ‘" ++ file ++ "’.\n" | 285 | errorConcurrent $ "Writing out level ‘" ++ (show level) ++ "’ to ‘" ++ file ++ "’.\n" |
285 | writeFile file (show level ++ "\n") | 286 | writeFile file (show level ++ "\n") |
287 | |||
288 | toCFloat :: Level -> CFloat | ||
289 | toCFloat = toRealFloat . unrefine . toLin | ||