module Vision.Image.Type (
Pixel (..), MaskedImage (..), Image (..), ImageChannel, FromFunction (..)
, FunctorImage (..)
, Manifest (..)
, Delayed (..)
, DelayedMask (..)
, nChannels, pixel
, Convertible (..), convert, delay, compute
, delayed, manifest
) where
import Control.Applicative ((<$>))
import Data.Convertible (Convertible (..), convert)
import Data.Int
import Data.Vector.Storable (
Vector, (!), create, enumFromN, forM_, generate, unfoldr
)
import Data.Vector.Storable.Mutable (new, write)
import Data.Word
import Foreign.Storable (Storable)
import Prelude hiding (map, read)
import Vision.Primitive (
Z (..), (:.) (..), Point, Size
, ix2, fromLinearIndex, toLinearIndex, shapeLength
)
class Storable p => Pixel p where
type PixelChannel p
pixNChannels :: p -> Int
pixIndex :: p -> Int -> PixelChannel p
instance Pixel Int16 where
type PixelChannel Int16 = Int16
pixNChannels _ = 1
pixIndex p _ = p
instance Pixel Int32 where
type PixelChannel Int32 = Int32
pixNChannels _ = 1
pixIndex p _ = p
instance Pixel Int where
type PixelChannel Int = Int
pixNChannels _ = 1
pixIndex p _ = p
instance Pixel Word8 where
type PixelChannel Word8 = Word8
pixNChannels _ = 1
pixIndex p _ = p
instance Pixel Word16 where
type PixelChannel Word16 = Word16
pixNChannels _ = 1
pixIndex p _ = p
instance Pixel Word32 where
type PixelChannel Word32 = Word32
pixNChannels _ = 1
pixIndex p _ = p
instance Pixel Word where
type PixelChannel Word = Word
pixNChannels _ = 1
pixIndex p _ = p
instance Pixel Float where
type PixelChannel Float = Float
pixNChannels _ = 1
pixIndex p _ = p
instance Pixel Double where
type PixelChannel Double = Double
pixNChannels _ = 1
pixIndex p _ = p
instance Pixel Bool where
type PixelChannel Bool = Bool
pixNChannels _ = 1
pixIndex p _ = p
class Pixel (ImagePixel i) => MaskedImage i where
type ImagePixel i
shape :: i -> Size
maskedIndex :: i -> Point -> Maybe (ImagePixel i)
maskedIndex img = (img `maskedLinearIndex`) . toLinearIndex (shape img)
maskedLinearIndex :: i -> Int -> Maybe (ImagePixel i)
maskedLinearIndex img = (img `maskedIndex`) . fromLinearIndex (shape img)
values :: i -> Vector (ImagePixel i)
values !img =
unfoldr step 0
where
!n = shapeLength (shape img)
step !i | i >= n = Nothing
| Just p <- img `maskedLinearIndex` i = Just (p, i + 1)
| otherwise = step (i + 1)
type ImageChannel i = PixelChannel (ImagePixel i)
class MaskedImage i => Image i where
index :: i -> Point -> ImagePixel i
index img = (img `linearIndex`) . toLinearIndex (shape img)
linearIndex :: i -> Int -> ImagePixel i
linearIndex img = (img `index`) . fromLinearIndex (shape img)
vector :: i -> Vector (ImagePixel i)
vector img = generate (shapeLength $ shape img) (img `linearIndex`)
class FromFunction i where
type FromFunctionPixel i
fromFunction :: Size -> (Point -> FromFunctionPixel i) -> i
fromFunctionLine :: Size -> (Int -> a)
-> (a -> Point -> FromFunctionPixel i) -> i
fromFunctionLine size line f =
fromFunction size (\pt@(Z :. y :. _) -> f (line y) pt)
fromFunctionCol :: Storable b => Size -> (Int -> b)
-> (b -> Point -> FromFunctionPixel i) -> i
fromFunctionCol size col f =
fromFunction size (\pt@(Z :. _ :. x) -> f (col x) pt)
fromFunctionCached :: Storable b => Size
-> (Int -> a)
-> (Int -> b)
-> (a -> b -> Point
-> FromFunctionPixel i)
-> i
fromFunctionCached size line col f =
fromFunction size (\pt@(Z :. y :. x) -> f (line y) (col x) pt)
class (MaskedImage src, MaskedImage res) => FunctorImage src res where
map :: (ImagePixel src -> ImagePixel res) -> src -> res
data Storable p => Manifest p = Manifest {
manifestSize :: !Size
, manifestVector :: !(Vector p)
} deriving (Eq, Ord, Show)
instance Pixel p => MaskedImage (Manifest p) where
type ImagePixel (Manifest p) = p
shape = manifestSize
Manifest _ vec `maskedLinearIndex` ix = Just $! vec ! ix
values = manifestVector
instance Pixel p => Image (Manifest p) where
Manifest _ vec `linearIndex` ix = vec ! ix
vector = manifestVector
instance Storable p => FromFunction (Manifest p) where
type FromFunctionPixel (Manifest p) = p
fromFunction !size@(Z :. h :. w) f =
Manifest size $ create $ do
arr <- new (h * w)
forM_ (enumFromN 0 h) $ \y -> do
let !lineOffset = y * w
forM_ (enumFromN 0 w) $ \x -> do
let !offset = lineOffset + x
!val = f (ix2 y x)
write arr offset val
return arr
fromFunctionLine !size@(Z :. h :. w) line f =
Manifest size $ create $ do
arr <- new (h * w)
forM_ (enumFromN 0 h) $ \y -> do
let !lineVal = line y
!lineOffset = y * w
forM_ (enumFromN 0 w) $ \x -> do
let !offset = lineOffset + x
!val = f lineVal (ix2 y x)
write arr offset val
return arr
fromFunctionCol !size@(Z :. h :. w) col f =
Manifest size $ create $ do
arr <- new (h * w)
forM_ (enumFromN 0 h) $ \y -> do
let !lineOffset = y * w
forM_ (enumFromN 0 w) $ \x -> do
let !offset = lineOffset + x
!val = f (cols ! x) (ix2 y x)
write arr offset val
return arr
where
!cols = generate w col
fromFunctionCached !size@(Z :. h :. w) line col f =
Manifest size $ create $ do
arr <- new (h * w)
forM_ (enumFromN 0 h) $ \y -> do
let !lineVal = line y
!lineOffset = y * w
forM_ (enumFromN 0 w) $ \x -> do
let !offset = lineOffset + x
!val = f lineVal (cols ! x) (ix2 y x)
write arr offset val
return arr
where
!cols = generate w col
instance (Image src, Pixel p) => FunctorImage src (Manifest p) where
map f img = fromFunction (shape img) (f . (img `index`))
data Delayed p = Delayed {
delayedSize :: !Size
, delayedFun :: !(Point -> p)
}
instance Pixel p => MaskedImage (Delayed p) where
type ImagePixel (Delayed p) = p
shape = delayedSize
maskedIndex img = Just . delayedFun img
instance Pixel p => Image (Delayed p) where
index = delayedFun
instance FromFunction (Delayed p) where
type FromFunctionPixel (Delayed p) = p
fromFunction = Delayed
instance (Image src, Pixel p) => FunctorImage src (Delayed p) where
map f img = fromFunction (shape img) (f . (img `index`))
data DelayedMask p = DelayedMask {
delayedMaskSize :: !Size
, delayedMaskFun :: !(Point -> Maybe p)
}
instance Pixel p => MaskedImage (DelayedMask p) where
type ImagePixel (DelayedMask p) = p
shape = delayedMaskSize
maskedIndex = delayedMaskFun
instance Pixel p => FromFunction (DelayedMask p) where
type FromFunctionPixel (DelayedMask p) = Maybe p
fromFunction = DelayedMask
instance (MaskedImage src, Pixel p) => FunctorImage src (DelayedMask p) where
map f img = fromFunction (shape img) (\pt -> f <$> (img `maskedIndex` pt))
nChannels :: MaskedImage i => i -> Int
nChannels img = pixNChannels (pixel img)
pixel :: MaskedImage i => i -> ImagePixel i
pixel _ = undefined
delay :: Image i => i -> Delayed (ImagePixel i)
delay = map id
compute :: (Image i, Storable (ImagePixel i)) => i -> Manifest (ImagePixel i)
compute = map id
instance (Pixel p1, Pixel p2, Storable p1, Storable p2, Convertible p1 p2)
=> Convertible (Manifest p1) (Manifest p2) where
safeConvert = Right . map convert
instance (Pixel p1, Pixel p2, Convertible p1 p2)
=> Convertible (Delayed p1) (Delayed p2) where
safeConvert = Right . map convert
instance (Pixel p1, Pixel p2, Storable p2, Convertible p1 p2)
=> Convertible (Delayed p1) (Manifest p2) where
safeConvert = Right . map convert
instance (Pixel p1, Pixel p2, Storable p1, Convertible p1 p2)
=> Convertible (Manifest p1) (Delayed p2) where
safeConvert = Right . map convert
delayed :: Delayed p -> Delayed p
delayed = id
manifest :: Manifest p -> Manifest p
manifest = id