summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2015-06-21 18:51:59 +0200
committerGregor Kleen <gkleen@yggdrasil.li>2015-06-21 18:51:59 +0200
commita386491241d272f2bb569d33ee9aa7d073461c62 (patch)
tree540374d95874938424d1c9f858694cf30c60b854 /src
parent1e8ea1b60069bfd3f68550b49929a64d05a5b35c (diff)
downloadtrivmix-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.hs16
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
34import Data.Function 34import Data.Function
35 35
36import Control.Monad 36import Control.Monad
37
38import Data.Fixed
37 39
38import Data.CaseInsensitive ( CI ) 40import Data.CaseInsensitive ( CI )
39import qualified Data.CaseInsensitive as CI 41import qualified Data.CaseInsensitive as CI
@@ -48,14 +50,18 @@ data Options = Options
48 50
49data Level = Lin Float | DB Float 51data Level = Lin Float | DB Float
50 52
51fixedPrecision :: (RealFrac a, Num a) => a -> a -> a 53withPrec :: (Num a, RealFrac a, HasResolution b) => a -> Fixed b
52fixedPrecision p x = (fromInteger $ round $ p' * x) / p' 54withPrec x = withResolution $ \p' -> MkFixed $ toInteger $ round $ x * (fromInteger p')
53 where 55
54 p' = 1 / p 56withType :: (p a -> f a) -> f a
57withType f = f undefined
58
59withResolution :: (HasResolution a) => (Integer -> f a) -> f a
60withResolution f = withType (f . resolution)
55 61
56instance Show Level where 62instance 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