{-# LANGUAGE BangPatterns, FlexibleContexts, MultiParamTypeClasses
, TypeFamilies #-}
module Vision.Image.Class (
Pixel (..), MaskedImage (..), Image (..), ImageChannel, FromFunction (..)
, FunctorImage (..)
, (!), (!?), nChannels, pixel
) where
import Data.Int
import Data.Vector.Storable (Vector, generate, unfoldr)
import Data.Word
import Foreign.Storable (Storable)
import Prelude hiding (map, read)
import Vision.Primitive (
Z (..), (:.) (..), Point, Size
, fromLinearIndex, toLinearIndex, shapeLength
)
class Pixel p where
type PixelChannel p
pixNChannels :: p -> Int
pixIndex :: p -> Int -> PixelChannel p
instance Pixel Int16 where
type PixelChannel Int16 = Int16
pixNChannels :: Int16 -> Int
pixNChannels Int16
_ = Int
1
pixIndex :: Int16 -> Int -> PixelChannel Int16
pixIndex Int16
p Int
_ = Int16
p
instance Pixel Int32 where
type PixelChannel Int32 = Int32
pixNChannels :: Int32 -> Int
pixNChannels Int32
_ = Int
1
pixIndex :: Int32 -> Int -> PixelChannel Int32
pixIndex Int32
p Int
_ = Int32
p
instance Pixel Int where
type PixelChannel Int = Int
pixNChannels :: Int -> Int
pixNChannels Int
_ = Int
1
pixIndex :: Int -> Int -> PixelChannel Int
pixIndex Int
p Int
_ = Int
p
instance Pixel Word8 where
type PixelChannel Word8 = Word8
pixNChannels :: Word8 -> Int
pixNChannels Word8
_ = Int
1
pixIndex :: Word8 -> Int -> PixelChannel Word8
pixIndex Word8
p Int
_ = Word8
p
instance Pixel Word16 where
type PixelChannel Word16 = Word16
pixNChannels :: Word16 -> Int
pixNChannels Word16
_ = Int
1
pixIndex :: Word16 -> Int -> PixelChannel Word16
pixIndex Word16
p Int
_ = Word16
p
instance Pixel Word32 where
type PixelChannel Word32 = Word32
pixNChannels :: Word32 -> Int
pixNChannels Word32
_ = Int
1
pixIndex :: Word32 -> Int -> PixelChannel Word32
pixIndex Word32
p Int
_ = Word32
p
instance Pixel Word where
type PixelChannel Word = Word
pixNChannels :: Word -> Int
pixNChannels Word
_ = Int
1
pixIndex :: Word -> Int -> PixelChannel Word
pixIndex Word
p Int
_ = Word
p
instance Pixel Float where
type PixelChannel Float = Float
pixNChannels :: Float -> Int
pixNChannels Float
_ = Int
1
pixIndex :: Float -> Int -> PixelChannel Float
pixIndex Float
p Int
_ = Float
p
instance Pixel Double where
type PixelChannel Double = Double
pixNChannels :: Double -> Int
pixNChannels Double
_ = Int
1
pixIndex :: Double -> Int -> PixelChannel Double
pixIndex Double
p Int
_ = Double
p
instance Pixel Bool where
type PixelChannel Bool = Bool
pixNChannels :: Bool -> Int
pixNChannels Bool
_ = Int
1
pixIndex :: Bool -> Int -> PixelChannel Bool
pixIndex Bool
p Int
_ = Bool
p
class Storable (ImagePixel i) => MaskedImage i where
type ImagePixel i
shape :: i -> Size
maskedIndex :: i -> Point -> Maybe (ImagePixel i)
maskedIndex i
img = (i
img forall i. MaskedImage i => i -> Int -> Maybe (ImagePixel i)
`maskedLinearIndex`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh. Shape sh => sh -> sh -> Int
toLinearIndex (forall i. MaskedImage i => i -> Point
shape i
img)
{-# INLINE maskedIndex #-}
maskedLinearIndex :: i -> Int -> Maybe (ImagePixel i)
maskedLinearIndex i
img = (i
img forall i. MaskedImage i => i -> Point -> Maybe (ImagePixel i)
`maskedIndex`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh. Shape sh => sh -> Int -> sh
fromLinearIndex (forall i. MaskedImage i => i -> Point
shape i
img)
{-# INLINE maskedLinearIndex #-}
values :: i -> Vector (ImagePixel i)
values !i
img =
forall a b. Storable a => (b -> Maybe (a, b)) -> b -> Vector a
unfoldr Int -> Maybe (ImagePixel i, Int)
step Int
0
where
!n :: Int
n = forall sh. Shape sh => sh -> Int
shapeLength (forall i. MaskedImage i => i -> Point
shape i
img)
step :: Int -> Maybe (ImagePixel i, Int)
step !Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n = forall a. Maybe a
Nothing
| Just ImagePixel i
p <- i
img forall i. MaskedImage i => i -> Int -> Maybe (ImagePixel i)
`maskedLinearIndex` Int
i = forall a. a -> Maybe a
Just (ImagePixel i
p, Int
i forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = Int -> Maybe (ImagePixel i, Int)
step (Int
i forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE values #-}
{-# MINIMAL shape, (maskedIndex | maskedLinearIndex) #-}
type ImageChannel i = PixelChannel (ImagePixel i)
class MaskedImage i => Image i where
index :: i -> Point -> ImagePixel i
index i
img = (i
img forall i. Image i => i -> Int -> ImagePixel i
`linearIndex`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh. Shape sh => sh -> sh -> Int
toLinearIndex (forall i. MaskedImage i => i -> Point
shape i
img)
{-# INLINE index #-}
linearIndex :: i -> Int -> ImagePixel i
linearIndex i
img = (i
img forall i. Image i => i -> Point -> ImagePixel i
`index`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh. Shape sh => sh -> Int -> sh
fromLinearIndex (forall i. MaskedImage i => i -> Point
shape i
img)
{-# INLINE linearIndex #-}
vector :: i -> Vector (ImagePixel i)
vector i
img = forall a. Storable a => Int -> (Int -> a) -> Vector a
generate (forall sh. Shape sh => sh -> Int
shapeLength forall a b. (a -> b) -> a -> b
$ forall i. MaskedImage i => i -> Point
shape i
img) (i
img forall i. Image i => i -> Int -> ImagePixel i
`linearIndex`)
{-# INLINE vector #-}
{-# MINIMAL index | linearIndex #-}
class FromFunction i where
type FromFunctionPixel i
fromFunction :: Size -> (Point -> FromFunctionPixel i) -> i
fromFunctionLine :: Size -> (Int -> a)
-> (a -> Point -> FromFunctionPixel i) -> i
fromFunctionLine Point
size Int -> a
line a -> Point -> FromFunctionPixel i
f =
forall i.
FromFunction i =>
Point -> (Point -> FromFunctionPixel i) -> i
fromFunction Point
size (\pt :: Point
pt@(DIM0
Z :. Int
y :. Int
_) -> a -> Point -> FromFunctionPixel i
f (Int -> a
line Int
y) Point
pt)
{-# INLINE fromFunctionLine #-}
fromFunctionCol :: Storable b => Size -> (Int -> b)
-> (b -> Point -> FromFunctionPixel i) -> i
fromFunctionCol Point
size Int -> b
col b -> Point -> FromFunctionPixel i
f =
forall i.
FromFunction i =>
Point -> (Point -> FromFunctionPixel i) -> i
fromFunction Point
size (\pt :: Point
pt@(DIM0
Z :. Int
_ :. Int
x) -> b -> Point -> FromFunctionPixel i
f (Int -> b
col Int
x) Point
pt)
{-# INLINE fromFunctionCol #-}
fromFunctionCached :: Storable b => Size
-> (Int -> a)
-> (Int -> b)
-> (a -> b -> Point
-> FromFunctionPixel i)
-> i
fromFunctionCached Point
size Int -> a
line Int -> b
col a -> b -> Point -> FromFunctionPixel i
f =
forall i.
FromFunction i =>
Point -> (Point -> FromFunctionPixel i) -> i
fromFunction Point
size (\pt :: Point
pt@(DIM0
Z :. Int
y :. Int
x) -> a -> b -> Point -> FromFunctionPixel i
f (Int -> a
line Int
y) (Int -> b
col Int
x) Point
pt)
{-# INLINE fromFunctionCached #-}
{-# MINIMAL fromFunction #-}
class (MaskedImage src, MaskedImage res) => FunctorImage src res where
map :: (ImagePixel src -> ImagePixel res) -> src -> res
(!?) :: MaskedImage i => i -> Point -> Maybe (ImagePixel i)
!? :: forall i. MaskedImage i => i -> Point -> Maybe (ImagePixel i)
(!?) = forall i. MaskedImage i => i -> Point -> Maybe (ImagePixel i)
maskedIndex
{-# INLINE (!?) #-}
(!) :: Image i => i -> Point -> ImagePixel i
! :: forall i. Image i => i -> Point -> ImagePixel i
(!) = forall i. Image i => i -> Point -> ImagePixel i
index
{-# INLINE (!) #-}
nChannels :: (Pixel (ImagePixel i), MaskedImage i) => i -> Int
nChannels :: forall i. (Pixel (ImagePixel i), MaskedImage i) => i -> Int
nChannels i
img = forall p. Pixel p => p -> Int
pixNChannels (forall i. MaskedImage i => i -> ImagePixel i
pixel i
img)
{-# INLINE nChannels #-}
pixel :: MaskedImage i => i -> ImagePixel i
pixel :: forall i. MaskedImage i => i -> ImagePixel i
pixel i
_ = forall a. HasCallStack => a
undefined