never executed always true always false
1 {-# language CPP #-}
2 {-# language QuasiQuotes #-}
3 {-# language TemplateHaskell #-}
4 {-# language UndecidableInstances #-}
5
6 #ifndef ENABLE_INTERNAL_DOCUMENTATION
7 {-# OPTIONS_HADDOCK hide #-}
8 #endif
9
10 module OpenCV.Internal.Core.Types.Mat.ToFrom
11 ( MatShape
12 , MatChannels
13 , MatDepth
14 , ToMat(..)
15 , FromMat(..)
16 ) where
17
18 import "base" Data.Proxy ( Proxy(..) )
19 import "base" Foreign.Storable ( Storable )
20 import "base" GHC.TypeLits
21 import "base" System.IO.Unsafe ( unsafePerformIO )
22 import qualified "inline-c" Language.C.Inline as C
23 import qualified "inline-c" Language.C.Inline.Unsafe as CU
24 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
25 import "linear" Linear.Matrix ( M23, M33 )
26 import "linear" Linear.V2 ( V2(..) )
27 import "linear" Linear.V3 ( V3(..) )
28 import "linear" Linear.V4 ( V4 )
29 import qualified "repa" Data.Array.Repa as Repa
30 import "this" OpenCV.Core.Types.Matx
31 import "this" OpenCV.Core.Types.Mat.Repa
32 import "this" OpenCV.Core.Types.Vec
33 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
34 import "this" OpenCV.Internal.C.Types
35 import "this" OpenCV.Internal.Core.Types.Mat
36 import "this" OpenCV.Internal.Exception
37 import "this" OpenCV.TypeLevel
38 import "this" OpenCV.Unsafe
39
40
41 --------------------------------------------------------------------------------
42
43 C.context openCvCtx
44
45 C.include "opencv2/core.hpp"
46 C.include "haskell_opencv_matx_typedefs.hpp"
47 C.using "namespace cv"
48
49 --------------------------------------------------------------------------------
50
51 type family MatShape (a :: *) :: DS [DS Nat]
52 type family MatChannels (a :: *) :: DS Nat
53 type family MatDepth (a :: *) :: DS *
54
55 type instance MatShape (Mat shape channels depth) = shape
56 type instance MatChannels (Mat shape channels depth) = channels
57 type instance MatDepth (Mat shape channels depth) = depth
58
59 type instance MatShape (Matx m n depth) = ShapeT '[m, n]
60 type instance MatChannels (Matx m n depth) = 'S 1
61 type instance MatDepth (Matx m n depth) = 'S depth
62
63 type instance MatShape (Vec dim depth) = ShapeT '[dim]
64 type instance MatChannels (Vec dim depth) = 'S 1
65 type instance MatDepth (Vec dim depth) = 'S depth
66
67 type instance MatShape (M23 depth) = ShapeT [2, 3]
68 type instance MatChannels (M23 depth) = 'S 1
69 type instance MatDepth (M23 depth) = 'S depth
70
71 type instance MatShape (M33 depth) = ShapeT [3, 3]
72 type instance MatChannels (M33 depth) = 'S 1
73 type instance MatDepth (M33 depth) = 'S depth
74
75 class ToMat a where
76 toMat :: a -> Mat (MatShape a) (MatChannels a) (MatDepth a)
77
78 class FromMat a where
79 fromMat :: Mat (MatShape a) (MatChannels a) (MatDepth a) -> a
80
81 instance ToMat (Mat shape channels depth) where toMat = id
82 instance FromMat (Mat shape channels depth) where fromMat = id
83
84 --------------------------------------------------------------------------------
85 -- Matx instances
86
87 #define MATX_TO_MAT(NAME) \
88 instance ToMat NAME where { \
89 toMat matx = unsafePerformIO $ fromPtr $ \
90 withPtr matx $ \matxPtr -> \
91 [CU.exp| Mat * { \
92 new cv::Mat(*$(NAME * matxPtr), false) \
93 }|]; \
94 };
95
96 MATX_TO_MAT(Matx12f)
97 MATX_TO_MAT(Matx12d)
98 MATX_TO_MAT(Matx13f)
99 MATX_TO_MAT(Matx13d)
100 MATX_TO_MAT(Matx14f)
101 MATX_TO_MAT(Matx14d)
102 MATX_TO_MAT(Matx16f)
103 MATX_TO_MAT(Matx16d)
104 MATX_TO_MAT(Matx21f)
105 MATX_TO_MAT(Matx21d)
106 MATX_TO_MAT(Matx22f)
107 MATX_TO_MAT(Matx22d)
108 MATX_TO_MAT(Matx23f)
109 MATX_TO_MAT(Matx23d)
110 MATX_TO_MAT(Matx31f)
111 MATX_TO_MAT(Matx31d)
112 MATX_TO_MAT(Matx32f)
113 MATX_TO_MAT(Matx32d)
114 MATX_TO_MAT(Matx33f)
115 MATX_TO_MAT(Matx33d)
116 MATX_TO_MAT(Matx34f)
117 MATX_TO_MAT(Matx34d)
118 MATX_TO_MAT(Matx41f)
119 MATX_TO_MAT(Matx41d)
120 MATX_TO_MAT(Matx43f)
121 MATX_TO_MAT(Matx43d)
122 MATX_TO_MAT(Matx44f)
123 MATX_TO_MAT(Matx44d)
124 MATX_TO_MAT(Matx51f)
125 MATX_TO_MAT(Matx51d)
126 MATX_TO_MAT(Matx61f)
127 MATX_TO_MAT(Matx61d)
128 MATX_TO_MAT(Matx66f)
129 MATX_TO_MAT(Matx66d)
130
131 --------------------------------------------------------------------------------
132 -- Vec instances
133
134 #define VEC_TO_MAT(NAME) \
135 instance ToMat NAME where { \
136 toMat vec = unsafePerformIO $ fromPtr $ \
137 withPtr vec $ \vecPtr -> \
138 [CU.exp| Mat * { \
139 new cv::Mat(*$(NAME * vecPtr), false) \
140 }|]; \
141 };
142
143 VEC_TO_MAT(Vec2i)
144 VEC_TO_MAT(Vec2f)
145 VEC_TO_MAT(Vec2d)
146 VEC_TO_MAT(Vec3i)
147 VEC_TO_MAT(Vec3f)
148 VEC_TO_MAT(Vec3d)
149 VEC_TO_MAT(Vec4i)
150 VEC_TO_MAT(Vec4f)
151 VEC_TO_MAT(Vec4d)
152
153 --------------------------------------------------------------------------------
154 -- Linear instances
155
156 instance (Storable depth) => FromMat (M23 depth) where
157 fromMat = repaToM23 . toRepa
158
159 instance (Storable depth) => FromMat (M33 depth) where
160 fromMat = repaToM33 . toRepa
161
162 repaToM23 :: (Storable e) => Repa.Array (M '[ 'S 2, 'S 3 ] 1) Repa.DIM3 e -> M23 e
163 repaToM23 a =
164 V2 (V3 (i 0 0) (i 0 1) (i 0 2))
165 (V3 (i 1 0) (i 1 1) (i 1 2))
166 where
167 i row col = Repa.unsafeIndex a $ Repa.ix3 0 col row
168
169 repaToM33 :: (Storable e) => Repa.Array (M '[ 'S 3, 'S 3 ] 1) Repa.DIM3 e -> M33 e
170 repaToM33 a =
171 V3 (V3 (i 0 0) (i 0 1) (i 0 2))
172 (V3 (i 1 0) (i 1 1) (i 1 2))
173 (V3 (i 2 0) (i 2 1) (i 2 2))
174 where
175 i row col = Repa.unsafeIndex a $ Repa.ix3 0 col row
176
177 instance (ToDepth (Proxy depth), Storable depth)
178 => ToMat (M23 depth) where
179 toMat (V2 (V3 i00 i01 i02)
180 (V3 i10 i11 i12)
181 ) =
182 exceptError $ withMatM
183 (Proxy :: Proxy [2, 3])
184 (Proxy :: Proxy 1)
185 (Proxy :: Proxy depth)
186 (pure 0 :: V4 Double) $ \imgM -> do
187 unsafeWrite imgM [0, 0] 0 i00
188 unsafeWrite imgM [1, 0] 0 i10
189 unsafeWrite imgM [0, 1] 0 i01
190 unsafeWrite imgM [1, 1] 0 i11
191 unsafeWrite imgM [0, 2] 0 i02
192 unsafeWrite imgM [1, 2] 0 i12
193
194 instance (ToDepth (Proxy depth), Storable depth)
195 => ToMat (M33 depth) where
196 toMat (V3 (V3 i00 i01 i02)
197 (V3 i10 i11 i12)
198 (V3 i20 i21 i22)
199 ) =
200 exceptError $ withMatM
201 (Proxy :: Proxy [3, 3])
202 (Proxy :: Proxy 1)
203 (Proxy :: Proxy depth)
204 (pure 0 :: V4 Double) $ \imgM -> do
205 unsafeWrite imgM [0, 0] 0 i00
206 unsafeWrite imgM [1, 0] 0 i10
207 unsafeWrite imgM [2, 0] 0 i20
208 unsafeWrite imgM [0, 1] 0 i01
209 unsafeWrite imgM [1, 1] 0 i11
210 unsafeWrite imgM [2, 1] 0 i21
211 unsafeWrite imgM [0, 2] 0 i02
212 unsafeWrite imgM [1, 2] 0 i12
213 unsafeWrite imgM [2, 2] 0 i22