diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2015-06-21 18:51:59 +0200 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2015-06-21 18:51:59 +0200 |
commit | a386491241d272f2bb569d33ee9aa7d073461c62 (patch) | |
tree | 540374d95874938424d1c9f858694cf30c60b854 /src | |
parent | 1e8ea1b60069bfd3f68550b49929a64d05a5b35c (diff) | |
download | trivmix-a386491241d272f2bb569d33ee9aa7d073461c62.tar trivmix-a386491241d272f2bb569d33ee9aa7d073461c62.tar.gz trivmix-a386491241d272f2bb569d33ee9aa7d073461c62.tar.bz2 trivmix-a386491241d272f2bb569d33ee9aa7d073461c62.tar.xz trivmix-a386491241d272f2bb569d33ee9aa7d073461c62.zip |
Better fixed precision
Diffstat (limited to 'src')
-rw-r--r-- | src/Trivmix.hs | 16 |
1 files changed, 11 insertions, 5 deletions
diff --git a/src/Trivmix.hs b/src/Trivmix.hs index d95ea46..37ecec6 100644 --- a/src/Trivmix.hs +++ b/src/Trivmix.hs | |||
@@ -34,6 +34,8 @@ import Data.Char | |||
34 | import Data.Function | 34 | import Data.Function |
35 | 35 | ||
36 | import Control.Monad | 36 | import Control.Monad |
37 | |||
38 | import Data.Fixed | ||
37 | 39 | ||
38 | import Data.CaseInsensitive ( CI ) | 40 | import Data.CaseInsensitive ( CI ) |
39 | import qualified Data.CaseInsensitive as CI | 41 | import qualified Data.CaseInsensitive as CI |
@@ -48,14 +50,18 @@ data Options = Options | |||
48 | 50 | ||
49 | data Level = Lin Float | DB Float | 51 | data Level = Lin Float | DB Float |
50 | 52 | ||
51 | fixedPrecision :: (RealFrac a, Num a) => a -> a -> a | 53 | withPrec :: (Num a, RealFrac a, HasResolution b) => a -> Fixed b |
52 | fixedPrecision p x = (fromInteger $ round $ p' * x) / p' | 54 | withPrec x = withResolution $ \p' -> MkFixed $ toInteger $ round $ x * (fromInteger p') |
53 | where | 55 | |
54 | p' = 1 / p | 56 | withType :: (p a -> f a) -> f a |
57 | withType f = f undefined | ||
58 | |||
59 | withResolution :: (HasResolution a) => (Integer -> f a) -> f a | ||
60 | withResolution f = withType (f . resolution) | ||
55 | 61 | ||
56 | instance Show Level where | 62 | instance Show Level where |
57 | show (Lin x) = show x | 63 | show (Lin x) = show x |
58 | show (DB x) = (show $ fixedPrecision 1e-3 x') ++ "dB" | 64 | show (DB x) = (show $ (withPrec x' :: Milli)) ++ "dB" |
59 | where | 65 | where |
60 | x' = 20 * (logBase 10 x) | 66 | x' = 20 * (logBase 10 x) |
61 | 67 | ||