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