module Graphics.ColorSpace.Binary (
Bit(..), on, off, isOn, isOff, fromBool, zero, one, bit2bool, bool2bit, toNum, fromNum
) where
import Control.Monad
import Data.Bits
import Data.Typeable (Typeable)
import qualified Data.Vector.Generic as V
import qualified Data.Vector.Generic.Mutable as M
import qualified Data.Vector.Unboxed as U
import Data.Word (Word8)
import Foreign.Ptr
import Foreign.Storable
import Graphics.ColorSpace.Internal
import Graphics.ColorSpace.X
import Prelude hiding (map)
newtype Bit = Bit Word8 deriving (Ord, Eq, Typeable)
instance Show Bit where
show (Bit 0) = "0"
show _ = "1"
instance Bits Bit where
(Bit 0) .&. _ = Bit 0
(Bit 1) .&. (Bit 1) = Bit 1
_ .&. (Bit 0) = Bit 0
_ .&. _ = Bit 1
(Bit 1) .|. _ = Bit 1
(Bit 0) .|. (Bit 0) = Bit 0
_ .|. _ = Bit 1
(Bit 0) `xor` (Bit 0) = Bit 0
(Bit 1) `xor` (Bit 1) = Bit 0
_ `xor` _ = Bit 1
complement (Bit 0) = Bit 1
complement _ = Bit 0
shift !b 0 = b
shift _ _ = Bit 0
rotate !b _ = b
zeroBits = Bit 0
bit 0 = Bit 1
bit _ = Bit 0
testBit (Bit 1) 0 = True
testBit _ _ = False
bitSizeMaybe _ = Just 1
bitSize _ = 1
isSigned _ = False
popCount (Bit 0) = 0
popCount _ = 1
instance Bits (Pixel X Bit) where
(.&.) = liftPx2 (.&.)
(.|.) = liftPx2 (.|.)
xor = liftPx2 xor
complement = liftPx complement
shift !b !n = liftPx (`shift` n) b
rotate !b !n = liftPx (`rotate` n) b
zeroBits = promote zeroBits
bit = promote . bit
testBit (PixelX (Bit 1)) 0 = True
testBit _ _ = False
bitSizeMaybe _ = Just 1
bitSize _ = 1
isSigned _ = False
popCount (PixelX (Bit 0)) = 0
popCount _ = 1
toNum :: Num a => Bit -> a
toNum (Bit 0) = 0
toNum _ = 1
fromNum :: (Eq a, Num a) => a -> Bit
fromNum 0 = zero
fromNum _ = one
zero :: Bit
zero = Bit 0
one :: Bit
one = Bit 1
bool2bit :: Bool -> Bit
bool2bit False = zero
bool2bit True = one
bit2bool :: Bit -> Bool
bit2bool (Bit 0) = False
bit2bool _ = True
on :: Pixel X Bit
on = PixelX one
off :: Pixel X Bit
off = PixelX zero
fromBool :: Bool -> Pixel X Bit
fromBool False = off
fromBool True = on
isOn :: Pixel X Bit -> Bool
isOn (PixelX (Bit 0)) = False
isOn _ = True
isOff :: Pixel X Bit -> Bool
isOff = not . isOn
instance Elevator Bit where
eToWord8 (Bit 0) = 0
eToWord8 _ = maxBound
eToWord16 (Bit 0) = 0
eToWord16 _ = maxBound
eToWord32 (Bit 0) = 0
eToWord32 _ = maxBound
eToWord64 (Bit 0) = 0
eToWord64 _ = maxBound
eToFloat (Bit 0) = 0
eToFloat _ = 1
eToDouble (Bit 0) = 0
eToDouble _ = 1
eFromDouble 0 = Bit 0
eFromDouble _ = Bit 1
instance Num Bit where
(+) = (.|.)
(Bit 0) (Bit 0) = Bit 0
_ (Bit 0) = Bit 1
_ _ = Bit 0
(*) = (.&.)
abs = id
signum = id
fromInteger 0 = Bit 0
fromInteger _ = Bit 1
instance Storable Bit where
sizeOf _ = sizeOf (undefined :: Word8)
alignment _ = alignment (undefined :: Word8)
peek !p = do
q <- return $ castPtr p
b <- peek q
return (Bit b)
poke !p (Bit b) = do
q <- return $ castPtr p
poke q b
instance U.Unbox Bit
newtype instance U.MVector s Bit = MV_Bit (U.MVector s Word8)
instance M.MVector U.MVector Bit where
basicLength (MV_Bit mvec) = M.basicLength mvec
basicUnsafeSlice idx len (MV_Bit mvec) = MV_Bit (M.basicUnsafeSlice idx len mvec)
basicOverlaps (MV_Bit mvec) (MV_Bit mvec') = M.basicOverlaps mvec mvec'
basicUnsafeNew len = MV_Bit `liftM` M.basicUnsafeNew len
basicUnsafeReplicate len (Bit w) = MV_Bit `liftM` M.basicUnsafeReplicate len w
basicUnsafeRead (MV_Bit mvec) idx = Bit `liftM` M.basicUnsafeRead mvec idx
basicUnsafeWrite (MV_Bit mvec) idx (Bit w) = M.basicUnsafeWrite mvec idx w
basicClear (MV_Bit mvec) = M.basicClear mvec
basicSet (MV_Bit mvec) (Bit w) = M.basicSet mvec w
basicUnsafeCopy (MV_Bit mvec) (MV_Bit mvec') = M.basicUnsafeCopy mvec mvec'
basicUnsafeMove (MV_Bit mvec) (MV_Bit mvec') = M.basicUnsafeMove mvec mvec'
basicUnsafeGrow (MV_Bit mvec) len = MV_Bit `liftM` M.basicUnsafeGrow mvec len
#if MIN_VERSION_vector(0,11,0)
basicInitialize (MV_Bit mvec) = M.basicInitialize mvec
#endif
newtype instance U.Vector Bit = V_Bit (U.Vector Word8)
instance V.Vector U.Vector Bit where
basicUnsafeFreeze (MV_Bit mvec) = V_Bit `liftM` V.basicUnsafeFreeze mvec
basicUnsafeThaw (V_Bit vec) = MV_Bit `liftM` V.basicUnsafeThaw vec
basicLength (V_Bit vec) = V.basicLength vec
basicUnsafeSlice idx len (V_Bit vec) = V_Bit (V.basicUnsafeSlice idx len vec)
basicUnsafeIndexM (V_Bit vec) idx = Bit `liftM` V.basicUnsafeIndexM vec idx
basicUnsafeCopy (MV_Bit mvec) (V_Bit vec) = V.basicUnsafeCopy mvec vec
elemseq (V_Bit vec) (Bit w) = V.elemseq vec w