From 5c320eb3668f153c229fba7b118b20ccffb8734b Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sun, 21 Jun 2015 20:19:49 +0200
Subject: Refined Adjustable Level instance

---
 src/Trivmix/Types.hs | 22 +++++++++++++++++-----
 1 file changed, 17 insertions(+), 5 deletions(-)

(limited to 'src/Trivmix')

diff --git a/src/Trivmix/Types.hs b/src/Trivmix/Types.hs
index 66accdf..01418bf 100644
--- a/src/Trivmix/Types.hs
+++ b/src/Trivmix/Types.hs
@@ -43,18 +43,24 @@ withType f = f undefined
 withResolution :: (HasResolution a) => (Integer -> f a) -> f a
 withResolution f = withType (f . resolution)
 
+linToDb :: Float -> Float
+linToDb x = 10 ** (0.05 * x)
+
+dBToLin :: Float -> Float
+dBToLin x = 20 * (logBase 10 x)
+
 instance Show Level where
   show (Lin x) = show x
   show (DB x) = (show $ (withPrec x' :: Milli)) ++ "dB"
     where
-      x' = 20 * (logBase 10 x)
+      x' = dBToLin x
 
 instance Read Level where
   readsPrec i = map toL . readsPrec i
     where
       toL :: (Float, String) -> (Level, String)
       toL (f, str)
-        | ((==) `on` CI.mk) prec unit = (DB $ 10 ** (0.05 * f), rest)
+        | ((==) `on` CI.mk) prec unit = (DB $ linToDb f, rest)
         | otherwise = (Lin f, str)
         where
           prec = take lU str
@@ -80,9 +86,15 @@ class Adjustable a where
   add :: a -> a -> a
   sub :: a -> a -> a
 
-instance Num a => Adjustable a where
-  add = (+)
-  sub = (-)
+-- instance Num a => Adjustable a where
+--   add = (+)
+--   sub = (-)
+
+instance Adjustable Level where
+  add (DB x) (DB y) = DB $ ((+) `on` linToDb) x y
+  add x y = x + y
+  sub (DB x) (DB y) = DB $ ((-) `on` linToDb) x y
+  sub x y = x - y
 
 doAdjustment :: Adjustable a => a -> Adjustment a -> a
 doAdjustment _ (Set y) = y
-- 
cgit v1.2.3