```{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Wumpus.Basic.Kernel.Base.Units
-- Copyright   :  (c) Stephen Tetley 2011
-- License     :  BSD3
--
-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
-- Stability   :  highly unstable
-- Portability :  GHC
--
-- Units @cm@, @pica@ and \"contextual\" units - @em@, @en@.
--
--------------------------------------------------------------------------------

module Wumpus.Basic.Kernel.Base.Units
(

-- * Centimeter
Centimeter
, cm
, dcm

-- * Pica
, Pica
, pica
, dpica

-- * Em
, Em

-- * En
, En

) where

import Wumpus.Basic.Kernel.Base.BaseDefs

import Wumpus.Core                              -- package: wumpus-core

--------------------------------------------------------------------------------

-- | Wrapped Double representing Centimeter.
--
newtype Centimeter = Centimeter { getCentimeter :: Double }
deriving (Eq,Ord,Num,Floating,Fractional,Real,RealFrac,RealFloat)

instance Show Centimeter where
showsPrec p d = showsPrec p (getCentimeter d)

-- | Cast a value in Centimeters to some Fractional type.
--
-- Note - this casting should only be used for non-contextual
-- units such as Double.
--
cm :: Fractional u => Centimeter -> u
cm = realToFrac . (28.45275619 *) . getCentimeter

-- | Convert Double to Centimer.
--
dcm :: Double -> Centimeter
dcm = Centimeter . (0.03514598 *)

instance ScalarUnit Centimeter where
fromPsPoint = dcm
toPsPoint   = cm

instance InterpretUnit Centimeter where
normalize _ = cm
dinterp   _ = dcm

-- | Wrapped Double /Pica/ unit type.
--
-- Pica is 12 Points.
--
newtype Pica = Pica { getPica :: Double }
deriving (Eq,Ord,Num,Floating,Fractional,Real,RealFrac,RealFloat)

instance Show Pica where
showsPrec p d = showsPrec p (getPica d)

-- | Cast a value in Pica to some Fractional type.
--
-- Note - this casting should only be used for non-contextual
-- units such as Double.
--
pica :: Fractional u => Pica -> u
pica = realToFrac . (* 12.0) . getPica

-- | Convert a Double to a Pica.
--
dpica :: Double -> Pica
dpica = Pica . (\x -> x / 12.0)

instance Tolerance Pica where
eq_tolerance     = 0.001
length_tolerance = 0.01

instance ScalarUnit Pica where
fromPsPoint = dpica
toPsPoint   = pica

instance InterpretUnit Pica where
normalize _ = pica
dinterp   _ = dpica

--------------------------------------------------------------------------------
-- Contextual units

-- | Wrapped Double representing an Em.
--
newtype Em = Em { getEm :: Double }
deriving (Eq,Ord,Num,Floating,Fractional,Real,RealFrac,RealFloat)

instance Show Em where
showsPrec p d = showsPrec p (getEm d)

instance InterpretUnit Em where
normalize sz a = fromIntegral sz * realToFrac a
dinterp sz d   = realToFrac d / fromIntegral sz

instance Tolerance Centimeter where
eq_tolerance     = 0.001
length_tolerance = 0.01

-- | Wrapped Double representing an En.
--
newtype En = En { getEn :: Double }
deriving (Eq,Ord,Num,Floating,Fractional,Real,RealFrac,RealFloat)

instance Show En where
showsPrec p d = showsPrec p (getEn d)

instance InterpretUnit En where
normalize sz a = (realToFrac  a) * 0.5 * fromIntegral sz
dinterp sz d   = 2 * (realToFrac d) / (fromIntegral sz)

instance Tolerance Em where
eq_tolerance     = 0.001
length_tolerance = 0.01

instance Tolerance En where
eq_tolerance     = 0.001
length_tolerance = 0.01
```