never executed always true always false
1 {-# language DataKinds #-}
2 {-# language Rank2Types #-}
3 {-# language TypeFamilies #-}
4 {-# language ScopedTypeVariables #-}
5 {-# language FlexibleContexts #-}
6 {-# language ViewPatterns #-}
7 {-# language ExistentialQuantification #-}
8
9 -- TODO (basvandijk): upstream the Storable instances to JuicyPixels!
10 {-# OPTIONS_GHC -fno-warn-orphans #-}
11
12 -- | A thin JuicyPixels layer.
13 module OpenCV.Juicy
14 ( -- * Types
15 Mat2D
16 , Filter
17 , PixelChannels
18 , PixelDepth
19
20 -- * Low level API
21 , fromImage
22 , toImage
23
24 -- * High level API
25 , isoJuicy
26 ) where
27
28 import "base" GHC.TypeLits (Nat,KnownNat)
29 import "base" Data.Proxy (Proxy (Proxy))
30 import "base" Foreign.Storable (Storable (..))
31 import "base" Foreign.Ptr (Ptr, plusPtr)
32 import "base" System.IO.Unsafe (unsafePerformIO)
33 import "base" Data.Word (Word8,Word16)
34 import "base" Data.Int (Int32)
35 import "base" Control.Monad (forM_)
36 import "primitive" Control.Monad.Primitive (PrimMonad)
37 import "linear" Linear.V4 (V4)
38 import "this" OpenCV
39 import "this" OpenCV.Unsafe (unsafeRead, unsafeWrite)
40 import "JuicyPixels" Codec.Picture.Types
41
42 -- list of pointers at a given byte distance from a base one
43 plusPtrS :: Ptr a -> Int -> [Ptr b]
44 plusPtrS p n = map (plusPtr p) [0..n-1]
45
46 -- multiple peek
47 peekS :: Storable b => Ptr a -> Int -> IO [b]
48 peekS p n = mapM peek (plusPtrS p n)
49
50 -- multiple poke
51 pokeS :: Storable a => Ptr a1 -> Int -> [a] -> IO ()
52 pokeS p n xs = sequence_ (zipWith poke (plusPtrS p n) xs)
53
54 instance Storable PixelRGB8 where
55 peek p = peekS p 3 >>= \[b,r,g] -> return (PixelRGB8 r g b)
56 poke p (PixelRGB8 r g b) = pokeS p 3 [b,g,r]
57 sizeOf _ = 3
58 alignment _ = 0
59
60 instance Storable PixelRGB16 where
61 peek p = peekS p 3 >>= \[b,r,g] -> return (PixelRGB16 r g b)
62 poke p (PixelRGB16 r g b) = pokeS p 3 [b,g,r]
63 sizeOf _ = 3
64 alignment _ = 0
65
66 instance Storable PixelRGBF where
67 peek p = peekS p 3 >>= \[b,r,g] -> return (PixelRGBF r g b)
68 poke p (PixelRGBF r g b) = pokeS p 3 [b,g,r]
69 sizeOf _ = 3
70 alignment _ = 0
71
72 instance Storable PixelRGBA8 where
73 peek p = peekS p 4 >>= \[b,r,g,a] -> return (PixelRGBA8 r g b a)
74 poke p (PixelRGBA8 r g b a) = pokeS p 4 [b,g,r,a]
75 sizeOf _ = 4
76 alignment _ = 0
77
78 instance Storable PixelRGBA16 where
79 peek p = peekS p 4 >>= \[b,r,g,a] -> return (PixelRGBA16 r g b a)
80 poke p (PixelRGBA16 r g b a) = pokeS p 4 [b,g,r,a]
81 sizeOf _ = 4
82 alignment _ = 0
83
84 instance Storable PixelYA8 where
85 peek p = peekS p 2 >>= \[b,g] -> return (PixelYA8 b g)
86 poke p (PixelYA8 b g) = pokeS p 2 [b,g]
87 sizeOf _ = 2
88 alignment _ = 0
89
90 instance Storable PixelYA16 where
91 peek p = peekS p 2 >>= \[b,g] -> return (PixelYA16 b g)
92 poke p (PixelYA16 b g) = pokeS p 2 [b,g]
93 sizeOf _ = 2
94 alignment _ = 0
95
96 -- | map Pixel types to a depth
97 type family PixelDepth a
98
99 -- | map Pixel types to a number of channels
100 type family PixelChannels a :: Nat
101
102 type instance PixelDepth Pixel8 = Word8
103 type instance PixelDepth Pixel16 = Word16
104 type instance PixelDepth PixelF = Float
105 type instance PixelDepth PixelYA8 = Word8
106 type instance PixelDepth PixelYA16 = Word16
107 type instance PixelDepth PixelRGB8 = Word8
108 type instance PixelDepth PixelRGB16 = Word16
109 type instance PixelDepth PixelRGBF = Float
110 type instance PixelDepth PixelRGBA8 = Word8
111 type instance PixelDepth PixelRGBA16 = Word16
112 type instance PixelDepth PixelYCbCr8 = Word8
113 type instance PixelDepth PixelCMYK8 = Word8
114 type instance PixelDepth PixelCMYK16 = Word16
115
116 type instance PixelChannels Pixel8 = 1
117 type instance PixelChannels Pixel16 = 1
118 type instance PixelChannels PixelF = 1
119 type instance PixelChannels PixelYA8 = 2
120 type instance PixelChannels PixelYA16 = 2
121 type instance PixelChannels PixelRGB8 = 3
122 type instance PixelChannels PixelRGB16 = 3
123 type instance PixelChannels PixelRGBF = 3
124 type instance PixelChannels PixelRGBA8 = 4
125 type instance PixelChannels PixelRGBA16 = 4
126 type instance PixelChannels PixelYCbCr8 = 3
127 type instance PixelChannels PixelCMYK8 = 4
128 type instance PixelChannels PixelCMYK16 = 4
129
130 -- | An OpenCV bidimensional matrix
131 type Mat2D h w channels depth = Mat ('S '[h,w]) channels depth
132
133 {- | Compute an OpenCV 2D-matrix from a JuicyPixels image.
134
135 Example:
136
137 @
138 fromImageImg :: IO (Mat ('S '[ 'D, 'D]) ('S 3) ('S Word8))
139 fromImageImg = do
140 r <- Codec.Picture.readImage "data/Lenna.png"
141 case r of
142 Left err -> error err
143 Right (Codec.Picture.ImageRGB8 img) -> pure $ OpenCV.Juicy.fromImage img
144 Right _ -> error "Unhandled JuicyPixels format!"
145 @
146
147 <<doc/generated/examples/fromImageImg.png fromImageImg>>
148 -}
149 fromImage
150 :: forall a c d
151 . ( ToDepth (Proxy d)
152 , KnownNat c
153 , Pixel a
154 , Storable a
155 , c ~ PixelChannels a
156 , d ~ PixelDepth a
157 )
158 => Image a -- ^ JuicyPixels image
159 -> Mat2D 'D 'D ('S c) ('S d)
160 fromImage i@(Image w h _data) = exceptError $ withMatM
161 (fi h ::: fi w ::: Z)
162 (Proxy :: Proxy c)
163 (Proxy :: Proxy d)
164 (pure 0 :: V4 Double) $ \m ->
165 forM_ ((,) <$> [0 .. h - 1] <*> [0 .. w - 1]) $ \(x,y) ->
166 unsafeWrite m [y,x] 0 (pixelAt i x y)
167 where
168 fi :: Int -> Int32
169 fi = fromIntegral
170
171 {- | Compute a JuicyPixels image from an OpenCV 2D-matrix
172
173 FIXME: There's a bug in the colour conversions in the example:
174
175 Example:
176
177 @
178 toImageImg :: IO (Mat ('S '[ 'D, 'D]) ('S 3) ('S Word8))
179 toImageImg = exceptError . cvtColor rgb bgr . from . to . exceptError . cvtColor bgr rgb \<$> fromImageImg
180 where
181 to :: OpenCV.Juicy.Mat2D 'D 'D ('S 3) ('S Word8) -> Codec.Picture.Image Codec.Picture.PixelRGB8
182 to = OpenCV.Juicy.toImage
183
184 from :: Codec.Picture.Image Codec.Picture.PixelRGB8 -> OpenCV.Juicy.Mat2D 'D 'D ('S 3) ('S Word8)
185 from = OpenCV.Juicy.fromImage
186 @
187
188 <<doc/generated/examples/toImageImg.png toImageImg>>
189 -}
190 toImage
191 :: forall a c d h w.
192 ( KnownNat c
193 , Pixel a
194 , Storable a
195 , c ~ PixelChannels a
196 , d ~ PixelDepth a
197 )
198 => Mat2D h w ('S c) ('S d) -- ^ OpenCV 2D-matrix
199 -> Image a
200 toImage m = unsafePerformIO $ do
201 mat <- unsafeThaw m
202 withImage w h $ \x y -> unsafeRead mat [y, x] 0
203 where
204 MatInfo [fromIntegral -> h, fromIntegral -> w] _ _ = matInfo m
205
206 -- | An OpenCV 2D-filter preserving the matrix type
207 type Filter m h w c d = Mat2D h w c d -> CvExceptT m (Mat2D h w c d)
208
209 -- | Apply an OpenCV 2D-filter to a JuicyPixels dynamic matrix,
210 -- preserving the Juicy pixel encoding
211 isoJuicy
212 :: forall m. (PrimMonad m)
213 => (forall c d h w. Filter m h w c d) -- ^ OpenCV 2D-filter
214 -> DynamicImage -- ^ JuicyPixels dynamic image
215 -> CvExceptT m DynamicImage
216 isoJuicy f (ImageRGB8 i) = ImageRGB8 <$> isoApply f i
217 isoJuicy f (ImageRGB16 i) = ImageRGB16 <$> isoApply f i
218 isoJuicy f (ImageRGBF i) = ImageRGBF <$> isoApply f i
219 isoJuicy f (ImageY8 i) = ImageY8 <$> isoApply f i
220 isoJuicy f (ImageY16 i) = ImageY16 <$> isoApply f i
221 isoJuicy f (ImageRGBA8 i) = ImageRGBA8 <$> isoApply f i
222 isoJuicy f (ImageRGBA16 i) = ImageRGBA16 <$> isoApply f i
223 isoJuicy _ _ = error
224 "Unhandled conversion from DynamicImage to Mat"
225
226 isoApply
227 :: forall f inPixel outPixel
228 . ( Functor f
229 , KnownNat (PixelChannels inPixel)
230 , KnownNat (PixelChannels outPixel)
231 , Storable inPixel
232 , Storable outPixel
233 , ToDepth (Proxy (PixelDepth inPixel))
234 , Pixel inPixel
235 , Pixel outPixel
236 )
237 => ( Mat2D 'D 'D ('S (PixelChannels inPixel)) ('S (PixelDepth inPixel))
238 -> f (Mat2D 'D 'D ('S (PixelChannels outPixel)) ('S (PixelDepth outPixel)))
239 )
240 -> ( Image inPixel
241 -> f (Image outPixel)
242 )
243 isoApply f = fmap toImage . f . fromImage