{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
#endif
module Graphics.ColorSpace.Elevator (
Elevator(..)
, clamp01
) where
import qualified Data.Complex as C
import Data.Int
import Data.Typeable
import Data.Vector.Storable (Storable)
import Data.Vector.Unboxed (Unbox)
import Data.Word
import GHC.Float
class (Eq e, Num e, Typeable e, Unbox e, Storable e) => Elevator e where
eToWord8 :: e -> Word8
eToWord16 :: e -> Word16
eToWord32 :: e -> Word32
eToWord64 :: e -> Word64
eToFloat :: e -> Float
eToDouble :: e -> Double
eFromDouble :: Double -> e
dropDown :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b
dropDown !e = fromIntegral $ fromIntegral e `div` ((maxBound :: a) `div`
fromIntegral (maxBound :: b))
{-# INLINE dropDown #-}
raiseUp :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b
raiseUp !e = fromIntegral e * ((maxBound :: b) `div` fromIntegral (maxBound :: a))
{-# INLINE raiseUp #-}
squashTo1 :: forall a b. (Fractional b, Integral a, Bounded a) => a -> b
squashTo1 !e = fromIntegral e / fromIntegral (maxBound :: a)
{-# INLINE squashTo1 #-}
stretch :: forall a b. (RealFrac a, Floating a, Integral b, Bounded b) => a -> b
stretch !e = round (fromIntegral (maxBound :: b) * clamp01 e)
{-# INLINE stretch #-}
clamp01 :: (Ord a, Floating a) => a -> a
clamp01 !x = min (max 0 x) 1
{-# INLINE clamp01 #-}
instance Elevator Word8 where
eToWord8 = id
{-# INLINE eToWord8 #-}
eToWord16 = raiseUp
{-# INLINE eToWord16 #-}
eToWord32 = raiseUp
{-# INLINE eToWord32 #-}
eToWord64 = raiseUp
{-# INLINE eToWord64 #-}
eToFloat = squashTo1
{-# INLINE eToFloat #-}
eToDouble = squashTo1
{-# INLINE eToDouble #-}
eFromDouble = eToWord8
{-# INLINE eFromDouble #-}
instance Elevator Word16 where
eToWord8 = dropDown
{-# INLINE eToWord8 #-}
eToWord16 = id
{-# INLINE eToWord16 #-}
eToWord32 = raiseUp
{-# INLINE eToWord32 #-}
eToWord64 = raiseUp
{-# INLINE eToWord64 #-}
eToFloat = squashTo1
{-# INLINE eToFloat #-}
eToDouble = squashTo1
{-# INLINE eToDouble #-}
eFromDouble = eToWord16
{-# INLINE eFromDouble #-}
instance Elevator Word32 where
eToWord8 = dropDown
{-# INLINE eToWord8 #-}
eToWord16 = dropDown
{-# INLINE eToWord16 #-}
eToWord32 = id
{-# INLINE eToWord32 #-}
eToWord64 = raiseUp
{-# INLINE eToWord64 #-}
eToFloat = squashTo1
{-# INLINE eToFloat #-}
eToDouble = squashTo1
{-# INLINE eToDouble #-}
eFromDouble = eToWord32
{-# INLINE eFromDouble #-}
instance Elevator Word64 where
eToWord8 = dropDown
{-# INLINE eToWord8 #-}
eToWord16 = dropDown
{-# INLINE eToWord16 #-}
eToWord32 = dropDown
{-# INLINE eToWord32 #-}
eToWord64 = id
{-# INLINE eToWord64 #-}
eToFloat = squashTo1
{-# INLINE eToFloat #-}
eToDouble = squashTo1
{-# INLINE eToDouble #-}
eFromDouble = eToWord64
{-# INLINE eFromDouble #-}
instance Elevator Word where
eToWord8 = dropDown
{-# INLINE eToWord8 #-}
eToWord16 = dropDown
{-# INLINE eToWord16 #-}
eToWord32 = dropDown
{-# INLINE eToWord32 #-}
eToWord64 = fromIntegral
{-# INLINE eToWord64 #-}
eToFloat = squashTo1
{-# INLINE eToFloat #-}
eToDouble = squashTo1
{-# INLINE eToDouble #-}
eFromDouble = stretch . clamp01
{-# INLINE eFromDouble #-}
instance Elevator Int8 where
eToWord8 = fromIntegral . max 0
{-# INLINE eToWord8 #-}
eToWord16 = raiseUp . max 0
{-# INLINE eToWord16 #-}
eToWord32 = raiseUp . max 0
{-# INLINE eToWord32 #-}
eToWord64 = raiseUp . max 0
{-# INLINE eToWord64 #-}
eToFloat = squashTo1 . max 0
{-# INLINE eToFloat #-}
eToDouble = squashTo1 . max 0
{-# INLINE eToDouble #-}
eFromDouble = stretch . clamp01
{-# INLINE eFromDouble #-}
instance Elevator Int16 where
eToWord8 = dropDown . max 0
{-# INLINE eToWord8 #-}
eToWord16 = fromIntegral . max 0
{-# INLINE eToWord16 #-}
eToWord32 = raiseUp . max 0
{-# INLINE eToWord32 #-}
eToWord64 = raiseUp . max 0
{-# INLINE eToWord64 #-}
eToFloat = squashTo1 . max 0
{-# INLINE eToFloat #-}
eToDouble = squashTo1 . max 0
{-# INLINE eToDouble #-}
eFromDouble = stretch . clamp01
{-# INLINE eFromDouble #-}
instance Elevator Int32 where
eToWord8 = dropDown . max 0
{-# INLINE eToWord8 #-}
eToWord16 = dropDown . max 0
{-# INLINE eToWord16 #-}
eToWord32 = fromIntegral . max 0
{-# INLINE eToWord32 #-}
eToWord64 = raiseUp . max 0
{-# INLINE eToWord64 #-}
eToFloat = squashTo1 . max 0
{-# INLINE eToFloat #-}
eToDouble = squashTo1 . max 0
{-# INLINE eToDouble #-}
eFromDouble = stretch . clamp01
{-# INLINE eFromDouble #-}
instance Elevator Int64 where
eToWord8 = dropDown . max 0
{-# INLINE eToWord8 #-}
eToWord16 = dropDown . max 0
{-# INLINE eToWord16 #-}
eToWord32 = dropDown . max 0
{-# INLINE eToWord32 #-}
eToWord64 = fromIntegral . max 0
{-# INLINE eToWord64 #-}
eToFloat = squashTo1 . max 0
{-# INLINE eToFloat #-}
eToDouble = squashTo1 . max 0
{-# INLINE eToDouble #-}
eFromDouble = stretch . clamp01
{-# INLINE eFromDouble #-}
instance Elevator Int where
eToWord8 = dropDown . max 0
{-# INLINE eToWord8 #-}
eToWord16 = dropDown . max 0
{-# INLINE eToWord16 #-}
eToWord32 = dropDown . max 0
{-# INLINE eToWord32 #-}
eToWord64 = fromIntegral . max 0
{-# INLINE eToWord64 #-}
eToFloat = squashTo1 . max 0
{-# INLINE eToFloat #-}
eToDouble = squashTo1 . max 0
{-# INLINE eToDouble #-}
eFromDouble = stretch . clamp01
{-# INLINE eFromDouble #-}
instance Elevator Float where
eToWord8 = stretch . clamp01
{-# INLINE eToWord8 #-}
eToWord16 = stretch . clamp01
{-# INLINE eToWord16 #-}
eToWord32 = stretch . clamp01
{-# INLINE eToWord32 #-}
eToWord64 = stretch . clamp01
{-# INLINE eToWord64 #-}
eToFloat = id
{-# INLINE eToFloat #-}
eToDouble = float2Double
{-# INLINE eToDouble #-}
eFromDouble = eToFloat
{-# INLINE eFromDouble #-}
instance Elevator Double where
eToWord8 = stretch . clamp01
{-# INLINE eToWord8 #-}
eToWord16 = stretch . clamp01
{-# INLINE eToWord16 #-}
eToWord32 = stretch . clamp01
{-# INLINE eToWord32 #-}
eToWord64 = stretch . clamp01
{-# INLINE eToWord64 #-}
eToFloat = double2Float
{-# INLINE eToFloat #-}
eToDouble = id
{-# INLINE eToDouble #-}
eFromDouble = id
{-# INLINE eFromDouble #-}
instance (Num e, Elevator e, RealFloat e) => Elevator (C.Complex e) where
eToWord8 = eToWord8 . C.realPart
{-# INLINE eToWord8 #-}
eToWord16 = eToWord16 . C.realPart
{-# INLINE eToWord16 #-}
eToWord32 = eToWord32 . C.realPart
{-# INLINE eToWord32 #-}
eToWord64 = eToWord64 . C.realPart
{-# INLINE eToWord64 #-}
eToFloat = eToFloat . C.realPart
{-# INLINE eToFloat #-}
eToDouble = eToDouble . C.realPart
{-# INLINE eToDouble #-}
eFromDouble = (C.:+ 0) . eFromDouble
{-# INLINE eFromDouble #-}