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