diff --git a/HOpenCV.cabal b/HOpenCV.cabal --- a/HOpenCV.cabal +++ b/HOpenCV.cabal @@ -1,11 +1,12 @@ name: HOpenCV -version: 0.1.2.4 -license: BSD3 +version: 0.3 +license: GPL-2 maintainer: Noam Lewis bug-reports: mailto:jones.noamle@gmail.com category: AI, Graphics synopsis: A binding for the OpenCV computer vision library -Tested-With: GHC == 6.10.4, GHC == 7.0.4 +Tested-With: GHC == 7.10.2 +license-file: LICENSE description: Initial version with very limited bindings to OpenCV 2.0. (See: ) . @@ -23,39 +24,52 @@ . You should then have libcv4 and libhighgui4 installed automatically too. . - + build-type: Simple -cabal-version: >= 1.2 +cabal-version: >= 1.6 extra-source-files: src/AI/CV/OpenCV/HOpenCV_wrap.h library exposed-modules: - AI.CV.OpenCV.CV - AI.CV.OpenCV.CxCore - AI.CV.OpenCV.HighGui - AI.CV.OpenCV.Types + AI.CV.OpenCV + AI.CV.OpenCV.Util + AI.CV.OpenCV.CxCore + AI.CV.OpenCV.CV + AI.CV.OpenCV.HighGui + AI.CV.OpenCV.ImgProc + AI.CV.OpenCV.Video +-- AI.CV.OpenCV.Gtk c-sources: src/AI/CV/OpenCV/HOpenCV_wrap.c hs-Source-Dirs: src - include-dirs: /usr/include/opencv pkgconfig-depends: opencv build-depends: base >= 4 && < 5, allocated-processor >= 0.0.1, vector-space ghc-options: -Wall -fno-warn-type-defaults + Ghc-Prof-Options: -Wall -executable test-hopencv +executable cannyVideo c-sources: src/AI/CV/OpenCV/HOpenCV_wrap.c - include-dirs: /usr/include/opencv - hs-source-dirs: src + hs-source-dirs: demo,src Build-Depends: base >= 4 && < 5 - main-is: Test.hs + main-is: cannyVideo.hs Ghc-Options: -Wall -fno-warn-type-defaults - Ghc-Prof-Options: -prof -auto-all + Ghc-Prof-Options: -Wall pkgconfig-depends: opencv - other-modules: AI.CV.OpenCV.CxCore, AI.CV.OpenCV.CV, AI.CV.OpenCV.HighGui, AI.CV.OpenCV.Types + other-modules: AI.CV.OpenCV.CxCore, AI.CV.OpenCV.CV, AI.CV.OpenCV.HighGui +-- executable usingOpenCV_WithGtk +-- c-sources: +-- src/AI/CV/OpenCV/HOpenCV_wrap.c +-- hs-source-dirs: demo,src +-- Build-Depends: base >= 4 && < 5 +-- main-is: usingOpenCV_WithGtk.hs +-- Ghc-Options: -Wall -fno-warn-type-defaults +-- Ghc-Prof-Options: -prof -auto-all +-- pkgconfig-depends: opencv +-- other-modules: AI.CV.OpenCV.CxCore, AI.CV.OpenCV.CV, AI.CV.OpenCV.HighGui, AI.CV.OpenCV.Gtk ---source-repository head --- type: git --- location: git://github.com/sinelaw/HOpenCV.git +source-repository head + type: git + location: git://github.com/sinelaw/HOpenCV.git diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,280 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS diff --git a/demo/cannyVideo.hs b/demo/cannyVideo.hs new file mode 100644 --- /dev/null +++ b/demo/cannyVideo.hs @@ -0,0 +1,24 @@ +module Main where + +import AI.CV.OpenCV +import Control.Monad (when) +import Data.Maybe (isNothing) + +showFrames :: String -> IplImage -> Capture -> IO () +showFrames win target cap = do + frame <- queryFrame cap + convertImage frame target 0 + canny target target 30 190 3 + showImage win target + k <- waitKey 5 + when (isNothing k) $ showFrames win target cap + +main :: IO () +main = do + let win = "win" + namedWindow win autoSize + cap <- createCameraCapture 0 + frame <- queryFrame cap + size <- getSize frame + target <- createImage size iplDepth8u 1 + showFrames win target cap diff --git a/src/AI/CV/OpenCV.hs b/src/AI/CV/OpenCV.hs new file mode 100644 --- /dev/null +++ b/src/AI/CV/OpenCV.hs @@ -0,0 +1,11 @@ +module AI.CV.OpenCV + ( module AI.CV.OpenCV.CxCore + , module AI.CV.OpenCV.CV + , module AI.CV.OpenCV.HighGui + , module AI.CV.OpenCV.Video ) +where + +import AI.CV.OpenCV.CxCore +import AI.CV.OpenCV.CV +import AI.CV.OpenCV.HighGui +import AI.CV.OpenCV.Video diff --git a/src/AI/CV/OpenCV/CV.hsc b/src/AI/CV/OpenCV/CV.hsc --- a/src/AI/CV/OpenCV/CV.hsc +++ b/src/AI/CV/OpenCV/CV.hsc @@ -4,22 +4,27 @@ import Foreign.C.Types import Foreign.Ptr +import Foreign.ForeignPtr import Data.Bits import AI.CV.OpenCV.CxCore +import AI.CV.OpenCV.Util #include foreign import ccall unsafe "cv.h cvCanny" - c_cvCanny :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> CInt -> IO () - -cvCanny :: (IplArrayType i1, IplArrayType i2) => - Ptr i1 -> Ptr i2 -> CDouble -> CDouble -> CInt -> IO () -cvCanny src dst threshold1 threshold2 apertureSize = - c_cvCanny (fromArr src) (fromArr dst) (realToFrac threshold1) (realToFrac threshold2) apertureSize + c_cvCanny :: Ptr Priv_IplImage -> Ptr Priv_IplImage -> CDouble -> CDouble -> CInt -> IO () +-- | Find edges using the Canny algorithm +canny :: IplImage -> IplImage -> Double -> Double -> Int -> IO () +canny src dst threshold1 threshold2 apertureSize + = withForeignPtr2 src dst $ \s d -> + c_cvCanny s d + (realToFrac threshold1) + (realToFrac threshold2) + (fromIntegral apertureSize) data InterpolationMethod = CV_INTER_NN | CV_INTER_LINEAR @@ -28,65 +33,82 @@ deriving (Enum,Eq) foreign import ccall unsafe "cv.h cvResize" - c_cvResize :: Ptr CvArr -> Ptr CvArr -> CInt -> IO () + c_cvResize :: Ptr Priv_IplImage -> Ptr Priv_IplImage -> CInt -> IO () -cvResize :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> InterpolationMethod -> IO () -cvResize src dst interp = c_cvResize (fromArr src) (fromArr dst) (fromIntegral . fromEnum $ interp) +-- | Resizes an image using the specified interpolation method +resize :: IplImage -> IplImage -> InterpolationMethod -> IO () +resize src dst interp + = withForeignPtr2 src dst $ \s d -> + c_cvResize s d (fromIntegral . fromEnum $ interp) -foreign import ccall unsafe "HOpenCV_warp.h dilate" - c_dilate :: Ptr CvArr -> Ptr CvArr -> CInt -> IO () +foreign import ccall unsafe "HOpenCV_wrap.h dilate" + c_dilate :: Ptr Priv_IplImage -> Ptr Priv_IplImage -> CInt -> IO () -cvDilate :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> CInt -> IO () -cvDilate src dst iter = c_dilate (fromArr src) (fromArr dst) iter +-- | Dilates an image using a specific structuring element +dilate :: IplImage -> IplImage -> Int -> IO () +dilate src dst iter + = withForeignPtr2 src dst + $ \s d -> c_dilate s d $ fromIntegral iter foreign import ccall unsafe "cv.h cvPyrDown" - c_cvPyrDown :: Ptr CvArr -> Ptr CvArr -> CInt -> IO () + c_cvPyrDown :: Ptr Priv_IplImage -> Ptr Priv_IplImage -> CInt -> IO () -- for now only one filter type is supported so no need for the CInt (filter type) constCvGaussian5x5 :: CInt constCvGaussian5x5 = 7 -cvPyrDown :: (IplArrayType i1, IplArrayType i2) => Ptr i1 -> Ptr i2 -> IO () -cvPyrDown src dst = c_cvPyrDown (fromArr src) (fromArr dst) constCvGaussian5x5 +-- | Smooths an image and downsamples it, currently only gaussian5x5 is supported +pyrDown :: IplImage -> IplImage -> IO () +pyrDown src dst + = withForeignPtr2 src dst + $ \s d -> c_cvPyrDown s d constCvGaussian5x5 + ------------------------------------------------------------------------------ -data CvHaarClassifierCascade +data Priv_CvHaarClassifierCascade +type HaarClassifierCascade = ForeignPtr Priv_CvHaarClassifierCascade -- thanks to http://book.realworldhaskell.org/read/interfacing-with-c-the-ffi.html newtype HaarDetectFlag = HaarDetectFlag { unHaarDetectFlag :: CInt } deriving (Eq, Show) #{enum HaarDetectFlag, HaarDetectFlag - , cvHaarFlagNone = 0 - , cvHaarDoCannyPruning = CV_HAAR_DO_CANNY_PRUNING - , cvHaarScaleImage = CV_HAAR_SCALE_IMAGE - , cvHaarFindBiggestObject = CV_HAAR_FIND_BIGGEST_OBJECT - , cvHaarDoRoughSearch = CV_HAAR_DO_ROUGH_SEARCH + , haarFlagNone = 0 + , haarDoCannyPruning = CV_HAAR_DO_CANNY_PRUNING + , haarScaleImage = CV_HAAR_SCALE_IMAGE + , haarFindBiggestObject = CV_HAAR_FIND_BIGGEST_OBJECT + , haarDoRoughSearch = CV_HAAR_DO_ROUGH_SEARCH } combineHaarFlags :: [HaarDetectFlag] -> HaarDetectFlag combineHaarFlags = HaarDetectFlag . foldr ((.|.) . unHaarDetectFlag) 0 -foreign import ccall unsafe "HOpenCV_warp.h c_cvHaarDetectObjects" - c_cvHaarDetectObjects :: Ptr CvArr -- ^ image - -> Ptr CvHaarClassifierCascade -- ^ cascade - -> Ptr CvMemStorage -- ^ storage - -> CDouble -- ^ scale_factor - -> CInt -- ^ min_neighbors - -> CInt -- ^ flags - -> CInt -> CInt -- ^ min_size - -> IO (Ptr (CvSeq CvRect)) +foreign import ccall unsafe "HOpenCV_wrap.h c_cvHaarDetectObjects" + c_cvHaarDetectObjects :: Ptr Priv_IplImage -- ^ image + -> Ptr Priv_CvHaarClassifierCascade -- ^ cascade + -> Ptr Priv_CvMemStorage -- ^ storage + -> CDouble -- ^ scale_factor + -> CInt -- ^ min_neighbors + -> CInt -- ^ flags + -> CInt -> CInt -- ^ min_size + -> IO (Ptr (Priv_CvSeq CvRect)) -cvHaarDetectObjects :: (IplArrayType i) => - Ptr i -- ^ image - -> Ptr CvHaarClassifierCascade -- ^ cascade - -> Ptr CvMemStorage -- ^ storage - -> CDouble -- ^ scale_factor - -> CInt -- ^ min_neighbors - -> HaarDetectFlag -- ^ flags - -> CvSize -- ^ min_size - -> IO (Ptr (CvSeq CvRect)) -cvHaarDetectObjects image cascade storage scaleFactor minNeighbors flags minSize = - c_cvHaarDetectObjects (fromArr image) cascade storage scaleFactor minNeighbors (unHaarDetectFlag flags) (sizeWidth minSize) (sizeHeight minSize) +-- | Detects objects in the image. Matches are returned as a list of rectangles +haarDetectObjects :: IplImage -- ^ image + -> HaarClassifierCascade -- ^ cascade + -> MemStorage -- ^ storage + -> Double -- ^ scale_factor + -> Int -- ^ min_neighbors + -> HaarDetectFlag -- ^ flags + -> CvSize -- ^ min_size + -> IO (CvSeq CvRect) +haarDetectObjects image cascade storage scaleFactor minNeighbors flags minSize + = do p <- withForeignPtr3 image storage cascade $ \im' s' c' -> + c_cvHaarDetectObjects im' c' s' + (realToFrac scaleFactor) + (fromIntegral minNeighbors) + (unHaarDetectFlag flags) + (sizeWidth minSize) (sizeHeight minSize) + newForeignPtr cvFree p diff --git a/src/AI/CV/OpenCV/CxCore.hsc b/src/AI/CV/OpenCV/CxCore.hsc --- a/src/AI/CV/OpenCV/CxCore.hsc +++ b/src/AI/CV/OpenCV/CxCore.hsc @@ -2,14 +2,14 @@ module AI.CV.OpenCV.CxCore where +import Foreign import Foreign.ForeignPtrWrap import Foreign.C.Types import Foreign.C.String -import Foreign hiding (unsafePerformIO) import Data.VectorSpace as VectorSpace -import System.IO.Unsafe (unsafePerformIO) +import AI.CV.OpenCV.Util #include @@ -23,6 +23,7 @@ data CvSize = CvSize { sizeWidth :: CInt, sizeHeight :: CInt } deriving (Show, Eq) + instance Storable CvSize where sizeOf _ = (#size CvSize) alignment _ = alignment (undefined :: CInt) @@ -51,7 +52,6 @@ type Scalar CvSize = Double -- todo: use CInt instead of Double here? a *^ s = liftCvSize (a*) s - data CvRect = CvRect { rectX :: CInt, rectY :: CInt, rectWidth :: CInt, rectHeight :: CInt } deriving (Show, Eq) @@ -88,23 +88,20 @@ type Scalar CvRect = Double -- todo: use CInt instead of Double here? a *^ r = liftCvRect (a*) r - - ------------------------------------------------------ -class IplArrayType a - -data CvArr -instance IplArrayType CvArr - -data IplImage -instance IplArrayType IplImage +{- +data Priv_CvArr +type CvArr = ForeignPtr Priv_CvArr +-} -data CvMemStorage +data Priv_IplImage +type IplImage = ForeignPtr Priv_IplImage -data CvSeq a +data Priv_CvMemStorage +type MemStorage = ForeignPtr Priv_CvMemStorage -fromArr :: IplArrayType a => Ptr a -> Ptr CvArr -fromArr = castPtr +data Priv_CvSeq a +type CvSeq a = ForeignPtr (Priv_CvSeq a) newtype Depth = Depth { unDepth :: CInt } deriving (Eq, Show) @@ -129,149 +126,205 @@ numToDepth :: CInt -> Maybe Depth numToDepth x = lookup x depthsLookupList - --------------------------------------------------------------- -- mem storage -foreign import ccall unsafe "cxcore.h cvCreateMemStorage" - c_cvCreateMemStorage :: CInt -> IO (Ptr CvMemStorage) -cvCreateMemStorage :: CInt -> IO (Ptr CvMemStorage) -cvCreateMemStorage = errorName "Failed to create mem storage" . checkPtr . c_cvCreateMemStorage +foreign import ccall unsafe "cxcore.h cvCreateMemStorage" + c_cvCreateMemStorage :: CInt -> IO (Ptr Priv_CvMemStorage) -foreign import ccall unsafe "HOpenCV_warp.h release_mem_storage" - cvReleaseMemStorage :: Ptr CvMemStorage -> IO () +foreign import ccall unsafe "HOpenCV_wrap.h &release_mem_storage" + cf_releaseMemStorage :: FunPtr (Ptr Priv_CvMemStorage -> IO ()) -foreign import ccall unsafe "HOpenCV_warp.h &release_mem_storage" - cp_release_mem_storage :: FunPtr (Ptr CvMemStorage -> IO ()) +foreign import ccall unsafe "HOpenCV_wrap.h release_mem_storage" + c_releaseMemStorage :: Ptr Priv_CvMemStorage -> IO () + +releaseMemStorage :: MemStorage -> IO () +releaseMemStorage memstorage = withForeignPtr memstorage c_releaseMemStorage -createMemStorageF :: CInt -> IO (ForeignPtr CvMemStorage) -createMemStorageF = (createForeignPtr cp_release_mem_storage) . cvCreateMemStorage - +createMemStorage :: Int -> IO MemStorage +createMemStorage i + = do p <- errorName "Failed to create mem storage" + . checkPtr . c_cvCreateMemStorage $ fromIntegral i + newForeignPtr cf_releaseMemStorage p +--------------------------------------------------------------- -- images / matrices / arrays -foreign import ccall unsafe "HOpenCV_warp.h create_image" - c_cvCreateImage :: CInt -> CInt -> CInt -> CInt -> IO (Ptr IplImage) +foreign import ccall unsafe "HOpenCV_wrap.h &cv_free" + cvFree :: FunPtr (Ptr a -> IO ()) -cvCreateImage :: CvSize -> CInt -> Depth -> IO (Ptr IplImage) -cvCreateImage size numChans depth = errorName "Failed to create image" . checkPtr $ c_cvCreateImage (sizeWidth size) (sizeHeight size) (unDepth depth) numChans +foreign import ccall unsafe "HOpenCV_wrap.h create_image" + c_cvCreateImage :: CInt -> CInt -> CInt -> CInt -> IO (Ptr Priv_IplImage) -foreign import ccall unsafe "HOpenCV_warp.h release_image" - cvReleaseImage :: Ptr IplImage -> IO () +createImage :: CvSize -> Depth -> Int -> IO IplImage +createImage size depth numChans + = do im <- errorName "Failed to create image" . checkPtr + $ c_cvCreateImage (sizeWidth size) (sizeHeight size) + (unDepth depth) + (fromIntegral numChans) + fp <- newForeignPtr cvFree im + return fp -foreign import ccall unsafe "HOpenCV_warp.h &release_image" - cp_release_image :: FunPtr (Ptr IplImage -> IO ()) +foreign import ccall unsafe "HOpenCV_wrap.h release_image" + c_releaseImage :: Ptr Priv_IplImage -> IO () -createImageF :: CvSize -> CInt -> Depth -> IO (ForeignPtr IplImage) -createImageF x y z = createForeignPtr cp_release_image $ cvCreateImage x y z +releaseImage :: IplImage -> IO () +releaseImage image = withForeignPtr image c_releaseImage +-- foreign import ccall unsafe "HOpenCV_wrap.h &release_image" + -- cp_release_image :: FunPtr (Ptr Priv_IplImage -> IO ()) + + foreign import ccall unsafe "cxcore.h cvCloneImage" - c_cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage) + c_cvCloneImage :: Ptr Priv_IplImage -> IO (Ptr Priv_IplImage) -cvCloneImage :: Ptr IplImage -> IO (Ptr IplImage) -cvCloneImage = errorName "Failed to clone image" . checkPtr . c_cvCloneImage +cloneImage :: IplImage -> IO IplImage +cloneImage p + = do p' <- errorName "Failed to clone image" . checkPtr + $ withForeignPtr p c_cvCloneImage + fp <- newForeignPtr cvFree p' + return fp -cloneImageF :: Ptr IplImage -> IO (ForeignPtr IplImage) -cloneImageF x = createForeignPtr cp_release_image $ cvCloneImage x - -foreign import ccall unsafe "HOpenCV_warp.h get_size" - c_get_size :: Ptr CvArr -> Ptr CvSize -> IO () +foreign import ccall unsafe "HOpenCV_wrap.h get_size" + c_get_size :: Ptr Priv_IplImage -> Ptr CvSize -> IO () foreign import ccall unsafe "cxcore.h cvCopy" - c_cvCopy :: Ptr CvArr -> Ptr CvArr -> Ptr CvArr -> IO () + c_cvCopy :: Ptr Priv_IplImage -> Ptr Priv_IplImage -> Ptr Priv_IplImage -> IO () -- todo add mask support -cvCopy :: IplArrayType a => Ptr a -> Ptr a -> IO () -cvCopy src dst = c_cvCopy (fromArr src) (fromArr dst) nullPtr +copy :: IplImage -> IplImage -> IO () +copy src dst + = withForeignPtr2 src dst $ \s d -> + c_cvCopy s d nullPtr -cvGetSize :: IplArrayType a => Ptr a -> CvSize -cvGetSize p = unsafePerformIO $ - alloca $ \cvSizePtr -> do - c_get_size (castPtr p) cvSizePtr - size <- peek cvSizePtr - return size +foreign import ccall unsafe "cxcore.h cvMerge" + cvMerge :: Ptr Priv_IplImage -> Ptr Priv_IplImage -> Ptr Priv_IplImage + -> Ptr Priv_IplImage -> Ptr Priv_IplImage -> IO () -foreign import ccall unsafe "HOpenCV_warp.h get_depth" - c_get_depth :: Ptr IplImage -> IO CInt +merge :: IplImage -> IplImage -> IplImage -> IplImage -> IplImage -> IO () +merge a b c d e + = withForeignPtr5 a b c d e $ \a' b' c' d' e' -> + cvMerge a' b' c' d' e' -getDepth :: Ptr IplImage -> IO Depth +foreign import ccall unsafe "HOpenCV_wrap.h wrap_getImageData" + wrap_getImageData :: Ptr Priv_IplImage -> IO (Ptr CUChar) + +getImageData :: IplImage -> IO (Ptr CUChar) +getImageData i + = withForeignPtr i wrap_getImageData + +getSize :: IplImage -> IO CvSize +getSize a + = alloca $ \cvSizePtr -> do + withForeignPtr a $ \a' -> c_get_size a' cvSizePtr + size <- peek cvSizePtr + return size + +foreign import ccall unsafe "HOpenCV_wrap.h get_depth" + c_get_depth :: Ptr Priv_IplImage -> IO CInt + +getDepth :: IplImage -> IO Depth getDepth img = do - depthInt <- c_get_depth img + depthInt <- withForeignPtr img c_get_depth case numToDepth depthInt of Nothing -> fail "Bad depth in image struct" Just depth -> return depth -foreign import ccall unsafe "HOpenCV_warp.h get_nChannels" - c_get_nChannels :: Ptr IplImage -> IO CInt +foreign import ccall unsafe "HOpenCV_wrap.h get_nChannels" + c_get_nChannels :: Ptr Priv_IplImage -> IO CInt -getNumChannels :: Integral a => Ptr IplImage -> IO a -getNumChannels img = fmap fromIntegral $ c_get_nChannels img +getNumChannels :: Integral a => IplImage -> IO a +getNumChannels img + = do i <- withForeignPtr img c_get_nChannels + return $ fromIntegral i +foreign import ccall unsafe "HOpenCV_wrap.h wrap_getWidthStep" + wrap_getWidthStep :: Ptr Priv_IplImage -> IO CInt +getWidthStep :: IplImage -> IO Int +getWidthStep im + = do i <- withForeignPtr im wrap_getWidthStep + return $ fromIntegral i + foreign import ccall unsafe "cxcore.h cvConvertScale" - cvConvertScale :: Ptr CvArr -> Ptr CvArr -> CDouble -> CDouble -> IO () + cvConvertScale :: Ptr Priv_IplImage -> Ptr Priv_IplImage -> CDouble -> CDouble -> IO () - -foreign import ccall unsafe "HOpenCV_warp.h cv_free" - cvFree :: Ptr a -> IO () - +convertScale :: IplImage -> IplImage -> Double -> Double -> IO () +convertScale a b c d + = withForeignPtr2 a b $ \a' b' -> + cvConvertScale a' b' + (realToFrac c) + (realToFrac d) + foreign import ccall unsafe "cxcore.h cvLoad" - c_cvLoad :: CString -> Ptr CvMemStorage -> CString -> Ptr CString -> IO (Ptr a) + c_cvLoad :: CString -> Ptr Priv_CvMemStorage -> CString -> Ptr CString -> IO (Ptr a) -cvLoad :: String -> Ptr CvMemStorage -> Maybe String -> IO (Ptr a, Maybe String) -cvLoad filename memstorage name = withCString filename cvLoad' - where cvLoad' filenameC = do - case name of - Nothing -> cvLoad'' filenameC nullPtr - Just n' -> withCString n' $ cvLoad'' filenameC - cvLoad'' filenameC nameC = alloca $ \ptrRealNameC -> do - ptrObj <- errorName "cvLoad failed" . checkPtr $ c_cvLoad filenameC memstorage nameC ptrRealNameC - realNameC <- peek ptrRealNameC - realName <- if realNameC == nullPtr - then return Nothing - else fmap Just $ peekCString realNameC - cvFree realNameC - return (ptrObj, realName) +load :: String -> MemStorage -> Maybe String -> IO (ForeignPtr a, Maybe String) +load filename mem name + = withCString filename $ \filenameC -> + case name + of Nothing -> cvLoad'' filenameC nullPtr + Just n' -> withCString n' $ cvLoad'' filenameC + where + cvLoad'' filenameC nameC + = alloca $ \ptrRealNameC -> + do let g mem' = errorName "cvLoad failed" . checkPtr + $ c_cvLoad filenameC mem' nameC ptrRealNameC + ptrObj <- withForeignPtr mem g + realNameC <- peek ptrRealNameC + realName <- if realNameC == nullPtr + then return Nothing + else fmap Just $ peekCString realNameC + -- cvFree realNameC + fp <- newForeignPtr cvFree ptrObj + return (fp, realName) foreign import ccall unsafe "cxcore.h cvGetSeqElem" - cvGetSeqElem :: Ptr (CvSeq a) -> CInt -> IO (Ptr a) + cvGetSeqElem :: Ptr (Priv_CvSeq a) -> CInt -> IO (Ptr a) --- foreign import ccall unsafe "HOpenCV_warp.h c_rect_cvGetSeqElem" +-- foreign import ccall unsafe "HOpenCV_wrap.h c_rect_cvGetSeqElem" -- cvGetSeqElemRect :: Ptr (CvSeq (Ptr CvRect)) -> CInt -> IO (Ptr CvRect) -foreign import ccall unsafe "HOpenCV_warp.h seq_total" - seqNumElems :: Ptr (CvSeq a) -> IO CInt +foreign import ccall unsafe "HOpenCV_wrap.h seq_total" + seqNumElems :: Ptr (Priv_CvSeq a) -> IO CInt -seqToPList :: Ptr (CvSeq a) -> IO [Ptr a] +seqToPList :: CvSeq a -> IO [ForeignPtr a] seqToPList pseq = do - numElems <- seqNumElems pseq - mapM (cvGetSeqElem pseq) [1..(numElems)] + numElems <- withForeignPtr pseq seqNumElems + mapM fetchElem [1..numElems] + where + fetchElem i + = do p <- withForeignPtr pseq + $ \p -> cvGetSeqElem p i + newForeignPtr cvFree p -seqToList :: Storable a => Ptr (CvSeq a) -> IO [a] +seqToList :: Storable a => CvSeq a -> IO [a] seqToList pseq = do - numElems <- seqNumElems pseq + numElems <- withForeignPtr pseq seqNumElems flip mapM [1..(numElems)] $ \i -> do - elemP <- cvGetSeqElem pseq i + elemP <- withForeignPtr pseq $ \p -> cvGetSeqElem p i elem' <- peek elemP return elem' -- seqToRectList :: Ptr (CvSeq (Ptr CvRect)) -> IO [CvRect] -- seqToRectList pseq = do --- numElems <- seqNumElems pseq +-- numElems <- withForeignPtr pseq seqNumElems -- flip mapM [1..(numElems)] $ \i -> do -- rectP <- cvGetSeqElemRect pseq i -- rect <- peek rectP -- return rect -foreign import ccall unsafe "HOpenCV_warp.h c_cvRectangle" - c_cvRectangle :: Ptr CvArr -> CInt -> CInt -> CInt -> CInt -> IO () +foreign import ccall unsafe "HOpenCV_wrap.h c_cvRectangle" + c_cvRectangle :: Ptr Priv_IplImage -> CInt -> CInt -> CInt -> CInt -> IO () -cvRectangle :: IplArrayType a => Ptr a -> CvRect -> IO () -cvRectangle dst (CvRect x y w h) = c_cvRectangle (fromArr dst) x y w h +rectangle :: IplImage -> CvRect -> IO () +rectangle dst (CvRect x y w h) + = withForeignPtr dst $ \d -> + c_cvRectangle d x y w h ------------------------------------------------------------------------------ -- Debugging stuff, not part of opencv -- | Debugging function to print some of the internal details of an IplImage structure -foreign import ccall unsafe "HOpenCV_warp.h debug_print_image_header" - c_debug_print_image_header :: Ptr IplImage -> IO () +foreign import ccall unsafe "HOpenCV_wrap.h debug_print_image_header" + c_debug_print_image_header :: Ptr Priv_IplImage -> IO () diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.c b/src/AI/CV/OpenCV/HOpenCV_wrap.c --- a/src/AI/CV/OpenCV/HOpenCV_wrap.c +++ b/src/AI/CV/OpenCV/HOpenCV_wrap.c @@ -34,6 +34,7 @@ /****************************************************************************/ +/* void num_to_name(int num, char *name, int length) { snprintf(name, length, "win-%d", num); @@ -59,7 +60,7 @@ num_to_name(num, name, sizeof(name)); cvShowImage(name, image); } - +*/ /**********************************************************/ /* Haskell's FFI doesn't know how to pass structs by value, I think. */ @@ -74,6 +75,14 @@ return cvReleaseImage(&temp); } +char *wrap_getImageData(const IplImage *im) { + return im->imageData; +} + +int wrap_getWidthStep(IplImage *im) { + return im->widthStep; +} + /* Notice that according to opencv docs, cvGetSize returns the ROI for images, not the image.width and .height */ void get_size(const CvArr *arr, CvSize *size) { @@ -98,7 +107,6 @@ } /**********************************************************/ - void release_mem_storage(CvMemStorage *mem_store) { CvMemStorage *temp = mem_store; @@ -144,3 +152,29 @@ return cvHaarDetectObjects(image, cascade, storage, scale_factor, min_neighbors, flags, cvSize(width, height), cvSize(0, 0)); } +/****************************************************************************/ + +void doNothing( int newPos ) { return; } + +int wrap_createTrackbar( const char* trackbarName + , const char* winName + , int* startPos + , int maxVal) +{ + return cvCreateTrackbar(trackbarName, winName, startPos, maxVal, doNothing); +} + +/****************************************************************************/ + +CvVideoWriter * +wrap_cvCreateVideoWriter( const char *file + , int fourcc + , double fps + , int height, int width) +{ + return cvCreateVideoWriter(file, fourcc, fps, cvSize(width, height), 1); +} + +void freeNothing(void *a) { + return; +} diff --git a/src/AI/CV/OpenCV/HOpenCV_wrap.h b/src/AI/CV/OpenCV/HOpenCV_wrap.h --- a/src/AI/CV/OpenCV/HOpenCV_wrap.h +++ b/src/AI/CV/OpenCV/HOpenCV_wrap.h @@ -34,3 +34,15 @@ int min_neighbors , int flags, int width, int height); +int wrap_createTrackbar( const char* trackbarName, + const char* winName, + int* startPos, + int maxVal, + CvTrackbarCallback onChange ); + +CvVideoWriter * +wrap_cvCreateVideoWriter( const char *file + , int fourcc + , double fps + , int width + , int height); diff --git a/src/AI/CV/OpenCV/HighGui.hsc b/src/AI/CV/OpenCV/HighGui.hsc --- a/src/AI/CV/OpenCV/HighGui.hsc +++ b/src/AI/CV/OpenCV/HighGui.hsc @@ -8,87 +8,121 @@ import Foreign.Ptr import Foreign.ForeignPtr import Foreign.C.String +import Foreign.Marshal +import Foreign.Storable import AI.CV.OpenCV.CxCore +import AI.CV.OpenCV.Util #include ------------------------------------------------ -- General foreign import ccall unsafe "highgui.h cvConvertImage" - c_cvConvertImage :: Ptr CvArr -> Ptr CvArr -> CInt -> IO () + c_cvConvertImage :: Ptr Priv_IplImage -> Ptr Priv_IplImage -> CInt -> IO () -cvConvertImage :: (IplArrayType a, IplArrayType a1) => Ptr a -> Ptr a1 -> CInt -> IO () -cvConvertImage src dst flags = c_cvConvertImage (fromArr src) (fromArr dst) flags +convertImage :: IplImage -> IplImage -> Int -> IO () +convertImage src dst flags + = withForeignPtr2 src dst + $ \s d -> c_cvConvertImage s d + (fromIntegral flags) ------------------------------------------------ -- Capturing -data CvCapture +data Priv_CvCapture +type Capture = ForeignPtr Priv_CvCapture foreign import ccall unsafe "highgui.h cvCreateCameraCapture" - c_cvCreateCameraCapture :: CInt -> IO (Ptr CvCapture) + c_cvCreateCameraCapture :: CInt -> IO (Ptr Priv_CvCapture) -cvCreateCameraCapture :: CInt -> IO (Ptr CvCapture) -cvCreateCameraCapture x = errorName "Failed to create camera" . checkPtr $ c_cvCreateCameraCapture . fromIntegral $ x +-- | self-documenting camera specification +pickAnyCam :: Int +pickAnyCam = -1 + +-- | self-documenting camera specification +cam :: Int -> Int +cam = id + +createCameraCapture :: Int -> IO Capture +createCameraCapture x + = do p <- errorName "Failed to create camera" . checkPtr $ c_cvCreateCameraCapture . fromIntegral $ x + newForeignPtr cp_release_capture p foreign import ccall unsafe "highgui.h cvCreateFileCapture" - c_cvCreateFileCapture :: CString -> IO (Ptr CvCapture) + c_cvCreateFileCapture :: CString -> IO (Ptr Priv_CvCapture) -cvCreateFileCapture :: String -> IO (Ptr CvCapture) -cvCreateFileCapture filename = err' . checkPtr $ withCString filename f +createFileCapture :: String -> IO Capture +createFileCapture filename + = do c <- err' . checkPtr $ withCString filename f + newForeignPtr cp_release_capture c where err' = errorName $ "Failed to capture from file: '" ++ filename ++ "'" f filenameC = c_cvCreateFileCapture filenameC -foreign import ccall unsafe "HOpenCV_warp.h release_capture" - cvReleaseCapture :: Ptr CvCapture -> IO () +foreign import ccall unsafe "HOpenCV_wrap.h release_capture" + c_releaseCapture :: Ptr Priv_CvCapture -> IO () + +releaseCapture :: Capture -> IO () +releaseCapture cap = withForeignPtr cap c_releaseCapture -foreign import ccall unsafe "HOpenCV_warp.h &release_capture" - cp_release_capture :: FunPtr (Ptr CvCapture -> IO () ) +foreign import ccall unsafe "HOpenCV_wrap.h &release_capture" + cp_release_capture :: FunPtr (Ptr Priv_CvCapture -> IO ()) -createCameraCaptureF :: CInt -> IO (ForeignPtr CvCapture) -createCameraCaptureF = (createForeignPtr cp_release_capture) . cvCreateCameraCapture - - - foreign import ccall unsafe "highgui.h cvQueryFrame" - c_cvQueryFrame :: Ptr CvCapture -> IO (Ptr IplImage) + c_cvQueryFrame :: Ptr Priv_CvCapture -> IO (Ptr Priv_IplImage) -cvQueryFrame :: Ptr CvCapture -> IO (Ptr IplImage) -cvQueryFrame cap = errorName "Failed to query frame from camera" . checkPtr $ c_cvQueryFrame cap +queryFrame :: Capture -> IO IplImage +queryFrame cap + = do i <- withForeignPtr cap $ \c -> + errorName "Failed to query frame from camera" . checkPtr + $ c_cvQueryFrame c + fp <- newForeignPtr cvFree i + return fp ------------------------------------------------- -- Windows -foreign import ccall unsafe "HOpenCV_wrap.h new_window" - c_newWindow :: CInt -> CInt -> IO () -newWindow :: CInt -> Bool -> IO () -newWindow num autoSize = c_newWindow num (if autoSize then 1 else 0) +foreign import ccall unsafe "highgui.h cvNamedWindow" + cvNamedWindow :: CString -> CInt -> IO CInt -foreign import ccall unsafe "HOpenCV_wrap.h del_window" - delWindow :: CInt -> IO () +type AutoSize = Bool -foreign import ccall unsafe "HOpenCV_wrap.h show_image" - showImage :: CInt -> Ptr IplImage -> IO () +-- | self-documenting window sizing specification +autoSize :: AutoSize +autoSize = True -foreign import ccall unsafe "highgui.h cvWaitKey" - waitKey :: CInt -> IO CInt +namedWindow :: String -> AutoSize -> IO () +namedWindow s a + = withCString s $ \cs -> + do _ <- cvNamedWindow cs (fromIntegral $ fromEnum a) + return () -foreign import ccall unsafe "highgui.h cvNamedWindow" - cvNamedWindow :: CString -> CInt -> IO CInt +foreign import ccall unsafe "highgui.h cvDestroyWindow" + cvDestroyWindow :: CString -> IO () -type AutoSize = Bool +destroyWindow :: String -> IO () +destroyWindow wId + = withCString wId cvDestroyWindow -titledWindow :: String -> AutoSize -> IO Int -titledWindow s a - = do cs <- newCString s - i <- cvNamedWindow cs (fromToInteger $ fromEnum a) - return $ fromToInteger i +foreign import ccall unsafe "highgui.h cvShowImage" + cvShowImage :: CString -> Ptr Priv_IplImage -> IO () -fromToInteger :: (Integral a, Num b) => a -> b -fromToInteger = fromInteger . toInteger +showImage :: String -> IplImage -> IO () +showImage wId p + = withCString wId $ \w -> + withForeignPtr p $ cvShowImage w +foreign import ccall unsafe "highgui.h cvWaitKey" + cvWaitKey :: CInt -> IO CInt + +waitKey :: Int -> IO (Maybe Int) +waitKey milliSecs + = do i <- cvWaitKey $ fromIntegral milliSecs + if i == (-1) + then return Nothing + else return $ Just $ fromIntegral i + newtype LoadImageColor = LoadImageColor { unLoadImageColor :: CInt } #{enum LoadImageColor, LoadImageColor @@ -97,21 +131,61 @@ , loadImageUnchanged = CV_LOAD_IMAGE_UNCHANGED } foreign import ccall unsafe "highgui.h cvLoadImage" - c_cvLoadImage :: CString -> CInt -> IO (Ptr IplImage) + c_cvLoadImage :: CString -> CInt -> IO (Ptr Priv_IplImage) -cvLoadImage :: String -> LoadImageColor -> IO (Ptr IplImage) -cvLoadImage filename (LoadImageColor color) = err' . checkPtr $ withCString filename f - where - err' = errorName $ "Failed to load from file: '" ++ filename ++ "'" - f filenameC = c_cvLoadImage filenameC color +loadImage :: String -> LoadImageColor -> IO IplImage +loadImage filename (LoadImageColor color) + = do i <- err' . checkPtr $ withCString filename + $ \fn -> c_cvLoadImage fn color + fp <- newForeignPtr cvFree i + return fp + where + err' = errorName $ "Failed to load from file: '" ++ filename ++ "'" foreign import ccall unsafe "highgui.h cvSaveImage" - c_cvSaveImage :: CString -> Ptr CvArr -> IO CInt + c_cvSaveImage :: CString -> Ptr Priv_IplImage -> IO CInt -cvSaveImage :: String -> Ptr IplImage -> IO CInt -cvSaveImage filename image = withCString filename f +saveImage :: String -> IplImage -> IO Int +saveImage filename image = withCString filename f where f filenameC = do - ret <- c_cvSaveImage filenameC (fromArr image) + ret <- withForeignPtr image $ \i -> + c_cvSaveImage filenameC i when (ret == 0) $ fail $ "Failed to save to file: '" ++ filename ++ "'" - return ret + return $ fromIntegral ret + +------------------------------------------------ +-- Trackbar + +foreign import ccall unsafe "HOpenCV_Wrap.h wrap_createTrackbar" + wrap_createTrackbar :: CString -> CString -> Ptr CInt -> CInt -> IO () + +createTrackbar :: String -> String -> Maybe Int -> Int -> IO () +createTrackbar trackbarName winName startPosition maxValue + = withCString trackbarName $ \tb -> + withCString winName $ \wn -> + alloca $ \sp -> + do maybeToPtr sp startPosition + wrap_createTrackbar tb wn sp (fromIntegral maxValue) + where + maybeToPtr mem (Just i) = poke mem (fromIntegral i) + maybeToPtr mem Nothing = poke mem (fromIntegral 0) + +foreign import ccall unsafe "highgui.h cvGetTrackbarPos" + cvGetTrackbarPos :: CString -> CString -> IO CInt + +getTrackbarPos :: String -> String -> IO Int +getTrackbarPos trackbarName winName + = withCString trackbarName $ \tb -> + withCString winName $ \wn -> + do i <- cvGetTrackbarPos tb wn + return $ fromIntegral i + +foreign import ccall unsafe "highgui.h cvSetTrackbarPos" + cvSetTrackbarPos :: CString -> CString -> CInt -> IO () + +setTrackbarPos :: String -> String -> Int -> IO () +setTrackbarPos trackbarName winName pos + = withCString trackbarName $ \tb -> + withCString winName $ \wn -> + cvSetTrackbarPos tb wn (fromIntegral pos) diff --git a/src/AI/CV/OpenCV/ImgProc.hs b/src/AI/CV/OpenCV/ImgProc.hs new file mode 100644 --- /dev/null +++ b/src/AI/CV/OpenCV/ImgProc.hs @@ -0,0 +1,266 @@ +{-# Language ForeignFunctionInterface #-} + +module AI.CV.OpenCV.ImgProc +where + +import Foreign +import Foreign.C +import AI.CV.OpenCV.CxCore +import AI.CV.OpenCV.Util + +foreign import ccall unsafe "imgproc.h cvCvtColor" + cvCvtColor :: Ptr Priv_IplImage -> Ptr Priv_IplImage -> CInt -> IO () + +cvtColor :: IplImage -> IplImage -> CvtColorFlag -> IO () +cvtColor i j f + = withForeignPtr2 i j + $ \i' j' -> cvCvtColor i' j' $ fromCvtColorFlag f + +-- yes i edited this by hand because i did not know how to refer to an anonymous enum +data CvtColorFlag + = BGR2BGRA + | RGB2RGBA + + | BGRA2BGR + | RGBA2RGB + + | BGR2RGBA + | RGB2BGRA + + | RGBA2BGR + | BGRA2RGB + + | BGR2RGB + | RGB2BGR + + | BGRA2RGBA + | RGBA2BGRA + + | BGR2GRAY + | RGB2GRAY + | GRAY2BGR + | GRAY2RGB + | GRAY2BGRA + | GRAY2RGBA + | BGRA2GRAY + | RGBA2GRAY + + | BGR2BGR565 + | RGB2BGR565 + | BGR5652BGR + | BGR5652RGB + | BGRA2BGR565 + | RGBA2BGR565 + | BGR5652BGRA + | BGR5652RGBA + + | GRAY2BGR565 + | BGR5652GRAY + + | BGR2BGR555 + | RGB2BGR555 + | BGR5552BGR + | BGR5552RGB + | BGRA2BGR555 + | RGBA2BGR555 + | BGR5552BGRA + | BGR5552RGBA + + | GRAY2BGR555 + | BGR5552GRAY + + | BGR2XYZ + | RGB2XYZ + | XYZ2BGR + | XYZ2RGB + + | BGR2YCrCb + | RGB2YCrCb + | YCrCb2BGR + | YCrCb2RGB + + | BGR2HSV + | RGB2HSV + + | BGR2Lab + | RGB2Lab + + | BayerBG2BGR + | BayerGB2BGR + | BayerRG2BGR + | BayerGR2BGR + + | BayerBG2RGB + | BayerGB2RGB + | BayerRG2RGB + | BayerGR2RGB + + | BGR2Luv + | RGB2Luv + | BGR2HLS + | RGB2HLS + + | HSV2BGR + | HSV2RGB + + | Lab2BGR + | Lab2RGB + | Luv2BGR + | Luv2RGB + | HLS2BGR + | HLS2RGB + + | BayerBG2BGR_VNG + | BayerGB2BGR_VNG + | BayerRG2BGR_VNG + | BayerGR2BGR_VNG + + | BayerBG2RGB_VNG + | BayerGB2RGB_VNG + | BayerRG2RGB_VNG + | BayerGR2RGB_VNG + + | BGR2HSV_FULL + | RGB2HSV_FULL + | BGR2HLS_FULL + | RGB2HLS_FULL + + | HSV2BGR_FULL + | HSV2RGB_FULL + | HLS2BGR_FULL + | HLS2RGB_FULL + + | LBGR2Lab + | LRGB2Lab + | LBGR2Luv + | LRGB2Luv + + | Lab2LBGR + | Lab2LRGB + | Luv2LBGR + | Luv2LRGB + + | BGR2YUV + | RGB2YUV + | YUV2BGR + | YUV2RGB + + | BayerBG2GRAY + | BayerGB2GRAY + | BayerRG2GRAY + | BayerGR2GRAY + + | YUV420i2RGB + | YUV420i2BGR + | YUV420sp2RGB + | YUV420sp2BGR + +fromCvtColorFlag :: CvtColorFlag -> CInt +fromCvtColorFlag BGR2BGRA = 0 +fromCvtColorFlag RGB2RGBA = fromCvtColorFlag BGR2BGRA +fromCvtColorFlag BGRA2BGR = 1 +fromCvtColorFlag RGBA2RGB = fromCvtColorFlag BGRA2BGR +fromCvtColorFlag BGR2RGBA = 2 +fromCvtColorFlag RGB2BGRA = fromCvtColorFlag BGR2RGBA +fromCvtColorFlag RGBA2BGR = 3 +fromCvtColorFlag BGRA2RGB = fromCvtColorFlag RGBA2BGR +fromCvtColorFlag BGR2RGB = 4 +fromCvtColorFlag RGB2BGR = fromCvtColorFlag BGR2RGB +fromCvtColorFlag BGRA2RGBA = 5 +fromCvtColorFlag RGBA2BGRA = fromCvtColorFlag BGRA2RGBA +fromCvtColorFlag BGR2GRAY = 6 +fromCvtColorFlag RGB2GRAY = 7 +fromCvtColorFlag GRAY2BGR = 8 +fromCvtColorFlag GRAY2RGB = fromCvtColorFlag GRAY2BGR +fromCvtColorFlag GRAY2BGRA = 9 +fromCvtColorFlag GRAY2RGBA = fromCvtColorFlag GRAY2BGRA +fromCvtColorFlag BGRA2GRAY = 10 +fromCvtColorFlag RGBA2GRAY = 11 +fromCvtColorFlag BGR2BGR565 = 12 +fromCvtColorFlag RGB2BGR565 = 13 +fromCvtColorFlag BGR5652BGR = 14 +fromCvtColorFlag BGR5652RGB = 15 +fromCvtColorFlag BGRA2BGR565 = 16 +fromCvtColorFlag RGBA2BGR565 = 17 +fromCvtColorFlag BGR5652BGRA = 18 +fromCvtColorFlag BGR5652RGBA = 19 +fromCvtColorFlag GRAY2BGR565 = 20 +fromCvtColorFlag BGR5652GRAY = 21 +fromCvtColorFlag BGR2BGR555 = 22 +fromCvtColorFlag RGB2BGR555 = 23 +fromCvtColorFlag BGR5552BGR = 24 +fromCvtColorFlag BGR5552RGB = 25 +fromCvtColorFlag BGRA2BGR555 = 26 +fromCvtColorFlag RGBA2BGR555 = 27 +fromCvtColorFlag BGR5552BGRA = 28 +fromCvtColorFlag BGR5552RGBA = 29 +fromCvtColorFlag GRAY2BGR555 = 30 +fromCvtColorFlag BGR5552GRAY = 31 +fromCvtColorFlag BGR2XYZ = 32 +fromCvtColorFlag RGB2XYZ = 33 +fromCvtColorFlag XYZ2BGR = 34 +fromCvtColorFlag XYZ2RGB = 35 +fromCvtColorFlag BGR2YCrCb = 36 +fromCvtColorFlag RGB2YCrCb = 37 +fromCvtColorFlag YCrCb2BGR = 38 +fromCvtColorFlag YCrCb2RGB = 39 +fromCvtColorFlag BGR2HSV = 40 +fromCvtColorFlag RGB2HSV = 41 +fromCvtColorFlag BGR2Lab = 44 +fromCvtColorFlag RGB2Lab = 45 +fromCvtColorFlag BayerBG2BGR = 46 +fromCvtColorFlag BayerGB2BGR = 47 +fromCvtColorFlag BayerRG2BGR = 48 +fromCvtColorFlag BayerGR2BGR = 49 +fromCvtColorFlag BayerBG2RGB = fromCvtColorFlag BayerRG2BGR +fromCvtColorFlag BayerGB2RGB = fromCvtColorFlag BayerGR2BGR +fromCvtColorFlag BayerRG2RGB = fromCvtColorFlag BayerBG2BGR +fromCvtColorFlag BayerGR2RGB = fromCvtColorFlag BayerGB2BGR +fromCvtColorFlag BGR2Luv = 50 +fromCvtColorFlag RGB2Luv = 51 +fromCvtColorFlag BGR2HLS = 52 +fromCvtColorFlag RGB2HLS = 53 +fromCvtColorFlag HSV2BGR = 54 +fromCvtColorFlag HSV2RGB = 55 +fromCvtColorFlag Lab2BGR = 56 +fromCvtColorFlag Lab2RGB = 57 +fromCvtColorFlag Luv2BGR = 58 +fromCvtColorFlag Luv2RGB = 59 +fromCvtColorFlag HLS2BGR = 60 +fromCvtColorFlag HLS2RGB = 61 +fromCvtColorFlag BayerBG2BGR_VNG = 62 +fromCvtColorFlag BayerGB2BGR_VNG = 63 +fromCvtColorFlag BayerRG2BGR_VNG = 64 +fromCvtColorFlag BayerGR2BGR_VNG = 65 +fromCvtColorFlag BayerBG2RGB_VNG = fromCvtColorFlag BayerRG2BGR_VNG +fromCvtColorFlag BayerGB2RGB_VNG = fromCvtColorFlag BayerGR2BGR_VNG +fromCvtColorFlag BayerRG2RGB_VNG = fromCvtColorFlag BayerBG2BGR_VNG +fromCvtColorFlag BayerGR2RGB_VNG = fromCvtColorFlag BayerGB2BGR_VNG +fromCvtColorFlag BGR2HSV_FULL = 66 +fromCvtColorFlag RGB2HSV_FULL = 67 +fromCvtColorFlag BGR2HLS_FULL = 68 +fromCvtColorFlag RGB2HLS_FULL = 69 +fromCvtColorFlag HSV2BGR_FULL = 70 +fromCvtColorFlag HSV2RGB_FULL = 71 +fromCvtColorFlag HLS2BGR_FULL = 72 +fromCvtColorFlag HLS2RGB_FULL = 73 +fromCvtColorFlag LBGR2Lab = 74 +fromCvtColorFlag LRGB2Lab = 75 +fromCvtColorFlag LBGR2Luv = 76 +fromCvtColorFlag LRGB2Luv = 77 +fromCvtColorFlag Lab2LBGR = 78 +fromCvtColorFlag Lab2LRGB = 79 +fromCvtColorFlag Luv2LBGR = 80 +fromCvtColorFlag Luv2LRGB = 81 +fromCvtColorFlag BGR2YUV = 82 +fromCvtColorFlag RGB2YUV = 83 +fromCvtColorFlag YUV2BGR = 84 +fromCvtColorFlag YUV2RGB = 85 +fromCvtColorFlag BayerBG2GRAY = 86 +fromCvtColorFlag BayerGB2GRAY = 87 +fromCvtColorFlag BayerRG2GRAY = 88 +fromCvtColorFlag BayerGR2GRAY = 89 +fromCvtColorFlag YUV420i2RGB = 90 +fromCvtColorFlag YUV420i2BGR = 91 +fromCvtColorFlag YUV420sp2RGB = 92 +fromCvtColorFlag YUV420sp2BGR = 93 diff --git a/src/AI/CV/OpenCV/Types.hs b/src/AI/CV/OpenCV/Types.hs deleted file mode 100644 --- a/src/AI/CV/OpenCV/Types.hs +++ /dev/null @@ -1,13 +0,0 @@ -module AI.CV.OpenCV.Types where - - -import AI.CV.OpenCV.CxCore -import AI.CV.OpenCV.HighGui - -import Foreign - -type PImage = Ptr IplImage -type PCapture = Ptr CvCapture - -type FPImage = ForeignPtr IplImage -type FPCapture = ForeignPtr CvCapture diff --git a/src/AI/CV/OpenCV/Util.hs b/src/AI/CV/OpenCV/Util.hs new file mode 100644 --- /dev/null +++ b/src/AI/CV/OpenCV/Util.hs @@ -0,0 +1,32 @@ +module AI.CV.OpenCV.Util +where + +import Foreign + +withForeignPtr2 :: ForeignPtr a -> ForeignPtr b + -> (Ptr a -> Ptr b -> IO c) + -> IO c +withForeignPtr2 a b f + = let g a' = withForeignPtr b $ f a' + in withForeignPtr a g + +withForeignPtr3 :: ForeignPtr a -> ForeignPtr b -> ForeignPtr c + -> (Ptr a -> Ptr b -> Ptr c -> IO d) + -> IO d +withForeignPtr3 a b c f + = withForeignPtr a $ \a' -> + withForeignPtr b $ \b' -> + withForeignPtr c $ \c' -> + f a' b' c' + +withForeignPtr5 :: ForeignPtr a -> ForeignPtr b -> ForeignPtr c + -> ForeignPtr d -> ForeignPtr e + -> (Ptr a -> Ptr b -> Ptr c -> Ptr d -> Ptr e -> IO f) + -> IO f +withForeignPtr5 a b c d e f + = withForeignPtr a $ \a' -> + withForeignPtr b $ \b' -> + withForeignPtr c $ \c' -> + withForeignPtr d $ \d' -> + withForeignPtr e $ \e' -> + f a' b' c' d' e' diff --git a/src/AI/CV/OpenCV/Video.hs b/src/AI/CV/OpenCV/Video.hs new file mode 100644 --- /dev/null +++ b/src/AI/CV/OpenCV/Video.hs @@ -0,0 +1,35 @@ +{-# Language ForeignFunctionInterface, EmptyDataDecls #-} + +module AI.CV.OpenCV.Video +where + +import Foreign +import Foreign.C +import AI.CV.OpenCV.CxCore + +data Priv_CvVideoWriter + +type CvVideoWriter = Ptr Priv_CvVideoWriter + +foreign import ccall unsafe "HOpenCV_wrap.h wrap_cvCreateVideoWriter" + wrap_cvCreateVideoWriter :: CString -> CInt -> CDouble -> CInt -> CInt -> IO (Ptr Priv_CvVideoWriter) + +type FourCC = String + +createVideoWriter :: String -> FourCC -> Double -> CvSize -> IO CvVideoWriter +createVideoWriter file fourCC fps size + = withCString file $ \f -> + wrap_cvCreateVideoWriter f (toCInt fourCC) (realToFrac fps) (sizeWidth size) (sizeHeight size) + where + toCInt = fromIntegral . sum . map fromEnum + +foreign import ccall unsafe "highgui.h cvReleaseVideoWriter" + releaseVideoWriter :: CvVideoWriter -> IO () + +foreign import ccall unsafe "highgui.h cvWriteFrame" + cvWriteFrame :: CvVideoWriter -> Ptr IplImage -> IO CInt + +writeFrame :: CvVideoWriter -> Ptr IplImage -> IO Int +writeFrame vw im + = do i <- cvWriteFrame vw im + return $ fromIntegral i diff --git a/src/Test.hs b/src/Test.hs deleted file mode 100644 --- a/src/Test.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Main where - -import Foreign.Ptr -import Foreign.ForeignPtr -import Foreign.C.Types - -import AI.CV.OpenCV.CxCore -import AI.CV.OpenCV.CV -import AI.CV.OpenCV.HighGui - -import Control.Monad(when) - -showFrames :: CInt -> Ptr IplImage -> Ptr CvCapture -> IO () -showFrames winNum targetImage cvcapture = do - frame <- cvQueryFrame cvcapture - cvConvertImage (fromArr frame) (fromArr targetImage) 0 - calcFrame targetImage - where calcFrame targetSmall = do - cvResize targetImage targetSmall CV_INTER_LINEAR - cvCanny targetSmall targetSmall 30 190 3 - showImage winNum targetSmall - key <- waitKey 5 - when (key == -1) (showFrames winNum targetImage cvcapture) - - -processImages :: Ptr CvCapture -> IO () -processImages capture = do - frame <- cvQueryFrame capture - let winNum = 0 - newWindow winNum True - target <- createImageF (cvGetSize frame) 1 iplDepth8u - withForeignPtr target $ (\target' -> showFrames winNum target' capture) - -main :: IO () -main = do - capture <- createCameraCaptureF 0 - withForeignPtr capture processImages - - -