HOpenCV 0.1.2.4 → 0.3

raw patch · 14 files changed

+1073/−269 lines, 14 filesnew-component:exe:cannyVideoPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• HOpenCV.cabal +33/−19
• LICENSE +280/−0
• demo/cannyVideo.hs +24/−0
• src/AI/CV/OpenCV.hs +11/−0
• src/AI/CV/OpenCV/CV.hsc +64/−42
• src/AI/CV/OpenCV/CxCore.hsc +153/−100
• src/AI/CV/OpenCV/HOpenCV_wrap.c +36/−2
• src/AI/CV/OpenCV/HOpenCV_wrap.h +12/−0
• src/AI/CV/OpenCV/HighGui.hsc +127/−53
• src/AI/CV/OpenCV/ImgProc.hs +266/−0
• src/AI/CV/OpenCV/Types.hs +0/−13
• src/AI/CV/OpenCV/Util.hs +32/−0
• src/AI/CV/OpenCV/Video.hs +35/−0
• src/Test.hs +0/−40

@@ -1,11 +1,12 @@ name: HOpenCV-version: 0.1.2.4-license: BSD3+version: 0.3+license: GPL-2 maintainer: Noam Lewis <jones.noamle@gmail.com> 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: <http://opencv.willowgarage.com/wiki/Welcome>)    .@@ -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

@@ -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

@@ -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

@@ -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

@@ -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 <cv.h>   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    

@@ -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 <cxcore.h> @@ -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 ()

@@ -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;+}

@@ -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);

@@ -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 <highgui.h>  ------------------------------------------------ -- 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)

@@ -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

@@ -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

@@ -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'

@@ -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

@@ -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---