Skip to content

Commit 6ce76b0

Browse files
nh2nh2
committed
opencv-extra: Make Aruco compile on OpenCV >= 4.7
1 parent 0174f21 commit 6ce76b0

File tree

3 files changed

+221
-12
lines changed

3 files changed

+221
-12
lines changed

‎opencv-extra/Setup.hs

+154-2
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,160 @@
1-
import Distribution.Simple ( defaultMainArgs )
1+
import Distribution.Simple ( defaultMainWithHooksArgs, simpleUserHooks )
22
import System.Environment ( getArgs )
33

4+
5+
-- Source copied from: https://hackage.haskell.org/package/cabal-pkg-config-version-hook-0.1.0.1/docs/src/Distribution.PkgConfigVersionHook.html#addHook
6+
-- TODO: Import this via `setup-depends` instead once it's on Stackage.
7+
8+
import Control.Lens ((%~), (^.))
9+
import Control.Monad (when)
10+
import qualified Data.Char as C
11+
import Data.Foldable (toList)
12+
import Data.Function ((&))
13+
import qualified Data.List as L
14+
import Distribution.Simple (UserHooks (confHook))
15+
import Distribution.Simple.Setup (ConfigFlags, configConfigurationsFlags)
16+
import Distribution.Types.BuildInfo.Lens (ccOptions, cppOptions, cxxOptions)
17+
import Distribution.Types.Flag (flagName, mkFlagAssignment, mkFlagName, unFlagName)
18+
import Distribution.Types.GenericPackageDescription.Lens
19+
( GenericPackageDescription,
20+
condBenchmarks,
21+
condExecutables,
22+
condForeignLibs,
23+
condLibrary,
24+
condSubLibraries,
25+
condTestSuites,
26+
genPackageFlags,
27+
)
28+
import System.IO (hPutStrLn, stderr)
29+
import System.Process (readProcess)
30+
import qualified Text.ParserCombinators.ReadP as P
31+
import Prelude hiding (log)
32+
33+
-- | Hook into Cabal to provide pkg-config metadata. Can be applied multiple
34+
-- times to support multiple packages.
35+
addHook :: Settings -> UserHooks -> UserHooks
36+
addHook settings hooks = hooks {confHook = composeConfHook settings (confHook hooks)}
37+
38+
-- | How the metadata for a pkg-config package should be made available to the
39+
-- cabal file.
40+
data Settings = Settings
41+
{ -- | Name of the package; used for querying pkg-config.
42+
pkgConfigName :: String,
43+
-- | Name to use in the Haskell CPP and C/C++ preprocessor macros.
44+
--
45+
-- For example, `pkgConfigName = "FOO"` will set the macros
46+
--
47+
-- * @FOO_MAJOR@
48+
--
49+
-- * @FOO_MINOR@
50+
--
51+
-- * @FOO_PATCH@
52+
--
53+
-- * @FOO_IS_AT_LEAST(major, minor, patch)@
54+
macroName :: String,
55+
-- | Name to use when setting flag values in the cabal file.
56+
--
57+
-- Flags named with this prefix, followed by a dash, followed by a major version number, an underscore and a minor version number will be set when the detected package is at least that version.
58+
flagPrefixName :: String
59+
}
60+
61+
-- | Derive a default 'Settings' value from just a pkg-config package name.
62+
mkSettings :: String -> Settings
63+
mkSettings name =
64+
Settings
65+
{ pkgConfigName = name,
66+
macroName = map (\c -> case c of '-' -> '_'; x -> x) name,
67+
flagPrefixName = name
68+
}
69+
70+
-- | Extend the value of 'confHook'. It's what powers 'addHook'.
71+
composeConfHook ::
72+
Settings ->
73+
((GenericPackageDescription, a) -> ConfigFlags -> IO b) ->
74+
(GenericPackageDescription, a) ->
75+
Distribution.Simple.Setup.ConfigFlags ->
76+
IO b
77+
composeConfHook settings origHook = \(genericPackageDescription, hookedBuildInfo) confFlags -> do
78+
(actualMajor, actualMinor, actualPatch) <- getPkgConfigPackageVersion (pkgConfigName settings)
79+
80+
let defines =
81+
[ "-D" <> macroName settings <> "_MAJOR=" <> show actualMajor,
82+
"-D" <> macroName settings <> "_MINOR=" <> show actualMinor,
83+
"-D" <> macroName settings <> "_PATCH=" <> show actualPatch,
84+
"-D" <> macroName settings <> "_IS_AT_LEAST(a,b,c)=(" <> show actualMajor <> ">a||(" <> show actualMajor <> "==a&&(" <> show actualMinor <> ">b||(" <> show actualMinor <> "==b&&" <> show actualPatch <> ">=c))))"
85+
]
86+
extraFlags =
87+
[ (mkFlagName (flagPrefixName settings ++ "-" ++ show major ++ "_" ++ show minor), (actualMajor, actualMinor) >= (major, minor))
88+
| declaredFlag <- genericPackageDescription ^. genPackageFlags,
89+
let rawName = unFlagName $ flagName declaredFlag,
90+
rawVersion <- L.stripPrefix (flagPrefixName settings ++ "-") rawName & toList,
91+
[major, minor] <- unambiguously parseFlagVersion rawVersion & toList
92+
]
93+
setDefines comp x =
94+
x
95+
& comp . cppOptions %~ (<> defines)
96+
& comp . ccOptions %~ (<> defines)
97+
& comp . cxxOptions %~ (<> defines)
98+
genericPackageDescription' =
99+
genericPackageDescription
100+
& setDefines (condLibrary . traverse . traverse)
101+
& setDefines (condSubLibraries . traverse . traverse . traverse)
102+
& setDefines (condForeignLibs . traverse . traverse . traverse)
103+
& setDefines (condExecutables . traverse . traverse . traverse)
104+
& setDefines (condTestSuites . traverse . traverse . traverse)
105+
& setDefines (condBenchmarks . traverse . traverse . traverse)
106+
107+
configConfigurationsFlags' = configConfigurationsFlags confFlags `mappend` mkFlagAssignment extraFlags
108+
confFlags' =
109+
confFlags
110+
{ configConfigurationsFlags = configConfigurationsFlags'
111+
}
112+
origHook (genericPackageDescription', hookedBuildInfo) confFlags'
113+
114+
parseVersion :: P.ReadP [Int]
115+
parseVersion = do
116+
map read <$> do
117+
P.many1 (P.satisfy C.isDigit) `P.sepBy` P.char '.'
118+
119+
parseFlagVersion :: P.ReadP [Int]
120+
parseFlagVersion =
121+
map read <$> do
122+
P.many1 (P.satisfy C.isDigit) `P.sepBy` P.char '_'
123+
124+
unambiguously :: P.ReadP a -> String -> Maybe a
125+
unambiguously p s =
126+
case filter (\(_a, x) -> x == "") $ P.readP_to_S p s of
127+
[(v, _)] -> Just v
128+
_ -> Nothing
129+
130+
getPkgConfigPackageVersion :: String -> IO (Int, Int, Int)
131+
getPkgConfigPackageVersion pkgName = do
132+
s <- readProcess "pkg-config" ["--modversion", pkgName] ""
133+
case L.sortOn (\(_, remainder) -> length remainder) $ P.readP_to_S parseVersion s of
134+
[] -> error ("Could not parse version " ++ show s ++ " returned by pkg-config for package " ++ pkgName)
135+
(v, r) : _ -> do
136+
when (L.dropWhile C.isSpace r /= "") $ do
137+
log ("ignoring trailing text " ++ show r ++ " in version " ++ show s ++ " of pkg-config package " ++ pkgName)
138+
let v' = v ++ L.repeat 0
139+
pure (v' L.!! 0, v' L.!! 1, v' L.!! 2)
140+
141+
-- Should probably use a Cabal function?
142+
log :: String -> IO ()
143+
log = hPutStrLn stderr
144+
145+
-- End of source copied from: https://hackage.haskell.org/package/cabal-pkg-config-version-hook
146+
147+
hooks =
148+
simpleUserHooks &
149+
addHook
150+
(mkSettings "opencv4")
151+
{ macroName = "SETUP_HS_OPENCV4_VERSION",
152+
flagPrefixName = "setup-hs-opencv4-version"
153+
}
154+
155+
4156
main = do
5157
args <- getArgs
6158
let args' | "configure" `elem` args = args ++ ["--with-gcc","c++"]
7159
| otherwise = args
8-
defaultMainArgs args'
160+
defaultMainWithHooksArgs hooks args'

‎opencv-extra/opencv-extra.cabal

+5-1
Original file line numberDiff line numberDiff line change
@@ -49,7 +49,11 @@ flag internal-documentation
4949
manual: True
5050

5151
custom-setup
52-
setup-depends: base, Cabal >= 1.23
52+
setup-depends:
53+
base,
54+
Cabal >= 1.23,
55+
lens,
56+
process
5357

5458
library
5559
hs-source-dirs: src

‎opencv-extra/src/OpenCV/Extra/ArUco.hsc

+62-9
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DataKinds, QuasiQuotes, RecordWildCards, TemplateHaskell #-}
2+
{-# LANGUAGE CPP #-}
23

34
module OpenCV.Extra.ArUco
45
( -- * ArUco markers
@@ -68,6 +69,11 @@ C.include "opencv2/core.hpp"
6869
C.include "iostream"
6970
C.include "aruco.hpp"
7071

72+
-- Note [opencv-4.7-aruco-api-change]:
73+
-- OpenCV broke its Aruco API between 4.6 and 4.7.
74+
-- We currently support both versions using CPP `#if`s because
75+
-- both older and newer versions are still popuplar.
76+
7177
C.using "namespace cv"
7278
C.using "namespace cv::aruco"
7379
C.using "namespace std"
@@ -455,18 +461,42 @@ createCharucoBoard squaresX squaresY squareLength markerLength dictionary =
455461
unsafePerformIO $
456462
withPtr dictionary $ \c'dictionary ->
457463
fromPtr $
464+
-- See note [opencv-4.7-aruco-api-change].
465+
--
466+
-- OpenCV < 4.7 uses `CharucoBoard::create()`, newer versions
467+
-- use the `CharucoBoard()` constructor.
468+
--
469+
-- Unfortunately `inline-c` does not support C++ `#if`s, otherwise
470+
-- this could be done a bit simpler via e.g.
471+
-- #if (CV_VERSION_MAJOR <= 4 && CV_VERSION_MINOR < 7)
472+
-- instead of the logic that generates the below macro from
473+
-- our `Setup.hs` hook.
474+
#if SETUP_HS_OPENCV4_VERSION_IS_AT_LEAST(4,7,0)
458475
[C.block| Ptr_CharucoBoard * {
459476
return
460-
new Ptr<CharucoBoard>
461-
( CharucoBoard::create
462-
( $(int c'squaresX)
463-
, $(int c'squaresY)
464-
, $(double c'squareLength)
465-
, $(double c'markerLength)
466-
, *$(Ptr_Dictionary * c'dictionary)
467-
)
468-
);
477+
new Ptr<CharucoBoard>(
478+
new CharucoBoard
479+
( Size( $(int c'squaresX) , $(int c'squaresY) )
480+
, $(float c'squareLength)
481+
, $(float c'markerLength)
482+
, **$(Ptr_Dictionary * c'dictionary)
483+
)
484+
);
485+
}|]
486+
#else
487+
[C.block| Ptr_CharucoBoard * {
488+
return
489+
new Ptr<CharucoBoard>(
490+
CharucoBoard::create
491+
( $(int c'squaresX)
492+
, $(int c'squaresY)
493+
, $(float c'squareLength)
494+
, $(float c'markerLength)
495+
, *$(Ptr_Dictionary * c'dictionary)
496+
)
497+
);
469498
}|]
499+
#endif
470500
where
471501
c'squaresX = fromIntegral squaresX
472502
c'squaresY = fromIntegral squaresY
@@ -539,9 +569,20 @@ getPredefinedDictionary :: PredefinedDictionaryName -> Dictionary
539569
getPredefinedDictionary name =
540570
unsafePerformIO $
541571
fromPtr $
572+
-- See note [opencv-4.7-aruco-api-change].
573+
--
574+
-- In OpenCV < 4.7, `getPredefinedDictionary()` returns a `Ptr<Dictionary>`,
575+
-- in newer versions it returns a `Dictionary`.
576+
#if SETUP_HS_OPENCV4_VERSION_IS_AT_LEAST(4,7,0)
577+
[C.block| Ptr_Dictionary * {
578+
const Dictionary dict = getPredefinedDictionary($(int32_t c'name));
579+
return new Ptr<Dictionary>(makePtr<Dictionary>(dict));
580+
}|]
581+
#else
542582
[C.block| Ptr_Dictionary * {
543583
return new Ptr<Dictionary>(getPredefinedDictionary($(int32_t c'name)));
544584
}|]
585+
#endif
545586
where
546587
c'name :: Int32
547588
c'name = marshalPredefinedDictionaryName name
@@ -578,11 +619,23 @@ drawCharucoBoard charucoBoard width height = unsafePerformIO $ do
578619
dst <- newEmptyMat
579620
withPtr charucoBoard $ \c'board ->
580621
withPtr dst $ \dstPtr ->
622+
-- See note [opencv-4.7-aruco-api-change].
623+
--
624+
-- In OpenCV < 4.7, `draw()` draws the board,
625+
-- in newer versions it's `generateImage()`.
626+
#if SETUP_HS_OPENCV4_VERSION_IS_AT_LEAST(4,7,0)
627+
[C.block| void {
628+
Mat & board = * $(Mat * dstPtr);
629+
Ptr<CharucoBoard> & charucoBoard = *$(Ptr_CharucoBoard * c'board);
630+
charucoBoard->generateImage(cv::Size($(int32_t w), $(int32_t h)), board);
631+
}|]
632+
#else
581633
[C.block| void {
582634
Mat & board = * $(Mat * dstPtr);
583635
Ptr<CharucoBoard> & charucoBoard = *$(Ptr_CharucoBoard * c'board);
584636
charucoBoard->draw(cv::Size($(int32_t w), $(int32_t h)), board);
585637
}|]
638+
#endif
586639
pure (unsafeCoerceMat dst)
587640
where
588641
w = toInt32 width

0 commit comments

Comments
 (0)