{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Color.Algebra.Binary
( Bit
, zero
, one
, toBool
, fromBool
, toNum
, fromNum
) where
import Data.Bits
import qualified Data.Vector.Generic as V
import qualified Data.Vector.Generic.Mutable as M
import qualified Data.Vector.Unboxed as U
import Foreign.Storable
import Graphics.Color.Algebra.Elevator
import Prelude hiding (map)
newtype Bit = Bit Word8 deriving (Eq Bit
Eq Bit
-> (Bit -> Bit -> Ordering)
-> (Bit -> Bit -> Bool)
-> (Bit -> Bit -> Bool)
-> (Bit -> Bit -> Bool)
-> (Bit -> Bit -> Bool)
-> (Bit -> Bit -> Bit)
-> (Bit -> Bit -> Bit)
-> Ord Bit
Bit -> Bit -> Bool
Bit -> Bit -> Ordering
Bit -> Bit -> Bit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Bit -> Bit -> Bit
$cmin :: Bit -> Bit -> Bit
max :: Bit -> Bit -> Bit
$cmax :: Bit -> Bit -> Bit
>= :: Bit -> Bit -> Bool
$c>= :: Bit -> Bit -> Bool
> :: Bit -> Bit -> Bool
$c> :: Bit -> Bit -> Bool
<= :: Bit -> Bit -> Bool
$c<= :: Bit -> Bit -> Bool
< :: Bit -> Bit -> Bool
$c< :: Bit -> Bit -> Bool
compare :: Bit -> Bit -> Ordering
$ccompare :: Bit -> Bit -> Ordering
$cp1Ord :: Eq Bit
Ord, Bit -> Bit -> Bool
(Bit -> Bit -> Bool) -> (Bit -> Bit -> Bool) -> Eq Bit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bit -> Bit -> Bool
$c/= :: Bit -> Bit -> Bool
== :: Bit -> Bit -> Bool
$c== :: Bit -> Bit -> Bool
Eq, Ptr b -> Int -> IO Bit
Ptr b -> Int -> Bit -> IO ()
Ptr Bit -> IO Bit
Ptr Bit -> Int -> IO Bit
Ptr Bit -> Int -> Bit -> IO ()
Ptr Bit -> Bit -> IO ()
Bit -> Int
(Bit -> Int)
-> (Bit -> Int)
-> (Ptr Bit -> Int -> IO Bit)
-> (Ptr Bit -> Int -> Bit -> IO ())
-> (forall b. Ptr b -> Int -> IO Bit)
-> (forall b. Ptr b -> Int -> Bit -> IO ())
-> (Ptr Bit -> IO Bit)
-> (Ptr Bit -> Bit -> IO ())
-> Storable Bit
forall b. Ptr b -> Int -> IO Bit
forall b. Ptr b -> Int -> Bit -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Bit -> Bit -> IO ()
$cpoke :: Ptr Bit -> Bit -> IO ()
peek :: Ptr Bit -> IO Bit
$cpeek :: Ptr Bit -> IO Bit
pokeByteOff :: Ptr b -> Int -> Bit -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Bit -> IO ()
peekByteOff :: Ptr b -> Int -> IO Bit
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Bit
pokeElemOff :: Ptr Bit -> Int -> Bit -> IO ()
$cpokeElemOff :: Ptr Bit -> Int -> Bit -> IO ()
peekElemOff :: Ptr Bit -> Int -> IO Bit
$cpeekElemOff :: Ptr Bit -> Int -> IO Bit
alignment :: Bit -> Int
$calignment :: Bit -> Int
sizeOf :: Bit -> Int
$csizeOf :: Bit -> Int
Storable)
instance Show Bit where
show :: Bit -> String
show (Bit Word8
0) = String
"0"
show Bit
_ = String
"1"
instance Bits Bit where
(Bit Word8
0) .&. :: Bit -> Bit -> Bit
.&. Bit
_ = Word8 -> Bit
Bit Word8
0
(Bit Word8
1) .&. (Bit Word8
1) = Word8 -> Bit
Bit Word8
1
Bit
_ .&. (Bit Word8
0) = Word8 -> Bit
Bit Word8
0
Bit
_ .&. Bit
_ = Word8 -> Bit
Bit Word8
1
{-# INLINE (.&.) #-}
(Bit Word8
1) .|. :: Bit -> Bit -> Bit
.|. Bit
_ = Word8 -> Bit
Bit Word8
1
(Bit Word8
0) .|. (Bit Word8
0) = Word8 -> Bit
Bit Word8
0
Bit
_ .|. Bit
_ = Word8 -> Bit
Bit Word8
1
{-# INLINE (.|.) #-}
(Bit Word8
0) xor :: Bit -> Bit -> Bit
`xor` (Bit Word8
0) = Word8 -> Bit
Bit Word8
0
(Bit Word8
1) `xor` (Bit Word8
1) = Word8 -> Bit
Bit Word8
0
Bit
_ `xor` Bit
_ = Word8 -> Bit
Bit Word8
1
{-# INLINE xor #-}
complement :: Bit -> Bit
complement (Bit Word8
0) = Word8 -> Bit
Bit Word8
1
complement Bit
_ = Word8 -> Bit
Bit Word8
0
{-# INLINE complement #-}
shift :: Bit -> Int -> Bit
shift !Bit
b Int
0 = Bit
b
shift Bit
_ Int
_ = Word8 -> Bit
Bit Word8
0
{-# INLINE shift #-}
rotate :: Bit -> Int -> Bit
rotate !Bit
b Int
_ = Bit
b
{-# INLINE rotate #-}
zeroBits :: Bit
zeroBits = Word8 -> Bit
Bit Word8
0
{-# INLINE zeroBits #-}
bit :: Int -> Bit
bit Int
0 = Word8 -> Bit
Bit Word8
1
bit Int
_ = Word8 -> Bit
Bit Word8
0
{-# INLINE bit #-}
testBit :: Bit -> Int -> Bool
testBit (Bit Word8
1) Int
0 = Bool
True
testBit Bit
_ Int
_ = Bool
False
{-# INLINE testBit #-}
bitSizeMaybe :: Bit -> Maybe Int
bitSizeMaybe Bit
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
{-# INLINE bitSizeMaybe #-}
bitSize :: Bit -> Int
bitSize Bit
_ = Int
1
{-# INLINE bitSize #-}
isSigned :: Bit -> Bool
isSigned Bit
_ = Bool
False
{-# INLINE isSigned #-}
popCount :: Bit -> Int
popCount (Bit Word8
0) = Int
0
popCount Bit
_ = Int
1
{-# INLINE popCount #-}
toBool :: Bit -> Bool
toBool :: Bit -> Bool
toBool (Bit Word8
0) = Bool
False
toBool Bit
_ = Bool
True
{-# INLINE toBool #-}
fromBool :: Bool -> Bit
fromBool :: Bool -> Bit
fromBool Bool
False = Bit
zero
fromBool Bool
True = Bit
one
{-# INLINE fromBool #-}
toNum :: Num a => Bit -> a
toNum :: Bit -> a
toNum (Bit Word8
0) = a
0
toNum Bit
_ = a
1
{-# INLINE toNum #-}
fromNum :: (Eq a, Num a) => a -> Bit
fromNum :: a -> Bit
fromNum a
0 = Bit
zero
fromNum a
_ = Bit
one
{-# INLINE fromNum #-}
zero :: Bit
zero :: Bit
zero = Word8 -> Bit
Bit Word8
0
{-# INLINE zero #-}
one :: Bit
one :: Bit
one = Word8 -> Bit
Bit Word8
1
{-# INLINE one #-}
instance Elevator Bit where
minValue :: Bit
minValue = Word8 -> Bit
Bit Word8
0
{-# INLINE minValue #-}
maxValue :: Bit
maxValue = Word8 -> Bit
Bit Word8
1
{-# INLINE maxValue #-}
toShowS :: Bit -> ShowS
toShowS (Bit Word8
0) = (Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:)
toShowS Bit
_ = (Char
'1'Char -> ShowS
forall a. a -> [a] -> [a]
:)
toWord8 :: Bit -> Word8
toWord8 (Bit Word8
0) = Word8
0
toWord8 Bit
_ = Word8
forall a. Bounded a => a
maxBound
{-# INLINE toWord8 #-}
toWord16 :: Bit -> Word16
toWord16 (Bit Word8
0) = Word16
0
toWord16 Bit
_ = Word16
forall a. Bounded a => a
maxBound
{-# INLINE toWord16 #-}
toWord32 :: Bit -> Word32
toWord32 (Bit Word8
0) = Word32
0
toWord32 Bit
_ = Word32
forall a. Bounded a => a
maxBound
{-# INLINE toWord32 #-}
toWord64 :: Bit -> Word64
toWord64 (Bit Word8
0) = Word64
0
toWord64 Bit
_ = Word64
forall a. Bounded a => a
maxBound
{-# INLINE toWord64 #-}
toFloat :: Bit -> Float
toFloat (Bit Word8
0) = Float
0
toFloat Bit
_ = Float
1
{-# INLINE toFloat #-}
toRealFloat :: Bit -> a
toRealFloat (Bit Word8
0) = a
0
toRealFloat Bit
_ = a
1
{-# INLINE toRealFloat #-}
fromRealFloat :: a -> Bit
fromRealFloat a
0 = Word8 -> Bit
Bit Word8
0
fromRealFloat a
_ = Word8 -> Bit
Bit Word8
1
{-# INLINE fromRealFloat #-}
// :: Bit -> Bit -> Bit
(//) (Bit Word8
x) (Bit Word8
y) = Word8 -> Bit
Bit (Word8
x Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
`div` Word8
y)
{-# INLINE (//) #-}
instance Num Bit where
+ :: Bit -> Bit -> Bit
(+) = Bit -> Bit -> Bit
forall a. Bits a => a -> a -> a
(.|.)
{-# INLINE (+) #-}
(Bit Word8
0) - :: Bit -> Bit -> Bit
- (Bit Word8
0) = Word8 -> Bit
Bit Word8
0
Bit
_ - (Bit Word8
0) = Word8 -> Bit
Bit Word8
1
Bit
_ - Bit
_ = Word8 -> Bit
Bit Word8
0
{-# INLINE (-) #-}
* :: Bit -> Bit -> Bit
(*) = Bit -> Bit -> Bit
forall a. Bits a => a -> a -> a
(.&.)
{-# INLINE (*) #-}
abs :: Bit -> Bit
abs = Bit -> Bit
forall a. a -> a
id
{-# INLINE abs #-}
signum :: Bit -> Bit
signum = Bit -> Bit
forall a. a -> a
id
{-# INLINE signum #-}
fromInteger :: Integer -> Bit
fromInteger Integer
0 = Word8 -> Bit
Bit Word8
0
fromInteger Integer
_ = Word8 -> Bit
Bit Word8
1
{-# INLINE fromInteger #-}
instance U.Unbox Bit
newtype instance U.MVector s Bit = MV_Bit (U.MVector s Word8)
instance M.MVector U.MVector Bit where
basicLength :: MVector s Bit -> Int
basicLength (MV_Bit mvec) = MVector s Word8 -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
M.basicLength MVector s Word8
mvec
{-# INLINE basicLength #-}
basicUnsafeSlice :: Int -> Int -> MVector s Bit -> MVector s Bit
basicUnsafeSlice Int
idx Int
len (MV_Bit mvec) = MVector s Word8 -> MVector s Bit
forall s. MVector s Word8 -> MVector s Bit
MV_Bit (Int -> Int -> MVector s Word8 -> MVector s Word8
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
M.basicUnsafeSlice Int
idx Int
len MVector s Word8
mvec)
{-# INLINE basicUnsafeSlice #-}
basicOverlaps :: MVector s Bit -> MVector s Bit -> Bool
basicOverlaps (MV_Bit mvec) (MV_Bit mvec') = MVector s Word8 -> MVector s Word8 -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
M.basicOverlaps MVector s Word8
mvec MVector s Word8
mvec'
{-# INLINE basicOverlaps #-}
basicUnsafeNew :: Int -> m (MVector (PrimState m) Bit)
basicUnsafeNew Int
len = MVector (PrimState m) Word8 -> MVector (PrimState m) Bit
forall s. MVector s Word8 -> MVector s Bit
MV_Bit (MVector (PrimState m) Word8 -> MVector (PrimState m) Bit)
-> m (MVector (PrimState m) Word8) -> m (MVector (PrimState m) Bit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) Word8)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
M.basicUnsafeNew Int
len
{-# INLINE basicUnsafeNew #-}
basicUnsafeReplicate :: Int -> Bit -> m (MVector (PrimState m) Bit)
basicUnsafeReplicate Int
len (Bit Word8
w) = MVector (PrimState m) Word8 -> MVector (PrimState m) Bit
forall s. MVector s Word8 -> MVector s Bit
MV_Bit (MVector (PrimState m) Word8 -> MVector (PrimState m) Bit)
-> m (MVector (PrimState m) Word8) -> m (MVector (PrimState m) Bit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Word8 -> m (MVector (PrimState m) Word8)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
M.basicUnsafeReplicate Int
len Word8
w
{-# INLINE basicUnsafeReplicate #-}
basicUnsafeRead :: MVector (PrimState m) Bit -> Int -> m Bit
basicUnsafeRead (MV_Bit mvec) Int
idx = Word8 -> Bit
Bit (Word8 -> Bit) -> m Word8 -> m Bit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) Word8 -> Int -> m Word8
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
M.basicUnsafeRead MVector (PrimState m) Word8
mvec Int
idx
{-# INLINE basicUnsafeRead #-}
basicUnsafeWrite :: MVector (PrimState m) Bit -> Int -> Bit -> m ()
basicUnsafeWrite (MV_Bit mvec) Int
idx (Bit Word8
w) = MVector (PrimState m) Word8 -> Int -> Word8 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
M.basicUnsafeWrite MVector (PrimState m) Word8
mvec Int
idx Word8
w
{-# INLINE basicUnsafeWrite #-}
basicClear :: MVector (PrimState m) Bit -> m ()
basicClear (MV_Bit mvec) = MVector (PrimState m) Word8 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicClear MVector (PrimState m) Word8
mvec
{-# INLINE basicClear #-}
basicSet :: MVector (PrimState m) Bit -> Bit -> m ()
basicSet (MV_Bit mvec) (Bit Word8
w) = MVector (PrimState m) Word8 -> Word8 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
M.basicSet MVector (PrimState m) Word8
mvec Word8
w
{-# INLINE basicSet #-}
basicUnsafeCopy :: MVector (PrimState m) Bit -> MVector (PrimState m) Bit -> m ()
basicUnsafeCopy (MV_Bit mvec) (MV_Bit mvec') = MVector (PrimState m) Word8 -> MVector (PrimState m) Word8 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeCopy MVector (PrimState m) Word8
mvec MVector (PrimState m) Word8
mvec'
{-# INLINE basicUnsafeCopy #-}
basicUnsafeMove :: MVector (PrimState m) Bit -> MVector (PrimState m) Bit -> m ()
basicUnsafeMove (MV_Bit mvec) (MV_Bit mvec') = MVector (PrimState m) Word8 -> MVector (PrimState m) Word8 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
M.basicUnsafeMove MVector (PrimState m) Word8
mvec MVector (PrimState m) Word8
mvec'
{-# INLINE basicUnsafeMove #-}
basicUnsafeGrow :: MVector (PrimState m) Bit -> Int -> m (MVector (PrimState m) Bit)
basicUnsafeGrow (MV_Bit mvec) Int
len = MVector (PrimState m) Word8 -> MVector (PrimState m) Bit
forall s. MVector s Word8 -> MVector s Bit
MV_Bit (MVector (PrimState m) Word8 -> MVector (PrimState m) Bit)
-> m (MVector (PrimState m) Word8) -> m (MVector (PrimState m) Bit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) Word8
-> Int -> m (MVector (PrimState m) Word8)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
M.basicUnsafeGrow MVector (PrimState m) Word8
mvec Int
len
{-# INLINE basicUnsafeGrow #-}
#if MIN_VERSION_vector(0,11,0)
basicInitialize :: MVector (PrimState m) Bit -> m ()
basicInitialize (MV_Bit mvec) = MVector (PrimState m) Word8 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
M.basicInitialize MVector (PrimState m) Word8
mvec
{-# INLINE basicInitialize #-}
#endif
newtype instance U.Vector Bit = V_Bit (U.Vector Word8)
instance V.Vector U.Vector Bit where
basicUnsafeFreeze :: Mutable Vector (PrimState m) Bit -> m (Vector Bit)
basicUnsafeFreeze (MV_Bit mvec) = Vector Word8 -> Vector Bit
V_Bit (Vector Word8 -> Vector Bit) -> m (Vector Word8) -> m (Vector Bit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) Word8 -> m (Vector Word8)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
V.basicUnsafeFreeze MVector (PrimState m) Word8
Mutable Vector (PrimState m) Word8
mvec
{-# INLINE basicUnsafeFreeze #-}
basicUnsafeThaw :: Vector Bit -> m (Mutable Vector (PrimState m) Bit)
basicUnsafeThaw (V_Bit vec) = MVector (PrimState m) Word8 -> MVector (PrimState m) Bit
forall s. MVector s Word8 -> MVector s Bit
MV_Bit (MVector (PrimState m) Word8 -> MVector (PrimState m) Bit)
-> m (MVector (PrimState m) Word8) -> m (MVector (PrimState m) Bit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word8 -> m (Mutable Vector (PrimState m) Word8)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
V.basicUnsafeThaw Vector Word8
vec
{-# INLINE basicUnsafeThaw #-}
basicLength :: Vector Bit -> Int
basicLength (V_Bit vec) = Vector Word8 -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.basicLength Vector Word8
vec
{-# INLINE basicLength #-}
basicUnsafeSlice :: Int -> Int -> Vector Bit -> Vector Bit
basicUnsafeSlice Int
idx Int
len (V_Bit vec) = Vector Word8 -> Vector Bit
V_Bit (Int -> Int -> Vector Word8 -> Vector Word8
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
V.basicUnsafeSlice Int
idx Int
len Vector Word8
vec)
{-# INLINE basicUnsafeSlice #-}
basicUnsafeIndexM :: Vector Bit -> Int -> m Bit
basicUnsafeIndexM (V_Bit vec) Int
idx = Word8 -> Bit
Bit (Word8 -> Bit) -> m Word8 -> m Bit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word8 -> Int -> m Word8
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
V.basicUnsafeIndexM Vector Word8
vec Int
idx
{-# INLINE basicUnsafeIndexM #-}
basicUnsafeCopy :: Mutable Vector (PrimState m) Bit -> Vector Bit -> m ()
basicUnsafeCopy (MV_Bit mvec) (V_Bit vec) = Mutable Vector (PrimState m) Word8 -> Vector Word8 -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
V.basicUnsafeCopy MVector (PrimState m) Word8
Mutable Vector (PrimState m) Word8
mvec Vector Word8
vec
{-# INLINE basicUnsafeCopy #-}
elemseq :: Vector Bit -> Bit -> b -> b
elemseq (V_Bit vec) (Bit Word8
w) = Vector Word8 -> Word8 -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
V.elemseq Vector Word8
vec Word8
w
{-# INLINE elemseq #-}