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 | ||
