{-# LANGUAGE BangPatterns
           , GeneralizedNewtypeDeriving
           , TypeFamilies #-}

module Vision.Image.Grey.Type (
      Grey, GreyPixel (..), GreyDelayed
    ) where

import Data.Bits
import Data.Word
import Foreign.Storable (Storable)

import Vision.Image.Class (Pixel (..))
import Vision.Image.Interpolate (Interpolable (..))
import Vision.Image.Type (Manifest, Delayed)

newtype GreyPixel = GreyPixel Word8
    deriving (Eq GreyPixel
GreyPixel
Int -> GreyPixel
GreyPixel -> Bool
GreyPixel -> Int
GreyPixel -> Maybe Int
GreyPixel -> GreyPixel
GreyPixel -> Int -> Bool
GreyPixel -> Int -> GreyPixel
GreyPixel -> GreyPixel -> GreyPixel
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: GreyPixel -> Int
$cpopCount :: GreyPixel -> Int
rotateR :: GreyPixel -> Int -> GreyPixel
$crotateR :: GreyPixel -> Int -> GreyPixel
rotateL :: GreyPixel -> Int -> GreyPixel
$crotateL :: GreyPixel -> Int -> GreyPixel
unsafeShiftR :: GreyPixel -> Int -> GreyPixel
$cunsafeShiftR :: GreyPixel -> Int -> GreyPixel
shiftR :: GreyPixel -> Int -> GreyPixel
$cshiftR :: GreyPixel -> Int -> GreyPixel
unsafeShiftL :: GreyPixel -> Int -> GreyPixel
$cunsafeShiftL :: GreyPixel -> Int -> GreyPixel
shiftL :: GreyPixel -> Int -> GreyPixel
$cshiftL :: GreyPixel -> Int -> GreyPixel
isSigned :: GreyPixel -> Bool
$cisSigned :: GreyPixel -> Bool
bitSize :: GreyPixel -> Int
$cbitSize :: GreyPixel -> Int
bitSizeMaybe :: GreyPixel -> Maybe Int
$cbitSizeMaybe :: GreyPixel -> Maybe Int
testBit :: GreyPixel -> Int -> Bool
$ctestBit :: GreyPixel -> Int -> Bool
complementBit :: GreyPixel -> Int -> GreyPixel
$ccomplementBit :: GreyPixel -> Int -> GreyPixel
clearBit :: GreyPixel -> Int -> GreyPixel
$cclearBit :: GreyPixel -> Int -> GreyPixel
setBit :: GreyPixel -> Int -> GreyPixel
$csetBit :: GreyPixel -> Int -> GreyPixel
bit :: Int -> GreyPixel
$cbit :: Int -> GreyPixel
zeroBits :: GreyPixel
$czeroBits :: GreyPixel
rotate :: GreyPixel -> Int -> GreyPixel
$crotate :: GreyPixel -> Int -> GreyPixel
shift :: GreyPixel -> Int -> GreyPixel
$cshift :: GreyPixel -> Int -> GreyPixel
complement :: GreyPixel -> GreyPixel
$ccomplement :: GreyPixel -> GreyPixel
xor :: GreyPixel -> GreyPixel -> GreyPixel
$cxor :: GreyPixel -> GreyPixel -> GreyPixel
.|. :: GreyPixel -> GreyPixel -> GreyPixel
$c.|. :: GreyPixel -> GreyPixel -> GreyPixel
.&. :: GreyPixel -> GreyPixel -> GreyPixel
$c.&. :: GreyPixel -> GreyPixel -> GreyPixel
Bits, GreyPixel
forall a. a -> a -> Bounded a
maxBound :: GreyPixel
$cmaxBound :: GreyPixel
minBound :: GreyPixel
$cminBound :: GreyPixel
Bounded, Int -> GreyPixel
GreyPixel -> Int
GreyPixel -> [GreyPixel]
GreyPixel -> GreyPixel
GreyPixel -> GreyPixel -> [GreyPixel]
GreyPixel -> GreyPixel -> GreyPixel -> [GreyPixel]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GreyPixel -> GreyPixel -> GreyPixel -> [GreyPixel]
$cenumFromThenTo :: GreyPixel -> GreyPixel -> GreyPixel -> [GreyPixel]
enumFromTo :: GreyPixel -> GreyPixel -> [GreyPixel]
$cenumFromTo :: GreyPixel -> GreyPixel -> [GreyPixel]
enumFromThen :: GreyPixel -> GreyPixel -> [GreyPixel]
$cenumFromThen :: GreyPixel -> GreyPixel -> [GreyPixel]
enumFrom :: GreyPixel -> [GreyPixel]
$cenumFrom :: GreyPixel -> [GreyPixel]
fromEnum :: GreyPixel -> Int
$cfromEnum :: GreyPixel -> Int
toEnum :: Int -> GreyPixel
$ctoEnum :: Int -> GreyPixel
pred :: GreyPixel -> GreyPixel
$cpred :: GreyPixel -> GreyPixel
succ :: GreyPixel -> GreyPixel
$csucc :: GreyPixel -> GreyPixel
Enum, GreyPixel -> GreyPixel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GreyPixel -> GreyPixel -> Bool
$c/= :: GreyPixel -> GreyPixel -> Bool
== :: GreyPixel -> GreyPixel -> Bool
$c== :: GreyPixel -> GreyPixel -> Bool
Eq, Enum GreyPixel
Real GreyPixel
GreyPixel -> Integer
GreyPixel -> GreyPixel -> (GreyPixel, GreyPixel)
GreyPixel -> GreyPixel -> GreyPixel
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: GreyPixel -> Integer
$ctoInteger :: GreyPixel -> Integer
divMod :: GreyPixel -> GreyPixel -> (GreyPixel, GreyPixel)
$cdivMod :: GreyPixel -> GreyPixel -> (GreyPixel, GreyPixel)
quotRem :: GreyPixel -> GreyPixel -> (GreyPixel, GreyPixel)
$cquotRem :: GreyPixel -> GreyPixel -> (GreyPixel, GreyPixel)
mod :: GreyPixel -> GreyPixel -> GreyPixel
$cmod :: GreyPixel -> GreyPixel -> GreyPixel
div :: GreyPixel -> GreyPixel -> GreyPixel
$cdiv :: GreyPixel -> GreyPixel -> GreyPixel
rem :: GreyPixel -> GreyPixel -> GreyPixel
$crem :: GreyPixel -> GreyPixel -> GreyPixel
quot :: GreyPixel -> GreyPixel -> GreyPixel
$cquot :: GreyPixel -> GreyPixel -> GreyPixel
Integral, Integer -> GreyPixel
GreyPixel -> GreyPixel
GreyPixel -> GreyPixel -> GreyPixel
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> GreyPixel
$cfromInteger :: Integer -> GreyPixel
signum :: GreyPixel -> GreyPixel
$csignum :: GreyPixel -> GreyPixel
abs :: GreyPixel -> GreyPixel
$cabs :: GreyPixel -> GreyPixel
negate :: GreyPixel -> GreyPixel
$cnegate :: GreyPixel -> GreyPixel
* :: GreyPixel -> GreyPixel -> GreyPixel
$c* :: GreyPixel -> GreyPixel -> GreyPixel
- :: GreyPixel -> GreyPixel -> GreyPixel
$c- :: GreyPixel -> GreyPixel -> GreyPixel
+ :: GreyPixel -> GreyPixel -> GreyPixel
$c+ :: GreyPixel -> GreyPixel -> GreyPixel
Num, Eq GreyPixel
GreyPixel -> GreyPixel -> Bool
GreyPixel -> GreyPixel -> Ordering
GreyPixel -> GreyPixel -> GreyPixel
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 :: GreyPixel -> GreyPixel -> GreyPixel
$cmin :: GreyPixel -> GreyPixel -> GreyPixel
max :: GreyPixel -> GreyPixel -> GreyPixel
$cmax :: GreyPixel -> GreyPixel -> GreyPixel
>= :: GreyPixel -> GreyPixel -> Bool
$c>= :: GreyPixel -> GreyPixel -> Bool
> :: GreyPixel -> GreyPixel -> Bool
$c> :: GreyPixel -> GreyPixel -> Bool
<= :: GreyPixel -> GreyPixel -> Bool
$c<= :: GreyPixel -> GreyPixel -> Bool
< :: GreyPixel -> GreyPixel -> Bool
$c< :: GreyPixel -> GreyPixel -> Bool
compare :: GreyPixel -> GreyPixel -> Ordering
$ccompare :: GreyPixel -> GreyPixel -> Ordering
Ord, Num GreyPixel
Ord GreyPixel
GreyPixel -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: GreyPixel -> Rational
$ctoRational :: GreyPixel -> Rational
Real, ReadPrec [GreyPixel]
ReadPrec GreyPixel
Int -> ReadS GreyPixel
ReadS [GreyPixel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GreyPixel]
$creadListPrec :: ReadPrec [GreyPixel]
readPrec :: ReadPrec GreyPixel
$creadPrec :: ReadPrec GreyPixel
readList :: ReadS [GreyPixel]
$creadList :: ReadS [GreyPixel]
readsPrec :: Int -> ReadS GreyPixel
$creadsPrec :: Int -> ReadS GreyPixel
Read, Int -> GreyPixel -> ShowS
[GreyPixel] -> ShowS
GreyPixel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GreyPixel] -> ShowS
$cshowList :: [GreyPixel] -> ShowS
show :: GreyPixel -> String
$cshow :: GreyPixel -> String
showsPrec :: Int -> GreyPixel -> ShowS
$cshowsPrec :: Int -> GreyPixel -> ShowS
Show
            , Ptr GreyPixel -> IO GreyPixel
Ptr GreyPixel -> Int -> IO GreyPixel
Ptr GreyPixel -> Int -> GreyPixel -> IO ()
Ptr GreyPixel -> GreyPixel -> IO ()
GreyPixel -> Int
forall b. Ptr b -> Int -> IO GreyPixel
forall b. Ptr b -> Int -> GreyPixel -> 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 GreyPixel -> GreyPixel -> IO ()
$cpoke :: Ptr GreyPixel -> GreyPixel -> IO ()
peek :: Ptr GreyPixel -> IO GreyPixel
$cpeek :: Ptr GreyPixel -> IO GreyPixel
pokeByteOff :: forall b. Ptr b -> Int -> GreyPixel -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> GreyPixel -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO GreyPixel
$cpeekByteOff :: forall b. Ptr b -> Int -> IO GreyPixel
pokeElemOff :: Ptr GreyPixel -> Int -> GreyPixel -> IO ()
$cpokeElemOff :: Ptr GreyPixel -> Int -> GreyPixel -> IO ()
peekElemOff :: Ptr GreyPixel -> Int -> IO GreyPixel
$cpeekElemOff :: Ptr GreyPixel -> Int -> IO GreyPixel
alignment :: GreyPixel -> Int
$calignment :: GreyPixel -> Int
sizeOf :: GreyPixel -> Int
$csizeOf :: GreyPixel -> Int
Storable)

type Grey = Manifest GreyPixel

type GreyDelayed = Delayed GreyPixel

instance Pixel GreyPixel where
    type PixelChannel GreyPixel = Word8

    pixNChannels :: GreyPixel -> Int
pixNChannels GreyPixel
_ = Int
1
    {-# INLINE pixNChannels #-}

    pixIndex :: GreyPixel -> Int -> PixelChannel GreyPixel
pixIndex !(GreyPixel Word8
v) Int
_ = Word8
v
    {-# INLINE pixIndex #-}

instance Interpolable GreyPixel where
    interpol :: (PixelChannel GreyPixel
 -> PixelChannel GreyPixel -> PixelChannel GreyPixel)
-> GreyPixel -> GreyPixel -> GreyPixel
interpol PixelChannel GreyPixel
-> PixelChannel GreyPixel -> PixelChannel GreyPixel
f (GreyPixel Word8
a) (GreyPixel Word8
b) = Word8 -> GreyPixel
GreyPixel forall a b. (a -> b) -> a -> b
$ PixelChannel GreyPixel
-> PixelChannel GreyPixel -> PixelChannel GreyPixel
f Word8
a Word8
b
    {-# INLINE interpol #-}