8000 withMatAsVec: convert Mat to storable vector · LumiGuide/haskell-opencv@2f1cb16 · GitHub
[go: up one dir, main page]

Skip to content

Commit 2f1cb16

Browse files
committed
withMatAsVec: convert Mat to storable vector
1 parent d56bc22 commit 2f1cb16

File tree

3 files changed

+49
-3
lines changed

3 files changed

+49
-3
lines changed

opencv/src/OpenCV/Core/Types/Mat.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ module OpenCV.Core.Types.Mat
2121
, emptyMat
2222
, mkMat
2323
, eyeMat
24+
, withMatAsVec
2425
, cloneMat
2526
, matSubRect
2627
, matCopyTo

opencv/src/OpenCV/Internal/Core/Types/Mat.hs

Lines changed: 35 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -29,9 +29,11 @@ module OpenCV.Internal.Core.Types.Mat
2929
, newEmptyMat
3030
, newMat
3131
, withMatData
32+
, withMatAsVec
3233
, matElemAddress
3334
, mkMat
3435
, cloneMat
36+
, isContinuous
3537

3638
-- * Mutable matrix
3739
, typeCheckMatM
@@ -80,10 +82,12 @@ import "base" Data.Monoid ( (<>) )
8082
import "base" Data.Proxy
8183
import "base" Data.Word
8284
import "base" Foreign.C.Types
83-
import "base" Foreign.ForeignPtr ( ForeignPtr, withForeignPtr, touchForeignPtr )
85+
import "base" Foreign.ForeignPtr
86+
( ForeignPtr, withForeignPtr, touchForeignPtr, newForeignPtr_ )
8487
import "base" Foreign.Marshal.Alloc ( alloca )
8588
import "base" Foreign.Marshal.Array ( allocaArray, peekArray )
86-
import "base" Foreign.Ptr ( Ptr, plusPtr )
89+
import "base" Foreign.Marshal.Utils ( toBool )
90+
import "base" Foreign.Ptr ( Ptr, plusPtr, castPtr )
8791
import "base" Foreign.Storable ( Storable(..), peek )
8892
import "base" GHC.TypeLits
8993
import "base" System.IO.Unsafe ( unsafePerformIO )
@@ -106,6 +110,7 @@ import "this" OpenCV.Internal.Mutable
106110
import "this" OpenCV.TypeLevel
107111
import "transformers" Control.Monad.Trans.Except
108112
import qualified "vector" Data.Vector as V
113+
import qualified "vector" Data.Vector.Storable as VS
109114
import qualified "vector" Data.Vector.Generic as VG
110115

111116
--------------------------------------------------------------------------------
@@ -351,6 +356,29 @@ withMatData mat f = withPtr mat $ \matPtr ->
351356
step <- peekArray (fromIntegral dims) stepPtr
352357
f step dataPtr
353358

359+
-- | Access a Mat's data via a temporary Storable Vector.
360+
--
361+
-- The storable vector may no longer be used after the supplied
362+
-- computation terminates.
363+
withMatAsVec
364+
:: forall a shape channels depth. (Storable depth)
365+
=> Mat shape channels ('S depth)
366+
-> (VS.Vector depth -> IO a)
367+
-- ^ A computation to perform on the vector.
368+
-> IO a
369+
withMatAsVec mat f =
370+
withMatData continuousMat $ \_step dataPtr -> do
371+
foreignDataPtr :: ForeignPtr depth <- newForeignPtr_ $ castPtr dataPtr
372+
f $ VS.unsafeFromForeignPtr0 foreignDataPtr numElems
373+
where
374+
numElems = fromIntegral $ product $ miChannels i : miShape i
375+
where
376+
i = matInfo continuousMat
377+
378+
continuousMat
379+
| isContinuous mat = mat
380+
| otherwise = cloneMat mat
381+
354382
matElemAddress :: Ptr Word8 -> [Int] -> [Int] -> Ptr a
355383
matElemAddress dataPtr step pos = dataPtr `plusPtr` offset
356384
where
@@ -383,6 +411,11 @@ cloneMatIO mat =
383411
fmap unsafeCoerceMat $ fromPtr $ withPtr mat $ \matPtr ->
384412
[C.exp|Mat * { new Mat($(Mat * matPtr)->clone()) }|]
385413

414+
isContinuous :: Mat shape channels depth -> Bool
415+
isContinuous mat = toBool $ unsafePerformIO $
416+
withPtr mat $ \matPtr ->
417+
[CU.exp| bool { $(Mat * matPtr)->isContinuous() } |]
418+
386419
--------------------------------------------------------------------------------
387420
-- Mutable matrix
388421
--------------------------------------------------------------------------------

opencv/test/test.hs

Lines changed: 13 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ import "base" Data.Monoid
1313
import "base" Data.Proxy
1414
import "base" Data.Word
1515
import "base" Data.List.NonEmpty ( nonEmpty )
16-
import "base" Data.Foldable ( for_ )
16+
import "base" Data.Foldable ( for_, toList )
1717
import "base" Foreign.C.Types ( CFloat(..), CDouble(..) )
1818
import "base" Foreign.Storable ( Storable )
1919
import qualified "bytestring" Data.ByteString as B
@@ -39,6 +39,7 @@ import "QuickCheck" Test.QuickCheck ( (==>) )
3939
import "QuickCheck" Test.QuickCheck.Property ( Result(..), failed, succeeded )
4040
import "transformers" Control.Monad.Trans.Except
4141
import qualified "vector" Data.Vector as V
42+
import qualified "vector" Data.Vector.Storable as VS
4243

4344
main :: IO ()
4445
main = defaultMain $ testGroup "opencv"
@@ -106,6 +107,11 @@ main = defaultMain $ testGroup "opencv"
106107
[ HU.testCase "M23 eye" $ testMatToM23 eye23_8u_1c (eye_m23 :: M23 Word8)
107108
, HU.testCase "M33 eye" $ testMatToM33 eye33_8u_1c (eye_m33 :: M33 Word8)
108109
]
110+
, testGroup "withMatAsVec"
111+
[ HU.testCase "eye_m33 Word8" $ testWithMatAsVec (eye_m33 :: M33 Word8)
112+
, HU.testCase "eye_m33 Double" $ testWithMatAsVec (eye_m33 :: M33 Double)
113+
, HU.testCase "1..9 Int16" $ testWithMatAsVec (V3 (V3 1 2 3) (V3 4 5 6) (V3 7 8 9) :: M33 Int16)
114+
]
109115
]
110116
]
111117
]
@@ -430,6 +436,12 @@ testMatToM33
430436
-> HU.Assertion
431437
testMatToM33 m v = assertEqual "" v $ fromMat m
432438

439+
testWithMatAsVec :: (ToMat (M33 a), Storable a, Eq a, Show a) => M33 a -> HU.Assertion
440+
testWithMatAsVec m33 = do
441+
xs <- withMatAsVec (toMat m33) $ \vec ->
442+
pure $ VS.toList vec
443+
assertEqual "" (concatMap toList $ toList m33) xs
444+
433445
getAffineTransformProp :: V3 (V2 CFloat) -> V3 (V2 CFloat) -> Result
434446
getAffineTransformProp v v' =
435447
let transfEither = getAffineTransform v v'

0 commit comments

Comments
 (0)
0